*DECK  FMRUN
      PROC  FM$RUN;          # MAIN PROCESSING LOOP                    #
      BEGIN 
#CALL FMCOM                                                            #
CONTROL NOLIST; 
*CALL FMCOM 
CONTROL LIST; 
  
        ITEM
          STOPPE  B,
          BDUMMY  B,
          IRL$WDS I,
          ISQAL   B,
          RPOS    I,
          RRL     I,
          OUTSIZE I,
          OUTWSA  I,
          IERR    I;
        ARRAY [1:3];               #BACKGROUND VALUES   # 
          ITEM BGDVALC C(0,0,60) = [" ",  , "0000000000"],
               BGDVALI I(0,0,60) = [   , 0,             ];
  
        ITEM  IN$PTR  U;
        BASED  ARRAY IN$RECORD  S(1); 
          ITEM  IN$REC   C (0,0,10);
        ITEM  OUT$PTR U;
        ITEM  AB$END  B; #  RUN-TIME ERROR FLAG                        #
        BASED ARRAY OUT$RECORD  S(1); 
          ITEM  OUT$REC  C (0,0,10);
        ARRAY OUT$REF;       # COBOL-FORMAT ITEM DESCRIPTOR            #
          ITEM OUT$REF$SIZ U(0, 0,24),
               OUT$REF$TYP U(0,24,18) = [ O"004000" ],
               OUT$REF$LOC U(0,42,18);
  
        ARRAY  IN$KEY  S(52);;
        ARRAY OUT$KEY  S(52);;
  
        XREF
          BEGIN 
            PROC  FM$ERR; 
            ITEM  FM$AKEY  U;   # KEY VALUE (AK)                       #
            ITEM  FM$PKYA  U; 
            ITEM  FM$PKEY  U; 
            PROC  FM$GET; 
            PROC  FM$GETN;
            PROC  FM$PUT; 
            FUNC  XREAD   R;    # 8-BIT INTERFACE                      #
            FUNC  XWRITE  R;
            FUNC  FM$XWRT R;    # XWRITE WITH RECORD LENGTH            #
            FUNC  FM$MIN  I;    # UTILITY                              #
            FUNC  FM$MAX  I;
            FUNC  FM$MOD  I;
            FUNC  FM$IFNC  I; 
            FUNC  FM$RFNC  R; 
            PROC  FM$CALL;
            PROC  FM$FILL;
            PROC  FM$MOVW;
            PROC  WEOR; 
            PROC  ENDFILE;
            PROC  CLOSEM; 
            PROC  SKIPP;
            FUNC  CMM$ALF  U; 
            PROC  CMM$FRF;
            PROC  FM$QAL; 
            PROC  FM$REF; 
            PROC  FM$PRT; 
          END 
  
  
#****   THE FOLLOWING DEFINITIONS MUST BE CHANGED IF CRM FIT FORMAT 
*       CHANGES.  THEY ARE IN FM$RUN TO PROVIDE OPTIMAL PERFORMANCE 
*       IN THE MAIN COPY LOOP.
# 
  
        DEF FM$GFL(DUMMY)     #B<0,24>FDBWORD[12]#; 
        DEF FM$GFP(DUMMY)     #B<26,7>FDBWORD[10]#; 
        DEF FM$GRL(DUMMY)     #B<0,24>FDBWORD[11]#; 
        DEF FM$GRT(DUMMY)     #B<32,4>FDBWORD[11]#; 
        DEF FM$SRL(DUMMY,RL)  #B<0,24>FDBWORD[11] = RL#;
#****#
  
        XREF ARRAY  FM$FDB  S(1); 
          ITEM  FDB$PTR  U(0);
  
#       STATUS LIST FOR TYPE OF DIRECTIVE BEING EXECUTED               #
  
        STATUS  DIR  QAL, REF, SEQ; 
  
        STATUS  ERR          # ERROR ORDINALS                          #
          ICN$1,
          RUN$1,
          RUN$2,
          LAST$ERR; 
  
        ARRAY ERR$MSG [0:10] S(1);
          ITEM  ERR$MSG$TEXT  C(0,0,10) = [ 
  
#  ICN$1         #
      "INTERNAL E","RROR - BAD"," FC FOR XC","T$DIR    :",
#  RUN$1         #
      "UNRECOVERA", "BLE INPUT ", "FILE ERROR", "         :", 
#  RUN$2         #
      "TEST ERROR","         :",
#  LAST$MSG      #
      "******** :" ]; 
