*DECK DB$AINT 
USETEXT CDCSCTX 
      PROC DB$AINT ;
      BEGIN 
 #
* *   DB$AINT = PROCESS CDCS CONTROL CARD        PAGE 1 
* *   AND DIRECTIVE FILE PARAMETERS.
* *   R.C.KLOENNE 
* *   M.L.BRANDENBURG - CPS R9 - DIR PARAMETER   DATE 03/10/81
* 
* DC  PURPOSE 
* 
*     CRACK PARAMETERS ON CDCS CONTROL CARD AND/OR DIRECTIVE FILE.
* 
* 
* DC  ENTRY CONDITIONS
* 
*     DB$AINT CALLED BY CDCS - CONTROL CARD IMAGE AT RA + 70. 
* 
*     DIRECTIVE FILE CONTAINS PARAMETERS WHEN DIR IS ONE OF CONTROL 
*     CARD PARAMETERS.
* 
* DC  EXIT CONDITIONS 
* 
*     NORMAL EXIT - 
* 
*     FOR EVERY VALID PARAMETER NAME FOUND, A FLAG (ITEM PFL) IS
*     SET TO TRUE IN ARRAY DB$AIPN. 
* 
*     IF CRM CAPSULE PARAMETERS ARE SPECIFIED, EACH PARAMETER 
*     IS STORED IN ARRAY DB$AIRM. 
* 
*     THE ACCOUNT TABLE "ACCNT" HAS BEEN ADJUSTED.
* 
*     MFL HAS ONE OF THE FOLLOWING THREE VALUES 
*       0, IF NOT ON CDCS CARD
*       120000, IF MFL ON CDCS CONTROL CARD 
*       VALUE, IF MFL = VALUE 
* 
*     BL PARAMETER, IF SUPPLIED, WILL BE STORED IN EXTERNAL ITEM AAM$BL 
*     FOR AAM TO ALLOCATE THE MAXIMUM BUFFER POOL FOR ALL OPEN FILES. 
* 
*     MASTER DIRECTORY PARAMETERS, IF PROVIDED, ARE STORED IN ARRAY 
*     MDPFINF AND MD FILE IS ATTACHED.
* 
*     ABNORMAL EXIT - 
* 
*     NO ERROR CHECKING IS DONE AFTER READING DIR FILE SO 
*     IF A CIO ERROR OCCURS THE SYSTEM WILL ABORT.
*     IF ILLEGAL PARAMETER, CDCS ABORTS.
*     IF MD PERMANENT FILE PARAMETERS ARE SPECIFIED AND A MASTER
*     DIRECTORY IS ALREADY ATTACHED, A MESSAGE IS WRITTEN TO THE
*     DAYFILE AND CDCS ABORTS.
* 
* DC  CALLING ROUTINES
* 
*     CDCS
* 
* DC  CALLED ROUTINES 
* 
# 
      XREF PROC DB$ABRT;  # CDCS ABORT ROUTINE                         #
      XREF FUNC DB$ACCL I;   # LOCATE BASED ARRAY DB$ACCT              #
      XREF PROC DB$ACCN;     # ACCOUNT TABLE TALLY                     #
      XREF PROC DB$ATWR;  # ATTACH FILE                                #
      XREF FUNC DB$CBIN U; # CONVERT DISPLAY TO BINARY                 #
      XREF FUNC DB$CFIL C(30);  # BINARY ZERO OR SPACE FILL            #
      XREF PROC DB$CPT ;  # GET CP TIME                                #
      XREF FUNC DB$DRRD I;# READ DIRECTIVE FILE                        #
      XREF PROC DB$IOT ;  # GET IO TIME                                #
      XREF PROC DB$MFLS;  # SET MAXIMUM FIELD LENGTH                   #
      XREF PROC DB$MSG;   # ISSUE DAYFILE MESSAGE                      #
      XREF PROC DB$NCLK;  # GET REAL TIME FOR NOS                      #
      XREF PROC DB$NCPT;  # GET CP TIME FOR NOS                        #
      XREF PROC DB$NIOT;  # GET IO TIME FOR NOS                        #
      XREF PROC DB$OLLO;  # LOAD AND LOCK OVCAP                        #
      XREF FUNC DB$STAT I; # FILE STATUS                               #
  
 #                                                                     #
#***********************************************************************
*     THE FOLLOWING DEF"S ARE FOR CDCS ACCOUNTING AND PARAMETER 
*     CRACKING. 
# 
      DEF DFBTF #"CDCSBTF"#;         # PROGRAM CDCSBTF                 #
      DEF DFCARDLOC #O"70"#;         # LOCATION OF CARD IMAGE          #
      DEF DFDIR     #10#;            # INDEX TO DIR PARAMETER          #
      DEF DFERRLVL  #15#;            # DIVIDER BETWEEN ERROR TYPES     #
      DEF DFFAMNM   #15#;            # INDEX TO FAMILY NAME PARAMETER  #
      DEF DFID      #13#;            # ID PARAMETER INDEX              #
      DEF DFINPUT   #"INPUT"#;       # DEFAULT VALUE FOR DIR (INPUT)   #
      DEF DFMDNM    #11#;            # INDEX TO MDPFN                  #
      DEF DFNP      #37#;            # MAXIMUM NUMBER OF CDCS          #
                                     # PARAMETERS                      #
      DEF DFNUMERRS #22#;            # NO. OF ERROR MESSAGES           #
      DEF DFPARABL  #O"377777"#;     # MAXIMUM VALUE FOR BL PARAMETER  #
      DEF DFPARACCN #O"64"#;         # RA LOCATION OF NUMBER OF        #
                                     # PARAMETERS ON CONTROL CARD      #
      DEF DFPARAMFL #O"121000"#;     # DEFAULT VALUE FOR MFL PARAMETER #
      DEF DFSETNM   #17#;            # INDEX TO SET NAME PARAMETER     #
      DEF DFUN      #12#;            # UN PARAMETER INDEX              #
      DEF DFVSN     #18#;            # INDEX TO VSN PARAMETER          #
 #
* DC  EXTERNAL ITEMS
# 
      XREF ITEM AAM$BL;              # BUFFER POOL SIZE                #
      XREF ITEM CMMSBL;              # CMM SMALL BLOCK LIMIT           #
      XREF ITEM CMMSBI;              # CMM SMALL BLOCK BOUND INCREMENT #
      XREF ITEM CMM$SBL;             # CMM SMALL BLOCK LIMIT - IN CMM  #
      XREF ITEM ECASW B;             # ENABLE CDCS ABORT BY USER - SW  #
      XREF ITEM RJRSW B;             # RESTRICT JOURNAL RECORDS - SW   #
      XREF ITEM ROFSW B;             # REDUCE OUTPUT FILE - SWITCH     #
      XREF ITEM TLOCKL I;            # TRANSACTION LOCK LIMIT          #
  
      XREF ARRAY DB$RA0;
        BEGIN 
        ITEM NUMPARM   U(DFPARACCN,42,18); #NUMBER OF CC PARAMETERS    #
        ITEM PARAMWD   C(00,00,80);        # CONTROL CARD IMAGE        #
        END 
  
      XREF ARRAY DB$DRFT; 
        BEGIN 
        ITEM DRLFN  C(00,00,07);     # LFN OF DIR FILE                 #
        END 
  
      XREF ARRAY DB$DRWB; 
        BEGIN 
        ITEM  DRWBUF  C(00,00,80);
        END 
  
*CALL ACCNT 
 #                                                                     #
  
