*DECK GSUBSC
          IDENT  GSUBSC 
          TITLE  GSUBSC - SUBSCRIPT GENERATORS
  
          SST 
          COMMENT  GENERATE SUBSCRIPT CODE
          SPACE  4
**        GSUBSC -  GENERATE SUBSCRIPT CODE 
* 
*         CONTAINS: 
*                CGSUBCA   - CALCULATE SUBSCRIPT
*                CGSUBSU   - SUBSCRIPT SUM
*                CGSUFET   - SUBSCRIPT FETCH
*                SCLOAD    - IN-LINE LOAD OF SUBSCRIPTED ITEM 
*                SCTORE    - IN-LINE STORE OF SUBSCRIPTED ITEM
*                SUBLOAD   - LOAD SUBSCRIPT 
  
          SST 
  
  
  
  
 CONTROL  OPSYN  NIL
  
  
  
  
  
*CALL CCT 
*CALL SUBTYPE 
  
 GSUBSC   MODULE
  
 CGRANGE  KNIL   CGRANGE
 CGRELSU  KNIL   CGRELSU
 CGRFLCP  KNIL   CGREFLC
CGRFLEN   KNIL   CGREFLE
 CGREFCK  KNIL   CGREFCH
 CGSUBRF  KNIL   CGSUBSR
 CGSUBCA  KNIL   CGSUBCA
 CGSUBSU  KNIL   CGSUBSU
 CGSUFET  KNIL   CGSUFET
 SCLOAD   KNIL   SCLOAD 
 SCSTORE  KNIL   SCSTORE
 SUBLOAD  KNIL   SUBLOAD
 CGSUBLI  KNIL   CGSUBLI
 SUBREF   KNIL   SUBREF 
  
 ADNAT    LINK   ADNAT
 ADPDNAT  LINK   ADPDNAT
 BINVAL   LINK   BINVAL 
 CONMULT  LINK   GCONMUL
 GETSZVG  LINK   CGGTSZV
 MOVER    LINK   CGMOVE 
 OCCLEN   LINK   OCCLEN 
 SUBDNAT  LINK   SUBDNAT
  
 REGMOVE  EXECUTE CGREGMV 
          RETURN
  
  
 BCP0     EQU    T5 
 JUSTL    EQU    T1 
 LFILL    EQU    T7 
 RFILL    EQU    T6 
 SHEVEN   EQU    T4 
 SHEVEN1  EQU    T2 
 SHEVEN2  EQU    T3 
 SLABL    EQU    T8 
 VREGA    EQU    VREG1
 VREGB    EQU    VREG2
 VREGC    EQU    VREG3
 VREGD    EQU    VREG4
 VREGE    EQU    VREG5
 VREGF    EQU    VREG6
 VREGG    EQU    VREG7
 VREGH    EQU    VREG8
 VREGI    EQU    VREG9
 VREGJ    EQU    VREG10 
 VREGK    EQU    VREG11 
 VREGZ    EQU    VREG35 
 OP1      EQU    REGB 
 OP2      EQU    REGC 
 SCREG    EQU    REGB 
 SUBITM   EQU    REGY 
 SUBSCR   EQU    REGZ 
  
 TENTH    SETSY  (EXT$OF,C.TNTH)
 ##SUBOVF CONSTANT  #SUBOVF 
  
 FETCHSB  MACRO                        LOAD SUBSCRIPT INTO VREGA
          MOVEZ  P1,SUBITM   SAVE 
          MOVEZ  (GSCODEOF,P1),P1 
          CALLZ  SUBLOAD
          MOVEZ  P1,VREGA 
          MOVEZ  SUBITM,P1   RESTORE
          ENDM
  
 CRREG    MACRO  P           CREATE DNAT REFERENCE IN REGT
          MOVEZ  (EQUALS,REGU1),REGT
          MOVEZ  0,P1 
          MOVEZ  REGT,P2
          EXECUTE CGREGMV 
          MOVEZ  GDATAREF,(GCODEOF,REGU1) 
          MOVEZ  (SUBLOCOF,P),(GPTROF,REGU1)
          ENDM
CGRELSUB  EJECT 
          TITLE  CGRELSUB - RELATIVE SUBSCRIPTING 
* 
*         CGRELSUB - RELATIVE SUBSCRIPTING
* 
 CGRELSU  EGO    1
          NOTE   CGRELSU
          MOVEZ  REGT6,REGT 
          CALLZ  ADPDNAT
          MOVEZ  0,(BCPOF,REGT) 
          MOVEZ  10,(BYTLENOF,REGT) 
          MOVEZ  (GPTROF,REGB),T3 
          MOVEZ  GDATAREF,(GCODEOF,REGU1) 
          MOVEZ  (SUBLOCOF,T3),(GPTROF,REGU1) 
          MOVEZ  (SUBLVLOF,REGU1),P2
          MOVEZ  REGU1,P1 
          EXECUTE OCCLEN
          MOVEZ  (GPTROF,REGC),T1 
          ADDZ   (SUBLOCOF,T1),1,T3 
          MULTZ  P1,T3,T2 
          ADDZ   (SHL30OF,T2),T3,P2 
          MOVEZ  0,P1 
          EXECUTE LITPOOL 
          GEN    SLRBPK,(VREGOF,VREGA),,((FWA$OF,REGT)) 
          MOVEZ  (GPTROF,REGB),P1 
          CALLZ  SUBLOAD1    LOAD SUBSCRIPT TO P1 
          GEN    IADD,(VREGOF,VREGA),VREGA,P1 
          MOVEZ  (GPTROF,REGA),T2 
          MOVEZ  (GSCODEOF,REGB),T1 
          IFTHEN ((RCTENTOF,T2),EQ,1) 
            MOVEZ SCALCR,(SUBTYPOF,T1)
            MOVEZ VREGA,(SUBLOCOF,T1) 
          ELSEZ 
            MOVEZ SCALC,(SUBTYPOF,T1) 
            MOVEZ T1,(SUBLOCOF,T1)
            GEN   SSRBPK,VREGA,,((SUBTMPOF,T1)) 
          ENDIFZ
          RETURN
          TITLE  CGSUBCA - SUBSCRIPT CALCULATION
* 
*         CGSUBCA - CALCULATE SUBSCRIPT 
* 
 CGSUBCA  EGO    1
          NOTE   CGSUBCA
          MOVEZ  REGB,SUBITM
          MOVEZ  REGC,SUBSCR
