*DECK QDSSLIB                                                           003340
      PRGM DL30305;                # THIS IS 3,5 OVERLAY               #003350
      BEGIN                                                             003360
 #                                                                      003370
* *   DL30305                                    PAGE  1                003380
* *   QDSSLIB - QU SUB-SCHEMA LIBRARY                                   003390
* *   S N TAM                                    DATE  02/05/79         003400
*                                                                       003410
*     DESCRIPTION                                                       003420
*                                                                       003430
*     THIS OVERLAY IS CALLED TO MAINTAIN OR TO CREATE A SUB-SCHEMA      003440
*     LIBRARY FILE.  THE SUB-SCHEMA LIBRARY IS A WORD ADDRESSABLE FILE. 003450
*     ANY MODIFICATIONS (I.E. WRITES) DONE TO THE FILE START AT THE     003460
*     WORD ADDRESS OF THE (END-OF-FILE MARKER, EOFM) + 1.  THIS ADDRESS 003470
*     IS OBTAINED BY TRACING BACK STARTING AT THE WORD ADDRESS OF THE   003480
*     FILE"S EOI, UNTIL THE END-OF-FILE MARKER IS FOUND.  THIS MARKER   003490
*     RESIDES ON THE FILE AS A TEN CHARACTER NAME "ENDOFSSFIL".  THE    003500
*     WORD ADDRESS OF THE EOI IS PASSED FROM THE EXTERNAL ROUTINE OPENSB003510
*     IN CELL NEWFILE.                                                  003520
*     A CONTROL WORD ALWAYS PRECEDES THE EOFM, WHICH IN TURN IS PRECEDED003530
*     BY THE INDEX TABLE.  THE INDEX TABLE CONTAINS A FOUR WORD ENTRY   003540
*     FOR EACH SUB-SCHEMA IN THE FILE.  THE FIRST THREE WORDS ARE FOR   003550
*     THE SUB-SCHEMA NAME AND THE FOURTH ONE CONTAINS THE WORD ADDRESS  003560
*     AND LENGTH OF THE SUB-SCHEMA.  THE LAST CONTROL WORD WILL ALWAYS  003570
*     CONTAIN THE ADDRESS OF THE START OF THE ACTIVE INDEX TABLE.  A    003580
*     NEW INDEX TABLE AND A NEW CONTROL WORD ARE WRITTEN FOR ANY MODI-  003590
*     FICATIONS TO THE FILE (I.E. PUTTING INFORMATION IN THE FILE).     003600
*                                                                       003610
 #                                                                      003620
                                                                        003630
                                                                        003640
      DEF BUFSIZ #4096#; # BUFFER SIZE                                 #003650
      DEF SSDIRLEN  #8#; # LENGTH OF SUB-SCHEMA DIRECTORY CONTROL WORD #003660
      XREF                                                              003670
        BEGIN                                                           003680
        PROC CBPINIT;    # SCAN SOURCE RECORD FOR SNYTACTIC TYPE       #003690
        PROC CLSEOUT;    # CLOSE THE OUTPUT FILE                       #003700
        PROC CLSESB;     # CLOSE THE SUB-SCHEMA FILE                   #003710
        PROC DDLABT;     # DDL ABORT                                   #003720
        PROC DDLCLNL;    # CLOSE NEW LIBRARY FILE                      #003730
        PROC DDLINIT;    # INITIAL ENTRY IN CTLSCAN                    #003740
        PROC DDLOPNL;    # OPEN NEW LIBRARY FILE                       #003750
        PROC DDLPRNT;    # WRITE MESSAGES TO OUTPUT FILE               #003760
        PROC DDLRDSB;    # READ FROM SUB-SCHEMA FILE                   #003770
        PROC DDLRTNL;    # WRITE TO THE NEW LIBRARY FILE               #003780
        PROC DDLRTSB;    # WRITE TO SUB-SCHEMA FILE                    #003790
        PROC EXTSB;      # EXTEND FILE                                 #003800
        PROC GETENT;     # READ FROM SCRATCH FILE                      #003810
        PROC LEXSCAN;    # SCAN THRU THE SUB-SCHEMA NAME               #003820
        PROC OPENSB;     # OPEN SUB-SCHEMA FILE                        #003830
        PROC OPENZZ;     # OPEN THE SCRATCH FILE                       #003840
        PROC RETNZZ;     # CLOSE AND UNLOAD THE SCRATCH FILE           #003850
                         # OR NEW LIBRARY FILE                         #003860
                                                                        003870
        ITEM ABORTFLAG;  # SET IF FATAL ERRORS ENCOUNTERED.            #003880
        ITEM DDLSU;      # CONTAINS THE STORAGE USED BY DDL            #003890
        ITEM ERRCNTR;    # CONTAINS THE COUNT OF DIAGNOSTICS ISSUED.   #003900
        ITEM EXHSS;      # EXHIBIT ALL SS NAMES AND DATES---- FLAG     #003910
        ITEM FIRSTWORD;  # LWA+1 OF THE LARGEST OVERLAY                #003920
        ITEM NEWFILE;    # CONTAINS THE STATUS OF THE SUB-SCHEMA FILE  #003930
                         # ---- WHETHER FILE TO BE CREATED OR NOT.     #003940
        ITEM NEWLIB U;   # FLAG/LFN FOR SUBSCHEMA LIB COPY             #003950
        ITEM NEXLENG;    # LENGTH IN CHARS OF SYNTAX ELEMENT           #003960
        ITEM NEXTYPE;    # CONTAINS THE SYNTACTIC TYPE OF CURRENT      #003970
                         # SOURCE WORD.                                #003980
        ITEM PURGESS;    # PURGE SUB-SCHEMA IN FILE---FLAG             #003990
        ITEM REPLACESS;  # REPLACE SUB-SCHEMA IN FILE--- FLAG          #004000
        ITEM SBLFN;      # CONTAINS THE SUBSCHEMA FILE NAME.           #004010
        ITEM SBLOCK;     # SUB-SCHEMA DIRECTORY CONTROL WORD ADDRESS   #004020
                                                                        004030
        ARRAY NEXWORD [25] S(1);                                        004040
          BEGIN                                                         004050
          ITEM NEXWRD30 C(00,00,30);  # CURRENT SUB-SCHEMA NAME        #004060
          ITEM NEXWRD U(00,00,60);    # DATA NAME OF THE INPUT RECORD  #004070
          END                                                           004080
        END     # XREF #                                                004090
                                                                        004100
      BASED ARRAY SCHBLOCK [0] S(SSDIRLEN);    # SS DIRECTORY CTL WORD #004110
        BEGIN                                                           004120
*CALL COMQUSBLK               COMDECK FOR SCHBLOCK                      004130
        END                                                             004140
                                                                        004150
      ARRAY COMMESG[7] S(1);
        BEGIN                       # INFORMATIVE OR ERROR MESSAGES    #004170
        ITEM CMESG C(0,0,10);                                           004180
        ITEM CMESG30 C(0,0,30);                                         004190
        END                                                             004200
      ARRAY NEWINDBUF [0] S(4);     # BUFFER FOR INDEX ENTRY           #004210
        BEGIN                       # NEW SUBSCHEMA LIB                #004220
        ITEM NEWSSNM30 C(0,0,30);   # SUB-SCHEMA NAME                  #004230
        ITEM NEWSSWA U(3,0,30);     # SUBSCH WORD ADDR IN FILE         #004240
        ITEM NEWSSLEN U(3,30,30);   # SUBSCH LENGTH IN WORDS           #004250
        END                                                             004260
      ARRAY OLDINDBUF [0] S(4);     # BUFFER FOR INDEX ENTRY           #004270
        BEGIN                       # OLD SUBSCHEMA LIB                #004280
        ITEM OLDSSNM30 C(0,0,30);   # SUB-SCHEMA NAME                  #004290
        ITEM OLDSSWA U(3,0,30);     # SUBSCH WORD ADDR IN FILE         #004300
        ITEM OLDSSLEN U(3,30,30);   # SUBSCH LENGTH IN WORDS           #004310
        END                                                             004320
      ARRAY SSCNTRLWRD [0];                                             004330
        BEGIN                                                           004340
        ITEM SUBSCHCOUNT U(0,0,12);  # COUNT OF SUB-SCHEMAS IN FILE    #004350
        ITEM SSINDXSTRT U(0,12,48);  # ADDRESS WHERE INDEX TABLE STARTS#004360
        END                                                             004370
      ARRAY SSNAMARR [0:2] S(1);                                        004380
        BEGIN                                                           004390
        ITEM SSNAM30 C(00,00,30);   # SUB-SCHEMA NAME                  #004400
        END                                                             004410
      ARRAY SSWORKBUF [BUFSIZ] S(1);         # SUB-SCHEMA LIB BUFFER   #004420
        BEGIN                                                           004430
        ITEM SSINDXNAME U(0,0,60);  # SS NAME IN INDEX TABLE ENTRY.    #004440
        ITEM INDTBLEND C(0,0,10);   # ACTUAL END OF SUB-SCHEMA FILE    #004450
        ITEM SSINDXNME30 C(0,0,30);                                     004460
        ITEM SSWRDADDR U(3,0,30);   # WORD ADDRESS WHERE SS RESIDES.   #004470
                                    # IN FILE.                         #004480
        ITEM SSINDXLEN U(3,30,30);  # SUB-SCHEMA LENGTH                #004490
        END                                                             004500
                                                                        004510
      ITEM ABRTFLAG B;   # A FATAL ERROR FLAG                          #004520
      ITEM EXTFLAG B;    # FLAG TO SAY EXTEND SHOULD BE DONE           #004530
      ITEM FLAG B;       # STATUS FLAG                                 #004540
      ITEM FWANEWIND;    # CONTAINS FWA OF THE INDEX TABLE             #004550
                         # ON THE NEW SUBSCH LIB FILE                  #004560
      ITEM FWANEWSS;     # CONTANS UPDATED FWA ON NEW SUBSC            #004570
                         # LIB FILE FOR SUBSCH WRITES                  #004580
      ITEM FWAOLDSS;     # CONTAINS UPDATE FWA ON OLD SUBSC            #004590
                         # LIB FILE FOR SUBSCH READS                   #004600
      ITEM I, J, K, L;   # SCRATCH VARIABLES                           #004610
      ITEM LENGMVD;      # CONTAIN NBR OF WORDS MOVED DURING READ/WRITE#004620
      ITEM LNGSSMODBFS;  # LENGTH OF SUBSCHEMA MODULE BUFFER SIZE      #004630
      ITEM LNGSSREAD;    # NBR OF WORDS TO READ FROM SUBSCHEMA FILE    #004640
      ITEM NBRBUFSS;     # NBR OF BUFFERS TO WRITE FROM SUBSCHEMA FILE #004650
      ITEM NEWINDXWA U;  # WA ON NEW LIB FILE OF NEXT AVAIL INDX ENTRY #004660
      ITEM SBADJLENG;    # CONTAINS THE LENGTH ADJUSTED TO PRU BOUNDARY#004670
      ITEM SSCOUNT;      # SUB-SCHEMA COUNT                            #004680
      ITEM SSCTLWDADR;   # CONTAINS THE ADDRESS OF THE CONTROL WORD OF #004690
                         # THE SUBSCHEMA FILE.                         #004700
      ITEM SSLENG;       # SUB-SCHEMA LENGTH                           #004710
      ITEM WRDADRINDX;   # CONTAINS WA OF THE INDEX TABLE ENTRY        #004720
                                                                        004730
