*COMDECK  COMCPAC - PROCESS ARGUMENTS FROM CONTROL STATEMENT. 
 PAC      CTEXT  COMCPAC - PROCESS ARGUMENTS FROM CONTROL STATEMENT.
 PAC      SPACE  4,10 
***       COMCPAC -  PROCESS ARGUMENTS FROM CONTROL STATEMENT.
* 
*         R. H. GOODELL      71/07/01       COMPASS 3.0 
*         P. H. MCQUESTEN    71/11/05       COMQARG 
*         G. E. LOGG         74/07/26       COMQARG VERSION  2. 
*         D. MONTAGNA        77/09/26       COMCPAC 
* 
*         COPYRIGHT CONTROL DATA CORP. 1977.
*         CONTROL DATA  PROPRIETARY PRODUCT.
 PAC      SPACE  4,10 
          IF     -DEF,QUAL$,1 
          QUAL   COMCPAC
          BASE   D
 COMCPAC  SPACE  4,10 
***       COMCPAC -  PROCESS ARGUMENTS FROM CONTROL STATEMENT.
* 
*         PAC CAN BE USED TO PROCESS ANY STATEMENT WHICH IS MADE UP 
*         OF A VERB FOLLOWED BY A LIST OF ITEMS DELIMITTED BY 
*         SEPARATORS AND ENDED BY A TERMINATOR. THE PARAMETERS MAY
*         HAVE THE FOLLOWING FORMS. 
*                PARAMETER
*                -PARAMETER 
*                PARAMETER=0
*                PARAMETER=SOP1/../SOPN (WHERE S IS *-* OR NULL)
*                PARAMETER=STRING 
*         EACH OPTION MUST BE LESS THAN 11 CHARACTERS.  A STRING MAY
*         ANY LENGTH.  MORE THAN ONE OCCURENCE OF A PARAMETER MAY 
*         BE ALLOWED. 
*         IF THE VERB IS *EXECUTE* AND (RA.PGN) DOES NOT CONTAIN
*         *EXECUTE*, THE LOADER *EXECUTE* DIRECTIVE IS ASSUMED AND
*         SKIPPED.  *PAC* WILL TREAT A *NOS* LABEL AS THE VERB. 
*         THEREFORE, CALLERS HAVING AN *ARG=* ENTRY POINT MUST
*         PREPROCESS THE LABEL BEFORE CALLING *PAC*.
* 
*         TERMINOLOGY --
*           PARAMETER - THE KEYWORD USED IN SPECIFYING INFORMATION. 
*           OPTION - A VALUE ASSIGNED TO A PARAMETER. 
*           FIRST DEFAULT - (FD) THE DEFAULT VALUE USED FOR A PARAMETER 
*              WHEN IT DOES NOT APPEAR IN THE CONTROL STATEMENT.
*           SECOND DEFAULT - (SD) THE DEFAULT VALUES USED WHEN ONLY THE 
*              PARAMETER APPEARS (NO = IS PRESENT). 
*           INITIAL VALUES - (IV) THE VALUES PUT INTO EFFECT WHEN AN
*              = IS ENCOUNTERED IN THE FORM *PARAMETER=OP/.../OP* OR
*              *PARAMETER=*.  EXPLICIT VALUES *OP* ADD OR DELETE FROM 
*              THIS INITIAL VALUE.
* 
*         ** CONTROL STATEMENT SYNTAX **
* 
*         PARAMETERS MAY BE SEPARATED BY ANY NON-ALPHANUMERIC CHARACTER 
*         EXCEPT :,-,*,/,=,$,),. AND BLANK. 
*         A BLANK MAY BE USED AS A SEPARATOR AFTER THE VERB.
*         IN ALL OTHER CASES BLANKS ARE IGNORED. THE CHARACTERS ) AND 
*         PERIOD (.) ARE THE TERMINATOR CHARACTERS.  ANY CHARACTERS 
*         FOLLOWING THE TERMINATOR ARE IGNORED.  CONTINUATION LINES ARE 
*         ALLOWED.  COLUMN 1 OF A CONTINUATION LINE LOGICALLY FOLLOWS 
*         THE LAST CHARACTER OF THE PREVIOUS LINE.
*         THE CHARACTERS -,*,/,= HAVE SPECIAL MEANING AND SHOULD
*         ONLY BE USED AS SPECIFIED BELOW.
*         SEPARATORS AND SPECIAL CHARACTERS MAY BE SPECIFIED IN ANY 
*         OPTION BY PLACING THE DESIRED CHARACTERS BETWEEN DOLLAR 
*         SIGNS.  DOLLAR SIGNS MAY BE USED TO DELIMIT ANY SET OF
*         CHARACTERS AND MAY OCCUR ANYWHERE WITHIN AN OPTION (E.G.
*         A$&$B IS EQUIVALENT TO $A&B$).  TO SPECIFY A DOLLAR SIGN
*         IN A DELIMITED FIELD USE TWO CONSECUTIVE DOLLAR SIGNS.
*         THE OPERATING SYSTEM MAY IMPOSE MORE SEVERE RESTRICTIONS
*         ON CONTROL STATEMENT SYNTAX. THE APPROPRIATE OPERATING
*         SYSTEM REFERENCE MANUAL SHOULD BE CONSULTED.
* 
*         THERE ARE THREE TYPES OF PARAMETERS.
* 
*         BINARY VALUE PARAMETER - (BV) THE PARAMETER MAY BE EITHER 
*            ON OR OFF.  *PARAMETER* TURNS IT ON AND *-PARAMETER*,
*            *PARAMETER=0*, OR *PARAMETER=* TURNS IT OFF. 
*         SPECIFIED VALUE PARAMETER - (SV) *PARAMETER=OP/.../OP*
*            WHERE OP ARE VALUES FOR THIS PARAMETER.  THE NUMBER OF 
*            OPTIONS MAY BE RESTRICTED (TO A MINIMUM OF 1).  IF ONLY
*            THE PARAMETER APPEARS, THE SECOND DEFAULT IS USED.  IF 
*            *-PARAMETER* OR *PARAMETER=* IS SPECIFIED, *PARAMETER=0* 
*            IS ASSUMED.
*         MULTIPLE BINARY VALUE PARAMETERS - (MBV)
*            *PARAMETER=SOP/.../SOP* WHERE S IS EITHER *-* OR NULL
*            AND OP IS THE NAME OF AN ON OFF SWITCH.  IF THE
*            PARAMETER IS OMITTED FIRST DEFAULTS ARE USED.  IF ONLY 
*            THE PARAMETER APPEARS, SECOND DEFAULTS ARE USED.  IF 
*            IF AN EQUAL SIGN IS PRESENT THE INTIAL VALUES ARE FIRST
*            SET AND THE OPTION LIST (IF ANY) IS SCANNED FROM LEFT
*            RIGHT TO SELECT (IF *OP*) OR DESELECT (IF *-OP*) THE 
*            OPTIONS.  A ZERO (0) DESELECTS ALL OPTIONS AND MAY BE
*            FOLLOWED BY NEW SELECTIONS.  *-PARAMETER* DESELECTS
*            ALL OPTIONS. 
* 
*         ** USING PAC ** 
* 
*         PAC IS CALLED BY PERFORMING AN RJ TO THE MAIN ROUTINE *PAC*.
*         THE FOLLOWING IS A LIST OF ROUTINES, CELLS, MICROS AND MACROS 
*         WHICH ARE AVAILABLE TO THE USER.  A COMPLETE DEFINITION OF
*         USAGE IS GIVEN IN THE CODE.  THAT DESCRIPTION SHOULD BE 
*         CONSULTED FOR APPROPRIATE DETAIL. 
* 
*         PAC = PROCESS ARGUMENTS FROM CONTROL STATEMENT. 
*         PAC.RET = RETURN FOR USER FIRST PARAMETER PROCESSOR 
*                (SEE *PAC.UFP*) AND USER NON-STANDARD ARGUMENT 
*                PROCESSOR (SEE *PAC.UAP*). 
*         CFV = CHECK FILE NAME VALIDITY. 
*         DEM = DISPLAY ERROR MESSAGES. 
*         DEM.RET = RETURN FOR USER SUPPLEMENTAL ERROR PROCESSOR
*                (SEE *DEM.UEP*). 
*         (ERR.CNT) = NUMBER OF ERRORS IN CONTROL STATEMENT.
*         (ERR.FLD) = ADDRESS OF A WORD CONTAINING THE BAD FIELD
*                WITHIN THE CONTROL STATEMENT.
*         ERR.RET = RETURN FOR USER ERROR PROCESSOR (SEE *DEM.UEP*).
*         GNC = GET NEXT CHARACTER OF CONTROL STATEMENT.
*         GNC.RET = RETURN FOR USER CONTINUATION LINE PROCESSOR 
*                (SEE *GNC.UCP*). 
*         GNA = GET NEXT ARTIFACT FROM CONTROL STATEMENT. 
*         "PAC.NAME" = NAME OF PROCESSOR FOR ERROR MESSAGES (OPTIONAL). 
*         CSERR = MACRO FOR CALLING DEFAULT ERROR MESSAGE PROCESSOR.
*         MBVOP = MACRO FOR DEFINING MULTIPLE BINARY VALUE OPTIONS. 
*         PARAM = MACRO FOR DEFINING PARAMETER KEYWORDS.
* 
*         EXITS TO USER WHEN -- 
*                THE FIRST PARAMETER IS ENCOUNTERED AND A USER FIRST
*                  PARAMETER PROCESSOR EXISTS;
*                A PARAMETER SPECIFIES NON-STANDARD PROCESSING; 
*                A CONTINUATION LINE IS NEEDED AND A USER CONTINUATION
*                  PROCESSOR EXISTS;
*                AN ERROR OCCURS AND A USER ERROR PROCESSOR EXISTS; 
*                CONTROL STATEMENT PROCESSING IS COMPLETE.
* 
*         COMMON DECKS *COMADEF*, *COMCDXB*, *COMCSFN* AND *COMCSYS*
*         ARE REQUIRED. 
 DEFS     SPACE  4,10 
