*DECK FMPARSE 
      FUNC  FM$PARS (INREC,OUTREC,OUTSIZE,CSTRING,ERRFLAG,CONV$OK)  B;
      ITEM
        INREC    U,          # INPUT RECORD                            #
        OUTREC   U,          # OUTPUT RECORD                           #
        OUTSIZE  U,          # CURRENT OUTPUT RECORD SIZE (MAX)        #
        CSTRING  U,          # TEST/CONVERSION SPECIFICATION           #
        ERRFLAG  B,          # ERROR FLAG                              #
        CONV$OK  B;          # FLAG IF CONVERSION IS ALLOWED           #
#                                                                      #
#  FMPARSE RETURNS THE RESULT OF THE TEST IF THIS IS A QAL PARSE       #
#          RETURNS FALSE  IF ANY ERRORS WERE FOUND                     #
  
      BEGIN 
#CALL FMCOM                                                            #
CONTROL NOLIST; 
*CALL FMCOM 
CONTROL LIST; 
  
      XREF
        BEGIN 
          PROC  FM$ERR; 
          FUNC  FM$TEST I;
          FUNC  FM$CONV I;
          FUNC  FM$THIS S:CH; 
          FUNC  FM$NEXT S:CH; 
          FUNC  FM$TNBL S:CH; 
          FUNC  FM$NNBL S:CH; 
          FUNC  FM$GTNM  I; 
          PROC  FM$GTST ; 
          FUNC  FM$MIN  I;
          FUNC  FM$MAX  I;
          FUNC  FM$MOD  I;
          ITEM  FM$PKEY  U; 
          ITEM  FM$PKYA  U; 
        END 
  
# ERROR MESSAGE DATA                                                   #
  
      STATUS  ERR            # ORDINALS OF MESSAGES IN ERR$MSG         #
        PAR$1,  PAR$2,  PAR$3,  PAR$4,  PAR$5,  PAR$6,  PAR$7,  PAR$8,
        PAR$9,  PAR$10, PAR$11, PAR$12, PAR$13, PAR$14, PAR$15, PAR$16, 
        PAR$17, 
        SPC$1,  SPC$2,  SPC$3,  SPC$4,
        ITM$1,  ITM$2,  ITM$3,  ITM$4,  ITM$5,  ITM$6,  ITM$7,  ITM$8,
        ITM$9,  ITM$10, ITM$11, ITM$12, ITM$13, ITM$14, ITM$15, ITM$16, 
        APP$1,
        PSH$1,
        LAST$ERR; 
  
      ARRAY ERR$MSG [0:120] S(1); 
        ITEM  ERR$MSG$TEXT  C(0,0,10) = [ 
  
#  PAR$1         #
      "CONVERSION"," NOT ALLOW","ED HERE  :", 
#  PAR$2         #
      "MISSING SE","PARATOR  :",
#  PAR$3         #
      "FIELD NOT ","IN RECORD ","ON LEFT  :", 
#  PAR$4         #
      "FIELD BEYO","ND RECORD ","ON LEFT  :", 
#  PAR$5         #
      "FIELD NOT ","IN RECORD ","ON RIGHT :", 
#  PAR$6         #
      "FIELD BEYO","ND RECORD ","ON RIGHT :", 
#  PAR$7         #
      "CONVERSION"," ERROR   :",
#  PAR$8         #
      "TEST NOT A","LLOWED HER","E        :", 
#  PAR$9         #
      "MISSING OP","ERATOR   :",
#  PAR$10        #
      "TEST CONVE","RSION ERRO","R        :", 
#  PAR$11        #
      "REPEAT COU","NT NOT VAL","ID       :", 
#  PAR$12        #
      "COLON NOT ","VALID    :",
#  PAR$13        #
      "SYNTAX ERR","OR AT COMM","A        :", 
#  PAR$14        #
      "NO CONVERS","ION SPEC S","EEN      :", 
#  PAR$15        #
      "CANNOT -QU","IT- TEST :",
#  PAR$16        #
      "MISSING RI","GHT PARENT","HESIS    :", 
#  PAR$17        #
      "KEYA NOT D","EFINED AT ","THIS POINT","         :",
#  SPC$1         #
      "UNRECOGNIZ","ED OPERATI","ON       :", 
#  SPC$2         #
      "+/- INVALI","D ON REPEA","T COUNT  :", 
#  SPC$3         #
      "SEARCH INV","ALID ON DE","STINATION ","SPEC     :",
#  SPC$4         #
      "K-- NOT KE","Y OR KEYA ","         :", 
#  ITM$1         #
      "MISSING RI","GHT-SIDE O","F SPECIFIC","ATION    :",
#  ITM$2         #
      "DIGIT DOES"," NOT FOLLO","W +/-    :", 
#  ITM$3         #
      "+/- INVALI","D ON REPEA","T COUNT  :", 
#  ITM$4         #
      "BIT SPECIF","IER NOT NU","MERIC    :", 
#  ITM$5         #
      "BIT NUMBER"," > 6     :",
#  ITM$6         #
      "DIGIT DOES"," NOT FOLLO","W +/-    :", 
#  ITM$7         #
      "+/- INVALI","D ON REPEA","T COUNT  :", 
#  ITM$8         #
      "LITERAL RE","PLACEMENT ","> 80 CHARA","CTERS    :",
#  ITM$9         #
      "LITERAL FO","LLOWED BY ","-T- CODE :", 
#  ITM$10        #
      "POSITION O","R REPEAT N","OT VALID W","ITH -Q-  :",
#  ITM$11        #
      "UNRECOGNIZ","ED DATA TY","PE       :", 
#  ITM$12        #
      "BIT POSITI","ON ONLY VA","LID WITH T","YPE -B-  :",
#  ITM$13        #
      "DIGIT DOES"," NOT FOLLO","W +/-    :", 
#  ITM$14        #
      "CANT SEARC","H WITH BIT"," OFFSET  :", 
#  ITM$15        #
      "MISSING -N","- SPECIFIE","R IN -OLN-","         :",
#  ITM$16        #
      "+/- INVALI","D ON SIZE ","SPECIFIER ","         :",
#  APP$1         #
      "INVALID LO","GICAL TERM","         :", 
#  PSH$1         #
      "TOO MANY P","ARENTHESIS"," LEVELS  :", 
#  LAST$MSG      #
      "******** :" ]; 
  
