*DECK GARITH
          IDENT  GARITH 
          TITLE  GARITH - ARITHMETIC GENERATOR
  
          MACHINE  ANY,I
          SST 
          COMMENT  ARITHMETIC PROCESSOR 
          SPACE  4
**        GARITH -  ARITHMETIC PROCESSOR
* 
*         CONTAINS: 
* 
*                CGADD     - ADD
*                CGADDRN   - ADD ROUNDED
*                CGDIV     - DIVIDE 
*                CGDIVRN   - DIVIDE ROUNDED 
*                CGEXP     - EXPONENTIATE 
*                CGMULT    - MULTIPLY 
*                CGMULTR   - MULTIPLY ROUNDED 
*                CGREM     - REMAINDER
*                CGREMRN   - REMAINDER ROUNDED
*                CGSUB     - SUBTRACT 
*                CGSUBRN   - SUBTRACT ROUNDED 
*                ROUND     - PERFORM ADDITION FOR ROUNDING
  
  
  
  
  
 CONTROL  OPSYN  NIL
  
  
  
  
  
 GARITH   MODULE
  
 AUXPTR   EQU    T12
 INTSIZ   EQU    T11
 NCOMP1   EQU    T8 
 NCOMP2   EQU    T9 
 NDISP    EQU    T10
 DUM      EQU    REGT1
 NSIZE1   EQU    T2 
 NSIZE2   EQU    T3 
 OPND1    EQU    REGB 
 OPND2    EQU    REGC 
 POINT    EQU    T7 
 PREC     EQU    T20
 RECV     EQU    REGU1
 RESULT   EQU    REGD 
 REMAIN   EQU    REGE 
 SAVREG   EQU    REGJ 
 SIGN     EQU    T5 
 VREGA    EQU    VREG21      SAVED ACROSS MOVER CALL
 VREGB    EQU    VREG1
 VREGC    EQU    VREG2
 VREGD    EQU    VREG3
 VREGE    EQU    VREG4
 VREGF    EQU    VREG5
 VREGG    EQU    VREG36      FOR SAVING QUOTIENT ACROSS ROUNDED MOVE
  
*      VALUES FOR MULTVERB AND DIVDVERB FROM DPPPMACRO
 DIVDVERB EQU    146
 MULTVERB EQU    217
  
  
  
 ERRLAB   SETSY  (LOCAL$OF,LABERR)
 SIXES    SETSY  (EXT$OF,C.SIXES) 
 SIZERR   SETSY  (EXT$OF,C.SIZER) 
 ZEROS    SETSY  (EXT$OF,C.ZEROS) 
  
 INT      EQU     1 
 REAL     EQU     2 
 DP       EQU    3
  
 CGADD    KNIL   CGADD
 CGADDRN  KNIL   CGADDRN
 CGDIV    KNIL   CGDIV
 CGDIVRN  KNIL   CGDIVRN
 CGEXPON  KNIL   CGEXPON
 CGMULT   KNIL   CGMULT 
 CGMULTR  KNIL   CGMULTR
 CGREM    KNIL   CGREM
 CGREMRN  KNIL   CGREMRN
 CGSUB    KNIL   CGSUB
 CGSUBRN  KNIL   CGSUBRN
 ROUND    KNIL   ROUND
  
 ADPDNAT  LINK   ADPDNAT
 CRDNAT   LINK   ADNAT
 BINVAL   LINK   BINVAL 
 CPYDNAT  LINK   CPYDNAT
 MOVER    LINK   CGMOVE 
 MOVERN   LINK   CGMOVER
 SUBDNAT  LINK   SUBDNAT
 LITMULT  LINK   GLITMUL
  
  
 POOLIT   LABEL 
          EXECUTE LITPOOL 
          RETURN
  
  
 CGADD    EGO    1
          MOVEZ  0,SUBTR
          MOVEZ  0,RND
          CALLZ  ADDSUB 
          RETURN
  
 CGADDRN  EGO    1
          MOVEZ  0,SUBTR
          MOVEZ  1,RND
          CALLZ  ADDSUB 
          RETURN
  
 CGDIV    EGO    1
          MOVEZ  0,REM
          MOVEZ  0,RND
          CALLZ  DIVIDE 
          RETURN
  
 CGDIVRN  EGO    1
          MOVEZ  0,REM
          MOVEZ  1,RND
          CALLZ  DIVIDE 
          RETURN
  
 CGEXPON  EGO    1
          CALLZ  EXP
          RETURN
  
 CGMULT   EGO    1
          MOVEZ  0,RND
          CALLZ  MULTIPLY 
          RETURN
  
 CGMULTR  EGO    1
          MOVEZ  1,RND
          CALLZ  MULTIPLY 
          RETURN
  
 CGREM    EGO    1
          MOVEZ  1,REM
          MOVEZ  0,RND
          CALLZ  DIVIDE 
          RETURN
  
 CGREMRN  EGO    1
          MOVEZ  1,REM
          MOVEZ  1,RND
          CALLZ  DIVIDE 
          RETURN
  
 CGSUB    EGO    1
          MOVEZ  1,SUBTR
          MOVEZ  0,RND
          CALLZ  ADDSUB 
          RETURN
  
 CGSUBRN  EGO    1
          MOVEZ  1,SUBTR
          MOVEZ  1,RND
          CALLZ  ADDSUB 
          RETURN
          TITLE  ADDSUB - ADD OR SUBTRACT 
* 
*         ADDSUB -  GENERATE ADD OR SUBTRACT
* 
 ADDSUB   LABEL 
          CALLZ  GETPREC     DETERMINE REQUIRED PRECISION 
          ORZ    (SIGNOF,OPND1),(SIGNOF,OPND2),T1 
          ORZ    T1,SUBTR,CSIGN        RESULT SIGN
          MAXZ   (POINTOF,OPND1),(POINTOF,OPND2),CPOINT 
  
          GOTOCASE  (TYPEOF,OPND1)
            CASE    COMP,ADD1 
            CASE    COMP1,ADD2
            CASE    COMP2,ADD3
          CASE   COMP4,ADD2 
            CASE    DPCOMP2,ADD4
            CASE   INDXDATA,ADD2
          ENDCASE 
          ERROR 
  
*      OPERAND1 DISPLAY 
 ADD1     LABEL 
          GOTOCASE  (TYPEOF,OPND2)
            CASE    COMP,PDSPDSP
            CASE    COMP1,PDSPC1
            CASE    COMP2,PDSPC2
          CASE   COMP4,PDSPC1 
            CASE    DPCOMP2,PDSPDC2 
            CASE   INDXDATA,PDSPC1
          ENDCASE 
          ERROR 
  
*      OPERAND  COMP-1 OR COMP-4
 ADD2     LABEL 
          GOTOCASE  (TYPEOF,OPND2)
            CASE    COMP,PC1DSP 
            CASE    COMP1,PC1C1 
            CASE    COMP2,PC1C2 
          CASE   COMP4,PC1C1
            CASE    DPCOMP2,PC1DC2
            CASE   INDXDATA,PC1C1 
          ENDCASE 
          ERROR 
  
*      OPERNAD1 COMP2 
 ADD3     LABEL 
          GOTOCASE  (TYPEOF,OPND2)
            CASE    COMP,PC2DSP 
            CASE    COMP1,PC2C1 
          CASE   COMP4,PC2C1
            CASE    COMP2,PC2C2 
            CASE    DPCOMP2,PC2DC2
            CASE   INDXDATA,PC2C1 
          ENDCASE 
          ERROR 
  
*      OPERAND1  DPCOMP2
 ADD4     LABEL 
          GOTOCASE  (TYPEOF,OPND2)
            CASE    COMP,PDC2DSP
            CASE    COMP1,PDC2C1
            CASE    COMP2,PDC2C2
          CASE   COMP4,PDC2C1 
            CASE    DPCOMP2,PDC2DC2 
            CASE   INDXDATA,PDC2C1
          ENDCASE 
          ERROR 
          TITLE  PDSPDSP -  DISPLAY +/- DISPLAY 
* 
*         PDSPDSP -  DISPLAY +/- DISPLAY
* 
 PDSPDSP  LABEL 
          MAXZ   (INTLENOF,OPND1),(INTLENOF,OPND2),T3 
          ADDZ   T3,CPOINT,CSIZE       COMPOSITE SIZE - 1 
          EQZ    (GCODEOF,OPND1),GLITREF,T1 
          EQZ    (GCODEOF,OPND2),GLITREF,T2 
          ANDZ   T1,T2,T1 
          LTZ    CSIZE,15,T2
          ANDZ   T1,T2,T1 
          IFZ    T1,PLITLIT 
          IFZ    (CSIZE,LT,19),PDSPDSP1 
*      COMPOSITE SIZE EXCEEDS 18
          SUBZ   CPOINT,(POINTOF,OPND1),T1
          ADDZ   (NUMLENOF,OPND1),T1,NSIZE1 
          IFTHEN (NSIZE1,LT,15) 
            CALLZ  C2PDC2 
            RETURN
          ENDIFZ
          SUBZ   CPOINT,(POINTOF,OPND2),T1
          ADDZ   (NUMLENOF,OPND2),T1,NSIZE2 
          IFTHEN (NSIZE2,LT,15) 
            CALLZ  DC2PC2 
          ELSEZ 
            CALLZ  DC2PDC2
          ENDIFZ
          RETURN
          SPACE  3
 PDSPDSP1 LABEL 
          IFZ    (CSIZE,LT,9),INLINE
          IFZ    (CSIGN),CAD222 
          IFZ    (CSIZE,EQ,9),INLINE
          IFZ    (CSIZE,EQ,10),CAD112 
 CAD222   LABEL 
*      DISPLAY CODE ADD /SUBTRACT - DOUBLE PRECISION INPUT, OUTPUT
          ADDZ   1,CSIZE,CSIZE
          MOVEZ  OPND2,SAVREG 
          MOVEZ  1,P2        SIGNED, SIZE GQ 10 FORCES DOUBLE PRECISION 
          MOVEZ  COMP,P3
          MOVEZ  CSIZE,P4 
          MOVEZ  CPOINT,P5
          CALLZ  LDCOC1 
          MOVEZ  P1,VREGA    WORD 1,OPERAND 1 
          MOVEZ  1,P2 
          MOVEZ  SAVREG,REGB
          MOVEZ  COMP,P3
          MOVEZ  CSIZE,P4 
          MOVEZ  CPOINT,P5
          CALLZ  LDCOC1 
          MOVEZ  P1,VREGB    WORD 1,OPERAND 2 
          NOTE   CAD222 
          IFTHEN (SUBTR)
            GEN    COMPL,(VREGOF,VREGE),,VREGB
            GEN    COMPL,(VREGOF,VREGF),,(VREGP1OF,VREGB) 
            GENOBJ N=C.AD222,I=(VREGA,(VREGP1OF,VREGA),VREGE,VREGF),O=((
,VREGOF,VREGC),(VREGOF,VREGD))
          ELSEZ 
            GENOBJ N=C.AD222,I=(VREGA,(VREGP1OF,VREGA),VREGB,(VREGP1OF,V
,REGB)),O=((VREGOF,VREGC),(VREGOF,VREGD)) 
          ENDIFZ
          MOVEZ  COMP,P1
          CALLZ  STCOC1 
          RETURN
          SPACE  4
 INLINE   LABEL 
*      DISPLAY CODE ADD/SUBTRACT - SINGLE PRECISION INPUT, OUTPUT 
          MOVEZ  OPND2,SAVREG 
          MOVEZ  (SIGNOF,REGB),P2 
          MOVEZ  COMP,P3
          MOVEZ  CPOINT,P5
          MOVEZ  CSIZE,P4 
          CALLZ  LDCOC1 
          MOVEZ  P1,VREGA    OPERAND 1
          MOVEZ  SAVREG,REGB
          MOVEZ  (SIGNOF,REGB),P2 
          MOVEZ  COMP,P3
          MOVEZ  CSIZE,P4 
          MOVEZ  CPOINT,P5
          CALLZ  LDCOC1 
          MOVEZ  P1,VREGB    OPERAND 2
          NOTE   INLINE 
          IFTHEN (SUBTR)
            GENM  DSPSUB
              SYMP   ZEROS,SIXES
              REGP   VREGA,VREGB,(VREGOF,VREGC) 
            ENDG
          ELSEZ 
            GENM  DSPADD
              SYMP   ZEROS,SIXES
              REGP   VREGA,VREGB,(VREGOF,VREGC) 
            ENDG
          ENDIFZ
          ADDZ   1,CSIZE,CSIZE
          MOVEZ  COMP,P1
          CALLZ  STCOC1 
          RETURN
          SPACE  4
 CAD112   LABEL 
*      DISPLAY CODE ADD - S.P. INPUT, D.P. OUTPUT 
          MOVEZ  OPND2,SAVREG 
          MOVEZ  0,P2 
          MOVEZ  COMP,P3
          MOVEZ  CPOINT,P5
          MOVEZ  CSIZE,P4 
          CALLZ  LDCOC1 
          MOVEZ  P1,VREGA    OPERAND 1
          MOVEZ  SAVREG,REGB
          MOVEZ  0,P2 
          MOVEZ  COMP,P3
          MOVEZ  CPOINT,P5
          MOVEZ  CSIZE,P4 
          CALLZ  LDCOC1 
          MOVEZ  P1,VREGB    OPERAND 2
          NOTE   CAD112 
          GENOBJ N=C.AD112,I=(VREGA,VREGB),O=((VREGOF,VREGC),(VREGOF,VRE
,GD)) 
          ADDZ   1,CSIZE,CSIZE
          MOVEZ  COMP,P1
          CALLZ  STCOC1 
          RETURN
          SPACE  4
 PLITLIT  LABEL 
*      COMPILE TIME ADD 
          NOTE   PLITLIT
          SUBZ   CPOINT,(POINTOF,OPND1),T1
          IFTHEN (T1,NE,0)
            ADDZ   T1,(POINTOF,OPND1),(POINTOF,OPND1) 
            ADDZ   T1,(NUMLENOF,OPND1),(NUMLENOF,OPND1) 
          ENDIFZ
          MOVEZ  OPND1,REGT 
          CALLZ  BINVAL 
          MOVEZ  P1,SAVLIT
          SUBZ   CPOINT,(POINTOF,OPND2),T1
          IFTHEN (T1,NE,0)
            ADDZ   T1,(POINTOF,OPND2),(POINTOF,OPND2) 
            ADDZ   T1,(NUMLENOF,OPND2),(NUMLENOF,OPND2) 
          ENDIFZ
          MOVEZ  OPND2,REGT 
          CALLZ  BINVAL 
          IFTHEN (SUBTR)
            SUBZ   SAVLIT,P1,SAVLIT 
          ELSEZ 
            ADDZ   SAVLIT,P1,SAVLIT 
          ENDIFZ
          IFTHEN (CSIZE,LT,6) 
            GEN  SXBPK,(VREGOF,VREGC),,SAVLIT 
          ELSEZ 
            MOVEZ  (EQUALS,DUM),REGT
            CALLZ  ADPDNAT   ADD PERMANENT DNAT 
            MOVEZ  0,(BCPOF,REGT) 
            MOVEZ  10,(BYTLENOF,REGT) 
            MOVEZ  0,P1 
            MOVEZ  SAVLIT,P2
            CALLZ  POOLIT 
            GEN    SLRBPK,(VREGOF,VREGA),((FWA$OF,REGT))
            GEN    XMIT,(VREGOF,VREGC),VREGA
          ENDIFZ
          ADDZ   1,CSIZE,CSIZE
          MOVEZ  COMP1,P1 
          CALLZ  STCOC1 
          RETURN
          TITLE  PDSPC1 -  DISPLAY +/- COMP1
* 
*         PDSPC1  - DISPLAY  +/- COMP1 OR COMP4 
* 
 PDSPC1   LABEL 
          IFTHEN ((GCODEOF,OPND1),NE,GLITREF) 
            CALLZ  C1PC1
            RETURN
          ENDIFZ
*      OPERAND1 LITERAL 
          GTZ    (POINTOF,OPND1),(POINTOF,OPND2),T1 
          MAXZ   (INTLENOF,OPND1),(INTLENOF,OPND2),T2 
          ADDZ   CPOINT,T2,CSIZE
          GTZ    CSIZE,5,T2 
          ORZ    T1,T2,T3 
          IFTHEN (T3) 
            CALLZ  C1PC1
          ELSEZ 
            CALLZ  LITPC1 
          ENDIFZ
          RETURN
          TITLE  PDSPC2 -  DISPLAY +/- COMP2
* 
*         PDSPC2  - DISPLAY +/- COMP2 
* 
 PDSPC2   LABEL 
          EQZ    CSIGN,0,T1 
          EQZ    PREC,1,T2
          ANDZ   T1,T2,T1 
          LTZ    (NUMLENOF,OPND1),15,T2 
          ORZ    T1,T2,T3 
          IFTHEN (T3) 
            CALLZ  C2PC2
          ELSEZ 
            CALLZ  DC2PC2 
          ENDIFZ
          RETURN
          TITLE  PDSPDC2 -  DISPLAY +/- DOUBLE PRECISION COMP2
* 
*         PDSPDC2 -  DISPLAY +/- DOUBLE PRECISION COMP2 
* 
 PDSPDC2  LABEL 
          EQZ    CSIGN,0,T1 
          EQZ    PREC,1,T2
          ANDZ   T1,T2,T1 
          IFTHEN (T1) 
            CALLZ  C2PC2
            RETURN
          ENDIFZ
          IFTHEN ((NUMLENOF,OPND1),LT,15) 
            CALLZ  C2PDC2 
          ELSEZ 
            CALLZ  DC2PDC2
          ENDIFZ
          RETURN
          TITLE  PC1DSP -  COMP1 +/- DISPLAY
