*DECK GBRANCH                                                           002000
          IDENT  GBRANCH                                                003000
 GBRANCH  TITLE  GBRANCH - CODE GENERATOR FOR BRANCH-TYPE STATEMENTS    005000
  
          MACHINE  ANY,I
          SST 
          COMMENT  BRANCH-TYPE STATEMENT PROCESSOR
          SPACE  4
**        GBRANCH - GENERATES CODE FOR THE FOLLOWING COBOL VERBS: 
* 
*                ALTER
*                CALL 
*                CANCEL 
*                ENTER
*                EXIT 
*                EXIT PROGRAM 
*                GO TO
*                GO TO DEPENDING
*                NOOVERFLOW 
*                OVERFLOW    (CALL ONLY)
*                PERFORM
*                PERFORM TIMES
*                PERFORM UNTIL
*                PERFORM VARYING
*                STOP 
* 
*         GTEXT VERB PROCESSORS:  
* 
*                ALTGEN    - ALTER
*                CALLGEN   - CALL 
*                CNCLGEN   - CANCEL 
*                ENDGEN    - END
*                ENTERGEN  - ENTER
*                ENTRYGEN  - ENTRY
*                EXITGEN   - EXIT 
*                EXITPGEN  - EXIT-PROGRAM 
*                FORMPGEN  - FORMAL-PARAMETER 
*                GOTOGEN   - GO TO
*                            GO TO DEPENDING
*                LABLGEN   - LABEL DEFINITION 
*                NOVFGEN   - NO ON OVERFLOW  (CALL) 
*                OVFLGEN   - ON OVERFLOW (CALL) 
*                PARAMGEN  - PARAMETER
*                PERFGEN   - PERFORM
*                            PERFORM ACTIVATE 
*                            PERFORM COMPLEX
*                            PERFORM END
*                            PERFORM TIMES
*                PROCGEN   - PROCEDURE DEFINITION 
*                STOPGEN   - STOP 
  
  
*         CALLS TO COMDECKS.
  
  
  
  
 CONTROL  OPSYN  NIL
  
  
  
  
*CALL CCT 
*CALL CCPARCM 
  
          TITLE  DEFINITIONS AND LINKAGES                               015000
 GBRANCH  MODULE                                                        016000
                                                                        017000
                                                                        019000
*         REGTABLE EQUATES. 
                                                                        021000
 BRREGA   EQU    REGA        VERB ATOM                                  022000
 BRREGB   EQU    REGB        1ST REFERENCE ATOM                         023000
 BRREGC   EQU    REGC        2ND REFERENCE ATOM                         024000
 BRREGD   EQU    REGD        3RD REFERENCE ATOM                         025000
 BRREGE   EQU    REGE        4TH REFERENCE ATOM                         026000
 BRREGF   EQU    REGF        5TH REFERENCE ATOM 
 BRREGG   EQU    REGG        NEXT VERB ATOM 
  
 FAKER    EQU    REGT5
                                                                        028000
*         VIRTUAL REGISTER EQUATES. 
                                                                        030000
 VREGA    EQU    VREG1                                                  031000
 VREGB    EQU    VREG2                                                  032000
 VREGC    EQU    VREG3                                                  033000
 VREGD    EQU    VREG4                                                  034000
 VREGE    EQU    VREG5                                                  035000
 VREGF    EQU    VREG6                                                  036000
 VREGG    EQU    VREG7
                                                                        037000
*         FIXED TABLE EQUATES.
                                                                        039000
 EPJUMP   EQU    T10         END-PERFORM JUMP NEEDED FLAG 
 COUNTD   EQU    GBR1        NO. OF DESTINATIONS FOR GO TO DEPENDING
 PARAMCT  EQU    GBR1        TO HOLD NO. OF FORMAL PARAMETERS 
 PARLEN   EQU    T20         NUMERIC LENGTH OF PARAMETER
 SAVER    EQU    GBR2        TO HOLD LOCAL LABEL ACROSS VARIOUS CALLS 
                                                                        041000
                                                                        043000
*         ERROR EQUATES.
                                                                        045000
 ALTNPER  EQU    0701        PARAGRAPH MAY NOT BE ALTERED 
 PARAMERR EQU    5501        ILLEGAL PARAMETER ON CALL OR ENTER 
                                                                        047000
*         MISCELLANEOUS EQUATES.
                                                                        049000
 VVB0     EQU    R0          B0 HARDWARE REGISTER                       050000
 VVB1     EQU    R1          B1 HARDWARE REGISTER                       051000
*                            BINARY LEVEL FOR OLD BINARY TESTS AT 
*                            EXECUTION - SEE GENERATION OF ENTRY INFO 
*                            FOR USE
*                            ADD A COMMENT CARD FOR EACH NEW LEVEL
* 
*                            VALUE AT LEVEL 466 WAS 1 
*                            VALUE AT LEVEL 466 WAS 1  FEATURE F186581
*                            VALUE AT LEVEL 477 WAS 2  PSR CL5A614
*                            VALUE AT LEVEL 485 WAS 3  PSR CL5A767
*                            VALUE AT COBOL 5.3 WAS 4  PSR CL5A827
*                            VALUE AT R6 (ABOUT L 517) FEATURE F2647CB
  
 BINRYLV  EQU 6 
                                                                        052000
*         ENTRY POINTS. 
                                                                        054000
 ALTGEN   KNIL   CGALTER     ALTER                         (  7)
                                                                        056000
 CALLGEN  KNIL   CGCALL      CALL                          (  9)
 CNCLGEN  KNIL   CGCANCE     CANCEL 
  
 ENDGEN   KNIL   CGEND       END                           ( 24)
  
 ENTERGEN KNIL   CGENTER     ENTER                         ( 25)
 ENTRYGEN KNIL   CGENTRY     ENTRY                         (100)
 EXITGEN  KNIL   CGEXIT      EXIT                          ( 28)
 EXITPGEN KNIL   CGEXITP     EXIT-PROGRAM                  ( 29)
 FORMPGEN KNIL   CGFORMP     FORMAL-PARAMETER              (101)
  
 GOTOGEN  KNIL   CGGOTO      GO TO                         ( 31)        057000
 GTDGEN   KNIL   CGGOTOD     GO TO DEPENDING               ( 32)
  
 LABLGEN  KNIL   CGLABEL     LABEL DEFINITION              ( 40)
 NOVFGEN  KNIL   CGNOOVE
 OVFLGEN  KNIL   OVFLGEN
                                                                        059000
 PARAMGEN KNIL   CGPARAM     PARAMETER                     ( 55)
  
 PERFGEN  KNIL   CGPERFO     PERFORM                       ( 56)
 PACTGEN  KNIL   CGPERFA     PERFORM ACTIVATE              ( 57)
 PCPXGEN  KNIL   CGPERFC     PERFORM COMPLEX               ( 58)
 PENDGEN  KNIL   CGPERFE     PERFORM END                   ( 59)
 PFTMGEN  KNIL   CGPERFT     PERFORM TIMES                 ( 64)
                                                                        065000
 PROCGEN  KNIL   CGPROC      PROCEDURE DEFINITION          ( 65)        066000
  
 STOPGEN  KNIL   CGSTOP      STOP                          ( 85)
                                                                        067000
*         EXTERNAL REFERENCES.
                                                                        069000
 ADNAT    LINK   ADNAT       GET *DNAT* ENTRY 
 ADPDNAT  LINK   ADPDNAT     GET PERMENENT *DNAT* ENTRY 
 CGMOVE   LINK   CGMOVE      GENERATE CODE FOR *MOVE* VERB
 CGREGMV  LINK   CGREGMV     COPY REG TABLE ENTRY 
 CGSETRG  LINK   CGSETRG     GET NEXT 5 REFERENCE ATOMS 
 CLIT2RN  LINK   CLIT2RN     EVALUATE NUMERIC LITERAL 
 CRN2BIN  LINK   CRN2BIN      CONVERT REG NUM TO BIN
 FLUSHOT  LINK   FLUSHOT     FLUSH OTEXT
 FLUSHPL  LINK   FLUSHPL     FLUSH POOLED LITERALS
 LITPOOL  LINK   LITPOOL     POOL LITERAL 
 SUBDNAT  LINK   SUBDNAT     RELEASE *DNAT* ENTRY 
 SUBREF   LINK   SUBREF 
 SETSAVE  LINK   SETSAVE A1  SET SAVEA1 FOR CID TABLES IN ASM2
  
*         SYMBOLIC PARAMETER DEFINITIONS. 
                                                                        073000
 ALTDES   SETSY  (FWA$OF,BRREGC)       NEW DESTINATION ADDRESS IN ALTER 
 ALTPARA  SETSY  (LWA$OF,BRREGB)       PARAGRAPH TO BE ALTERED
 GOTODES  SETSY  (FWA$OF,BRREGB)       PROCEDURE REFERENCED BY GO TO
 PERFFWA  SETSY  (FWA$OF,BRREGB)       FWA OF PERFORM RANGE 
 PERFRET  SETSY  (FWA$OF,BRREGD)       RETURN ADDRESS FOR PERFORMS
 PERFTCT  SETSY  (FWA$OF,BRREGE)       LOCTION OF COUNT IN PERFORM-TIMES
 PROCLOC  SETSY  (FWA$OF,BRREGA)       ADDRESS IN PROCEDURE DEFINITION
 DUMOVL   CONSTANT  77000B             LEVEL NUMBERS FOR DUMMY OVERLAY
 ##CALLOV CONSTANT #CALLOV
 ABTMSG   CONSTANT  #GSTABT 
 ##MSBV   CONSTANT  #MSBV 
 ##LBZV   CONSTANT  #LBZV 
 ##AUDITV CONSTANT  #AUDITV 
 LOCALA   SETSY  (LOCAL$OF,T1)         LOCAL LABEL NO. MUST BE IN *T1*
 LOCALB   SETSY  (LOCAL$OF,T2)         LOCAL LABEL NO. MUST BE IN *T2*
 LOCALC   SETSY  (LOCAL$OF,T3)         LOCAL LABEL NO. MUST BE IN *T3*
 LOCALD   SETSY  (LOCAL$OF,T4)         LOCAL LABEL NO. MUST BE IN *T4*
 LOCALE   SETSY  (LOCAL$OF,T5)         LOCAL LABEL NO. MUST BE IN *T5*
  
*         DECLARATIONS FOR CDCS 
  
 CDCSLO   DATA   0LC.DMOPN   TABLE OF CDCS INTERFACE ENTRIES WHICH MAY
          DATA   0LC.DMCLS    BE OMITTED
          DATA   0LC.DMDEL
          DATA   0LC.DMSTR
 CDCSLO1  EQU    *-CDCSLO 
          DATA   0LC.DMWR1
          DATA   0LC.DMWR2
 CDCSLO2  EQU    *-CDCSLO 
          DATA   0LC.DMRD1
          DATA   0LC.DMRD2
          DATA   0LC.DMREW
 CDCSLO3  EQU    *-CDCSLO 
          DATA   0LC.DMSKP
 CDCSLO4  EQU    *-CDCSLO 
          DATA   0LDM$CKP 
          DATA   0LC.KRORD
          DATA   0LC.RORD 
          DATA   0LC.SVSKP
 CDCSLO5  EQU    *-CDCSLO 
 ALTGEN   TITLE  ALTGEN - ALTER STATEMENT                               094000
**        ALTGEN - PROCESSOR FOR THE ALTER GTEXT. 
* 
* 
*              THIS PROCESSOR FIRST VERIFIES THAT THE PARAGRAPH IS
*         ALLOWED TO BE ALTERED.  THEN CODE IS GENERATED AS FOLLOWS:  
* 
*         IF NO SEGMENTATION: 
* 
*         SXI    04          FORM JUMP INSTRUCTION
*         LXI    54 
*         SXJ    ALTDES      NEW DESTINATION ADDRESS
*         LXJ    30 
*         BXK    XI+XJ
*         SAK    ALTPARA     STORE AT PARAGRAPH TO BE ALTERED 
*         JP     TAG1        CLEAR INSTRUCTION STACK
* TAG1    BSS    0
  
  
 ALTGEN   EGO    1                                                      095000
          NOTE   ALTGEN                                                 096000
          IFZ    (SEGPROG,NE,0),ALT2   COMPILE AS SEGMENTED 
          MOVEZ  (LOCLAB,T1),T1                  GET LOCAL LABEL
  
          GEN    SXBPK,(VREGOF,VREGA),,4
          GEN    SHL,VREGA,54 
          GEN    SXBPK,(VREGOF,VREGB),,ALTDES 
          GEN    SHL,VREGB,30 
          GEN    LOR,(VREGOF,VREGC),VREGA,VREGB 
          GEN    SSRBPK,VREGC,,ALTPARA
          GEN    RJ$,LOCALA        BREAK STACK
          GEN    LABEL$,LOCALA
          GEN    STARTSEQ,,(SEQUENCE,0) 
          GEN    BSS$,,1
  
          RETURN
 ALTGEN   SPACE  4,8
 ALT2     LABEL 
          NOTE   SEGALT 
  
          MOVEZ  (PSGALTOF,BRREGB),T1 
          GEN    SLRBPK,(VREGOF,VREGA),,((USEORG$F,USESGIX),T1) 
          MOVEZ  (PSGENTOF,BRREGC),T2 
          GEN    SXBPK,(VREGOF,VREGB),,((USEORG$F,USESGIX),T2)
          GEN    MASK,(VREGOF,VREGC),42 
          GEN    LAND,(VREGOF,VREGC),VREGA,VREGC
          GEN    LOR,(VREGOF,VREGD),VREGC,VREGB 
          GEN    SSRAPB,VREGD,VREGA,VREGB0
  
          RETURN                                                        098000
 CALLGEN  TITLE  CALLGEN - CALL STATEMENT 
**        CALLGEN - PROCESSOR FOR THE CALL STATEMENT. 
* 
* 
*         CODE GENERATED: 
* 
*         USE    USEPARAM              * IF ANY PARAMS
* TAG1    BSS    0                     * IF ANY PARAMS
*         USE    USECODE               * IF ANY PARAMS
*         SA1    (FWA OF PARAM LIST)   * IF ANY PARAMS
* +       RJ     =XPROGNAME 
* -       VFD    12/(LINE-NO),18/(ENTRY-ADR)
  
  
 CALLGEN  EGO    1
          NOTE   CALLGEN
          IFZ    ((CCTBIT,FDL),EQ,0),CALLG2 
          IFZ    ((GCODEOF,REGB),EQ,GDATAREF),CALLG1
          IFZ    ((STATICOF,REGB),NE,0),CALLG2   LITERAL
 CALLG1   LABEL 
          MOVEZ  0,T1 
          PUSH   T1 
          CALLZ  FDLCALL
          MOVEZ  0,GBR1 
          RETURN
 CALLG2   LABEL 
          IFTHEN  ((CCTBIT,FDL),NE,0) 
            MOVEZ  1,T1      OVERFLOW IMPOSSIBLE
            PUSH   T1 
          ENDIFZ
          CALLZ  CALLCOM     COMMON CODE FOR CALL AND ENTER 
          MOVEZ  0,GBR1      FLAG FOR PARAMETER GENERATOR 
          RETURN
 CALLCOM  SPACE  4,10 
