; IfsBcplRuntime.asm -- replacement for standard Bcpl runtime,
;			making calls on microcoded routines
; Copyright Xerox Corporation 1979, 1980

; Last modified by Taft, April 19, 1980  12:13 PM

; Derived from BcplRuntime.asm:
; Last modified October 13, 1977  11:23 AM


.ent InitBcplRuntime
.ent InitIfsRuntime, ifsRuntime
.ent ResetStrings
.bext OsFinish
.bext lvUserFinishProc

.srel

InitBcplRuntime: .InitBcplRuntime
Z300:	.Z300
InitIfsRuntime: .InitIfsRuntime
ifsRuntime: 0
ResetStrings: .ResetStrings

.nrel


; Trap opcodes that call the microcoded routines

.dusr uGetFrame = 61400
.dusr uReturn = 62000
.dmr uCall = 64000

getFrame = 370

ftemp = 2
fret = 1
return = 1
flink = 0
stackBottom = -1
XPC = -2
XJMP = -3
XARGS = -4
stringList = -5

; Page zero image, starting at 300

.Z300:	uCall 00		; Lq0.6 Routines that live in page 0
	uCall 01		; Lq1.6
	uCall 02		; Lq0.5
	uCall 03		; Lq1.5
	uCall 04		; Lq0.4
	uCall 05		; Lq1.4
	uCall 06		; Lq0.3
	uCall 07		; Lq1.3
.Z310:	uCall 10		; Lq0.2
	uCall 11		; Lq1.2
	uCall 12		; Lq0.1
	uCall 13		; Lq1.1
	77400			; Shouldn't ever get here
	uCall 15		; Sq0.7
	uCall 16		; Sq1.7
	uCall 17		; Sq0.6
.Z320:	uCall 20		; Sq1.6
	uCall 21		; Sq0.5
	uCall 22		; Sq1.5
	uCall 23		; Sq0.4
	uCall 24		; Sq1.4
	uCall 25		; Sq0.3
	uCall 26		; Sq1.3
	uCall 27		; Sq0.2
.Z330:	uCall 30		; Sq1.2
	uCall 31		; Sq0.1
	uCall 32		; Sq1.1
	77400			; Shouldn't ever get here
	77400
	0			; ZsMax
	0			; ZsNxt
	0			; ZsMin

; Routines dispatched through page 0.
; Note that Bldr will not let us put absolute addresses here, so
; we use self-relative addresses which InitBcplRuntime must fix up.

.Z340:	Ior-.
	Xor-.
	Eqv-.
	Mult-.
	DivRem-.
	DivRem-.
	Lsh-.
	Rsh-.
.Z350:	Branch-.
	Lookup-.
	NotImp-.		; Was once Util
	Finish-.
	Abort-.
	LongJump-.
	NotImp-.		; GetLv
	MulPlus-.
.Z360:	Snq0-.
	Snq1-.
	Ly01-.
	Ly10-.
	Sy01-.
	Sy10-.
	Return-.
	NotImp-.		; StoreArgs
.Z370:	GetFrame-.
	NotImp-.		; GetFrmAlt
	0
	0
	NotImp-.		; Lwb01
	NotImp-.		; Lwb10
	StackOverflow-.		; Stack overflow during frame allocation
	StackOverflow-.		; Stack overflow during string allocation

; Code for routines dispatched through page zero
Ior:	uCall 40
Xor:	uCall 41
Eqv:	uCall 42
Mult:	uCall 43
DivRem:	uCall 44
Lsh:	uCall 46
Rsh:	uCall 47
Branch:	uCall 50
Lookup:	uCall 51
LongJump: uCall 55
MulPlus: uCall 57
Snq0:	uCall 60
Snq1:	uCall 61
Ly01:	uCall 62
Ly10:	uCall 63
Sy01:	uCall 64
Sy10:	uCall 65
Return:	uReturn

