Trailing-Edge
-
PDP-10 Archives
-
BB-4157E-BM
-
fortran-compiler/cnstcm.mac
There are 12 other files named cnstcm.mac in the archive. Click here to see a list.
TITLE CNSTCM - CONSTANT COMBINE MODULE
SUBTTL S. MURPHY/SRM/HPW/NEA/HPW/SJW/DCE/TFV
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1972,1981 BY DIGITAL EQUIPMENT CORPORATION
INTERN CNSTCV
CNSTCV= BYTE (3)0(9)6(6)0(18)^D72 ; Version Date: 24-Jul-81
SUBTTL Revision History
Comment \
***** Begin Revision History *****
54 ----- ----- FIX CONVERSION OF LITERALS
55 ----- ----- ADD CONVERSION ROUTINE TO
CMPLX WITH CONSTANT ARGUMENTS
AT KILFBR+1
56 ----- ----- ADD ROUTINES TO FOLD INTEGER EXPONENTIATION
57 ----- ----- ADD SPECIFIC DISPATCH KDPINT FOR REAL TO INTEGER
TRUNCATION
58 ----- ----- PATCH CALL TO WARNERR
59 ----- ----- ADD CODE FOR INLINE DABS
60 ----- ----- ADD CODE FOR SQUARE OF DP
61 ----- ----- ADD CODE FOR EXPONEN OF DP
62 ----- ----- REMOVE CODE FOR SQUARE,CUBE,P4 (THEY ARE NOW
ALL UNDER EXPCIOP)
63 ----- ----- FIX BUG IN "EXPRL" (REAL NUMBER TO INTEGER
POWER) -WHEN CALL KADPML, C1H-C1L MUST
CONTAIN THE FIRST ARG TO BE MULTIPLIED
64 ----- ----- IN "EXPINT" AND "EXPRL" MUSTCHECK FOR THE
POWER EQUAL TO 0 (AND SET RESULT TO 1 IN
THAT CASE)
65 275 ----- FOR FLOATING UNDEFLOW, CHECK UNDERFLOW AND NOT
OVERFLOW + DIVIDE CHECK BECAUSE OVERFLOW IS SET, (JNT)
***** Begin Version 5 *****
66 413 ----- DON'T USE FADL IN INTDP IF NOT ON KA10
***** Begin Version 5A *****
67 606 22795 CATCH ALL OVERFLOWS AND UNDERFLOWS IN EXPRL, (DCE)
***** Begin Version 6 *****
68 761 TFV 1-Mar-80 -----
Remove all KA tables and add /GFLOATING tables.
Clean up everything
69 1006 TFV 1-Jul-80 ------
Add code for specops (p2mul, p2div, p21mul) for reals and dp
70 1025 TFV 21-Nov-80 ------
Fix conversion of reals to logical under GFLOATING.
Just taking the high order word losses.
71 1030 TFV 25-Nov-80 ------
Fix GFLOATING DP conversion to INT. Truncate don't round.
72 1031 TFV 25-Nov-80 ------
Fix ABS of GFLOATING reals. Use DABS routine since low word has some
mantissa bits for the SP representation
***** End Revision History *****
\
SUBTTL COMBIND CONSTANTS
HISEG
;TO COMBINE CONSTANTS AT RUN TIME
;CALLED WITH THE GLOBALS
; C1H - HIGH ORDER WD OF 1ST CONSTANT
; C1L - LOW ORDER WD OF 1ST CONSTANTS
; C2H - HIGH ORDER WD OF 2ND CONSTNT (HIGH ORDER WD OF RESULT
; IS LEFT HERE)
; C2L - LOW ORDER WD OF 2ND CONSTANT (LOW ORDER WD OF RESULT IS
; LEFT HERE)
; COPRIX - TABLE INDEX FOR OPERATION TO BE PERFORMED
; FOR ARITH OPERATIONS - 2 BITS FOR OP FOLLOWED
; BY 2 BITS FOR VALUE-TYPE
; FOR TYPE CONVERSIONS - "KTYPCB" (BASE IN TABLE FOR TYPE
; CONV) PLUS 2 BITS FOR SOURCE TYPE FOLLOWED
; BY 2 BITS FOR DESTINATION TYPE
; FOR BOOLEAN OPERATIONS - "KBOOLB" (BASE IN TABLE FOR
; BOOLEANS) PLUS 2 BITS SPECIFYING
; THE OPERATION
;
SEARCH GFOPDF ;[761] OPDEFS FOR GFLOAT INSTRUCTIONS
ENTRY CNSTCM
EXTERN SKERR,C1H,C1L,C2H,C2L,COPRIX
INTERN KDPINT ;REAL TO INTEGER TRUNCATION
INTERN KGFINT ;[761] REAL TO INTEGER TRUNCATION
INTERN KARIIB ;BASE FOR ARITH OPERATIONS FOR KI10
INTERN KARIGB ;[761] BASE FOR GFLOATING ARITH OPS
INTERN KBOOLB,KDNEGB,KILFBA,KILFBR,KILFBG
INTERN KTYPCB,KTYPCG,KSPECB,KSPECG ;[761] type conversions
INTERN KDPRL,KGFRL ;[761] TO ROUND A DOUBLE-WD REAL DOWN TO A
; SINGLE WD OF PRECISION. USED ONLY WITH THE
; OPTIMIZER
INTERN KGFSPR ;[761] to round /GFLOATING to SP accuracy
; keeping /GFLOATING format
INTERN KILDAB ;TO FOLD DABS
SREG=17 ;STACK REG
FLGREG=0 ;FLAGS REGISTER
RH=4 ;HIGH ORDER WD OF RESULT DEVELOPED
; INTO THIS REG
RL=5 ;LOW ORDER WD OF RESULT DEVELOPED
; INTO THIS REG
RGDSP=6 ;INDEX INTO TABLE OF OPERATIONS
; INDICATING OPERATION TO BE PERFORMED
T=7 ;REGISTER USED AS A TEMPORARY
F1=201400 ;FLOATING POINT ONE
G1=200140 ;[761] GFLOATING 1.0
CNSTCM: JRSTF @[0,,.+1] ;CLEAR FLAGS FOR OVERFLOW AND UNDERFLOW
MOVE RH,C1H ;LOW HIGH ORDER 1ST CONSTANT
MOVE RL,C1L ;LOW LOW ORDER 1ST CONSTANT
HRRZ RGDSP,COPRIX ;LOAD INDEX
XCT 0(RGDSP) ;PERFORM DESIRED OPERATION
JSP T,.+1 ;LOAD FLAGS INTO T
TLNE T,440140 ;IF OVERFLOW,UNDERFLOW,OR DIVIDE CHECK IS
PUSHJ SREG,OVFLW ;SET, GO HANDLE THE OVERFLOW
MOVEM RH,C2H ;RETURN RESULTS IN GLOBALS
MOVEM RL,C2L ;C2H AND C2L
POPJ SREG, ;RETURN
;TABLE OF OPERATIONS TO BE PERFORMED
;CODE FOR EACH OPERATION IS IDENTICAL TO THE CODE THAT WOULD BE
;EXECUTED AT RUN-TIME.
;
;
;ARITH OPERATIONS
; NOGFLOATING - Clean up table
KARIIB: ADD RL,C2L
DFAD RH,C2H ;[761]
DFAD RH,C2H ;[761]
PUSHJ SREG,CMPADD
SUB RL,C2L
DFSB RH,C2H ;[761]
DFSB RH,C2H ;[761]
PUSHJ SREG,CMPSUB
IMUL RL,C2L
DFMP RH,C2H ;[761]
DFMP RH,C2H ;[761]
PUSHJ SREG,CMPMUL
IDIV RL,C2L
DFDV RH,C2H ;[761]
DFDV RH,C2H ;[761]
PUSHJ SREG,CMPDIV
;ARITH OPERATIONS
; GFLOATING [761]
KARIGB: ADD RL,C2L ;[761]
GFAD RH,C2H ;[761]
GFAD RH,C2H ;[761]
PUSHJ SREG,CMPADD ;[761]
SUB RL,C2L ;[761]
GFSB RH,C2H ;[761]
GFSB RH,C2H ;[761]
PUSHJ SREG,CMPSUB ;[761]
IMUL RL,C2L ;[761]
GFMP RH,C2H ;[761]
GFMP RH,C2H ;[761]
PUSHJ SREG,CMPMUL ;[761]
IDIV RL,C2L ;[761]
GFDV RH,C2H ;[761]
GFDV RH,C2H ;[761]
PUSHJ SREG,CMPDIV ;[761]
;
; FOR TYPE CONVERSIONS
; NOGFLOATING
KTYPCB=.
; FROM OCTAL/LOGICAL
JFCL ;TO OCTAL/LOGICAL
PUSHJ SREG,SKERR ;TO CONTROL (SHOULD NEVER OCCUR)
PUSHJ SREG,OCTRL ;TO DOUBLE-OCTAL - THIS WD BECOMES HIGH WD
PUSHJ SREG,OCTRL ;TO LITERAL - THIS WD IS HIGH WD
JFCL ;TO INTEGER
PUSHJ SREG,OCTRL ;TO REAL
PUSHJ SREG,OCTRL ;TO DOUBLE-PREC
PUSHJ SREG,OCTRL ;TO COMPLEX
; FROM CONTROL
JFCL ;TO OCTAL
JFCL ;TO CONTROL
PUSHJ SREG,OCTRL ;TO DOUBLE-OCTAL
PUSHJ SREG,OCTRL ;TO LITERAL
JFCL ;TO INTEGER
PUSHJ SREG,OCTRL ;TO REAL - MUST MOVE CONST2 TO CONST1
PUSHJ SREG,OCTRL ;TO DOUBLE-PREC
PUSHJ SREG,OCTRL ;TO COMPLEX
; FROM DOUBLE-OCTAL
PUSHJ SREG,DOCTIN ;TO LOGICAL - USE HIGH WD ONLY,SET OVFLW
PUSHJ SREG,DOCTIN ;TO CONTROL
JFCL ;TO DOUBLE-OCTAL
JFCL ;TO LITERAL
PUSHJ SREG,DOCTIN ;TO INTEGER
JFCL ;TO REAL
JFCL ;TO DOUBLE-PREC
JFCL ;TO COMPLEX
; FROM LITERAL
PUSHJ SREG,LITINT ;TO LOGICAL - USE HIGH WD ONLY
PUSHJ SREG,LITINT ;TO CONTROL
PUSHJ SREG,LITTWD ;TO DOUBLE-OCTAL (COMPLEX/DOUBLE PRECISION)
JFCL ;TO LITERAL
PUSHJ SREG,LITINT ;TO INTEGER
PUSHJ SREG,LITRL ;TO REAL
PUSHJ SREG,LITTWD ;TO DOUBLE PREC
PUSHJ SREG,LITTWD ;TO COMPLEX
; FROM INTEGER
JFCL ;TO LOGICAL
JFCL ;TO CONTROL
PUSHJ SREG,SKERR ;TO DOUBLE-OCTAL - SHOULD NEVER OCCUR
PUSHJ SREG,SKERR ;TO LITERAL - SHOULD NEVER OCCUR
JFCL
PUSHJ SREG,INTDP ;TO REAL
PUSHJ SREG,INTDP ;TO DOUBLE PRECISION
PUSHJ SREG,INTCM ;TO COMPLEX
; FROM REAL
PUSHJ SREG,RLLOG ;TO LOGICAL
PUSHJ SREG,RLLOG ;TO CONTROL
PUSHJ SREG,SKERR ;TO DOUBLE-OCTAL (SHOULD NEVER OCCUR)
PUSHJ SREG,SKERR ;TO LITERAL (SHOULD NEVER OCCUR)
KDPINT: PUSHJ SREG,DPINT ;TO INTEGER (SAME AS FROM DOUBLE-PREC)
JFCL
JFCL ;TO DOUBLE PREC (SINCE REAL KEPT 2 WDS OF PREC)
PUSHJ SREG,DPCM ;TO COMPLEX - ROUND AND USE HIGH WD
; FROM DOUBLE PREC
PUSHJ SREG,RLLOG ;TO LOGICAL - USE HIGH WD ONLY
PUSHJ SREG,RLLOG ;TO CONTROL
PUSHJ SREG,SKERR ;TO DOUBLE-OCTAL (SHOULD NEVER OCCUR)
PUSHJ SREG,SKERR ;TO LITERAL (SHOULD NEVER OCCUR)
PUSHJ SREG,DPINT
JFCL ;TO REAL - KEEP SAME 2 WDS OF PREC
JFCL ;DOUBLE-PREC TO DOUBLE-PREC
PUSHJ SREG,DPCM ;DOUBLE-PREC TO COMPLEX-USE HIGH ORDER WD
; FROM COMPLEX
PUSHJ SREG,RLLOG ;TO LOGICAL - USE REAL PART ONLY
PUSHJ SREG,RLLOG ;TO CONTROL
PUSHJ SREG,SKERR ;TO DOUBLE-OCTAL (SHOULD NEVER OCCUR)
PUSHJ SREG,SKERR ;TO LITERAL (SHOULD NEVER OCCUR)
PUSHJ SREG,CMINT ;TO INTEGER - CONVERT REAL PART
MOVEI RL,0 ;TO REAL - USE HIGH WD ONLY
MOVEI RL,0 ;COMPLEX TO DOUBLE-PREC- USE HIGH ORDER WD
JFCL ;COMPLEX TO COMPLEX
; FOR TYPE CONVERSIONS [761]
; GFLOATING
KTYPCG=.
; FROM OCTAL/LOGICAL
JFCL ;[761] TO OCTAL/LOGICAL
PUSHJ SREG,SKERR ;[761] TO CONTROL (SHOULD NEVER OCCUR)
PUSHJ SREG,OCTRL ;[761] TO DOUBLE-OCTAL - THIS WD BECOMES HIGH WD
PUSHJ SREG,OCTRL ;[761] TO LITERAL - THIS WD IS HIGH WD
JFCL ;[761] TO INTEGER
PUSHJ SREG,OCTRL ;[761] TO REAL
PUSHJ SREG,OCTRL ;[761] TO DOUBLE-PREC
PUSHJ SREG,OCTRL ;[761] TO COMPLEX
; FROM CONTROL
JFCL ;[761] TO OCTAL
JFCL ;[761] TO CONTROL
PUSHJ SREG,OCTRL ;[761] TO DOUBLE-OCTAL
PUSHJ SREG,OCTRL ;[761] TO LITERAL
JFCL ;[761] TO INTEGER
PUSHJ SREG,OCTRL ;[761] TO REAL - MUST MOVE CONST2 TO CONST1
PUSHJ SREG,OCTRL ;[761] TO DOUBLE-PREC
PUSHJ SREG,OCTRL ;[761] TO COMPLEX
; FROM DOUBLE-OCTAL
PUSHJ SREG,DOCTIN ;[761] TO LOGICAL - USE HIGH WD ONLY,SET OVFLW
PUSHJ SREG,DOCTIN ;[761] TO CONTROL
JFCL ;[761] TO DOUBLE-OCTAL
JFCL ;[761] TO LITERAL
PUSHJ SREG,DOCTIN ;[761] TO INTEGER
JFCL ;[761] TO REAL
JFCL ;[761] TO DOUBLE-PREC
JFCL ;[761] TO COMPLEX
; FROM LITERAL
PUSHJ SREG,LITINT ;[761] TO LOGICAL - USE HIGH WD ONLY
PUSHJ SREG,LITINT ;[761] TO CONTROL
PUSHJ SREG,LITTWD ;[761] TO DOUBLE-OCTAL (COMPLEX/DOUBLE PRECISION)
JFCL ;[761] TO LITERAL
PUSHJ SREG,LITINT ;[761] TO INTEGER
PUSHJ SREG,LITRL ;[761] TO REAL
PUSHJ SREG,LITTWD ;[761] TO DOUBLE PREC
PUSHJ SREG,LITTWD ;[761] TO COMPLEX
; FROM INTEGER
JFCL ;[761] TO LOGICAL
JFCL ;[761] TO CONTROL
PUSHJ SREG,SKERR ;[761] TO DOUBLE-OCTAL - SHOULD NEVER OCCUR
PUSHJ SREG,SKERR ;[761] TO LITERAL - SHOULD NEVER OCCUR
JFCL
PUSHJ SREG,INTGF ;[761] TO REAL
PUSHJ SREG,INTGF ;[761] TO DOUBLE PRECISION
PUSHJ SREG,INTCM ;[761] TO COMPLEX
; FROM REAL
PUSHJ SREG,GRLLOG ;[1025] TO LOGICAL
PUSHJ SREG,GRLLOG ;[1025] TO CONTROL
PUSHJ SREG,SKERR ;[761] TO DOUBLE-OCTAL (SHOULD NEVER OCCUR)
PUSHJ SREG,SKERR ;[761] TO LITERAL (SHOULD NEVER OCCUR)
KGFINT: PUSHJ SREG,GFINT ;[761] TO INTEGER (SAME AS FROM DOUBLE-PREC)
JFCL ;[761]
JFCL ;[761] TO DOUBLE PREC (SINCE REAL KEPT 2 WDS OF PREC)
PUSHJ SREG,GFCM ;[761] TO COMPLEX - ROUND AND USE HIGH WD
; FROM DOUBLE PREC
PUSHJ SREG,RLLOG ;[761] TO LOGICAL - USE HIGH WD ONLY
PUSHJ SREG,RLLOG ;[761] TO CONTROL
PUSHJ SREG,SKERR ;[761] TO DOUBLE-OCTAL (SHOULD NEVER OCCUR)
PUSHJ SREG,SKERR ;[761] TO LITERAL (SHOULD NEVER OCCUR)
PUSHJ SREG,GFINT
JFCL ;[761] TO REAL - KEEP SAME 2 WDS OF PREC
JFCL ;[761] DOUBLE-PREC TO DOUBLE-PREC
PUSHJ SREG,GFCM ;[761] DOUBLE-PREC TO COMPLEX-USE HIGH ORDER WD
; FROM COMPLEX
PUSHJ SREG,RLLOG ;[761] TO LOGICAL - USE REAL PART ONLY
PUSHJ SREG,RLLOG ;[761] TO CONTROL
PUSHJ SREG,SKERR ;[761] TO DOUBLE-OCTAL (SHOULD NEVER OCCUR)
PUSHJ SREG,SKERR ;[761] TO LITERAL (SHOULD NEVER OCCUR)
PUSHJ SREG,CMINT ;[761] TO INTEGER - CONVERT REAL PART
EXTEND RH,[GDBLE RH] ;[761] TO REAL - USE HIGH WD ONLY
EXTEND RH,[GDBLE RH] ;[761] COMPLEX TO DOUBLE-PREC- USE HIGH ORDER WD
JFCL ;[761] COMPLEX TO COMPLEX
;
;TO ROUND A DOUBLE-WD REAL TO A SINGLE WORD. USED WITH THE OPTIMIZER
; FOR THE CASE:
; R=5.4
; DP=R
; SO THAT WHEN THE CONSTANT 5.4 IS PROPAGATED, ONLY ONE WORD OF
; PRECISION WILL BE PROPAGATED
KDPRL: PUSHJ SREG,DPCM ;USE SAME ROUTINE AS IS USED FOR
; CONVERTING DOUBLE-WD REAL TO COMPLEX
KGFRL: PUSHJ SREG,GFCM ;[761]
;[761] Round /GFLOATING DP to SP precision without changing the form
KGFSPR: PUSHJ SREG,GFSPR ;[761]
GFSPR: EXTEND RH,[GSNGL RH] ;[761] first convert to SP
MOVEI RL,0 ;[761] zero second word
EXTEND RH,[GDBLE RH] ;[761] convert back to DP format
POPJ SREG, ;[761] return
;
;
;
;
;
;FOR BOOLEAN OPS - ALWAYS PERFORMED ON ONE WD ONLY
KBOOLB=.
AND RL,C2L
OR RL,C2L
EQV RL,C2L
XOR RL,C2L
;
;
;FOR NEGATION OF DOUBLE-PREC CONSTANTS (NOTE THAT ALL CONSTANTS ARE
; STORED IN KI10 FORMAT
KDNEGB=.
DMOVN RH,RH ;FOR COMPILATION ON KI10
;OPERATIONS THAT TAKE MORE THAN 1 INSTR
;
;COMPLEX ARITHMETIC
;
;COMPLEX ADD
CMPADD: FADR RH,C2H
FADR RL,C2L
POPJ SREG,
;
;COMPLEX SUBTRACT
CMPSUB: FSBR RH,C2H
FSBR RL,C2L
POPJ SREG,
;
;COMPLEX MULTIPLY
CMPMUL: PUSHJ SREG,SKERR ;DO NOT FOLD COMPLEX MULTIPLICATION
;
;COMPLEX DIVIDE
CMPDIV: PUSHJ SREG,SKERR ;DO NOT FOLD COMPLEX DIVISION
;
;FOR FOLDING OF SPECIAL-OPS (P2MUL,P2DIV,PLPL1MUL,EXPCIOP
;NOGFLOATING
KSPECB: PUSHJ SREG,P2MI
PUSHJ SREG,P2MR ;[1006]
PUSHJ SREG,P2MR ;[1006]
PUSHJ SREG,P2MC
;
PUSHJ SREG,P2DI
PUSHJ SREG,P2DR ;[1006]
PUSHJ SREG,P2DR ;[1006]
PUSHJ SREG,P2DC
;
PUSHJ SREG,P21MI
PUSHJ SREG,P21MR ;[1006]
PUSHJ SREG,P21MR ;[1006]
PUSHJ SREG,P21MC
;
; UNUSED OPERSP (FORMERLY USED FOR SQUARE)
PUSHJ SREG,SKERR
PUSHJ SREG,SKERR
PUSHJ SREG,SKERR
PUSHJ SREG,SKERR
;
; UNUSED OPERSP (FORMERLY USED FOR CUBE)
PUSHJ SREG,SKERR
PUSHJ SREG,SKERR
PUSHJ SREG,SKERR
PUSHJ SREG,SKERR
;
; UNUSED OPERSP (FORMERLY USED FOR POWER OF 4)
PUSHJ SREG,SKERR
PUSHJ SREG,SKERR
PUSHJ SREG,SKERR
PUSHJ SREG,SKERR
;
;
;FOR INTEGER EXPONENTIATION
PUSHJ SREG,EXPINT
PUSHJ SREG,EXPRL
PUSHJ SREG,EXPRL
PUSHJ SREG,SKERR
;GFLOATING [761]
KSPECG: PUSHJ SREG,P2MI ;[761]
PUSHJ SREG,P2MG ;[761]
PUSHJ SREG,P2MG ;[761]
PUSHJ SREG,P2MC ;[761]
;
PUSHJ SREG,P2DI ;[761]
PUSHJ SREG,P2DG ;[761]
PUSHJ SREG,P2DG ;[761]
PUSHJ SREG,P2DC ;[761]
;
PUSHJ SREG,P21MI ;[761]
PUSHJ SREG,P21MG ;[761]
PUSHJ SREG,P21MG ;[761]
PUSHJ SREG,P21MC ;[761]
;
; UNUSED OPERSP (FORMERLY USED FOR SQUARE)
PUSHJ SREG,SKERR ;[761]
PUSHJ SREG,SKERR ;[761]
PUSHJ SREG,SKERR ;[761]
PUSHJ SREG,SKERR ;[761]
;
; UNUSED OPERSP (FORMERLY USED FOR CUBE)
PUSHJ SREG,SKERR ;[761]
PUSHJ SREG,SKERR ;[761]
PUSHJ SREG,SKERR ;[761]
PUSHJ SREG,SKERR ;[761]
;
; UNUSED OPERSP (FORMERLY USED FOR POWER OF 4)
PUSHJ SREG,SKERR ;[761]
PUSHJ SREG,SKERR ;[761]
PUSHJ SREG,SKERR ;[761]
PUSHJ SREG,SKERR ;[761]
;
;
;FOR INTEGER EXPONENTIATION
PUSHJ SREG,EXPINT ;[761]
PUSHJ SREG,EXPGF ;[761]
PUSHJ SREG,EXPGF ;[761]
PUSHJ SREG,SKERR ;[761]
P2MI: MOVE T,C2L
ASH RL,0(T)
POPJ SREG,
;
P2MR: SKIPA RH,C2L ;[1006]
P2DR: MOVN RH,C2L ;[1006]
ASH RH,^D27 ;[1006]
ADD RH,[201400,,0] ;[1006]
SETZ RL, ;[1006]
DFMP RH,C1H ;[1006]
POPJ SREG, ;[1006]
;
P2MG: MOVE T,C2L ;[761]
EXTEND RH,[GFSC 0,0(T)] ;[761]
POPJ SREG, ;[761]
;
P2MC: MOVE T,C2L
FSC RH,0(T)
FSC RL,0(T)
POPJ SREG,
;
P2DI: JUMPGE RL,P2DI1 ;FOR A DIVIDING A NEGATIVE CONST
; BY 2**N BY DOING A RIGHT SHIFT
MOVEI T,1 ; MUST ADD IN 2**N -1. MUST COMPUTE
ASH T,@C2L ; 2**N
SUBI T,1 ; MINUS ONE
ADD RL,T ;THEN ADD IT TO THE NEG CONST
P2DI1: MOVN T,C2L ;GET NEG OF THE POWER - TOSHIFT RIGHT
ASH RL,0(T) ;SHIFT RIGHT N PLACES
POPJ SREG,
;
P2DG: MOVN T,C2L ;[761]
EXTEND RH,[GFSC 0,0(T)] ;[761]
POPJ SREG, ;[761]
;
P2DC: MOVN T,C2L
FSC RH,0(T)
FSC RL,0(T)
POPJ SREG,
;
P21MI: MOVE T,C2L
ASH RL,0(T)
ADD RL,C1L
POPJ SREG,
;
P21MR: MOVE RH,C2L ;[1006]
ASH RH,^D27 ;[1006]
ADD RH,[201400,,0] ;[1006]
SETZ RL, ;[1006]
DFMP RH,C1H ;[1006]
DFAD RH,C1H ;[1006]
POPJ SREG, ;[1006]
;
P21MG: MOVE T,C2L ;[761]
EXTEND RH,[GFSC 0,0(T)] ;[761]
GFAD RH,C1H ;[761]
POPJ SREG, ;[761]
;
P21MC: MOVE T,C2L
FSC RH,0(T)
FADR RH,C1H
FSC RL,0(T)
FADR RL,C1L
POPJ SREG,
;
;
;
;RAISE TO AN ARBITRARY INTEGER POWER
EXPINT: SKIPN T,C2L ;CHECK FOR POWER=0
JRST EXPIN0 ; IF SO RETURN 1
MOVEM T,C2H ;STORE POWER SOMEWHERE FOR COMPARE
SETZ RH, ;NOTHING BACK IN HIGH ORDER
EXPIN1: TRNN T,777776 ;BITS OTHER THAN 1
JRST EXPIN2 ;NO
ROT T,-1 ;CYCLE
JRST EXPIN1 ;TRY AGAIN
EXPIN2: CAMN T,C2H ;ANOTHER POWER
POPJ SREG, ;DONE
ROT T,1 ;CYCLE
IMUL RL,RL ;MULTIPLY BY POWER
TRNE T,1 ;BY NUMBER ITSELF?
IMUL RL,C1L ;YES
JRST EXPIN2 ;ITERATE
;
EXPIN0: MOVEI RL,1 ;IF POWER=0, RETURN 1
POPJ SREG,
;
;RAISE A REAL (OR DOUBLE PREC ) TO AN ARBITRARY INTEGER POWER
EXPRL: SKIPN T,C2L ;CHECK FOR POWER=0
JRST EXPRL0 ;IF SO RETURN 1.0
PUSH SREG,C1H ;COPY ORIGINAL NUMBER
PUSH SREG,C1L
PUSH SREG,T ;SAVE POWER FOR COMPARE
EXPRL1: TRNN T,777776 ;ONLY 1 LEFT
JRST EXPRL2 ;NO
ROT T,-1 ;SHIFT A BIT
JRST EXPRL1 ;CONTINUE TIL DONE
EXPRL2: MOVEM RH,C2H ;STORE
MOVEM RL,C2L ;STORE
CAMN T,0(SREG) ;DONE
JRST EXPRL3 ;YES
ROT T,1 ;GET A BIT
PUSH SREG,T ;PRESERVE OVER CALL
MOVEM RH,C1H ;(WHEN CALL KADPML, C1H-C1L MUST CONTAIN
; ARG1)
MOVEM RL,C1L
DFMP RH,C2H ;MULTIPLY RH/RL BY C2H/C2L
;RESULT COMES BACK IN RH/RL
;(C1H/C1L IS CLOBBERED)
;TEST FOR OVERFLOW/UNDERFLOW AND GET OUT IF THERE IS.
JSP T,.+1 ; USE T AS TEMP FOR FLAGS
TLNE T,440140 ; TEST FOR TROUBLE!
JRST EXPRL4 ; TIME TO GET OUT
POP SREG,T ;RESTORE
TRNN T,1 ;ANOTHER MULTIPLY NEEDED
JRST EXPRL2 ;NO - STORE AND ITERATE
PUSH SREG,T ;NEED T FOR COPY
MOVE T,-3(SREG) ;GET ORIGINAL NUMBER
MOVEM T,C2H ;STORE IT
MOVE T,-2(SREG) ;GET ORIGINAL NUMBER
MOVEM T,C2L ;STORE IT
MOVEM RH,C1H ;NUMBER TO BE MULTIPLIED
MOVEM RL,C1L
DFMP RH,C2H ;MULTIPLY
JSP T,.+1 ; USE T AS TEMP FOR FLAGS
TLNE T,440140 ; TEST FOR TROUBLE!
JRST EXPRL4 ; TIME TO GET OUT
POP SREG,T ;RESTORE T
JRST EXPRL2 ;REPEAT
EXPRL4: POP SREG,T ; RESTORE T
; THIS IS OVERFLOW/UNDERFLOW EXIT
EXPRL3: POP SREG,0(SREG) ;FIX STACK
POP SREG,0(SREG)
POP SREG,0(SREG)
POPJ SREG, ;DONE
;
;IF POWER IS 0
EXPRL0: MOVSI RH,F1 ;SET HI WD TO FLOATING PT 1
MOVEI RL,0 ; LO WD TO 0
POPJ SREG, ;RETURN
;[761] RAISE A REAL (OR DOUBLE PREC ) TO AN ARBITRARY INTEGER POWER
EXPGF: SKIPN T,C2L ;[761] CHECK FOR POWER=0
JRST EXPGF0 ;[761] IF SO RETURN 1.0
PUSH SREG,C1H ;[761] COPY ORIGINAL NUMBER
PUSH SREG,C1L ;[761]
PUSH SREG,T ;[761] SAVE POWER FOR COMPARE
EXPGF1: TRNN T,777776 ;[761] ONLY 1 LEFT
JRST EXPGF2 ;[761] NO
ROT T,-1 ;[761] SHIFT A BIT
JRST EXPGF1 ;[761] CONTINUE TIL DONE
EXPGF2: MOVEM RH,C2H ;[761] STORE
MOVEM RL,C2L ;[761] STORE
CAMN T,0(SREG) ;[761] DONE
JRST EXPGF3 ;[761] YES
ROT T,1 ;[761] GET A BIT
PUSH SREG,T ;[761] PRESERVE OVER CALL
MOVEM RH,C1H ;[761] (WHEN CALL KADPML, C1H-C1L MUST CONTAIN
;[761] ARG1)
MOVEM RL,C1L ;[761]
GFMP RH,C2H ;[761] MULTIPLY RH/RL BY C2H/C2L
;[761] RESULT COMES BACK IN RH/RL
;[761] (C1H/C1L IS CLOBBERED)
;[761] TEST FOR OVERFLOW/UNDERFLOW AND GET OUT IF THERE IS.
JSP T,.+1 ;[761] USE T AS TEMP FOR FLAGS
TLNE T,440140 ;[761] TEST FOR TROUBLE!
JRST EXPGF4 ;[761] TIME TO GET OUT
POP SREG,T ;[761] RESTORE
TRNN T,1 ;[761] ANOTHER MULTIPLY NEEDED
JRST EXPGF2 ;[761] NO - STORE AND ITERATE
PUSH SREG,T ;[761] NEED T FOR COPY
MOVE T,-3(SREG) ;[761] GET ORIGINAL NUMBER
MOVEM T,C2H ;[761] STORE IT
MOVE T,-2(SREG) ;[761] GET ORIGINAL NUMBER
MOVEM T,C2L ;[761] STORE IT
MOVEM RH,C1H ;[761] NUMBER TO BE MULTIPLIED
MOVEM RL,C1L ;[761]
GFMP RH,C2H ;[761] MULTIPLY
JSP T,.+1 ;[761] USE T AS TEMP FOR FLAGS
TLNE T,440140 ;[761] TEST FOR TROUBLE!
JRST EXPGF4 ;[761] TIME TO GET OUT
POP SREG,T ;[761] RESTORE T
JRST EXPGF2 ;[761] REPEAT
EXPGF4: POP SREG,T ;[761] RESTORE T
;[761] THIS IS OVERFLOW/UNDERFLOW EXIT
EXPGF3: POP SREG,0(SREG) ;[761] FIX STACK
POP SREG,0(SREG) ;[761]
POP SREG,0(SREG) ;[761]
POPJ SREG, ;[761] DONE
;
;IF POWER IS 0
EXPGF0: MOVSI RH,G1 ;[761]
MOVEI RL,0 ;[761]
POPJ SREG, ;[761]
;FOR THE FOLDING OF IN-LINE-FNS
;
KILFBA: MOVM RL,RL
PUSHJ SREG,SKERR ;UNUSED OPERSP
PUSHJ SREG,ISIGN
PUSHJ SREG,DIM
PUSHJ SREG,MOD
PUSHJ SREG,MAX
PUSHJ SREG,MIN
;FOR ARGS REAL NOGFLOATING
KILFBR: MOVM RH,RH
PUSHJ SREG,CMPLX ;FOR REAL TO CMPLX
PUSHJ SREG,SIGN
PUSHJ SREG,DIM
PUSHJ SREG,SKERR ;PUSHJ SREG,MOD
PUSHJ SREG,AMAX
PUSHJ SREG,AMIN
;FOR ARGS REAL GFLOATING [761]
;[1031] Use DABS routine for GFLOATING ABS since low word has some SP mantissa
KILFBG: PUSHJ SREG,ILDABS ;[1031] GFLOATING must do both words
PUSHJ SREG,GCMPLX ;[761] FOR REAL TO CMPLX
PUSHJ SREG,SIGN ;[761]
PUSHJ SREG,GDIM ;[761]
PUSHJ SREG,SKERR ;[761] PUSHJ SREG,MOD
PUSHJ SREG,AMAX ;[761]
PUSHJ SREG,AMIN ;[761]
;
;SPECIAL CODE TO HANDLE DABS
KILDAB: PUSHJ SREG,ILDABS
ILDABS: SKIPGE 0,RH
DMOVN RH,RH
POPJ SREG,
;
;
CMPLX: PUSHJ SREG,DPCM ;COMBINE HIGH ORDER WORD
EXCH RH,C2H ;STORE HIGH ORDER, GET NEW HIGH ORDER
MOVEM RH,C1H ;STORE FOR DPCM
EXCH RL,C2L ;STORE LOW ORDER, LOAD NEW LOW ORDER
MOVEM RL,C1L ;SET FOR DPCM
PUSHJ SREG,DPCM ;COMBINE LOW ORDER
MOVE RL,RH ;COPY LOW ORDER
MOVE RH,C2H ;COPY HIGH ORDER
POPJ SREG, ;DONE
;
GCMPLX: PUSHJ SREG,GFCM ;[761] COMBINE HIGH ORDER WORD
EXCH RH,C2H ;[761] STORE HIGH ORDER, GET NEW HIGH ORDER
MOVEM RH,C1H ;[761] STORE FOR GFCM
EXCH RL,C2L ;[761] STORE LOW ORDER, LOAD NEW LOW ORDER
MOVEM RL,C1L ;[761] SET FOR GFCM
PUSHJ SREG,GFCM ;[761] COMBINE LOW ORDER
MOVE RL,RH ;[761] COPY LOW ORDER
MOVE RH,C2H ;[761] COPY HIGH ORDER
POPJ SREG, ;[761] DONE
;
SIGN: MOVM RH,RH
SKIPGE C2H
MOVNS RH,RH
POPJ SREG,
;
DIM: CAMG RH,C2H
TDZA RH,RH
FSBR RH,C2H
POPJ SREG,
;
GDIM: CAMG RH,C2H ;[761]
TDZA RH,RH ;[761]
GFSB RH,C2H ;[761]
POPJ SREG, ;[761]
;
MOD: MOVE RH,RL
IDIV RH,C2L
POPJ SREG,
;
MAX: CAMGE RL,C2L
MOVE RL,C2L
POPJ SREG,
;
MIN: CAMLE RL,C2L
MOVE RL,C2L
POPJ SREG,
AMAX: CAMGE RH,C2H
MOVE RH,C2H
POPJ SREG,
;
AMIN: CAMLE RH,C2H
MOVE RH,C2H
POPJ SREG,
;
ISIGN: MOVM RL,RL
SKIPGE C2L
MOVNS RL,RL
POPJ SREG,
;
;
;
;TYPE CONVERSION
;
;FROM LOGICAL/OCTAL TO REAL,DOUBLE-PREC,COMPLEX
OCTRL: MOVE RH,RL
LITRL: MOVEI RL,0
POPJ SREG,
;FROM DOUBLE-OCTAL TO INTEGER
; OR LITERAL TO OCTAL/LOGICAL/CONTROL/INTEGER
DOCTIN:
LITINT: MOVE RL,RH
MOVEI RH,0
POPJ SREG,
;
;FROM LITERAL TO DOUBLE OCTAL (COMPLEX OR DOUBLE PRECISION)
;
LITTWD: JUMPN RL,CPOPJ ;SET LOW ORDER WORD TO
MOVE RL,[ASCII / /] ;BLANKS IF ZERO
POPJ SREG, ;AND RETURN
;
;FROM REAL (DOUBLE-PREC OR COMPLEX) TO LOGICAL. USE HIGH ORDER OR
; REAL PART ONLY
RLLOG: MOVE RL,RH
MOVEI RH,0
POPJ SREG,
;
;[1025] FROM REAL TO LOGICAL. Convert to SP then use high order.
GRLLOG: EXTEND RL,[GSNGL RH] ;[1025] convert GFLOATING DP to SP
MOVEI RH,0 ;[1025] logical value is in low order word
POPJ SREG, ;[1025] return
;
;FROM INTEGER TO COMPLEX
INTCM: MOVE RH, RL ;MOVE INTEGER INTO WD WHER REAL PART IS TO
; BE LEFT
IDIVI RH,400 ;DIVIDE INTEGER INTO 2 PIECES
SKIPE RH ;IMPLIES INTEGER LESS THAN 18 BITS
TLC RH, 243000 ;SET EXP TO 254 (27+17 DECIMAL)
TLC RL, 233000 ;SET EXP OF 2ND PART TO 233 (27 DECIMAL)
FADR RH,RL ;NORMALIZE AND ADD
MOVEI RL,0
POPJ SREG,
;FROM INTEGER TO DOUBLE-PREC OR REAL (SINCE WE KEEP 2 WDS)
INTDP: MOVE RH, RL ;PUT INTEGER INTO REG IN WHICH HIGH ORDER
; PART WILL BE RETURNED
SETZ RL, ; CLEAR LOW ORDER WORD
ASHC RH,-8 ; MAKE ROOM FOR EXPONENT IN HIGH WORD
TLC RH,243000 ; SET EXP TO 27+8 DECIMAL
DFAD RH,[EXP 0,0] ; NORMALIZE
POPJ SREG, ; RETURN
;
INTGF: MOVE RH, RL ;[761]
EXTEND RH,[GFLTR 0,RH] ;[761]
POPJ SREG, ;[761]
;FROM COMPLEX TO INTEGER
CMINT: MOVM RH, RH ;USE MAGNITUDE ONLY
MULI RH,400 ;SEPARATE FRACTION AND EXPONENT
;(EXPONENT IN RH, FRACTION IN RL)
ASH RL, -243(RH) ;USE THE EXPONENT AS AN INDEX REGISTER
SKIPGE C1H ;SET THE CORRECT SIGN
MOVNS RL,RL
MOVEI RH,0 ;ZERO 1ST WD
POPJ SREG,
;FROM DOUBLE PREC OR REAL (SINCE WE KEEP 2 WDS OF ACCURACY) TO INTEGER
DPINT:
;TAKE THE ABSOLUTE VALUE - IF THE NUMBER IS NEGATIVE, MUST
; NEGATE A KI10 FORMAT NUMBER (THIS CODE RUNS ON KA OR KI)
SKIPGE RH
DMOVN RH,RH
HLRZ T,RH ;GET EXPONENT INTO RIGHT
ASH T,-9 ; 8 BITS OF REGISTER "T"
TLZ RH,777000 ;WIPE OUT EXPONENT IN ARG
ASHC RH,-201-^D26(T) ;CHANGE FRACTION BITS TO INTEGER
SKIPGE C1H ;IF ORIGINAL VAL WAS NEGATIVE
MOVNS RH ; NEGATE THE INTEGER RESULT
;
MOVE RL,RH ;ALWAYS LEAVE INTEGER RESULTS IN RL
MOVEI RH,0 ; WITH RH EQL TO 0
;
POPJ SREG,
GFINT: EXTEND RL,[GFIX RH] ;[1030] truncate instead of rounding
MOVEI RH,0 ;[761]
POPJ SREG, ;[761]
;
;FROM DOUBLE PREC TO COMPLEX - ROUND HIGH WD, ZERO IMAGINARY PART
DPCM:
JUMPE RH,CPOPJ ;FOR ZERO - DO NOTHING
;MUST FIRST TAKE ABSOLUTE VALUE - IF THE NUMBER IS NEG, MUST
; NEGATE A KI10 FORMAT NUMBER (THIS CODE RUNS ON KA OR KI)
SKIPGE RH
DMOVN RH,RH
TLNN RL,200000 ;IS ROUNDING NECESSARY
JRST DPRL2
AOS RH ;YES, ROUND INTO HIGH WORD
TLO RH,400 ;TURN ON HI FRAC BIT IN CASE CARRY
; ADDED 1 TO EXPONENT
DPCM1: JUMPGE RH,DPRL2
HRLOI RH,377777 ;OVERFLOW, MAKE LARGEST NUMBER AND
JRSTF @[XWD 440000,DPRL2] ; SET AROV AND FOV
DPRL2: SKIPGE C1H ;IF ORIGINAL NUMBER WAS NEG
MOVNS RH ; THEN NEGATE THE RESULT
MOVEI RL,0 ;CLEAR LOW WORD
POPJ SREG,
GFCM: EXTEND RH,[GSNGL RH] ;[761]
MOVEI RL,0 ;[761]
POPJ SREG, ;[761]
;
;WHEN AN OVERFLOW/UNDERFLOW WAS DETECTED
;
;
OVFLW:
PUSH SREG,RH ;STORE RESULT OF COMPUTATION HIGH ORDER
PUSH SREG,RL ;STORE RESULT OF COMPUTATION LOW ORDER
PUSH SREG,T ;STORE FLAGS
;TYPE OUT MESSAGE
PUSH SREG,ISN## ;PASS STATEMENT NUMBER
PUSH SREG,[E64##] ;ERROR NUMBER 64(DEC) TO BE PRINTED
PUSHJ SREG,WARNERR## ;TYPE WARNING
POP SREG,0(SREG) ;RESTORE STACK
POP SREG,0(SREG)
POP SREG,T ;RESTORE FLAGS
POP SREG,RL ;RESTORE RESULT LOW ORDER
POP SREG,RH ;RESTORE RESULT HIGH ORDER
HRRZ RGDSP,COPRIX ;RESTORE DISPATCH INDEX
;DETERMINE THE TYPE OF THE RESULT BEING GENERATED
; LEAVE THE REGISTER "RGDSP" SET TO 0 FOR INTEGER, 1 FOR REAL,
; 2 FOR DOUBLE-PREC, 3 FOR COMPLEX
;
;THE FIRST ENTRIES IN THE DISPATCH TABLE ARE ARITH FOLLOWED BY TYPE
; CONVERSION. IN BOTH THESE CASES, THE INDEX INTO THE TABLE WAS BUILT
; BY ADDING THE BASE FOR THE GIVEN OPERATION TO A 2 BIT TYPE CODE.
CAIL RGDSP,KBOOLB
JRST OVFLW1
; IF DISPATCH-INDEX WAS FOR A TYPE-CNV OR ARITH OP, CAN GET TYPE
; OF RES BY SUBTRACTING BASE OF TABLE AND THEN USING LAST 2 BITS
SUBI RGDSP,KARIIB
ANDI RGDSP,3
JRST HAVTYP
OVFLW1:
; IF THE VAL OF COPRIX IS BETWEEN THE BASE FOR BOOLEANS AND THE
; THE BASE FOR SPECIAL-OPS, THEN THE OVERFLOW WAS CAUSED IN
; DOUBLE-PREC NEGATION. VALUE TYPE IS ALWAYS DOUBLE-PREC
CAIL RGDSP,KSPECB
JRST OVFLW2
MOVEI RGDSP,2
JRST HAVTYP
OVFLW2:
;IF COPRIX IS IN THE RANGE USED FOR SPECIAL-OPS - USE THE LAST 2 BITS
CAIL RGDSP,KILFBA
JRST OVFLW3
SUBI RGDSP,KSPECB
ANDI RGDSP,3
JRST HAVTYP
OVFLW3:
;FOR IN-LINE-FNS ARGS ARE INTEGER BETWEEN "KILFBA" AND "KILFBR"
; REAL IF GREATER THAN "KILFBR"
CAIL RGDSP,KILFBR
JRST OVFLW4
MOVEI RGDSP,0
JRST HAVTYP
OVFLW4: MOVEI RGDSP,1
; AFTER HAVE SET THE REGISTER "RGDSP" TO CONTAIN THE VALTYPE OF
; THE RESULT
HAVTYP:
JUMPE RGDSP,CPOPJ ;IF THE TYPE IS INTEGER, DO NOT ALTER THE
; RESULT
TLNN T,000100 ; SKIP IF UNDERFLOW
JRST OVERFL ; IF EITHER OVERFLOW OR DIVIDE-CHECK,
; TREAT AS AN OVERFLOW
;
; FOR UNDERFLOW - SET THE RESULT TO 0
SETZB RH,RL
CPOPJ: POPJ SREG, ;GO STORE THE RESULT AND RETURN
;
;FOR OVERFLOW (OR DIVIDE CHECK) - SET THE RESULT TO THE HIGHEST
; NUMBER (NEG OR POS) AND RETURN
OVERFL: JUMPL RH,NEGNUM
HRLOI RH,377777
CAIE RGDSP,1
HRLOI RL,377777 ;IF THE VALTYPE WAS DOUBLE-PREC
; OR COMPLEX
POPJ SREG,
;
; IF THE VAL WAS NEG - USE THE LARGEST NEG NUMBER
NEGNUM:
CAIN RGDSP,2
JRST DPNEGN
MOVE RH,[400000000001]
CAIN RGDSP,3
MOVE RL,[400000000001] ;IF THE TYPE WAS COMPLEX, SET THE IMAGIN
; PART AS WELL AS THE REAL PART
POPJ SREG,
;
; FOR A DOUBLE-PREC, WHEN WANT THE LARGEST NEGATIVE DP NUMBER
DPNEGN: HRLZI RH,400000
MOVEI RL,1
POPJ SREG,
END