# THE STATUS LIST BELOW CARRIES THE PRECEDENCE VALUES FOR PARSING      #
#   TEST AND CONVERSION SPECIFICATIONS.  THE ORDER IS CRITICAL, AS     #
#   RELATIVE VALUES ARE USED TO DETERMINE OPERATOR BINDING STRENGTH.   #
  
      STATUS  PR
        CVAL,           # 0    CONVERSION SPEC/VALUE                   #
        TVAL,           # 1    TEST SPEC/VALUE                         #
        NOT,            # 2    LOGICAL OPERATORS                       #
        AND,            # 3    LOGICAL OPERATORS                       #
        OR,             # 4    LOGICAL OPERATORS                       #
        LPAR,           # 5    LEFT PARENTHESIS                        #
        COLON,          # 6    COLON BETWEEN TEST/CONV                 #
        COMMA,          # 7    CONVERSION ITEM SEPARATOR               #
        SEMI,           # 8    END OF ALTERNATIVE CONVERSION SPEC      #
        RPAR,           # 9    RIGHT PARENTHESIS                       #
        QUIT,           #10    -P- CONVERSION SPEC                     #
        EOS;            #11    END OF CONVERSION STRING                #
  
      DEF  STK$LEVELMAX  # 32 #;
  
      ARRAY  STACK [0:STK$LEVELMAX] S(1); 
        ITEM
          STACKWORD   U(0),       # FULL WORD ENTRY                    #
          STACKOP  S:PR(0,54,6),  # OPERATION STACKED                  #
          STACKVAL    I(0,6,48),  # VALUE STACKED OR REPEAT COUNT      #
          STACKTEST   B(0,3,3),   # TEST AND CONVERSION VALIDITY BITS  #
          STACKCONV   B(0,0,3);   #   (USED WHEN STACKING -(-)         #
  
      DEF  POP    # STACK$LEVEL = STACK$LEVEL - 1 #;
      DEF  OP(I)   # STACKOP [STACK$LEVEL +(I)] #;
      DEF  VAL(I)  # STACKVAL[STACK$LEVEL +(I)] #;
  
      ITEM                   # LOCAL ITEMS                             #
        ANYOLN       B, 
        CHR          S:CH,
        PTR          U, 
        RPT$COUNT    I, 
        RSLT         U, 
        STACK$LEVEL  I, 
        TMP          I, 
        TOP          S:PR,
        V$CONV       B, 
        V$TEST       B; 
  
        ITEM  LEGAL$TYPES  U = O" 37041 02450 00000 00000 ";
        ARRAY  SPECS [0:1] S(1);
          ITEM  SPEC$BITS  U(0) = 
            [O" 37041 12457 77772 00000 ",   # LEFT                    #
             O" 37041 02457 77762 00000"];  # RIGHT                    #
  
CONTROL EJECT;
 #
* *   FMPARSE - PERFORM QUALIFICATION AND REFORMATTING. 
* *   M.T. KAUFMAN
* 1DC FMPARSE 
* 
* DC  FUNCTION
* 
*     PERFORM THE RECORD QUALIFICATION AND REFORMATTING FUNCTIONS.
* 
*     PARSES AND INTERPRETS QAL AND REF STRINGS.  CALLS THE 8-BIT 
*     SUBROUTINES (VIA FM$CONV AND FM$TEST) TO ACTUALLY PERFORM 
*     CONVERSIONS AND TESTS.
* 
*     A STANDARD OPERATOR-PRECEDENCE PARSE TECHNIQUE IS USED. 
* 
* DC  ENTRY CONDITIONS
* 
*     FM$PARS IS CALLED WITH POINTERS TO THE INPUT, CONVERSION/ 
*     QUALIFICATION AND (FOR REF) OUTPUT STRINGS.  A FLAG (CONV$OK) 
*     IS PASSED TO DIFFERENTIATE BETWEEN QAL AND REF CALLS. 
* 
* DC  EXIT CONDITIONS 
* 
*     IF AN ERROR IS DETECTED DURING PARSING, AN ERROR MESSAGE IS 
*     PRINTED AND ERR$FLAG IS SET TRUE. 
* 
*     THE FM$PARS FUNCTION VALUE IS SET TO REFLECT THE RESULT OF
*     A QAL TEST. 
* 
* DC  ERROR CONDITIONS
* 
*     MANY SYNTACTIC ERRORS ARE DIAGNOSED BY FM$PARS.  CONVERSION 
*     AND DATA ERRORS ARE DIAGNOSED BY THE 8-BIT SUBROUTINES. ALL 
*     ERRORS EVENTUALLY SET THE ERROR RETURN FLAG AND PERFORM AN EARLY
*     TERMINATION OF PARSING/CONVERSION.
* 
* DC  INTERNAL PROCEDURES 
* 
*     APPLYOP  - APPLIES THE TEST OPERATOR AT THE TOP OF THE STACK
*                (AND,OR,NOT) TO THE ONE OR TWO VALUES BELOW IT IN
*                THE STACK.  THE RESULT IS PUSHED INTO THE STACK, 
*                REPLACING THE OPERANDS AND OPERATOR. 
* 
*     PUSH     - PUSHES A VALUE, AN OPERATOR, AND STATE FLAGS 
*                INTO THE STACK.  CHECKS FOR STACK OVERFLOW.
*                (NOTE: POP IS HANDLED AS A DEF). 
* 
*     MATCH    - COMPARES A SEARCH STRING TO A SUBSTRING OF THE 
*                INPUT RECORD.  USED BY -FIND-. 
* 
*     FIND     - PERFORMS AN -0LN- TYPE SEARCH OF THE INPUT STRING
*                TO FIND CHARACTER POSITION AND LENGTH. 
* 
*     GETITM   - PARSES A SINGLE -ITM- VALUE.  A PARAMETER (LR) 
*                SELECTS LEFT-HAND-SIDE (OR DESTINATION) OR 
*                RIGHT-HAND-SIDE (OR SOURCE). 
* 
*     GETSPEC  - PARSES A COMPLETE TEST OR CONVERSION SPECIFICATION.
*                USES GETITM FOR NORMAL FORMS OF EACH SIDE. 
* 
 #
