.TOC "SINGLE FLOATING ADD & SUB -- FAD, FADR, FSB, FSBR" .DCODE 140: R, FL-AC, B0/0, J/FAD ;FAD .IF/FPLONG R, B0/0, J/FADL ;FADL [414] .IFNOT/FPLONG EA, J/UUO ;(FADL) [414] .ENDIF/FPLONG RW, FL-MEM, B0/0, J/FAD ;FADM RW, FL-BOTH,B0/0, J/FAD ;FADB R, FL-AC, B0/0, J/FADR ;FADR [414] I, FL-AC, B0/0, J/FADRI ;FADRI RW, FL-MEM, B0/0, J/FADR ;FADRM [414] RW, FL-BOTH,B0/0, J/FADR ;FADRB [414] 150: R, FL-AC, B0/1, J/FSB ;FSB .IF/FPLONG R, B0/1, J/FSBL ;FSBL [414] .IFNOT/FPLONG EA, J/UUO ;(FSBL) [414] .ENDIF/FPLONG RW, FL-MEM, B0/1, J/FSB ;FSBM RW, FL-BOTH,B0/1, J/FSB ;FSBB R, FL-AC, B0/1, J/FSBR ;FSBR [414] I, FL-AC, B0/1, J/FSBRI ;FSBRI RW, FL-MEM, B0/1, J/FSBR ;FSBRM [414] RW, FL-BOTH,B0/1, J/FSBR ;FSBRB [414] .UCODE .IFNOT/FPLONG 1001: ;[414] Must be near UUO FAD: FSB: SR_#,#/1,J/FADR ;[414] FLAG NO ROUND, GO FAD/FSB .IF/FPLONG =0****00***0 FAD: FSB: SR_#,#/1,J/FADR ;[414] FLAG TRUNCATE MODE, GO FAD FADL: FSBL: SR_#,#/2,J/FADR ;[414] FLAG LONG MODE = .ENDIF/FPLONG =0****00***0 FADRI: FSBRI: AR_AR SWAP ;Orient immediate operand FADR: FSBR: FE_EXP,EXP_SIGN,SC/SCAD,ARX_0S, ;Grab exponent, test for subtract B DISP ;[414] = ; FIND OPERAND WITH LARGER EXP, LEAVING IT IN BR, ; AND ITS EXP-1 IN FE. THE SMALLER OPERAND IS LEFT IN AR, ; SHIFTED RIGHT BY THE DIFFERENCE BETWEEN THE EXPONENTS -1 =011 ;[414] FAS: BR/AR,BRX/ARX,AR_AC0,J/FADFSB ;[414] SAVE MEM OP IN BR, GET AC AR_-AR,J/FAS ;NEGATE SUBTRAHEND ; FADFSB: SC_EXP-SC,EXP_SIGN,SKP SCAD0 ;[414] FIND LARGER OPERAND =0 FE_FE+SC,BR/AR,AR_BR*2,J/FAS1 ;AC EXP .GE. MEM MQ_AR,SC_#+SC,#/37., ;MEM OP LARGER, SHIFT AC OP SKP SCAD0,J/FAS2 ;COMPUTE SHIFT AMOUNT FAS1: MQ_AR,SC_#-SC,#/36.,SKP SCAD0 ;CHECK SHIFT AMOUNT =0 FAS2: MQ_SHIFT,ARX/MQ,AR_SIGN,J/FAS3 ;LOW TO MQ, READY TO GET HI AR_SIGN,ARX_AR, ;HERE IF EXP DIFF .GT. 36 SC_#+SC,#/36.,SKP SCAD0 ; .GT. 72? =0 ARX_SHIFT,MQ_0.M,FE_FE+1,J/FAS5 ARX_AR,MQ_0.M,FE_FE+1,J/FAS5 ;SHIFTED CLEAR OUT FAS3: AR_SHIFT,ARL/SH,ARX/MQ, MQ_0.M,FE_FE+1 ;READY TO ADD FAS5: AR_(AR+2BR)*.25,ARX/ADX*.25, ;HERE FOR ADD OR SUB NORM,J/SNORM .TOC "SINGLE FLOATING MULTIPLY -- FMP, FMPR" .DCODE 160: R, FL-AC, B0/1, J/FMP ;FMP [414] .IF/FPLONG R, J/FMPL ;FMPL [414] .IFNOT/FPLONG EA, J/UUO ;(FMPL) [414] .ENDIF/FPLONG RW, FL-MEM, B0/1, J/FMP ;FMPM [414] RW, FL-BOTH,B0/1, J/FMP ;FMPB [414] R, FL-AC, J/FMPR ;FMPR I, FL-AC, B0/1, J/FMPRI ;FMPRI [414] RW, FL-MEM, J/FMPR ;FMPRM RW, FL-BOTH, J/FMPR ;FMPRB .UCODE .IF/FPLONG =0****00**00 ;[414] FDV: ;[414] FMPx and FDVx start here FMP: SR_#,#/1,B DISP,J/FDVR ;[414] FLAG TRUNCATE MODE and split FMPL: SR_#,#/2,J/FMPR ;LONG MODE FDVL: FE_EXP-1,EXP_SIGN,ARX+MQ_0.M,J/FDVL1;[414] = .IFNOT/FPLONG ;[414] 1003: ;[414] Must adjoin UUO FDV: ;[414] FMP: SR_#,#/1,B DISP,J/FDVR ;[414] Flag for truncate mode .ENDIF/FPLONG =0****00*010 FDVRI: ;[414] FMPRI: AR_AR SWAP,B DISP ;[414] Orient op. FMP or FDV? FDVR: SC_EXP+1,EXP_SIGN,ARX+MQ_0.M, ;[414] FDV. SETUP DIVISOR J/FDVGO ; =111 FMPR: SC_EXP,EXP_SIGN,ARX_0S ;FMP. PREPARE M'IER FRACTION = MQ_AR,AR_AC0,FE_#,#/-14. ;M'IER TO MQ, GET M'CAND =01* SC_EXP+SC,EXP_SIGN, ;SEPARATE M'CAND FRACTION FROM EXP CALL.M,J/MULSUB ;[414] AND BEGIN MULTIPLY =11* FE_#+SC,#/-200,NORM AR,J/SNORM = .TOC "SINGLE FLOATING DIVIDE -- FDV, FDVR" .DCODE 170: R, FL-AC, B0/0, J/FDV ;FDV [414] .IF/FPLONG R, FL-AC, J/FDVL ;FDVL [414] .IFNOT/FPLONG EA, J/UUO ;(FDVL) [414] .ENDIF/FPLONG RW, FL-MEM, B0/0, J/FDV ;FDVM [414] RW, FL-BOTH,B0/0, J/FDV ;FDVB [414] R, FL-AC, J/FDVR ;FDVR I, FL-AC, B0/0, J/FDVRI ;FDVRI [414] RW, FL-MEM, J/FDVR ;FDVRM RW, FL-BOTH, J/FDVR ;FDVRB .UCODE ;FDV: SR_#,#/1,J/FDVR ;This stuff is with FMP ; ;FDVRI: AR_AR SWAP ;[414] Orient op ;FDVR: SC_EXP+1,EXP_SIGN,ARX+MQ_0.M ;[414] SETUP DIVISOR =000 FDVGO: BR/AR,BRX/ARX,AR_AC0,FE_#,#/27.,;[414] DIVISOR TO BR, CLR BRX SKP AD0,CALL,J/FDVCHK ;GET DIVIDEND, STEP COUNT =10 SKP BR0,CALL,J/DIV- ;OK, BEGIN DIVISION SET FL NO DIV,J/IFNOP ;NO DIVIDE, SORRY ;RETURN HERE WITH QUOTIENT IN ARX. WE TOOK 29 DIVIDE STEPS, TO ; GUARANTEE HAVING A ROUNDING BIT EVEN IF THE FIRST STEP GENERATES ; A QUOTIENT BIT OF ZERO. THEREFORE, THE MSB OF QUOTIENT IS EITHER ; IN BIT 7 OR 8, AND NORM WILL FIND IT IN ONE STEP. =110 AR_ARX,FE_FE+#,#/2, ;NEGATIVE QUOTIENT SKP BR EQ,J/FDVNEG ;CHECK FOR MORE QUO TO COME AR_ARX*.25,ARX_ARX*.25,NORM, ;JUNK IS 36 BITS AWAY FROM MSB FE_FE+#,#/2,J/SNORM ;POS QUOTIENT, NORMALIZE = ;HERE IF QUOTIENT SHOULD BE NEGATIVE, WITH POSITIVE FORM IN ; AR AND ARX. SKIP IF REMAINDER (IN BR) IS ZERO. IN THIS CASE, ; WE CLEAR ARX, BECAUSE AR CONTAINS THE ENTIRE QUOTIENT. ; IF, HOWEVER, THE REMAINDER IS NOT ZERO, WE INFER ; THAT AN INFINITE PRECISION DIVISION WOULD GENERATE MORE ONES ; IN THE QUOTIENT. IF THAT IS THE CASE, WE LEAVE ARX WITH THE ; QUOTIENT, SO THE NEGATION PROCESS WILL WORK CORRECTLY TO RETURN ; THE HIGH ORDER PART OF THE INFINITE-PRECISION NEGATIVE QUOTIENT. =0 FDVNEG: SET SR1,AR_AR*.25 LONG,NORM,J/SNORM ARX_0S,J/FDVNEG ;REMAINDER WENT TO ZERO ;HERE FOR FDVL .IF/FPLONG ;FDVL: FE_EXP-1,EXP_SIGN,ARX+MQ_0.M =000 FDVL1: AR_AC1,BR_AR LONG, ;SAVE DIVISOR IN BR LONG SC_#,#/9.,CALL ;READY TO SHIFT LOW DIVIDEND ARX_SHIFT,AR_AC0, ;DIVIDEND IN PLACE SC_FE,FE_#,#/24., ;EXP TO SC, STEP COUNT TO FE SKP AD0,J/FDVCHK ;GO CHECK FOR NO DIVIDE =010 CALL,SKP BR0,J/FDVL2 ;GO BEGIN DIVIDE SET FL NO DIV,J/IFNOP ;CAN'T DIVIDE, ABORT =110 AR_AC0,SR_#,#/5, ;NEG QUO, FLAG TRUNCATE MODE SR DISP,J/FDVL4 ; WAS IT 26 OR 27 STEPS? AR_AC0,SR_#,#/1, ;POS QUO SR DISP,J/FDVL4 = ;COME HERE TO START THE DIVISION. ON THE FIRST STEP, WE CHECK ; TO SEE WHETHER A 1 HAS BEEN GENERATED IN THE QUOTIENT. IF SO, ; 26 ADDITIONAL STEPS WILL GENERATE THE FULL 27 SIGNIFICANT BITS ; OF THE QUOTIENT. IF NOT, 27 STEPS ARE REQUIRED. =0 FDVL2: DIVIDE,AR_2(AR-BR),ARX/ADX*2,J/FDVL3 ;FIRST DIVIDE STEP DIVIDE,AR_2(AR+BR),ARX/ADX*2 ; DOES IT GENERATE A 1? =00 FDVL3: DISP/DIV,MQ/MQ*2, ;NO, TAKE AN EXTRA DIVIDE STEP AR_2(AR+BR),ARX/ADX*2,J/DIVLP ; WITHOUT COUNTING FE SR_1,SC_#+SC,#/1,J/DIV- ;YES, 27 STEPS WILL NORMALIZE QUO DISP/DIV,MQ/MQ*2,AR_2(AR-BR),ARX/ADX*2,J/DIVLP SR_1,SC_#+SC,#/1,J/DIV+ ;WE COME HERE AFTER DOING THE DIVISION, EITHER 26 OR 27 STEPS ; AS REQUIRED TO GENERATE A NORMALIZED QUOTIENT FROM NORMALIZED ; OPERANDS. NOW FIGURE OUT WHAT EXPONENT THE REMAINDER SHOULD HAVE. =0 FDVL4: SC_EXP-#,#/27., ;DIVIDEND EXP-27 AR_BR,SKP AR0,J/FDVL6 ;GET REMAINDER, TEST D'END SIGN SC_EXP-#,#/26., ;D'END EXP-26 AR_BR,SKP AR0 ;HERE WITH REMAINDER IN AR, ITS EXP IN SC ; SKIP IF D'END (AND THEREFORE REM) NEGATIVE. =0 FDVL6: EXP_SC,BYTE DISP, ;TEST FOR UNDERFLOW SKP AR EQ,J/FDVL7 ; OR REM =0 AR_-BR,SKP CRY0, ;NEGATE REM, CHECK =0 GEN SC,BYTE DISP ; AND LOOK FOR EXP UFLO =110 EXP_-SC-1,J/FDVL7 ;ONE'S COMPLEMENT EXP AR_0S ;REM =0 OR EXP UFLO =110 FDVL7: AC1_AR,ARX+MQ_0.M, ;SAVE REMAINDER AR_MQ,ARL/AD,J/SNR2 ;GO NORMALIZE QUOTIENT AR_0S,J/FDVL7 .ENDIF/FPLONG ;SUBR TO CHECK FOR FLOATING NO DIVIDE ; ENTER WITH SKP ON DIVIDEND SIGN, IN AR LONG, WITH ; DIVISOR EXP IN SC, DIVISOR IN BR =0 FDVCHK: SC_EXP-SC,EXP_SIGN,SKP BR0,J/FDVCK1 AR_-AR LONG,J/FDVCHK ;GET POSITIVE DIVIDEND =0 FDVCK1: GEN AR-2BR,SKP CRY0, ;TEST FOR NO DIVIDE SC_#+SC,#/177,RETURN2 ;AND CORRECT EXP GEN AR+2BR,SKP CRY0, ;SAME TEST, NEG DIVISOR SC_#+SC,#/177,RETURN2 ;AND SAME EXP CORRECTION .TOC "UFA, DFN, FSC" .DCODE .IF/FPLONG 130: R, J/UFA ;UFA RPW, J/DFN ;DFN .IFNOT/FPLONG 130: EA, J/UUO ;UFA EA, J/UUO ;DFN .ENDIF/FPLONG 132: I, FL-AC, J/FSC ;Must adjoin 133 (IBP/ADJBP) .UCODE .IF/FPLONG =0****00***0 DFN: FE_AR0-8,AR0-8_#,#/0, ;SAVE LOW EXP, CLR SO CAN ARX_0S,J/DFN1 ; DETECT FRACTION = 0 UFA: FE_EXP,SC/SCAD,EXP_SIGN,ARX_0S = =000 BR_AR LONG,AR_AC0,CALL,J/EXPD =100 ARX_AR,AR_SIGN,ARL/AD, ;READY TO UNNORMALIZE SMALLER OP CALL.M,J/SHIFT AR_SIGN,ARX/AD ;LOST SMALLER OP, USE ITS SIGN AR_AR+BR,SKP AD NE, ;IS RESULT SIGNIFICANT? SC_FE,I FETCH = =0 AC1_AR,J/FINI ;NO, CLEAR RESULT AC SKP EXP NE,BR/AR ;IS RIGHT SHIFT REQ'D? =0 SKP AR0,FETCH WAIT,J/UFA4 ;NO, IS RESULT NEG? AR_BR*.5,GEN FE-#,#/377,SKP SCAD NE,FETCH WAIT =0 FE_-1,SET FLOV FE_FE+1,SC/SCAD,SKP AR0 =0 UFA4: AR0-8_SC,J/STAC1 ;POS, PUT IN EXP STRAIGHT AR0-8_-SC-1,J/STAC1 ;NEG, USE COMPLEMENT OF EXP DFN1: AR_-AR,SKP CRY0 ; LOW FRACTION =0? =0 AR0-8_FE,STORE, ;STORE LOW WORD BACK TO MEM ARX_AC0 COMP,J/STMAC ; GET COMPLEMENTED HIGH WORD AR0-8_FE,STORE, ;LOW WORD WAS ZERO, INSTALL EXP ARX_-AC0,J/STMAC ; GET NEGATED HIGH WORD .ENDIF/FPLONG ; ;FSC ;ENTER WITH E IN AR 1502: ;[345] Next to IBP because of DRAM FSC: SC_EA,ARX+MQ_0.M, AR_AC0,ARL/AD = FE_EXP+SC,EXP_SIGN,J/SNR2 ;NORMALIZE SCALED RESULT .TOC "FIX, FIXR, FLTR" .DCODE 122: R, J/FIX ;FIX--Unrounded. Adjoins EXTEND 126: R, J/FIXR ;FIXR--Rounded R, FL-AC, J/FLTR ;FLTR .UCODE ;FLTR ;ENTER WITH (E) IN AR =0****00***0 FLTR: FE_#,#/277,ARX_AR,SKP AR0, ;BINARY POINT TO RIGHT OF ARX AR_SIGN,J/SNORM ; SIGN EXTENDED. GO NORMALIZE ;FIX AND FIXR ;ENTER WITH (E) IN AR ; FIX AND FIXR DIFFER ONLY IN THE ROUNDING CRITERION: ;FIXR ADDS 1 TO THE INTEGER PART IF THE FRACTION PART IS ONE-HALF ;OR GREATER. FIX DROPS THE FRACTION PART OF POSITIVE NUMBERS, BUT ADDS ;1 TO THE INTEGER PART OF NEGATIVE NUMBERS IF THE FRACTION PART IS NOT ;ALL ZERO. ; THIS IS IMPLEMENTED BY CHOOSING A FRACTION (THE ROUNDING ;CONSTANT) TO ADD TO THE INPUT, SUCH THAT A CARRY WILL OCCUR INTO THE ;INTEGER PART UNDER THE APPROPRIATE CONDITIONS. FOR FIXR, THE ROUNDING ;CONSTANT IS EXACTLY ONE-HALF. FOR FIX, IT IS ZERO ON POSITIVE INPUT, ;OR THE LARGEST POSSIBLE FRACTION (ALL 1S) ON NEGATIVE INPUT. FIXR: FE_EXP-#,#/244,SKP SCAD0, ;GET BINARY POINT POSITION ARX_1B1,J/FIX1 ;GET ROUNDING CONSTANT = 1410: ;Must be near EXTEND FIX: FE_EXP-#,#/244,SKP SCAD0, ;GET BINARY POINT POSITION ARX_AR SIGN ;SET ROUNDING CONSTANT, GO FIX =0 FIX1: SET AROV,J/IFNOP ;CAN'T DO IT, GIVE UP BR/AR,CLR AR,ARX_ARX*2 ;ROUNDING CONSTANT READY IN ARX BR_AR LONG,AR_BR,CLR ARX, ;MANTISSA TO AR LONG SC_#,#/9. ;READY TO SHIFT OFF EXPONENT ARX_SHIFT,AR_SIGN, ;MANTISSA LEFT ALIGNED IN ARX SC_FE+#,#/36.,SKP SCAD0 ;ANY INTEGER BITS? =0 MQ_SHIFT, ;YES, PUT THEM IN MQ AR_ARX (ADX),CLR ARX, ;SHIFT MANTISSA LEFT 36 PLACES I FETCH,J/FIX2 ;AND PREFETCH NEXT AR_0S,I FETCH,J/STORAC ;ALL SIGNIFICANCE LOST FIX2: ARX_SHIFT,AR_MQ ;INTEGER IN AR, FRACTION IN ARX AR_AR+BR,AD LONG,J/STAC ;ROUND AND STORE .TOC "SINGLE PRECISION FLOATING NORMALIZATION" ;HERE TO NORMALIZE SINGLE PRECISION RESULTS ;SR2-3 TELL HOW TO STORE RESULTS: ;XX00 ... ROUND, SINGLE PRECISION ;XX01 ... TRUNCATE, SINGLE PRECISION ;XX10 ... LONG MODE (IMPLIES TRUNCATION) ;IN ADDITION, THIS CODE SETS SR 1 IF ANSWER IS NEGATIVE, SO X1YZ ; CORRESPONDS TO X0YZ EXCEPT THAT THE RESULT MUST BE NEGATED. ;DISPATCH TO SNORM WITH "DISP/NORM,AR/AD*.25" ; THUS THE 8 POSSIBILITIES ARE: ;SNORM AD=0 AR=0 EITHER ANSWER IS ZERO, OR MSB IS IN ARX ;SNORM+1 AD0 AR NEG RESULT IS NEG. MAKE POS, TRY AGAIN ;SNORM+2 AD1-6 AR3-8 MSB TOO FAR LEFT, SHIFT RIGHT & RETRY ;SNORM+3 AD7 AR9 RESULT IS CORRECTLY NORMALIZED ;SNORM+4 AD8 AR10 SHIFT LEFT ONCE FOR NORMALIZATION ;SNORM+5 AD9 AR11 SHIFT LEFT 2 PLACES ;SNORM+6 AD10 AR12 SHIFT LEFT THRICE ;SNORM+7 AD11-35 AR13-35 SHIFT LEFT A LOT, TRY AGAIN =000 SNORM: AR_ARX,ARL/SH,SKP ARX NE, ;AR IS ZERO, GET ARX ARX_0.M,J/SNZERO NORM -AR,SET SR1,J/SNORM ;REMEMBER NEGATIVE, GO POSITIVE SNR2: AR_AR*.25 LONG,FE_FE+#,#/2, ;SHIFT RIGHT, NORM,J/SNORM ;TRY AGAIN SR DISP,J/SROUND ;AD7 -> AR9, IS ROUND REQ'D? AR_AR*2 LONG,FE_FE-1, ;AD8 -> AR10, ONCE LEFT AND DONE SR DISP,J/SROUND AR_AR*4 LONG,FE_FE-#,#/2, ;AD9 -> AR11 SR DISP,J/SROUND AR_AR*8 LONG,FE_FE-#,#/3, ;AD10 -> AR12 SR DISP,J/SROUND .IFNOT/SNORM.OPT SKP AR NE,INH CRY18,SC_#,#/7 ;LOOK FOR AR13-17 =0 SC_#,#/13. ;LH IS 0. SHIFT FARTHER MQ_SHIFT,AR_ARX (ADX),CLR ARX, ;HIGH TO MQ, GET READY FOR LOW FE_FE-SC ; ADJUST EXPONENT ARX_SHIFT,AR_MQ,J/SNR2 ;FRACTION REPOSITIONED. GO AGAIN ;HERE IS THE FASTER VERSION OF LONG NORMALIZATION SHIFTS, ; WHICH TAKES FOUR WORDS MORE BUT IS A BIT QUICKER IN THE ; INTERMEDIATE NORMALIZATION CASES. .IF/SNORM.OPT ADA EN/0S,ADB/AR*4,AD/ANDCA, ;GENERATE AR*4 AR/AD*2,ARX/ADX*2, ; AR_AR*8 LONG SC_#,#/12., ;READY TO SHIFT FARTHER GEN CRY18,SKP CRY0 ; TEST AR0-19 FOR ZERO =0 AR_AR*8 LONG,BR_AR LONG, ;IT WAS IN AR13-19 FE_FE-#,#/6,NORM,J/SN1 ; NOW IN AR10-16, AD8-14 MQ_SHIFT,AR_ARX (ADX), ;13-19=0, SHIFT TO TRY 20-35 CLR ARX,SC_#,#/10. ARX_SHIFT,AR_MQ*.25, ;REPOSITION FRACTION IN AR LONG FE_FE-#,#/13., ;COMPENSATE EXPONENT NORM,J/SNORM =100 SN1: AR_BR*2 LONG,FE_FE+#,#/2, ;MSB IN AD8, SO IN BR10 SR DISP,J/SROUND AR_BR*4 LONG,FE_FE+1, ;MSB IN AD9, THUS IN BR11 SR DISP,J/SROUND SR DISP,J/SROUND ;AD10 -> AR9, A LUCKY GUESS AR_AR*8 LONG,BR_AR LONG, ;TRY SHIFTING 3 MORE FE_FE-#,#/3,NORM,J/SN1 .ENDIF/SNORM.OPT ;HERE WHEN AD ENTIRELY ZERO ON NORMALIZE ATTEMPT. SKIP IF ARX ; IS NOT ZERO, HAVING COPIED IT TO AR (IE, LEFT SHIFT 36 PLACES). ; OTHERWISE, THE ENTIRE RESULT IS ZERO, SO WE STORE THAT. =0 SNZERO: CLR FE,AR+ARX+MQ_0.M, ;RESULT = 0 SR DISP,J/SRND5 AR_AR*.25 LONG,FE_FE-#,#/34., ;HAVE MOVED LEFT 36, GO RIGHT 2 NORM,J/SNORM ;AND TRY THAT ;WE GET HERE WITH A NORMALIZED POSITIVE FRACTION IN AR'ARX, ; THE CORRECTED EXPONENT IN FE, AND SR INDICATES THE PROPER SIGN ; FOR THE RESULT AND WHETHER THE ANSWER SHOULD BE ROUNDED, ; TRUNCATED, OR LONG. .IF/FPLONG =100 .IFNOT/FPLONG =1*0 .ENDIF/FPLONG SROUND: BR_AR LONG,AR_0S,J/SRND2 ;PREPARE TO ROUND BY ADDING THE ; PART OF THE FRACTION WE WILL ; DISCARD (CARRY IF ARX0) BR_AR LONG,CLR AR,ARX_1S, ;TRUNCATE MODE SR DISP,J/STRNC ; HANDLING DEPENDS ON SIGN .IF/FPLONG BR_AR LONG,CLR AR,ARX_1S, ;LONG MODE SC_#,#/9. = ARX_SHIFT,SR DISP ;MASK = 0,,000777 TO ARX =01* BR_AR LONG,AR_BR LONG,J/SRND4 ;POS, TRUNCATE BY ANDING AR_AR+BR,ARX/ADX,BR_AR LONG, ;NEG, MUST DIDDLE NORM,J/SRND3 ; NORM FORCES LONG ARITH .ENDIF/FPLONG ;HERE TO PERFORM ROUNDING OR TRUNCATION OF SINGLE-PRECISION RESULTS, ; AND CHECK FOR CARRY INTO EXPONENT FIELD REQUIRING RENORMALIZATION =0*1 STRNC: AR_BR,CLR ARX,J/SRND4 ;POS TRUNCATE, GO STUFF IN EXP SRND2: AR_AR+BR,NORM,CLR ARX ;NORM FORCES LONG ARITH ; SO THIS ADDS ARX TO BR'BRX =1*0 SRND3: AR_AR*.5,FE_FE+1 ;RENORMALIZE SRND4: EXP_FE TST,SR DISP, ;STUFF EXP, CHECK NEG OR LONG ARX_ARX*BRX,AD/ANDCB ;CLEAR TRUNCATED FRACTION ;HERE TO STORE RESULT AS A FUNCTION OF SINGLE OR LONG PRECISION ; AND POSITIVE OR NEGATIVE... .IF/FPLONG =001 .IFNOT/FPLONG =0*1 .ENDIF/FPLONG SRND5: SR_0,B WRITE,J/ST6 ;POS & NOT LONG .IF/FPLONG SLNG3: AC0_AR,AR_0S,SC_#,#/27.,J/SLNG4 ;STORE HIGH PART OF LONG ANS .ENDIF/FPLONG AR_-AR,SR_0,B WRITE,J/ST6 ;NEG & NOT LONG .IF/FPLONG AR_-AR LONG,J/SLNG3 ;LONG NEG, MAKE IT SO SLNG4: AR_SHIFT,I FETCH AR0-8_FE-SC,BYTE DISP, ;TEST FOR EXP UNDERFLOW SKP AR EQ ; OR LOW WORD ZERO =110 .ENDIF/FPLONG STRAC1: SR_0,J/STAC1 ;PUT AWAY LOW WORD OF LONG RESULT .IF/FPLONG AR_0S,SR_0,J/STAC1 ;CLEAR LOW WORD IN AC1 .ENDIF/FPLONG .TOC "DOUBLE FLOATING ARITHMETIC -- DFAD, DFSB, DFMP, DFDV" .DCODE 110: R, B/0, J/DFLOAT ;DFAD R, B/2, J/DFLOAT ;DFSB R, B/4, J/DFLOAT ;DFMP R, B/6, J/DFLOAT ;DFDV .UCODE =0****00**0* DFLOAT: FE_EXP,EXP_SIGN.S,SC/SCAD,MQ_0.S,;[414] VMA_VMA+1,LOAD ARX, CALL.S,J/XFERW ;GET LOW WORD ARX_ARX*2,B DISP ;LOW BIT 0 IGNORED = =00* DFAS: BR_AR LONG,AR_AC1*2,J/DFAS1 ;MEM OP READY, GET AC OP AR_-AR LONG,J/DFAS ;DFSB, NEGATE AND ADD BR_AR LONG,GEN ARX,SKP AD NE, ;[241]HERE FOR DOUBLE FLT MUL FE_#,#/-18.,J/DFMP ;[241]BEGIN TEST FOR STICKY BIT GEN AR*AC0,AD/XOR,SKP AD0, ;DFDV. WILL QUO BE NEG? BR_AR LONG, ;SAVE D'SOR IN BR, BRX SC_FE-1,J/DFDV ;HERE FOR DFAD AND DFSB ; MEM OPERAND IS IN BR (NEGATED IF DFSB) ; FE AND SC HAVE ITS EXPONENT =0*0 DFAS1: ARX_AR,AR_AC0,CALL,J/EXPD ;AC OPERAND IN PLACE =1*0 DFAS2: ARX_AR,AR_SIGN, ;GET SHIFTED HIGH WORD GEN #+SC,#/-36., ;IS ANY SHIFT REQUIRED? SKP SCAD0,J/DFAS3 ARX_AR,AR_SIGN, ;DIFF IS > 36 SC_#+SC,#/36.,SKP SCAD0 ;CHECK FOR >72 =0 AC0_AR,MQ_SHIFT,AR_ARX (ADX), ARX/MQ,J/DFAS6 ;[241]36 < DIFF < 72 AR_BR,ARL/AD,ARX_BRX, ;DIFF >72 MQ_0.M,J/DNTRY ;NORMALIZE LARGER OP =0 DFAS3: AR_ARX,ARL/SH,ARX/MQ, ;NO SHIFT REQUIRED MQ_0.M,J/DFAS5 AR_SHIFT ;BEGIN SHIFTING SMALLER OP AC0_AR,AR_ARX,ARX/MQ ;HI PART TO AC MQ_SHIFT,AR_ARX (ADX), ;MID PART TO MQ CLR ARX ;SHIFT ZEROS IN FROM RIGHT DFAS4: MQ_SHIFT,ARX/MQ,AR_AC0 ;ALL PIECES NOW IN PLACE DFAS5: AR_AR+BR,ARX/ADX,SC_#,#/4, ;HERE WHEN OPERANDS ALIGNED NORM,J/DNORM ;ADD, AND NORMALIZE RESULT DFAS6: MQ_SHIFT,AR_MQ ;[241]GET H,L, PUT S,H IN AR AC1_AR,AR_ARX,ARX_0S ;[241]STORE S,H ARX_AC1,AR_SHIFT ;[241]GET L,0, GET S,H BACK GEN AR,SKP AD NE ;[241]TEST FOR 0'S, =0 CLR SR3,AR_AC0,J/DFAS5 ;[241]DO 2'S COMP, ALL IN PLACE SET SR3,AR_AC0,J/DFAS5 ;[241]DO 1'S COMP, ALL IN PLACE ;SUBROUTINE TO CHOOSE OPERAND WITH SMALLER EXPONENT, AND ; PREPARE FOR SHIFTING IT. ; ENTER WITH ONE OPERAND FRACTION IN BR, ITS EXPONENT IN FE & SC, ; THE OTHER OP IN AR WITH ITS EXPONENT IN AR0-8 ; RETURN THE LARGER EXPONENT IN FE, AND 36-(MAGNITUDE OF DIFFERENCE) ; IN SC. RETURN 4 IF SC POSITIVE, 5 IF NEGATIVE. EXPD: SC_EXP-SC,EXP_SIGN,SKP SCAD0 ;COMPARE MAGNITUDES =0 AR_BR,ARX_BRX,BR/AR,BRX/ARX, ;AC OP IS LARGER MAGNITUDE FE_FE+SC,J/EXPD1 ;ITS EXP TO FE MQ_ARX,SC_#+SC,#/36., ;CHECK FOR EXP DIFF > 36 SKP SCAD0,RETURN4 EXPD1: MQ_ARX,SC_#-SC,#/36., ;AC EXP .GE. MEM SKP SCAD0,RETURN4 ;SHIFT MEM OP ;DFMP ; DO TESTS FOR STICKY BITS FIRST THEN ; GET HERE WITH MEM OPERAND (M'CAND) IN BR!BRX ; AR HAS (AC1), LOW HALF OF M'IER =0 DFMP: AR_AC1,J/DFMP1 ;NO STICKY BIT AR_AC1,SKP AD NE ;GET AC LOW AND TEST =0 J/DFMP1 ;NO STICKY BIT SET SR3 ;WORRY ABOUT IT IN NORM =00* DFMP1: MQ_AR,AR_0S,ARX_0S, ;SETUP LOW M'IER SC_#+SC,#/-200, ;CORRECT EXPONENT CALL,J/MULREE ;MULTIPLY BY THE LOW PART =10* AR_AR+BR LONG ;OOPS, LOW SIGN WAS SET MQ_AR,AR_AC0,FE_#,#/-14. ;READY TO CONTINUE WITH HIGH PART ;HERE TO USE HIGH MULTIPLIER SC_EXP+SC,EXP_SIGN, ;[414] EXTRACT EXP FROM HIGH WORD SKP AR0 ;CHECK FOR NEG M'IER =010 DFMP2: MQ_AR,AR_MQ,CALL,J/MULREE ;GO BACK IN FOR HIGH PART EXP_1,J/DFMP2 ;OOPS, NEG, MOVE SIGN TO BIT 8 =110 DNTRY: SC_#,#/4,GEN AR,NORM,J/DNORM ;NORMALIZE THE ANSWER = ;DFDV ; GET HERE WITH DIVISOR IN BR!BRX, ITS EXP-1 IN SC ; SKIP IF D'SOR AND D'END SIGNS DIFFER =000 DFDV: AR_AC1*2,CALL,J/DFDV1 ;GET LOW D'END, GO START DIVIDE SET SR2,AR_AC1*2,CALL,J/DFDV1 ;NOTE NEG QUO =011 AC1_AR,AR_MQ,ARL/AD,FE_FE+1, ;HERE FROM DDVSUB. NEW STEP CNT MQ_0.M,CALL.M,J/DIV+ ; SAVE HIGH QUO, RESUME =101 AC1_AR,AR_MQ,ARL/AD,FE_FE+1, MQ_0.M,CALL.M,J/DIV- =111 AR_AC1,ARX/MQ,SC_#,#/4, ;POSITIVE QUOTIENT TO AR LONG NORM,J/DNORM ;NORMALIZE AND ROUND =00 DFDV1: ARX_AR,AR_AC0,SKP AD0, ;TEST DIVIDEND SIGN FE_#,#/26., ;SETUP COUNT FOR HIGH QUO CALL,J/FDVCHK ;GO CHECK DIVIDABILITY =10 SKP BR0,J/DDVSUB ;BEGIN DIVISION (RETURN ABOVE) SET FL NO DIV,J/IFNOP ;ABORT THE DIVISION .TOC "DOUBLE PRECISION NORMALIZATION" =000 DNORM: SKP ARX+MQ NE,SC_#,#/35.,J/DNZERO ;AR=0 BR/AR,BRX/ARX,AR_MQ COMP, ;RESULT NEG, MAKE POS SET SR2,J/DNNEG ;[241]FLAG NEGATIVE AR_AR*.25 LONG,MQ_MQ*.25, FE_FE+#,#/4,J/DNHI ;MSB IN AR 1-6 AR_AR*.25 LONG, FE_FE+#,#/2,J/DROUND ;MSB IN AR7 AR_AR*.5 LONG,FE_FE+1 ;MSB IN AR8 DROUND: AR_AR+1,ARX/ADX,NORM, ;MSB IS AR9, RIGHT ON SC_#,#/35.,J/DRND1 (AR+ARX+MQ)*2,FE_FE-1,J/DROUND ;MSB IN AR10 AR_SHIFT,FE_FE-SC ;SOMEWHERE IN AR 11-35 DNSHFT: BR/AR,AR_ARX,ARX/MQ ;SHIFT THE WHOLE THING MQ_SHIFT,AR_ARX (ADX),CLR ARX MQ_SHIFT,ARX/MQ,AR_BR,SC_#,#/10., NORM,J/DNORM ;GIVE IT ANOTHER GO DNNEG: SR DISP ;[241]TEST FOR 1'S COMP =1110 AR_AR+1,SKP CRY0,J/DNNEG1 ;[241]COMPLETE NEGATION OF MQ MQ_AR,AR_BR COMP,ARX_BRX COMP, NORM,J/DNORM ;NORMALIZE THE POS FORM =0 DNNEG1: MQ_AR,AR_BR COMP,ARX_BRX COMP, NORM,J/DNORM ;NORMALIZE THE POS FORM MQ_AR,AR_-BR,ARX/ADX,NORM,J/DNORM DNHI: (AR+ARX+MQ)*.25,J/DNTRY ;GO TRY AGAIN =0 DNZERO: SR_0,AR_0S,ARX_0S,I FETCH,J/DLOAD;[413] RESULT = 0, STORE THAT AR_SHIFT,FE_FE-SC,J/DNSHFT ;NOT ZERO, SHIFT AND TRY AGAIN =110 DRND1: AR_AR*.5 LONG,FE_FE+1 ;ROUNDING BLEW THE NORM, GO RIGHT EXP_FE TST,SR DISP,CLR MQ, ;STUFF EXP IN, CHECK RESULT SIGN BRX/ARX,ARX_1 ;READY IF NEGATION NECESSARY =1101 AC0_AR,AR_SHIFT,ARX_BRX, ;[241] STORE HIGH WORD, READY LOW I FETCH,J/STD1 ARX_ARX*BRX,AD/ANDCA,SR_0, ;CLEAR ROUNDING BIT BRX/ARX ;[413] and force BRX non zero CDBLST: AR_-AR LONG,J/DBLST ;[345] NEGATE RESULT AND STORE