*DECK DBMSTRD                                                            DBMSTRD
USETEXT UTMPTTX 
USETEXT MDDEFTX 
USETEXT MDBCMTX 
      PRGM DBMSTRD;                                                      DBMSTRD
*CALL COPYRDCLS 
 #                                                                       DBMSTRD
  *   MASTER DIRECTORY BUILD UTILITY             PAGE  1                 DBMSTRD
  *   MAIN ROUTINE - 0,0 OVERLAY                                         DBMSTRD
  *   J. JAN JANIK                               DATE  10/03/75          DBMSTRD
  *   A. W. LO                                   DATE  05/08/77 
                                                                         DBMSTRD
  DC  PURPOSE                                                            DBMSTRD
                                                                         DBMSTRD
      THIS ROUTINE SETS UP FILES AS SPECIFIED ON THE DBMSTRD CONTROL     DBMSTRD
      CARD AND CONTROLS THE LOADING OF THE PROPER OVERLAYS TO BUILD THE  DBMSTRD
      NEW MASTER DIRECTORY.                                              DBMSTRD
                                                                         DBMSTRD
  DC  ENTRY CONDITIONS                                                   DBMSTRD
                                                                         DBMSTRD
      THE CONTROL CARD HAS BEEN CRACKED BY THE OPERATING SYSTEM AND THE  DBMSTRD
      PARAMETERS AND SEPARATORS STORED IN RA+2 THRU RA+53 IN THE NOS/BE  DBMSTRD
      FORMAT. 
                                                                         DBMSTRD
  DC  EXIT CONDITIONS                                                    DBMSTRD
                                                                         DBMSTRD
      THE NEW MASTER DIRECTORY IS BUILT AND CONTROL IS RETURNED TO THE   DBMSTRD
      OPERATING SYSTEM.                                                  DBMSTRD
                                                                         DBMSTRD
  DC  CALLING ROUTINES                                                   DBMSTRD
                                                                         DBMSTRD
      CALLED BY CONTROL CARD DBMSTRD.                                    DBMSTRD
                                                                         DBMSTRD
  DC  CALLED ROUTINES                                                    DBMSTRD
                                                                         DBMSTRD
      DB$MABT - CALLED TO ABORT THE RUN WHEN A FATAL ERROR OCCURS        DBMSTRD
      DB$MORS - CALLED TO OUTPUT RUN STATISTICS AND DONE MESSAGE         DBMSTRD
      DB$MSSG - CALLED TO START GATHERING RUN UNIT STATISTICS            DBMSTRD
      DB$M10E - CALLED TO ENTER OVERLAY (1,0) 
      DB$M20E - CALLED TO ENTER OVERLAY (2,0) 
      DB$M30E - CALLED TO ENTER OVERLAY (3,0) 
      DB$M40E - CALLED TO ENTER OVERLAY (4,0) 
      DB$UCLF - CALLED TO CLOSE INPUT AND OUTPUT FILES                   DBMSTRD
      DB$UOPF - CALLED TO  OPEN INPUT AND OUTPUT FILES                   DBMSTRD
      DB$WCLS - CALLED TO CLOSE WORD ADDRESSABLE FILE                    DBMSTRD
      DB$WOPN - CALLED TO  OPEN WORD ADDRESSABLE FILE                    DBMSTRD
      STORLFN - CALLED TO STORE LFN FROM CC INTO PROPER VARIABLE         DBMSTRD
                                                                         DBMSTRD
* DC  NON-LOCAL VARIABLES 
                                                                         DBMSTRD
      DB$FTMD - FIT FOR NEW MD                                           DBMSTRD
      DB$LNLF - LINES LEFT ON PAGE                                       JJJ1107
      DB$MEOF - EOF DETECTED ON INPUT FILE                               JJJ1107
                                                                         DBMSTRD
  DC  DESCRIPTION                                                        DBMSTRD
                                                                         DBMSTRD
      ON ENTRY BASED ARRAY RA IS SET AT ZERO TO ACCESS COMMUNICATION     DBMSTRD
      CELLS.  ALL DEFAULT LFNS ARE SET UP.                               DBMSTRD
                                                                         DBMSTRD
      PARAMETERS ARE EXTRACTED FROM THE COMMUNICATION CELLS AND CHECKED  DBMSTRD
      AGAINST THE LIST OF LEGAL PARAMETERS.  IF A MATCH IS FOUND AND THE DBMSTRD
      PARAMETER SPECIFIES A LFN, THE FILE NAME IS STORED IN THE PROPER   DBMSTRD
      VARIABLE OVERWRITING THE DEFAULT.  IF THE PARAMETER IS LD, GENLD   DBMSTRD
      IS SET FOR USE LATER.  SINCE A PARAMETER CAN ONLY BE SPECIFIED     DBMSTRD
      ONCE, WHEN A PARAMETER IS SPECIFIED IT IS REMOVED FROM THE LIST OF DBMSTRD
      LEGAL PARAMETERS.  ANY ERROR IN THE CONTROL CARD CAUSES THE RUN TO DBMSTRD
*     BE ABORTED IMMEDIATELY. 
                                                                         DBMSTRD
      IF THE OLD MD LFN IS THE SAME AS THE NEW MD LFN, THE RUN IS 
*     ABORTED. INPUT,OUTPUT, AND NEW MD FILES ARE OPENED. DB$MLDV IS
      CALLED TO LOAD AND EXECUTE OVERLAY (1,0).  ON RETURN FROM (1,0)    DBMSTRD
      THE FLAG SCHINCR IS CHECKED TO SEE IF A SCHEMA OR MODS TO A SCHEMA DBMSTRD
      ARE IN CORE.  IF YES, (2,0) IS LOADED AND EXECUTED TO PUT THE NEW  DBMSTRD
      SCHEMA OR MODIFIED SCHEMA ON THE MD.  ON RETURN (3,0) IS LOADED    DBMSTRD
      AND EXECUTED TO BUILD ANY NEW CSTS.  ON RETURN FROM (3,0) OR IF    DBMSTRD
      SCHINCR WAS 0,DB$MEOF IS CHECKED TO SEE IF EOF WAS DETECTED ON THE JJ10247
      INPUT FILE.  IF NOT THE PROGRAM LOOPS BACK AND RELOADS (1,0).  IF  DBMSTRD
      SO FINFLAG IS SET AND OVERLAY (2,0) IS LOADED AND EXECUTED TO COPY DBMSTRD
