*DECK DLCKSUB                                                           000110
USETEXT TDLSCOM;                                                        000120
      PRGM DL30105;                                                     000130
                                                                        000140
      BEGIN                                                             000150
                                                                        000160
 #                                                                      000170
* *   DL30105 - CHECK SUBSCHEMA CHECKSUMS        PAGE  1                000180
* *   J G SERPA                                  DATE  10/01/79         000190
*                                                                       000200
* DC  PURPOSE                                                           000210
*                                                                       000220
*     TO VALIDATE SUBSCHEMAS AFTER A SCHEMA RECOMPILATION.              000230
*                                                                       000240
* DC  CALLED ROUTINES                                                   000250
*                                                                       000260
*     DDLPRNT                        PRINT INFORMATION ON OUTPUT FILE   000270
*     DDLRDSB                        READ THE SUBSCHEMA LIBRARY FILE    000280
*     OPENSB                         OPEN SUBSCHEMA LIBRARY FILE        000290
*     SCCKSRD                        READ SCHEMA CHECKSUM SCRATCH FILE  000300
*                                                                       000310
* DC  NON-LOCAL VARIABLES                                               000320
*                                                                       000330
*     ITEM NEWFILE                   LENGTH OF SUBSCHEMA LIBRARY        000340
*                                                                       000350
* DC  DESCRIPTION                                                       000360
*                                                                       000370
*     AT THE END OF A SCHEMA COMPILATION, IF SB=LFN IS SPECIFIED ON     000380
*     THE DDL CONTROL CARD, OVERLAY (1,4) WILL CALL LOADOVL TO LOAD     000390
*     AND EXECUTE OVERLAY (1,5).                                        000400
*     THE PURPOSE OF THIS OVERLAY IS TO READ THE SUBSCHEMA LIBRARY      000410
*     FILE AND GO THROUGH ALL THE ACTIVE SUBSCHEMA CHECKSUM BLOCKS AND  000420
*     COMPARE THOSE AGAINST THE ONES FOR THE SCHEMA JUST RECOMPILED     000430
*     IF ANY OF THE CHECKSUMS DO NOT MATCH, THEN THAT SUBSCHEMA MUST    000440
*     BE RECOMPILED.                                                    000450
*                                                                       000460
 #                                                                      000470
                                                                        000480
                                                                        000490
*CALL COMHDRLEN                                                         000500
                                                                        000510
      DEF  DFBUFSIZE    # 512#;    # SIZE OF SS WORKING BUFFER         #000520
                                                                        000530
                                                                        000540
      XREF PROC CLSEOUT;     # CLOSE OUTPUT FILE                       #000550
      XREF PROC CLSESC;      # CLOSE SCHEMA FILE                       #000560
      XREF PROC DDLPRNT;     # WRITE MESSAGES TO OUTPUT FILE           #000570
      XREF PROC SCCLCKS;     # CLOSE CHECKSUM SCRATCH FILE             #000580
      XREF PROC OPENSB;      # OPEN SUBSCHEMA FILE                     #000590
      XREF PROC DDLRDSB;     # READ FROM SUBSCHEMA FILE                #000600
      XREF PROC CLSESB;      # CLOSE SUBSCHEMA FILE                    #000610
      XREF PROC SCCKSRD;     # READ FROM CHECKSUM SCRATCH FILE         #000620
                                                                        000630
      XREF ITEM NEWFILE;     # LENGTH OF SUBSCHEMA LIBRARY FILE        #000640
                                                                        000650
      BASED ARRAY LIBWORKBUF [0] S;  # SUBSCHEMA LIBRARY WORKING BUFFER#000660
          BEGIN                                                         000670
