*DECK DML                                                               000160
  PRGM DML;                                                             000180
#**********************************************************************#005620
      ITEM COPYRIGHT C(33) =                                            005630
          "COPYRIGHT CONTROL DATA CORP. 1982";
#**********************************************************************#005650
#**********************************************************************#005660
#                                                                      #005670
#                                   DML                                #000200
#                                                                      #005690
# PURPOSE:  INTERPRET CONTROL CARD PARAMETERS, OPEN FILES, INVOKE REST #005700
#           OF PRE-PASS, CLOSE FILES, AND RETURN                       #005710
# ENTRY:    DML AND PROCS BINTOOD AND BINTODD                          #000220
# ENTRY CONDITIONS: THE DML CONTROL CARD HAS BEEN STORED IN THE        #000240
#           SYSTEM COMMUNICATION AREA. THIS IS THE MAIN ENTRY POINT    #005740
#           OF THE PRE-PASS                                            #005750
# EXIT CONDITIONS: CONTROL IS RETURNED TO THE SYSTEM WHEN PROCESSING   #005760
#           IS COMPLETE                                                #005770
# ERROR CONDITIONS: AN ERROR IN THE PARAMETERS OF THE DML CALL WILL    #000260
#           CAUSE AN ABORT. DML CALLS DMLABT PASSING A PARM OF 1.      #000280
# CALLING ROUTINES: NONE FOR DML. DMLIO CALLS BINTOOD AND BINTODD      #000300
# CALLED ROUTINES:  DMLABT -  TO ABORT FOR CONTROL CARD ERROR          #000150
#                   DMLOPEN - TO OPEN SUBSCHEMA, INPUT, AND OPTIONALLY,#000160
#                            OUTPUT FILES                              #005830
#                   DMLMAIN- TO INVOKE REST OF PREPASS                 #005840
#                   CLSEOUT- TO CLOSE ALL OPEN FILES                   #005850
# NON-LOCAL VARIABLES: THE FOLLOWING XDEF VARIABLES ARE MODIFIED       #005860
#                   DDLCOMP - COMPILATION LANGUAGE MODE                #
#                             SET TO FTN4 OR FTN5 CODE                 #
#                   FIRSTWORD - FWA OF AVAILABLE SPACE FOLLOWING       #005880
#                               LARGEST OVERLAY                        #005890
#                   LINELMT - SET TO 100,000 FOR CTLSTD                #005900
#                   SBLFN -   LFN OF SUBSCHEMA FILE                    #005910
#                   INFILE -  LFN OF INPUT FILE                        #005920
#                   OUTFILE-  LFN OF OUTPUT FILE OR 0 IF NO OUTPUT     #005930
#                             FILE IS TO BE CREATED                    #005940
#                   ERRFILE - LFN OF ERROR FILE                        #005950
#                   ETLEVEL - ERROR TERMINATE LEVEL - T,W,F,C, OR 0    #005960
#                   DSOPT  -  TRUE IF DIRECTIVES ARE TO BE SUPPRESSED  #000392
# DESCRIPTION:  DML IS THE FIRST MODULE TO RECEIVE CONTROL IN THE      #000320
#               PRE-PASS. IT SETS UP CONTROL CARD PARAMETER DEFAULTS   #005990
#               AND THEN PICKS UP USER-SPECIFIED PARAMETERS FROM THE   #006000
#               SYSTEM COMMUNICATION AREA. IT THEN INVOKES EXTERNAL    #006010
#               ROUTINES TO OPEN THE FILES, CONTROL THE PRE-PASS, AND  #006020
#               CLOSE THE FILES. WHEN THE PRE-PASS IS FINISHED, CONTROL#006030
#               RETURNS TO DML WHO RETURNS TO THE SYSTEM.              #000340
#**********************************************************************#006050
 CONTROL EJECT;                                                         006060
                                 #--------------DEFS-------------------#
                                 #                                     #
                                 # DISPLAY F4 LEFT JUSTIFIED ZERO FILL #
      DEF DISPF4 #O"06370000000000000000"#; 
                                 # DISPLAY F5 LEFT JUSTIFIED ZERO FILL #
      DEF DISPF5 #O"06400000000000000000"#; 
                                 # DISPLAY 0 LEFT JUSTIFIED ZERO FILL  #
      DEF DISP0  #O"33000000000000000000"#; 
      DEF EQUAL  #O"02"#;        # EQUAL CODE IN COMMUNICATIONS AREA   #000220
      DEF ETN    #5#;            # NO. OF ERROR TERMINATE OPTIONS      #000240
      DEF F4     #8#;            # FORTRAN 4 CODE - MATCHES DDL CODE   #
      DEF F5     #9#;            # FORTRAN 5 CODE - MATCHES DDL CODE   #
      DEF NULL   #0#;            # NULL VALUE - BINARY ZERO            #
      DEF PN     #7#;            # NUMBER OF DML PARAMETER TYPES       #
                                                                        006120
      XREF                                                              006130
        BEGIN                                                           006140
          ITEM DDLSU;        # STORAGE USE - MIN FL NEEDED             #
          PROC DMLOPEN;      # COMPASS ROUTINE WHICH OPENS THE INPUT,  #000280
                             # OUTPUT, AND SUBSCHEMA FILES.            #006160
          PROC DMLABT;       # COMPASS ROUTINE WHICH ABORTS THE JOB    #000300
                             # AFTER DISPLAYING A DIAGNOSTIC MESSAGE   #006180
          PROC CLSEOUT;      # COMPASS ROUTINE WHICH CLOSES ALL OPEN   #006190
                             # FILES                                   #006200
          PROC DMLMAIN;      # SYMPL ROUTINE WHICH CONTROLS EXECUTION  #006210
                             # OF THE REST OF THE PREPASS              #006220
        END                                                             006230
                                                                        006240
      XDEF                                                              006250
        BEGIN                                                           006260
          ITEM DDLCOMP;          # CONTAINS CODE FOR FTN4 OR FTN5      #
          ITEM FIRSTWORD;    # FWA OF AVAILABLE SPACE FOLLOWING        #006340
                             # LARGEST OVERLAY                         #006350
          ITEM LINELMT = 1000; # TRACE LINE LIMIT                      #000340
          ITEM SBLFN U;          # LFN OF SUBSCHEMA FILE               #
                                 #   FIRST DEFAULT = SBLFN             #
                                 #   SECOND DEFAULT = SBLFN            #
          ITEM INFILE U;         # LFN OF INPUT FILE                   #006380
                                 #  FIRST DEFAULT = INPUT              #006390
                                 #  SECOND DEFAULT = COMPILE           #006400
          ITEM OUTFILE U;        # LFN OF OUTPUT FILE                  #006410
                                 #  FIRST AND SECOND DEFAULTS = DMLOUT #006420
                                 #  0 MEANS NO OUTPUT FILE SHOULD BE   #006430
                                 #  CREATED                            #006440
          ITEM ERRFILE U;        # LFN OF ERROR FILE                   #006450
                                 #  FIRST DEFAULT = OUTPUT             #006460
                                 #  SECOND DEFAULT = ERRS              #006470
          ITEM ETLEVEL U = 0;    # ERROR TERMINATE LEVEL               #006480
                                 #  FIRST DEFAULT = 0                  #006490
                                 #  SECOND DEFAULT = F (FATAL)         #006500
                                 #  OTHER POSSIBLE VALUES ARE T,W,+C   #006510
          ITEM DSOPT B = FALSE;        # DIRECTIVE SUPPRESSION FLAG    #000150
                                       # FIRST DEFAULT IS 0            #000160
                                       # MEANING DO NOT SUPPRESS       #000170
                                       # SECOND DEFAULT = TRUE         #000180
                                       # MEANING DIRECTIVES ARE TO BE  #000190
                                       # SUPPRESSED                    #000200
                                                                        001290
          ITEM PPFLAG B = TRUE;  # TRUE MEANS THAT PRE-PASS IS         #001300
                                 # EXECUTING                           #001310
                                                                        001320
          ITEM PURGESS = 0;      # 0 MEANS NO PURGE PARAM IN PRE-PASS  #001330
          ITEM SYNTBL;           # THE FOLLOWING ARE DECLARED EXTERNAL #006550
          ITEM LBLPTR;           # FOR USE BY CTLSTD AND CTLSCAN       #006560
          ITEM TRACE;                                                   006570
          ITEM SYNSEC;                                                  006580
          ITEM LEXWD;                                                   006590
          ITEM LEXICO;                                                  006600
          ITEM DDLDIAG;                                                 006610
          ITEM SWITCHVCTR;                                              006620
        END                                                             006630
