*DECK GIO 
          IDENT  GIO
          SST 
          TITLE  GIO - GENERATE INPUT-OUTPUT
  
          MACHINE  ANY,I
          SST 
          COMMENT  INPUT-OUTPUT PROCESSOR 
          SPACE  4
**        GIO -  INPUT OUTPUT PROCESSOR 
* 
*         CONTAINS: 
*                CGACCEP   - ACCEPT 
*                CGATEND   - AT END 
*                CGCLOSE   - CLOSE
*                CGCLOSR   - CLOSE ... REEL 
*                CGDELET   - DELETE 
*                CGDISPL   - DISPLAY
*                CGIOSUC   - IO SUCCESS 
*                CGINVKE   - INVALID KEY
*                CGMOVRC   READ INTO MOVE RECORD
*                CGOPEN    - OPEN 
*                CGREADK   - READ WITH KEY
*                CGREADN   - READ SEQUENTIAL
*                CGREADS   - READ START 
*                CGREWRI   - REWRITE
*                CGSTAR    - START
*                CGWRITE   - WRITE
*                CGWRITK   - WRITE WITH KEY 
*                SETMNNM   - GENERATE MNEMONIC NAME CODE
*                SETPARS   - SET UP PARAMETERS FOR ACCEPT/DISPLAY 
  
  
  
  
  
 CONTROL  OPSYN  NIL
  
  
  
  
*CALL FNATVALS
  
  
*CALL CCT 
*CALL IOMICROS
          EJECT 
          TITLE  IO MAIN CONTROL
 GIO      MODULE
  
*      REGTABLE EQUATES 
  
  
 IOREGA   EQU    REGA 
 IOREGB   EQU    REGB 
 IOREGC   EQU    REGC 
 IOREGD   EQU    REGD 
 IOREGE   EQU    REGE 
 IOREGF   EQU    REGF 
 IOREGT   EQU    REGT5
 IOREGX   EQU    REGT7
 IOREGY   EQU    REGT8
 MOVEREGA EQU    REGB 
 MOVEREGB EQU    REGC 
 MOVEREGM EQU    REGM 
  
*      VIRTUAL REGISTER EQUATES 
  
 IOVREGA  EQU    VREG1
 IOVREGB  EQU    VREG2
 IOVREGC  EQU    VREG3
 IOVREGD  EQU    VREG5
 IOVREGE  EQU    VREG6
 IOVREGF  EQU    VREG7
 IOVREGG  EQU    VREG8
 IOVREGX  EQU    VREG4       USED FOR  SETBREG
 SBXPKVR  EQU    VREG16 
 IOVREGY  EQU    VREG18      FOR SETXREG
  
*      FIXED TABLE EQUATES
  
  
*      ERROR EQUATES
  
 IOERR1   EQU    1801        BAD FROM SUBCODE IN ACCEPT 
 IOERR2   EQU    1802        BAD REWIND OPTION SUB CODE IN CLOSE
 IOERR3   EQU    1803        BAD REWIND OPTION IN OPEN
 IOERR4   EQU    1804        BAD OPEN OPTION (INPUT - OUTPUT- IO) 
 IOERR5   EQU    1805        BAD AT END OR INV KEY SUB CODE 
 IOERR6   EQU    1806        BAD FILE ORG 
 IOERR7   EQU    1807        KEY RELATION IS START IS WRONG 
 IOERR8   EQU    1808        BAD FILE ORGANIZATION
 IOERR9   EQU    1809        WRITE ADVANCING SYS-NAME IS NOT PAGE 
 IOERR10  EQU    1810        BAD NO ADVANCING OPTION IN DISPLAY 
  
*      MISCELLANEOUS EQUATES
  
 IOB0     EQU    R0          B0 HARDWARE REGISTER 
 IOB1     EQU    R1          B1 = 1 HDW REGISTER
  
*      LINKAGE FROM CALLING ROUTINES IN OTHER MODULES 
  
 CGACCEP  KNIL   CGACCEP
 CGATEND  KNIL   CGATEND
 CGCLOSE  KNIL   CGCLOSE
 CGCLOSR  KNIL   CGCLOSR
 CGDELET  KNIL   CGDELET
 CGDISPL  KNIL   CGDISPL
 CGEOP    KNIL   CGEOP
 CGINVKE  KNIL   CGINVKE
 CGIOSUC  KNIL   CGIOSUC
 CGMOVRC  KNIL   CGMOVRC
 CGOPEN   KNIL   CGOPEN 
 CGREADK  KNIL   CGREADK
 CGREADN  KNIL   CGREADN
 CGREADS  KNIL   CGREADS
 CGREWRI  KNIL   CGREWRI
 CGSTAR   KNIL   CGSTAR 
 CGWRITE  KNIL   CGWRITE
 CGWRITK  KNIL   CGWRITK
*      LINKAGE FROM SORT GENERATOR
 GSOPENI  KNIL   GSOPENI
 GSCLOSE  KNIL   GSCLOSE
 GSOPENO  KNIL   GSOPENO
 GSREADN  KNIL   GSREADN
 GSWRITE  KNIL   GSWRITE
 MVTOXRG  KNIL   MVTOXRG
 STORERL  KNIL   STORERL
 SA0FIT   KNIL   SA0FIT 
  
*      LINKAGE TO CALLED ROUTINES IN OTHER MODULES
  
 REGMOVE  EXECUTE  CGREGMV
          RETURN
 CLITPOOL EXECUTE  LITPOOL
          RETURN
 ADNAT    LINK   ADNAT
 ADPDNAT  LINK   ADPDNAT
 CGGTSZV  LINK   CGGTSZV     GET VARIABLE GROUP SIZE
 GMOVER   LINK   CGMOVE 
 SETBREG  LINK   CGSETB4
 SETBXPK  LINK   CGSBXPK
 SETXREG  LINK   CGSETXW     SET X REGISTER 
 SUBDNAT  LINK   SUBDNAT
 SUBLOAD  LINK   SUBLOAD
 SUBREF   LINK   SUBREF 
          ERROR  IOERR1 
  
*CALL IODEFSC 
  
**        GIO    INPUT-OUTPUT VERB GENERATOR
* 
*         GENERATES CODE FOR THE INPUT-OUTPUT VERBS 
* 
          TITLE  CGACCEP - ACCEPT CODE GENERATOR
* 
**        CGACCEP - ACCEPT CODE GENERATOR 
* 
*         GENERATES 
*            IF FROM MNEMONIC NAME
*                SA1  MNEMONIC NAME 
*                SB5  FWA OF ITEM 
*                SB6 BCP
*                SB7  SIZE
*                RJ   =XC.ACCMN 
* 
*            IF FROM DATE 
*                RJ  =XC.ACCDT
* 
*            IF FROM DAY
*                RJ  =XC.ACCDY
* 
*            IF FROM TIME 
*                RJ  =XC.ACCTM
* 
*            IF FROM DAY-OF-WEEK
*                RJ  =XC.ACCDW
* 
 CGACCEP  EGO    1
          IFTHEN ((GCODEOF,IOREGC),EQ,GSYSREF)
            CALLZ  SETMNNM   SET UP MENMONIC NAME 
          ELSEZ 
            GOTOCASE  (GSCODEOF,IOREGC) 
              CASE    GDATE,ACCDATE     ACCEPT FROM DATE
              CASE    GDAY,ACCDAY       ACCEPT FROM DAY 
              CASE    GDAYOFWK,ACCDOW   ACCEPT FROM DAY OF WEEK 
              CASE    GTIME,ACCTIME     ACCEPT FROM TIME
              CASE    GNULL,ACCINP      ACCEPT (INPUT ASSUMED)
            ENDCASE 
            ERROR   7001
          ENDIFZ
          SPACE  4
 GENACC0  LABEL              ACCEPT DATA-NAME FROM MNEMONIC NAME
          NOTE   GENACC0
          CALLZ  SETPARS
          GENOBJ N=C.ACCMN,I=(IOVREGD,IOVREGA,IOVREGB,IOVREGC)
          RETURN
          SPACE  4
 ACCDATE  LABEL              ACCEPT DATA-NAME FROM DATE 
          NOTE   ACCDATE
          GENOBJ N=C.ACCDT,O=((VREGOF,IOVREGA)) 
          MOVEZ  IOVREGA,(TREGOF,IOREGB)
          RETURN
          SPACE  4
 ACCDAY   LABEL              ACCEPT DATA-NAME FROM DAY
          NOTE   ACCDAY 
          GENOBJ N=C.ACCDY,O=((VREGOF,IOVREGA)) 
          MOVEZ  IOVREGA,(TREGOF,IOREGB)
          RETURN
          SPACE  4
 ACCDOW   LABEL              ACCEPT DATA-NAME FROM DAY-OF-WEEK
          NOTE   ACCDOW 
          GENOBJ N=C.ACCDW,O=((VREGOF,IOVREGA)) 
          MOVEZ  IOVREGA,(TREGOF,IOREGB)
          RETURN
          SPACE  4
 ACCTIME  LABEL              ACCEPT DATA-NAME FROM TIME 
          NOTE   ACCTIME
          GENOBJ N=C.ACCTM,O=((VREGOF,IOVREGA)) 
          MOVEZ  IOVREGA,(TREGOF,IOREGB)
          RETURN
          SPACE  4
 ACCINP   LABEL              ACCEPT DATA-NAME (INPUT ASSUMED) 
          GEN    SLRBPK,(VREGOF,IOVREGD),IOB0,((EXT$OF,C.INPUT))
          BRANCH GENACC0
          RETURN
          TITLE  CGATEND - AT END GENERATOR 