#                                                                      #
#     LOCAL ITEMS                                                      #
#                                                                      #
      ITEM BL = 0;           # MAXIMUM BUFFER SIZE FOR ALL OPEN FILES  #
                             # SPECIFIED ON CDCS CONTROL CARD          #
      ITEM CCARD        B;   # SOURCE INDICATOR. TRUE IF CONTROL CARD  #
      ITEM CHAR      C(1);   # ONE CHARACTER FROM PARMWD               #
      ITEM CHARCNT      I;   # COUNT OF CHARACTERS IN PARMWD           #
      ITEM CHARPTR      I;   # CHARACTER  POINTER                      #
      ITEM CP R;             # CP ADJUSTMENT FROM CDCS CONTROL CARD    #
      ITEM EXAM      C(1);   # ONE CHARACTER TO BE EXAMINED            #
      ITEM ENDCARD      B;   # END OF CONTROL CARD FLAG                #
      ITEM ENDJOB       B;   # END OF JOB FLAG                         #
      ITEM FILSTAT      I;   # FILE STATUS, -1 MEANS EOF               #
      ITEM FINIS        B;   # FINISH FLAG                             #
      ITEM FIRSTTIME    B;   # FIRST ERROR FLAG                        #
      ITEM FSTATUS      I;   # RETURN STATUS FROM DB$STAT              #
      ITEM IO R;             # IO ADJUSTMENT FROM CDCS CONTROL CARD    #
      ITEM  I ; 
      ITEM ICRM I = 1;       # CRM TABLE INDEX                         #
      ITEM J            I;   # LOOP VARIABLE                           #
      ITEM K            I;   # LOOP VARIABLE                           #
      ITEM LFNAME C(7) = "MSTRDIR";  # LFN OF MASTER DIRECOTORY        #
      ITEM MFL = 0;          # MAXIMUM FIELD LENGTH PARAMETER          #
      ITEM NEXTPTR      I;   # LOCATION OF START IN PARMWD             #
      ITEM NUM          I;   # LOOP VARIABLE                           #
      ITEM PARMWD    C(7);   # PARAMETER WORD                          #
      ITEM STEPPER      I;   # LOOP VARIABLE                           #
  
  
  
      ARRAY ERRTEXT [DFNUMERRS]  S(4);
        ITEM ERRS    C(0,0,40) =
        ["CDCS ERRORS -                        :"    # ERROR 0         #
        ,"CONTROL CARD PARAMETER XXXXX         :"    # ERROR 1         #
        ,"DIR FILE PARAMETER XXXXX             :"    # ERROR 2         #
        ,"MUST BEGIN WITH LETTER               :"    # ERROR 3         #
        ,"INVALID CHARACTER                    :"    # ERROR 4         #
        ,"TOO MANY CHARACTERS                  :"    # ERROR 5         #
        ,"DUPLICATE PARAMETER                  :"    # ERROR 6         #
        ,"NOT ALLOWED ON FILE                  :"    # ERROR 7         #
        ,"TOO MANY PASSWORDS                   :"    # ERROR 8         #
        ,"THIRD CHARACTER MUST BE NUMERIC      :"    # ERROR 9         #
        ,"FIRST TWO CHARACTERS MUST BE LETTERS :"    # ERROR 10        #
        ,"VALUE TOO LARGE                      :"    # ERROR 11        #
        ,"EQUAL SIGN NOT ALLOWED               :"    # ERROR 12        #
        ,"EQUAL SIGN MUST BE PRESENT           :"    # ERROR 13        #
        ,"UNKNOWN PARAMETER                    :"    # ERROR 14        #
        ,"BOTH VSN AND SET NAME MUST BE GIVEN  :"    # ERROR 15        #
        ,"MASTER DIRECTORY ALREADY ATTACHED    :"    # ERROR 16        #
        ,"MASTER DIRECTORY NOT AVAILABLE       :"    # ERROR 17        #
        ,"MFL MUST BE GREATER THAN BL          :"    # ERROR 18        #
        ,"CDCS ABORT                           :"    # ERROR 19        #
        ,"NO TERMINATOR ON CONTROL CARD        :"    # ERROR 20        #
        ,"LFN IS REQUIRED                      :"    # ERROR 21        #
        ,"UN OR ID MUST BE GIVEN WITH MDPFN    :"    # ERROR 22        #
        ];
  
  
      ARRAY TIMES[1];        # CP AND IO TIMES - USED FOR              #
                             # ACCOUNTING PURPOSES                     #
        BEGIN 
        ITEM TIME;
        END 
  
  
      XDEF ITEM AAMBLS B = FALSE;    # BUFFER POOL SIZE DEFINED        #
      XDEF ITEM CMMMFL I = O"377000";  # MFL VALUE FOR DB$INIT         #
  
      XDEF ARRAY DB$AIPN [0:DFNP];     # VALID PARAMETER NAMES AND     #
                                       # PARAMETER FLAGS               #
  
# PLEASE NOTE:  IF ANY OF THE INDEXES IN THIS ARRAY ARE CHANGED        #
#               THE OVCAP PARAMETER DEFS IN DB$CAPL MUST BE            #
#               CHANGED ALSO.                                          #
  
        BEGIN 
        ITEM PFL B(00,00,01)           # FLAGS FOR PARAMETER NAMES     #
          = [DFNP(FALSE),FALSE];       # INITIALIZE EACH FLAG TO FALSE #
        ITEM PNAME C(00,30,05)         # PARAMETER NAMES               #
         =  ["CP"            # CP    J = 0                             #
            ,"IO"            # IO    J = 1                             #
            ,"MFL"           # MFL   J = 2                             #
            ,"BL"            # BL    J = 3                             #
            ,"IS"            # IS    J = 4                             #
            ,"AK"            # AK    J = 5                             #
            ,"DA"            # DA    J = 6                             #
            ,"MP"            # MP    J = 7                             #
            ,"MIP"           # MIP   J = 8                             #
            ,"CRM"           # CRM   J = 9                             #
            ,"DIR"           # DIR   J = 10                            #
            ,"MDPFN"         # MDPFN J = 11                            #
            ,"UN"            # UN    J = 12                            #
            ,"ID"            # ID    J = 13                            #
            ,"PW"            # PW    J = 14                            #
            ,"FAM"           # FAM   J = 15                            #
            ,"PN"            # PN    J = 16                            #
            ,"SN"            # SN    J = 17                            #
            ,"VSN"           # VSN   J = 18                            #
            ,"DT"            # DT    J = 19                            #
            ,"CAP"           # CAP   J = 20                            #
            ,"CON"           # CON   J = 21                            #
            ,"DBP"           # DBP   J = 22                            #
            ,"INV"           # INV   J = 23                            #
            ,"JLOG"          # JLOG  J = 24                            #
            ,"QRF"           # QRF   J = 25                            #
            ,"REL"           # REL   J = 26                            #
            ,"TRAN"          # TRAN  J = 27                            #
            ,"SBL"           # SBL   J = 28                            #
            ,"SBI"           # SBI   J = 29                            #
            ,"PBC"           # PBC   J = 30                            #
            ,"BFN"           # BFN   J = 31                            #
            ,"FCA"           # FCA   J = 32                            #
            ,"RJR"           # RJR   J = 33                            #
            ,"ROF"           # ROF   J = 34                            #
            ,"ECA"           # ECA   J = 35                            #
            ,"TLL"           # TLL   J = 36                            #
            ,"-END-"];       #       J = DFNP                          #
        END 
  
      BASED ARRAY PARMS;
        BEGIN 
        ITEM PARAM   C(0,0,80);      # CONTROL CARD IMAGE              #
        END 
  
  
      SWITCH PARMSW  ACCT,         # CP                                #
                     ACCT,         # IO                                #
                     FLDLNG,       # MFL                               #
                     BUFLNG,       # BL                                #
                     AAMPARM,      # IS                                #
                     AAMPARM,      # AK                                #
                     AAMPARM,      # DA                                #
                     AAMPARM,      # MP                                #
                     MIPPARM,      # MIP                               #
                     CRMEQ,        # CRM                               #
                     INFILE,       # DIR                               #
                     MDPFN,        # MDPFN                             #
                     UNID,         # UN                                #
                     UNID,         # ID                                #
                     PWSPOT,       # PASSWORD                          #
                     FAMSET,       # FAMILY                            #
                     FAMSET,       # PACK NAME                         #
                     FAMSET,       # SET NAME                          #
                     PARMVSN,      # VSN                               #
                     DTPARM,       # DEVICE TYPE                       #
                     CAPEQ,        # CAP                               #
                     EQTEST,       # CONSTRAINT                        #
                     EQTEST,       # DATA BASE PROCEDURE               #
                     EQTEST,       # INVOKE                            #
                     EQTEST,       # JOURNAL LOGGING                   #
                     EQTEST,       # BLOCK LOGGING                     #
                     EQTEST,       # RELATIONS                         #
                     EQTEST,       # TRANSACTIONS                      #
                     SETSBL,       # SBL - SMALL BLOCK LIMIT           #
                     SETSBI,       # SBI - SMALL BLOCK BOUND INCREMENT #
                     SETPBC,       # PRIORITY BLOCK COUNT              #
                     SETBFN,       # NUMBER OF EXTRA BUFFERS           #
                     SETFCA,       # FIT COUNT ADJUSTMENT              #
                     SETRJR,       # RESTRICT JOURNAL RECORDS          #
                     SETROF,       # REDUCE OUTPUT FILE                #
                     SETECA,       # ENABLE CDCS ABORT BY USER         #
                     SETTLL,       # TRANSACTION LOCK LIMIT            #
                     NOPARM;       #      - UNKNOWN PARAMETER          #
  
  
  
      XDEF ARRAY DB$AIRM  [6]; # LIST OF CRM PARAMETERS                #
        BEGIN 
        ITEM RMLIST U(0,0,60) = [O"17200000000000000000",5(0)]; 
        ITEM RMNAME U(0,0,42);
        END 
 #
  