**        CONTROL STATEMENT CHARACTER MAPPINGS. 
  
 O.EOS    EQU    -1          TERMINATOR (PERIOD, RPAREN)
 O.VAL    EQU    0           ALPHANUMERIC  (A-Z, 0-9, *)
 O.SEP    EQU    1           SEPARATOR (PLUS, ET SEQ) 
 O.SLASH  EQU    2           SLASH
 O.EQUAL  EQU    3           EQUAL SIGN 
 O.MINUS  EQU    4           MINUS SIGN (MUST BE GREATEST VALUE)
 DEFS     SPACE  4,10 
**        PARAMETER TABLE DESCRIPTION.
  
          DESCRIBE KA.,,,0   PARAMETER TABLE WORD A 
  
 KEY      DEFINE 7*6         PARAMETER KEYWORD NAME (0L FORMAT) 
 POA      DEFINE 18          FWA PARAM OPTION AREA (- IF PROCESSOR ADDR)
  
  
          DESCRIBE KB.,,,1   PARAMETER TABLE WORD B 
  
 MBV      DEFINE 20          MULTIPLE BINARY VALUE TABLE FWA
          REDEF  MBV
 SD       DEFINE 20          SECOND DEFAULT TABLE FWA 
 NOC      DEFINE 20          NUMBER OF OCCURENCES 
 NOP      DEFINE 20          NUMBER OF OPTIONS PER OCCURENCE
  
  
          DESCRIBE KC.,,,2   PARAMETER TABLE WORD C 
  
 STR      DEFINE 60          STRING ATTRIBUTE (-BITS IN LAST WORD)
          REDEF  STR
          DEFINE 3
 AT       DEFINE 3           1ST ATTRIBUTE
          DEFINE 18*3        REMAINING ATTRIBUTES (18 MORE FIELDS)
  
  
 Z.KEY    =      3           LENGTH OF PARAMETER TABLE ENTRY
 DEFS     SPACE  4,10 
**        MULTIPLE BINARY VALUE OPTION TABLE DESCRIPTION. 
  
          DESCRIBE KD.,,,0   MULTIPLE BINARY VALUE TABLE WORD A 
  
 KOP      DEFINE 7*6         MBV KEYWORD OPTION NAME (0L FORMAT)
 KOA      DEFINE 18          KEYWORD OPTION ADDRESS 
  
  
          DESCRIBE KE.,,,1   MULTIPLE BINARY VALUE TABLE WORD B 
  
 SD       DEFINE 1           SECOND DEFAULT (ON=1)
 IV       DEFINE 1           INITIAL VALUE (ON=1) 
 OFF      DEFINE 1           ALWAYS OFF FLAG
          DEFINE 57 
  
  
 Z.MBV    =      2           LENGTH OF MULTIPLE BINARY VALUE TABLE ENTRY
 DEFS     SPACE  4,10 
 ON       =      1
 OFF      =      0
 PAC      SPACE  4,10 
**        PAC -  PROCESS ARGUMENTS FROM CONTROL STATEMENT.
* 
*         THIS IS THE *PAC* MAIN PROCESSOR.  A COMPLETE DESCRIPTION OF
*         *PAC* IS GIVEN AT THE START OF THIS COMDECK.
* 
*         ENTRY  FIRST LINE OF CONTROL STATEMENT IS IN RA.CCD ET SEQ. 
*                (B1) = 1 
*                (X1) = ADDRESS OF PARAMETER TABLE
*                (X2) = LENGTH OF PARAMETER TABLE 
*                (X5) = ADDRESS OF USER FIRST PARAMETER PROCESSOR 
*                       OR ZERO IF NONE 
*                (X6) = ADDRESS USER ERROR PROCESSOR OR ZERO IF NONE
*                (X7) = ADDRESS OF USER CONTINUATION LINE PROCESSOR 
*                       OR ZERO IF NONE.  THE *CONTRLC* MACRO WILL BE 
*                       USED TO READ THE NEXT CONTROL STATEMENT IF NO 
*                       USER CONTINUATION LINE PROCESSOR IS SPECIFIED.
* 
*         EXIT   (B1) = 1 
*                (B3) = MODE:  -1 = NORMAL,  0 = QUOTE ($)
*                (B5) = NUMBER OF CHARACTERS REMAINING IN (X5)
*                (A5) _ CURRENT WORD OF LINE IMAGE
*                (X5) = CURRENT WORD OF LINE IMAGE
*                       I.E. (B5,A5,X5) POINT TO THE CHARACTER FOLLOWING
*                       THE TERMINATOR. 
*                (ERR.CNT) = NUMBER OF ERRORS ENCOUNTERED 
*                ARGUMENTS PROCESSED
* 
*         USES   ALL
*                RA.CCD TO RA.CCD+7 
* 
*         CALL   CFV, DEM, DXB=, GNA, GNC, MSG=, SFN=, SYS= 
  
  
 PAC      SUBR               ...ENTRY/EXIT... 
          SA6    DEMA        SAVE USER ERROR PROCESSOR
          SA7    GNCC        SAVE USER CONTINUATION LINE PROCESSOR ADDR 
          BX6    X1 
          LX7    X2 
          SA6    PACB        SAVE ADDRESS OF PARAMETER TABLE
          SB5    B0 
          BX6    X5 
          SA7    A6+B1       SAVE LENGTH OF PARAMETER TABLE 
          SA6    A7+B1       SAVE USER FIRST PARAMETER PROCESSOR
  
*         SKIP LEADING BLANKS.
  
 PAC2     SB3    B0 
          RJ     GNC
          SB7    X4-1R
          ZR     B7,PAC2     IF STILL BLANK 
  
*         SKIP VERB OR LOADER *EXECUTE* DIRECTIVE.
  
          SX6    0+ 
          SB3    0+ 
 PAC4     LX6    6
          BX6    X6+X4       COLLECT NEXT CHARACTER 
          RJ     GNC
          SB7    X4-1R9-1 
          MI     B7,PAC4     IF STILL VERB
  
*         RETURN IF TERMINATOR. 
  
          SB3    -1          SET NORMAL MODE
          SB7    X4-1R. 
          SB6    X4-1R) 
          ZR     B7,EXIT.    IF TERMINATOR, DONE... 
          ZR     B6,EXIT.    IF TERMINATOR, DONE... 
  
*         CHECK FOR LOADER *EXECUTE* DIRECTIVE. 
  
          SA2    =7REXECUTE 
          IX6    X2-X6
          NZ     X6,PAC6     IF NOT EXECUTE 
          LX2    3*6         7LEXECUTE
          SA3    RA.PGN      PROGRAM NAME 
          MX0    7*6
          BX3    X0*X3
          IX6    X2-X3
          ZR     X6,PAC6     IF VERB IS EXECUTE 
          SX0    B1          DO NOT ALLOW .GT. 10 CHARACTERS
          RJ     GNA         SKIP THE VERB
  
*         CHECK FOR USER FIRST PARAMETER PROCESSOR. 
  
 PAC6     SA1    PACB+2 
          ZR     X1,PAC10    IF NO USER PROCESSOR 
 PAC.UFP  SPACE  4,10 
**        PAC.UFP - USER FIRST PARAMETER PROCESSING.
* 
*         EXIT   (B3,B4,B5,A5,X5) = AS IN *PAC.RET* (SEE BELOW) 
* 
*         REENTRY AT *PAC.RET* (SEE BELOW)
  
  
 PAC.UFP  BSS 
          SB6    X1 
          JP     B6          JUMP TO USER FIRST PARAMETER PROCESSOR 
 PAC      SPACE  4,10 
