; 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