*     ALL REMAINING SCHEMAS TO THE NEW MD AND TO FINISH MD PROCESSING.
      ON RETURN FROM (2,0), GENLD IS CHECKED AND IF SET (4,0) IS CALLED  DBMSTRD
      IN TO GENERATE A DIRECTORY LIST.  ALL FILES ARE THEN CLOSED, A     DBMSTRD
      MESSAGE THAT THE RUN IS DONE IS ISSUED TO THE DAYFILE WITH CP RUN  DBMSTRD
      TIME AND FL USED, AND THE RUN STOPPED.                             DBMSTRD
 #                                                                       DBMSTRD
      BEGIN                                                              JJJ1024
*CALL MDABTDCLS                                                          DBMSTRD
                                                                         DBMSTRD
      XREF ARRAY DE$FTSC;    #SCHEMA FIT #
        BEGIN 
        ITEM FTSCES U(13,33,9);  #ERROR STATUS FIELD #
        END 
*CALL FITMDDCLS                                                          DBMSTRD
                                                                         DBMSTRD
      XREF ARRAY DB$FTOD;    # OLD MASTER DIRECTORY FIT                #
        BEGIN 
        ITEM FTODLFN C(0,0,7);    # LFN OF THE OLD MD.                 #
      ITEM FTODES U(13,33,9);          #ERROR STATUS FIELD             #
        END 
  
                                                                         CORTOPL
# MISCELLANEOUS DEFS #                                                   DBMSTRD
                                                                         DBMSTRD
      DEF DFCOMPLFN  #O"03171520111405000000"#;  #COMPILE ZERO FILLED  # DBMSTRD
      DEF DFEQPRSEP #2#;     #THE CODE FOR AN EQUAL SIGN AS A CONTROL#   DBMSTRD
                             #CARD SEPARATOR IS 2#                       DBMSTRD
      DEF DFHDLINLN #60#;  # LENGTH OF HEADER LINE                     # JJJ1107
      DEF DFINPLFN  #O"11162025240000000000"#;  #  INPUT ZERO FILLED   # DBMSTRD
      DEF DFLEGLPCNT #4#;    #NUMBER OF PARAMETER TYPES ALLOWED ON #     DBMSTRD
                             # CONTROL CARD MINUS 1 #                    DBMSTRD
      DEF DFNEWLFN  #O"16152324220422000000"#;  #NMSTRDR ZERO FILLED   # DBMSTRD
      DEF DFOLDLFN  #O"17152324220422000000"#;  #OMSTRDR ZERO FILLED   # DBMSTRD
      DEF DFOUTLFN  #O"17252420252400000000"#;  # OUTPUT ZERO FILLED   # DBMSTRD
                                                                         DBMSTRD
                                                                         JJJ1107
      XDEF PROC DB$ERSC;     # CRM ERROR ON SCHEMA             #
                                                                         JJJ1107
      XDEF PROC DB$ERMD;     # ERROR PROC FOR MD CRM ERRORS            # DBMSTRD
                                                                         JJJ1107
      XDEF PROC DB$EROD;     # ERROR PROC FOR OLD MD CRM ERRORS        #
                                                                         JJJ1107
                                                                         DBMSTRD
      XREF                                                               DBMSTRD
        BEGIN                                                            DBMSTRD
        PROC DB$MABT;        #ABORT DBMSTRD RUN AFTER ISSUING MESSAGE#   DBMSTRD
        PROC DB$MSG;         # ISSUES MSG TO THE DAYFILE AND DISPLAYS  # DBMSTRD
        PROC DB$MULO;        # UNLOAD ALL LOADED OVCAPS                #
        PROC DB$M10E;        # ENTER OVERLAY (1,0)                     #
        PROC DB$M20E;        # ENTER OVERLAY (2,0)                     #
        PROC DB$M30E;        # ENTER OVERLAY (3,0)                     #
        PROC DB$M40E;        # ENTER OVERLAY (4,0)                     #
        PROC DB$UCHD;        # CHANGE HEADER LINE                      # JJJ1107
        PROC DB$UCLF;        # CLOSE INPUT AND OUTPUT FILES            # DBMSTRD
        PROC DB$UOPF;        # OPEN INPUT AND OUTPUT FILES             # DBMSTRD
        PROC DB$UPRT;        # PRINT A STRING                          # DBMSTRD
        PROC DB$USPN;        # SET PROGRAM NAME IN HEADER LINE         # JJJ1107
        PROC DB$WCLS;        # CLOSE WORD ADDRESSABLE FILE             # DBMSTRD
        PROC DB$WOPN;        #  OPEN WORD ADDRESSABLE FILE             # DBMSTRD
        PROC SECOND;         # FORTRAN OBJ TIME RTN FOR CP TIME        # DBMSTRD
                                                                         DBMSTRD
        FUNC DB$CDEB C(10);  # INTEGER TO DECIMAL WITH LEADING BLANKS  #
        FUNC DB$CDEC C(10);  # INTEGER TO DECIMAL WITH LEADING ZEROS   #
        FUNC DB$COCB C(10);  # INTEGER TO OCTAL WITH LEADING BLANKS    #
        FUNC DB$CFIL C(30);  # BLANK OR ZERO FILL                      # JJJ1107
        FUNC DB$MGSS;        # GET CMM STATS. USED TO GET MAX FL USED  #
                                                                         DBMSTRD
        ITEM DB$LNLF;        # LINES LEFT ON PAGE                      # JJJ1107
        ITEM DB$MEOF;        # EOF DETECTED ON INPUT FILE WHEN NON-0   # JJ10247
        ARRAY DB$RA0;  NULLSTMT  # ARRAY USED TO GENERATE ZERO WORD IN # DBMSTRD
                                 # A CALLING SEQUENCE                  # DBMSTRD
        END                                                              DBMSTRD
                                                                         DBMSTRD
                                                                         JJJ1230