* 
*         PC1DSP  - COMP1 OR COMP4  +/DISPLAY 
* 
 PC1DSP   LABEL 
          IFTHEN ((GCODEOF,OPND2),NE,GLITREF) 
            CALLZ  C1PC1
            RETURN
          ENDIFZ
*      OPERAND2 LITERAL 
          GTZ    (POINTOF,OPND2),(POINTOF,OPND1),T1 
          MAXZ   (INTLENOF,OPND1),(INTLENOF,OPND2),T2 
          ADDZ   CPOINT,T2,CSIZE
          GTZ    CSIZE,5,T2 
          ORZ    T1,T2,T3 
          IFTHEN (T3) 
            CALLZ  C1PC1
          ELSEZ 
            CALLZ  C1PLIT 
          ENDIFZ
          RETURN
          TITLE  PC1C1 -  COMP1 +/- COMP1 
* 
*         PC1C1   - COMP1 OR CPMP4  +/- COMP1 OR COMP4
* 
 PC1C1    LABEL 
          CALLZ  C1PC1
          RETURN
          TITLE  PC1C2 -   COMP1 +/- COMP2
* 
*         PC1C2  - COMP1 OR COMP4  +/- COMP2
* 
 PC1C2    LABEL 
          CALLZ  C2PC2
          RETURN
          TITLE  PC1DC2 -  COMP1 +/- DOUBLE PRECISION COMP2 
* 
*         PC1DC2 - COMP1 OR COMP4  +/- DOUBLE PRECISION COMP2 
* 
 PC1DC2   LABEL 
          EQZ    CSIGN,0,T1 
          EQZ    PREC,1,T2
          ANDZ   T1,T2,T3 
          IFTHEN (T3) 
            CALLZ  C2PC2
          ELSEZ 
            CALLZ  C2PDC2 
          ENDIFZ
          RETURN
          TITLE  PC2DSP -  COMP2 +/- DISPLAY
* 
*         PC2DSP  -  COMP2 +/- DISPLAY
* 
 PC2DSP   LABEL 
          EQZ    CSIGN,0,T1 
          EQZ    PREC,1,T2
          ANDZ   T1,T2,T1 
          LTZ    (NUMLENOF,OPND2),15,T2 
          ORZ    T1,T2,T3 
          IFTHEN (T3) 
            CALLZ  C2PC2
          ELSEZ 
            CALLZ  C2PDC2 
          ENDIFZ
          RETURN
          TITLE  PC2C1 -  COMP2 +/- COMP1 
* 
*         PC2C1    COMP2  +/- COMP1 OR COMP4
* 
 PC2C1    LABEL 
          CALLZ  C2PC2
          RETURN
          TITLE  PC2C2 -  COMP2 +/- COMP2 
* 
*         PC2C2   -  COMP2 +/- COMP2
* 
 PC2C2    LABEL 
          CALLZ  C2PC2
          RETURN
          TITLE  PC2DC2 -  COMP2 +/- DOUBLE PRECISION COMP2 
* 
*         PC2DC2  -  COMP2 +/- DOUBLE PRECISION COMP2 
* 
 PC2DC2   LABEL 
          EQZ    CSIGN,0,T1 
          EQZ    PREC,1,T2
          ANDZ   T1,T2,T3 
          IFTHEN (T3) 
            CALLZ  C2PC2
          ELSEZ 
            CALLZ  C2PDC2 
          ENDIFZ
          RETURN
          TITLE  PDC2DSP -  DOUBLE PRECISION COMP2 +/- DISPLAY
* 
*         PDC2DSP -  DOUBLE PRECISION COMP2 +/- DISPLAY 
* 
 PDC2DSP  LABEL 
          EQZ    CSIGN,0,T1 
          EQZ    PREC,1,T2
          ANDZ   T1,T2,T1 
          IFTHEN (T1) 
            CALLZ  C2PC2
            RETURN
          ENDIFZ
          IFTHEN ((NUMLENOF,OPND2),LT,15) 
            CALLZ  DC2PC2 
          ELSEZ 
            CALLZ  DC2PDC2
          ENDIFZ
          RETURN
          TITLE  PDC2C1 -  DOUBLE PRECISION COMP2 +/- COMP1 
* 
*         PDC2C1 - DOUBLE PRECISION COMP2  +/- COMP1 OR COMP4 
* 
 PDC2C1   LABEL 
          EQZ    CSIGN,0,T1 
          EQZ    PREC,1,T2
          ANDZ   T1,T2,T3 
          IFTHEN (T3) 
            CALLZ  C2PC2
          ELSEZ 
            CALLZ  DC2PC2 
          ENDIFZ
          RETURN
          TITLE  PDC2C2 -  DOUBLE PRECISION COMP2 +/- COMP2 
* 
*         PDC2C2  - DOUBLE PRECISION COMP2 +/- COMP2
* 
 PDC2C2   LABEL 
          EQZ    CSIGN,0,T1 
          EQZ    PREC,1,T2
          ANDZ   T1,T2,T3 
          IFTHEN (T3) 
            CALLZ  C2PC2
          ELSEZ 
            CALLZ  DC2PC2 
          ENDIFZ
          RETURN
          TITLE  PDC2DC2 -  DOUBLE PRECISION COMP2 +/- D.P. COMP2 
* 
*         PDC2DC2 -  DOUBLE PRECISION COMP2 +/- D.P. COMP2
* 
 PDC2DC2  LABEL 
          EQZ    CSIGN,0,T1 
          EQZ    PREC,1,T2
          ANDZ   T1,T2,T3 
          IFTHEN (T3) 
            CALLZ  C2PC2
          ELSEZ 
            CALLZ  DC2PDC2
          ENDIFZ
          RETURN
          TITLE  ADDSUB SUBROUTINES 
 C1PC1    EJECT 
* 
*         C1PC1 -  COMP1 +/- COMP1
* 
 C1PC1    LABEL 
          MAXZ   (INTLENOF,OPND1),(INTLENOF,OPND2),T3 
          ADDZ   CPOINT,T3,CSIZE
          SUBZ   CPOINT,(POINTOF,OPND1),T1
          ADDZ   (NUMLENOF,OPND1),T1,NSIZE1      NEW OPND1 SIZE 
          SUBZ   CPOINT,(POINTOF,OPND2),T1
          ADDZ   (NUMLENOF,OPND2),T1,NSIZE2      NEW OPND2 SIZE 
          IFZ    (NSIZE1,GE,15),C1PC1B
          IFZ    (NSIZE2,GE,15),C1PC1A
          MOVEZ  (SIGNOF,OPND1),P2
          MOVEZ  COMP1,P3 
          MOVEZ  OPND2,SAVREG 
          MOVEZ  CSIZE,P4 
          MOVEZ  CPOINT,P5
          CALLZ  LDCOC1 
          MOVEZ  P1,VREGA 
          MOVEZ  COMP1,P3 
          MOVEZ  SAVREG,REGB
          MOVEZ  (SIGNOF,REGB),P2 
          MOVEZ  CSIZE,P4 
          MOVEZ  CPOINT,P5
          CALLZ  LDCOC1 
          MOVEZ  P1,VREGB 
          NOTE   C1PC1
          IFTHEN (SUBTR)
            GEN    ISUB,(VREGOF,VREGC),VREGA,VREGB
          ELSEZ 
            GEN    IADD,(VREGOF,VREGC),VREGA,VREGB
          ENDIFZ
          ADDZ   CSIZE,1,CSIZE
          MOVEZ  COMP1,P1 
          CALLZ  STCOC1 
          RETURN
          SPACE  4
 C1PC1A   LABEL 
          EQZ    CSIGN,0,T1 
          EQZ    PREC,1,T2
          ANDZ   T1,T2,T3 
          IFTHEN (T3) 
            CALLZ  C2PC2
          ELSEZ 
            CALLZ  C2PDC2 
          ENDIFZ
          RETURN
          SPACE  4
 C1PC1B   LABEL 
          EQZ    CSIGN,0,T1 
          EQZ    PREC,1,T2
          ANDZ   T1,T2,T1 
          IFTHEN (T1) 
            CALLZ  C2PC2
            RETURN
          ENDIFZ
            IFTHEN (NSIZE2,LT,15) 
            CALLZ  DC2PC2 
          ELSEZ 
            CALLZ  DC2PDC2
          ENDIFZ
          RETURN
 C1PLIT   EJECT 
* 
*         C1PLIT -  COMP1 +/- LITERAL 
* 
 C1PLIT   LABEL 
          ADDZ   CSIZE,1,CSIZE
          MOVEZ  OPND2,SAVREG 
          MOVEZ  (SIGNOF,OPND1),P2
          MOVEZ  COMP1,P3 
          MOVEZ  (NUMLENOF,OPND1),P4
          MOVEZ  (POINTOF,OPND1),P5 
          CALLZ  LDCOC1 
          NOTE   C1PLIT 
          MOVEZ  P1,VREGA 
          SUBZ   (POINTOF,OPND1),(POINTOF,SAVREG),T1
          IFTHEN (T1,NE,0)
            ADDZ   T1,(POINTOF,SAVREG),(POINTOF,SAVREG) 
            ADDZ   T1,(NUMLENOF,SAVREG),(NUMLENOF,SAVREG) 
          ENDIFZ
          MOVEZ  SAVREG,REGT
          CALLZ  BINVAL 
          IFZ    (SUBTR),C1PLITA
          IFTHEN (P2,EQ,1)
            MOVEZ  VREGA,VREGC
          ENDIFZ
          IFTHEN (P2,EQ,2)
          GEN    SXXPB,(VREGOF,VREGC),VREGA,R1
          ENDIFZ
          IFTHEN (P2,GT,2)
            GEN    SXXPK,(VREGOF,VREGC),VREGA,P1
          ENDIFZ
          MOVEZ  COMP1,P1 
          CALLZ  STCOC1 
          RETURN
          SPACE  4
 C1PLITA  LABEL 
          IFTHEN (P2,EQ,1)
            MOVEZ  VREGA,VREGC
          ENDIFZ
          IFTHEN (P2,GE,2)
            SUBZ   0,P1,P1
            GEN    SXXPK,(VREGOF,VREGC),VREGA,P1
          ENDIFZ
          MOVEZ  COMP1,P1 
          CALLZ  STCOC1 
          RETURN
 C2PC2    EJECT 
* 
*         C2PC2 - COMP2 +/- COMP2 
* 
 C2PC2    LABEL 
          MOVEZ  CPOINT,P1   SCALE OPND1
          MOVEZ  CPOINT,P2   SCALE OPND2
          CALLZ  LDC2C2 
          NOTE   C2PC2
          IFTHEN (SUBTR)
            GEN    RSUB,(VREGOF,VREGD),VREGA,VREGB
          ELSEZ 
            GEN    RADD,(VREGOF,VREGD),VREGA,VREGB
          ENDIFZ
          GEN    NORM,(VREGOF,VREGC),,VREGD 
          MOVEZ  COMP2,P1 
          CALLZ  STC2DC2
          RETURN
 C2PDC2   EJECT 
* 
*         C2PDC2 -  COMP2 +/- DPCOMP2 
* 
 C2PDC2   LABEL 
          MOVEZ  CPOINT,P1   SCALE OPND1
          MOVEZ  CPOINT,P2   SCALE OPND2
          CALLZ  LDC2DC2
          NOTE   C2PDC2 
          IFTHEN (SUBTR)
            GENM   SUBSDD 
              REGP   VREGA,VREGB,(VREGP1OF,VREGB),(VREGOF,VREGC),(VREGOF
,,VREGD)
            ENDG
          ELSEZ 
            GENM   ADDSDD 
              REGP   VREGB,(VREGP1OF,VREGB),VREGA,(VREGOF,VREGC),(VREGOF
,,VREGD)
            ENDG
          ENDIFZ
          MOVEZ  DPCOMP2,P1 
          CALLZ  STC2DC2
          RETURN
 DC2PC2   EJECT 
* 
*         DC2PC2 -  DPCOMP2 +/- COMP2 
* 
 DC2PC2   LABEL 
          MOVEZ  CPOINT,P1   SCALE OPND1
          MOVEZ  CPOINT,P2   SCALE OPND2
          CALLZ  LDDC2C2
          NOTE   DC2PC2 
          IFTHEN (SUBTR)
            GENM  SUBDSD
              REGP   VREGA,(VREGP1OF,VREGA),VREGB,(VREGOF,VREGC),(VREGOF
,,VREGD)
            ENDG
          ELSEZ 
            GENM   ADDSDD 
              REGP   VREGA,(VREGP1OF,VREGA),VREGB,(VREGOF,VREGC),(VREGOF
,,VREGD)
          ENDIFZ
          MOVEZ  DPCOMP2,P1 
          CALLZ  STC2DC2
          RETURN
 DC2PDC2  EJECT 
* 
*         DC2PDC2  -  DPCOMP2 +/- DPCOMP2 
* 
 DC2PDC2  LABEL 
          MOVEZ  CPOINT,P1   SCALE OPND1
          MOVEZ  CPOINT,P2   SCALE OPND2
          CALLZ  LDDC2DC2 
          NOTE   DC2PDC2
          IFTHEN (SUBTR)
            GENM   SUBDDD 
              REGP   VREGA,(VREGP1OF,VREGA),VREGB,(VREGP1OF,VREGB),(VREG
,OF,VREGC),(VREGOF,VREGD) 
            ENDG
          ELSEZ 
            GENM   ADDDDD 
              REGP   VREGA,(VREGP1OF,VREGA),VREGB,(VREGP1OF,VREGB),(VREG
,OF,VREGC),(VREGOF,VREGD) 
            ENDG
          ENDIFZ
          MOVEZ  DPCOMP2,P1 
          CALLZ  STC2DC2
          RETURN
 LITPC1   EJECT 
* 
*         LITPC1 -  LITERAL +/- COMP1 
* 
 LITPC1   LABEL 
          ADDZ   CSIZE,1,CSIZE
          MOVEZ  OPND1,SAVREG 
          MOVEZ  OPND2,REGB 
          MOVEZ  (SIGNOF,REGB),P2 
          MOVEZ  COMP1,P3 
          MOVEZ  (NUMLENOF,REGB),P4 
          MOVEZ  (POINTOF,REGB),P5
          CALLZ  LDCOC1 
          MOVEZ  P1,VREGA 
          NOTE   LITPC1 
          SUBZ   (POINTOF,REGB),(POINTOF,SAVREG),T1 
          IFTHEN (T1,NE,0)
            ADDZ T1,(POINTOF,SAVREG),(POINTOF,SAVREG) 
            ADDZ T1,(NUMLENOF,SAVREG),(NUMLENOF,SAVREG) 
          ENDIFZ
          MOVEZ  SAVREG,REGT
          CALLZ  BINVAL 
          IFZ    (SUBTR),LITPC1A
          IFTHEN (P2,EQ,1)
            MOVEZ  VREGA,VREGC
          ENDIFZ
          IFTHEN (P2,EQ,2)
          GEN    SXXPB,(VREGOF,VREGC),VREGA,R1
          ENDIFZ
          IFTHEN (P2,GT,2)
            GEN    SXXPK,(VREGOF,VREGC),VREGA,P1
          ENDIFZ
          MOVEZ  COMP1,P1 
          CALLZ  STCOC1 
          RETURN
          SPACE  4
 LITPC1A  LABEL 
          IFTHEN (P2,EQ,1)
            GEN    COMPL,(VREGOF,VREGC),,VREGA
          ELSEZ 
            GEN    COMPL,(VREGOF,VREGD),,VREGA
            GEN  SXXPK,(VREGOF,VREGC),VREGD,P1
          ENDIFZ
          MOVEZ  COMP1,P1 
          CALLZ  STCOC1 
          RETURN
          TITLE  DIVIDE - GENERATE DIVIDE 
* 
*         DIVIDE  - GENERATE DIVIDE 
* 
 DIVIDE   EGO    2
          MOVEZ  (LOCLAB,T1),LABERR 
  
*      IF *DIVIDE* HAS REMAINDER CLAUSE, PREPARE FOR IT 
          IFTHEN (REM)
            MOVEZ  (EQUALS,REGT19),DIVID
            MOVEZ  REGB,REGS
            MOVEZ  DIVID,REGT 
            CALLZ  CPYDNAT
            MOVEZ  (EQUALS,REGT20),DIVIS
            MOVEZ  REGC,REGS
            MOVEZ  DIVIS,REGT 
            CALLZ  CPYDNAT
            MOVEZ  REGD,QUOT
          ENDIFZ
  
*      DECIDE WHETHER WE HAVE TO WORRY ABOUT A SIGN FOR THE RESULT
*      (THIS VALUE IS USED BY *STC2DC2* AND *STCOC1*) 
  
          ORZ    (SIGNOF,OPND1),(SIGNOF,OPND2),CSIGN       RESULT SIGN
  
*      COMPUTE THE OFFICIAL POINT LOCATION FOR THE COMPOSITE RESULT 
*      (THIS VALUE IS USED BY *STC2DC2* AND *STCOC1*) 
  
          SUBZ   (POINTOF,OPND1),(POINTOF,OPND2),CPOINT  RESULT SCALE 
  
*      KEEP TRACK OF THE SIZE OF THE COMPOSITE RESULT 
  
          MOVEZ  (NUMLENOF,RESULT),CSIZE
  
*      IF THE DIVIDE CAN BE DONE BY SHIFTING, 
*        GENERATE CODE TO DO SO, AND DON'T COME BACK
  
          BRANCH DVSHIFT
 NOTSHIFT LABEL 
  
