*DECK FMCRACK 
      PROC  FM$CRAK;         # PARSE INPUT DIRECTIVES                  #
      BEGIN 
#CALL FMCOM                                                            #
*CALL FMCOM 
CONTROL EJECT;
 #
* *   FMCRACK - READ AND CRACK PROGRAM CALL AND CONTROL CARDS 
* *   M.T. KAUFMAN
* 1DC FMCRACK 
* 
* DC  FUNCTION
* 
*     CRACKS THE FORM CONTROL CARD.  OPENS THE I= FILE AND READS THE
*     PARAMETER CARDS.  SETS UP INTERNAL TABLES AND OPENS ALL FILES.
* 
*     FM$CRAK IS TABLE DRIVEN, WITH A SEPARATE KEYWORD TABLE FOR EACH 
*     CARD TYPE.  KEYWORD SEMANTICS ARE ENFORCED BY CODE AT THE OUTER 
*     LEVEL.
* 
* DC  ENTRY CONDITIONS
* 
*     THE PROGRAM CALL CARD IS CRACKED DIRECTLY FROM RA+70. 
* 
* DC  EXIT CONDITIONS 
* 
*     NONE. 
* 
* DC  ERROR CONDITIONS
* 
*     PARAMETER ERRORS CAUSE MESSAGES TO BE PRINTED ON THE OUTPUT FILE. 
*     THE PROCESS ATTEMPTS TO CATCH AS MANY ERRORS AS POSSIBLE.  IF 
*     ERRORS ARE FOUND, THE PROGRAM WILL BE TERMINATED UPON FINISHING 
*     READING THE PARAMETER CARDS.
* 
* DC  INTERNAL PROCEDURES 
* 
*     BUILD$FDB   - BUILD A NEW FILE DESCRIPTION BLOCK
*     FIND$FDB    - FIND THE FDB CORRESPONDING TO A -FILENAME-
*     GET$CON$QAL - PICK UP CON, REF, OR QAL STRING 
*     GETCARD     - READ NEXT INPUT PARAMETER CARD
*     GETKEY      - PARSE A KEYWORD FROM A PARAMETER CARD 
*     GETLFN      - PARSE A FILENAME FROM A PARAMETER CARD
*     GETPARM     - PICK UP A PARAMETER VALUE FIELD 
*     PRE$PARSE   - PREPARSE SELECTED DIRECTIVES FOR FASTER EXECUTION 
*     SELECT      - FIND A KEYWORD IN A LIST OF KEYWORDS
*     CCRACK      - READ AND CRACK THE PROGRAM CALL CARD
* 
 #
CONTROL EJECT;
  
#  LOCAL DEFINITIONS                                                   #
  
        XREF
          BEGIN 
            PROC  FM$ERR; 
                                  # UTILITY PROCEDURES                 #
            FUNC  FM$THIS S:CH; 
            FUNC  FM$TNBL S:CH; 
            FUNC  FM$NEXT S:CH; 
            FUNC  FM$NNBL S:CH; 
            FUNC  FM$CV5D  C(5);
            FUNC  FM$MIN I; 
            FUNC  FM$MAX I; 
            FUNC  FM$MOD I; 
            FUNC  FM$GTNM I;
            FUNC  IFETCH I;       # FORTRAN INTERFACE TO CRM           #
            PROC  STOREF; 
            PROC  OPENM;
            PROC  CLOSEM; 
            PROC  GET;
            PROC  PUT;
            PROC  XFILE;           # 8-BIT ROUTINES                    #
            FUNC  XREAD  R; 
            FUNC  XWRITE R; 
            PROC  FM$SKPP;        # OTHERS                             #
            PROC  FM$SKPR;
            PROC  FM$SKPS;
            PROC  FM$ABRT;
            PROC  FM$ERXT;
            ITEM  FM$PKEY  U; 
            FUNC  CMM$ALF  U; 
            PROC  CMM$CSF;
            PROC  CMM$GLF;
            FUNC  FDL$LDC  I; 
            FUNC  FDL$ULC  I; 
  
            ARRAY  FM$LIST;;
            ARRAY  FM$PASS;;
  
            ITEM  FM$MAXU  U;   # MAXIMUM NUMBER OF USER ENTRIES       #
            ARRAY FM$UENT [0:50] S(1);  # USER ENTRY NAME LIST         #
              ITEM  USRENTRY  C(0,0,7); 
            PROC  FM$LUSR;      # LOAD USR ROUTINES                    #
  
          END 
  
  
        ITEM
          BTEMP     B,
          C         S:CH, 
          ERROR$COUNT  I = 0, 
          FDBX      U,
          FDBY      U,
          INSTRING  B,
          KEY       I,
          KEYSIZE   U,
          KEYVAL    U,
          KEYWORD   C(7), 
          PTR       U,
          CARDPTR   U,
          OWNCOUNT  I = 0,   # NUMBER OF USER EXITS                    #
          BGDPAR    C(4) = "CXBZ",
          SIGN      B;
  
        XREF ARRAY  LOF$RM  S(1); 
          ITEM  LOF$PTR  U(0,42,18);
  
        XREF ARRAY  FM$FDB  S(1); 
          ITEM  FDB$PTR  U(0);
  
        DEF  NEW$FILE  # TRUE  #; 
        DEF  OLD$FILE  # FALSE #; 
  
        ARRAY LIST$HEAD [0:8] S(1); 
          ITEM LIST$TEXT C(0,0,10) = [
            "1 FORM DIR", "ECTIVES   ", "          ", 
            "          ", "          ", "          ", 
            "          ", "FORM 1.2  ", "          "];
  
        STATUS  TYPS         # PARAMETER TYPES                         #
          NONE,             # NONE  (USED FOR NOSEC)                   #
          NUM,              # NUMERIC                                  #
          SNUM,             # SIGNED NUMERIC                           #
          EPT,              # ENTRY POINT OR LFN (ZERO FILL)           #
          EPTNUM,           # ENTRY POINT OR ORDINAL (PCA, CPA)        #
          CHR,              # CHARACTERS  (BLANK FILL)                 #
          ITM,              # I-T-M  (NBR)                             #
          SITM,             # SIGNED I-T-M  (KEY)                      #
          STRING,           # LITERAL STRING (TTL)                     #
          ERROR;            # UNRECOGNIZED KEYWORD                     #
        ITEM  KEYTYPE  S:TYPS;
  
        ARRAY  CC$PARS [0:7] S(1);  # CONTROL CARD PARAMETERS          #
          ITEM
            CC$KEY  C(0,0,7) =
              ["I=     ", "L=     ", "OWN=   ", "INP=   ", "OUT=   ", 
               "I      ", "L      ", "       "],
            CC$TYP  S:TYPS (0,42,18) =
              [S"EPT",    S"EPT",    S"EPT",    S"EPT",    S"EPT",
               S"NONE",   S"NONE",   S"ERROR" ];
  
        ARRAY  INP$PARS [0:14] S(1);  #  INP STATEMENT                 #
          ITEM
            INP$KEY  C(0,0,7) = 
              ["MAX=   ", "POS=   ", "REW=   ", "HRL=   ", "DCA=   ", 
               "LX=    ", "DX=    ", "RFM=   ", "BLK=   ", "LRL=   ", 
               "IRL=   ", "COD=   ", "CX=    ", "EX=    ", "       "],
            INP$TYP  S:TYPS (0,42,18) = 
              [S"NUM",    S"SNUM",   S"CHR",     S"EPT",   S"EPTNUM", 
               S"EPT",    S"EPT",    S"CHR",     S"NUM",   S"NUM",
               S"NUM",    S"CHR",    S"EPT",     S"EPT",   S"ERROR" ];
  
        ARRAY  OUT$PARS  [0:17] S(1); 
          ITEM
            OUT$KEYS C(0,0,7) = 
              ["MAX=   ", "NOSEC  ", "REW=   ", "HRL=   ", "CPA=   ", 
               "LX=    ", "RX=    ", "RFM=   ", "BLK=   ", "LRL=   ", 
               "IRL=   ", "COD=   ", "CX=    ", "EX=    ", "DCT=   ", 
               "KEY=   ", "BGD=   ", "       "],
            OUT$TYP  S:TYPS (0,42,18) = 
              [S"NUM",    S"NONE",   S"CHR",    S"EPT",    S"EPTNUM", 
               S"EPT",    S"EPT",    S"CHR",    S"NUM",    S"NUM",
               S"NUM",    S"CHR",    S"EPT",    S"EPT",    S"EPT",
               S"SITM",   S"CHR",    S"ERROR" ];
  
        ARRAY  SEQ$PARS [0:3] S(1); 
          ITEM
            SEQ$KEY  C(0,0,7) = 
              ["NBR=   ", "BEG=   ", "ADD=   ", "       "], 
            SEQ$TYP  S:TYPS (0,42,18) = 
              [S"ITM",    S"NUM",    S"NUM",    S"ERROR" ]; 
  
        ARRAY  PAG$PARS [0:4] S(1); 
          ITEM
            PAG$KEY  C(0,0,7) = 
              ["FMT=   ", "PGL=   ", "TOP=   ", "TTL=   ", "       "],
            PAG$TYP  S:TYPS (0,42,18) = 
              [S"CHR",    S"NUM",    S"NUM",    S"STRING", S"ERROR" ];
  
        ARRAY XEQ$PARS [0:3] S(1);
          ITEM
            XEQ$KEY  C(0,0,7) = 
              ["IX=    ", "FEX=   ", "FIN    ", "       "], 
            XEQ$TYP  S:TYPS (0,42,18) = 
              [S"EPT",    S"EPT",    S"NONE",   S"ERROR" ]; 
  
        BASED ARRAY  KEYWORDS [0:17] S(1);
          ITEM
            KEYSTRING  C(0,0,7),
            KEYTYPE$   S:TYPS (0,42,18);
  
        ARRAY  FILEPARM S(6); 
          ITEM
            PARM$PROTO  C(0,0,55) = 
        ["(FT=T,USE=*,CODE=*,BLKSIZE=*****,LRECL=*****,RECFM=***)"],
            FILE$USE    C(1, 0,1),
            FILE$CODE   C(1,42,1),
            FILE$BLKSZ  C(2,42,5),
            FILE$RECL   C(3,54,5),
            FILE$RECFM  C(5, 6,3);
  
        ARRAY  TITLCONV S(1); 
          ITEM
            PARM$CONV   C(0, 0,8) = ["(X*****)"], 
            TITL$COUNT  C(0,12,5);
        ITEM  KEYHIT  B;
  
        ARRAY  LOADGROUP; 
          ITEM
            GROUP$NAME  C(0, 0, 4) = [ "BIT8" ],
            GROUP$FILL  U(0,24,36) = [ 0 ]; 
  
        ARRAY  LXFILE;
          ITEM
            XFILE$NAME  C(0, 0, 5) = [ "XFILE" ], 
            XFILE$FILL  U(0,30,30) = [ 0 ]; 
  
        ARRAY  TESTT; 
          ITEM
            TESTT$NAME  C(0, 0, 7) = [ "T8.TSTT" ], 
            TESTT$FILL  U(0,42,18) = [ 0 ]; 
  
        ARRAY  TEST6 [1:3] S(1);
          ITEM
            TEST6$NAME  C(0, 0, 7) =
              [ "T8.TST6", "T8.CN6T" ], 
            TEST6$NAM1  C(2, 0, 6) = [ "XWRITE" ],
            TEST6$FIL1  U(2,36, 6) = [ 0 ], 
            TEST6$FILL  U(0,42,18) = [ 0,0,0 ]; 