# STATUS LIST FOR VALUES USED IN SETSTATUS                             # JJJ1230
        STATUS CHARST DELM,PERIOD,QUOTE,MNUS,LTR,DGT,SC,TRCE;            JJJ1230
                                                                         JJJ1230
#        I  T  E  M  S      #                                            DBMSTRD
                                                                         DBMSTRD
      ITEM ENDTIME R;        # CONTAINS CP TIME USED AT END OF RUN     # DBMSTRD
      ITEM GENLD;            # GENERATE DIRECTORY LIST                 # DBMSTRD
      ITEM INDEX I;          #INDEX FOR FOR LOOPS#                       DBMSTRD
      ITEM NWMDLFN U;        #LFN OF NEW MASTER DIRECTORY#               DBMSTRD
      ITEM PARAM U;          #CC PARAMETER BEING WORKED ON #             DBMSTRD
      ITEM PARAMCNT I;       #NUMBER OF PARAMETERS ON CONTROL CARD#      DBMSTRD
      ITEM STRTIME R;        # CONTAINS CP TIME USED AT START OF RUN   # DBMSTRD
      ITEM SUBINDEX;         #INDEX USED TO SEARCH FOR LEGAL PARAM#      DBMSTRD
                                                                         DBMSTRD
      XREF
  
        BEGIN                                                            DBMSTRD
      CONTROL NOLIST;        # SUPPRESS LISTING OF SCANXDCLS           # CORTOPL
*CALL SCANXDCLS                                                          CORTOPL
      CONTROL LIST;                                                      CORTOPL
                                                                         CORTOPL
        ITEM DB$MIN  U;       # INPUT LFN                              # JJJ1107
        ITEM DB$MOUT U;      # OUTPUT LIST LFN #
        ITEM DB$4FG;         #INDICATES CONTENTS REPORT HEADER REQUIRED#
        ITEM DB$MDND C(10);  #LFN OF THE NEW MD. USED IN MD CONTENTS   #
                             #REPORT PAGE HEADER.                      #
        ITEM DB$TLIM;        #LIMIT OF NUMBER OF LINES PRINTED DURING  #
                              # THE TRACE OF THE SYNTAX                # JJJ1107
        ITEM DB$TLCN;         # NUMBER OF TRACE LINES PRINTED          # CORTOPL
          ARRAY DB$CHLS [79] S(1);  # CONTAINS THE INPUT RECORD, ONE   # JJJ1230
                               # CHARACTER PER WORD WITH THE           # JJJ1230
                               # CORRESPONDING STATUS                  # JJJ1230
            BEGIN                                                        JJJ1230
            ITEM LEXCHAR C(0,0,1) ; # THE CHARACTER                    # JJJ1230
            ITEM  SETSTATUS S:CHARST(0,42,18); # ITS STATUS            # JJJ1230
            END                                                          JJJ1230
                                                                         JJJ1230
        END                                                              DBMSTRD
                                                                         DBMSTRD
#        A R R A Y S                                                   # JJJ1107
      ARRAY HEADLINE P(6);                                               JJJ1107
        BEGIN                                                            JJJ1107
        ITEM HDLIN1   C(0,0,33)=["DBMSTRD SOURCE LISTING   NMD LFN="];   JJJ1107
        ITEM HDLNMDNM C(3,18,7);                                         JJJ1107
        ITEM HDLIN2   C(4,0,12)=["    OMD LFN="];                        JJJ1107
        ITEM HDLOMDNM C(5,12,7);                                         JJJ1107
        ITEM HDLIN3   C(5,54,1)=[" "];                                   JJJ1107
        END                                                              JJJ1107
                                                                         JJJ1107
                                                                         JJJ1107
# PARAMETER VALUES DEFINED BELOW MUST CORRESPOND WITH SWITCH VALUES IN # DBMSTRD
# THE SWITCH SVPARMSW SINCE A COMMON INDEX IS USED TO ACCESS THEM#       DBMSTRD
      ARRAY [DFLEGLPCNT];                                                DBMSTRD
        BEGIN                                                            DBMSTRD
        ITEM LEGPARAM U (0,0,60);  #THE WHOLE PARAMETER#                 DBMSTRD
        ITEM P1HALF U (0,0,18) = [O"110000",  #I#                        DBMSTRD
                                  O"140000",  #L# 
                                  O"171504",  #OMD#                      DBMSTRD
                                  O"161504",  #NMD#                      DBMSTRD
                                  O"140400"]; #LD#                       DBMSTRD
                                                                         DBMSTRD
        ITEM P2HALF U (0,18,42) = [0,0,0,0,0];                           DBMSTRD
        END                                                              DBMSTRD
                                                                         DBMSTRD
      BASED ARRAY RA;        #ARRAY FOR EXAMING THE SYSTEMS #            DBMSTRD
                             #COMMUNICATIONS AREA #                      DBMSTRD
        BEGIN                                                            DBMSTRD
        ITEM CCPARAM U (0,0,42); #CONTROL CARD PARAMETER #               DBMSTRD
        ITEM NUMCCPR I (0,42,18); #COUNT OF CC PARAMETERS #              DBMSTRD
        ITEM CCPRSEP I (0,54,6);  #PARAMETER SEPARATOR #                 DBMSTRD
        END                                                              DBMSTRD
                                                                         DBMSTRD
      SWITCH SVPARMSW SAVEINPLFN,  #SAVE INPUT LFN, I= #                 DBMSTRD
                      SAVEOUTLFN,  # SAVE OUTPUT LIST LFN, L= # 
                      SAVEOMDLFN,  #SAVE OLD MD LFN, OMD= #              DBMSTRD
                      SAVENMDLFN,  #SAVE NEW MD LFN, NMD= #              DBMSTRD
                      LISTDIR;     # SET LIST DIRECTORY FLAG, LD #       DBMSTRD
  
  
  
