Trailing-Edge
-
PDP-10 Archives
-
AP-D480B-SB_1978
-
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
;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,1977 BY DIGITAL EQUIPMENT CORPORATION
INTERN CNSTCV
CNSTCV= BYTE (3)0(9)5(6)0(18)^D67 ;VERSION DATE: 11-AUG-77
SUBTTL 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
;************ VERSION 5
;66 413 ----- DON'T USE FADL IN INTDP IF NOT ON KA10
;************ VERSION 5A
;67 606 22795 CATCH ALL OVERFLOWS AND UNDERFLOWS IN EXPRL
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
;
ENTRY CNSTCM
EXTERN SKERR,C1H,C1L,C2H,C2L,COPRIX
INTERN KDPINT ;REAL TO INTEGER TRUNCATION
INTERN KARIAB ;BASE FOR ARITH OPERATIONS FOR KA10
INTERN KARIIB ;BASE FOR ARITH OPERATIONS FOR KI10
INTERN KBOOLB,KTYPCB,KDNEGB,KSPECB,KILFBA,KILFBR
INTERN KDPRL ;TO ROUND A DOUBLE-WD REAL DOWN TO A
; SINGLE WD OF PRECISION. USED ONLY WITH THE
; OPTIMIZER
INTERN KADPRN ;TO ROUND ^A DOUBLE PRECISION FROM KI TO KA
; PRECISION - LEAVING IT IN KI10 FORMAT
INTERN KILDAB ;TO FOLD DABS
SREG=17 ;STACK REG
FLGREG=0 ;FLAGS REGISTER
KA10FL=4000 ;FLAG FOR "COMPILING CODE FOR KA10" IS BIT 24
; OF FLGREG - USE THIS MASK TO TEST IT
CKA10F=40 ;[413]FLAG SET FOR "COMPILING ON A KA10" IS BIT
;[413] 12 OF FLGREG
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
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 ;%51% - 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
; KI10
KARIIB: ADD RL,C2L
PUSHJ SREG,KIDPAD
PUSHJ SREG,KIDPAD
PUSHJ SREG,CMPADD
SUB RL,C2L
PUSHJ SREG,KIDPSB
PUSHJ SREG,KIDPSB
PUSHJ SREG,CMPSUB
IMUL RL,C2L
PUSHJ SREG,KIDPML
PUSHJ SREG,KIDPML
PUSHJ SREG,CMPMUL
IDIV RL,C2L
PUSHJ SREG,KIDPDV
PUSHJ SREG,KIDPDV
PUSHJ SREG,CMPDIV
;
; KA10
; ( DOUBLE-PREC CONSTANTS ARE ALL STORED IN KI10 FORMAT INSIDE THE COMPILER,
; HENCE FOR DOUBLE-PREC OPS MUST SIMULATE KI10 ARITHMETIC)
KARIAB: ADD RL,C2L
PUSHJ SREG,KADPAD
PUSHJ SREG,KADPAD
PUSHJ SREG,CMPADD
SUB RL,C2L
PUSHJ SREG,KADPSB
PUSHJ SREG,KADPSB
PUSHJ SREG,CMPSUB
IMUL RL,C2L
PUSHJ SREG,KADPML
PUSHJ SREG,KADPML
PUSHJ SREG,CMPMUL
IDIV RL,C2L
PUSHJ SREG,KADPDV
PUSHJ SREG,KADPDV
PUSHJ SREG,CMPDIV
;FOR TYPE CONVERSIONS
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
SETZ RL, ;TO REAL
JFCL ;TO DOUBLE PREC
JFCL ;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
;
;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
;
;
;
;TO ROUND A DOUBLE PRECISIOM FROM KI10 TO KA10 PRECISION - LEAVING IT
; IN KI10 FORMAT. USED BY ROUTINES IN P2SKEL WHICH TEST PROPERTIES
; OF CONSTANTS
KADPRN: PUSHJ SREG,RNKADP
;
;
;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
PUSHJ SREG,KADPNG ;FOR COMPILATION ON KA10
;OPERATIONS THAT TAKE MORE THAN 1 INSTR
;
;TO FOLD DOUBLE-PREC OPERATIONS ON THE KI10
;
; ADD
KIDPAD: TRNE FLGREG,KA10FL ;IF ARE COMPILING CODE TO RUN ON **KA10*
PUSHJ SREG,RNARGS ;MUST ROUND THE 2 ARGS TO KA10 PRECISION
; BEFORE FOLDING
DFAD RH,C2H ;ADD THE 2 ARGS
POPJ SREG,
; SUBTRACT
KIDPSB: TRNE FLGREG,KA10FL ;IF ARE COMPILING CODE TO RUN ON **KA10*
PUSHJ SREG,RNARGS ;MUST ROUND THE 2 ARGS TO KA10 PRECISION
; BEFORE FOLDING
DFSB RH,C2H ;SUB THE 2 ARGS
POPJ SREG,
; MULTIPLY
KIDPML: TRNE FLGREG,KA10FL ;IF ARE COMPILING CODE TO RUN ON **KA10*
PUSHJ SREG,RNARGS ;MUST ROUND THE 2 ARGS TO KA10 PRECISION
; BEFORE FOLDING
DFMP RH,C2H ;MUL THE 2 ARGS
POPJ SREG,
; DIVIDE
KIDPDV: TRNE FLGREG,KA10FL ;IF ARE COMPILING CODE TO RUN ON **KA10*
PUSHJ SREG,RNARGS ;MUST ROUND THE 2 ARGS TO KA10 PRECISION
; BEFORE FOLDING
DFDV RH,C2H ;DIV THE 2 ARGS
POPJ SREG,
;DOUBLE PREC OPS FOR KA10
; MAINTAIN CONSTANTS IN KI10 FORMAT, SO MUST SIMULATE KI10
; DOUBLE PREC OPS
;
EXTERN DFA4
EXTERN DFS4
EXTERN DFM4
EXTERN DFD4
EXTERN SAVACS
;
; DOUBLE-PREC ADD
KADPAD: MOVE T, [10,,SAVACS] ;PRESERVE REGISTERS 10-16
BLT T,SAVACS+6
TRNE FLGREG,KA10FL ;IF ARE COMPILING CODE FOR A
;KA10, ROUND ARGS TO
PUSHJ SREG,RNARGS ;KA10 PRECISION BEFORE FOLDING
MOVEI 16,C2H ;PTR TO 2ND ARG
PUSHJ SREG,DFA4 ;DOUBLE-PREC ADD ROUTINE
; WHEN ARG1 IS IN REG 4
MOVE T, [SAVACS,,10] ;RESTORE ACS 10-16
BLT T,16
POPJ SREG,
;
;DOUBLE PREC SUBTRACT
KADPSB: MOVE T, [10,,SAVACS] ;PRESERVE REGISTERS 10-16
BLT T,SAVACS+6
TRNE FLGREG,KA10FL ;IF ARE COMPILING CODE FOR A
;KA10, ROUND ARGS TO
PUSHJ SREG,RNARGS ;KA10 PRECISION BEFORE FOLDING
MOVEI 16,C2H ;PTR TO 2ND ARG
PUSHJ SREG,DFS4 ;DOUBLE-PREC SUB ROUTINE
; WHEN ARG1 IS IN REG 4
MOVE T, [SAVACS,,10] ;RESTORE ACS 10-16
BLT T,16
POPJ SREG,
;
;DOUBLE-PREC MULTIPLY
KADPML: MOVE T, [10,,SAVACS] ;PRESERVE REGS 10-16
BLT T,SAVACS+6
TRNE FLGREG,KA10FL ;IF ARE COMPILING CODE FOR A
;KA10, ROUND ARGS TO
PUSHJ SREG,RNARGS ;KA10 PRECISION BEFORE FOLDING
MOVEI 16,C2H ;PTR TO 2ND ARG
PUSHJ SREG,DFM4 ;DOUBLE-PREC MUL ROUTINE
; WHEN ARG1 IS IN REG 4
MOVE T, [SAVACS,,10] ;RESTORE ACS 10-16
BLT T,16
POPJ SREG,
;
; DOUBLE-PREC DIVIDE
KADPDV: MOVE T,[10,,SAVACS] ;PRESERVE REGS 10-16
BLT T,SAVACS+6
TRNE FLGREG,KA10FL ;IF ARE COMPILING CODE FOR A
;KA10, ROUND ARGS TO
PUSHJ SREG,RNARGS ;KA10 PRECISION BEFORE FOLDING
MOVEI 16,C2H ;PTR TO 2ND ARG
PUSHJ SREG,DFD4 ;DOUBLE-PREC DIV ROUTINE
; WHEN ARG1 IS IN REG 4
MOVE T, [SAVACS,,10] ;RESTORE ACS 10-16
BLT T,16
POPJ SREG,
; TO ROUND THE 2 ARGS OF A DOUBLE-PREC OPERATION TO KA10
; PRECISION BEFORE FOLDING. THIS IS NECESSARY
; BECAUSE REAL AND DOUBLE-PRECISION CONSTANTS THAT ARE BEING
; COMPILED FOR THE KA10 ARE NOT ROUNDED AT ALL UNTIL FINAL
; OUTPUT IS DONE. 2.0-2 GIVES A NONZERO ANSWER IF DONT
; ROUND HERE
RNARGS: PUSHJ SREG,RNKADP ;ROUND ARG1 TO KA10 PREC
; (ARG1 IS IN RH-RL)
MOVEM RH,C1H ;SAVE THE ROUNDED VAL
MOVEM RL,C1L
MOVE RH,C2H ;SET UP REGS TO CONTAIN ARG2
MOVE RL,C2L
SKIPGE RH ;FOR ROUNDING ARG2, CANNOT USE THE
; ROUTINE THAT HANDLES NEGATIVE
; NUMBERS BECAUSE IT HAS A REFERENCE
; TO "C1H". THEREFORE, TAKE ABSOLUTE
PUSHJ SREG,KADPNG ; VALUE OF ARG2
PUSHJ SREG,ROUNKA ;ROUND THIS POSITIVE NUMBER
SKIPGE C2H ;IF ARG2 WAS NEGATIVE,
PUSHJ SREG,KADPNG ; NEGATE THE RESULT
MOVEM RH,C2H ;SAVE THE ROUNDED VALUE
MOVEM RL,C2L ; OF ARG2
MOVE RH,C1H ;SET RH-RL TO THE ROUNDED
MOVE RL,C1L ; VAL OF ARG1
POPJ SREG,
;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
;
;
;NEGATION OF A DOUBLE-PREC CONSTANT ON THE KA10 (CONSTANT IS IN KI10
; FORMAT)
KADPNG: SETCM RH,RH
MOVNS RL
TLZ RL,(1B0)
SKIPN RL
AOS RH
POPJ SREG,
;FOR FOLDING OF SPECIAL-OPS (P2MUL,P2DIV,PLPL1MUL,EXPCIOP
KSPECB: PUSHJ SREG,P2MI
PUSHJ SREG,P2MR
PUSHJ SREG,P2MR ;DOUBLE-PREC P2MUL OF KI10 FORMAT NOS
; IS SAME AS FOR REAL
PUSHJ SREG,P2MC
;
PUSHJ SREG,P2DI
PUSHJ SREG,P2DR
PUSHJ SREG,P2DR ;P2DIV OF DOUBLE-PREC KI10 NOS IS SAME
; AS FOR REAL NOS
PUSHJ SREG,P2DC
;
PUSHJ SREG,P21MI
PUSHJ SREG,P21MD ;FOR REALS - PERFORM DOUBLE-PREC OPERATIONS
PUSHJ SREG,P21MD
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
P2MI: MOVE T,C2L
ASH RL,0(T)
POPJ SREG,
;
P2MR: MOVE T,C2L
FSC RH,0(T)
POPJ SREG,
;
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,
;
P2DR: MOVN T,C2L
FSC RH,0(T)
POPJ SREG,
;
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 T,C2L
FSC RH,0(T)
FADR RH,C1H
POPJ SREG,
;
P21MD: MOVE T,C2L
FSC RH,0(T)
;TO ADD DOUBLE-PREC NOS THAT ARE KI10 FORMAT ON A KA10, MUST
; USE SIMULATION ROUTINES
MOVE T, [10,,SAVACS] ;PRESERVE REGS 10-16
BLT T,SAVACS+6
MOVEI 16,C1H
PUSHJ SREG,DFA4
MOVE T, [SAVACS,,10] ;RESTORE ACS 10-16
BLT T,16
POPJ SREG,
;
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
PUSHJ SREG,KADPML ;MULTIPLY RH/RL BY C2H/C2L
;RESULT COMES BACK IN RH/RL
;(C1H/C1L IS CLOBBERED)
;**[606], INSERT @EXPRL2+11L, DCE, 11-AUG-77
;**[606], TEST FOR OVERFLOW/UNDERFLOW AND GET OUT IF THERE IS.
JSP T,.+1 ;[606] USE T AS TEMP FOR FLAGS
TLNE T,440140 ;[606] TEST FOR TROUBLE!
JRST EXPRL4 ;[606] 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
PUSHJ SREG,KADPML ;MULTIPLY
;**[606], INSERT @EXPRL3-3L, DCE, 11-AUG-77
JSP T,.+1 ;[606] USE T AS TEMP FOR FLAGS
TLNE T,440140 ;[606] TEST FOR TROUBLE!
JRST EXPRL4 ;[606] TIME TO GET OUT
POP SREG,T ;RESTORE T
JRST EXPRL2 ;REPEAT
;**[606], INSERT @EXPRL3-1L, DCE, 11-AUG-77
EXPRL4: POP SREG,T ;[606] RESTORE T
;[606] 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
;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
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
;
;SPECIAL CODE TO HANDLE DABS
KILDAB: PUSHJ SREG,ILDABS
ILDABS: MOVE T,[10,,SAVACS] ;SAV THE ACS
BLT T,SAVACS+6
SKIPGE 0,RH ;ITS ALREADY POSITIVE?
PUSHJ 17,KADPNG ;SIMULATE THE NEGATE
MOVE T,[SAVACS,,10] ;RESTORE ACS
BLT T,16
POPJ SREG, ;DONE
;
;
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
;
SIGN: MOVM RH,RH
SKIPGE C2H
MOVNS RH,RH
POPJ SREG,
;
DIM: CAMG RH,C2H
TDZA RH,RH
FSBR RH,C2H
POPJ SREG,
;
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
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,
;
;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
TLNN FLGREG,CKA10F ;[413] RUNNING ON A KA10 ?
JRST INTDP1 ;[413] NO => DON'T EXECUTE THE FADL
IDIVI RH, 400 ;DIVIDE INTO 2 PIECES
SKIPE RH ;IMPLIES INTEGER LESS THAN 18 BITS
TLC RH, 243000 ;SET EXP TO 254 (27 DECIMAL)
TLC RL, 233000 ;SET EXP OF LOW PART TO 233 (27 DECIMAL)
FADL RH, RL ;NORMALIZE AND ADD
LSH RL,10 ;GET RID OF LOW EXPONENT
POPJ SREG,
INTDP1: ;[413] FROM DFL.I IN FORDAR IN FORLIB
SETZ RL, ;[413] CLEAR LOW ORDER WORD
ASHC RH,-8 ;[413] MAKE ROOM FOR EXPONENT IN HIGH WORD
TLC RH,243000 ;[413] SET EXP TO 27+8 DECIMAL
DFAD RH,[EXP 0,0] ;[413] NORMALIZE
POPJ SREG, ;[413] RETURN
;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
PUSHJ SREG,KADPNG ;NEGATIVE, MAKE POSITIVE
;IF ARE COMPILING FOR THE KA10, THIS DOUBLE-PREC NUMBER WILL
; BE UNROUNDED. IF SO, ROUND IT.
TRNE FLGREG,KA10FL
PUSHJ SREG,ROUNKA
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,
;
;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
PUSHJ SREG,KADPNG ;NEGATIVE, MAKE POSITIVE
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
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,
;TO ROUND A KI10 FORMAT POSITIVE DOUBLE PREC NUMBER TO KA10 PRECISION,
; BUT LEAVING IT IN KI10 FORMAT
; DO NOT WANT TO FALSELY SET OVERFLOW FLAG
ROUNKA:
JUMPE RH,CPOPJ ;FOR ZERO - DO NOTHING
TLO RL,(1B0) ;MAKE LOW WD NEGATIVE TO PREVENT OVFLW
ADDI RL,200 ;ADD ROUNDING CONSTANT
TRZ RL,377 ;GET RID OF INSIGNIFICANT BITS
TLZN RL,(1B0) ;TEST FOR CRY TO HI
ADDI RH,1
TLO RH,(1B9) ;ALWAYS SET HIGH BIT OF MANTISSA
POPJ SREG,
;
;
;
;TO ROUND A KI10 FORMAT NUMBER (EITHER POS OR NEG) TO KA10 PRECISION
; BUT LEAVE IT IN KI10 FORMAT
RNKADP: SKIPGE RH ;IF THIS NUMBER IS NEGATIVE
PUSHJ SREG,KADPNG ; COMPLEMENT IT
PUSHJ SREG,ROUNKA ;ROUND THIS POSITIVE NUMBER TO KA10 PREC
SKIPGE C1H ;IF THE ORIGINAL NUMBER WAS NEGATIVE
PUSHJ SREG,KADPNG ; THEN TAKE THE COMPLEMENT OF THE ROUNDED NUM
POPJ SREG,
;
;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
;**;[275],CNSTCM,JNT,30-MAY-75
;**;[275],HAVTYP+4 LINES
TLNN T,000100 ;[275] 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