#                             LOCAL VARIABLES                          #006640
      ITEM I,J,K;                                                       006650
      ITEM ITEMP;                                                       006660
      ITEM LFN U;                                                       006670
      ITEM PWORDSP1;         # HOLDS NBR OF PARAM WORDS PLUS 1         #001200
                                                                        006690
        BASED ARRAY RA;          # ARRAY FOR EXAMINING THE SYSTEMS     #006700
          BEGIN                  # COMMUNICATIONS AREA                 #006710
            ITEM CCPARAM I(0,0,18);#1ST 18 BITS OF A CONTROL CARD PARM #006720
            ITEM PARMCODE C(0,54,1);#CHARACTER FOLLOWING PARAMETER     #006730
            ITEM RTPARM U(0,0,42);# RIGHT SIDE OF EQUAL SIGN IN PARM   #006740
            ITEM NRCCPARMS I(0,42,18);#COUNT OF PARM WORDS IN DML CALL #000360
            ITEM DDLSPCE I(0,42,18);# FWA OF AVAILABLE SPACE FOLLOWING #006760
                                    # THE LARGEST OVERLAY              #006770
          END                                                           006780
                                                                        006790
      ARRAY [PN];            #ARRAY OF LEGAL PARAMETERS                #006800
        #                NULL  SB        I         O         E         #006810
        ITEM LEGALPARAM = [,O"230200",O"110000",O"170000",O"050000",    006820
        #       ET        DS        LV                                 #
            O"052400",O"042300",O"142600"]; 
                                                                        006850
      ITEM EQCODE B = FALSE; # THIS FLAG IS TRUE WHEN THE CHARACTER    #006860
                             # FOLLOWING THE PARAMETER BEING ANALYZED  #006870
                             # IS AN EQUAL SIGN                        #006880
                                                                        006890