#**********************************************************************#
#                                                                      #
#     I N T E R N A L   P R O C E D U R E   -   D B $ E R M D          #
#                                                                      #
#**********************************************************************#
  
      PROC DB$ERMD;          # ERROR ON MD                             # DBMSTRD
 #                                                                       DBMSTRD
* *   DB$ERMD - ERROR ON NEW MASTER DIRECTORY    PAGE  1
  *   J. JAN JANIK                               DATE  10/21/75          DBMSTRD
  DC  PURPOSE                                                            DBMSTRD
                                                                         JJJ1107
*     TO PROCESS ERRORS DETECTED ON THE NEW MD
                                                                         JJJ1107
  DC  ENTRY CONDITIONS                                                   DBMSTRD
                                                                         JJJ1107
*     ENTERED FROM CRM WHEN AN ERROR IS DETECTED ON THE NEW MD
                                                                         JJJ1107
  DC  EXIT CONDITIONS                                                    DBMSTRD
                                                                         JJJ1107
      DBMSTRD RUN IS ABORTED                                             DBMSTRD
                                                                         JJJ1107
  DC  CALLING ROUTINES                                                   DBMSTRD
                                                                         JJJ1107
      CRM - IF ERRORS DETECTED                                           DBMSTRD
      DBMSTRD - SETS UP ROUTINE TO BE CALLED IN CRM INTERFACES           DBMSTRD
                                                                         JJJ1107
  DC  CALLED ROUTINES                                                    DBMSTRD
                                                                         JJJ1107
      DB$MABT - TO ABORT THE RUN                                         DBMSTRD
 #                                                                       DBMSTRD
                                                                         JJJ1107
                                                                         JJJ1107
        BEGIN                                                            DBMSTRD
        DB$MABT (DFMDERAB,FTMDES[0]);  # ALL CRM ERRORS ARE FATAL      # DBMSTRD
                                                                         JJJ1107
        END                                                              DBMSTRD
  
  
#**********************************************************************#
#                                                                      #
#     I N T E R N A L   P R O C E D U R E   -   D B $ E R O D          #
#                                                                      #
#**********************************************************************#
  
      PROC DB$EROD; 
 #
  *   DB$EROD - ERROR ON OLD MASTER DIRECTORY    PAGE  1
  *   M. D. SAXE                                 DATE  04/15/76 
  DC  PURPOSE 
  
      TO PROCESS ERRORS DETECTED ON THE OLD MD
  
  DC  ENTRY CONDITIONS
  
      ENTERED FROM CRM WHEN AN ERROR IS DETECTED ON THE OLD MD
  
  DC  EXIT CONDITIONS 
  
      DBMSTRD RUN IS ABORTED
  
  DC  CALLING ROUTINES
  
      CRM - IF ERRORS DETECTED
      DBMSTRD - SETS UP ROUTINE TO BE CALLED IN CRM INTERFACES
  
  DC  CALLED ROUTINES 
  
      DB$MABT - TO ABORT THE RUN
 #
  
        BEGIN 
        DB$MABT(DFODERAB, FTODES[0]);  # ALL CRM ERRORS ARE FATAL      #
        END 
  
  
#**********************************************************************#
#                                                                      #
#     I N T E R N A L   P R O C E D U R E   -   D B $ M S S G          #
#                                                                      #
#**********************************************************************#
  
      PROC DB$MSSG;          #START STATISTICS GATHERING               # DBMSTRD
 #                                                                       DBMSTRD
  *   DB$MSSG - START STATISTICS GATHERING       PAGE  1                 DBMSTRD
  *   J. JAN JANIK                               DATA  10/08/75          DBMSTRD
  DC  PURPOSE                                                            DBMSTRD
                                                                         DBMSTRD
      TO INITIATE TIME CELL SO THAT CP SECONDS USED CAN BE OUTPUT AT END DBMSTRD
      OF THE RUN.                                                        DBMSTRD
                                                                         DBMSTRD
  DC  ENTRY CONDITIONS                                                   DBMSTRD
                                                                         DBMSTRD
  C   NONE                                                               DBMSTRD
                                                                         DBMSTRD
  DC  EXIT CONDITIONS                                                    DBMSTRD
                                                                         DBMSTRD
      STRTIME = CP TIME ALREADY USED BY JOB                              DBMSTRD
                                                                         DBMSTRD
  DC  CALLING ROUTINES                                                   DBMSTRD
                                                                         DBMSTRD
  C   DBMSTRD                                                            DBMSTRD
                                                                         DBMSTRD
  DC  CALLED ROUTINES                                                    DBMSTRD
                                                                         DBMSTRD
      SECOND - FTN OBJ RTN WHICH RETURNS CP TIME USED                    DBMSTRD
 #                                                                       DBMSTRD
        BEGIN                                                            DBMSTRD
        SECOND (STRTIME);    # GET CP TIME USED                        # DBMSTRD
        RETURN;                                                          DBMSTRD
                                                                         DBMSTRD
        END                                                              DBMSTRD
  
  