* 
**        CGATEND - AT END GENERATOR
* 
*         GENERATES 
*                CODE FOR AT END LINKAGE
* 
 CGATEND  EGO    1
          NOTE   CGATEND
          BRANCH  INVKYPR                        AT-END SAME AS INV-KEY 
          TITLE  CGCLOSE - CLOSE FILENAME CODE GENERATOR
* 
**        CGCLOSE - CLOSE FILENAME CODE GENERATOR 
* 
*         GENERATES 
*                SA0  FIT ADDR
*                SB3  REWIND OPTION 
*                SB6  RETURN
*                EQ   =XC.CLOXX  -  XX IS THE FILE ORG
* 
 CGCLOSE  EGO    1
          NOTE   CGCLOSE
          GOTOCASE  (GSCODEOF,IOREGD) 
            CASE   GNULL,CLOSREW                 DEFAULT - REWIND 
            CASE   GLOCK,CLOSLK                  LOCK 
            CASE   GNOREWND,CLOSNR
          ENDCASE 
          ERROR  IOERR2 
 CLOSREW  LABEL 
          MOVEZ  #R#,P1 
          BRANCH  CLOSE1
 CLOSLK   LABEL 
          MOVEZ  #LOCK#,P1
          BRANCH  CLOSE1
 CLOSNR   LABEL 
          MOVEZ  #N#,P1 
          BRANCH  CLOSE1
 CLOSE1   LABEL 
          GEN    SBBPK,(VREGOF,IOVREGB),IOB0,P1  SET REWIND OPTION
          CALLZ  SA0FIT      SET IOVREGA TO FIT ADDR
          CALLZ  SETFO       SET T1 TO FILE ORG INDEX 
          GENOBJ N=(C.CLOAK,T1),I=(IOVREGA,IOVREGB)  GEN CALL TO CLOSE
          RETURN
* 
**        GSCLOSE - ENTERED FROM SORT/MERGE TO CLOSE W/ REWIND
* 
*         GENERATES 
*                SAME AS CLOSE EXCEPT B1 IS ALWAYS REWIND 
 GSCLOSE  EGO    2
          NOTE   GSCLOSE
          MOVEZ  #R#,P1                          SET REWIND 
          BRANCH  CLOSE1
          TITLE  CGCLOSR - CLOSE FILENAME REEL CODE GENERATOR 
* 
**        CGCLOSR - CLOSE FILENAME REEL CODE GENERATOR
* 
*         GENERATES 
*                SA0  FIT ADDR
*                SB6  RETURN
*                SB3  REWIND OPTION 
*                EQ   =XC.CLOSR 
* 
 CGCLOSR  EGO    1
          NOTE   CGCLOSR
          GOTOCASE  (GSCODEOF,IOREGD)            CHECK REWIND OPTION
            CASE   GNULL,CLRREW                  NOTHING - REWIND 
            CASE   GNOREWND,CLRNR                NO REWIND
            CASE   GREMOVE,CLRREM                FOR REMOVAL
          ENDCASE 
          ERROR  IOERR2 
 CLRREW   LABEL 
          MOVEZ  #R#,P1 
          BRANCH  CLR1
 CLRNR    LABEL 
          MOVEZ  #R#,P1      USE REWIND - CRM HAS NO NO REWIND ON VOLS
          BRANCH  CLR1
 CLRREM   LABEL 
          MOVEZ  #U#,P1 
 CLR1     LABEL 
          GEN    SBBPK,(VREGOF,IOVREGB),,P1      SET REWIND OPTION
          CALLZ  SA0FIT 
          GENOBJ  N=C.CLOSR,I=(IOVREGA,IOVREGB) 
          MOVEZ  (FNRRCOF,IOREGB),T1   GET RERUN FLAG 
          IFTHEN  (P1,EQ,1)            TRUE IF RERUN ON END OF UNIT 
            GENOBJ  N=C.RERUN                    TAKE CHECKPOINT
          ENDIFZ
          RETURN
          TITLE  CGDELET - DELETE FILENAME CODE GENERATOR 
* 
**        CGDELET - DELETE FILENAME CODE GENERATOR
* 
*         GENERATES 
*                SA0  FIT ADDR
*                MX4 1 IF INVALID KEY SPECIFIED - 0 IF NOT
*                 X1 HAS KEY IF RELATIVE FILE - 0 OTHERWISE 
*                SB6  RETURN
*                EQ   =XC.DELXX - XX IS THE FILE ORG
* 
*                FOR RELATIVE FILES, X1 HAS THE KEY 
* 
 CGDELET  EGO    1
          IFZ    ((GSCODEOF,IOREGC),EQ,GDFILE),DELFILE
          NOTE   CGDELET
          CALLZ  CKRERUN                         IF OK GEN CODE FOR RRUN
          CALLZ  SETAEIK                         SET X4 FOR INV KEY (VB)
          CALLZ  SETRLKY                         SET X REG TO RL OR WA
          CALLZ  SA0FIT                          SET FIT ADDR IN A0 (VA)
          CALLZ  SETFO                           SET T1 TO FO IND 
          GENOBJ  N=(C.DELAK,T1),I=(IOVREGA,IOVREGB,IOVREGC),O=IORTNRG
          RETURN
* 
**        DELETE FILE 
* 
*         GENERATES 
*                SA0 FIT ADDRESS
*                SB6 RETURN 
*                EQ =XC.DELFL 
* 
 DELFILE  LABEL 
          NOTE   CGDELFL
          CALLZ  SA0FIT 
          GENOBJ N=C.DELFL,I=IOVREGA
          RETURN
          TITLE  CGDISPL - DISPLAY GENERATOR
**        CGDISPL - DISPLAY CODE GENERATOR
* 
*         GENERATES 
*                SB5  FWA OF ITEM 
*                SB6 BCP
*                SB7  SIZE
*                SA0  FIT OF UPON FILE
*                SB4  NOADV FLAG
*                RJ   =XC.DSPLY 
* 
 CGDISPL  EGO    1
          NOTE   CGDISPL
          IFTHEN ((TYPEOF,IOREGB),EQ,VARGROUP)
            PUSH IOREGB,IOREGC
            MOVEZ  IOREGB,P1
            MOVEZ  MOVEREGM,P2
            CALLZ  REGMOVE                       SET UP PARAM FOR MOVE
            CALLZ  CGGTSZV                       SIZE OF VAR GROUP ITEM 
            GEN    SBXPB,(VREGOF,IOVREGC),P1,IOB0  SIZE TO B REG
            POP  IOREGB,IOREGC
          ENDIFZ
          IFTHEN ((GCODEOF,IOREGC),EQ,GSYSREF)
*      HERE WE HAVE DISPLAY DATA-NAME UPON MNEMONIC NAME
            CALLZ  SETMNNM   SET UP MNEMONIC NAME 
          ELSEZ 
*      HERE WE HAVE DISPLAY DATA-NAME (OUTPUT ASSUMED)
            GEN    SLRBPK,(VREGOF,IOVREGD),IOB0,((EXT$OF,C.OUTPT))
          ENDIFZ
          CALLZ  SETPARS
          GOTOCASE  (GSCODEOF,IOREGD) 
            CASE    GNOADV,DISNO
            CASE    GNULL,DISADV
          ENDCASE 
          ERROR  IOERR10
 DISNO    LABEL 
          MOVEZ  #YES#,P1 
          BRANCH DISPLAY1 
 DISADV   LABEL 
          MOVEZ  #NO#,P1
          BRANCH DISPLAY1 
 DISPLAY1 LABEL 
          CALLZ  SETBREG
          MOVEZ  IOVREGX,IOVREGE
          GENOBJ N=C.DSPLY,I=(IOVREGD,IOVREGE,IOVREGA,IOVREGB,IOVREGC)
          RETURN
          TITLE  CGEOP - END OF PAGE PROCESSOR
**        CGEOP - END OF PAGE PROCESSOR 
* 
*         GENERATES 
*                CODE FOR SKIPPING EOP IF NONE
* 
 CGEOP    EGO    1
          NOTE   CGEOP
          IFTHEN  ((GSCODEOF,IOREGB),EQ,GFALSE) 
            GEN    EQ$,IORTNRG,,((FWA$OF,IOREGB))  EQ B3,B0 AROUND CODE 
          ELSEZ 
            GEN    NE$,IORTNRG,,((FWA$OF,IOREGB))  \E B3,B0 AROUND CODE 
          ENDIFZ
          RETURN
          TITLE  CGIOSUC - IO SUCCESS CODE GENERATOR
* 
**        CGIOSUC - IO SUCCESS CODE GENERATOR 
* 
*         GENERATES 
*                LINKAGES FOR NORMAL IO RETURN
* 
 CGIOSUC  EGO    1
          NOTE   CGIOSUC
          IFTHEN  ((GSCODEOF,IOREGB),EQ,GFALSE) 
            GEN    NE$,IOB0,IORTNRG,((FWA$OF,IOREGB))  JP IF AE OR IK 
          ELSEZ 
            GEN    EQ$,IOB0,IORTNRG,((FWA$OF,IOREGB))  JP IF NO AE OR IK
          ENDIFZ
          MOVEZ  0,IORTNRG                       INDICATE PROCESSED 
          RETURN
          RETURN
          TITLE  CGINVKE - INVALID KEY CODE GENERATOR 