*         COMMON PROCESSING FOR CALL AND ENTER VERBS. 
  
 CALLCOM  EGO    2
            MOVEZ  (LOCLAB,T1),T1      GET LOCAL LABEL FOR USE BLOCK
  
            NOTE  CLLPARAM
            GEN  USE$,((USETB$OF,USEPARAM))      SET TO USE BLOCK 
            GEN  LABEL$,LOCALA         DEFINE LOCAL LABEL IN USE BLOCK
            GEN  PLIST                 SPECIFY START OF POOLED SEQUENCE 
            IFTHEN  ((GPTROF,BRREGD),EQ,0)       NO PARAMETERS
              GENVFD  (60,0)
              GEN     ENDPL 
            ENDIFZ
  
            NOTE  CLLCODE 
            GEN  USE$,((USETB$OF,USECODE))       RESET TO CODE BLOCK
          GEN    RSTOR,(VREGOF,VREGA),A1
          GEN    SLRBPK,VREGA,,LOCALA 
  
  
          GEN    PLUS 
          IFTHEN ((CCTBIT,FDL),NE,0)
          ANDIF  ((STATICOF,REGB),GT,0) 
            MOVEZ  (STATICOF,REGB),T2 
            GEN    RJ$,((FDLT$OF,T2)) 
          ELSEZ 
            GEN    RJ$,((UEXT$OF,REGB)) 
          ENDIFZ
          GEN    MINUS
          GEN    STARTSEQ,,(SEQUENCE,0) 
          GENVFD (30,CURRLINE)
  
          RETURN
          SPACE  3
 FDLCALL  EGO    2
          GEN    SBBPK,(VREGOF,VREGB),,((FWA$OF,REGB))
          IFTHEN ((GPTROF,REGD),EQ,0)  PARAMETER COUNT
            GEN    SBBPB,(VREGOF,VREGD),R0,R0 
          ELSEZ 
            MOVEZ  (LOCLAB,T1),T1 
            GEN    USE$,((USETB$OF,USEPARAM)) 
            GEN    LABEL$,LOCALA
            GEN    PLIST
            GEN    USE$,((USETB$OF,USECODE))
            GEN    SBBPK,(VREGOF,VREGD),,LOCALA 
          ENDIFZ
          IFTHEN ((GSCODEOF,REGB),EQ,0) 
            GEN    SBBPK,(VREGOF,VREGC),,(BCPOF,REGB) 
            GEN    SBBPK,(VREGOF,VREGE),,(BYTLENOF,REGB)
          ELSEZ 
            MOVEZ  REGB,P2
            CALLZ  SUBREF 
            GEN    SBXPB,(VREGOF,VREGC),P3
            GEN    SBXPB,(VREGOF,VREGE),P4
          ENDIFZ
          GENOBJ N=C.CALL,I=(VREGB,VREGC,VREGD,VREGE),O=((VREGOF,VREGA))
          RETURN
          TITLE  CNCLGEN - CANCEL STATEMENT 
* 
**        CNCLGEN - CANCEL
* 
 CNCLGEN  EGO    1
          IFZ    ((CCTBIT,FDL),EQ,0),RETURN 
          NOTE   CNCLGEN
          GEN    SBBPK,(VREGOF,VREGA),,((FWA$OF,REGB))
          IFTHEN ((GSCODEOF,REGB),EQ,0) 
          GEN    SBBPK,(VREGOF,VREGB),,(BCPOF,REGB) 
          GEN    SBBPK,(VREGOF,VREGC),,(BYTLENOF,REGB)
          ELSEZ 
            MOVEZ  REGB,P2
            CALLZ  SUBREF 
            GEN    SBXPB,(VREGOF,VREGB),P3
            GEN    SBXPB,(VREGOF,VREGC),P4
          ENDIFZ
          GENOBJ N=C.CNCL,I=(VREGA,VREGB,VREGC) 
          RETURN
 ENTERGEN TITLE  ENTERGEN - ENTER STATEMENT 
**        ENTERGEN - PROCESSOR FOR THE ENTER GTEXT. 
* 
* 
*         CODE GENERATED: 
* 
*         (SAME AS FOR THE CALL STATEMENT). 
  
  
 ENTERGEN EGO    1
          NOTE   ENTERGEN 
          CALLZ  CALLCOM               COMMON CODE FOR CALL AND ENTER 
          GEN    SBBPK,R1,,1                     SB1 1
          MOVEZ  (GSCODEOF,REGC),T1 
          MOVEZ  0,GBR1            ASSUME NOT FTN5 OR FORTRAN-X 
          IFZ    (T1,NE,GFORTRNX),ENTERG1  JP IF NOT ENTER FORTRAN-X
          MOVEZ  1,GBR1            FLAG AS FORTRAN-X
          RETURN
 ENTERG1  LABEL 
          IFZ    (T1,NE,GFTN5),ENTERG2  JP IF NOT ENTER FTN5
          MOVEZ  2,GBR1            FLAG AS FTN5 
 ENTERG2  LABEL 
          RETURN
 ENTRYGEN TITLE  ENTRYGEN - VERY FIRST GENERATOR
**        ENTRYGEN - VERY FIRST GENERATOR.
* 
* 
*              AS THE FIRST GENERATOR CALLED FOR EVERY COMPILATION, THIS
*         ONE DOES THE FOLLOWING: 
* 
*              1) INITIALIZES VARIOUS FIXED CELLS WHICH ARE CARRIED 
*                 THROUGHOUT THE COMPILATION. 
*              2) IF SUBCOMPILE - 
*                 A) GENERATES ENTRY/EXIT WORD. 
*                 B) IF ANY PARAMS PRESENT, GENERATES CALL TO C.ADSUB 
*                    TO INSERT ADDRESSES TO PARAMETER REFERENCES. 
*              3) IF SEGMENTATION, GENERATES CODE TO SET C.SEGFG
*                 NON-ZERO.  C.SEGFG IS LOCATED IN CBINIT.
*              4) IF MAIN PROGRAM, GENERATES CALL TO C.INIT FOR MAIN
*                 OBJECT TIME INITIALIZATION PROCEDURES.
*              4) IF DECLARATIVES PRESENT, GENERATES PERFORMS OF
*                 THEM AND TABLE OF POINTERS TO PERFORMS
 CDCS     IFNE   OP.DCS,OP.NO 
*              6) IF THE PROGRAM INTERFACES WITH CDCS, GENERATES CALL 
*                 TO -C.DMINV- (MAIN PROGRAM/SUBROUTINE) OR TO C.DMSUB- 
*                 (SUBCOMPILATION) FOR CDCS INITIALIZATION (-INVOKE-) 
 CDCS     ENDIF 
* 
*         CODE GENERATED: 
* 
*         FOR A SUBCOMPILE: 
* 
* TAG1    VFD    60/0        ENTRY/EXIT 
*         EQ     TAG1+3 
* +       VFD    60/0        COL. SEQ. POINTER OF CALLER
*         SA1    C.PRGCS
*         BX6    X1 
*         SA6    TAG1+2 
* 
*         IF ANY PARAMETERS PRESENT:  
* 
*         USE    PILST
* TAG2    BSS    0           DEFINE LABEL FOR INSERTION LIST
*         USE    CODE 
*         SB3    TAG3        FWA OF PARAMETER ASSOCIATION LIST
*         SB4    TAG2        FWA OF PARAM INSERTION LIST
*         RJ     =XC.ADSUB   GO PLANT PARAMETER ADDRESSES 
* 
*         IF SEGMENTATION:  
* 
*         SXI    B1          SET FLAG TO INDICATE SEGMENTATION
*         SAI    =XC.SEGFG
* 
*         FOR A MAIN PROGRAM OR A MAIN SUBCOMPILE:  
* 
*         RJ     =XC.INIT    INITIALIZE FOR EXECUTION 
* 
 CDCS     IFNE   OP.DCS,OP.NO 
*         FOR A PROGRAM WHICH INTERFACES WITH CDCS -
*         USE    CDCS 
*TAGDM    BSS    3           CONTAINS SUB-SCHEMA (SS) NAME
 CDCS2    IFEQ   OP.DCS,OP.DCS1 
*         BSS    1           CONTAINS NAME OF FILE WITH SS
 CDCS2    ELSE
*         BSS    3           CONTAINS SCHEMA NAME 
 CDCS2    ENDIF 
*         BSS    1           CONTAINS PROGRAM ID
*         BSS    1           CONTAINS TIME AND DATE OF SS COMPILATION 
*         BSS    N           CDCS -FILE USAGE- TABLE (ENDS WITH 0 WORD) 
*TAGRQ    BSS    N           CDCS RELATIONS/QUALIFIERS TABLE
*TAGRA    BSS    N           CDCS RELATIONS/AREAS TABLE 
*         USE    CODE 
*         SB4    TAGRQ
*         SB5    TAGRA
*         SB6    TAGDM
*         SX6    =XDM$OP2    IF PROGRAM CONTAINS AN -OPEN OUTPUT- ON A
*                             SS-DESCRIBED MIP FILE 
*                B0          IF NOT 
*         RJ     =XC.DMINV   IF MAIN COBOL PROGRAM
*                =XC.DMSUB   IF (NON-MAIN PROGRAM) SUBCOMPILATION 
 CDCS     ENDIF 
* 
*         FOR DECLARATIVES
* 
*         EQ     TAGA2       JUMP AROUND DECL STUFF 
* TAGA    DATA   0
*         PERFORM CODE TO PERFORM FIRST I-O DECLARATIVE 
*         EQ     TAGA 
* TAGB    DATA   0
*           ETC 
* 
*         EQ     LASTTAG
* TAGA1   BSS    0
*         RJ     TAGA 
*         RJ     TAGB 
*           ETC 
*         RJ     LASTTAG
* TAGA2   BSS    0
*         SX2    TAGA1
*         RJ     =XC.SETDC   SET DECLARATIVE POINTER VECTOR ADDRESS 
* 
*         IF ANY PARAMETERS PRESENT:  
* 
*         EQ     TAG4        JUMP OVER PARAMETER ASSOCIATION LIST 
*                            NOTE -TAG4- WITH -FORMPGEN-
* TAG3    BSS    0           DEFINE START OF PARAM ASSOC LIST 
  
  
 ENTRYGEN EGO    1
          NOTE   ENTRYGEN 
          MOVEZ  0,PARAMCT             NO. OF PARAMS IF SUBCOMPILE
          MOVEZ  0,CUROVL              INIT. CURRENT OVERLAY NUMBER 
          MOVEZ  0,PFTPTR              INIT. PERFORM TIMES ORDINAL
          MOVEZ  (GPTROF,BRREGB),FSTLABEL        SAVE 1ST LABEL PNAT PTR
          IFTHEN  ((CCTBIT,SUBPROGR),NE,0)
*      GENERATE SUBPROGRAM ENTRY AND OTHER OVERHEAD FOR SUBPROGRAMS 
            GEN    STARTSEQ,,(SEQUENCE,0) 
            GENVFD  (60,0)                       ENTRY WORD FOR SUB PROG
*       GENERATE CODE TO SAVE A0 - BAD DESIGN OF FTN REQUIRES IT
          GEN    RDEF,(VREGOF,VREGA),A0 
          GEN    SXAPB,(VREGOF,VREGA),VREGA 
          GEN    SSRBPK,VREGA,((EXT$OF,C.SVA0)) 
          IFZ    ((CCTBIT,MAINSUB),EQ,0),ENTRYS1 JP IF NOT MAIN SUBPROGR
          CALLZ  INITGEN                         GEN CALL TO INITIALIZE 
 ENTRYS1  LABEL 
            MOVEZ  (GPTROF,BRREGD),PARAMCT
            MOVEZ  (LOCLAB,T2),T2 
* PUT THE PARAMETER ASSOCIATION LIST IN THE BEFORE BLOCK. 
* THIS SHOULD NOT CAUSE ANY CONFILCTS.
            GEN    USE$,((USETB$OF,USEBEFOR)) 
            GEN    LABEL$,LOCALB
            GEN    USE$,((USETB$OF,USECODE))
            GEN    RDEF,(VREGOF,VREGA),A1 
            IFZ ((CCTBIT,IDBUG),EQ,0),ENTRYS2 JP IF NO CID
              MOVEZ  (LOCLAB,P1),P1 
              GEN    USE$,((USETB$OF,USEPARAM)) 
              GEN    PLIST
              GEN    LABEL$,((LOCAL$OF,P1)) 
              GENVFD (60,0) 
              GEN    ENDPL
              GEN    USE$,((USETB$OF,USECODE))
              GEN    SXAPB,(VREGOF,VREGB),VREGA 
      GEN    SXBPK,(VREGOF,VREGC),,LOCALB 
      GEN    SHL,VREGC,30 
      GEN    LOR,(VREGOF,VREGB),VREGB,VREGC 
              GEN    SSRBPK,VREGB,,((LOCAL$OF,P1))
              EXECUTE SETSAVE A1
 ENTRYS2    LABEL 
            GEN   SAAPB,(VREGOF,VREGA),VREGA
            GEN    SBBPK,(VREGOF,VREGB),,LOCALB 
            ADDZ   1,PARAMCT,T3 
            GEN    SBBPK,(VREGOF,VREGC),,((USEORG$F,USEPILST))
            GEN    SBBPK,(VREGOF,VREGD),,((FWA$OF,BRREGB))
            MOVEZ  REGU1,REGT 
            CALLZ  ADPDNAT
            MOVEZ  0,(BCPOF,REGT) 
            MOVEZ  30,(BYTLENOF,REGT) 
            MOVEZ  0,P1 
            MOVEZ  (CCTWORD,PROGRI0),P2 
            MOVEZ  (CCTWORD,PROGRI1),P3 
            MOVEZ  (CCTWORD,PROGRI2),P4 
            EXECUTE LITPOOL 
            GEN    SBBPK,(VREGOF,VREGE),,((FWA$OF,REGT))
*      SET BINARY LEVEL TO CURRENT VALUE
            GEN    SXBPK,(VREGOF,VREGF),,BINRYLV    SET TO CURR LEVEL 
            GEN    SXBPK,(VREGOF,VREGG),,PARAMCT
            GENOBJ N=C.ADSUB,I=(VREGA,VREGB,VREGC,VREGD,VREGE,VREGF,VREG
,G) 
*   SET DEFAULT COLLATING SEQUENCE
            GEN    SBBPK,(VREGOF,VREGA),,4   PROGRAM
            GEN    SBBPK,(VREGOF,VREGB),,3   NATIVE 
            GEN    SBBPB,(VREGOF,VREGC),VREGB0,VREGB0 
            GENOBJ N=C.SETCS,I=(VREGA,VREGB,VREGC)
          ENDIFZ
          SPACE   3 
*    DECLARATIVES 
          MOVEZ  (GETDCCT,T1),SAVEDCT            GET COUNT OF I-O DECL
          IFZ    (SAVEDCT,EQ,0),ENTRYND          JUMP IF NO I- DECL 
  
          PUSH   BRREGB 
  
          MOVEZ  (LOCLAB,FLOCLAB),FLOCLAB        GET A LOCAL LABEL
*      GET AS MANY LOCAL LABEL NUMBERS AS THERE ARE DECLARATIVES
*      THIS IN EFFECT RESERVES THESE NUMBERS. 
*      ONE IS NEEDED FOR THE JUMP AROUND AND FOR THE JUMP VECTOR, TOO.
 ENTRYL1  LABEL 
          NOTE   ENTRYL1
          MOVEZ  (LOCLAB,T1),T1                  GET ANOTHER LABEL
          SUBZ   SAVEDCT,1,SAVEDCT
          IFZ    (SAVEDCT,NE,0),ENTRYL1          GET DECL CT MORE LABS
          MOVEZ  (LOCLAB,T1),T1                  GET LABEL FOR JP 
          GEN    EQ$,,,((LOCAL$OF,T1))           EQ AROUND DECL STUFF 
          MOVEZ  (GETDCCT,T1),SAVEDCT            GET COUNT OF I-O DECL