* DC  DESCRIPTION 
* 
*     SCAN CONTROL CARD PARAMETERS (IMAGE IN RA+70) 
*       BFN - NUMBER OF EXTRA BUFFERS TO BE ASSIGNED FOR EACH FIT THAT
*            IS OPENED.  USED TO DIRECT AAM BUFFER ALLOCATION TARGET. 
*            A DECIMAL NUMBER.
*       BL - MAXIMUM BUFFER POOL SIZE IN OCTAL FOR FILE BUFFERS 
*            ALLOCATED BY AAM. IF ABSENT, CDCS COMPUTES A DEFAULT.
*       CP - A DECIMAL NUMBER USED AS A MULTIPLIER FOR ENTRIES RELATED
*            TO CP CHARGES IN CDCS INTERNAL ACCOUNTING TABLE. IF THIS 
*            PARAMETER IS ABSENT, A 1 IS USED AS THE MULTIPLIER.
*       ECA - SETS A MODE THAT ALLOWS A USER TO ABORT CDCS WITH A CALL
*            TO DB$ABT. 
*       FCA - FIT COUNT ADJUSTMENT.  WHEN THERE ARE N USERS WHO HAVE
*            OPENED AN AREA, CDCS ALLOCATES AND OPENS LOG(N)+FCA
*            FITS FOR THE AREA.  THIS DECIMAL NUMBER MAY BE NEGATIVE. 
*       IO - A DECIMAL NUMBER USED AS A MULTIPLIER FOR ENTRIES RELATED
*            TO IO CHARGES IN CDCS INTERNAL ACCOUNTING TABLE. IF THIS 
*            PARAMETER IS ABSENT, A 1 IS USED AS THE MULTIPLIER.
*       MFL - MAXIMUM FIELD LENGTH IN OCTAL FOR CDCS. DEFAULT VALUE IS
*            120000.
*       PBC - PRIORITY BUFFER COUNT.  THE MAXIMUM NUMBER OF INDEX 
*            BUFFERS TO BE GIVEN PRIORITY IN THE AAM KICKOUT CHAIN. 
*            A DECIMAL NUMBER.
*       RJR - RESTRICT JOURNAL LOG RECORDS.  SUPRESSES INVOKE,
*            TERMINATE, OPEN, CLOSE, BEGIN, COMMIT, DROP AND
*            VERSION-CHANGE LOG RECORDS.
*       ROF - REDUCE OUTPUT FILE.  SUPRESSES INVOKE AND TERMINATE 
*            MESSAGES FROM THE OUTPUT FILE. 
*       SBI - CMM SMALL BLOCK BOUNDARY INCREMENT.  AN INCREMENT BY
*            WHICH CMM.SBL WILL BE PROGESSIVELY INCREASED UNTIL SBL IS
*            REACHED. 
*       SBL - CMM SMALL BLOCK LIMIT.  THE MAXIMUM ADDRESS AT WHICH
*            CMM WILL ASSIGN MEMORY BLOCKS OF LENGTH LESS THAN CMM.SBM. 
*            AN OCTAL NUMBER. 
*       TLL - TRANSACTION LOCK LIMIT.  SETS A LIMIT TO THE NUMBER OF
*            LOCKS ONE USER CAN HAVE WITHIN A TRANSACTION.
* 
* 
*       DIR - LFN OF FILE CONTAINING PARAMETERS 
* 
*             IF DIR PRESENT THEN 
*               OPEN FILE.
*               SCAN EACH LINE (RECORD) OF FILE.
*               VALIDATE PARAMETERS.
*               SET PARAMETERS IN SAME MANNER AS CONTROL CARD PARAMETERS
*               IF MD INFORMATION PROVIDED THEN 
*                 STORE INFORMATION IN MDPFINF. 
*                 ATTACH MD FILE. 
*                 IF A MASTER DIRECTORY ALREADY ATTACHED, 
*                 ISSUE MESSAGE AND ABORT.
* 
* 
*     CRM CAPSULE LOCK-IN PARAMETERS. 
* 
*       CRM- FOR DOCUMENTATION ONLY.
* 
*       IS - LOCK IN THE INDEX SEQUENTIAL CAPSULES. 
* 
*       AK - LOCK IN THE ACTUAL KEY FILE STRUCTURE CAPSULES.
* 
*       DA - LOCK IN THE DIRECT ACCESS FILE STRUCTURE CAPSULES. 
* 
*       MP - LOCK IN MIP AND IS CAPSULES. 
*            (MIP IS AN EQUIVALENT CONTROL CARD PARAMETER TO MP)
* 
* 
*     CDCS OVCAP LOCK-IN PARAMETERS.  (CAP IS CHECKED FOR AN
*     EQUAL SIGN FOLLOWING IT.  FOR ALL OTHERS, A FLAG (ITEM PFL
*     IN ARRAY DB$AIPN) IS SET WHEN THEY ARE FOUND AND A CHECK IS 
*     MADE AT LABEL EQTEST TO SEE THAT AN EQUAL SIGN DOES NOT 
*     FOLLOW.  ALL OTHER PROCESSING IS DONE IN DB$CAPL.)
* 
*       CAP  - FOR DOCUMENTATION ONLY.
* 
*       CON  - LOCK IN THE CONSTRAINT OVCAP.
* 
*       DBP  - LOCK IN THE DATA BASE PROCEDURE OVCAP. 
* 
*       INV  - LOCK IN THE INVOKE OVCAPS. 
* 
*       JLOG - LOCK IN THE JOURNAL LOGGING OVCAPS.
* 
*       QRF  - LOCK IN THE BLOCK LOGGING OVCAP. 
* 
*       REL  - LOCK IN THE RELATIONS OVCAPS.
* 
*       TRAN - LOCK IN THE TRANSACTIONS OVCAPS. 
* 
 #
  
  
  