#**********************************************************************#
#                                                                      #
#     I N T E R N A L   P R O C E D U R E   -   D B $ E R S C          #
#                                                                      #
#**********************************************************************#
  
      PROC DB$ERSC;          #ERROR ON SCHEMA                          #
 #
  *   DB$ERSC - ERROR ON SCHEMA        PAGE 1 
  *   A. W. LO                         DATE  6/3/77 
  DC  PURPOSE 
  
      TO PROCESS ERRORS DETECTED ON SCHEMA
  
  DC  ENTRY CONDITIONS
  
      ENTERED FROM CRM WHEN AN ERROR IS DETECTED ON SCHEMA
  
  DC  EXIT CONDITIONS 
  
      DBMSTRD RUN IS ABORTED
  
  DC  CALLING ROUTINES
  
      CRM - IF ERRORS DETECTED
*     DBMSTRD - SETS UP ROUTINES TO BE CALLED IN CRM INTERFACES 
  
  DC  CALLED ROUTINES 
  
      DB$MABT - TO ABORT THE RUN
  
 #
      BEGIN 
      DB$MABT(DFSCERAB,FTSCES[0]);      #ALL CRM ERRORS ARE FATAL # 
      END 
  
  
#**********************************************************************#
#                                                                      #
#     I N T E R N A L   P R O C E D U R E   -   D B $ M O R S          #
#                                                                      #
#**********************************************************************#
  
      PROC DB$MORS;          #OUTPUT RUN STATISTICS                    # DBMSTRD
 #                                                                       DBMSTRD
  *   DB$MORS - OUTPUT RUN STATISTICS            PAGE 1                  DBMSTRD
  *   J. JAN JANIK                               DATA  10/08/75          DBMSTRD
  DC  PURPOSE                                                            DBMSTRD
                                                                         DBMSTRD
      TO OUTPUT CP TIME AND FIELD LENGTH USED DURING RUN.  ALSO ISSUES   DBMSTRD
      DONE MESSAGE.                                                      DBMSTRD
                                                                         DBMSTRD
  DC  ENTRY CONDITIONS                                                   DBMSTRD
                                                                         DBMSTRD
      OUTPUT FILE OPEN, STRTIME = CP TIME USED AT START OF JOB           DBMSTRD
                                                                         DBMSTRD
  DC  EXIT CONDITIONS                                                    DBMSTRD
                                                                         DBMSTRD
      MESSAGES HAVE BEEN PRINTED AND ISSUED TO THE DAYFILE.              DBMSTRD
                                                                         DBMSTRD
  DC  CALLING ROUTINES                                                   DBMSTRD
                                                                         DBMSTRD
  C   DBMSTRD                                                            DBMSTRD
                                                                         DBMSTRD
  DC  CALLED ROUTINES                                                    DBMSTRD
                                                                         DBMSTRD
      DB$CDIS - CONVERT BINARY NUMBER TO DISPLAY CODE                    DBMSTRD
      DB$MGSS - GET MAX FL USED BY JOB FROM CMM                          DBMSTRD
      DB$MSG  - ISSUE MESSAGE TO A, B, AND JOB DAYFILES                  DBMSTRD
      DB$UPRT - PRINT STRING                                             DBMSTRD
      SECOND - FTN OBJ RTN WHICH RETURNS CP TIME USED                    DBMSTRD
 #                                                                       DBMSTRD
                                                                         DBMSTRD
      ITEM TEMPINT I;        # USED AS TEMP STORE FOR INTEGER ITEM     # DBMSTRD
      BASED ARRAY STATS (6);           #SUMMARY STATISTICS FOR CMM# 
        BEGIN 
        ITEM MAXMM U(0,0,60); 
        ITEM MAXFL U(1,0,60); 
        ITEM NUMCRASH U(2,0,60);
        ITEM NUMINCR U(3,0,60); 
        ITEM NUMDECR U(4,0,60); 
        ITEM NUMOVER U(5,0,60); 
        END 
                                                                         DBMSTRD
        ARRAY COMPMSG P(4);  #COMPLETE MESSAGE                         # DBMSTRD
          BEGIN                                                          DBMSTRD
          ITEM CMPMSG1   C(0,0,22)  =["     DBMSTRD COMPLETE "];         DBMSTRD
          ITEM CMPERRCNT C(2,12,5);                                      DBMSTRD
          ITEM CMPMSG2   C(2,42,11) =[" ERRORS    "];                    DBMSTRD
          ITEM CMPMSG3   U(3,48,12) =[0];                                DBMSTRD
          ITEM CMPMSGCC  C(0,0,1);                                       DBMSTRD
          END                                                            DBMSTRD
                                                                         DBMSTRD
        ARRAY COREMSG P(4);  # PRINT MESSAGE GIVING CORE USED          # DBMSTRD
          BEGIN                                                          DBMSTRD
          ITEM CRMSG1   C(0,0,40) = 
            ["     REQUIRED        B WORDS SCM  "]; 
          END                                                            DBMSTRD
                                                                         DBMSTRD
      ARRAY FATALMD P(6); 
        ITEM FTLMD C(0,0,60) =
          ["     FATAL ERRORS PROHIBITED THE CREATION OF THE NEW MD"];
        ARRAY RNTMPMSG P(4);   # PRINT MESSAGE GIVING RUN TIME        #  DBMSTRD
          BEGIN                                                          DBMSTRD
          ITEM RTPMSG1  C(0,0,40) = 
            ["     RUN TIME      .    SECONDS "]; 
          END                                                            DBMSTRD
                                                                         DBMSTRD
        ARRAY TIMCORDF P(4);  # TIME AND CORE DF MSG                   # DBMSTRD
          BEGIN                                                          DBMSTRD
          ITEM TIMCR1   C(0,0,9)   =["REQUIRED "];                       JJJ1107
          ITEM TIMCREQC C(0,54,6);                                       JJJ1107
          ITEM TIMCR2   C(1,30,11) =["B WORDS    "];                     JJJ1107
          ITEM TIMSECD  C(2,36,4);                                       DBMSTRD
          ITEM TIMCR3   C(3,0,1)   =["."];                               DBMSTRD
          ITEM TIMMILD  C(3,6,3);                                        DBMSTRD
          ITEM TIMCR4   C(3,24,4) = [" SEC"]; 
          ITEM TIMCR5   C(3,48,12) =[0];                                 DBMSTRD
          END                                                            DBMSTRD
      ARRAY WARNMSG P(4);    # WARNING MESSAGES                        #
        BEGIN 
        ITEM WRNMSG1 C(0,0,37) =
          ["                            WARNINGS "];
        END 
  
  
  