* 
*      GENERATE A PERFORM SUBROUTINE FOR EACH I-O DECLARATIVE 
* 
 ENTRYL2  LABEL 
          GEN    LABEL$,((LOCAL$OF,FLOCLAB))     DEFINE LABEL FOR DECL
          GEN    STARTSEQ,,(SEQUENCE,0) 
          GENVFD (60,0)                          ENTRY FOR PRFRM
          MOVEZ  REGU1,BRREGB 
          MOVEZ  0,P1 
          MOVEZ  BRREGB,P2
          EXECUTE  CGREGMV                       ZERO OUT REG 
          MOVEZ  GPROCREF,(GCODEOF,BRREGB)       MAKE A PROC REF
          MOVEZ  (FINDDP,T1),(GPTROF,BRREGB)     PUT IN PNAT ADDR OF DEC
          MOVEZ  BRREGB,P1
          MOVEZ  BRREGC,P2
          EXECUTE  CGREGMV                       DUPLICATE REG FOR PERF 
          CALLZ  PERFGEN                         GEN PERFORM CODE 
          GEN    EQ$,,,((LOCAL$OF,FLOCLAB))      EQ TO EXIT/ENTRY 
          ADDZ   1,FLOCLAB,FLOCLAB
          SUBZ   SAVEDCT,1,SAVEDCT
          IFZ    (SAVEDCT,NE,0),ENTRYL2          LOOP UNTIL DONE
          GEN    LABEL$,((LOCAL$OF,FLOCLAB))     LABEL FOR JUMP VECTOR
          MOVEZ  (GETDCCT,T1),SAVEDCT            GET COUNT OF I-O DECL
          SUBZ   FLOCLAB,SAVEDCT,FLOCLAB         RESET TO FIRST LABEL 
* 
*      GENERATE A JUMP VECTOR WITH AN RJ TO A DECL IN EACH WORD 
* 
 ENTRYL3  LABEL 
          GEN    RJ$,((LOCAL$OF,FLOCLAB))        GEN RJ TO PERFORM CODE 
          SUBZ   SAVEDCT,1,SAVEDCT
          ADDZ   1,FLOCLAB,FLOCLAB
          IFZ    (SAVEDCT,NE,0),ENTRYL3          LOOP TIL DONE
          ADDZ   1,FLOCLAB,FLOCLAB               GIVES LBL FOR EQ AROUND
          GEN    STARTSEQ,,(SEQUENCE,0) 
          GENVFD (60,0) 
          GEN    LABEL$,((LOCAL$OF,FLOCLAB))     DEFINE LABEL AFTER STUF
          IFTHEN ((CCTBIT,SUBPROGR),EQ,1) 
            GEN    SLRBPK,(VREGOF,VREGA),,((EXT$OF,C.USETB))
            GEN    XMIT,(VREGOF,VREGC),VREGA
            GEN    SSRBPK,VREGC,((LOCAL$OF,FLOCLAB),-1) 
          ENDIFZ
          SUBZ   FLOCLAB,1,FLOCLAB               POINT TO JUMP VECTOR LA
          GEN    SXBPK,(VREGOF,VREGB),,((LOCAL$OF,FLOCLAB))  SX2  VECT
          GEN    SSRBPK,VREGB,,((EXT$OF,C.USETB)) 
          ADDZ    1,FLOCLAB,FLOCLAB 
  
          POP    BRREGB 
          SPACE  3
 ENTRYND  LABEL 
          IFZ    ((CCTBIT,SUBPROGR),EQ,1),ENT2   NO INIT IF SUBPROGRAM
  
          IFTHEN  ((CCTBIT,SEGMENTS),NE,0)
            MOVEZ  (PFSSECOF,T1),NXTSECT
            GEN    SXBPB,(VREGOF,VREGA),,VVB1 
            GEN    SSRBPK,VREGA,,((EXT$OF,C.SEGFN)) 
          ENDIFZ
  
          CALLZ  INITGEN                         GEN INITIALIZATION CALL
  
 ENT2     LABEL 
 CDCS     IFNE   OP.DCS,OP.NO 
          NOTZ   ((CCTWORD,DBFSCTXT),EQ,0),ENT2B  JUMP IF CDCS INTERFACE
          IFZ    ((CCTBIT,SUBPROGR),EQ,0),ENT2A0  JUMP IF NOT SUBCOMPILE
          IFZ    ((CCTBIT,MAINSUB),EQ,0),ENT3  JUMP IF NOT MAIN SUBRTNE 
 ENT2A0   LABEL 
*                GENERATE LOADER OMIT TABLE ENTRIES FOR CERTAIN CDCS
*                INTERFACE ENTRY POINTS 
          MOVEZ  0,P2        INDEX INTO TABLE -CDCSLO-
 ENT2A    LABEL 
          EXECUTE  CDCSSR2   ENTRY POINT TO BE OMITTED TO P3
          MOVEZ  P3,(LDROMIT,P3)  GENERATE LOADER OMIT TABLE ENTRY
          ADDZ   P2,1,P2
          NOTZ   (P2,EQ,CDCSLO5),ENT2A  JUMP IF MORE -OMIT-S
          BRANCH  ENT3
  
 ENT2B    LABEL 
          MOVEZ  (LOCLAB,T5),T5  ALLOCATE LOCAL LABEL (-TAGDM-) 
          GEN    USE$,((USETB$OF,USECDCS))  -CDCS- USE BLOCK
          GEN    LABEL$,LOCALE  DEFINE LOCAL LABEL
          GENVFD  (60,(CCTWORD,SSNAME))  SUB-SCHEMA NAME
 SSNAME1  EQU    SSNAME+1    SS NAME IS A 3-WORD FIELD
 SSNAME2  EQU    SSNAME+2 
          GENVFD  (60,(CCTWORD,SSNAME1))
          GENVFD  (60,(CCTWORD,SSNAME2))
 CDCS2    IFEQ   OP.DCS,OP.DCS1 
          GENVFD  (60,(CCTWORD,SSLIB))  FILE CONTAINING SS
 CDCS2    ELSE
          GENVFD (60,(CCTWORD,SCHNAME))  SCHEMA NAME
 SCHNAME1 EQU    SCHNAME+1   SCHEMA NAME IS A 3-WORD FIELD
 SCHNAME2 EQU    SCHNAME+2
          GENVFD  (60,(CCTWORD,SCHNAME1)) 
          GENVFD  (60,(CCTWORD,SCHNAME2)) 
 CDCS2    ENDIF 
          MOVEZ  (DMPRGID,T6),T6  PROGRAM-ID (ZERO-FILLED)
          GENVFD  (60,T6) 
          GENVFD  (60,(CCTWORD,SSDATE))  TIME AND DATE OF SS COMPILATION
          MOVEZ  0,T6 
          MOVEZ  0,P1 
*                GENERATE THE CDCS -FILE USAGE- TABLE, 1 WORD PER FILE
*                WHOSE I/O IS PERFORMED VIA CDCS
 ENT2C    LABEL 
          ADDZ   T6,1,T6     FNAT INDEX 
          MOVEZ  (DMFUTOF,T6),P2  -FILE USAGE- TABLE WORD 
          IFZ    (P2,EQ,0),ENT2C0  JUMP IF NOT A CDCS I/O FILE
          GENVFD  (60,P2)    -FILE USAGE- TABLE WORD TO OBJECT CODE 
          EXECUTE  CDCSSR1   ACCUMULATE -FILE USAGE- TABLE BITS FOR 
*                 SUBSEQUENT LOADER OMIT TABLE (IN P1)
 ENT2C0   LABEL 
          NOTZ   (T6,EQ,(CCTWORD,FNATLEN)),ENT2C  JUMP IF ANOTHER FILE
          GENVFD  (60,0)     TERMINATE TABLE WITH ZERO WORD 
*                GENERATE THE CDCS -RELATIONS/QUALIFIERS- TABLE, FOR
*                EACH RELATION
*                    WORD 1 - BITS 59-45 - NUMBER +1 OF QUALIFIERS
*                             BITS 11-0  - RELATION ORDINAL 
 CDCS2    IFEQ   OP.DCS,OP.DCS1 
*                    1 WORD/QUALIFIER - BITS 35-30 - QUALIFIER BCP
 CDCS2    ELSE
*                    1 WORD/QUALIFIER - BITS 50-36 - QUALIFIER CHAR SIZE
*                                            35-30 - QUALIFIER BCP
 CDCS2    ENDIF 
*                                       BITS 17-0  - QUALIFIER ADDRESS
*                  ZERO WORD ENDS TABLE 
          MOVEZ  (LOCLAB,T1),T1  ALLOCATE A LABEL FOR TABLE (-TAGRQ-) 
          GEN    LABEL$,LOCALA  DEFINE LOCAL LABEL -TAGRQ-
          MOVEZ  0,T6 
          MOVEZ  1,T9        FLAG FOR -DMRELOF- FUNCTION - RELATN QUALFR
 ENT2C0A  LABEL 
          ADDZ   T6,1,T6     FNAT INDEX 
          MOVEZ  (DMRELOF,T6),T7  (T7)=WORD1, (T8)=AUX PTR TO QUALIFIERS
          IFZ    (T7,EQ,0),ENT2C0C  JUMP IF NOT A RELATION
          GENVFD  (60,T7)    WORD 1 TO OBJECT CODE
          IFZ    (T8,EQ,0),ENT2C0C  JUMP IF NO QUALIFIERS 
 ENT2C0B  LABEL 
          MOVEZ  GDATAREF,(GCODEOF,REGF)  SET UP FOR -FWA$OF- 
          MOVEZ  (AUXDNPOF,T8),(GPTROF,REGF)
 CDCS2    IFEQ   OP.DCS,OP.DCS1 
          GENVFD  (30,(BCPOF,REGF)),(30,((FWA$OF,REGF)))  QUALIFIER BCP 
*                                      AND ADDRESS TO OBJECT CODE 
 CDCS2    ELSE
          GENVFD  (24,(BYTLENOF,REGF)),(6,(BCPOF,REGF)),(30,((FWA$OF,REG
,F)))                        QUALIFIER LENGTH/BCP/ADDRESS TO OBJECT CODE
 CDCS2    ENDIF 
          MOVEZ  (AUXNXTOF,T8),T8 
          NOTZ   (T8,EQ,0),ENT2C0B  JUMP IF ANOTHER RELATION QUALIFIER
 ENT2C0C  LABEL 
          NOTZ   (T6,EQ,(CCTWORD,FNATLEN)),ENT2C0A  JUMP IF ANOTHER RLTN
          GENVFD  (60,0)     TERMINATE TABLE WITH ZERO WORD 
*                GENERATE THE CDCS -RELATIONS/AREAS TABLE - FOR EACH
*                RELATION - 
*                    WORD 1 - BITS 59-45 - NUMBER OF AREAS
*                             BITS 11-0  - RELATION ORDINAL 
*                    1 WORD/AREA - BITS 17-0 - AREA FIT ADDRESS 
*                    ZERO WORD
*                  ZERO WORD ENDS TABLE 
          MOVEZ  (LOCLAB,T2),T2  ALLOCATE A LABEL FOR TABLE 
          GEN    LABEL$,LOCALB  DEFINE LOCAL LABEL
          MOVEZ  0,T6 
          MOVEZ  0,T9        FLAG FOR -DMRELOF- FUNCTION - RELATION AREA
 ENT2C0D  LABEL 
          ADDZ   T6,1,T6     FNAT INDEX 
          MOVEZ  (DMRELOF,T6),T7  (T7)=WORD 1, (T8)=AUX PTR TO AREAS
          IFZ    (T7,EQ,0),ENT2C0F  JUMP IF NOT A RELATION
          GENVFD  (60,T7)    WORD 1 TO OBJECT CODE
 ENT2C0E  LABEL 
          MOVEZ  GDATAREF,(GCODEOF,REGF)  SET UP REGF FOR -FWA$OF-
          MOVEZ  (AUXDNPOF,T8),(GPTROF,REGF)
          GENVFD  (60,((FWA$OF,REGF)))  AREA FIT ADDRESS TO OBJECT CODE 
          MOVEZ  (AUXNXTOF,T8),T8 
          NOTZ   (T8,EQ,0),ENT2C0E  JUMP IF ANOTHER AREA
          GENVFD  (60,0)     ZERO WORD
 ENT2C0F  LABEL 
          NOTZ   (T6,EQ,(CCTWORD,FNATLEN)),ENT2C0D  JUMP IF ANOTHER RLTN
          GENVFD  (60,0)     TERMINATE TABLE WITH ZERO WORD 
          GEN    USE$,((USETB$OF,USECODE))  -REGULAR USE BLOCK
          GEN    SBBPK,(VREGOF,VREGC),,LOCALA  SB4 TAGRQ
          GEN    SBBPK,(VREGOF,VREGD),,LOCALB  SB5 TAGRA
          GEN    SBBPK,(VREGOF,VREGA),,LOCALE  SB6 TAGDM
*                CHECK FOR -OPEN OUTPUT- ON MIP FILE WITH CDCS I/O
          IFTHEN  ((CCTBIT,MIPOO),EQ,0) 
          GEN    SXBPB,(VREGOF,VREGB),,  SX6 B0, IF NO
          ELSEZ 
 CDCS2    IFEQ   OP.DCS,OP.DCS2 
          GEN    SXBPK,(VREGOF,VREGB),,((EXT$OF,DB$OPN))  SX6  =XDB$OPN,
*                                                          IF YES 
 CDCS2    ELSE
          GEN    SXBPK,(VREGOF,VREGB),,((EXT$OF,DM$OP2))  SX6 =XDM$OP2, 
*                                                          IF YES 
 CDCS2    ENDIF 
          ENDIFZ
          IFZ    ((CCTBIT,SUBPROGR),EQ,0),ENT2C1  JUMP IF NOT SUBCOMPILE
          NOTZ   ((CCTBIT,MAINSUB),EQ,0),ENT2C1  JUMP IF MAIN SUBROUTINE
          GENOBJ  N=C.DMSUB,I=(VREGA,VREGB,VREGC,VREGD)  CDCS SUBCOMPILE
*                                                         -INVOKE-
          BRANCH  ENT3
 ENT2C1   LABEL 
          GENOBJ  N=C.DMINV,I=(VREGA,VREGB,VREGC,VREGD)  CDCS MAIN PRO- 
*                                                         GRAM -INVOKE- 
 CDCS1    IFEQ   OP.DCS,OP.DCS1 
*                GENERATE A LOADER OMIT TABLE ENTRY FOR EACH CDCS 
*                FUNCTION NOT SPECIFIED IN THE USER PROGRAM.  P1
*                CONTAINS, IN ITS UPPER 8 BITS, 1 BIT, NOT SET, FOR EACH
*                FUNCTION TO BE OMITTED 
          MOVEZ  0,P2        INDEX INTO TABLE -CDCSLO-
 ENT2D    LABEL 
          IFZ    (P1,LT,0),ENT2E  JUMP IF ENTRY NOT TO BE OMITTED 
          EXECUTE  CDCSSR2   ENTRY(S) TO BE OMITTED INTO P3 (AND P4)
          IFZ    (P3,EQ,0),ENT2E2  JUMP IF -SKIP- AND PROGRAM DOES -READ
          MOVEZ  P3,(LDROMIT,P3)  GENERATE LOADER OMIT TABLE ENTRY
          IFZ    (P4,EQ,0),ENT2E2  JUMP IF ONLY 1 ENTRY TO BE OMITTED 
          MOVEZ  P4,(LDROMIT,P4)  GENERATE LOADER OMIT TABLE ENTRY
 ENT2E    LABEL 
          IFZ    (P2,EQ,CDCSLO1),ENT2E1  JUMP IF TESTING -WRITE-
          NOTZ   (P2,EQ,CDCSLO2),ENT2E2  JUMP IF NOT TESTING -READ- 
 ENT2E1   LABEL 
          ADDZ   P2,1,P2     ALLOW FOR 2 ENTRIES IF -WRITE- OR -READ- 
 ENT2E2   LABEL 
          ADDZ   P2,1,P2
          LSHIFT  P1,1
          NOTZ   (P2,EQ,CDCSLO4),ENT2D  JUMP IF MORE CDCS FUNCTIONS 