CONTROL EJECT;
CONTROL EJECT;
      PROC  APPLYOP;         # APPLY A TEST OPERATOR                   #
      BEGIN 
        ITEM  RHV  U,        # RIGHT HAND SIDE VALUE                   #
              LHV  U,        # LEFT  HAND SIDE VALUE                   #
              OPR  S:PR;     # OPERATOR                                #
  
        RHV = VAL(0); 
        IF  OP(0) NQ PR"TVAL"  THEN ERROR(ERR"APP$1");
        POP;
        OPR = OP(0); POP; 
        IF  OPR NQ S"NOT"  THEN 
          BEGIN 
            LHV = VAL(0); 
            IF  OP(0)NQ PR"TVAL"  THEN ERROR(ERR"APP$1"); 
            POP;
          END 
        CASE (OPR EQ S"AND")
          IF  LHV NQ 0  AND  RHV NQ 0  THEN  RHV = 1; ELSE RHV = 0; 
        ORCASE (OPR EQ S"OR") 
          IF  LHV NQ 0  OR   RHV NQ 0  THEN  RHV = 1; ELSE RHV = 0; 
        OTHERWISE 
          IF  # NOT #        RHV NQ 0  THEN  RHV = 0; ELSE RHV = 1; 
        ESAC; 
        PUSH(PR"TVAL",RHV); 
      END; # APPLYOP #
CONTROL EJECT;
      PROC  ERROR (TYPE);    # ERROR HANDLER FOR -FMPARSE-             #
      ITEM  TYPE  S:ERR;
      BEGIN 
        FM$ERR (CSTRING, (RESIDUAL(CSTRING)-RESIDUAL(PTR))/6 -1,
                ERR$MSG, TYPE,
                FALSE);      # NOT FATAL                               #
        ERRFLAG = TRUE; 
        GOTO  ABORT$PARSE;   # QUIT NOW                                #
  
  
      END; # ERROR #
CONTROL EJECT;
      PROC  PUSH (OPR,VA);
      ITEM
        OPR S:PR, 
        VA  U;
      BEGIN 
        IF  STACK$LEVEL GQ STK$LEVELMAX  THEN  ERROR(ERR"PSH$1"); 
        STACK$LEVEL = STACK$LEVEL + 1;
        IF OPR EQ PR"LPAR"  THEN
          BEGIN 
          IF  STACK$LEVEL GQ STK$LEVELMAX  THEN  ERROR(ERR"PSH$1"); 
            STACKWORD[STACK$LEVEL] = PTR; 
              STACK$LEVEL = STACK$LEVEL + 1;
          END 
        STACKOP  [STACK$LEVEL] = OPR; 
        STACKVAL [STACK$LEVEL] = VA;
        STACKTEST[STACK$LEVEL] = V$TEST;
        STACKCONV[STACK$LEVEL] = V$CONV;
      END;  # PUSH #
CONTROL EJECT;
      FUNC  MATCH ((PTR)) B;
      ITEM PTR; 
      BEGIN 
        ITEM  I I,  T  B; 
  
        T = TRUE; 
        FOR  I = 1 STEP 1 WHILE (I LQ T$M2) AND T  DO 
          BEGIN 
              T=(PCHAR(PTR) EQ C<I-1>T$STRING) AND (RESIDUAL(PTR) GQ 6);
            ADVANCE(PTR); 
          END 
        MATCH = T;
      END; # MATCH  # 
  
  
      FUNC FIND (REL, START, LRSTAT, NTH) I;
      ITEM
        REL     I,           # FLAG FOR RELATIVE START POSITION        #
        START   I,           # STARTING CHARACTER POSITION             #
        LRSTAT  S:LEFT$RIGHT, # FLAG FOR LEFT OR RIGHT CHAR POSITION   #
        NTH     I;            # N-TH OCCURANCE COUNT                   #
      BEGIN 
        ITEM  I I,  J I,  K I,
              PTR  I;         # TEMPORARY POINTER                      #
        IF  REL NQ 0
          THEN               # RELATIVE TO CURRENT RECORD POSITION     #
            BEGIN 
              PTR = T$INREC;
              K = REL * START;
            END 
          ELSE               # ABSOLUTE POSITION                       #
            BEGIN 
              PTR = T$RECORD; 
              K = START-1;  IF  K LS 0  THEN K=0; 
            END 
  
        I = MOD(USED(PTR),6);# ADJUST POINTER TO NEXT EVEN CHARACTER   #
        IF  I NQ 0
          THEN
            I = RESIDUAL(PTR) + I-6;
          ELSE
            I = RESIDUAL(PTR);
  
        I = I - 6*K;         # ADJUST PTR TO DESIRED STARTING CHAR     #
        I = MIN(RESIDUAL(T$RECORD), MAX(I, 0)); 
        PTR = 0;
        RESIDUAL(PTR) = I;
        I = USED(T$RECORD) + RESIDUAL(T$RECORD) - I;
        USED(PTR) = MOD(I, 60); 
        ADDRESS(PTR) = ADDRESS(T$RECORD) + (I/60);
  
        FOR  J = 1 TO  MAX(NTH,1)  DO 
          BEGIN 
            WHYLE (NOT MATCH(PTR)) AND (RESIDUAL(PTR) GQ 6)  DO 
              ADVANCE(PTR); 
            IF  J LS NTH  THEN
              FOR  I = 1 TO T$M2  DO  ADVANCE(PTR); 
          END 
        IF  LRSTAT EQ S"LEFT" 
          THEN
            I = RESIDUAL(PTR);
          ELSE
            I = MAX(RESIDUAL(PTR)-6*T$M2, 0); 
  
        FIND = 1 + (RESIDUAL(T$RECORD)-I)/6 ; 
      END;