CONTROL EJECT;
#               ERROR MESSAGES                                         #
  
      STATUS  ERR 
        GETL$1,  GETL$2,  GETL$3,  GETL$4,
        GET$1,   GET$2,   GET$3,   GET$4,   GET$5,   GET$6,   GET$7,
        OWN$1,
        CCR$1,   CCR$2,   CCR$3,   CCR$4,   CCR$5,   CCR$6,   CCR$7,
        ICN$1,   ICN$2, 
        INP$1,   INP$2,   INP$3,   INP$4,   INP$5,   INP$6,   INP$7,
        INP$8,   INP$9,   INP$10,  INP$11,  INP$12,  INP$13,  INP$14, 
        INP$15,  INP$16,  INP$17,  INP$18,  INP$19,  INP$20,  INP$21, 
        INP$22,  INP$23,  INP$24, 
        OUT$1,   OUT$2,   OUT$3,   OUT$4,   OUT$5,   OUT$6,   OUT$7,
        OUT$8,   OUT$9,   OUT$10,  OUT$11,  OUT$12,  OUT$13,  OUT$14, 
        OUT$15,  OUT$16,  OUT$17,  OUT$18,  OUT$19,  OUT$20,  OUT$21, 
        OUT$22,  OUT$23,  OUT$24,  OUT$25,  OUT$26,  OUT$27,
        SEQ$1,   SEQ$2,   SEQ$3,   SEQ$4, 
        PAG$1,   PAG$2,   PAG$3,   PAG$4,   PAG$5,   PAG$6, 
        XEQ$1,   XEQ$2,   XEQ$3,
        CON$1,
        QAL$1,
        QAL$2,   QAL$3,   QAL$4,   QAL$5,   QAL$6,   QAL$7,   QAL$8,
        QAL$9,   QAL$10,  QAL$11,  QAL$12,  QAL$13,  QAL$14,  QAL$15, 
        REF$1,
        FMC$1,   FMC$2, 
        VAL$1,   VAL$2,   VAL$3,   VAL$4,   VAL$5,   VAL$6,   VAL$7,
        VAL$8,   VAL$9,   VAL$10, 
        LDC$1,
        ULC$1,
        LAST$ERROR; 
  
  
      ARRAY  ERR$MSG [0:300] S(1);
        ITEM  ERR$MSG$TEXT  C(0,0,10) = [ 
  
#  GETL$1        #
      "MISSING FI","LENAME   :",
#  GETL$2        #
      "DUPLICATE ","FILENAME :",
#  GETL$3        #
      "FILE NOT D","EFINED   :",
#  GETL$4        #
      "INVALID FI","LENAME   :",
#  GET$1         #
      "NUMERIC FI","ELD EXPECT","ED       :", 
#  GET$2         #
      "ENTRY NAME"," EXPECTED:",
#  GET$3         #
      "KEYTYPE MU","ST BE *I,F",",X*      :", 
#  GET$4         #
      "KEY LOCATI","ON MISSING","         :", 
#  GET$5         #
      "STRING TER","MINATOR MI","SSING    :", 
#  GET$6         #
      "STRING DEL","IMITER MIS","SING     :", 
#  GET$7         #
      "UNRECOGNIZ","ED PARAMET","ER       :", 
#  OWN$1         #
      "TOO MANY O","WNCODE ENT","RIES     :", 
#  CCR$1         #
      "I= ALREADY"," SPECIFIED","         :", 
#  CCR$2         #
      "L= ALREADY"," SPECIFIED","         :", 
#  CCR$3         #
      "OWN= ALREA","DY SPECIFI","ED       :", 
#  CCR$4         #
      "FILE ALREA","DY SPECIFI","ED       :", 
#  CCR$5         #
      "UNRECOGNIZ","ED OPTION:",
#  CCR$6         #
      "CANT SPECI","FY INP= OR"," OUT= WITH"," I=      :",
#  CCR$7        # 
      "ILLEGAL SE","PARATOR ON"," CONTROL C","ARD      :",
#  ICN$1         #
      "INTERNAL E","RROR - QQT","OK ENTRY B","AD       :",
#  ICN$2         #
      "INTERNAL E","RROR - BAD","ARG FOR PR","E$PARSE  :",
#  INP$1         #
      "ONLY ONE I","NPUT FILE ","ALLOWED  :", 
#  INP$2         #
      "MAX OUT OF"," RANGE   :",
#  INP$3         #
      "MAX SPECIF","IED TWICE:",
#  INP$4         #
      "POS OUT OF"," RANGE   :",
#  INP$5         #
      "POS SPECIF","IED TWICE:",
#  INP$6         #
      "INVALID RE","W OPTION :",
#  INP$7         #
      "REW SPECIF","IED TWICE:",
#  INP$8         #
      "HRL SPECIF","IED TWICE:",
#  INP$9         #
      "DCA SPECIF","IED TWICE:",
#  INP$10        #
      "LX SPECIFI","ED TWICE :",
#  INP$11        #
      "DX SPECIFI","ED TWICE :",
#  INP$12        #
      "INVALID RF","M OPTION :",
#  INP$13        #
      "REM SPECIF","IED TWICE:",
#  INP$14        #
      "BLK OUT OF"," RANGE   :",
#  INP$15        #
      "BLK SPECIF","IED TWICE:",
#  INP$16        #
      "LRL SPECIF","IED TWICE:",
#  INP$17        #
      "IRL OUT OF"," RANGE   :",
#  INP$18        #
      "IRL SPECIF","IED TWICE:",
#  INP$19        #
      "INVALID CO","D OPTION :",
#  INP$20        #
      "COD SPECIF","IED TWICE:",
#  INP$21        #
      "CX SPECIFI","ED TWICE :",
#  INP$22        #
      "EX SPECIFI","ED TWICE :",
#  INP$23        #
      "PARAMETER ","MISSING  :",
#  INP$24        #
      "LRL OUT OF"," RANGE   :",
#  OUT$1         #
      "TOO MANY O","UTPUT FILE","S        :", 
#  OUT$2         #
      "MAX OUT OF"," RANGE   :",
#  OUT$3         #
      "MAX SPECIF","IED TWICE:",
#  OUT$4         #
      "NOSEC SPEC","IFIED TWIC","E        :", 
#  OUT$5         #
      "INVALID RE","W OPTION :",
#  OUT$6         #
      "REW SPECIF","IED TWICE:",
#  OUT$7         #
      "HRL SPECIF","IED TWICE:",
#  OUT$8         #
      "CPA SPECIF","IED TWICE:",
#  OUT$9         #
      "LX SPECIFI","ED TWICE :",
#  OUT$10        #
      "RX SPECIFI","ED TWICE :",
#  OUT$11        #
      "INVALID RF","M OPTION :",
#  OUT$12        #
      "RFM SPECIF","IED TWICE:",
#  OUT$13        #
      "BLK OUT OF"," RANGE   :",
#  OUT$14        #
      "BLK SPECIF","IED TWICE:",
#  OUT$15        #
      "LRL OUT OF"," RANGE   :",
#  OUT$16        #
      "LRL SPECIF","IED TWICE:",
#  OUT$17        #
      "IRL OUT OF"," RANGE   :",
#  OUT$18        #
      "IRL SPECIF","IED TWICE:",
#  OUT$19        #
      "INVALID CO","D OPTION :",
#  OUT$20        #
      "COD SPECIF","IED TWICE:",
#  OUT$21        #
      "CX SPECIFI","ED TWICE :",
#  OUT$22        #
      "EX SPECIFI","ED TWICE :",
#  OUT$23        #
      "DCT SPECIF","IED TWICE:",
#  OUT$24        #
      "KEY SPECIF","IED TWICE:",
#  OUT$25        #
      "INVALID BG","D OPTION :",
#  OUT$26        #
      "BGD SPECIF","IED TWICE:",
#  OUT$27        #
      "PARAMETER ","MISSING  :",
#  SEQ$1         #
      "NBR SPECIF","IED TWICE:",
#  SEQ$2         #
      "BEG SPECIF","IED TWICE:",
#  SEQ$3         #
      "ADD SPECIF","IED TWICE:",
#  SEQ$4         #
      "PARAMETER ","MISSING  :",
#  PAG$1         #
      "INVALID FM","T OPTION :",
#  PAG$2         #
      "FMT SPECIF","IED TWICE:",
#  PAG$3         #
      "PGL SPECIF","IED TWICE:",
#  PAG$4         #
      "TOP SPECIF","IED TWICE:",
#  PAG$5         #
      "TTL SPECIF","IED TWICE:",
#  PAG$6         #
      "PARAMETER ","MISSING  :",
#  XEQ$1         #
      "IX SPECIFI","ED TWICE :",
#  XEQ$2         #
      "FEX SPECIF","IED TWICE:",
#  XEQ$3         #
      "PARAMETER ","MISSING  :",
#  CON$1         #
      "CON SPECIF","IED TWICE:",
#  QAL$1         #
      "QAL SPECIF","IED TWICE:",
#  QAL$2         #
      "PARENTHESI","S MISPLACE","D        :", 
#  QAL$3         #
      "UNRECOGNIZ","ED DATA-TY","PE       :", 
#  QAL$4         #
      "AND,OR,NOT"," MISPLACED","         :", 
#  QAL$5         #
      "STRING LIT","ERAL NOT A","LLOWED LEF","T OF RELAT","ION      :", 
#  QAL$6         #
      "INVALID -T","- TYPE IN ","ITM      :", 
#  QAL$7         #
      "BIT NUMBER"," > 6     :",
#  QAL$8         #
      "BIT SPECIF","IER NON-NU","MERIC    :", 
#  QAL$9         #
      "BIT POSITI","ON ONLY VA","LID WITH T","YPE -B-  :",
#  QAL$10        #
      "MISSING AN","D,OR,NOT C","ONNECTOR :", 
#  QAL$11        #
      "INVALID -M","- VALUE FO","R DATA TYP","E        :",
#  QAL$12        #
      "DIGIT DOES"," NOT FOLLO","W +/-    :", 
#  QAL$13        #
      "MISSING -N","- SPECIFIE","R IN OLN :", 
#  QAL$14        #
      "UNRECOGNIZ","ED OPERATI","ON       :", 
#  QAL$15        #
      "+ITM AND -","ITM ILLEGA","L IN SELEC","TOR EXP. :",
#  REF$1         #
      "REF SPECIF","IED TWICE:",
#  FMC$1         #
      "UNRECOGNIZ","ED DIRECTI","VE       :", 
#  FMC$2         #
      "MISSING TE","RMINATOR :",
#  VAL$1         #
      "RFM NOT SP","ECIFIED  :",
#  VAL$2         #
      "BLK NOT SP","ECIFIED  :",
#  VAL$3         #
      "ERROR WRIT","ING TITLE:",
#  VAL$4         #
      "IBM FILE O","R PAG INVA","LID IF FT ","NOT SQ   :",
#  VAL$5         #
      "NO SEQ FOR","MAT SPECIF","IED      :", 
#  VAL$6         #
      "NO INPUT F","ILE SPECIF","IED      :", 
#  VAL$7         #
      "NO OUTPUT ","FILE SPECI","FIED     :", 
#  VAL$8         #
      "CANT DUMP ","TO IBM FOR","MAT      :", 
#  VAL$9         #
      "ZERO MRL/F","L ILLEGAL:",
#  VAL$10        #
      "CANT OPEN ","FILE; POSS","IBLE CRM E","RROR.    :",
#  LDC$1         #
      "CANT LOAD ","CAPSULE  :",
#  ULC$1         #
      "CANT UNLOA","D CAPSULE:",
  
#  LAST$MSG      #
      "******** :" ]; 
CONTROL EJECT;
      PROC  ERROR (TYPE);    # ERROR HANDLER FOR FMCRACK               #
        ITEM  TYPE  S:ERR;
      BEGIN 
        ERROR$COUNT = ERROR$COUNT + 1;
        FM$ERR (CARDPTR, (RESIDUAL(CARDPTR)-RESIDUAL(PTR))/6, 
                ERR$MSG, TYPE,
                FALSE);      # NOT FATAL                               #
        ADDRESS(CARDPTR) = 0;  # DONT PRINT CARD IMAGE TWICE           #
      END; # ERROR #
CONTROL EJECT;
      PROC FTLERROR (TYPE);     # FATAL ERROR HANDLER                  #
        ITEM  TYPE  S:ERR;
      BEGIN 
        FM$ERR (0,-1,ERR$MSG,TYPE,FALSE); # NON-FATAL TO SKIP FEX      #
        FM$ABRT; # BLOW OFF THE RUN                                    #
      END; #  FTLERROR  # 
CONTROL EJECT;
      FUNC PRE$PARSE(DIRTYPE) U;  # PREPARSE SELECTED DIRECTIVES #
      ITEM
        DIRTYPE  C(7);
  
      BEGIN 
        ARRAY QTOKENS [0:66] S(1);
          ITEM
            QQTOK   U(0,0,18),
            QQCOND  U(0,18,18), 
            QQPTR   U(0,36,24); 
  
        ARRAY PARSSTACK [0:30] S(1);
          ITEM
            STACK  U; 
  
#     VALID CDC -T- TYPES: B D E I N S U X Z                         #
      ITEM QAL$TYPES U = O" 13041 02450 00000 00000 ";
  
      ITEM
        PARCOUNT     U, 
        INDEX        U, 
        CHR          S:CH,
        CHR1         S:CH,
        CHR2         S:CH,
        QALSTRNGPTR  U, 
        QALCODEPTR   U, 
        TCOND        S:CONDITION, 
        QERR         B, 
        LOCTEXT      C(240),
        QTEXTPTR     U, 
        OLN          U, 
        OLN$USED     I, 
        I            I, 
        J            I, 
        K            U; 
  
  
      XREF  PROC     FM$GTST; 
CONTROL EJECT;
      PROC GETITM(REL,I,W,T,M,XCODES);  # GET AN ITM SPECIFICATION #
      ITEM
        REL     I,
        I       I,
        W       I,
        T       I,
        M       I;
      ARRAY XCODES S(2);  # ENTRY FROM REF$CODES OR QAL$CODES # 
        ITEM
          XREL     U(0,0,3),
          XT       U(0,3,6),
          XW       U(0,9,6),
          XSTRING  U(0,15,9), 
          XI       U(0,24,18),      # XI[0] = 1 IF SEARCH DISC.        #
          XM       U(0,42,18),      # XM[0] = LOC(X$TEXT)              #
          XIREL    U(1,0,3),
          XISTRING U(1,3,8),
          XIT$M2   U(1,11,8), 
          XILR$RT  U(1,19,3), 
          XIN      U(1,22,8), 
          XMREL    U(1,30,3), 
          XMSTRING U(1,33,8), 
          XMT$M2   U(1,41,8), 
          XMLR$RT  U(1,49,3), 
          XMN      U(1,52,8); 
  
      BEGIN 
        ITEM
          SAVEPTR I;
  
  
        REL = QAL$REL"PLUS";
        IF CHR EQ CH"MINUS" OR CHR EQ CH"PLUS" THEN 
          BEGIN 
            IF CHR EQ CH"MINUS" THEN
              REL = QAL$REL"MINUS"; 
            CHR = NNBL(PTR);
            IF NOT NUMERIC(CHR) THEN
              BEGIN 
                ERROR(ERR"QAL$12"); 
                QERR = TRUE;
                RETURN; 
              END;
          END 
        ELSE
            REL = QAL$REL"ABS"; 
  
        I = ALLONES;
        IF NUMERIC(CHR)  THEN 
          BEGIN 
            I = GETNUM(PTR);
            CHR = TNBL(PTR);
          END;
  
        W = ALLONES;
        IF CHR EQ CH"SLASH" THEN
          BEGIN 
            CHR = NNBL(PTR);
            IF NUMERIC(CHR) THEN
              BEGIN 
                W = GETNUM(PTR);
                IF W GR 6 OR W LS 1 THEN
                  BEGIN 
                    ERROR(ERR"QAL$7");
                    QERR = TRUE;
                    RETURN; 
                  END;
                CHR = TNBL(PTR);
              END 
            ELSE
              BEGIN 
                ERROR(ERR"QAL$8");
                QERR = TRUE;
                RETURN; 
              END;
          END;
  
        IF CHR EQ CH"DOLLAR" OR CHR EQ CH"STAR" THEN
          BEGIN 
            GETSTRING(PTR); 
            CHR = TNBL(PTR);
            IF NUMERIC(CHR) OR CHR EQ CH"PLUS" OR CHR EQ CH"MINUS" THEN 
              BEGIN  #  OLN FOR I # 
                XIREL[INDEX] = REL; 
                REL = QAL$REL"ABS"; 
                XISTRING[INDEX] = QTEXTPTR; 
                C<QTEXTPTR,T$M2>LOCTEXT = C<0,T$M2>T$STRING;
                XIT$M2[INDEX] = T$M2; 
                QTEXTPTR = QTEXTPTR + T$M2; 
                XSTRING[INDEX] = 261; # FLAG OLN FOR I #
                CASE (CHR EQ CH"MINUS") 
                  XILR$RT[INDEX] = LEFT$RIGHT"RIGHT"; 
                  CHR = NNBL(PTR);
                ORCASE (CHR EQ CH"PLUS")
                  XILR$RT[INDEX] = LEFT$RIGHT"LEFT";
                  CHR = NNBL(PTR);
                OTHERWISE 
                  XILR$RT[INDEX] = LEFT$RIGHT"LEFT";
                ESAC; 
  
                IF NUMERIC(CHR) THEN
                  BEGIN 
                    XIN[INDEX] = GETNUM(PTR); 
                    CHR = TNBL(PTR);
                  END;
              END   #  OLN FOR I #
            ELSE
              BEGIN 
                T = CH"ONE";
                M = T$M2; 
                I = 6 * T$M2; 
                W = ALLONES;
                REL = QAL$REL"ABS"; 
                RETURN; 
              END;
          END;
  