*                GENERATE A LOADER OMIT TABLE ENTRY FOR EACH ENTRY IN 
*                THE SUB-SCHEMA LOADER OMIT TABLE, IF ONE EXISTS
          MOVEZ  (CCTWORD,PLTLOPTR),T6
          IFZ    (T6,EQ,0),ENT2G  JUMP IF NO SS OMIT TABLE
          MOVEZ  (DMPLTSTR,T6),T6  POINTER TO SS OMIT TABLE IN -PLTSTR- 
          MOVEZ  (DMLOSZOF,T6),T7  T7=NUMBER OF SS OMIT TABLE ENTRIES 
 ENT2F    LABEL 
          ADDZ   T6,1,T6     INCREMENT -PLTSTR- (SS OMIT TABLE POINTER) 
          MOVEZ  (DMLOWDOF,T6),T8  SS OMIT TABLE ENTRY TO T8
          MOVEZ  T8,(LDROMIT,T8)  GENERATE LOADER OMIT TABLE ENTRY
          SUBZ   T7,1,T7
          NOTZ   (T7,EQ,0),ENT2F  JUMP IF NOT END OF SS OMIT TABLE
 ENT2G    LABEL 
 CDCS1    ENDIF 
 CDCS     ENDIF 
  
 ENT3     LABEL 
          IFTHEN ((CCTWORD,INITCD),NE,0)
            MOVEZ 0,P1
            MOVEZ REGU1,P2
            EXECUTE  CGREGMV
            MOVEZ (EQUALS,GDATAREF),(GCODEOF,REGU1) 
            MOVEZ (CCTWORD,INITCD),(GPTROF,REGU1) 
            GEN   SABPK,(VREGOF,VREG1),,((FWA$OF,REGU1))
            GEN   SXBPB,(VREGOF,VREG2),,VREGB1
            GENOBJ N=C.MCS12,I=(VREG1,VREG2)
          ENDIFZ
          RETURN
 CDCS     IFNE   OP.DCS,OP.NO 
          EJECT 
* ROUTINE TO ACCUMULATE CDCS -FILE USAGE- TABLE BITS FOR SUBSEQUENT 
* LOADER OMIT TABLE (NOTE -CDCSSR2-). 
*         ON ENTRY, A1=PARAMETER LIST (ADDRESSES OF P1,P2,P3,P4) ADDRESS
*                   X1=P1 
*                   (P1)=BIT ACCUMULATION SO FAR
*                   (P2)=CURRENT -FILE USAGE- WORD
*         ON EXIT,  (P1)=UPDATED BIT ACCUMULATION 
 CDCSSR1  BSS    1
          SA2    X1          X2=(P1)
          SA3    A1+1        X3=P2
          SA3    X3          X3=(P2)
          BX6    X2+X3       UPDATED BIT ACCUMULATION 
          SA6    X1          NEW (P1) 
          EQ     CDCSSR1
          SPACE  2
* ROUTINE TO PLACE 1 OR 2 ENTRIES FROM TABLE -CDCSLO- INTO FIXED CELLS
* P3 AND P4.  (THE FIRST -CDCSLO4- ENTRIES ARE IN THE SAME ORDER AS THE 
* CDCS INTERFACE -FILE USAGE- TABLE BITS.)
*         ON ENTRY, A1=PARAMETER LIST (ADDRESSES OF P1,P2,P3,P4) ADDRESS
*                   X1=P1 
*                   (P1)=-FILE USAGE- BIT PATTERN, LEFT-SHIFTED, BIT 59 
*                        CORRESPONDS TO CURRENT -CDCSLO- ENTRY (NOTE P2)
*                   (P2)=INDEX IN -CDCSLO- OF ENTRY TO PLACE INTO P3
*         ON EXIT,  (P3)=ENTRY IN -CDCSLO- SPECIFIED BY (P2)
*                       =0 IF -SKIP- AND PROGRAM DOES -READ- (SKIP RE-
*                         QUIRED IF REVERSED READ)
*                   (P4)=-C.DMWR2- IF WRITE 
*                   (P4)=-C.DMRD2 IF -READ- 
*                       =0 OTHERWISE
 CDCSSR2  BSS    1
          SB1    1
          SA2    A1+B1       X2=P2
          SA3    X2          X3=(P2)=INDEX IN TABLE -CDCSLO-
          SA4    X3+CDCSLO
          SX5    X3-CDCSLO3 
          BX6    X4 
          NZ     X5,CDCSSR2A  JUMP IF NOT SKIP
          SA5    X1          X5=(P1)
          LX5    60-54+52    SHIFT -READ- BIT TO BIT 59 
          PL     X5,CDCSSR2A  JUMP IF PROGRAM DOES NO CDCS READ 
          MX6    0           ELSE DO NOT OMIT -SKIP-
 CDCSSR2A SA4    A2+B1       X4=P3
          SA6    X4          SET (P3) 
          MX6    0
          SX5    X3-CDCSLO1 
          ZR     X5,CDCSSR2B  JUMP IF -WRITE- 
          SX5    X3-CDCSLO2 
          NZ     X5,CDCSSR2C  JUMP IF NOT READ
 CDCSSR2B SA5    X3+CDCSLO+1  OMIT 2 ENTRIES IF -READ- OR -WRITE- 
          BX6    X5 
 CDCSSR2C SA4    A4+B1       X4=P4
          SA6    X4          SET (P4) 
          EQ     CDCSSR2
 CDCS     ENDIF 
          SPACE  1
          EJECT 
 EXITGEN  SPACE  4,10 
**        EXITGEN - EXIT VERB.
* 
* 
  
  
 EXITGEN  EGO    1
          NOTE   EXITGEN
          RETURN
 EXITPGEN SPACE  4,10 
**        EXITPGEN - EXIT-PROGRAM VERB. 
* 
* 
*         IF THIS IS A SUBCOMPILE, A RETURN THROUGH THE ENTRY POINT 
*         IS GENERATED.  (CALLS *GENJO*)
  
  
 EXITPGEN EGO    1
          NOTE   EXITPGEN 
          IFTHEN  ((CCTBIT,SUBPROGR),NE,0)       NE 0 IF SUBCOMPILE 
            CALLZ  GENJO                         GENERATE JUMP TO ENTRY 
          ENDIFZ
          RETURN
 FORMPGEN SPACE  4,10 
**        FORMPGEN - FORMAL PARAMETER.
* 
* 
*              THIS GENERATOR GENERATES THE PARAMETER ASSOCIATION 
*         LIST, WHICH RELATES THE FORMAL PARAMETER NUMBER WITH THE
*         LINKAGE SECTION ORDINAL NUMBER.  THE LATTER IS THE NUMBER 
*         WHICH THE ASSEMBLER PLACES IN THE PARAMETER INSERTION LIST. 
*         SEE THE MORE DETAILED DESCRIPTION IN THE *CBADSUB* LISTING. 
* 
*         CODE GENERATED: 
* 
*         VFD    12/(LINKAGE-SECTION ORD),48/0
* 
* TAG4    BSS    0           LAST TIME ONLY 
  
  
 FORMPGEN EGO    1
          NOTE   FORMPGEN 
  
          SUBZ   PARAMCT,1,PARAMCT
          GEN    USE$,((USETB$OF,USEBEFOR)) 
          GENVFD  (12,(SUBMSCOF,BRREGB)),(48,0) 
          IFTHEN (PARAMCT,EQ,0) 
            GENVFD  (60,0)
          ENDIFZ
  
          GEN    USE$,((USETB$OF,USECODE))
          RETURN
 PARAMGEN TITLE  PARAMGEN - PARAMETER LIST
**        PARAMGEN - PARAMETER LIST GENERATOR.
* 
* 
*         INPUT:  
* 
*              THIS GENERATOR IS CALLED ONE OR MORE TIMES IMMEDIATELY 
*         AFTER THE GENERATOR FOR EITHER *CALL* OR *ENTER* HAS BEEN 
*         CALLED. 
* 
*              THE *GPTR* FIELD OF THE VERB ATOM CONTAINS A COUNT 
*         OF THE REMAINING PARAMETERS, AND, HENCE, FOR THE LAST ONE,
*         THIS VALUE IS ONE (1).
* 
*         CODE GENERATED: 
* 
*         VFD    42/0,18/ADDRESS               FOR ENTER FORTRAN-X
* 
*           -OR-
 CDCS     IFNE   OP.DCS,OP.NO 
* 
*         VFD    60/ORDINAL                    FOR CDCS RELATION
* 
*           -OR-
 CDCS     ENDIF 
* 
*         VFD    42/(ATTRIBUTES),18/ADDRESS    FOR ALL OTHER CASES
* 
*           -AND- 
* 
*         VFD    60/0                          IF THIS IS THE LAST PARAM
* 
*         ATTRIBUTES - AS DEFINED ON PAGE II-8-5 OF COBOL 4 REF. MANUAL.
*         ADDRESS    - ADDRESS OF PARAMETER.
  
  
 PARAMGEN EGO    1
          NOTE   PARAMGEN 
  
          GEN    USE$,((USETB$OF,USEPARAM))      SET TO USE BLOCK 
  
          GOTOCASE  (GCODEOF,BRREGB)
            CASE  GFILEREF,PMG30
            CASE  GPROCREF,PMG40
          ENDCASE 
          IFZ    (GBR1,NE,1),PMG01 JP IF NOT FORTRAN-X
          IFZ    ((TYPEOF,BRREGB),EQ,COMP),PMG14  JP IF NUMERIC (OR LIT)
          BRANCH PMG50                 IS NORMAL OP, GEN ADDR FOR FTNX
 PMG01    LABEL 
  
*      DATA-REF AND LIT-REF PROCESSING. 
  
          MOVEZ  (BYTLENOF,BRREGB),PARLEN 
          IFZ    (GBR1,EQ,2),PMG60   JP IF ENTER FTN5 
          MOVEZ  50B,T3                ELEMENTARY ITEM
          GOTOCASE  (TYPEOF,BRREGB) 
            CASE  ALPHABET,PMG11
            CASE  ALPHNUM,PMG12 
            CASE  ALPNUMED,PMG12
            CASE  NUMEDIT,PMG13 
            CASE   INDXDATA,PMG15 
            CASE  COMP,PMG14
            CASE  COMP1,PMG15 
            CASE    COMP2,PMG14 
            CASE   COMP4,PMG17
            CASE  GROUP,PMG16 
            CASE  VARGROUP,PMG16
            CASE   BOOLDSP,PMG10
            CASE   BOOLBIT,PMG18
          ENDCASE 
          ERROR  PARAMERR 
          BRANCH PMG52
  
 PMG10    LABEL 
          MOVEZ  1,T1        DISPLAY
          MOVEZ  4,T2        BOOLEAN
          BRANCH PMG20
 PMG11    LABEL 
          MOVEZ  1,T1                  DISPLAY
          MOVEZ  1,T2                  ALPHABETIC 
          BRANCH  PMG20 
  
 PMG12    LABEL 
          MOVEZ  1,T1                  DISPLAY
          MOVEZ  3,T2                  ALPHANUMERIC, ALPHANUMERIC-EDITED
          BRANCH  PMG20 
  
 PMG13    LABEL 
          MOVEZ  1,T1                  DISPLAY
          MOVEZ  6,T2                  NUMERIC-EDITED 
          BRANCH  PMG22 
  
 PMG14    LABEL 
  
*      IF PARAMETER IS A LITERAL WE MUST POOL IT
  
          IFTHEN ((GCODEOF,BRREGB),EQ,GLITREF)
            MOVEZ  (LITREFOF,BRREGB),P1 
            MOVEZ  (NUMLENOF,BRREGB),P2 
            MOVEZ  (POINTOF,BRREGB),P3
            MOVEZ  (SIGNOF,BRREGB),P4 
            CALLZ  CLIT2RN
            MOVEZ  0,(BCPOF,BRREGB) 
            SUBZ   (NUMLENOF,BRREGB),1,T1        N = NUMLENOF LITERAL 
            QUOTZ  T1,10,T1                      0 IF 0@N@10, 1 IF N>10 
            ADDZ   1,T1,T1
            MULTZ  10,T1,(BYTLENOF,BRREGB)       10 IF 0@N@10,20 IF N>10
            MOVEZ  (BYTLENOF,BRREGB),PARLEN 
            MOVEZ  BRREGB,REGT
            IFZ    (T1,EQ,1),PMG14A              IF 1 WORD LITERAL
            MOVEZ  P2,P3             LEAST SIGNIFICANT
            MOVEZ  P1,P2             MOST SIGNIFICANT 
 PMG14A   LABEL 
            MOVEZ  0,P1 
            EXECUTE LITPOOL 
          ENDIFZ
          IFZ    (GBR1,EQ,1),PMG50     JP IF FORTRAN-X - GEN ADDR ONLY
          IFZ  ((TYPEOF,BRREGB),EQ,COMP2),PMG50 
          MOVEZ  2,T1                  COMP 
          MOVEZ  2,T2                  NUMERIC
          BRANCH  PMG22 
  
 PMG15    LABEL 
          MOVEZ  4,T1                  COMP-1 
          MOVEZ  2,T2                  NUMERIC
          BRANCH  PMG22 
  
 PMG16    LABEL 
          MOVEZ  7,T1                  GROUP
          MOVEZ  7,T2                  GROUP
          MOVEZ  40B,T3                GROUP ITEM 
          GENVFD  (6,0) 
          BRANCH  PMG21 
 PMG17    LABEL 
          MOVEZ  5,T1 
          MOVEZ  2,T2 
          MOVEZ  (BYTLENOF,BRREGB),PARLEN 
          BRANCH PMG22
 PMG18    LABEL 
          GENVFD (5,0),(1,(JUSTOF,BRREGB))
          GENVFD (18,(BITLENOF,BRREGB)) 
          MOVEZ  3,T1        BIT
          MOVEZ  4,T2        BOOLEAN
          BRANCH PMG23
  
 PMG20    LABEL 
          GENVFD  (5,0),(1,(JUSTOF,BRREGB)) 
  
 PMG21    LABEL 
          GENVFD  (18,(BYTLENOF,BRREGB))
          BRANCH  PMG23 
  
 PMG22    LABEL 
          MOVEZ  (POINTOF,BRREGB),T4
          LTZ    T4,0,T5
  
          GENVFD  (1,(SIGNOF,BRREGB)),(2,0),(1,T5),(5,(ABSVALOF,T4))
          GENVFD (6,0),(9,PARLEN) 
  
 PMG23    LABEL 
          GENVFD  (6,(BCPOF,BRREGB)),(6,T3),(3,T2),(3,T1) 
          BRANCH  PMG51 
  