#                             ARRAY OF LEGAL ET VALUES                 #006900
      ARRAY[ETN];                                                       000360
        ITEM LEGALET =[,                          # NULL               #000370
                       O"24000000000000000000",   # T                  #000380
                       O"27000000000000000000",   # W                  #000390
                       O"06000000000000000000",   # F                  #000400
                       O"03000000000000000000",   # C                  #000410
                       O"33000000000000000000"];   # 0                 #000420
                                                                        006930
                                 # ARRAY TO CONVERT ET VALUES INTO     #000160
                                 # DIGITS USEABLE BY DIAG ROUTINE      #000170
      ARRAY[ETN];                                                       000180
        ITEM NEWET =[,           # NULL                                #000190
                     1,          # T                                   #000200
                     2,          # W                                   #000210
                     3,          # F                                   #000220
                     4,          # C                                   #000230
                     0];         # 0                                   #000240
                                                                        000250
# SWITCH USED TO STORE PARAMETER VALUES                                #006940
      SWITCH STOREPARM
             STOSB,              # SUB-SCHEMA FILE NAME                #
             STOI,               # FORTRAN/DML INPUT FILE              #
             STOO,               # FORTRAN/DML OUTPUT FILE             #
             STOE,               # ERROR DIAGNOSTIC FILE               #
             STOET,              # ERROR TERMINATION CODE              #
             STODS,              # DIRECTIVE SUPPRESSION               #
             STOFV;              # FORTRAN VERSION                     #
 CONTROL EJECT;                                                         006960
      P<RA> = 0;             # SET BASE TO SYSTEM COMMUNICATION AREA   #006980
      FIRSTWORD = DDLSPCE[68];# GET HHA FROM RA+104                    #006990
      DDLSU = FIRSTWORD;     # STORAGE USED SO FAR IS HHA              #
#                                                                      #007000
#     SET UP PARAMETER DEFAULTS                                        #007010
#                                                                      #007020
      INFILE =               # LFN OF FORTRAN SOURCE FILE CONTAINING   #007030
        O"11162025240000000000"; #DML STATEMENTS -DEFAULT IS INPUT     #007040
      OUTFILE =              # LFN OF OUTPUT FILE CONTAINING FORTRAN   #007050
        O"04151417252400000000";# STATEMENTS WHICH WILL BE THE INPUT   #007060
                                # FILE TO THE FORTRAN COMPILER         #007070
                                # DEFAULT IS DMLOUT                    #007080
      ERRFILE =              # LFN OF FILE TO RECEIVE ERROR LISTING    #007090
        O"17252420252400000000";# INFORMATION. DEFAULT IS OUTPUT       #007100
      SBLFN =                # DEFAULT SUB-SCHEMA LFN - *SBLFN*        #
        O"23021406160000000000";
  
      DDLCOMP = F5;          # FIRST DEFAULT FORTRAN VERSION           #