#         CHECK FOR VALID CDC T TYPES                                  #
  
        T = CHR;
        IF B<MIN(CHR,59)>QAL$TYPES EQ 0 THEN
          BEGIN 
            ERROR(ERR"QAL$3");
            QERR = TRUE;
            RETURN; 
          END;
  
        IF T EQ CH "B" AND W EQ ALLONES THEN W = 1; 
        IF T NQ CH "B" AND W NQ ALLONES THEN
          BEGIN 
            ERROR(ERR"QAL$9");
            QERR = TRUE;
            RETURN; 
          END;
  
        CHR = NNBL(PTR);
        M = ALLONES;
        IF T EQ CH"I" OR T EQ CH"U" OR T EQ CH"E" OR T EQ CH"D" 
          THEN RETURN;
  
        OLN = 0;
        IF CHR EQ CH"PLUS" OR CHR EQ CH"MINUS" THEN 
          BEGIN 
            OLN = CHR;
            CHR = NNBL(PTR);
            IF NOT NUMERIC(CHR) THEN
              BEGIN 
                ERROR(ERR"QAL$12"); 
                QERR = TRUE;
                RETURN; 
              END;
          END;
        IF NUMERIC(CHR) THEN
          BEGIN 
            SAVEPTR = PTR;
            M = GETNUM(PTR);
            CHR = TNBL(PTR);
          END;
  
        IF CHR EQ CH"DOLLAR" OR CHR EQ CH"STAR" THEN
          BEGIN    #  OLN FOR M   # 
            IF XSTRING[INDEX] EQ 261 THEN 
              XSTRING[INDEX] = 263; 
            ELSE
              XSTRING[INDEX] = 262; 
            GETSTRING(PTR); 
            XMT$M2[INDEX] = T$M2; 
            XMSTRING[INDEX] = QTEXTPTR; 
            C<QTEXTPTR,T$M2>LOCTEXT = C<0,T$M2>T$STRING;
            QTEXTPTR = QTEXTPTR + T$M2; 
            XMREL[INDEX] = QAL$REL"ABS";
            IF OLN EQ CH"PLUS" THEN XMREL[INDEX] = QAL$REL"PLUS"; 
            IF OLN EQ CH"MINUS" THEN XMREL[INDEX] = QAL$REL"MINUS"; 
            CHR = TNBL(PTR);
            CASE (CHR EQ CH"MINUS") 
              XMLR$RT[INDEX] = LEFT$RIGHT"LEFT";
              CHR = NNBL(PTR);
            ORCASE (CHR EQ CH"PLUS")
              XMLR$RT[INDEX] = LEFT$RIGHT"RIGHT"; 
              CHR = NNBL(PTR);
            OTHERWISE 
              XMLR$RT[INDEX] = LEFT$RIGHT"RIGHT"; 
            ESAC; 
  
            IF NOT NUMERIC(CHR) THEN
              BEGIN 
                ERROR(ERR"QAL$13"); 
                QERR = TRUE;
                RETURN; 
              END;
            XMN[INDEX] = GETNUM(PTR); 
            RETURN; 
          END;     #  OLN FOR M   # 
  
        IF M EQ ALLONES THEN M = 1; 
  
        CASE (M LS 1) 
          QERR = TRUE;
        ORCASE (T EQ CH"B" AND M GR 60) 
          QERR = TRUE;
        ORCASE (T EQ CH"X" AND M GR 240)
          QERR = TRUE;
        ORCASE (T NQ CH"X" AND T NQ CH"B" AND M GR 18)
          QERR = TRUE;
        OTHERWISE 
          RETURN; 
        ESAC; 
  
        PTR = SAVEPTR;
        ERROR(ERR"QAL$11");  # M VALUE INVALID #
        RETURN; 
      END;  # GETITM  #;
CONTROL EJECT;
      PROC GETSELX;  #  GET SELECTOR EXPRESSION  #
      BEGIN 
        ITEM
          REL  I, 
          I    I, 
          W    I, 
          T    I, 
          M    I, 
          CHR1 S:CH;
  
  
        CMM$GLF(QAL$CODES,4); 
        INDEX = INDEX + 1;
        QSTRING[INDEX] = 0; 
        GETITM(REL,I,W,T,M,QAL$CODES);
        IF QERR THEN RETURN;
        IF REL NQ QAL$REL"ABS" THEN 
          BEGIN 
            ERROR(ERR"QAL$15"); 
            QERR = TRUE;
            RETURN; 
          END;
        IF T EQ CH"ONE" THEN
          BEGIN 
            ERROR(ERR"QAL$5");
            QERR = TRUE;
            RETURN; 
          END;
        QREL[INDEX] = REL;
        QI[INDEX] = I;
        QT[INDEX] = T;
        QW[INDEX] = W;
        QM[INDEX] = M;
        IF QSTRING[INDEX] GR 260 THEN OLN$USED = 1; 
  
        CHR = TNBL(PTR);
        CHR1 = NNBL(PTR); 
        CASE (CHR EQ CH"E" AND CHR1 EQ CH"Q") 
          TCOND = S"EQ";
        ORCASE (CHR EQ CH"N" AND (CHR1 EQ CH"E" OR CHR1 EQ CH"Q"))
          TCOND = S"NE";
        ORCASE (CHR EQ CH"G" AND (CHR1 EQ CH"E" OR CHR1 EQ CH"Q"))
          TCOND = S"GE";
        ORCASE (CHR EQ CH"G" AND (CHR1 EQ CH"T" OR CHR1 EQ CH"R"))
          TCOND = S"GT";
        ORCASE (CHR EQ CH"L" AND (CHR1 EQ CH"E" OR CHR1 EQ CH"Q"))
          TCOND = S"LE";
        ORCASE (CHR EQ CH"L" AND (CHR1 EQ CH"T" OR CHR1 EQ CH"S"))
          TCOND = S"LT";
        OTHERWISE 
          QERR = TRUE;
          ERROR(ERR"QAL$14"); 
          RETURN; 
        ESAC; 
  
        CHR = NNBL(PTR);
        INDEX = INDEX + 1;
        QSTRING[INDEX] = 0; 
        GETITM(REL,I,W,T,M,QAL$CODES);
        IF QERR THEN RETURN;
        IF REL NQ QAL$REL"ABS" THEN 
          BEGIN 
            ERROR(ERR"QAL$15"); 
            QERR = TRUE;
            RETURN; 
          END;
        QREL[INDEX] = REL;
        QI[INDEX] = I;
        QT[INDEX] = T;
        QW[INDEX] = W;
        QM[INDEX] = M;
        IF QSTRING[INDEX] GR 260 THEN OLN$USED = 1; 
  
        IF T EQ CH"ONE" THEN
          BEGIN 
            QSTRING[INDEX] = QTEXTPTR;
            C<QTEXTPTR,T$M2>LOCTEXT = C<0,T$M2>T$STRING;
            QTEXTPTR = QTEXTPTR + T$M2; 
          END;
        RETURN; 
      END;  #  GETSELX #; 
CONTROL EJECT;
      FUNC QAL$PARSE U;  # PARSE QAL STATEMENT #
      BEGIN 
        CARDPTR = STRING$PTR;   # POINTER BASE FOR ERROR MESSAGES # 
        PTR = STRING$PTR; 
        QERR = FALSE; 
        OLN$USED = 0; 
        QTEXTPTR = 0; 
        INDEX = 0;
  
        P<QAL$CODES> = CMM$ALF(2,LWA$GROW,0); # SPACE FOR ITM CODES # 
        QALCODEPTR = LOC(QAL$CODES);
        QQCOND[0] = 0;
        QQPTR[0] = 0; 
        QQTOK[0] = QLIST"LPAR"; 
  
        CHR = NNBL(PTR);
        PARCOUNT = 1; 
        FOR J = 1 STEP 1 WHILE PARCOUNT GQ 1 AND J LS 65 DO 
          BEGIN 
            QQCOND[J] = 0;
            QQPTR[J] = 0; 
            CASE(CHR EQ CH"LPAREN") 
              IF QQTOK[J - 1] GR QLIST"NOT" THEN
                BEGIN 
                  ERROR(ERR"QAL$2");
                  GOTO END$PARS;
                END;
              QQTOK[J] = QLIST"LPAR"; 
              PARCOUNT = PARCOUNT + 1;
              ADVANCE(PTR); 
            ORCASE(CHR EQ CH"RPAREN") 
              IF QQTOK[J - 1] LS QLIST"TVAL" THEN 
                BEGIN 
                  ERROR(ERR"QAL$2");
                  GOTO END$PARS;
                END;
              QQTOK[J] = QLIST"RPAR"; 
              PARCOUNT = PARCOUNT - 1;
              ADVANCE(PTR); 
            OTHERWISE 
              I = PTR;
              CHR1 = NEXT(PTR); 
              CHR2 = NEXT(PTR); 
              CASE(CHR EQ CH"A" AND CHR1 EQ CH"N" AND CHR2 EQ CH"D")
                IF QQTOK[J - 1] LS QLIST"TVAL" THEN 
                  BEGIN 
                    ERROR(ERR"QAL$4");
                    GOTO END$PARS;
                  END;
                QQTOK[J] = QLIST"AND";
                ADVANCE(PTR); 
              ORCASE(CHR EQ CH"O" AND CHR1 EQ CH"R")
                PTR = I;
                ADVANCE(PTR); 
                ADVANCE(PTR); 
                IF QQTOK[J - 1] LS QLIST"TVAL" THEN 
                  BEGIN 
                    ERROR(ERR"QAL$4");
                    GOTO END$PARS;
                  END;
                QQTOK[J] = QLIST"OR"; 
              ORCASE(CHR EQ CH"N"AND CHR1 EQ CH"O"AND CHR2 EQ CH"T")
                IF QQTOK[J - 1] GR QLIST"AND" THEN
                  BEGIN 
                    ERROR(ERR"QAL$4");
                    GOTO END$PARS;
                  END;
                QQTOK[J] = QLIST"NOT";
                ADVANCE(PTR); 
              OTHERWISE     #MUST BE A SPEC # 
                PTR = I;
                IF QQTOK[J - 1] GR QLIST"NOT" THEN
                  BEGIN 
                    ERROR(ERR"QAL$10"); 
                    GOTO END$PARS;
                  END;
                GETSELX;
                IF QERR THEN GOTO END$PARS; 
                QQTOK[J] = QLIST"TVAL"; 
                QQCOND[J] = TCOND;
                QQPTR[J] = RESIDUAL(PTR); 
              ESAC; 
            ESAC; 
  
            CHR = TNBL(PTR);
          END;
  
        CMM$CSF(QAL$CODES,0); 
        K = QTEXTPTR / 10 + 1;
        P<Q$TEXT> = CMM$ALF(K,LWA$GROW,0); # SPACE FOR LITERALS  #
        QM[0] = LOC(Q$TEXT);
        QI[0] = OLN$USED; 
        CMM$CSF(Q$TEXT,0);
        C<0,QTEXTPTR>QTEXT = C<0,QTEXTPTR>LOCTEXT;
  
  