*      LOAD SUBSCRIPT IN COMP1 FORMAT 
          MOVEZ  (EQUALS,REGT1),REGT
          CALLZ  ADNAT
          MOVEZ  COMP1,(TYPEOF,REGT1) 
          IFTHEN ((CCTBIT,SUBSCHEC),EQ,0) 
            MINZ   (NUMLENOF,REGC),6,T1 
            MOVEZ  T1,(NUMLENOF,REGT1)
          ELSEZ 
            MOVEZ  (NUMLENOF,REGC),(NUMLENOF,REGT1) 
          ENDIFZ
          MOVEZ  0,(POINTOF,REGT1)
          MOVEZ  (SIGNOF,REGC),(SIGNOF,REGT1) 
          MOVEZ  REGC,REGB
          MOVEZ  (EQUALS,REGT1),REGC
          CALLZ  MOVER
          MOVEZ  (TREGOF,REGC),VREGA
          CALLZ  SUBDNAT
*      COMPUTE  SUBSCRIPT * OCCURRENCE LENGTH 
          MOVEZ  SUBITM,P1
          MOVEZ  (GSCODEOF,REGD),P2 
          EXECUTE OCCLEN
          GEN    SXXPK,(VREGOF,P2),VREGA,-1 
          CALLZ  CONMULT
          MOVEZ  P3,VREGB 
*      ENTER SUBSCRIPT CALCULATION IN SUBSCRIPT TABLE 
      MOVEZ   (GPTROF,REGA),T1
