.titl SpruceMl ; [a] means a -> double-precision number ;DoubleAdd(a,b) -- [a] ← [a] + [b] ;SafeAdd(a, b) -- [a] ← [a] + b, returns true if no overflow, false if overflow ;DoubleSub(a,b) -- [a] ← [a] - [b] ;DoubleShr(a) -- [a] ← [a] arith-rshift 1 ;DoubleCop(a,b) -- [a] ← [b] ;MulDiv(a,b,c) returns a*b/c without losing intermediate precision -- rounds ;MulDivNR(a,b,c) " " -- truncates ;MulDivRU(a,b,c) " " -- always rounds up ;MulMod(a,b,c) returns (a*b) rem c ;MulFull(a,b,v) [v] ← a*b ;Ugt(a,b) returns true if a>b unsigned 16-bit ;TGr(a,b) returns true if a>b using "true compare" ;GetCode0 returns AC0 ;GetCode1 returns AC1, destroys AC0 ; TruePredicate, FalsePredicate, Noop live here ; InitFrameRuntime(init/cleanup) // GetFrame, return microcode initialization, cleanup ; SetupFrameFinishProc() // one call per system image to set up frame cleanup ; BankBlt(from, to, size) // calls BankBlt microcode at #31 savedPC=1 temp=2 extraArguments=3 .srel DoubleAdd: .DoubleAdd DoubleSub: .DoubleSub DoubleShr: .DoubleShr DoubleCop: .DoubleCop MulDiv: .MulDiv MulDivNR: .MulDivNR MulDivRU: .MulDivRU MulMod: .MulMod MulFull: .MulFull SafeAdd: .SafeAdd Ugt: .Ugt TGr: .TGr TruePredicate: .t FalsePredicate: .f Noop: .n GetCode0: .GetCode0 GetCode1: .GetCode1 InitFrameRuntime: .InitFrameRuntime SetupFrameFinishProc: .SetupFrameFinishProc FrameFinishProc: .FrameFinishProc BankBlt: .BankBlt Z366: .Z366 .ent DoubleAdd,DoubleSub,DoubleShr,DoubleCop, SafeAdd .ent MulDiv,MulDivNR, MulDivRU, MulMod,MulFull,Ugt,TGr .ent GetCode0, GetCode1 .ent TruePredicate, FalsePredicate, Noop .ent InitFrameRuntime, SetupFrameFinishProc .bext OsFinish, lvUserFinishProc .ent BankBlt .nrel 0 .SafeAdd: inc 3 3 sta 3 s3 sta 0 s0 sub 0 0 sta 0 n00 lda 0 @s0 sta 0 n01 sta 1 n11 jsr nadr ; set up ac0, 1 to point to n00 and n10 n00: 0 ; mea culpa (DCS 9-22-78) n01: 0 nadr: mov 3 0 jsr nadr2 n10: 0 n11: 0 nadr2: mov 3 1 jsr .DoubleAdd 2 dsz n00 ; 0 if overflow, -1 otherwise mov# 0 0 lda 0 n01 sta 0 @s0 lda 0 n00 jmp @s3 ; false if overflow, true otherwise s3: 0 s0: 0 .DoubleAdd: sta 3 savedPC,2 sta 1 temp,2 ; => first word of arg 2 mov 1,3 lda 1,1,3 ; word 2 of arg 2 mov 0 3 lda 0,1,3 ; word 2 of arg 1 addz 1,0 sta 0,1,3 ; word 2 of arg 1 lda 0,0,3 ; word 1 of arg 1 lda 1 @temp,2 ; word 1 of arg 2 mov 0,0,szc inc 0,0 add 1,0 sta 0,0,3 ; word 1 of arg 1 lda 3 savedPC,2 jmp 1,3 .DoubleSub: sta 3 savedPC,2 sta 1 temp,2 ; => first word of arg 2 mov 1 3 lda 1,1,3 ; word 2 of arg 2 mov 0 3 lda 0,1,3 ; word 2 of arg 1 subz 1,0 sta 0,1,3 ; word 2 of arg 1 lda 0,0,3 ; word 1 of arg 1 lda 1 @temp,2 ; word 1 of arg 2 mov 0,0,szc inc 0,0 adc 1,0 sta 0,0,3 ; word 1 of arg 1 lda 3 savedPC,2 jmp 1,3 .DoubleShr: sta 3 savedPC,2 MOV 0,3 ;SAVE POINTER TO NUMBER LDA 0,0,3 ;HIGH ORDER PART MOVL# 0,0,SZC ;TEST SIGN BIT MOVOR 0,0,SKP ;SHIFT IN A 1 MOVZR 0,0 ;SHIFT IN A 0 STA 0,0,3 LDA 1,1,3 ;LOW ORDER MOVR 1,1 ;SHIFT CARRY BIT IN STA 1,1,3 ;AND REPLACE lda 3 savedPC,2 jmp 1,3 ;RETURN INTEGER PART... .DoubleCop: sta 3 savedPC,2 mov 0 3 ; destination address sta 1 temp,2 lda 0 @temp,2 ; high order sta 0 0,3 ; save it isz temp,2 lda 0 @temp,2 sta 0 1,3 ; low order lda 3 savedPC,2 jmp 1,3 ;RETURN INTEGER PART... .MulDivNR: ;non-rounding MulDiv sta 3,savedPC,2 mov 2,3 mov 0,2 sub 0,0 ; do not round jmp .ml .MulDivRU: ;always round up sta 3,savedPC,2 mov 2,3 mov 0,2 lda 0,extraArguments,3 neg 0,0 ; divisor-1 inc 0,0 neg 0,0 jmp .ml .MulDiv: sta 3 savedPC,2 mov 2,3 ; stack pointer mov 0 2 ; a lda 0 extraArguments,3 ; c movzr 0 0 ; c/2 for rounding .ml: mul ; go multiply lda 2 extraArguments,3 ; c div mov# 0,0 mov 1 0 ; answer mov 3 2 lda 3 savedPC,2 jmp 1,3 .MulMod: sta 3 savedPC,2 mov 2,3 ; stack pointer mov 0 2 ; a sub 0 0 mul ; go multiply lda 2 extraArguments,3 ; c div mov# 0,0 mov 3 2 ;div returns remainder in AC0 lda 3 savedPC,2 jmp 1,3 .MulFull: sta 3 savedPC,2 mov 2 3 mov 0 2 sub 0 0 mul lda 2 extraArguments,3 sta 0 0,2 ; high order sta 1 1,2 ; low order mov 3 2 lda 3 savedPC,2 jmp 1,3 .Ugt: sgtu 0,1 mkzero 0,0,skp mkminusone 0,0 jmp 1,3 .TGr: sta 3 savedPC,2 subzr 3,3 and 1,3 addl 0,3 adc# 1,0,snc sub 0,0,skp ; false adc 0,0 ; true lda 3 savedPC,2 jmp 1,3 ; TruePredicate, FalsePredicate, Noop may be invoked by the CALL mechanism ; Thus, jumps to "start+1" may occur, with AC3 invalid. .t: jmp .+2 lda 3 savedPC,2 mkminusone 0,0 jmp 1,3 .f: jmp .+2 lda 3 savedPC,2 mkzero 0,0 jmp 1,3 .n: jmp 1,3 lda 3 savedPC,2 jmp 1,3 .GetCode1: mov 1,0 .GetCode0: jmp 1,3 ; GetFrame group uGetFrame = 61400 uReturn = 62000 ; Trap opcodes that call the microcoded routines .Z366: Return-. 0 ; StoreArgs .Z370: GetFrame-. Return: uReturn ; Frame allocator -- microcode returns if stack overflows GetFrame: uGetFrame jsr SwatPrint 1000. ; ecStackOverflow SwatPrint: mov 3 1 ; Pointer to error code jsr swat1 .txt "Sys.Errors" swat1: mov 3 0 ; Pointer to error filename 77403 ; Call Swat error printing facility ; InitFrameRuntime(initialize) Replaces parts of the standard Bcpl runtime transfer vector with ; entries in this package, after saving the old ones. Assumes the companion microcode has already ; been loaded. ; Note: you can't Junta past levBcpl, because not all runtimes are replaced. If this changes, see Taft's ; BcplRuntime. ; This routine is called for both initialization and cleanup -- depending on the argument. A separate ; routine sets up the finish routine for invoking it in the cleanup mode. .InitFrameRuntime: sta 3 1 2 lda 1 initState ;non-zero if initialized, 0 if not sne 0 1 ;quit if same jmp 1 3 sta 0 initState ; now the same! dir ; Exchange selected locations in 300-377 with the page zero image, except do not ; exchange words where the page zero image contains zero. lda 3 c366 ; Page zero pointer -- locns 366 (return), 367, 370 (GetFrame) sta 3 2 2 lda 3 c3 ; Counter sta 3 3 2 lda 3 @lvZ366 ; 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 eir ret: lda 3 1 2 jmp 1 3 .SetupFrameFinishProc: sta 3 1 2 lda 3 @lvLvUserFinishProc lda 0 0 3 ; Save old userFinishProc sta 0 savedUserFinishProc lda 0 @lvFrameFinishProc ; Install ours sta 0 0 3 jmp ret .FrameFinishProc: inc 3 3 sta 3 sve3 sub 0 0 jsr .InitFrameRuntime 1 lda 3 @lvLvUserFinishProc lda 0 savedUserFinishProc sta 0 0 3 jmp @sve3 sve3: 0 c366: 366 c3: 3 c100: 100 lvZ366: Z366 lvLvUserFinishProc: lvUserFinishProc lvFrameFinishProc: FrameFinishProc savedUserFinishProc: 0 initState: 0 JMPRAM = 61010 .BankBlt: sta 2,bbsv2 inc 3,3 sta 3,bbsv3 lda 3,extraArguments,2 mov 1,2 lda 1,BankBltLoc JMPRAM lda 2,bbsv2 jmp @bbsv3 bbsv2: 0 bbsv3: 0 BankBltLoc: 31 .END ;; DCS, September 30, 1977 10:57 AM, add GetCode0, GetCode1 ;; October 4, 1977 3:29 PM, MulDivNR -- truncates ;; October 4, 1977 3:43 PM, MulDivRU -- rounds up ;; December 27, 1977 10:37 AM, TruePredicate, FalsePredicate, Noop can be invoked by CALL ;; March 6, 1978 6:51 PM, RowRotate linkage to ROWROT in RAM ;; September 22, 1978 9:03 PM, add SafeAdd(lv x, y) ;; October 3, 1978 2:58 PM, add ShowChars(lvC, lvBand), ;; SetupShowChars(specs, num, stream) ;; October 4, 1978 11:29 AM, return results from ShowChars ;; October 18, 1978 12:25 PM, move orbit, band-related stuff to sprucebandml ;; October 20, 1978 1:55 PM, add getframe, return, init of same ;; April 7, 1979 4:06 PM, add BankBlt, calling BankBlt microcode ;;