*      FILE-REF PROCESSING. 
  
 PMG30    LABEL 
 CDCS     IFNE   OP.DCS,OP.NO 
          MOVEZ  (DMRELOOF,BRREGB),T4 
          IFTHEN  (T4,EQ,0)     IF A FILE, NOT A CDCS RELATION
 CDCS     ENDIF 
          MOVEZ  0,P1                  FORM REG TABLE ENTRY FOR DNAT
          MOVEZ  REGU1,P2               OF FILE 
          EXECUTE  CGREGMV
          MOVEZ  (EQUALS,GDATAREF),(GCODEOF,REGU1)
          MOVEZ  (FNDNATOF,BRREGB),(GPTROF,REGU1) 
  
          IFZ    (GBR1,NE,0),PMG30A    JP IF NOT FTN-X
          GENVFD  (36,44B),(6,0)
          BRANCH  PMG30B
 PMG30A   LABEL 
          IFZ    (GBR1,EQ,2),PMG30A1  JP IF ENTER FTN5
          GENVFD (42,0)            NO STUFF IN UPPER FOR FTN-X
          BRANCH PMG30B 
 PMG30A1  LABEL 
          GENVFD  (12,7),(30,0)    FLAG AS P-N FOR FTN5 
          BRANCH  PMG30B
 PMG30B   LABEL 
          GENVFD  (18,((FWA$OF,REGU1))) 
 CDCS     IFNE   OP.DCS,OP.NO 
          ELSEZ              CDCS RELATION
          GENVFD  (60,T4)    RELATION ORDINAL 
          ENDIFZ
 CDCS     ENDIF 
  
          BRANCH  PMG52 
  
*      PROC-REF PROCESSING. 
  
 PMG40    LABEL 
          IFZ    (GBR1,EQ,1),PMG50     JP IF FTN-X - ADDR ONLY
          IFTHEN (GBR1,EQ,0)       IF NOT FTN5 OR FORTRAN-X 
            GENVFD  (34,5),(1,(PKINDOF,BRREGB)),(7,0) 
          ELSEZ                    FTN5 - FLAG AS FILE
            GENVFD  (12,6),(30,0) 
          ENDIFZ
          BRANCH  PMG51 
  
*      ADDRESS-ONLY PROCESSING. 
  
 PMG50    LABEL 
          GENVFD  (42,0)
  
*      ADDRESS PROCESSING FOR PROC-REF, DATA-REF, LIT-REF.
  
 PMG51    LABEL 
          GENVFD  (18,((FWA$OF,BRREGB)))
  
 PMG52    LABEL 
          IFTHEN  ((GPTROF,BRREGA),EQ,1)
  
            GENVFD  (60,0)             ZERO WORD AT END OF LIST 
            GEN  ENDPL                 END OF POOLED SEQUENCE 
  
          ENDIFZ
  
          GEN    USE$,((USETB$OF,USECODE))       SET TO CODE BLOCK
  
          RETURN
*     FTN5 APLIST PROCESSING (ALSO CALLED STANDARD APLIST)
 PMG60    LABEL 
          MOVEZ  0,T2              ASSUME POINT OF ZERO 
          GOTOCASE  (TYPEOF,BRREGB) 
            CASE   ALPHABET,PMG60A
            CASE   ALPHNUM,PMG60A 
            CASE   ALPNUMED,PMG60A
            CASE   NUMEDIT,PMG60A 
            CASE   INDXDATA,PMG60A
            CASE   COMP,PMG60NUM
            CASE   COMP1,PMG60C1
            CASE   COMP2,PMG60C2
            CASE   COMP4,PMG60C1
            CASE   GROUP,PMG60A 
            CASE   VARGROUP,PMG60A
          ENDCASE 
          ERROR  PARAMERR 
          BRANCH PMG52
 PMG60A   LABEL 
          MOVEZ  5,T1              DISPLAY CODE STRING - CHARACTER TYPE 
          MOVEZ  (BYTLENOF,BRREGB),PARLEN  SIZE 
          BRANCH PMG60OP
  
 PMG60NUM LABEL 
          IFTHEN  ((GCODEOF,BRREGB),EQ,GLITREF)  IF LITERAL 
            MOVEZ  10,PARLEN       ASSUME LENGTH 10 
            MOVEZ  (LITREFOF,BRREGB),P1 
            MOVEZ  (NUMLENOF,BRREGB),P2 
            MOVEZ  (POINTOF,BRREGB),P3
            MOVEZ  (SIGNOF,BRREGB),P4 
            CALLZ  CLIT2RN         CONVERT LIT TO REG NUMERIC 
            IFZ    ((NUMLENOF,BRREGB),GT,14),PMG60N1
            MOVEZ  (POINTOF,BRREGB),P3
            CALLZ  CRN2BIN             CONVERT TO BINARY VALUE
            IFZ    ((POINTOF,BRREGB),NE,0),PMG60N2  JP IF IT HAS A POINT
*     INTEGER VALUE < 15 CHARS
            MOVEZ  P3,P2           RESULT 
            MOVEZ  1,T1            TYPE 1 (INTEGER) 
            BRANCH  PMG60N3 
  
*     MORE THAN 14 CHARACTERS - POOL AS STRING
 PMG60N1  LABEL 
            MOVEZ  20,PARLEN       TWO WORDS
            MOVEZ  P2,P3
            MOVEZ  P1,P2           FOR POOLING
            MOVEZ  5,T1            FLAG AS CHARACTER TYPE 
            MOVEZ  (POINTOF,BRREGB),T2
            BRANCH  PMG60N3 
  
*     POINT GIVEN - ASSUME FLOATING POIN
 PMG60N2  LABEL 
            MOVEZ  P1,P2           REAL VALUE 
            MOVEZ  0,T1            FLAG AS REAL 
 PMG60N3  LABEL 
            MOVEZ  0,(BCPOF,BRREGB) 
            MOVEZ  PARLEN,(BYTLENOF,BRREGB) 
            MOVEZ  BRREGB,REGT
            MOVEZ  0,P1 
            EXECUTE  LITPOOL       POOL THE LITERAL 
          ELSEZ              NOT A LITERAL
            MOVEZ  (POINTOF,BRREGB),T2  POINT LOCN - NORMAL NUM DATA
            MOVEZ  5,T1            ASSUME UNSIGNED
            IFZ    ((SIGNOF,BRREGB),EQ,0),PMG60OP  JP IF NOT SIGNED 
            MOVEZ  9,T1           ASSUME SEP SIGN LEFT
            IFZ    ((SCHAROF,BRREGB),EQ,0),PMG60N4  JP IF NOT SEP CHAR
            IFZ    ((LDSIGNOF,BRREGB),EQ,1),PMG60OP  JP IF SEP SIGN LEFT
            MOVEZ  10,T1           IS SEP SIGN RIGHT
            BRANCH  PMG60OP 
 PMG60N4  LABEL 
            MOVEZ  11,T1           ASSUME INCL SIGN LEFT
            IFZ    ((LDSIGNOF,BRREGB),EQ,1),PMG60OP  JP IF LEAD INCL SIG
            MOVEZ  12,T1           IS TRAILING INCL SIGN
          ENDIFZ
          BRANCH PMG60OP
  
*     COMP-1 OR COMP-4 DATA ITEM
 PMG60C1  LABEL 
          MOVEZ  1,T1 
          MOVEZ  (BYTLENOF,BRREGB),PARLEN 
          MOVEZ  (POINTOF,BRREGB),T2
          BRANCH  PMG60OP 
  
*     COMP-2 DATA ITEM
 PMG60C2  LABEL 
          MOVEZ  0,T1 
          MOVEZ  10,PARLEN
  
 PMG60OP  LABEL 
          IFTHEN ((MAJMSCOF,BRREGB),EQ,SECSMSEC)  IF ECS
            GENVFD  (1,1)          FLAG AS ECS
          ELSEZ 
            GENVFD  (1,0)          NOT ECS
          ENDIFZ
          GENVFD  (5,T2),(6,T1),(18,PARLEN),(2,0)  POINT,TYPE,LEN 
          GENVFD  (4,(BCPOF,BRREGB)),(6,0)  BCP 
          BRANCH  PMG51 
 ENDGEN   TITLE  ENDGEN - END OF PROGRAM GTEXT PROCESSING 
**        ENDGEN - PROCESSOR FOR THE END GTEXT. 
* 
* 
  
  
 ENDGEN   EGO    1
          NOTE   ENDGEN 
  
*      SUBCOMPILE PROCESSING. 
  
          IFTHEN  ((CCTBIT,SUBPROGR),NE,0)       NE 0 IF SUBCOMPILE 
            CALLZ  GENJO                         GENERATE JUMP TO ENTRY 
          ENDIFZ
          RETURN
 GENJO    SPACE  4,8
**        GENJO - GENERATE JUMP TO ENTRY POINT. 
* 
* 
*              THIS IS CALLED ONLY IF THE PROGRAM IS A SUB-COMPILE. 
* 
*         CODE GENERATED: 
* 
*         EQ     ENTRY-ADR
  
  
 GENJO    EGO    2
          IFTHEN  ((GETDCCT,T1),NE,0) 
* RESTORE DECLARATIVE TABLE ADDRESS 
          GEN    SLRBPK,(VREGOF,VREGA),,((LOCAL$OF,FLOCLAB),-1) 
          GEN    XMIT,(VREGOF,VREGC),VREGA
          GEN    SSRBPK,VREGC,,((EXT$OF,C.USETB)) 
          ENDIFZ
          MOVEZ  0,P1 
          MOVEZ  (EQUALS,REGU1),P2
          EXECUTE  CGREGMV
          MOVEZ  (EQUALS,GPROCREF),(GCODEOF,REGU1)
          MOVEZ  FSTLABEL,(GPTROF,REGU1)
  
          GENOBJ N=C.EXITP
          GEN    EQ$,,,((FWA$OF,REGU1)) 
          GEN    PLUS 
  
          RETURN
 GOTOGEN  TITLE  GOTOGEN - GO TO STATEMENT
**        GOTOGEN - PROCESSOR FOR THE GO TO GTEXT.
* 
* 
*              THIS GENERATOR AND VARIOUS OTHER PROCEDURE-BRANCHING 
*         GENERATORS MAKE USE OF THE FWA$OF FUNCTION TO GET AT THE
*         PROPER ADDRESS.  IT SHOULD BE NOTED THAT IN THE CASE OF 
*         SEGMENTED PROGRAMS, THIS FUNCTION AUTOMATICALLY GENERATES 
*         A REFERENCE TO THE PROPER ENTRY OR EXIT INDEX WHEN THE
*         LOCATION REFERENCED IS NOT IN THE SAME SEGMENT. 
* 
*           CODE GENERATED IF DESTINATION NOT SPECIFIED:  
* 
*         RJ     =XC.GTERR
* 
*           OTHERWISE:  
* 
*         EQ     B0,B0,(DESTINATION)
  
  
 GOTOGEN  EGO    1
          NOTE   GOTOGEN
  
*      FOR UNSEGMENTED PROGRAMS-
*      IF THE PREVIOUS PROC-DEF WAS ALTERED (I.E. THIS IS AN ALTERED
*      PARAGRAPH CONSISTING ONLY OF A PROC-DEF AND THIS GO TO) WE PUT 
*      OUT AN EPRC SO THE ALTER GENERATOR CAN REFERENCE THE ABOVE EQ$ 
*      WITH A LWA$OF.  THIS IS NECESSARY BECAUSE OF THE POSSIBILITY OF
*      (GENERATED) DEBUG MOVES BETWEEN THE PROC-DEF AND THIS GO TO. 
*      (NOTICE THAT IF THE GTEXT FOR A GO-TO CHANGES TO USE REG6- 
*      THIS CODE WILL CAUSE PROBLEMS) 
*      FOR SEGMENTED PROGRAMS-
*      THIS IS UNNECESSARY SINCE THE ALTER GENERATOR DOES NOT USE LWA$OF
  
          MOVEZ  0,T1 
          IFTHEN (PLSTPARA,NE,0)
            MOVEZ  GPROCREF,(GCODEOF,REG6)
            MOVEZ  PLSTPARA,(GPTROF,REG6) 
            ANDIF  ((PALTEROF,REG6),NE,0) 
            ANDIF  (SEGPROG,EQ,0) 
              MOVEZ  1,T1 
          ENDIFZ
  
  
          IFZ    ((GCODEOF,BRREGB),EQ,(EQUALS,GLABLREF)),GOTWO1 
          IFZ    ((GCODEOF,BRREGB),EQ,(EQUALS,GPROCREF)),GOTWO1 
          IFTHEN (SEGPROG,NE,0) 
            MOVEZ  (PSGALTOF,REG6),T2 
            GEN    SLRBPK,(VREGOF,VREGA),,((USEORG$F,USESGIX),T2) 
            GEN    SBXPB,(VREGOF,VREGB),VREGA 
            MOVEZ  (LOCLAB,T1),T1 
            GEN    EQ$,VREGB,VREGB0,LOCALA
            GEN    JP$,VREGB
            GEN    LABEL$,LOCALA
          ENDIFZ
          GENOBJ  N=C.GTERR                                             104000
          IFTHEN (T1,NE,0)
            GEN    EPRC,((FWA$OF,REG6)) 
            GEN    PLUS 
          ENDIFZ
          RETURN                                                        105000
 GOTO1    SPACE  4                                                      106000
 GOTWO1   LABEL 
          IFTHEN (T1,NE,0)
            GEN    PLUS 
            GEN    EQ$,VVB0,VVB0,GOTODES
            GEN    PLUS 
            GEN    EPRC,((FWA$OF,REG6)) 
            RETURN
          ENDIFZ
          IFTHEN (SEGPROG,NE,0) 
          ANDIF  ((PALTEROF,REG6),NE,0) 
            MOVEZ  (PSGALTOF,REG6),T2 
            GEN    SLRBPK,(VREGOF,VREGA),,((USEORG$F,USESGIX),T2) 
            GEN    SBXPB,(VREGOF,VREGB),VREGA 
            MOVEZ  (LOCLAB,T1),T1 
            GEN    EQ$,VREGB,VREGB0,LOCALA
            GEN    JP$,VREGB
            GEN    LABEL$,LOCALA
          ENDIFZ
            GEN    EQ$,VVB0,VVB0,GOTODES
            GEN    PLUS 
          RETURN                                                        109000
 GTDGEN   TITLE  GTDGEN - GO TO DEPENDING STATEMENT 
**        GTDGEN - PROCESSOR FOR THE GO TO DEPENDING GTEXT. 
* 
* 
*         CODE GENERATED: 
* 
*         (GMOVE CODE TO PUT COMP1 VALUE OF IDENTIFIER IN XI) 
* 
*         SBJ    N           NUMBER OF POSSIBLE DESTINATIONS
*         SBK    XI          VALUE OF IDENTIFIER
*         LT     BK,B1,TAG2  IF VALUE @ 0 
*         LT     BJ,BK,TAG2  IF VALUE > MAXIMUM 
*         JP     BK+TAG1-1   GO TO CORRECT BRANCH 
* 
* TAG1    EQ     (PROCEDURE NAME 1) 
*         . 
*         . 
*         EQ     (PROCEDURE NAME N) 
* 
* TAG2    (WHATEVER COMES NEXT) 
  
  
 GTDGEN   EGO    1
          NOTE   GTDGEN 
          MOVEZ  (EQUALS,FAKER),REGT   CREATE DNAT FOR RECEIVING
          CALLZ  ADNAT                 COMP1 IDENTIFIER 
          MOVEZ  (EQUALS,FAKER),REGC
          MOVEZ  (EQUALS,COMP1),(TYPEOF,REGC) 
          MOVEZ  6,(NUMLENOF,REGC)
          MOVEZ  0,(POINTOF,REGC) 
          MOVEZ  1,(SIGNOF,REGC)
          CALLZ  CGMOVE                MOVE REGB_REG2 TO REGC_FAKER 
          NOTE   GTDRET1
          MOVEZ  (EQUALS,REG3),REGC    RESTORE GTEXT ATOM POINTER 
          MOVEZ  (GPTROF,BRREGC),COUNTD  NUMBER OF POSSIBLE DESTINATIONS
          MOVEZ  (LOCLAB,T1),T1        GET LOCAL LABEL FOR TAG1 
          MOVEZ  (LOCLAB,T2),T2        GET LOCAL LABEL FOR TAG2 
          MOVEZ  T2,SAVER              THIS ONE HAS TO BE SAVED 
  
          GEN    SBBPK,(VREGOF,VREGC),,COUNTD 
          GEN    SBXPB,(VREGOF,VREGD),(TREGOF,FAKER)
          GEN    LT$,VREGD,VREGB1,LOCALB
          GEN    LT$,VREGC,VREGD,LOCALB 
          GEN    JP$,VREGD,((LOCAL$OF,T1),-1) 
          GEN    STARTSEQ,,(SEQUENCE,0) 
  
          GEN    LABEL$,LOCALA         DEFINE TAG1
  
          CALLZ  SUBDNAT               RELEASE DNAT 
          MOVEZ  (EQUALS,REG4),BEGINREG 
  
 GTD2     LABEL 
          SUBZ   COUNTD,1,COUNTD
          IFZ    (COUNTD,LT,0),GTD4 
          ADDZ   BEGINREG,1,BEGINREG
          IFTHEN  (BEGINREG,EQ,CURGTEXT)
            MOVEZ  (EQUALS,REG2),BEGINREG 
            EXECUTE  CGSETRG
          ENDIFZ
          MOVEZ  BEGINREG,P1
          MOVEZ  (EQUALS,REGU1),P2
          EXECUTE  CGREGMV
  
          GEN    PLUS 
          GEN    EQ$,,,((FWA$OF,REGU1)) 
  
          BRANCH  GTD2
  
 GTD4     LABEL 
  
          MOVEZ  SAVER,T2              RESTORE LOCAL LABEL NO. FOR TAG2 
          GEN    LABEL$,LOCALB         DEFINE TAG2
  
          RETURN
 LABLGEN TITLE  LABLGEN - COMPILER GENERATED LABEL DEFINITION 