CONTROL EJECT;
 #
* *   FMRUN - DRIVER FOR CONVERSION RUN (MAIN LOOP) 
* *   M.T. KAUFMAN
* 1DC FMRUN 
* 
* DC  FUNCTION
* 
*     MAIN LOOP OF THE ACTUAL CONVERSION RUN.  READS INPUT RECORDS, 
*     CALLS THE APPROPRIATE FUNCTIONS (QAL, REF, SEQ, PAG), THEN WRITES 
*     OUTPUT RECORDS.  FMRUN IS ALSO RESPONSIBLE FOR INVOKING RX,CX,
*     EX,FX AND FEX USER EXITS. 
* 
* DC  ENTRY CONDITIONS
* 
*     NONE. 
* 
* DC  EXIT CONDITIONS 
* 
*     ALL RECORDS HAVE BEEN PROCESSED.  FATAL ERRORS TRAP DIRECTLY
*     THROUGH THE ERROR ROUTINE.
* 
* DC  ERROR CONDITIONS
* 
*     RUN-TIME ERRORS ARE PROCESSED FIRST BY ANY REQUESTED USER OWNCODE 
*     ROUTINES.  UNRESOLVED ERRORS ARE PROCESSED BY THIS ROUTINE.  ANY
*     ERROR WILL CAUSE THE RUN TO BE TERMINATED AFTER THE CURRENT RECORD
* 
* DC  INTERNAL PROCEDURES 
* 
*     CMOVE       - MOVE =N= CHARACTERS FROM SOURCE TO DESTINATION
*     QAL$RUN     - EVALUATES QAL DIRECTIVES PREVIOUSLY PARSED
*     REF$RUN     - EVALUATES REF DIRECTIVES PREVIOUSLY PARSED
*     SEQ$RUN     - EVALUATES SEQ DIRECTIVES PREVIOUSLY PARSED
* 
 #
CONTROL EJECT;
      PROC  ERROR (TYPE);    # ERROR HANDLER                           #
        ITEM  TYPE S:ERR; 
      BEGIN 
        FM$ERR (0, 0, ERR$MSG, TYPE, TRUE);  # FATAL ERROR             #
      END; # ERROR #
CONTROL EJECT;
      PROC CMOVE (SOURCE, SCHR, DEST, DCHR, N); 
        ITEM  SCHR U,  DCHR U,  N U;
        ARRAY SOURCE;;
        ARRAY DEST;;
      BEGIN 
  
        ITEM
          SW  I,  SB  I,  I I,
          DW  I,  DB  I;
  
        SW = LOC(SOURCE) + SCHR/10;  SB = 6*MOD(SCHR, 10);
        DW = LOC(DEST)   + DCHR/10;  DB = 6*MOD(DCHR, 10);
        FOR  I = 1 TO N  DO 
          BEGIN 
            B<DB,6>UMEMORY[DW] = B<SB,6>UMEMORY[SW];
            DB = DB + 6;
              IF  DB EQ 60  THEN
                BEGIN 
                  DW = DW + 1;  DB = 0; 
                END 
            SB = SB + 6;
              IF  SB EQ 60  THEN
                BEGIN 
                  SW = SW + 1;  SB = 0; 
                END 
          END 
      END;
CONTROL EJECT;
      FUNC XCT$DIR(FC,INREC,OUTREC,OUTSIZE,ERRFLAG) B;#QAL/REF/SEQ EXEC#
      ITEM
        FC       S:DIR, 
        INREC    U, 
        OUTREC   U, 
        OUTSIZE  I, 
        ERRFLAG  I; 
  
      BEGIN 
        ARRAY STACK[0:32] P(1); 
          ITEM
            STACKOP       U(0,0,18),
            STACKVAL      B(0,18,18), 
            STACKLEFT     B(0,42,18); 
  
        ITEM
          CODECNT  I, 
          I        I, 
          J        I, 
          OLN$USED I, 
          TOP      I, 
          VALUE    B; 
  
        XREF  FUNC FM$PARS B; 
CONTROL EJECT;
      FUNC  MATCH ((PTR)) B;  # HELPER FUNCTION FOR FIND #
      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  # 
