File [Indigo]<AltoSource>OSSOURCES.DM!2>LevBcpl.asm
; LevBCPL.asm - Bcpl runtime machine code
; Copyright Xerox Corporation 1979
; Last modified December 10, 1978 12:30 AM by Boggs
.titl LevBCPL
; These next lines are so that we
; can debug this mess by loading it with a normal
; BCPL program which smashes it into its proper place.
; When assembling this program for inclusion in the
; Operating System through non-subversive means, these
; lines should be de-activated.
;
; .bext Z300
; .bext UTILBEGIN, UTILEND
; .srel
;UTILBEGIN: UTIL
;UTILEND: UTILLAST
; End of debugging junk
.ent LevBcpl
.bext StackOverflow
.srel
LevBcpl: .LevBcpl
StackOverflow: StkOfl ; so swat can print a reasonable name.
.bext OsFinish
; Error codes passed to the procedure called on a "finish"
; If no error, pass 0
ecOfl = 1000. ; Stack overflow (common)
ecNYI = 1001. ; Not yet implemented
swat = 77400 ; Debugger trap instruction
.zrel
; Right shift constant amount
; LQ0
; Computes ac0 ← ac0 rshift n (n in range 1 to 7)
; Calling sequence is:
; lda 0 value
; jsr 314 - 2*n
; LQ1
; Computes ac1 ← ac1 rshift n (n in range 1 to 7)
; Calling sequence is:
; lda 1 value
; jsr 315 - 2*n
Z300:
LQ0: movzr 0 0 skp
LQ1: movzr 1 1 skp
movzr 0 0 skp
movzr 1 1 skp
movzr 0 0 skp
movzr 1 1 skp
movzr 0 0 skp
movzr 1 1 skp
movzr 0 0 skp
movzr 1 1 skp
movzr 0 0 skp
movzr 1 1
jmp 0 3
; Left shift data a constant amount, then store in partial-word field
; in the same manner as SNQx.
;
; SQ0
; Executes @ac1 ← (@ac1 & not @ac3) + ((ac0 lshift n) & @ac3)
; Calling sequence is:
; lda 0 value (right-justified)
; lda 1 address of word being stored into
; jsr 333 - 2*n (n is number of left shifts desired, in range 0-7)
; mask word (ones in field being stored into, zeroes elsewhere)
; returns here
; SQ1
; Executes @ac0 ← (@ac0 & not @ac3) + ((ac1 lshift n) & @ac3)
; Calling sequence is:
; lda 1 value (right-justified)
; lda 0 address of word being stored into
; jsr 334 - 2*n (n is number of left shifts desired, in range 0-7)
; mask word (ones in field being stored into, zeroes elsewhere)
; returns here
Z315:
SQ0: movzl 0 0 skp
SQ1: movzl 1 1 skp
movzl 0 0 skp
movzl 1 1 skp
movzl 0 0 skp
movzl 1 1 skp
movzl 0 0 skp
movzl 1 1 skp
movzl 0 0 skp
movzl 1 1 skp
movzl 0 0 skp
movzl 1 1 skp
movzl 0 0 skp
movzl 1 1 skp
jmp @360
jmp @361
ZSMAX: -1 ; 335
ZSNXT: -1
ZSMIN: -1
Z340: IOR
XOR
EQV
MULT
DIVREM
DIVREM
LSH
RSH
Z350: BRANCH
LOOKUP
0 ; was once UTIL
FINL: FINISH
ABORT
LONGJ
GETLV
MULPLUS
Z360: SNQ0
Z361: SNQ1
LY01
LY10
SY01
SY10
RETURN
STARGS
Z370: GETFRM
GETFRMALT ; was once START
-1
-1
LWB01
LWB10
SWB01
SWB10
.nrel
.LevBcpl: 0 ; The sacrificial word.....
fLast = 0 ; The layout of a BCPL frame
fRet = 1
fTemp = 2
fArgx = 3
fArg1 = 4
fArg2 = 5
fArg3 = 6
FINISH: mkzero 0 0 skp ; finishCode = fcOK
ABORT: mkone 0 0 ; finishCode = fcAbort
Blast: mkzero 1 1 ; Enter with AC0 set to code
sta 1 ZSMAX ; Make bottom of stack very low for now.
jsrii .+1
OsFinish ; call the OS finish routine
LWB01: ; replicated bit field manipulations
LWB10: ; are not implemented, though the
SWB01: ; compiler generates code for them.
SWB10:
GETLV: ; used on the Nova?
NOTYET: swat
lda 0 .+2
jmp Blast
ecNYI
; Getframe:
GETFRM: sta 3 fTemp 2 ; save return in old frame
mov 2 3 ; compute new frame by fetching
lda 2 @fTemp 3 ; frame size and subtracting
;BCPL used to assume that the minimum frame size was 4.
;Getframe unconditionally stored AC0 and AC1 in the first two locals.
;This could smash the previous frame. The bug was fixed here in getframe
; by making it always allocate a frame 2 bigger than requested.
;The compiler has since been fixed so that the minimum frame size
; in code it generates is 6. The inc 2 2, com 2 2 can be turned into
; a neg 2 2 whenever you think all code compiled with the old version
; of the compiler has gone away. If you are wrong, the old code will
; act very flaky and be very hard to track down.
;The correct minimum frame size is 6.
GETFRMALT: ; Alternate entry point with ac2=frame size
inc 2 2
com 2 2
add 3 2 ; 2=> new frame
sta 0 -1 3 ; save ac0 below current frame (ahem)
lda 0 ZSMAX ; stack moves "down".
subz# 0 2 snc ; max must be less
jmp GFOFL ; overflow
lda 0 -1 3 ; pick up first arg
sta 0 fArg1 2 ; and save it in new frame
sta 1 fArg2 2 ; store second param
sta 3 fLast 2 ; and old stack pointer
lda 0 @fRet 3
lda 1 K3
subl# 1 0 snc
jmp GFGE3
GFLE2: lda 3 fTemp 3
jmp 2 3
GFGE3: sub 0 1 szr
jmp GFGR3
GFEQ3: lda 1 fArgx 3
sta 1 fArg3 2
lda 3 fTemp 3
jmp 2 3
GFGR3: lda 1 fArgx 3
add 3 1
lda 3 fTemp 3
jmp 1 3
K3: 3
GFOFL: mov 3 2 ; Put old stack back in 2 for viewing
StkOfl: swat
lda 0 .+2 ; Error code for stack overflow.
jmp Blast ; Abort
ecOfl
; Return
; Performs:
; AC2 ← AC2!0
; PC ← AC2!1
RETURN: lda 2 fLast 2
lda 3 fRet 2
jmp 1 3
; StoreArgs
; Assumes AC0 has actual parameter count
; and AC1 points to actual parameter
; vector-1, and that the first two parameters
; have already been transferred (by GetFrame usually).
STARGS: sta 3 fRet 2
sta 0 fTemp 2
lda 3 K2
sub 0 3 ; AC3 ← -(ArgCount-2)
inc 1 0
inc 0 0 ; AC0 ← Pointer to third parameter-1
lda 1 KFARG
add 2 1
sub 3 1 ; AC1 ← AC2+(fArg1-1)+ArgCount
blt ; Wheeeeee!
lda 0 fTemp 2 ; AC0 ← ArgCount again (for NumArgs)
jmp @fRet 2
K2: 2
KFARG: (fArg1-1)+2
; LongJump
; Jumps to AC3 + @AC3
; Calling sequence is:
; jsr @355
; target-. (i.e., a self-relative pointer)
LONGJ: lda 1 0 3
add 1 3
jmp 0 3
; Branch
; Calling sequence is:
; lda 0 switchon value
; jsr @350
; value of last case
; number of cases
; lastTarget-.
; ...
; firstTarget-.
; return here if out of range, AC0 unchanged
BRANCH: lda 1 0 3
subz 0 1 snc
jmp BR2
sta 3 fRet 2
lda 3 1 3
adcz# 1 3 snc
jmp BR1
lda 3 fRet 2
add 1 3
lda 1 2 3
add 1 3
jmp 2 3
BR1: mov 3 1
lda 3 fRet 2
add 1 3
jmp 2 3
BR2: lda 1 1 3
add 1 3
jmp 2 3
; Lookup
; Calling sequence is:
; lda 0 switchon value
; jsr @351
; number of cases
; case value 1
; target1-.
; ...
; case value n
; targetn-.
; return here if out of range
LOOKUP: lda 1 0 3
sta 1 fRet 2
LK0: inc 3 3
inc 3 3
lda 1 -1 3
sub 0 1 snr
jmp LK1
dsz fRet 2
jmp LK0
jmp 1 3
LK1: lda 1 0 3
add 1 3
jmp 0 3
; Right shift
; Computes ac0 ← ac0 rshift ac1
; Called by jsr @347
; Note that shift count may be either positive or negative
RSH: sta 3 fRet 2 ; Computes AC0 ← AC0 rshift AC1
lda 3 K16
RSH0: subz 3 1 szc
jmp RSH9
jsr .+1
sub 1 3
jmp 1 3
movzr 0 0
movzr 0 0
movzr 0 0
movzr 0 0
movzr 0 0
movzr 0 0
movzr 0 0
movzr 0 0
movzr 0 0
movzr 0 0
movzr 0 0
movzr 0 0
movzr 0 0
movzr 0 0
movzr 0 0
jmp @fRet 2
RSH9: movl# 1 1 szc
add 3 1 skp
sub 0 0 skp
neg 1 1 skp
jmp @fRet 2
jmp LSH0
; Left shift
; Computes ac0 ← ac0 lshift ac1
; called by jsr @346
; Note that shift count may be either positive or negative
LSH: sta 3 fRet 2 ; Computes AC0 ← AC0 lshift AC1
lda 3 K16
LSH0: subz 3 1 szc
jmp LSH9
jsr .+1
sub 1 3
jmp 1 3
movzl 0 0
movzl 0 0
movzl 0 0
movzl 0 0
movzl 0 0
movzl 0 0
movzl 0 0
movzl 0 0
movzl 0 0
movzl 0 0
movzl 0 0
movzl 0 0
movzl 0 0
movzl 0 0
movzl 0 0
jmp @fRet 2
LSH9: movl# 1 1 szc
add 3 1 skp
sub 0 0 skp
neg 1 1 skp
jmp @fRet 2
jmp RSH0
K16: 20
; Ior
; Computes ac0 ← ac0 % ac1
; Called by jsr @340
IOR: com 1 1
and 1 0
adc 1 0
jmp 0 3
; Xor
; Computes ac0 ← ac0 xor ac1
; Called by jsr @341
XOR: sta 3 fRet 2
mov 0 3
andzl 1 3
add 1 0
sub 3 0
jmp @fRet 2
; Eqv
; Computes ac0 ← ac0 eqv ac1
; Called by jsr @342
EQV: sta 3 fRet 2
mov 0 3
andzl 1 3
add 1 0
sub 3 0
com 0 0
jmp @fRet 2
; Mult
; Computes (ac0,ac1) ← ac0*ac1
; Called by jsr @343
MULT: sta 3 fRet 2
mov 2 3
mov 0 2
subc 0 0
mul
mov 3 2
jmp @fRet 2
; DivRem
; Computes ac1 ← ac0/ac1 and ac0 ← ac0 rem ac1 (signed)
; Called by jsr@344 or jsr@345
DIVREM: sta 3 fRet 2
mov 2 3
mov 1 2
movl 1 1 szc
neg 2 2 ; AC2 = ABS(Divisor)
mov 0 1
movr 0 0
sta 0 fTemp 3 ; High bit is sign of divisor, next bit
; is sign of dividend
movl# 1 1 szc
neg 1 1 ; AC1 = ABS(Dividend)
sub 0 0
div
nop
mov 3 2
lda 3 fTemp 2
movl 3 3 szc
neg 1 1 ; Only if divisor was negative
movl 3 3 snc
jmp @fRet 2 ; Only if dividend was positive
neg 1 1
neg 0 0
jmp @fRet 2
; MulPlus
; Computes ac0 ← ac3 ← (ac1*@ac3)+ac0
; Calling sequence is:
; lda 0 addend
; lda 1 multiplicand
; jsr @357
; multiplier
; return here with result in ac0 and ac3
MULPLUS:inc 3 3 ; Computes AC0 ← AC3 ← (AC1*@AC3)+AC0
sta 3 fRet 2
mov 2 3
lda 2 fRet 2
lda 2 -1 2
mul
mov 1 0
mov 3 2
mov 1 3
jmp @fRet 2 ; go to (originalAC3+1)
; Snq0
; Stores partial-word field into a structure.
; Executes @ac1 ← (@ac1 & not @ac3) + (ac0 & @ac3)
; Calling sequence is:
; lda 0 value (must be bit-aligned with field being stored into)
; lda 1 address of word being stored into
; jsr @360
; mask word (ones in field being stored into, zeroes elsewhere)
; returns here
SNQ0: sta 3 fRet 2
sta 1 fTemp 2
lda 1 0 3
and 1 0
lda 3 fTemp 2
lda 3 0 3
com 1 1
and 3 1
add 1 0
lda 3 fTemp 2
sta 0 0 3
lda 3 fRet 2
jmp 1 3
; Snq1
; Stores partial-word field into a structure.
; Executes @ac0 ← (@ac0 & not @ac3) + ac1 & @ac3
; Calling sequence is:
; lda 1 value (must be bit-aligned with field being stored into)
; lda 0 address of word being stored into
; jsr @360
; mask word (ones in field being stored into, zeroes elsewhere)
; returns here
SNQ1: sta 3 fRet 2
sta 0 fTemp 2
lda 0 0 3
and 0 1
lda 3 fTemp 2
lda 3 0 3
com 0 0
and 3 0
add 0 1
lda 3 fTemp 2
sta 1 0 3
lda 3 fRet 2
jmp 1 3
; Ly01
; Load byte from array
; Loads the ac1'th byte from the array pointed to by ac0
; and returns it right-justified in ac0.
; Called by jsr @362
; Note: ac1 may be negative.
LY01: sta 3 fRet 2
movl# 1 1 szc
movor 1 3 skp
movzr 1 3 skp
addc 0 3 skp
add 0 3
lda 1 0 3
lda 0 K377R
mov# 0 0 snc
movs 0 0 skp
and 1 0 skp
ands 1 0
jmp @fRet 2
; Sy01
; Store byte into array
; Stores the byte now contained in frame temp 3 (ac2!3) into
; the ac1'th byte of the array pointed to by ac0.
; Called by jsr@364
; Note: ac1 may be negative.
SY01: sta 3 fRet 2
movl# 1 1 szc
movor 1 3 skp
movzr 1 3 skp
addc 0 3 skp
add 0 3
sta 3 fTemp 2
lda 3 0 3
lda 1 fArgx 2
lda 0 K377R
mov# 0 0 szc
and 0 1 skp
and 0 3 skp
movs 0 0 skp
ands 1 0 skp
and 3 0 skp
add 3 0 skp
add 1 0
lda 3 fTemp 2
sta 0 0 3
jmp @fRet 2
; Ly10
; Load byte from array
; Loads the ac0'th byte from the array pointed to by ac1
; and returns it right-justified in ac1.
; Called by jsr @363
; Note: ac0 may be negative.
LY10: sta 3 fRet 2
movl# 0 0 szc
movor 0 3 skp
movzr 0 3 skp
addc 1 3 skp
add 1 3
lda 0 0 3
lda 1 K377R
mov# 1 1 snc
movs 1 1 skp
and 0 1 skp
ands 0 1
jmp @fRet 2
; Sy10
; Store byte into array
; Stores the byte now contained in frame temp 3 (ac2!3) into
; the ac0'th byte of the array pointed to by ac1.
; Called by jsr@365
; Note: ac0 may be negative.
SY10: sta 3 fRet 2
movl# 0 0 szc
movor 0 3 skp
movzr 0 3 skp
addc 1 3 skp
add 1 3
sta 3 fTemp 2
lda 3 0 3
lda 0 fArgx 2
lda 1 K377R
mov# 1 1 szc
and 1 0 skp
and 1 3 skp
movs 1 1 skp
ands 0 1 skp
and 3 1 skp
add 3 1 skp
add 0 1
lda 3 fTemp 2
sta 1 0 3
jmp @fRet 2
UTILLAST:
K377R: 377
.end