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