#**********************************************************************#004740
#                                                                      #004750
#                    DIAGNOSTIC / INFORMATIVE MESSAGES                 #004760
#                                                                      #004770
#**********************************************************************#004780
      ARRAY MESSAGE1 [0:7];                                             004790
        ITEM MESG1 C(0,0,10) = ["*****DID N", "OT LOCATE ", "SUB-SCHEMA"004800
         ," TO BE REP","LACED --- ","NEW SUB-SC","HEMA HAS B",          004810
          "EEN ADDED "];                                                004820
      ARRAY MESSAGE2 [0:9];                                             004830
        ITEM MESG2 C(0,0,10) = ["*****SUB-S","CHEMA WITH"," THE SAME ", 004840
          "NAME AS TH","E NEW SUB-","SCHEMA ALR","EADY EXIST",          004850
          "S --- FILE"," NOT UPDAT","ED        "];                      004860
      ARRAY MESSAGE3 [0:7];                                             004870
        ITEM MESG3 C(0,0,10) = ["*****DID N","OT LOCATE ","          ", 004880
          "          ","          ","--PURGE NO","T POSSIBLE"];         004890
      ARRAY MESSAGE4[0:5];                                              004900
        ITEM MESG4 C(0,0,10) = ["     SUB-S","CHEMA,    ","          ", 004910
          "          ","          ",",PURGED   "];                      004920
      ARRAY MESSAGE5 [0:3];                                             004930
        ITEM MESG5 C(0,0,10) = ["          ","LIST OF SU",              004940
          "B-SCHEMAS ","IN FILE   "];                                   004950
      ARRAY MESSAGE6A [0:5];                                            004960
        ITEM MESG6A C(0,0,10) = ["0         ","SUB-SCHEMA",             004970
          "          ","          ","  --------","--------  "];         004980
      ARRAY MESSAGE6B [0:5];                                            004990
        ITEM MESG6B C(0,0,10) = ["         -","----------",             005000
          "          ","          ","  --------","--------  "];         005010
      ARRAY MESSAGE7 [0:6];                                             005020
        ITEM MESG7 C(0,0,10) = ["0         ","     -----","       END", 005030
          " OF FILE M","AINTENANCE","          ","     -----"];         005040
      ARRAY MESSAGE8 [0:3];                                             005050
        ITEM MESG8 C(0,0,10) = ["***** WARN","ING-- EMPT","Y SUBSCHEM", 005060
          "A FILE    "];                                                005070
      ARRAY MESSAGE9 [0:7];                                             005080
        ITEM MESG9 C(0,0,10) = ["0         ","     -----","       BEG", 005090
          "IN SUB-SCH","EMA FILE M","AINTENANCE","          ",          005100
          "     -----"];                                                005110
      ARRAY MESSAGE10 [0:5];                                            005120
        ITEM MESG10 C(0,0,10) = ["*****ILL-F","ORMATTED L","IBRARY -- ",005130
          "NOT UPDATA","BLE, DDL A","BORTED    "];                      005140
                                                                        005150
      ARRAY MESSAGE11 [0:3];                                            005160
        ITEM MESG11 C(0,0,10) = ["***** EMPT", "Y SUBSCHEM",            005170
                    "A FILE, DD", "L ABORTED" ];                        005180
      ARRAY MESSAGE12 [0:5];                                            005190
        ITEM MESG12 C(0,0,10) = ["          ", "     -----",            005200
                    "       NEW", " SUBSCHEMA", " LIBRARY G",           005210
                    "ENERATED" ];                                       005220
      ARRAY MESSAGE13 [0:6];                                            005230
        ITEM MESG13 C(0,0,10) = ["***** OLD ","SUBSCHEMA ","FILE BAD, ",005240
                    "SUBSCHEMA ","LENGTH IS ","ZERO.  DDL"," ABORTED  " 005250
                    ];                                                  005260
      ARRAY MESSAGE14 [0:4];                                            005270
        ITEM MESG14 C(0,0,10) = ["***** EMPT","Y INPUT FI","LE---PURGE",005280
                    " NOT POSSI","BLE       " ];                        005290
                                                                        005300
                                                                        005310
      CONTROL EJECT;                                                    005320
#**********************************************************************#005330
#                                                                      #005340
#      E X E C U T A B L E   C O D E   F O R   Q D S S L I B           #005350
#                                                                      #005360
#**********************************************************************#005370
      CMESG[0] = "          ";                                          005380
      DDLPRNT (MESSAGE9, 80);                                           005390
      DDLPRNT (COMMESG,10);                                             005400
      ABRTFLAG = FALSE;                                                 005410
      EXTFLAG = FALSE;                                                  005420
      P<SCHBLOCK> = LOC(SBLOCK);  # WORD ADDR OF SS DIRECTORY CTLWD    #005430
      OPENSB;            # OPENS SUB-SCHEMA LIBRARY FILE               #005440
      IF NEWFILE LQ 1 AND EXHSS NQ 1 AND PURGESS NQ 1 THEN              005450
        IF NEWLIB EQ 0  THEN                                            005460
          GOTO CREATESSFL;                                              005470
                                                                        005480
        ELSE                                                            005490
          BEGIN                                                         005500
          DDLPRNT (MESSAGE11,40); # EMPTY SUB-SCHEMA FILE, ABORT DDL   #005510
          ERRCNTR = ERRCNTR + 1;  # UPDATE ERROR COUNTER               #005520
          ABRTFLAG = TRUE;        # SET ABORT FLAG                     #005530
          GOTO EXIT1;                                                   005540
                                                                        005550
          END                                                           005560
                                                                        005570
#     LOOK FOR THE END OF INFORMATION OF THE SUB-SCHEMA LIBRARY FILE   #005580
LOOP:                                                                   005590
      IF NEWFILE LQ 1 THEN                                              005600
        BEGIN                                                           005610
        DDLPRNT (MESSAGE10,60); # ILLFORMATTED LIB, NOT UPDATABLE      #005620
        ERRCNTR = ERRCNTR + 1;                                          005630
        ABRTFLAG = TRUE;                                                005640
        GOTO EXIT1;                                                     005650
                                                                        005660
        END                                                             005670
      IF NEWFILE LQ BUFSIZ THEN                                         005690
        I = NEWFILE;                                                    005710
      ELSE                                                              005740
        I = BUFSIZ;                                                     005750
      J = NEWFILE -I+1;  # START OF READ TO SEARCH FOR ACTUAL END OF SS#
      DDLRDSB (LOC(SSWORKBUF), I, J);       # READ FROM SUB-SCHEMA FILE#005770
      FOR J = I-1 STEP -1 UNTIL 0 DO  # THE SUBSCHEMA FILE STARTING AT #005780
        BEGIN                     # EOI, SO AS TO FIND THE ACTUAL END  #005790
        IF INDTBLEND[J] EQ "ENDOFSSFIL" THEN  # IF END OF FILE MARKER  #005800
          BEGIN                                                         005810
          SSCTLWDADR = NEWFILE - I + J; 
          J = 0;                                                        005830
          END                                                           005840
        END                                                             005850
      IF SSCTLWDADR EQ 0 THEN                                           005860
        BEGIN                                                           005870
        NEWFILE = NEWFILE - I;                                          005880
        GOTO LOOP;                                                      005890
                                                                        005900
        END                                                             005910
      DDLRDSB (LOC(SSCNTRLWRD), 1, SSCTLWDADR); # READ A CONTROL WORD  #005920
      FOR J = 0 STEP 1 UNTIL I-1 DO                                     005930
        SSINDXNAME[J] = 0;         # ZERO OUT THE SSWORKBUF            #005940
      IF NEWLIB NQ 0  THEN                                              005950
        GOTO COPYSSFL;             # GENERATE A MODIFIED SS FILE       #005960
                                                                        005970
      IF PURGESS EQ 1 THEN                                              005980
        GOTO PURSUBSCH;            # PURGE SUB-SCHEMA FROM FILE        #005990
                                                                        006000
      IF REPLACESS EQ 1 THEN                                            006010
        GOTO REPLSUBSCH;           # REPLACE A SUB-SCHEMA IN FILE      #006020
                                                                        006030
      IF EXHSS EQ 1 THEN                                                006040
        GOTO EXHSSNAMES;           # LIST ALL ACTIVE SS NAMES          #006050
      CONTROL EJECT;                                                    006060
 #                                                                      006070