**        PAC.RET - PROCESS NEXT PARAMETER. 
* 
*         THIS IS THE PAC MAIN LOOP NODE.  ALL PARAMETER PROCESSORS,
*         INCLUDING USER FIRST PARAMETER AND NON-STANDARD PROCESSORS, 
*         RE-ENTER HERE.  IF REQUESTED, THE PREVIOUS PARAMETER TABLE
*         IS UPDATED BEFORE PROCESSING THE NEXT PARAMETER.
* 
*         ENTRY  (B1) = 1 
*                (B2) = NUMBER OF OPTION SUBFIELDS REMAINING (OR 0 IF 
*                       RETURNING FROM PROCESSOR) 
*                (B3) = MODE:  -1 = NORMAL,  0= QUOTE ($) 
*                (B4) = TYPE OF CHARACTER AFTER THE PRECEEDING PARAMETER
*                (B5) = NUMBER OF CHARACTERS REMAINING IN X5
*                (B7) = ADDRESS+1 OF LAST OPTION STORED (OR - ADDRESS 
*                       OF USER PROCESSOR).  IF (B7) = 0, THE PARAMETER 
*                       TABLE WILL NOT BE UPDATED AND (B2), (A0) ARE
*                       IGNORED.
*                (A0) _ WORD B OF PARAMETER TABLE ENTRY 
*                (A5) _ CURRENT WORD OF LINE IMAGE
*                (X5) = CURRENT WORD OF LINE IMAGE
  
 PAC.RET  BSS                ...MAIN LOOP NODE
          ZR     B7,PAC10    IF NOTHING TO UPDATE 
          SA1    A0-KB.W+KA.W      WORD A 
          MX4    -KA.POAL 
          SA2    A0          WORD B 
          MX3    1
          BX6    X4*X1       (X6) = 0LKEYWORD 
          LX3    KB.NOCP-59 
          SX1    B7+B2       ADDRESS TO STORE NEXT OPTION GROUP 
          IX7    X2-X3       DECREMENT NUMBER OF OCCURENCES 
          BX1    -X4*X1      TRUNCATE TO KA.POAL
          SA7    A2          UPDATE WORD B
          BX6    X6+X1
          SA6    A1+         UPDATE POA FIELD 
  
  
**        PROCESS NEXT PARAMETER. 
  
 PAC10    BSS 
          SX6    B4-O.MINUS 
          MI     B4,EXIT.    IF TERMINATOR, DONE... 
          SA6    PACA        INDICATE POSSIBLE MINUS SIGN PREFIX
          SX0    1           DO NOT ALLOW .GT. 10 CHARACTERS
          RJ     GNA         GET NEXT ARTIFACT
          ZR     X6,PAC10    IF EMPTY ARGUMENT, IGNORE
          SA1    PACB        START OF PARAMETER TABLE 
          MX3    KA.KEYL
          SA4    A1+B1
          SA2    X1+         LENGTH OF PARAMETER TABLE
          SB7    X4+
          SA6    ERR.FLD     SAVE SEARCHED FOR PARAMETER
  
*         SEARCH PARAMETER TABLE. 
  
 PAC12    BX4    X3*X2       EXTRACT KEY
          ERRNZ  60-KA.KEYL-KA.KEYP 
          SB7    B7-Z.KEY 
          BX7    X4-X6
          ZR     X7,PAC14    IF FOUND 
          SA2    A2+Z.KEY    NEXT TABLE ENTRY 
          GT     B7,PAC12    IF MORE KEYS TO CHECK
          EQ     E.UA        ** UNRECOGNIZED ARGUMENT **
  
*         PROCESS PARAMETER ITEM. 
  
 PAC14    LX2    -KA.POAP 
          SB7    X2          PARAMETER OPTION ADDRESS 
          ERRMI  KA.POAL-18  FIELD .GE. 18 ASSUMED
          SA2    A2+KB.W     WORD B 
          SX3    B4-O.EQUAL 
          LX2    -KB.NOPP 
          SA0    A2          SAVE WORD B POINTER
          SB2    X2          NUMBER OF OPTIONS
          ERRMI  KB.NOPL-18  FIELD .GE. 18 ASSUMED
          LX2    KB.NOPP-KB.SDP 
          SX1    X2          SECOND DEFAULT 
          ERRMI  KB.SDL-18   FIELD .GE. 18 ASSUMED
          LX2    KB.SDP-KB.NOCP 
          SX2    X2+         NUMBER OF OCCURENCES 
          ERRMI  KB.NOCL-18  FIELD .GE. 18 ASSUMED
  
  
**        TRANSFER TO PARAMETER PROCESSOR.
* 
*         ENTRY  (B2) = NUMBER OF OPTIONS ALLOWED 
*                (B7) = FWA PARAMETER OPTION AREA (- IF PROCESSOR)
*                (A0) _ WORD B OF PARAMETER TABLE 
*                (X1) = FWA SECOND DEFAULT TABLE (- IF BV, 0 IF NONE) 
*                (X2) = NUMBER OF OCCURENCES ALLOWED
*                (X3) = 0 IF *=* FOLLOWS THIS KEY 
  
          ZR     X2,E.TMOC   IF ** TOO MANY OCCURENCES ** 
          MI     B7,PAC.UAP  IF SPECIAL, CALL USER ARGUMENT PROCESSOR 
          ZR     B7,PAC60    IF MULTIPLE BINARY VALUE PARAMETER 
          MI     X1,PAC50    IF BINARY VALUE PARAMETER
          ZR     X3,PAC30    IF = FOLLOWS PARAMETER KEYWORD 
          ZR     X1,E.NE     IF ** = REQUIRED **
          SA1    X1+
  
  
**        PROCESS *PARAM* OR *-PARAM* SYNTAX FOR SPECIFIED VALUE PARAM. 
* 
*         ENTRY  (B2) = NUMBER OF OPTIONS ALLOWED 
*                (B7) = FWA PARAMETER OPTION AREA 
*                (A1) = FWA SECOND DEFAULT LIST 
  
  
          SA2    PACA        MINUS FLAG 
          ZR     X2,PAC100   IF MINUS PRESENT, ZERO ALL OPTIONS 
  
  
**        PROCESS SECOND DEFAULT FOR SPECIFIED VALUE PARAMETERS.
  
 PAC20    BSS 
          BX6    X1 
          SB2    B2-B1
          SA6    B7          UPDATE NEXT OPTION 
          SA1    A1+B1
          SB7    B7+1 
          NZ     B2,PAC20    IF MORE OPTIONS
          EQ     PAC.RET     RE-ENTER MAIN LOOP...
  
  
**        PROCESS SPECIFIED VALUE PARAMETER OPTIONS.
  
 PAC30    BSS 
          SA4    A0-KB.W+KC.W      GET WORD C 
          SA2    PACA        MINUS FLAG 
          BX7    X4 
          ZR     X2,E.ME     IF ** - AND = NOT ALLOWED ** 
          PL     X7,PAC36    IF NOT A STRING OPTION 
  
  
**        PROCESS STRING ATTRIBUTES.
* 
*         ENTRY  (B2) = NUMBER OF OPTIONS LEFT
*                (B7) = NEXT PARAMETER STORE ADDRESS
*                (A0) _ WORD B
*                (X7) = -(NUMBER OF BITS ALLOWED IN LAST WORD OF STRING)
  
 PAC32    BSS 
          SX0    B0          ALLOW .GT. 10 CHARACTERS 
          RJ     GNA         GET NEXT ARTIFACT
          SA6    B7          STORE THIS WORD
          SB2    B2-B1
          SB7    B7+1 
          NZ     B4,PAC34    IF END OF STRING 
          NZ     B2,PAC32    IF NOT END OF SUBFIELDS
  
 PAC33    MX1    KA.KEYL
          SA2    A0-KB.W+KA.W 
          BX6    X1*X2       EXTRACT PARAMETER NAME 
          SA6    ERR.FLD     STORE PARAMETER NAME 
          EQ     E.STL       ** STRING TOO LONG **
  
*         CHECK FOR STRING TOO LONG.
  
 PAC34    NZ     B2,PAC100   IF NOT LAST WORD 
          SB2    9*6
          SB6    B2-B6       NUMBER OF BITS IN X6 
          SB2    B6+X7       NUMBER OF EXCESS BITS IN X6
          GT     B2,PAC35    IF TOO LONG
          SB2    B0 
          EQ     PAC.RET     RE-ENTER MAIN LOOP...
  
 PAC35    SB6    X7+B1
          MX1    1
          LX0    X1,B6       FORM MASK
          BX6    X0*X6       TRUNCATE STRING
          SA6    B7-B1       RESTORE LAST WORD OF STRING
          EQ     PAC33       FLAG THE ERROR 
  
  