**        LABLGEN - PROCESSOR FOR COMPILER GENERATED LABEL. 
* 
* 
*              THIS PROCESSOR DEFINES THE COMPILER-GENERATED LABELS.
  
  
 LABLGEN  EGO    1
          NOTE   LABLGEN
          GEN    LABEL$,((FWASG$OF,BRREGA)) 
          GEN    STARTSEQ,,(SEQUENCE,0) 
          RETURN
 NOVFGEN  TITLE  NOVFGEN - GENERATE CODE FOR CALL WITH NO OVERFLOW
* 
*         NOVFGEN - GENERATE CODE FOR CALL WITH NO OVERFLOW 
* 
 NOVFGEN  EGO    1
          IFZ    ((CCTBIT,FDL),EQ,0),RETURN 
          POP    T1 
          IFZ    (T1,NE,0),RETURN 
          MOVEZ  (LOCLAB,T1),T1 
          GEN    EQ$,VREGA,R0,((LOCAL$OF,T1)) 
          GEN    SXBPK,(VREGOF,VREGB),,##CALLOV 
          GEN    SXBPB,(VREGOF,VREGC),R0,R0 
          GEN    SXBPB,(VREGOF,VREGD),R0,R0 
          GEN    SXBPB,(VREGOF,VREGE),R1,R0 
          GENOBJ N=C.MSG,I=(VREGB,VREGC,VREGD,VREGE)
          GEN    LABEL$,((LOCAL$OF,T1)) 
          RETURN
 OVFLGEN  TITLE  OVFLGEN - GENERATE CODE FOR CALL ON OVERFLOW 
* 
*         OVFLGEN - GENERATE CODE FOR CALL ON OVERFLOW
* 
 OVFLGEN  EGO    1
*      RETURN IF NO FDL 
          IFZ    ((CCTBIT,FDL),EQ,0),OVFL1
          POP    T1 
          IFZ    (T1,NE,0),OVFL1
          IFTHEN ((GSCODEOF,REGB),EQ,GFALSE)
            GEN    EQ$,VREGA,,((FWA$OF,REGB)) 
          ELSEZ 
            GEN    NE$,VREGA,,((FWA$OF,REGB)) 
          ENDIFZ
          RETURN
 OVFL1    LABEL 
          IFTHEN  ((GSCODEOF,REGB),EQ,GFALSE) 
            GEN    EQ$,,,((FWA$OF,REGB))
          ENDIFZ
          RETURN
 PERFGEN  TITLE  PERFGEN - PERFORM STATEMENT
**        PERFGEN - PROCESSOR FOR THE PERFORM GTEXT.
* 
* 
*              PERFORM PROCESSING IS GROUPED AS FOLLOWS:  
* 
*         - PERFGEN HANDLES THE PERFORM VERB. 
*         - PFTMGEN HANDLES THE PERFORM-TIMES VERB. 
*         - PACTGEN, PCPXGEN, AND PENDGEN HANDLE BOTH THE PERFORM-UNTIL 
*           AND THE PERFORM-VARYING VERBS.
* 
*              NOTE THAT THE -THRU- CLAUSE IS TRANSPARENT TO ALL OF 
*         THESE PROCESSORS DUE TO THE STRUCTURE OF THE GTEXT. 
* 
  
  
 PERFGEN  EGO    1
          NOTE   PERFGEN
          IFZ    (SEGPROG,NE,0),PFM4   COMPILE AS SEGMENTED 
  
          MOVEZ  (LOCLAB,T1),T1    GET TEMP 
          MOVEZ  (LOCLAB,T2),T2    GET PLUG 
          MOVEZ  (PLOCALOF,BRREGC),T5  GET EXIT JUMP-ADR
  
          GEN    USE$,((USETB$OF,USEPRFM))
          GEN    LABEL$,LOCALA
          GEN    BSS$,,1
          GEN    USE$,((USETB$OF,USECODE))
          GEN    SLRBPK,(VREGOF,VREGA),,LOCALE  PERFORM EXIT ADDRESS
          GEN    SXBPK,(VREGOF,VREGB),,LOCALB   RETURN ADDRESS
          GEN    XMIT,(VREGOF,VREGC),VREGA
          GEN    SSRBPK,VREGC,,LOCALA           TEMP SAVE 
          GEN    SSRAPB,VREGB,VREGA 
          GEN    EQ$,,,PERFFWA
          GEN    LABEL$,LOCALB
          GEN    SLRBPK,(VREGOF,VREGA),LOCALA   RESTORE EXIT
          GEN    XMIT,(VREGOF,VREGB),VREGA
          GEN    SSRBPK,VREGB,,LOCALE 
          RETURN
  
 PERFORM  SPACE  4,8
**        CODE GENERATED IF SEGMENTATION: 
* 
*         SB3    EXIT        ADDRESS OF EXIT INDEX WORD 
*         SB4    TAG1        ADDRESS OF RETURN INDEX WORD 
*         RJ     =XC.PERF    GO STACK ENTRY AND PLANT RETURN
*         EQ     PERF-START  ENTER PERFORM RANGE
* 
* TAG1    RJ     =XC.SEGR    RETURN INDEX WORD
* -       VFD    12/OVLY-NO,18/TAG2 
* 
* TAG2    SB3    EXIT        ADDRESS OF EXIT INDEX WORD 
*         SB4    B0          ZERO MEANS POP STACK ENTRY 
*         RJ     =XC.PERF    GO POP LAST ENTRY AND RESTORE EXIT INDEX 
  
  
 PFM4     LABEL 
          NOTE   PERFGEN1 
          MOVEZ  (LOCLAB,T1),T1 
          MOVEZ  (LOCLAB,T2),T2 
  
          MOVEZ  (PSGEXTOF,BRREGC),T3 
          GEN    SBBPK,(VREGOF,VREGA),,((USEORG$F,USESGIX),T3)
          GEN    SBBPK,(VREGOF,VREGB),,LOCALA 
          GENOBJ N=C.PERFS,I=(VREGA,VREGB)
          GEN    EQ$,,,PERFFWA
  
          GEN    LABEL$,LOCALA                   DEFINE LOCAL LABEL 1 
          IFTHEN ((CCTBIT,SUBPROGR),EQ,0) 
            GEN    RJ$,((EXT$OF,C.SEGR))
          ELSEZ 
            GEN    RJ$,((EXT$OF,C.SEGS))
          ENDIFZ
          GEN    MINUS
          GEN    STARTSEQ,,(SEQUENCE,0) 
          GENVFD  (12,CUROVL),(18,LOCALB) 
  
          GEN    LABEL$,LOCALB                   DEFINE LOCAL LABEL 2 
          MOVEZ  (PSGEXTOF,BRREGC),T3 
          GEN    SBBPK,(VREGOF,VREGA),,((USEORG$F,USESGIX),T3)
          GEN    SBBPB,(VREGOF,VREGB),VREGB0
          GENOBJ  N=C.PERF,I=(VREGA,VREGB)
  
          RETURN
 PACTGEN  SPACE  4,8
**        PACTGEN - PROCESSOR FOR THE PERFORM-ACTIVATE GTEXT. 
* 
* 
*              THE PERFORM-ACTIVATE GTEXT IS IGNORED COMPLETELY.
  
  
 PACTGEN  EGO    1
          RETURN
 PCPXGEN  TITLE  PCPXGEN - PERFORM-COMPLEX GTEXT PROCESSING 
**        PCPXGEN - PROCESSOR FOR THE PERFORM-COMPLEX GTEXT.
* 
* 
*              NOTE THAT THERE IS ALWAYS A PERFORM-END GTEXT
*         ASSOCIATED WITH PERFORM-COMPLEX.  THESE HANDLE BOTH THE 
*         PERFORM-UNTIL AND THE PERFORM-VARYING VERBS.
* 
*         CODE GENERATED IF NO SEGMENTATION:  
* 
*         IF TRACE NOT ON-
* 
*         SAI    JUMP-ADR 
*         SAJ    B1+LOCALA   (PLUG) 
*         BXK    XI 
*         AXL    XJ,B0
*         SAK    LOCALA      (TEMP) 
*         SAL    AI 
*         EQ     LOCALC 
*LOCALA   BSS    1
*+        JP     RET-ADR
*LOCALC   BSS    0
* 
  
  
 PCPXGEN  EGO    1
          NOTE   PCPXGEN
          IFZ    (SEGPROG,NE,0),PCPX4  COMPILE AS SEGMENTED 
  
          MOVEZ  (LOCLAB,T1),T1 
          MOVEZ  (LOCLAB,T3),T3 
          MOVEZ  (PLOCALOF,BRREGC),T5  GET JUMP-ADR 
          GEN    USE$,((USETB$OF,USEPRFM))
          GEN    LABEL$,LOCALA
          GEN    BSS$,,1
          GEN    USE$,((USETB$OF,USECODE))
          GEN    SLRBPK,(VREGOF,VREGA),,LOCALE
          GEN    SXBPK,(VREGOF,VREGB),,PERFRET
          GEN    XMIT,(VREGOF,VREGC),VREGA
          GEN    SSRAPB,VREGB,VREGA 
          GEN    SSRBPK,VREGC,,LOCALA 
          PUSH   T1 
          RETURN
  
 PERFCPX  SPACE  4,8
**        CODE GENERATED IF SEGMENTATION: 
* 
*         SB3    EXIT        ADDRESS OF EXIT INDEX WORD 
*         SB4    TAG1        ADDRESS OF RETURN INDEX WORD 
*         RJ     =XC.PERF    GO STACK ENTRY AND PLANT RETURN
*         EQ     TAG2        CONTINUE 
* 
* TAG1    RJ     =XC.SEGR    RETURN INDEX WORD
* -       VFD    12/OVLY-NO,18/RET-ADR
* 
* TAG2    BSS    0
  
  
 PCPX4    LABEL 
          NOTE   PCPXGEN1 
          MOVEZ  (LOCLAB,T1),T1 
          MOVEZ  (LOCLAB,T2),T2 
  
          MOVEZ  (PSGEXTOF,BRREGC),T3 
          GEN    SBBPK,(VREGOF,VREGA),,((USEORG$F,USESGIX),T3)
          GEN    SBBPK,(VREGOF,VREGB),,LOCALA 
          GENOBJ N=C.PERFS,I=(VREGA,VREGB)
          GEN    EQ$,,,LOCALB 
  
          GEN    LABEL$,LOCALA                   DEFINE LOCAL LABEL 1 
          IFTHEN ((CCTBIT,SUBPROGR),EQ,0) 
            GEN    RJ$,((EXT$OF,C.SEGR))
          ELSEZ 
            GEN    RJ$,((EXT$OF,C.SEGS))
          ENDIFZ
          GEN    MINUS
          GEN    STARTSEQ,,(SEQUENCE,0) 
          GENVFD  (12,CUROVL),(18,PERFRET)
  
          GEN    LABEL$,LOCALB                   DEFINE LOCAL LABEL 2 
  
          RETURN
 PENDGEN  TITLE  PENDGEN - PERFORM-END GTEXT PROCESSING 
**        PENDGEN - PROCESSOR FOR THE PERFORM-END GTEXT.
* 
* 
*         CODE GENERATED IF NO SEGMENTATION:  
* 
*         IF NO TRACE 
* 
*         SAI    PERFRTN
*         BXJ    XI 
*         SAJ    JUMP-ADR 
* 
  
  
 PENDGEN  EGO    1
          NOTE   PENDGEN
          IFZ    (SEGPROG,NE,0),PEND4  COMPILE AS SEGMENTED 
  
          POP    T1 
          MOVEZ  (PLOCALOF,BRREGB),T5  GET JUMP-ADR 
  
          GEN    SLRBPK,(VREGOF,VREGA),,LOCALA
          GEN    XMIT,(VREGOF,VREGB),VREGA
          GEN    SSRBPK,VREGB,,LOCALE 
  
          RETURN
  
 PERFEND  SPACE  4,8
**        CODE GENERATED IF SEGMENTATION: 
* 
*         SB3    EXIT        ADDRESS OF EXIT INDEX WORD 
*         SB4    B0          ZERO MEANS POP STACK ENTRY 
*         RJ     =XC.PERF    GO POP LAST ENTRY AND RESTORE EXIT INDEX 
  
  
 PEND4    LABEL 
          NOTE   PENDGEN1 
  
          MOVEZ  (PSGEXTOF,BRREGB),T1 
          GEN    SBBPK,(VREGOF,VREGA),,((USEORG$F,USESGIX),T1)
          GEN    SBBPB,(VREGOF,VREGB),VREGB0
          GENOBJ  N=C.PERF,I=(VREGA,VREGB)
  
          RETURN
 PFTMGEN  TITLE  PFTMGEN - PERFORM-TIMES GTEXT PROCESSING 
