*DECK CONSAM
USETEXT   TSOURCE 
USETEXT   TCEXECQ 
USETEXT   TCOM37Q 
USETEXT   TCOM39Q 
USETEXT   TCOM78Q 
USETEXT   TC7DECS 
PROC CONSAM; # CONSTANT ARITHMETIC MODULE # 
BEGIN 
*CALL COMEX 
ARRAY [0:3]S(1); ITEM 
    R0 R (0,0,60),      I0 I (0,0,60),
    R1 R (1,0,60),      I1 I (1,0,60),
    R2 R (2,0,60),      I2 I (2,0,60),
    R3 R (3,0,60)=[0.0],I3 I (3,0,60);
  
    XDEF FUNC CIAOP;
    XDEF FUNC CIREL B;
    XDEF PROC CKDOP;
    XDEF PROC CKIOP;
    XDEF FUNC CRAOP R;
    XDEF FUNC CRREL B;
    XREF FUNC ITOJ$;
    XREF FUNC XTOI$ R;
    XREF FUNC XTOY$ R;
    DEF J842 #842#;                                                      CONSAM 
    DEF J843 #843#;                                                      CONSAM 
    XREF PROC SYMABTL;                                                   CONSAM 
CONTROL EJECT;
PROC CKDOP(A); #CHECK INDEFINITE OPERAND# 
    BEGIN 
    ITEM A; 
    ITEM I; 
    I=B<0,12>A; 
    IF I EQ O"1777" OR I EQ O"6000" THEN
         BEGIN #INDEFINITE OPERAND# 
         SYMABTL(J842,"INFINITE OPERAND(CKIOP IN CONSAM) LINE XXXXX",    CONSAM 
                 44,LINUM);                                              CONSAM 
         END
    END 
CONTROL EJECT;
PROC CKIOP(A); #CHECK INFINITE OPERAND# 
    BEGIN 
    ITEM A; 
    ITEM I; 
    I=B<0,12>A; 
    IF I EQ O"3777" OR I EQ O"4000" THEN
         BEGIN #INFINITE OPERAND# 
         SYMABTL(J843,"INDEFINITE OPERAND(CKIOP IN CONSAM) LINE XXXXX",  CONSAM 
                 46,LINUM);                                              CONSAM 
         END
    END 
CONTROL EJECT;
FUNC CIAOP(P0,P1,P2); #CONSTANT INTEGER ARITHMETIC OPERATION# 
    BEGIN 
    ITEM P0,P1,P2 S:QAOP; 
    SWITCH CIASW:QAOP 
              IPL:PLUS, 
              ISB:SUB,
              IML:MUL,
              IDV:DIV,
              IEX:IIEX, 
              IMD:MOD,
              IMN:MNUS, 
              IAB:ABS,
              ILR:LOR,
              IND:LAND, 
              IXR:LXOR, 
              IQV:LEQV, 
              IMP:LIMP, 
              ICM:COMP; 
    I0[0]=P0; I1[0]=P1; I2[0]=P2; 
    GOTO CIASW[I2[0]];
IMN:CIAOP=I3[0]-I0[0]; RETURN; #FOILS MINUS ZERO# 
IMD:CIAOP=I0[0]-(I0[0]/I1[0])*I1[0]; RETURN;
IEX:      IF I0[0] EQ 2 THEN
            BEGIN   ITEM I; 
           I =0;
           B<59-I1[0] > I =  1; 
           CIAOP = I; 
           END
         ELSE 
           CIAOP = ITOJ$ ( I0[0] , I1[0] ); 
         RETURN;
IAB:CIAOP=ABS(I0[0]); RETURN; 
ICM:CIAOP=LNO I0[0]; RETURN;
ILR:CIAOP=I0[0] LOR I1[0]; RETURN;
IND:CIAOP=I0[0] LAN I1[0]; RETURN;
IXR:CIAOP=I0[0] LXR I1[0]; RETURN;
IQV:CIAOP=I0[0] LQV I1[0]; RETURN;
IMP:CIAOP=I0[0] LIM I1[0]; RETURN;
IPL:CIAOP=I0[0]  +  I1[0]; RETURN;
ISB:CIAOP=I0[0]  -  I1[0]; RETURN;
IML:  
               # AVOID INT MULT TRUNCATION TO 48 BITS   # 
         CIAOP =  (  B< 0 , 30> I0[0]  * B<30,30> I1[0] 
                  +  B<30 , 30> I0[0]  * B< 0,30> I1[0]   ) 
                  *   2**30 
                  +  B<30 , 30> I0[0]  * B<30,30> I1[0]     ; 
         RETURN;