**        PROCESS SPECIFIED VALUE OPTIONS SEPARATED BY /. 
* 
*         ENTRY  (B2) = NUMBER OF OPTIONS REMAINING 
*                (B7) = NEXT ADDRESS TO STORE ARGUMENT
*                (A0) _ WORD B OF PARAMETER TABLE ENTRY 
*                (X7) = WORD C OF PARAMETER TABLE ENTRY 
  
 PAC36    LX7    KC.ATL      POSITION FIRST ATTRIBUTE 
          ERRNZ  60-2*KC.ATL-KC.ATP 
  
 PAC38    SX0    B1          DO NOT ALLOW .GT. 10 CHARACTERS
          RJ     GNA         GET NEXT ARTIFACT
          NZ     X6,PAC39    IF ARTIFACT NOT SEPERATOR, ETC.
          LX4    6           SHIFT CHARACTER
          BX6    X4 
  
 PAC39    SA6    ERR.FLD
          ZR     B2,E.TMOP   IF ** TOO MANY OPTIONS **
          SB2    B2-B1
          LX7    KC.ATL 
          ZR     X6,PAC42    IF NULL PARAMETER
          MX4    -KC.ATL
          BX4    -X4*X7      EXTRACT NEXT ATTRIBUTE 
          SX1    -B6
          SB6    X4+PAC40 
          JP     B6          PROCESS NEXT OPTION
  
*         ATTRIBUTE JUMP TABLE. 
  
 PAC40    BSS 
 +        EQ     PAC42       0 = CHARACTER FIELD 0L FORMAT
 +        EQ     PAC44       1 = CHARACTER FIELD 0R FORMAT
 +        EQ     PAC46       2 = FILE NAME
 +        SB6    B7 
          SB7    B1 
          EQ     PAC48       3 = NUMERIC FIELD (DECIMAL ASSUMED)
 +        SB6    B7 
          SB7    B0 
          EQ     PAC48       4 = NUMERIC FIELD (OCTAL ASSUMED)
  
  
**        STORE OPTION VALUE. 
* 
*         ENTRY  (B7) = ADDRESS TO STORE OPTION VALUE 
*                (X6) = OPTION VALUE
*                (B2,A0,X7) = AS *PAC38*
  
 PAC42    BSS 
          SA6    B7+         PROCESS CHARACTER FIELD
          SX1    B4-O.SLASH 
          SB7    B7+1 
          ZR     X1,PAC38    IF MORE OPTIONS
          EQ     PAC100      ZERO REMAINING OPTION SUBFIELDS
  
  
**        RIGHT JUSTIFY CHARACTER FIELD.
* 
*         ENTRY  (X1) = 6 - NUMBER OF UNUSED BIT IN (X6)
*                (X6) = CHARACTER FIELD, LEFT JUSTIFIED 
  
 PAC44    BSS 
          SB6    60+X1-6
          LX6    X6,B6
          EQ     PAC42       STORE OPTION VALUE 
  
  
**        CHECK FILE NAME OPTION. 
* 
*         ENTRY  (X6) = FILENAME 0L FORMAT
  
 PAC46    BSS 
          BX1    X6 
          RJ     CFV         CHECK FILE NAME VALIDITY 
          ZR     X4,PAC42    IF NAME OK 
          EQ     E.IFN       ** ILLEGAL FILE NAME **
  
  
**        CONVERT NUMERIC OPTION. 
* 
*         ENTRY  (B6) = SAVED (B7)
*                (B7) = 1 IF ASSUMED DECIMAL, 0 IF OCTAL
*                (X6) = VALUE TO CONVERT
  
 PAC48    BSS                SAVE REGISTERS 
          SA7    PACA        (X7) 
          BX7    X5 
          LX5    X6 
          SA7    A7+B1       (X5) 
          MX0    -18
          SX6    B2 
          SX7    B4 
          BX7    -X0*X7 
          LX6    40 
          LX7    20 
          BX6    X6+X7
          SX7    B5 
          BX7    -X0*X7 
          BX6    X6+X7
          SA6    A7+B1       (B2,B4,B5) 
          RJ     =XDXB       CHECK AND CONVERT NUMBER 
          SA1    PACA        RESTORE REGISTERS
          SA2    A1+B1
          BX7    X1          (X7) 
          SA3    A2+B1
          LX5    X2          (X5) 
          SB5    X3          (B5) 
          AX3    20 
          SB4    X3          (B4) 
          SB3    -B1         (B3) 
          AX3    20 
          SB2    X3          (B2) 
          SB7    B6+         (B7) 
          ZR     X4,PAC42    IF NUMBER OK 
          EQ     E.IN        ** ILLEGAL NUMERIC **
  
  
**        PROCESS BINARY VALUE PARAMETER. 
* 
*         ENTRY  (B7) = ADDRESS TO STORE SWITCH:  ON=1S59, OFF=0
*                (X3) = 0 IF *=* AFTER PARAMETER KEYWORD
*                (PACA) = 0 IF MINUS BEFORE KEYWORD, ELSE .NE. 0
  
 PAC50    BSS 
          SA2    PACA        MINUS FLAG 
          SX7    OFF
          ZR     X2,PAC52    IF MINUS PRESENT 
          ZR     X3,PAC54    IF EQUAL PRESENT 
          MX7    ON 
          EQ     PAC56       SET SWITCH 
  
 PAC52    ZR     X3,E.ME     IF ** - AND = NOT ALLOWED ** 
          EQ     PAC56       SET SWITCH 
  
 PAC54    SX0    B1          DO NOT ALLOW .GT. 10 CHARACTERS
          RJ     GNA         GET NEXT ARTIFACT
          ZR     X6,PAC56    IF NULL, OK
          LX6    2*6
          SX4    X6-2R0 +1R 
          ZR     X4,PAC56    IF 0, OK 
          EQ     E.IBV       ** ILLEGAL BINARY VALUE ** 
  
 PAC56    SA7    B7 
          EQ     PAC.RET     RE-ENTER MAIN LOOP...
  
  
**        PROCESS MULTIPLE BINARY VALUE PARAMETER.
* 
*         ENTRY  (B2) = NUMBER OF OPTIONS ALLOWED 
*                (A0) _ WORD B OF PARAMETER TABLE ENTRY 
*                (X1) = MBV TABLE ADDRESS 
*                (X3) = 0 IF *=* FOLLOWS PARAMETER KEYWORD
  
 PAC60    BSS 
          ERRNZ  KB.MBVP-KB.SDP    MBV FIELD = SD FIELD ASSUMED 
          SB7    B2+
          SB6    59-KE.SDP   SECOND DEFAULT 
          NZ     X3,PAC62    IF NO =
          SA2    PACA        MINUS FLAG 
          SB6    59-KE.IVP   INITIAL VALUE
          ZR     X2,E.ME     IF ** - AND = NOT ALLOWED ** 
  
*         INITIALIZE TO SECOND DEFAULT OR INITIAL VALUE.
  
 PAC62    SA2    X1+KD.W     MBV WORD A 
 PAC64    SA4    A2-KD.W+KE.W      MBV WORD B 
          MX7    ON 
          LX4    X4,B6
          MI     X4,PAC66    IF ON
          SX7    OFF
 PAC66    SA7    X2+         STORE BINARY VALUE 
          ERRNZ  KD.KOAP     LOWER 18 BITS ASSUMED
          SB7    B7-1 
          ZR     B7,PAC68    IF DONE
          SA2    A2+Z.MBV 
          EQ     PAC64       SETUP NEXT ENTRY 
  
*         SET SELECTED OPTIONS IF PRESENT.
  
 PAC68    NZ     X3,PAC80    IF NO =
          MX7    ON 
          SB7    X1          SAVE MBV TABLE ADDRESS 
  
*         GET NEXT OPTION.
  
 PAC70    SX0    1           DO NOT ALLOW .GT. 10 CHARACTERS
          RJ     GNA         GET NEXT ARTIFACT
          NZ     X6,PAC74    IF AN OPTION 
  
*         CHECK FOR MINUS.
  
          SX3    B4-O.MINUS 
          NZ     X3,PAC72    IF NOT A MINUS 
          SA1    PACA        MINUS FLAG 
          ZR     X1,PAC80    IF ALREADY A MINUS 
          SX7    OFF
          EQ     PAC70       GO FOR MORE
  
*         CHECK FOR SLASH.
  
 PAC72    SX3    B4-O.SLASH 
          NZ     X3,PAC80    IF NOT A SLASH 
          MX7    ON 
          EQ     PAC70       GO FOR MORE
  
*         FIND THE OPTION.
* 
*         ENTRY  (B2) = NUMBER OF OPTIONS ALLOWED 
*                (B7) = FWA MBV TABLE AREA
*                (X6) = 0L OPTION 
*                (X7) = ON OR OFF SWITCH VALUE
  
 PAC74    MX0    KD.KOPL
          ERRNZ  60-KD.KOPL-KD.KOPP    ASSUMES UPPER 42 
          SA2    B7+
          SB6    B2 
          SA6    ERR.FLD
 PAC76    BX4    X0*X2
          SB6    B6-1 
          BX4    X4-X6
          ZR     X4,PAC78    IF FOUND 
          SA2    A2+Z.MBV    NEXT TABLE ENTRY 
          GT     B6,PAC76    IF MORE OPTIONS TO CHECK 
          LX6    2*6
          SX4    X6-2R0 +1R 
          NZ     X4,E.UOP    ** UNKNOWN OPTION ** 
  