#         ORDER THE TOKENS IN PREFIX IN QAL$TOKENS ARRAY               #
  
        I = -1; 
        K = 0;
        P<QAL$TOKENS> = CMM$ALF(1,LWA$GROW,0); # SPACE FOR TOKENS # 
        QTOK[0] = QALCODEPTR;  # 1ST TOKEN HAS LOCATION FOR QAL$CODES#
        QPTR[0] = LOC(STRING);  # 1ST PTR TO PARSED STRING   #
        J = J - 1;
        FOR J = J STEP -1 UNTIL 0 DO
          BEGIN 
            CASE(QQTOK[J] EQ QLIST"RPAR") 
              I = I + 1;
              STACK[I] = QQTOK[J];
            ORCASE(QQTOK[J] EQ QLIST"TVAL") 
              CMM$GLF(QAL$TOKENS,1);
              K = K + 1;
              QTOK[K] = QQTOK[J]; 
              QCOND[K] = QQCOND[J]; 
              QPTR[K] = QQPTR[J]; 
            ORCASE(QQTOK[J] EQ QLIST"NOT")
              CMM$GLF(QAL$TOKENS,1);
              K = K + 1;
              QTOK[K] = QQTOK[J]; 
              QCOND[K] = 0; # SAVE NO OF TOKENS IN 1ST COND # 
            ORCASE(QQTOK[J] EQ QLIST"LPAR") 
              FOR I = I STEP -1 WHILE STACK[I] NQ QLIST"RPAR" AND 
               I GR 0 DO
                BEGIN 
                  CMM$GLF(QAL$TOKENS,1);
                  K = K + 1;
                  QTOK[K] = STACK[I]; 
                  QCOND[K] = 0; 
                END;
                I = I - 1;
            ORCASE(QQTOK[J] EQ QLIST"AND")
              IF STACK[I] EQ QLIST"AND" THEN
                BEGIN 
                  CMM$GLF(QAL$TOKENS,1);
                  K = K + 1;
                  QTOK[K] = STACK[I]; 
                  QCOND[K] = 0; 
                END 
              ELSE
                BEGIN 
                  I = I + 1;
                  STACK[I] = QQTOK[J];
                END;
            ORCASE(QQTOK[J] EQ QLIST"OR") 
              FOR I = I STEP -1 WHILE STACK[I] NQ QLIST"RPAR" 
               AND I GR 0 DO
                BEGIN 
                  CMM$GLF(QAL$TOKENS,1);
                  K = K + 1;
                  QTOK[K] = STACK[I]; 
                  QCOND[K] = 0; 
                END;
              I = I + 1;
              STACK[I] = QLIST"OR"; 
            OTHERWISE 
              FTLERROR(ERR"ICN$1"); 
            ESAC; 
          END;
  
        QCOND[0] = K; 
        CMM$CSF(QAL$TOKENS,0);
        QAL$PARSE = LOC(QAL$TOKENS);
        RETURN; 
  
 END$PARS:  
        CMM$CSF(QAL$CODES,0); 
        QAL$PARSE = 0;
        RETURN; 
      END; #  QAL$PARSE   #;
CONTROL EJECT;
#     PRE$PARSE CONTROL AND DISPATCH                                   #
  
        CASE (DIRTYPE EQ "QAL") 
          PRE$PARSE = QAL$PARSE;
        ORCASE (DIRTYPE EQ "REF") 
          PRE$PARSE = LOC(STRING);
        ORCASE (DIRTYPE EQ "SEQ") 
          PRE$PARSE = LOC(STRING);
        OTHERWISE 
          FTLERROR(ERR"ICN$2"); 
        ESAC; 
        RETURN; 
      END; #  PRE$PARSE  #
CONTROL EJECT;
      FUNC  BUILD$FDB (NAME) U;   # BUILD NEW FDB BLOCK                #
        ITEM  NAME  C(10);
      BEGIN 
      ITEM  I U;
  
        P<FDB> = CMM$ALF (FDBSIZE, 0, 0); 
        FOR I = 0 TO FDBSIZE-1  DO  FDBWORD[I] = 0; 
        LFN = NAME; 
        SEQNEXT = -1; 
        BUILD$FDB = LOC(FDB); 
      END; # BUILD$FDB #
CONTROL EJECT;
      PROC CHECKOPEN( FDB );
        BEGIN 
        ARRAY FDB;; 
  
        IF IFETCH( FDB, RM$OC ) NQ OC$OPEN
          THEN FTLERROR(ERR"VAL$10"); 
        END #CHECKOPEN# 
CONTROL EJECT;
      FUNC  FIND$FDB (NAME) U;    # FIND FDB FOR FILE                  #
        ITEM  NAME  C(10);
      BEGIN 
        ITEM  I U;
  
        FOR I = 0 TO N$FILES  DO
          IF  FDB$PTR[I] NQ 0  THEN 
            BEGIN 
              P<FDB> = FDB$PTR[I];
              IF  C<0,7>NAME EQ LFN  THEN 
                BEGIN 
                  FIND$FDB = LOC(FDB);
                  RETURN; 
                END 
            END;
        FIND$FDB = 0; 
      END; # FIND$FDB # 
CONTROL EJECT;
      FUNC  GET$CON$QAL  U;  # GET CONVERSION OR QAL SPEC STRING       #
      BEGIN 
        ITEM  INSTRING  B,  CB  S:CH; 
        ITEM  PARCOUNT  I;
  
#       SEQ DIRECTIVES ARE SET UP BY GETPARM, SO WE CAN SKIP MOST OF   #
#       THIS CODE.                                                     #
  
        IF KEYWORD EQ "SEQ" THEN
          BEGIN 
            PARCOUNT = 0; 
            GOTO GET$CON$1; 
          END;
  
        P<STRING> = CMM$ALF (2, LWA$GROW, 0); # GET SPACE FOR STRING   #
        STRING$PTR = 0; 
        C<0>STRING$TEXT[0] = "("; 
        K = 1;  C = THIS(PTR);
        INSTRING = FALSE;  PARCOUNT = 1;
        IF  C EQ CH"COMMA"  THEN
          BEGIN 
            REPEAT
              BEGIN 
                IF  INSTRING OR C NQ CH"SPACE"
                  THEN  C = NEXT(PTR);
                  ELSE  C = NNBL(PTR);
                WHYLE  C EQ CH"EOS" AND PTR NQ 0  DO
                  BEGIN 
                    GETCARD;
                    IF  PTR EQ 0  THEN  ERROR(ERR"FMC$2");
                    C = NEXT(PTR);
                  END 
                IF  INSTRING
                  THEN
                    BEGIN 
                      IF  C EQ CB  THEN  INSTRING = FALSE;
                    END 
                  ELSE
                    BEGIN 
                      CASE (C EQ CH"DOLLAR" OR C EQ CH"STAR") 
                        INSTRING = TRUE;
                        CB = C; 
                      ORCASE (C EQ CH"LPAREN")
                        PARCOUNT = PARCOUNT + 1;
                      ORCASE (C EQ CH"RPAREN")
                        PARCOUNT = PARCOUNT - 1;
                      ESAC; 
                    END 
                IF  MOD(K,10) EQ 0  THEN  CMM$GLF (STRING, 1);
                C<MOD(K,10)>STRING$TEXT[K/10] = C;
                K = K + 1;
              UNTYL (PTR EQ 0 OR PARCOUNT EQ 0);
              END 
          END 
  
        CMM$CSF (STRING, 0);           # FREEZE BLOCK SIZE             #
        RESIDUAL(STRING$PTR) = 6*K;   # BUILD DESCRIPTOR               #
        ADDRESS (STRING$PTR) = LOC(STRING[1]);
        IF KEYWORD EQ "CON" THEN
          BEGIN 
            GET$CON$QAL = LOC(STRING);
            RETURN; 
          END;
  
#       PRE-PARSE QAL, REF, AND SEQ DIRECTIVES, IF WE FOUND ALL OF THE #
#       DIRECTIVE (I.E., BALANCED PARENS).                             #
  
 GET$CON$1: 
        K = PTR;
        GET$CON$QAL = 0;
        IF PARCOUNT EQ 0 THEN 
          GET$CON$QAL = PRE$PARSE(KEYWORD); 
        PTR = K;
        RETURN; 
      END; # GET$CON$QAL #
CONTROL EJECT;
      PROC  GETCARD;         # READ NEXT INPUT CARD, PRINT IT          #
      BEGIN 
        ARRAY LINE S(10); 
          ITEM
            LINECTL   C(0,0,1)  = [ "0" ],
            LINETEXT  C(0,6,90);
        ITEM  RECSIZ  U;
        ITEM  FILPOS  U;
        ARRAY  CARDIMAGE [0:9] S(1);
          ITEM
            PREFIX    C(0,54,1) = [ ","], 
            LOGREC  C(1,0,90);
  
        IF  (IFETCH(FM$IFDB, RM$FP) LAN EOD) EQ 0  THEN 
          GET (FM$IFDB, CARDIMAGE[1], 90);
        IF  (IFETCH(FM$IFDB, RM$FP) LAN EOD) EQ 0 
          THEN
            BEGIN 
          RECSIZ = MIN(IFETCH(FM$IFDB, RM$RL), 90); 
              LINETEXT[0] = LOGREC[0];
              PUT (FM$LFDB, LINE, RECSIZ+1);
              PTR = LOC(CARDIMAGE);   # POINT TO CHAR BEFORE RECORD    #
              RESIDUAL(PTR) = 6*73; 
              USED(PTR) = 54; 
              IF RECSIZ LS 72 THEN C<RECSIZ,72-RECSIZ>LOGREC[0]= " "; 
            END 
          ELSE
            PTR = 0;
  
        CARDPTR = PTR;
        ADVANCE(CARDPTR);    # SKIP COMMA ON DISPLAY POINTER           #
        ADDRESS(CARDPTR) = 0;  # DONT PRINT CARD IMAGE TWICE           #
  
      END; # GETCARD #
CONTROL EJECT;
      PROC  GETKEY;          # GET A KEYWORD FROM INPUT STREAM         #
      BEGIN 
        ITEM
          I  I, 
          C  S:CH;
  
        KEYWORD = " ";       # INITIALIZE                              #
        C = NNBL( PTR );
        IF ALPHA( C ) THEN
          BEGIN 
            C<0>KEYWORD = THIS(PTR);
            C = NEXT(PTR);
            FOR I = 1 STEP 1 WHILE I LQ 6 AND (ALPHA(C) OR NUMERIC(C))
              DO
                BEGIN 
                  C<I>KEYWORD = C;
                  C = NEXT(PTR);
                END 
            C = TNBL(PTR);  # TRASH SPACES AFTER KEYWORD               #
            IF  C EQ CH"EQUAL"  THEN
              BEGIN 
                C<I>KEYWORD = C;
                C = NEXT(PTR);
              END 
          END 
      END 
CONTROL EJECT;
      FUNC  GETLFN  (GETNEW) U;  # PARSE LFN FROM CONTROL CARD         #
      ITEM  GETNEW  B;
      BEGIN 
        ITEM  I      U; 
        ITEM  KEYVAL U; 
  
        P<FDB> = 0; 
        C = THIS(PTR);
        IF (C NQ CH"SPACE" AND C NQ CH"LPAREN" AND
            C NQ CH"COMMA" AND C NQ CH"EQUAL" ) 
          THEN
            BEGIN 
              ERROR(ERR"GETL$1"); 
              GETLFN = 0; 
              RETURN; 
            END;
        C = NEXT( PTR );
        IF ALPHA( C ) 
          THEN
            BEGIN 
              KEYVAL = 0; 
              FOR  I = 0  STEP 6 WHILE I LQ 36 AND
                   (ALPHA(THIS(PTR)) OR NUMERIC(THIS(PTR)))  DO 
                BEGIN 
                  B<I,6>KEYVAL = THIS(PTR); 
                  ADVANCE(PTR); 
                END;
              P<FDB> = FIND$FDB(KEYVAL);
              IF  GETNEW
                THEN
                  BEGIN 
                    IF  LOC(FDB) EQ 0 
                      THEN
                        BEGIN 
                          IF  C<0,7>KEYVAL EQ I$LFN  THEN 
                            P<FDB> = LOC(FM$IFDB);
                          ELSEIF  C<0,7>KEYVAL EQ L$LFN  THEN 
                            P<FDB> = LOC(FM$LFDB);
                          ELSE
                            P<FDB> = BUILD$FDB(KEYVAL); 
                        END 
                      ELSE  ERROR(ERR"GETL$2"); 
                  END 
                ELSE
                  IF  LOC(FDB) EQ 0  THEN  ERROR(ERR"GETL$3");
            END 
          ELSE  ERROR (ERR"GETL$4");
        GETLFN = LOC(FDB);
  
      END; # GETLFN # 