CONTROL EJECT;
      FUNC FIND (REL,START,LRSTAT,NTH) I;  # FIND STRING FOR OLN #
      ITEM
        REL     I,         # FLAG FOR RELATIVE START POSITION          #
        START   I,         # STARTING CHARACTER POSITION               #
        LRSTAT  S:LEFT$RIGHT, # FLAG FOR LEFT/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
          BEGIN 
            PTR = T$RECORD; 
            K = MAX(START - 1,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;  #  FIND   #;
CONTROL EJECT;
      FUNC SETFIND(I$M,XCODES) I;  # SET UP FOR OLN SPECIFICATION # 
      ITEM
        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
          REL       I,
          N         I,
          START     I,
          SIDE      I,
          INDEX     I;
  
  
        IF I$M EQ 0 THEN
          BEGIN       # SET UP I VALUES  #
            REL = XIREL[CODECNT]; 
            T$M2 = XIT$M2[CODECNT]; 
            INDEX = XISTRING[CODECNT];
            N = XIN[CODECNT]; 
            START = XI[CODECNT];
            SIDE = XILR$RT[CODECNT];
          END 
        ELSE
          BEGIN       # SET UP M VALUES  #
            REL = XMREL[CODECNT]; 
            T$M2 = XMT$M2[CODECNT]; 
            INDEX = XMSTRING[CODECNT];
            N = XMN[CODECNT]; 
            START = XM[CODECNT];
            SIDE = XMLR$RT[CODECNT];
          END;
  
        CASE (REL EQ QAL$REL"PLUS") 
          REL = +1; 
        ORCASE (REL EQ QAL$REL"MINUS")
          REL = -1; 
        OTHERWISE 
          REL = 0;
        ESAC; 
        IF START EQ 262143 THEN START = ALLONES;
  
        C<0,T$M2>T$STRING = C<INDEX,T$M2>QTEXT; 
        SETFIND = FIND(REL,START,SIDE,N); 
        RETURN; 
      END;  # SETFIND #;
CONTROL EJECT;
      FUNC Q$TEST B;  # PERFORM TEST OPERATION FOR QAL #
      BEGIN 
        ITEM
          I       I,
          REL     I;
  
        XREF
          FUNC    FM$TEST  I; 
  
  
        CODECNT = CODECNT + 1;
        T$REL1 = QREL[CODECNT]; 
        IF T$REL1 EQ QAL$REL"ABS"  THEN 
          T$REL1 = ALLONES; 
        IF OLN$USED NQ 0 THEN     GOTO OLN$TEST;
        T$I1 = QI[CODECNT]; 
        IF T$I1 EQ 262143 THEN
          T$I1 = ALLONES; 
        T$M1 = QM[CODECNT]; 
        IF T$M1 EQ 262143 THEN
          T$M1 = ALLONES; 
        T$W1 = QW[CODECNT]; 
        IF T$W1 EQ 63 THEN
          T$W1 = ALLONES; 
        T$T1 = QT[CODECNT]; 
  
        CODECNT = CODECNT + 1;
        T$REL2 = QREL[CODECNT]; 
        IF T$REL2 EQ QAL$REL"ABS"  THEN 
          T$REL2 = ALLONES; 
        T$I2 = QI[CODECNT]; 
        IF T$I2 EQ 262143 THEN
          T$I2 = ALLONES; 
        T$M2 = QM[CODECNT]; 
        IF T$M2 EQ 262143 THEN
          T$M2 = ALLONES; 
        T$W2 = QW[CODECNT]; 
        IF T$W2 EQ 63 THEN
          T$W2 = ALLONES; 
        T$T2 = QT[CODECNT]; 
  
        GOTO TEST$ITM;
  
  
 OLN$TEST:  
        IF QSTRING[CODECNT] EQ 261 OR QSTRING[CODECNT] EQ 263 THEN
          T$I1 = SETFIND(0,QAL$CODES);
        ELSE
          BEGIN 
            T$I1 = QI[CODECNT]; 
            IF T$I1 EQ 262143 THEN
              T$I1 = ALLONES; 
          END;
        IF QSTRING[CODECNT] GR 261 THEN 
          BEGIN 
            T$M1 = SETFIND(1,QAL$CODES);
            CASE(T$I1 EQ ALLONES) 
              I = 1 + (RESIDUAL(T$RECORD) - RESIDUAL(T$INREC)) / 6; 
              T$M1 = MAX(0,(T$M1 - I)); 
            ORCASE(T$REL1 EQ ALLONES) 
              T$M1 = MAX(0,(T$M1 - T$I1));
            OTHERWISE 
              I = 1 + (RESIDUAL(T$RECORD) - RESIDUAL(T$INREC)) / 6; 
              IF T$REL1 EQ QAL$REL"MINUS" THEN
                I = MAX(0,I - T$I1);
              ELSE
                I = I + T$I1; 
              T$M1 = MAX(0,T$M1 - I); 
            ESAC; 
          END 
        ELSE
          BEGIN 
            T$M1 = QM[CODECNT]; 
            IF T$M1 EQ 262143 THEN
              T$M1 = ALLONES; 
          END;
        T$W1 = QW[CODECNT]; 
        IF T$W1 EQ 63 THEN
          T$W1 = ALLONES; 
        T$T1 = QT[CODECNT]; 
  
        CODECNT = CODECNT + 1;
        T$REL2 = QREL[CODECNT]; 
        IF T$REL2 EQ QAL$REL"ABS"  THEN 
          T$REL2 = ALLONES; 
        IF QSTRING[CODECNT] EQ 261 OR QSTRING[CODECNT] EQ 263 THEN
          T$I2 = SETFIND(0,QAL$CODES);
        ELSE
          BEGIN 
            T$I2 = QI[CODECNT]; 
            IF T$I2 EQ 262143 THEN
              T$I2 = ALLONES; 
          END;
        IF QSTRING[CODECNT] GR 261 THEN 
          BEGIN 
            T$M2 = SETFIND(1,QAL$CODES);
            CASE(T$I2 EQ ALLONES) 
              I = 1 + (RESIDUAL(T$RECORD) - RESIDUAL(T$INREC)) / 6; 
              T$M2 = MAX(0,(T$M2 - I)); 
            ORCASE(T$REL2 EQ ALLONES) 
              T$M2 = MAX(0,(T$M2 - T$I2));
            OTHERWISE 
              I = 1 + (RESIDUAL(T$RECORD) - RESIDUAL(T$INREC)) / 6; 
              IF T$REL2 EQ QAL$REL"MINUS" THEN
                I = MAX(0,I - T$I2);
              ELSE
                I = I + T$I2; 
              T$M2 = MAX(0,T$M2 - I); 
            ESAC; 
          END 
        ELSE
          BEGIN 
            T$M2 = QM[CODECNT]; 
            IF T$M2 EQ 262143 THEN
              T$M2 = ALLONES; 
          END;
        T$W2 = QW[CODECNT]; 
        IF T$W2 EQ 63 THEN
          T$W2 = ALLONES; 
        T$T2 = QT[CODECNT]; 
  
 TEST$ITM:  
        IF T$T2 EQ CH"ONE" THEN 
          C<0,T$M2>T$STRING = C<QSTRING[CODECNT],T$M2>QTEXT;
  
        Q$TEST = FALSE; 
        IF FM$TEST(I) GR 0 THEN 
          ERRFLAG = 1;
        ELSE
          IF I EQ -1 THEN 
            Q$TEST = TRUE;
        RETURN; 
      END;       #  Q$TEST     #; 
  
CONTROL EJECT;
      PROC SKIP;  # SKIP UNNEEDED PORTION OF QAL #
      BEGIN 
        ITEM
          LEVEL   I;
  
#**     FOR EACH OPERATOR IN THE PREFIX LIST, LEVEL GETS INCREMENTED
*       BY 2.  HOWEVER, SINCE EACH OPERATOR IS ALSO SOMEONES OPERAND
*       LEVEL GETS DECREMENTED BY 1 AT THE SAME TIME.  FOR EACH PURE
*       OPERAND, LEVEL GETS DECREMENTED BY 1.  'NOT' OPERATORS CAN
*       BE IGNORED SINCE THEY ONLY MODIFY THE NEXT UNARY RESULT.  ONCE
*       LEVEL GOES TO 0, WE HAVE REACHED WHAT WOULD HAVE BEEN THE 
*       CORRESPONDING ')' IN THE ORIGINAL INFIX EXPRESSION. 
# 
  
        LEVEL = 1;
        WHYLE (LEVEL GR 0) DO 
          BEGIN 
            J = J - 1;
            IF QTOK[J] EQ QLIST"AND"  OR  QTOK[J] EQ QLIST"OR" THEN 
              LEVEL = LEVEL + 2 - 1;
            ELSE
              IF QTOK[J] EQ QLIST"TVAL" THEN
                BEGIN 
                  LEVEL = LEVEL - 1;
                  CODECNT = CODECNT + 2;
                END;
          END;
        RETURN; 
      END;     #   SKIP   #;
CONTROL EJECT;
      FUNC POP B; # POP ENTRIES OFF OF QAL STACK #
      BEGIN 
        POP = FALSE;
        FOR TOP = TOP STEP -1 UNTIL -1  DO
          BEGIN 
            CASE (STACKOP[TOP] EQ QLIST"NOT") 
              VALUE = NOT VALUE;
            ORCASE(STACKOP[TOP] EQ QLIST"EOS")
              POP = TRUE; 
              RETURN; 
            OTHERWISE 
              IF STACKLEFT[TOP]  THEN 
                BEGIN 
                  IF STACKOP[TOP] EQ QLIST"AND" THEN
                    VALUE = VALUE AND STACKVAL[TOP];
                  ELSE
                    VALUE = VALUE OR STACKVAL[TOP]; 
                END 
              ELSE
                BEGIN 
                  STACKVAL[TOP] = VALUE;
                  STACKLEFT[TOP] = TRUE;
                  IF VALUE AND STACKOP[TOP] EQ QLIST"AND" THEN
                    RETURN; 
                  IF NOT VALUE AND STACKOP[TOP] EQ QLIST"OR" THEN 
                    RETURN; 
                  SKIP; 
                END;
            ESAC; 
        END;
      END;  # POP #;
CONTROL EJECT;
      FUNC QAL$RUN(INREC,OUTREC,ERRFLAG) B;  # EXECUTE PARSED QALS     #
      ITEM
        INREC    U, 
        OUTREC   U, 
        ERRFLAG  I; 
  
      BEGIN 
        ITEM
          DONE     B, 
          TYPE     I; 
  
  
        ERRFLAG = 0;
        QAL$RUN = FALSE;
        T$RECORD = INREC; 
        T$INREC  = INREC; 
        T$OUTREC = OUTREC;
        P<QAL$TOKENS> = QAL$; 
        P<QAL$CODES> = QTOK[0]; 
        STACKOP[0] = QLIST"EOS";
        STACKLEFT[0] = FALSE; 
        J = QCOND[0]; 
        DONE = FALSE; 
        TOP = 0;
        P<Q$TEXT> = QM[0];
        OLN$USED = QI[0]; 
        CODECNT = 0;
  
        WHYLE (NOT DONE) DO 
          BEGIN 
            IF QTOK[J] EQ QLIST"TVAL" THEN
              BEGIN 
                T$COND = QCOND[J];
                VALUE = Q$TEST; 
                IF ERRFLAG EQ 1 THEN
                  BEGIN 
                    P<STRING> = QPTR[0];
                    J = (RESIDUAL(STRING$PTR) - 
                         RESIDUAL(QPTR[J])) / 6 - 1;
                    TYPE = ERR"RUN$2";
                    FM$ERR(STRING$PTR,J,ERR$MSG,TYPE,FALSE);
                    RETURN; 
                  END;
                DONE = POP; 
                J = J - 1;
              END 
            ELSE
              BEGIN 
                TOP = TOP + 1;
                STACKOP[TOP] = QTOK[J]; 
                STACKLEFT[TOP] = FALSE; 
                J = J - 1;
              END;
        END;
        QAL$RUN = VALUE;
        RETURN; 
      END; # QAL$RUN  #;
CONTROL EJECT;
#     XCT$DIR CONTROL AND DISPATCH                                     #
  
        CASE (FC EQ DIR"QAL") 
          XCT$DIR = QAL$RUN(INREC,OUTREC,ERRFLAG);
        ORCASE (FC EQ DIR"REF") 
          XCT$DIR = FM$PARS(INREC,OUTREC,OUTSIZE,CON$PTR,ERRFLAG,TRUE); 
        ORCASE (FC EQ DIR"SEQ") 
          P<STRING> = SEQ$; 
          XCT$DIR = FM$PARS(INREC,OUTREC,OUTSIZE,STRING,ERRFLAG,TRUE);
        OTHERWISE 
          ERROR(ERR"ICN$1");
        ESAC; 
        RETURN; 
      END; #  XCT$DIR  #
CONTROL EJECT;
  
        IRL$WDS = 2 + (IRL$MAX+9)/10; 
        IF FDB$PTR[0] NQ 0
        THEN
          P<IN$RECORD> = CMM$ALF( IRL$WDS + 1, 0, 0 );
        IF TRANSFORMG 
        THEN
          OUTWSA = CMM$ALF( IRL$WDS + 1, 0, 0 );
        ELSE
          OUTWSA = P<IN$RECORD>;
        P<OUT$RECORD> = OUTWSA; 
        ADDRESS( FM$PKEY ) = LOC( IN$KEY ); 
        STOPPE = FALSE; 
        WHYLE  NOT STOPPE  DO     # MAIN LOOP                          #
          BEGIN 
  
            P<FDB> = FDB$PTR[0];
          IF  LOC(FDB) NQ 0  THEN 
            FM$FILL( IN$RECORD, " ", IRL$WDS + 1 ); 
      CASE (LOC(FDB) EQ 0)          # NO INPUT FILE                    #
        P<EXIT> = IX$$; 
        RPOS = FM$IFNC(EXIT, J, RRL); 
        P<IN$RECORD> = J; 
        IF NOT TRANSFORMG 
        THEN
          OUTWSA = J; 
  
      ORCASE ($IBM)                 # 8-BIT INPUT FILE                 #
        P<WSA> = WSA$;  P<CON> = CON$;
        RPOS = XREAD (WSA, IN$RECORD, CON); 
        IF  RPOS EQ E$EOP  THEN  RPOS = E$EOI;
        RRL = (RESIDUAL(T$OUTREC)+5)/6; 
        IF RPOS GR 0 AND CX$$ NQ 0  THEN    # CONVERSION ERROR         #
          BEGIN 
            P<EXIT> = CX$$; 
            RPOS = FM$IFNC (EXIT, WSA, IN$RECORD, CON, RPOS, RRL);
          END 
  
      OTHERWISE                     # CRM INPUT FILE                   #
        FM$SRL(FDB,IRL);            #IN CASE RT=U#
        IF FILORG EQ FO$SQ
          THEN  FM$GET(FDB,IN$RECORD);
          ELSE  FM$GETN(FDB,IN$RECORD,IN$KEY);  # KEY RETURNED IN ALL#
                                                #CASES BUT DA INITIAL#
        RRL = FM$GRL(FDB);
        RPOS = FM$GFP(FDB); 
          IF  RPOS LAN FP$EOS NQ 0  THEN RPOS = E$EOS;
          ELSEIF  RPOS LAN FP$EOP NQ 0  THEN RPOS = E$EOP;
          ELSEIF  RPOS LAN FP$EOI NQ 0  THEN RPOS = E$EOI;
          ELSE  RPOS = 0; 
  
      ESAC; 
  
          IF  RPOS LQ E$EOI  THEN 
            BEGIN  STOPPE = TRUE; TEST;  END  # DONE WITH INPUT        #
          IF  RPOS GR 0  THEN 
            BEGIN 
              ERROR (ERR"RUN$1");           # INPUT FILE ERROR         #
              STOPPE = TRUE;  TEST; 
            END 
          IF  LOC(FDB) NQ 0  THEN 
            BEGIN 
              IF  RPOS EQ MAX$R  THEN  RECNO = RECNO + 1; 
              IF  (RPOS+MAXFIL) EQ 0  THEN
                BEGIN 
                  IF  RMAX NQ 0  THEN 
                    BEGIN 
                      RMAX = RMAX - 1;
                      IF  RMAX EQ 0  THEN  STOPPE = TRUE; 
                    END 
                END 
            END 
          IN$PTR = LOC( IN$RECORD );
          RESIDUAL( IN$PTR ) = 6*RRL; 
  
  
            FOR  I = 1 TO N$FILES  DO   # OUTPUT FILE PROCESSING       #
              BEGIN 
      P<FDB> = FDB$PTR[I];
  
      CASE (RPOS NQ 0)       # EOS OR EOP (SEQUENTIAL ONLY)            #
        IF (RMAX NQ 0) AND ((RPOS+MAXFIL) EQ 0) THEN
          BEGIN 
            RMAX = RMAX - 1;
            IF  RMAX EQ 0  THEN 
              BEGIN 
                FOR  J = I  TO  N$FILES-1  DO 
                  FDB$PTR[J] = FDB$PTR[J+1];
                FDB$PTR[N$FILES] = LOC(FDB);
                N$FILES = N$FILES - 1;
                IF  N$FILES EQ 0  THEN  STOPPE = TRUE;
              END 
          END 
        IF FILORG EQ FO$SQ THEN 
          IF  NOT NOSEC  THEN 
            BEGIN 
              IF  $IBM
                THEN
                  BEGIN 
                    IF  RPOS EQ E$EOP 
                      THEN
                        BEGIN 
                          P<WSA> = WSA$;
                          RPOS = XWRITE(WSA);  # FLUSH ANY BLOCK       #
                          ENDFILE(FDB); 
                        END 
                  END 
                ELSE
                  IF  RPOS EQ E$EOS 
                    THEN  WEOR(FDB);
                    ELSE  ENDFILE(FDB); 
            END 
  
      OTHERWISE              # HAVE A DATA RECORD                      #
        ISQAL = TRUE; 
        IF  $QAL  THEN       # PERFORM RECORD QUALIFICATION            #
          BEGIN 
            P<CON> = QAL$;   # DE-REFERENCE QAL STRING                 #
            ISQAL = XCT$DIR(DIR"QAL",IN$PTR,OUT$PTR,OUTSIZE,IERR);
            IF IERR NQ 0 THEN 
              BEGIN 
                AB$END = TRUE;
                STOPPE = TRUE;
                TEST; 
              END;
          END 
  
        IF  ISQAL  THEN      # RECORD WILL BE USED                     #
          BEGIN 
  
            RECNO = RECNO + 1;
            IF  (RMAX NQ 0) AND (MAXFIL EQ MAX$R)  THEN 
              BEGIN          # CHECK LIMIT COUNT                       #
                RMAX = RMAX-1;
                IF  RMAX EQ 0  THEN 
                  BEGIN 
                    FOR  J = I TO N$FILES-1  DO 
                      FDB$PTR[J] = FDB$PTR[J+1];
                    FDB$PTR[N$FILES] = LOC(FDB);
                    N$FILES = N$FILES - 1;
                    IF  N$FILES EQ 0  THEN  STOPPE = TRUE;
                  END 
              END 
  
          IF TRANSFORML 
          THEN
            P<OUT$RECORD> = OUTWSA; 
          ELSE
            P<OUT$RECORD> = P<IN$RECORD>; 
          IF  $REF  THEN     # REFORMAT REQUESTED                      #
            BEGIN 
              OUT$PTR = LOC(OUT$RECORD);
              RESIDUAL(OUT$PTR) = 6*IRL;
              J = (IRL + 9)/10; 
              IF BGD EQ S"C"
                THEN
                  BEGIN 
                    FM$MOVW ( OUT$RECORD, IN$RECORD,      J );
                    OUTSIZE = MIN( IRL, RRL); 
                  END 
                ELSE
                  BEGIN 
                    FM$FILL ( OUT$RECORD, BGDVALI[ BGD ], J );
                    OUTSIZE = 0;
                  END;
              P<CON> = REF$;
              BDUMMY = XCT$DIR(DIR"REF",IN$PTR,OUT$PTR,OUTSIZE,IERR); 
              IF  IERR NQ 0  THEN 
                IF  RX$$  NQ 0  THEN
                  BEGIN 
                    P<EXIT> = RX$$; 
                    IERR = FM$IFNC (EXIT, IN$PTR, OUT$PTR, CON$PTR);
                  END 
              IF  IERR NQ 0  THEN  STOPPE = TRUE; 
            END 
          ELSE
            BEGIN 
              IF TRANSFORML 
              THEN
                BEGIN 
              J = (RRL + 9)/10; 
              FM$MOVW( OUT$RECORD, IN$RECORD, J );
                END 
              OUT$PTR = LOC(OUT$RECORD);
              IF ($PAG AND PAGFMT EQ "D") 
                THEN  RESIDUAL(OUT$PTR) =     RESIDUAL(IN$PTR); 
                ELSE  RESIDUAL(OUT$PTR) = MIN(RESIDUAL(IN$PTR), 6*IRL); 
              OUTSIZE = RESIDUAL(OUT$PTR)/6;
            END 
  
          IF  $SEQ  THEN     # ADD SEQUENCING                          #
            BEGIN 
              I = IN$PTR;  # SAVE INPUT RECORD POINTER                 #
              RESIDUAL(IN$PTR) = 60;  # CREATE DUMMY INPUT RECORD      #
              USED(IN$PTR) = 0; 
              ADDRESS(IN$PTR) = LOC(SEQNEXT); 
              $SEQ = XCT$DIR(DIR"SEQ",IN$PTR,OUT$PTR,OUTSIZE,IERR); 
              IN$PTR = I;  # RESTORE INPUT RECORD POINTER              #
              SEQNEXT = SEQNEXT + SEQADD;  # SET NEXT SEQUENCE NUMBER  #
            END;
  
          IF  $PAG  THEN
            FM$PRT (P<FDB>, OUT$PTR, OUTSIZE);
  
        CASE ($PAG AND PAGFMT EQ "D") 
#         ** DUMP ALREADY PRINTED THE LINE **                          #
  
        ORCASE ( $IBM )           # WRITE OUTPUT RECORD                #
          P<WSA> = WSA$;  P<CON> = CON$;
          OUT$REF$LOC = LOC(OUT$RECORD);
          OUT$REF$SIZ = OUTSIZE;
          RPOS = FM$XWRT (WSA, OUT$REF, CON); 
          IF  RPOS GR 0  AND  CX$$ NQ 0  THEN   # CONVERSION ERROR     #
            BEGIN 
              P<EXIT> = CX$$; 
              RPOS = FM$IFNC(EXIT, WSA, OUT$RECORD, CON, RPOS); 
            END 
  
        ORCASE (FILORG EQ FO$SQ)
          FM$PUT(FDB,OUT$RECORD,OUTSIZE); 
  
        ORCASE (FILORG EQ FO$AK)
          FM$AKEY = 0;
          FM$PUT(FDB,OUT$RECORD,OUTSIZE,FM$AKEY); 
          FM$PKYA = LOC(FM$AKEY); 
          RESIDUAL(FM$PKYA) = 60; 
  
        OTHERWISE            # FILORG EQ FO$IS                         #
          IF  OUTKEY
            THEN
              BEGIN 
                IF  NEGKEY
                  THEN       # REMOVE KEY FROM RECORD                  #
                    BEGIN 
                      CMOVE (OUT$RECORD, KEYSTART-1, OUT$KEY, 0,
                             KEY$SIZ);
                      CMOVE (OUT$RECORD, KEYSTART+KEY$SIZ-1,
                             OUT$RECORD, KEYSTART-1, IRL-KEYSTART); 
                      FM$PUT(FDB,OUT$RECORD,MAX(0,OUTSIZE - KEY$SIZ), 
                             OUT$KEY,0);
                    END 
                  ELSE       # LEAVE KEY IN RECORD                     #
                    BEGIN 
                      P<STRING> = LOC (OUT$RECORD[(KEYSTART-1)/10]);
                      FM$PUT(FDB,OUT$RECORD,OUTSIZE,STRING, 
                             MOD(KEYSTART - 1,10)); 
                    END 
              END 
            ELSE             # NO OUTPUT KEY SPECIFICATION             #
              BEGIN 
                FM$PUT(FDB,OUT$RECORD,OUTSIZE,IN$KEY,0);
  
              END 
  
        ESAC;                # END OF OUTPUT CASES                     #
          END                # END OF QUALIFIED RECORD OUTPUT          #
      ESAC;                  # END OF DATA RECORD PROCESSING           #
              END            # END OF FOR-LOOP ON OUTPUT FILES         #
          END                # END OF MAIN WHYLE-LOOP                  #
  
        FOR  I = 0 TO NN$FILES  DO
          BEGIN 
            IF  FDB$PTR[I] NQ 0  THEN 
              BEGIN 
                P<FDB> = FDB$PTR[I];
                IF  LOC(FDB) NQ LOC(FM$LFDB)  THEN
                  BEGIN 
                    IF  $IBM AND I NQ 0  THEN 
                      BEGIN 
                        P<WSA> = WSA$;
                        RPOS = XWRITE (WSA);
                      END 
                    CLOSEM(FDB);    # CLOSE FILE                       #
                  END 
              END 
          END 
  
      END  # FM$RUN # 
      TERM