*         OPTION IS *0*.  OFF ALL OPTIONS.
  
          SX1    B7          MBV TABLE FWA
          SB6    B2          MBV TABLE LENGTH 
          MX7    OFF
          =A2    X1+KD.W     MBV 1ST WORD 
 PAC77    SA7    X2 
          =B6    B6-1 
          ZR     B6,PAC72    IF DONE
          SA2    A2+Z.MBV 
          EQ     PAC77       CONTINUE OFFING
  
*         UPDATE THE OPTION.
  
 PAC78    SA7    X2 
          ERRNZ  KD.KOAP     ASSUMES ADDRESS IN LOWER 18
          MX7    ON 
          EQ     PAC72       GO FOR MORE
  
 PAC80    SB7    B1 
          SB2    -B7         SO B7+B2 = 0 
          EQ     PAC.RET     RE-ENTER MAIN LOOP...
  
  
**        ZERO THE REMAINING OPTION SUBFIELDS.
* 
*         ENTRY  (B2) = NUMBER OF SUBFIELDS TO ZERO 
*                (B7) = ADDRESS OF NEXT SUBFIELD
  
 PAC100   BSS 
          ZR     B2,PAC.RET  IF DONE, RE-ENTER MAIN LOOP... 
          BX6    X6-X6
          SB2    B2-B1
          SA6    B7 
          SB7    B7+B1
          EQ     PAC100      MORE TO ZERO 
 PAC.UAP  SPACE  4,10 
**        PAC.UAP - USER ARGUMENT PROCESSOR.
* 
*         EXITS TO USER ARGUMENT PROCESSOR.  USER RE-ENTERS AT
*         *PAC.RET*.  SEE *PAC.RET* FOR RE-ENTRY CONDITIONS.  THE 
*         VALUE OF B7 WILL OVERRIDE THE VALUE DEFINED BY THE *POA*
*         PARAMETER ON THE *PARAM* MACRO. 
* 
*         EXIT   (B1) = 1 
*                (B2) = NUMBER OF OPTION SUBFIELDS ALLOWED
*                (B4) = CHARACTER TYPE (SEE *GNC*)
*                (B7) = ADDRESS OF USER PROCESSOR 
*                (A0) _ WORD B OF PARAMETER TABLE ENTRY 
*                (X1) = FWA OF SECOND DEFAULT LIST
*                (X2) = NUMBER OF OCCURENCES ALLOWED
*                (X3) = 0 IF *=* FOLLOWS KEYWORD
* 
*         REENTRY TO *PAC.RET* (SEE FOR REQUIREMENTS) 
  
  
 PAC.UAP  BSS 
          SB7    -B7
          JP     B7          PROCESS SPECIAL ARGUMENTS
 PAC      SPACE  4,10 
 PACA     CON    0           SWITCH VALUE AND USED TO SAVE X7 
          CON    0           SAVE X5
          CON    0           SAVE B2,B4,B5
 PACB     CON    0           FWA OF PARAMETER TABLE 
          CON    0           LENGTH OF PARAMETER TABLE
          CON    0           ADDRESS OF USER FIRST PARAMETER PROCESSOR
 CFV      SPACE  4,15 
**        CFV -  CHECK LOGICAL FILE NAME VALIDITY.
* 
*         A LEGAL FILE NAME MAY CONTAIN FROM ONE TO SEVEN 
*         ALPHANUMERIC CHARACTERS.
* 
*         ENTRY  (X1) = NAME TO BE CHECKED (0L FORMAT)
* 
*         EXIT   (X6) = NAME, TRUNCATED TO 7 CHARACTERS IF NECESSARY
*                       IF NAME WAS *0*, REPLY IS BINARY ZERO.
*                (X4) = 0 IF NAME WAS VALID, ELSE .NE. 0
* 
*         USES   X - 1, 2, 4, 6 
  
  
 CFV      SUBR               ...ENTRY/EXIT... 
          SX2    X1+
          IX6    X6-X6
          LX1    2*6
          SX4    X1-2R0 +1R 
          ZR     X4,EXIT.    IF *0* 
  
 .OS      IFNE   .OS,1       IF NOT NOS 
          PL     X4,EXIT.    IF FIRST CHARACTER NOT ALPHABETIC
 .OS      ENDIF 
  
          LX1    -2*6        RESTORE (X1) 
          BX6    X2-X1
          NZ     X2,EXIT.    IF MORE THAN 7 CHARS 
          MX4    0
          EQ     EXIT.       DONE...
 DEM      SPACE  4,10 
**        DEM - DAYFILE ERROR MESSAGES. 
* 
*         ENTRY  (B6) _ DAYFILE MESSAGE 
*                (DEMA) = 0 TO DAYFILE THE ERROR MESSAGE ELSE, ADDRESS
*                        OF USER ERROR PROCESSOR TO CALL.  IF (DEMA)=0, 
*                        * "PAC.NAME" CONTROL STATEMENT ERRORS --* WILL 
*                        BE DISPLAYED THE FIRST TIME IN.
*                (ERR.FLD) = ARGUMENT FIELD WHICH IS IN ERROR IF ANY. 
*                        IF .NE. 0, (ERR.FLD) WILL BE PREFIXED TO 
*                        THE MESSAGE IN (B6) (WHICH MUST BE .LE.
*                        3 WORDS LONG). 
* 
*         USES   B - 6
*                A - 1-3, 6 
*                X - 0-4, 6 
* 
*         CALLS  MSG=, SFN= (OR USER ERROR PROCESSOR) 
  
  
 ERR.RET  BSS                ...USER PROCESSOR RETURN 
  
 DEM      SUBR               ...ENTRY/EXIT... 
          SA2    DEMA 
          NZ     X2,DEM.UEP  IF USER ERROR PROCESSOR SHOULD BE CALLED 
  
 DEM.RET  BSS                ...USER SUPPLEMENTAL PROCESSOR RETURN
          SA2    ERR.CNT     ERROR COUNT
          SX6    X2+B1
          SA6    A2          UPDATE ERROR COUNT 
          NZ     X2,DEM1     IF NOT FIRST TIME
          MESSAGE  DEMB,,RCL
 DEM1     SA1    ERR.FLD
          NZ     X1,DEM2     IF ARGUMENT FIELD EXISTS 
          SX1    B6 
          MESSAGE   X1,,RCL 
          EQ     EXIT.       DONE...
  
 DEM2     SX0    B2          SAVE B2
          BX4    X7          SAVE X7
          RJ     =XSFN=      SPACE FILL NAME
          SA6    A1          (ERR.FLD)
          SA1    B6          MESSAGE WORD 1 
          BX6    X1 
          SA6    A6+B1
          SA1    A1+B1       MESSAGE WORD 2 
          BX6    X1 
          SA6    A6+B1
          SA1    A1+1        MESSAGE WORD 3 
          BX6    X1 
          SA6    A6+B1
          MESSAGE ERR.FLD,,RCL
          SB2    X0          RESTORE B2 
          BX7    X4          RETORE X7
          EQ     EXIT.       DONE...
 DEM.UEP  SPACE  4,10 
**        CALL USER ERROR PROCESSOR.
* 
*         EXIT   (A1) = FWA OF DAYFILE MESSAGE OR ZERO IF NONE
*                (ERR.FLD) = SAME AS *DEM* ABOVE
*                (DEMA) = SAME AS *DEM* ABOVE 
* 
*         REENTRY TO *ERR.RET* IF ONLY USER PROCESSING DESIRED, 
*                   (ERR.CNT) UPDATED IF DESIRED
*                 ELSE, TO *DEM.RET* FOR *DEM* STANDARD PROCESSING. 
* 
*         USES   SAME AS *DEM* ABOVE
  
  
 DEM.UEP  BSS 
          SA1    B6 
          SB6    X2 
          JP     B6          USE USER ERROR PROCESSOR 
 DEM      SPACE  4,10 
          IF     -MIC,PAC.NAME,1
 PAC.NAME MICRO  1,,
  
 DEMA     CON    0           ADDRESS OF USER ERROR PROCESSOR IF ANY 
 DEMB     DIS    ,* "PAC.NAME" CONTROL STATEMENT ERRORS --* 
 ERR.FLD  CON    0           BAD FIELD OR ZERO IF NONE
          BSSZ   4           MESSAGE/END-OF-MESSAGE MARK
 ERR.CNT  CON    0           ERROR COUNT
 CSERR    SPACE  4,10         CONTROL STATEMENT ERROR MESSAGES. 