CONTROL EJECT;
      PROC  GETPARM;         # GET A PARAMETER FIELD                   #
        BEGIN 
  
          GETKEY;            # GET KEYWORD                             #
          C = TNBL(PTR);     # TRASH SPACES AFTER EQUAL SIGN           #
          SELECT;            # LOOK UP INDEX                           #
          KEYTYPE = KEYTYPE$[KEY];
  
        SWITCH  GET:TYPS
          LNONE: NONE,  LNUM: NUM,  LSNUM: SNUM,  LEPT: EPT,
          LEPTNUM: EPTNUM,  LCHR: CHR,  LITM: ITM,  LSITM: SITM,
          LSTRING: STRING,  LERROR: ERROR;
  
          GOTO  GET[KEYTYPE]; 
  
 LSNUM: 
        CASE (THIS(PTR) EQ CH"PLUS")
          SIGN = FALSE; 
          ADVANCE(PTR); 
        ORCASE (THIS(PTR) EQ CH"MINUS") 
          SIGN = TRUE;
          ADVANCE(PTR); 
        OTHERWISE 
 LNUM:  
          SIGN = FALSE; 
        ESAC; 
        IF  NUMERIC(THIS(PTR))
          THEN
            BEGIN 
              KEYVAL = GETNUM(PTR); 
              IF  SIGN  THEN  KEYVAL = -KEYVAL; 
            END 
          ELSE
            BEGIN 
              KEYVAL = 0; 
              ERROR(ERR"GET$1");
            END;
        GOTO LNONE; 
  
 LEPTNUM:   
        IF  NUMERIC(THIS(PTR))
          THEN
            KEYVAL = GETNUM(PTR); 
          ELSE
 LEPT:  
            IF  ALPHA(THIS(PTR))
              THEN
                BEGIN 
                  KEYVAL =0;
                  FOR  I = 0 STEP 6 WHILE I LQ 36 AND 
                      (ALPHA(THIS(PTR)) OR NUMERIC(THIS(PTR)))  DO
                    BEGIN 
                      B<I,6>KEYVAL = THIS(PTR); 
                      ADVANCE(PTR); 
                    END 
                END 
              ELSE
                BEGIN 
                  KEYVAL = 0; 
                  ERROR(ERR"GET$2");
                END;
        GOTO LNONE; 
  
 LCHR:  
        C<0,10>KEYVAL = " ";
        FOR I=0 STEP 6 DO 
          BEGIN 
          IF I LQ 54
          THEN
            BEGIN 
            C = THIS( PTR );
            IF ALPHA( C ) OR NUMERIC( C ) 
            THEN
              BEGIN 
              B<I,6>KEYVAL = C; 
              ADVANCE( PTR ); 
              TEST; 
              END 
            END 
          GOTO LNONE; 
          END 
  
 LSITM: 
        CASE (THIS(PTR) EQ CH"PLUS")
          SIGN = FALSE; 
          ADVANCE(PTR); 
        ORCASE (THIS(PTR) EQ CH"MINUS") 
          SIGN = TRUE;
          ADVANCE(PTR); 
        OTHERWISE 
          SIGN = FALSE; 
        ESAC; 
  
        IF  NUMERIC(THIS(PTR))
          THEN
            BEGIN 
              KEYVAL = GETNUM(PTR);   # -I- PART                       #
              K = THIS(PTR);          # -T- PART                       #
              ADVANCE(PTR); 
              CASE (K EQ CH"I" OR K EQ CH"F") 
                KEYSIZE = 10; 
              ORCASE (K EQ CH"X") 
                IF  NUMERIC(THIS(PTR))
                  THEN  KEYSIZE = GETNUM(PTR);
                  ELSE  KEYSIZE = 1;
              OTHERWISE 
                ERROR(ERR"GET$3");
              ESAC; 
            END 
          ELSE
            BEGIN 
              ERROR(ERR"GET$4");
            END 
        GOTO LNONE; 
  
 LITM:  
        P<STRING> = CMM$ALF (3, LWA$GROW, 0);  # GET SPACE FOR STRING  #
        STRING$PTR = 0; 
        C<0>STRING$TEXT = "(";    # MAKE SEQ CONVERSION STRING         #
        K = 1;  C = THIS(PTR);  INSTRING = FALSE; 
        WHYLE (C NQ CH"EOS" AND (INSTRING OR (C NQ CH"COMMA" AND
                                              C NQ CH"RPAREN")))  DO
          BEGIN 
            IF  MOD(K,10) EQ 0  THEN  CMM$GLF (STRING, 1);
            C<MOD(K,10)>STRING$TEXT[K/10] = PCHAR(PTR); 
            K = K+1;
            IF C EQ CH"DOLLAR" THEN INSTRING = NOT INSTRING;
            C = NEXT(PTR);
          END 
        CMM$CSF (STRING, 0);                   # FREEZE BLOCK SIZE     #
        C<MOD(K,10),3>STRING$TEXT[K/10] = "=I)";  K = K+3;
        RESIDUAL(STRING$PTR) = 6*K;            # BUILD DESCRIPTOR      #
        ADDRESS(STRING$PTR) = LOC(STRING[1]); 
        GOTO LNONE; 
  
 LSTRING: 
        P<STRING> = CMM$ALF (3, LWA$GROW, 0);  # GET SPACE FOR STRING  #
        STRING$PTR = 0; 
        C<0,10>STRING$TEXT = " ";  K = 1;  # START WITH SECOND POSITION#
        C = TNBL(PTR);
        IF  C EQ CH"EOS"  THEN
          BEGIN 
            GETCARD;
            C = NNBL(PTR);
          END 
        IF  C GR CH"NINE" AND C NQ CH"EOS"
          THEN
            BEGIN 
              J = C;         # TERMINATOR CHARACTER                    #
              C = NEXT(PTR);  INSTRING = TRUE;
              IF  C EQ CH"EOS"  THEN
                BEGIN 
                  GETCARD;
                  C = NEXT(PTR);
                END 
              WHYLE (C NQ CH"EOS" AND INSTRING)  DO 
                BEGIN 
                  IF  C EQ J  THEN
                    BEGIN 
                      C = NEXT(PTR);
                      IF  C NQ J  THEN
                        BEGIN 
                          INSTRING = FALSE; 
                          TEST; 
                        END 
                    END 
                  IF  MOD(K,10) EQ 0  THEN  CMM$GLF (STRING, 1);
                  C<MOD(K,10)>STRING$TEXT[K/10] = PCHAR(PTR); 
                  K = K + 1;
                  C = NEXT(PTR);
                  IF  C EQ CH"EOS"  THEN
                    BEGIN 
                      GETCARD;
                      C = NEXT(PTR);
                    END 
                END 
              IF  C EQ CH"EOS"  THEN  ERROR(ERR"GET$5");
            END 
          ELSE
            ERROR(ERR"GET$6");
        CMM$CSF (STRING, 0);                     # FREEZE BLOCK SIZE   #
        RESIDUAL(STRING$PTR) = 6*K;              # BUILD DESCRIPTOR    #
        ADDRESS (STRING$PTR) = LOC(STRING[1]);
        GOTO LNONE; 
  
 LERROR:  
      IF  (KEYWORD NQ " ") OR (THIS(PTR) NQ CH"EOS")  THEN
        ERROR (ERR"GET$7");  # UNRECOGNIZED PARAMETER KEYWORD          #
  
 LNONE:                      # NO PARAMETERS                           #
  
          RETURN;            # EXIT GETPARM                            #
        END;  # GETPARM  #
CONTROL EJECT;
      FUNC  OWN$LINK (NAME)  U;   # ADD USER ENTRY POINT TO LOADER LIST#
        ITEM  NAME  C(7); 
      BEGIN 
        ITEM  I  U; 
  
        FOR  I = 1 TO OWNCOUNT  DO
          BEGIN 
            IF  USRENTRY[I] EQ NAME  THEN 
              BEGIN 
                OWN$LINK = LOC(FM$UENT[I]); 
                RETURN; 
              END 
          END 
        IF  OWNCOUNT LS FM$MAXU 
          THEN
            BEGIN 
              OWNCOUNT = OWNCOUNT + 1;
              USRENTRY[OWNCOUNT] = NAME;
              OWN$LINK = LOC(FM$UENT[OWNCOUNT]);
            END 
          ELSE
            BEGIN 
              ERROR (ERR"OWN$1"); 
              OWN$LINK = 0; 
            END 
  
      END; # OWN$LINK # 
CONTROL EJECT;
      PROC  SELECT;          # SELECT KEYWORD FROM LIST                #
      BEGIN 
        ITEM  I I;
  
        FOR  I = 0 STEP 1  DO 
          BEGIN 
            IF  KEYSTRING[I] EQ " " OR KEYSTRING[I] EQ KEYWORD  THEN
              BEGIN 
                KEY = I;
                RETURN; 
              END 
          END 
      END; # SELECT # 
CONTROL EJECT;
      PROC CCRACK;           # READ AND CRACK CONTROL CARD             #
      BEGIN 
        DEF  CCBASE  # O"70" #; # MEMORY BASE OF CONTROL CARD IMAGE    #
  
        PTR = CCBASE;        # BUILD POINTER TO CONTROL CARD IMAGE     #
        FOR  I = 0 STEP 1 WHILE (I LQ 7) AND
                                B<48,12>UMEMORY[CCBASE+I] NQ 0
          DO  RESIDUAL(PTR) = 60*(I+1); 
        IF  UMEMORY[CCBASE+I] EQ 0
          THEN
            BEGIN 
              IF  B<54,6>UMEMORY[CCBASE+I-1] EQ 0 
                THEN  RESIDUAL(PTR) = RESIDUAL(PTR)-6;
            END 
          ELSE
            BEGIN 
              FOR  J = 6 STEP 6 WHILE B<J,60-J>UMEMORY[CCBASE+I] NQ 0 
                DO; 
              RESIDUAL(PTR) = RESIDUAL(PTR) + J;
            END 
        CARDPTR = PTR;
  
        C = TNBL(PTR);       # TRASH LEADING SPACES, IF ANY.           #
        WHYLE (ALPHA(C) OR NUMERIC(C)) DO  # SKIP KEYWORD              #
          C = NEXT(PTR);
  
        IF  C EQ CH"SPACE" OR C EQ CH"COMMA" OR C EQ CH"LPAREN"  THEN 
          BEGIN 
            P<KEYWORDS> = LOC(CC$PARS); 
            REPEAT           # GET INDIVIDUAL PARAMETERS               #
              BEGIN 
                GETPARM;
  
#  IF ANY ERRORS HAVE BEEN FOUND BY GETPARM AND FRIENDS, ABORT NOW TO  #
#  PREVENT SPURIOUS DIAGNOSTICS.                                       #
  
                IF ERROR$COUNT NQ 0 THEN  FM$ABRT;
  
#  DISPATCH TO CONTROL CARD OPTION PROCESSOR.                          #
  
      SWITCH  CCPAR  IEQ, LEQ, OWN, INP, OUT, IDEF, LDEF, UNREC;
  
                GOTO CCPAR[KEY];
  
 IDEF:  
        KEYVAL = "COMPILE"; 
 IEQ: 
        IF  I$LFN EQ 0
          THEN  C<0,7>I$LFN = C<0,7>KEYVAL; 
          ELSE  FTLERROR(ERR"CCR$1"); 
        GOTO  CCDONE; 
  
 LDEF:  
        KEYVAL = 0; C<0,4>KEYVAL = "LIST";
 LEQ: 
        IF  L$LFN EQ 0
          THEN  C<0,7>L$LFN =  C<0,7>KEYVAL;
          ELSE  FTLERROR(ERR"CCR$2"); 
        GOTO  CCDONE; 
  
 OWN: 
        IF  OWN$LFN EQ 0
          THEN  C<0,7>OWN$LFN = C<0,7>KEYVAL; 
          ELSE  FTLERROR(ERR"CCR$3"); 
        GOTO  CCDONE; 
  
 INP: 
        IF  FDB$PTR[0] EQ 0 
          THEN  FDB$PTR[0] = KEYVAL;
          ELSE  FTLERROR(ERR"CCR$4"); 
        GOTO  CCDONE; 
  
 OUT: 
        IF  FDB$PTR[1] EQ 0 
          THEN  FDB$PTR[1] = KEYVAL;
          ELSE  FTLERROR(ERR"CCR$4"); 
        GOTO  CCDONE; 
  
 UNREC: 
        FTLERROR(ERR"CCR$5"); 
  
 CCDONE:  
                C = THIS(PTR);
               UNTYL (C NQ CH"COMMA");
              END 
          END 
  
#  CHECK TERMINATING CHARACTER                                         #
  
        IF C NQ CH"POINT" AND C NQ CH"RPAREN" THEN
          FTLERROR(ERR"CCR$7"); 
  
#  NOW CHECK PARAMETERS AND OPEN FILES                                 #
  
        IF  L$LFN EQ 0  THEN  C<0,6>L$LFN = "OUTPUT"; 
        STOREF (FM$LFDB, RM$BT, RM$C);
        STOREF (FM$LFDB, RM$RT, RM$Z);
        STOREF (FM$LFDB, RM$MRL, 140);
        STOREF (FM$LFDB, RM$DFC, DFC$ALL);
        STOREF (FM$LFDB, RM$EFC, EFC$ALL);
        STOREF (FM$LFDB, RM$EX, FM$ERXT); 
        STOREF (FM$LFDB, RM$OF, OF$N);
        STOREF (FM$LFDB, RM$CF, OF$N);
        OPENM (FM$LFDB, RM$OUTPUT); 
        CHECKOPEN( FM$LFDB ); 
        C<0,6>CMEMORY[LOF$PTR+1] = "OUTPUT";
        B<36,6>UMEMORY[LOF$PTR+1] = 0;
  
        IF  I$LFN EQ 0 AND FDB$PTR[0] EQ 0 AND FDB$PTR[1] EQ 0
          THEN  C<0,5>I$LFN = "INPUT";
        IF  I$LFN NQ 0  THEN
          BEGIN 
            IF  FDB$PTR[0] NQ 0 OR FDB$PTR[1] NQ 0  THEN
              FTLERROR(ERR"CCR$6"); 
  
            STOREF (FM$IFDB, RM$BT, RM$C);
            STOREF (FM$IFDB, RM$RT, RM$Z);
            STOREF (FM$IFDB, RM$MRL,  90);
            STOREF (FM$IFDB, RM$DFC, DFC$ALL);
            STOREF (FM$IFDB, RM$EFC, EFC$ALL);
            STOREF (FM$IFDB, RM$EX, FM$ERXT); 
            STOREF (FM$IFDB, RM$OF, OF$N);
            STOREF (FM$IFDB, RM$CF, OF$N);
            OPENM (FM$IFDB, RM$INPUT);
            CHECKOPEN( FM$IFDB ); 
          END;
  
        IF  OWN$LFN EQ 0  THEN  C<0,3>OWN$LFN = "LGO";
  
        IF  FDB$PTR[0] NQ 0  THEN 
          BEGIN 
            IF  C<0,7>FDB$PTR[0] EQ C<0,7>I$LFN 
              THEN
                FDB$PTR[0] = LOC(FM$IFDB);
              ELSE
                BEGIN 
                  KEYVAL = FDB$PTR[0];  FDB$PTR[0] = 0; 
                  FDB$PTR[0] = BUILD$FDB (KEYVAL);
                END 
          END 
        IF  FDB$PTR[1] NQ 0  THEN 
          BEGIN 
            IF  C<0,7>FDB$PTR[1] EQ C<0,7>L$LFN 
              THEN
                FDB$PTR[1] = LOC(FM$LFDB);
              ELSE
                FDB$PTR[1] = BUILD$FDB (FDB$PTR[1]);
            N$FILES = 1;
            NN$FILES = 1; 
          END 
  
      END; # CCRACK # 
