*DECK     ARG     - PROCESS CONTROL STATEMENT ARGUMENTS.
          IDENT  ARG
          IPARAMS 
          LIST   F
          SYSCOM B1 
          TITLE  ARG - PROCESS CONTROL STATEMENT ARGUMENTS. 
          COMMENT PROCESS CONTROL STATEMENT ARGUMENTS.
 ARG      SPACE  4,8
**        ARG  -  PROCESS CONTROL STATEMENT ARGUMENTS.
* 
*         R. H. GOODELL.     76/08/10.
* 
*         ARG PROCESSES THE DDL 3.0 CONTROL STATEMENT.
 ARG      SPACE  4,8
**        ARG MACRO - DEFINE ARGUMENTS. 
* 
*  KW     ARG    VA,SD,CM 
* 
*         *KW* = ARGUMENT KEYWORD (1 OR 2 CHARACTERS).
*         *VA* = VALUE ADDRESS. 
*         *SD* = SECOND DEFAULT VALUE ADDRESS.
*         *CM* = CONVERSION MODE. 
*                  OMITTED = STORE VALUES IN DISPLAY CODE, 0L . 
*                  *Z*  =  SAME EXCEPT STORE *0* AS SIXTY ZEROS.
*                  *O* OR *D* = IF VALUE IS NUMERIC THEN CONVERT
*                            IT TO BINARY ASSUMING OCTAL/DECIMAL
*                            BASE IF NO B/D POSTRADIX GIVEN.
* 
*         ARGUMENT VALUE WILL BE STORED INTO *VA*, WHICH IS PRESUMED
*           PRESET TO THE FIRST DEFAULT VALUE.
*         IF *SD* ADDRESS < 0, ARGUMENT MUST NOT BE EQUIVALENCED. 
*         IF *VA* ADDRESS < 0, IT IS THE FWA OF AN OPTION LIST FOR
*           A MULTIPLE-BINARY-VALUE ARGUMENT.  IN THIS CASE *SD* IS 
*           NOT USED SINCE SECOND DEFAULT VALUES ARE GIVEN IN THE LIST. 
*         IF *VA* = *SD* (ABSOLUTE VALUES), ONLY ONE ENTRY OF THAT
*           ARGUMENT WILL BE ALLOWED (*KW* WILL BE CHANGED TO 7777B 
*           UPON FIRST OCCURRANCE). 
  
  
          PURGMAC ARG 
          MACRO  ARG,KW,VA,SD,CM
 '?ARG#CM MICRO  1,1, CM
          IFC    NE, "'?ARG#CM"  ,1 
 '?ARG#CM MICRO  1+1R"'?ARG#CM",1,*0000300000000001000000000020000000000
,000000000000000000000000000*          D          O          Z
 +        VFD    12D/0L_KW,18D/SD,12D/"'?ARG#CM",18D/VA 
          ENDM
 OPT      SPACE  4,8
**        OPT MACRO - DEFINE OPTION FOR MULTIPLE-BINARY-VALUE ARG.
* 
*  OP     OPT    VA,SD,IV 
* 
*         *OP* = OPTION NAME (1 TO 6 CHARACTERS). 
*         *VA* = VALUE ADDRESS. 
*         *SD* = SECOND DEFAULT VALUE (0 OR 1). 
*         *IV* = INITIAL VALUE (0 OR 1).
* 
*         OPTION VALUE (0 OR 1) WILL BE STORED INTO *VA*, WHICH 
*           IS PRESUMED PRESET TO THE FIRST DEFAULT VALUE.
*         *IV* IS USED WHEN ARGUMENT IS EQUIVALENCED. 
  
  
          MACRO  OPT,OP,VA,SD,IV
 +        VFD    36D/0L_OP,3/IV,3/SD,18D/VA 
          ENDM
 TARG     SPACE  4,8
**        TARG - TABLE OF ARGUMENT DESCRIPTORS. 
  
                                   * IN COL 1 (COMMENT) MEANS DISABLED  000860
 TARG     BSS    0
 A        ARG    EXHSS,-=1         AUDIT SUB-SCHEMA LIBRARY INDEX  C5/F5
