Trailing-Edge
-
PDP-10 Archives
-
BB-BL69A-SB_1984
-
fp.mic
There are 5 other files named fp.mic in the archive. Click here to see a list.
.TOC "SINGLE FLOATING ADD & SUB -- FAD, FADR, FSB, FSBR"
.DCODE
.IFNOT/FPLONG
130: EA, J/UUO ;UFA
EA, J/UUO ;DFN
.ENDIF/FPLONG
140: R, FL-AC, B0/0, J/FAD
R, B0/0, J/FPNO
RW, FL-MEM, B0/0, J/FAD
RW, FL-BOTH,B0/0, J/FAD
R, FL-AC, J/FADR
I, FL-AC, B0/0, J/FADRI
RW, FL-MEM, J/FADR
RW, FL-BOTH, J/FADR
150: R, FL-AC, B0/1, J/FSB
R, B0/1, J/FPNO
RW, FL-MEM, B0/1, J/FSB
RW, FL-BOTH,B0/1, J/FSB
R, FL-AC, J/FSBR
I, FL-AC, B0/1, J/FSBRI
RW, FL-MEM, J/FSBR
RW, FL-BOTH, J/FSBR
.UCODE
.IFNOT/FPLONG
=0****00**00
FAD:
FSB: SR_#,#/1,B DISP,J/FADR ;FLAG NO ROUND, GO FAD/FSB
FMP: SR_#,#/1,J/FMPR
FDV: SR_#,#/1,J/FDVR
FPNO: AR_BR,J/UUO
=
.IF/FPLONG
=0****00***0
FAD:
FSB: SR_#,#/1,B DISP,J/FADR ;FLAG TRUNCATE MODE, GO FAD
FADL:
FSBL: SR_#,#/2,B DISP,J/FADR ;FLAG LONG MODE
.ENDIF/FPLONG
=
=0****00*010
FADRI:
FSBRI: AR_AR SWAP,B DISP
FADR: FE_EXP,EXP_SIGN,SC/SCAD,
ARX_0S,J/FAS
=111
FSBR: FE_EXP,SC/SCAD,EXP_SIGN,ARX_0S
= AR_-AR,J/FAS ;NEGATE SUBTRAHEND
;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
FAS: BR/AR,BRX/ARX,AR_AC0 ;SAVE MEM OP IN BR, GET AC
SC_EXP-SC,EXP_SIGN,SKP SCAD0 ;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, J/FMP
R, J/FPNO
RW, FL-MEM, J/FMP
RW, FL-BOTH,J/FMP
R, FL-AC, J/FMPR
I, FL-AC, J/FMPRI
RW, FL-MEM, J/FMPR
RW, FL-BOTH,J/FMPR
.UCODE
.IF/FPLONG
=0****00***0
FMP: SR_#,#/1,J/FMPR ;FLAG TRUNCATE MODE
FMPL: SR_#,#/2,J/FMPR ;LONG MODE
=
.ENDIF/FPLONG
=0****00***0
FMPRI: AR_AR SWAP
FMPR: SC_EXP,EXP_SIGN,ARX_0S ;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.S,J/MULSUB ;AND BEGIN MULTIPLY
=11* FE_#+SC,#/-200,NORM AR,J/SNORM
=
.TOC "SINGLE FLOATING DIVIDE -- FDV, FDVR"
.DCODE
170: R, FL-AC, J/FDV
R, FL-AC, J/FPNO
RW, FL-MEM, J/FDV
RW, FL-BOTH,J/FDV
R, FL-AC, J/FDVR
I, FL-AC, J/FDVRI
RW, FL-MEM, J/FDVR
RW, FL-BOTH,J/FDVR
.UCODE
.IF/FPLONG
=0****00***0
FDVL: FE_EXP-1,EXP_SIGN,ARX+MQ_0.S,J/FDVL1
FDV: SR_#,#/1,J/FDVR ;FLAG TRUNCATE MODE
=
.ENDIF/FPLONG
=0****00***0
FDVRI: AR_AR SWAP
FDVR: SC_EXP+1,EXP_SIGN,ARX+MQ_0.S ;SETUP DIVISOR
=
=000 BR/AR,BRX/ARX, ;DIVISOR TO BR, CLR BRX
AR_AC0,FE_#,#/27., ;GET DIVIDEND, STEP COUNT
SKP AD0,CALL,J/FDVCHK
=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,CLR ARX+MQ
=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, IBP"
;ENTER WITH (E) IN AR
.IF/FPLONG
.DCODE
130: R, J/UFA
RPW, J/DFN
.UCODE
=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
.DCODE
132: I, FL-AC, J/FSC
R, B/6, J/IBP ;ADJBP IF AC .NE. 0
.UCODE
=0****00***0
.IF/ADJBP
.IF/OWGBP
IBP: SKP PC SEC0,J/IBP0 ;[251] CAN IT BE A OWGBP ?
.IFNOT/OWGBP
IBP: SKP AC#0,J/IBP1 ;IS IT IBP, OR ADJBP?
.ENDIF/OWGBP
.IFNOT/ADJBP
IBP: J/IBP2
.ENDIF/ADJBP
;FSC
;ENTER WITH E IN AR
=0****00****
FSC: SC_EA,ARX+MQ_0.M,
AR_AC0,ARL/AD
= FE_EXP+SC,EXP_SIGN,J/SNR2 ;NORMALIZE SCALED RESULT
.IF/OWGBP
=0
IBP0: SC_P-#,#/45,SKP SCAD0,J/IBP3 ;TREAT THIS AS A OWGBP ?
SKP AC#0,J/IBP1 ;IS IT IBP, OR ADJBP?
=0
IBP3: BR/AR,SKP AC#0,J/GIBP ;YES, CHECK FOR ADJBP
SKP AC#0,J/IBP1 ;NO, TREAT AS BEFORE, ADJBP?
.ENDIF/OWGBP
.TOC "FIX, FIXR, FLTR, EXTEND"
.DCODE
122: R, J/FIX ;UNROUNDED
R, J/EXTEND ;EXTENDED INSTRUCTION SET
126: R, J/FIXR ;ROUNDED
R, FL-AC, J/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.
=0****00****
FIXR: FE_EXP-#,#/244,SKP SCAD0, ;GET BINARY POINT POSITION
ARX_1B1,J/FIX1 ;GET ROUNDING CONSTANT
=
=0****00***0
FIX: FE_EXP-#,#/244,SKP SCAD0, ;GET BINARY POINT POSITION
ARX_AR SIGN,J/FIX1 ;SET ROUNDING CONSTANT, GO FIX
.IF/EXTEND
.IFNOT/XADDR
.IF/MODEL.B ;[246]
EXTEND: FE_#+AR0-8,#/-32,SKP SCAD0, ;VALID EXTENDED OPERATION?
ARX_AR,AR_BRX,J/EXT1 ; OPR TO ARX, AC TO AR
.IFNOT/MODEL.B
EXTEND: FE_#+AR0-8,#/-20,SKP SCAD0, ;[246] VALID EXTENDED OPERATION?
ARX_AR,AR_BRX,J/EXT1 ;[246] OPR TO ARX, AC TO AR
.ENDIF/MODEL.B ;[246]
.IF/XADDR
EXTEND: SC_#+AR0-8,#/-32,SKP SCAD0, ;VALID EXTENDED OPERATION?
ARX_AR,AR_BR,J/EXTF1 ; OPR TO ARX, AC TO AR
.ENDIF/XADDR
.IFNOT/EXTEND
EXTEND: AR_BR,J/UUO
.ENDIF/EXTEND
=
;HERE FOR FIX. CONVERT FLOATING TO INTEGER
=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,SC/SCAD,MQ_0.S,
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
.IF/MODEL.B
BR_AR LONG,GEN ARX,SKP AD NE, ;[241]HERE FOR DOUBLE FLT MUL
FE_#,#/-18.,J/DFMP ;[241]BEGIN TEST FOR STICKY BIT
.IFNOT/MODEL.B
AR_AC1,BR_AR LONG, ;HERE FOR DBL FLOATING MUL
FE_#,#/-18.,J/DFMP
.ENDIF/MODEL.B
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
.IF/MODEL.B
=0 AC0_AR,MQ_SHIFT,AR_ARX (ADX),
ARX/MQ,J/DFAS6 ;[241]36 < DIFF < 72
.IFNOT/MODEL.B
=0 AC0_AR,MQ_SHIFT,AR_ARX (ADX),
ARX/MQ,J/DFAS4 ;36 < DIFF < 72
.ENDIF/MODEL.B
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
.IF/MODEL.B
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
.ENDIF/MODEL.B
;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
.IF/MODEL.B
=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
.IFNOT/MODEL.B
=00*
DFMP: MQ_AR,AR_0S,ARX_0S, ;SETUP LOW M'IER
SC_#+SC,#/-200, ;CORRECT EXPONENT
CALL,J/MULREE ;MULTIPLY BY THE LOW PART
.ENDIF/MODEL.B
=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.M, ;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
.IF/MODEL.B
SET SR2,AR_AC1*2,CALL,J/DFDV1 ;NOTE NEG QUO
.IFNOT/MODEL.B
SR_1,AR_AC1*2,CALL,J/DFDV1 ;NOTE NEG QUO
.ENDIF/MODEL.B
=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
.IF/MODEL.B
BR/AR,BRX/ARX,AR_MQ COMP, ;RESULT NEG, MAKE POS
SET SR2,J/DNNEG ;[241]FLAG NEGATIVE
.IFNOT/MODEL.B
BR/AR,BRX/ARX,AR_MQ COMP, ;RESULT NEG, MAKE POS
SR_1,J/DNNEG ;FLAG NEGATIVE
.ENDIF/MODEL.B
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
.IF/MODEL.B
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
.IFNOT/MODEL.B
DNNEG: AR_AR+1,SKP CRY0 ;COMPLETE NEGATION OF MQ
=0 MQ_AR,AR_BR COMP,ARX_BRX COMP,
NORM,J/DNORM ;NORMALIZE THE POS FORM
MQ_AR,AR_-BR,ARX/ADX,NORM,J/DNORM
.ENDIF/MODEL.B
DNHI: (AR+ARX+MQ)*.25,J/DNTRY ;GO TRY AGAIN
=0
DNZERO: SR_0,AR_0S,ARX_0S,J/DBLST ;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
.IF/MODEL.B
=1101 ;[241]
.IFNOT/MODEL.B
=0
.ENDIF/MODEL.B
AC0_AR,AR_SHIFT,ARX_BRX, ;STORE HIGH WORD, READY LOW
I FETCH,J/STD1
.IF/XADDR
ARX_ARX*BRX,AD/ANDCA,SR_0, ;CLEAR ROUNDING BIT
J/CDBLST
.IFNOT/XADDR
ARX_ARX*BRX,AD/ANDCA,SR_0 ;CLEAR ROUNDING BIT
AR_-AR LONG,J/DBLST ;NEGATE RESULT AND STORE
.ENDIF/XADDR