*      BUILD SUBSCRIPT WORD AND STORE IN SUBSCRIPT TEMPORARY
          NOTE   CGSUBCA
          GEN    SHL,VREGB,30 
          IFTHEN ((SIGNOF,SUBSCR),NE,0) 
             GEN  MASK,(VREGOF,VREGD),30
             GEN  LAND,(VREGOF,VREGB),VREGD,VREGB 
             GEN  LIMP,(VREGOF,VREGA),VREGA,VREGD 
          ENDIFZ
          GEN    LOR,(VREGOF,VREGC),VREGA,VREGB 
      MOVEZ   (GPTROF,REGD),T2
          IFTHEN ((RCTENTOF,T2),EQ,1)  ONLY ONE REFERENCE 
            MOVEZ  SCALCR,(SUBTYPOF,T1) 
            MOVEZ  VREGC,(SUBLOCOF,T1)
          ELSEZ 
            MOVEZ  SCALC,(SUBTYPOF,T1)
            MOVEZ  T1,(SUBLOCOF,T1) 
            GEN     SSRBPK,VREGC,,((SUBTMPOF,T1)
          ENDIFZ
          RETURN
CGSUBLIT  EJECT 
          TITLE  CGSUBLIT - LITERAL SUBSCRIPT 
* 
*         CGSUBLIT - LITERAL SUBSCRIPT
* 
 CGSUBLI  EGO    1
          NOTE   CGSUBLI
          MOVEZ  (GPTROF,REGA),T1 
          MOVEZ  SCON,(SUBTYPOF,T1) 
          MOVEZ  REGB,REGT
          CALLZ  BINVAL 
          SUBZ   P1,1,(SUBLOCOF,T1) 
          MOVEZ  (GPTROF,REGC),T2  AUXTABLE POINTER 
          MOVEZ  (AUXOCCLN,T2),T2 
          MULTZ  (SUBLOCOF,T1),T2,(SUBOFFOF,T1) 
          RETURN
          TITLE  CGSUBSU - SUBSCRIPT SUM
* 
*         CSUBSU - SUBSCRIPT SUM
* 
 CGSUBSU  EGO    1
          MOVEZ  (GPTROF,OP1),T1
          EQZ    (SUBTYPOF,T1),SCON,T2
          MOVEZ  (GPTROF,OP2),T3
          EQZ    (SUBTYPOF,T3),SCON,T4
          ANDZ   T2,T4,T5 
          IFTHEN (T5)        BOTH LITERAL SUBSCRIPTS
            ADDZ   (SUBOFFOF,T1),(SUBOFFOF,T3),T2 
            MOVEZ  (GSCODEOF,OP1),T1
            MOVEZ  T2,(SUBOFFOF,T1) 
            MOVEZ  SCON,(SUBTYPOF,T1) 
            MOVEZ  0,(SUBLOCOF,T1)     IN CASE SUBLOAD USED LATER 
            RETURN
          ENDIFZ
*      AT LEAST ONE VARIABLE SUBSCRIPT
          MOVEZ  (GPTROF,OP1),P1
          CALLZ  SUBLOAD1 
          MOVEZ  P1,VREGB 
          MOVEZ  (GPTROF,OP2),P1
      CALLZ  SUBLOAD1 
          MOVEZ  P1,VREGC 
          MOVEZ  (GSCODEOF,OP1),T1
          GEN    IADD,(VREGOF,VREGA),VREGB,VREGC
          MOVEZ  (GPTROF,REGA),T2 
          IFTHEN ((RCTENTOF,T2),EQ,1)  ONLY ONE REFERENCE 
            MOVEZ  SCALCR,(SUBTYPOF,T1) 
            MOVEZ  VREGA,(SUBLOCOF,T1)
          ELSEZ 
            MOVEZ  SCALC,(SUBTYPOF,T1)
            MOVEZ  T1,(SUBLOCOF,T1) 
            GEN    SSRBPK,VREGA,,((SUBTMPOF,T1))
          ENDIFZ
          RETURN
          SPACE  4
          TITLE  CGSUFET - SUBSCRIPT FETCH
* 
*         CGSUFET - SUBSCRIPT FETCH 
* 
 CGSUFET  EGO    1
          MOVEZ  REGB,SUBSCR
          MOVEZ  (GPTROF,REGA),T1 
            MOVEZ  SINDX,(SUBTYPOF,T1)
            MOVEZ  (GPTROF,SUBSCR),(SUBLOCOF,T1)
          RETURN
          TITLE  CGRFLEN  - GENERATOR FOR REFERENCE MODIFIER LENGTH 
* 
*         CGRFLEN  - REFERENCE MODIFIER LENGTH
* 
 CGRFLEN  EGO    1
          NOTE   CGRFLEN
          IFTHEN ((GCODEOF,REGB),EQ,GLITREF)
            MOVEZ  REGB,REGT
            CALLZ  BINVAL 
            MOVEZ  (GPTROF,REGA),T1 
            MOVEZ  P1,(RFLENVAL,T1) 
            MOVEZ  SCON,(RFLENTYP,T1) 
          ENDIFZ
          IFTHEN ((GCODEOF,REGB),EQ,GDATAREF) 
            MOVEZ  REGC,P1
            MOVEZ  REGT6,P2 
            CALLZ  REGMOVE   SAVE REGC
            MOVEZ  REGT1,REGT 
            CALLZ  ADNAT
            MOVEZ  COMP1,(TYPEOF,REGT1) 
            MOVEZ  (NUMLENOF,REGB),(NUMLENOF,REGT1) 
            MOVEZ  0,(POINTOF,REGT1)
            MOVEZ  (SIGNOF,REGB),(SIGNOF,REGT1) 
            MOVEZ  REGT1,REGC 
            CALLZ  MOVER
            MOVEZ  (GPTROF,REGA),T1 
            MOVEZ  (TREGOF,REGC),(RFLENVAL,T1)
            MOVEZ  SCALCR,(RFLENTYP,T1) 
            CALLZ  SUBDNAT
            MOVEZ  REGT6,P2 
            MOVEZ  REGC,P2
            CALLZ  REGMOVE
          ENDIFZ
          IFTHEN ((GCODEOF,REGB),EQ,GSUBVERB) 
            MOVEZ  (GPTROF,REGA),T1 
            MOVEZ  RFEND,(RFLENTYP,T1)
          ENDIFZ
          RETURN
          TITLE  CGREFCK - REFERENCE MODIFICATION CHECKING
* 
*         CGREFCK - REFERENCE MODIFICATION CHECKING 
* 
 CGREFCK  EGO    1
          NOTE   CGREFCK
          IFTHEN ((TYPEOF,REGB),EQ,VARGROUP)
            MOVEZ  REGB,REGM
            CALLZ  GETSZVG
            MOVEZ  P1,VREGA 
          ELSEZ 
            GEN    SXBPK,(VREGOF,VREGA),,(BYTLENOF,REGB)
          ENDIFZ
          MOVEZ  (GPTROF,REGA),T1 
          IFTHEN ((RFLCPTYP,T1),EQ,SCON)
            GEN    SXBPK,(VREGOF,VREGB),,(RFLCPVAL,T1)
          ELSEZ 
            MOVEZ  (RFLCPVAL,T1),VREGB
          ENDIFZ
          MOVEZ  (LOCLAB,T2),T2 
          MOVEZ  (LOCLAB,T3),T3 
          GEN    NG$,VREGB,,((LOCAL$OF,T2)) 
          GEN    ZR$,VREGB,,((LOCAL$OF,T2)) 
          IFTHEN ((RFLENTYP,T1),EQ,RFEND) 
            GEN    ISUB,(VREGOF,VREGC),VREGA,VREGB
            GEN    PL$,VREGC,,((LOCAL$OF,T3)) 
            BRANCH RFLEN1 
          ENDIFZ
          IFTHEN ((RFLENTYP,T1),EQ,SCON)
            GEN    SXBPK,(VREGOF,VREGC),,(RFLENVAL,T1)
          ELSEZ 
            MOVEZ  (RFLENVAL,T1),VREGC
          ENDIFZ
          GEN    ZR$,VREGC,,((LOCAL$OF,T2)) 
          GEN    NG$,VREGC,,((LOCAL$OF,T2)) 
          GEN    SXXPB,(VREGOF,VREGA),VREGA,VREGB1
          GEN    IADD,(VREGOF,VREGD),VREGB,VREGC
          GEN    ISUB,(VREGOF,VREGA),VREGA,VREGD
          GEN    PL$,VREGA,,((LOCAL$OF,T3)) 
 RFLEN1   LABEL 
          GEN    LABEL$,((LOCAL$OF,T2)) 
          GEN    PLUS 
          GEN    RJ$,((EXT$OF,C.RFERR)) 
          GEN    MINUS
          GEN    PS$,,CURRLINE
          GEN    LABEL$,((LOCAL$OF,T3)) 
          RETURN
          TITLE  CGRFLCP - GENERATOR FOR REFERENCE MODIFIER LCP 
* 
*         CGRFLCP - REFERENCE MODIFIER LEADING CHARACTER POSITION 
* 
 CGRFLCP  EGO    1
          NOTE   CGRFLCP
          IFTHEN ((GCODEOF,REGB),EQ,GLITREF)
            MOVEZ  REGB,REGT
            CALLZ  BINVAL 
            MOVEZ  (GPTROF,REGA),T1 
            MOVEZ  P1,(RFLCPVAL,T1) 
            MOVEZ  SCON,(RFLCPTYP,T1) 
          ELSEZ 
            MOVEZ  REGT1,REGT 
            CALLZ  ADNAT
            MOVEZ  COMP1,(TYPEOF,REGT1) 
            MOVEZ  (NUMLENOF,REGB),(NUMLENOF,REGT1) 
            MOVEZ  0,(POINTOF,REGT1)
            MOVEZ  (SIGNOF,REGB),(SIGNOF,REGT1) 
            MOVEZ  REGT1,REGC 
            CALLZ  MOVER
            MOVEZ  (GPTROF,REGA),T1 
            MOVEZ  (TREGOF,REGC),(RFLCPVAL,T1)
            MOVEZ  SCALCR,(RFLCPTYP,T1) 
            CALLZ  SUBDNAT
          ENDIFZ
          RETURN
          TITLE  CGSUBRF - SUBSCRIPT REFERENCE PROCESSOR
* 
*         CGSUBRF - SUBSCRIPT REFERENCE 
* 
 CGSUBRF  EGO    1
          NOTE   CGSUBRF
          MOVEZ  (GPTROF,REGA),T1 
          MOVEZ  (GPTROF,REGB),(SUBNUMOF,T1)
          RETURN
          TITLE   SCLOAD - SPECIAL CASE SUBSCRIPTED LOAD
          EJECT 
*         SUBREF    --  APPLY VARIABLE SUBSCRIPTS AND/OR REFERENCE
*                       MODIFIERS 
*         INPUT 
*                P2 -  REGTABLE POINTER TO MODIFIED DNAT
*         OUTPUT
*                P3 -  VIRTUAL REGISTER NUMBER OF MODIFIED OFFSET 
*                P4 -  VIRTUAL REGISTER NUMBER OF LENGTH
*                BOTH P3 AND P4 REPRESENT X REGISTERS 
 SUBREF   EGO    3
          NOTE  SUBREF
          MOVEZ  (GSCODEOF,P2),T1 
          IFTHEN ((SUBNUMOF,T1),NE,0) 
            PUSH   T1 
            MOVEZ  (GSCODEOF,P2),P1 
            CALLZ  SUBLOAD
            GEN    SHR,P1,30
            GEN    SXXPK,(VREGOF,P3),P1,(BCPOF,P2)
            POP    T1 
          ELSEZ 
            GEN    SXBPK,(VREGOF,P3),,(BCPOF,P2)
          ENDIFZ
          IFTHEN ((RFLCPTYP,T1),EQ,0)  NO REFERENCE MODIFICATION
            GEN    SXBPK,(VREGOF,P4),,(BYTLENOF,P2) 
            RETURN
          ENDIFZ
          IFTHEN ((RFLCPTYP,T1),EQ,SCON)
            SUBZ   (RFLCPVAL,T1),1,T2 
            GEN    SXXPK,(VREGOF,P3),P3,T2
          ENDIFZ
          IFTHEN ((RFLCPTYP,T1),EQ,SCALCR)
            GEN    IADD,(VREGOF,P3),P3,(RFLCPVAL,T1)
            GEN    SXXPK,(VREGOF,P3),P3,-1
          ENDIFZ
          IFTHEN ((RFLENTYP,T1),EQ,SCON)
            GEN    SXBPK,(VREGOF,P4),,(RFLENVAL,T1) 
          ENDIFZ
          IFTHEN ((RFLENTYP,T1),EQ,SCALCR)
            GEN    XMIT,(VREGOF,P4),(RFLENVAL,T1) 
          ENDIFZ
          IFTHEN ((RFLENTYP,T1),EQ,RFEND) 
          ANDIF  ((RFLCPTYP,T1),EQ,SCON)
            SUBZ   (RFLCPVAL,T1),1,T2 
            SUBZ  (BYTLENOF,P2),T2,T2 
            GEN    SXBPK,(VREGOF,P4),,T2
          ENDIFZ
          IFTHEN ((RFLENTYP,T1),EQ,RFEND) 
            ANDIF  ((RFLCPTYP,T1),EQ,SCALCR)
            ADDZ   (BYTLENOF,P2),1,T2 
            GEN    SXBPK,(VREGOF,P4),,T2
            GEN    ISUB,(VREGOF,P4),P4,(RFLCPVAL,T1)
          ENDIFZ
          RETURN
* 
*         SCLOAD - GENERATE IN-LINE LOAD OF SUBSCRIPTED ITEM
*         INPUT 
*                P1 - REGTABLE POINTER TO SUBSCRIPTED ITEM
*                P2 - 0 LEFT JUSTIFY LOADED ITEM
*                     1 RIGHT JUSTIFY LOADED ITEM 
*                P3 - 0 DON"T FILL LOADED ITEM
*                   - 1 BINARY ZERO FILL LOADED ITEM
*         OUTPUT
*                P4 - NUMBER OF VIRTUAL REGISTER CONTAINING LOADED ITEM 
* 
 SCLOAD   EGO    1
          GOTOCASE (SUBSCOF,P1) 
            CASE   0,SCLOAD0
            CASE   1,SCLOAD1
            CASE   2,SCLOAD2
            CASE 3,SCLOAD3
            CASE   4,SCLOAD4
            CASE   5,SCLOAD5
          ENDCASE 
          ERROR 
          SPACE  4
*      NOT SPECIAL CASE 
 SCLOAD0  LABEL 
          RETURN
          SPACE  4
*      SIZE = 10, OCCL1 MOD 10 = 0, OCCL2 MOD OCCL1 = 0,
*                 0CCL3 MOD 0CCL2 = 0 
 SCLOAD1  LABEL 
          NOTE   SCLOAD1
          FETCHSB            SUBSCRIPT TO VREGA 
          EQZ    (SBDPTHOF,P1),1,T1 
          PUSH   P1 
          MOVEZ  1,P2 
          EXECUTE  OCCLEN 
          EQZ    P1,10,T2 
          POP    P1 
          ANDZ   T1,T2,T3 
          IFTHEN (T3,EQ,0)
            GEN    SHR,VREGA,30 
            GENM   LDSUB
              SYMP   ((FWA$OF,P1))
              REGP   VREGA,(VREGOF,VREGB) 
            ENDG
          ELSEZ 
            GEN  SXXPK,(VREGOF,VREGA),VREGA,-1
            GEN    SLRXPK,(VREGOF,VREGB),VREGA,((FWA$OF,P1))
          ENDIFZ
          IFTHEN ((BCPOF,P1),EQ,0)
            MOVEZ  VREGB,P4 
          ELSEZ 
*                                      ARITH2 - 6*BCP 
            GEN    MASK,(VREGOF,VREGC),(ARITH2,P1)
            GEN    LIMP,(VREGOF,VREGD),VREGB,VREGC
            GEN    SLRAPB,(VREGOF,VREGE),VREGB,R1 
            GEN    LAND,(VREGOF,VREGF),VREGC,VREGE
            GEN    SHL,VREGD,(ARITH2,P1)
            GEN    SHL,VREGF,(ARITH2,P1)
            GEN    LOR,(VREGOF,VREGG),VREGD,VREGF 
            MOVEZ  VREGG,P4 
          ENDIFZ
          RETURN
          SPACE  4
*      CONSTANT BCP, SIZE + BCP LE 10, SIZE NE 10 
 SCLOAD2  LABEL 
          NOTE   SCLOAD2
          FETCHSB            SUBSCRIPT TO VREGA 
          EQZ    (SBDPTHOF,P1),1,T1 
          PUSH   P1,P2
          MOVEZ  1,P2 
          EXECUTE OCCLEN
          EQZ    P1,10,T2 
          POP    P1,P2
          ANDZ   T1,T2,T3 
          IFTHEN (T3,EQ,0)
            GEN    SHR,VREGA,30 
            GENM   LDSUB
              SYMP   ((FWA$OF,P1))
              REGP   VREGA,(VREGOF,VREGB) 
            ENDG
          ELSEZ 
            GEN    SXXPK,(VREGOF,VREGA),VREGA,-1
            GEN    SLRXPK,(VREGOF,VREGB),VREGA,((FWA$OF,P1))
          ENDIFZ
          IFZ    (P2,EQ,0),SCLOAD2A    LEFT JUSTIFY 
*      RIGHT JUSTIFY
*                                      ARITH7 -  60 - 6*FIXED 
*                                      ARITH10 - 6*SIZE + 6*BCP 
          IFTHEN ((ARITH10,P1),NE,60) 
            GEN    SHL,VREGB,(ARITH10,P1) 
          ENDIFZ
          IFTHEN (P3,EQ,1)   ZERO FILL
            MOVEZ  (BYTLENOF,P1),T1 
            GEN    MASK,(VREGOF,VREGC),(ARITH7,T1)
            GEN    LIMP,(VREGOF,VREGD),VREGB,VREGC
            MOVEZ  VREGD,P4 
          ELSEZ              NO FILL
            MOVEZ  VREGB,P4 
          ENDIFZ
          RETURN
          SPACE  4
*      LEFT JUSTIFY 
 SCLOAD2A LABEL 
*                                      ARITH2 - 6*BCP 
*                                      ARITH3 - 6*SIZE
          NOTE   SCLOAD2A 
          IFTHEN ((BCPOF,P1),NE,0)
            GEN    SHL,VREGB,(ARITH2,P1)
          ENDIFZ
          IFTHEN (P3,EQ,1)   ZERO FILL
            GEN    MASK,(VREGOF,VREGC),(ARITH3,P1)
            GEN    LAND,(VREGOF,VREGD),VREGB,VREGC
            MOVEZ  VREGD,P4 
          ELSEZ 
            MOVEZ  VREGB,P4 
          ENDIFZ
          RETURN
          SPACE  4
*    SINGLE SUBSCRIPT, SIZE = 2  = OCCLEN1, BCP =0
 SCLOAD3  LABEL 
          FETCHSB            SUBSCRIPT TO VREGA 
          GEN    SHR,VREGA,30 
          GENM   LDSUBWO
            SYMP   TENTH,((FWA$OF,P1))
            REGP   VREGA,(VREGOF,VREGB),(VREGOF,VREGC)
          ENDG
          IFZ    (P2,EQ,0),SCLOAD3A    LEFT JUSTIFY 
*      RIGHT JUSTIFY
          GEN    SBXPK,(VREGOF,VREGE),VREGB,12
          GEN    SHLB,(VREGOF,VREGF),VREGE,VREGC
          IFTHEN (P3,EQ,0)             NO FILL
            MOVEZ  VREGF,P4 
          ELSEZ                        ZERO FILL
            GEN    MASK,(VREGOF,VREGD),48 
            GEN    LIMP,(VREGOF,VREGG),VREGF,VREGD
            MOVEZ  VREGG,P4 
          ENDIFZ
          RETURN
          SPACE  4
*      LEFT JUSTIFY 
 SCLOAD3A LABEL 
          GEN    SBXPB,(VREGOF,VREGE),VREGB 
          GEN    SHLB,(VREGOF,VREGF),VREGE,VREGC
          IFTHEN (P3,EQ,0)             NO FILL
            MOVEZ  VREGF,P4 
          ELSEZ                        ZERO FILL
            GEN    MASK,(VREGOF,VREGD),12 
            GEN    LAND,(VREGOF,VREGG),VREGF,VREGD
            MOVEZ  VREGG,P4 
          ENDIFZ
          RETURN
          SPACE  4
*      SINGLE SUBSCRIPT, SIZE = 5, OCCLEN MOD 5 = 0, BCP = 0 OR 5 
 SCLOAD4  LABEL 
          NOTE   SCLOAD4
          FETCHSB            SUBSCRIPT TO VREGA 
          GEN    SHR,VREGA,30 
          IFTHEN ((BCPOF,P1),EQ,5)
            GEN    SXXPK,(VREGOF,VREGA),VREGA,5 
          ENDIFZ
          GENM   LDSUB
            SYMP   ((FWA$OF,P1))
            REGP   VREGA,(VREGOF,VREGB) 
          ENDG
          EQZ    P2,0,JUSTL 
          GEN    SHL,VREGA,59 
          MOVEZ  (LOCLAB,SLABL),SLABL 
          IFTHEN (JUSTL,NE,0) 
            GEN    PL$,VREGA,,((LOCAL$OF,SLABL))
          ELSEZ 
            GEN    NG$,VREGA,,((LOCAL$OF,SLABL))
          ENDIFZ
          GEN    SHL,VREGB,30 
          GEN    LABEL$,((LOCAL$OF,SLABL))
          ANDZ   P3,P2,RFILL
          ANDZ   P3,JUSTL,LFILL 
          GEN    MASK,(VREGOF,VREGC),30 
          IFTHEN (RFILL)
            GEN    LIMP,(VREGOF,VREGD),VREGB,VREGC
            MOVEZ  VREGD,P4 
          ENDIFZ
          IFTHEN (LFILL)
            GEN    LAND,(VREGOF,VREGD),VREGB,VREGC
            MOVEZ  VREGD,P4 
          ENDIFZ
          IFTHEN (P3,EQ,0)   NO FILL
            MOVEZ  VREGB,P4 
          ENDIFZ
          RETURN
          SPACE  4
*      SINGLE SUBSCRIPT, SIZE = OCCL = 1, BCP = 0 
 SCLOAD5  LABEL 
          NOTE   SCLOAD5
          FETCHSB            SUBSCRIPT TO VREGA 
          GEN    SHR,VREGA,30 
          GENM   LDSUBWO
            SYMP   TENTH,((FWA$OF,P1))
            REGP   VREGA,(VREGOF,VREGB),(VREGOF,VREGC)
          ENDG
          IFZ    (P2,EQ,0),SCLOAD5A    LEFT JUSTIFY 
*      RIGHT JUSTIFY
          GEN    SBXPK,(VREGOF,VREGE),VREGB,6 
          GEN    SHLB,(VREGOF,VREGF),VREGE,VREGC
          IFTHEN (P3,EQ,0)             NO FILL
            MOVEZ  VREGF,P4 
          ELSEZ 
            GEN    MASK,(VREGOF,VREGD),54 
            GEN    LIMP,(VREGOF,VREGG),VREGF,VREGD
            MOVEZ  VREGG,P4 
          ENDIFZ
          RETURN
          SPACE   4 
 SCLOAD5A LABEL 
*      LEFT JUSTIFY 
          NOTE   SCLOAD5A 
          GEN    SBXPB,(VREGOF,VREGE),VREGB,R0
          GEN    SHLB,(VREGOF,VREGF),VREGE,VREGC
          IFTHEN (P3,EQ,0)   NO FILL
            MOVEZ  VREGF,P4 
          ELSEZ 
            GEN    MASK,(VREGOF,VREGD),6
            GEN    LAND,(VREGOF,VREGG),VREGF,VREGD
            MOVEZ  VREGG,P4 
          ENDIFZ
          RETURN
          SPACE   4 
          TITLE  SCSTORE - GENERATE IN-LINE STORE OF SUBSCRIPTED ITEM 
* 
*         SCSTORE - GENERATE IN-LINE STORE OF SUBSCRIPTED ITEM
*         INPUT 
*                P1 - REGTABLE POINTER TO SUBSCRIPTED DNAT ITEM 
*                P2 - 0 ITEM IS LEFT JUSTIFIED
*                     1 ITEM IS RIGHT JUSTIFIED 
*                P3 - 0 ITEM IS NOT ZERO FILLED 
*                     1 ITEM IS ZERO FILLED 
*                P4 - VIRTUAL REGISTER NUMBER CONTAINING ITEM 
* 
 SCSTORE  EGO    1
          GOTOCASE (SUBSCOF,P1) 
            CASE   0,SCSTORE0 
            CASE   1,SCSTORE1 
            CASE   2,SCSTORE2 
            CASE   3,SCSTORE3 
            CASE   4,SCSTORE4 
            CASE   5,SCSTORE5 
          ENDCASE 
          ERROR 
          SPACE  4
*      NOT SPECIAL CASE 
 SCSTORE0 LABEL 
          RETURN
          SPACE  4
*      SIZE = 10, OCCL1 MOD 10 = 0, OCCL2 MOD OCCL1 = 0,
*                 OCCL3 MOD OCCL2 = 0 
 SCSTORE1 LABEL 
          NOTE   SCSTORE1 
          FETCHSB            SUBSCRIPT TO VREGA 
          IFZ    ((BCPOF,P1),NE,0),SCSTOR1A 
          EQZ    (SBDPTHOF,P1),1,T1 
          PUSH   P1,P2
          MOVEZ  1,P2 
          EXECUTE OCCLEN
          EQZ    P1,10,T2 
          POP    P1,P2
          ANDZ   T1,T2,T3 
          IFTHEN (T3) 
            GEN    XMIT,(VREGOF,VREGB),P4 
          GEN    SXXPK,(VREGOF,VREGA),VREGA,-1
            GEN    SSRXPK,VREGB,VREGA,((FWA$OF,P1)) 
          ELSEZ 
            GEN    SHR,VREGA,30 
            GENM   STSUB
              SYMP   ((FWA$OF,P1))
              REGP   VREGA,P4 
            ENDG
          ENDIFZ
          RETURN
          SPACE  4
*      BCP NE 0 
 SCSTOR1A LABEL 
          NOTE   SCSTOR1A 
          GEN    SHR,VREGA,30 
          GENM   LDSUB
            SYMP   ((FWA$OF,P1))
            REGP   VREGA,(VREGOF,VREGB) 
          ENDG
*                                      ARITH2 - 6*BCP 
          GEN    MASK,(VREGOF,VREGC),(ARITH2,P1)
          MOVEZ  (BCPOF,P1),T1
*                                      ARITH7 - 60 - 6*FIXED
          GEN    SBBPK,(VREGOF,VREGD),,(ARITH7,T1)
          GEN    LAND,(VREGOF,VREGE),VREGC,VREGB
          GEN    SHLB,(VREGOF,VREGF),VREGD,P4 
          GEN    LIMP,(VREGOF,VREGG),VREGF,VREGC
          GEN    LOR,(VREGOF,VREGH),VREGG,VREGE 
          GEN    SLRAPB,(VREGOF,VREGI),VREGB,R1 
          GEN    SSRAPB,VREGH,VREGB 
          GEN    LAND,(VREGOF,VREGJ),VREGC,VREGF
          GEN    LIMP,(VREGOF,VREGK),VREGI,VREGC
          GEN    LOR,(VREGOF,VREGJ),VREGK,VREGJ 
          GEN    SSRAPB,VREGJ,VREGI 
          RETURN
          SPACE  4
*      CONSTANT BCP, SIZE + BCP LE 10, SIZE NE 10 
 SCSTORE2 LABEL 
          NOTE   SCSTORE2 
          FETCHSB 
          EQZ    (SBDPTHOF,P1),1,T1 
          PUSH   P1,P2
          MOVEZ  1,P2 
          EXECUTE OCCLEN
          EQZ    P1,10,T2 
          POP    P1,P2
          ANDZ   T1,T2,T3 
          IFTHEN (T3,EQ,0)
            GEN    SHR,VREGA,30 
            GENM     LDSUB
              SYMP   ((FWA$OF,P1))
              REGP   VREGA,(VREGOF,VREGB) 
            ENDG
          ELSEZ 
            GEN    SXXPK,(VREGOF,VREGA),VREGA,-1
            GEN    SLRXPK,(VREGOF,VREGB),VREGA,((FWA$OF,P1))
          ENDIFZ
          IFZ    (P2),SCSTOR2A         RIGHT JUSTIFIED
*      LEFT JUSTIFIED 
*                                      ARITH3 - 6*SIZE
          GEN    MASK,(VREGOF,VREGC),(ARITH3,P1)
          IFTHEN (P3,EQ,0)
            GEN    LAND,(VREGOF,VREGD),VREGC,P4 
          ELSEZ 
            MOVEZ  P4,VREGD 
          ENDIFZ
          MOVEZ  (BCPOF,P1),T1
*                                      ARITH7 - 60 - 6*FIXED
          GEN    SBBPK,(VREGOF,VREGE),,(ARITH7,T1)
          GEN    SHLB,(VREGOF,VREGF),VREGE,VREGD
          GEN    SHLB,(VREGOF,VREGG),VREGE,VREGC
          GEN    LIMP,(VREGOF,VREGH),VREGB,VREGG
          GEN    LOR,(VREGOF,VREGI),VREGH,VREGF 
          GEN    SSRAPB,VREGI,VREGB 
          RETURN
          SPACE  4
*      RIGHT JUSTIFIED
 SCSTOR2A LABEL 
          NOTE   SCSTOR2A 
          MOVEZ  (BYTLENOF,P1),T1 
*                                      ARITH7 - 60 - 6*FIXED
          GEN    MASK,(VREGOF,VREGC),(ARITH7,T1)
          IFTHEN (P3,EQ,0)
            GEN    LIMP,(VREGOF,VREGD),P4,VREGC 
          ELSEZ 
            MOVEZ  P4,VREGD 
          ENDIFZ
          ADDZ   (BYTLENOF,P1),(BCPOF,P1),T1
*                                      ARITH7 - 60 - 6*FIXED
          GEN    SBBPK,(VREGOF,VREGE),,(ARITH7,T1)
          GEN    SHLB,(VREGOF,VREGF),VREGE,VREGD
          GEN    SHLB,(VREGOF,VREGG),VREGE,VREGC
          GEN    LAND,(VREGOF,VREGH),VREGG,VREGB
          GEN    LOR,(VREGOF,VREGI),VREGH,VREGF 
          GEN    SSRAPB,VREGI,VREGB 
          RETURN
          SPACE  4
 SCSTORE3 LABEL 
          NOTE   SCSTORE3 
          FETCHSB 
          GEN    SHR,VREGA,30 
          GENM   LDSUBWO
            SYMP   TENTH,((FWA$OF,P1))
            REGP   VREGA,(VREGOF,VREGC),(VREGOF,VREGB)
          ENDG
          IFZ    (P2,EQ,0),SCSTOR3A    LEFT JUSTIFIED 
*    RIGHT JUSTIFIED
          GEN    MASK,(VREGOF,VREGD),48 
          IFTHEN (P3,EQ,1)
            MOVEZ  P4,VREGE 
          ELSEZ 
            GEN    LIMP,(VREGOF,VREGE),P4,VREGD 
          ENDIFZ
          GEN    SBXPB,(VREGOF,VREGF),VREGC 
          GEN    SBBPK,(VREGOF,VREGG),,48 
          GEN    SBBMB,(VREGOF,VREGH),VREGG,VREGF 
          GEN    SHLB,(VREGOF,VREGI),VREGH,VREGE
          GEN    SHLB,(VREGOF,VREGJ),VREGH,VREGD
          GEN    LAND,(VREGOF,VREGK),VREGB,VREGJ
          GEN    LOR,(VREGOF,VREGF),VREGK,VREGI 
          GEN    SSRAPB,VREGF,VREGB 
          RETURN
          SPACE  4
*    LEFT JUSTIFIED 
 SCSTOR3A LABEL 
          NOTE   SCSTOR3A 
          GEN    MASK,(VREGOF,VREGD),12 
          IFTHEN (P3,EQ,1)
            MOVEZ  P4,VREGE 
          ELSEZ 
            GEN    LAND,(VREGOF,VREGE),P4,VREGD 
          ENDIFZ
          GEN    SBXPB,(VREGOF,VREGF),VREGC 
          GEN    SBBPK,(VREGOF,VREGG),,60 
          GEN    SBBMB,(VREGOF,VREGH),VREGG,VREGF 
          GEN    SHLB,(VREGOF,VREGI),VREGH,VREGE
          GEN    SHLB,(VREGOF,VREGJ),VREGH,VREGD
          GEN    LIMP,(VREGOF,VREGK),VREGB,VREGJ
          GEN           LOR,(VREGOF,VREGF),VREGK,VREGI
          GEN    SSRAPB,VREGF,VREGB 
          RETURN
          SPACE  4
*      SINGLE SUBSCRIPT, SIZE = 5, OCCLEN MOD 5 = 0, BCP = 0 OR 5 
 SCSTORE4 LABEL 
          NOTE   SCSTORE4 
          FETCHSB            SUBSCRIPT TO VREGA 
          GEN    SHR,VREGA,30 
          IFTHEN ((BCPOF,P1),EQ,5)
            GEN    SXXPK,(VREGOF,VREGA),VREGA,5 
          ENDIFZ
          GENM   LDSUB
            SYMP   ((FWA$OF,P1))
            REGP   VREGA,(VREGOF,VREGB) 
          ENDG
          IFZ    (P2),SCSTOR4A         RIGHT JUSTIFIED
*      LEFT JUSTIFIED 
          GEN    MASK,(VREGOF,VREGC),30 
          IFTHEN (P3) 
            MOVEZ  P4,VREGD 
          ELSEZ 
            GEN    LAND,(VREGOF,VREGD),VREGC,P4 
          ENDIFZ
          GEN    SHL,VREGA,59 
          MOVEZ  (LOCLAB,T1),SLABL
          GEN    PL$,VREGA,,((LOCAL$OF,SLABL))
          GEN    SHL,VREGD,30 
          GEN    SHL,VREGC,30 
          GEN    LABEL$,((LOCAL$OF,SLABL))
          GEN    LIMP,(VREGOF,VREGE),VREGB,VREGC
          GEN    LOR,(VREGOF,VREGF),VREGE,VREGD 
          GEN    SSRAPB,VREGF,VREGB 
          RETURN
          SPACE  4
*      RIGHT JUSTIFIED
 SCSTOR4A LABEL 
          NOTE   SCSTOR4A 
          GEN    MASK,(VREGOF,VREGC),30 
          IFTHEN (P3) 
            MOVEZ  P4,VREGD 
          ELSEZ 
            GEN    LIMP,(VREGOF,VREGD),P4,VREGC 
          ENDIFZ
          GEN    SHL,VREGA,59 
          MOVEZ  (LOCLAB,T1),SLABL
          GEN    NG$,VREGA,,((LOCAL$OF,SLABL))
          GEN    SHL,VREGD,30 
          GEN    SHL,VREGC,30 
          GEN    LABEL$,((LOCAL$OF,SLABL))
          GEN    LAND,(VREGOF,VREGE),VREGB,VREGC
          GEN    LOR,(VREGOF,VREGF),VREGE,VREGD 
          GEN    SSRAPB,VREGF,VREGB 
          RETURN
          SPACE  4
*      SINGLE SUBSCRIPT, SIZE = OCCL = 1, BCP = 0 
 SCSTORE5 LABEL 
          NOTE   SCSTORE5 
          FETCHSB            SUBSCRIPT TO VREGA 
          GEN    SHR,VREGA,30 
          GENM   LDSUBWO
            SYMP   TENTH,((FWA$OF,P1))
            REGP   VREGA,(VREGOF,VREGC),(VREGOF,VREGB)
          ENDG
          IFZ    (P2),SCSTOR5A         RIGHT JUSTIFIED
*      LEFT JUSTIFIED 
          GEN    MASK,(VREGOF,VREGD),6
          IFTHEN (P3) 
            MOVEZ  P4,VREGE 
          ELSEZ 
            GEN    LAND,(VREGOF,VREGE),P4,VREGD 
          ENDIFZ
          GEN    SBXPB,(VREGOF,VREGF),VREGC 
          GEN    SBBPK,(VREGOF,VREGG),,60 
          GEN    SBBMB,(VREGOF,VREGH),VREGG,VREGF 
          GEN    SHLB,(VREGOF,VREGI),VREGH,VREGE
          GEN    SHLB,(VREGOF,VREGJ),VREGH,VREGD
          GEN    LIMP,(VREGOF,VREGK),VREGB,VREGJ
          GEN    LOR,(VREGOF,VREGF),VREGK,VREGI 
          GEN    SSRAPB,VREGF,VREGB 
          RETURN
          SPACE  4
*      RIGHT JUSTIFIED
 SCSTOR5A LABEL 
          NOTE   SCSTOR5A 
          GEN    MASK,(VREGOF,VREGD),54 
          IFTHEN (P3) 
            MOVEZ  P4,VREGE 
          ELSEZ 
            GEN    LIMP,(VREGOF,VREGE),P4,VREGD 
          ENDIFZ
          GEN    SBXPB,(VREGOF,VREGF),VREGC 
          GEN    SBBPK,(VREGOF,VREGG),,54 
          GEN    SBBMB,(VREGOF,VREGH),VREGG,VREGF 
          GEN    SHLB,(VREGOF,VREGI),VREGH,VREGE
          GEN    SHLB,(VREGOF,VREGJ),VREGH,VREGD
          GEN    LAND,(VREGOF,VREGK),VREGB,VREGJ
          GEN    LOR,(VREGOF,VREGF),VREGK,VREGI 
          GEN    SSRAPB,VREGF,VREGB 
          RETURN
          TITLE  CGRANGE - SUBSCRIPT RANGE CHECKING 
* 
*         CGRANGE - SUBSCRIPT RANGE CHECKING
* 
 CGRANGE  EGO    1
          MOVEZ  (GSCODEOF,REGB),P1    SUBSCRIPT NUMBER 
      CALLZ   SUBLOAD1
          GEN    SXXPB,(VREGOF,VREGA),P1
          MOVEZ  (GPTROF,REGB),T1 
          GEN    SXBPK,(VREGOF,VREGB),,(AUXMAXOC,T1)
          GEN    ISUB,(VREGOF,VREGC),VREGB,VREGA
          MOVEZ  (LOCLAB,T1),T1 
          MOVEZ  (LOCLAB,T2),T2 
          GEN    LOR,(VREGOF,VREGC),VREGC,VREGA 
          GEN    ZR$,VREGA,,((LOCAL$OF,T1)) 
          GEN    PL$,VREGC,,((LOCAL$OF,T2)) 
          GEN    LABEL$,((LOCAL$OF,T1)) 
          GEN    PLUS 
          GEN    RJ$,((EXT$OF,C.SBOVF)) 
          GEN    MINUS
          GEN    PS$,,CURRLINE
          GEN    LABEL$,((LOCAL$OF,T2)) 
          RETURN
          TITLE  SUBLOAD - LOAD A SUBSCRIPT 
* 
*         SUBLOAD - LOAD A SUBSCRIPT
*         INPUT 
*                P1 - SUBSCRIPT TABLE INDEX 
*         OUTPUT
*                P1 - VIRTUAL REGISTER CONTAINING SUBSCRIPT 
* 
 SUBLOAD  EGO    1
          NOTE   SUBLOAD
          MOVEZ  (SUBNUMOF,P1),P1 
 SUBLOAD1 EGO    1
          IFTHEN ((SUBTYPOF,P1),EQ,SCALCR)
            GEN    XMIT,(VREGOF,VREGZ),(SUBLOCOF,P1)
            MOVEZ  VREGZ,P1 
            RETURN
          ENDIFZ
          IFTHEN ((SUBTYPOF,P1),EQ,SCALC) 
            GEN    SLRBPK,(VREGOF,VREGZ),,((SUBTMPOF,P1)) 
            MOVEZ  VREGZ,P1 
            RETURN
          ENDIFZ
          IFTHEN ((SUBTYPOF,P1),EQ,SINDX) 
            MOVEZ  (EQUALS,REGT6),REGT
            MOVEZ  P1,SAVSUB
            MOVEZ  0,P1 
            PUSH   P2 
            MOVEZ  REGT,P2
            CALLZ  REGMOVE
            POP    P2 
            MOVEZ  GDATAREF,(GCODEOF,REGT)
            MOVEZ  (SUBLOCOF,SAVSUB),(GPTROF,REGT)
            GEN    SLRBPK,(VREGOF,VREGZ),,((FWA$OF,REGT)) 
            MOVEZ  VREGZ,P1 
            RETURN
          ENDIFZ
          IFTHEN ((SUBTYPOF,P1),EQ,SCON)
            PUSH   P2 
            MOVEZ  REGT6,REGT 
            CALLZ  ADPDNAT
            MOVEZ  0,(BCPOF,REGT) 
            MOVEZ  10,(BYTLENOF,REGT) 
            MOVEZ  (SUBOFFOF,P1),P2 
            ADDZ   (SHL30OF,P2),(SUBLOCOF,P1),P2
            MOVEZ  0,P1 
            EXECUTE LITPOOL 
            GEN    SLRBPK,(VREGOF,VREGZ),,((FWA$OF,REGT)) 
            MOVEZ  VREGZ,P1 
            POP    P2 
            RETURN
          ENDIFZ
          END 