* *   DL30305                                    PAGE  1                006080
* *   ADDTOSSFL - ADD SUB-SCHEMA TO FILE                                006090
* *   S N TAM                                    DATE  02/05/79         006100
*                                                                       006110
*     DESCRIPTION                                                       006120
*                                                                       006130
*     CHECKS IF THE SUB-SCHEMA FILE IS EMPTY.  IF SO, IT WRITES AN      006140
*     INFORMATIVE MESSAGE (MESSAGE8) TO THE OUTPUT FILE.  THEN          006150
*     SRCHSSNAME IS CALLED TO SEARCH THE INDEX TABLE FOR A MATCHING     006160
*     SUB-SCHEMA NAME.  IF ONE IS FOUND (FLAG=TRUE RETURNED FROM        006170
*     SRCHSSNAME), AN INFORMATIVE MESSAGE (MESSAGE2) IS WRITTEN TO THE  006180
*     OUTPUT FILE, AND CONTROL IS PASSED TO LABEL EXIT1.  ELSE, PUTSB   006190
*     IS CALLED TO COPY THE SUB-SCHEMA FROM THE SCRATCH FILE TO THE     006200
*     SUB-SCHEMA LIBRARY FILE.  A NEW SUB-SCHEMA INDEX TABLE IS CREATED 006210
*     AND WRITTEN TO THE LIBRARY FILE, AND CONTROL IS PASSED TO LABEL   006220
*     EXIT.                                                             006230
*                                                                       006240
 #                                                                      006250
                                                                        006260
                                                                        006270
ADDTOSSFL:                                                              006280
      IF SUBSCHCOUNT[0] EQ 0 THEN # IF FILE EMPTY, THEN                #006290
        BEGIN                                                           006300
        DDLPRNT (MESSAGE8, 40);    # ISSUE WARNING MESSAGE             #006310
        ERRCNTR = ERRCNTR + 1;                                          006320
        END                                                             006330
      SSNAM30[0] = SNM[0];  # SUB-SCHEMA NAME                          #006340
      SRCHSSNAME;                                                       006350
      IF FLAG THEN                # THE SAME NAME AS THE ONE TO BE     #006360
        BEGIN                     # ADDED ALREADY EXISTS. IF SO,       #006370
        DDLPRNT (MESSAGE2, 96);   # ISSUE DIAGNOSTIC AND ABORT.        #006380
        ERRCNTR = ERRCNTR + 1;                                          006390
        ABORTFLAG = 1;                                                  006400
        GOTO EXIT1;                                                     006410
                                                                        006420
        END                                                             006430
      PUTSB (SSCTLWDADR+2);             # WRITE SUBSCHEMA TO FILE      #006440
      INDXTBLNEW (SSCTLWDADR+2+SSLENG);    # NEW INDEX TABLE           #006450
      INDXTBLUPD (SSCTLWDADR+2);                                        006460
      SUBSCHCOUNT[0] = SUBSCHCOUNT[0] + 1; # INCREMENT SUBSCH COUNTER  #006470
      DDLRTSB (LOC(SSWORKBUF), 4, WRDADRINDX);  # WRITE INDEX TABLE    #006480
      DDLRTSB (LOC(SSCNTRLWRD), 1, WRDADRINDX+4);  # WRITE CONTROL WORD#006490
      WRDADRINDX = WRDADRINDX + 5;                                      006500
      GOTO EXIT;                  # GO TO EXIT.                        #006510
      CONTROL EJECT;                                                    006520
 #                                                                      006530
* *   DL30305                                    PAGE  1                006540
* *   CREATESSFL - CREATE A NEW SUB-SCHEMA LIBRARY FILE                 006550
* *   S N TAM                                    DATE  02/05/79         006560
*                                                                       006570
*     DESCRIPTION                                                       006580
*                                                                       006590
*     IF THE "R" PARAMETER WAS SPECIFIED ON THE DDL3 CONTROL STATEMENT, 006600
*     WARNING DIAGNOSTICS (MESSAGE8 AND MESSAGE1) ARE WRITTEN TO THE    006610
*     OUTPUT FILE.  THE SUB-SCHEMA COUNT INITIALIZED TO ONE AND THEN    006620
*     PUTSB IS CALLED TO COPY THE SUB-SCHEMA FROM THE SCRATCH FILE TO   006630
*     THE LIBRARY FILE.  INDXTBLUPD IS THEN CALLED TO GENERATE THE INDEX006640
*     TABLE WHICH IS THEN WRITTEN TO THE LIBRARY.                       006650
*                                                                       006660
 #                                                                      006670
                                                                        006680
                                                                        006690
CREATESSFL:                                                             006700
      IF REPLACESS EQ 1 THEN                                            006710
        BEGIN                      # SUBSCHEMA TO BE REPLACED - ERROR  #006720
        DDLPRNT (MESSAGE8, 40);    # EMPTY SUB-SCHEMA FILE             #006730
        DDLPRNT (MESSAGE1, 80);    # EMPTY SS FILE, CANNOT FIND SS     #006740
        ERRCNTR = ERRCNTR + 1;     # UPDATE ERROR COUNTER              #006750
        END                                                             006760
      SSNAM30[0] = SNM[0];         # SUB-SCHEMA NAME                   #006770
      SUBSCHCOUNT[0] = 1;          # INITIALIZE SUB-SCHEMA COUNTER     #006780
      PUTSB (1);                   # PUT SUBSCHEMA IN FILE             #006790
      SSINDXSTRT[0] = SAREAINDXADR[0] + SAREAINDXLEN[0] + 1;            006800
                                   # STARTING ADDR OF INDEX TABLE      #006810
      INDXTBLUPD (1);                                                   006820
      DDLRTSB (LOC(SSWORKBUF), 4, SSINDXSTRT[0]);   # WRITE INDEX TABLE#006830
      WRDADRINDX = SSINDXSTRT[0] + 4; # IN FILE, AND STORE NEXT AVAIL. #006840
      DDLRTSB (LOC(SSCNTRLWRD), 1, WRDADRINDX);  # WRITE CONTROL WORD  #006850
      WRDADRINDX = WRDADRINDX + 1;     # IN FILE AND UPDATE ADDRESS    #006860
      GOTO EXIT;                                                        006870
      CONTROL EJECT;                                                    006880
 #                                                                      006890
* *   DL30305                                    PAGE  1                006900
* *   PURSUBSCH - PURGE SUB-SCHEMA FROM FILE                            006910
* *   S N TAM                                    DATE  02/05/79         006920
*                                                                       006930
*     DESCRIPTION                                                       006940
*                                                                       006950
*     CBPINIT (AN ENTRY POINT IN CTLSCAN) IS CALLED TO SCAN THE FIRST   006960
*     SOURCE WORD ON THE INPUT RECORD AND SET ITS TYPE.  IF THE NUMBER  006970
*     OF ACTIVE SUB-SCHEMAS IN THE LIBRARY FILE IS ZERO, A DIAGNOSTIC   006980
*     (MESSAGE11) IS ISSUED AND CONTROL IS PASSED TO LABEL EXIT1.       006990
*     OTHERWISE, FOR EACH SUB-SCHEMA NAME IN THE INPUT RECORD,          007000
*     SRCHSSNAME IS CALLED TO SEARCH THE INDEX TABLE FOR A MATCHING     007010
*     SUB-SCHEMA NAME.  IF THE NAME IS NOT FOUND (FLAG=FALSE RETURNED   007020
*     FROM SRCHSSNAME), AN INFORMATIVE MESSAGE (MESSAGE3) IS ISSUED     007030
*     AND IT PROCEEDS TO THE NEXT SUB-SCHEMA NAME.  ELSE, THE INDEX     007040
*     TABLE IS UPDATED TO REFLECT THE PURGE AND MESSAGE (MESSAGE4)      007050
*     IS ISSUED TO INDICATE THAT THE SUB-SCHEMA HAS BEEN PURGED.        007060
*     IF NO SUB-SCHEMA NAME HAS BEEN SPECIFIED ON THE INPUT RECORD, A   007070
*     DIAGNOSTIC (MESSAGE14) IS ISSUED AND CONTROL IS PASSED TO         007080
*     LABEL EXIT1.                                                      007090
*     IF ANY SUB-SCHEMA HAS BEEN PURGED THEN THE INDEX TABLE IS         007100
*     REWRITTEN TO REFLECT THE NEW LIBRARY AND CONTROL IS PASSED        007110
*     TO LABEL EXIT1.                                                   007120
*                                                                       007130
 #                                                                      007140
                                                                        007150
                                                                        007160