CONTROL EJECT;
      PROC  GETITM (LR);     # PARSE A COMPLETE  ITM  SPECIFICATION    #
      ITEM  LR S:LEFT$RIGHT;
      BEGIN 
        ITEM
          REL  U, 
          I    I, 
          W    U, 
          T    S:CH,
          M    U, 
          REL2 I, 
          J    I, 
          SIDE S:LEFT$RIGHT;
  
  
        CHR = TNBL(PTR);     # START.                                  #
        IF  B<MIN(CHR,59)>SPEC$BITS[LR]  EQ 0  THEN   # NULL SPEC      #
          BEGIN 
            IF  LR EQ S"RIGHT"  THEN  ERROR(ERR"ITM$1");
            RETURN; 
          END 
  
        CASE (CHR EQ CH"PLUS" OR CHR EQ CH"MINUS")    # GET +/-        #
          IF  CHR EQ CH"PLUS"  THEN  REL = +1;  ELSE  REL = -1; 
          CHR = NNBL(PTR);
          IF  NOT NUMERIC(CHR)  THEN  ERROR(ERR"ITM$2");
        ORCASE (NUMERIC(CHR) OR CHR EQ CH"LPAREN")
          REL = 0;
        OTHERWISE 
          REL = +2;          # MEANS CONTINUE FROM CURRENT POINT       #
        ESAC; 
  
        IF  NUMERIC(CHR)     #                          GET  I         #
          THEN
            BEGIN 
              I = GETNUM(PTR);
              CHR = TNBL(PTR);
            END 
          ELSE
            I = ALLONES;
  
        W = -1; 
        CASE (CHR EQ CH"LPAREN")    #   I(  -NESTED SPEC               #
          IF  REL NQ 0  THEN  ERROR(ERR"ITM$3");
          T$I1 = I;          # THIS IS A LEFT-SIDE CONSTRUCT ONLY      #
          T$T1 = CHR; 
          ADVANCE(PTR); 
          RETURN; 
        ORCASE (CHR EQ CH"SLASH")   #   I/W  BIT SPECIFICATION         #
          CHR = NNBL(PTR);
          IF  NOT NUMERIC(CHR)  THEN  ERROR(ERR"ITM$4");
          W = GETNUM(PTR);
          IF  W GR 6  THEN  ERROR(ERR"ITM$5");
        ORCASE (CHR EQ CH"DOLLAR" OR CHR EQ CH"STAR")   # LITERAL      #
          GETSTRING(PTR); 
          CHR = TNBL(PTR);
          CASE (CHR EQ CH"PLUS" OR CHR EQ CH"MINUS" OR NUMERIC(CHR))
            ANYOLN = TRUE;   # FLAG THAT AN OLN SPEC WAS SEEN          #
            CASE (CHR EQ CH"PLUS")
              SIDE = S"LEFT"; 
              CHR = NNBL(PTR);
            ORCASE (CHR EQ CH"MINUS") 
              SIDE = S"RIGHT";
              CHR = NNBL(PTR);
            OTHERWISE 
              SIDE = S"LEFT"; 
            ESAC; 
            IF  NOT NUMERIC(CHR)  THEN  ERROR(ERR"ITM$6");
            I = FIND( REL, I, SIDE, GETNUM(PTR)); 
            REL = 0;
          OTHERWISE                 # LITERAL TO BE USED               #
            IF  REL NQ 0 AND REL NQ +2  THEN  ERROR(ERR"ITM$7");
            IF  I GR 1  THEN
              BEGIN 
                IF  I * T$M2 GR T$STRING$MAX  THEN  ERROR(ERR"ITM$8");
                FOR J = 1 TO (I-1)*T$M2  DO 
                  C<J+T$M2>T$STRING = C<J>T$STRING; 
              END 
            IF  I EQ 0  THEN  I = 1;
            I = I * T$M2; 
            IF  LR EQ S"LEFT" 
              THEN
                BEGIN        #  SET UP  +0XM=$STRING$                  #
                  T$REL1 = +0;
                  T$REL2 = +0;
                  T$I1   =  0;
                  T$I2   =  0;
                  T$T1   = CH"X"; 
                  T$T2   = CH"ONE"; # FLAG FOR LITERAL STRING          #
                  T$M1   =  I;
                  T$M2   =  I;
                T$COND =  CONDITION"REPLACE"; 
                END 
              ELSE
                BEGIN        # SET UP RIGHT-HAND SIDE STRING           #
                  IF  T$COND EQ CONDITION"REPLACE"
                    THEN
                      BEGIN 
                        T$REL2 = +0;
                        T$I2   =  0;
                        T$T2   = CH"ONE"; 
                        T$M2   =  I;
                      END 
                    ELSE
                      BEGIN       # COMPARISONS ARE SET UP DIFFERENTLY #
                        T$I2   = 6* I;
                        T$T2   = CH"ONE"; 
                      END 
                END 
            RETURN; 
          ESAC; 
        ESAC; 
  
# WE NOW HAVE  [+/-] I [/W]  PARSED...  LOOK FOR T-M                   #
  
        CHR = THIS(PTR);
        IF  CHR EQ CH"Q" AND LR EQ S"LEFT"  THEN      # QUIT CODE      #
          BEGIN 
            IF  REL NQ +2 OR W NQ -1 OR ANYOLN  THEN
              ERROR(ERR"ITM$10");   # -Q- MUST BE BY ITSELF            #
            T$T1 = CHR; 
            ADVANCE(PTR); 
            RETURN; 
          END 
        IF  B<MIN(CHR,59)>LEGAL$TYPES EQ 0  THEN
          ERROR(ERR"ITM$11"); 
        IF  W GQ 0 AND CHR NQ CH"B"  THEN 
          ERROR(ERR"ITM$12");       # /W WITH NON-BIT TYPE             #
        T = CHR;
        CHR = NNBL(PTR);
  
        M = ALLONES;
  IF  CHR EQ CH"A"
    THEN
      BEGIN 
        J = PTR;
        CHR = NEXT(PTR);
        IF  CHR EQ CH"L" AND NEXT(PTR) EQ CH"L" 
          THEN
            BEGIN 
              M = -2;        #  FLAG -ALL-                             #
              CHR = NNBL(PTR);
            END 
          ELSE
            PTR = J;         #  NOT -ALL-                              #
      END 
    ELSE
      BEGIN 
        IF  CHR EQ CH"PLUS" OR CHR EQ CH"MINUS"  THEN 
          BEGIN 
            IF  CHR EQ CH"PLUS"  THEN  REL2 = +1; ELSE  REL2 = -1;
            CHR = NNBL(PTR);
            IF  NOT NUMERIC(CHR)  THEN  ERROR(ERR"ITM$13"); 
          END 
          ELSE
            REL2 = 0;              #ABSOLUTE POSITION FOR M SEARCH# 
        IF  NUMERIC(CHR)  THEN
          BEGIN 
            M = GETNUM(PTR);
            CHR = TNBL(PTR);
          END 
          ELSE
            REL2 = +2;             #CURRENT POSITION FOR M SEARCH#
  
        IF  CHR EQ CH"DOLLAR" OR CHR EQ CH"STAR"
          THEN
            BEGIN 
              ANYOLN = TRUE;  GETSTRING(PTR); 
              IF  W GR 0  THEN  ERROR(ERR"ITM$14");  # CANT SEARCH BITS#
              CHR = TNBL(PTR);
              CASE (CHR EQ CH"PLUS")
                SIDE = S"RIGHT";
                CHR = NNBL(PTR);
              ORCASE (CHR EQ CH"MINUS") 
                SIDE = S"LEFT"; 
                CHR = NNBL(PTR);
              OTHERWISE 
                SIDE = S"RIGHT";
              ESAC; 
              IF  NOT NUMERIC(CHR)  THEN  ERROR(ERR"ITM$15"); 
              M = FIND( REL2, M, SIDE, GETNUM( PTR ) ); 
              IF REL NQ 0 
              THEN
                BEGIN        #COMPUTE LENGTH USING CURR POS AND I#
                J = 1 + (RESIDUAL( T$RECORD ) - RESIDUAL( T$INREC ))/6; 
                IF REL NQ +2    #REL EQ -1 OR REL EQ +1#
                THEN               #I IS RELATIVE TO CURR POS#
                  M = M - MAX( 0, J + REL*I );
                ELSE               #I IS ABSENT#
                  M = M - J;
                END 
              ELSE                 #COMPUTE LENGTH USING I# 
                M = M - I;
              M = MAX( 0, M );
            END 
          ELSE
            BEGIN            # DIRECT -M- VALUE                        #
              IF  REL2 NQ 0  AND  REL2 NQ +2  THEN  ERROR(ERR"ITM$16"); 
            END 
      END 
  