#**********************************************************************#
#                                                                      #
#     I N T E R N A L   P R O C E D U R E   -   E R R W R I T E        #
#                                                                      #
#**********************************************************************#
  
      PROC ERRWRITE(ERRNUM);
 #
* *   ERRWRITE - WRITE ERROR MESSAGES            PAGE 1 
* *   M.L.BRANDENBURG                            DATE 04/03/81
* 
* DC  PURPOSE 
*     WRITE ERROR MESSAGES. 
* 
* DC  ENTRY CONDITIONS
*     INPUT PARAMETER ERRNUM IS SET WITH THE ERROR MESSAGE
*     TO BE WRITTEN.
*     J IS EQUAL TO THE SUBSCRIPT OF THE PARAMETER IN PNAME.
*     FIRSTTIME TRUE IF FIRST TIME ERRWRITE HAS BEEN CALLED.
* 
* DC  EXIT CONDITIONS 
*     ERROR MESSAGES WRITTEN TO DAYFILE.  FIRSTTIME FLAG SET
*     FALSE WHEN FIRST MESSAGE REQUEST RECEIVED.
* 
* DC  CALLING ROUTINES
*     LITCHECK
*     DB$AINT 
*     SCANNER 
* 
* DC  CALLED ROUTINES 
*     DB$MSG
* 
* DC  DESCRIPTION 
*     THE FIRST TIME THIS PROCEDURE IS CALLED THE MESSAGE 
*     "CDCS ERRORS - " IS WRITTEN.  A MESSAGE IS THEN 
*     WRITTEN TO INFORM THE USER IF THE ERROR WAS CAUSED BY 
*     INPUT FROM THE CONTROL CARD OR FROM THE DIR FILE AND
*     THE NAME OF THE PARAMETER CAUSING THE ERROR.  THE 
*     SPECIFIC ERROR MESSAGE IS THEN WRITTEN. 
* 
 #
  
      BEGIN 
  
      ITEM ERRNUM      I; 
  
      IF FIRSTTIME
      THEN
        BEGIN 
        DB$MSG(ERRS[0]);           # WRITE CDCS ERRORS                 #
        FIRSTTIME = FALSE;         # SHOW THAT WE WERE HERE            #
        END 
  
      IF ERRNUM LS DFERRLVL        # DOES MSG NEED SOURCE              #
      THEN
        BEGIN 
        IF CCARD                   # FROM CONTROL CARD                 #
        THEN
          BEGIN 
          C<23,5>ERRS[1] = PNAME[DFNP];  # INSERT PARAMETER            #
          DB$MSG(ERRS[1]);         # WRITE IT OUT                      #
          END 
        ELSE
          BEGIN 
          C<19,5>ERRS[2] = PNAME[DFNP];  # INSERT PARAMETER            #
          DB$MSG(ERRS[2]);
          END 
        END 
  
      DB$MSG(ERRS[ERRNUM]);        # WRITE REASON FOR ERROR            #
  
      RETURN; 
      END                          # END PROC ERRWRITE                 #
  
  
  
#**********************************************************************#
#                                                                      #
#     I N T E R N A L   P R O C E D U R E   -   L I T C H E C K .      #
#                                                                      #
#**********************************************************************#
  
      PROC LITCHECK;
 #
* *   LITCHECK - VALIDATE LITERALS               PAGE 1 
* *   M.L.BRANDENBURG                            DATE 04/02/81
* 
* DC  PURPOSE 
* 
*     VALIDATE ALPHANUMERIC LITERALS RECEIVED AS PARAMETER VALUES.
* 
* DC  ENTRY CONDITIONS
*     THE LITERAL HAS BEEN STORED IN VARIABLE, PARMWD.
*     THE LENGTH OF THE LITERAL IS IN VARIABLE, CHARCNT.
* 
* DC  EXIT CONDITIONS 
* 
*     NORMAL EXIT IS RETURN TO THE CALLER.
*     ABNORMAL EXIT CAUSES CDCS TO ABORT AFTER ERROR MESSAGES 
*     ARE WRITTEN.
* 
* DC  CALLING ROUTINES
* 
*     DB$AINT 
* 
* DC  CALLED ROUTINES 
* 
*     NONE
* 
* DC  DESCRIPTION 
* 
*     THE FIRST CHARACTER IS TESTED TO BE SURE IT IS ALPHABETIC.
*     EACH REMAINING CHARACTER IS TESTED TO BE SURE THAT NO 
*     SPECIAL CHARACTERS ARE INCLUDED.
* 
* 
 #
  
      BEGIN 
  
      EXAM = C<0,1>PARMWD;         # GET ONE CHARACTER TO EXAMINE      #
      IF EXAM LS "A"               # NAME MUST BEGIN WITH ALPHA CHAR   #
        OR EXAM GR "Z"
      THEN
        BEGIN 
        ERRWRITE(3);               # NAME MUST BEGIN WITH LETTER       #
        END 
  
      FOR STEPPER = 1 STEP 1 UNTIL CHARCNT - 1
      DO                           # MAKE SURE NO SPECIAL CHARS        #
        BEGIN 
        EXAM = C<STEPPER,1>PARMWD;
        IF EXAM LS "A"
          OR EXAM GR "9"
        THEN
          BEGIN 
          ERRWRITE(4);             # INVALID CHARACTER IN LITERAL      #
          END 
        END                        # END STEPPER LOOP                  #
  
      RETURN; 
      END                          # END PROC LITCHECK                 #
  
  
  
#**********************************************************************#
#                                                                      #
#     I N T E R N A L   P R O C E D U R E   -   S C A N N E R .        #
#                                                                      #
#**********************************************************************#
  
      PROC SCANNER; 
  
 #