PURSUBSCH:                                                              007170
      DDLSU = FIRSTWORD; # DDL STORAGE USED                            #007180
      CBPINIT;           # SCAN FIRST SOURCE RECORD FOR SYNTACTIC TYPE #007190
      SSCOUNT = 0;       # INITIALIZE COUNT OF SUBSCHEMAS BEING PURGED #007200
      IF SUBSCHCOUNT[0] EQ 0 THEN                                       007210
        BEGIN            # EMPTY SUB-SCHEMA FILE, DDL ABORT            #007220
        DDLPRNT (MESSAGE11, 40);                                        007230
        ERRCNTR = ERRCNTR + 1;                                          007240
        ABRTFLAG = TRUE;                                                007250
        GOTO EXIT1;                                                     007260
                                                                        007270
        END                                                             007280
      FOR I = 1 STEP 1 WHILE NEXTYPE EQ 101 DO  # LOOP THRU INPUT RE-  #007290
        BEGIN            # CORD FOR SYNTACTIC TYPE "NAMES".            #007300
        SSNAM30[0] = NEXWRD30[0];  # CURRENT SUB-SCHEMA NAME           #007310
        SRCHSSNAME;        # SEARCH THRU INDEX TABLE FOR SS NAME       #007320
        IF NOT FLAG THEN   # IF NAME NOT FOUND THEN ISSUE DIAGNOSTIC   #007330
          BEGIN                                                         007340
          SSMSG (LOC(MESSAGE3), LOC(NEXWORD), NEXLENG);                 007350
          DDLPRNT (MESSAGE3, 70);                                       007360
          ERRCNTR = ERRCNTR + 1;                                        007370
          LEXSCAN;       # SCAN THRU THE SUB-SCHEMA NAME               #007380
          TEST I;                                                       007390
                                                                        007400
          END                                                           007410
        INDXTBLNEW (SSCTLWDADR+2);   # WRITE NEW INDEX TABLE           #007420
        SUBSCHCOUNT[0] = SUBSCHCOUNT[0] - 1;     # DECREMENT COUNT OF  #007430
                         # SUBSCHEMAS IN FILE TO REFLECT THE PURGE.    #007440
        SSCOUNT = SSCOUNT + 1;                                          007450
        SSMSG (LOC(MESSAGE4), LOC(NEXWORD), NEXLENG);                   007460
        DDLPRNT (MESSAGE4, 57);    # SUB-SCHEMA PURGED                 #007470
        LEXSCAN;                   # SCAN THRU THE SUB-SCHEMA NAME     #007480
        END                                                             007490
      IF I EQ 1 THEN     # IF NO NAMES SPECIFIED IN INPUT RECORD,      #007500
        BEGIN            # THEN ISSUE DIAGNOSTIC TO THAT EFFECT.       #007510
        DDLPRNT (MESSAGE14, 50);                                        007520
        ERRCNTR = ERRCNTR + 1;                                          007530
        ABRTFLAG = TRUE;                                                007540
        GOTO EXIT1;                                                     007550
                                                                        007560
        END                                                             007570
      IF SSCOUNT GR 0 THEN                                              007580
        BEGIN                                                           007590
        DDLRTSB (LOC(SSCNTRLWRD), 1, WRDADRINDX);  # WRITE CONTROL WORD#007600
        WRDADRINDX = WRDADRINDX + 1;                                    007610
        INDTBLEND[0] = "ENDOFSSFIL";               # END OF FILE MARKER#007620
        DDLRTSB (LOC(SSWORKBUF), 1, WRDADRINDX);   # WRITE EOF MARKER  #007630
        EXTFLAG = TRUE;                            # EXTEND FILE       #007640
        END                                                             007650
      GOTO EXIT1;                                                       007660
      CONTROL EJECT;                                                    007670
 #                                                                      007680
* *   DL30305                                    PAGE  1                007690
* *   REPLSUBSCH - REPLACE A SUBSCHEMA IN LIBRARY FILE                  007700
* *   S N TAM                                    DATE  02/05/79         007710
*                                                                       007720
*     DESCRIPTION                                                       007730
*                                                                       007740
*     IF THE SUB-SCHEMA LIBRARY IS EMPTY, AN INFORMATIVE MESSAGE        007750
*     (MESSAGE8) IS WRITTEN TO THE OUTPUT FILE.  PROC PUTSB IS CALLED   007760
*     TO COPY THE SUB-SCHEMA FROM THE SCRATCH FILE TO THE LIBRARY.      007770
*     THEN SRCHSSNAME IS CALLED TO SEARCH THE INDEX TABLE FOR A MATCHING007780
*     SUB-SCHEMA NAME.  IF ONE IS NOT FOUND (FLAG=FALSE RETURNED BY     007790
*     SRCHSSNAME) THE INFORMATIVE DIAGNOSTIC (MESSAGE1) IS WRITTEN      007800
*     TO THE OUTPUT FILE.  THE INDEX TABLE IS THEN UPDATED TO REFLECT   007810
*     THE REPLACING OF THE SUB-SCHEMA AND CONTROL IS PASSED TO LABEL    007820
*     EXIT.                                                             007830
*                                                                       007840
 #                                                                      007850
                                                                        007860
                                                                        007870
REPLSUBSCH:                                                             007880
      SSCOUNT = 0;                                                      007890
      IF SUBSCHCOUNT[0] EQ 0 THEN # IF SUB-SCHEMA FILE IS EMPTY, THEN  #007900
        BEGIN                     # PRINT MESSAGE TO THAT EFFECT       #007910
        DDLPRNT (MESSAGE8, 40);                                         007920
        ERRCNTR = ERRCNTR + 1;                                          007930
        END                                                             007940
      PUTSB (SSCTLWDADR+2);       # PUT SUB-SCHEMA IN FILE             #007950
      SSNAM30[0] = SNM[0];        # SUB-SCHEMA NAME                    #007960
      SRCHSSNAME;                                                       007970
      IF NOT FLAG THEN                                                  007980
        BEGIN                     # NAME NOT FOUND                     #007990
        DDLPRNT (MESSAGE1, 80);   # IN FILE AND ISSUE INFORMATIVE DIAG.#008000
        SSCOUNT = SSCOUNT + 1;                                          008010
        ERRCNTR = ERRCNTR + 1;                                          008020
        END                                                             008030
      INDXTBLNEW (SSCTLWDADR+2+SSLENG);   # NEW INDEX TABLE            #008040
      INDXTBLUPD (SSCTLWDADR+2);                                        008050
      SUBSCHCOUNT[0] = SUBSCHCOUNT[0] + SSCOUNT;                        008060
      DDLRTSB (LOC(SSWORKBUF), 4, WRDADRINDX);  # WRITE INDEX TABLE    #008070
      DDLRTSB (LOC(SSCNTRLWRD), 1, WRDADRINDX+4);  # WRITE CONTROL WORD#008080
      WRDADRINDX = WRDADRINDX + 5;  # WORD IN FILE, UPDATE ADDRESS     #008090
      GOTO EXIT;                    # TO NEXT AVAILABLE WRD AND EXIT   #008100
      CONTROL EJECT;                                                    008110
 #                                                                      008120
* *   DL30305                                    PAGE  1                008130
* *   EXHSSNAMES - EXHIBITS THE SUB-SCHEMA NAMES                        008140
* *   S N TAM                                    DATE  02/05/79         008150
*                                                                       008160
*     DESCRIPTION                                                       008170
*                                                                       008180
*     PROC PRNTHEAD IS CALLED TO GENERATE A HEADER LINE ON OUTPUT.      008190
*     THEN FOR EACH SUB-SCHEMA NAME IN THE INDEX TABLE THE SUB-SCHEMA   008200
*     NAME PLUS ITS DATE AND TIME OF COMPILATION ARE EXHIBITED BY       008210
*     CALLING PROC WRTEXLIN.                                            008220
*                                                                       008230
 #                                                                      008240
                                                                        008250
                                                                        008260
EXHSSNAMES:                                                             008270
      DDLSU = FIRSTWORD;           # DDL STORAGE USED                  #008280
      PRNTHEAD;          # PRINT HEADER LINES                          #008290
      IF ABRTFLAG THEN                                                  008300
        GOTO EXIT1;      # FATAL ERROR FLAG IS SET, EXIT               #008310
                                                                        008320
      WRDADRINDX = SSINDXSTRT[0];                                       008330
      FOR J = 1 STEP 1 UNTIL SUBSCHCOUNT[0] DO                          008340
        BEGIN            # LOOP THRU ALL INDEX TABLE ENTRIES           #008350
        RDOLDIND;        # READ AN ENTRY FROM OLD INDEX TABLE          #008360
        DDLRDSB (LOC(SBLOCK), SSDIRLEN, OLDSSWA[0]);                    008370
                         #READ THE SUB-SCHEMA DIRECTORY CONTROL WORDS  #008380
        WRTEXLIN;        # EXHIBIT A LINE                              #008390
        END                                                             008400
      GOTO EXIT1;                                                       008410
      CONTROL EJECT;                                                    008420
 #                                                                      008430