# NOW PASS I-T-M VALUES BACK                                           #
  
        CASE (REL EQ 0) 
          REL = ALLONES;
        ORCASE (REL LS 0) 
          REL = +1; 
        OTHERWISE 
          REL = +0; 
        ESAC; 
        IF  W LQ 0  THEN  W = ALLONES;
      IF  M EQ -1  THEN  M = ALLONES; 
        T$M2 = ALLONES;      # RESET IN CASE OLN WAS USED              #
  
        IF  LR EQ S"LEFT" 
          THEN
            BEGIN 
              T$REL1 = REL; 
              T$I1   = I; 
              T$W1   = W; 
              T$T1   = T; 
              T$M1   = M; 
            END 
          ELSE
            BEGIN 
              T$REL2 = REL; 
              T$I2   = I; 
              T$W2   = W; 
              T$T2   = T; 
              T$M2   = M; 
            END 
      END # GETITM #; 
CONTROL EJECT;
      PROC  GETSPEC (PTR);   # GET A COMPLETE CONVERSION OR TEST SPEC  #
      ITEM  PTR  U; 
      BEGIN 
        ITEM  ANYOLN  B;
        T$REL1 = ALLONES;  T$W1 = ALLONES;  T$M1 = ALLONES; # BEGIN    #
        T$REL2 = ALLONES;  T$W2 = ALLONES;  T$M2 = ALLONES; # CLEAR ALL#
        T$COND = ALLONES;  ANYOLN = FALSE;                  # POINTERS #
        T$I1 = 0;  T$T1 = 0;  T$I2 = 0;  T$T2 = 0;  RPT$COUNT = 1;
  
        GETITM(LEFT$RIGHT"LEFT");     # GET LEFT SIDE ITEM             #
        IF  T$T1 EQ 0 OR T$T1 EQ CH"LPAREN" OR T$T1 EQ CH"Q"
            OR T$COND GR 0
          THEN  RETURN;      # THATS THE WHOLE THING                   #
  
        CHR = TNBL(PTR);
  
        CASE (CHR EQ CH"EQUAL")         # GET OPERATOR                 #
          T$COND = CONDITION"REPLACE";
        ORCASE (CHR EQ CH"E") 
          CHR = NEXT(PTR);
          CASE (CHR EQ CH"Q") 
            T$COND = CONDITION"EQ"; 
          OTHERWISE 
            ERROR(ERR"SPC$1");
          ESAC; 
        ORCASE (CHR EQ CH"N") 
          CHR = NEXT(PTR);
          CASE (CHR EQ CH"E" OR CHR EQ CH"Q") 
            T$COND = CONDITION"NE"; 
          OTHERWISE 
            ERROR(ERR"SPC$1");
          ESAC; 
        ORCASE (CHR EQ CH"L") 
          CHR = NEXT(PTR);
          CASE (CHR EQ CH"E" OR CHR EQ CH"Q") 
            T$COND = CONDITION"LE"; 
          ORCASE (CHR EQ CH"S" OR CHR EQ CH"T") 
            T$COND = CONDITION"LT"; 
          OTHERWISE 
            ERROR(ERR"SPC$1");
          ESAC; 
        ORCASE (CHR EQ CH"G") 
          CHR = NEXT(PTR);
          CASE (CHR EQ CH"E" OR CHR EQ CH"Q") 
            T$COND = CONDITION"GE"; 
          ORCASE (CHR EQ CH"R" OR CHR EQ CH"T") 
            T$COND = CONDITION"GT"; 
          OTHERWISE 
            ERROR(ERR"SPC$1");
          ESAC; 
        OTHERWISE            # COPY LEFT SIDE TO RIGHT SIDE            #
          T$REL2 = T$REL1;  T$REL1 = +0;
          T$I2   = T$I1  ;  T$I1   =  0;
          T$W2   = T$W1  ;  T$W1   = ALLONES; 
          T$T2 =  T$T1; 
          T$M2 = T$M1;
          T$COND = CONDITION"REPLACE";
        ESAC; 
  
        IF  T$COND EQ CONDITION"REPLACE" AND ANYOLN 
          THEN  ERROR(ERR"SPC$3");
        IF  T$T2 NQ 0  THEN  RETURN;    # DONE IF DEFAULT COPY         #
        CHR = NNBL(PTR);
  
        IF  T$COND EQ CONDITION"REPLACE" AND CHR EQ CH"K"  THEN 
          BEGIN              # KEY[A] SPECIFICATION                    #
            IF  NEXT(PTR) NQ CH"E"  THEN  ERROR(ERR"SPC$4");
            IF  NEXT(PTR) NQ CH"Y"  THEN  ERROR(ERR"SPC$4");
            IF  NEXT(PTR) EQ CH"A"
              THEN
                BEGIN        # KEYA                                    #
                  T$T2 = CH"THREE"; 
                  CHR = NEXT(PTR);
                END 
              ELSE
                BEGIN        # KEY                                     #
                  T$T2 = CH"TWO"; 
                END 
            RETURN; 
          END 
  
        GETITM(LEFT$RIGHT"RIGHT");    # GET RIGHT SIDE ITEM            #
  
      END  # GETSPEC # ;