#     B E G I N   D B $ M O R S   E X E C U T A B L E   C O D E .      #
  
  
        BEGIN                                                            DBMSTRD
        CMPERRCNT[0] = DB$CDEB(ERRCNT,5); 
        C<22,5>WRNMSG1[0] = DB$CDEB(WRNMSGCTR,5); 
                                                                         DBMSTRD
        DB$MSG  (COMPMSG);   # ISSUE COMPLETE MSG TO DAYFILE           # DBMSTRD
      DB$MSG (WARNMSG); 
        CMPMSGCC [0] = "-";  # TRIPLE SPACE IT                         # DBMSTRD
        DB$UPRT (COMPMSG,40); # PRINT IT                               # DBMSTRD
      DB$UPRT (WARNMSG,40); 
                                                                         DBMSTRD
      IF ERRCNT GR 0                   # IF THERE WERE FATAL ERRORS # 
        THEN                           # THEN OUTPUT SPECIAL MESSAGE #
          BEGIN 
            DB$UPRT(FATALMD,60);       # OUTPUT FATAL ERRORS MESSAGE #
            DB$UPRT("  ",2);           # OUTPUT COMPLETELY BLANK LINE#
          END 
  
      P<STATS> = DB$MGSS; 
                                                                         DBMSTRD
                             # CONVERT IT AND STORE IN MESSAGES        # DBMSTRD
        C<15,6>CRMSG1[0] = DB$COCB(MAXFL,6);
      TIMCREQC[0] = C<15,6>CRMSG1[0]; 
        DB$UPRT (COREMSG,40); # PRINT CORE USED MESSAGE                # DBMSTRD
                                                                         DBMSTRD
        SECOND (ENDTIME);    # GET CP TIME USED                        # DBMSTRD
        ENDTIME = ENDTIME - STRTIME;  # GET TIME USED BY DBMSTRD       # DBMSTRD
        TEMPINT = ENDTIME;   # GET SECONDS                             # DBMSTRD
        ENDTIME = (ENDTIME - TEMPINT ) * 1000;  # NUMBER OF MILLI-SEC  # DBMSTRD
                             # CONVERT AND STORE SECONDS               # DBMSTRD
        C<15,4>RTPMSG1[0] = DB$CDEB(TEMPINT,4); 
      TIMSECD[0] = C<15,4>RTPMSG1[0]; 
        TEMPINT = ENDTIME;   # GET MILLI-SEC AS INTEGER                # DBMSTRD
                             # CONVERT AND STORE MILLI-SECONDS         # DBMSTRD
        C<20,3>RTPMSG1[0] = DB$CDEC(TEMPINT,3); 
      TIMMILD[0] = C<20,3>RTPMSG1[0]; 
                                                                         DBMSTRD
        DB$MSG (TIMCORDF);   # ISSUE TIME AND CORE MESSAGE             # DBMSTRD
        DB$UPRT (RNTMPMSG,40);  # PRINT TIME MESSAGE                   # DBMSTRD
        RETURN;                                                          DBMSTRD
                                                                         DBMSTRD
        END                                                              DBMSTRD
  
  
#**********************************************************************#
#                                                                      #
#     I N T E R N A L   P R O C E D U R E   -   S T O R L F N          #
#                                                                      #
#**********************************************************************#
  
      PROC STORLFN (FILNAM);                                             DBMSTRD
 #                                                                       DBMSTRD
  *   STORLFN - STORE LFN IN VARIABLE            PAGE  1                 DBMSTRD
  *   J. JAN JANIK                               DATE  10/03/75          DBMSTRD
                                                                         DBMSTRD
  DC  PURPOSE                                                            DBMSTRD
                                                                         DBMSTRD
*     GET NEXT PARAMETER FROM CC AREA, ZERO FILL IT, CHECK IF IT"S A
      LEGAL LFN AND STORE IT IN VARIABLE PASSED AS PARAMETER.            DBMSTRD
                                                                         DBMSTRD
  DC  ENTRY CONDITIONS                                                   DBMSTRD
                                                                         DBMSTRD
      FILNAM - NAME OF VARIABLE IN WHICH LFN IS TO BE PLACED.            DBMSTRD
      INDEX - POINTING TO PREVIOUS PARAMETER IN CC AREA. FOR LOOP        DBMSTRD
              INDUCTION VARIABLE IN DBMSTRD.                             DBMSTRD
                                                                         DBMSTRD
  DC  EXIT CONDITIONS                                                    DBMSTRD
                                                                         DBMSTRD
      FILNAM = LFN ZERO FILLED                                           DBMSTRD
      INDEX = INDEX + 1                                                  DBMSTRD
                                                                         DBMSTRD
  DC  CALLING ROUTINES                                                   DBMSTRD
                                                                         DBMSTRD
      DBMSTRD                                                            DBMSTRD
                                                                         DBMSTRD
  DC  CALLED ROUTINES                                                    DBMSTRD
  
      DB$MABT - CALLED IF LFN FIRST CHAR NOT ALPHABETIC.                 DBMSTRD
                                                                         DBMSTRD
  DC  DESCRIPTION                                                        DBMSTRD
                                                                         DBMSTRD
      THE VARIABLE, INDEX, IS BUMPED BY 1, AND THE CONTROL CARD PARAM-   DBMSTRD
      ETER IT"S POINTING TO IS ZERO-FILLED AND STORED IN THE VARIABLE    DBMSTRD
      PASSED AS A PARAMETER.  IF THE 1ST CHARACTER IS NOT A LETTER THE   DBMSTRD
      RUN IS ABORTED.                                                    DBMSTRD
 #                                                                       DBMSTRD
        BEGIN                                                            DBMSTRD
        ITEM FILNAM U;       #FORMAL PARAMETER, FILE NAME#               DBMSTRD
                                                                         DBMSTRD
                                                                         DBMSTRD
        INDEX = INDEX + 1;   #BUMP INDUCTION VARIABLE#                   DBMSTRD
        FILNAM = ( CCPARAM [INDEX] * 2** 18); #GET LFN, ZERO FILL, AND#  DBMSTRD
                                              #STORE IN LOCATION GIVEN#  DBMSTRD