* *   DL30305                                    PAGE  1                008440
* *   COPYSSFL - GENERATE A NEW SUB-SCHEMA FILE FROM THE EXISTING ONE   008450
* *   S N TAM                                    DATE  02/05/79         008460
*                                                                       008470
*     DESCRIPTION                                                       008480
*                                                                       008490
*     A PASS IS MADE THROUGH THE INDEX TABLE LOOKING FOR ZERO LENGTH    008500
*     SUB-SCHEMAS.  IF ANY IS FOUND THEN A DIAGNOSTIC (MESSAGE13) IS    008510
*     ISSUED AND CONTROL IS PASSED TO LABEL EXIT1.                      008520
*     THE NEW LIBRARY FILE IS OPENED.  A HEADER LINE IS WRITTEN TO      008530
*     OUTPUT.  THEN ANOTHER PASS IS MADE THROUGH THE INDEX TABLE AND    008540
*     EACH SUB-SCHEMA THAT IS ACTIVE IN THE OLD LIBRARY IS COPIED TO    008550
*     THE NEW LIBRARY.  THE INDEX TABLE IS THEN WRITTEN TO REFLECT      008560
*     THE NEW LIBRARY.  INFORMATIVE MESSAGE (MESSAGE12) IS THEN WRITTEN 008570
*     TO OUTPUT.  THE LIBRARY FILE IS CLOSED AND CONTROL IS PASSED TO   008580
*     LABEL EXIT2.                                                      008590
*                                                                       008600
 #                                                                      008610
                                                                        008620
                                                                        008630
COPYSSFL:                                                               008640
      DDLSU = FIRSTWORD;           # DDL STORAGE USED                  #008650
      FWANEWIND = 1;                                                    008660
      WRDADRINDX = SSINDXSTRT[0];                                       008670
      FOR I = 1  STEP 1 UNTIL SUBSCHCOUNT[0]  DO                        008680
        BEGIN                                                           008690
        RDOLDIND;                                                       008700
        IF OLDSSLEN [0] EQ 0  THEN                                      008710
        BEGIN            # EMPTY SUB-SCHEMA, DDL ABORT                 #008720
          DDLPRNT (MESSAGE13, 70);                                      008730
          ERRCNTR = ERRCNTR + 1;                                        008740
          ABRTFLAG = TRUE;                                              008750
          GOTO EXIT1;                                                   008760
                                                                        008770
          END                                                           008780
        FWANEWIND = FWANEWIND + OLDSSLEN[0];  # NEW INDEX TABLE ADDRESS#008790
        END                                                             008800
# OPEN NEW SUBSCH LIB FILE, INITIALIZE VARIABLES, PRINT HEADER LINE    #008810
      DDLOPNL;           # OPEN THE SUB-SCHEMA LIBRARY FILE            #008820
      NEWINDXWA = FWANEWIND;                                            008830
      WRDADRINDX = SSINDXSTRT[0];                                       008840
      FWANEWSS = 1;      # INITIAL ADDRESS FOR NEW INDEX TABLE         #008850
      P<SCHBLOCK> = LOC(SSWORKBUF);  # SET BUFFER TO SS DIRECTORY CTLWD#008860
      PRNTHEAD;                                                         008870
      IF ABRTFLAG THEN                                                  008880
        GOTO EXIT1;      # FATAL ERROR FLAG IS SET, EXIT               #008890
                                                                        008900
# SCAN THROUGH OLD SUBSCH LIB INDEX AGAIN, WRITING SUBSCHEMAS WHICH    #008910
# ARE ACTIVE TO NEW SUBSCH LIBRARY                                     #008920
      FOR I = 1  STEP 1 UNTIL SUBSCHCOUNT[0]  DO                        008930
        BEGIN                                                           008940
        RDOLDIND;                                                       008950
#   GENERATE NEW INDEX ENTRY, WRITE TO NEW SUBSCH LIB AT NEWINDXWA     #008960
        NEWSSNM30 [0] = OLDSSNM30 [0];                                  008970
        NEWSSWA [0] = FWANEWSS;                                         008980
        NEWSSLEN [0] = OLDSSLEN [0];                                    008990
        DDLRTNL (LOC(NEWINDBUF), 4, NEWINDXWA); # WRITE INDEX TABLE    #009000
        NEWINDXWA = NEWINDXWA + 4;                                      009010
# READ SUBSCH FROM OLD LIB AT FWAOLDSS, WRITE TO NEW LIB AT FWANEWSS   #009020
        FLAG = TRUE;      # FLAG TO INDICATE FIRST READ ON SS LIB      #009030
        FWAOLDSS = OLDSSWA [0];                                         009040
        NBRBUFSS = NEWSSLEN [0] / BUFSIZ;                               009050
        LNGSSMODBFS = NEWSSLEN [0] - (BUFSIZ * NBRBUFSS);               009060
        IF LNGSSMODBFS EQ 0  THEN                                       009070
          NBRBUFSS = NBRBUFSS - 1;                                      009080
# LOOP THRU READS AND WRITES, A BUFSIZ AT A TIME, UNTIL THE ENTIRE     #009090
# SUBSCHEMA IS COPIED                                                  #009100
        FOR J = J WHILE NBRBUFSS GQ 0  DO                               009110
          BEGIN                                                         009120
          IF NBRBUFSS EQ 0  THEN                                        009130
            LNGSSREAD = LNGSSMODBFS;                                    009140
          ELSE LNGSSREAD = BUFSIZ;                                      009150
          DDLRDSB (LOC(SSWORKBUF), LNGSSREAD, FWAOLDSS);                009160
#  ON READ OF FIRST BUFFER, PRINT LINES WITH SUBSCH INFORMATION        #009170
          IF FLAG THEN                                                  009180
            BEGIN                                                       009190
            FLAG = FALSE;                                               009200
            WRTEXLIN;                                                   009210
            END                                                         009220
# WRITE BUFFER TO NEW SUBSCH LIB FILE, INCREMENT ADDRESSES             #009230
          DDLRTNL (LOC(SSWORKBUF), LNGSSREAD, FWANEWSS);                009240
          FWAOLDSS = FWAOLDSS + LNGSSREAD;                              009250
          FWANEWSS = FWANEWSS + LNGSSREAD;                              009260
          NBRBUFSS = NBRBUFSS - 1;                                      009270
          END                                                           009280
        END                                                             009290
# WRITE CONTROL WORD AND END-OF-SUBSCH MARKER TO NEW LIB FILE          #009300
      SSINDXSTRT[0] = FWANEWIND;                                        009310
      DDLRTNL (LOC(SSCNTRLWRD), 1, NEWINDXWA);   # WRITE CONTROL WORD  #009320
      NEWINDXWA = NEWINDXWA + 1;                                        009330
      INDTBLEND[0] = "ENDOFSSFIL";                                      009340
      DDLRTNL (LOC(SSWORKBUF), 1, NEWINDXWA);    # WRITE EOF MARKER    #009350
# PRINT MESSAGE FOR NEW LIBRARY GENERATED, CLOSE NEW LIB FILE          #009360
      DDLPRNT (MESSAGE12, 60);                                          009370
      DDLCLNL;           # CLOSE NEW SUB-SCHEMA FILE                   #009380
      GOTO EXIT2;                                                       009390
      CONTROL EJECT;                                                    009400
 #                                                                      009410
* *   DL30305                                    PAGE  1                009420
* *   EXIT - END OF FILE UPDATE AND MAINTENANCE                         009430
* *   S N TAM                                    DATE  02/05/79         009440
*                                                                       009450
*     DESCRIPTION                                                       009460
*                                                                       009470
*     END OF FILE MAINTENANCE.  WRITES THE END-OF-FILE MARKER           009480
*     "ENDOFSSFL" AND EXTENDS THE FILE IF THE RIGHT CONDITION OCCURS.   009490
*     WRITES (MESSAGE7) TO OUTPUT FILE.  IF ABRTFLAG IS SET, CALL       009500
*     DDLABT.  ELSE, ALL FILES ARE CLOSED.  STOP EXECUTION.             009510
*                                                                       009520
 #                                                                      009530
                                                                        009540
                                                                        009550
EXIT:                                                                   009560
      INDTBLEND[0] = "ENDOFSSFIL";              # STORE EOF MARKER     #009570
      DDLRTSB (LOC(SSWORKBUF), 1, WRDADRINDX);  # WRITE EOF MARKER     #009580
      IF NEWFILE GR 1 AND EXHSS NQ 1 THEN                               009590
        EXTFLAG = TRUE;                         # EXTEND THE FILE      #009600
EXIT1:                                                                  009610
      RETNZZ;            # CLOSE AND UNLOAD SCRATCH OR NEW LIBRARY     #009620