*CALL SBCWDECLS                                                         000680
*CALL SBNAMDCLS                                                         000690
          END                                                           000700
                                                                        000710
      ARRAY OLDINDBUF[0:0] S(4);  # OLD SS LIB INDEX BUFFER            #000720
        BEGIN                                                           000730
        ITEM OLDSSNAM     C(00,00,10);  # SUBSCHEMA NAME               #000740
        ITEM OLDSSNM30    C(00,00,30);                                  000750
        ITEM OLDSSWA      U(03,00,30);  # WA OF SUBSCHEMA IN LIBRARY   #000760
        ITEM OLDSSLEN     U(03,30,30);  # LENGTH OF SUBSCHEMA          #000770
        END                                                             000780
                                                                        000790
      BASED ARRAY SBCKSUMS [1:50] S(4);  # SUBSCHEMA CHECKSUMS         #000800
        BEGIN                                                           000810
        ITEM SBARNAME     C(00,00,30);  # SUBSCHEMA AREA NAME          #000820
        ITEM SBCKSUM      U(03,00,60);  # SUBSCHEMA AREA CHECKSUM      #000830
        END                                                             000840
                                                                        000850
      BASED ARRAY SCCKSUMS [1:50] S(4);  # CONTAINS SCHEMA CHECKSUMS   #000860
        BEGIN                                                           000870
        ITEM SCARNAME     C(00,00,30);  # SCHEMA AREA NAME             #000880
        ITEM SCCKSUM      U(03,00,60);  # SCHEMA AREA CHECKSUM         #000890
        END                                                             000900
                                                                        000910
      ARRAY SSCNTRLWRD [0:0];  # SS INDEX CONTROL WORDS                #000920
        BEGIN                                                           000930
        ITEM SBSCHCOUNT   U(00,00,12);  # NUMBER OF SUBSCHEMAS IN FILE #000940
        ITEM SSINDXSTRT   U(00,12,48);  # WORD ADDRESS OF INDEX TABLE  #000950
        END                                                             000960
                                                                        000970
      ARRAY SSWORKBUF [0:DFBUFSIZE] S(1);  # SS WORKING BUFFER         #000980
        BEGIN                                                           000990
        ITEM SSINDXNAME   U(00,00,60);  # SS NAME IN INDEX TABLE ENTRY #001000
        ITEM INDTBLEND    C(00,00,10);  # ACTUAL END OF SS FILE        #001010
        ITEM SSINDXNME30  C(00,00,30);  # NAME OF SS IN INDEX TABLE    #001020
        ITEM SSWRDADDR    U(03,00,30);  # WORD ADDRESS WHERE SUBSCHEMA #001030
                                        # RESIDES IN FILE              #001040
        ITEM SSINDXLEN    U(03,30,30);  # LENGTH OF SUBSCHEMA          #001050
        END                                                             001060
                                                                        001070
      ARRAY MESSAGE1 [0:9] S(1);                                        001080
        BEGIN                                                           001090
        ITEM MESG1V       C(00,00,10) = ["1         ",                  001100
                                         "      ----",                  001110
                                         "- REPORT O",                  001120
                                         "N SUB-SCHE",                  001130
                                         "MA RECOMPI",                  001140
                                         "LATIONS FO",                  001150
                                         "R SCHEMA  ",                  001160
                                         "          ",                  001170
                                         "          ",                  001180
                                         "          "];                 001190
        ITEM MESG1        C(00,00,100);                                 001200
        END                                                             001210
                                                                        001220
      ARRAY MESSAGE2 [0:6];                                             001230
        ITEM MESG2V       C(00,00,10) = ["          ",                  001240
                                         "          ",                  001250
                                         "       FOL",                  001260
                                         "LOWING SUB",                  001270
                                         "-SHEMAS RE",                  001280
                                         "QUIRE RECO",                  001290
                                         "MPILATION "];                 001300
                                                                        001310
      ARRAY MESSAGE3[0:3];                                              001320
        ITEM MESG3        C(00,00,10) = ["0NO SUB-SC",                  001330
                                         "HEMAS NEED",                  001340
                                         " TO BE REC",                  001350
                                         "OMPILED   "];                 001360
                                                                        001370
      ARRAY MESSAGE4 [0:5];                                             001380
        ITEM MESG4        C(00,00,10) = ["0         ",                  001390
                                         "          ",                  001400
                                         "          ",                  001410
                                         "          ",                  001420
                                         "-----END R",                  001430
                                         "EPORT-----"];                 001440
                                                                        001450
      ARRAY MESSAGE5 [0:2];                                             001460
        ITEM MESG5        C(00,00,10) = ["0EMPTY SUB",                  001470
                                         "-SCHEMA FI",                  001480
                                         "LE        "];                 001490
                                                                        001510
      ARRAY MESSAGE6 [0:2];                                             001520
        ITEM MESG6        C(00,00,10) = ["0CANNOT RE",                  001530
                                         "AD SUB-SCH",                  001540
                                         "EMA FILE  "];                 001550
                                                                        001580
      ARRAY MESSAGE7 [0:6] S(1);                                        001590
        BEGIN                                                           001600
        ITEM MESG7V       C(00,00,10) = ["          ",                  001610
                                         "          ",                  001620
                                         "          ",                  001630
                                         "          ",                  001640
                                         "          ",                  001650
                                         "          ",                  001660
                                         "          "];                 001670
        ITEM MESG7        C(00,00,70);                                  001680
        END                                                             001690
                                                                        001700
      ITEM COMPARE   B;      # TRUE IF CHECKSUMS COMPARE               #001710
      ITEM FWAOLDSS;         # FWA OF SUBSCHEMA IN OLD LIB             #001720
      ITEM FRSTINDWD;        # FWA OF INDEX TABLE FOR OLD SS LIB       #001730
      ITEM I;                # SCRATCH INDEX VARIABLE                  #001740
      ITEM J;                # SCRATCH INDEX VARIABLE                  #001750
      ITEM JJ;               # SCRATCH INDEX VARIABLE                  #001760
      ITEM K;                # SCRATCH INDEX VARIABLE                  #001770
      ITEM L;                # SCRATCH INDEX VARIABLE                  #001780
      ITEM LASTINDWD;        # LWA OF THE INDEX TABLE                  #001790
      ITEM LFIL;                                                        001800
      ITEM LL;               # SCRATCH INDEX VARIABLE                  #001810
      ITEM NO B = TRUE;      # TRUE IF SUBSCHEMAS TO BE RECOMPILED     #001820
      ITEM NUMSBCKS;         # NUMBER OF SUBSCHEMA CHECKSUMS           #001830
      ITEM NUMSCCKS;         # NUMBER OF SCHEMA CHECKSUMS              #001840
      ITEM RDLEN;            # LENGTH OF CHECKSUM BLOCK TO BE READ     #001850
      ITEM SBCKBEGIN;        # FWA OF CURRENT SS CHECKSUM BLOCK        #001860
      ITEM SBCKLAST;         # LWA OF CURRENT SS CHECKSUM BLOCK        #001870
      ITEM SBCKWA;           # WA OF SUBSCHEMA CHECKSUM BLOCK          #001880
      ITEM SCCKBEGIN I = 1;  # FWA OF CHECKSUM SCRATCH FILE            #001890
      ITEM SCCKLAST  I = 0;  # LWA OF CHECKSUM SCRATCH FILE            #001900
      ITEM SSCTLWDADR;       # SUBSCHEMA INDEX ENTRY WORD ADDRESS      #001910
      ITEM WRDADRINDX;       # WA OF INDEX TABLE ENTRIES               #001920
                                                                        001930
                                                                        001940
      CONTROL EJECT;                                                    001950
      PROC TERMEXIT;                                                    001960
                                                                        001970
      BEGIN                                                             001980
 #                                                                      001990