IDV:CIAOP=I0[0]  /  I1[0]; RETURN;
    END 
CONTROL EJECT;
FUNC CIREL(P0,P1,P2) B; #CONSTANT INTEGER RELATIONAL# 
    BEGIN 
    ITEM P0,P1,P2 S:QRLTL;
    SWITCH CIRSW:QRLTL
              IEQ:EQ, 
              INQ:NQ, 
              ILS:LS, 
              IGR:GR, 
              ILQ:LQ, 
              IGQ:GQ, 
              ITR:TR, 
              IFL:FL; 
    I0[0]=P0-P1;
    CIREL=FALSE;
    GOTO CIRSW[P2]; 
IEQ:IF I0[0] EQ 0 THEN CIREL=TRUE; RETURN;
INQ:IF I0[0] NQ 0 THEN CIREL=TRUE; RETURN;
ILS:IF I0[0] LS 0 THEN CIREL=TRUE; RETURN;
IGR:IF I0[0] GR 0 THEN CIREL=TRUE; RETURN;
ILQ:IF I0[0] LQ 0 THEN CIREL=TRUE; RETURN;
IGQ:IF I0[0] GQ 0 THEN CIREL=TRUE; RETURN;
ITR:CIREL=TRUE; RETURN; 
IFL:CIREL=FALSE;RETURN; 
    END 
CONTROL EJECT;
FUNC CRAOP(P0,P1,P2) R; #CONSTANT REAL ARITHMETIC OPERATION#
    BEGIN 
    ITEM P0 R, P1 R, P2 S:QAOP; 
    SWITCH CRASW:QAOP 
              RPL:PLUS, 
              RSB:SUB,
              RML:MUL,
              RDV:DIV,
              RIEX:RIEX,
              RREX:RREX,
              RMN:MNUS, 
              RAB:ABS;
    R0[0]=P0; R1[0]=P1; I2[0]=P2; 
    CKDOP(R0[0]); CKIOP(R0[0]); 
    IF TWOP[I2[0]] AND I2[0] NQ QAOP"RIEX" THEN 
       BEGIN
       CKDOP(R1[0]); CKIOP(R1[0]);
       END
    GOTO CRASW[I2[0]];
RMN:CRAOP=R3[0]-R0[0]; RETURN; #FOILS MINUS ZERO# 
RAB:CRAOP=ABS(R0[0]); RETURN; 
RIEX:CRAOP=XTOI$(R0[0],I1[0]); RETURN;
RREX: RETURN;  # NOT USED#
RPL:CRAOP=R0[0]+R1[0]; RETURN;
RSB:CRAOP=R0[0]-R1[0]; RETURN;
RML:CRAOP=R0[0]*R1[0]; RETURN;
RDV:CRAOP=R0[0]/R1[0]; RETURN;
    END 
CONTROL EJECT;
FUNC CRREL(P0,P1,P2) B; #CONSTANT REAL RELATIONAL#
    BEGIN 
    ITEM P0 R, P1 R, P2 S:QRLTL;
    SWITCH CRRSW:QRLTL
              REQ:EQ, 
              RNQ:NQ, 
              RLS:LS, 
              RGR:GR, 
              RLQ:LQ, 
              RGQ:GQ, 
              RTR:TR, 
              RFL:FL; 
    R0[0]=P0; R1[0]=P1; I2[0]=P2; 
    CKDOP(R0[0]); CKIOP(R0[0]); 
    CKDOP(R1[0]); CKIOP(R1[0]); 
    R0[0]=R0[0]-R1[0];
    CRREL=FALSE;
    GOTO CRRSW[I2[0]];
REQ:IF R0[0] EQ 0 THEN CRREL=TRUE; RETURN;
RNQ:IF R0[0] NQ 0 THEN CRREL=TRUE; RETURN;
RLS:IF R0[0] LS 0 THEN CRREL=TRUE; RETURN;
RGR:IF R0[0] GR 0 THEN CRREL=TRUE; RETURN;
RLQ:IF R0[0] LQ 0 THEN CRREL=TRUE; RETURN;
RGQ:IF R0[0] GQ 0 THEN CRREL=TRUE; RETURN;
RTR:CRREL=TRUE; RETURN; 
RFL:CRREL=FALSE;RETURN; 
    END 
END 
TERM