*      IF WE CAN GENERATE A PRECISE ANSWER, 
*        GENERATE CODE TO DO SO, AND DON'T COME BACK
*         (WE GENERATE A PRECISE ANSWER BY ENSURING PRECISE OPERANDS
*          SO THAT DIVIDING YIELDS AN ANSWER PRECISE ENOUGH FOR THE 
*          RESULT.  THE PRICE OF THIS PRECISION IS THAT THE VALUES
*          IN REGISTERS MAY BE ARTIFICIALLY SCALED, AND UNFIT FOR 
*          FURTHER OPERATIONS IN A *COMPUTE* STATEMENT EXPRESSION 
*          OR *ON SIZE ERROR* TEST. 
*          WHEN WE STORE THE RESULT, WE ARTIFICIALLY SCALE IT THE 
*          OPPOSITE WAY SO THE CORRECT ANSWER IS STORED IN MEMORY.
*          THE SPAN OF ALL OPERANDS MUST FIT IN DOUBLE-PRECISION
*          COMP-2.  SEE THE *HISTORY* COMDECK FOR AN EXAMPLE.)
  
          IFZ    ((TYPEOF,OPND1),EQ,COMP2),NOTPRECI 
          IFZ    ((TYPEOF,OPND2),EQ,COMP2),NOTPRECI 
          IFZ    ((TYPEOF,RESULT),EQ,COMP2),NOTPRECI
  
          IFZ    ((TYPEOF,OPND1),EQ,DPCOMP2),NOTPRECI 
          IFZ    ((TYPEOF,OPND2),EQ,DPCOMP2),NOTPRECI 
          IFZ    ((TYPEOF,RESULT),EQ,DPCOMP2),NOTPRECI
  
          IFZ    ((LEVELOF,RESULT),EQ,TEMPLEVL),NOTPRECI
          IFZ    ((LEVELOF,RESULT),EQ,RESULTTE),NOTPRECI
          IFZ    (RND),NOTPRECI 
          IFZ    (SIZESW),NOTPRECI
  
*      CONSIDER,
*        NUMERATOR     PIC 9(AI)V9(AF)
*        DENOMINATOR   PIC 9(BI)V9(BF)
*        QUOTIENT      PIC 9(CI)V9(CF)
* 
*      COMPUTE T1 = MAX(AI,BI,CI) + MAX(AF,BF+CF) 
  
          MAXZ   (INTLENOF,OPND1),(INTLENOF,OPND2),T1 
          MAXZ   T1,(INTLENOF,RESULT),T1
          ADDZ   (POINTOF,OPND2),(POINTOF,RESULT),T2
          MAXZ   T2,(POINTOF,OPND1),T2
          ADDZ   T1,T2,T1 
  
*      IF TOTAL LENGTH IS MORE THAN DOUBLE-PRECISION, NOT PRECISE 
  
          IFZ    (T1,GT,28),NOTPRECI
  
*      REACHING HERE MEANS WE CAN GENERATE PRECISE DIVIDES
*      GO DO SO, RETURNING TO CALLER OF *DIVIDE*
  
          BRANCH PRECISE
  
 NOTPRECI LABEL 
          CALLZ  GETPREC     PREC=1 FOR SINGLE-PRECISION
  
*      IF BOTH OPERANDS AND RESULT ARE SINGLE PRECISION,
*        GENERATE CODE, AND 
*        RETURN TO CALLER OF *DIVIDE* 
  
          IFTHEN (PREC,EQ,1)
            CALLZ  C2QSC2 
            RETURN
          ENDIFZ
  
          GOTOCASE  (TYPEOF,OPND1)
            CASE   COMP,DIVD1 
            CASE   COMP1,DIVD2
            CASE   COMP2,DIVD3
            CASE   COMP4,DIVD2
            CASE   DPCOMP2,DIVD4
          ENDCASE 
          ERROR 
  
*      OPERAND1 DISPLAY 
 DIVD1    LABEL 
          GOTOCASE  (TYPEOF,OPND2)
            CASE   COMP,QDSPDSP 
            CASE   COMP1,QDSPC1 
            CASE   COMP2,QDSPC2 
            CASE   COMP4,QDSPC1 
            CASE   DPCOMP2,QDSPDC2
          ENDCASE 
          ERROR 
  
*      OPERAND1 COMP1 
 DIVD2    LABEL 
          GOTOCASE  (TYPEOF,OPND2)
            CASE   COMP,QC1DSP
            CASE   COMP1,QC1C1
            CASE   COMP2,QC1C2
            CASE   COMP4,QC1C1
            CASE   DPCOMP2,QC1DC2 
          ENDCASE 
          ERROR 
  
*      OPERAND1 COMP2 
 DIVD3    LABEL 
          GOTOCASE  (TYPEOF,OPND2)
            CASE   COMP,QC2DSP
            CASE   COMP1,QC2C1
            CASE   COMP2,QC2C2
            CASE   COMP4,QC2C1
            CASE   DPCOMP2,QC2DC2 
          ENDCASE 
          ERROR 
  
*      OPERAND1 DPCOMP2 
 DIVD4    GOTOCASE  (TYPEOF,OPND2)
            CASE   COMP,QDC2DSP 
            CASE   COMP1,QDC2C1 
            CASE   COMP2,QDC2C2 
            CASE   COMP4,QDC2C1 
            CASE   DPCOMP2,QDC2DC2
          ENDCASE 
          ERROR 
          TITLE  PRECISE - DIVIDE WITH PRECISE ANSWER 
*      PRECISE - DIVIDE WITH PRECISE ANSWER 
* 
*         T2 = MAXIMUM OF DECIMAL PARTS OF OPERANDS, RESULT 
  
 PRECISE  EGO    3
  
*      SET PARAMETER TO STCOC1
*       TO INDICATE POWER OF TEN BY WHICH REGISTER VALUE
*       SHOULD BE MULTIPLIED TO GET MEMORY VALUE. 
* 
*       THE REGISTER VALUE IS 10**(POINTOF,RESULT) LARGER THAN
*       ITS MATHEMATICAL VALUE. 
*       WE SET *CPOINT* SO THAT WHEN *STOCOC1* OFFSETS IT BY
*       (POINTOF,RESULT), THE ANSWER GOES STRAIGHT INTO MEMORY
*       WITHOUT ANY MULTIPLYING OR DIVIDING BY A POWER OF TEN.
  
          MOVEZ  (POINTOF,RESULT),CPOINT
  
*      PUSH *HOLDRES* ON THE STACK TO KEEP *STC2DC2* AND *STCOC1* HAPPY 
  
          CALLZ  GETPREC     (DESTROYING T1 AND T2) 
  