CONTROL EJECT;
#                   FM$CRAK - MAIN ROUTINE                             #
  
        FOR  I = 0 TO FILE$MAX  DO  FDB$PTR[I] = 0;  # INITIALIZE      #
  
        CCRACK;              # PARSE PROGRAM CALL CARD                 #
        IF  I$LFN NQ 0  THEN # PARSE PARAMETER CARDS                   #
          BEGIN 
            PUT(FM$LFDB,LIST$HEAD,90);  # OUTPUT TITLE LINE            #
            PUT(FM$LFDB," ",1);         # BLANK OUT SUBTITLE LINE      #
            GETCARD;         # READ FIRST CARD                         #
              WHYLE ((IFETCH(FM$IFDB, RM$FP) LAN EOD) EQ 0)  DO 
                BEGIN 
                  GETKEY;    # GET COMMAND KEYWORD                     #
  
      CASE (KEYWORD EQ "INP") 
        IF  FDB$PTR[0] NQ 0 
          THEN  ERROR(ERR"INP$1");
          ELSE
            BEGIN 
              FDB$PTR[0] = GETLFN (NEW$FILE); 
              IF LOC(FDB) NQ 0  THEN
                BEGIN 
                  IF  THIS(PTR) EQ CH"EQUAL"  THEN
                   BEGIN
                      FDBX = LOC(FDB);
                      FDBY = GETLFN(OLD$FILE);
                      IF  FDBX EQ FDBY  THEN
                        ERROR (ERR"GETL$2");
                      ELSEIF  FDBY NQ 0 
                        THEN
                          BEGIN 
  
       I = RMAX;        P<FDB> = FDBX;  RMAX = I;         P<FDB> = FDBY;
       I = MAXFIL;      P<FDB> = FDBX;  MAXFIL = I;       P<FDB> = FDBY;
       C<0>I = REW;     P<FDB> = FDBX;  REW = C<0>I;      P<FDB> = FDBY;
       I = HRL$$;       P<FDB> = FDBX;  HRL$$ = I;        P<FDB> = FDBY;
       I = LX$$;        P<FDB> = FDBX;  LX$$ = I;         P<FDB> = FDBY;
       C<0,3>I = RECFM; P<FDB> = FDBX;  RECFM = C<0,3>I;  P<FDB> = FDBY;
       I = BLKSIZE;     P<FDB> = FDBX;  BLKSIZE = I;      P<FDB> = FDBY;
       I = LRECL;       P<FDB> = FDBX;  LRECL = I;        P<FDB> = FDBY;
       I = IRL;         P<FDB> = FDBX;  IRL = I;          P<FDB> = FDBY;
       C<0>I = CODE;    P<FDB> = FDBX;  CODE = C<0>I;     P<FDB> = FDBY;
       I = CX$$;        P<FDB> = FDBX;  CX$$ = I;         P<FDB> = FDBY;
       I = EX$$;        P<FDB> = FDBX;  EX$$ = I;         P<FDB> = FDBY;
       BTEMP = $IBM;    P<FDB> = FDBX;  $IBM = BTEMP; 
  
                          END 
                        ELSE  P<FDB> = FDBX;
                      END 
                  P<KEYWORDS> = LOC(INP$PARS);
                  WHYLE (THIS(PTR) EQ CH"COMMA")  DO
                    BEGIN 
                      GETPARM;
  
        SWITCH  INP$SW  INP$MAX, INP$POS, INP$REW, INP$HRL, INP$DCA,
                        INP$LX,  INP$DX,  INP$RFM, INP$BLK, INP$LRL,
                        INP$IRL, INP$COD, INP$CX,  INP$EX,  INP$; 
  
          GOTO  INP$SW[KEY];
  
 INP$MAX: 
        IF  KEYVAL LS 1 OR KEYVAL GR 16777215 
          THEN  ERROR(ERR"INP$2");
        ELSEIF  RMAX NQ 0 
          THEN  ERROR(ERR"INP$3");
          ELSE  RMAX = KEYVAL;
        IF THIS(PTR) EQ "/"  THEN 
          BEGIN 
            C = NEXT(PTR);
            CASE (C EQ "R") 
              MAXFIL = MAX$R; 
              ADVANCE(PTR); 
            ORCASE (C EQ "S") 
              MAXFIL = MAX$S; 
              ADVANCE(PTR); 
            ORCASE (C EQ "P") 
              MAXFIL = MAX$P; 
              ADVANCE(PTR); 
            OTHERWISE 
              ERROR(ERR"INP$2");
            ESAC; 
          END 
        GOTO  INP$$;
  
 INP$POS: 
        IF  KEYVAL LS -2047 OR KEYVAL GR 2047 
          THEN  ERROR(ERR"INP$4");
        ELSEIF  POS NQ 0
          THEN  ERROR(ERR"INP$5");
          ELSE  POS = KEYVAL; 
          POSFIL = POS$P; 
          IF THIS(PTR) EQ "/"  THEN 
            BEGIN 
              C = NEXT(PTR);
              CASE (C EQ "P") 
                POSFIL = POS$P; 
                ADVANCE(PTR); 
              ORCASE (C EQ "R") 
                POSFIL = POS$R; 
                ADVANCE(PTR); 
              ORCASE (C EQ "S") 
                POSFIL = POS$S; 
                ADVANCE(PTR); 
              OTHERWISE 
                ERROR(ERR"INP$4");
              ESAC; 
            END 
        GOTO  INP$$;
  
 INP$REW: 
        IF  C<0,10>KEYVAL NQ "N" AND C<0,10>KEYVAL NQ "R" AND 
            C<0,10>KEYVAL NQ "U"
          THEN  ERROR(ERR"INP$6");
        ELSEIF  B<0,6>REW NQ 0
          THEN  ERROR(ERR"INP$7");
          ELSE  REW = C<0>KEYVAL; 
        GOTO  INP$$;
  
 INP$HRL: 
        IF HRL$$ NQ 0 
          THEN  ERROR(ERR"INP$8");
          ELSE  HRL$$ = OWN$LINK(KEYVAL); 
        GOTO  INP$$;
  
 INP$DCA: 
        IF  DCA$$ NQ 0
          THEN  ERROR(ERR"INP$9");
        ELSEIF  KEYVAL GQ 0 AND KEYVAL LQ 63
          THEN  DCA$$ = KEYVAL; 
          ELSE  DCA$$ = OWN$LINK(KEYVAL); 
        GOTO  INP$$;
  
 INP$LX:    
        IF  LX$$ NQ 0 
          THEN  ERROR(ERR"INP$10"); 
          ELSE  LX$$ = OWN$LINK(KEYVAL);
        GOTO  INP$$;
  
 INP$DX:  
        IF  DX$$ NQ 0 
          THEN  ERROR(ERR"INP$11"); 
          ELSE  DX$$ = OWN$LINK(KEYVAL);
        GOTO  INP$$;
  
 INP$RFM: 
        IF  C<0,10>KEYVAL NQ "F"   AND C<0,10>KEYVAL NQ "V"   AND 
            C<0,10>KEYVAL NQ "U"   AND C<0,10>KEYVAL NQ "FB"  AND 
            C<0,10>KEYVAL NQ "VB"  AND C<0,10>KEYVAL NQ "VSB" 
          THEN  ERROR(ERR"INP$12"); 
        ELSEIF  B<0,18>RECFM NQ 0 
          THEN  ERROR(ERR"INP$13"); 
          ELSE  RECFM = C<0,3>KEYVAL; 
        $IBM = TRUE;
        GOTO  INP$$;
  
 INP$BLK: 
        IF  KEYVAL GR 32760 
          THEN  ERROR(ERR"INP$14"); 
        ELSEIF  BLKSIZE NQ 0
          THEN  ERROR(ERR"INP$15"); 
          ELSE  BLKSIZE = KEYVAL; 
        $IBM = TRUE;
        GOTO  INP$$;
  
 INP$LRL: 
        IF  KEYVAL GR 32760 
          THEN  ERROR(ERR"INP$24"); 
        ELSEIF  LRECL NQ 0
          THEN  ERROR(ERR"INP$16"); 
          ELSE  LRECL = KEYVAL; 
        $IBM = TRUE;
        GOTO  INP$$;
  
 INP$IRL: 
        IF  KEYVAL GR 131071
          THEN  ERROR(ERR"INP$17"); 
        ELSEIF  IRL NQ 0
          THEN  ERROR(ERR"INP$18"); 
          ELSE  IRL = KEYVAL; 
        GOTO  INP$$;
  
 INP$COD: 
        IF  C<0,10>KEYVAL NQ "A" AND C<0,10>KEYVAL NQ "C" AND 
            C<0,10>KEYVAL NQ "E"
          THEN  ERROR(ERR"INP$19"); 
        ELSEIF  B<0,6>CODE NQ 0 
          THEN  ERROR(ERR"INP$20"); 
          ELSE  CODE = C<0>KEYVAL;
        $IBM = TRUE;
        GOTO  INP$$;
  
 INP$CX:  
        IF  CX$$ NQ 0 
          THEN  ERROR(ERR"INP$21"); 
          ELSE  CX$$ = OWN$LINK(KEYVAL);
        $IBM = TRUE;
        GOTO  INP$$;
  
 INP$EX:  
        IF  EX$$ NQ 0 
          THEN  ERROR(ERR"INP$22"); 
          ELSE  EX$$ = OWN$LINK(KEYVAL);
        GOTO  INP$$;
  
 INP$:                       # MISSING PARAMETER                       #
        IF  THIS(PTR) NQ CH"SPACE" AND THIS(PTR) NQ CH"EOS" 
          THEN  ERROR(ERR"INP$23"); 
          ELSE  GETCARD;
  
 INP$$: 
                    END      # PARAMETER LOOP                          #
                END 
            END 
  
      ORCASE (KEYWORD EQ "OUT") 
        IF  N$FILES EQ FILE$MAX 
          THEN  ERROR(ERR"OUT$1");
          ELSE
            BEGIN 
              FDB$PTR[N$FILES+1] = GETLFN(NEW$FILE);
              IF  LOC(FDB) NQ 0  THEN 
                BEGIN 
                  N$FILES = N$FILES + 1;
                  NN$FILES = N$FILES; 
                  IF  THIS(PTR) EQ CH"EQUAL"  THEN
                   BEGIN
                      FDBX = LOC(FDB);
                      FDBY = GETLFN(OLD$FILE);
                      IF  FDBX EQ FDBY  THEN
                        ERROR (ERR"GETL$2");
                      ELSEIF  FDBY NQ 0 
                        THEN
                          BEGIN 
                            IF  FDBY NQ FDB$PTR[0]  THEN
                              BEGIN 
  
       BTEMP=TRANSFORML;P<FDB>=FDBX;    TRANSFORML=BTEMP; P<FDB>=FDBY;
       BTEMP = NOSEC;   P<FDB> = FDBX;  NOSEC = BTEMP;    P<FDB> = FDBY;
       I = DCA$$;       P<FDB> = FDBX;  DCA$$ = I;        P<FDB> = FDBY;
       I = RX$$;        P<FDB> = FDBX;  RX$$ = I;         P<FDB> = FDBY;
       I = DCT$$;       P<FDB> = FDBX;  DCT$$ = I;        P<FDB> = FDBY;
       BTEMP = OUTKEY;  P<FDB> = FDBX;  OUTKEY = BTEMP;   P<FDB> = FDBY;
       BTEMP = NEGKEY;  P<FDB> = FDBX;  NEGKEY = BTEMP;   P<FDB> = FDBY;
       I = KEYSTART;    P<FDB> = FDBX;  KEYSTART = I;     P<FDB> = FDBY;
       I = KEY$SIZ;     P<FDB> = FDBX;  KEY$SIZ = I;      P<FDB> = FDBY;
       I = BGD;         P<FDB> = FDBX;  BGD = I;          P<FDB> = FDBY;
  
                              END 
  
       I = RMAX;        P<FDB> = FDBX;  RMAX = I;         P<FDB> = FDBY;
       I = MAXFIL;      P<FDB> = FDBX;  MAXFIL = I;       P<FDB> = FDBY;
       C<0>I = REW;     P<FDB> = FDBX;  REW = C<0>I;      P<FDB> = FDBY;
       I = HRL$$;       P<FDB> = FDBX;  HRL$$ = I;        P<FDB> = FDBY;
       I = LX$$;        P<FDB> = FDBX;  LX$$ = I;         P<FDB> = FDBY;
       C<0,3>I = RECFM; P<FDB> = FDBX;  RECFM = C<0,3>I;  P<FDB> = FDBY;
       I = BLKSIZE;     P<FDB> = FDBX;  BLKSIZE = I;      P<FDB> = FDBY;
       I = LRECL;       P<FDB> = FDBX;  LRECL = I;        P<FDB> = FDBY;
       I = IRL;         P<FDB> = FDBX;  IRL = I;          P<FDB> = FDBY;
       C<0>I = CODE;    P<FDB> = FDBX;  CODE = C<0>I;     P<FDB> = FDBY;
       I = CX$$;        P<FDB> = FDBX;  CX$$ = I;         P<FDB> = FDBY;
       I = EX$$;        P<FDB> = FDBX;  EX$$ = I;         P<FDB> = FDBY;
       BTEMP = $IBM;    P<FDB> = FDBX;  $IBM = BTEMP; 
  
                          END 
                        ELSE  P<FDB> = FDBX;
                      END 
                  P<KEYWORDS> = LOC(OUT$PARS);
                  WHYLE (THIS(PTR) EQ CH"COMMA")  DO
                    BEGIN 
                      GETPARM;
  
        SWITCH  OUT$SW   OUT$MAX, OUT$NOS, OUT$REW, OUT$HRL, OUT$CPA, 
                         OUT$LX,  OUT$RX,  OUT$RFM, OUT$BLK, OUT$LRL, 
                         OUT$IRL, OUT$COD, OUT$CX,  OUT$EX,  OUT$DCT, 
                         OUT$KEY, OUT$BGD, OUT$;
  
          GOTO  OUT$SW[KEY];
  
 OUT$MAX: 
        IF  KEYVAL LS 1 OR KEYVAL GR 16777215 
          THEN  ERROR(ERR"OUT$2");
        ELSEIF  RMAX NQ 0 
          THEN  ERROR(ERR"OUT$3");
          ELSE  RMAX = KEYVAL;
        IF  THIS(PTR) EQ "/"  THEN
          BEGIN 
            C = NEXT(PTR);
            CASE (C EQ "R") 
              MAXFIL = MAX$R; 
              ADVANCE(PTR); 
            ORCASE (C EQ "S") 
              MAXFIL = MAX$S; 
              ADVANCE(PTR); 
            ORCASE (C EQ "P") 
              MAXFIL = MAX$P; 
              ADVANCE(PTR); 
            OTHERWISE 
              ERROR(ERR"OUT$2");
            ESAC; 
          END 
        GOTO  OUT$$;
  
 OUT$NOS: 
        IF  NOSEC 
          THEN  ERROR(ERR"OUT$4");
          ELSE  NOSEC = TRUE; 
        GOTO  OUT$$;
  
 OUT$REW: 
        IF  C<0,10>KEYVAL NQ "N" AND C<0,10>KEYVAL NQ "R" AND 
            C<0,10>KEYVAL NQ "U"
          THEN  ERROR(ERR"OUT$5");
        ELSEIF  B<0,6>REW NQ 0
          THEN  ERROR(ERR"OUT$6");
          ELSE  REW = C<0>KEYVAL; 
        GOTO  OUT$$;
  
 OUT$HRL: 
        IF  HRL$$ NQ 0
          THEN  ERROR(ERR"OUT$7");
          ELSE  HRL$$ = OWN$LINK(KEYVAL); 
        GOTO  OUT$$;
  
 OUT$CPA: 
        IF  DCA$$ NQ 0
          THEN  ERROR(ERR"OUT$8");
        ELSEIF  KEYVAL GQ 0 AND KEYVAL LQ 63
          THEN  DCA$$ = KEYVAL; 
          ELSE  DCA$$ = OWN$LINK(KEYVAL); 
        GOTO  OUT$$;
  
 OUT$LX:  
        IF  LX$$ NQ 0 
          THEN  ERROR(ERR"OUT$9");
          ELSE  LX$$ = OWN$LINK(KEYVAL);
        GOTO  OUT$$;
  
 OUT$RX:  
        IF  RX$$ NQ 0 
          THEN  ERROR(ERR"OUT$10"); 
          ELSE  RX$$ = OWN$LINK(KEYVAL);
        GOTO  OUT$$;
  
 OUT$RFM: 
        IF  C<0,10>KEYVAL NQ "F"   AND C<0,10>KEYVAL NQ "V"   AND 
            C<0,10>KEYVAL NQ "U"   AND C<0,10>KEYVAL NQ "FB"  AND 
            C<0,10>KEYVAL NQ "VB"  AND C<0,10>KEYVAL NQ "VSB" 
          THEN  ERROR(ERR"OUT$11"); 
        ELSEIF  B<0,18>RECFM NQ 0 
          THEN  ERROR(ERR"OUT$12"); 
          ELSE  RECFM = C<0,3>KEYVAL; 
        $IBM = TRUE;
        GOTO  OUT$$;
  
 OUT$BLK: 
        IF  KEYVAL GR 32760 
          THEN  ERROR(ERR"OUT$13"); 
        ELSEIF  BLKSIZE NQ 0
          THEN  ERROR(ERR"OUT$14"); 
          ELSE  BLKSIZE = KEYVAL; 
        $IBM = TRUE;
        GOTO  OUT$$;
  
 OUT$LRL: 
        IF  KEYVAL GR 32760 
          THEN  ERROR(ERR"OUT$15"); 
        ELSEIF  LRECL NQ 0
          THEN  ERROR(ERR"OUT$16"); 
          ELSE  LRECL = KEYVAL; 
        $IBM = TRUE;
        GOTO  OUT$$;
  
 OUT$IRL: 
        IF  KEYVAL GR 131071
          THEN  ERROR(ERR"OUT$17"); 
        ELSEIF  IRL NQ 0
          THEN  ERROR(ERR"OUT$18"); 
          ELSE  IRL = KEYVAL; 
        GOTO  OUT$$;
  
 OUT$COD: 
        IF  C<0,10>KEYVAL NQ "A" AND C<0,10>KEYVAL NQ "C" AND 
            C<0,10>KEYVAL NQ "E"
          THEN  ERROR(ERR"OUT$19"); 
        ELSEIF  B<0,6>CODE NQ 0 
          THEN  ERROR(ERR"OUT$20"); 
          ELSE  CODE = C<0>KEYVAL;
        $IBM = TRUE;
        GOTO  OUT$$;
  
 OUT$CX:  
        IF  CX$$ NQ 0 
          THEN  ERROR(ERR"OUT$21"); 
          ELSE  CX$$ = OWN$LINK(KEYVAL);
        $IBM = TRUE;
        GOTO  OUT$$;
  
 OUT$EX:  
        IF  EX$$ NQ 0 
          THEN  ERROR(ERR"OUT$22"); 
          ELSE  EX$$ = OWN$LINK(KEYVAL);
        GOTO  OUT$$;
  
 OUT$DCT: 
        IF  DCT$$ NQ 0
          THEN  ERROR(ERR"OUT$23"); 
          ELSE  DCT$$ = OWN$LINK(KEYVAL); 
        GOTO  OUT$$;
  
 OUT$KEY: 
        IF  OUTKEY
          THEN  ERROR(ERR"OUT$24"); 
          ELSE
            BEGIN 
              OUTKEY = TRUE;
              NEGKEY = SIGN;
              TRANSFORML = TRANSFORML OR NEGKEY;
              KEYSTART = KEYVAL;
              KEY$SIZ = KEYSIZE;
            END 
        GOTO  OUT$$;
  
 OUT$BGD: 
        FOR I=BGDTYPE"C" STEP 1 UNTIL BGDTYPE"Z" DO 
          IF C<0,10>KEYVAL EQ C<I>BGDPAR
            THEN GOTO BGDOK;
        I = BGDTYPE"C"; 
        ERROR( ERR"OUT$25" ); 