* BL      ARG    BLFLAG,=1,Z       BIG LISTING
* C5      ARG    LM+C5,-=1         COBOL 5 SUB-SCHEMA COMPILATION       000880
*IF DEF,DEBUG,1 
DB        ARG    DEBUGF,-=1        DEBUG MODE (RECORD MAPPER DEBUG) 
* DS      ARG    LM+DS,-=1         DDL SCHEMA COMPILATION               000900
* EL      ARG    ELFLAG,=1LF       ERROR LIST SEVERITY
* ET      ARG    ETFLAG,=1LF,Z     ERROR TERMINATE SEVERITY 
* EX      ARG    LM+EX,-=1         EXHIBIT (OF SCHEMA) MODE             000920
 F4       ARG    LM+F4,-=1         FORTRAN 4 SUB-SCHEMA COMPILATION     000880
 F5       ARG    LM+F5,-=1         FORTRAN 5 SUB-SCHEMA COMPILATION 
 I        ARG    INFILE,=0LCOMPILE SOURCE INPUT FILE NAME 
 L        ARG    OUTFILE,=0LLIST,Z LISTING OUTPUT FILE NAME 
 LO       ARG    -LO,LO            LISTING OPTIONS
 N        ARG    NOADDSS,-=1       NO LIBRARY MAINTENANCE          C5/F5
 NL       ARG    NEWLIB,=0LNEWLIB,Z  NEW SUBSCHEMA LIBRARY FILE NAME
* NI      ARG    NBRITEM,=1,D      NUMBER OF ITEMS                    DS000960
 P        ARG    PURGESS,-=1       PURGE SUB-SCHEMA FROM LIBRARY   C5/F5
* PD      ARG    PDENS,=8,D        PRINT DENSITY (LINES PER INCH) 
* PS      ARG    PSIZE,=0,D        PAGE SIZE (LINES PER PAGE) 
* PW      ARG    PWIDTH,=72,D      PAGE WIDTH (CHARACTERS PER LINE) 
* QD      ARG    LM+QD,-=1         QU 2/3 SUB-SCHEMA COMPILATION        000980
* QU      ARG    LM+QD,-=1         = QD (QU IS AN OBSOLETE PARAMETER)   000990
* Q1      ARG    LM+QD,-=1         = QD (Q1 IS AN OBSOLETE PARAMETER)   001000
 R        ARG    REPLACE,-=1       REPLACE SUB-SCHEMA IN LIBRARY   C5/F5
 SB       ARG    SBLFN,SBLFN,Z     SUB-SCHEMA (LIBRARY) FILE NAME  C5/F5
 SC       ARG    SCLFN,SCLFN,Z     SCHEMA FILE NAME 
          DATA   0
  
  
 LO       BSS    0           *LO* OPTIONS 
* A       OPT    LATTF,1,1         SYMBOLS WITH ATTRIBUTES
* M       OPT    LMAPF,0,0         SYMBOLS WITH LOCATIONS (DATA MAP)
 O        OPT    LOBJF,0,0         OBJECT CODE                     C5/F5
* R       OPT    LREFF,1,0         SYMBOLS WITH REFERENCES
 S        OPT    LSINF,1,1         SOURCE INPUT 
          DATA   0
 PARG     SPACE  4,8
**        PROCESSED ARGUMENTS.
  
  
          MACRO  EPT,NAME,VALUE 
          ENTRY  NAME 
 NAME     CON    VALUE
          ENDM
  
  
 LM       BSS    0           LANGUAGE MODES 
                             ** ORDER DETERMINES THE VALUE WHICH ARG    000650
                                WILL STORE IN DDLCOMP.                **000660
          LOC    0
          CON    0              0  (NOT USED)                           000680
 DS       CON    0              1  DDL SCHEMA COMPILATION (DEFAULT)     000690
 EX       CON    0              2  EXHIBIT (OF A SCHEMA)                000700
 QD       CON    0              3  QU 2/3 SUB-SCHEMA COMPILATION        000710
          CON    0              4  (NOT USED)                           000720
 C5       CON    0              5  COBOL 5 SUB-SCHEMA COMPILATION       000730
          CON    0              6  (NOT USED)                           000740
          CON    0              7  (NOT USED)                           000750
 F4       CON    0              8  FORTRAN 4 SUB-SCHEMA COMPILATION     000900
 F5       CON    0              9  FORTRAN 5 SUB-SCHEMA COMPILATION     001020
 LML      BSS    0
          LOC    *O 
                              ** FIRST DEFAULTS ARE SET HERE **         001040