#                                                                      #007110
#     CRACK CONTROL CARD PARAMETERS                                    #007120
#                                                                      #007130
      PWORDSP1 = NRCCPARMS[52] + 1; # PICK UP NBR OF WORDS FOR INDEX   #001220
                                       # NOTE THAT PWORDSP1 IS NUMBER  #001260
                                       # OF PARAMETER WORDS + 1        #001070
      FOR I=2 STEP 2 UNTIL PWORDSP1 DO # PARAMETERS START AT RA+2      #001240
        BEGIN                                                           007160
          ITEMP = CCPARAM[I];          # PICK UP 1ST 3 BYTES OF PARM   #007170
          FOR K=1 STEP 1 UNTIL PN DO   # LOOP ON NO. OF LEGAL PARMS    #007180
            IF ITEMP EQ LEGALPARAM[K]  # TEST FOR VALID PARAMETER      #007190
            THEN                                                        007200
              GOTO  SAVEPARAM;         # PARAMETER IS LEGAL            #007210
                                       # IF PARAMETER IS NOT LEGAL,    #007220
      DMLABT(1,ITEMP);                 # PRINT ERRONEOUS PARM - ABORT  #
                                                                        007240
SAVEPARAM:                             # SAVE PARM VALUES IN XREFS     #007250
          IF B<2,4>PARMCODE[I] EQ EQUAL #IF THERE IS A SECOND WORD FOR #001040
          THEN                         # THIS PARM, TURN ON EQCODE FLAG#007270
            BEGIN                      # AND PICK UP SECOND WORD LEFT  #007280
              EQCODE = TRUE;           # JUSTIFIED AND ZERO FILLED     #007290
              LFN = ((RTPARM[I+1]*2**15)*2**3);                         007300
            END                                                         007310
          ELSE                         # PARM IS ONLY 1 WORD           #000920
            I= I - 1;                  # SO DECREMENT I                #000930
          GOTO  STOREPARM[K-1];        # SWITCH TO PROPER ROUTINE TO   #007320
                                       # SAVE PARAMETER VALUES         #007330
STOSB:                                 # STORE SUBSCHEMA LFN           #007340
          IF NOT EQCODE                # PARM OF ONLY "SB"             #007350
          THEN                         # DEFAULT TO *SBLFN*            #
            GOTO STOEXIT; 
  
          IF LFN EQ DISP0                                               001400
            OR LFN EQ NULL
          THEN                         # IF *SB=0* OR *SB= * -ERROR-   #
            DMLABT(1,ITEMP);           # PRINT ERRONEOUS PARM - ABORT  #
          SBLFN = LFN;                 # SAVE LFN                      #007380
          GOTO STOEXIT;                                                 007390
STOI:                                  # STORE INPUT FILE LFN          #007400
          IF EQCODE                    # IF PARM IS "I=LFN" THEN PICK  #007410
          THEN                         # UP LFN                        #007420
            BEGIN                                                       000480
              IF LFN EQ DISP0          # IF PARM IS "I=0", ABORT       #000490
              THEN                                                      000500
                DMLABT(1,ITEMP);       # PRINT ERRONEOUS PARM - ABORT  #
              ELSE                                                      000520
                INFILE = LFN;          # SAVE LFN                      #000530
            END                                                         000540
          ELSE                         # IF PARM IS JUST "I" THEN USE  #000550
                                       # SECOND DEFAULT OF "COMPILE"   #000560
              INFILE = O"03171520111405000000";                         007460
          GOTO STOEXIT;                                                 007490
STOO:                                  # STORE OUTPUT LFN              #007500
          IF EQCODE                    # IF PARM IS "O=LFN" THEN PICK  #007510
          THEN                         # UP LFN OR 0 AND CHANGE DISPLAY#007520
            BEGIN                      # 0 TO BINARY                   #007530
              IF LFN EQ DISP0                                           001090
              THEN                                                      007550
                LFN = 0;                                                007560
              OUTFILE = LFN;                                            007570
            END                                                         007580
                                       # IF PARM IS JUST "O"      DO   #007590
                                       # NOTHING SINCE FIRST AND SECOND#007600
                                       # DEFAULTS ARE THE SAME         #007610
          GOTO STOEXIT;                                                 007650
STOE:                                  # STORE ERROR FILE LFN          #007660
          IF EQCODE                    # IF PARM IS "E=LFN" THEN PICK  #000600
          THEN                         # UP LFN                        #000610
            BEGIN                                                       000620
              IF LFN EQ DISP0          # IF PARM IS "E=0" THEN ABORT   #000630
              THEN                                                      000640
                DMLABT(1,ITEMP);       # PRINT ERRONEOUS PARM - ABORT  #
              ELSE                                                      000660
                ERRFILE = LFN;         # SAVE LFN                      #000670
            END                                                         000680
          ELSE                         #IF PARM IS JUST "E" THEN USE   #007700
                                       # SECOND DEFAULT OF "ERRS"      #000960
              ERRFILE = O"05222223000000000000";                        007720
          GOTO STOEXIT;                                                 007750
