Trailing-Edge
-
PDP-10 Archives
-
klad_sources
-
klad.sources/dfas.mac
There are no other files named dfas.mac in the archive.
SUBTTL DOUBLE PRECISION FLOATING ADD/SUBTRACT
;*FOR KI10 SIMULATION/DIAGNOSTICS 13-OCT-71, J.R.KIRCHOFF
;* 7-DEC-69 /TWE , 14-JULY-70 /JRK
;* DICK GRUEN: 9-SEP-67
;* 7-MAY-66 BEGOT 9-SEP-67 (MACROX Q ERRORS)
;*THESE ROUTINES ADD OR SUBTRACT TWO DOUBLE PRECISION
;*NUMBERS. EACH NUMBER IS COMPOSED OF 8 BITS OF EXPONENT
;*IN THE HI ORDER WORD WITH THE REMAINING 27 HI ORDER BITS
;*AND THE 33 FIRST ARIMETIC BITS OF THE LO ORDER AS THE
;*MANTISSA. THE LAST 2 LO ORDER BITS ARE UNUSED. THE
;*ANSWER IS RETURNED IN AC X, WHERE "X" IS THE DOUBLE PRECISION
;*AC USED AND MAY BE 0. THE ROUTINE IS CALLED BY:
;*FAD: MOVEI Q,ARG2
;* PUSHJ P,DFA.X ;ARG1 IN AC X
;* OR
;*FADM: MOVEI Q,ARG2
;* PUSHJ P,DFAM.X ;ARG1 IN AC X
;* OR
;*FSB: MOVEI Q,ARG2
;* PUSHJ P,DFS.X ;ARG1 IN AC X
;* OR
;*FSBM: MOVEI Q,ARG2
;* PUSHJ P,DFSM.X ;ARG1 IN AC X
;* NOTE THAT THE "X" AFTER THE "." IS A NUMBER
;* AND NOT A LETTER
P==17
Q==16
AC2==10
X2==11
XDIFF==12
AC1==13
X1==15
BIT1==200000
BIT2==100000
BITCRY==1000
BITNEG==1B18
BITEST==3400
SGNAC1==1
SGNAC2==2
DEFINE FSM(A)<
DFSM.'A': SKIPA AC1,Q
DFS.'A': MOVEI AC1,A
IFN A,<
HRLI Q,A
JRST GETNEG
>>
DEFINE FAM(A)<
DFAM.'A': SKIPA AC1,Q
DFA.'A': MOVEI AC1,A
IFN A,<
HRLI Q,A
JRST DFADX
>>
DEFINE DSUB<
FSM 0
>
DEFINE DADD<
FAM 0
>
DEFINE MAKNEG(A)<
SETCM A,A
MOVNS A+1
TDNN A+1,DLOW.0
AOS A
>
DSUB
GETNEG: PUSH P,AC1 ;ALL SUBTRACTS ENTER HERE
MOVN AC1+1,1(Q) ;PICKUP NEGATIVE OF MEM ARG
SETCM AC1,0(Q)
TDNN AC1+1,DLOW.0
AOJA AC1,DFSBX
JRST DFSBX
DADD
DXFAD: PUSH P,AC1 ;ALL ADDS ENTER HERE
MOVE AC1,0(Q) ;GET MEMORY ARGUMENT
MOVE AC1+1,1(Q) ;...
DFSBX: MOVSS Q ;SWAP ARGUMENT POINTERS
SKIPN AC2,0(Q) ;GET HI ORDER OF AC ARG
JRST OVTM1 ;IF 0, AC1 HAS THE SUM
JUMPN AC1,GA ;IF AC1 NON ZERO, PERFORM ADD
MOVE AC1,AC2 ;AC1=0 MEANS AC ARG IS ANSWER
MOVE AC1+1,1(Q) ;RETURN IT TO EITHER AC OR MEM
JRST OVTM1 ;...
GA:! LDB X1,DPAC.1 ;ARG1 EXP AND SIGN
LDB X2,DPAC.2 ;ARG2 EXP AND SIGN
SKIPG AC1 ;MAKE EXPS +
ANDCAI X1,777 ;...
SKIPG AC2 ;...
ANDCAI X2,777 ;...
MOVE XDIFF,X2 ;GET EXP DIFFERENCE
SUB XDIFF,X1 ;...
SKIPLE XDIFF ;SAVE HIGHER EXP
AOS X1,X2 ;SAVED IN X1
MOVE AC2+1,1(Q) ;GET LO ORDER OF AC ARG
TLZ Q,SGNAC1+SGNAC2 ;MARK SIGNS BEFORE SHIFT
JUMPGE AC1,AC1PL ;SKIP HAIR IF AC1 +
TLO Q,SGNAC1 ;MARK SIGN = -
MAKNEG AC1
AC1PL:! JUMPGE AC2,AC2PL ;SKIP HAIR IF AC2 = +
TLO Q,SGNAC2 ;MARK SIGN = -
MAKNEG AC2
AC2PL:! TLZ AC1,777000 ;REMOVE EXPS
TLZ AC2,777000 ;...
JUMPLE XDIFF,SHFT2 ;SHIFT ARG2
MOVNS XDIFF ;SHIFF ARG1 RIGHT
ASHC AC1,(XDIFF) ;UNORMALIZE ARG1
CADD:! TLNN Q,SGNAC1 ;WAS AC1 =-?
JRST AC1WPL ;NO, SKIP RECOMPL
TLNE Q,SGNAC2 ;IF BOTH WERE NEG,...
JRST BOTHN ;DON'T RECOMPL EITHER
MAKNEG AC1
AC1WPL:!TLNN Q,SGNAC2 ;WAS AC2=-?
JRST AC2WPL ;NO, SKIP RECOMPL
MAKNEG AC2
AC2WPL:!TLZ AC1,477000 ;SET TESTABLE BITS
TLZ AC2,477000 ;TURN OTHERS OFF
JCRY1 .+1 ;TURN OFF OVFLO FLAG
ADD AC1+1,AC2+1 ;LO ORDER ADD
JCRY1 [AOJA AC1,TADD] ;ADD IN HI ORDER CARRY
TADD:! ADD AC1,AC2 ;HI ORDER ADD
TLNE AC1,BIT2 ;IS CARRY BIT TRUE
TLC AC1,BITCRY ;NO, COMPL. IT
TLZN AC1,BIT1 ;IS SUM -
JRST NORMA ;NO ON FIRST GLANCE
TLZE AC1,BIT2 ;...
TLNE AC1,BITCRY ;...
PUSHJ P,NEG1 ;SUM=-,GO MAKE IT +
MLON
D.DORM: ;ENTRY FOR DFDV
NORMA:! TRO X1,200000 ;PROTECT AGAINST BORROWS FROM BITNEG
TLNN AC1,1000 ;SKIP UNNORM IF NOT NEEDED
SOSA X1 ;BUT TELL THE EXPONENT ABOUT IT
ASHC AC1,-1 ;THERE WAS SOMETHING THERE
D.MORM: TRO X1,200000 ;PROTECT AGAINST BORROWS FROM BITNEG
TLZ AC1,777000 ;NO STRAY BITS
JUMPN AC1,LOOPA+1 ;CHECK FOR ZERO
TDNN AC1+1,DLOW.0 ;...
JRST 2,@[XWD 0,RET0] ;RETURN ZERO ANSWER
SKIPA ;ENTER NORMALIZE ROUTINE
LOOPA:! ASHC AC1,1 ;1 BIT NORMALIZE
TLNN AC1,400 ;IS NORMALIZE DONE?
SOJA X1,LOOPA ;IF NOT, SUB1 FROM EXP
TRNE X1,BITEST ;DID FP OV/UNDER FLO OCCUR?
JRST [TRNN X1,040000 ;UNDERFLOW?
JRST OVTM2 ;NO, OVERFLOW
JRST UFLOW] ;YES
TRZE X1,BITNEG ;SHOULD ANS BE -
PUSHJ P,NEG2 ;GO MAKE IT SO
DPB X1,DPAC.1 ;STORE EXP AND SIGN
OVTM1:! JRST 2,@[OVTA] ;CLEAR AR FLAGS
OVTM2:! TRZ X1,400
TRZE X1,BITNEG ;SHOULD ANS BE -
PUSHJ P,NEG2 ;GO MAKE IT SO
DPB X1,DPAC.1 ;STORE EXPONENT AND SIGN
JRST 2,@[XWD 440200,OVTA]
D.ZERO: ;ENTRY FOR ZERO ANSWER
RET0:! SETZB AC1,AC1+1 ;RETURN ANS=0
OVTA:! POP P,Q ;RESTORE AC Q
MOVEM AC1,0(Q) ;STORE HI ORDER ANS
TLZ AC1+1,400000 ;SET LO SIGN = +
MOVEM AC1+1,1(Q) ;STORE LO ORDER ANS
POPJ P, ;TRA 1,4
UFLOW:! TRZ X1,400
TRZE X1,BITNEG
PUSHJ P,NEG2
DPB X1,DPAC.1
JRST 2,@[XWD 440300,OVTA]
DPAC.1: POINT 9,AC1,8
DPAC.2: POINT 9,AC2,8
DLOW.0: OCT 377777777777
D.NORM: PUSH P, Q ;SAVE AC Q
JRST D.MORM ;ENTER COMMON ROUTINE
SHFT2:! ASHC AC2,0(XDIFF) ;UNNORMALIZE ARG2
AOJA X1,CADD ;INDICATE UNNORMALIZATION
NEG2:! ANDCAI X1,777 ;MAKE EXP -
NEG1:! TRO X1,BITNEG ;SET MARKER FOR -
MOVNS AC1+1 ;TWOS COMPL
SETCMM AC1 ;...
TDNN AC1+1,DLOW.0 ;...
AOS AC1 ;...
POPJ P, ;RETURN
BOTHN:! TRO X1,BITNEG ;SINCE BOTH WERE NEG, ANS ...
JRST AC2WPL ;MUST BE NEG