# TEST IF FIRST CHAR OF LFN IS PROPER#                                   DBMSTRD
  
        IF C<0,1> FILNAM GR O"32" OR C<0,1> FILNAM EQ O"00" 
          THEN DB$MABT (DFBDCCPM,FILNAM);  #ILL-FORMED LFN#              DBMSTRD
                                                                         DBMSTRD
        RETURN;                                                          DBMSTRD
                                                                         DBMSTRD
        END                                                              DBMSTRD
  
  
  
  
  
#     B E G I N   D B M S T R D   E X E C U T A B L E   C O D E .      #
  
  
      DB$MSSG;               # START STATISTICS GATHERING              # DBMSTRD
                                                                         DBMSTRD
      P<RA> = 0;             #SET UP RA TO ACCESS COMMUNICATION CELLS  # DBMSTRD
                                                                         DBMSTRD
# INITIALIZE COMMUNICATION CELLS                                       # JJJ1107
      ERRCNT = 0;                                                        JJJ1107
      FINFLAG =0;                                                        JJJ1107
      NEWSCH = 0;                                                        JJJ1107
      RSTSCAN = 0;                                                       JJJ1107
      SCHINCR = 0;                                                       JJJ1107
      WRNMSGCTR = 0;         # NUMBER OF WARNING MESSAGES ISSUED #
      DB$TFLG = 0;                                                       JJJ1009
      MODFLG = 0; 
                                                                         JJJ1107
#INITIALIZE WITH DEFAULT CC PARAMETER VALUES#                            DBMSTRD
      DB$MIN = DFINPLFN;                                                 JJJ1107
      DB$MOUT = DFOUTLFN;                                                JJJ1107
      NWMDLFN = DFNEWLFN;                                                DBMSTRD
      OLMDLFN = DFOLDLFN;                                                DBMSTRD
      PARAMCNT = NUMCCPR [52] + 1;  # GET NUMBER OF PARAMETERS         # DBMSTRD
                                                                         DBMSTRD
# GO THRU ALL PARAMETERS ON CONTROL CARD#                                DBMSTRD
      FOR INDEX = 2 STEP 1 UNTIL PARAMCNT DO                             DBMSTRD
        BEGIN                                                            DBMSTRD
        PARAM =  (CCPARAM [INDEX] * 2**18);  #GET PARAM AND ZERO FILL #  DBMSTRD
                                                                         DBMSTRD
# CHECK PARAMETER AGAINST LEGAL PARAMETER VALUES.  IF SUBINDEX FOR LOOP# DBMSTRD
# COMPLETES THEN PARAMETER WAS NOT LEGAL OR IS SECOND OCCURANCE.#        DBMSTRD
        FOR SUBINDEX = 0 STEP 1 UNTIL DFLEGLPCNT DO                      DBMSTRD
          BEGIN                                                          DBMSTRD
          IF PARAM EQ LEGPARAM [SUBINDEX]                                DBMSTRD
            THEN                                                         DBMSTRD
            BEGIN            #LEGAL PARAMETER#                           DBMSTRD
            LEGPARAM [SUBINDEX] = 0; #CLEAR PARAMETER SINCE PARAMETER#   DBMSTRD
                                     #MAY BE SPECIFIED ONLY ONCE#        DBMSTRD
            GOTO SVPARMSW [SUBINDEX];  #EXIT FOR LOOP BY GOING TO #      DBMSTRD
                                       #PROCESSING CODE. WILL GO FROM#   DBMSTRD
                                       #THERE TO TEST PORTION OF INDEX # DBMSTRD
                                       #FOR LOOP#                        DBMSTRD
            END                                                          DBMSTRD
            ELSE NULLSTMT    #IF NOT THIS ONE TRY NEXT ONE#              DBMSTRD
                                                                         DBMSTRD
          END                #END OF SEARCH.  IT WAS NOT LEGAL.#         DBMSTRD
                                                                         DBMSTRD
        DB$MABT (DFBDCCPM,PARAM);  # EXIT LOOP, ABORT RUN, BAD PARAM   # DBMSTRD
                                                                         DBMSTRD
# FOLLOWING LABELED CODE IS JUMPED TO AS PARAMETERS ARE RECOGNIZED#      DBMSTRD
# CODE IS JUMPED TO BY MEANS OF SWITCH SVPARMSW AND SUBINDEX#            DBMSTRD
                                                                         DBMSTRD
SAVEINPLFN:                                                              DBMSTRD
        IF CCPRSEP [INDEX] EQ DFEQPRSEP                                  DBMSTRD
          THEN                                                           DBMSTRD
          BEGIN                                                          DBMSTRD
          STORLFN (DB$MIN);  # PARAMETER WAS I=LFN. STORLFN BUMPS INDEX# JJJ1107
          END                                                            DBMSTRD
          ELSE DB$MIN = DFCOMPLFN;  # I ALONE SETS LFN TO COMPILE      # JJJ1107
        TEST;                #SEE IF ANY MORE PARAMS #                   DBMSTRD
                                                                         DBMSTRD
                                                                         DBMSTRD