STOET:                                 # STORE ERROR TERMINATE OPTION  #007760
          IF NOT EQCODE                # IF PARM IS JUST "ET" THEN USE #007770
          THEN                         # SECOND DEFAULT OF "F"         #007780
            BEGIN                                                       007790
              ETLEVEL = O"06000000000000000000";                        007800
              GOTO STOEXIT;                                             000990
            END                                                         007820
          ELSE                         # PARM IS "ET="                 #007830
            BEGIN                                                       007840
                FOR J=1 STEP 1 UNTIL ETN DO  # CHECK PARM FOR VALID    #007890
                  BEGIN                  # PARAMETER                   #000700
                    IF LFN EQ LEGALET[J]                                000710
                    THEN                                                000720
                      BEGIN                                             000730
                                 # CONVERT PARM TO DIGIT FOR DIAG RTN  #000130
                        ETLEVEL = NEWET[J];                             000140
                        GOTO STOEXIT;                                   000780
                      END                                               000790
                  END                                                   000800
                                             # IF PARM NOT T,W,F,C OR O#
                DMLABT(1,ITEMP);             # PRINT PARM AND ABORT    #
            END 
STODS:                                       # DIRECTIVE SUPPRESSION   #000270
      IF EQCODE                              # IF PARM IS "DS=" THEN   #000280
      THEN                                   # TEST FOR 0 WHICH IS THE #000290
        BEGIN                                # ONLY LEGAL VALUE AND    #000300
          IF LFN EQ DISP0                    # ALSO THE DEFAULT        #000310
          THEN                                                          000320
            GOTO STOEXIT;                                               000330
          ELSE                               # IF VALUE IS NOT 0       #000340
            DMLABT(1,ITEMP);                 # PRINT PARM AND ABORT    #
        END                                                             000360
      ELSE                                                              000370
        DSOPT = TRUE;                                                   000380
  
      GOTO STOEXIT;                                                     000390
  
STOFV:                             #-------FORTRAN VERSION-------------#
                                   #                                   #
      IF NOT EQCODE                # IF PARAMETER IS "LV" ONLY         #
      THEN
        BEGIN 
        DDLCOMP = F4;              # SET COMPILATION LANG MODE TO FTN4 #
        END 
      ELSE                         # IF PARAMETER IS "LV=VALUE"        #
        BEGIN 
        IF LFN EQ DISPF4           # IF FORTRAN VERSION 4 SPECIFIED    #
        THEN
          DDLCOMP = F4;            # SET COMPILATION LANG MODE TO FTN4 #
        ELSE                       #             ELSE                  #
          IF LFN EQ DISPF5         # CHECK FOR FORTRAN VERSION 5       #
          THEN
            DDLCOMP = F5;          # IF SO, SET COMP LANG MODE TO FTN5 #
          ELSE                     #             ELSE                  #
            DMLABT(1,ITEMP);       # IF NOT, GENERATE ERROR - ABORT    #
        END 
#                      FALL THROUGH TO STOEXIT                         #
  
STOEXIT:                                     # CONTROL COMES HERE AFTER#008150
                                             # A PARM HAS BEEN ANALYZED#008160
          LEGALPARAM[K] = -1;                # OVERLAY PARM JUST SEEN  #008170
                                             # SO DUPLICATES ARE NOT   #008180
                                             # ALLOWED                 #008190
          EQCODE = FALSE;                     # TURN OFF EQUAL FLAG    #008200
        END                                  # END PARM LOOP           #008210
                                                                        008220
      DMLOPEN;                               # CALL DMLOPEN TO OPEN    #000880
                                             # SUBSCHEMA FILE, INPUT   #008280
                                             # FILE, AND OUTPUT FILE   #008290
                                             # IF REQUESTED            #008300
      DMLMAIN;                               # CALL DMLMAIN TO INVOKE  #000900
                                             # REST OF PREPASS         #008320
      CLSEOUT;                               # CALL CLSEOUT TO CLOSE   #008330
                                             # ALL OPEN FILES          #008340
      STOP;                                   # RETURN TO SYSTEM       #001360
TERM                                                                    008630