EXIT2:                   # ENTRY POINT FOR COPYSSFL                    #009630
      CMESG[0] = "          ";                                          009640
      DDLPRNT (MESSAGE7,70);  # END OF MAINTENANCE                     #009650
      CLSESB;            # CLOSE THE SUB-SCHEMA FILE                   #009660
      IF EXTFLAG  THEN                                                  009670
        EXTSB (SBLFN);   # EXTEND THE FILE                             #009680
      IF ABRTFLAG THEN                                                  009690
        DDLABT (5);      # DDL ABORT                                   #009700
      CLSEOUT;           # CLOSE OUTPUT FILE                           #009710
      STOP;                                                             009720
      CONTROL EJECT;                                                    009730
      PROC ADJTOPRUBND (NOWORDS);                                       009740
      BEGIN                                                             009750
                                                                        009760
 #                                                                      009770
* *   DL30305                                    PAGE  1                009780
* *   ADJTOPRUBND - ADJUST TO A  PRU BOUNDARY                           009790
* *   S N TAM                                    DATE  02/05/79         009800
*                                                                       009810
* DC  PURPOSE                                                           009820
*                                                                       009830
*     ADJUST THE LENGTH TO A PRU BOUNDARY                               009840
*                                                                       009850
* DC  ENTRY CONDITIONS                                                  009860
*                                                                       009870
*     NOWORDS                LENGTH IN WORDS TO BE ADJUSTED             009880
*                                                                       009890
* DC  EXIT CONDITIONS                                                   009900
*                                                                       009910
*     THE LENGTH IS ADJUSTED TO THE NEAREST PRU BOUNDARY                009920
*                                                                       009930
* DC  CALLED ROUTINES                                                   009940
*                                                                       009950
*     NONE                                                              009960
*                                                                       009970
* DC  DESCRIPTIONS                                                      009980
*                                                                       009990
*     IF THE LENGTH IS NOT A MULTIPLE OF 64, IT IS CALCULATED BY THE    010000
*     EQUATION BELOW.  THE LENGTH IS ROUNDED UP TO THE NEAREST PRU      010010
*     BOUNDARY.  THIS PROC IS CALLED BY INDXTBLNEW.                     010020
*                                                                       010030
 #                                                                      010040
                                                                        010050
                                                                        010060
      ITEM NOWORDS;                # LENGTH TO BE ADJUSTED             #010070
                                                                        010080
      ITEM I1;                     # SCRATCH VARIABLE                  #010090
                                                                        010100
      IF NOWORDS EQ 0 THEN                                              010110
        BEGIN                                                           010120
        SBADJLENG = 0;                                                  010130
        RETURN;                                                         010140
        END                                                             010150
      I1 = NOWORDS - (((NOWORDS - 1) / 64) * 64);                       010160
      SBADJLENG = NOWORDS + 64 - I1;                                    010170
      RETURN;                                                           010180
      END       # ADJTOPRUBND #                                         010190
      CONTROL EJECT;                                                    010200
      PROC INDXTBLNEW (WRITEADR);                                       010210
      BEGIN                                                             010220
                                                                        010230
 #                                                                      010240
* *   DL30305                                    PAGE  1                010250
* *   INDXTBLNEW - BUILD A NEW INDEX TABLE                              010260
* *   S N TAM                                    DATE  02/05/79         010270
*                                                                       010280
* DC  PURPOSE                                                           010290
*                                                                       010300
*     WRITE A NEW INDEX TABLE INTO THE SS FILE BASED ON THE OLD ONE     010310
*                                                                       010320
* DC  ENTRY CONDITIONS                                                  010330
*                                                                       010340
*     WRITEADR               WORD ADDRESS IN SS FILE OF NEW INDEX TABLE 010350
*                                                                       010360
* DC  EXIT CONDITIONS                                                   010370
*                                                                       010380
*     A NEW INDEX TABLE IS BUILT                                        010390
*                                                                       010400
* DC  CALLED ROUTINES                                                   010410
*                                                                       010420
*     ADJTOPRUBND            ADJUST NO. OF WORDS TO NEAREST PRU BOUNDARY010430
*     DDLRDSB                READ FROM SUB-SCHEMA FILE                  010440
*     DDLRTSB                WRITE TO SUB-SCHEMA FILE                   010450
*                                                                       010460
* DC  DESCRIPTIONS                                                      010470
*                                                                       010480
*     ON ENTRY, THE VALUE OF "LENGMVD" IS EITHER 0 OR WA (SET AT        010490
*     SRCHSSNAME).  IF IT IS NON-ZERO, IT INDICATES TO THE PROC         010500
*     THAT THE INDEX TABLE ENTRY AT WA IS TO BE BYPASSED WHEN           010510
*     CREATING A NEW INDEX TABLE.  CONSEQUENTLY THE NEW INDEX TABLE     010520
*     IS WRITTEN TO THE SUBSCHEMA LIBRARY FILE AT "WRITEADR" MINUS      010530
*     THE ENTRY AT WA.  IF VALUE IS EQUAL TO ZERO, THE OLD INDEX TABLE  010540
*     IS WRITTEN IN ITS ENTIRETY AT "WRITEADR".  THIS PROC IS CALLED    010550
*     BY ADDTOSSFL, PURSUBSCH AND REPLSUBSCH.                           010560
*                                                                       010570
 #                                                                      010580
                                                                        010590
                                                                        010600
      ITEM WRITEADR;                                                    010610
                                                                        010620
      ITEM I3, J3, K3;             # SCRATCH VARIABLES                 #010630
                                                                        010640
      J3 = SUBSCHCOUNT[0] * 4;                                          010650
      WRDADRINDX = SSINDXSTRT[0]; # INITIALIZE TO START OF INDEX TABLE #010660
      SSINDXSTRT[0] = WRITEADR;   # STORE ADDRESS OF START OF INDEX TBL#010670
      FOR I3 = I3 WHILE J3 GR 0 DO # LOOP TO READ IN INDEX TABLE ENT.  #010680
        BEGIN                                                           010690
        IF J3 GR BUFSIZ THEN      # IF INDEX TABLE LENGTH EXCEEDS WORK #010700
          I3 = BUFSIZ;            # BUFFER SIZE, THEN SET VARIABLE TO  #010710
        ELSE                      # MAXIMUM SIZE, ELSE                 #010720
          I3 = J3;                # SET SIZE TO INDEX TABLE LENGTH.    #010730
        J3 = J3 - I3;             # DECREMENT LENGTH OF INDEX TABLE.   #010740
        DDLRDSB (LOC(SSWORKBUF), I3, WRDADRINDX);  # READ INDEX TABLE  #010750
        K3 = I3;                                                        010760
      IF FLAG AND LENGMVD LS I3  THEN                                   010770
        BEGIN                                                           010780
        IF LENGMVD NQ 0  THEN                                           010790
          BEGIN                                                         010800
          ADJTOPRUBND (LENGMVD);                                        010810
          DDLRTSB (LOC(SSWORKBUF), SBADJLENG, WRITEADR);                010820
          WRITEADR = WRITEADR + LENGMVD;                                010830
          END                                                           010840
        LENGMVD = LENGMVD + 4;                                          010850
        I3 = I3 - LENGMVD;                                              010860
        IF I3 NQ 0  THEN                                                010870
          BEGIN                                                         010880
          ADJTOPRUBND (I3);                                             010890
          DDLRTSB (LOC(SSWORKBUF)+LENGMVD, SBADJLENG, WRITEADR);        010900
          END                                                           010910
        FLAG = FALSE;      # NOT FIRST READ IN INDEX TABLE             #010920
        END                                                             010930
        ELSE                                                            010940
          BEGIN                                                         010950
          ADJTOPRUBND(I3);                                              010960
          DDLRTSB (LOC(SSWORKBUF), SBADJLENG, WRITEADR);                010970
          LENGMVD = LENGMVD - I3;                                       010980
          END                                                           010990
        WRITEADR = WRITEADR + I3;                                       011000
        WRDADRINDX = WRDADRINDX + K3;                                   011010
        END                                                             011020
      WRDADRINDX = WRITEADR;  # STORE ADDRESS OF NEXT AVAILABLE WORD   #011030
                              # FOR A WRITE IN THE SUB-SCHEMA FILE     #011040
      RETURN;                                                           011050
      END       # INDXTBLNEW #                                          011060
      CONTROL EJECT;                                                    011070
      PROC INDXTBLUPD (WRDADDR);                                        011080
      BEGIN                                                             011090
                                                                        011100
 #                                                                      011110