* 
**        CGINVKE - INVALID KEY CODE GENERATOR
* 
*         GENERATES 
*                LINKAGES FOR INVALID KEY 
* 
 CGINVKE  EGO    1
          NOTE   CGINVKE
* 
 INVKYPR  LABEL 
          IFZ    ((GCODEOF,IOREGB),EQ,GLABLREF),INVK2  JP IF NOT FNAT 
          IFZ    ((CCTBIT,DEBUGMOD),EQ,0),INVK1  JP IF NOT DEBUG MODE 
 CDCS     IFNE   OP.DCS,OP.NO 
          MOVEZ  (DMRELOOF,IOREGB),T2  GET RELATION ORDINAL IF ONE
          IFZ    (T2,NE,0),INVK1   JP IF RELATIONAL OPERATION 
 CDCS     ENDIF 
          IFZ    (IORTNRG,EQ,0),GIORTN           EXIT IF ALREADY PROCD
          CALLZ  SA0FIT      SA0 TO FIT ADDR
          GEN    SLRAPK,(VREGOF,IOVREGB),IOVREGA,#FLAGWD#  GET FLAG WD
          IFTHEN  ((GSCODEOF,IOREGA),EQ,GINVKEY)
            GEN    SHL,IOVREGB,#INVKSC#          POSITION INVK FLAG 
          ELSEZ 
            GEN    SHL,IOVREGB,#ATENSC#          POSITION AT END FLAG 
          ENDIFZ
          IFTHEN  ((GSCODEOF,IOREGC),EQ,GFALSE) 
            GEN    PL$,IOVREGB,((FWA$OF,IOREGC))  JP IF NO INV KEY
          ELSEZ 
            GEN    NG$,IOVREGB,((FWA$OF,IOREGC))  JP IF INV KEY 
          ENDIFZ
          BRANCH GIORTN      EXIT 
  
 INVK1    LABEL 
*      NORMALLY, IOREGB HAS THE LABEL REF OF THE INVALID KEY CODE 
*      HOWEVER, FOR DEBUG, IT MAY HAVE THE FNAT POINTER AND IOREGC HAS
*      THE LABEL REF
          MOVEZ  IOREGC,P1
          MOVEZ  IOREGB,P2
          CALLZ  REGMOVE     MOVE REGC TO B (THE NORMAL SEQUENCE) 
 INVK2    LABEL 
          IFZ    (IORTNRG,EQ,0),GIORTN           EXIT IF PROCESSED
*      THE CHECK FOR INV KEY OR AT END CAN BE HANDLED BY I-O SUCCESS FOR
*      READ INTO OR DEBUGGING OPERATIONS
          IFTHEN  ((GSCODEOF,IOREGB),EQ,GFALSE) 
            GEN    EQ$,IOB0,IORTNRG,((FWA$OF,IOREGB))  JP IF NO AE OR IK
          ELSEZ 
            GEN    NE$,IOB0,IORTNRG,((FWA$OF,IOREGB))  JP IF AE OR IK 
          ENDIFZ
 GIORTN   LABEL              EXIT FROM GIO
          RETURN
          TITLE  CGMOVRC - MOVE RECORD FOR READ INTO
 CGMOVRC  EJECT 
* 
**        CGMOVRC - MOVE RECORD FOR READ INTO 
* 
*         GENERATES 
*                CALLS NORMAL MOVE IF FIXED LENGTH RECORDS
* 
*             IF VARIABLE LENGTH RECORDS
*                SB3  FWA OF INTO ITEM
*                SB4  BCP 
*                SB7  LENGTH OF INTO ITEM 
*                RJ   =XC.MOVRC 
* 
 CGMOVRC  EGO    1
          NOTE   CGMOVRC
          MOVEZ  (FNELEMR,IOREGB),T1             ELEM ITEM PTR
          IFZ    (T1,EQ,0),MOVRC1                JUMP IF NOT ELEM REC 
          MOVEZ  IOREGC,MOVEREGB                 RECEIVER 
          MOVEZ  0,P1 
          MOVEZ  MOVEREGA,P2
          CALLZ  REGMOVE                         CLEAR SENDER REG 
          MOVEZ  GDATAREF,(GCODEOF,MOVEREGA)     SET UP FOR SENDER
          MOVEZ  T1,(GPTROF,MOVEREGA)            SENDER DNAT
          CALLZ  GMOVER                          MOVE THE RECORD
          RETURN
 MOVRC1   LABEL 
          IFTHEN ((GSCODEOF,IOREGC),EQ,0) 
          ANDIF  ((TYPEOF,IOREGC),NE,VARGROUP)
            MOVEZ  (BYTLENOF,IOREGC),P1 
            CALLZ  SETBREG
            MOVEZ  IOVREGX,IOVREGC
          ENDIFZ
          IFTHEN ((GSCODEOF,IOREGC),EQ,0) 
          ANDIF  ((TYPEOF,IOREGC),EQ,VARGROUP)
          ANDIF  ((CCTBIT,AUDIT),NE,0)
            MOVEZ  IOREGC,REGM
            CALLZ  CGGTSZV
            GEN    SBXPB,(VREGOF,IOVREGC),P1
          ENDIFZ
          IFTHEN ((GSCODEOF,IOREGC),EQ,0) 
          ANDIF  ((TYPEOF,IOREGC),EQ,VARGROUP)
          ANDIF  ((CCTBIT,AUDIT),EQ,0)
            MOVEZ  (BYTLENOF,IOREGC),P1 
            CALLZ  SETBREG
            MOVEZ  IOVREGX,IOVREGC
          ENDIFZ
          CALLZ  SA0FIT                          SA0 TO FIT ADDR
          GEN    SBBPK,(VREGOF,IOVREGA),IOB0,((FWA$OF,IOREGC))  INTO FWA
          IFTHEN ((GSCODEOF,IOREGC),NE,0) 
            MOVEZ  IOREGC,P2
            CALLZ  SUBREF 
            GEN    SBXPB,(VREGOF,IOVREGB),P3
            GEN    SBXPB,(VREGOF,IOVREGC),P4
          ELSEZ                                  NON-SUBSCRIPTED CASE 
            MOVEZ  (BCPOF,IOREGC),P1
            CALLZ  SETBREG                       SET BCP OF RECEIVER
            MOVEZ  IOVREGX,IOVREGB
          ENDIFZ
          IFTHEN  ((JUSTOF,IOREGC),NE,0)         TEST FOR JUST RT 
            GEN    SBBMB,IOVREGC,IOB0,IOVREGC    JUST - COMP LENGTH 
          ENDIFZ
          IFTHEN  ((MAJMSCOF,IOREGC),NE,SECSMSEC) 
            GENOBJ  N=C.MOVRC,I=(IOVREGA,IOVREGB,IOVREGC) 
          ELSEZ 
            GENOBJ  N=C.MOVRE,I=(IOVREGA,IOVREGB,IOVREGC) 
          ENDIFZ
          RETURN
          TITLE  CGOPEN - OPEN FILENAME CODE GENERATOR
* 
**        CGOPEN - OPEN FILENAME CODE GENERATOR 
* 
*         GENERATES 
*                SA0  FIT ADDR
*                SB3  OPEN REWIND OPTION
*                SB6  RETURN
*                EQ   =XC.OPEXX - XX IS THE FILE ORG
* 
 CGOPEN   EGO    1
          NOTE   CGOPEN 
 OPEN0    LABEL 
          CALLZ  SA0FIT 
          IFTHEN  ((FNLABTS,IOREGB),EQ,1)        TEST FOR LABEL RECS
            GENOBJ  N=C.LABLI,I=IOVREGA          CALL LABEL PROCESS 
          ENDIFZ
          GOTOCASE  (GSCODEOF,IOREGE) 
          CASE     GNULL,OPENREW                 DEFAULT - REWIND 
          CASE     GNOREWND,OPENNR               NO REWIND
          CASE     GREVERSE,OPENRV               REVERSED 
          ENDCASE 
          ERROR  IOERR3 
 OPENREW  LABEL 
          MOVEZ  #R#,P1 
          BRANCH  OPEN1 
 OPENNR   LABEL 
          MOVEZ  #N#,P1 
          BRANCH  OPEN1 
 OPENRV   LABEL 
          MOVEZ  #REVD#,P1
          BRANCH  OPEN1 
 OPEN1    LABEL 
          GEN    SBBPK,(VREGOF,IOVREGB),IOB0,P1  SET REWIND OPTION
          CALLZ  SETFO       SET T1 TO FILE ORG INDEX 
          GOTOCASE  (GSCODEOF,IOREGD) 
            CASE    GINPUT,OPINP   JUMP IF OPENED INPUT 
            CASE    GIO,OPIO JUMP IF OPENED IO
            CASE    GOUTPUT,OPOUT  JUMP IF OPENED OUTPUT
            CASE   GEXTEND,OPEXT       JP IF OPEN EXTEND
          ENDCASE 
          ERROR  IOERR4 
 OPEXT    LABEL 
          GEN    SBBPK,(VREGOF,IOVREGE),IOB0,((EXT$OF,C.OPEXT)) 
          BRANCH OPGENC 
 OPINP    LABEL 
          GEN    SBBPK,(VREGOF,IOVREGE),IOB0,((EXT$OF,C.OPIN))
          BRANCH OPGENC 
 OPIO     LABEL 
          GEN    SBBPK,(VREGOF,IOVREGE),IOB0,((EXT$OF,C.OPIO))
 OPGENC   LABEL 
          GENOBJ N=(C.OPAK,T1),I=(IOVREGA,IOVREGB,IOVREGE)  GEN OPEN
          RETURN
 OPOUT    LABEL 
          GEN    SBBPK,(VREGOF,IOVREGE),IOB0,((EXT$OF,C.OPOUT)) 
          IFZ    ((FNFOOF,IOREGB),NE,DIRECT),OPOND  JP IF NOT ORG DA
          MOVEZ  (FNBLKNB,IOREGB),T1             GET DNAT OF HMB