* *   SCANNER - SCANS INPUT STREAM               PAGE 1 
* *   M.L.BRANDENBURG                            DATE 04/02/81
* 
* DC  PURPOSE 
* 
*     SCANS INPUT STREAMS EXTRACTING CHARACTERS BETWEEN DELIMITERS. 
* 
* DC  ENTRY CONDITIONS
* 
*     NEXTPTR POINTS TO THE NEXT CHARACTER TO BE PROCESSED. 
*     CCARD IS SET TRUE IF INPUT IS THE CONTROL CARD STREAM 
*     AND IS SET FALSE IF INPUT IS FROM THE DIRECTIVE FILE. 
*     POINTER TO PARAMWD IS SET TO EITHER RA + 70 OR TO DB$DRWB,
*     THE BUFFER DECLARED IN DB$MURR
* 
* DC  EXIT CONDITIONS 
* 
*     NORMAL EXIT HAS THE CHARACTERS BETWEEN DELIMITERS STORED IN 
*     PARMWD. 
*     IF END OF CARD IMAGE, ENDCARD IS SET TRUE.
*     IF END OF RECORD FROM THE FILE, THE NEXT RECORD HAS BEEN READ.
*     IF END OF FILE, FILESTAT IS SET -1. 
*     THE VARIABLE CHAR CONTAINS THE DELIMITER WHICH CAUSED THE 
*     SCAN TO STOP. 
*     THE VARIABLE CHARCNT CONTAINS THE NUMBER OF CHARACTERS
*     STORED IN PARMWD. 
*     THE VARIABLE NEXTPTR POINTS TO THE CHARACTER AFTER THE
*     DELIMITER, OR TO ZERO IF A NEW RECORD WAS READ. 
* 
*     ABNORMAL EXIT WILL BE TAKEN IF NO FINAL DELIMITER IS FOUND
*     ON THE CONTROL CARD OR IF CHARCNT IS GREATER THAN 7.
* 
* DC  CALLING ROUTINES
* 
*     DB$AINT 
* 
* DC  CALLED ROUTINES 
* 
*     DB$DRRD - READ RECORD FROM INPUT FILE 
* 
* DC  DESCRIPTION 
*     EACH CHARACTER IS EXAMINED, ONE BY ONE, TO DETERMINE IF 
*     THE CHARACTER IS A DELIMITER.  DELIMITERS ARE DEFINED 
*     TO BE PERIOD, COMMA, EQUAL SIGN, SLASH, RIGHT OR LEFT 
*     PARENTHESES, OR A SPACE.
*     IF A SPACE IS FOUND, IT IS IGNORED UNTIL CHARPTR IS GQ 80.
*     AT THAT TIME, IF INPUT IS FROM THE CONTROL CARD, A MESSAGE
*     IS WRITTEN THAT THE TERMINATOR IS MISSING AND ENDJOB IS SET TRUE. 
*     IF INPUT IS FROM THE FILE, A NEW RECORD IS READ.
*     IF A PERIOD OR RIGHT PARENTHESES IS FOUND IT IS CONSIDERED
*     TO BE SIGNALLING THE END OF INPUT, IF SOURCE IS CONTROL CARD. 
*     ALL OTHER DELIMITERS ARE CONSIDERED AS NOTING THE END OF THE
*     WORD OR VALUE BEING SCANNED, AND NEXTPTR IS SET TO POINT TO 
*     THE NEXT CHARACTER IN THE INPUT STREAM.  THE DELIMITER IS NOT 
*     MOVED TO PARMWD.
* 
 #
  
      BEGIN 
      PARMWD = "       ";          # CLEAR THE TARGET WORD             #
      CHARCNT = 0;                 # SET CHARACTER COUNT TO ZERO       #
      FINIS = FALSE;               # FINISH FLAG IS FALSE              #
  
      FOR CHARPTR = NEXTPTR STEP 1
        WHILE NOT FINIS 
      DO
        BEGIN 
        CHAR = C<CHARPTR,1>PARAM[0];
        IF CHAR EQ " "            # IGNORE SPACE UNLESS IMAGE FINISHED #
          OR CHARPTR GQ 80        # LAST CHARACTER PROCESSED           #
        THEN
          BEGIN 
          IF CHARPTR LQ 79         # CARD AND RECORD LENGTH IS 80      #
          THEN
            BEGIN 
            TEST CHARPTR;          # JUST IGNORE THE SPACE             #
            END 
          IF CCARD                 # COUNT > 80 AND CONTROL CARD       #
          THEN
            BEGIN 
            ERRWRITE(20);          # NO TERMINATOR ON CONTROL CARD     #
            FINIS = TRUE;          # NO MORE TO DO                     #
            ENDCARD = TRUE; 
            TEST CHARPTR; 
            END 
          ELSE
            BEGIN                  # INPUT FROM FILE                   #
            FILSTAT = DB$DRRD;     # READ NEW RECORD                   #
            NEXTPTR = 0;           # SET TO START OF RECORD # 
            FINIS = TRUE;          # SAY THRU WITH THIS WORD #
            TEST CHARPTR; 
            END 
          END 
        IF CHAR EQ "."             # IS IT A PERIOD                    #
          OR CHAR EQ ","           # OR A COMMA                        #
          OR CHAR EQ "="           # OR AN EQUAL SIGN                  #
          OR CHAR EQ "/"           # OR A SLASH                        #
          OR CHAR EQ "("           # ( IS END OF "CDCS" ON CARD        #
          OR CHAR EQ ")"           # ) IS END OF CONTROL CARD          #
        THEN
          BEGIN 
          FINIS = TRUE;            # SIGNAL THROUGH WITH THIS WORD     #
          IF CHAR EQ "."           # PERIOD MEANS END                  #
            OR CHAR EQ ")"         # AND SO DOES )                     #
          THEN
            BEGIN 
            IF CCARD               # IF IN CONTROL CARD - END          #
            THEN
              BEGIN 
              ENDCARD = TRUE; 
              END 
            ELSE
              BEGIN 
              NEXTPTR = 0;         # SET FOR BEGINNING OF RECORD       #
              FILSTAT = DB$DRRD;   # READ ANOTHER RECORD               #
              END 
            END 
          ELSE
            BEGIN 
            NEXTPTR = CHARPTR + 1;  # SET POINTER PAST DELIMITER       #
            END 
          END                      # END CHAR EQUAL DELIMITER          #
        ELSE
          BEGIN 
          IF CHARCNT GQ 8 
          THEN
            BEGIN 
            ERRWRITE(5);           # TOO MANY CHARACTERS               #
            TEST CHARPTR;          # DO NOT STORE                      #
            END 
          C<CHARCNT,1>PARMWD = CHAR;   # STORE ONE CHARACTER           #
          CHARCNT = CHARCNT + 1;   # INCREMENT COUNTER                 #
  
          END 
        END                        # END LOOP                          #
  
      RETURN; 
      END                          # END PROC SCANNER                  #
  
  
  
  
  
  
#     B E G I N   D B $ A I N T   E X E C U T A B L E   C O D E .      #
  
  
 #
      PROCESS CONTROL CARD AND DIR FILE PARAMETERS
 #
 #
*     INITIALIZE SOME ITEMS IN CDCSCOMMN - CHANGED TO EXPLICIT CODE 
*     INSTEAD OF PRESET FOR ENCAPSULATION.
 #
      ACCNFLAG = FALSE; 
      CCARD = TRUE; 
      CDCSCP = 0; 
      CDCSIO = 0; 
      CDCSRCP = 0;
      CDCSRIO = 0;
      ENDCARD = FALSE;
      FILSTAT = -1;                # END OF FILE UNTIL FIRST READ      #
      FIRSTTIME = TRUE;            # NO ERRORS YET                     #
      NEXTPTR = 0;
      P<PARMS> = DFCARDLOC;        # POINT TO CARD IMAGE AT RA+70     # 
      RPNUM = 0;
      SCHDFLAG = 0; 
      STATCOMP = 1; 
      STATBUSY = 0; 
      TERMFLAG = FALSE; 
      TIMESTAMP = -1; 
  
      FOR I = 0 STEP 1 UNTIL 8     # CLEAR MDPFINF ARRAY               #
      DO
        BEGIN 
        MDPFWORD[I] = 0;
        END 
  
  
 #
*      SET CP AND IO TIME TO INITIALIZATION VALUE 
 #
      TIME[0] = -1; 
      TIME[1] = -1; 
 #
*     SCAN THROUGH THE PARAMETERS, IF THERE ARE ANY.
 #
  
      IF NUMPARM EQ 0        # SEE IF "CDCS" IS ONLY PARAMETER         #
      THEN
        BEGIN 
        ENDJOB = TRUE;       # DO NOT WANT TO GO THROUGH LOOP          #
        END 
      ELSE
        BEGIN 
        ENDJOB = FALSE; 
  
 #