**        PFTMGEN - PROCESSOR FOR THE PERFORM-TIMES GTEXT.
* 
  
  
 PFTMGEN  EGO    1
          NOTE   PFTMGEN
          MOVEZ  (EQUALS,FAKER),REGT
          CALLZ  ADNAT
          MOVEZ  (EQUALS,FAKER),REGC
          MOVEZ  (EQUALS,REG5),REGB 
          MOVEZ  (EQUALS,COMP1),(TYPEOF,REGC) 
          MOVEZ  14,(NUMLENOF,REGC) 
          MOVEZ  0,(POINTOF,REGC) 
          MOVEZ  1,(SIGNOF,REGC)
  
          CALLZ  CGMOVE                MOVE REGB_REG5 TO REGC_FAKER 
          NOTE   PFTRET1
  
          MOVEZ  (EQUALS,REG2),REGB    RESTORE GTEXT ATOM POINTERS
          MOVEZ  (EQUALS,REG3),REGC 
          GEN    SXBPK,(VREGOF,VREGD),VREGB1,0
          GEN    ISUB,(VREGOF,VREGC),(TREGOF,FAKER),VREGD 
          CALLZ  SUBDNAT     RETURN TEMPORARY DNAT
          MOVEZ  0,P1                  CREATE REG TABLE ENTRY TO POINT
          MOVEZ  (EQUALS,FAKER),P2      TO THE NEXT DNAT CREATED FOR
          EXECUTE  CGREGMV               USE BY PERFORM-TIMES 
          MOVEZ  (EQUALS,GDATAREF),(GCODEOF,FAKER)
          ADDZ   (CCTWORD,PERFTIME),PFTPTR,T1 
          MOVEZ  T1,(GPTROF,FAKER)
          ADDZ   PFTPTR,1,PFTPTR
          IFZ    (SEGPROG,NE,0),PFTM6  COMPILE AS SEGMENTED 
          MOVEZ  (LOCLAB,T4),T4        GET LOCAL LABEL 4
  
          GEN    NG$,VREGC,LOCALD 
          GEN    SSRBPK,VREGC,,((FWA$OF,FAKER)) 
  
          MOVEZ  (LOCLAB,T1),T1        GET LOCAL LABEL 1
          MOVEZ  (PLOCALOF,BRREGC),T5  GET LOCAL LABEL 5
  
          MOVEZ  (LOCLAB,T2),T2    GET LOCAL LABEL 2
          GEN    USE$,((USETB$OF,USEPRFM))
          GEN    LABEL$,LOCALB
          GEN    BSS$,,1
          GEN    USE$,((USETB$OF,USECODE))
          GEN    SLRBPK,(VREGOF,VREGA),,LOCALE
          GEN    SXBPK,(VREGOF,VREGB),,LOCALA 
          GEN    XMIT,(VREGOF,VREGC),VREGA
          GEN    SSRAPB,VREGB,VREGA 
          GEN    SSRBPK,VREGC,,LOCALB 
  
          GEN    LABEL$,LOCALA         DEFINE LOCAL LABEL 1 
  
          MOVEZ  (LOCLAB,T3),T3        GET LOCAL LABEL 3
  
          GEN    SLRBPK,(VREGOF,VREGA),,((FWA$OF,FAKER))
          GEN    NG$,VREGA,LOCALC 
          GEN    SXBPK,(VREGOF,VREGD),VREGB1,0
          GEN    ISUB,(VREGOF,VREGB),VREGA,VREGD
          GEN    SSRAPB,VREGB,VREGA 
          GEN    EQ$,,,PERFFWA
  
  
          GEN    LABEL$,LOCALC     DEFINE LOCAL LABEL C 
          GEN    SLRBPK,(VREGOF,VREGD),,LOCALB
          GEN    XMIT,(VREGOF,VREGB),VREGD
          GEN    SSRBPK,VREGB,,LOCALE 
          GEN    LABEL$,LOCALD         DEFINE LOCAL LABEL 4 
  
          RETURN
 PERFTM   SPACE  4,8
**        CODE GENERATED IF SEGMENTATION: 
* 
*         (GMOVE CODE TO PUT VALUE OF COUNT IN XI)
* 
*         SXJ    XI-1 
*         NG     XJ,TAG4     SKIP PERFORM ENTIRELY IF INITIAL COUNT = 0 
*         SAJ    COUNT       STORE COUNT
*         SB3    EXIT        ADDRESS OF EXIT INDEX WORD 
*         SB4    TAG2        ADDRESS OF RETURN INDEX WORD 
*         RJ     =XC.PERF    GO STACK ENTRY AND PLANT RETURN
* 
* TAG1    SAK    COUNT
*         NG     XK,TAG3     IF DESIGNATED NO. OF TIMES COMPLETED 
*         SXL    XK-1        DECREMENT COUNT
*         SAL    AK          STORE
*         EQ     PERF-START  ENTER PERFORM RANGE
* 
* TAG2    RJ     =XC.SEGR    RETURN INDEX WORD
* -       VFD    12/OVL-NO,18/TAG1
* 
* TAG3    SB3    EXIT        ADDRESS OF EXIT INDEX WORD 
*         SB4    B0          ZERO MEANS POP STACK ENTRY 
*         RJ     =XC.PERF    GO POP LAST ENTRY AND RESTORE EXIT INDEX 
* 
* TAG4    BSS    0
  
  
 PFTM6    LABEL 
          NOTE   SGPERFTM 
          MOVEZ  (LOCLAB,T1),T1                  GET LOCAL LABEL 1
          MOVEZ  (LOCLAB,T2),T2                  GET LOCAL LABEL 2
          MOVEZ  (LOCLAB,T3),T3                  GET LOCAL LABEL 3
          MOVEZ  (LOCLAB,T4),T4                  GET LOCAL LABEL 4
  
          GEN    NG$,VREGC,LOCALD 
          GEN    SSRBPK,VREGC,,((FWA$OF,FAKER)) 
          MOVEZ  (PSGEXTOF,BRREGC),T5 
          GEN    SBBPK,(VREGOF,VREGA),,((USEORG$F,USESGIX),T5)
          GEN    SBBPK,(VREGOF,VREGB),,LOCALB 
          GENOBJ N=C.PERFS,I=(VREGA,VREGB)
  
          GEN    LABEL$,LOCALA                   LOCAL LABEL 1
          GEN    SLRBPK,(VREGOF,VREGA),,((FWA$OF,FAKER))
          GEN    NG$,VREGA,LOCALC                DECREMENT TIMES COUNT
          GEN    SXBPK,(VREGOF,VREGD),VREGB1,0
          GEN    ISUB,(VREGOF,VREGB),VREGA,VREGD
          GEN    SSRAPB,VREGB,VREGA 
          GEN    EQ$,,,PERFFWA                   ENTER RANGE
  
          GEN    LABEL$,LOCALB                   LOCAL LABEL 2
          IFTHEN ((CCTBIT,SUBPROGR),EQ,0) 
            GEN    RJ$,((EXT$OF,C.SEGR))
          ELSEZ 
            GEN    RJ$,((EXT$OF,C.SEGS))
          ENDIFZ
          GEN    MINUS
          GEN    STARTSEQ,,(SEQUENCE,0) 
          GENVFD  (12,CUROVL),(18,LOCALA) 
  
          GEN    LABEL$,LOCALC                   LOCAL LABEL 3
          MOVEZ  (PSGEXTOF,BRREGC),T5 
          GEN    SBBPK,(VREGOF,VREGA),,((USEORG$F,USESGIX),T5)
          GEN    SBBPB,(VREGOF,VREGB),VREGB0
          GENOBJ  N=C.PERF,I=(VREGA,VREGB)
  
          GEN    LABEL$,LOCALD                   LOCAL LABEL 4
  
          RETURN
 PROCGEN  TITLE  PROCGEN - PROCEDURE DEFINITION                         115000
**        PROCGEN - PROCESSOR FOR THE PROCEDURE-DEFINITION GTEXT. 
* 
* 
*              THIS PROCESSOR IS CALLED AT THE POINT WHERE EACH 
*         PARAGRAPH/SECTION NAME IS TO BE DEFINED.  IT HAS SEVERAL
*         ITEMS TO DEAL WITH, AS FOLLOWS: 
* 
  
 PROCGEN  EGO    1
          NOTE   PROCGEN
  
**        1) FOR ALL CASES - CHECKS IF THE PARAGRAPH/SECTION JUST 
*            CONCLUDED IS THE END OF ANY PERFORM RANGE, AND, IF SO, 
*            GENERATES A JUMP TO THIS PROCEDURE NAME.  IN THE NON-
*            SEGMENTED CASE, THIS WORD GETS MODIFIED DURING THE 
*            EXECUTION OF ANY SUCH PERFORM. 
* 
*            * +     EQ    PROC-NAME     * ONLY IF END OF PERFORM RANGE 
* 
  
          MOVEZ  0,EPJUMP              SET FOR JUMP NOT NEEDED
          IFTHEN  ((PKINDOF,BRREGA),EQ,0) 
            CALLZ  CKP
            MOVEZ  (GPTROF,BRREGA),PLSTPARA 
          ELSEZ 
            CALLZ  CKSP 
            MOVEZ  (GPTROF,BRREGA),PLSTSECT 
            MOVEZ  0,PLSTPARA 
          ENDIFZ
          IFZ    (EPJUMP,EQ,0),PRC10   IF NOT END OF PERFORM RANGE
          IFTHEN (SEGPROG,EQ,0) 
  
          GEN    USE$,((USETB$OF,USEPRFM))
          GENVFD (60,PROCLOC) 
          GEN    USE$,((USETB$OF,USECODE))
          GEN    SLRBPK,(VREGOF,VREGA),,LOCALA
          GEN    SBXPB,(VREGOF,VREGB),VREGA 
          GEN    JP$,VREGB,0
          GEN    STARTSEQ,,(SEQUENCE,0) 
  
          ELSEZ 
  
            MOVEZ  (PSGEXTOF,REGU1),T1
            GEN    EQ$,,,((USEORG$F,USESGIX),T1)
            GEN  PLUS 
  
          ENDIFZ
  
 PRC10    LABEL 
          IFZ    (SEGPROG,EQ,0),PRC30  COMPILE AS UNSEGMENTED 
  
**        2) IF THIS IS A SECTION HEADER, A JUMP IS GENERATED TO THE
*            NEXT SECTION TO BE EXECUTED AFTER THE PREVIOUS SECTION.
*            (I.E., IT IS NOT NECESSARILY TO THIS ONE, SINCE THE
*            SECTIONS DO NOT HAVE TO BE IN ORDER IN THE PROGRAM.) 
* 
  
          NOTE   SEGPROC
          IFTHEN  ((PKINDOF,BRREGA),EQ,1) 
          ANDIF  ((CCTBIT,SUBPROGR),EQ,0) 
            MOVEZ  0,P1 
            MOVEZ  REGU1,P2 
            EXECUTE  CGREGMV
            MOVEZ  GPROCREF,(GCODEOF,REGU1) 
            MOVEZ  NXTSECT,(GPTROF,REGU1) 
  
            IFZ    ((PSEGNOOF,REGU1),EQ,100),PRC12
            GEN  EQ$,,,((FWA$OF,REGU1)) 
 PRC12    LABEL 
  
            MOVEZ  (PNXSECOF,BRREGA),NXTSECT
  
          ENDIFZ
  
**        3) IF SEGMENTATION - THE OVERLAY NUMBER FOR THIS SECTION IS 
*            COMPUTED AS -
* 
*                MAX [[(SECTION NUMBER) - (SEGMENT LIMIT) + 1], 0]
* 
*            IF THIS REPRESENTS A HIGHER NON-PERMANENT SEGMENT
*            THAN THE CURRENT ONE, THE STATEMENTS 
*            TO CAUSE A NEW OVERLAY TO BE STARTED ARE GENERATED.
*            OVERLAY LEVELS ARE CHOSEN AS FOLLOWS:  
* 
*                A) (OVERLAY NUMBER) < 77B  L1 = (OVERLAY NUMBER) 
*                                           L2 = 0
* 
*                B) (OVERLAY NUMBER) \ 77B  L1 = 77B
*                                           L2 = (OVERLAY NUMBER) - 76B 
* 
*            ALSO, WITH THE FIRST OCCURRENCE OF (B), A DUMMY (77,0) 
*            OVERLAY IS CREATED.
* 
*            *       EQ    PROC-NAME
*            *
*            *       END                    TERMINATE LAST OVERLAY
*            *
*            *       LCC   OVERLAY(77,0)    * IF NEXT OVERLAY IS
*            *       IDENT                  *  THE FIRST ONE
*            *       VFD   60/0             *   WITH L1 = 77B 
*            *       END                    * 
*            *
*            *       LCC   OVERLAY(L1,L2)   START NEW OVERLAY 
*            *       IDENT
*            *       USE   SGJMP            SET BLOCK FOR XFER VECTORS
*            *       USE   CODE             RESET TO CODE BLOCK 
* 
  
          IFZ    ((PSEGNOOF,BRREGA),EQ,100),RETURN
          IFZ    ((CCTBIT,SUBPROGR),NE,0),PRC20  #SUBCOMPILE           #
          SUBZ   (PSEGNOOF,BRREGA),(CCTWORD,SEGLIMIT),T9
          ADDZ   T9,1,T9
          IFTHEN  (T9,LT,0) 
            MOVEZ  0,GBR1 
          ELSEZ 
            MOVEZ  T9,GBR1
          ENDIFZ
          IFZ    (GBR1,EQ,0),PRC20               IF PART OF PERM SEG
          IFZ    (GBR1,EQ,CUROVL),PRC20          IF SAME SEG AS LAST
          ADDZ   (CCTWORD,OVCOUNT),1,(CCTWORD,OVCOUNT)   UP OVLY COUNT
          EXECUTE  FLUSHPL                       FLUSH POOLED LITERALS
          IFTHEN  (CUROVL,EQ,0)        END CARD FOR PERM. SEGMENT 
            MOVEZ  0,P1                XFER IS ENTRY ADR OF PROGRAM 
            MOVEZ  (EQUALS,REGU1),P2
            EXECUTE  CGREGMV
            MOVEZ  (EQUALS,GPROCREF),(GCODEOF,REGU1)
            MOVEZ  FSTLABEL,(GPTROF,REGU1)
  
            GEN  END$,((FWASG$OF,REGU1))
            GEN    STARTSEQ,,(SEQUENCE,0) 
  
          ELSEZ                        END CARD FOR REMAINING SEGMENTS
            MOVEZ  FSTLABEL,T1         XFER IS ADR OF XFER VECTOR TABLE 
  
            GEN  END$,LOCALA
            GEN    STARTSEQ,,(SEQUENCE,0) 
  
          ENDIFZ
          EXECUTE  FLUSHOT             FLUSH OUT OTEXT
          MOVEZ  GBR1,T2
          MOVEZ  0,T3 
          IFTHEN  (GBR1,GE,77B) 
            MOVEZ  77B,T2 
            SUBZ  GBR1,76B,T3 
          ENDIFZ
          LSHIFT  T2,9
          ADDZ   T2,T3,GBR2 
  
          IFTHEN  (T2,EQ,DUMOVL)
           ANDIF  (CUROVL,LT,77B) 
            MOVEZ  (LOCLAB,T1),T1 
  
            GEN  OVLY,,T2 
            GEN  IDENT$,,100
          GEN    STARTSEQ,,(SEQUENCE,0) 
            GEN  USE$,((USETB$OF,USECODE))
            GEN  LABEL$,LOCALA
            GEN    STARTSEQ,,(SEQUENCE,0) 
            GENVFD  (60,0)
            GEN  END$,LOCALA
            GEN    STARTSEQ,,(SEQUENCE,0) 
  
            EXECUTE  FLUSHOT
          ENDIFZ
          MOVEZ  (LOCLAB,T1),FSTLABEL 
  
          GEN    OVLY,,GBR2 
          GEN    IDENT$,,GBR1 
          GEN    STARTSEQ,,(SEQUENCE,0) 
          GEN    USE$,((USETB$OF,USESGJMP)) 
          GEN    LABEL$,LOCALA         DEFINE LABEL FOR XFER VECTOR TBL 
          GEN    USE$,((USETB$OF,USECODE))
  
          MOVEZ  GBR1,CUROVL
  
  
 PRC20    LABEL 
  
**        5) IF SEGMENTATION - IF AN ENTRY INDEX IS DEFINED FOR THE 
*            PROCEDURE, THE TRANSFER VECTOR IS GENERATED. 
* 
*            *       USE   SGJMP         SET TO BLOCK FOR XFER VECTORS
*            *       EQ    DEST          JUMP TO WITHIN SEGMENT 
*            *       USE   CODE          RESET TO CODE BLOCK
* 
  
          IFTHEN  ((PSGENTOF,BRREGA),NE,0)
           ANDIF  (CUROVL,NE,0) 
            ANDIF  ((CCTBIT,SUBPROGR),EQ,0) 
  
            GEN  USE$,((USETB$OF,USESGJMP))      GEN. XFER VECTOR 
            GEN  PLUS 
            GEN  EQ$,,,((FWASG$OF,BRREGA))
            GEN  USE$,((USETB$OF,USECODE))
  
          ENDIFZ
  