**        CSERR - CONTROL STATEMENT ERROR MESSAGES. 
* 
*         CSERR  (TEXT) 
* 
*                *TEXT* = ERROR MESSAGE TEXT.  A BLANK WILL BE
*                         PREFIXED AND A PERIOD SUFFIXED. THE TEXT
*                         IS DISPLAYED 40 CHARACTERS PER LINE.  ON
*                         LONG MESSAGES, SPACES SHOULD BE PROVIDED
*                         SO THAT WORDS ARE NOT SPLIT ACROSS LINES. 
*                         IF (ERR.FLD) .NE. 0, IT WILL BE SPACE FILLED
*                         AND PREFIXED TO THE TEXT.  IN THIS CASE *TEXT*
*                         MUST BE .LE. 28 CHARACTERS.  EXCESS TEXT WILL 
*                         BE IGNORED WITHOUT WARNING. 
* 
*         USES   B - 6
*                A - 1-3, 6 
*                X - 0-4, 6 
* 
*         CALLS  DEM
  
          PURGMAC CSERR 
  
 CSERR    MACRO  TEXT 
          SB6    =C$ TEXT.$ 
          RJ     DEM
 CSERR    ENDM
  
  
 E.GT10   SA6    ERR.FLD
          CSERR  (.GT. 10 CHAR) 
          EQ     GNA2        SKIP EXCESS CHARACTERS 
  
 E.IBV    CSERR  (HAS ILLEGAL BINARY VALUE) 
          SB7    B0          NO PARAMETER TO UPDATE 
          EQ     E.SKIP1     SKIP TO SEPARATOR
  
 E.IC     BX0    X6 
          MX6    0
          SB4    B6+
          SA6    ERR.FLD
          CSERR  (ILLEGAL CHARACTER)
          SB6    B4          RESTORE (B6) 
          BX6    X0          RESTORE (X6) 
          EQ     GNC1        GET NEXT CHARACTER 
  
 E.IFN    CSERR  (ILLEGAL FILENAME) 
          MX6    0
          EQ     PAC42       PROCESS NEXT OPTION SUBFIELD 
  
 E.IN     CSERR  (ILLEGAL NUMERIC)
          MX6    0
          EQ     PAC42       PROCESS NEXT OPTION SUBFIELD 
  
 E.ME     CSERR  (- AND = NOT BOTH ALLOWED) 
          SB7    B0          NO PARAMETER TO UPDATE 
          EQ     E.SKIP2     SKIP TO SEPARATOR
  
 E.NE     CSERR  (MUST BE EQUIVALENCED) 
          EQ     PAC10       RE-ENTER MAIN LOOP 
  
 E.STL    CSERR  (STRING TOO LONG)
          EQ     E.SKIP1     SKIP TO NEXT SEPARATOR 
  
 E.TM     SX6    0
          SA6    ERR.FLD
          CSERR  (TERMINATOR MISSING) 
          EQ     PACX 
  
 E.TMOC   CSERR  (TOO MANY OCCURENCES)
          SB7    B0          NO PARAMETER TO UPDATE 
          EQ     E.SKIP2     SKIP TO NEXT SEPARATOR 
  
 E.TMOP   CSERR  (TOO MANY OPTIONS) 
          EQ     E.SKIP2     SKIP TO NEXT SEPARATOR 
  
 E.UA     CSERR  (UNRECOGNIZABLE) 
          SB7    B0          DO NO PARAMETER TABLE TO UPDATE
          EQ     E.SKIP2     SKIP TO NEXT SEPARATOR 
  
 E.UOP    CSERR  (UNKNOWN OPTION) 
          EQ     PAC72       GET NEXT OPTION
  
  
*         SKIP TO NEXT SEPARATOR OR TERMINATOR. 
  
 E.SKIP1  SX0    B0          ALLOW .GT. 10 CHARACTERS 
          RJ     GNA         SKIP 
 E.SKIP2  GT     B4,B1,E.SKIP1     IF /, =, OR -
          ERRNZ  O.SEP-1
          ZR     B4,E.SKIP1  IF ALPHANUMERIC
          ERRNZ  O.VAL
          EQ     PAC.RET     RE-ENTER MAIN LOOP...
 GNA      SPACE  4,10 
**        GNA - GET NEXT ARTIFACT.
* 
*         THE NEXT ALPHANUMERIC STRING (FIRST 10 CHARACTERS WITH
*         QUOTES ($) REMOVED), SEPARATOR OR TERMINATOR IS OBTAINED. 
*         AN ASTRISK (*) IS INTERPRETED AS AN ALPHANUMERIC CHARACTER. 
*         BLANKS ARE SKIPPED. 
* 
*         ENTRY  (B3) = MODE:  -1 = NORMAL,  0 = QUOTE ($)
*                (B5) = NUMBER OF CHARACTERS REMAINING IN (X5)
*                (A5) = ADDRESS OF (X5) 
*                (X0) = 0 IF STRING .GT. 10 CHARACTERS IS ALLOWED 
*                (X5) = CURRENT WORD OF LINE IMAGE
* 
*         EXIT   (X5, A5,B3, B5) UPDATED AND -- 
* 
*                IF NEXT ARTIFACT WAS A SEPARATOR OR TERMINATOR --
*                (B4) = TYPE OF ARTIFACT.  SEE *GNC* FOR TYPE.
*                (B6) = 9*6 
*                (X4) = THE ARTIFACT (SEPARATOR OR TERMINATOR) 1R FORMAT
*                (X6) = 0 
* 
*                IF NEXT ARTIFACT WAS AN ALPHANUMERIC STRING -- 
*                (B4) = TYPE OF CHARACTER IN (X4).  SEE *GNC* FOR TYPE. 
*                       IF (B4) = 0, (X6) = 1ST 10 CHARACTERS OF A
*                       LONGER STRING.
*                (B6) = 9*6-(NUMBER OF CHAR IN X6)*6
*                       I.E. (B6)+6 = NUMBER OF UNUSED BITS IN X6 
*                       RANGE (B6) = 9*6 TO -6
*                (X4) = CHARACTER FOLLOWING (X6), 1R FORMAT 
*                (X6) = NEXT ALPHANUMERIC VALUE, 0L FORMAT
* 
*         USES   B - 3-6
*                A - 1-3, 5, 6
*                X - 0-6
* 
*         CALLS  DEM, GNC 
  
  
 GNA      SUBR               ...ENTRY/EXIT... 
          SX6    B0+
          SB6    9*6         INDICATE EMPTY ACCUMULATOR 
  
 GNA1     RJ     GNC         GET NEXT CHARACTER 
          NZ     B4,EXIT.    IF SEPARATOR OR TERMINATOR 
          LX4    B6 
          BX6    X6+X4
          SB6    B6-6 
          PL     B6,GNA1     IF .LE. 10 CHARACTERS ACCUMULATED
          RJ     GNC         CHECK FOR 11TH CHARACTER OR SEPARATOR
          NZ     B4,EXIT.    IF NOT .GT. 10 CHARACTERS
          ZR     X0,EXIT.    IF .GT. 10 CHARACTERS ALLOWED
          EQ     E.GT10      ** .GT. 10 CHARACTERS ** 
  
*         SKIP EXCESS CHARACTERS UNTIL SEPARATOR. 
  
 GNA2     RJ     GNC         SKIP EXCESS
          ZR     B4,GNA2     IF STILL ALPHNUMERIC 
          SA1    ERR.FLD
          SB6    -6          FLAG LENGTH OF 10
          BX6    X1          RESTORE X6 = 10 CHARACTERS OF PAC
          EQ     EXIT.       DONE...
 GNC      SPACE  4,15 
**        GNC - GET NEXT CHARACTER. 
* 
*         THE NEXT CHARACTER OF THE CONTROL STATEMENT IS
*         OBTAINED.  IF THIS CHARACTER IS A $, THE CHARACTER
*         FOLLOWING IT IS RETURNED.  A CONTINUATION LINE WILL 
*         BE OBTAINED IF NEEDED.
* 
*         ENTRY  (B3) = MODE:  -1 = NORMAL,  0 = QUOTE ($)
*                (B5) = NUMBER OF CHARACTERS REMAINING IN (X5)
*                (A5) = ADDRESS OF (X5) 
*                (X5) = CURRENT WORD OF LINE IMAGE
* 
*         EXIT   (B4) = CHARACTER TYPE -- 
*                       -1 = TERMINATOR 
*                        0 = ALPHANUMERIC OR *
*                       +1 = SEPARATOR
*                       +2 = /
*                       +3 = =
*                       +4 = -
*                       IF QUOTE MODE, ALL CHARACTERS ARE TYPE 0. 
*                (X4) = CHARACTER 1R FORMAT 
*                (X5, A5, B3, B5)  UPDATED
* 
*         USES   B - 3-5
*                A - 1-3, 5, 6
*                X - 0-5
* 
*         CALLS  DEM, SYS=
  
  
 GNC      SUBR               ...ENTRY/EXIT... 
  
