*DECK     CONRED
          IDENT  CONRED 
 CONRED   SECT   (COMPLILE TIME ARITHMETIC PROCESSOR.),1
  
          SST    B,D,EXIT.
          NOREF  B,D,EXIT.
  
 B=CON    RPVDEF             DEFINE ROUTINE FWA FOR REPRIEVE UTILITY
  
          ENTRY  TER1,TER2,LCT,CCR,CMC,CMO
  
*         IN FTN
          EXT    CO.RND 
  
*         IN TABLES 
          EXT    CONF,CONZER,DIVP2,IMULT2,MINUS.M,PLUS.M,SHFC,SHFD,SHFDS
          EXT    SHFSA,SHFS,TS.CON
  
*         IN ERRORS 
          EXT    CON.DPC,E.CR1,E.CR2,E.CR3,E.CR3A,E.CR4,E.CR5,E.CR6 
          EXT    E.CR7,E.CR8,E.CR9,E.CR10,FILL. 
  
*         IN ALLOC
          EXT    NCS
  
*         IN PAR
          EXT    SMOD,SOPR
  
*         IN GEN
          EXT    MULT.R 
  
*         IN INIT 
          EXT    SCR
  
 CCR      EJECT  4,30 
 CCR      EJECT  4,30 
**        CCR -  CHECK FOR POSSIBLE CONSTANT REDUCTION. 
* 
*                     GENERAL PURPOSE ROUTINE TO REDUCE SIMPLE
*                OPERATOR COMBINATIONS USING EITHER  -- 
*                            A.  PLUS            (PLC SECTION.) 
*                            B.  MINUS           (MIC SECTION.) 
*                            C.  MULTIPLY        (MUC SECTION.) 
*                            D.  DIVIDE          (DIC SECTION.) 
* 
*                WITH MODE OF OPERATION BEING EITHER  --
*                            A. UNIVERSAL 
*                            B. INTEGER.
*                            C. REAL
* 
*                ALSO HANDLIES IMPLIED REDUCTIONS.  (IE. A=0/X) 
*                AND OUTPUTS ERRORS FOR *END* CASES.(IE OVERFLOW) 
* 
*         ENTRY  (X4)    = 1ST OPERAND. 
*                (X5)    = 2ND OPERAND. 
*                (SOPR)  = CURRENT OPERATOR.
*                (SMOD)  = DOMINANT MODE. 
* 
*         EXIT   (X6) = 0 NO REDUCTION PERFORMED. 
*                     " 0 RESULTS OF PERFORMED REDUCTION. 
*                (X4,X5) = PRESERVED. 
* 
*                (B3) =-1       NO CONSTANT.
*                     = 0   1ST IS CONSTANT.
*                     = 1   2ND IS CONSTANT 
* 
*         USES   CANNOT DESTORY  A7  B4,B5,B6  X4,X5
*                (X4,X5 CAN BE ALTERED IF EXPRESSION IS REDUCED.) 
*         CELLS  (SCR TO SCR+3) 
* 
*         CALLS  LCT - TO LOAD PROPOSED CONSTANT IN BINARY FORM.
*                CMC - CHECK IF CONSTANT CAN BE CONVERTED TO MODE OF
*                      EXPRESSION.
*                NCS - ENTER REDUCED CONSTANT INTO TS.CON.
*                PCA - PROCESS ACTUAL ARITHMETIC REDUCTIONS.
  
  
 CCR0     SX6    0
          SA3    SOPR 
  
 CCR      SUBR               ENTRY/EXIT...
          SA1    SMOD 
          SA2    ="CCRMOD"
          BX6    0
          SB2    X1 
          SA6    TER2 
          SA1    SOPR 
          SA6    CONF        INDICATE NO CONSTANT IN TURPLE 
          LX0    B2,X2
          SA2    ="CCROPS"
          =B3    -1 
          PL     X0,EXIT.    IF NOT REDUCABLE MODE. - EXIT..
          SB2    X1 
          LX0    B2,X2
          MI     X0,CCR1     IF REDUCABLE OPERATOR
          SX0    B2 
          SB2    B2-O.= 
          NZ     B2,EXIT.    IF NOT EQUALS - EXIT 
          BX1    X4 
          RJ     LCT
          SB7    B1 
          ZR     B2,CCR0     IF NOT A CONSTANT
          SB2    X0-M.INT 
          NZ     B2,CCR0     IF NOT INTEGER - EXIT
          BX2    X4 
          RJ     CIR         CHECK IF CONVERSION REQUIRED 
          BX4    X2 
          EQ     CCR0        EXIT 
  
**        REDUCABLE OPERATOR FOUND, MODE IS UNIV, INTEGER OR REAL.
*         CHECK FOR CONSTANTS AS OPERANDS 
  
 CCR1     BX1    X4 
          RJ     LCT         GET 1ST CONSTANT 
          ZR     B2,CCR10    IF  1ST NOT CONSTANT 
          =B7    1
          BX2    X4 
          RJ     CIR         CHECK IF LEGAL INTEGER 
          BX4    X2 
          BX1    X6 
          SA6    TER1 
          RJ     COC         CHECK IF CONSTANT IN RANGE 
          PL     B7,CCR.RX   IF OUT OF RANGE
          BX1    X5 
          =B3    0
          RJ     LCT         GET 2ND CONSTANT 
          SA1    TER1        RELOAD 1ST TERM BINARY 
          ZR     B2,CCR15    IF 2ND NOT CONSTANT, 1ST IS
          =B7    2
          BX2    X5 
          RJ     CIR         CHECK IF LEGAL INTEGER 
          BX5    X2 
          BX3    X6 
          LX1    X6 
          RJ     COC         CHECK IF CONSTANT IN RANGE 
          NZ     X1,CCR6     IF NOT ZERO
          SA4    SOPR 
          SB3    X4-O.DIV 
          NZ     B3,CCR7     IF NOT DIVIDE
          =B3    1
          EQ     CCR15
  
 CCR6     PL     B7,CCR.RX   IF OUT OF RANGE
  