*      P1 IS ZERO IF DNAT RETURNED, 1 IF VALUE RETURNED 
          IFTHEN  (P1,EQ,0) 
          ANDIF  (T1,NE,0)      DNAT POINTER MUST NOT BE 0 (NO BCT) 
          GEN    SBAPB,(VREGOF,IOVREGD),IOVREGA  SAVE A0 OVER LOAD
            MOVEZ  GDATAREF,P3
            CALLZ  MVTOXRG                       PUT HMB IN X REGISTER
            MOVEZ  T1,IOVREGC                    REG NBR OF RETURN
            GEN    SABPB,(VREGOF,IOVREGA),IOVREGD 
          ELSEZ 
            MOVEZ  T1,P1
            CALLZ  SETXREG                       SET X REG TO VALUE 
            MOVEZ  IOVREGY,IOVREGC               SET PROPER V REG 
          ENDIFZ
          GENOBJ  N=C.OPNDA,I=(IOVREGA,IOVREGB,IOVREGC,IOVREGE) 
          BRANCH  OPNOT1
 OPOND    LABEL 
          GENOBJ N=(C.OPAK,T1),I=(IOVREGA,IOVREGB,IOVREGE)
          IFTHEN  ((FNFOOF,IOREGB),EQ,SEQUENTI)  TEST FOR SEQUENTIAL FO 
          ANDIF  ((FNLINAG,IOREGB),NE,0)         AND LINAGE FILE
            GENOBJ  N=C.LINOP                    CALL LINAGE OPEN 
          ENDIFZ
 OPNOT1   LABEL 
          IFZ    ((FNALTK,IOREGB),EQ,0),OPENCP   JUMP IF NO ALT KEYS
          CALLZ  SA0FIT 
          GENOBJ N=(C.KYDEF),I=IOVREGA           DO KEYDEF ON OPEN OTPT 
 OPENCP   LABEL 
          RETURN
          SPACE  2
* 
**        GSOPENI AND GSOPENO ENTERED FROM SORT/MERGE TO OPEN W/REWIND
* 
*         GENERATES 
*                SAME AS OPEN INPUT WITH REWIND 
* 
*                CHANGES REGD (IOREGD)
* 
 GSOPENI  EGO    2
          NOTE   GSOPENI
          MOVEZ  GINPUT,(GSCODEOF,IOREGD) 
          BRANCH GSOPENX
 GSOPENO  EGO    2
          NOTE   GSOPENO
          MOVEZ  GOUTPUT,(GSCODEOF,IOREGD)
 GSOPENX  LABEL 
          MOVEZ  GNULL,(GSCODEOF,IOREGE)         SET UP FOR LATER TEST
          BRANCH OPEN0
          TITLE  CGREADK - READ WITH KEY CODE GENERATOR 
* 
**        CGREADK - READ WITH KEY CODE GENERATOR
* 
*         GENERATES 
*                SA0  FIT ADDR
 CDCS     IFNE   OP.DCS,OP.NO 
*            OR  SA0  (CDCS) RELATION ORDINAL 
 CDCS     ENDIF 
*                SB6  RETURN
*                EQ   =XC.RDRXX - XX IS THE FILE ORGANIZATION 
 CDCS     IFNE   OP.DCS,OP.NO 
*            OR  EQ   =XC.DMRR - IF A (CDCS) RELATION READ
 CDCS     ENDIF 
* 
 CGREADK  EGO    1
          NOTE   CGREADK
          CALLZ  CKRERUN                         IF OK GEN CODE FOR RRUN
          CALLZ  SETAEIK                         SET X4 FOR INV KEY (VB)
          CALLZ  SETRLKY
          CALLZ  SA0FIT 
 CDCS     IFNE   OP.DCS,OP.NO 
          NOTZ   (T2,EQ,0),READRELR  JUMP IF A RELATION 
 CDCS     ENDIF 
          CALLZ  SETFO                           SET T1 TO FO 
          IFTHEN  ((FNFOOF,IOREGB),EQ,WORD$ADD) 
*                  WORD ADDRESS FILE RETURNS NEW ADDRESS IN X1
            MOVEZ  (VREGOF,P3),P3                GET VIRT REG FOR RTN 
            GENOBJ  N=C.RDRWA,I=(IOVREGA,IOVREGB,IOVREGC),O=(IORTNRG,P3)
            CALLZ  STOREKY                       STORE THE WORD ADDR KEY
          ELSEZ 
            GENOBJ  N=(C.RDRAK,T1),I=(IOVREGA,IOVREGB,IOVREGC),O=(IORTNR
,G,(VREGOF,P3)) 
            CALLZ  STORERL                       STORE REC LENGTH 
          ENDIFZ
          RETURN
 CDCS     IFNE   OP.DCS,OP.NO 
 READRELR LABEL 
          GENOBJ  N=C.DMRR,I=(IOVREGA,IOVREGB,IOVREGC),O=IORTNRG
          RETURN
 CDCS     ENDIF 
          TITLE  CGREADN - READ SEQUENTIAL CODE GENERATOR 
* 
**        CGREADN - READ SEQUENTIAL CODE GENERATOR
* 
*         GENERATES 
*                SA0  FIT ADDR
 CDCS     IFNE   OP.DCS,OP.NO 
*            OR  SA0  (CDCS) RELATION ORDINAL 
 CDCS     ENDIF 
*                SB6  RETURN
*                EQ   =XC.RDNXX - XX IS THE FILE ORGANIZATION 
 CDCS     IFNE   OP.DCS,OP.NO 
*            OR  EQ   =XC.DMRN - IF A (CDCS) RELATION READ
 CDCS     ENDIF 
* 
 CGREADN  EGO    1
          NOTE   CGREADN
          CALLZ  CKRERUN                         IF OK GEN CODE FOR RRUN
          CALLZ  SETAEIK                         SET X4 FOR INV KEY (VB)
 READ1    LABEL 
          CALLZ  SA0FIT      SET IOVREGA TO FIT ADDR
 CDCS     IFNE   OP.DCS,OP.NO 
          NOTZ   (T2,EQ,0),READRELN  JUMP IF A RELATION 
          ENDIF 
          MOVEZ  (FNFOOF,IOREGB),T1              GET FILE ORG 
          IFZ    (T1,EQ,WORD$ADD),READNWA        JP IF FO IS WORD ADDR
          IFZ    (T1,NE,RELATIVE),READNNR        JP IF NOT RELATIVE 
          IFZ    ((FNRLKOF,IOREGB),EQ,0),READNNR  JP IF KEY NOT GIVEN 
          GENOBJ  N=C.RDNRL,I=(IOVREGA,IOVREGB),O=(IORTNRG,(VREGOF,P3)) 
          CALLZ  STOREKY                         STORE NEW KEY VALUE
          RETURN
 READNWA  LABEL 
          GENOBJ  N=C.RDNWA,I=(IOVREGA,IOVREGB),O=(IORTNRG,(VREGOF,P3)) 
          CALLZ  STOREKY                         STORE NEW KEY VALUE
          RETURN
 READNNR  LABEL 
          CALLZ  SETFO
          GENOBJ  N=(C.RDNAK,T1),I=(IOVREGA,IOVREGB),O=(IORTNRG,(VREGOF,
,P3)) 
          CALLZ  STORERL                         STORE RECORD LENGTH
          RETURN
 CDCS     IFNE   OP.DCS,OP.NO 
 READRELN LABEL 
          GENOBJ  N=C.DMRN,I=(IOVREGA,IOVREGB),O=(IORTNRG)
          RETURN
 CDCS     ENDIF 
          SPACE  2