BGDOK:  
        IF BGD NQ S"C"
          THEN ERROR( ERR"OUT$26" );
        BGD = I;
        GOTO  OUT$$;
  
 OUT$:                       # MISSING PARAMETER                       #
        IF  THIS(PTR) NQ CH"SPACE" AND THIS(PTR) NQ CH"EOS" 
          THEN  ERROR(ERR"OUT$27"); 
          ELSE  GETCARD;
  
 OUT$$: 
                    END      # PARAMETER LOOP                          #
                END 
            END 
  
      ORCASE (KEYWORD EQ "SEQ") 
        P<FDB> = GETLFN (OLD$FILE); 
        IF  LOC(FDB) NQ 0  THEN 
          BEGIN 
            IF  THIS(PTR) EQ CH"EQUAL"
              THEN
                BEGIN 
                  FDBX = LOC(FDB);
                  FDBY = GETLFN(OLD$FILE);
                  IF  FDBX EQ FDBY  THEN
                    ERROR (ERR"GETL$2");
                  ELSEIF  FDBY NQ 0  THEN 
                    BEGIN 
  
      I = SEQ$;  J = SEQNEXT;  K = SEQADD;
      P<FDB> = FDBX;
      SEQ$ = I;  SEQNEXT = J;  SEQADD = K;
  
                    END 
                  ELSE  P<FDB> = FDBX;
                END 
            $SEQ = TRUE;
            P<KEYWORDS> = LOC(SEQ$PARS);
            WHYLE (THIS(PTR) EQ CH"COMMA")  DO
              BEGIN 
                GETPARM;
  
        SWITCH  SEQ$SW  SEQ$NBR, SEQ$BEG, SEQ$ADD, SEQ$X; 
  
          GOTO  SEQ$SW[KEY];
  
 SEQ$NBR: 
        IF  SEQ$ NQ 0 
          THEN  ERROR(ERR"SEQ$1");
          ELSE  SEQ$ = LOC(STRING); 
        GOTO  SEQ$$;
  
 SEQ$BEG: 
        IF  SEQNEXT GQ 0
          THEN  ERROR(ERR"SEQ$2");
          ELSE  SEQNEXT = KEYVAL; 
        GOTO  SEQ$$;
  
 SEQ$ADD: 
        IF  SEQADD NQ 0 
          THEN  ERROR(ERR"SEQ$3");
          ELSE  SEQADD = KEYVAL;
        GOTO  SEQ$$;
  
 SEQ$X: 
        IF  THIS(PTR) NQ CH"SPACE" AND THIS(PTR) NQ CH"EOS" 
          THEN  ERROR(ERR"SEQ$4");
          ELSE  GETCARD;
  
 SEQ$$: 
              END            # PARAMETER LOOP                          #
  
#           IF NBR WAS GIVEN, PARSE IT NOW.                            #
  
            IF SEQ$ NQ 0 THEN 
              BEGIN 
                P<STRING> = SEQ$;  # SET UP 'STRING' FOR GET$CON$QAL   #
                KEYWORD = "SEQ";   # SINCE 'GETPARM' ZAPPED 'KEYWORD'  #
                SEQ$ = GET$CON$QAL; 
              END;
  
          END 
  
      ORCASE (KEYWORD EQ "PAG" OR KEYWORD EQ "PRT") 
        P<FDB> = GETLFN (OLD$FILE); 
        IF  LOC(FDB) NQ 0  THEN 
          BEGIN 
            IF  THIS(PTR) EQ CH"EQUAL"
              THEN
                BEGIN 
                  FDBX = LOC(FDB);
                  FDBY = GETLFN(OLD$FILE);
                  IF  FDBX EQ FDBY  THEN
                    ERROR (ERR"GETL$2");
                  ELSEIF  FDBY NQ 0  THEN 
                    BEGIN 
  
      C<0>I = PAGFMT;  J = PGL;  K = TOPSIZE;  L = TTL$;
      P<FDB> = FDBX;
      PAGFMT = C<0>I;  PGL = J;  TOPSIZE = K;  TTL$ = L;
  
                    END 
                  ELSE  P<FDB> = FDBX;
                END 
            $PAG = TRUE;
            P<KEYWORDS> = LOC(PAG$PARS);
            WHYLE (THIS(PTR) EQ CH"COMMA")  DO
              BEGIN 
                GETPARM;
  
        SWITCH  PAG$SW  PAG$FMT, PAG$PGL, PAG$TOP, PAG$TTL, PAG$; 
  
          GOTO  PAG$SW[KEY];
  
 PAG$FMT: 
        IF  C<0,10>KEYVAL NQ "1" AND C<0,10>KEYVAL NQ "2" AND 
            C<0,10>KEYVAL NQ "A" AND C<0,10>KEYVAL NQ "D" 
          THEN  ERROR(ERR"PAG$1");
        ELSEIF  B<0,6>PAGFMT NQ 0 
          THEN  ERROR(ERR"PAG$2");
          ELSE  PAGFMT = C<0>KEYVAL;
        TRANSFORML = TRANSFORML OR B<0,6>PAGFMT EQ CH"ONE"
                                OR B<0,6>PAGFMT EQ CH"TWO"; 
        GOTO  PAG$$;
  
 PAG$PGL: 
        IF  PGL NQ 0
          THEN  ERROR(ERR"PAG$3");
          ELSE  PGL = KEYVAL; 
        GOTO  PAG$$;
  
 PAG$TOP: 
        IF  TOPSIZE NQ 0
          THEN  ERROR(ERR"PAG$4");
          ELSE  TOPSIZE = KEYVAL; 
        GOTO  PAG$$;
  
 PAG$TTL: 
        IF  TTL$ NQ 0 
          THEN  ERROR(ERR"PAG$5");
          ELSE  TTL$ = LOC(STRING); 
        GOTO  PAG$$;
  
 PAG$:  
        IF  THIS(PTR) NQ CH"SPACE" AND THIS(PTR) NQ CH"EOS" 
          THEN  ERROR(ERR"PAG$6");
          ELSE  GETCARD;
  
 PAG$$: 
              END            # PARAMETER LOOP                          #
          END 
  
      ORCASE (KEYWORD EQ "XEQ") 
        P<KEYWORDS> = LOC(XEQ$PARS);
        WHYLE  (THIS(PTR) EQ CH"COMMA" OR THIS(PTR) EQ CH"LPAREN")  DO
          BEGIN 
            GETPARM;
  
        SWITCH  XEQ$SW  XEQ$IX, XEQ$FEX, XEQ$FIN, XEQ$; 
  
          GOTO  XEQ$SW[KEY];
  
 XEQ$IX:  
        IF  IX$$ NQ 0 
          THEN  ERROR(ERR"XEQ$1");
          ELSE  IX$$ = OWN$LINK(KEYVAL);
        GOTO  XEQ$$;
  
 XEQ$FEX: 
        IF  FEX$$ NQ 0
          THEN  ERROR(ERR"XEQ$2");
          ELSE  FEX$$ = OWN$LINK(KEYVAL); 
        GOTO  XEQ$$;
  
 XEQ$:  
        IF  THIS(PTR) NQ CH"SPACE" AND THIS(PTR) NQ CH"EOS" 
          THEN  ERROR(ERR"XEQ$3");
          ELSE  GETCARD;
  
 XEQ$FIN:                    # ALLOW BUT IGNORE FOR 1.0 COMPATIBILITY  #
 XEQ$$: 
          END                # PARAMETER LOOP                          #
  
      ORCASE (KEYWORD EQ "CON") 
        P<FDB> = GETLFN (OLD$FILE); 
        IF  LOC(FDB) NQ 0  THEN 
          BEGIN 
            IF  $CON
              THEN  ERROR(ERR"CON$1");
            ELSEIF  THIS(PTR) EQ CH"EQUAL"
              THEN
                BEGIN 
                  FDBX = LOC(FDB);
                  FDBY = GETLFN (OLD$FILE); 
                  IF  FDBX EQ FDBY  THEN
                    ERROR (ERR"GETL$2");
                  ELSEIF  FDBY NQ 0  THEN 
                    BEGIN 
                      I = CON$;  P<FDB> = FDBX; CON$ = I; 
                      $CON = I NQ 0;
                    END 
                END 
              ELSE
                BEGIN 
                  $IBM = TRUE;
                  $CON = TRUE;
                  CON$ = GET$CON$QAL + 1; # POINT TO TEXT ITSELF       #
                END 
          END 
  
      ORCASE (KEYWORD EQ "QAL") 
        P<FDB> = GETLFN (OLD$FILE); 
        IF  LOC(FDB) NQ 0  THEN 
          BEGIN 
            IF  $QAL
              THEN  ERROR(ERR"QAL$1");
            ELSEIF  THIS(PTR) EQ CH"EQUAL"
              THEN
                BEGIN 
                  FDBX = LOC(FDB);
                  FDBY = GETLFN (OLD$FILE); 
                  IF  FDBX EQ FDBY  THEN
                    ERROR (ERR"GETL$2");
                  ELSEIF  FDBY NQ 0  THEN 
                    BEGIN 
                      I = QAL$;  P<FDB> = FDBX; QAL$ = I; 
                      $QAL = I NQ 0;
                    END 
                END 
              ELSE
                BEGIN 
                  $QAL = TRUE;
                  QAL$ = GET$CON$QAL; 
                END 
          END 
  
      ORCASE (KEYWORD EQ "REF") 
        P<FDB > = GETLFN (OLD$FILE);
        IF  LOC(FDB) NQ 0  THEN 
          BEGIN 
            IF  $REF
              THEN  ERROR(ERR"REF$1");
            ELSEIF  THIS(PTR) EQ CH"EQUAL"
              THEN
                BEGIN 
                  FDBX = LOC(FDB);
                  FDBY = GETLFN (OLD$FILE); 
                  IF  FDBX EQ FDBY  THEN
                    ERROR (ERR"GETL$2");
                  ELSEIF  FDBY NQ 0  THEN 
                    BEGIN 
                      I = REF$;  P<FDB> = FDBX; REF$ = I; 
                      $REF = I NQ 0;
                    END 
                END 
              ELSE
                BEGIN 
                  $REF = TRUE;
                  REF$ = GET$CON$QAL; 
                END 
          END 
  
      OTHERWISE              # UNRECOGNIZED DIRECTIVE                  #
        ERROR(ERR"FMC$1");
  
      ESAC;                  # END OF -CASE- GROUP                     #
  
                  IF  THIS(PTR) NQ CH"RPAREN" AND 
                      THIS(PTR) NQ CH"POINT"
                    THEN  ERROR (ERR"FMC$2"); 
                  GETCARD;   # ADVANCE TO NEXT CARD OF INPUT FILE      #
                END 
            CLOSEM (FM$IFDB);   # CLOSE INPUT FILE                     #
          END                # ALL INPUT PROCESSED                     #