*      SET PARAMETERS TO LDC2C2, LDC2DC2, LDDC2DC2
*       TO INDICATE POWER OF TEN BY WHICH MEMORY VALUES 
*       SHOULD BE MULTIPLIED TO GET COMP2 OR DPCOMP2 REGISTER VALUES. 
* 
*      CONSIDER,
*        NUMERATOR     PIC 9(AI)V9(AF)
*        DENOMINATOR   PIC 9(BI)V9(BF)
*        QUOTIENT      PIC 9(CI)V9(CF)
* 
*      TO ENSURE ACCURACY, THE MATHEMATICAL VALUE OF THE DENOMINATOR
*      SHOULD BE MULTIPLIED BY AT LEAST 10**BF, 
*      AND THE MATHEMATICAL VALUE OF THE NUMERATOR SHOULD BE MULTIPLIED 
*      BY 10**CF MORE THAN THE DENOMINATOR (I.E. AT LEAST 10**(BF+CF).
*      SO IF AF IS LESS THAN BF+CF
*          MULTIPLY NUMERATOR BY 10**(BF+CF)
*          MULTIPLY DENOMINATOR BY 10**BF 
*      ELSE 
*          MULTIPLY NUMERATOR BY 10**AF 
*          MULTIPLY DENOMINATOR BY 10**(AF-CF). 
*      THIS WILL LEAVE THE REGISTER VALUE OF THE QUOTIENT 10**CF TIMES
*      THE MATHEMATICAL VALUE OF THE QUOTIENT.
* 
*      NOTE THAT A NUMERATOR WITH PIC 999PPPP WOULD HAVE AF=-4. 
*      BUT THE LOGIC AND THE FORMULAS FOR P'S ARE THE SAME. 
* 
*      TO MULTIPLY THE MATHEMATICAL VALUE OF THE NUMERATOR BY 10**N 
*      WE SET P1 TO N.
* 
*      TO MULTIPLY THE MATHEMATICAL VALUE OF THE DENOMINATOR BY 10**N 
*      WE SET P2 TO N.
  
          ADDZ   (POINTOF,OPND2),(POINTOF,RESULT),P1
          MAXZ   P1,(POINTOF,OPND1),P1
          SUBZ   P1,(POINTOF,RESULT),P2 
  
  
*      SAVE T1 = NUMERIC LENGTH OF NUMERATOR IN REGISTER
  
          ADDZ   (INTLENOF,OPND1),P1,T1 
  
*      SAVE T2 = NUMERIC LENGTH OF DENOMINATOR IN REGISTER
  
          ADDZ   (INTLENOF,OPND2),P2,T2 
  
*      DISPLAY, COMP1 AND COMP4 ARE HANDLED THE SAME IN CODE BELOW. 
*      (DIFFERENCES ARE HANDLED IN LDC2D2, LDC2DC2 AND LDDC2DC2.) 
  
*      GO TO DIFFERENCE PROCESSORS ACCORDING TO SINGLE- OR DOUBLE-
*       PRECISION REGISTER VALUES.
  
          MOVEZ  (NUMLENOF,RESULT),T3 
  
*      T1 = NUMERIC LENGTH OF REGISTER VALUE OF NUMERATOR 
*      T2 = NUMERIC LENGTH OF REGISTER VALUE OF DENOMINATOR 
*      T3 = NUMERIC LENGTH OF REGISTER VALUE OF QUOTIENT
* 
*      ...         / ...         TO ... 
  
          IFZ    (T1,GT,14),PRECISE2
  
*      SINGLE-PREC / ...         TO ... 
  
          IFZ    (T2,GT,14),PRECISE1
  
*      SINGLE-PREC / SINGLE-PREC TO ... 
  
          IFZ    (T3,LT,15),PR2R2R2 
          BRANCH PR2R2R4
  
*      SINGLE-PREC / DOUBLE-PREC TO ... 
  
 PRECISE1 LABEL 
          IFZ    (T3,LT,15),PR2R4R2 
          BRANCH PR2R4R4
  
*      DOUBLE-PREC / ...         TO ... 
  
 PRECISE2 LABEL 
          IFZ    (T2,GT,14),PRECISE3
  
*      DOUBLE-PREC / SINGLE-PREC TO ... 
  
          IFZ    (T3,LT,15),PR4R2R2 
          BRANCH PR4R2R4
  
*      DOUBLE-PREC / DOUBLE-PREC TO ... 
  
 PRECISE3 LABEL 
          IFZ    (T3,LT,15),PR4R4R2 
          BRANCH PR4R4R4
   TITLE  PR2R2R2 - SINGLE-PREC / SINGLE-PREC TO SINGLE-PREC   (PRECISE)
* 
*         PR2R2R2 - SINGLE-PREC / SINGLE-PREC TO SINGLE-PREC   (PRECISE)
* 
 PR2R2R2  EGO    4
  
*      LOAD SINGLE-PRECISION OPERAND 1 INTO VREGA, AND
*      LOAD SINGLE-PRECISION OPERAND 2 INTO VREGB 
  
          CALLZ  LDC2C2      (P1 AND P2 WERE SET PREVIOUSLY)
  
*      DIVIDE  SINGLE-PRECISION IN VREGA
*       BY     SINGLE-PRECISION IN VREGB
*       TO GET SINGLE-PRECISION IN VREGD
*       ON ZERO DENOMINATOR, JUMP TO *ERRLAB* 
  
          NOTE   PR2R2R2
          GEN    ZR$,VREGB,,ERRLAB
          GEN    FDIV,(VREGOF,VREGD),VREGA,VREGB
  
*      TRUNCATE RESULT TO INTEGER VALUE 
*      (SO ROUNDING WHILE STORING DOES NOT MAKE ANSWER WRONG) 
  
          GEN    UNP,(VREGOF,VREGA),(VREGOF,VREGB),VREGD  UXA BB,XD 
          GEN    SHLB,(VREGOF,VREGC),VREGB,VREGA          LXC BB,XA 
  
*      STORE RESULT (IN VREGC) INTO MEMORY
  
          MOVEZ  VREGC,VREGG (SAVE DIVREM PARAMETER IN CASE *REMAINDER*)
          MOVEZ  COMP1,P1 
          CALLZ  STCOC1      (CPOINT WAS SET PREVIOUSLY)
  
*      HANDLE POSSIBLE *REMAINDER* CLAUSE 
*      GENERATE *ERRLAB* (IN CASE OF DIVIDE BY ZERO)
  
          IFTHEN (REM)
            MOVEZ  COMP1,P1 
            CALLZ  DIVREM 
          ENDIFZ
          CALLZ  ERRCHEK
  
          RETURN
   TITLE  PR2R2R4 - SINGLE-PREC / SINGLE-PREC TO DOUBLE-PREC   (PRECISE)
* 
*         PR2R2R4 - SINGLE-PREC / SINGLE-PREC TO DOUBLE-PREC   (PRECISE)
* 
 PR2R2R4  EGO    4
  
*      LOAD SINGLE-PRECISION OPERAND 1 INTO VREGA, AND
*      LOAD SINGLE-PRECISION OPERAND 2 INTO VREGB 
  
          CALLZ  LDC2C2      (P1 AND P2 WERE SET PREVIOUSLY)
  
*      DIVIDE  SINGLE-PRECISION IN VREGA
*       BY     SINGLE-PRECISION IN VREGB
*       TO GET DOUBLE-PRECISION IN VREGD
  
          NOTE   PR2R2R4
          GENM   DIVSSD 
            SYMP   ERRLAB 
            REGP   VREGA,VREGB,(VREGOF,VREGD),(VREGOF,VREGE)
          ENDG
  
*      TRUNCATE RESULT TO INTEGER VALUE 
*      (SO ROUNDING WHILE STORING DOES NOT MAKE ANSWER WRONG) 
  
      GENOBJ N=C.R4TRU,I=(VREGD,VREGE),O=((VREGOF,VREGC),(VREGOF,VREGA))
  
*      STORE RESULT (IN VREGC AND VREGC+1) INTO MEMORY
  
          MOVEZ  VREGC,VREGG (SAVE DIVREM PARAMETER IN CASE *REMAINDER*)
          MOVEZ  DPCOMP2,P1 
          CALLZ  STC2DC2     (CPOINT WAS SET PREVIOUSLY)
  
*      HANDLE POSSIBLE *REMAINDER* CLAUSE 
*      GENERATE *ERRLAB* (IN CASE OF DIVIDE BY ZERO)
  
          IFTHEN (REM)
            MOVEZ  DPCOMP2,P1 
            CALLZ  DIVREM 
          ENDIFZ
          CALLZ  ERRCHEK
  
          RETURN
   TITLE  PR2R4R2 - SINGLE-PREC / DOUBLE-PREC TO SINGLE-PREC   (PRECISE)
* 
*         PR2R4R2 - SINGLE-PREC / DOUBLE-PREC TO SINGLE-PREC   (PRECISE)
* 
 PR2R4R2  EGO    4
  
*      LOAD SINGLE-PRECISION OPERAND 1 INTO VREGA, AND
*      LOAD DOUBLE-PRECISION OPERAND 2 INTO VREGB 
  
          CALLZ  LDC2DC2     (P1 AND P2 WERE SET PREVIOUSLY)
  
*      DIVIDE  SINGLE-PRECISION IN VREGA
*       BY     DOUBLE-PRECISION IN VREGB
*       TO GET SINGLE-PRECISION IN VREGD
  
          NOTE   PR2R4R2
          GEN    ZR$,VREGB,,ERRLAB
          GEN    FDIV,(VREGOF,VREGD),VREGA,VREGB
  
*      TRUNCATE RESULT TO INTEGER VALUE 
*      (SO ROUNDING WHILE STORING DOES NOT MAKE ANSWER WRONG) 
  
          GEN    UNP,(VREGOF,VREGA),(VREGOF,VREGB),VREGD  UXA BB,XD 
          GEN    SHLB,(VREGOF,VREGC),VREGB,VREGA          LXC BB,XA 
  
*      STORE RESULT (IN VREGC) INTO MEMORY
  
          MOVEZ  VREGC,VREGG (SAVE DIVREM PARAMETER IN CASE *REMAINDER*)
          MOVEZ  COMP1,P1 
          CALLZ  STCOC1      (CPOINT WAS SET PREVIOUSLY)
  
*      HANDLE POSSIBLE *REMAINDER* CLAUSE 
*      GENERATE *ERRLAB* (IN CASE OF DIVIDE BY ZERO)
  
          IFTHEN (REM)
            MOVEZ  COMP1,P1 
            CALLZ  DIVREM 
          ENDIFZ
          CALLZ  ERRCHEK
  
          RETURN
   TITLE  PR2R4R4 - SINGLE-PREC / DOUBLE-PREC TO DOUBLE-PREC   (PRECISE)
* 
*         PR2R4R4 - SINGLE-PREC / DOUBLE-PREC TO DOUBLE-PREC   (PRECISE)
* 
 PR2R4R4  EGO    4
  
*      LOAD SINGLE-PRECISION OPERAND 1 INTO VREGA, AND
*      LOAD DOUBLE-PRECISION OPERAND 2 INTO VREGB 
  
          CALLZ  LDC2DC2     (P1 AND P2 WERE SET PREVIOUSLY)
  
*      DIVIDE  SINGLE-PRECISION IN VREGA
*       BY     DOUBLE-PRECISION IN VREGB
*       TO GET DOUBLE-PRECISION IN VREGD
  
          NOTE   PR2R4R4
          GENM   DIVSDD 
            SYMP   ERRLAB 
         REGP VREGA,VREGB,(VREGP1OF,VREGB),(VREGOF,VREGD),(VREGOF,VREGE)
          ENDG
  
*      TRUNCATE RESULT TO INTEGER VALUE 
*      (SO ROUNDING WHILE STORING DOES NOT MAKE ANSWER WRONG) 
  
      GENOBJ N=C.R4TRU,I=(VREGD,VREGE),O=((VREGOF,VREGC),(VREGOF,VREGA))
  
*      STORE RESULT (IN VREGC AND VREGC+1) INTO MEMORY
  
          MOVEZ  VREGC,VREGG (SAVE DIVREM PARAMETER IN CASE *REMAINDER*)
          MOVEZ  DPCOMP2,P1 
          CALLZ  STC2DC2     (CPOINT WAS SET PREVIOUSLY)
  
*      HANDLE POSSIBLE *REMAINDER* CLAUSE 
*      GENERATE *ERRLAB* (IN CASE OF DIVIDE BY ZERO)
  
          IFTHEN (REM)
            MOVEZ  DPCOMP2,P1 
            CALLZ  DIVREM 
          ENDIFZ
          CALLZ  ERRCHEK
  
          RETURN
   TITLE  PR4R2R2 - DOUBLE-PREC / SINGLE-PREC TO SINGLE-PREC   (PRECISE)
* 
*         PR4R2R2 - DOUBLE-PREC / SINGLE-PREC TO SINGLE-PREC   (PRECISE)
* 
 PR4R2R2  EGO    4
  
*      LOAD DOUBLE-PRECISION OPERAND 1 INTO VREGA, AND
*      LOAD SINGLE-PRECISION OPERAND 2 INTO VREGB 
  
          CALLZ  LDDC2C2     (P1 AND P2 WERE SET PREVIOUSLY)
  
*      DIVIDE  DOUBLE-PRECISION IN VREGA
*       BY     SINGLE-PRECISION IN VREGB
*       TO GET SINGLE-PRECISION IN VREGD
* 
*                A SIMPLE DIVISION OF MOST SIG. VREGA BY VREGB
*                WOULD WORK IN THE VAST MAJORITY OF CASES, BUT
*                IT CAN HAPPEN THAT THE FRACTION PART OF THAT DIVISION
*                PLUS THE FRACTION OF LEAST SIG. VREGA OVER VREGB IS
*                MORE THAN 1.0, MEANING THE QUOTIENT IS INCREASED BY 1. 
  
          NOTE   PR4R2R2
          GENM   DIVDSD 
            SYMP   ERRLAB 
         REGP VREGA,(VREGP1OF,VREGA),VREGB,(VREGOF,VREGD),(VREGOF,VREGE)
          ENDG
  
*      TRUNCATE RESULT TO INTEGER VALUE 
*      (SO ROUNDING WHILE STORING DOES NOT MAKE ANSWER WRONG) 
  
          GEN    UNP,(VREGOF,VREGA),(VREGOF,VREGB),VREGD  UXA BB,XD 
          GEN    SHLB,(VREGOF,VREGC),VREGB,VREGA          LXC BB,XA 
  
*      STORE RESULT (IN VREGC) INTO MEMORY
  
          MOVEZ  VREGC,VREGG (SAVE DIVREM PARAMETER IN CASE *REMAINDER*)
          MOVEZ  COMP1,P1 
          CALLZ  STCOC1      (CPOINT WAS SET PREVIOUSLY)
  
*      HANDLE POSSIBLE *REMAINDER* CLAUSE 
*      GENERATE *ERRLAB* (IN CASE OF DIVIDE BY ZERO)
  
          IFTHEN (REM)
            MOVEZ  COMP1,P1 
            CALLZ  DIVREM 
          ENDIFZ
          CALLZ  ERRCHEK
  
          RETURN
   TITLE  PR4R2R4 - DOUBLE-PREC / SINGLE-PREC TO DOUBLE-PREC   (PRECISE)
* 
*         PR4R2R4 - DOUBLE-PREC / SINGLE-PREC TO DOUBLE-PREC   (PRECISE)
* 
 PR4R2R4  EGO    4
  
*      LOAD DOUBLE-PRECISION OPERAND 1 INTO VREGA, AND
*      LOAD SINGLE-PRECISION OPERAND 2 INTO VREGB 
  
          CALLZ  LDDC2C2     (P1 AND P2 WERE SET PREVIOUSLY)
  
*      DIVIDE  DOUBLE-PRECISION IN VREGA
*       BY     SINGLE-PRECISION IN VREGB
*       TO GET DOUBLE-PRECISION IN VREGD
  
          NOTE   PR4R2R4
          GENM   DIVDSD 
            SYMP   ERRLAB 
         REGP VREGA,(VREGP1OF,VREGA),VREGB,(VREGOF,VREGD),(VREGOF,VREGE)
          ENDG
  
*      TRUNCATE RESULT TO INTEGER VALUE 
*      (SO ROUNDING WHILE STORING DOES NOT MAKE ANSWER WRONG) 
  
      GENOBJ N=C.R4TRU,I=(VREGD,VREGE),O=((VREGOF,VREGC),(VREGOF,VREGF))
  
*      POINT *DIVREM* TO THE RESULT 
  
          MOVEZ  VREGC,VREGG
  
*      STORE RESULT (IN VREGC AND VREGC+1) INTO MEMORY
  
          MOVEZ  VREGC,VREGG (SAVE DIVREM PARAMETER IN CASE *REMAINDER*)
          MOVEZ  DPCOMP2,P1 
          CALLZ  STC2DC2     (CPOINT WAS SET PREVIOUSLY)
  
*      HANDLE POSSIBLE *REMAINDER* CLAUSE 
*      GENERATE *ERRLAB* (IN CASE OF DIVIDE BY ZERO)
  
          IFTHEN (REM)
            MOVEZ  DPCOMP2,P1 
            CALLZ  DIVREM 
          ENDIFZ
          CALLZ  ERRCHEK
  
          RETURN
   TITLE  PR4R4R2 - DOUBLE-PREC / DOUBLE-PREC TO SINGLE-PREC   (PRECISE)
* 
*         PR4R4R2 - DOUBLE-PREC / DOUBLE-PREC TO SINGLE-PREC   (PRECISE)
* 
 PR4R4R2  EGO    4
  
*      LOAD DOUBLE-PRECISION OPERAND 1 INTO VREGA, AND
*      LOAD DOUBLE-PRECISION OPERAND 2 INTO VREGB 
  
          CALLZ  LDDC2DC2    (P1 AND P2 WERE SET PREVIOUSLY)
  
*      DIVIDE  DOUBLE-PRECISION IN VREGA
*       BY     DOUBLE-PRECISION IN VREGB
*       TO GET SINGLE-PRECISION IN VREGD
* 
*                A SIMPLE DIVISION OF MOST SIG. VREGA BY VREGB
*                WOULD WORK IN THE VAST MAJORITY OF CASES, BUT
*                IT CAN HAPPEN THAT THE FRACTION PART OF THAT DIVISION
*                PLUS THE FRACTION OF LEAST SIG. VREGA OVER VREGB IS
*                MORE THAN 1.0, MEANING THE QUOTIENT IS INCREASED BY 1. 
  
          NOTE   PR4R4R2
          GENM   DIVDSD 
            SYMP   ERRLAB 
         REGP VREGA,(VREGP1OF,VREGA),VREGB,(VREGOF,VREGD),(VREGOF,VREGE)
          ENDG
  
*      TRUNCATE RESULT TO INTEGER VALUE 
*      (SO ROUNDING WHILE STORING DOES NOT MAKE ANSWER WRONG) 
  
          GEN    UNP,(VREGOF,VREGA),(VREGOF,VREGB),VREGD  UXA BB,XD 
          GEN    SHLB,(VREGOF,VREGC),VREGB,VREGA          LXC BB,XA 
  
*      STORE RESULT (IN VREGC) INTO MEMORY
  
          MOVEZ  VREGC,VREGG (SAVE DIVREM PARAMETER IN CASE *REMAINDER*)
          MOVEZ  COMP1,P1 
          CALLZ  STCOC1      (CPOINT WAS SET PREVIOUSLY)
  
*      HANDLE POSSIBLE *REMAINDER* CLAUSE 
*      GENERATE *ERRLAB* (IN CASE OF DIVIDE BY ZERO)
  
          IFTHEN (REM)
            MOVEZ  COMP1,P1 
            CALLZ  DIVREM 
          ENDIFZ
          CALLZ  ERRCHEK
  
          RETURN
   TITLE  PR4R4R4 - DOUBLE-PREC / DOUBLE-PREC TO DOUBLE-PREC   (PRECISE)
* 
*         PR4R4R4 - DOUBLE-PREC / DOUBLE-PREC TO DOUBLE-PREC   (PRECISE)
* 
 PR4R4R4  EGO    4
  
*      LOAD DOUBLE-PRECISION OPERAND 1 INTO VREGA, AND
*      LOAD DOUBLE-PRECISION OPERAND 2 INTO VREGB 
  
          CALLZ  LDDC2DC2     (P1 AND P2 WERE SET PREVIOUSLY) 
  
*      DIVIDE  DOUBLE-PRECISION IN VREGA
*       BY     DOUBLE-PRECISION IN VREGB
*       TO GET DOUBLE-PRECISION IN VREGD
  
          NOTE   PR4R4R4
          GENM   DIVDDD 
            SYMP   ERRLAB 
            REGP   VREGA,(VREGP1OF,VREGA),VREGB,(VREGP1OF,VREGB),(VREGOF
,,VREGD),(VREGOF,VREGE) 
          ENDG
  
*      TRUNCATE RESULT TO INTEGER VALUE 
*      (SO ROUNDING WHILE STORING DOES NOT MAKE ANSWER WRONG) 
  
          GENOBJ N=C.R4TRU,I=(VREGD,(VREGP1OF,VREGD)),O=((VREGOF,VREGC),
,(VREGOF,VREGE))
  
*      STORE RESULT (IN VREGC AND VREGC+1) INTO MEMORY
  
          MOVEZ  VREGC,VREGG (SAVE DIVREM PARAMETER IN CASE *REMAINDER*)
          MOVEZ  DPCOMP2,P1 
          CALLZ  STC2DC2     (CPOINT WAS SET PREVIOUSLY)
  
*      HANDLE POSSIBLE *REMAINDER* CLAUSE 
*      GENERATE *ERRLAB* (IN CASE OF DIVIDE BY ZERO)
  
          IFTHEN (REM)
            MOVEZ  DPCOMP2,P1 
            CALLZ  DIVREM 
          ENDIFZ
          CALLZ  ERRCHEK
  
          RETURN
 DVSHIFT  TITLE  DIVIDE BY POWER OF TWO 
 DVSHIFT  LABEL 
          IFTHEN ((TYPEOF,OPND1),NE,COMP) 
          ANDIF  ((TYPEOF,OPND1),NE,COMP1)
            BRANCH NOTSHIFT 
          ENDIFZ
          IFZ    ((NUMLENOF,OPND1),GT,14),NOTSHIFT
          IFZ    ((LEVELOF,RESULT),EQ,TEMPLEVL),NOTSHIFT
          IFZ    ((LEVELOF,RESULT),EQ,RESULTTE),NOTSHIFT
          IFZ    ((TYPEOF,RESULT),EQ,COMP2),NOTSHIFT
          IFZ    (REM,NE,0),NOTSHIFT
          IFZ    (RND,NE,0),NOTSHIFT
          IFZ    ((POINTOF,OPND1),LT,(POINTOF,RESULT)),NOTSHIFT 
          IFZ    ((GCODEOF,OPND2),NE,GLITREF),NOTSHIFT
          IFZ    ((TYPEOF,OPND2),NE,COMP),NOTSHIFT  FP LITERAL
          IFZ    ((POINTOF,OPND2),NE,0),NOTSHIFT
*    GENERATE RIGHT SHIFT OF APPROPRIATE POWER OF TWO 
          MOVEZ  OPND2,REGT 
          CALLZ  BINVAL 
          IFTHEN (P2,NE,3)   LITERAL NOT EQUAL TWO
          ANDIF  (P2,NE,5)   LITERAL NOT POWER OF TWO 
            BRANCH NOTSHIFT 
          ENDIFZ
          CALLZ  GETPREC
          PUSH P3 
          MOVEZ  (SIGNOF,OPND1),P2
          MOVEZ  COMP1,P3 
          MOVEZ  (NUMLENOF,OPND1),P4
          MOVEZ  (POINTOF,OPND1),P5 
          NOTE   DVSHIFT
          CALLZ  LDCOC1 
          POP    P3 
          GEN    SHR,P1,P3
          MOVEZ  (NUMLENOF,OPND1),CSIZE 
          MOVEZ  P1,VREGC 
          MOVEZ  COMP1,P1 
          CALLZ  STCOC1 
          CALLZ  ERRCHEK
          RETURN
          TITLE  QDSPDSP -  DISPLAY / DISPLAY 
* 
*         QDSPDSP - DISPLAY / DISPLAY   (IMPRECISE) 
* 
 QDSPDSP  LABEL 
          IFZ    ((NUMLENOF,OPND1),GE,15),QDSPDSP1
          IFTHEN ((NUMLENOF,OPND2),LT,15) 
            CALLZ  C2QC2
          ELSEZ 
            CALLZ  C2QDC2 
          ENDIFZ
          RETURN
  
 QDSPDSP1 LABEL 
          IFTHEN ((NUMLENOF,OPND2),LT,15) 
            CALLZ  DC2QC2 
          ELSEZ 
            CALLZ  DC2QDC2
          ENDIFZ
          RETURN
          TITLE  QDSPC1  -  DISPLAY / COMP1 
* 
*         QDSPC1 -  DISPLAY / COMP1     (IMPRECISE) 
* 
 QDSPC1   LABEL 
          IFTHEN ((NUMLENOF,OPND1),LT,15) 
            CALLZ  C2QC2
          ELSEZ 
            CALLZ  DC2QC2 
          ENDIFZ
          RETURN
          TITLE  QDSPC2  -  DISPLAY / COMP2 
* 
*         QDSPC2 -  DISPLAY / COMP2     (NECESSARILY IMPRECISE) 
* 
 QDSPC2   LABEL 
          IFTHEN ((NUMLENOF,OPND1),LT,15) 
            CALLZ  C2QC2
          ELSEZ 
            CALLZ  DC2QC2 
          ENDIFZ
          RETURN
          TITLE  QDSPDC2 -  DISPLAY / DPCOMP2 
* 
*         QDSPDC2 - DISPLAY / DPCOMP2   (NECESSARILY IMPRECISE) 
* 
 QDSPDC2  LABEL 
          IFTHEN ((NUMLENOF,OPND1),LT,15) 
            CALLZ  C2QDC2 
          ELSEZ 
            CALLZ  DC2QDC2
          ENDIFZ
          RETURN
          TITLE  QC1DSP  -  COMP1 / DISPLAY 
* 
*         QC1DSP -  COMP1 / DISPLAY     (IMPRECISE) 
* 
 QC1DSP   LABEL 
          IFTHEN ((NUMLENOF,OPND2),LT,15) 
            CALLZ  C2QC2
          ELSEZ 
            CALLZ  C2QDC2 
          ENDIFZ
          RETURN
          TITLE  QC1C1   -  COMP1 / COMP1 
* 
*         QC1C1 -   COMP1 / COMP1       (IMPRECISE) 
* 
 QC1C1    LABEL 
          CALLZ  C2QC2
          RETURN
          TITLE  QC1C2   -  COMP1 / COMP2 
* 
*         QC1C2 -   COMP1 / COMP2       (NECESSARILY IMPRECISE) 
* 
 QC1C2    LABEL 
          CALLZ  C2QC2
          RETURN
          TITLE  QC1DC2  -  COMP1 / DPCOMP2 
* 
*         QC1DC2 -  COMP1 / DPCOMP2     (NECESSARILY IMPRECISE) 
* 
 QC1DC2   LABEL 
          CALLZ  C2QDC2 
          RETURN
          TITLE  QC2DSP  -  COMP2 / DISPLAY 
* 
*         QC2DSP -  COMP2 / DISPLAY     (NECESSARILY IMPRECISE) 
* 
 QC2DSP   LABEL 
          IFTHEN ((NUMLENOF,OPND2),LT,15) 
            CALLZ  C2QC2
          ELSEZ 
            CALLZ  DC2QC2 
          ENDIFZ
          RETURN
          TITLE  QC2C1   -  COMP2 / COMP1 
* 
*         QC2C1 -   COMP2 / COMP1       (NECESSARILY IMPRECISE) 
* 
 QC2C1    LABEL 
          CALLZ  C2QC2
          RETURN
          TITLE  QC2C2   -  COMP2 / COMP2 
* 
*         QC2C2 -   COMP2 / COMP2       (NECESSARILY IMPRECISE) 
* 
 QC2C2    LABEL 
          CALLZ  C2QC2
          RETURN
          TITLE  QC2DC2  -  COMP2 / DPCOMP2 
* 
*         QC2DC2 -  COMP2 / DPCOMP2     (NECESSARILY IMPRECISE) 
* 
 QC2DC2   LABEL 
          CALLZ  C2QDC2 
          RETURN
          TITLE  QDC2DSP -  DPCOMP2 / DISPLAY 
* 
*         QDC2DSP - DPCOMP2 / DISPLAY   (NECESSARILY IMPRECISE) 
* 
 QDC2DSP  LABEL 
          IFTHEN ((NUMLENOF,OPND2),LT,15) 
            CALLZ  DC2QC2 
          ELSEZ 
            CALLZ  DC2QDC2
          ENDIFZ
          RETURN
          TITLE  QDC2C1  -  DPCOMP2 / COMP1 
* 
*         QDC2C1 -  DPCOMP2 / COMP1     (NECESSARILY IMPRECISE) 
* 
 QDC2C1   LABEL 
          CALLZ  DC2QC2 
          RETURN
          TITLE  QDC2C2  -  DPCOMP2 / COMP2 
* 
*         QDC2C2 -  DPCOMP2 / COMP2     (NECESSARILY IMPRECISE) 
* 
 QDC2C2   LABEL 
          CALLZ  DC2QC2 
          RETURN
          TITLE  QDC2DC2 -  DPCOMP2 / DPCOMP2 
* 
*         QDC2DC2 - DPCOMP2 / DPCOMP2   (NECESSARILY IMPRECISE) 
* 
 QDC2DC2  LABEL 
          CALLZ  DC2QDC2
          RETURN
          TITLE  DIVIDE SUBROUTINES 
 C2QC2    EJECT 
 C2QC2    LABEL 
          MOVEZ  (POINTOF,OPND1),P1    SCALE OPND1
          MOVEZ  (POINTOF,OPND2),P2    SCALE OPND2
          CALLZ  LDC2C2 
          NOTE   C2QC2
          GENM   DIVSSD 
            SYMP   ERRLAB 
            REGP   VREGA,VREGB,(VREGOF,VREGC),(VREGOF,VREGD)
          ENDG
          MOVEZ  VREGC,VREGG
          MOVEZ  DPCOMP2,P1 
          CALLZ  STC2DC2
          IFTHEN (REM)
            MOVEZ  DPCOMP2,P1 
            CALLZ  DIVREM 
          ENDIFZ
          CALLZ  ERRCHEK
          RETURN
 C2QSC2   EJECT 
 C2QSC2   LABEL 
          MOVEZ  (POINTOF,OPND1),P1 
          MOVEZ  (POINTOF,OPND2),P2    SCALE OPND2
          CALLZ  LDC2C2 
          NOTE   C2QSC2 
          GEN    ZR$,VREGB,,ERRLAB
          GEN    RDIV,(VREGOF,VREGC),VREGA,VREGB
          MOVEZ  VREGC,VREGG
          MOVEZ  COMP2,P1 
          CALLZ  STC2DC2
          IFTHEN (REM)
            MOVEZ  COMP2,P1 
            CALLZ  DIVREM 
          ENDIFZ
          CALLZ  ERRCHEK
          RETURN
 C2QDC2   EJECT 
 C2QDC2   LABEL 
          MOVEZ  (POINTOF,OPND1),P1    SCALE OPND1
          MOVEZ  (POINTOF,OPND2),P2    SCALE OPND2
          CALLZ  LDC2DC2
          NOTE   C2QDC2 
          GENM   DIVSDD 
            SYMP   ERRLAB 
            REGP   VREGA,VREGB,(VREGP1OF,VREGB),(VREGOF,VREGC),(VREGOF,V
,REGD)
          ENDG
          MOVEZ  VREGC,VREGG
          MOVEZ  DPCOMP2,P1 
          CALLZ  STC2DC2
          IFTHEN (REM)
            MOVEZ  DPCOMP2,P1 
            CALLZ  DIVREM 
          ENDIFZ
          CALLZ  ERRCHEK
          RETURN
 DC2QC2   EJECT 
 DC2QC2   LABEL 
          MOVEZ  (POINTOF,OPND1),P1    SCALE OPND1
          MOVEZ  (POINTOF,OPND2),P2    SCALE OPND2
          CALLZ  LDDC2C2
          NOTE   DC2QC2 
          GENM   DIVDSD 
            SYMP   ERRLAB 
            REGP   VREGA,(VREGP1OF,VREGA),VREGB,(VREGOF,VREGC),(VREGOF,V
,REGD)
          ENDG
          MOVEZ  VREGC,VREGG
          MOVEZ  DPCOMP2,P1 
          CALLZ  STC2DC2
          IFTHEN (REM)
            MOVEZ  DPCOMP2,P1 
            CALLZ  DIVREM 
          ENDIFZ
          CALLZ  ERRCHEK
          RETURN
 DC2QDC2  EJECT 
 DC2QDC2  LABEL 
          MOVEZ  (POINTOF,OPND1),P1    SCALE OPND1
          MOVEZ  (POINTOF,OPND2),P2    SCALE OPND2
          CALLZ  LDDC2DC2 
          NOTE   DC2QDC2
          GENM   DIVDDD 
            SYMP   ERRLAB 
            REGP   VREGA,(VREGP1OF,VREGA),VREGB,(VREGP1OF,VREGB),(VREGOF
,,VREGC),(VREGOF,VREGD) 
          ENDG
          MOVEZ  VREGC,VREGG
          MOVEZ  DPCOMP2,P1 
          CALLZ  STC2DC2
          IFTHEN (REM)
            MOVEZ  DPCOMP2,P1 
            CALLZ  DIVREM 
          ENDIFZ
          CALLZ  ERRCHEK
          RETURN
 DIVREM   EJECT 
* 
*         DIVREM  - GENERATE CODE FOR REMAINDER 
*                   P1     - TYPE OF QUOTIENT 
*                   VREGG  - VIRTUAL REGISTER OF QUOTIENT (FROM DIVIDE) 
*                   CPOINT - POINT LOCATION FOR QUOTIENT
* 
 DIVREM   LABEL 
          IFTHEN (SIZESW)    SKIP REMAINDER COMPUTATION ON SIZE ERROR 
            NOTE   DIVREM 
            GEN    SLRBPK,(VREGOF,VREGE),,SIZERR
            GEN    NZ$,VREGE,,ERRLAB
          ENDIFZ
*      CREATE QUOTIENT DNAT 
          MOVEZ  (EQUALS,REGT1),REGT
          CALLZ  CRDNAT 
          MOVEZ  P1,(TYPEOF,REGT1)
          MOVEZ  CPOINT,(POINTOF,OPND1) 
          MOVEZ  VREGG,(TREGOF,REGT1) 
*      CREATE RECEIVING QUOTIENT DNAT 
          MOVEZ  (EQUALS,REGT2),REGT
          CALLZ  CRDNAT 
          MOVEZ  QUOT,REGD
*      ELIMINATE REDUNDANT CONVERSIONS WHEN POSSIBLE
          IFTHEN ((TYPEOF,REGD),EQ,COMP)
          ANDIF  ((NUMLENOF,REGD),LE,14)
            MOVEZ  COMP1,(TYPEOF,REGT2) 
          ELSEZ 
            MOVEZ  (TYPEOF,REGD),(TYPEOF,REGT2) 
          ENDIFZ
          IFTHEN ((TYPEOF,REGD),EQ,NUMEDIT) 
          ANDIF  ((NUMLENOF,REGD),LE,14)
            MOVEZ  COMP1,(TYPEOF,REGT2) 
          ENDIFZ
          IFTHEN ((TYPEOF,REGD),EQ,NUMEDIT) 
          ANDIF  ((NUMLENOF,REGD),GT,14)
            MOVEZ  COMP,(TYPEOF,REGT2)
          ENDIFZ
          MOVEZ  (NUMLENOF,REGD),(NUMLENOF,REGT2) 
          MOVEZ  (POINTOF,REGD),(POINTOF,REGT2) 
          MOVEZ  1,(SIGNOF,REGT2) 
*      MOVE QUOTIENT TO RECEIVING QUOTIENT
          MOVEZ  (EQUALS,REGT1),REGB
          MOVEZ  (EQUALS,REGT2),REGC
          CALLZ  MOVER
*      COMPUTE RECEIVING QUOTIENT * DIVISOR 
          MOVEZ  (EQUALS,REGT3),REGT
          CALLZ  CRDNAT 
          MOVEZ  (EQUALS,REGT2),REGB
          MOVEZ  DIVIS,REGC 
          MOVEZ  (EQUALS,REGT3),REGD
          CALLZ  CGMULT 
*      COMPUTE DIVIDEND - (RECEIVING QUOTIENT * DIVISOR)
*      AND STORE IN REMAINDER 
          MOVEZ  DIVID,REGB 
          MOVEZ  (EQUALS,REGT3),REGC
          MOVEZ  REMAIN,REGD
          CALLZ  CGSUB
          CALLZ  SUBDNAT
          CALLZ  SUBDNAT
          CALLZ  SUBDNAT
          RETURN
          TITLE  EXP - GENERATE EXPONENTIATE
 EXP      LABEL 
          EXECUTE FTNLIB
          CALLZ  GETPREC
          MOVEZ  (SIGNOF,OPND1),CSIGN            RESULT SIGN
          MOVEZ  0,CPOINT 
          MOVEZ  (LOCLAB,T1),LABERR 
          CALLZ  SETT1
          CALLZ  SETT2
          GOTOCASE  T1
            CASE   REAL,OP1REAL 
            CASE   DP,OP1DP 
          ENDCASE 
          ERROR 
  
*      OPERAND1 REAL
 OP1REAL  LABEL 
          GOTOCASE  T2
            CASE   INT,RTOI 
            CASE   REAL,RTOR
            CASE   DP,RTOD
          ENDCASE 
          ERROR 
  
*      OPERAND1 DOUBLE PRECISION
 OP1DP    LABEL 
          GOTOCASE  T2
            CASE   INT,DTOI 
            CASE   REAL,DTOR
            CASE   DP,DTOD
          ENDCASE 
          ERROR 
          TITLE  EXP SUBROUTINES
 DTOD     EJECT 
* 
*         DTOD - DOUBLE PRECISION ** DOUBLE PRECISION 
* 
 DTOD     LABEL 
          MOVEZ  0,P1        SCALE OPND1
          MOVEZ  0,P2        SCALE OPND2
          CALLZ  LDDC2DC2 
          NOTE   DTOD 
          GENOBJ N=C.DTOD,I=(VREGA,(VREGP1OF,VREGA),VREGB,(VREGP1OF,VREG
,B)),O=((VREGOF,VREGC),(VREGOF,VREGD),(VREGOF,VREGE)) 
          IFTHEN (SIZESW) 
            GEN  NE$,VREGE,R0,ERRLAB
          ENDIFZ
          MOVEZ  DPCOMP2,P1 
          CALLZ  STC2DC2
          CALLZ  ERRCHEK
          RETURN
 DTOR     EJECT 
* 
*         DTOR - DOUBLE PRECISION ** REAL 
* 
 DTOR     LABEL 
          MOVEZ  0,P1        SCALE OPND1
          MOVEZ  0,P2        SCALE OPND2
          CALLZ  LDDC2C2
          NOTE   DTOR 
          GENOBJ N=C.DTOR,I=(VREGA,(VREGP1OF,VREGA),VREGB),O=((VREGOF,VR
,EGC),(VREGOF,VREGD),(VREGOF,VREGE))
          IFTHEN (SIZESW) 
            GEN  NE$,VREGE,R0,ERRLAB
          ENDIFZ
          MOVEZ  DPCOMP2,P1 
          CALLZ  STC2DC2
          CALLZ  ERRCHEK
          RETURN
 RTOD     EJECT 
* 
*         RTOD - REAL ** DOUBLE PRECISION 
* 
 RTOD     LABEL 
          MOVEZ  0,P1        SCALE OPND1
          MOVEZ  0,P2        SCALE OPND2
          CALLZ  LDC2DC2
          NOTE   RTOD 
          GENOBJ N=C.RTOD,I=(VREGA,VREGB,(VREGP1OF,VREGB)),O=((VREGOF,VR
,EGC),(VREGOF,VREGD),(VREGOF,VREGE))
          IFTHEN (SIZESW) 
            GEN  NE$,VREGE,R0,ERRLAB
          ENDIFZ
          MOVEZ  DPCOMP2,P1 
          CALLZ  STC2DC2
          CALLZ  ERRCHEK
          RETURN
 RTOI     EJECT 
* 
*         RTOI - REAL ** INTEGER
* 
 RTOI     LABEL 
          BRANCH SQUARE 
 NOTSQ    LABEL 
          EQZ    (LEVELOF,OPND1),TEMPLEVL,T1
          EQZ    (TYPEOF,OPND1),COMP2,T2
          ANDZ   T1,T2,T3 
          EQZ    (POINTOF,OPND1),0,T1 
          ANDZ   T1,T3,T3 
          IFTHEN (T3) 
            MOVEZ  (TREGOF,OPND1),VREGA 
          ELSEZ 
            MOVEZ  OPND2,SAVREG 
            MOVEZ  (EQUALS,DUM),REGT
            CALLZ  CRDNAT 
            MOVEZ  COMP2,(TYPEOF,DUM) 
            MOVEZ  0,(POINTOF,DUM)
            MOVEZ  1,(SIGNOF,DUM) 
            MOVEZ  (EQUALS,DUM),REGC
            CALLZ  MOVER               OPND1(REGB) TO DUM(REGC) 
            MOVEZ  (TREGOF,DUM),VREGA 
            CALLZ  SUBDNAT
            MOVEZ  SAVREG,OPND2 
          ENDIFZ
          MOVEZ  (SIGNOF,OPND2),P2
          MOVEZ  (NUMLENOF,OPND2),P4
          MOVEZ  0,P5 
          MOVEZ  COMP1,P3 
          MOVEZ  OPND2,REGB 
          CALLZ  LDCOC1 
          MOVEZ  P1,VREGB 
          NOTE   RTOI 
          GENOBJ N=C.RTOI,I=(VREGA,VREGB),O=((VREGOF,VREGC),(VREGOF,VREG
,E))
          IFTHEN (SIZESW) 
            GEN  NE$,VREGE,R0,ERRLAB
          ENDIFZ
          MOVEZ  COMP2,P1 
          CALLZ  STC2DC2
          CALLZ  ERRCHEK
          RETURN
          EJECT 
 SQUARE   LABEL              CHECK FOR A **2
          IFZ    ((GCODEOF,OPND2),NE,GLITREF),NOTSQ 
          MOVEZ  OPND2,REGT 
          CALLZ  BINVAL 
          IFZ    (P1,NE,2),NOTSQ
          IFZ    ((TYPEOF,OPND1),EQ,COMP2),NOTSQ  NO MORE ACCURATE
          IFZ    ((NUMLENOF,OPND1),GT,7),NOTSQ
          MOVEZ  (SIGNOF,OPND1),P2
          MOVEZ  COMP1,P3 
          MOVEZ  (NUMLENOF,OPND1),P4
          MOVEZ  (POINTOF,OPND1),P5 
          CALLZ  LDCOC1 
          NOTE   SQUARE 
          GEN    IMUL,(VREGOF,VREGC),P1,P1
          MOVEZ  COMP1,P1 
          ADDZ   (NUMLENOF,OPND1),(NUMLENOF,OPND1),CSIZE
          ADDZ   (POINTOF,OPND1),(POINTOF,OPND1),CPOINT 
          MOVEZ  0,CSIGN
          CALLZ  STCOC1 
          RETURN
 RTOR     EJECT 
* 
*         RTOR - REAL ** REAL 
* 
 RTOR     LABEL 
          MOVEZ  0,P1        SCALE OPND1
          MOVEZ  0,P2        SCALE OPND2
          CALLZ  LDC2C2 
          NOTE   RTOR 
          GENOBJ N=C.RTOR,I=(VREGA,VREGB),O=((VREGOF,VREGC),(VREGOF,VREG
,E))
          IFTHEN (SIZESW) 
            GEN    NE$,VREGE,R0,ERRLAB
          ENDIFZ
          MOVEZ  COMP2,P1 
          CALLZ  STC2DC2
          CALLZ  ERRCHEK
          RETURN
 ITOI     EJECT 
 DTOI     EJECT 
* 
*         DTOI - DOUBLE PRECISION ** INTEGER
* 
 DTOI     LABEL 
          EQZ    (LEVELOF,OPND1),TEMPLEVL,T1
          EQZ    (TYPEOF,OPND1),DPCOMP2,T2
          ANDZ   T1,T2,T3 
          EQZ    (POINTOF,OPND1),0,T1 
          ANDZ   T1,T3,T3 
          IFTHEN (T3) 
            MOVEZ  (TREGOF,OPND1),VREGA 
          ELSEZ 
            MOVEZ  OPND2,SAVREG 
            MOVEZ  (EQUALS,DUM),REGT
            CALLZ  CRDNAT 
            MOVEZ  DPCOMP2,(TYPEOF,DUM) 
            MOVEZ  0,(POINTOF,DUM)
            MOVEZ  (EQUALS,DUM),REGC
            CALLZ  MOVER               OPND1(REGB) TO DUM(REGC) 
            MOVEZ  (TREGOF,DUM),VREGA 
            CALLZ  SUBDNAT
            MOVEZ  SAVREG,OPND2 
          ENDIFZ
          MOVEZ  (NUMLENOF,OPND2),P4
          MOVEZ  0,P5 
          MOVEZ  (SIGNOF,OPND2),P2
          MOVEZ  COMP1,P3 
          MOVEZ  OPND2,REGB 
          CALLZ  LDCOC1 
          MOVEZ  P1,VREGB 
          NOTE   DTOI 
          GENOBJ N=C.DTOI,I=(VREGA,(VREGP1OF,VREGA),VREGB),O=((VREGOF,VR
,EGC),(VREGOF,VREGD),(VREGOF,VREGE))
          IFTHEN (SIZESW) 
            GEN    NE$,VREGE,R0,ERRLAB
          ENDIFZ
          MOVEZ  DPCOMP2,P1 
          CALLZ  STC2DC2
          CALLZ  ERRCHEK
          RETURN
 ITOR     EJECT 
 SETT1    EJECT 
* 
*         SETT1 - SET FORTRAN TYPE OPERAND1 (BASE)
* 
 SETT1    LABEL 
          GOTOCASE  (TYPEOF,OPND1)
            CASE   COMP,OP1DSP
            CASE   COMP1,OP1C1
            CASE   COMP2,OP1C2
          CASE   COMP4,OP1C1
            CASE   DPCOMP2,OP1DC2 
          ENDCASE 
          ERROR 
 OP1DSP   LABEL 
          IFTHEN ((NUMLENOF,OPND1),GE,15) 
            MOVEZ  DP,T1
            RETURN
          ENDIFZ
          MOVEZ  REAL,T1
          RETURN
          SPACE  4
 OP1C1    LABEL 
          MOVEZ  REAL,T1
          RETURN
          SPACE  4
 OP1C2    LABEL 
          MOVEZ   REAL,T1 
          RETURN
          SPACE  4
 OP1DC2   LABEL 
          MOVEZ  DP,T1
          RETURN
 SETT2    EJECT 
* 
*         SETT2 - SET FORTRAN TYPE OPERAND 2 (EXPONENT) 
* 
 SETT2    LABEL 
          GOTOCASE  (TYPEOF,OPND2)
            CASE   COMP,OP2DSP
            CASE   COMP1,OP2C1
            CASE   COMP2,OP2C2
          CASE   COMP4,OP2C1
            CASE   DPCOMP2,OP2DC2 
          ENDCASE 
          ERROR 
 OP2DSP   LABEL 
          IFTHEN ((NUMLENOF,OPND2),GE,15) 
            MOVEZ  DP,T2
            RETURN
          ENDIFZ
          IFTHEN ((POINTOF,OPND2),EQ,0) 
            MOVEZ  INT,T2 
          ELSEZ 
            MOVEZ  REAL,T2
          ENDIFZ
          RETURN
          SPACE  4
 OP2C1    LABEL 
          IFTHEN ((POINTOF,OPND2),EQ,0) 
            MOVEZ  INT,T2 
          ELSEZ 
            MOVEZ  REAL,T2
          ENDIFZ
          RETURN
          SPACE  4
 OP2C2    LABEL 
          MOVEZ  REAL,T2
          RETURN
          SPACE  4
 OP2DC2   LABEL 
          MOVEZ  DP,T2
          RETURN
          TITLE  MULTIPLY - GENERATE MULTIPLY 
* 
*         MULTIPLY - GENERATE MULTIPLY
* 
 MULTIPLY LABEL 
          ORZ    (SIGNOF,OPND1),(SIGNOF,OPND2),CSIGN       RESULT SIGN
          ADDZ   (POINTOF,OPND1),(POINTOF,OPND2),CPOINT 
          CALLZ  GETPREC
  
          GOTOCASE  (TYPEOF,OPND1)
            CASE   COMP,MULT1 
            CASE   COMP1,MULT2
            CASE   COMP2,MULT3
          CASE   COMP4,MULT2
            CASE   DPCOMP2,MULT4
          ENDCASE 
          ERROR 
*      OPERAND1 COMP
 MULT1    LABEL 
          GOTOCASE  (TYPEOF,OPND2)
            CASE   COMP,TDSPDSP 
            CASE   COMP1,TDSPC1 
            CASE   COMP2,TDSPC2 
          CASE   COMP4,TDSPC1 
            CASE   DPCOMP2,TDSPDC2
          ENDCASE 
          ERROR 
*      OPERAND1 COMP1 
 MULT2    LABEL 
          GOTOCASE  (TYPEOF,OPND2)
            CASE   COMP,TC1DSP
            CASE   COMP1,TC1C1
            CASE   COMP2,TC1C2
          CASE   COMP4,TC1C1
            CASE   DPCOMP2,TC1DC2 
          ENDCASE 
          ERROR 
*      OPERAND1 COMP2 
 MULT3    LABEL 
          GOTOCASE  (TYPEOF,OPND2)
            CASE   COMP,TC2DSP
            CASE   COMP1,TC2C1
            CASE   COMP2,TC2C2
          CASE   COMP4,TC2C1
            CASE   DPCOMP2,TC2DC2 
          ENDCASE 
          ERROR 
*      OPERAND2 DPCOMP2 
 MULT4    LABEL 
          GOTOCASE  (TYPEOF,OPND2)
            CASE   COMP,TDC2DSP 
            CASE   COMP1,TDC2C1 
            CASE   COMP2,TDC2C2 
          CASE   COMP4,TDC2C1 
            CASE   DPCOMP2,TDC2DC2
          ENDCASE 
          ERROR 
          TITLE  TDSPDSP -  DISPLAY * DISPLAY 
* 
*         TDSPDSP -  DISPLAY * DISPLAY
* 
 TDSPDSP  LABEL 
          ADDZ   (NUMLENOF,OPND1),(NUMLENOF,OPND2),CSIZE
          IFTHEN (CSIZE,GT,14)
            CALLZ  IMULT
            RETURN
          ENDIFZ
          IFZ    ((GCODEOF,OPND1),EQ,GLITREF),TDSPDSP1
          IFZ    ((GCODEOF,OPND2),EQ,GLITREF),TDSPDSP3
          CALLZ  IMULT
          RETURN
          SPACE  4
 TDSPDSP1 LABEL 
*      OPERAND1 LITERAL 
          IFZ    ((GCODEOF,OPND2),EQ,GLITREF),TDSPDSP2
          CALLZ  LITTCOC1 
          RETURN
          SPACE  4
 TDSPDSP2 LABEL 
*      COMPILE TIME MULTIPLY
          ADDZ   (POINTOF,OPND1),(POINTOF,OPND2),CPOINT 
          MOVEZ  OPND1,REGT 
          CALLZ  BINVAL 
          MOVEZ  P1,SAVLIT
          MOVEZ  OPND2,REGT 
          CALLZ  BINVAL 
          MULTZ  P1,SAVLIT,SAVLIT 
          NOTE   TDSPDSP2 
          IFTHEN (CSIZE,LT,6) 
            GEN  SXBPK,(VREGOF,VREGC),,SAVLIT 
          ELSEZ 
            MOVEZ  (EQUALS,DUM),REGT
            CALLZ  ADPDNAT   ADD PERMANENT DNAT 
            MOVEZ  0,(BCPOF,REGT) 
            MOVEZ  10,(BYTLENOF,REGT) 
            MOVEZ  0,P1 
            MOVEZ  SAVLIT,P2
            CALLZ  POOLIT 
            GEN    SLRBPK,(VREGOF,VREGA),((FWA$OF,REGT))
            GEN    XMIT,(VREGOF,VREGC),VREGA
          ENDIFZ
          MOVEZ  COMP1,P1 
          CALLZ  STCOC1 
          RETURN
          SPACE  4
 TDSPDSP3 LABEL 
*      OPERAND2 LITERAL 
          CALLZ  COC1TLIT 
          RETURN
          TITLE  TDSPC1 -  DISPLAY * COMP1
* 
*         TDSPC1 -  DISPLAY * COMP1 
* 
 TDSPC1   LABEL 
          IFTHEN ((GCODEOF,OPND1),NE,GLITREF) 
            CALLZ  IMULT
            RETURN
          ENDIFZ
*      OPERAND1 LITERAL 
          ADDZ   (NUMLENOF,OPND1),(NUMLENOF,OPND2),CSIZE
          IFTHEN (CSIZE,GT,14)
            CALLZ  IMULT
          ELSEZ 
            CALLZ  LITTCOC1 
          ENDIFZ
          RETURN
          TITLE  TDSPC2 -  DISPLAY * COMP2
* 
*         TDSPC2 -  DISPLAY * COMP2 
* 
 TDSPC2   LABEL 
          IFTHEN ((NUMLENOF,OPND1),LT,15) 
            CALLZ  C2TC2
          ELSEZ 
            CALLZ  DC2TC2 
          ENDIFZ
          RETURN
          TITLE  TDSPDC2 -  DISPLAY * DPCOMP2 
* 
*         TDSPDC2 -  DISPLAY * DPCOMP2
* 
 TDSPDC2  LABEL 
          IFTHEN ((NUMLENOF,OPND1),LT,15) 
            CALLZ  C2TDC2 
          ELSEZ 
            CALLZ  DC2TDC2
          ENDIFZ
          RETURN
          TITLE  TC1DSP -  COMP1 * DISPLAY
* 
*         TC1DSP - COMP1 * DISPLAY
* 
 TC1DSP   LABEL 
          IFTHEN ((GCODEOF,OPND2),NE,GLITREF) 
            CALLZ  IMULT
            RETURN
          ENDIFZ
*      OPERAND2 LITERAL 
          ADDZ   (NUMLENOF,OPND1),(NUMLENOF,OPND2),CSIZE
          IFTHEN (CSIZE,GT,14)
            CALLZ  IMULT
          ELSEZ 
            CALLZ  COC1TLIT 
          ENDIFZ
          RETURN
          TITLE  TC1C1 -  COMP1 * COMP1 
* 
*         TC1C1 -  COMP1 * COMP1
* 
 TC1C1    LABEL 
          CALLZ  IMULT
          RETURN
          TITLE  TC1C2 -  COMP1 * COMP2 
* 
*         TC1C2 -  COMP1 * COMP2
* 
 TC1C2    LABEL 
          IFTHEN (PREC,EQ,1)
            CALLZ  C2TSC2 
          ELSEZ 
            CALLZ  C2TC2
          ENDIFZ
          RETURN
          TITLE  TC1DC2 -  COMP1 * DPCOMP2
* 
*         TC1DC2 -  COMP1 * DPCOMP2 
* 
 TC1DC2   LABEL 
          CALLZ  C2TDC2 
          RETURN
          TITLE  TC2DSP -  COMP * DISPLAY 
* 
*         TC2DSP -  COMP2 * DISPLAY 
* 
 TC2DSP   LABEL 
          IFTHEN ((NUMLENOF,OPND2),LT,15) 
            CALLZ  C2TC2
          ELSEZ 
            CALLZ  C2TDC2 
          ENDIFZ
          RETURN
          TITLE  TC2C1 -  COMP2 * COMP1 
* 
*         TC2C1 -  COMP2 * COMP1
* 
 TC2C1    LABEL 
          IFTHEN (PREC,EQ,1)
            CALLZ  C2TSC2 
          ELSEZ 
            CALLZ  C2TC2
          ENDIFZ
          RETURN
          TITLE  TC2C2 -  COMP2 * COMP2 
* 
*         TC2C2 -  COMP2 * COMP2
* 
 TC2C2    LABEL 
          IFTHEN (PREC,EQ,1)
            CALLZ  C2TSC2 
          ELSEZ 
            CALLZ  C2TC2
          ENDIFZ
          RETURN
          TITLE  TC2DC2 -  COMP2 * DPCOMP2
* 
*         TCDDC2 -  COMP2 * DPCOMP2 
* 
 TC2DC2   LABEL 
          CALLZ C2TDC2
          RETURN
          TITLE  TDC2DSP -  DPCOMP2 * DISPLAY 
* 
*         TDC2DSP -  DPCOMP2 * DISPLAY
* 
 TDC2DSP  LABEL 
          IFTHEN ((NUMLENOF,OPND2),LT,15) 
            CALLZ  DC2TC2 
          ELSEZ 
            CALLZ  DC2TDC2
          ENDIFZ
          RETURN
          TITLE  TDC2D1 -  DPCOMP2 * COMP1
* 
*         TDC2C1 -  DPCOMP2 * COMP1 
* 
 TDC2C1   LABEL 
          CALLZ  DC2TC2 
          RETURN
          TITLE  TDC2C2 -  DPCOMP2 * COMP2
* 
*         TDC2C2 -  DPCOMP2 * COMP2 
* 
 TDC2C2   LABEL 
          CALLZ  DC2TC2 
          RETURN
          TITLE  TDC2DC2 -  DPCOMP2 * DPCOMP2 
* 
*         TDC2DC2 -  DPCOMP2 * DPCOMP2
* 
 TDC2DC2  LABEL 
          CALLZ  DC2TDC2
          RETURN
 COC1TLIT EJECT 
* 
*         COC1TLIT -  DISPLAY OR COMP1 * LITERAL
* 
 COC1TLIT LABEL 
          NOTE   COC1TLIT 
          ADDZ   (POINTOF,OPND1),(POINTOF,OPND2),CPOINT 
          MOVEZ  OPND2,SAVREG 
          MOVEZ  (SIGNOF,OPND1),P2
          MOVEZ  COMP1,P3 
          MOVEZ  (NUMLENOF,OPND1),P4
          MOVEZ  (POINTOF,OPND1),P5 
          CALLZ  LDCOC1 
          MOVEZ  P1,P2
          MOVEZ  SAVREG,P1
          CALLZ  LITMULT
          MOVEZ  COMP1,P1 
          MOVEZ  P3,VREGC 
          CALLZ  STCOC1 
          RETURN
          TITLE  MULTIPLY SUBROUTINES 
* 
*         C2TC2  -  COMP2 * COMP2 = DPCOMP2 
* 
 C2TC2    LABEL 
          MOVEZ  (POINTOF,OPND1),P1    SCALE OPND1
          MOVEZ  (POINTOF,OPND2),P2    SCALE OPND2
          CALLZ  LDC2C2 
          NOTE   C2TC2
          GENM   MULTSSD
            REGP   VREGA,VREGB,(VREGOF,VREGC),(VREGOF,VREGD)
          ENDG
          MOVEZ  DPCOMP2,P1 
          CALLZ  STC2DC2
          RETURN
 C2TSC2   EJECT 
* 
*         C2TSC2 -  COMP2 * COMP2 = COMP2 
* 
 C2TSC2   LABEL 
          MOVEZ  (POINTOF,OPND1),P1    SCALE OPND1
          MOVEZ  (POINTOF,OPND2),P2    SCALE OPND2
          CALLZ  LDC2C2 
          NOTE   C2TSC2 
          GEN    RMUL,(VREGOF,VREGC),VREGA,VREGB
          MOVEZ  COMP2,P1 
          CALLZ  STC2DC2
          RETURN
 C2TDC2   EJECT 
* 
*         C2TDC2 -  COMP * DPCOMP2
* 
 C2TDC2   LABEL 
          MOVEZ  (POINTOF,OPND1),P1    SCALE OPND1
          MOVEZ  (POINTOF,OPND2),P2    SCALE OPND2
          CALLZ  LDC2DC2
          NOTE   C2TDC2 
          GENM   MULTSDD
            REGP   VREGA,VREGB,(VREGP1OF,VREGB),(VREGOF,VREGC),(VREGOF,V
,REGD)
          ENDG
          MOVEZ  DPCOMP2,P1 
          CALLZ  STC2DC2
          RETURN
 DC2TC2   EJECT 
* 
*         DC2TC2 -  DPCOMP2 * COMP2 
* 
 DC2TC2   LABEL 
          MOVEZ  (POINTOF,OPND1),P1    SCALE OPND1
          MOVEZ  (POINTOF,OPND2),P2    SCALE OPND2
          CALLZ  LDDC2C2
          NOTE   DC2TC2 
          GENM   MULTSDD
            REGP   VREGB,VREGA,(VREGP1OF,VREGA),(VREGOF,VREGC),(VREGOF,V
,REGD)
          ENDG
          MOVEZ  DPCOMP2,P1 
          CALLZ  STC2DC2
          RETURN
 DC2TDC2  EJECT 
* 
*         DC2TDC2 -  DPCOMP2 * DPCOMP2
* 
 DC2TDC2  LABEL 
          MOVEZ  (POINTOF,OPND1),P1    SCALE OPND1
          MOVEZ  (POINTOF,OPND2),P2    SCALE OPND2
          CALLZ  LDDC2DC2 
          NOTE   DC2TDC2
          GENM   MULTDDD
            REGP   VREGA,(VREGP1OF,VREGA),VREGB,(VREGP1OF,VREGB),(VREGOF
,,VREGC),(VREGOF,VREGD) 
          ENDG
          MOVEZ  DPCOMP2,P1 
          CALLZ  STC2DC2
          RETURN
 LITTCOC1 EJECT 
* 
*         LITTCOC1 -  LITERAL * DISPLAY OR COMP1
* 
 LITTCOC1 LABEL 
          NOTE   LITTCOC1 
          ADDZ   (POINTOF,OPND1),(POINTOF,OPND2),CPOINT 
          MOVEZ  OPND1,SAVREG 
          MOVEZ  (SIGNOF,OPND2),P2
          MOVEZ  COMP1,P3 
          MOVEZ  (NUMLENOF,OPND2),P4
          MOVEZ  (POINTOF,OPND2),P5 
          MOVEZ  OPND2,REGB 
          CALLZ  LDCOC1 
          MOVEZ  P1,P2
          MOVEZ  SAVREG,P1
          CALLZ  LITMULT
          MOVEZ  COMP1,P1 
          MOVEZ  P3,VREGC 
          CALLZ  STCOC1 
          RETURN
 IMULT    EJECT 
* 
*         IMULT  - GENERATE MULTIPLY OF DISPLAY AND OR COMP1 OPERANDS 
* 
 IMULT    LABEL 
          ADDZ   (NUMLENOF,OPND1),(NUMLENOF,OPND2),CSIZE
          IFTHEN (CSIZE,LT,15)
            MINZ   CSIZE,14,CSIZE 
            ADDZ   (POINTOF,OPND1),(POINTOF,OPND2),CPOINT 
            MOVEZ  OPND2,SAVREG 
            MOVEZ  (SIGNOF,REGB),P2 
            MOVEZ  (NUMLENOF,REGB),P4 
            MOVEZ  (POINTOF,REGB),P5
            MOVEZ  COMP1,P3 
            CALLZ  LDCOC1 
            MOVEZ  P1,VREGA 
            MOVEZ  SAVREG,REGB
            MOVEZ  (SIGNOF,REGB),P2 
            MOVEZ  (NUMLENOF,REGB),P4 
            MOVEZ  (POINTOF,REGB),P5
            MOVEZ  COMP1,P3 
            CALLZ  LDCOC1 
            MOVEZ  P1,VREGB 
            NOTE   IMULT
            GEN    IMUL,(VREGOF,VREGC),VREGA,VREGB
  
*      THE FOLLOWING (APPARENTLY USELESS) CODE INSURES THAT VREGC WILL
*      BE +0 IN THE CASE THAT ONE OF VREGA OR VREGB IS +0 AND THE OTHER 
*      IS A NEGATIVE NUMBER.  (IN THIS CASE THE STUPID HARDWARE PRODUCES
*      A -0 AS THE RESULT OF THE INTEGER MULTIPLY)
  
            GEN    MASK,(VREGOF,VREGD)
            GEN    IADD,(VREGOF,VREGC),VREGC,VREGD
            MOVEZ  COMP1,P1 
            CALLZ  STCOC1 
            RETURN
          ENDIFZ
          IFZ    ((NUMLENOF,OPND1),GT,14),IMULT1
          IFTHEN ((NUMLENOF,OPND2),LT,15) 
            CALLZ  C2TC2
          ELSEZ 
            CALLZ  C2TDC2 
          ENDIFZ
          RETURN
          SPACE  4
 IMULT1   LABEL 
          IFTHEN ((NUMLENOF,OPND1),LT,15) 
            CALLZ  DC2TC2 
          ELSEZ 
            CALLZ  DC2TDC2
          ENDIFZ
          RETURN
          TITLE  ROUND
* 
*         ROUND  - PERFORM ADDITION FOR ROUNDING
*         INPUT 
*           REGB - TEMP CONTAING ITEM TO BE ROUNDED 
*           REGC - TEMP CONTAINING ROUNDING VALUE 
*           REGD - TEMP TO CONTAIN RESULT 
*         OUTPUT
*           SETS TREGOF(REGD) AND TYPE, NUMLEN, ETC.
* 
 ROUND    EGO    1
          GOTOCASE (TYPEOF,REGB)
            CASE   COMP,RND1
            CASE   COMP1,RND2 
            CASE   COMP2,RND3 
          CASE   COMP4,RND2 
            CASE   DPCOMP2,RND4 
          ENDCASE 
          ERROR 
*      COMP 
 RND1     LABEL 
          NOTE   RND1 
          MOVEZ  COMP,(TYPEOF,REGD) 
*      POINT LOCATIONS ARE ALIGNED
          MOVEZ  (NUMLENOF,REGB),CSIZE
          ORZ    (SIGNOF,REGB),(SIGNOF,REGC),CSIGN
          MOVEZ  CSIGN,(SIGNOF,REGD)
          MOVEZ  (POINTOF,REGB),(POINTOF,REGD)
          ADDZ   1,CSIZE,T1 
          MOVEZ  T1,(NUMLENOF,REGD) 
          IFZ    (CSIZE,LT,9),RND1B 
          IFZ    (CSIGN),RND1A
          IFZ    (CSIZE,EQ,9),RND1B 
          IFZ    (CSIZE,EQ,10),RND1C
 RND1A    LABEL 
*      DISPLAY CODE ADD - DOUBLE PRECISION INPUT,OUTPUT 
          NOTE   RND1A
          GENOBJ N=C.AD222,I=((TREGOF,REGB),(TREGP1OF,REGB),(TREGOF,REGC
,),(TREGP1OF,REGC)),O=((VREGOF,VREGC),(VREGOF,VREGD)) 
          MOVEZ  VREGC,(TREGOF,REGD)
          RETURN
          SPACE  4
 RND1B    LABEL 
*      DISPLAY CODE ADD - SINGLE PRECISION INPUT,OUTPUT 
          NOTE   RND1B
          GENM   DSPADD 
            SYMP   ZEROS,SIXES
            REGP   (TREGOF,REGB),(TREGOF,REGC),(VREGOF,VREGC) 
          ENDG
          MOVEZ  VREGC,(TREGOF,REGD)
          RETURN
          SPACE  4
 RND1C    LABEL 
*      DISPLAY CODE ADD - SINGLE PRECISION INPUT, D.P. OUTPUT 
          NOTE   RND1C
          GENOBJ N=C.AD112,I=((TREGOF,REGB),(TREGOF,REGC)),O=((VREGOF,VR
,EGC),(VREGOF,VREGD)) 
          MOVEZ  VREGC,(TREGOF,REGD)
          RETURN
          SPACE  4
 RND2     LABEL 
*      COMP1
          NOTE   RND2 
          MOVEZ  COMP1,(TYPEOF,REGD)
          MOVEZ  (NUMLENOF,REGB),(NUMLENOF,REGD)
          MOVEZ    (POINTOF,REGB),(POINTOF,REGD)
          ORZ      (SIGNOF,REGB),(SIGNOF,REGC),(SIGNOF,REGD)
          GEN      IADD,(VREGOF,VREGC),(TREGOF,REGB),(TREGOF,REGC)
          MOVEZ    VREGC,(TREGOF,REGD)
          RETURN
          SPACE  4
 RND3     LABEL 
*      COMP2
          NOTE   RND3 
          MOVEZ  COMP2,(TYPEOF,REGD)
          ORZ    (SIGNOF,REGB),(SIGNOF,REGC),(SIGNOF,REGD)
          MOVEZ  (POINTOF,REGB),(POINTOF,REGD)
          GEN    RADD,(VREGOF,VREGC),(TREGOF,REGC),(TREGOF,REGB)
          GEN    NORM,(VREGOF,VREGC),,VREGC 
          MOVEZ  VREGC,(TREGOF,REGD)
          RETURN
          SPACE  4
 RND4     LABEL 
*      DPCOMP2
          NOTE   RND4 
          MOVEZ  DPCOMP2,(TYPEOF,REGD)
          ORZ    (SIGNOF,REGB),(SIGNOF,REGC),(SIGNOF,REGD)
          MOVEZ  (POINTOF,REGB),(POINTOF,REGD)
          GENM   ADDSDD 
            REGP   (TREGOF,REGC),(TREGOF,REGB),(TREGP1OF,REGB),(VREGOF,V
,REGC),(VREGOF,VREGD) 
          ENDG
          MOVEZ  VREGC,(TREGOF,REGD)
          RETURN
          TITLE  ARITH SUBROUTINES
 ERRCHEK  EJECT 
* 
*         ERRCHEK - GENERATE LABEL FOR ERROR JUMP 
* 
 ERRCHEK  LABEL 
          NOTE   ERRCHEK
          IFTHEN (SIZESW) 
            MOVEZ  (LOCLAB,T1),T2 
            GEN    EQ$,,,((LOCAL$OF,T2))
            GEN    LABEL$,ERRLAB
            GEN    SXBPB,(VREGOF,VREGE),R1
            GEN    SSRBPK,VREGE,,SIZERR 
            GEN    EQ$,,,((LOCAL$OF,SZRLABL)) 
            GEN    LABEL$,((LOCAL$OF,T2)) 
          ELSEZ 
            GEN    LABEL$,ERRLAB
          ENDIFZ
          RETURN
 GETPREC  EJECT 
* 
*         GETPREC - DETERMINE REQUIRED PRECISION
*         INPUT 
*           RESULT - RESULT POINTER 
*           SIZESW - SIZE ERROR FLAG
  
*         OUTPUT
*           PREC    0 - MAXIMUM POSSIBLE PRECISION
*                   1 - SINGLE PRECISION
*                   2 - DOUBLE PRECISION
*           HOLDRES IS *PUSH*ED ON STACK
*                   FOR LATER USE BY *STC2DC2* AND *STCOC1* 
* 
 GETPREC  LABEL 
          IFZ    ((LEVELOF,RESULT),EQ,TEMPLEVL),GETPREC1
          IFZ    ((LEVELOF,RESULT),EQ,RESULTTE),GETPREC2
*      RESULT NOT TEMPORARY 
          MOVEZ  0,HOLDRES
          PUSH   HOLDRES
          IFTHEN (SIZESW) 
            MOVEZ  0,PREC 
            RETURN
          ENDIFZ
          EQZ    (TYPEOF,RESULT),COMP1,T1 
          EQZ    (TYPEOF,RESULT),COMP4,T1 
          EQZ    (TYPEOF,RESULT),COMP2,T2 
          ORZ    T1,T2,T3 
          IFTHEN (T3) 
            MOVEZ  1,PREC 
            RETURN
          ENDIFZ
          IFTHEN ((NUMLENOF,RESULT),LT,15)
            MOVEZ  1,PREC 
          ELSEZ 
            MOVEZ  2,PREC 
          ENDIFZ
          RETURN
          SPACE  4
 GETPREC1 LABEL              RESULT TEMPORARY 
          MOVEZ  0,HOLDRES
          PUSH   HOLDRES
          MOVEZ  0,PREC 
          RETURN
          SPACE  4
 GETPREC2 LABEL              FINAL RESULT 
          IFTHEN (SIZESW) 
            MOVEZ  1,HOLDRES
          ELSEZ 
            MOVEZ  0,HOLDRES
          ENDIFZ
          PUSH   HOLDRES
          EQZ    VERBDESC,MULTVERB,T1 
          EQZ    VERBDESC,DIVDVERB,T2 
          ORZ    T1,T2,T1 
          EQZ    (GSCODEOF,REGA),GMULT,T2 
          ORZ    T1,T2,T2 
          IFTHEN (T2,EQ,0)
            MOVEZ  0,PREC 
            MOVEZ  TEMPLEVL,(LEVELOF,RESULT)
            RETURN
            ENDIFZ
          MOVEZ  0,INTSIZ 
          MOVEZ  0,NCOMP1 
          MOVEZ  0,NCOMP2 
          MOVEZ  0,NDISP
          MOVEZ  0,POINT
          MOVEZ  0,SIGN 
          MOVEZ  0,SIZE 
          MOVEZ  (AUXREFOF,RESULT),AUXPTR 
*      EXAMINE RECEIVING FIELD DNATS
 GETPREC3 LABEL 
          MOVEZ  GDATAREF,(GCODEOF,RECV)
          MOVEZ  (AUXRCVOF,AUXPTR),(GPTROF,RECV)
          IFTHEN ((TYPEOF,RECV),EQ,COMP)
            ADDZ   1,NDISP,NDISP
            MAXZ   POINT,(POINTOF,RECV),POINT 
            MAXZ   INTSIZ,(INTLENOF,RECV),INTSIZ
          ENDIFZ
          IFTHEN ((TYPEOF,RECV),EQ,COMP1) 
            ADDZ   1,NCOMP1,NCOMP1
            MAXZ   POINT,(POINTOF,RECV),POINT 
            MAXZ   INTSIZ,(INTLENOF,RECV),INTSIZ
          ENDIFZ
          IFTHEN ((TYPEOF,RECV),EQ,COMP4) 
            ADDZ   1,NCOMP1,NCOMP1
            MAXZ   POINT,(POINTOF,RECV),POINT 
            MAXZ   INTSIZ,(INTLENOF,RECV),INTSIZ
          ENDIFZ
          IFTHEN ((TYPEOF,RECV),EQ,COMP2) 
            ADDZ   1,NCOMP2,NCOMP2
          ENDIFZ
          IFTHEN (TYPEOF,RECV),EQ,NUMEDIT)
            ADDZ   1,NDISP,NDISP
            MAXZ   POINT,(POINTOF,RECV),POINT 
            MAXZ   INTSIZ,(INTLENOF,RECV),INTSIZ
          ENDIFZ
          ORZ    (SIGNOF,RECV),SIGN,SIGN
          MOVEZ  (AUXNXTOF,AUXPTR),AUXPTR 
          IFZ    (AUXPTR,NE,0),GETPREC3 