*       DB$AINT MAY BE CALLED FROM EITHER CDCS OR CDCSBTF.
*       IF CALLED FROM CDCSBTF, THE LGO*S MUST IMMEDIATELY
*       FOLLOW AND BE SEPARATED FROM THE REMAINDER OF THE 
*       PARAMETERS BY A "/".  NO TESTS ARE MADE TO DETERMINE
*       THE VALIDITY OF THE LGO LFNS
 #
  
        SCANNER;                   # SEE IF CDCS OR CDCSBTF            #
        IF PARMWD EQ DFBTF         # IF BTF SKIP OVER LGOS             #
        THEN
          BEGIN 
          FOR I = 0 STEP 1
            WHILE CHAR NQ "/" 
              AND CHAR NQ "." 
              AND CHAR NQ ")" 
          DO
            BEGIN 
            SCANNER;               # GET LGO LFN                       #
            END 
          IF I EQ 0 
          THEN
            BEGIN 
            ERRWRITE(21);          # NO LGO PRESENT                    #
            END 
          END 
        END 
  
      FOR I = 0 STEP 1
        WHILE NOT ENDJOB
      DO
        BEGIN 
         SCANNER;                  # GET PARAMETER                     #
 #
*       FOR EACH PARAMETER, SCAN THE LIST OF VALID PARAMETER NAMES. 
*       WHEN ONE IS FOUND, GO TO THE LABELLED SECTION FOR THAT
*       PARAMETER.
 #
  
        PNAME[DFNP] = PARMWD; 
  
        FOR J = 0 STEP 1 UNTIL DFNP 
        DO
          BEGIN 
          IF PARMWD EQ PNAME[J] 
          THEN
            BEGIN 
            IF PFL[J]              # CHECK FOR DUPLICATES              #
            THEN
              BEGIN 
              ERRWRITE(6);         # DUPLICATE PARAMETER               #
              IF CHAR EQ "="
              THEN
                BEGIN 
                SCANNER;           # SKIP THE ASSIGNED VALUE OF ANY    #
                                   # DUPLICATE PARAMETER               #
                END 
              GOTO ENDTEST; 
  
              END 
            ELSE
              BEGIN 
              PFL[J] = TRUE;       # NOTE PARAMETER FOUND              #
              END 
  
            GOTO PARMSW[J];        # GO PROCESS PARMS                  #
  
            END 
          END 
  
NOPARM: 
        PFL[DFNP] = FALSE;         # DONT CHECK FOR DUPLICATES         #
        ERRWRITE(14);              # UNKNOWN PARAMETER                 #
        IF CHAR EQ "="
        THEN
          BEGIN 
          SCANNER;                 # SKIP THE ASSIGNED VALUE OF ANY    #
                                   # UNKNOWN PARAMETER                 #
          END 
        GOTO ENDTEST;              # GO START NEW ONE                  #
  
ACCT:                              # CP OR IO  (0 OR 1)                #
        ACCNFLAG = TRUE;           # ACCOUNT INFO FOUND                #
        IF CHAR NQ "="             # IF NO = THEN 2ND DEFAULT USED #
        THEN
          BEGIN 
          GOTO ENDTEST; 
          END 
        SCANNER;                   # GET PARAMETER VALUE               #
        TIME[J] = DB$CBIN(PARMWD,CHARCNT,10); 
        IF TIME[J] LQ 0 
        THEN
          BEGIN 
          ERRWRITE(4);             # INVALID CHARACTER                 #
          END 
  
        GOTO ENDTEST;              # GET NEXT PARAMETER                #
  
FLDLNG:                            # MFL                               #
        IF NOT CCARD               # MFL NOT ALLOWED ON FILE           #
        THEN
          BEGIN 
          ERRWRITE(7);             # MFL NOT ALLOWED AS FILE INPUT     #
          END 
  
        IF CHAR NQ "="             # IF NO EQUAL SIGN, USE DEFAULT     #
        THEN
          BEGIN 
          MFL = DFPARAMFL;
          END 
        ELSE
          BEGIN 
          SCANNER;                 # GET PARAMETER VALUE               #
          MFL = DB$CBIN(PARMWD,CHARCNT,8);
          IF MFL LS 0 
          THEN
            BEGIN 
            ERRWRITE(4);           # INVALID CHARACTER                 #
            END 
          END 
  
        GOTO ENDTEST;              # GET NEXT PARAMETER                #
  
  
BUFLNG:                            # BL PARAMETER                      #
        AAMBLS = TRUE;
SETSBL:                            # SBL PARAMETER                     #
SETSBI:                            # SBI PARAMETER                     #
        IF CHAR NQ "="             # DEFAULT TO BE USED                #
        THEN
          BEGIN 
          GOTO ENDTEST; 
          END 
        SCANNER;                   # GET BUFFER LENGTH                 #
        BL = DB$CBIN(PARMWD,CHARCNT,8); 
        IF BL LQ 0
        THEN
          BEGIN 
          ERRWRITE(4);             # INVALID CHARACTER                 #
          END 
        IF BL GR DFPARABL 
        THEN
          BEGIN 
          ERRWRITE(11);            # VALUE TOO LARGE                   #
          END 
        IF J EQ 3 
        THEN
          BEGIN 
          AAM$BL = BL;             # BL TO BE SET                      #
          END 
        ELSE
          BEGIN 
          IF J EQ 28
          THEN
            BEGIN 
            CMMSBL = BL;           # SBL TO BE SET                     #
            END 
          ELSE
            BEGIN 
            CMMSBI = BL;           # SBI TO BE SET                     #
            END 
          END 
  
        GOTO ENDTEST;              # GET NEXT PARAMETER                #
  
SETPBC:                            # SET PRIORITY BLOCK COUNT          #
SETBFN:                            # SET NUMBER OF EXTRA BUFFERS       #
SETTLL:                            # SET TRANSACTION LOCK LIMIT        #
  
        IF CHAR NQ "="             # DEFAULT TO BE USED                #
        THEN
          BEGIN 
          GOTO ENDTEST; 
          END 
        SCANNER;                   # GET NUMERIC FIELD                 #
        BL = DB$CBIN(PARMWD,CHARCNT,10);
        IF BL LS 0
        THEN
          BEGIN 
          ERRWRITE(4);             # INVALID CHARACTER                 #
          END 
        IF J EQ 30
        THEN
          BEGIN 
          PBCOUNT = BL;            # PRIORITY BLOCK COUNT (PBC)        #
          END 
        ELSE
          BEGIN 
          IF J EQ 31
          THEN
            BEGIN 
            BFNUMBER = BL;         # NUMBER OF EXTRA BUFFERS (BFN)     #
            END 
          ELSE
            BEGIN 
            TLOCKL = BL;           # TRANSACTION LOCK LIMIT (TLL)      #
            END 
          END 
        GOTO ENDTEST;              # GET NEXT PARAMETER                #
  
  
