# You may have to edit this file to delete header lines produced by # mailers or news systems from this file (all lines before these shell # comments you are currently reading). # Shell archive made by dwjones on Mon Jul 21 16:31:33 CDT 2014 # To install this software on a UNIX system: # 1) create a directory (e.g. with the shell command mkdir stuff) # 2) change to that directory (e.g. with the command cd stuff), # 3) direct the remainder of this text to sh (e.g. sh < ../savedmail). # This will make sh create files in the new directory; it will do # nothing else (if you're paranoid, you should scan the following text # to verify this before you follow these directions). cat > monitor.a << 'xxENDFILExxmonitor.a' TITLE "monitor.a -- Hawk Monitor and Library" ; by: Douglas W. Jones ; rewritten: July 2014 ; compatable with monitor.h ; requires full Hawk instruction set ; except does not use floating point USE "hawk.h" USE "ascii.h" ; ---------------------------------- ; static memory allocation support MACRO ALLOC =n . = . + n ENDMAC ; ---------------------------------- ; machine configuration ; trap vector RESTARTTRAP = #00 BUSTRAP = #10 INSTRTRAP = #20 PRIVTRAP = #30 MMUTRAP = #40 COTRAP = #50 POSTTRAP = #100 ; location beyond the trap vector ; memory mapped display interface DISPBASE = #FF000000 DISPLINES = 0 DISPCOLS = 4 DISPTEXT = #100 ; keyboard interface KBDBASE = #FF100000 KBDDATA = 0 KBDSTAT = 4 ; ---------------------------------- ; trap handler framework ; the following code intercepts all traps and interrupts, ; saves registers in the trap save area. Note that it is ; essential that trap service routines that intend to return ; to the user not cause traps themselves. ; save area structure (displacements from start of area) LC = . . = 0 PSWSV: ALLOC 4 TMASV: ALLOC 4 PCSV: ALLOC 4 R1SV: ALLOC 4 R2SV: ALLOC 4 R3SV: ALLOC 4 R4SV: ALLOC 4 R5SV: ALLOC 4 R6SV: ALLOC 4 R7SV: ALLOC 4 R8SV: ALLOC 4 R9SV: ALLOC 4 RASV: ALLOC 4 RBSV: ALLOC 4 RCSV: ALLOC 4 RDSV: ALLOC 4 RESV: ALLOC 4 RFSV: ALLOC 4 SVSIZE: ALLOC 0 . = LC COMMON SVFATAL,SVSIZE ; savearea for fatal traps SUBTITLE "Trap vector code" ;------------------------ . = RESTARTTRAP ; do { --special case, start or restart EXT UNUSED ; -- needed only for restart EXT MAIN ; -- needed only for restart LIL R2,UNUSED ; 4 -- set up the stack JSR R1,DSPINI ; 4 (columns, lines) = dspini() LIL R1,MAIN ; 4 JSRS R1,R1 ; 2 main(columns, lines) BR RESTARTTRAP ; 2 } forever . = BUSTRAP CPUSET R2,TSV ; 2 LIL R2,SVFATAL+R5SV ; 4 STORES R5,R2 ; 2 savearea.r5sv = oldR5 LEA R5,BUSMSG ; 4 -- parameter, bus trap message JUMP TRAPCON ; 4 . = INSTRTRAP CPUSET R2,TSV ; 2 LIL R2,SVFATAL+R5SV ; 4 STORES R5,R2 ; 2 savearea.r5sv = oldR5 LEA R5,INSTMSG ; 4 -- parameter, bus trap message JUMP TRAPCON ; 4 . = PRIVTRAP CPUSET R2,TSV ; 2 LIL R2,SVFATAL+R5SV ; 4 STORES R5,R2 ; 2 savearea.r5sv = oldR5 LEA R5,PRIVMSG ; 4 -- parameter, bus trap message JUMP TRAPCON ; 4 . = MMUTRAP CPUSET R2,TSV ; 2 LIL R2,SVFATAL+R5SV ; 4 STORES R5,R2 ; 2 savearea.r5sv = oldR5 LEA R5,MMUMSG ; 4 -- parameter, bus trap message JUMP TRAPCON ; 4 . = COTRAP CPUSET R2,TSV ; 2 LIL R2,SVFATAL+R5SV ; 4 STORES R5,R2 ; 2 savearea.r5sv = oldR5 LEA R5,COPMSG ; 4 -- parameter, bus trap message JUMP TRAPCON ; 4 . = POSTTRAP SUBTITLE "Generic fatal trap continuation" ;------------------------ TRAPCON:; expects: oldR5 saved in savearea->r5sv ; oldR2 saved in TSV ; R2 -- points to savearea->r5sv ; R5 -- m, pointer to diagnostic message to print ; all other registers still hold user values ; including PSW, TMA and TPC ; first, fix R2 so it points to the start of the savearea LEA R2,R2,PSWSV-R5SV ; now, save a few registers STORE R1,R2,R1SV ; savearea->r1sv = oldR1 CPUGET R1,TSV STORE R3,R2,R3SV ; savearea->r3sv = oldR3 STORE R1,R2,R2SV ; savearea->r2sv = TSV = oldR2 ; take a break from saving registers to save other stuff CPUGET R1,PSW CPUGET R3,TMA STORE R1,R2,PSWSV ; savearea->pswsv = oldPSW CPUGET R1,TPC STORE R3,R2,TMASV ; savearea->tmasv = TMA STORE R1,R2,PCSV ; savearea->pcsv = TPC = oldPC ; finish saving registers STORE R4,R2,R4SV ; savearea->r4sv = oldR4 STORE R6,R2,R6SV ; savearea->r6sv = oldR6 STORE R7,R2,R7SV ; savearea->r7sv = oldR7 ; here: (R1-R7, PSW, TMA and TPC) all saved in savearea ; R2 -- points to R8SV (used as base of small stack) ; R4 -- m, pointer to diagnostic message to print ; can now use existing monitor calling conventions ; the following trap service code simply prints ; diagnostic output and terminates! ADDI R2,R2,R8SV ; -- push activation record JSR R1,DSPINI ; (columns, lines) = dspini() -- uses R3-4 MOVE R3,R5 JSR R1,PUTS ; puts( m ) LEA R3,MSGPC ; -- parameter (address of string) JSR R1,PUTS ; puts( "PC =" ) -- uses R3-7 LOAD R3,R2,PCSV-R8SV ; -- parameter pcsv JSR R1,PUTHEX ; puthex( pcsv ) -- uses R3-7 LEA R3,MSGXX ; -- parameter (address of string) JSR R1,PUTS ; puts( " " ) -- uses R3-7 LIS R3,17 ; -- parameters LIS R4,1 JSR R1,PUTAT ; putat( 17, 1 ) -- uses R3-7 LEA R3,MSGMA ; -- parameter (address of string) JSR R1,PUTS ; puts( "MA =" ) -- uses R3-7 LOAD R3,R2,TMASV-R8SV; -- parameter JSR R1,PUTHEX ; puthex( tmasv ) -- uses R3-7 LEA R3,MSGXX ; -- parameter (address of string) JSR R1,PUTS ; puts( " " ) -- uses R3-7 ADDI R2,R2,-R8SV ; -- pop activation record ; here: (R1-R7, PSW, TMA and TPC) all saved in savearea ; R2 -- points to R8SV ; First, restore (R3-R7) to prepare for restart LOAD R7,R2,R7SV ; R7 = savearea.r7sv LOAD R6,R2,R6SV ; R6 = savearea.r6sv LOAD R5,R2,R5SV ; R5 = savearea.r5sv LOAD R4,R2,R4SV ; R4 = savearea.r4sv LOAD R3,R2,R3SV ; R3 = savearea.r3sv ; Then, stop to restore (TPC, PSW) before restoring (R1-R2) LOAD R1,R2,PSWSV CPUSET R1,PSW ; PSW = savearea->pswsv CPUSET R0,TPC ; TPC = 0 -- return from trap will restart LOAD R1,R2,R1SV ; R1 = savearea.r1sv LOAD R2,R2,R2SV ; R2 = savearea.r2sv RTT ; -- done! BUSMSG: ASCII "Bus Trap. ",0 INSTMSG:ASCII "Instruction Trap.",0 PRIVMSG:ASCII "Privelege Trap. ",0 MMUMSG: ASCII "MMU Trap. ",0 COPMSG: ASCII "Coprocessor Trap.",0 MSGPC: ASCII " Trap PC = #",0 MSGMA: ASCII " Trap MA = #",0 MSGXX: ASCII " ",0 SUBTITLE "Standard Library" ;------------------------ ; All support procedures are linked through R1. ; on procedure entry, R2 is the frame pointer. ; the stack frame grows up. Each support proc ; documents the registers it uses; the caller ; must save these if they are valuable. ; All output procedures use DSPPTR. This ; pointer points to the most recent character ; output in Video RAM. It is incremented before ; use! COMMON DSPPTR,4 ; pointer to output in Video RAM ALIGN 4 DSPPTP: W DSPPTR ; pointer to the pointer! ;------------------------ INT EXIT EXIT = 0 ; terminate application ; no parameters, does nothing ;------------------------ INT DSPINI ; initialize for display output DSPINI: ; expects: nothing ; returns: R3=columns (width), ; R4=lines (height) LIW R3,DISPBASE+DISPTEXT-1 ; -- initial value of dspptr LOAD R4,DSPPTP ; -- address of dspptr STORES R3,R4 ; dspptr = dispbase+disptext-1 LIW R4,DISPBASE LOAD R3,R4,DISPCOLS ; R3 = display columns LOAD R4,R4,DISPLINES ; R4 = display lines JUMPS R1 ; return SUBTITLE "PUTAT" ;------------------------ INT PUTAT ; set location on display ; activation record ;RETAD = 0 ; return address ARSIZE = 4 ; total size PUTAT: ; expects: R3 -- x coordinate ; R4 -- y coordinate ; uses: R3-7 STORES R1,R2 ; -- push return address ADDSI R2,ARSIZE MOVE R7,R3 ; -- set aside x LIW R3,DISPBASE+DISPCOLS LOADS R5,R3 ; -- parameter, columns JSR R1,TIMES ; prod = times( y, columns ), uses R4-6 ADD R3,R3,R7 ; offset = prod + x LIW R5,DISPBASE+DISPTEXT-1 ADD R3,R3,R5 ; addr = (dispbase+disptext-1) + offset LOAD R4,DSPPTP ; -- address of dspptr STORES R3,R4 ; dspptr = addr ADDSI R2,-ARSIZE LOADS R1,R2 ; -- pop return address JUMPS R1 SUBTITLE "PUTCHAR" ;------------------------ INT PUTCHAR ; output char to display PUTCHAR:; expects: R3 -- char to output ; uses: R4-5 LOAD R4,DSPPTP ; -- address of dspptr LOADS R5,R4 ADDSI R5,1 STORES R5,R4 ; dspptr = dspptr + 1 LOADS R4,R5 STUFFB R4,R3,R5 STORES R4,R5 ; display[ dspptr ] = char JUMPS R1 ; return SUBTITLE "PUTS" ;------------------------ INT PUTS ; output string to display PUTS: ; expects: R3 -- s, pointer to string to output ; uses: R6 -- saved return address ; R7 -- string pointer ; R3-5 -- used for each call to putchar MOVE R6,R1 ; -- save return address MOVE R7,R3 ; -- move s PUTSL: ; loop { LOADS R4,R7 EXTB R3,R4,R7 ; ch = *s BZS PUTSQ ; if (ch == NUL) break JSR R1,PUTCHAR ; putchar( ch ) -- wipes R4-5 ADDSI R7,1 ; s = s + 1 BR PUTSL PUTSQ: ; } JUMPS R6 ; return SUBTITLE "PUTHEX" ;------------------------ INT PUTHEX ; output hex number ; activation record ;RETAD = 0 ; return address ARSIZE = 4 ; total size PUTHEX: ; expects: R3 -- n, number to output ; uses: R7 -- copy of n ; R6 -- i, loop counter ; R3-5 -- used for each call to putchar STORES R1,R2 ; -- push return address ADDSI R2,ARSIZE MOVE R7,R3 ; -- move n LIS R6,8 ; i = 8 PUTHXL: ; loop { MOVE R3,R7 SRU R3,12 SRU R3,16 ; digit = n >>> 28 LIS R1,'0' ADD R3,R3,R1 ; ch = digit + '0' -- convert to ASCII LIS R1,'9' CMP R3,R1 BLE PUTHXN ; if (ch > '9') { ; -- convert digits above 9 to A-F range LIS R1,'A'-('9'+1) ADD R3,R3,R1 ; ch = ch + 'A' - ('9' + 1) PUTHXN: ; } JSR R1,PUTCHAR ; putchar( ch ) -- wipes R4-5 SL R7,4 ; n << 4 -- shift next digit into place ADDSI R6,-1 ; i = i - 1 BGT PUTHXL ; } while (i > 0) ADDSI R2,-ARSIZE LOADS R1,R2 ; -- pop return address JUMPS R1 ; return SUBTITLE "PUTDEC and PUTDECU" ;------------------------ INT PUTDEC ; output signed decimal number PUTDEC: ; expects: R3 - n, the number to output ; R4 - w, field width ; uses: R5 - s, the sign ; R6 ?? ; R7 ?? LIS R5,0 ; s = 0 TESTR R3 BNR PDECRB ; if (n < 0) NEG R3,R3 ; n = -n LIS R5,'-' ; s = '-' BR PDECRB ; endif ; pdecrb( n, w, s ) ;------------------------ INT PUTDECU ; output unsigned decimal number PUTDECU:; expects: R3 - n, the number to output ; R4 - w, field width ; uses: R5 - s, the sign ; R6 ?? ; R7 ?? LIS R5,0 ; s = 0 ; pdecrb( n, w, s ) ;------------------------ ; PDECRB ; actual putdec recursive body ; activation record ;RETAD = 0 WR = 4 ; field width/remainder S = 8 ; sign ARSIZE = S ; AR does not include S at point of recursion PDECRB: ; expects: R3 - n, the number to output ; R4 - w, field width ; R5 - s, the sign ; uses R6 - used by divideu() ; R7 ?? STORES R1,R2 ; -- save return address ADDSI R4,-1 ; w = w - 1 STORE R4,R2,WR ; -- save w STORE R5,R2,S ; -- save s LIS R5,10 ; -- parameter JSR R1,DIVIDEU ; (q, r) = divideu( n, 10 ) -- wipe out R5-6 TESTR R3 BZS PDECBL ; if (q != 0) LOAD R5,R2,S ; -- restore s LOAD R6,R2,WR ; -- partially restore w STORE R4,R2,WR ; -- save r MOVE R4,R6 ; -- finish restoring w ADDSI R2,ARSIZE JSR R1,PDECRB ; pdecrb( q, w, s ) ADDSI R2,-ARSIZE PDECQT: ; } endif LOAD R3,R2,WR ; -- restore r LIS R4,'0' ADD R3,R3,R4 ; -- parameter r + '0' JSR R1,PUTCHAR ; putchar( r + '0' ) -- wipes R4,R5 LOADS R1,R2 ; -- get return address JUMPS R1 ; return ; by rights, the following else clause should be inside ; the above, but it's a bit more efficient to put it here PDECBL: ; else { LOADCC R3,R2,S ; -- restore and test s LOAD R6,R2,WR ; -- partially restore w STORE R4,R2,WR ; -- save r BZS PDECNS ; if (s != 0) { ADDSI R6,-1 ; w = w - 1 PDECNS: ; } LIS R3,' ' ; -- parameter ' ' (trick optimization) PDECLP: ; loop { ADDSI R6,-1 ; w = w - 1; BLT PDECPS ; if (w < 0) break JSR R1,PUTCHAR ; putchar( ' ' ) -- wipes R4,R5 BR PDECLP ; } PDECPS: LOADCC R3,R2,S BZS PDECQT ; if (s != 0) { JSR R1,PUTCHAR ; putchar( s ) -- wipes R4,R5 BR PDECQT ; } ; } SUBTITLE "GETCHAR" ;------------------------------- INT GETCHAR ; get char from keyboard GETCHAR:; returns: R3 -- ch, the character from keyboard ; uses: R4 -- scratch used for addressing LIW R4,KBDBASE GETCLP: ; loop { -- poll keyboard LOADCC R3,R4,KBDSTAT ; -- test status BZS GETCLP ; } until ( kbdstat != 0 ) LOAD R3,R4,KBDDATA ; -- get ch JUMPS R1 ; return ch SUBTITLE "GETS" ;------------------------------- INT GETS ; get string from keyboard GETS: ; expects: R3 -- s, pointer to string ; uses: R3 -- ch, the most recent character ; R4 -- scratch ; R5 -- scratch ; R6 -- s, working copy ; R7 -- saved return address MOVE R7,R1 ; -- save return addr MOVE R6,R3 ; -- move s GETSLP: ; loop { JSR R1,GETCHAR ; ch = getchar() -- wipes out R4 CMPI R3,' ' BLT GETSNP ; if (ch >= ' ') { LOADS R5,R6 STUFFB R5,R3,R6 ; -- stuff character into string STORES R5,R6 ; *s = ch ADDSI R6,1 ; s++ -- advance string pointer ; -- echo character JSR R1,PUTCHAR ; putchar( ch ) -- wipes out R4 BR GETSLP ; -- continue GETSNP: ; } else { -- nonprinting CMPI R3,LF BEQ GETSQT ; if (ch == LF) break CMPI R3,CR BEQ GETSQT ; if (ch == LF) break CMPI R3,BS BEQ GETSLP ; if (ch == BS) { LOAD R4,DSPPTP ; -- address of dspptr LOADS R5,R4 ADDSI R5,-1 STORES R5,R4 ; dspptr = dspptr - 1 ADDSI R5,1 ; -- erase a character LIS R4,SP LOADS R3,R5 STUFFB R3,R4,R5 STORES R3,R5 ; display[ dspptr + 1 ] = ' ' ADDSI R6,-1 ; s-- BR GETSLP ; } -- continue ; } -- continue GETSQT: ; } LOADS R5,R6 STUFFB R5,R0,R6 ; store null at end-string STORES R5,R6 JUMPS R7 ; return SUBTITLE "TIMES" ;------------------------ INT TIMES ; signed multiply TIMES: ; expects: R4 -- ier, signed 32-bit multiplier ; R5 -- cand, signed 32-bit multiplicand ; returns: R3 -- prod, the low 32 bits of the product ; uses: R4 -- incrementally destroys the multiplier ; R6 -- i, the loop counter CLR R3 ; prod = 0 ; -- start of special multiply step SL R4,1 ; ier = ier * 2 BCR TMSSKP ; if (ier was negative) { SUB R3,R0,R5 ; prod = prod - icand TMSSKP: ; } -- end of multiply step LIS R6,31 ; i = 31 TMSLLP: ; do { ; -- start of normal multiply step SL R3,1 ; prod = prod * 2 SL R4,1 ; ier = ier * 2 BCR TMSLCN ; if (high bit was one) { ADD R3,R3,R5 ; prod = prod + icand TMSLCN: ; } -- end of multiply step ADDSI R6,-1 ; i = i - 1 BGT TMSLLP ; } until (i = 0) JUMPS R1 ; return prod SUBTITLE "TIMESU" ;------------------------ INT TIMESU ; unsigned multiply TIMESU: ; expects: R4 -- ier, unsigned 32-bit multiplier ; R5 -- cand, unsigned 32-bit multiplicand ; returns: R3 -- prod, the low 32 bits of the product ; uses: R4 -- incrementally destroys the multiplier ; R6 -- i, the loop counter CLR R3 ; prod = 0 LIS R6,16 ; i = 16 TMULLP: ; do { ; -- start of first multiply step SL R3,1 ; prod = prod * 2 SL R4,1 ; ier = ier * 2 BCR TMULC1 ; if (high bit was one) { ADD R3,R3,R5 ; prod = prod + icand TMULC1: ; -- end of multiply step ; -- start of second multiply step SL R3,1 ; prod = prod * 2 SL R4,1 ; ier = ier * 2 BCR TMULC2 ; if (high bit was one) { ADD R3,R3,R5 ; prod = prod + icand TMULC2: ; } -- end of multiply step ADDSI R6,-1 ; i = i - 1 BGT TMULLP ; } until (i = 0) JUMPS R1 ; return prod SUBTITLE "DIVIDEU" ;------------------------ INT DIVIDEU ; unsigned divide DIVIDEU:; expects: R3 -- idend, unsigned 32-bit dividend ; R5 -- isor, unsigned 32-bit divisor ; returns: R3 -- quo, unsigned 32-bit quotient ; R4 -- rem, unsigned 32-bit remaineder ; uses R6 -- i, loop counter CLR R4 ; rem = 0 LIS R6,32 ; i = 32 DIVULP: ; do { ; -- start of divide step SL R3,1 ROL R4 ; rem/quo = rem/quo << 1 (64-bit shift) CMP R4,R5 BLTU DIVUC ; if ( rem >= isor ) { SUB R4,R4,R5 ; rem = rem - isor ADDSI R3,1 ; quo = quo + 1 -- low bit was zero DIVUC: ; } -- end of divide step ADDSI R6,-1 ; i = i - 1 BGT DIVULP ; } while (i > 0) JUMPS R1 ; return rem/quo END xxENDFILExxmonitor.a cat > sparrowmon.a << 'xxENDFILExxsparrowmon.a' TITLE "sparrowmon.a -- Sparrowhawk Monitor and Library" ; by: Douglas W. Jones ; written: July 2014 ; compatable with monitor.h ; requires Sparrowhawk subset of Hawk instruction set ; operates compatably but slower on the Hawk STRICTSPARROW = 1 USE "sparrowhawk.h" USE "ascii.h" PC = R0 ; added for clarity ; ---------------------------------- ; static memory allocation support MACRO ALLOC =n . = . + n ENDMAC ; ---------------------------------- ; machine configuration ; trap vector RESTARTTRAP = #00 BUSTRAP = #10 INSTRTRAP = #20 PRIVTRAP = #30 MMUTRAP = #40 COTRAP = #50 POSTTRAP = #100 ; location beyond the trap vector ; memory mapped display interface DISPBASE = #FF000000 DISPLINES = 0 DISPCOLS = 4 DISPTEXT = #100 ; keyboard interface KBDBASE = #FF100000 KBDDATA = 0 KBDSTAT = 4 ; ---------------------------------- ; trap handler framework ; the following code intercepts all traps and interrupts, ; saves registers in the trap save area. Note that it is ; essential that trap service routines that intend to return ; to the user not cause traps themselves. ; save area structure (displacements from start of area) LC = . . = 0 PSWSV: ALLOC 4 TMASV: ALLOC 4 PCSV: ALLOC 4 R1SV: ALLOC 4 R2SV: ALLOC 4 R3SV: ALLOC 4 R4SV: ALLOC 4 R5SV: ALLOC 4 R6SV: ALLOC 4 R7SV: ALLOC 4 R8SV: ALLOC 4 R9SV: ALLOC 4 RASV: ALLOC 4 RBSV: ALLOC 4 RCSV: ALLOC 4 RDSV: ALLOC 4 RESV: ALLOC 4 RFSV: ALLOC 4 SVSIZE: ALLOC 0 . = LC COMMON SVFATAL,SVSIZE ; trap save area for fatal traps SUBTITLE "Trap vector code" ;------------------------ . = RESTARTTRAP ; special case, call MAIN start or restart LIS R1,RESTCON >> 8 ; 2 ORIS R1,RESTCON & #FF; 2 LOADS R2,R1 ; 2 set up the stack ADJUST R1,PLUS4 ; 2 JUMPS R1 ; 2 continue work at RESTART + 4 ; 6 bytes unused . = BUSTRAP CPUSET R2,TSV ; 2 LIS R2,BUSCON >> 8 ; 2 ORIS R2,BUSCON & #FF ; 2 JSRS R2,R2 ; 2 -- tricky code W SVFATAL+R1SV ; 4 ; 4 bytes unused . = INSTRTRAP CPUSET R2,TSV ; 2 LIS R2,INSTCON >> 8 ; 2 ORIS R2,INSTCON & #FF; 2 JSRS R2,R2 ; 2 -- tricky code W SVFATAL+R1SV ; 4 ; 4 bytes unused . = PRIVTRAP CPUSET R2,TSV ; 2 LIS R2,PRIVCON >> 8 ; 2 ORIS R2,PRIVCON & #FF; 2 JSRS R2,R2 ; 2 -- tricky code W SVFATAL+R1SV ; 4 ; 4 bytes unused . = MMUTRAP CPUSET R2,TSV ; 2 LIS R2,MMUCON >> 8 ; 2 ORIS R2,MMUCON & #FF ; 2 JSRS R2,R2 ; 2 -- tricky code W SVFATAL+R1SV ; 4 ; 4 bytes unused . = COTRAP CPUSET R2,TSV ; 2 LIS R2,COPCON >> 8 ; 2 ORIS R2,COPCON & #FF ; 2 JSRS R2,R2 ; 2 -- tricky code W SVFATAL+R1SV ; 4 ; 4 bytes unused . = POSTTRAP SUBTITLE "Restart trap continuation" ;------------------------ EXT UNUSED EXT MAIN ALIGN 4 RESTPM: W MAIN RESTCON: W UNUSED ; -- initial value of stack pointer ; -- entry point VVV= DSPINI-(.+6) LIS R1,VVV >> 8 ORIS R1,VVV & #FF PLUS R1,PC JSRS R1,R1 ; (columns, lines) = dspini() LIS R1,RESTPM-(.+4) PLUS R1,PC LOADS R1,R1 JSRS R1,R1 ; main( columns, lines ) LIS R1,EXIT JSRS R1,R1 ; exit() -- never returns SUBTITLE "Bus Trap Continuation" ;------------------------ ALIGN 4 BUSCON: ; assumes TSV = oldR2 ; R2 points to pointer to savearea->r1sv ; all other registers still hold user values ; including PSW, TMA and TPC LOADS R2,R2 ; -- get save area pointer STORES R1,R2 ; savearea->r1sv = oldR1 ADJUST R2,PLUS16 STORES R5,R2 ; savearea->r5sv = oldR5 ORIS R5,BUSMSG >> 8 ORIS R5,BUSMSG & #FF ; -- R5 is m, bus trap message address BR TRAPCON ; -- at this point, we can enter generic code SUBTITLE "Instruction Trap Continuation" ;------------------------ ALIGN 4 INSTCON: ; assumes TSV = oldR2 ; R2 points to pointer to savearea->r1sv ; all other registers still hold user values ; including PSW, TMA and TPC LOADS R2,R2 ; -- get save area pointer STORES R1,R2 ; savearea->r1sv = oldR1 ADJUST R2,PLUS16 STORES R5,R2 ; savearea->r5sv = oldR5 ORIS R5,INSTMSG >> 8 ORIS R5,INSTMSG & #FF; -- R5 is m, instruction trap message address BR TRAPCON ; -- at this point, we can enter generic code SUBTITLE "Privilege Trap Continuation" ;------------------------ ALIGN 4 PRIVCON: ; assumes TSV = oldR2 ; R2 points to pointer to savearea->r1sv ; all other registers still hold user values ; including PSW, TMA and TPC LOADS R2,R2 ; -- get save area pointer STORES R1,R2 ; savearea->r1sv = oldR1 ADJUST R2,PLUS16 STORES R5,R2 ; savearea->r5sv = oldR5 ORIS R5,PRIVMSG >> 8 ORIS R5,PRIVMSG & #FF; -- R5 is m, privilege trap message address BR TRAPCON ; -- at this point, we can enter generic code SUBTITLE "MMU Trap Continuation" ;------------------------ ALIGN 4 MMUCON: ; assumes TSV = oldR2 ; R2 points to pointer to to savearea->r1sv ; all other registers still hold user values ; including PSW, TMA and TPC LOADS R2,R2 ; -- get save area pointer STORES R1,R2 ; savearea->r1sv = oldR1 ADJUST R2,PLUS16 STORES R5,R2 ; savearea->r5sv = oldR5 ORIS R5,MMUMSG >> 8 ORIS R5,MMUMSG & #FF ; -- R5 is m, mmu trap message address BR TRAPCON ; -- at this point, we can enter generic code SUBTITLE "Coprocessor Trap Continuation" ;------------------------ ALIGN 4 COPCON: ; assumes TSV = oldR2 ; R2 points to pointer to savearea->r1sv ; all other registers still hold user values ; including PSW, TMA and TPC LOADS R2,R2 ; -- get save area pointer STORES R1,R2 ; savearea->r1sv = oldR1 ADJUST R2,PLUS16 STORES R5,R2 ; savearea->r5sv = oldR5 ORIS R5,COPMSG >> 8 ORIS R5,COPMSG & #FF ; -- R5 is m, coprocessor trap message address BR TRAPCON ; -- at this point, we can enter generic code SUBTITLE "Generic fatal trap continuation" ;------------------------ TRAPCON:; expects: savearea->(r1sv,r5sv) -- hold oldR1,oldR5 ; TSV -- holds oldR2 ; R2 -- points to savearea->r5sv ; R5 -- m, pointer to diagnostic message to print ; all other registers still hold user values ; including PSW, TMA and TPC LIS R1,R3SV-R5SV PLUS R1,R2 ; -- R1 points to savearea->r3sv STORES R3,R1 ; savearea->r3sv = oldR3 ADJUST R1,PLUS4 STORES R4,R1 ; savearea->r4sv = oldR4 ADJUST R1,PLUS8 STORES R6,R1 ; savearea->r6sv = oldR6 ADJUST R1,PLUS4 STORES R7,R1 ; savearea->r7sv = oldR7 ; here: oldR1, oldR3 - oldR7 are properly saved ; R2 still points to savearea->r5sv ; next: save TSV (oldR2), PSW, TMA and TPC LIS R1,PSWSV-R5SV PLUS R1,R2 CPUGET R3,PSW STORES R3,R1 ; savearea->pswsv = oldPSW ADJUST R1,PLUS4 CPUGET R3,TMA STORES R3,R1 ; savearea->tmasv = TMA ADJUST R1,PLUS4 CPUGET R3,TPC STORES R3,R1 ; savearea->pcsv = TPC = oldPC ADJUST R1,PLUS8 CPUGET R3,TSV STORES R3,R1 ; savearea->r2sv = TSV = oldR2 ; here: (R1-R7, PSW, TMA and TPC) all saved in savearea ; R2 -- still points to savearea->r5sv ; R1 -- points to savearea->r2sv ; R5 -- m, pointer to diagnostic message to print LIS R2,R8SV-R2SV PLUS R2,R1 ; -- point R2 to savearea->R8SV (used as stack) ; can now use existing monitor calling conventions ; so long as no monitor call needs more than an 8-word stack ; the following trap service code simply prints ; diagnostic output and terminates! VVV= DSPINI-(.+6) LIS R1,VVV >> 8 ORIS R1,VVV & #FF PLUS R1,PC JSRS R1,R1 ; (columns, lines) = dspini() -- uses R3-4 MOVE R3,R5 VVV= PUTS-(.+6) ; -- parameter m LIS R1,VVV >> 8 ORIS R1,VVV & #FF PLUS R1,PC JSRS R1,R1 ; puts( m ) VVV= MSGPC-(.+6) LIS R3,VVV >> 8 ORIS R3,VVV & #FF PLUS R3,PC ; -- parameter (address of string) VVV= PUTS-(.+6) LIS R1,VVV >> 8 ORIS R1,VVV & #FF PLUS R1,PC JSRS R1,R1 ; puts( "PC = #" ) -- uses R3-7 LIS R3,PCSV-R8SV PLUS R3,R2 LOADS R3,R3 ; -- parameter pcsv VVV= PUTHEX-(.+6) LIS R1,VVV >> 8 ORIS R1,VVV & #FF PLUS R1,PC JSRS R1,R1 ; puthex( pcsv ) -- uses R3-7 VVV= MSGXX-(.+6) LIS R3,VVV >> 8 ORIS R3,VVV & #FF PLUS R3,PC ; -- parameter (address of string) VVV= PUTS-(.+6) LIS R1,VVV >> 8 ORIS R1,VVV & #FF PLUS R1,PC JSRS R1,R1 ; puts( " " ) -- uses R3-7 LIS R3,17 ; -- parameters LIS R4,1 VVV= PUTAT-(.+6) LIS R1,VVV >> 8 ORIS R1,VVV & #FF PLUS R1,PC JSRS R1,R1 ; putat( 17, 1 ) -- uses R3-7 VVV= MSGMA-(.+6) LIS R3,VVV >> 8 ORIS R3,VVV & #FF PLUS R3,PC ; -- parameter (address of string) VVV= PUTS-(.+6) LIS R1,VVV >> 8 ORIS R1,VVV & #FF PLUS R1,PC JSRS R1,R1 ; puts( "MA =" ) -- uses R3-7 LIS R3,TMASV-R8SV PLUS R3,R2 LOADS R3,R3 ; -- parameter VVV= PUTHEX-(.+6) LIS R1,VVV >> 8 ORIS R1,VVV & #FF PLUS R1,PC JSRS R1,R1 ; puthex( tmasv ) -- uses R3-7 VVV= MSGXX-(.+6) LIS R3,VVV >> 8 ORIS R3,VVV & #FF PLUS R3,PC ; -- parameter (address of string) VVV= PUTS-(.+6) LIS R1,VVV >> 8 ORIS R1,VVV & #FF PLUS R1,PC JSRS R1,R1 ; puts( " " ) -- uses R3-7 ; here: (R1-R7, PSW, TMA and TPC) all saved in savearea ; R2 -- points to R8SV ; First, restore (R4-R7) to prepare for restart ADDSI R2,-4 LOADS R7,R2 ; R7 = savearea.r7sv ADDSI R2,-4 LOADS R6,R2 ; R6 = savearea.r6sv ADDSI R2,-4 LOADS R5,R2 ; R5 = savearea.r5sv ADDSI R2,-4 LOADS R4,R2 ; R4 = savearea.r4sv ; here: R2 -- points to SVR4 ; Then, stop to restore (TPC, PSW) before restoring (R1-R3) LIS R3,PSWSV-R4SV PLUS R3,R2 LOADS R1,R3 CPUSET R1,PSW ; PSW = savearea->pswsv ADJUST R3,PLUS8 ; -- skip TMA (no need to restore it) CPUSET R0,TPC ; TPC = 0 ADJUST R3,PLUS4 LOADS R1,R3 ; R1 = savearea->r1sv ADJUST R3,PLUS4 LOADS R2,R3 ; R2 = savearea->r2sv ADJUST R3,PLUS4 LOADS R3,R3 ; R3 = savearea->r3sv RTT ; -- done! BUSMSG: ASCII "Bus Trap. ",0 INSTMSG:ASCII "Instruction Trap.",0 PRIVMSG:ASCII "Privelege Trap. ",0 MMUMSG: ASCII "MMU Trap. ",0 COPMSG: ASCII "Coprocessor Trap.",0 MSGPC: ASCII " Trap PC = #",0 MSGMA: ASCII " Trap MA = #",0 MSGXX: ASCII " ",0 SUBTITLE "Standard Library" ;------------------------ ; All support procedures are linked through R1. ; on procedure entry, R2 is the frame pointer. ; the stack frame grows up. Each support proc ; documents the registers it uses; the caller ; must save these if they are valuable. ; All output procedures use DSPPTR. This ; pointer points to the most recent character ; output in Video RAM. It is incremented before ; use! COMMON DSPPTR,4 ; pointer to output in Video RAM ALIGN 4 DSPPTP: W DSPPTR ; pointer to the pointer! DSPBPT: W DISPBASE+DISPTEXT-1 DSPBPC: W DISPBASE+DISPCOLS ;------------------------ INT EXIT EXIT = 0 ; terminate application ; no parameters, does nothing ;------------------------ INT DSPINI ; initialize for display output DSPINI: ; expects: nothing ; returns: R3=columns (width), ; R4=lines (height) LIS R3,DSPBPT-(.+4) PLUS R3,PC LOADS R3,R3 ; -- initial value dspptr LIS R4,DSPPTP-(.+4) PLUS R4,PC LOADS R4,R4 ; -- address of dspptr STORES R3,R4 ; dspptr = dispbase+disptext-1 LIS R4,DSPBPC-(.+4) PLUS R4,PC LOADS R4,R4 ; -- address dispbase+dispcols LOADS R3,R4 ; R3 = display columns ADDSI R4,DISPLINES-DISPCOLS LOADS R4,R4 ; R4 = display lines JUMPS R1 ; return SUBTITLE "PUTAT" ;------------------------ INT PUTAT ; set location on display ; activation record ;RETAD = 0 ; return address ARSIZE = 4 ; total size PUTAT: ; expects: R3 -- x coordinate ; R4 -- y coordinate ; uses: R3-7 STORES R1,R2 ; -- push return address ADDSI R2,ARSIZE MOVE R7,R3 ; -- set aside x LIS R3,DSPBPC-(.+4) PLUS R3,PC LOADS R3,R3 ; -- address dispbase+dispcols LOADS R5,R3 ; -- parameter, columns VVV= TIMES-(.+6) LIS R1,VVV >> 8 ORIS R1,VVV & #FF PLUS R1,PC JSRS R1,R1 ; prod = times( y, columns ), uses R4-6 ADD R3,R3,R7 ; offset = prod + x LIS R5,DSPBPT-(.+4) PLUS R5,PC LOADS R5,R5 ; -- address dispbase+disptext-1 ADD R3,R3,R5 ; addr = (dispbase+disptext-1) + offset LIS R4,DSPPTP-(.+4) PLUS R4,PC LOADS R4,R4 ; -- address of dspptr STORES R3,R4 ; dspptr = addr ADDSI R2,-ARSIZE LOADS R1,R2 ; -- pop return address JUMPS R1 SUBTITLE "PUTCHAR" ;------------------------ INT PUTCHAR ; output char to display PUTCHAR:; expects: R3 -- char to output ; uses: R4-5 LIS R4,DSPPTP-(.+4) PLUS R4,PC LOADS R4,R4 ; -- address of dspptr LOADS R5,R4 ADDSI R5,1 STORES R5,R4 ; dspptr = dspptr + 1 LOADS R4,R5 STUFFB R4,R3,R5 STORES R4,R5 ; display[ dspptr ] = char JUMPS R1 ; return SUBTITLE "PUTS" ;------------------------ INT PUTS ; output string to display PUTS: ; expects: R3 -- s, pointer to string to output ; uses: R6 -- saved return address ; R7 -- string pointer ; R3-5 -- used for each call to putchar MOVE R6,R1 ; -- save return address MOVE R7,R3 ; -- move s PUTSL: ; loop { LOADS R4,R7 EXTB R3,R4,R7 ; ch = *s BZS PUTSQ ; if (ch == NUL) break LIS R1,PUTCHAR-(.+4) PLUS R1,PC JSRS R1,R1 ; putchar( ch ) -- wipes R4-5 ADDSI R7,1 ; s = s + 1 BR PUTSL PUTSQ: ; } JUMPS R6 ; return SUBTITLE "PUTHEX" ;------------------------ INT PUTHEX ; output hex number ; activation record ;RETAD = 0 ; return address ARSIZE = 4 ; total size PUTHEX: ; expects: R3 -- n, number to output ; uses: R7 -- copy of n ; R6 -- i, loop counter ; R3-5 -- used for each call to putchar STORES R1,R2 ; -- push return address ADDSI R2,ARSIZE MOVE R7,R3 ; -- move n LIS R6,8 ; i = 8 PUTHXL: ; loop { MOVE R3,R7 SRU R3,12 SRU R3,16 ; digit = n >>> 28 LIS R1,'0' ADD R3,R3,R1 ; ch = digit + '0' -- convert to ASCII LIS R1,'9' CMP R3,R1 BLE PUTHXN ; if (ch > '9') { ; -- convert digits above 9 to A-F range LIS R1,'A'-('9'+1) ADD R3,R3,R1 ; ch = ch + 'A' - ('9' + 1) PUTHXN: ; } LIS R1,PUTCHAR-(.+4) PLUS R1,PC JSRS R1,R1 ; putchar( ch ) -- wipes R4-5 SL R7,4 ; n << 4 -- shift next digit into place ADDSI R6,-1 ; i = i - 1 BGT PUTHXL ; } while (i > 0) ADDSI R2,-ARSIZE LOADS R1,R2 ; -- pop return address JUMPS R1 ; return SUBTITLE "PUTDEC and PUTDECU" ;------------------------ INT PUTDEC ; output signed decimal number PUTDEC: ; expects: R3 - n, the number to output ; R4 - w, field width ; uses: R5 - s, the sign ; R6 ?? ; R7 ?? LIS R5,0 ; s = 0 TESTR R3 BNR PDECRB ; if (n < 0) NEG R3,R3 ; n = -n LIS R5,'-' ; s = '-' BR PDECRB ; endif ; pdecrb( n, w, s ) ;------------------------ INT PUTDECU ; output unsigned decimal number PUTDECU:; expects: R3 - n, the number to output ; R4 - w, field width ; uses: R5 - s, the sign ; R6 ?? ; R7 ?? LIS R5,0 ; s = 0 ; pdecrb( n, w, s ) ;------------------------ ; PDECRB ; actual putdec recursive body ; activation record ;RETAD = 0 ARSIZE = 4 PDECRB: ; expects: R3 - n, the number to output ; R4 - w, field width ; R5 - s, the sign ; uses R6 ?? ; R7 ?? STORES R1,R2 ; -- push return address ADDSI R4,-1 ; w = w - 1 ADDSI R2,4 STORES R4,R2 ; -- push w ADDSI R2,4 STORES R5,R2 ; -- push s LIS R5,10 ; -- parameter VVV= DIVIDEU-(.+6) LIS R1,VVV >> 8 ORIS R1,VVV & #FF PLUS R1,PC JSRS R1,R1 ; (q, r) = divideu( n, 10 ) -- wipe out R5-6 TESTR R3 BZS PDECBL ; if (q != 0) LOADS R5,R2 ; -- pop s ADDSI R2,-4 LOADS R6,R2 ; -- pop w STORES R4,R2 ; -- push r MOVE R4,R6 ; -- move w to expected register ADDSI R2,4 LIS R1,PDECRB-(.+4) PLUS R1,PC JSRS R1,R1 ; pdecrb( q, w, s ) ADDSI R2,-4 PDECQT: ; } endif LOADS R3,R2 ; -- pop r LIS R4,'0' ADD R3,R3,R4 ; -- parameter r + '0' VVV= PUTCHAR-(.+6) LIS R1,VVV >> 8 ORIS R1,VVV & #FF PLUS R1,PC JSRS R1,R1 ; putchar( r + '0' ) -- wipes R4,R5 ADDSI R2,-4 LOADS R1,R2 ; -- pop return address JUMPS R1 ; return ; by rights, the following else clause should be inside ; the above, but it's a bit more efficient to put it here PDECBL: ; else { LOADS R3,R2 ; -- pop s ADDSI R2,-4 LOADS R6,R2 ; -- pop w STORES R4,R2 ; -- push r TESTR R3 BZS PDECNS ; if (s != 0) { ADDSI R6,-1 ; w = w - 1 PDECNS: ; } LIS R3,' ' ; -- parameter ' ' (trick optimization) PDECLP: ; loop { ADDSI R6,-1 ; w = w - 1; BLT PDECPS ; if (w < 0) break VVV= PUTCHAR-(.+6) LIS R1,VVV >> 8 ORIS R1,VVV & #FF PLUS R1,PC JSRS R1,R1 ; putchar( ' ' ) -- wipes R4,R5 BR PDECLP ; } PDECPS: LIS R3,4 PLUS R3,R2 LOADSCC R3,R3 ; -- recover s BZS PDECQT ; if (s != 0) { VVV= PUTCHAR-(.+6) LIS R1,VVV >> 8 ORIS R1,VVV & #FF PLUS R1,PC JSRS R1,R1 ; putchar( s ) -- wipes R4,R5 BR PDECQT ; } ; } SUBTITLE "GETCHAR" ;------------------------------- INT GETCHAR ; get char from keyboard GETCHAR:; returns: R3 -- ch, the character from keyboard ; uses: R4 -- scratch used for addressing VVV= KBDBASE+KBDSTAT LIS R4,VVV >> 24 ORIS R4,VVV >> 16 & #FF ORIS R4,VVV >> 8 & #FF ORIS R4,VVV >> 8 & #FF GETCLP: ; loop { -- poll keyboard LOADSCC R3,R4 ; -- test status BZS GETCLP ; } until ( kbdstat != 0 ) VVV= KBDBASE+KBDDATA LIS R4,VVV >> 24 ORIS R4,VVV >> 16 & #FF ORIS R4,VVV >> 8 & #FF ORIS R4,VVV >> 8 & #FF LOADS R3,R4 ; -- get ch JUMPS R1 ; return ch SUBTITLE "GETS" ;------------------------------- INT GETS ; get string from keyboard GETS: ; expects: R3 -- s, pointer to string ; uses: R3 -- ch, the most recent character ; R4 -- scratch ; R5 -- scratch ; R6 -- s, working copy ; R7 -- saved return address MOVE R7,R1 ; -- save return addr MOVE R6,R3 ; -- move s GETSLP: ; loop { LIS R1,GETCHAR-(.+4) PLUS R1,PC JSRS R1,R1 ; ch = getchar() -- wipes out R4 LIS R4,' ' CMP R3,R4 BLT GETSNP ; if (ch >= ' ') { LOADS R5,R6 STUFFB R5,R3,R6 ; -- stuff character into string STORES R5,R6 ; *s = ch ADDSI R6,1 ; s++ -- advance string pointer VVV= PUTCHAR-(.+6) LIS R1,VVV >> 8 ORIS R1,VVV & #FF PLUS R1,PC ; -- echo character JSRS R1,R1 ; putchar( ch ) -- wipes out R4 BR GETSLP ; -- continue GETSNP: ; } else { -- nonprinting LIS R4,LF CMP R3,R4 BEQ GETSQT ; if (ch == LF) break LIS R4,CR CMP R3,R4 BEQ GETSQT ; if (ch == LF) break LIS R4,BS CMP R3,R4 BEQ GETSLP ; if (ch == BS) { VVV= DSPPTP-(.+6) LIS R4,VVV >> 8 ORIS R4,VVV & #FF PLUS R4,PC LOADS R4,R4 ; -- address of dspptr LOADS R5,R4 ADDSI R5,-1 STORES R5,R4 ; dspptr = dspptr - 1 ADDSI R5,1 ; -- erase a character LIS R4,SP LOADS R3,R5 STUFFB R3,R4,R5 STORES R3,R5 ; display[ dspptr + 1 ] = ' ' ADDSI R6,-1 ; s-- BR GETSLP ; } -- continue ; } -- continue GETSQT: ; } LOADS R5,R6 STUFFB R5,R0,R6 ; store null at end-string STORES R5,R6 JUMPS R7 ; return SUBTITLE "TIMES" ;------------------------ INT TIMES ; signed multiply TIMES: ; expects: R4 -- ier, signed 32-bit multiplier ; R5 -- cand, signed 32-bit multiplicand ; returns: R3 -- prod, the low 32 bits of the product ; uses: R4 -- incrementally destroys the multiplier ; R6 -- i, the loop counter CLR R3 ; prod = 0 ; -- start of special multiply step SL R4,1 ; ier = ier * 2 BCR TMSSKP ; if (ier was negative) { SUB R3,R0,R5 ; prod = prod - icand TMSSKP: ; } -- end of multiply step LIS R6,31 ; i = 31 TMSLLP: ; do { ; -- start of normal multiply step SL R3,1 ; prod = prod * 2 SL R4,1 ; ier = ier * 2 BCR TMSLCN ; if (high bit was one) { ADD R3,R3,R5 ; prod = prod + icand TMSLCN: ; } -- end of multiply step ADDSI R6,-1 ; i = i - 1 BGT TMSLLP ; } until (i = 0) JUMPS R1 ; return prod SUBTITLE "TIMESU" ;------------------------ INT TIMESU ; unsigned multiply TIMESU: ; expects: R4 -- ier, unsigned 32-bit multiplier ; R5 -- cand, unsigned 32-bit multiplicand ; returns: R3 -- prod, the low 32 bits of the product ; uses: R4 -- incrementally destroys the multiplier ; R6 -- i, the loop counter CLR R3 ; prod = 0 LIS R6,16 ; i = 16 TMULLP: ; do { ; -- start of first multiply step SL R3,1 ; prod = prod * 2 SL R4,1 ; ier = ier * 2 BCR TMULC1 ; if (high bit was one) { ADD R3,R3,R5 ; prod = prod + icand TMULC1: ; -- end of multiply step ; -- start of second multiply step SL R3,1 ; prod = prod * 2 SL R4,1 ; ier = ier * 2 BCR TMULC2 ; if (high bit was one) { ADD R3,R3,R5 ; prod = prod + icand TMULC2: ; } -- end of multiply step ADDSI R6,-1 ; i = i - 1 BGT TMULLP ; } until (i = 0) JUMPS R1 ; return prod SUBTITLE "DIVIDEU" ;------------------------ INT DIVIDEU ; unsigned divide DIVIDEU:; expects: R3 -- idend, unsigned 32-bit dividend ; R5 -- isor, unsigned 32-bit divisor ; returns: R3 -- quo, unsigned 32-bit quotient ; R4 -- rem, unsigned 32-bit remaineder ; uses R6 -- i, loop counter CLR R4 ; rem = 0 LIS R6,32 ; i = 32 DIVULP: ; do { ; -- start of divide step SL R3,1 ROL R4 ; rem/quo = rem/quo << 1 (64-bit shift) CMP R4,R5 BLTU DIVUC ; if ( rem >= isor ) { SUB R4,R4,R5 ; rem = rem - isor ADDSI R3,1 ; quo = quo + 1 -- low bit was zero DIVUC: ; } -- end of divide step ADDSI R6,-1 ; i = i - 1 BGT DIVULP ; } while (i > 0) JUMPS R1 ; return rem/quo END xxENDFILExxsparrowmon.a