*      DETERMINE INTERMEDIATE RESULT FORMAT 
          MOVEZ  SIGN,(SIGNOF,RESULT) 
          ADDZ   INTSIZ,POINT,SIZE
          IFTHEN (SIZE,EQ,0)       ALL RECEIVING FIELDS COMP2 
            MOVEZ  COMP2,(TYPEOF,RESULT)
            MOVEZ  0,(POINTOF,RESULT) 
            MOVEZ  1,PREC 
            RETURN
          ENDIFZ
          ADDZ   1,POINT,POINT     ALLOW FOR ROUNDING 
          ADDZ   1,SIZE,SIZE
          ANDZ   T1,SIZESW,T2          T1 MULTIPLY OR DIVIDE VERB 
          IFZ    (T2),GETPREC4
          IFTHEN (T1,EQ,0)
            MOVEZ  TEMPLEVL,(LEVELOF,RESULT)
          ENDIFZ
*      NO SIZE ERROR
          IFTHEN (SIZE,GT,14) 
            MOVEZ  2,PREC 
          ELSEZ 
            MOVEZ  1,PREC 
          ENDIFZ
          IFTHEN (NCOMP2,NE,0)
            MOVEZ  TEMPLEVL,(LEVELOF,RESULT)
            RETURN
          ENDIFZ
          IFTHEN (SIZE,GT,14) 
            MOVEZ  TEMPLEVL,(LEVELOF,RESULT)
            RETURN
          ENDIFZ
          MOVEZ  SIZE,(NUMLENOF,RESULT) 
          MOVEZ  POINT,(POINTOF,RESULT) 
          IFTHEN (NCOMP1,NE,0)
            MOVEZ  COMP1,(TYPEOF,RESULT)
          ELSEZ 
            MOVEZ  COMP,(TYPEOF,RESULT) 
          ENDIFZ
          RETURN
          SPACE  4
 GETPREC4 LABEL 