SETFCA:                            # SET FIT COUNT ADJUSTMENT          #
  
        IF CHAR NQ "="             # DEFAULT TO BE USED                #
        THEN
          BEGIN 
          GOTO ENDTEST; 
          END 
        SCANNER;                   # GET NUMERIC FIELD                 #
        IF C<0,1>PARMWD NQ "-"
        THEN
          BEGIN 
          BL = DB$CBIN(PARMWD,CHARCNT,10);
          IF BL LS 0
          THEN
            BEGIN 
            ERRWRITE(4);           # INVALID CHARACTER                 #
            END 
          END 
        ELSE
          BEGIN 
          CHARCNT = CHARCNT -1;    # REMOVE THE MINUS SIGN             #
          PARMWD = C<1,6>PARMWD;
          BL = DB$CBIN(PARMWD,CHARCNT,10);
          IF BL LS 0
          THEN
            BEGIN 
            ERRWRITE(4);           # INVALID CHARACTER                 #
            END 
          BL = -BL;                # CONVERT INTEGER TO NEGATIVE       #
          END 
        FCADJUST = BL;             # FIT COUNT ADJUSTMENT (FCA)        #
  
        GOTO ENDTEST;              # GET NEXT PARAMETER                #
  
SETRJR:                            # SET RESTRICT JOURNAL RECORDS      #
        RJRSW = TRUE; 
        GOTO ENDTEST;              # GET NEXT PARAMETER                #
  
SETROF:                            # SET REDUCE OUTPUT FILE            #
        ROFSW = TRUE; 
        GOTO ENDTEST;              # GET NEXT PARAMETER                #
  
SETECA:                            # ENABLE CDCS ABORT BY USER.        #
        ECASW = TRUE; 
        GOTO ENDTEST;              # GET NEXT PARAMETER                #
  
MIPPARM:                           # MIP PARAMETER                     #
        PARMWD = "MP";             # CHANGE MIP TO MP SO CRM WILL      #
                                   # RECOGNIZE IT.                     #
AAMPARM:                           # AK,IS,DA OR MP                    #
        RMNAME[ICRM] = PARMWD;     # STORE FOR PASSING TO AAM          #
        ICRM = ICRM + 1;
  
        GOTO EQTEST;               # MAY NOT BE FOLLOWED BY "="        #
  
CAPEQ:                             # CAP PARAMETER                     #
CRMEQ:                             # CRM PARAMETER                     #
        IF CHAR NQ "="
        THEN
          BEGIN 
          ERRWRITE(13);            # EQUAL SIGN MUST BE PRESENT        #
          END 
  
        GOTO ENDTEST;              # DO NOTHING PARAMETER              #
  
INFILE:                            # DIR PARAMETER                     #
        IF NOT CCARD               # DIR PARAMETER NOT ALLOWED ON FILE #
        THEN
          BEGIN 
          ERRWRITE(7);             # DIR PARAMETER NOT ALLOWED ON FILE #
          END 
        ELSE
          BEGIN 
          FILSTAT = 0;             # SET ONLY WHEN DIR ON CARD         #
          END 
  
        IF CHAR NQ "="             # IF NO LFN, USE INPUT AS DEFAULT   #
        THEN
          BEGIN 
          PARMWD = DFINPUT; 
          END 
        ELSE
          BEGIN 
          SCANNER;                 # GET LFN                           #
          LITCHECK;                # VALIDATE                          #
          END 
  
        DRLFN = DB$CFIL(PARMWD,10,0); # ZERO FILL FILE NAME            #
  
        GOTO ENDTEST;              # GET NEXT PARAMETER                #
  
MDPFN:  
        IF CHAR NQ "="
        THEN
          BEGIN 
          ERRWRITE(13);            # EQUAL SIGN REQUIRED               #
          END 
        SCANNER;                   # GET MD NAME                       #
        LITCHECK;                  # VALIDATE                          #
        MDPFINAME[0] = DB$CFIL(PARMWD,7,0); 
  
        GOTO ENDTEST; 
  
UNID:                              # UN OR ID                          #
        IF CHAR NQ "="
        THEN
          BEGIN 
          ERRWRITE(13);            # EQUAL SIGN REQUIRED               #
          END 
        SCANNER;                   # GET UN OR ID                      #
        LITCHECK;                  # VALIDATE                          #
        MDPFUNID[0] = DB$CFIL(PARMWD,7,0);
  
        GOTO ENDTEST; 
  
PWSPOT:                            # PASSWORD                          #
        IF CHAR NQ "="             # EQUAL SIGN REQUIRED               #
        THEN
          BEGIN 
          ERRWRITE(13); 
          END 
        SCANNER;                   # GET FIRST PW                      #
        LITCHECK;                  # VALIDATE                          #
        MDPFPW1[0] = DB$CFIL(PARMWD,7,0); 
        FOR K = 1 STEP 1           # CHECK FOR ADDITIONAL PASSWORDS    #
          WHILE CHAR EQ "/" 
        DO
          BEGIN 
          SCANNER;                 # GET NEXT VALUE                    #
          LITCHECK; 
          IF K GR 4 
          THEN
            BEGIN 
            ERRWRITE(8);           # TOO MANY PASSWORDS                #
            TEST K;                # DO NOT STORE                      #
            END 
          MDPFPW1[K] = DB$CFIL(PARMWD,7,0); 
          END 
  
          GOTO ENDTEST; 
  
FAMSET:                            # FAMILY, SET NAME OR PACK NAME     #
        IF CHAR NQ "="
        THEN
          BEGIN 
          ERRWRITE(13);            # EQUAL SIGN REQUIRED               #
          END 
        SCANNER;
        LITCHECK; 
        MDPFSN[0] = DB$CFIL(PARMWD,7,0);
        MDPFFMF[0] = FALSE; 
        MDPFSNF[0] = FALSE; 
        IF J EQ DFFAMNM 
        THEN
          BEGIN 
          MDPFFMF[0] = TRUE;       # SET FAMILY FLAG                   #
          END 
        ELSE
          BEGIN 
          IF J EQ DFSETNM          # IF SET NAME                       #
          THEN
            BEGIN 
            MDPFSNF[0] = TRUE;     # SET SET FLAG                      #
            END 
          END 
  
        GOTO ENDTEST; 
  
PARMVSN:                           # VSN PARAMETER                     #
  
        IF CHAR NQ "="
        THEN
          BEGIN 
          ERRWRITE(13);            # EQUAL SIGN REQUIRED               #
          END 
        SCANNER;                   # GET VSN VALUE                     #
        IF CHARCNT GR 6            # ONLY 6 CHARACTERS ALLOWED         #
        THEN
        BEGIN 
          ERRWRITE(5);             # VSN VALUE TOO LONG                #
          END 
  
        MDPFVSN[0] = DB$CFIL(PARMWD,7,0); 
  
        GOTO ENDTEST; 
  
DTPARM:                            # DEVICE TYPE                       #
        IF CHAR NQ "="
        THEN
          BEGIN 
          ERRWRITE(13);            # EQUAL SIGN REQUIRED               #
          END 
        SCANNER;                   # GET DEVICE TYPE                   #
        IF CHARCNT NQ 2            # FORMAT MUST BE XXN OR XX          #
          AND CHARCNT NQ 3
        THEN
          BEGIN 
          ERRWRITE(5);             # DT VALUE TOO LONG                 #
          END 
  
        FOR NUM = 0 STEP 1 UNTIL 1
        DO
          BEGIN 
          EXAM = C<NUM,1>PARMWD;
          IF EXAM LS "A"
            OR EXAM GR "Z"
          THEN
            BEGIN 
            ERRWRITE(10);          # FIRST 2 CHARACTERS MUST BE LETTERS#
            END 
          END 
  
        IF CHARCNT GR 2            # DT WITHOUT NUMBER IS OK           #
        THEN
          BEGIN 
          EXAM = C<2,1>PARMWD;
          IF EXAM LS "0"           # 3RD MUST BE NUMERIC               #
          OR EXAM GR "9"
          THEN
            BEGIN 
            ERRWRITE(9);           # LAST DT CHARACTER MUST BE NUMERIC #
            END 
          MDPFUNIT[0] = C<2,1>PARMWD - O"33"; 
          END 
  
        MDPFDT[0] = C<0,2>PARMWD;  # STORE DEVICE TYPE #
  
        GOTO ENDTEST; 
  