**        HERE WHEN BOTH OPERANDS ARE CONSTANTS.
*         REDUCE EXPRESSION AT COMPILE TIME.
  
 CCR7     SA4    =XARGMODE
          SB2    =XA=DO 
          SB7    X4 
          SB7    B7-B2
          NZ     B7,CCR8     NOT PROCESSING DO
          SA1    =XARGCOMA   DO INDEX NUMBER
          SB7    X1+
          SA4    B7+=XDO.DPC DPC FOR CURRENT INDEX
          SA1    FILL.
          BX6    X4 
          IX4    X6-X1
          ZR     X4,CCR8     IF MESSAGE JUST GIVEN
          SA6    A1 
          ANSI   =XE.DO16    INDEX MUST BE SIMPLE INTEGER 
 CCR8     SA1    TER1        =1ST CONSTANT
          BX2    X3 
          SA3    SOPR 
          RJ     PCA         PERFORM COMPILE TIME REDUCTION 
          EQ     EXIT.
  
**        HERE WHEN 1ST IS NOT A CONSTANT.
  
 CCR10    BX1    X5 
          RJ     LCT         LOAD 2ND OPERAND.
          SA6    TER2 
          =B3    -1          INDICATE NO CONSTANTS. 
          LX7    X6 
          =X6    0           INDICATE NO CONSTANTS
          ZR     B2,EXIT.    IF NOT CONSTANT - EXIT.. 
          BX6    X7 
          =B7    2
          BX2    X5 
          RJ     CIR         CHECK IF LEGAL INTEGER 
          BX5    X2 
          BX1    X6 
          RJ     COC         CHECK FOR CONSTANT IN RANGE
          PL     B7,CCR.RX   IF OUT OF RANGE
          =B3    1           INDIATE 2ND = CONSTANT.
  
**        ONE OPERAND IS A CONSTANT - CHECK FOR LEGAL OPERATION 
*         INVOLVING CONSTANT OPERAND. 
* 
*         (X1) = BINARY OF CONSTANT 
*                (X1) IS IN RANGE.
* 
*         (B3) = 0 IF 1ST OPERAND IS A CONSTANT 
*                1 IF 2ND OPERAND IS A CONSTANT 
  
 CCR15    SA3    SOPR        CURRENT OPERATOR 
          SA2    X3+OPJTBL-O.PL 
          BX6    0           INDICATE NO REDUCTION
  
          SB7    X2 
          SA2    SMOD 
  