* *   DL30305                                    PAGE  1                011120
* *   INDXTBLUPD - INDEX TABLE UPDATE                                   011130
* *   S N TAM                                    DATE  02/05/79         011140
*                                                                       011150
* DC  PURPOSE                                                           011160
*                                                                       011170
*     BUILDS AN ENTRY IN THE INDEX TABLE FOR A NEW SUB-SCHEMA           011180
*                                                                       011190
* DC  ENTRY CONDITIONS                                                  011200
*                                                                       011210
*     WRDADDR                WORD ADDRESS OF SUB-SCHEMA IN THE SS FILE  011220
*                                                                       011230
* DC  EXIT CONDITIONS                                                   011240
*                                                                       011250
*     AN INDEX TABLE ENTRY IS BUILT                                     011260
*                                                                       011270
* DC  CALLED ROUTINES                                                   011280
*                                                                       011290
*     NONE                                                              011300
*                                                                       011310
* DC  DESCRIPTIONS                                                      011320
*                                                                       011330
*     THIS PROCEDURE CREATES AN INDEX TABLE ENTRY FOR THE CURRENT       011340
*     SUB-SCHEMA BEING WRITTEN TO THE FILE.  EACH ENTRY CONSISTS OF     011350
*     A SUB-SCHEMA NAME, ITS WORD ADDRESS AND LENGTH.  THIS PROC        011360
*     IS CALLED BY ADDTOSSFL, CREATESSFL AND REPLSUBSCH.                011370
*                                                                       011380
 #                                                                      011390
                                                                        011400
                                                                        011410
      ITEM WRDADDR;  # WORD ADDRESS OF SUBSCHEMA AS IT RESIDES IN FILE #011420
                                                                        011430
      SSINDXNME30 [0] = SSNAM30 [0];                                    011440
      SSWRDADDR [0] = WRDADDR;                                          011450
      SSINDXLEN[0] = SSLENG;     # SUB-SCHEMA LENGTH                   #011460
      RETURN;                                                           011470
      END       # INDXTBLUPD #                                          011480
      CONTROL EJECT;                                                    011490
      PROC PRNTHEAD;                                                    011500
      BEGIN                                                             011510
                                                                        011520
 #                                                                      011530
* *   DL30305                                    PAGE  1                011540
* *   PRNTHEAD - PRINTS LIBRARY AUDIT HEADER                            011550
* *   S N TAM                                    DATE  02/05/79         011560
*                                                                       011570
* DC  PURPOSE                                                           011580
*                                                                       011590
*     GENERATE AUDIT HEADER LINE                                        011600
*                                                                       011610
* DC  EXIT CONDITIONS                                                   011620
*                                                                       011630
*     DDL ABORTS IF SUB-SCHEMA FILE IS EMPTY                            011640
*     PUTS LIBRARY AUDIT HEADER INFORMATION IN OUTPUT FILE              011650
*                                                                       011660
* DC  CALLED ROUTINES                                                   011670
*                                                                       011680
*     DDLPRNT                WRITE A LINE TO OUTPUT FILE                011690
*                                                                       011700
* DC  DESCRIPTIONS                                                      011710
*                                                                       011720
*     IF THE SUB-SCHEMA FILE IS EMPTY, SET ABRTFLAG AND RETURN.         011730
*     OTHERWISE PRINTS HEADER LINES FOR SUB-SCHEMA AUDIT LIST IN OUTPUT 011740
*     FILE.                                                             011750
*                                                                       011760
 #                                                                      011770
                                                                        011780
                                                                        011790
      ITEM IPRNT;                                                       011800
                                                                        011810
      IF SUBSCHCOUNT[0] EQ 0 THEN                                       011820
        BEGIN            # EMPTY SUB-SCHEMA FILE, DDL ABORT            #011830
        DDLPRNT (MESSAGE11, 40);                                        011840
        ERRCNTR = ERRCNTR + 1;                                          011850
        ABRTFLAG = TRUE;                                                011860
        RETURN;                                                         011870
        END                                                             011880
      DDLPRNT (MESSAGE5,40);   # LIST OF SUB-SCHEMA IN FILE            #011890
      FOR IPRNT = 0 STEP 1 UNTIL 6 DO                                   011900
        CMESG [IPRNT] = "          ";                                   011910
      DDLPRNT (COMMESG, 10);                                            011920
      DDLPRNT (MESSAGE6A,60);                                           011930
      CMESG[4] = "    DATE  ";                                          011940
      CMESG[5] = "  TIME    ";                                          011950
      DDLPRNT (COMMESG,70);                                             011960
      DDLPRNT (MESSAGE6B,60);                                           011970
      RETURN;                                                           011980
      END     # PRNTHEAD #                                              011990
      CONTROL EJECT;                                                    012000
      PROC PUTSB ((ADDR));                                              012010
      BEGIN                                                             012020
                                                                        012030
 #                                                                      012040
* *   DL30305                                    PAGE  1                012050
*     PUTSB - WRITES SUB-SCHEMA TO THE FILE                             012060
* *   S N TAM                                    DATE  02/05/79         012070
*                                                                       012080
* DC  PURPOSE                                                           012090
*                                                                       012100
*     TAKES THE SUB-SCHEMA FROM THE SCRATCH FILE AND WRITES IT TO THE   012110
*     SUB-SCHEMA FILE                                                   012120
*                                                                       012130
* DC  ENTRY CONDITIONS                                                  012140
*                                                                       012150
*     ADDR                   NEXT AVAILABLE WA IN SUB-SCHEMA FILE       012160
*                                                                       012170
* DC  EXIT CONDITIONS                                                   012180
*                                                                       012190
*     A SUB-SCHEMA IS COPIED TO THE SUB-SCHEMA FILE                     012200
*                                                                       012210
* DC  CALLED ROUTINES                                                   012220
*                                                                       012230
*     DDLRTSB                WRITE TO SUB-SCHEMA FILE                   012240
*     GETENT                 READ FROM THE SUB-SCHEMA SCRATCH FILE      012250
*                                                                       012260
* DC  DESCRIPTIONS                                                      012270
*                                                                       012280
*     READS ONE BUFFER OF WORDS FROM THE SCRATCH FILE AND WRITES IT     012290
*     TO THE SUB-SCHEMA LIBRARY FILE UNTIL THE LOOP COUNTER REACHES THE 012300
*     SUB-SCHEMA LENGTH.  THIS PROC IS CALLED BY ADDTOSSFL, CREATESSFL  012310
*     AND REPLSUBSCH.                                                   012320
*                                                                       012330
 #                                                                      012340
                                                                        012350
                                                                        012360
      ITEM ADDR;                   # WORD ADDRESS OF SUB-SCHEMA        #012370
                                                                        012380
      ITEM I, J, N;                # SCRATCH VARIABLES                 #012390
                                                                        012400
      SSLENG = SAREAINDXADR[0] + SAREAINDXLEN[0];  # SUB-SCHEMA LENGTH #012410
      I = 0;                       # BEGINNING ADDRESS OF SCRATCH FILE #012420
      J = SSLENG;                  # SUB-SCHEMA LENGTH                 #012430
      N = BUFSIZ;                  # BUFFER SIZE                       #012440
      FOR ADDR = ADDR STEP BUFSIZ                                       012450
        WHILE N EQ BUFSIZ                                               012460
      DO                                                                012470
        BEGIN                                                           012480
        IF N GR J                                                       012490
        THEN                       # SS LENGTH IS LESS THAN BUFFER SIZE#012500
          N = J;                                                        012510
        J = J - N;                 # LEN OF SS REMAINING ON SCRATCH FIL#012520
        GETENT (LOC(SSWORKBUF), N, I);       # READ FROM SCRATCH FILE  #012530
        I = I + N;                 # WA IN SCRATCH FILE FOR NEXT READ  #012540
        DDLRTSB (LOC(SSWORKBUF), N, ADDR);  # WRITE TO SUB-SCHEMA FILE #012550
        END                                                             012560
      END     # PUTSB #                                                 012570
      CONTROL EJECT;                                                    012580
      PROC RDOLDIND;                                                    012590
      BEGIN                                                             012600
                                                                        012610
 #                                                                      012620
* *   DL30305                                    PAGE  1                012630
* *   RDOLDIND - READ AN ENTRY FROM OLD INDEX TABLE                     012640
* *   S N TAM                                    DATE  02/05/79         012650
*                                                                       012660
* DC  PURPOSE                                                           012670
*                                                                       012680
*     READ ONE ENTRY FROM THE OLD SUB-SCHEMA INDEX TABLE                012690
*                                                                       012700
* DC  EXIT CONDITIONS                                                   012710
*                                                                       012720
*     ONE INDEX TABLE ENTRY IS READ AND WRDADRINDX IS UPDATED TO        012730
*     POINT TO THE NEXT LOCATION IN THE OLD INDEX TABLE.                012740
*                                                                       012750
* DC  CALLED ROUTINES                                                   012760
*                                                                       012770
*     DDLRDSB                READ FROM SUB-SCHEMA FILE                  012780
*                                                                       012790
* DC  DESCRIPTIONS                                                      012800
*                                                                       012810
*     READS AN ENTRY FROM THE OLD INDEX TABLE.  INCREMENTS THE WA       012820
*     POINTER (WRDADRINDX) TO POINT TO THE NEXT ENTRY IN THE OLD        012830
*     INDEX TABLE.  THIS PROC IS CALLED BY COPYSSFL AND EXHSSNAMES.     012840
*                                                                       012850
 #                                                                      012860
                                                                        012870
                                                                        012880
                                                                        012890
      DDLRDSB (LOC(OLDINDBUF), 4, WRDADRINDX);                          012900
      WRDADRINDX = WRDADRINDX + 4;                                      012910
      RETURN;                                                           012920
      END     # RDOLDIND #                                              012930
      CONTROL EJECT;                                                    012940
      PROC SRCHSSNAME;                                                  012950
      BEGIN                                                             012960
                                                                        012970
 #                                                                      012980