CONTROL EJECT;
#  VALIDATE DIRECTIVE OPTIONS                                          #
  
        CARDPTR = 0;  RESIDUAL(PTR) = 60;   # UN-PRINT CARDS           #
  
        IF  FDB$PTR[0] EQ 0 AND IX$$ EQ 0  THEN  ERROR(ERR"VAL$6"); 
        IF  N$FILES EQ 0  THEN  ERROR(ERR"VAL$7");
        IF  OWNCOUNT NQ 0    # LOAD OWNCODE ROUTINES                   #
          THEN  FM$LUSR;
        FOR  I = 0  TO  N$FILES  DO 
          BEGIN                   # STUFF FIT FIELDS                   #
            P<FDB> = FDB$PTR[I];
            IF  LOC(FDB) EQ 0  THEN  TEST;  # SKIP IX= INPUT FILE      #
  
            CARDPTR = LOC(FDB);  RESIDUAL(CARDPTR) = 6*7; # PRINT LFN  #
            WHYLE  (RESIDUAL(CARDPTR) GR 6 AND            # ON ERROR   #
                    B<RESIDUAL(CARDPTR)-6,6>LFN EQ 0)  DO 
              RESIDUAL(CARDPTR) = RESIDUAL(CARDPTR) - 6;
  
            IF  B<0,6>REW EQ 0  THEN  REW = "N";
              J = 0;  C<0>J = REW;
              STOREF (FDB, RM$CF, J); 
            IF  LX$$ NQ 0  THEN 
              BEGIN 
                P<EXIT> = ADDRESS(UMEMORY[LX$$]); 
                STOREF (FDB, RM$LX, EXIT);
              END 
            IF  EX$$ NQ 0  THEN 
              BEGIN 
                P<EXIT> = ADDRESS(UMEMORY[EX$$]); 
                STOREF (FDB, RM$EX, EXIT);
              END 
              ELSE  STOREF (FDB, RM$EX, FM$ERXT); 
            IF  DX$$ NQ 0  THEN 
              BEGIN 
                P<EXIT> = ADDRESS(UMEMORY[DX$$]); 
                STOREF (FDB, RM$DX, EXIT);
              END 
            IF  HRL$$ NQ 0  THEN
              BEGIN 
                P<EXIT> = ADDRESS(UMEMORY[HRL$$]);
                STOREF (FDB, RM$HRL, EXIT); 
              END 
            IF  DCT$$ NQ 0  THEN
              BEGIN 
                P<EXIT> = ADDRESS(UMEMORY[DCT$$]);
                STOREF (FDB, RM$DCT, EXIT); 
              END 
            IF  CPA$$ NQ 0  THEN
              BEGIN 
                IF  CPA$$ LS 64 
                  THEN  P<EXIT> = CPA$$;
                  ELSE  P<EXIT> = ADDRESS(UMEMORY[CPA$$]);
                IF  I EQ 0
                  THEN  STOREF (FDB, RM$DCA, EXIT); 
                  ELSE  STOREF (FDB, RM$CPA, EXIT); 
              END 
  
            IF  IFETCH (FDB, RM$OC) NQ OC$OPEN  THEN    # OPEN FILE    #
              BEGIN 
                STOREF (FDB, RM$OF, OF$N);
                STOREF (FDB,RM$ORG,RM$NEW); 
                STOREF (FDB, RM$DFC, DFC$ALL);
                STOREF (FDB, RM$EFC, EFC$ALL);
                STOREF (FDB, RM$ERL, 2);
                IF  I EQ 0
                  THEN
                    BEGIN 
                    OPENM( FDB, RM$INPUT ); 
                    RESIDUAL( FM$PKEY ) = IFETCH( FDB, RM$KL )*6; 
                    USED( FM$PKEY ) = IFETCH( FDB, RM$KP )*6; 
                    IF FILORG EQ FO$AK AND IFETCH( FDB, RM$ORG ) GQ 0 
                      THEN
                        BEGIN 
                        FM$PKEY = 0;
                        RESIDUAL( FM$PKEY ) = 60; 
                        END 
                    END 
                  ELSE  OPENM (FDB, RM$NEW);
                CHECKOPEN( FDB ); 
                IF IFETCH( FDB, RM$MRL ) EQ 0   #THE CRM DEFAULT OF 0  #
                   THEN ERROR( ERR"VAL$9" );    #WILL NOT WORK IN FORM #
              END 
            FILORG = IFETCH (FDB, RM$FO); 
  
            IF  FILORG EQ FO$SQ 
              THEN
                BEGIN 
                  IF  POS NQ 0  THEN
                    BEGIN 
                      CASE (POSFIL EQ POS$P)
                        FM$SKPP(FDB,POS); 
                      ORCASE (POSFIL EQ POS$R)
                        FM$SKPR(FDB,POS); 
                      ORCASE (POSFIL EQ POS$S)
                        FM$SKPS(FDB,POS); 
                      ESAC; 
                    END 
  
  
                  IF  $IBM  THEN
        BEGIN 
          IF  CODE NQ "A"  THEN  CODE = "C";  # VALIDATE FIELDS        #
          IF  B<0,18>RECFM EQ 0  THEN 
            BEGIN 
              ERROR (ERR"VAL$1"); 
              $IBM = FALSE; 
            END 
          IF  BLKSIZE EQ 0  THEN
            BEGIN 
              ERROR (ERR"VAL$2"); 
              $IBM = FALSE; 
            END 
          IF  LRECL EQ 0  THEN  LRECL = BLKSIZE;
          IF  IRL EQ 0  THEN  IRL = (4*LRECL + 2)/3;
  
          L = 6 + (2*LRECL+14)/15;  L = L + (2*BLKSIZE+14)/15;
          P<WSA> = CMM$ALF(L, 0, 0);
          WSA$ = LOC(WSA);
          IF  I EQ 0
            THEN  FILE$USE = "R"; 
            ELSE  FILE$USE = "W"; 
          FILE$CODE = CODE; 
          FILE$BLKSZ = FM$CV5D(BLKSIZE);
          FILE$RECL  = FM$CV5D(LRECL);
          FILE$RECFM = RECFM; 
  
          IF  NOT L$IBMR AND I EQ 0  THEN 
            BEGIN 
              J = FDL$LDC (LOADGROUP, TESTT, FM$PASS, FM$LIST); 
              IF  J NQ 0 AND J NQ 6 
                THEN  ERROR(ERR"LDC$1");
            END 
          IF  NOT L$IBMW AND I NQ 0  THEN 
            BEGIN 
              FOR  K=1 TO 3  DO 
                BEGIN 
                  J = FDL$LDC (LOADGROUP, TEST6[K], FM$PASS, FM$LIST);
                  IF  J NQ 0 AND J NQ 6 
                    THEN  ERROR(ERR"LDC$1");
                END 
            END 
          IF  NOT (L$IBMR OR L$IBMW)  THEN
            BEGIN 
              J = FDL$LDC (LOADGROUP, LXFILE, FM$PASS, FM$LIST);
              IF  J NQ 0 AND J NQ 6 
                THEN  ERROR(ERR"LDC$1");
            END 
  
          IF  $IBM  THEN  XFILE (FDB, WSA, FILEPARM, L);
  
        END 
  
                  IF  $PAG  THEN
        BEGIN 
          IF B<0,6>PAGFMT EQ 0
          THEN
            BEGIN 
            PAGFMT = "1";               #DEFAULT# 
            TRANSFORML = TRUE;
            END 
          IF  PGL EQ 0  THEN  PGL = 60; 
          IF  TOPSIZE EQ 0  THEN  TOPSIZE = 3;
          IF  PAGFMT EQ "A"  THEN 
            BEGIN 
              $PAG = FALSE; 
              IF  TTL$ NQ 0  THEN 
                BEGIN 
                  P<STRING> = TTL$; 
                  J = RESIDUAL(STRING$PTR)/6; 
                  IF  $IBM
                    THEN
                      BEGIN 
                        TITL$COUNT = FM$CV5D(J);
                        P<WSA> = WSA$;
                        IF  XWRITE (WSA, STRING[1], TITLCONV) NQ 0
                          THEN  ERROR(ERR"VAL$3");
                      END 
                    ELSE
                      BEGIN 
                        PUT (FDB, STRING[1], J);
                      END 
                END 
            END 
              IF  PAGFMT EQ "D"  THEN 
                BEGIN 
                  IF  $IBM  THEN  ERROR (ERR"VAL$8"); 
                END 
        END 
  
                END 
              ELSE           # FILEORG NQ SQ                           #
                BEGIN 
                  IF  $IBM OR $PAG  THEN
                    BEGIN 
                      ERROR (ERR"VAL$4"); 
                      $IBM = FALSE; 
                      $PAG = FALSE; 
                      $CON = FALSE; 
                    END 
                END 
  
            IF  $SEQ  THEN
              BEGIN 
                IF  SEQNEXT LS 0  THEN  SEQNEXT = 1;
                IF  SEQADD  LQ 0  THEN  SEQADD  = 1;
                IF  SEQ$ EQ 0  THEN 
                  BEGIN 
                    ERROR(ERR"VAL$5");
                    $SEQ = FALSE; 
                  END 
              END 
  
            IF  I EQ 0 AND $IBM  THEN  L$IBMR = TRUE; 
            IF  I NQ 0 AND $IBM  THEN  L$IBMW = TRUE; 
            IF  $QAL  THEN  L$QAL = TRUE; 
            IF  $REF  THEN  L$REF = TRUE; 
            IF  $SEQ  THEN  L$SEQ = TRUE; 
            IF  $PAG  THEN  L$PAG = TRUE; 
            TRANSFORML = TRANSFORML  OR  L$REF  OR  L$SEQ;
            TRANSFORMG = TRANSFORMG  OR  TRANSFORML;
  
            IF  IRL EQ 0  THEN  IRL = IFETCH (FDB, RM$MRL); 
            IRL$MAX = MAX(IRL$MAX, IRL);
  
          END 
  
        IF  ERROR$COUNT NQ 0  THEN  FM$ABRT;
        IF  L$IBMR OR L$IBMW  THEN
          IF  FDL$ULC (LOADGROUP, LXFILE, FM$PASS) NQ 0 
            THEN  ERROR(ERR"ULC$1");
  
      END  # FM$CRAK #
      TERM