; Frame allocator -- microcode returns if stack overflows
GetFrame: uGetFrame
StackOverflow:
	sta 3 save3
	jsr SwatPrint
	 1000.			; ecStackOverflow

; Runtime routines that aren't microcoded
NotImp:	jsr SwatPrint
	 1001.			; ecUnimplemented

SwatPrint:
	mov 3 1			; Pointer to error code
	jsr swat1
	.txt "Sys.Errors"
swat1:	mov 3 0			; Pointer to error filename
	lda 3 save3
	77403			; Call Swat error printing facility

Abort:	mkone 0 0 skp		; fcAbort
Finish:	mkzero 0 0		; fcOK
	jsrii .+1
	 OsFinish

save3:	.blk 1

; InitBcplRuntime()
; Replaces the standard Bcpl runtime transfer vector with the one
; in this package, after saving the old one.  Enables a userFinishProc
; to restore the old transfer vector at finish time.
; Assumes the companion microcode has already been loaded.

; Note: if you Junta past levBcpl, InitBcplRuntime must be called
; before any other initialization that queues up userFinishProcs,
; so as to ensure that our userFinishProc is executed last.
; Otherwise, the standard transfer vector will end up transferring
; into random garbage at the next Bcpl runtime call.

; This routine is called for both initialization and cleanup --
; it tells which by looking at savedUserFinishProc

.InitBcplRuntime:
	sta 3 1 2
	dir

; Exchange locations 300-377 with the page zero image, except do not
; exchange words where the page zero image contains zero.
	lda 3 c300		; Page zero pointer
	sta 3 2 2
	lda 3 c100		; Counter
	sta 3 3 2
	lda 3 @lvZ300		; Image pointer
init1:	lda 0 0 3		; Get word from image
	snz 0 0			; Zero?
	 jmp init2		; Yes, bypass
	lda 1 @2 2		; Get word from page zero
	sta 1 0 3		; Save in image
	lda 1 c100		; See if relocation needed
	sgeu 0 1
	 add 3 0		; Yes, do so
	sta 0 @2 2		; Exchange
init2:	inc 3 3			; Increment pointers
	isz 2 2
	dsz 3 2			; Decrement and test count
	 jmp init1

; See whether initializing or cleaning up
	eir
	lda 3 @lvLvUserFinishProc
	lda 0 savedUserFinishProc
	com# 0 0 szr
	 jmp init3

; Initializing, set up a userFinishProc
	lda 0 0 3		; Save old userFinishProc
	sta 0 savedUserFinishProc
	lda 0 @lvInitBcplRuntime ; Install ours

; Cleaning up, restore saved userFinishProc
init3:	sta 0 0 3
	lda 3 1 2
	jmp 1 3

c300:	300
c100:	100
lvZ300:	Z300
lvLvUserFinishProc: lvUserFinishProc
lvInitBcplRuntime: InitBcplRuntime
savedUserFinishProc: -1

; InitIfsRuntime()
; Changes BcplRuntime's @getFrame to uCall getFrame
; Sets ifsRuntime for DVec
; Relies on BcplRuntime userFinishProc to restore the old
; transfer vector at finish time.

; This routine is called at initialization

.InitIfsRuntime:

; Change @getFrame to XGetFrame
	lda 0 cUCallGetFrame
	sta 0 @getFrame

; Set up stackBottom and set ifsRuntime.
	adc 0 0
	sta 0 @lvIfsRuntime
	add 2 0
	sta 0 stackBottom,2

	jmp 1 3

cUCallGetFrame: uCall getFrame
lvIfsRuntime: ifsRuntime


; ResetStrings()
; Deletes all strings that have been allocated in the current frame.
; This invalidates any variables that have been assigned string literal
; values during the current procedure, but does not prevent new strings
; from being created.

.ResetStrings:
	lda 0 cXARGS
	add 2 0
	sta 0 stackBottom 2
	jmp 1 3

cXARGS:	XARGS

.end