CONTROL EJECT;
      PROC  SKIP;            # SKIP TO SEMICOLON, RPAR, OR EOS         #
      BEGIN 
        ITEM  INSTRING  B,
              PARCOUNT  I,
              DCH    S:CH;
  
        INSTRING = FALSE; 
        PARCOUNT = 0; 
        REPEAT
          BEGIN 
            CHR = NNBL(PTR);
            IF  INSTRING
              THEN
                BEGIN 
                  IF  CHR EQ DCH
                    THEN
                      INSTRING = FALSE; 
                END 
              ELSE
                BEGIN 
                  CASE (CHR EQ CH"DOLLAR" OR CHR EQ CH"STAR") 
                    INSTRING = TRUE;
                    DCH = CHR;
                  ORCASE (CHR EQ CH"LPAREN")
                    PARCOUNT = PARCOUNT + 1;
                  ORCASE (CHR EQ CH"RPAREN")
                    PARCOUNT = PARCOUNT - 1;
                  ESAC; 
                END 
           UNTYL (CHR EQ CH"EOS" OR 
                  ((NOT INSTRING) AND PARCOUNT LQ 0 AND 
                  (CHR EQ CH"SEMI" OR CHR EQ CH"RPAREN") ));
          END 
      END;  # SKIP #
CONTROL EJECT;
# BEGIN MAIN PROGRAM OF FMPARSE.  LEADING -(- WILL BE ASSUMED          #
  
      STACK$LEVEL = -1;      # INITIALIZE TO EMPTY NEXT                #
      T$RECORD  = INREC;     # INPUT RECORD DESCRIPTOR                 #
      T$INREC   = INREC;
      T$OUTREC  = OUTREC;    # OUTPUT RECORD DESCRIPTOR (CONV. ONLY    #
      PTR       = CSTRING;   # CONVERSION STRING                       #
      V$TEST    = TRUE;      # INITIAL VALIDATION FLAGS                #
      V$CONV    = CONV$OK;
      ADVANCE(PTR);          # SKIP -(- SUPPLIED BY FMCRACK            #
      PUSH (PR"LPAR", 1);    # FIRST STACK ENTRY                       #
  
      ERRFLAG = FALSE;
      FM$PARS = FALSE;
      REPEAT                 # MAIN PARSE LOOP                         #
        BEGIN 
  
          T$I1 = ALLONES; 
          CHR = TNBL(PTR);   # CLASSIFY NEXT SYNTACTIC ENTITY          #
          CASE (CHR EQ CH"LPAREN")
            TOP = S"LPAR";  ADVANCE(PTR); 
          ORCASE (CHR EQ CH"COLON" OR CHR EQ CH"PERCT") 
            TOP = S"COLON"; 
          ORCASE (CHR EQ CH"COMMA") 
            TOP = S"COMMA"; ADVANCE(PTR); 
          ORCASE (CHR EQ CH"SEMI")
            TOP = S"SEMI";  ADVANCE(PTR); 
          ORCASE (CHR EQ CH"RPAREN")
            TOP = S"RPAR";  ADVANCE(PTR); 
          ORCASE (CHR EQ CH"Q") 
            TOP = S"QUIT";
          ORCASE (CHR EQ CH"EOS") 
            TOP = S"EOS"; 
          OTHERWISE 
            I = PTR;         # SAVE AND TEST FOR AND/OR/NOT            #
            IF  CHR EQ CH"A"
              THEN IF  NEXT(PTR) EQ CH"N" 
                THEN IF  NEXT(PTR) EQ CH"D"  THEN 
                  BEGIN                                       # AND    #
                    ADVANCE(PTR); TOP = S"AND";  GOTO AND$OR$NOT; 
                  END;
            PTR = I;
            IF  CHR EQ CH"N"
              THEN IF  NEXT(PTR) EQ CH"O" 
                THEN IF  NEXT(PTR) EQ CH"T"  THEN 
                  BEGIN                                       # NOT    #
                    ADVANCE(PTR); TOP = S"NOT";  GOTO AND$OR$NOT; 
                  END;
              PTR = I;
              IF  CHR EQ CH"O"
                THEN IF  NEXT(PTR) EQ CH"R"  THEN 
                  BEGIN                                       #  OR    #
                    ADVANCE(PTR); TOP = S"OR";  GOTO AND$OR$NOT;
                  END;
              PTR = I;
              GETSPEC(PTR);  # OTHERWISE IT MUST BE A SPEC, PARSE IT.  #
              IF  T$T1 EQ CH"LPAREN"
                THEN  TOP = S"LPAR";
              ELSEIF  T$T1 EQ CH"Q" 
                THEN TOP = S"QUIT"; 
              ELSEIF  T$T1 EQ 0 
                THEN
                  BEGIN 
                    ERROR(ERR"PAR$14"); 
                    TOP = S"EOS"; 
                  END 
              ELSEIF  T$COND EQ CONDITION"REPLACE"
                THEN  TOP = S"CVAL";
                ELSE  TOP = S"TVAL";
          ESAC; 
 AND$OR$NOT:                 # END OF CLASSIFICATION                   #
  