* *   DL30105                                    PAGE  1                002000
* *   TERMEXIT - TERMINATE DDL PROCESSING                               002010
* *   J G SERPA                                  DATE  09/28/79         002020
*                                                                       002030
* DC  PURPOSE                                                           002040
*                                                                       002050
*     TO CLOSE FILES AND TERMINATE EXECUTION OF DDL                     002060
*                                                                       002070
* DC  ENTRY CONDITIONS                                                  002080
*                                                                       002090
*     NONE                                                              002100
*                                                                       002110
* DC  EXIT CONDITIONS                                                   002120
*                                                                       002130
*     EXECUTION OF DDL IS TERMINATED                                    002140
*                                                                       002150
* DC  CALLING ROUTINES                                                  002160
*                                                                       002170
*     DL30105                                                           002180
*                                                                       002190
* DC  CALLED ROUTINES                                                   002200
*                                                                       002210
*     CLSEOUT                CLOSE OUTPUT FILE                          002220
*     CLSESB                 CLOSE SUBSCHEMA LIBRARY FILE               002230
*     SCCLCKS                CLOSE CHECKSUM SCRATCH FILE                002240
*                                                                       002250
* DC  DESCRIPTION                                                       002260
*                                                                       002270
*     CLSEOUT IS CALLED TO ISSUE END OF COMPILATION MESSAGES AND        002280
*     CLOSE THE OUTPUT FILE.                                            002290
*     CLSESB IS CALLED TO CLOSE THE SUBSCHEMA LIBRARY DIRECTORY         002300
*     FILE.                                                             002310
*     SCCLCKS IS CALLED TO CLOSE THE SCHEMA CHECKSUMS SCRATCH FILE      002320
*     EXECUTION IS THEN TERMINATED.                                     002330
*                                                                       002340
 #                                                                      002350
                                                                        002360
      CLSEOUT;                     # CLOSE OUTPUT FILE                 #002370
                                                                        002380
      CLSESB;                      # CLOSE SUBSCHEMA LIBRARY FILE      #002390
                                                                        002400
      SCCLCKS;                     # CLOSE CHECKSUM SCRATCH FILE       #002410
                                                                        002420
      STOP;                                                             002430
                                                                        002440
      END                                                               002450
      CONTROL EJECT;                                                    002460
