.TITLE FPP .IDENT /V1.1/ ;FIS FLOATING POINT EMULATOR ; ;WRITTEN 15-DEC-78 BY DANIEL STEINBERG ; SRI INTERNATIONAL loc K1023 ; 415 326-6200 ext.5539 ; ; MODIFIED 8-MAR-79 TO CORRECT LDF,LDCDF,LDCIF INPUT BYTE COUNT ERROR ; ; ;The basic idea is this: ; On the PDP 11/40 or 11/03 with FIS (Floating Instruction Set), the FP11 ; floating point processor op-codes are illegal instructions. RSX-11M ; provides a mechanism whereby tasks may be notified, via an SST (Synchronous ; System Trap), when an illegal instruction is encountered. The task is then ; free to handle it as it wishes, without further Executive interference. ; This emulator is entered at FPPSST when illegal instructions occur. If the ; offending op-code is not a floating point op-code, then the emulator removes ; its entry point from the SST vector table and returns to attempt to execute ; the instruction again. This time, either the task itself will field the ; instruction, or the Executive will abort the task. If the offending op-code ; is a legal FPP instruction code, the emulator will decode and execute it, ; using the FIS instructions. As far as i know, the emulator functions exactly ; like FPP with the following exceptions: ; 1) As of now, all arithmetic is 32-bit floating point, regardless of ; the state of the FD-bit.....one day, 64-bit precision might be ; implemented. ; 2) The emulator does not issue any interrupts on -0 or other errors. ; 3) Chop mode is always used, regardless of the state of the FT-bit ; 4) The FER, FID, FIUV, FIU, FIV, FIC, FT, and FMM bits of the FPS ; (Floating Point Status register) are ignored. ; 5) The FEC (Floating Exception Code) register never contains a ; 2, 12., or 14. (floating op-code error, -0 error, maintenance trap). ; Other errors set the FEC register and the FEA register (Floating ; Exception Address), and the STST instruction reads and clears these ; locations. Thus, if STST recalls a zero from FEC, no error occurred ; since the last STST instruction. ; 6) Note that immediate mode addresses (code: 27) are legal destination ; addresses (though they make no sense). ; There are a few pitfalls to watch out for: ; 1) The SST vector table may be set up as a Task or Debugging Level ; SST. There are two entry points to reflect this difference. ; Debugging Level SST addresses are used, if they exist, before ; Task Level SST addresses. If a task specifies two of the same ; type of SST vector tables, the last (in time) specified will be ; used. ODT, for instance, uses Debugging Level SSTs when the user ; task is running. To enable a Task Level SST when running under ODT, ; the user must clear the Debugging Level SST entry first ( $#V, where ; # is a number from 0 to 7, corresponding to the SST number). ; [All this sounds extremely complicated because it is. The Executive ; Reference Manual for RSX sheds some light on what's going on.] ; Most people using this emulator will not be running ODT, so the ; call: CALL FPINIT :as the first instruction of their programs ; will effectively implement the emulator and make it invisible. ; 2) FPPEMULAT dynamically inserts the entry point FISSST in the ; SST vector table when it is entered, and removes it when it exits. ; This is so that FIS overflows, underflows, and divide by zeroes ; are caught by the emulator and dealt with expediently. Because ; of this, it is not sufficient to place the entry point FPPSST ; in a user SST vector table, rather than calling FPINIT or FPPINI. ; However, you could place both FPPSST and FISSST in your SST table, ; assuming that you don't intend to generate any FIS errors in your ; own code, or you could place your own vectors in the emulator's ; SST table (at SSTTBL), if you really want to be perverse. You're ; on your own. ; 3) T-bit traps are suspended until after SST routines execute the ; RTI instruction. That means that ODT will single step through ; FPP instructions as though the hardware was there (nice, eh?). ; If you want to set a breakpoint in the emulator code itself, ; that's perfectly kosher. ; 4) This code buys you nothing unless you have FIS (if anyone modifies ; it to work with no FIS/EIS, please let me know). ; 5) I wrote this code trying to optimize speed and size both, and ; consequently, it is not a shining example of easy-to-read code. ; Good luck. ; I have made references to details about the FP-11 processor which are ; only comprehensible if you have a manual for it....It is documented ; in the 1978-79 PDP11 Processor Handbook, and g-d knows where else. ; ; This emulator has successfully been incorporated into the DECUS BASIC ; program, which uses exclusively FPP instructions, by merely inserting the ; instruction: CALL FPINIT :at the start of the program, an by modifying ; the floating point trap routine. ; ;**** NOTE **** ; This code is NOT position independent. The instructions and data areas ; have been separated into two psects (FPPPUR and FPPIMP), but i've never tried ; incorporating this code into a resident library. ; ;**** ANOTHER NOTE **** ; It might be possible to munge around with the Executive a little to include ; this package right in the Exec. This would mean that the Exec code to save ; and restore FPP status during task-switching would work just as if there was ; an FP-11. This is probably no small task, though, and if anyone accomplishes ; it, please let me know. ;Daniel Steinberg....8-MAR-79 .PSECT FPPPUR I ;PURE CODE AREA .MCALL SVTK$S,SVDB$S,ENAR$S FPINIT:: SVDB$S #SSTTBL,#8. ;SET DEBUGGING SST TABLE (USE MOST OF THE TIME) BR FPEN FPPINI:: SVTK$S #SSTTBL,#8. ;SET TASK SST TABLE (USE WITH DDT, ETC.) FPEN: ENAR$S RETURN ; FPP SST ENTRY....MAIN INSTRUCTION DECODE/EXECUTE DISPATCHER FPPSST:: MOV R0,SVR0 ;SAVE R0 MOV #SVPC,R0 ;GET ADDRESS OF TOP OF REG STACK MOV (SP)+,(R0)+ ;SAVE PC MOV (SP)+,(R0) ;SAVE PS MOV #SVSP,R0 ;POINT R0 AT SVSP MOV SP,(R0) ;SAVE SP MOV R5,-(R0) ;AND THE REST OF THE REGS MOV R4,-(R0) MOV R3,-(R0) MOV R2,-(R0) MOV R1,-(R0) CLR IL ;CLEAR SSTTBL ENTRY TO AVOID RE-ENTRY SUB #8.,SP ;RESERVE STACK SPACE IN CASE OF D.P. -(SP) FDST MOV SVPC,R3 ;GET PC AT INTERRUPT MOV -(R3),R2 ;GET INSTRUCTION THAT CAUSED IT MOV R3,INSPC ;SAVE INSTRUCTION ADDRESS FOR FEA LATER SUB #170000,R2 ;FPP? BLT CRASH ;NO....GIVE UP MOV FPS,R1 ;GET CURRENT FP STATUS REG VALUE BIT #7000,R2 ;ESOTERIC OPERATION? BNE TYPE3 ; YUP BIT #700,R2 ;SIMPLE OPERATION? BNE TYPE2 ; YUP CMP R2,#12 ;TRIVIAL OP? BHI CRASH ; NOPE...NONE OF THE ABOVE TYPE1: ASL R2 ;TURN VALUE TO AN OFFSET JMP @TBL1(R2) ;AND DISPATCH TBL1: .WORD COPYCC ;CFCC .WORD SETF ;SETF .WORD SETI ;SETI .WORD CRASH,CRASH,CRASH,CRASH,CRASH,CRASH .WORD SETD ;SETD .WORD SETL ;SETL ; TYPE 1 INSTRUCTION EXECUTERS SETF: BIC #FD,R1 ;CLEAR DOUBLE BIT BR EXFPS SETI: BIC #FL,R1 ;CLEAR LONG INTEGER BIT BR EXFPS SETD: BIS #FD,R1 ;SET DOUBLE BR EXFPS SETL: BIS #FL,R1 ;SET LONG EXFPS: BR EXIT ;DONE (THAT WAS EASY!) ;REGACC IS CALLED BY ACCOP AND ACCRV (BELOW) ;INPUT: R4 - PTR TO SVR# ;OUT: R4 - PTR TO AC# (ERROR IF # > 5) REGACC: SUB #SVR0,R4 ;CONVERT GENERAL REGISTER ADDRESS TO ACC CMP R4,#10. ; ALLOW ACC0-5 BGT CRASH ;ELSE ERROR ASL R4 ASL R4 ;EACH ONE IS 8 BYTES ADD #AC0,R4 MOV R4,R5 RTS PC ; FPP SST EXIT ROUTINES CRASH: SUB #2,SVPC ;POINT PC BACK TO INSTRUCTION THAT FUCKED UP BR OUT ;AFTER RTI, SST WILL NOT GO TO FPPSST AGAIN COPYCC: MOV R1,R2 ;COPY THE FPS BIC #177760,R2 ;CLEAR ALL BUT CONDITION CODES BIC #17,SVPS ;CLEAR PS CONDITION CODES BIS R2,SVPS ;AND SET THE NEW ONES IN EXIT: MOV #FPPSST,IL ;SET UP THE SST ADDRESS AGAIN OUT: MOV SVSP,SP ;RESTORE STACK PTR (POSSIBLY MODIFIED) MOV #FPS,R0 ;POINT TO TOP OF REG MESS MOV R1,(R0) ;SET FINAL FPS MOV -(R0),-(SP) ;PUSH PS MOV -(R0),-(SP) ;PUSH PC TST -(R0) ;SKIP SVSP MOV -(R0),R5 ;RESTORE REGS MOV -(R0),R4 MOV -(R0),R3 MOV -(R0),R2 MOV -(R0),R1 MOV -(R0),R0 CLR FIS ;NO FIS SST RTI ;GO HOME AND STAY THERE (HOPEFULLY) ;FPP TYPE 2 INSTRUCTION DECODING AND DISPATCH TYPE2: CMP R2,#400 ; > STST ? BGE 1$ ;YES CMP R2,#300 ; < STST? BGE 2$ ; STST EXACTLY JSR R3,OPRAND .WORD REGOP,OFF2 ;YES...GET A SINGLE WORD SRC/DST BR 5$ 1$: JSR R3,OPRAND .WORD ACCOP,OFF48 ;GET A DOUBLE/QUADRUPLE WORD FSRC/FDST BR 5$ 2$: JSR R3,OPRAND ; FOR STST...REG OR 4 BYTES .WORD REGOP,OFF4 ;GET A DOUBLE WORD SRC/DST 5$: ASR R0 ;TURN BYTE CNT TO WORD CNT ASL R2 ;SET UP FOR DISPATCH ASL R2 CLRB R2 SWAB R2 ASL R2 JSR PC,@TBL2-2(R2) ;DISPATCH (R2 NEVER HAS 0 OFFSET) BR EXIT ;AND GO HOME TBL2: .WORD LDFPS .WORD STFPS .WORD STST .WORD CLRF .WORD TSTF .WORD ABSF .WORD NEGF ;FPP TYPE 3 INSTRUCTION DECODING AND DISPATCH TYPE3: CMP R2,#5000 ;SIMPLE AC/FSRC ? BLO 40$ ;YES MOV R2,R4 ;NO...DO SOME TWIDDLING CLRB R4 ;LOOK AT JUST THE OPCODE CMP R4,#6400 ;MAP 6400 -> 5000 BLO 1$ ; 7000 -> 5400 SUB #1400,R4 ; 7400 -> 6000 1$: CMP R4,#5400 BLO 20$ ;AC/(SRC/DST) BHI 30$ ;AC/(FSRC/FDST....[~FD]) 10$: JSR R3,OPRAND ;AC/(SRC/DST....[FL]) .WORD REGOP,OFF24 BR 100$ 20$: JSR R3,OPRAND ;SIMPLE 2-BYTE SRC/DST .WORD REGOP,OFF2 BR 100$ 30$: JSR R3,OPRAND ;FSRC/FDST, LENGTH DOESN'T FOLLOW FD-BIT .WORD ACCRV,OFF84 BR 100$ 40$: JSR R3,OPRAND ;FSRC/FDST, LENGTH FOLLOWS FD-BIT .WORD ACCOP,OFF48 100$: MOV R2,R4 ;GET OPCODE AGAIN BIC #177477,R4 ;CLEAR ALL BUT AC ASR R4 ASR R4 ASR R4 ;TURN INTO OFFSET ADD #AC0,R4 BIC #17,R1 ;CLEAR N,Z,V,C IN FPS ASR R0 ;R0 <- WORD COUNT FOR R5 MOV #FISSST,FIS ;SET UP ROUTINE FOR FIS SSTs CLRB R2 SWAB R2 ASL R2 JSR PC,@TBL3-4(R2) ;DISPATCH ON OPCODE JSR PC,TSTR3 ;SET FCCs IN FPS BR EXIT TBL3: .WORD MULF .WORD MODF .WORD ADDF .WORD LDF .WORD SUBF .WORD CMPF .WORD STF .WORD DIVF .WORD STEXP .WORD STCFI .WORD STCFD .WORD LDEXP .WORD LDCIF .WORD LDCDF ; MAIN OPERAND DECODING DISPATCHER OPRAND: MOV R2,R4 ;GET A COPY OF INSTRUCTION BIC #177770,R4 ;CLEAR ALL BUT REG ASL R4 ADD #SVR0,R4 ;POINT TO SAVED REG (WILL ADJUST IF MODE 0) MOV R2,R5 ;GET ANOTHER COPY BIC #177707,R5 ;CLEAR ALL BUT MODE BEQ MODE0 ;IF 0, WHAT HAPPENS DEPENDS ON CALLER SUBR LIST TST (R3)+ ;SKIP MODE 0 SUBROUTINE ASR R5 ;SET UP FOR DISPATCH ASR R5 JMP @MODE-2(R5) ;AND GO DO SPECIFIC OPERATIONS MODE: .WORD MODE1 .WORD MODE2 .WORD MODE3 .WORD MODE4 .WORD MODE5 .WORD MODE6 .WORD MODE7 ;MODE 0 DISPATCHER, AND RELATED ROUTINES MODE0: JMP @(R3)+ ;DISPATCH TO CALLERS ROUTINE TO HANDLE MODE 0 REGOP: MOV R4,R5 ;USE GENERAL REGISTERS TST (R3)+ ;AND SKIP THE OFFSET ROUTINE OFF2: MOV #2,R0 ;2 BYTES AVAILABLE RTS R3 ACCOP: JSR PC,REGACC ;CONVERT REGISTER ADDRESS TO FPP ACC ADDRESS TST (R3)+ ;SKIP THE OFFSET ROUTINE OFF48: MOV #4,R0 ;LENGTH DEPENDS ON FD-BIT BIT #FD,R1 ;IF SET, DOUBLE PRECISION BEQ 1$ ;ELSE SINGLE ASL R0 1$: RTS R3 OFF4: MOV #4,R0 ;4 BYTES AVAILABLE RTS R3 ACCRV: JSR PC,REGACC ;GET ACC ADDRESS TST (R3)+ ;SKIP OFFSET ROUTINE OFF84: MOV #4,R0 ;LENGTH IS OPPOSITE OF FD-BIT BIT #FD,R1 BNE 1$ ASL R0 1$: RTS R3 OFF24: MOV #2,R0 ;LENGTH DEPENDS ON FL-BIT BIT #FL,R1 BEQ 1$ ;LONG INTEGER IF SET ASL R0 1$: RTS R3 ; MODE 1 - 7 DECODING ROUTINES MODE1: MOV (R4),R5 ; (R) JMP @(R3)+ ;GO SET AVAILABLE LENGTH MODE2: MOV (R4),R5 ; (R)+ or #n CMP R4,#SVPC BNE 1$ TST (R3)+ ; #n MOV #2,R0 ;ONLY 1 WORD AVAILABLE BR 2$ 1$: JSR R3,@(R3)+ ; (R)+ .... SET OFFSET AS NEEDED 2$: ADD R0,(R4) ;AUTO-INCREMENT THE REGISTER RTS R3 MODE3: MOV @(R4),R5 ; @(R)+ or @#A ADD #2,(R4) ;AUTO-INCREMENT THE REG (EVEN IF PC) JMP @(R3)+ ;AND SET OFFSET MODE4: JSR R3,@(R3)+ ; -(R) SUB R0,(R4) ;AUTO-DECREMENT MOV (R4),R5 ;GET ADDRESS OF OPERAND VALUE RTS R3 MODE5: SUB #2,(R4) ; @-(R) MOV @(R4),R5 JMP @(R3)+ ;GET OFFSET MODE6: MOV @SVPC,R5 ; X(R) or A ADD #2,SVPC ;GET NEXT WORD AND POINT PC PAST IT ADD (R4),R5 ;ADD IN REG (EVEN IF PC) JMP @(R3)+ ;AND SET OFFSET MODE7: MOV @SVPC,R5 ; @X(R) or @A ADD #2,SVPC ;GET NEXT WORD AND POINT PC PAST ADD (R4),R5 ;ADD REG MOV (R5),R5 ;AND DO INDIRECT JMP @(R3)+ ;SET OFFSET ; TYPE 2 INSTRUCTION EXECUTERS LDFPS: MOV (R5),R1 ;SET NEW FPS RTS PC STFPS: MOV R1,(R5) ;GIVE BACK THE CURRENT FPS RTS PC STST: MOV #FEC,R2 ;GIVE USER SOME CLUE ABOUT HIS FUCKUP 1$: MOV (R2),(R5)+ CLR (R2)+ ;CLEAR FEC (AND FEA) AFTER STORAGE SOB R0,1$ RTS PC CLRF: MOV R5,R3 ;SAVE FOR TSTR3 LATER 1$: CLR (R5)+ SOB R0,1$ BR S1FCC ABSF: BIC #100000,(R5) ;CLEAR SIGN BIT BR TSTF NEGF: TST (R5) ;IF ZERO, DON'T SET TO -0 BEQ TSTF ADD #100000,(R5) ;SWITCH SIGN BIT TSTF: MOV R5,R3 ;SET UP FOR TSTR3 S1FCC: BIC #17,R1 ;CLEAR ALL FCC'S (C AND V STAY CLEAR) TSTR3: BIT #77600,(R3) ;EXPONENT ALL ZERO? BEQ 2$ ;YES TST (R3) ;NEG? BPL 1$ ;NO BIS #FN,R1 ;YES...SET FN-BIT 1$: RTS PC 2$: CLR (R3) ;MAKE SURE IT'S CLEAR BIS #FZ,R1 ;AND SET FZ-BIT RTS PC ; TYPE 3 INSTRUCTION EXECUTERS MODF: JSR PC,XXXF ;SET UP FOR FIS OP FMUL R3 ;FISA<-PRODUCT MOV (R3),R2 ;GET RESULT EXPONENT MOV 2(R3),-(R3) ;DUPLICATE A INTO B MOV R2,-(R3) ;R3 POINTS TO B MOV #377,R4 ;SET UP TO INTEGERIZE FISB MOVB R4,R5 ;SIGN EXTEND IN R5 JSR PC,R2EXP ;CONVERT EXPONENT TO INTEGER BGT 5$ ;BR IF OK MOVB R5,R4 ;ZERO RESULT EXPECTED, SO SET R4, TOO 5$: NEG R2 ;SHIFT THE R4,R5 MASK RIGHT TO CLEAR ASHC R2,R4 ;ALL BUT INTEGER BITS IN FISB BIC R4,(R3)+ ;CLEAR HI BIC R5,(R3) ;AND LOW MOV DST,R4 ;GET DST SUB #AC0,R4 BIS #10,R4 ;GET ACv1 ADD #AC0,R4 MOV -(R3),(R4)+ ;STORE HIGH INT(PROD) MOV 2(R3),(R4)+ ;STORE LOW INT(PROD) CLR (R4)+ CLR (R4)+ ;CLEAR VERY LOW FSUB R3 ;FISA<- PROD - INT(PROD) = FRAC BR ATODST ;SET RESULT AND RETURN XXXF: JSR PC,R5TOB ;SET FSRC INTO FISB JSR PC,CHOPB ;AND CHOP TO SINGLE PRECISION JSR PC,ACDST ;SET UP DST AND DSTL JSR PC,R4TOA ;SET AC INTO FISA MOV #FISB,R3 ;SET PTR FOR FIS OP JMP CHOPA ;AND CHOP IT, TOO MULF: JSR PC,XXXF ;SET UP FOR FIS OP FMUL R3 ;MULTIPLY BR ATODST ;AND FINISH UP ADDF: JSR PC,XXXF ;SET UP FOR FIS OP FADD R3 ;ADD BR ATODST ;AND FINISH UP SUBF: JSR PC,XXXF ;SET UP FOR FIS OP FSUB R3 ;SUBTRACT BR ATODST ;AND FINISH UP DIVF: JSR PC,XXXF ;SET UP FOR FIS OP FDIV R3 ;DIVIDE BR ATODST ;AND FINISH UP STCFD: JSR PC,R5DST ;SET UP DESTINATION JSR PC,R4TOA ;AND LOAD THE SOURCE BR XXCDF ;ROUND IT, IF NECESSARY, AND STORE IT LDF: LDCDF: JSR PC,R5TOA ;GET FSRC IN DESIRED MODE JSR PC,ACDST ;SET UP DST AND DSTL XXCDF: CMP DSTL,#8. ;DOUBLE PRECISION DST? BGE 1$ ;YUP JSR PC,TRNCA ;NO...CONVERT TO SINGLE 1$: ;GO RIGHT INTO ATODST ATODST: MOV #FISA,R4 ;SET SRC MOV DST,R3 ;AND DST MOV R3,R2 ;R2 IS DST PTR....R3 IS FOR TSTR3 LATER R4TOR2: MOV DSTL,R0 ;GET COUNT 1$: MOV (R4)+,(R2)+ SOB R0,1$ RTS PC LDCIF: MOV (R5)+,R2 ;GET HI ORDER BIT #FL,R1 ;LONG OR SHORT? BNE 1$ ;...LONG MOV R2,R3 ;SHORT--WE GOT THE LOW ORDER SXT R2 ;EXTEND SIGN SINCE SINGLE PRECISION BR 3$ 1$: CLR R3 ;CLEAR LOW ORDER, JUST IN CASE DEC R0 ;HOW MANY AVAILABLE? BEQ 3$ ;ONLY ONE....DONE MOV (R5)+,R3 ;GET 1ST INT WD 3$: JSR PC,ACDST ;SET DST AND DSTL MOV #241,R4 ;SET STARTING EXPONENT TST R2 ;NEG? BGE 5$ ;NO BIS #400,R4 ;YES...SET HI WD NEG NEG R3 ;AND MAKE # POS ADC R2 NEG R2 BVC 10$ ;OK...CONVERT A POSITIVE NUMBER DEC R2 ; MAP 100000 -> 077777 BR 10$ ;AND CONVERT 5$: BGT 10$ ;NON-ZERO SRC TST R3 ;ARE THEY BOTH ZERO? BEQ 15$ ;YES...DONE 10$: DEC R4 ;INTEGER TO CONVERT IN R2,R3 ASL R3 ;SHIFT UNTIL "HIDDEN BIT" COMES OUT ROL R2 BCC 10$ ;IT'S GOTTA COME EVENTUALLY MOV R2,R5 ;COPY HIGH WORD ASHC #7,R4 ;AND SHIFT IN TO MAKE A HI-ORDER WORD ASHC #-9.,R2 ;AND SHIFT LOW TO MAKE A LOW-ORDER WORD MOV R4,R2 ;SET THE HIGH....RESULT IN R2,R3 15$: MOV #FISA,R0 ;SET FISA FOR ATODST MOV R2,(R0)+ MOV R3,(R0)+ CLR (R0)+ CLR (R0)+ BR ATODST STCFI: MOV R5,-(SP) ;SAVE DST ADDRESS MOV (R4)+,R2 ;GET HIGH ORDER SRC BPL 1$ ;BR IF POS BIS #FN,R1 ;SET NEG FLAG 1$: MOV (R4)+,R5 ;GET LOW ORDER MOV R2,R4 ;AND SET HIGH ORDER JSR PC,R2EXP ;CONVERT R2 TO EXPONENT BLE 5$ ; RESULT IS ZERO MOV #16.,R3 ;16. IS UPPER EXP LIMIT IF S.P. BIT #FL,R1 BEQ 3$ ;WHICH IT IS ASL R3 ;32. IS UPPER LIMIT FOR D.P. 3$: CMP R2,R3 ;IS R2 TOO BIG? BGE 7$ ;YES...OVERFLOW SUB #8.,R3 ;R3 <- 8. or 24. SUB R3,R2 ; ( -8. or -24. ) < R2 < 8. BIS #200,R4 ;SET 'HIDDEN BIT' BIC #177400,R4 ;AND CLEAR THE EXPONENT AND SIGN ASHC R2,R4 ;SHIFT TO PROPER PLACE BEQ 5$ ;ZERO BIT #FL,R1 ;LONG INTEGER? BNE 9$ ;YES...NON-ZERO CLR R5 ;NO...CLR LOW SIDE IN CASE OF FUTURE NEG TST R4 ;AND USE DIFFERENT CRITERIA FOR ZERO TEST BNE 9$ ; AND FINISH UP 5$: CLR R4 ;ZERO RESULT CLR R5 BIS #FZ,R1 ;SET FZ-BIT BIC #FN,R1 ;AND CLEAR FN-BIT, JUST IN CASE BR 10$ ;AND STORE RESULT 7$: BIS #FC,R1 ;OVERFLOW....SET FC-BIT MOV #ERRCNV,FEC ;SET ERROR CODE MOV INSPC,FEA ;AND ADDRESS MOV #77777,R4 ;AND SET HIGH MOV #177777,R5 9$: BIT #FN,R1 ;NEG? BEQ 10$ ; NO...STORE RESULT NEG R5 ;YES...NEG RESULT ADC R4 NEG R4 ;-OVERFLOW WORKS, TOO 10$: MOV (SP)+,R3 ;RETRIEVE DST PTR MOV R4,(R3)+ ;SET HIGH ORDER (OR ALL OF RESULT) DEC R0 BEQ CCCQ ;ONLY ONE WORD TO STORE MOV R5,(R3) ;SET LOW ORDER CCCQ: JMP COPYCC ;COPY TO CCs AND QUIT STEXP: JSR PC,R4EXP ;GET EXPONENT FROM AC TO R2 MOV R2,(R5) ;AND STORE IT AWAY BGT CCCQ ;AND DONE IF >0 BEQ 1$ BIS #FN,R1 ;MINUS BR CCCQ 1$: BIS #FZ,R1 ;ZERO BR CCCQ ;COPY CCs AND QUIT R4EXP: MOV (R4),R2 ;GET EXPONENT INTO R2 R2EXP: ASL R2 CLRB R2 ;EXTRACT THE EXPONENT SWAB R2 SUB #200,R2 ;FROM EXCESS 200 RTS PC CMPF: JSR PC,R5TOB ;GET AS MUCH OF FSRC AS AVAILABLE MOV #FISB,R5 ;AND POINT TO IT TST (R4) ; 1ST, CHECK IF BOTH ARE NEGATIVE BGE 1$ ;NOT THIS ONE TST (R5) BGE 1$ ;NOR THIS MOV R5,R3 ;THEY ARE BOTH NEG...REVERSE THE TEST MOV R4,R5 ;BY REVERSING THE PTRS MOV R3,R4 1$: CMP (R4),(R5)+ ;COMPARE SIGN, EXPONENT, AND HI FRACTION 2$: BGT LT ;IF AC GREATER, THEN FSRC