**        EXIT WITH 
*                (X1) = BINARY OF CONSTANT
*                (X2) = (SMOD)
  
          JP     B7          JUMP TO OPERATOR USING CONSTANT
  
 OPJTBL   CON    PLC         *+*
          CON    MIC         *-*
          CON    MUC         *
          CON    DIC         */*
 PLC      SPACE  4,8
**        PLC - OPERATOR IS A PLUS. 
* 
*         A.  CHECK IF ADD OF *0* - NOTE MESSAGE TO PROGRAMMER. 
*         B.  CONVERT CONSTANT TO DOMINANT MODE.
*         C.  IF CONSTANT IS = (2**N-1) CHANGE OPERATOR TO MINUS AND
*             OPERAND TO -(2**N-1)
  
 PLC      NZ     X1,PLC5     IF NOT *0* 
          SB7    E.CR1
          EQ     CCR.EC      OUTP 
 PLC5     RJ     CMO         CHECK FOR MASK ADD 
          ZR     X6,CCR.IG   IF FAILURE 
          SA3    PLUS.M 
          EQ     MIC10
 MIC      SPACE  4,8
**        MIC - OPERATOR IS A MINUS.
* 
*         A.  CHECK IF MINUS OF *0* - NOTE MESSAGE TO PROGRAMMER. 
*         B.  CONVERT CONSTANT TO DOMINANT MODE.
*         C.  IF CONSTANT IS = (2**N-1) CHANGE OPERATOR TO PLUS AND 
*             OPERAND TO -(2**N-1)
  
 MIC      NZ     X1,MIC5     IF NOT *0* 
          ZR     B3,CCR.IG   IF 0-I, NO REDUCTION 
          SB7    E.CR1
          EQ     CCR.EC      OUTPUT NOTE
 MIC5     RJ     CMO         CHECK FOR MASK ADD 
          ZR     X6,CCR.IG   IF FAILURE 
          SA3    MINUS.M
 MIC10    BX7    X3 
          LX5    X6 
          SA7    SOPR 
          =X6    0           INDICATE NO REDUCTION
          =B3    1
          EQ     EXIT.
 MUC      SPACE  4,8
**        MUC -  OPERATOR IS A MULTIPLY.
* 
*         A.  CHECK FOR MULTIPLY BY *0*. IF SO AND EXPRESSION IS NOT
*             INTEGER * REAL 0 - ELIMINATE MULTIPLY - SETTING RESULTS TO
*             *0*, OTHERWISE EXIT.
* 
*         B.  CHECK FOR MULTIPLY BY *1*.  PERFORM SAME TESTS AS *A* 
*             INTEGER * REAL 1 - ELIMINATE MULTIPLY. OTHERWISE EXIT.
*         C.  IF NO MODE CONVERSION IS SET AND MULTIPLY IS AN INTEGER 
*             CALL *CSI* TO SEE IF MULTIPLY CAN BE CHANGED TO USE 
*             *SHIFT* COMBINATION.
* 
*         D.  CONVERT CONSTANT TO DOMINANT MODE.
  
  
 MUC      NZ     X1,MUC10    IF CONSTANT NOT *0*
          SB7    E.CR2
          EQ     CCR.E0      OUTPUT NOTE ERROR - SET RESULTS = 0
  
 MUC10    =X7    1
          IX0    X7-X1
          NZ     X0,MUC20    IF NOT INTEGER *1* 
          SB7    E.CR5
          SA2    ARGMODE
          SX0    X2 
          SX2    =XA=ARRAY
          IX0    X0-X2
          NZ     X0,CCR.EC   IF NOT TRANSPARENT TO USER REDUCTION 
          =B7    0
          EQ     CCR.EC      OUTPUT NOTE ERROR - SET RESULTS = NON CONS 
  
 MUC20    BX0    X1 
          SX6    1.0/1S42 
          LX0    L.SHC
          IX7    X0-X6
          NZ     X7,MUC30    IF CONSTANT NOT *1.0*
          BX0    X2 
          SB7    E.CR5
          AX0    18 
          NZ     X0,CCR.IG   IF OTHER OPERAND IS INTEGER - IGNORE 
          SA2    ARGMODE
          SX0    X2 
          SX2    =XA=ARRAY
          IX0    X0-X2
          NZ     X0,CCR.EC   IF NOT TRANSPARENT TO USER REDUCTION 
          =B7    0
          EQ     CCR.EC      OUTPUT NOTE ERROR - SET RESULTS = NON CONS 
  
 MUC30    =B7    X2-M.INT 
          NZ     B7,CCR.IG   IF DOMINANT MODE NOT INTEGER 
          BX6    X1          CONSTANT 
          RJ     CSI         CHECK FOR USE OF SHIFT MACRO 
          BX6    0           INDICATE NOT REDUCED 
          EQ     EXIT.
 DIC      SPACE  4,8
**        DIC -  OPERATOR IS DIVIDE.
* 
*         A.  CHECK FOR DIVIDE INTO *0*. SET RESULTS = 0. 
* 
*         B.  CHECK FOR DIVIDE BY *0*.   SET RESULTS = INFINITE.
* 
*         C.  CHECK FOR DIVIDE BY *1*. IF NON-CONSTANT OPERAND NOT
*             INTEGER AND CONSTANT NOT REAL 1 - SET RESULTS = NON-CONST.
* 
*         D.  CHECK FOR DIVIDE BY REAL CONSTANT INTO REAL CONSTANT. 
*             IF SO AND *NOINVERT* IS NOT SET CHANGE CONSTANT TO 1/CONS 
*             AND CHANGE OPERATOR TO MULTIPLY.
* 
*         E.  IF DOMINANT MODE IS INTEGER AND 2ND OPERAND IS A CONSTANT,
*             CHECK IF CONSTANT IS A POWER OF 2.  IF SO CHANGE DIVIDE TO
*             *SHF2* OPERATOR TO PERFORM DIVIDE BY RIGHT SHIFT. 
  
  
 DIC      NZ     X1,DIC10    IF CONSTANT NOT *0*
          SB7    E.CR4
          ZR     B3,CCR.E0   IF DIVIDE INTO 0 (1ST OPERAND = 0) 
          SB2    X2-M.INT 
          SB7    E.CR3A 
          ZR     B2,CCR.E0   IF INTEGER DIVIDE
          SX6    1777B
          SX7    X2          MODE 
          LX6    48 
          RJ     NCS         ENTER CONSTANT 
          BX2    X6 
          SB7    E.CR3
          EQ     CCR.NE      OUTPUT FATAL ERROR - SET RESULTS = 1777BS42
  
 DIC10    ZR     B3,CCR.IG   IF SECOND OPERAND NOT CONSTANT 
          =X7    1
          IX0    X7-X1
          NZ     X0,DIC15    IF CONSTANT NOT *1*
          SB7    E.CR6
          EQ     CCR.EC      OUTPUT NOTE ERROR - SET RESULTS = NON CONST
  
 DIC15    SX0    1.0/1S42 
          LX0    P.SHC
          IX0    X0-X1
          NZ     X0,DIC20    IF CONSTANT NOT *1.0*
          BX0    X2 
          AX0    18 
          NZ     X0,DIC20    IF MODE CONVERSION 
          SB7    E.CR6
          EQ     CCR.EC      OUTPUT NOTE ERROR - SET RESULTS = NON CONST
  
**        CHECK IF DIVIDE CAN BE CHANGED TO A RECIPROCAL MULTIPLY.
  
 NOINVERT IFEQ   NOINVERT 
 DIC20    BX0    X2 
          AX0    18 
          NZ     X0,CCR.IG   IF MODE CONVERSION 
          =B7    X2-M.INT 
          NZ     B7,DIC22    IF DOMINANT MODE NOT *INTEGER* 
          SX6    X1-1 
          BX7    X1*X6
          NZ     X7,CCR.IG1  IF NOT POWER OF *2*
          NX0,B7 X1 
          SA3    DIVP2
          SB7    B7-47
          SX5    -B7
          BX7    X3 
          LX5    P.PTAGM
          =X6    0           INDICATE NO REDUCTION
          SA7    SOPR 
          EQ     EXIT.
  
 DIC22    =B7    X2-M.REAL
          NZ     B7,CCR.IG1  IF DOMINANT MODE NOT *REAL*
          BX6    X4 
          SA6    SCR+2       SAVE 1ST OPERAND 
          BX7    X1 
          LX6    X5 
          SA1    =1.0 
          =A6    A6+1        SAVE 2ND OPERAND 
          BX2    X7 
          SA3    SOPR 
          SA7    SCR         SAVE ORGINAL CONSTANT
          RJ     PCA         PERFORM DIVIDE 
          NZ     B7,DIC30    IF NO ERROR IN CONVERTING
  
**        IF ERROR IN CONVERTING TO RECIPROCAL
  
 DIC25    SA4    SCR+2       RELOAD OPERANDS
          SA3    SOPR 
          =A5    A4+1 
          BX6    0
          EQ     EXIT.
  
 DIC30    SA6    SCR+1       SAVE RESULTING TAG 
          SA1    RTER        LOAD RESULTS 
          =A2    A6-1        ORGINAL CONSTANT 
          SX3    O.MULT 
          RJ     PCA         PERFORM MULTIPLY  (1/CON) * CON
          SA2    =1.0 
          SA1    RTER 
          IX6    X1-X2
          NZ     X6,DIC25    IF (1/CON) * CON  .NE. 1 - IGNORE
          SA5    SCR+1       RESULTING TAG
          MX0    -L.SBPR
          =A4    A5+1 
          SX1    MULT.R 
          =X3    O.MULT 
          LX1    P.JPAD 
          IX6    X1+X3       CHANGE DIVIDE TO MULTIPLY
          SA6    SOPR 
          BX3    X6 
          =X6 
          EQ     EXIT.
 NOINVERT ELSE
 DIC20    BSS    0
 NOINVERT ENDIF 
 CCR.IG   SPACE  4,8
**        HERE IF NO CONSTANT REDUCTION.
* 
*         CHECK FOR MODE CONVERSION AT COMPILE TIME OF CONSTANT.
*         EXIT   (X6) ALWAYS = 0. 
  
 CCR.IG   RJ     CMC
 CCR.IG1  =X6    0           INDICATE NO REDUCTION
          SA3    SOPR        RELOAD OPERATOR
          EQ     EXIT.
 CONMESS  SPACE  4,8
**        OUTPUT  FATAL/NOTE/WARNING MESSAGES INVOLVING CONSTANTS 
*         USED AS OPERANDS. 
* 
*         EXPRESSION REDUCES TO CONSTANT 0. 
*         (X2) = (SMOD) 
*         (B7) = ERROR ADDRESS. 
  
 CCR.E0   SX0    X2          RESULTANT MODE ONLY
          SA3    CONZER 
          IX6    X3+X0       ZERO RESULTS.
  
**        OUTPUT ERROR - EXIT.. 
*         (X6) = RESULTS /FLAG
*         (B7) = ERROR ADDRESS. 
  
 CCR.NE   ZR     B7,EXIT.    IF TRANSPARENT TO USER REDUCTION 
          BX2    X6          SAVE RESULTS / FLAG
          WARN   B7          OUTPUT ERROR.
          BX6    X2          RESULTS. 
          EQ     EXIT.
  
**        EXPRESSION ELIMINATED.
*         (B3) = CONSTANT FLAG
  
 CCR.EC   BX6    X5 
          ZR     B3,CCR.NE   IF 1ST = CONSTANT, RESULTS = 2ND OPERAND 
          BX6    X4 
          EQ     CCR.NE 
  
**        CONSTANT OUT OF RANGE - NON-STANDARD CONSTANT.
* 
*         (B7) = ERROR ADDRESS
  
 CCR.RX   SA1    SOPR 
          SA3    X1+CON.DPC-O.PL
          BX6    X3 
          SA2    SMOD 
          SA6    FILL.
          EQ     CCR.E0      CONTINUE 
 CMO      SPACE  4,8
**        CMO -  CHECK FOR MASK OPERAND.
* 
*         IF (X1) = (2**N-1), (X6) = -(2**N-1)
* 
*         ENTRY  (B3) = 0, 1ST = CONSTANT 
*                       1, 2ND = CONSTANT 
*                (X1) = CONSTANT
*                (X2) = (SMOD)
* 
*         EXIT   (X6) " 0, CONSTANT CHANGED TO -(CONSTANT)
*                (TER2) = BINARY OF CONSTANT. 
  
  
 CMO      SUBR               ENTRY/EXIT...
          BX6    0           INDICATE FAILURE 
          ZR     B3,EXIT. 
          SB7    X2-M.INT 
          =X0    1
          NZ     B7,EXIT.    IF NOT INTEGER 
          IX0    X1+X0
          BX7    X0*X1
          NZ     X7,EXIT.    IF NOT -(POWER OF 2) 
          BX6    -X1
          =X7    M.INT
          SA6    TER2 
          RJ     NCS
          EQ     EXIT.
 COC      SPACE  4,8
**        COC -  CHECK OPERAND CONSTANT FOR NON-STANDARD. 
* 
*         ENTRY  (X0) = MODE OF CONSTANT. 
*                (X1) = CONSTANT
* 
*         EXIT   (B7) > 0, NON-STANDARD CONSTANT. 
*                (X1) = ALWAYS PRESERVED. 
* 
*         CANNOT DESTROY - B2,B3,B4,B5,B6  X1,X4,X5,X7
  
  
 COC      SUBR               ENTRY/EXIT.. 
          NZ     X0,COC1     IF NOT MODELESS CONSTANT 
          SA2    SMOD 
          BX0    X2 
 COC1     SB7    X0-M.REAL
          MI     B7,EXIT.    IF NOT FLOATING POINT
          =B7    -1 
          OR     X1,COC2     IF CONSTANT INFINITE 
          ID     X1,COC2     IF CONSTANT INDEFINITE 
          EQ     EXIT.
 COC2     SB7    E.CR7
          EQ     EXIT.
 CIR      SPACE  4,5
**        CIR  -  CHECK IF LEGAL INTEGER. 
*         *CIR* CHECKS THE SUPPLIED CONSTANT TO SEE IF IT IS AN 
*         INTEGER USED IN CONJUNCTION WITH AN * OR /, IF SO *CIR* 
*         ISSUES A FATAL DIAGNOSTIC.  IF THE CONSTANT IS INVOLVED 
*         IN A TURPLE WHOSE DOMINANT MODE IS REAL, *CIR* CHECKS 
*         WHETHER IT MAY PERFORM A CONVERSION.  IF IT MAY, IT WILL, 
*         ISSUING DIAGNOSTICS AS NECESSARY. 
* 
*         ENTRY  (X0) = MODE OF CONSTANT. 
*                (X2) = OPERATOR FORM OF CONSTANT 
*                (X6) = BINARY OF CONSTANT. 
* 
*         EXIT   AS ENTRY.
* 
*         USES   X1,X3,X7,B2,B7 
  
 CIR0     AX1    60-12
          ZR     X0,CIR      IF CONSTANT MODE UNIVERSAL 
          ZR     X1,CIR1     IF INTEGER .LT. 2**48
          BX3    X0          SAVE X0 TEMPORARILY
          FATAL  E.CR9
          BX0    X3 
          EQ     CIR
  
 CIR1     SA1    A1 
          LX1    -18
          SB2    X1 
          AX1    18 
          ZR     B2,CIR      IF NO MODE CONVERSION
          SB7    B2-B7
          LX1    2*18 
          ZR     B7,CIR      IF NO CONVERSION FOR THIS CONSTANT 
          PX6    B0,X6       CONVERT
          BX7    X1 
          NX6    B0,X6
          SX0    M.REAL      SET CONSTANT TYPE EQUAL TO M.REAL
          SA7    A1          RESET SMOD 
          SA6    CIRA        PRESERVE THE BINARY CONSTANT 
          LX7    X0 
          RJ     NCS
          LX2    X6 
          SA1    CIRA 
          BX6    X1          RESTORE THE BINARY OF THE CONSTANT 
  
 CIR      SUBR
          SB2    X0-M.REAL
          PL     B2,EXIT.    IF CONSTANT NOT INTEGER OR OCTAL 
          SA1    SOPR        CURRENT OPERATOR 
          MX3    -2 
          LX3    -8 
          SB2    X1 
          NO
          SA1    SMOD 
          LX3    B2,X3
          SB2    X1-M.REAL
          NO
          BX1    X6 
          ZR     B2,CIR0     IF DOMINANT MODE IS REAL 
          MI     X3,EXIT.    IF OPERATOR IS + OR -
          AX1    60-12
          ZR     X1,CIR1     IF INTEGER .LT. 2**48
          BX3    X0          SAVE X0 TEMPORARILY
          FATAL  E.CR8
          BX0    X3 
          EQ     CIR
  
 CIRA     BSS    1
 PCA      EJECT  4,20 
**        PCA -  PERFORM COMPILE TIME ARITHMETIC. 
* 
*         ENTRY  (X1) = 1ST CONSTANT
*                (X2) = 2ND CONSTANT
* 
*         NOTE   BOTH (X1) AND (X2) MUST BE OF MODE 
*                            MODLS,INTEGER, OR REAL 
* 
*                (X3) = O.XX FOR OPERATOR.
*                       MAY BE ANY OF THE FOLLOWING --
*                        1.  O.PL 
*                        2.  O.MIN
*                        3.  O.MULT 
*                        4.  O.DIV
* 
*         EXIT   (B7) > 0, TERM REDUCED 
*                (X6) = TAG FOR RESULTS 
*                (RTER) = RESULTS IN BINARY OF REDUCTION. 
* 
*                (B7) = 0, ERROR IN REDUCTION.
* 
*         USES   A1,A2,A3,A4,A5  X0  B2,B3,B7 
*         CELLS  (SCR+4) TO SAVE O.XX 
* 
*         CALLS  COC - TO CHECK RESULTS.
*                NCS - TO ENTER CONSTANT. 
  
  
 PCA      SUBR               ENTRY/EXIT...
          BX6    X3 
          SA6    SCR+4       SAVE OPERATOR
          BX6    X1 
          SA4    SMOD 
          SB2    X4          DOMINANT MODE
          SX5    X3-O.PL
          SX7    X4          MODE BITS
          BX0    -X5
          NZ     B2,PCA15    IF MODE NOT UNIVERSAL
          =B2    M.INT       PROCESS AS INTEGER 
          =X7    M.INT       MODE OF RESULT, INTEGER
          SA7    SMOD 
  
 PCA15    SA3    B2+PCA22-M.INT 
          SB2    X0 
          LX5    4           *16
          MX0    -15
          SB2    X5+B2       *15
          AX3    B2,X3
          BX0    -X0*X3 
          SB2    X0 
          SA3    CO.RND 
          JP     B2          JUMP TO PROCESSOR. 
  
          POPMAC JUMPTO 
 JUMPTO   MACRO  ARG,MODE 
 .1       IRP    ARG
          VFD    15/MODE.ARG
 .1       IRP 
 JUMPTO   ENDM
 PCA22    JUMPTO (DIV,MU,MI,PL),INT 
          JUMPTO (DIV,MU,MI,PL),REAL
  
**        DOMINANT MODE = UNIVERSAL / INTEGER.
  
 INT.PL   IX6    X1+X2
          EQ     PCA40       CONTINUE 
  
 INT.MI   IX6    X1-X2
          EQ     PCA40       CONTINUE.
  
 INT.MU   FX3    X1*X2       CHECK FOR OVERFLOW 
          IX6    X1*X2       INTEGER MULTIPLY 
          NZ     X3,PCA30 
          EQ     PCA40       CONTINUE.
  
 INT.DIV  IX6    X1/X2
          EQ     PCA40       CONTINUE.
  
**        DOMINANT MODE = REAL. 
  
 REAL.PL  FX0    X1+X2
          LX3    1R+         FADD BIT 
          NX6    X0 
          PL     X3,PCA40    IF ROUNDED NOT SELECTED
          RX0    X1+X2
          NX6    X0 
          EQ     PCA40       CONTINUE.
  
 REAL.MI  FX0    X1-X2
          LX3    1R-         FSUB BIT 
          NX6    X0 
          PL     X3,PCA40    IF ROUNDED NOT SELECTED
          RX0    X1-X2
          NX6    X0 
          EQ     PCA40       CONTINUE.
  
 REAL.MU  FX6    X1*X2
          LX3    1R*         FMULT BIT
          PL     X3,PCA40    IF ROUNDED NOT SELECTED
          RX0    X1*X2
          EQ     PCA40       CONTINUE.
  
 REAL.DIV FX6    X1/X2
          LX3    1R/         FDIV BIT 
          PL     X3,PCA40    IF ROUNDED NOT SELECTED
          RX0    X1/X2
          EQ     PCA40       CONTINUE.
  
**        REDUCTION PERFORMED 
*         (X6) = BINARY OF ARITHMETIC PERFORMED.
*         (X7) = MODE OF RESULTS
  
 PCA30    FATAL  E.CR10 
  
 PCA40    SA6    RTER        SAVE BINARY OF REDUCTION 
          SA3    SCR+4
          BX1    X6 
          SX0    X7          MODE OF CONSTANT 
          RJ     COC         CHECK IF RESULTING CONSTANT IN RANGE 
          PL     B7,PCA.RX   IF OUT OF RANGE
          BX6    X1 
          RJ     NCS         ADD TO RESULTS TO CON TABLE
          =B7    1           INDICATE REDUCTION 
          EQ     EXIT.
  
**        IF UNDEFINED ARITHMETIC OPERATION.
*         ONE OF OPERANDS IS NON-STANDARD 
* 
*         ENTRY  (B7) = ERROR ADDRESS 
*                (X3) = O.XX
  
 PCA.RX   SB2    X3-O.PL
          SA4    B2+CON.DPC 
          SA2    SMOD 
          BX6    X4 
          SA1    CONZER 
          SA6    FILL.       SET OPERATOR DPC INTO FILL. FOR ERROR
          SX0    X2 
          IX2    X0+X1       SET RESULTS = 0
          FATAL  B7 
          BX6    X2 
          =B7    0           INDICATE ERROR IN REDUCTION
          EQ     EXIT.
  
 TER1     DATA   0
 TER2     DATA   0
 RTER     DATA   0           RESULTS OF REDUCTION PERFORMED BY *PCA* IN 
                             BINARY 
 CMC      EJECT  4,20 
**        CMC -  CHECK FOR REDUCTION IN MODE CONVERSION OF CONSTANT.
* 
*                THIS ROUTINE IS NOT INTENDED TO CATCH ALL COMPILE TIME 
*         MODE CONVERSIONS.  BUT IT IS SUPPOSE TO CATCH TYPICAL 
*         PROGRAMMER ERRORS WHEN DEALING WITH CONSTANT EXPRESSIONS, 
*         IE.         A=1.0        AS      A=1
* 
*         ENTRY  (X1) = CONSTANT. 
*                (X2) = (SMOD), 24/0,18/MODE CONV,18/DOMINANT MODE
*                (X3) = (SOPR)
*                (B3) = 0 IF 1ST = CONSTANT.
* 
*         EXIT   (B3) = PRESERVED.
*                (X1) = PRESERVED.
*                (X2) = (SMOD) ALTETER IF CONSTANT CONVERTED. 
*                (X3) = (SOPR) ALTERED IF CONSTANT CONVERTED TO (SMOD). 
* 
*                (SPOR) RESET IF CONVERSION PROCESSED.
*         USES   A1,A2,A3,A6,A7  X0  B2,B3,B7 
*                (SCR, SCR+1) 
*         CALLS  NCS
  
  
 CMCX     BX4    X0          IF 1ST = CONSTANT
          SX6    0
  
 CMC      SUBR   -           ENTRY/EXIT...
          =B7    X2-M.REAL
          AX2    18 
          ZR     X2,EXIT.    IF NO MODE CONVERSION
          SB2    X2          DOMINANT MODE
          NE     B2,B3,EXIT. IF CONSTANT IN DOMINANT MODE 
          SX6    B3 
          NZ     B7,EXIT.    IF NOT REAL
          SA6    SCR         SAVE CONSTANT POINTER
          PX1    X1 
          NX6    X1 
          =A6    A6+1 
          =X7    M.REAL 
          SA7    SMOD        RESET, INDICATING NO MODE CONVERSION 
          RJ     NCS         ENTER CONSTANT.
          MX1    L.MODC 
          SA3    SOPR 
          LX1    P.MODC+L.MODC
          SA2    SCR         RELOAD CONSTANT POINTER
          BX0    X6 
          BX6    -X1*X3 
          =A1    A2+1        LOAD ACTUAL CONVERTED CONSTANT.
          BX3    X6 
          SA6    A3          RESET *SOPR* 
          ZR     X2,CMCX     IF 1ST = CONSTANT
          BX5    X0 
          =X6    0
          EQ     EXIT.
 CSI      EJECT  4
**        CSI -  CHECK SHIFT INSTRUCTION USAGE. 
* 
* 
*         INSPIRATION BY --  C. BAGWELL   (SIGPLAN NOTICE)
*                                          VOLUME 5, NUMBER 7.
*                                          PAGE 56. 
* 
*         THE PURPOSE OF THIS LITTLE ROUTINE IS DEFINED BY THE TIMINGS O
*         AN INTEGER MULTIPLY FOR 6000 MACHINES.
* 
*                6400 TIME = 8.3 US 
*                6600 TIME = 2.2 US (INCLUDING SET OF CONSTANT) 
* 
*         THE CODE PRODUCED BY THIS ROUTINE TIMES OUT AT
*                6400      = 3.4 US (WORST CASE)
*                6600      = 1.8 US (WORST CASE)
* 
*         IT SEEMS OBVIOUS TO THIS PROGRAMMER, EVEN WITH INTEGER
*         MULTIPLY THAT THIS ROUTINE SHOULD BE LEFT ACTIVE.  ONE MIGHT
*         HAVE A POINT ON A 6600 FOR ONLY TRANSFORMING SIMPLE POWERS OF 
*         *2* -- BUT ...... 
* 
* 
*         *CSI* WILL SEE IF AN INTEGER MULTIPLY INSTRUCTION CAN BE
*         CHANGED TO ONE OF THE FORMS LISTED BELOW. 
* 
*          POWER OF 2       DIFFERENCE POWER OF 2      SUM POWER OF 2 
*         ---------------   ---------------------      ---------------
*         SA1   OPERAND     SA1   OPERAND              SA1   OPERAND
*         LX1   (K)         BX0   X1                   BX0   X1 
*         BX7    X1         LX1   (J)                  LX1   (K-J)
*                           LX0   (K)                  IX7   X1+X0
*                           IX7   X1-X0                LX7   (J)
*         O=SHFC            O=SHFD                     O=SHFS 
*         (IF FOUND THAT TERM IS (I*2), INSTEAD OF A O=SHFC MACRO,
*          IMULT2 MACRO IS PROCESSED, THUS PERFORMING MULTIPLY AS 
*          (I+I). ) 
* 
*         ENTRY  (X6)   = CONSTANT MULTIPLIER TO BE CHECKED.
*                (SOPR) = CURRENT OPERATOR. 
*                (B3)   = 0  1ST = MULTIPLIER.
*                       = 1  2ND = MULTIPLIER.
* 
*         EXIT   (B3) = 0 = INSTRUCTION CHANGED.
*                (X5) = MULTIPLIER. (IF CHANGED)
* 
*         USES   A1,A2,A3  X0,X5  B2,B7 
  
  
**        TRANSFORMATION PERFORMED. 
*         (X1) = SHIFT MULTIPLIER.
*         (X3) = NEW OPERATOR.
  
 CSIX     BX6    X3 
          NZ     B3,CSIX5    IF 2ND IS MULTIPLIER 
          LX4    X5 
 CSIX5    BX5    X1          MULTIPLIER TO 2ND OPERAND. 
          SA6    SOPR        RESET OPERATOR WORD. 
          LX5    P.PTAGM
  
  
 CSI      SUBR   -           ENTRY/EXIT...
          =X3    1
          IX1    X6-X3
          SB7    X6          SAVE MULTIPLIER
          BX0    X6*X1
          BX2    X1 
          AX2    17 
          NZ     X2,EXIT. 
          NZ     X0,CSI5     IF NOT SIMPLE POWER OF 2 
  
*         SET-UP SIMPLE POWER OF 2
  
          NX0,B7 X6          POWER
          SB7    B7-47       OFF BIAS 
          SA3    SHFC 
          SB7    -B7         SHIFT CONSTANT.
          BX6    X3 
          SX1    B7          K
          NE1    B7,CSIX     IF POWER NOT *1* 
          SB7    B3 
          SA3    IMULT2      PLUS OPERATOR FOR I+I
          LX7    X3 
          SB3    -1          FLAG NO CONSTANTS IN OPERATION 
          SA7    SOPR        RESET MULTIPLIER OPERATOR TO PLUS
          NZ     B7,CSI3     IF 2ND OPERAND IS CONSTANT 
          LX4    X5          OVERLAY CONSTANT WITH VARIABLE OPERAND 
          EQ     EXIT.
 CSI3     LX5    X4 
          EQ     EXIT.
  
*         NOT SIMPLE POWER OF *2*, CHECK IF SUM OF POWER OF *2* 
  
 CSI5     IX2    X0-X3
          SB2    X0          SAVE K PORTION 
          BX0    X0*X2
          NZ     X0,CSI10    IF NO SUM OF POWER OF 2
  
*         SET-UP SUM OF POWER OF 2
  
          SX2    B2          K   NUMBER 
          SX1    B7-B2       J   NUMBER 
          NX0,B2 X2 
          SB2    B2-47       -K  POWER
          NX0,B7 X1          J   NUMBER 
          SB2    -B2
          SB7    B7-47       -J  POWER
          SX2    -B7         J   POWER
          SA3    SHFS 
          SX0    B2+B7       K-J POWER
          LX0    18 
          IX1    X2+X0       J POWER + (K-J) POWER
          NZ     X2,CSIX     IF *J* POWER NOT *0* 
          SA3    SHFSA
          EQ     CSIX        SET EXIT CONDITIONS..
  
*         NOT SUM OF POWER OF *2*, CHECK IF DIFFERENCE OF POWER OF *2*
  
 CSI10    BX7    X6+X1
          IX0    X7+X3
          BX2    X0*X7
          NZ     X2,CSI20    IF NOT DIFFERENCE OF POWER OF *2*
          BX2    X6-X1       2**J+1 - 1 
  
*         SET-UP DIFFERENCE OF POWER OF 2 
  
          NX1,B2 X2 
          SB2    B2-47
          SX1    B7 
          SX2    -B2         J   POWER
          NX0,B7 X1          K+J POWER
          SB7    B7-48
          SA3    SHFD 
          SX0    -B7         K   POWER
          LX2    18 
          IX1    X2+X0       J .OR. K 
          NZ     X2,CSIX     IF *J* POWER NOT ZERO. 
          SA3    SHFDS
          EQ     CSIX        SET EXIT CONDITIONS. 
  
*         NOT SUM, DIFFERENCE OF POWER OF *2*, CHECK IF (N-1) IS EITHER 
*         SUM OR DIFFERENCE 
  
 CSI20    BSS    0
          EQ     EXIT.
 LCT      SPACE  4,12 
**        LCT -  LOAD BINARY OF CONSTANT. 
* 
*         ENTRY  (X1)= PROPOSED CONSTANT. 
* 
*         EXIT   IF CONSTANT FOUND. 
*                (B2) =   1 = SHORT CONSTANT. 
*                (B2) =  -1 = CONSTANT (K-TAG)
*                (X0) = MODE. 
*                (X6) = CONSTANT (1ST WORD) 
*                (X7) = CONSTANT (2ND WORD, B2 = -1, LONG BIT ON) 
*                (X1=X6, X2=X7, TRUE IF LONG BIT SET) 
* 
*                IF CONSTANT NOT FOUND. 
*                (B2) =   0 = NO CONSTANT.
*                (X0) = MODE
*                (X6) = 0 
* 
*         USES   A1,A2  X0  B2,B7 
  
  
 LCT1     LX2    X1 
          BX0    -X0*X1 
          SB7    X0-M.REAL
          AX1    P.SHC
          =B2    1           INDICATE SHORT CONSTANT
          BX6    X1 
          LX6    P.SHC
          ZR     B7,LCT      IF REAL CONSTANT 
          BX6    X1 
          NZ     X1,LCT      IF CONSTANT NOT *0*
          AX2    P.2BIAS
          ZR     X2,LCT      IF TRUE *0* CONSTANT 
          MX1    1
          SB7    X2-1 
          AX6    B7,X1       GENERATE *MASK* TYPE CONSTANT
  
 LCT      SUBR               ENTRY/EXIT...
          =X2    M.SHORT
          MX0    -L.MODE
          BX6    X2*X1
          NZ     X6,LCT1     IF SHORT CONSTANT
          LX7    X1 
          BX0    -X0*X1 
          AX7    P.TGB
          SA2    TS.CON 
          BX6    0           =0, NO CONSTANT
          =B7    X7-C.CON/1S13
          =B2    0           INDICATE NO CONSTANT.
          NZ     B7,EXIT.    IF NOT *CONSTANT*
  
          AX1    P.TAG
          SB2    X1-C.CON 
          SA1    X2+B2       LOAD CONSTANT (1ST WORD) 
          =B7    1           INDICATE CONSTANT
          =A2    A1+1        LOAD CONSTANT (2ND WORD) 
          =B2    -1          INDICATE NOT SHORT CONSTANT
          BX6    X1          1ST WORD 
          LX7    X2          2ND WORD 
          EQ     EXIT.
          LIST   D
          END 