*      SIZE ERROR 
          MOVEZ  0,PREC 
          GTZ    SIZE,14,T1 
          GTZ    NDISP,0,T2 
          ORZ    T1,T2,T3 
          MOVEZ  SIZE,(NUMLENOF,RESULT) 
          MOVEZ  POINT,(POINTOF,RESULT) 
          IFTHEN (T3) 
            MOVEZ  COMP,(TYPEOF,RESULT) 
          ELSEZ 
            MOVEZ  COMP1,(TYPEOF,RESULT)
          ENDIFZ
          RETURN
 LDCOC1   EJECT 
* 
*         LDCOC1 - LOAD DISPLAY OR COMP1 OPERAND
* 
*         INPUT   - REGB - DNAT TO BE LOADED TO REGISTER
*                   P2 - SIGN TO BE MATCHED 
*                   P3- TYPE TO BE MATCHED
*                   P4 - SIZE TO BE MATCHED 
*                   P5 - POINT TO BE MATCHED
*         OUTPUT  - P1 - VIRTUAL REGISTER NUMBER CONTAINING LOADED ITEM 
*         FUNCTION- IF REGB IS A TEMPORARY WITH PROPERTIES MATCHING 
*                   INPUTS, RETURN ITS VIRTUAL REGISTER NUMBER. OTHERWISE 
*                   CREATE A DUMMY DNAT WITH INPUT PROPERTIES AND 
*                   GENERATE MOVE FROM REGB TO DUMMY. 
* 
 LDCOC1   LABEL 
          NOTZ   ((LEVELOF,REGB),EQ,TEMPLEVL),NEWDN 
          NOTZ   ((TYPEOF,REGB),EQ,P3),NEWDN
          NOTZ   ((NUMLENOF,REGB),EQ,P4),NEWDN
          NOTZ   ((POINTOF,REGB),EQ,P5),NEWDN 
          NOTZ   ((SIGNOF,REGB),EQ,P2),NEWDN
          MOVEZ  (TREGOF,REGB),P1 
          RETURN
          SPACE  4
 NEWDN    LABEL 
          MOVEZ  (EQUALS,DUM),REGT
          CALLZ  CRDNAT 
          MOVEZ  P4,(NUMLENOF,DUM)
          MOVEZ  P5,(POINTOF,DUM) 
          MOVEZ  P3,(TYPEOF,DUM)
          MOVEZ  P2,(SIGNOF,DUM)
          MOVEZ  (EQUALS,DUM),REGC
          CALLZ  MOVER       REGB TO DUM(REGC)
          MOVEZ  (TREGOF,DUM),P1
          CALLZ  SUBDNAT
          RETURN
 LDC2C2   EJECT 