*BLFLAG   EPT    0           BIG LISTING FLAG 
 DDLCOMP  EPT    F5          COMPILATION (LANGUAGE) MODE - SEE ABOVE
 DEBUGF   EPT    0           DEBUG MODE FLAG
*ELFLAG   EPT    1LW         ERROR LISTING SEVERITY LEVEL (T/W/F/C) 
*ETFLAG   EPT    0           ERROR TERMINATE SEVERITY LEVEL (T/W/F/C/0) 
 EXHSS    EPT    0           AUDIT SUB-SCHEMA LIBRARY INDEX MODE   CB/FT
 INFILE   EPT    0LINPUT     SOURCE INPUT FILE NAME 
*LATTF    EPT    1           LIST SYMBOLS WITH ATTRIBUTES FLAG
*LMAPF    EPT    0           LIST SYMBOLS WITH LOCATIONS (DATA MAP) FLAG
 LOBJF    EPT    0           LIST OBJECT CODE FLAG                 C5/F5
 LREFF    EPT    0           LIST SYMBOLS WITH REFERENCES FLAG
 LSINF    EPT    1           LIST SOURCE INPUT FLAG 
 NBRITEM  EPT    0           NUMBER OF ITEMS                          DS
 NEWLIB   EPT    0           NEW SUBSCHEMA LIBRARY NAME            C5/F5
 NOADDSS  EPT    0           NO LIBRARY MAINTENANCE (COMPILE ONLY) C5/F5
 OUTFILE  EPT    0LOUTPUT    LISTING OUTPUT FILE NAME 
*PDENS    EPT    IP.PD       PRINT DENSITY (3/4/6/8 LINES PER INCH) 
*PSIZE    EPT    0           PAGE SIZE (LINES PER PAGE) 
*PWIDTH   EPT    IP.PW       PAGE WIDTH (CHARACTERS PER LINE) 
 PURGESS  EPT    0           PURGE SUB-SCHEMA FROM LIBRARY MODE    C5/F5
 REPLACE  EPT    0           REPLACE SUB-SCHEMA IN LIBRARY MODE    C5/F5
 SBLFN    EPT    0LSBLFN     SUB-SCHEMA (LIBRARY) FILE NAME        C5/F5
 SCLFN    EPT    0           SCHEMA FILE NAME 
 ARG      SPACE  4,8
**        ARG  -  PROCESS CONTROL STATEMENT ARGUMENTS.
* 
*         ENTRY  (RA+2 ET SEQ.) = ARGUMENTS CRACKED PER SCOPE RULES.
* 
*         EXIT   VALUES STORED IN CORRESPONDING LOCATIONS.
  
  
 ARG      SUBR   =           ENTRY/EXIT 
          SB1    1           (B1) = CONSTANT 1
          =A1    RA.ARG-1    (A1) = ARGUMENT POINTER
          MX0    7*6         (X0) = MASK
  
*         PROCESS NEXT ARGUMENT.
  
 ARG1     SA1    A1+B1       (X1) = NEXT ARGUMENT 
          BX5    X0*X1
          ZR,X1  ARG8        IF END OF ARGUMENTS
          ZR,X5  ARG1        IGNORE NULL ARGUMENT 
  
*         SEARCH FOR MATCH IN ARGUMENT TABLE. 
  
          SA2    TARG 
          MX3    2*6
 ARG2     IX6    X2-X5       SEARCH DESCRIPTOR TABLE
          BX7    X3*X6
          ZR,X7  ARG3        IF FOUND 
          SA2    A2+B1
          NZ,X2  ARG2        LOOP 
          EQ     ARG9B       ERROR - UNKNOWN KEYWORD
  
*         CHECK FOR EQUIVALENCE ALLOWED.
  
 ARG3     SX7    X1-2        TEST FOR = AFTER ARGUMENT
          SB2    X2          VALUE ADDRESS
          LX2    30 
          SB3    X2          SECOND DEFAULT VALUE ADDRESS 
          PL,B3  ARG4        IF EQUIVALENCE ALLOWED 
  
*         INVALIDATE BINARY PARAMETER ONCE FOUND
  
          SA2    A2 
          MX3    12          SET KW = 7777B 
          BX6    X2+X3
          SA6    A2 
  