EQTEST:                            # CON, DBP, INV, JLOG, QRF, REL,    #
                                   # TRAN, IS, AK, DA, MP, OR MIP      #
        IF CHAR EQ "="             # MAY NOT BE FOLLOWED BY "="        #
        THEN
          BEGIN 
          ERRWRITE(12);            # EQUAL SIGN NOT ALLOWED            #
          END 
  
ENDTEST:  
        IF ENDCARD                 # IF END OF CONTROL CARD            #
        THEN
          BEGIN 
          IF CCARD
          THEN
            BEGIN 
            IF MFL NQ 0 
            THEN
              BEGIN 
              CMMMFL = MFL;        # PASS MFL TO DB$INIT               #
              END 
            DB$MFLS(MFL);          # SET MFL BEFORE FILE READ          #
            IF PFL[DFDIR]          # WAS DIR FILE A PARAMETER          #
            THEN
              BEGIN 
              CCARD = FALSE;       # NOTE INPUT FROM FILE              #
              P<PARMS> = LOC(DB$DRWB);
              NEXTPTR = 0;         # SET FOR START OF RECORD           #
              FILSTAT = DB$DRRD;   # READ FIRST RECORD                 #
              END 
            ELSE
              BEGIN 
              ENDJOB = TRUE;       # IF ENDCARD AND NO DIR, END IT     #
              END 
            END                    # END CONTROL CARD                  #
          ELSE
            BEGIN                  # NOT CCARD - COULD BE EOF          #
            IF FILSTAT NQ 0 
            THEN
              BEGIN 
              ENDJOB = TRUE;
              END 
            END                    # END NOT CONTROL CARD              #
          END                      # END ENDCARD                       #
        END                        # END I LOOP     # 
  
#     IF EITHER VSN OR SET NAME IS GIVEN, BOTH MUST BE PRESENT #
  
        IF (PFL[DFVSN]
          AND NOT PFL[DFSETNM]) 
        OR (PFL[DFSETNM]
          AND NOT PFL[DFVSN]) 
        THEN
          BEGIN 
          ERRWRITE(15);            # NEED BOTH VSN AND SET NAME        #
          END 
  
 #
*     ATTACH MASTER DIRECTORY IF NAME GIVEN.  ERROR MESSAGES ARE
*     WRITTEN IF THE FILE IS ALREADY ATTACHED OR CANNOT BE ATTACHED.
* 
 #
  
      IF PFL[DFMDNM]
      THEN
        BEGIN 
          IF NOT PFL[DFUN]
            AND NOT PFL[DFID] 
        THEN
          BEGIN 
          ERRWRITE(22);            # MUST HAVE UN OR ID WITH NAME      #
          END 
        ELSE
          BEGIN 
 #
*         SEE IF MASTER DIRECTORY ALREADY ATTACHED. 
*         IF SO, WRITE ERROR MESSAGE ELSE ATTACH IT 
 #
          FSTATUS = DB$STAT(LFNAME);
          IF FSTATUS NQ 0 
          THEN
            BEGIN 
            ERRWRITE(16);          # ALREADY THERE, NOT GOOD           #
            END 
          ELSE
            BEGIN 
            DB$ATWR(B<0,42>LFNAME,MDPFINF,ATTACHSTATUS);
            IF ATTACHSTATUS NQ 0
            THEN
              ERRWRITE(17);        # MD NOT AVAILABLE                  #
            END 
          END 
        END 
  
#     IF NO SMALL BLOCK LIMIT (SBL) WAS SPECIFIED, USE THE CMM DEFAULT.#
  
      IF CMMSBL EQ 0
      THEN
        BEGIN 
        CMMSBL = CMM$SBL;          # CMM$SBL IS CMM.SBL IN CMM         #
        END 
  
#     CHECK TO SEE IF BL GREATER THAN OR EQUAL TO MFL WHEN BOTH        #
#     PARAMETERS ARE PRESENT                                           #
  
      IF MFL NQ 0 
      THEN
        BEGIN 
        IF BL GQ MFL
        THEN
          BEGIN 
          ERRWRITE(18);            # MFL MUST BE > BL                  #
          END 
        END 
  
  
      IF NOT FIRSTTIME             # IF THERE WERE ERRORS              #
      THEN
        BEGIN 
        ERRWRITE(19);              # GIVE ABORT MESSAGE                #
        DB$ABRT;                   # AND THEN DO IT                    #
        END 
  
 #
*     IF NEITHER CP OR IO PARAMETERS THEN DONT DO ACCOUNTING. 
 #
      IF NOT ACCNFLAG THEN
        RETURN; 
# 
*     CALL DB$OLLO TO LOAD AND LOCK THE ACCOUNTING CAPSULE
# 
      DB$OLLO(DB$ACCN); 
 #
*     POSITION THE ACCOUNTING TABLE 
 #
      P<ACCNT> = DB$ACCL; 
 #
      GET START SYSTEM CP AND IO  TIME FOR CDCS EXECUTION 
 #
      DB$CPT(LOC(CDCSRCP)); 
      DB$IOT(LOC(CDCSRIO)); 
 #
      CHECK IF NOS OPERATING SYSTEM  (ZERO RETURNED FROM DB$IOT ) 
 #
      IF CDCSRIO  EQ 0  THEN
        BEGIN 
        DB$NCLK(LOC(CDCSRCP));    #SET UP STARTING REAL TIME           #
        DB$NCPT(LOC(CDCSRCP));
        DB$NIOT(LOC(CDCSRIO));
        END 
 #
*     INITIALIZE THE ACCOUNTING CONVERSION FACTORS TO DEFAULT 
*     VALUES IF THE CP AND IO PARAMETERS WERE NOT SPECIFIED 
*     IN THE CDCS CONTROL CARD
 #
      IF TIME[0] EQ -1       # NO CP TIME SPECIFIED                    #
      THEN
        BEGIN 
        TIME[0] = ACPISCP[DFRD2]; 
        END 
      IF TIME[1] EQ -1       # NO IO TIME SPECIFIED                    #
      THEN
        BEGIN 
        TIME[1] = ACPISIO[DFRD2]; 
        END 
 #
      CALCULATE CP AND IO RATIO BETWEEN CDCS PARAMETERS AND RANDOM
      READ OF AN INDEX SEQUENTIAL FILE
 #
      CP = 1.0*TIME[0]/ACPISCP[DFRD2];
      IO = 1.0*TIME[1]/ACPISIO[DFRD2];
 #
      READJUST ACCOUNT TABLE WITH CDCS CARD PARAMS
 #
      CONTROL FASTLOOP; 
      FOR I=0 STEP 1 UNTIL DFFUNCMAX  DO
        BEGIN 
           ACFIXIO[I] = IO*ACFIXIO[I];
           ACFIXCP[I] = CP*ACFIXCP[I];
           ACALTIO[I] = IO*ACALTIO[I];
           ACALTCP[I] = CP*ACALTCP[I];
           ACPISIO[I] = IO*ACPISIO[I];
           ACPISCP[I] = CP*ACPISCP[I];
           ACPDAIO[I] = IO*ACPDAIO[I];
           ACPDACP[I] = CP*ACPDACP[I];
           ACPAKIO[I] = IO*ACPAKIO[I];
           ACPAKCP[I] = CP*ACPAKCP[I];
        END 
      END 
      TERM