* 
*         LDC2C2   - LOAD OPND1 AS COMP2 INTO VREGA AND 
*                    OPND2 AS COMP2 INTO VREGB
* 
*         INPUT  -P1 - SCALE  OPND1 
*                 P2 - SCALE  OPND2 
* 
 LDC2C2   LABEL 
*      PREVENT SCALE EXCEEDING 18 
          MOVEZ  (ABSVALOF,CPOINT),T1 
          IFTHEN (T1,GT,18) 
            MOVEZ  0,P1 
            MOVEZ  0,P2 
            MOVEZ  0,CPOINT 
          ENDIFZ
*       PREVENT SCALE BEYOND RANGE OF POWERS OF TEN TABLE 
          MINZ   (POINTOF,OPND1),(POINTOF,OPND2),T2 
          SUBZ   CPOINT,T2,T2 
          MOVEZ  (ABSVALOF,T2),T3 
          IFTHEN (T3,GT,18) 
            MOVEZ  0,P1 
            MOVEZ  0,P2 
            MOVEZ  0,CPOINT 
          ENDIFZ
          EQZ    (LEVELOF,OPND1),TEMPLEVL,T1
          EQZ    (TYPEOF,OPND1),COMP2,T2
          ANDZ   T1,T2,T3 
          EQZ    (POINTOF,OPND1),P1,T1
          ANDZ   T1,T3,T3 
          IFTHEN (T3) 
            MOVEZ  (TREGOF,OPND1),VREGA 
          ELSEZ 
            PUSH   P2 
            MOVEZ  OPND2,SAVREG 
            MOVEZ  (EQUALS,DUM),REGT
            CALLZ  CRDNAT 
            MOVEZ  COMP2,(TYPEOF,DUM) 
            MOVEZ  P1,(POINTOF,DUM) 
            MOVEZ  1,(SIGNOF,DUM) 
            MOVEZ  (EQUALS,DUM),REGC
            CALLZ  MOVER               OPND1(REGB) TO DUM(REGC) 
            MOVEZ  (TREGOF,DUM),VREGA 
            CALLZ  SUBDNAT
            MOVEZ  SAVREG,OPND2 
            POP    P2 
          ENDIFZ
          EQZ    (LEVELOF,OPND2),TEMPLEVL,T1
          EQZ    (TYPEOF,OPND2),COMP2,T2
          ANDZ   T1,T2,T3 
          EQZ    (POINTOF,OPND2),P2,T1
          ANDZ   T1,T3,T3 
          IFTHEN (T3) 
            MOVEZ  (TREGOF,OPND2),VREGB 
          ELSEZ 
            MOVEZ  OPND2,REGB 
            MOVEZ  (EQUALS,DUM),REGT
            CALLZ  CRDNAT 
            MOVEZ  COMP2,(TYPEOF,DUM) 
            MOVEZ  P2,(POINTOF,DUM) 
            MOVEZ  1,(SIGNOF,DUM) 
            MOVEZ  (EQUALS,DUM),REGC
            CALLZ  MOVER               OPND2(REGB) TO DUM(REGC) 
            MOVEZ  (TREGOF,DUM),VREGB 
            CALLZ  SUBDNAT
          ENDIFZ
          RETURN
 LDC2DC2  EJECT 