* *   DL30305                                    PAGE  1                012990
* *   SRCHSSNAME - SEARCH FOR SUB-SCHEMA NAME                           013000
* *   S N TAM                                    DATE  02/05/79         013010
*                                                                       013020
* DC  PURPOSE                                                           013030
*                                                                       013040
*     SEARCH THROUGH THE INDEX TABLE FOR A MATCHING SUB-SCHEMA NAME     013050
*                                                                       013060
* DC  EXIT CONDITIONS                                                   013070
*                                                                       013080
*     FLAG                   IF SET, A MATCHING SUB-SCHEMA NAME IS FOUND013090
*     LENGMVD                WA OF A SUB-SCHEMA NAME                    013100
*     WRDADRINDX             WA OF INDEX TABLE ENTRY                    013110
*                                                                       013120
* DC  CALLED ROUTINES                                                   013130
*                                                                       013140
*     DDLRDSB                READ FROM THE SUB-SCHEMA FILE              013150
*                                                                       013160
* DC  DESCRIPTIONS                                                      013170
*                                                                       013180
*     SEARCHES FOR A MATCHING SUB-SCHEMA NAME BY GOING THROUGH THE INDEX013190
*     TABLE ONE BUFFER AT A TIME.  WHEN THE NAME IS FOUND, THE WORD     013200
*     ADDRESS IS SAVED IN "LENGMVD" AND A FLAG IS SET TO SHOW THE       013210
*     SATISFIED CONDITION.  THIS PROC IS CALLED BY ADDTOSSFL, PURSUBSCH 013220
*     AND REPLSUBSCH.                                                   013230
*                                                                       013240
 #                                                                      013250
                                                                        013260
                                                                        013270
      ITEM I4, J4, K4;           # SCRATCH VARIABLES                   #013280
                                                                        013290
      WRDADRINDX = SSINDXSTRT[0]; # INITIALIZE TO START OF INDEX TABLE #013300
      LENGMVD = 0;                                                      013310
      FLAG = FALSE;                                                     013320
        J4 = SUBSCHCOUNT[0] * 4; # LENGTH OF INDEX TABLE               #013330
      FOR I4 = I4 WHILE J4 GR 0 DO # LOOP TO READ IN INDEX TABLE.  #    013340
        BEGIN                                                           013350
        IF J4 GR BUFSIZ THEN                                            013360
          I4 = BUFSIZ;                                                  013370
        ELSE                                                            013380
          I4 = J4;                                                      013390
        J4 = J4 - I4;                                                   013400
        DDLRDSB (LOC(SSWORKBUF), I4, WRDADRINDX); #RD INDEX TABLE ENTRY#013410
        FOR K4 = 0 STEP 4 UNTIL I4 - 1 DO        # SEARCH FOR SS NAME  #013420
          BEGIN                                                         013430
          IF SSNAM30[0] EQ SSINDXNME30[K4] THEN                         013440
            BEGIN                                                       013450
            FLAG = TRUE;                                                013460
            LENGMVD = LENGMVD + K4; # IF FLAG SET, SS NAME IS FOUND    #013470
            RETURN;                                                     013480
            END                                                         013490
          END                                                           013500
        WRDADRINDX = WRDADRINDX + I4;                                   013510
        LENGMVD = LENGMVD + I4;                                         013520
        END                                                             013530
      IF NOT FLAG THEN                                                  013540
        LENGMVD = 0;     # NAME NOT FOUND                              #013550
      RETURN;                                                           013560
      END       # SRCHSSNAME #                                          013570
      CONTROL EJECT;                                                    013580
      PROC SSMSG (MSGLOC, NAMLOC, NAMLENC);                             013590
      BEGIN                                                             013600
                                                                        013610
 #                                                                      013620
* *   DL30305                                    PAGE  1                013630
* *   SSMSG - STORE NAME IN MESSAGE ARRAY                               013640
* *   S N TAM                                    DATE  02/05/79         013650
*                                                                       013660
* DC  PURPOSE                                                           013670
*                                                                       013680
*     PUT SUB-SCHEMA NAME IN THE MESSAGE ARRAY                          013690
*                                                                       013700
* DC  ENTRY CONDITIONS                                                  013710
*                                                                       013720
*     MSGLOC                 LOCATION OF MESSAGE ARRAY                  013730
*     NAMLOC                 LOCATION OF SUB-SCHEMA NAME                013740
*     NAMLENC                LENGTH OF SUB-SCHEMA NAME IN CHARACTERS    013750
*                                                                       013760
* DC  EXIT CONDITIONS                                                   013770
*                                                                       013780
*     THE SUB-SCHEMA NAME IS PUT IN THE MESSAGE ARRAY                   013790
*                                                                       013800
* DC  CALLED ROUTINES                                                   013810
*                                                                       013820
*     NONE                                                              013830
*                                                                       013840
* DC  DESCRIPTIONS                                                      013850
*                                                                       013860
*     PICKS UP THE SUB-SCHEMA NAME FROM LOCATION NAMLOC AND PUTS        013870
*     IT IN THE MESSAGE ARRAY.  THIS PROC IS CALLED BY PURSUBSCH.       013880
*                                                                       013890
 #                                                                      013900
                                                                        013910
                                                                        013920
      ITEM MSGLOC;     # LOCATION OF MESSAGE ARRAY FOR NAME STORE.     #013930
      ITEM NAMLOC;     # LOCATION WHERE SUBSCH NAME IS STORED.         #013940
      ITEM NAMLENC;    # LENGTH OF NAME IN CHARACTERS.                 #013950
                                                                        013960
      BASED ARRAY MSGARR [0:7];                                         013970
        ITEM MSGN C(0,0,10);                                            013980
      BASED ARRAY NAMARR [0:2];                                         013990
        ITEM NAM C(0,0,10);                                             014000
                                                                        014010
      ITEM I2, J2;       # SCRATCH VARIABLES                           #014020
                                                                        014030
      P<MSGARR> = MSGLOC;                                               014040
      P<NAMARR> = NAMLOC;                                               014050
      J2 = 0;                                                           014060
      MSGN[2] = "          ";                                           014070
      MSGN[3] = "          ";                                           014080
      MSGN[4] = "          ";                                           014090
      FOR I2 = 2 STEP 1 UNTIL 4 DO                                      014100
        BEGIN                                                           014110
        MSGN[I2] = NAM[J2];                                             014120
        J2 = J2 + 1;                                                    014130
        END                                                             014140
      RETURN;                                                           014150
      END       # SSMSG #                                               014160
      CONTROL EJECT;                                                    014170
      PROC WRTEXLIN;                                                    014180
      BEGIN                                                             014190
                                                                        014200
 #                                                                      014210
* *   DL30305                                    PAGE  1                014220
* *   WRTEXLIN - WRITE A LINE OF AUDIT INFORMATION                      014230
* *   S N TAM                                    DATE  02/05/79         014240
*                                                                       014250
* DC  PURPOSE                                                           014260
*                                                                       014270
*     WRITE A LINE WITH SUB-SCHEMA NAME, ITS CREATION TIME AND          014280
*     DATE IN THE OUTPUT FILE                                           014290
*                                                                       014300
* DC  EXIT CONDITIONS                                                   014310
*                                                                       014320
*     A LINE OF AUDIT INFORMATION IS WRITTEN TO OUTPUT FILE             014330
*                                                                       014340
* DC  CALLED ROUTINES                                                   014350
*                                                                       014360
*     DDLPRNT                WRITE A LINE TO OUTPUT FILE                014370
*                                                                       014380
* DC  DESCRIPTIONS                                                      014390
*                                                                       014400
*     WRITES AN AUDIT LINE TO THE OUTPUT FILE USING PROC DDLPRNT        014410
*     THE LINE IS STORED IN ARRAY COMMESG.  IT CONTAINS:                014420
*       WORDS 1, 2, 3 - A SUB-SCHEMA NAME, OBTAINED FROM OLDINDBUF      014430
*       WORDS 4, 5    - DATE AND TIME OF SUB-SCHEMA CREATION, OBTAINED  014440
*                       FROM SSWORKBUF/SBLOCK WHICH CONTAINS SUB-SCHEMA 014450
*                       DIRECTORY CONTROL WORDS                         014460
*     ON ENTRY OLDSSWA MUST POINT TO BASED ARRAY SCHBLOCK WHICH HAS     014470
*     THE SUB-SCHEMA DIRECTORY CONTROL WORDS.  ARRAY OLDINDBUF ALSO     014480
*     CONTAINS AN INDEX TABLE ENTRY FOR THE CURRENT SUB-SCHEMA.  THIS   014490
*     PROC IS CALLED BY EXHSSNAMES AND COPYSSFL.                        014500
*                                                                       014510
 #                                                                      014520
                                                                        014530
                                                                        014540
      ITEM IWRT U;                 # SCRATCH VARIABLE                  #014550
                                                                        014560
      FOR IWRT = 0 STEP 1 UNTIL 6 DO    # BLANK FILL LINES             #014570
        CMESG [IWRT] = "          ";                                    014580
      CMESG30[1] = OLDSSNM30[0];   # STORE SUB-SCHEMA NAME             #014590
      B<18,30> CMESG[4] = SCDATE[0];   # SUB-SCHEMA CREATION DATE      #014600
      B<12,30> CMESG[5] = SCTIME[0];   # SUB-SCHEMA CREATION TIME      #014610
      DDLPRNT (COMMESG,60);   # PRINT A LINE                           #014620
      RETURN;                                                           014630
      END     # WRTEXLIN #                                              014640
                                                                        014650
      END       # DL30305 #                                             014660
      TERM;                                                             014670