#                                                                       002470
         E X E C U T A B L E  C O D E  F O R  D L C K S U B             002480
                                                                        002490
#                                                                       002500
                                                                        002510
      C<70,30>MESG1[0] = RPTSCHNAME30[0]; 
      DDLPRNT (MESSAGE1, 100);     # PRINT HEADER MESSAGE              #002530
      DDLPRNT (MESSAGE2, 70);                                           002540
      DDLPRNT (MESSAGE2, 10);           # BLANK LINE ON OUTPUT         #002550
                                                                        002560
      P<LIBWORKBUF> = LOC(SSWORKBUF);   # POSITION BASED ARRAYS        #002570
      P<SCCKSUMS> = LOC(SSWORKBUF) + 100;                               002580
      P<SBCKSUMS> = LOC(SSWORKBUF) + 300;                               002590
      OPENSB;                # OPEN SUBSCHEMA LIBRARY FILE             #002600
                                                                        002610
LOOP:                                                                   002620
      IF NEWFILE LQ 1              # IF SUBSCHEMA FILE EMPTY           #002630
      THEN                                                              002640
        BEGIN                                                           002650
        DDLPRNT (MESSAGE5, 30);    # ISSUE MESSAGE TO OUTPUT FILE      #002660
                                                                        002670
        TERMEXIT;                  # TERMINATE DDL PROCESSING          #002680
                                                                        002690
        END                                                             002700
      K = 1;                                                            002710
      I = DFBUFSIZE;               # AMOUNT TO GET IS ONE BUFFER FULL  #002720
      IF NEWFILE LQ DFBUFSIZE      # IF LESS THAN ONE BUFFER FULL LEFT #002730
      THEN                                                              002740
        BEGIN                                                           002750
        I = NEWFILE;               # THEN GET WHATEVER IS LEFT         #002760
        K = 0;                                                          002770
        END                                                             002780
      J = NEWFILE - I;             # ADDRESS OF WHERE TO START READING #002790
      DDLRDSB (LOC(SSWORKBUF), I, J);                                   002800
                                                                        002810
      FOR J = I - 1 STEP -1        # STEP THRU THE SUBSCHEMA FILE      #002820
        UNTIL 0                    # BACKWARDS, STARTING AT EOI        #002830
      DO                           # SEARCHING FOR ACTUAL END OF FILE  #002840
        BEGIN                                                           002850
        IF INDTBLEND[J] EQ "ENDOFSSFIL"     # IF END OF SS FILE FOUND  #002860
        THEN                                                            002870
          BEGIN                                                         002880
          SSCTLWDADR = NEWFILE - (I - J) - K;  # SS INDEX ENTRY WA     #002890
          J = 1;                   # FORCE END OF LOOP                 #002900
          END                                                           002910
        END                                                             002920
      IF SSCTLWDADR EQ 0           # IF END OF SS FILE NOT FOUND       #002930
      THEN                                                              002940
        BEGIN                                                           002950
        NEWFILE = NEWFILE - I;     # RESET AMOUNT TO BE SEARCHED       #002960
        GOTO LOOP;                 # AND RESTART FROM THE TOP          #002970
                                                                        002980
        END                                                             002990
      DDLRDSB( LOC(SSCNTRLWRD), 1, SSCTLWDADR );  #READ NDX CONTROL WRD#003000
                                                                        003010
      FOR J = 0 STEP 1                                                  003020
        UNTIL I - 1                                                     003030
      DO                                                                003040
        SSINDXNAME[J] = 0;         # ZERO OUT INDEX WORKING AREA       #003050
      WRDADRINDX = SSINDXSTRT[0];  # SET WORD ADDRESS OF INDEX TABLE   #003060
      NUMSCCKS = SCCWNUMAREAS[0] + SCCWNUMRELTN[0];                     003070
      FOR I = 1  STEP 1            # STEP THRU ALL SS IN THE FILE      #003080
        UNTIL SBSCHCOUNT[0]                                             003090
      DO                                                                003100
        BEGIN                                                           003110
        COMPARE = TRUE;            # SET CHECKSUMS COMPARE FLAG        #003120
        DDLRDSB (LOC(OLDINDBUF), DFINDXTBLEN, WRDADRINDX); #READ ENTRY #003130
                                                                        003140
        WRDADRINDX = WRDADRINDX + DFINDXTBLEN;  # INCREMENT TO NEXT WA #003150
        IF OLDSSLEN[0] EQ 0        # IF SS LIBRARY IS EMPTY            #003160
        THEN                                                            003170
          BEGIN                                                         003180
          DDLPRNT (MESSAGE6, 30);                                       003190
                                                                        003200
          TERMEXIT;                # TERMINATE DDL PROCESSING          #003210
                                                                        003220
          END                                                           003230
        DDLRDSB (P<LIBWORKBUF>, CTLWDLENG+5, OLDSSWA[0]);               003240
                                                                        003250
        IF SBCWSCHNAM30[0] NQ SCCWSCHNAM30[0]  # IF NAMES DO NOT MATCH #003260
        THEN                                                            003270
          TEST I;                  # IGNORE SUBSCHEMA                  #003280
                                                                        003290
        SBCKLAST = 0;                                                   003300
        NUMSBCKS = SBCWNUMAREAS[0] + SBCWNUMRELS[0];                    003310
        SBCKWA = OLDSSWA[0] + SBCWCKSUMWA[0] + 1;                       003320
        FOR J = 1 STEP 1           # STEP THROUGH ALL SS CHECKSUMS     #003330
          UNTIL NUMSBCKS                                                003340
        DO                                                              003350
          BEGIN                                                         003360
          IF J GR SBCKLAST         #IF ALL SS CHECKSUMS IN CORE CHECKED#003370
          THEN                                                          003380
            BEGIN                                                       003390
            IF NUMSBCKS - J GQ 50   # IF CHECKSUMS LEFT GQ 50          #003400
            THEN                                                        003410
              RDLEN = 50;          # READ 50 CHECKSUMS                 #003420
            ELSE                                                        003430
              RDLEN = NUMSBCKS - J + 1;  # READ REMAINING CHECKSUMS    #003440
            SBCKLAST = RDLEN + J - 1;                                   003450
            SBCKBEGIN = J;                                              003460
            DDLRDSB (P<SBCKSUMS>, RDLEN*4, SBCKWA+(SBCKBEGIN-1)*4);     003470
                                                                        003480
            END                                                         003490
          JJ = J - SBCKBEGIN + 1;                                       003500
          LL = 0;                                                       003510
          FOR L = 1 STEP 1         # STEP THROUGH ALL SCHEMA CHECKSUMS #003520
            UNTIL NUMSCCKS                                              003530
          DO                                                            003540
            BEGIN                                                       003550
            LFIL = SCCKBEGIN + LL;                                      003560
            IF LFIL GR SCCKLAST    # IF MORE SC CHECKSUMS TO BE CHECKED#003570
            THEN                                                        003580
              BEGIN                                                     003590
              IF LFIL GR NUMSCCKS                                       003600
              THEN                                                      003610
                LFIL = 1;                                               003620
              IF NUMSCCKS - LFIL GQ 50  # IF CHECKSUMS LEFT GQ 50      #003630
              THEN                                                      003640
                RDLEN = 50;        # READ 50 SCHEMA CHECKSUMS          #003650
              ELSE                                                      003660
                RDLEN = NUMSCCKS - LFIL + 1;  #READ REMAINING CHECKSUMS#003670
              SCCKLAST = RDLEN + LFIL - 1;                              003680
              SCCKBEGIN = LFIL;                                         003690
              SCCKSRD (P<SCCKSUMS>, RDLEN*4, (SCCKBEGIN-1)*4+1);        003700
                                                                        003710
              LL = 0;                                                   003720
              END                                                       003730
            LL = LL + 1;                                                003740
            IF SBARNAME[JJ] EQ SCARNAME[LL]                             003750
            THEN                                                        003760
              BEGIN                                                     003770
              IF SBCKSUM[JJ] NQ SCCKSUM[LL]                             003780
              THEN                                                      003790
                COMPARE = FALSE;   # CLEAR CHECKSUMS COMPARE FLAG      #003800
              TEST J;              # GET NEXT SUBSCHEMA CHECKSUM       #003810
                                                                        003820
              END                                                       003830
            END                                                         003840
          C<35,30>MESG7[0] =                                            003850
                C<0,SBSCNAMELENC[SBCWSBHDRPTR[0]]>OLDSSNM30[0];         003860
          DDLPRNT (MESSAGE7, 70);                                       003870
          TEST I;                  # GET NEXT SUBSCHEMA                #003880
                                                                        003890
          END                                                           003900
        IF NOT COMPARE             # IF CHECKSUMS DO NOT COMPARE       #003910
        THEN                                                            003920
          BEGIN                    # STORE SS NAME IN MESSAGE          #003930
          C<35,30>MESG7[0] =                                            003940
                C<0,SBSCNAMELENC[SBCWSBHDRPTR[0]]>OLDSSNM30[0];         003950
          DDLPRNT (MESSAGE7, 70);                                       003960
                                                                        003970
          NO = FALSE;              # SET SS TO BE RECOMPILED FLAG      #003980
          END                                                           003990
        END                                                             004000
      IF NO                        # IF NO SUBSCHEMAS TO BE RECOMPILED #004010
      THEN                                                              004020
        DDLPRNT (MESSAGE3, 40);                                         004030
                                                                        004040
      DDLPRNT (MESSAGE4, 60);      # END OF REPORT MESSAGE             #004050
                                                                        004060
      DDLPRNT (MESSAGE2, 10);      # BLANK LINE ON OUTPUT              #004070
                                                                        004080
      TERMEXIT;                    # TERMINATE DDL PROCESSING          #004090
                                                                        004100
      END                                                               004110
      TERM;                                                             004120