*         GET NEXT CHARACTER. 
  
 GNC1     ZR     B5,GNC5     IF (X5) IS EMPTY 
          LX5    6
          MX0    -6 
          SB5    B5-B1       EXTRACT NEXT CHARACTER 
          BX4    -X0*X5 
          SB4    X4-1R$ 
          ZR     B4,GNC3     IF $ 
          ZR     B3,GNC4     IF IN QUOTE MODE 
          SB4    B0          CHECK VALUE
          ERRNZ  O.VAL       CODE ASSUMES 0 VALUE 
          MI     B3,GNC2     IF NOT LEAVING QUOTE MODE
          SB3    -B1
  
*         HERE IF NOT $ AND NOT QUOTE MODE. 
  
 GNC2     SX2    X4-1R9-1    CLASSIFY CHARACTER 
          SX3    X4-1R.-1 
          ZR     X4,E.IC     IF ** ILLEGAL CHARACTER ** (COLON) 
          MI     X2,EXIT.    IF ALPHANUMERIC, RETURN
          SB4    B1          CHECK SEPARATOR
          ERRNZ  O.SEP-1     CODE ASSUMES O.SEP=1 
          LX2    2
          PL     X3,EXIT.    IF .GT. 1R.
          SA3    GNCA 
          SB4    X2 
          LX2    X3,B4       GET CHARACTER TYPE CODE
          AX2    -4 
          SB4    X2 
          NZ     X2,EXIT.    IF SEPARATOR, RETURN 
          PL     X2,EXIT.    IF *, TREAT AS ALPHANUMERIC
          EQ     GNC1        IGNORE BLANK 
  
*         HERE IF $.
  
 GNC3     SB3    B3+B1
          LE     B3,B1,GNC1  IF NOT SECOND $ OF A PAIR IN QUOTE MODE
          SB3    B0 
  
*         HERE IF IN QUOTE ($) MODE.
  
 GNC4     SB4    O.VAL       QUOTE MODE, RETURN WITH CHARACTER TYPE = 0 
          EQ     EXIT.       DONE...
  
*         HERE IF CURRENT WORD OF LINE IMAGE IS EXAUSTED. 
  
 GNC5     SA1    GNCB 
          SA5    A5+1        GET NEXT LINE
          SB5    10 
          ZR     X1,GNC7     IF INITIAL ENTRY 
          SB4    A5-RA.CCD-7
          GT     B4,GNC6     IF END OF LINE IMAGE 
          NZ     X5,GNC1     IF NOT END OF LINE 
          MI     X5,GNC1     IF NOT END OF LINE (10 SEMICOLONS) 
  
*         HERE IF CONTINUATION LINE NEEDED. 
  
 GNC6     SA2    GNCC 
          BX5    X6          SAVE (X6)
          NZ     X2,GNC.UCP  CALL USER CONTINUATION LINE PROCESSOR
          CONTRLC  GNCB,READ
          SA1    X6 
          LX1    59-4 
          MI     X1,E.TM     IF ** TERMINATOR MISSING **
          MESSAGE RA.CCD,,RCL 
  
  
**        IF FIRST TIME FIND NEXT AVAILABLE CHARACTER ADDRESS 
*         IN CONTROL CARD TEMPLET.
  
          SA1    CAF
          NZ     X1,GNC6A    IF ADDRESS OF NEXT CHARACTER STORE IN
*                            TEMPLET RESOLVED.
          MX6    1
          SA6    A1 
          RJ     FCA         FIND NEXT AVAILABLE CHARACTER ADDRESS
*                            IN CONTROL CARD TEMPLET. 
 GNC6A    RJ     TCC         TRANSFER CONTINUATION CARD TO TEMPLET
  
*         HERE TO BLANK FILL LAST WORD OF LINE IMAGE. 
  
 GNC7     SB4    RA.CCD+7 
 GNC8     SA3    B4 
          SB4    B4-B1
          ZR     X3,GNC8
          SB4    60-6+1 
          MX6    -1 
          IX4    X3+X6
          SA2    =40404040404040404040B 
          SA1    =10H 
          BX6    -X4+X3 
          BX4    X6*X2
          LX6    X4,B4
          IX2    X4-X6
          BX6    X4+X2
          BX1    -X6*X1 
          IX6    X3+X1
          SA6    A3          BLANK FILL LAST WORD 
 GNC.RET  SPACE  4,10 
**        GNC.RET - RETURN FROM USER CONTINUATION LINE PROCESSOR. 
* 
*         ENTRY  RA.CCD TO RA.CCD+7 CONTAINS THE NEXT LINE IMAGE. 
*                THE LAST USABLE WORD IS BLANK FILLED.  UNUSED
*                WORDS ARE ZERO.
  
  
 GNC.RET  BSS 
          SX6    B1          NOT FIRST TIME THRU FLAG 
          SA6    GNCB        INDICATE NOT FIRST TIME IN 
          BX6    X5          RESTORE (X6) 
          SA5    RA.CCD      SCAN NEW LINE
          EQ     GNC1 
  
 CAF      CON    0           CHARACTER ADDRESS FLAG - ZERO INDICATES -
*                            CALL *FCA* TO FIND NEXT AVAILABLE CHARACTER
*                            ADDRESS IN CONTROL CARD TEMPLET. 
 GNC.UCP  SPACE  4,10 
**        GNC.UCP - CALL USER CONTINUATION LINE PROCESSOR.
* 
*         USER PROCESSOR MAY USE  B4  A1,2,3,5,6  X1,2,3,4,6
* 
*         REENTRY AT *GNC.RET*
  
  
 GNC.UCP  BSS 
          SB4    X2 
          JP     B4 
 GNC      SPACE  4,10 
*                  +   -   *   /   (    )   $   =   BL   ,    . 
 GNCA     VFD    4/1,4/4,4/0,4/2,4/1,4/-1,4/0,4/3,4/-0,4/1,4/-1,*P/0
 GNCB     CON    0           STATUS WORD FOR CONTRLC + FIRST TIME FLAG
 GNCC     CON    0           ADDRESS OF USER CONTINUATION LINE PROCESSOR
 PAC      SPACE  4,10 
          BASE   *
 QUAL$    IF     -DEF,QUAL$ 
          QUAL   *
 PAC      EQU    /COMCPAC/PAC 
 PAC.RET  EQU    /COMCPAC/PAC.RET 
 CFV      EQU    /COMCPAC/CFV 
 DEM      EQU    /COMCPAC/DEM 
 DEM.RET  EQU    /COMCPAC/DEM.RET 
 ERR.CNT  EQU    /COMCPAC/ERR.CNT 
 ERR.FLD  EQU    /COMCPAC/ERR.FLD 
 ERR.RET  EQU    /COMCPAC/ERR.RET 
 GNA      EQU    /COMCPAC/GNA 
 GNC      EQU    /COMCPAC/GNC 
 GNC.RET  EQU    /COMCPAC/GNC.RET 
 QUAL$    ENDIF 
  
  
 COMCPAC  ENDX
 KEYS     EJECT  4,12        CONTROL STATEMENT PARAMETER KEYWORD DEFS.