* 
**        GSREADN - ENTERED FROM SORT/MERGE TO READ NEXT
* 
*         GENERATES 
*                SAME AS READ SEQUENTIAL
* 
 GSREADN  EGO    2
          NOTE   GSREADN
          CALLZ  CKRERUN                         IF OK GEN CODE FOR RRUN
          GEN    MASK,(VREGOF,IOVREGB),2         INDICATE AT END
          BRANCH  READ1 
          TITLE  CGREADS - READ START CODE GENERATOR (WHO KNOWS WHAT THI
* 
**        CGREADS - READ START CODE GENERATOR 
* 
*         GENERATES 
*                SA0  FIT ADDR
 CDCS     IFNE   OP.DCS,OP.NO 
*            OR  SA0  (CDCS) RELATION ORDINAL 
 CDCS     ENDIF 
*                SB3  KEY NUMBER
*                MX4  1 IF INVALID KEY - 0 IF NONE
*                SB6  RETURN
*                EQ   =XC.RDSXX - XX IS THE FILE ORGANIZATION 
 CDCS     IFNE   OP.DCS,OP.NO 
*            OR  EQ   =XC.DMRS - IF A (CDCS) RELATION READ
 CDCS     ENDIF 
* 
 CGREADS  EGO    1
          CALLZ  CKRERUN                         IF OK GEN CODE FOR RRUN
          NOTE   CGREADS
          CALLZ  SA0FIT                          SET FIT ADDR IN A0 (VA)
          CALLZ  SETAEIK                         SET X4 FOR INV KEY (VB)
          MOVEZ  (REGPTROF,IOREGD),P1            SET UP DNAT FOR KNBOF
          MOVEZ  0,P2        FLAG AS A READ 
          MOVEZ  (FNKNBOF,IOREGB),P1             GET KEY ORD+NAL
          CALLZ  SETBREG                         PUT IT IN A  B REG 
          MOVEZ  IOVREGX,IOVREGC                 B REG TO V C (B4)
 CDCS     IFNE   OP.DCS,OP.NO 
          NOTZ   (T2,EQ,0),READRELS  JUMP IF A RELATION 
 CDCS     ENDIF 
          CALLZ  SETFO                           SET T1 TO FO 
          GENOBJ  N=(C.RDSAK,T1),I=(IOVREGA,IOVREGB,IOVREGC),O=(IORTNRG,
,(VREGOF,P3)) 
          CALLZ  STORERL                         STORE RECORD LENGTH
          RETURN
 CDCS     IFNE   OP.DCS,OP.NO 
 READRELS LABEL 
          GENOBJ  N=C.DMRS,I=(IOVREGA,IOVREGB,IOVREGC),O=(IORTNRG)
          RETURN
 CDCS     ENDIF 
          TITLE  CGREWRI - REWRITE CODE GENERATOR 
* 
**        CGREWRI - REWRITE CODE GENERATOR
* 
*         GENERATES 
*                SA0  FIT ADDR
*                SA1  KEY IF RELATIVE 
*                SX3  RECORD LENGTH 
*                MX4  1 IF INVALID KEY - 0 IF NONE
 CDCS     IFNE   OP.DCS,OP.NO 
*                SX7  RECORD ORDINAL (CDCS I/O) 
 CDCS     ENDIF 
*                SB6  RETURN
*                EQ   =XC.REWXX - XX IS THE FILE ORGANIZATION 
* 
 CGREWRI  EGO    1
          NOTE   CGREWRI
          CALLZ  CKRERUN                         IF OK GEN CODE FOR RRUN
          CALLZ  SETAEIK                         SET X4 FOR INV KEY (VB)
          CALLZ  SETRECL                         SET RECORD LENGTH
          CALLZ  SETRLKY                         SET X REG TO KEY - RLWA
          CALLZ  SA0FIT 
          CALLZ  SETFO                           SET T1 TO FO 
 CDCS     IFNE   OP.DCS,OP.NO 
          GENOBJ  N=(C.REWAK,T1),I=(IOVREGA,IOVREGB,IOVREGC,IOVREGD,IOVR
,EGF),O=IORTNRG 
 CDCS     ELSE   1
          GENOBJ  N=(C.REWAK,T1),I=(IOVREGA,IOVREGB,IOVREGC,IOVREGD),O=I
,ORTNRG 
          RETURN
          TITLE  CGSTAR - START CODE GENERATOR
* 
**        CGSTAR - START CODE GENERATOR 
* 
*         GENERATES 
*                SA0  FIT ADDR
*                MX4  1  IF INVALID KEY - 0 IF NONE 
*                SA1  KEY IF RELATIVE 
*                SX3  KEY LENGTH
 CDCS     IFNE   OP.DCS,OP.NO 
*                SX7  KEY ORDINAL (CDCS I/O)
 CDCS     ENDIF 
*                SB3  KEY NUMBER
*                SB4  RELATION
*                SB6  RETURN
*                EQ   =XC.STAXX - XX IS THE FILE ORGANIZATION 
* 
 CGSTAR   EGO    1
          NOTE   CGSTAR 
          CALLZ  SETAEIK                         SET X4 FOR INV KEY (VB)
          GEN    SXBPK,(VREGOF,IOVREGD),IOB0,(BYTLENOF,IOREGE)  KEY LEN 
 CDCS     IFNE   OP.DCS,OP.NO 
          GEN    SXBPK,(VREGOF,IOVREGG),,(DMIORDOF,IOREGE)  SET X7 TO 
*                                                            KEY ORDINAL
 CDCS     ENDIF 
          GOTOCASE  (GSCODEOF,IOREGD) 
            CASE   GKEYEQ,STARTEQ                KEY IS EQUAL TO D-N
            CASE   GKEYGR,STARTGR                KEY IS GREATER THAN D-N
            CASE   GKEYNLSS,STARTGQ              KEY IS NOT LESS THAN DN
          ENDCASE 
          ERROR  IOERR7 
 STARTEQ  LABEL 
          MOVEZ  #EQ#,P1
          BRANCH  START1
 STARTGR  LABEL 
          MOVEZ  #GT#,P1
          BRANCH  START1
 STARTGQ  LABEL 
          MOVEZ  #GE#,P1
          BRANCH  START1
 START1   LABEL 
          CALLZ  SETBREG                         SET B3 TO RELATION (VE)
          MOVEZ  IOVREGX,IOVREGE                 RETURN FROM SETBREG
          MOVEZ  (REGPTROF,IOREGE),P1            MOVE DNAT ADDR OF KEY
          MOVEZ  1,P2        FLAG AS A START
          MOVEZ  (FNKNBOF,IOREGB),P1             GET KEY NUMBER 
          CALLZ  SETBREG                         SET B4 TO KEY  (VF)
          MOVEZ  IOVREGX,IOVREGF
          CALLZ  SETRLKY                         SET X REG TO KEY - RLWA
          CALLZ  SA0FIT 
          CALLZ  SETFO                           SET FILE ORG 
 CDCS     IFNE   OP.DCS,OP.NO 
          IFTHEN  (T2,EQ,0)      SEE IF CDCS START RELATION-NAME
            GENOBJ  N=(C.STAAK,T1),I=(IOVREGA,IOVREGB,IOVREGC,IOVREGD,IO
,VREGE,IOVREGF,IOVREGG),O=IORTNRG    NOT START REALTION 
          ELSEZ 
            GENOBJ  N=C.DMRSR,I=(IOVREGA,IOVREGB,IOVREGC,IOVREGD,IOVREGE
,,IOVREGF,IOVREGG),O=IORTNRG    START RELATION
          ENDIFZ
 CDCS     ELSE   1
          GENOBJ N=(C.STAAK,T1),I=(IOVREGA,IOVREGB,IOVREGC,IOVREGD,IOVRE
,GE,IOVREGF),O=IORTNRG
          RETURN
          TITLE  CGWRITE - WRITE SEQUENTIAL CODE GENERATOR
* 
**        CGWRITE - WRITE SEQUENTIAL CODE GENERATOR 
* 
*         GENERATES 
*                SA0  FIT ADDR
*                MX4  1 IF INVALID KEY SPECIFIED - 0 IF NOT 
*                SX3  RECORD LENGTH 
 CDCS     IFNE   OP.DCS,OP.NO 
*                SX7  RECORD ORDINAL ([DCS I/O) 
 CDCS     ENDIF 
*                SB6  RETURN
*                EQ   =XC.WRSXX - XX IS THE FILE ORGANIZATION 
* 
 CGWRITE  EGO    1
          NOTE   CGWRITE
          CALLZ  CKRERUN                         IF OK GEN CODE FOR RRUN
          IFZ    ((FNFOOF,IOREGB),NE,SEQUENTI),WRITENA  JUMP IF NOT SQ
          IFZ    ((GCODEOF,IOREGF),NE,GSUBVERB),WRITENS  JP IF NOT SB VB
*      HERE IF REGF IS A SUB-VERB - IF NULL NO ADV - IP PAGE SKIP PAGE
          IFZ    ((GSCODEOF,IOREGF),NE,GNULL),WRITEIA  JP IF ADVANCING
          IFZ    ((FNLINAG,IOREGB),EQ,0),WRITENA  JP IF NOT LINAGE
          GEN    SXBPB,(VREGOF,IOVREGE),,IOB1    SX1 1 FOR WAA 1
          GEN    SBBPB,(VREGOF,IOVREGC)          SB3 B0 (NOT MNEMONIC)
          CALLZ  SA0FIT 
          CALLZ  SETRECL                         SET REC LEN IN VREGD 
          BRANCH WRITELA                         GO DO LINAGE AFT 
 WRITEIA  LABEL 
*      WRITE WITH PAGE
          IFTHEN  ((GSCODEOF,IOREGF),EQ,GPAGE)
            GEN    SXBPK,(VREGOF,IOVREGE),,34B   SX1 1 FOR PAGE EJECT 
          ELSEZ 
            ERROR   IOERR9                       ERROR - NOT PAGE 
          ENDIFZ
          BRANCH WRITESB
 WRITENS  LABEL 
          IFZ    ((GCODEOF,IOREGF),NE,GSYSREF),WRITENM JUMP IF NOT MN 
*      WRITE WITH MNEMONIC NAME 
          GEN    SXBPK,(VREGOF,IOVREGE),,(MNVALOF,IOREGF)  SX1 MNEM 
 WRITESB  LABEL 
          GEN    SBBPB,(VREGOF,IOVREGC),IOB1     SB3 B1 (MNEMONIC)
          BRANCH WRITEA1
 WRITENM  LABEL 
*      WRITE WITH ADVANCING LITERAL OR DATA-NAME
          MOVEZ  0,P3        INDICATE NOT A DATA-REF
          MOVEZ  IOREGF,T1                       PUT SENDER IN PARAM
          PUSH   IOREGE                          SAVE REGE
          CALLZ  MVTOXRG                         MOVE STUFF TO X REG
          MOVEZ  T1,IOVREGE                      RESULTING VREG 
          POP    IOREGE                          RESTORE REGE 
          GEN    SBBPB,(VREGOF,IOVREGC)          SB3 B0 (NOT MNEMONIC)
 WRITEA1  LABEL 
          CALLZ  SA0FIT                          SA0 TO FIT 
          CALLZ  SETRECL                         SET REC LEN IN VREGD 
          IFZ    ((FNLINAG,IOREGB),NE,0),WRITELN  JP IF LINAGE
          IFTHEN ((GSCODEOF,IOREGE),EQ,GAFTER)
 CDCS     IFNE   OP.DCS,OP.NO 
          GENOBJ  N=C.WAA,I=(IOVREGA,IOVREGC,IOVREGE,IOVREGD,IOVREGF) 
 CDCS     ELSE   1
            GENOBJ  N=C.WAA,I=(IOVREGA,IOVREGC,IOVREGE,IOVREGD) 
          ELSEZ 
 CDCS     IFNE   OP.DCS,OP.NO 
          GENOBJ  N=C.WBA,I=(IOVREGA,IOVREGC,IOVREGE,IOVREGD,IOVREGF) 
 CDCS     ELSE   1
            GENOBJ  N=C.WBA,I=(IOVREGA,IOVREGC,IOVREGE,IOVREGD) 
          ENDIFZ
          RETURN
 WRITENA  LABEL 
          CALLZ  SETAEIK                         SET X4 FOR INV KEY (VB)
          CALLZ  SETRECL                         SET RECORD LENGTH
 WRITE1   LABEL 
          CALLZ  SA0FIT 
          CALLZ  SETFO       SET T1 TO FILE ORG INDEX 
          IFZ    ((FNFOOF,IOREGB),NE,RELATIVE),WRITENR  JP IF NOT RELAT 
*         RELATIVE RETURNS KEY ON SEQ WRITE IF KEY IS PROVIDED
          MOVEZ  (VREGOF,P3),P3                  GET VIRT REG FOR RTN 
 CDCS     IFNE   OP.DCS,OP.NO 
          GENOBJ  N=C.WRIRL,I=(IOVREGA,IOVREGD,IOVREGB,IOVREGF),O=(IORTN
,RG,P3) 
 CDCS     ELSE   1
          GENOBJ  N=C.WRIRL,I=(IOVREGA,IOVREGD,IOVREGB),O=(IORTNRG,P3)
          IFZ    ((FNRLKOF,IOREGB),EQ,0),GIORTN  RETURN IF NO KEY 
          CALLZ  STOREKY                         MOVE KEY TO PLACE
          RETURN
 WRITENR  LABEL 
 CDCS     IFNE   OP.DCS,OP.NO 
          GENOBJ  N=(C.WRIAK,T1),I=(IOVREGA,IOVREGD,IOVREGB,IOVREGF),O=I
,ORTNRG 
 CDCS     ELSE   1
          GENOBJ  N=(C.WRIAK,T1),I=(IOVREGA,IOVREGD,IOVREGB),O=IORTNRG
          RETURN
          SPACE  2
 WRITELN  LABEL                                  LINAGE WRITE 
          IFZ    ((GSCODEOF,IOREGE),EQ,GAFTER),WRITELA  JP IF AFTER ADV 
          MOVEZ  (VREGOF,IORTNRG),IORTNRG 
 CDCS     IFNE   OP.DCS,OP.NO 
          GENOBJ  N=C.LINBA,I=(IOVREGA,IOVREGC,IOVREGE,IOVREGD,IOVREGF),
,O=IORTNRG
 CDCS     ELSE   1
          GENOBJ N=C.LINBA,I=(IOVREGA,IOVREGC,IOVREGE,IOVREGD),O=IORTNRG
          RETURN
 WRITELA  LABEL                                  AFT ADV WITH LINAGE
          MOVEZ  (VREGOF,IORTNRG),IORTNRG 
 CDCS     IFNE   OP.DCS,OP.NO 
          GENOBJ  N=C.LINAA,I=(IOVREGA,IOVREGC,IOVREGE,IOVREGD,IOVREGF),
,O=IORTNRG
 CDCS     ELSE   1
          GENOBJ N=C.LINAA,I=(IOVREGA,IOVREGC,IOVREGE,IOVREGD),O=IORTNRG
          RETURN
          SPACE  2
* 
**        GSWRITE - ENTERED FROM SORT/MERGE TO WRITE
* 
*         GENERATES 
*                SAME AS WRITE EXCEPT SORT RETURNS RL IN X3 
* 
 GSWRITE  EGO    2
          NOTE   GSWRITE
          PUSH    P3
          CALLZ  CKRERUN
          POP    P3 
          MOVEZ  P3,IOVREGD  RECORD LENGTH
 CDCS     IFNE   OP.DCS,OP.NO 
          GEN    MASK,(VREGOF,IOVREGF),0  DUMMY INSTRUCTION TO DEFINE 
*                                          -IOVREGF-
 CDCS     ENDIF 
          MOVEZ  (FNFOOF,IOREGB),T1              GET FILE ORG 
          IFZ    (T1,EQ,SEQUENTI),GSWR1          IF SEQUENTIAL ORG
          IFZ    (T1,EQ,RELATIVE),GSWR1          IF RELATIVE ORG
          IFZ    (T1,EQ,WORD$ADD),GSWR1          IF WORD ADDRESS
          BRANCH SWRITER                         NOT - USE RAN WRITE
 GSWR1    LABEL 
          GEN    MASK,(VREGOF,IOVREGB),0  INDICATE NO AT END
          BRANCH  WRITE1
          TITLE  CGWRITK - WRITE WITH KEY CODE GENERATOR
* 
**        CGWRITK - WRITE WITH KEY CODE GENERATOR 
* 
*         GENERATES 
*                SA0  FIT ADDR
*                MX4  1 IF INVALID KEY SPECIFIED - 0 IF NOT 
*                SX3  RECORD LENGTH 
 CDCS     IFNE   OP.DCS,OP.NO 
*                SX7  RECORD ORDINAL (CDCS I/O) 
 CDCS     ENDIF 
*                SX1  KEY IF RELATIVE FILE
*                SB6  RETURN
*                EQ   =XC.WRIXX - XX IS THE FILE ORGANIZATION 
* 
 CGWRITK  EGO    1
          NOTE   CGWRITK
          CALLZ  CKRERUN                         IF OK GEN CODE FOR RRUN
          CALLZ  SETAEIK                         SET X4 FOR INV KEY (VB)
          CALLZ  SETRECL                         SET RECORD LENGTH
 WRITEK1  LABEL 
          CALLZ  SETRLKY                         SET X REG TO KEY - RLWA
          CALLZ  SA0FIT 
          CALLZ  SETFO
          IFTHEN  ((FNFOOF,IOREGB),EQ,WORD$ADD) 
 CDCS     IFNE   OP.DCS,OP.NO 
            GENOBJ  N=C.WRRWA,I=(IOVREGA,IOVREGB,IOVREGC,IOVREGD,IOVREGF
,),O=(IORTNRG,(VREGOF,P3))
 CDCS     ELSE   1
            GENOBJ  N=C.WRRWA,I=(IOVREGA,IOVREGB,IOVREGC,IOVREGD),O=(IOR
,TNRG,(VREGOF,P3))
            CALLZ  STOREKY                       STORE KEY VALUE
            RETURN
          ELSEZ 
 CDCS     IFNE   OP.DCS,OP.NO 
            GENOBJ  N=(C.WRRAK,T1),I=(IOVREGA,IOVREGB,IOVREGC,IOVREGD,IO
,VREGF),O=IORTNRG 
 CDCS     ELSE   1
          GENOBJ  N=(C.WRRAK,T1),I=(IOVREGA,IOVREGB,IOVREGC,IOVREGD),O=I
,ORTNRG 
          ENDIFZ
          RETURN
          SPACE  2
 SWRITER  LABEL                                  HERE IF SORT/MERGE GIV 
          GEN    MASK,(VREGOF,IOVREGB),1  INDICATE INVALID KEY
          BRANCH WRITEK1
          TITLE  GENERAL USE SUBROUTINES
 SETMNNM  SPACE  2
 CKRERUN  EJECT 
* 
**        CKRERUN - CHECK RERUN - GEN CODE IF THERE 
* 
*         INPUT IS IOREGB (FNAT)
* 
*         DOES   - EHCKDS RERUN ON RECORD COUNT IN FNAT 
*                IF SET WILL GENERATE 
*                SA0 FIT
*                RJ   =XC.RERCT    BUMPS RERUN COUNTER AND DUMPS
* 
 CKRERUN  EGO    2
          NOTE   CKRERUN
          IFTHEN  ((FNRRCOF,IOREGB),NE,0)  TRUE IF RERUN ON N RECS
            CALLZ  SA0FIT 
            GENOBJ  N=C.RERCT,I=IOVREGA    GENERATE CALL TO COUNT REC 
          ENDIFZ
          RETURN
          SPACE  2
* 
**        MVTOXRG - MOVE DATA (NUMERIC ONLY) TO AN X REGISTER 
* 
*         INPUT IS DNAT ADDR IN T1
*                GCODEOF OF SENDER IN P3
* 
*         OUTPUT IS VREG NUMBER IN T1 (OF RESULTING X REG)
* 
*         SAVES 
*                IOVREGA THRU IOVREGF 
*                IOREGB AND ASSOCIATED FIXED TABLE
* 
*         MOST OTHER FIXED CELLS ARE DESTROYED
* 
* 
 MVTOXRG  EGO    2
          NOTE   MVTOXRG
          PUSH   IOREGB 
          PUSH   IOVREGA,IOVREGB,IOVREGC,IOVREGD,IOVREGE,IOVREGF
          MOVEZ  IOREGB,P1
          MOVEZ  REGT12,P2
          CALLZ  REGMOVE                         SAVE  FIXED TABLE
          IFTHEN  (P3,EQ,GDATAREF)
*      SENDER IS DNAT (DATA REF)
            MOVEZ  0,P1 
            MOVEZ  IOREGX,P2
            CALLZ  REGMOVE                       ZERO OUT IOREGX
            MOVEZ  P3,(GCODEOF,IOREGX)           SET AS DATA REF
            MOVEZ  T1,(GPTROF,IOREGX)            PUT DNAT POINTER IN
            MOVEZ  IOREGX,MOVEREGA               SET AS SENDER
            MINZ   (NUMLENOF,IOREGX),8,P3        PUT SIZE IN P3 
          ELSEZ 
*      SENDER IS A LITERAL - T1 HAS SENDER REG NUMBER 
            MOVEZ  T1,MOVEREGA                   SENDER TO PROPER REG 
            MOVEZ  8,P3                          USE SIZE OF 8 FOR LITS 
          ENDIFZ
          MOVEZ  IOREGT,REGT                     SET UP FOR ADNAT 
          CALLZ  ADNAT                           ADD A TEMP DNAT
          MOVEZ  COMP1,(TYPEOF,REGT)             COMP-1 TYPE
          MOVEZ  0,(POINTOF,REGT)                NO DEC POINT 
          MOVEZ  P3,(NUMLENOF,REGT)              PUT IN SIZE
          MOVEZ  REGT,MOVEREGB                   SET UP CALL
          CALLZ  GMOVER                          GEN CODE TO GET KEY
          MOVEZ  (TREGOF,MOVEREGB),T1            RESULTING VREG NUMBER
          CALLZ  SUBDNAT                         REMOVE TEMP DNAT 
          POP    IOVREGA,IOVREGB,IOVREGC,IOVREGD,IOVREGE,IOVREGF
          POP    IOREGB 
          MOVEZ  REGT12,P1
          MOVEZ  IOREGB,P2
          CALLZ  REGMOVE                         RESTORE FIXED TABLE ENT
          RETURN
          SPACE  2
 SA0FIT   SPACE  2
* 
**        SA0FIT - SA0 (IOVREGA) TO THE FIT ADDRESS 
 CDCS     IFNE   OP.DCS,OP.NO 
*                  SA0 (IOVREGA) TO (CDCS) RELATION ORDINAL 
 CDCS     ENDIF 
* 
*         INPUT IS FNAT IN IOREGB 
* 
*         OUTPUT IS IOVREGA 
* 
 SA0FIT   EGO    2
          NOTE   SA0FIT 
 CDCS     IFNE   OP.DCS,OP.NO 
          MOVEZ  (DMRELOOF,IOREGB),T2  RELATION ORDINAL, PERHAPS
          IFZ    (T2,EQ,0),SA0FIT1  JUMP IF NOT A RELATION
          GEN    SABPK,(VREGOF,IOVREGA),IOB0,T2  SA0  RELATION ORDINAL
          RETURN
 SA0FIT1  LABEL 
 CDCS     ENDIF 
*      MAKE A REAL REG TABLE ENTRY FOR THE DNAT FOR THE FILE
          MOVEZ  0,P1 
          MOVEZ  REGU1,P2 
          CALLZ  REGMOVE
          MOVEZ  (EQUALS,GDATAREF),(GCODEOF,REGU1)
          MOVEZ  (FNDNATOF,IOREGB),(GPTROF,REGU1) 
          GEN    SABPK,(VREGOF,IOVREGA),IOB0,((FWA$OF,REGU1)) 
          RETURN
 SETAEIK  SPACE  3
* 
**        SETAEIK - SETS VREG B FOR INV KEY OR AT-END 
* 
*         INPUT IS SUB-VERB IN REG C
* 
*         OUTPUT IS MX  1 IF INV KEY, MX 2 IF AT END, MX 0 IF NONE
*                IOVREGB HAS OUTPUT 
* 
 SETAEIK  EGO    2
          NOTE   SETAEIK
          MOVEZ  (VREGOF,IORTNRG),IORTNRG        GET AE-IK RTN REG
          GOTOCASE (GSCODEOF,IOREGC)
            CASE   GTATEND,SETAIAE               AT-END 
            CASE   GTINVKEY,SETAIIK              INVALID KEY
            CASE   GNULL,SETAINL                 NEITHER (DECLARATIVE)
          ENDCASE 
          ERROR  IOERR5 
 SETAIAE  LABEL 
          GEN    MASK,(VREGOF,IOVREGB),2         MX  2 - AT END 
          RETURN
 SETAIIK  LABEL 
          GEN    MASK,(VREGOF,IOVREGB),1         MX  1 - INVALID KEY
          RETURN
 SETAINL  LABEL 
          GEN    MASK,(VREGOF,IOVREGB),0         MX  0 - NONE 
          RETURN
 SETFO    SPACE  2
* 
**        SETFO  - SETS FIXED CELL T1 TO FILE ORG INDEX 
* 
*         INPUT IS FNAT POINTER IN IOREGB 
* 
*         OUTPUT IS FILE ORG INDEX IN T1
*                AK = 0, DA = 1, IS = 2, RL = 3, SQ = 4, WA = 5 
* 
 SETFO    EGO    2
          NOTE   SETFO
          GOTOCASE  (FNFOOF,IOREGB) 
            CASE   ACTUAL$K,FOAK   ACTUAL KEY 
            CASE   DIRECT,FODA     DIRECT 
            CASE   INDEXED,FOIS    INDEXED SEQUENTIAL 
            CASE   RELATIVE,FORL   RELATIVE 
            CASE   SEQUENTI,FOSQ   SEQUENTIAL 
            CASE   WORD$ADD,FOWA   WORD ADDRESS 
          ENDCASE 
          ERROR IOERR8
 FOAK     LABEL 
          MOVEZ  0,T1 
          RETURN
 FODA     LABEL 
          MOVEZ  1,T1 
          RETURN
 FOIS     LABEL 
          MOVEZ  2,T1 
          RETURN
 FORL     LABEL 
          MOVEZ  3,T1 
          RETURN
 FOSQ     LABEL 
          MOVEZ  4,T1 
          RETURN
 FOWA     LABEL 
          MOVEZ  5,T1 
          RETURN
* 
*         SETMNNM - GENERATE MNEMONIC NAME CODE 
* 
*         INPUTS ARE POINTER IN IOREGC
* 
*         OUTPUT IS SA-RD MNEMONIC NAME 
* 
 SETMNNM  EGO    2
          NOTE   SETMNNM
* 
          MOVEZ  REGU1,REGT 
          CALLZ  ADPDNAT                         ADD A PERMANENT DNAT 
          MOVEZ  0,(BCPOF,REGT)                  SET VALUES IN DNAT 
          MOVEZ  10,(BYTLENOF,REGT) 
          MOVEZ   0,P1                            SET UP CALL TO POOL 
          MOVEZ  (IMPNMOF,IOREGC),P2             IMPLEMENTOR NAME 
          CALLZ  CLITPOOL                        POOL THE NAME
          GEN    SLRBPK,(VREGOF,IOVREGD),IOB0,((FWA$OF,REGT))  SA-D NAME
* 
          RETURN
 SETPARS  SPACE  2
* 
**        SETPARS - SETS UP PARAMETERS FOR ACCEPT/DISPLAY 
* 
*         INPUT IS DNAT PTR IN IOREGB 
* 
*         OUTPUTS 
*         ALL INSTRUCTIONS ARE SB 
*                IOVREGA  FWA 
*                IOVREGB  BCP 
* 
*         SAVES 
*                IOVREGD
* 
*         ALL OTHER FIXED CELLS CAN BE CLOBBERED
* 
 SETPARS  EGO    2
          NOTE   SETPARS
          IFZ    ((GCODEOF,IOREGB),NE,GLITREF),SETPNLT     JP IF NOT LIT
          IFZ    ((SPACESOF,IOREGB),NE,1),SETPNLT          JP IF NOT SPA
          GEN    SBBPK,(VREGOF,IOVREGA),IOB0,((EXT$OF,C.BLANK))  SB BLNKS 
          BRANCH SETPNXT
 SETPNLT  LABEL 
          GEN    SBBPK,(VREGOF,IOVREGA),IOB0,((FWA$OF,IOREGB))  SB ADDR 
 SETPNXT  LABEL 
          IFTHEN  ((GSCODEOF,IOREGB),EQ,0)
*      NOT SUBSCRIPTED
            MOVEZ  (BCPOF,IOREGB),P1
            CALLZ  SETBREG                       SET B TO BCP 
            MOVEZ  IOVREGX,IOVREGB               RESULTING V REG
            EQZ    (GSCODEOF,IOREGA),GDISPLAY,T1
            EQZ    (TYPEOF,IOREGB),VARGROUP,T2
            ANDZ   T1,T2,T1 
            IFZ    (T1,NE,0),RETURN 
            MOVEZ  (BYTLENOF,IOREGB),P1 
            CALLZ  SETBREG
            MOVEZ  IOVREGX,IOVREGC
          ELSEZ 
*      SUBSCRIPTED
            PUSH   IOVREGA,IOVREGD
            MOVEZ  IOREGB,P2
            CALLZ  SUBREF 
            GEN    SBXPB,(VREGOF,IOVREGB),P3
            GEN    SBXPB,(VREGOF,IOVREGC),P4
            POP    IOVREGA,IOVREGD
          ENDIFZ
          RETURN
 SETRECL  SPACE  2
* 
**        SETRECL - SETS IOVREGD TO RECORD LENGTH (X3 NORMALLY) 
 CDCS     IFNE   OP.DCS,OP.NO 
**                  SETS IOVREGF (X7) TO RECORD ORDINAL IF I/O VIA CDCS 
 CDCS     ENDIF 
* 
* 
 SETRECL  EGO    2
          NOTE   SETRECL
 CDCS     IFNE   OP.DCS,OP.NO 
          GEN    SXBPK,(VREGOF,IOVREGF),,(DMRORDOF,IOREGD)  SX7  REC ORD
 CDCS     ENDIF 
          MOVEZ  (FNVLREC,IOREGB),T1             V LEN REC PTR
          IFZ    (T1,NE,0),SETRL1                JP IF COMPUTED VAR L RC
          IFTHEN  (P3,NE,0)  SEE IF PRINT FILE
            GEN    SXBPK,(VREGOF,IOVREGD),IOB1,(BYTLENOF,IOREGD)  RL
          ELSEZ 
            GEN    SXBPK,(VREGOF,IOVREGD),IOB0,(BYTLENOF,IOREGD)  RL
          ENDIFZ
          RETURN
 SETRL1   LABEL 
          PUSH   P3          SAVE P3
          MOVEZ  GDATAREF,P3                     FLAG AS DNAT 
          IFZ    (P1,EQ,0),SETRL2                JP IF REC CONT DEP ON
          PUSH   P2                              SAVE FIXED LEN 
          PUSH   P1                              SAVE OCC LENGTH
          CALLZ  MVTOXRG                         PICK UP KEY FIELD
          MOVEZ  T1,IOVREGD                      RESULT REG NBR 
          POP    P1                              RESTORE OCC LEN
          CALLZ  SETXREG                         SET X TO OCC LENGTH
          GEN    IMUL,(VREGOF,IOVREGD),IOVREGD,IOVREGY 3CC SZ = OCC LN*N
          POP    P2                              RESTORE FIXED LEN
          GEN    SXXPK,(VREGOF,IOVREGD),IOVREGD,P2  BUMP BY FIXED SZ
          RETURN
 SETRL2   LABEL              RECORD CONTAINS DEP ON SPECIFIED 
          CALLZ  MVTOXRG                         PICK UP SIZE 
          MOVEZ  T1,IOVREGD 
          POP    P3          RESTORE P3 
          IFTHEN  (P3,NE,0)  SEE IF PRINT FILE
            GEN    SXXPB,IOVREGD,IOVREGD,IOB1    BUMP LEN BY 1 FOR PRINT
          ENDIFZ
          RETURN
 SETRLKY  SPACE  3
* 
**        SETRLKY - SETS X VREGC TO KEY NUMBER FOR WA OR RL FILE
*                   SETS IT TO ZERO OTHERWISE 
*         INPUT  IS INAT IN REGB
* 
*         OUTPUT IS CODE TO FETCH KEY INTO X REG
* 
*         CALLS MVOTXREG TO FETCH DATA
*                SEE IT FOR REGISTER INFO - MOST STUFF IS DESTROYED 
* 
 SETRLKY  EGO    2
          NOTE   SETRLKY
          GOTOCASE  (FNFOOF,IOREGB) 
            CASE   ACTUAL$K,SETRLIG 
            CASE   DIRECT,SETRLIG 
            CASE   INDEXED,SETRLIG
            CASE   RELATIVE,SETRLFK 
            CASE   SEQUENTI,SETRLIG 
            CASE   WORD$ADD,SETRLFK 
          ENDCASE 
          ERROR  IOERR6 
 SETRLIG  LABEL 
          GEN    MASK,(VREGOF,IOVREGC),0         MASK OF ZERO 
          RETURN                                 IGNORE - NOT APP 
 SETRLFK  LABEL 
          MOVEZ  (FNRLKOF,IOREGB),T1             DNAT FOR REL KEY 
          IFZ    (T1,EQ,0),SETRLIG     JP IF NO KEY SPECIFIED 
          MOVEZ  GDATAREF,P3
          CALLZ  MVTOXRG                         MOVE STUFF TO X REG
          MOVEZ  T1,IOVREGC                      RESULTING VREG 
          RETURN                                 EXIT 
          SPACE  2
* 
**        STOREKY - STORE KEY VALUE ON RELATIVE OR WORD ADDR FILES
* 
*         INPUTS - P3 HAS VREG NUMBER OF RETURN FROM I-O OPERATION
*                IOREGB HAS FILE
* 
*         OUTPUTS - GENS CODE TO STORE KEY VALUE
* 
*         CLOBBERS EVERYTHING 
* 
 STOREKY  EGO    2
          NOTE   STOREKY
          MOVEZ  (FNRLKOF,IOREGB),T1             DNAT PTR TO KEY
          CALLZ  STOREXX                         STORE THE KEY
          RETURN
 STORERL  SPACE  2
* 
**        STORERL - STORE RECORD LENGTH IF RCONT D-N
* 
*         INPUTS - P3 HAS VREG NUMBER OF RETURNED REC LEN 
* 
*         OUTPUTS - CODE TO STORE IT
* 
*         CLOBBERS EVERYTHING 
* 
 STORERL  EGO    2
          NOTE   STORERL
          PUSH   P3          SAVE P3 - FNVLREC  CHANGES IT
          MOVEZ  (FNVLREC,IOREGB),T1             GET VAR LEN STUFF
          POP    P3 
          IFTHEN  (T1,NE,0) 
            CALLZ  STOREXX                       V -LEN - STORE LENGTH
          ENDIFZ
          RETURN
 STOREXX  SPACE  2
* 
**        STOREXX - STORE AN X REGISTER 
* 
*         INPUTS - P3 HAS VREG NUMBER OF RETURN X REG 
*                T1 HAS DNAT ADDR OF PLACE TO PUT IT
* 
*         CLOBBERS EVERYTHING 
* 
 STOREXX  EGO    2
          MOVEZ  (LOCLAB,GBRFLAB),GBRFLAB        GET LOC LABEL
*      GEN A BRANCH AROUND STORE IF AN EXCEPTION (INV KEY OR AT END)
          GEN    NE$,IOB0,IORTNRG,((LOCAL$OF,GBRFLAB))  SKIP IF EXCEPT
          GEN    HOLDR,IORTNRG                   PUT HOLD ON RETURN 
          MOVEZ  IOREGB,P1
          MOVEZ  REGT12,P2
          CALLZ  REGMOVE                         SAVE IOREGB REGTABLE 
          MOVEZ  0,P1 
          MOVEZ  IOREGY,P2
          CALLZ  REGMOVE                         CLEAR REG OUT
          MOVEZ  GDATAREF,(GCODEOF,IOREGY)       INDICATE A DATA REF
          MOVEZ  T1,(GPTROF,IOREGY)              POINT TO DNAT
          MOVEZ  (EQUALS,IOREGY),MOVEREGB        SET RECEIVER FOR MOVE
          MOVEZ  IOREGT,REGT                     SET UP FOR ADNAT 
          CALLZ  ADNAT                           MAKE A TEMP DNAT FOR IT
          MOVEZ  COMP1,(TYPEOF,REGT)             INDICATE IT IS COMP1 
          MOVEZ  0,(POINTOF,REGT)                NO POINT 
          MINZ   (NUMLENOF,IOREGY),8,(NUMLENOF,REGT)  SIZE MIN OF 8 
          MOVEZ  REGT,MOVEREGA                   INDICATE SENDER
          MOVEZ  P3,(TREGOF,MOVEREGA)            SET VREG OF SENDER 
          CALLZ  GMOVER                          MOVE TO CORE 
          MOVEZ  REGT12,IOREGB                   POINT TO SAVED REGTABLE
          CALLZ  SUBDNAT                         REMOVE TEMP DNAT 
          GEN    RFREE,IORTNRG                   RELEASE HELD REGISTER
          GEN    LABEL$,((LOCAL$OF,GBRFLAB))
          RETURN                                 EXIT 
          END 