*         PROCESS BINARY VALUE PARAMETER. 
  
          SA3    -B3         SECOND DEFAULT VALUE 
          BX6    -X0*X3 
          SB3    -B3
          NZ,X7  ARG7        IF NOT EQUIVALENCED
          EQ     ARG9B       ERROR - EQUIVALENCE NOT ALLOWED
  
 ARG4     MI,B2  ARG6        IF MULTIPLE BINARY VALUE PARAMETER 
  
*         PROCESS SPECIFIED VALUE PARAMETER.
  
          SA3    B3          SECOND DEFAULT VALUE 
          BX6    -X0*X3 
          NZ,X7  ARG7        IF NOT EQUIVALENCED
          SA1    A1+B1
          AX2    48 
          BX3    X0*X1       ARGUMENT VALUE 
          LX2    -1 
          ZR,X3  ARG9A       ERROR - NULL VALUE OR END OF ARGUMENT
          PL,X2  ARG5        IF CONVERSION MODE = BLANK OR *Z*
          SB6    B2          SAVE VA IN B6
          SB7    X2          (B7) = 0 IF *O*, 1 IF *D*
          BX5    X3          (X5) = ARGUMENT
          RJ     DXB=        CONVERT TO BINARY                          000640
          SB2    B6 
          SB3    A3          RESTORE REGISTERS
          MX0    7*6
          SX3    B0 
          NZ,X4  ARG9A       ERROR - BINARY CONVERSION ERROR
          EQ     ARG7 
  
 ARG5     SB7    X2          (B7) = 0 IF BLANK, 1 IF *Z*
          AX1    7*6
          ZR,B7  ARG7        IF NO CONVERSION WANTED
          SX1    X1-1L0 
          NZ,X1  ARG7        IF NOT *0* 
          SX3    B0 
          MX6    0           CLEAR VALUE
          EQ     ARG7 
  
*         PROCESS MULTIPLE BINARY VALUE PARAMETER.
  
 ARG6     SA3    -B2
          SB4    18          SET FOR SECOND DEFAULTS
          MX4    -1 
          NZ,X7  ARG6A       IF NOT EQUIVALENCED
          SB4    21          SET FOR INITIAL VALUES 
 ARG6A    AX5    X3,B4       PROCESS OPTION LIST
          BX6    -X4*X5 
          SA6    X3          STORE SECOND DEFAULT OR INITIAL VALUE
          SA3    A3+B1
          NZ,X3  ARG6A       LOOP 
          SB2    -B2
          NZ,X7  ARG7A       IF NOT EQUIVALENCED
          SX6    B0          SET OPTION VALUE 
          SX2    B1 
 ARG6B    SA1    A1+B1       GET NEXT ARGUMENT
          SX7    X1-6 
          IX6    X2-X6       TOGGLE OPTION VALUE
          ZR,X7  ARG6B       IF MINUS SIGN
          BX7    X0*X1
          SA3    B2 
          ZR,X7  ARG6F       IF NULL OPTION 
          MX4    6*6
 ARG6C    BX5    X1-X3       SEARCH OPTION LIST 
          BX7    X4*X5
          ZR,X7  ARG6E       IF FOUND 
          SA3    A3+B1
          NZ,X3  ARG6C       LOOP 
          BX3    X1 
          AX3    7*6         NOT FOUND - TEST FOR *0* 
          SX3    X3-1L0 
          NZ,X3  ARG9A       ERROR - UNKNOWN OPTION 
          SA4    B2 
          IX6    X2-X6       (X6) = 0 IF *0* OR 1 IF *-0* 
 ARG6D    SX3    X4 
          SA4    A4+B1       STORE INTO EACH OPTION 
          SA6    X3 
          NZ,X4  ARG6D       LOOP 
 ARG6E    SA6    X3+         STORE VALUE
 ARG6F    SX7    X1-3 
          MX6    0
          ZR,X7  ARG6B       LOOP IF FOLLOWED BY SLASH
          EQ     ARG7A       GO FINISH UP 
  
*         ENTER ARGUMENT. 
  
 ARG7     BX3    X0*X3       MERGE ARGUMENT AND STATUS
          IX7    X3+X6
          SA7    B2          STORE ARGUMENT 
 ARG7A    NE,B2,B3  ARG1     IF VA AND SD ADDRESSES NOT EQUAL 
          SA2    A2 
          MX3    2*6
          BX7    X2+X3       SET KW = 7777B 
          SA7    A2 
          EQ     ARG1        LOOP FOR NEXT ARGUMENT 
  