***       PARAM - DEFINE KEYWORD PARAMETER. 
* 
*         PARAMETER KEYWORDS ARE DEFINED BY MACRO CALLS, AS FOLLOWS --
* 
* KEY     PARAM  POA=XXX,MBV=YYY,SD=ZZZ,NOP=MMM,NOC=NNN,AT=AAA
* 
*         THE PARAMETERS MAY BE IN ANY ORDER.  THE ONLY REQUIRED
*         PARAMETERS ARE KEY AND POA OR MBV.  THE THREE TYPES OF
*         PARAMETER KEYWORDS ARE DESCRIBED AT *PAC*.  THE TYPES OF
*         KEYWORDS (SB,BV,MBV) WHICH MAY USE A PARTICULAR MACRO 
*         PARAMETER ARE LISTED IN PARENTHESIS AFTER THAT PARAMETER
*         BELOW.
* 
*         KEY      PARAMETER KEYWORD (REQUIRED ALWAYS)
*                FROM ONE TO SEVEN ALPHANUMERIC CHARACTERS.  *KEY*
*                WILL BE THE ADDRESS OF THE PARAMETER TABLE ENTRY.
* 
*         POA=XXX  PARAMETER OPTION AREA (REQUIRED FOR SB OR BV)
*         XXX = ADDRESS OF A PARAMETER AREA WITH A LENGTH OF NNN*MMM
*                OR - THE ADDRESS OF A USER PROCESSOR TO BE CALLED
*                IF THIS KEYWORD IS ENCOUNTERED.  IF THIS FIELD IS .GT. 
*                ZERO *PAC* WILL EXIT WITH THIS FIELD CONTAINING THE
*                LWA+1 USED WITHIN THE PARAMETER AREA.  IN THIS WAY IT
*                IS POSSIBLE TO DETERMINE THE NUMBER OF OCCURENCES OF 
*                THIS KEYWORD ON THE CONTROL STATEMENT. 
*  NOTE:         RESET THE ADDRESS OF THE PARAMETER AREA IF PAC IS
*                CALLED MORE THAN ONCE WITH THE SAME PARAMETER TABLE. 
* 
*         MBV=YYY  MULTIPLE BINARY VALUE (REQUIRED FOR MBV) 
*         YYY = ADDRESS OF MULTIPLE BINARY VALUE OPTION TABLE.
*                SEE *MPVOP* MACRO BELOW.  THIS PARAMETER IS
*                REQUIRED FOR ALL MBV KEYWORDS. 
* 
*         SD=ZZZ   SECOND DEFAULT (SV,BV) 
*         ZZZ = ADDRESS OF A LIST OF SECOND DEFAULT VALUES.  THE LENGTH 
*                OF THE LIST MUST BE MMM (SEE NOC BELOW).  IF OMITTED 
*                THERE  WILL BE NO SECOND DEFAULT LIST AND THE KEYWORD
*                MUST BE EQUIVALENCED.  IF ZZZ IS NEGATIVE, THE KEYWORD 
*                IS A BINARY VALUE PARAMETER.  THE SECOND DEFAULT LIST
*                MUST BE IN THE DESIRED FORMAT BECAUSE *PAC* WILL NOT 
*                CONVERT OR ATTEMPT TO CHECK FOR PARAMETER VALIDITY.
* 
*         NOP=MMM  NUMBER OF OPTIONS PER OCCURENCE (SV,MBV) 
*         MMM = MAXIMUM NUMBER OF OPTION SUBFIELDS FOR EACH OCCURENCE.
*                THE MINIMUM ALLOWED IS 1.  THE MAXIMUM ALLOWED IS 19 
*                UNLESS ATT=STRING.  IF AT=STRING, MMM IS THE MAXIMUM 
*                NUMBER OF CHARACTERS (NOT WORDS) IN THE STRING.  IF
*                OMITTED NOP=1 IS ASSUMED.
* 
*         NOC=NNN  NUMBER OF OCCURENCES (SV)
*         NNN = MAXIMUM NUMBER OF OCCURENCES OF THE KEYWORD. IF OMITTED 
*                NOC=1 WILL BE ASSUMED.  EACH OCCURENCE WILL BE STORED
*                STARTING AT XXX+(N-1)*MMM WHERE N IS THE NUMBER OF 
*                THE OCCURENCE. 
*  NOTE:         RESET THE OCCURENCE COUNT IF PAC IS CALLED 
*                MORE THAN ONCE WITH THE SAME PARAMETER TABLE.
* 
*         AT=AAA   ATTRIBUTES (SV)
*         AAA = LIST OF ATTRIBUTES ASSOCIATED WITH EACH OPTION
*                SUBFIELD.  THE NTH ENTRY IS THE ATTRIBUTE FOR THE NTH
*                SUBFIELD.  THE MAXIMUM NUMBER OF ATTRIBUTES IS MMM.
*                IF AN ATTRIBUTE IS OMITTED THE LAST MENTIONED VALUE
*                (FOR THIS CALL) IS ASSUMED.  IF AT IS OMITTED AT=0 
*                IS ASSUMED.
*                   ATTRIBUTE      MEANING
*                       0          10 CHARACTER FIELD, 0L FORMAT. 
*                       1          10 CHARACTER FIELD, 0R FORMAT. 
*                       2          CHECK FOR FILE NAME VALIDITY.
*                       3          CHECK AND CONVERT NUMERIC ARGUMENT 
*                                  (DECIMAL ASSUMED). 
*                       4          CHECK AND CONVERT NUMERIC ARGUMENT 
*                                  (OCTAL ASSUMED). 
*         AAA = *STRING* (OR ANY TRUNCATION DOWN TO *S*) IS A SPECIAL 
*                ATTRIBUTE WHICH ALLOWS A STRING OF UP TO MMM 
*                CHARACTERS.  THE STRING WILL BE STORED LEFT JUSTIFIED
*                WITH ZERO FILL.  MMM MAY BE AS LARGE AS DESIRED. 
* 
*         EACH ENTRY IN THE PARAMETER TABLE WILL HAVE THE FOLLOWING FORM
**T A  KEY       42/0L_KEY,18/POA 
*   IF (AT.NE.*STRING*) --
* 
**T B            20/(MBV OR SD), 20/NOC, 20/NOP 
**T C            3/0,57/(3 BITS PER ATTRIBUTE, LEFT JUSTIFIED)
*   IF (AT.EQ.*STRING*) --
**T B            20/SD, 20/NOC, 20/(NUMBER OF WORDS IN NOP CHARACTERS)
**T C            60/-(NUMBER OF BITS IN LAST WORD OF NOP CHARACTERS)
  
  
          PURGMAC PARAM 
  
          MACROE PARAM,KEY,POA,NOC,NOP,SD,AT,MBV
*         WORD A. 
* 
 KEY      VFD    42/0L_KEY,18/POA 
          IFC    EQ,\_MBV_\\,3
          IFC    EQ,\_POA_\\,1
          ERR    PARAMETER OPTION AREA (POA) MUST BE DEFINED
          SKIP   2
          IFC    NE,\_POA_SD_AT_\\,1
          ERR    ONLY NOP OR NOC MAY OCCUR WITH MBV 
 '?PAC#02 SET    NOC 1
 '?PAC#03 SET    NOP 1
 '?PAC#04 MICRO  1,,\_SD_MBV_\
          IF     DEF,SD,3 
          IFMI   SD,2 
          ERRNZ  '?PAC#02-1  BINARY VALUE PARAMETER MAY ONLY OCCUR ONCE 
          ERRNZ  '?PAC#03-1  BINARY VALUE PARAMETER MAY ONLY OCCUR ONCE 
 '?PAC#05 MICRO  1,,\_AT_\
 '?PAC#05 MICCNT '?PAC#05 
 '?PAC#05 MAX    '?PAC#05,1 
 '?PAC#05 MICRO  1,'?PAC#05,\STRING\
          IFC    EQ,\"'?PAC#05"\_AT_\,6 
 '?PAC#01 SET    '?PAC#03+9 
 '?PAC#01 SET    '?PAC#01/10
 '?PAC#06 SET    '?PAC#03+10-'?PAC#01*10
* 
*         WORD B (AT.EQ.*STRING*).  20/SD,20/NOC,20/NOWDS 
* 
 +        VFD    20/"'?PAC#04",20/'?PAC#02,20/'?PAC#01
* 
*         WORD C (STRING).  60/-(BITS IN LAST WORD) 
* 
 +        VFD    60/-6*'?PAC#06 
          SKIP   8
* 
*         WORD B (AT.NE.*STRING*). 20/(MBV OR SD), 20/NOC, 20/NOP 
* 
 +        VFD    20/"'?PAC#04",20/'?PAC#02,20/'?PAC#03
* 
*         WORD C (ATTRIBUTES). 3/0,57/(3 BITS PER ATTRIBUTE)
* 
 +        VFD    3/0
 '?PAC#06 SET    0
          ECHO   2,A=(AT) 
 '?PAC#06 SET    A '?PAC#06 
          VFD    3/A
          IFNE   *P,60,1
          VFD    *P/0 
 PARAM    ENDM
 MBVOP    SPACE  4,10 
***       MBVOP - MULTIPLE BINARY VALUE OPTIONS.
* 
*         THIS MACRO IS USED TO DEFINE THE SUBKEYWORD TABLE USED
*         FOR MULTIPLE BINARY VALUE OPTION PROCESSING.
* 
* KOP     MBVOP  KOA,SD,IV
* 
*         KOP    SUBKEYWORD NAME (REQUIRED) 
*                ONE TO SEVEN ALPHANUMERIC CHARACTERS.  *KOP* MAY BE
*                THE SAME CHARACTERS AS ANY PARAMETER KEYWORD (*KEY*).
*         KOA    SUBKEYWORD OPTION ADDRESS (REQUIRED) 
*                ADDRESS OF A WORD TO STORE BINARY VALUE FOR THIS 
*                OPTION.  IF THE OPTION IS *ON* THEN 1S59 IS STORED.
*                IF IT IS *OFF*, A 0 IS STORED. 
*         SD     SECOND DEFAULT 
*                *ON* OR *OFF*.  VALUE TO USE FOR THIS SUBKEYWORD 
*                WHEN THE MBV PARAMETER OCCURES WITHOUT MINUS OR
*                EQUIVALENCE.  DEFAULT SD=OFF.
*         IV     INITIAL VALUE
*                *ON* OR *OFF*. VALUE USED WHEN AN *=* IS ENCOUNTERED 
*                AFTER THE MBV PARAMETER.  DEFAULT IV=OFF.
  
  
          PURGMAC MBVOP 
  
          MACRO  MBVOP,KOP,KOA,SD,IV
 '?PAC#01 SET    0
 '?PAC#02 SET    0
          IFC    EQ,/SD/ON/,1 
 '?PAC#01 SET    1
          IFC    EQ,/IV/ON/,1 
 '?PAC#02 SET    1
          VFD    42/0L_KOP,18/KOA 
          VFD    1/'?PAC#01,1/'?PAC#02,58/0 
 MBVOP    ENDM