**        6) FOR ALL CASES - THE PROCEDURE IS DEFINED.
* 
*            * PROC  BSS   0
  
 PRC30    LABEL 
  
          GEN    LABEL$,((FWASG$OF,BRREGA)) 
          GEN    STARTSEQ,,(SEQUENCE,0) 
*    GENERATE DROP THRU AT END OF USER PROGRAM
          IFTHEN  ((GPTROF,BRREGA),EQ,(CCTWORD,RPSECTNA)) 
          ANDIF  ((CCTBIT,SUBPROGR),EQ,0) 
            GEN    MASK,(VREGOF,VREG2)
            GEN    SXBPK,(VREGOF,VREG1),,ABTMSG 
            GEN    MASK,(VREGOF,VREG3)
            GEN    SXBPB,(VREGOF,VREG4),,VREGB1 
            GENOBJ N=C.MSG,I=(VREG1,VREG2,VREG3,VREG4)
          ENDIFZ
*    NO TRACE ON COMPILER GENERATED PARAGRAPHS
          IFZ    ((GPTROF,BRREGA),GE,(CCTWORD,RPSECTNA)),RETURN 
  
*    STYLIZED CODE FOR PARAGRAPH NAMES FOR CID
          IFTHEN ((CCTBIT,IDBUG),NE,0)
            MOVEZ  (PARNAM0,BRREGA),T1
            IFZ    (P1,EQ,0),PRC40 JUMP IF COMPILER GENERATED PARAGRAPH 
          MOVEZ  P4,CURRLINE
          MOVEZ  CURRLINE,LSTLNUM 
          GEN    LINE,,CURRLINE 
          GEN    PLUS 
          GEN    SABPK,(VREGOF,VREG1),,CURRLINE 
          GEN    RSTOR,VREG1,A0 
          GEN    MINUS
          GEN    RJ$,((EXT$OF,DBUG.LN)) 
          GEN    RFREE,VREG1
              MOVEZ  (LOCLAB,T2),T2 
              GEN    USE$,((USETB$OF,USEIDBG))
              GEN    LABEL$,((LOCAL$OF,T2)) 
              GENVFD (60,P1)
              GENVFD (60,P2)
              GENVFD (60,P3)
              GEN    USE$,((USETB$OF,USECODE))
              GEN    PLUS 
              GEN    SLRBPK,(VREGOF,VREGA),,((LOCAL$OF,T2)) 
              GEN    RSTOR,VREGA,A1 
              GEN    MINUS
              GEN    RJ$,((EXT$OF,DBUG.PR)) 
              GEN    RFREE,VREGA
 PRC40      LABEL 
          ENDIFZ
  
          IFTHEN  ((PKINDOF,BRREGA),EQ,1) 
            RETURN
          ENDIFZ
          IFTHEN ((CCTBIT,TRACE),EQ,0)
            RETURN                               RTN IF NO PARA TRACE 
          ENDIFZ
  
*      OUTPUT PARAGRAPH TRACE CODE - IT IS SELECTED 
  
          GENOBJ  N=C.TRACE                      CALL TO TRACE
          MOVEZ  (PARANAM,BRREGA),T1
          GEN    STARTSEQ,,(SEQUENCE,0) 
          GENVFD (60,P1)     FIRST 10 CHARS OF NAME 
          GENVFD (60,P2)     SECOND 10 CHARS
          GENVFD (60,P3)     THIRD 10 CHARS 
  
          RETURN
 CKSP     TITLE  PROCGEN - PROCEDURE DEFINITION (SUBROUTINES) 
**        CKSP - CHECK PREVIOUS SECTION AND PARAGRAPH.
* 
* 
*              THIS IS A SUBROUTINE OF *PROCGEN* WHICH CHECKS FOR END OF
*         PERFORM RANGE ON BOTH THE PREVIOUS SECTION AND PREVIOUS 
*         PARAGRAPH.  IF SO, IT DOES THE FOLLOWING: 
* 
*         1) IN ALL CASES, SETS EPJUMP TO SO INDICATE.
* 
*         2) IF PROGRAM IS NOT SEGMENTED, DEFINES THE LABEL WHICH WAS 
*            STORED IN THE PNAT OF THE PREVIOUS SECTION/PARAGRAPH FOR 
*            THIS PURPOSE.
* 
*         ENTRY  (PLSTSECT) = POINTER TO PREVIOUS SECTION.
*                (PLSTPARA) = POINTER TO PREVIOUS PARAGRAPH.
* 
*         EXIT   (EPJUMP) = 1 IF AT END OF PERFORM RANGE. 
* 
*         USES   T1, P1, P2, REGU1. 
* 
*         CALLS  CKP. 
  
  
 CKSP     EGO    2
          IFZ    (PLSTSECT,EQ,0),CKSP1           IF NO PREVIOUS SECTION 
          MOVEZ  0,P1 
          MOVEZ  (EQUALS,REGU1),P2
          EXECUTE  CGREGMV
          MOVEZ  (EQUALS,GPROCREF),(GCODEOF,REGU1)
          MOVEZ  PLSTSECT,(GPTROF,REGU1)
          IFZ    ((PPERFEOF,REGU1),EQ,0),CKSP1   IF NOT END OF RANGE
          NOTE   CKSP 
          MOVEZ  1,EPJUMP                        SET JUMP NEEDED FLAG 
          IFTHEN (SEGPROG,EQ,0)        COMPILE AS UNSEGMENTED 
            MOVEZ  (PLOCALOF,REGU1),T1           LOC LABEL NO. TO *T1*
  
          GEN    USE$,((USETB$OF,USEPRFM))
            GEN  LABEL$,LOCALA                   DEFINE LOCAL LABEL 
          GEN    USE$,((USETB$OF,USECODE))
  
          ENDIFZ
  
 CKSP1    LABEL 
  
          IFTHEN (SEGPROG,NE,0)        COMPILE AS SEGMENTED 
           ANDIF  (EPJUMP,NE,0) 
            RETURN
          ENDIFZ
  
          CALLZ  CKP         CHECK PREVIOUS PARAGRAPH 
          RETURN
 CKP      SPACE  4,8
**        CKP - CHECK PREVIOUS PARAGRAPH. 
* 
* 
*              THIS IS A SUBROUTINE OF *PROCGEN* SIMILAR TO *CKSP*, 
*         EXCEPT THAT IT CHECKS PREVIOUS PARAGRAPH ONLY.
* 
*         ENTRY  (PLSTPARA) = POINTER TO PREVIOUS PARAGRAPH.
* 
*         EXIT   (EPJUMP) = 1 IF AT END OF PERFORM RANGE. 
* 
*         USES   T1, P1, P2, REGU1. 
  
  
 CKP      EGO    2
          IFZ    (PLSTPARA,EQ,0),CKP1            IF NOT TO CHECK PREV PG
          MOVEZ  0,P1 
          MOVEZ  (EQUALS,REGU1),P2
          EXECUTE  CGREGMV
          MOVEZ  (EQUALS,GPROCREF),(GCODEOF,REGU1)
          MOVEZ  PLSTPARA,(GPTROF,REGU1)
          IFZ    ((PPERFEOF,REGU1),EQ,0),CKP1    IF NOT END OF RANGE
          NOTE   CKP
          MOVEZ  1,EPJUMP                        SET JUMP NEEDED FLAG 
          IFTHEN (SEGPROG,EQ,0)        COMPILE AS UNSEGMENTED 
            MOVEZ  (PLOCALOF,REGU1),T1           LOC LABEL NO. TO *T1*
  
          GEN    USE$,((USETB$OF,USEPRFM))
            GEN  LABEL$,LOCALA                   DEFINE LOCAL LABEL 
          GEN    USE$,((USETB$OF,USECODE))
  
          ENDIFZ
  
 CKP1     LABEL 
          RETURN
 INITGEN  EJECT 
**        INITGEN - GENERATES CALL TO C.INIT
* 
 INITGEN  EGO    2
*      GENERATE CONTROL CARD PARAMETERS 
          MOVEZ  0,T1 
          IFTHEN ((CCTBIT,MAINSUB),NE,0)
            ADDZ   T1,##MSBV,T1 
          ENDIFZ
          IFTHEN ((CCTBIT,LBZ),NE,0)
            ADDZ   T1,##LBZV,T1 
          ENDIFZ
          IFTHEN ((CCTBIT,AUDIT),NE,0)
            ADDZ   T1,##AUDITV,T1 
          ENDIFZ
          IFTHEN (T1,EQ,0)
            GEN    MASK,(VREGOF,VREGA),0
          ELSEZ 
            GEN    SXBPK,(VREGOF,VREGA),T1
            GEN    SHL,VREGA,43                  POSITION TO TOP
          ENDIFZ
******
******    NOTE - BINARY LEVEL FLAG
******
*         WHEN MAKING CHANGES TO OBJECT ROUTINES WHICH COULD CAUSE
*         OLD BINARIES TO NO LONGER WORK, THE FOLLOWING PROCEDURE SHOULD
*         BE FOLLOWED:  THE LOW ORDER 18 BITS OF REGISTER X1 (VREGA)
*         WILL BE STORED IN OBJECT LOCATION C.BINRY.  FOR VERY OLD
*         BINARIES (LEVEL 446, 452 OR 460) C.BINRY WILL BE ZERO (NO 
*         STORE DONE).  EACH TIME AN OBJECT ROUTINE CALLING SEQUENCE IS 
*         CHANGED, THE EQUATE BINRYLV SHOULD BE INCREMENTED BY 1.  THEN 
*         AT OBJECT TIME C.BINRY CAN BE CHECKED TO DETERMINE WHETHER A
*         BINARY PREDATES THE CHANGE AND THUS WHICH CALLING SEQUENCE WAS
*         GENERATED 
******
          GEN    SXBPK,(VREGOF,VREGB),,BINRYLV
          GEN    LOR,(VREGOF,VREGA),VREGA,VREGB  OR IN BINARY LEVEL 
*      SAVE PROGRAM ID AND PASS ADDR AS PARAMETER 
          MOVEZ  REGU1,REGT 
          CALLZ  ADPDNAT                         MAKE A PERMANENT DNAT
          MOVEZ  0,(BCPOF,REGT) 
          MOVEZ  30,(BYTLENOF,REGT) 
          MOVEZ  0,P1 
          MOVEZ  (CCTWORD,PROGRI0),P2            ;MOVE PROG ID TO PARAMS
          MOVEZ  (CCTWORD,PROGRI1),P3 
          MOVEZ  (CCTWORD,PROGRI2),P4 
          EXECUTE LITPOOL          POOL THE PROG ID 
          GEN    SBBPK,(VREGOF,VREGB),,((FWA$OF,REGT))
*       LOAD NAME OF LIBRARY WHICH CONTAINS COBOL5 FOR INITIALIZATION 
          MOVEZ  REGU2,REGT 
          CALLZ  ADPDNAT
          MOVEZ  0,(BCPOF,REGT) 
          MOVEZ  10,(BYTLENOF,REGT) 
          MOVEZ  0,P1 
          MOVEZ  (IMPNMOF,P1),P2                 GET LIBRARY NAME 
          EXECUTE  LITPOOL                       POOL IT
          GEN    SLRBPK,(VREGOF,VREGC),0,((FWA$OF,REGT))  GET LIB NAME
*      LOAD DATE TO PASS AS PARAMETER FOR C.DTCMP 
          MOVEZ  REGU3,REGT 
          CALLZ  ADPDNAT     ADD DNAT 
          MOVEZ  0,(BCPOF,REGT) 
          MOVEZ  10,(BYTLENOF,REGT) 
          MOVEZ  (CCTWORD,DATE),P2               CURRENT DATE 
          EXECUTE  LITPOOL                       POOL THE DATE
          GEN    SLRBPK,(VREGOF,VREGD),0,((FWA$OF,REGT))
*      GENERATE CALL TO C.INIT
          GENOBJ  N=C.INIT,I=(VREGA,VREGC,VREGB,VREGD)
          IFTHEN ((CCTBIT,TDF),EQ,1)
            GEN    SBBPK,(VREGOF,VREGA),,((FWA$OF,BRREGB))
            GEN    SBBPK,(VREGOF,VREGB),,((FWA$OF,REGU1))   AD OF ID
            GENOBJ  N=C.ITDMP,I=(VREGA,VREGB)    INITIALIZE TERM DMP
          ENDIFZ
          RETURN
 STOPGEN  TITLE  STOPGEN - STOP STATEMENT 
**        STOPGEN - PROCESSOR FOR THE STOP GTEXT. 
* 
* 
*         CODE GENERATED FOR STOP RUN:  
* 
* +       RJ     =XC.CLOSF   CLOSE COBOL FILES
 CDCS     IFNE   OP.DCS,OP.NO 
*      +  RJ     =XC.DMEND  IF PROGRAM INTERFACES WITH CDCS 
*      -  PS     LINE NUMBER
 CDCS     ENDIF 
* +       RJ     =XC.STOPR   TERMINATE RUN
* 
*         CODE GENERATED FOR STOP (LITERAL):  
* 
*                            IF POSSIBLE RERUN ON SWITCH SETTING
*         SAI    0
*         SXJ    SWITCH BITS
*         AXI    6
*         BXK    XI*XJ
*         ZR     XK,TAG 
*         RJ     =XC.RERUN
*  TAG    BSS    0
* 
*         SB3    LIT-FWA     INDICATE STOP LITERALL 
*         SB4    LENGTH      LENGTH OF LITERAL
* +       RJ     =XC.STOPL   DISPLAY LITERAL AND WAIT 
  
  
 STOPGEN  EGO    1
          IFZ    ((GCODEOF,BRREGB),NE,GSUBVERB),STOPLGEN
  
*      STOP RUN 
  
          NOTE   STOPGEN
 CDCS     IFNE   OP.DCS,OP.NO 
  
*      IF CDCS INTERFACE - CALL ROUTINE TO TERMINATE
  
          IFTHEN ((CCTWORD,DBFSCTXT),NE,0)
            GENOBJ N=C.DMEND
          ENDIFZ
 CDCS     ENDIF 
  
          GENOBJ N=C.STOPR
          RETURN
          SPACE  4
*      STOP LITERAL 
  
 STOPLGEN LABEL 
          NOTE   STOPLGEN 
          MOVEZ  (CCTWORD,RERUNCON),T1
          IFTHEN  (T1,NE,0)     IF RERUN SPECIFIED
          GEN    SLRBPB,(VREGOF,VREGA),,     SAI  0 
          GEN    SXBPK,(VREGOF,VREGB),,T1     SXJ  SWITCH BITS
          GEN    SHR,VREGA,6     AXI  6 
          GEN    LAND,(VREGOF,VREGC),VREGA,VREGB     BXK  XI*XJ 
          MOVEZ  (LOCLAB,T1),T1     ALLOCATE LABEL
          GEN    ZR$,VREGC,LOCALA     ZR  XK,TAG
          GENOBJ  N=C.RERUN     RJ  =XC.RERUN 
          GEN    LABEL$,LOCALA     TAG  BSS  0
          ENDIFZ
          GEN    SBBPK,(VREGOF,VREGA),,((FWA$OF,BRREGB))
          GEN    SBBPK,(VREGOF,VREGB),,(BYTLENOF,BRREGB)
          GENOBJ N=C.STOPL,I=(VREGA,VREGB)
          RETURN
                                                                        129000
          END                                                           130000