* 
*         LDC2DC2  - LOAD OPND1 AS COMP2 INTO VREGA AND 
*                    OPND2 AS DPCOMP2 INTO VREGB
* 
*         INPUT  - P1 - SCALE OPND1 
*                  P2 - SCALE OPND2 
* 
 LDC2DC2  LABEL 
*      PREVENT SCALE EXCEEDING 18 
          MOVEZ  (ABSVALOF,CPOINT),T1 
          IFTHEN (T1,GT,18) 
            MOVEZ  0,P1 
            MOVEZ  0,P2 
            MOVEZ  0,CPOINT 
          ENDIFZ
*       PREVENT SCALE BEYOND RANGE OF POWERS OF TEN TABLE 
          MINZ   (POINTOF,OPND1),(POINTOF,OPND2),T2 
          SUBZ   CPOINT,T2,T2 
          MOVEZ  (ABSVALOF,T2),T3 
          IFTHEN (T3,GT,18) 
            MOVEZ  0,P1 
            MOVEZ  0,P2 
            MOVEZ  0,CPOINT 
          ENDIFZ
          EQZ    (LEVELOF,OPND1),TEMPLEVL,T1
          EQZ    (TYPEOF,OPND1),COMP2,T2
          ANDZ   T1,T2,T3 
          EQZ    (POINTOF,OPND1),P1,T1
          ANDZ   T1,T3,T3 
          IFTHEN (T3) 
            MOVEZ  (TREGOF,OPND1),VREGA 
          ELSEZ 
            PUSH   P2 
            MOVEZ  OPND2,SAVREG 
            MOVEZ  (EQUALS,DUM),REGT
            CALLZ  CRDNAT 
            MOVEZ  COMP2,(TYPEOF,DUM) 
            MOVEZ  P1,(POINTOF,DUM) 
            MOVEZ  1,(SIGNOF,DUM) 
            MOVEZ  (EQUALS,DUM),REGC
            CALLZ  MOVER               OPND1(REGB) TO DUM(REGC) 
            MOVEZ  (TREGOF,DUM),VREGA 
            CALLZ  SUBDNAT
            MOVEZ  SAVREG,OPND2 
            POP    P2 
          ENDIFZ
          EQZ    (LEVELOF,OPND2),TEMPLEVL,T1
          EQZ    (TYPEOF,OPND2),DPCOMP2,T2
          ANDZ   T1,T2,T3 
          EQZ    (POINTOF,OPND2),P2,T1
          ANDZ   T1,T3,T3 
          IFTHEN (T3) 
            MOVEZ  (TREGOF,OPND2),VREGB 
          ELSEZ 
            MOVEZ  OPND2,REGB 
            MOVEZ  (EQUALS,DUM),REGT
            CALLZ  CRDNAT 
            MOVEZ  DPCOMP2,(TYPEOF,DUM) 
            MOVEZ  P2,(POINTOF,DUM) 
            MOVEZ  1,(SIGNOF,DUM) 
            MOVEZ  (EQUALS,DUM),REGC
            CALLZ  MOVER               OPND2(REGB) TO DUM(REGC) 
            MOVEZ  (TREGOF,DUM),VREGB 
            CALLZ  SUBDNAT
          ENDIFZ
          RETURN
 LDDC2C2  EJECT 
* 
*         LDDC2C2 - LOAD OPND1 AS DPCOMP2 INTO VREGA AND OPND2
*                   AS COMP2 INTO VREGB 
* 
*         INPUT  - P1 - SCALE OPND1 
*                  P2 - SCALE OPND2 
* 
 LDDC2C2  LABEL 
*      PREVENT SCALE EXCEEDING 18 
          MOVEZ  (ABSVALOF,CPOINT),T1 
          IFTHEN (T1,GT,18) 
            MOVEZ  0,P1 
            MOVEZ  0,P2 
            MOVEZ  0,CPOINT 
          ENDIFZ
*       PREVENT SCALE BEYOND RANGE OF POWERS OF TEN TABLE 
          MINZ   (POINTOF,OPND1),(POINTOF,OPND2),T2 
          SUBZ   CPOINT,T2,T2 
          MOVEZ  (ABSVALOF,T2),T3 
          IFTHEN (T3,GT,18) 
            MOVEZ  0,P1 
            MOVEZ  0,P2 
            MOVEZ  0,CPOINT 
          ENDIFZ
          EQZ    (LEVELOF,OPND1),TEMPLEVL,T1
          EQZ    (TYPEOF,OPND1),DPCOMP2,T2
          ANDZ   T1,T2,T3 
          EQZ    (POINTOF,OPND1),P1,T1
          ANDZ   T1,T3,T3 
          IFTHEN (T3) 
            MOVEZ  (TREGOF,OPND1),VREGA 
          ELSEZ 
            PUSH   P2 
            MOVEZ  OPND2,SAVREG 
            MOVEZ  (EQUALS,DUM),REGT
            CALLZ  CRDNAT 
            MOVEZ  DPCOMP2,(TYPEOF,DUM) 
            MOVEZ  P1,(POINTOF,DUM) 
            MOVEZ  1,(SIGNOF,DUM) 
            MOVEZ  (EQUALS,DUM),REGC
            CALLZ  MOVER              OPND1(REGB) TO DUM(REGC)
            MOVEZ  (TREGOF,DUM),VREGA 
            CALLZ  SUBDNAT
            MOVEZ  SAVREG,OPND2 
            POP    P2 
          ENDIFZ
          EQZ    (LEVELOF,OPND2),TEMPLEVL,T1
          EQZ    (TYPEOF,OPND2),COMP2,T2
          ANDZ   T1,T2,T3 
          EQZ    (POINTOF,OPND2),P2,T1
          ANDZ   T1,T3,T3 
          IFTHEN (T3) 
            MOVEZ  (TREGOF,OPND2),VREGB 
          ELSEZ 
            MOVEZ  (EQUALS,DUM),REGT
            CALLZ  CRDNAT 
            MOVEZ  COMP2,(TYPEOF,DUM) 
            MOVEZ  P2,(POINTOF,DUM) 
            MOVEZ  1,(SIGNOF,DUM) 
            MOVEZ  OPND2,REGB 
            MOVEZ  (EQUALS,DUM),REGC
            CALLZ  MOVER              OPND2(REGB) TO DUM(REGC)
            MOVEZ  (TREGOF,DUM),VREGB 
            CALLZ  SUBDNAT
          ENDIFZ
          RETURN
 LDDC2DC2 EJECT 
* 
*         LDDC2DC2 - LOAD OPND1 AS DPCOMP2 INTO VREGA AND 
*                    OPND2 AS DPCOMP2 INTO VREGB
* 
*         INPUT  - P1 - SCALE OPND1 
*                  P2 - SCALE OPND2 
* 
 LDDC2DC2 LABEL 
*      PREVENT SCALE EXCEEDING 18 
          MOVEZ  (ABSVALOF,CPOINT),T1 
          IFTHEN (T1,GT,18) 
            MOVEZ  0,P1 
            MOVEZ  0,P2 
            MOVEZ  0,CPOINT 
          ENDIFZ
*       PREVENT SCALE BEYOND RANGE OF POWERS OF TEN TABLE 
          MINZ   (POINTOF,OPND1),(POINTOF,OPND2),T2 
          SUBZ   CPOINT,T2,T2 
          MOVEZ  (ABSVALOF,T2),T3 
          IFTHEN (T3,GT,18) 
            MOVEZ  0,P1 
            MOVEZ  0,P2 
            MOVEZ  0,CPOINT 
          ENDIFZ
          EQZ    (LEVELOF,OPND1),TEMPLEVL,T1
          EQZ    (TYPEOF,OPND1),DPCOMP2,T2
          ANDZ   T1,T2,T3 
          EQZ    (POINTOF,OPND1),P1,T1
          ANDZ   T1,T3,T3 
          IFTHEN (T3) 
            MOVEZ  (TREGOF,OPND1),VREGA 
          ELSEZ 
            PUSH   P2 
            MOVEZ  OPND2,SAVREG 
            MOVEZ  (EQUALS,DUM),REGT
            CALLZ  CRDNAT 
            MOVEZ  DPCOMP2,(TYPEOF,DUM) 
            MOVEZ  P1,(POINTOF,DUM) 
            MOVEZ  1,(SIGNOF,DUM) 
            MOVEZ  (EQUALS,DUM),REGC
            CALLZ  MOVER               OPND1(REGB) TO DUM(REGC) 
            MOVEZ  (TREGOF,DUM),VREGA 
            CALLZ  SUBDNAT
            MOVEZ  SAVREG,OPND2 
            POP    P2 
          ENDIFZ
          EQZ    (LEVELOF,OPND2),TEMPLEVL,T1
          EQZ    (TYPEOF,OPND2),DPCOMP2,T2
          ANDZ   T1,T2,T3 
          EQZ    (POINTOF,OPND2),P2,T1
          ANDZ   T1,T3,T3 
          IFTHEN (T3) 
            MOVEZ  (TREGOF,OPND2),VREGB 
          ELSEZ 
            MOVEZ  OPND2,REGB 
            MOVEZ  (EQUALS,DUM),REGT
            CALLZ  CRDNAT 
            MOVEZ  DPCOMP2,(TYPEOF,DUM) 
            MOVEZ  P2,(POINTOF,DUM) 
            MOVEZ  1,(SIGNOF,DUM) 
            MOVEZ  (EQUALS,DUM),REGC
            CALLZ  MOVER               OPND2(REGB) TO DUM(REGC) 
            MOVEZ  (TREGOF,DUM),VREGB 
            CALLZ  SUBDNAT
          ENDIFZ
          RETURN
 MOVERA   EJECT 
 MOVERA   LABEL 
*      FOLLOWING CODE DIRECTS GMOVE TO GENERATE SIZE ERROR CODE FOR 
*      INTERMEDIATE RESULTS IN MULTIPLY AND DIVIDE STATEMENTS 
          EQZ    VERBDESC,MULTVERB,T1 
          EQZ    VERBDESC,DIVDVERB,T2 
          ORZ    T1,T2,T1 
          ORZ    T1,T2,T1 
          ANDZ   T1,SIZESW,T1 
          IFTHEN ((LEVELOF,RESULT),EQ,RESULTTE) 
            MOVEZ  TEMPLEVL,(LEVELOF,RESULT)
            MOVEZ  1,T2 
          ELSEZ 
            MOVEZ  0,T2 
          ENDIFZ
          ANDZ   T1,T2,T1 
          IFTHEN (T1) 
            MOVEZ  1,MOVESIZE 
          ELSEZ 
            MOVEZ  0,MOVESIZE 
          ENDIFZ
          IFTHEN (RND)
            CALLZ  MOVERN    MOVE ROUNDED 
          ELSEZ 
            CALLZ  MOVER
          ENDIFZ
          MOVEZ  0,MOVESIZE 
          RETURN
 STC2DC2  EJECT 
* 
*         STC2DC2 - STORE COMP2 OR DPCOMP2 COMPUTATION
* 
*         INPUT   - P1      - TYPE OF COMPUTATION (COMP1 OR DPCOMP2)
*                   RESULT  - RESULT POINTER
*                   VREGC   - VIRTUAL REGISTER HOLDING COMPUTATION
*                   CPOINT  - COMPUTATION POINT LOCATION
*                   CSIGN   - COMPOSITE SIGN
*                   HOLDRES - *PUSH*ED ON STACK BY *GETPREC*
* 
*         FUNCTION- IF RESULT IS A TEMPORARY SET ITS TYPE TO P1 AND 
*                   VIRTUAL REGISTER TO VREGC. OTHERWISE CREATE A 
*                   TEMPORARY DNAT ENTRY FOR COMPUTATION AND GENERATE 
*                   MOVE TO RESULT. 
* 
 STC2DC2  LABEL 
          IFTHEN ((LEVELOF,RESULT),EQ,TEMPLEVL) 
            MOVEZ   VREGC,(TREGOF,RESULT) 
            MOVEZ   P1,(TYPEOF,RESULT)
            MOVEZ  CSIGN,(SIGNOF,RESULT)
            MOVEZ  CPOINT,(POINTOF,RESULT)
          ELSEZ 
            MOVEZ  (EQUALS,DUM),REGT
            CALLZ  CRDNAT 
            MOVEZ  P1,(TYPEOF,DUM)
          MOVEZ  CSIGN,(SIGNOF,DUM) 
            MOVEZ  CPOINT,(POINTOF,DUM) 
            MOVEZ  VREGC,(TREGOF,DUM) 
            MOVEZ  RESULT,REGC
            MOVEZ  (EQUALS,DUM),REGB
            CALLZ  MOVERA             DUM(REGB) TO RESULT(REGC) 
            CALLZ  SUBDNAT
          ENDIFZ
          POP    HOLDRES
          IFZ    (HOLDRES,EQ,0),RETURN
          IFTHEN ((TYPEOF,RESULT),EQ,DPCOMP2) 
            GENLP  ((TREGOF,RESULT),(TREGP1OF,RESULT))
          ELSEZ 
            GENLP  ((TREGOF,RESULT))
          ENDIFZ
          RETURN
 STCOC1   EJECT 
* 
*         STOCOC1  - STORE COMP OR COMP1 COMPUTATION
* 
*         INPUT   - RESULT - RESULT POINTER 
*                   P1     - TYPE OF COMPUTATION (COMP OR COMP1)
*                   CSIZE  - COMPUTAION SIZE
*                   CPOINT - COMPUTATION POINT LOCATION 
*                   CSIGN  - COMPUTATION SIGN 
*                   VREGC  - VIRTUAL REGISTER HOLDING COMPUTATION 
*                   HOLDRES- *PUSH*ED ON STACK BY *GETPREC* 
* 
*         FUNCTION - IF RECEIVING FIELD IS A TEMPORARY, SET ITS 
*                   PROPERTIES TO MATCH COMPUTATION.  OTHERWISE 
*                   CREATE A DUMMY DNAT ENTRY FOR COMPUTATION 
*                   AND GENERATE MOVE TO RECEIVING FIELD
* 
 STCOC1   LABEL 
          IFTHEN ((LEVELOF,RESULT),EQ,TEMPLEVL) 
            MOVEZ  P1,(TYPEOF,RESULT) 
            MOVEZ  CSIZE,(NUMLENOF,RESULT)
            MOVEZ  CPOINT,(POINTOF,RESULT)
            MOVEZ  CSIGN,(SIGNOF,RESULT)
            MOVEZ  VREGC,(TREGOF,RESULT)
          ELSEZ 
            MOVEZ  (EQUALS,DUM),REGT
            CALLZ  CRDNAT 
            MOVEZ  RESULT,REGC
            MOVEZ  P1,(TYPEOF,DUM)
            MOVEZ  CSIZE,(NUMLENOF,DUM) 
            MOVEZ  CPOINT,(POINTOF,DUM) 
            MOVEZ  CSIGN,(SIGNOF,DUM) 
            MOVEZ  VREGC,(TREGOF,DUM) 
            MOVEZ  (EQUALS,DUM),REGB
            CALLZ  MOVERA    DUM(REGB) TO RESULT(REGC)
            CALLZ  SUBDNAT
          ENDIFZ
          POP    HOLDRES
          IFZ    (HOLDRES,EQ,0),RETURN
          IFTHEN ((TYPEOF,RESULT),EQ,COMP)
          ANDIF  ((NUMLENOF,RESULT),LT,10)
            GENLP  ((TREGOF,RESULT))
          ENDIFZ
          IFTHEN ((TYPEOF,RESULT),EQ,COMP1) 
            GENLP  ((TREGOF,RESULT))
          ENDIFZ
          IFTHEN ((NUMLENOF,RESULT),GT,10)
          ANDIF  ((TYPEOF,RESULT),EQ,COMP)
            GENLP  ((TREGOF,RESULT),(TREGP1OF,RESULT))
          ENDIFZ
          IFTHEN ((NUMLENOF,RESULT),EQ,10)
          ANDIF  ((TYPEOF,RESULT),EQ,COMP)
          ANDIF  ((SIGNOF,RESULT))
            GENLP  ((TREGOF,RESULT),(TREGP1OF,RESULT))
          ENDIFZ
          RETURN
          END 