#  PERFORM ACTION BASED ON PREVIOUS CLASSIFICATION.                    #
#    THIS IS SIMILAR TO A STANDARD PRECEDENCE PARSER                   #
  
      CASE (TOP EQ S"CVAL")  # REF ITEM (CONVERSION)                   #
        IF  NOT V$CONV  THEN  ERROR(ERR"PAR$1");  # CONV NOT ALLOWED   #
        V$TEST = FALSE;      # ALLOW ONLY CONVERSIONS FROM HERE ON     #
        IF  OP(0) NQ PR"LPAR"  THEN  ERROR(ERR"PAR$2"); # MISSING COMMA#
        IF  B<0>T$REL1 NQ 0  # SETUP DESTINATION POINTER               #
          THEN
            BEGIN 
              TMP = OUTREC;    # ABSOLUTE POSITION                     #
              I = MAX (T$I1-1, 0);
            END 
          ELSE
            BEGIN 
              TMP = T$OUTREC;  # RELATIVE POSITION                     #
              IF  T$REL1 GR 0 
                THEN  I = -T$I1;
                ELSE  I =  T$I1;
            END 
  
        K = RESIDUAL(TMP) - 6*I;  # COMPUTE DESIRED DESTINATION        #
        IF  T$W1 GR 1  THEN K = K+1 - T$W1; 
        IF  K LS 0  THEN  ERROR(ERR"PAR$3");  #OUT OF RECORD           #
        IF  K GR RESIDUAL(OUTREC)  THEN  ERROR(ERR"PAR$4"); 
        RESIDUAL(TMP) = K;
        IF  T$M1 EQ -2  THEN
          BEGIN 
            IF  T$T1 EQ CH"B" 
              THEN  T$M1 = K; 
              ELSE  T$M1 = K/6; 
          END 
        K = USED(OUTREC) + RESIDUAL (OUTREC) - K; 
        USED(TMP) = MOD(K,60);
        ADDRESS(TMP) = ADDRESS(OUTREC) + K/60;
        T$REL1 = ALLONES; 
        T$I1   = ALLONES; 
        T$W1   = ALLONES; 
        T$OUTREC = TMP; 
  
        CASE (T$T2 LS CH"ZERO")    #  BUILD SOURCE POINTER             #
          IF  B<0>T$REL2 NQ 0  # SOURCE IN DATA RECORD                 #
            THEN
              BEGIN 
                TMP = INREC;    # ABSOLUTE POSITION                    #
                I = MAX (T$I2-1, 0);
              END 
            ELSE
              BEGIN 
                TMP = T$INREC;  # RELATIVE POSITION                    #
                IF  T$REL2 GR 0 
                  THEN  I = -T$I2;
                  ELSE  I =  T$I2;
              END 
  
          K = RESIDUAL(TMP) - 6*I;
          IF  T$W2 GR 1  THEN K = K+1 - T$W2; 
          IF K LS 0  THEN  K = 0;  # ENTIRELY OUT OF RECORD ON RIGHT   #
          IF  K GR RESIDUAL(INREC)  THEN  ERROR(ERR"PAR$6");
          RESIDUAL(TMP) = K;
          IF  T$M2 EQ -2  THEN
            BEGIN 
              IF  T$T2 EQ CH"B" 
                THEN  T$M2 = K; 
                ELSE  T$M2 = K/6; 
            END 
          K = USED(INREC) + RESIDUAL(INREC) - K;
          USED(TMP) = MOD(K,60);
          ADDRESS(TMP) = ADDRESS(INREC) + K/60; 
  
        ORCASE (T$T2 EQ CH"ONE")   #  LITERAL STRING                   #
          TMP = LOC(T$STRING);
          RESIDUAL(TMP) = 6*T$M2; 
  
        ORCASE (T$T2 EQ CH"TWO")   #  KEY                              #
          TMP = FM$PKEY;
  
        ORCASE (T$T2 EQ CH"THREE")  #  KEYA                            #
          IF FM$PKYA EQ 0 
             THEN ERROR( ERR"PAR$17" );   #KEYA UNDEFINED YET#
          TMP = FM$PKYA;
  
        ESAC; 
        T$REL2 = ALLONES; 
        T$I2   = ALLONES; 
        T$W2   = ALLONES; 
        T$T1 == T$T2;        # REPLACEMENTS ARE REALLY RIGHT TO LEFT   #
        T$M1 == T$M2; 
        K = RESIDUAL(TMP);   # IS SOURCE WITHIN RECORD                 #
        IF  K EQ 0  THEN  TMP = 0;  # NO, USE NULL POINTER             #
        IF  T$T1 LS CH"ZERO"
          THEN               #  CONVERT AND UPDATE RECORD POINTER      #
            BEGIN 
              T$INREC = TMP;
            IF  FM$CONV(I) NQ 0  THEN  ERROR(ERR"PAR$7"); 
            END 
          ELSE               #  CONVERT FROM ALTERNATE SOURCE          #
            BEGIN 
              T$M1 = RESIDUAL(TMP)/6; 
              IF  T$T1 EQ CH"THREE" 
                THEN                  # KEYA                           #
                  BEGIN 
                    T$T1 = CH"I"; 
                    T$M1 = ALLONES; 
                  END 
                ELSE                  # KEY  OR LITERAL                #
                  T$T1 = CH"X"; 
              T$INREC == TMP; 
            IF  FM$CONV(I) NQ 0  THEN  ERROR(ERR"PAR$7"); 
              T$INREC = TMP;
            END 
        IF  K NQ 0  THEN     # REAL DATA CONVERTED, ADJUST OUTSIZE     #
          BEGIN 
            K = (RESIDUAL(OUTREC) - RESIDUAL(T$OUTREC) + 5)/6;
            OUTSIZE = MAX(OUTSIZE, K);
          END;
        PUSH(TOP, 0); 
  
  
      ORCASE (TOP EQ S"TVAL")# TEST SPECIFICATION                      #
        IF  NOT V$TEST  THEN  ERROR(ERR"PAR$8");  # TEST NOT ALLOWED   #
        V$CONV = FALSE;      # FLAG THAT TEST IS IN PROGRESS           #
        IF  OP(0) LQ PR"TVAL" THEN  ERROR(ERR"PAR$9"); # SYNTAX ERROR  #
        IF  FM$TEST(I) GR 0  THEN  ERROR(ERR"PAR$10");
        PUSH(TOP,-I);        # PUSH TEST RESULT, +1 = TRUE, 0=FALSE    #
  
      ORCASE (TOP EQ S"NOT") # LOGICAL NOT                             #
        IF  NOT V$TEST  THEN  ERROR(ERR"PAR$8");   # TEST NOT ALLOWED  #
        V$CONV = FALSE;      # FLAG THAT TEST IS IN PROGRESS           #
        IF  OP(0) LQ PR"NOT" THEN  ERROR(ERR"PAR$9"); # SYNTAX ERROR   #
        PUSH(TOP,0);
  
      ORCASE (TOP EQ S"AND" OR TOP EQ S"OR") # BINARY OPERATORS        #
        IF  OP(0) NQ PR"TVAL" THEN  ERROR(ERR"PAR$8");  # NO L. OPRND  #
        WHYLE  TOP GQ OP(-1)  DO APPLYOP;  # REDUCE INNER EXPRS.       #
        PUSH(TOP,0);
  
      ORCASE (TOP EQ S"LPAR")  # NESTED SOMETHING OR OTHER             #
        IF  OP(0) LQ PR"TVAL"  THEN  ERROR(ERR"PAR$9"); 
        IF  B<0>T$I1 EQ 0 AND NOT V$CONV  THEN  ERROR(ERR"PAR$1");
        PUSH(TOP,MAX(T$I1,1));
        V$TEST = TRUE;
  
      ORCASE (TOP EQ S"COLON")   # END OF TEST, START CONVERSION       #
        IF  OP(0) EQ PR"TVAL" 
          THEN
            BEGIN 
              WHYLE  OP(-1) NQ PR"LPAR"  DO  APPLYOP; 
              RSLT = VAL(0);
              POP;
            END 
          ELSE
            RSLT = +1;       # TRUE                                    #
        IF  OP(0) NQ PR"LPAR"  THEN  ERROR(ERR"PAR$12");
        V$TEST = FALSE; 
        V$CONV = STACKCONV[STACK$LEVEL];
        IF  NOT V$CONV  THEN  ERROR(ERR"PAR$12"); 
        IF  RSLT EQ 0  THEN 
          BEGIN              #  FALSE TEST RESULT, ADVANCE             #
            SKIP;            #  ADVANCE TO SEMI, RPAR, OR EOS          #
            V$TEST = TRUE;   #  TURN TESTS BACK ON                     #
            IF  TNBL(PTR) EQ CH"SEMI"  THEN  ADVANCE(PTR);
          END 
        ELSE  ADVANCE(PTR);  #  SET TO DO CONVERSION                   #
  
      ORCASE (TOP EQ S"COMMA")  # MULTIPLE CONVERSIONS OR NULL ONE     #
        V$TEST = FALSE; 
        IF  OP(0) EQ PR"CVAL" 
          THEN  POP;
          ELSEIF  NOT V$CONV  THEN  ERROR(ERR"PAR$1");
        IF  OP(0) NQ PR"LPAR"  THEN  ERROR(ERR"PAR$13");
  
      ORCASE (TOP EQ S"SEMI")  # SUCCESSFUL END OF CONVERSION          #
        IF  NOT V$CONV  THEN  ERROR(ERR"PAR$1");
        SKIP; 
  
      ORCASE (TOP EQ S"RPAR")  # CLOSE OF NEST LEVEL                   #
        IF  OP(0) EQ PR"TVAL"  THEN   # TEST                           #
          BEGIN 
            WHYLE  OP(-1) NQ PR"LPAR"  DO  APPLYOP; 
            RSLT = VAL(0);  POP;
            IF  STACKCONV[STACK$LEVEL]  THEN
              ERROR(ERR"PAR$14");   # CONVERSION WAS WANTED            #
            POP;  POP;       # GET RID OF LPAR                         #
            PUSH(PR"TVAL",RSLT);  # SAVE RESULT, V$TEST IS STILL SET   #
          END 
        ELSE
          BEGIN              # CONVERSION WRAP-UP                      #
            IF  OP(0) EQ PR"CVAL" 
              THEN  POP;
              ELSEIF  NOT V$CONV  THEN  ERROR(ERR"PAR$1");
            IF  OP(0) NQ PR"LPAR"  THEN  ERROR(ERR"PAR$13");
            V$TEST = STACKTEST[STACK$LEVEL]; # RESET OUTER ENVIRONMENT #
            IF  VAL(0) GR 1  THEN   # REPEATED CONVERSION              #
              BEGIN 
                VAL(0) = VAL(0)-1;
                PTR = STACKWORD[STACK$LEVEL-1]; 
                V$TEST = TRUE;
              END 
            ELSE
              BEGIN 
                POP;  POP;   # DONE WITH THIS NEST                     #
                PUSH(PR"CVAL",0); 
              END 
          END;
        IF  STACK$LEVEL EQ 0  THEN  RESIDUAL(PTR) = 0; # ALL DONE      #
  
      ORCASE (TOP EQ S"QUIT")  # QUIT CONVERSION                       #
        IF  NOT V$CONV  THEN  ERROR(ERR"PAR$15"); 
        V$TEST = FALSE; 
        IF  OP(0) NQ PR"LPAR"  THEN  ERROR(ERR"PAR$2"); #MISSING COMMA #
        STACK$LEVEL = 1;     #  CLEAR OUT STACK                        #
        RESIDUAL(PTR) = 0;   #  NEXT WILL BE -EOS-                     #
        PUSH(PR"CVAL",0);    #  DUMMY ENTRY                            #
  
      ORCASE (TOP EQ S"EOS")  # RUN OUT OF CONVERSION STRING           #
        IF  STACK$LEVEL GQ 1  THEN
          BEGIN 
            IF  OP(0) EQ PR"TVAL"  THEN   # TEST                       #
              BEGIN 
                WHYLE  OP(-1) NQ PR"LPAR"  DO  APPLYOP; 
                RSLT = VAL(0);  POP;
                IF  STACKCONV[STACK$LEVEL]  THEN
                  ERROR(ERR"PAR$14");   # CONVERSION WAS WANTED        #
                POP; POP;    # GET RID OF LPAR                         #
                PUSH(PR"TVAL",RSLT);  # SAVE RESULT                    #
              END 
            ELSE
              BEGIN          # CONVERSION WRAP UP                      #
                IF  OP(0) EQ PR"CVAL" 
                  THEN  POP;
                  ELSEIF  NOT V$CONV  THEN  ERROR(ERR"PAR$1");
                IF  OP(0) NQ PR"LPAR"  THEN  ERROR(ERR"PAR$13");
                POP;  POP;   # POP PARENTHSIS                          #
                PUSH(PR"CVAL",0); 
              END 
          END;
          IF  STACK$LEVEL NQ 0  THEN  ERROR(ERR"PAR$16"); #MISSING -)- #
        FM$PARS = (OP(0) EQ PR"CVAL") OR (VAL(0) NQ 0); 
  
      ESAC;                  # END OF PARSE CASES                      #
  
         UNTYL (TOP EQ PR"EOS");
        END;                 # END OF CONVERSION PARSING               #
        RETURN; 
  
 ABORT$PARSE:                # ESCAPE FROM ERRORS                      #
        FM$PARS = FALSE;
      END  # FM$PARS #
      TERM