*         POST SCAN PROCESSING. 
  
 ARG8     MX7    0
          SA1    LM 
          SB7    LML
 ARG8B    LX2    X7,B1       COLLECT LANGUAGE MODE BITS 
          SB7    B7-B1
          BX7    X2+X1
          SA1    A1+B1
          NZ,B7  ARG8B       LOOP 
          LX7    48-LML 
          CX6    X7          COUNT THE BITS 
          ZR,X7  ARG8C       IF NONE
          NX7,B7
          SX6    X6-2        X7 = WHICH ONE 
          SX7    B7 
          PL,X6  ARG9C       ERROR - 2 OR MORE LANGUAGE MODES 
          SA7    DDLCOMP
 ARG8C    SA1    EXHSS
          SA2    NOADDSS
          SX6    X1-2 
          SA3    PURGESS
          IX6    X6+X2
          SA4    REPLACE
          IX6    X6+X3
          IX6    X6+X4
          PL,X6  ARG9C       ERROR - 2 OR MORE LIBRARY DIRECTIVES 
          SA1    NEWLIB      SUBSCHEMA LIBRARY MODE SPECIFIED 
          ZR,X1     ARG8E    NO DIRECTIVES SPECIFIED SO QUIT
          SX6    X6+1 
          PL,X6  ARG9C       ERROR - BOTH NL AND LIB DIRECTIVES GIVEN 
  
 PD       IF     DEF,PDENS
          SA1    PDENS       PRINT DENSITY (LINES PER INCH) 
          SX6    X1-8 
          ZR,X6  ARG8D       IF *PD=8*
          SX6    X1-6 
          ZR,X6  ARG8D       IF *PD=6*
          SX6    X1-4 
          ZR,X6  ARG8D       IF *PD=4*
          SX6    X1-3 
          NZ,X6  ARG9D       IF NOT *PD=3* ERROR - *PD* INVALID 
 ARG8D    BSS    0
  
 PS       IF     DEF,PSIZE
          SA2    PSIZE
          NZ,X1  ARG8E       IF *PS=N* SPECIFIED
          SX3    IP.PS
          IX6    X1*X3       COMPUTE DEFAULT PAGE SIZE
          SX2    IP.PD       = (PDENS) * IP.PS / IP.PD
          IX6    X6/X2
          SA6    A2 
 PS       ENDIF 
 PD       ENDIF 
  
 ARG8E    BSS    0
          JP     EXIT.
  
*         ARGUMENT ERROR. 
* SETS UP THE CALL PARAMETERS AND CALLS AN ABORT ROUTINE               *
*         -DOES NOT RETURN-                                            *
*                                                                      *
*         ARG9A - PARAMETER EQUIVALENCE VALUE INVALID                  *
*         ARG9B - DUPLICATE OR INVALID PARAMETERS                      *
*         ARG9C - INCOMPATIBLE PARAMETERS                              *
*         ARG9D - PD PARAMETER INVALID                                 *
*                                                                      *
 ARG9A    SA1    A1-B1       IF EQUIVALINCE INVALID - LOAD PARAMETER
 ARG9B    BX6    X0*X1       MASK OFF SEPARATOR CODE
          SA6    PPARM       STORE CC PARM FOR CALL (BINARY 0 FILLED) 
          SX6    =1          SET ABORT TYPE TO 2 PARAMETER CALL (1) 
          SA6    ABTYPE 
          SA1    ABTYPE 
          RJ     =XDDLABT    CALL THE ABORT *NO RETURN* 
  
 ARG9C    SX6    =2          SET ABORT TYPE TO ONE PARAMETER CALL (2) 
          SA6    ABTYPE 
          SA1    ABTYPE 
          RJ     =XDDLABT    CALL THE ABORT *NO RETURN* 
  
 ARG9D    SX1    PDPARM      STORE *PD* IN THE PARAMETER REGISTER 
          EQ     ARG9B       LOOP BACK TO STORE IT IN CALL
  
  
 ABTYPE   DATA   0           ** PARM LIST - DO NOT INSERT LINES **
          CON    PPARM       ** END LIST ** 
 PPARM    DATA   0
 PDPARM   DATA   10LPD
  
  
*CALL     COMCDXB            CONVERT DISPLAY CODE INTEGER TO BINARY.
  
  
          END 