SAVEOUTLFN:                                                              DBMSTRD
        IF CCPRSEP [INDEX] EQ DFEQPRSEP                                  DBMSTRD
          THEN                                                           DBMSTRD
          BEGIN                                                          DBMSTRD
          IF C<0,1> CCPARAM [INDEX+1] EQ "0"                             JJJ1107
            THEN
            BEGIN 
            DB$MOUT = 0;   # L=0 - SUPPRESS OUTPUT LIST # 
            INDEX = INDEX + 1;
            END 
                                                                         JJJ1107
            ELSE STORLFN (DB$MOUT); # STORE NEW LFN. INDEX IS BUMPED   # JJJ1107
          END                                                            DBMSTRD
        TEST;                #SEE IF ANY MORE PARAMS#                    DBMSTRD
                                                                         DBMSTRD
                                                                         DBMSTRD
SAVEOMDLFN:                                                              DBMSTRD
      MODFLG = 1; 
        IF CCPRSEP [INDEX] EQ DFEQPRSEP                                  DBMSTRD
          THEN                                                           DBMSTRD
          BEGIN                                                          DBMSTRD
          STORLFN (OLMDLFN); #WE HAVE PARAMETER OF THE FORM OMD = LFN #  DBMSTRD
                             #STORLFN IS CALLED TO BUMP INDUCTION #      DBMSTRD
                             #VARIABLE (INDEX) AND STORE LFN INTO#       DBMSTRD
                             #OLMDLFN#                                   DBMSTRD
          END                                                            DBMSTRD
        TEST;                #SEE IF ANY MORE PARAMS #                   DBMSTRD
                                                                         DBMSTRD
                                                                         DBMSTRD
SAVENMDLFN:                                                              DBMSTRD
        IF CCPRSEP [INDEX] EQ DFEQPRSEP                                  DBMSTRD
          THEN                                                           DBMSTRD
          BEGIN                                                          DBMSTRD
          STORLFN (NWMDLFN); #WE HAVE PARAMETER OF THE FORM NMD = LFN  # DBMSTRD
                             #STORLFN IS CALLED TO BUMP INDUCTION #      DBMSTRD
                             #VARIABLE (INDEX) AND STORE LFN INTO#       DBMSTRD
                             #NWMDLFN#                                   DBMSTRD
          END                                                            DBMSTRD
        TEST;                #SEE IF ANY MORE PARAMS #                   DBMSTRD
                                                                         DBMSTRD
                                                                         DBMSTRD
LISTDIR:                                                                 DBMSTRD
        GENLD = 1;           # SET FLAG SO DIRECTORY LIST IS GENERATED # DBMSTRD
        TEST;                                                            DBMSTRD
                                                                         DBMSTRD
                                                                         DBMSTRD
        END                  #END OF FOR (INDEX) LOOP #                  DBMSTRD
                                                                         DBMSTRD
                                                                         JJJ0106
      IF OLMDLFN EQ NWMDLFN THEN DB$MABT(DFMDSAME,0); 
      OVERFLOW = FALSE;                                                  JJJ0106
      DB$UOPF;               # OPEN INPUT AND OUTPUT FILES             # JJJ1107
                                                                         JJJ1107
      DB$USPN (" DBMSTRD V");  # SET PROGRAM NAME IN HEADER LINE       # JJJ1107
                                                                         JJJ1107
      HDLNMDNM [0] = DB$CFIL (NWMDLFN,7," ");                            JJJ1107
      HDLOMDNM [0] = DB$CFIL (OLMDLFN,7," ");                            JJJ1107
      DB$UCHD (HEADLINE,DFHDLINLN);  # SET HEADER LINE                 # JJJ1107
      DB$LNLF =0;            # SET LINES LEFT TO 0 SO NEW PAGE STARTED # JJJ1107
                                                                         DBMSTRD
      FTMDLFN[0]=C<0,7>NWMDLFN;  #SET LFN TO PROPER LFN FOR THIS RUN   # JJJ1027
      FTODLFN[0] = C<0,7>OLMDLFN; 
      DB$WOPN (DB$FTMD,DB$ERMD); # OPEN NEW MD                         # DBMSTRD
      DB$UOPF;               # OPEN INPUT AND OUTPUT FILES             # DBMSTRD
                                                                         DBMSTRD
#  INITIALIZATION COMPLETE.  NOW START CRANKING.                       # DBMSTRD
                                                                         DBMSTRD
CONTSCAN:                                                                DBMSTRD
      DB$M10E;
      DB$MULO;               # UNLOAD ALL OVCAPS                       #
      IF SCHINCR NQ 0                                                    DBMSTRD
        THEN                 # SCHEMA IN CORE                          # DBMSTRD
        BEGIN                                                            DBMSTRD
        DB$M20E;
                                                                         DBMSTRD
        DB$M30E;
        END                                                              DBMSTRD
                                                                         DBMSTRD
      IF DB$MEOF EQ 0 THEN GOTO CONTSCAN;   # MORE CARDS ON INPUT      # JJ10247
                                                                         DBMSTRD
      FINFLAG = 1;           # DONE WITH CARDS                         # DBMSTRD
      DB$M20E;
                                                                         DBMSTRD
      DB$MORS;
      IF GENLD EQ 1 AND ERRCNT EQ 0 
        THEN                                                             JJJ1107
        BEGIN                                                            JJJ1107
        C<3,7>DB$MDND = HDLNMDNM[0];
        DB$LNLF = 0;                                                     JJJ1107
      DB$4FG = 1; 
      DB$M40E;               # PRODUCE DIRECTORY LIST                  #
        END                                                              JJJ1107
                                                                         DBMSTRD
      DB$WCLS (DB$FTMD,DB$ERMD);                                         DBMSTRD
      IF ERRCNT GR 0 THEN 
          DB$MABT(DFNOMDCR);
      DB$UCLF;               # CLOSE INPUT AND OUTPUT FILES            # DBMSTRD
                                                                         DBMSTRD
      STOP;                  #STOP EXECUTION#                            DBMSTRD
                                                                         DBMSTRD
      END                                                                JJJ1024
      TERM                                                               DBMSTRD
