*DECK     FMT 
          IDENT  FMT
 FMT      SECT   (FORMAT STATEMENT PROCESSOR.)
 FMT      SPACE  4
*         IN ALLOC
          EXT    ALC
  
*         IN FEC
          EXT    CT1,FEC.RTN,FORSKEL,SSY,T=CONB 
  
*         IN FERRS
          EXT    E.FS00,E.FS01,E.FS02,E.FS03,E.FS04,E.FS05,E.FS06,E.FS07
          EXT    E.FS08,E.FS09,E.FS10,E.FS11,E.FS12,E.FS13,E.FS14,E.FS15
          EXT    E.FS16,E.FS17,E.FS18,E.FS19,E.FS20,E.FS21,E.FS22,E.FS23
          EXT    E.FS24,E.FS25,E.FS26,FILL. 
  
*         IN LEX
          EXT    TB=LABR
  
*         IN PEM
          EXT    ANSI=,PDM
  
*         IN PUC
          EXT    T=CON,T=FMT,T.CON,T.FMT,T.SYM
  
*         IN UTILITY
          EXT    CDD,MVE= 
          TITLE  TABLES, CELLS, DESCRIBES.
 FM.      SPACE  4,10 
**        FM. -  FORMAT TOKEN JUMP TABLE DEFINITION.
  
          DESCRIBE FM.
  
 DPC      DEFINE 36          DPC OF TOKEN FOR FORMAT PROCESSING 
          DEFINE 5
 FIX      DEFINE             FIXED CHARACTER STRING FOR FORMAT PROCESSOR
 ADDR     DEFINE 18          FMT PROCESSOR ADDRESS
 FMT=     SPACE  4,10 
**        FMT= - MACRO TO DEFINE FORMAT TOKEN CONTROL TABLE.
  
  
          PURGMAC  FMT= 
  
          MACRO  FMT=,DEST,DPC,ILL
 .1       IFC    EQ,/ILL//
 A        MICRO  1,3, DEST
 .1       ELSE
 A        MICRO  1,, ILL
 .1       ENDIF 
 B        MICRO  1,, DPC
 C        MICCNT B
 C        DECMIC C
 .1       IFEQ   C,0
 D        DECMIC C
 .1       ELSE
 D        DECMIC 1
 .1       ENDIF 
          VFD    FM.DPCL/"C"L"B",5/0,FM.FIXL/"D",FM.ADDRL/FMT="A" 
 FMT=     ENDM
 FMT=TOK  SPACE  4,10 
*         ****NOTE****  THIS TABLE WILL EVENTUALLY BE PRODUCED VIA A
*         COMDECK WHICH WILL BE USED BY O.X (FTN5TXT) AND CHARMAP (FEC).
  
**        FMT=TOK - BRANCH TABLE FOR TOKENS.
  
  
 FMT=TOK  EQU    *-O.DEF
          LOC    O.DEF
  
 EOS      FMT=
 HOLL     FMT=
 QHOLL    FMT=
 RLCON    FMT=
 CHAR     FMT=
 CONS     FMT=
 OCT      FMT=   O"CTAL,ILL 
 HEX      FMT=   X"HEX,ILL
 PERIOD   FMT=   .
 VAR      FMT=
 TRUE     FMT=   TRUE,ILL 
 FALSE    FMT=   FALSE,ILL
 PL       FMT=   +
 MIN      FMT=   -
 STAR     FMT=   *,ILL
 SLASH    FMT=   /
 UMIN     FMT=   UNARY-,INV 
 EXP      FMT=   **,ILL 
 LT       FMT=   .LT.,ILL 
 GE       FMT=   .GE.,ILL 
 EQ       FMT=   .EQ.,ILL 
 NE       FMT=   .NE.,ILL 
 LE       FMT=   .LE.,ILL 
 GT       FMT=   .GT.,ILL 
 NOT      FMT=   .NOT.,ILL
 AND      FMT=   .AND.,ILL
 XOR      FMT=   .XOR.,ILL
 NEQV     FMT=   .NEQV.,ILL 
 EQV      FMT=   .EQV.,ILL
 OR       FMT=   .OR.,ILL 
 CAT      FMT=   // 
 LP       FMT=   ()(
 RP       FMT=   )
 =        FMT=   (=),ILL
 COMMA    FMT=   (,)
 COLON    FMT=   (: ) 
 SLP      FMT=   NSTD(,INV
 STFA     FMT=   STFARG,INV 
 ILL      FMT=   ILL-CH      **MODIFY WHEN LEX PUTS CHARACTER IN TOKEN**
  
          LOC    *O 
  
 FMTSEP   BITMIC (O.COMMA,O.RP,O.COLON,O.SLASH,O.CAT) 
 JTFMT    SPACE  4,10 
**        JTFMT - FORMAT JUMP TABLE. (O.VAR AND O.CONS) 
  
  
 JTFMT    MACRO  JUMPS
          VFD    28/0 
          IRP    JUMPS
 .1       IFC    EQ,/JUMPS//
          VFD    8/0
 .1       ELSE
          VFD    8/FMT.JUMPS-FMT. 
 .1       ENDIF 
          IRP 
 JTFMT    ENDM
  
  
**        JUMP TABLE PARAMETERS.
  
  
 FMTJT    BSS    0
          JTFMT  (C,B,A,ILL)
          JTFMT  (G,F,E,D)
          JTFMT  (K,J,I,H)
          JTFMT  (O,N,M,L)
          JTFMT  (S,R,Q,P)
          JTFMT  (W,V,U,T)
          JTFMT  (,Z,Y,X) 
 CELLS    SPACE  4,10 
 LVMAX    EQU    10          MAXIMUM LEVEL OF PARENTHESES 
 FMTRC    CON    1           CURRENT REPEAT COUNT (FOR THIS PAREN LEVEL)
 LVSTAK   BSS    LVMAX       PAREN LEVEL STACK -- 1/SLASH-TAB, 23/0,
                             18/FMTRL, 18/REPEAT COUNT
 FMTRL    DATA   0           CURRENT RECORD LENGTH. 
 FMTRLC   DATA   0           FLAG TO INDICATE WHETHER ERROR SHOULD BE 
                             ISSUED FOR COLUMN COUNT EXCEEDED 
 EDRPT    CON    1           EDIT DESCRIPTOR REPEAT COUNT 
 EDWID    CON    1           EDIT DESCRIPTOR FIELD WIDTH
 FMTIDX   BSS    1           SYMTAB *WB* INDEX OF FORMAT
 ES.      SPACE  4,10 
**        EDSTA - EDIT STATUS WORD. 
* 
*         USED TO KEEP TRACK OF WHAT HAS HAPPENED DURING RECOGNITION OF 
*         EDIT DESCRIPTORS. 
  
  
          DESCRIBE ES.
 TB       DEFINE 18          ADDRESS OF FIRST TOKEN OF DESCRIPTOR 
 TGRP     DEFINE 3           TAB GROUP (T,TL,TR EDIT DESCRIPTORS) 
 ATTR     DEFINE 33          ATTRIBUTES 
 SC       DEFINE 6           STATUS CODES 
  
          REDEF  TGRP 
 T        DEFINE             EDIT DESCRIPTOR IS TAB 
 TL       DEFINE             EDIT DESCRIPTOR IS TAB LEFT
 TR       DEFINE             EDIT DESCRIPTOR IS TAB RIGHT 
  
          REDEF  ATTR 
          DEFINE 15 
 MD       DEFINE             M OR D FIELD OCCURRED
 WLD      DEFINE             WIDTH-LESS DESCRIPTOR
 HOL      DEFINE             HOLLERITH/CHARACTER DESCRIPTOR 
 SF       DEFINE             SCALE FACTOR OCCURRED
 SP       DEFINE             SCALE FACTOR PERMITTED 
 SGN      DEFINE             + OR - OCCURRED
 RPT      DEFINE             REPEAT COUNT FIELD PRESENT 
 WF       DEFINE             FIELD WIDTH OCCURRED 
 WR       DEFINE             FIELD WIDTH REQUIRED 
 DES      DEFINE             DESCRIPTOR OCCURRED
 EXP      DEFINE             EXPONENT OCCURRED
 EF       DEFINE             EXPONENT FIELD OCCURRED
 EP       DEFINE             EXPONENT PERMITTED 
 PER      DEFINE             . OCCURRED 
 PP       DEFINE             . PERMITTED
 PR       DEFINE             . REQUIRED 
 ERR      DEFINE             ERROR DETECTED 
 FIN      DEFINE             FINAL ALLOWABLE STRING IN DESCRIPTOR FOUND 
  
          REDEF  SC 
 IS       DEFINE             INITIAL TOKEN STATE
 SS       DEFINE             SCALE FACTOR STATE 
 RS       DEFINE             REPEAT COUNT STATE 
 DS       DEFINE             EDIT DESCRIPTOR STATE
 WS       DEFINE             FIELD WIDTH STATE
 MS       DEFINE             M OR D FIELD STATE 
  
  
 EDSTA    CON    0           EDIT STATUS WORD 
          TITLE  FORMAT 
 FMT      SPACE  4,10 
**        FMT -  PROCESS "FORMAT" STATEMENT.
* 
*         *FMT* SCANS FORMAT FOR SYNTACTICAL CORRECTNESS, CHECKING FOR
*         ILLEGAL COMBINATIONS AND MISCELLANEOUS PROGRAMMER ERRORS.  THE
*         GOAL IS TO CONTINUE TO VERIFY THE FORMAT IN ALL CASES, EVEN 
*         WHEN ERROR(S) ARE ENCOUNTERED.
* 
*         ENTRY  (B4) _ START OF *TB*.
* 
*         EXIT   TO *FEC.RTN* 
* 
*         CALLS  AED, CRL, CT1, EST, MVE=, PFC, SSY 
* 
*         USES   ALL REGISTERS. 
  
  
          HEREIF FORMAT 
  
          SX6    0
          SA6    FMTIDX      INITIALIZE 
          SA1    TB=LABR     STATEMENT LABEL, IN -R- FORMAT 
          SA5    =5L.BAD. 
          SB2    B0+
          NZ     X1,FMT1     IF STATEMENT LABEL FIELD PRESENT 
          FATAL  E.FS00 
          EQ     FMT5 
  
 FMT1     MI     X1,FMT5     IF BAD LABEL 
          SA3    =5L
          BX6    X1 
          LX1    5*CHAR 
          MX0    -CHAR
          BX5    0
  
*        PACK STATEMENT LABEL AND LINE NUMBER FOR I/O ROUTINES. 
  
 FMT2     LX1    CHAR 
          BX2    -X0*X1 
          ZR     X2,FMT2     IF NO DIGIT YET
  
 FMT3     ZR     X2,FMT4     IF END OF STATEMENT LABEL
          LX5    CHAR 
          SB2    B2+CHAR
          LX1    CHAR 
          BX5    X2+X5
          BX2    -X0*X1 
          EQ     FMT3        CONTINUE 
  
**        (X5) = 0L [STATEMENT LABEL] 
  
 FMT4     SB3    10*CHAR-1
          SB2    B2-B1
          MX0    1
          SB6    B3-B2
          AX0    B2,X0
          BX1    -X0*X3 
          LX5    B6,X5
          BX5    X1+X5       ADD IN TRAILING BLANKS.
          LX6    WA.STLP
          RJ     SSY
          IFEQ   TEST,ON,1
          MI     B7,"BLOWUP" IF LABEL NOT IN SYMTAB 
  
*         (B7) = SYMBOL TABLE INDEX FOR STATEMENT LABEL.
*         (X0) = SYMBOL TABLE ORDINAL FOR STATEMENT LABEL.
*         (X5) = FORMAT LABEL FOR ENTRY INTO FORMAT SKELETON TABLE. 
  
          SX6    B7 
          SA6    FMTIDX 
          RJ     CT1         GET LABEL TAG
          SA3    T=FMT
          SA4    T.SYM
          =B7    B7-WB.W+WC.W 
          SA4    X4+B7       FETCH SYMTAB WORD (WC.)
          LX3    WC.RAP 
          IX6    X4+X3       (WC.RA) = ADDRESS RELATIVE TO (T.FMT)
          SA6    A4 
  
 FMT5     BX7    X5 
          SA7    FORSKEL     5L [STATEMENT LABEL (BLANK PADDED)]
  
**        INITIALIZE FOR MASTER LOOP. 
  
          SB6    B0          PARENTHESIS LEVEL COUNTER
          BX6    0
          SB5    9*CHAR      CHARACTER SHIFT COUNT FOR FORMAT BUILD WORD
          SA4    B4          FETCH 1ST *(* OF FORMAT
          SA6    FMTRL       CHARACTER/RECORD COUNTER 
          SA6    FMTRLC      CLEAR RECORD LENGTH CHECK
          SA6    EDSTA       CLEAR EDIT STATUS WORD 
          MX7    0           FORMAT BUILD WORD
          SB2    X4-O.LP
          ZR     B2,FMT=NX   IF LEFT PAREN
          FATAL  E.FS26      **  MISSING LEFT PAREN 
*         EQ     FMT=NX 
          TITLE  TOKEN LOOP.
 FMT=     SPACE  4,10 
**        MASTER LOOP FOR CHECKING SYNTAX OF FORMAT.
* 
*         (A4) _ CURRENT *TB* TOKEN PROCESSING
*         (A7) = SKELETON STORE ADDRESS-1 
*         (X7) = CURRENT BUILD WORD 
*         (B6) = PARENTHESIS LEVEL
  
  
 FMT=NX   BSS    0
          SB2    X4+
          SX1    B2-O.ILL-1 
          PL     X1,"BLOWUP" IF BAD TOKEN 
          SA1    B2+FMT=TOK  FETCH TOKEN TABLE ENTRY
          LX1    -FM.ADDRP
          SB7    X1          JUMP ADDRESS 
          ERRNZ  18-FM.ADDRL
          LX1    FM.ADDRP 
          MX0    FM.DPCL
          BX6    X0*X1
          SBIT   X1,FM.FIXP 
          MI     X1,FMT=NX1  IF FIXED CHARACTER STRING
          JP     B7          PROCESS FORMAT INFORMATION FROM TOKEN
  
 FMT=NX1  LX4    X6 
          RJ     PFC         PROCESS FORMAT CHARACTER(S)
          JP     B7          FINISH PROCESSING
 FMT=COM  SPACE  4,10 
**        HERE ON *,*.
  
 FMT=COM  BSS    0
          SA1    EDSTA
          NZ     X1,FMT=COM1 IF NOT EXTRANEOUS *,*
          SA1    A4-1 
          SB2    X1-O.RP
          ZR     B2,FMT=COM1 IF PREVIOUS *)*
          WARN   E.FS20 
 FMT=COM1 RJ     AED         ANALYZE EDIT DESCRIPTOR
          SA4    A4+1        NEXT TOKEN 
          EQ     FMT=NX 
 FMT=COL  SPACE  4,10 
**        HERE ON *:*.
  
 FMT=COL  BSS    0
          RJ     AED         ANALYZE EDIT DESCRIPTOR
          SA4    A4+1        NEXT TOKEN 
          EQ     FMT=SL2     ATTEMPT TO BYPASS *,*
 FMT=CAT  SPACE  4,10 
**        HERE ON */*, OR *//*. 
  
 FMT=CAT  BSS    0
 FMT=SLA  BSS    0
          RJ     AED         ANALYZE EDIT DESCRIPTOR
          SA1    B6+LVSTAK-1
          MX6    1           MARK *SLASH IN NEST* 
          SA6    A1 
          SA2    FMTRL
          MX0    1
          BX1    -X0*X1      CLEAR SLASH BIT
          AX1    18 
          IX6    X1+X2
          RJ     CRL         CHECK RECORD LENGTH UP TO SLASH
          BX6    0
          SA6    FMTRL       RESTART RECORD LENGTH
          =A4    A4+1        NEXT TOKEN 
  
*         *,* CAN BE ELIMINATED IF NEXT CHARACTER.
  
 FMT=SL2  SB7    X4-O.COMMA 
          NZ     B7,FMT=NX   IF NOT FOLLOWED BY *,* 
          SA4    A4+1        BYPASS *,* 
          EQ     FMT=NX 
 FMT=PER  SPACE  4,10 
**        HERE ON *.* 
  
 FMT=PER  BSS    0
          SA1    EDSTA       EDIT STATUS WORD 
          ZR     X1,FMT=ILL  IF O.PER AS FIRST TOKEN OF EDIT DESCRIPTOR 
          CLAS=  X6,ES,(PER)
          LX1    -ES.TBP
          SB4    X1          SET FOR POSSIBLE DIAGNOSTIC
          ERRNZ  18-ES.TBL
          LX1    ES.TBP 
          BX2    X1 
          SBIT   X2,ES.PPP
          MI     X2,FMT=PER1 IF PERIOD ALLOWED
          FATAL  E.FS16 
          CLAS=  X6,ES,(ERR)
          EQ     FMT=PER2 
  
 FMT=PER1 SBIT   X2,ES.PERP/ES.PPP
          PL     X2,FMT=PER2 IF NOT MULTIPLE *.*
          FATAL  E.FS21 
          CLAS=  X6,ES,(ERR)
  
 FMT=PER2 BX6    X1+X6
          SA6    A1          UPDATE 
          SA4    A4+1        NEXT TOKEN 
          EQ     FMT=NX 
 FMT=PL   SPACE  4,10 
**        HERE ON *+* OR *-*. 
  
 FMT=PL   BSS    0
 FMT=MIN  BSS    0
          SA1    EDSTA       EDIT STATUS WORD 
          ZR     X1,FMT=PL1  IF SIGN IS FIRST TOKEN OF EDIT DESCRIPTOR
          LX1    -ES.TBP
          SB4    X1          FOR DIAGNOSTIC 
          ERRNZ  18-ES.TBL
          FATAL  E.FS25 
          RJ     AED         ANALYZE EDIT DESCRIPTOR. 
  
 FMT=PL1  RJ     RED         RESTART EDIT DESCRIPTOR
          SA1    EDSTA
          CLAS=  X6,ES,(SGN)
          BX6    X1+X6
          SA6    A1          UPDATE 
          SA4    A4+1        NEXT TOKEN 
          EQ     FMT=NX 
 FMT=LP   SPACE  4,10 
**        HERE ON *(*.
  
 FMT=LP   BSS    0
          SA1    EDSTA
          CLAS=  X2,ES,(TGRP,MD,SF,SGN,WF,DES,EXP,EF,PER) 
          BX2    X2*X1
          ZR     X2,FMT=LP1  IF NO INVALID PRECEDENT
          LX1    -ES.TBP
          SB4    X1          FOR DIAGNOSTIC 
          ERRNZ  18-ES.TBL
          FATAL  E.FS25 
  
 FMT=LP1  RJ     AED         ANALYZE EDIT DESCRIPTOR
          SA1    EDRPT
          SA2    FMTRC
          SA3    FMTRL
          =A4    A4+1        NEXT TOKEN 
          =B6    B6+1 
          LX3    18 
          BX6    X3+X2       24/0,18/FMTRL,18/FMTRC 
          SX2    B6-LVMAX-1 
          SA6    B6+LVSTAK-1 NTH LEVEL STACK WORD 
          LX6    X1 
          SA6    A2          SET FMTRC
          MX6    0
          SA6    A3          RESET FMTRL
          =X6    1
          SA6    A1          EDIT DESCRIPTOR REPEAT COUNT = 1 
          MI     X2,FMT=NX   IF PAREN LEVEL .LE. MAX
          FATAL  E.FS03      EXCEEDED MAX PAREN LEVELS
          =B6    B6-1        IN CASE MORE LEFT PARENS 
          EQ     FMT=NX 
 FMT=RP   SPACE  4,10 
**        HERE ON *)*.
  
 FMT=RP   BSS    0
          EQ     B6,B1,FMT=RP1  IF AT OUTERMOST ( 
          =A1    A4-1        PREVIOUS TOKEN 
          SB4    A1          FOR POSSIBLE DIAGNOSTIC
          SX1    X1-O.LP
          NZ     X1,FMT=RP1  IF NOT () [NULL EDIT DESCRIPTOR] 
          FATAL  E.FS22 
  
 FMT=RP1  RJ     AED         ANALYZE EDIT DESCRIPTOR
          SA2    FMTRC
          SA3    B6+LVSTAK-1
          PL     X3,FMT=RP2  IF NO SLASH IN THIS LEVEL
          =X2    1           USE 1 AS REPEAT COUNT
          =X3    0           USE ZERO FOR PREVIOUS LEN AND REP COUNT
          EQ     B6,B1,FMT=RP2  IF AT OUTERMOST ( 
          MX6    1
          =A1    A3-1 
          BX6    X6+X1       PROPOGATE / TO OUTER LEVEL OF NEST 
          SA6    A1 
  
 FMT=RP2  SA1    FMTRL
          =B6    B6-1 
          =A4    A4+1        NEXT TOKEN 
          IX6    X1*X2       RECORD LENGTH * REPEAT COUNT 
          SX2    X3          PREVIOUS REPEAT COUNT
          AX3    18          PREVIOUS RECORD LENGTH 
          IX6    X6+X3       INCREMENT RECORD LENGTH
          SA3    FMTRL
          SA6    A3          UPDATE REAL RECORD LENGTH
          RJ     CRL         CHECK RECORD LENGTH
          LX6    X2 
          SA6    A2          RESTORE PREVIOUS REPEAT COUNT
          ZR     B6,FMT=EOS1 IF TERMINAL *)*
          SA1    ="FMTSEP"
          SB7    X4          UPCOMING TOKEN 
          LX1    X1,B7
          MI     X1,FMT=NX   IF NEXT IS SEPARATOR 
          SB4    A4+         POINT TO UPCOMING TOKEN
          FATAL  E.FS25      ** MISSING SEPARATOR 
          EQ     FMT=NX 
 FMT=CHA  SPACE  4,10 
**        HERE ON CHARACTER OR HOLLERITH TOKEN. 
* 
*         (X4) = CHARACTER/HOLLERITH TOKEN. 
  
 FMT=RLC  BSS    0
          SA1    =7L R" OR
          SA2    =3RL"
          BX6    X1+X2
          EQ     FMT=ILL
  
 FMT=QHO  BSS    0
          SA1    =7L"STRING 
          BX6    X1 
          SA6    FILL.
          ANSI   E.FS08 
  
 FMT=CHA  BSS    0
 FMT=HOL  BSS    0
          SA1    EDSTA
          ZR     X1,FMT=CHA1 IF NO MISSING PUNCTUATION
          LX1    -ES.TBP
          SB4    X1          SET FOR DIAGNOSTIC 
          ERRNZ  18-ES.TBL
          FATAL  E.FS25 
          RJ     AED         ANALYZE EDIT DESCRIPTOR
 FMT=CHA1 SA5    A4+         SAVE TOKEN POINTER 
          SB7    A7          SAVE LAST BUILD WORD 
          MX0    -TB.CLCNL
          HX4    TB.CLCN
          LX4    TB.CLCNL 
          BX1    -X0*X4      NUMBER OF CHARACTERS 
          LX0    X7          SAVE CURRENT BUILD WORD
          CALL   CDD         CONVERT TO DPC 
          SA1    B7          LAST BUILD WORD
          BX7    X1 
          SA7    A1          RESTORE
          LX7    X0          RESTORE CURRENT BUILD WORD 
          SX1    1RH
          SB7    9*CHAR 
          SB7    B7-B2
          LX1    X1,B7       POSITION THE H 
          =B2    B2-1 
          MX0    1
          AX0    X0,B2
          BX4    X0*X4       EXTRACT COUNT (DPC)
          BX4    X4+X1       MAKE NH PREFIX 
          RJ     PFC         PROCESS FORMAT CHARACTERS FOR PREFIX 
          SA4    A5          RESTORE TOKEN POINTER
  
*         THE PREFIX IS OUTPUT.  NOW PROCESS THE CHARACTER STRING.
  
          SA5    T.CON
          LX4    -TB.SHCP 
          SB2    X4 
          ERRNZ  18-TB.SHCL 
          SA5    X5+B2       FIRST WORD OF CHARACTER
          MX0    -TB.CLCNL
          LX4    TB.SHCP-TB.CLCNP 
          BX6    -X0*X4      EXTRACT CHARACTER COUNT
          SB2    X6 
          SA6    EDWID
          =A5    A5-1        PREFETCH FOR LOOP
          MX0    -CHAR
  
 FMT=CHA2 SB3    10          RESET CURRENT WORD CHARACTER COUNT 
          SA5    A5+1        FETCH NEXT WORD
 FMT=CHA3 =B2    B2-1        TOTAL CHARACTER COUNT
          =B3    B3-1        CHARACTER COUNT THIS WORD
          LX5    CHAR 
          BX2    -X0*X5      EXTRACT CHARACTER
          LX2    X2,B5
          BX7    X7+X2       MERGE INTO BUILD WORD
          SB5    B5-CHAR
          MI     B5,FMT=CHA4 IF WORD FULL 
          ZR     B2,FMT=CHA5 IF HOLLERITH/CHARACTER FINISHED
          NZ     B3,FMT=CHA3 IF MORE TO PROCESS THIS WORD 
          EQ     FMT=CHA2    GET NEXT WORD OF HOLLERITH/CHARACTER 
  
 FMT=CHA4 =A7    A7+1        STORE FULL WORD
          MX7    0           RESET BUILD WORD 
          SB5    9*CHAR      SHIFT COUNT
          ZR     B2,FMT=CHA5 IF HOLLERITH/CHARACTER FINISHED
          NZ     B3,FMT=CHA3 IF MORE TO PROCESS THIS WORD 
          EQ     FMT=CHA2    GET NEXT WORD OF HOLLERITH/CHARACTER 
  
 FMT=CHA5 SX6    A4 
          =A4    A4+1        NEXT TOKEN 
          CLAS=  X2,ES,(HOL,FIN,DES,DS) 
          LX6    ES.TBP 
          BX6    X6+X2
          SA6    EDSTA       UPDATE EDIT DESCRIPTOR STATUS
          EQ     FMT=NX 
 FMT=EOS  SPACE  4,10 
**        HERE ON *EOS*.
* 
*         (X7) = FORMAT BUILD WORD
*         (B5) = CURRENT CHARACTERS SHIFT COUNT.
  
 FMT=EOS  BSS    0
          FATAL  E.FS19      ENTRY FROM MAIN LOOP -- PARENS UNBALANCED
          EQ     FMT=EOS2 
  
 FMT=EOS1 ZR     X4,FMT=EOS2 IF *EOS* 
          SB4    A4+         FOR DIAGNOSTIC FILL. 
          EQ     E.FS18 
  
 FMT=EOS2 ZR     X7,FMT=EOS3 IF NULL WORD 
  
*         OTHERWISE, BLANK PAD THE FINAL WORD AND OUTPUT. 
  
          SA1    =10H 
          SB2    10*CHAR
          SB3    B2-B5
          MX0    CHAR 
          SB2    B3-2*CHAR
          AX0    X0,B2
          BX1    -X0*X1 
          BX7    X7+X1
          =A7    A7+1 
  
*         ADD FORMAT TO T.FMT AND EXIT. 
  
 FMT=EOS3 SB6    FORSKEL-1
          SB6    A7-B6       = LENGTH OF THIS FORMAT
          SA1    FMTIDX 
          ZR     X1,FMT=EOS4 IF NO FORMAT LABEL 
          SA3    T.SYM
          SB3    X1 
          SX1    B6-1        FORMAT TEXT LENGTH (WORDS) 
          SX7    B6-1 
          SA3    X3+B3       *WB* OF FORMAT 
          LX1    3           (F.T.L.)*8 
          LX7    1           (F.T.L.)*2 
          IX7    X1+X7       (F.T.L.)*10
          LX7    WB.FMTLP 
          BX7    X3+X7       MERGE IN FORMAT LENGTH (CHARACTERS)
          SA7    A3 
  
 FMT=EOS4 ALLOC  T.FMT,B6 
          SX1    B6          = W.C. 
          SX2    FORSKEL     = SOURCE 
          SX3    B7-B6       = DESTINATION = (LWA+1 OF TABLE) - (W.C.)
          MOVE   X1,X2,X3 
          SA1    T=CONB 
          SHRINK T=CON,X1    SCRATCH CONSTANTS FORMED FOR FORMAT
          EQ     FEC.RTN     EXIT TO FRONT END CONTROLLER...
 FMT=ILL  SPACE  4,10 
**        HERE ON ILLEGAL TOKEN.
 DELIM    BITMIC (O.EOS,O.LP,O.RP,O.COMMA,O.COLON,O.SLASH,O.CAT)
  
 FMT=ILL  BSS    0
          SA6    FILL.
          FATAL  E.FS14 
 FMT=ILL1 =A4    A4+1        NEXT TOKEN 
          SB4    X4 
          SA1    ="DELIM" 
          LX1    B4,X1
          PL     X1,FMT=ILL1 IF NOT DELIMETER 
          RJ     RED         RESET EDIT DESCRIPTOR
          EQ     FMT=NX      CONTINUE PROCESSING
 FMT=INV  SPACE  4,10 
**        HERE ON TOTALLY INVALID TOKEN.
*         (CANNOT BE PRODUCED (LEGALLY) BY LEX) 
  
 FMT=INV  EQ     "BLOWUP" 
          TITLE  FMT=VAR/FMT=CON SUBLOOP. 
 FMT=CON  SPACE  4,10 
**        HERE ON CONSTANT OR VARIABLE TOKEN. 
  
 FMT=CON  BSS    0
 FMT=VAR  BSS    0
          RJ     PFC         PROCESS THE STRING 
          SA1    EDSTA
          NZ     X1,FMT.NX   IF NOT FIRST TOKEN IN EDIT DESCRIPTOR
          SX6    A4 
          LX6    ES.TBP 
          CLAS=  X1,ES,(IS) 
          BX6    X6+X1       SET TO INITIAL STATE 
          SA6    A1          UPDATE EDIT DESCRIPTOR STATUS
*         EQ     FMT.NX 
 FMT.NX   SPACE  4,10 
**        JUMP TO NEXT PROCESSOR UNIT 
* 
*         (X4) = CHARACTER STRING PROCESSING (FROM O.VAR OR O.CONS).
*         (B3) = NUMBER OF CHARACTERS (IN X4) REMAINING TO PROCESS. 
  
 FMT.NX   BSS    0
          ZR     B3,FMT.NX1  IF NO MORE CHARACTERS TO PROCESS 
          MX0    -CHAR
          LX4    CHAR 
          BX2    -X0*X4      EXTRACT CURRENT CHARACTER
          SX1    3
          SX6    X2 
          BX0    X1*X2       2 BITS ONLY FOR SHIFT COUNT
          LX6    9*CHAR 
          SB2    X2-1R+ 
          PL     B2,FMT.ILL  IF NOT ALPHANUMERIC
          SA5    ="NUM09" 
          SB2    X2 
          LX5    X5,B2
          MI     X5,FMT.DIG  IF CHARACTER 0-9 
          LX0    3           *8--SHIFT COUNT WITHIN JUMP WORD 
          AX2    2           INDEX TO JUMP WORD 
          SA6    FILL.       CHARACTER IN CASE OF ERROR 
          SA1    X2+FMTJT    JUMP WORD
          SB7    X0 
          AX1    X1,B7
          SX0    377B 
          BX1    X1*X0
          SB2    X1 
          EQ     FMT.ED      PREPROCESS EDIT DESCRIPTOR 
  
 FMT.NX1  SA4    A4+1        NEXT TOKEN 
          EQ     FMT=NX 
 FMT.ED   SPACE  4,10 
**        HERE ON EDIT DESCRIPTOR.
* 
*         (B2) = PROCESSOR ADDRESS (-FMT.)
  
 FMT.ED   BSS    0
          SA1    EDSTA
          =B3    B3-1 
          LX1    -ES.TBP
          SB4    X1          SET FOR POSSIBLE DIAGNOSTIC
          ERRNZ  18-ES.TBL
          LX1    ES.TBP 
          BX2    X1 
          SBIT   X2,ES.DESP 
          PL     X2,FMT.ED2  IF NO EDIT DESCRIPTOR YET
  
*         TEST FOR EXPONENT.
  
          SBIT   X2,ES.EPP/ES.DESP
          PL     X2,FMT.ED1  IF EXPONENT NOT PERMITTED
          MX0    -CHAR
          BX0    -X0*X4 
          SX0    X0-1RE 
          NZ     X0,FMT.ED1  IF NOT EXPONENT
          SBIT   X2,ES.MSP/ES.EPP 
          PL     X2,FMT.ED1  IF NOT PROPERLY FORMED 
          CLAS=  X2,ES,(EXP)
          BX6    X1+X2
          SA6    A1          RESET TO INDICATE EXPONENT 
          EQ     FMT.NX 
  
 FMT.ED1  FATAL  E.FS25      DESCRIPTOR WITHOUT PUNCTUATION 
          CLAS=  X6,ES,(ERR)
          BX6    X1+X6
          SA6    A1          UPDATE WITH ERROR
          RJ     AED         ANALYZE THE PREVIOUS EDIT DESCRIPTOR 
          =B3    B3+1 
          LX4    -CHAR
          RJ     RED         RESTART EDIT DESCRIPTOR STATUS 
          EQ     FMT.NX      REPROCESS
  
 FMT.ED2  MX0    -CHAR
          BX0    -X0*X4 
          SX0    X0-1RP 
          ZR     X0,FMT.P    IF SCALE FACTOR
          MX0    -ES.SCL
          LX1    -ES.SCP
          BX1    X0*X1       CLEAR OLD STATE
          LX1    ES.SCP 
          CLAS=  X6,ES,(DS,DES) 
          BX6    X1+X6
          SA6    A1          UPDATE EDIT DESCRIPTOR STATUS
          BX1    X6 
          SBIT   X6,ES.SGNP 
          PL     X6,FMT.ED3  IF NO SIGNED REPEAT COUNT
          FATAL  E.FS06 
 FMT.ED3  JP     B2+FMT.
          TITLE  FMT. - EDIT DESCRIPTOR PROCESSORS. 
 FMT.RPT  SPACE  4,10 
**        HERE ON EDIT DESCRIPTOR WHICH ALLOW A REPEAT COUNT. 
*         (A,D,E,F,G,I,L,O,R,Z) 
  
 FMT.     BSS    0
  
 FMT.R    BSS    0
          CLAS=  X3,ES,(WR) 
          EQ     FMT.ANSI 
  
 FMT.O    BSS    0
 FMT.Z    BSS    0
          CLAS=  X3,ES,(WR,PP)
 FMT.ANSI ANSI   E.FS08      O,R,Z ARE NON-ANSI 
          EQ     FMT.RPT
  
 FMT.A    BSS    0
          SX3    0
          EQ     FMT.RPT
  
 FMT.D    BSS    0
 FMT.F    BSS    0
          CLAS=  X3,ES,(WR,PP,PR,SP)
          EQ     FMT.RPT
  
 FMT.E    BSS    0
 FMT.G    BSS    0
          CLAS=  X3,ES,(WR,PP,PR,EP,SP) 
          EQ     FMT.RPT
  
 FMT.I    BSS    0
          CLAS=  X3,ES,(WR,PP)
          EQ     FMT.RPT
  
 FMT.L    BSS    0
          CLAS=  X3,ES,(WR) 
  
*                (A1) _ EDIT DESCRIPTOR STATUS WORD 
*                (X1) = EDIT DESCRIPTOR STATUS (PREVIOUS) 
*                (X3) = CURRENT STATUS BITS 
  
 FMT.RPT  BSS    0
          BX6    X1+X3       MERGE IN STATUS BITS 
          SA6    A1 
          EQ     FMT.NX 
 FMT.NRPT SPACE  4,10 
**        HERE ON EDIT DESCRIPTORS WHICH DISALLOW REPEAT COUNTS.
*         (BN,BZ,P,S,SP,SS,T,TL,TR,X) 
  
  
**        HERE ON *BN* OR *BZ*. 
* 
*                (A1) _ EDIT DESCRIPTOR STATUS WORD 
*                (X1) = EDIT DESCRIPTOR STATUS (PREVIOUS) 
*                (B3) = COUNT OF REMAINING CHARACTERS IN (X4) 
  
 FMT.B    BSS    0
          NZ     B3,FMT.B2   IF MORE CHARACTERS IN STRING 
          SA2    A4+1        FETCH NEXT TOKEN 
          SB2    X2-O.CONS
          ZR     B2,FMT.B1   IF CONSTANT TOKEN
          SB2    X2-O.VAR 
          NZ     B2,FMT.B2   IF NOT VARIABLE TOKEN
 FMT.B1   SA4    A4+1 
          RJ     PFC         PROCESS STRING (FROM TOKEN)
 FMT.B2   SA3    FILL.
          LX4    CHAR 
          MX0    -CHAR
          BX2    -X0*X4      EXTRACT NEXT CHARACTER 
          LX0    X2 
          LX0    8*CHAR 
          BX6    X3+X0
          SA6    A3          UPDATE FOR POSSIBLE DIAGNOSTIC 
          LX4    -CHAR       RESTORE
          ZR     X2,FMT.INV  IF *B* ONLY
          =B3    B3-1 
          LX4    CHAR 
          SB2    X2-1RN 
          ZR     B2,FMT.B3   IF *BN*
          SB2    X2-1RZ 
          ZR     B2,FMT.B3   IF *BZ*
          EQ     FMT.INV     INVALID CODE 
  
 FMT.B3   SBIT   X1,ES.RPTP 
          PL     X1,FMT.B4   IF NOT REPEAT COUNT
          FATAL  E.FS04 
 FMT.B4   LX1    ES.RPTL+ES.RPTP
          CLAS=  X3,ES,(FIN,WLD)
          BX6    X1+X3
          SA6    A1+         UPDATE 
          EQ     FMT.NX 
  
**        HERE ON *P*.
* 
*                (A1) _ EDIT DESCRIPTOR STATUS WORD 
*                (X1) = EDIT DESCRIPTOR STATUS (PREVIOUS) 
*                (B3) = COUNT OF REMAINING CHARACTERS IN (X4) 
  
 FMT.P    BSS    0
          BX0    X1 
          SBIT   X0,ES.SFP
          PL     X0,FMT.P1   IF NOT ALREADY A SCALE FACTOR
          CLAS=  X6,ES,(ERR)
          BX6    X6+X1
          SA6    A1          REFLECT THE ERROR
          FATAL  E.FS25 
 FMT.P1   MX0    -ES.SCL
          LX1    -ES.SCP
          BX1    X0*X1       CLEAR OLD STATE
          LX1    ES.SCP 
          CLAS=  X2,ES,(SS,SF)
          BX6    X1+X2
          SBIT   X6,ES.RPTP 
          MI     X6,FMT.P2   IF SCALE FACTOR COUNT PRESENT
          FATAL  E.FS07 
 FMT.P2   LX6    ES.RPTL+ES.RPTP
          CLAS=  X2,ES,(SGN,RPT)
          BX6    -X2*X6      CLEAR ES.RPT AND ES.SGN
          SA6    A1          UPDATE EDIT DESCRIPTOR STATUS
          =X6    1
          SA6    EDRPT       RESET EDIT DESCRIPTOR REPEAT COUNT 
          EQ     FMT.NX 
  
**        HERE ON *S*, *SP*, *SS*.
* 
*                (A1) _ EDIT DESCRIPTOR STATUS WORD 
*                (X1) = EDIT DESCRIPTOR STATUS (PREVIOUS) 
*                (B3) = COUNT OF CHARACTERS REMAINING IN (X4) 
  
 FMT.S    BSS    0
          NZ     B3,FMT.S2   IF MORE CHARACTERS IN STRING 
          SA2    A4+1        FETCH NEXT TOKEN 
          SB2    X2-O.CONS
          ZR     B2,FMT.S1   IF CONSTANT TOKEN
          SB2    X2-O.VAR 
          NZ     B2,FMT.S2   IF NOT VARIABLE TOKEN
 FMT.S1   SA4    A4+1 
          RJ     PFC         PROCESS STRING (FROM TOKEN)
 FMT.S2   SA3    FILL.
          LX4    CHAR 
          MX0    -CHAR
          BX2    -X0*X4      EXTRACT NEXT CHARACTER 
          LX0    X2 
          LX0    8*CHAR 
          BX6    X3+X0
          SA6    A3          UPDATE FOR POSSIBLE DIAGNOSTIC 
          SB3    B3+1 
          LX4    -CHAR       RESTORE
          ZR     X2,FMT.S3   IF *S* 
          =B3    B3-1 
          LX4    CHAR 
          SB2    X2-1RP 
          ZR     B2,FMT.S3   IF *SP*
          SB2    X2-1RS 
          ZR     B2,FMT.S3   IF *SS*
          SB3    B3-1 
          EQ     FMT.INV     INVALID CODE 
  
 FMT.S3   SBIT   X1,ES.RPTP 
          PL     X1,FMT.S4   IF NOT REPEAT COUNT
          FATAL  E.FS04 
 FMT.S4   LX1    ES.RPTL+ES.RPTP
          CLAS=  X3,ES,(FIN,WLD)
          BX6    X1+X3
          SA6    A1          UPDATE 
          =B3    B3-1 
          EQ     FMT.NX 
  
**        HERE ON *T*, *TL* OR *TR*.
* 
*                (A1) _ EDIT DESCRIPTOR STATUS WORD 
*                (X1) = EDIT DESCRIPTOR STATUS (PREVIOUS) 
*                (B3) = COUNT OF CHARACTERS REMAINING IN (X4) 
  
 FMT.T    BSS    0
          NZ     B3,FMT.T2   IF MORE CHARACTERS IN STRING 
          SA2    A4+1        FETCH NEXT TOKEN 
          SB2    X2-O.CONS
          ZR     B2,FMT.T1   IF CONSTANT TOKEN
          SB2    X2-O.VAR 
          NZ     B2,FMT.T2   IF NOT VARIABLE TOKEN
 FMT.T1   SA4    A4+1 
          RJ     PFC         PROCESS STRING (FROM TOKEN)
 FMT.T2   SA3    FILL.
          LX4    CHAR 
          MX0    -CHAR
          BX2    -X0*X4      EXTRACT NEXT CHARACTER 
          LX0    X2 
          LX0    8*CHAR 
          BX6    X3+X0
          SA6    A3          UPDATE FOR POSSIBLE DIAGNOSTIC 
          SB3    B3+1 
          LX4    -CHAR       RESTORE
          CLAS=  X3,ES,(T)
          ZR     X2,FMT.T3   IF *T* 
          SA5    ="NUM09" 
          SB2    X2 
          LX5    X5,B2
          MI     X5,FMT.T3   IF *TNNNN* 
          =B3    B3-1 
          LX4    CHAR 
          CLAS=  X3,ES,(TL) 
          SB2    X2-1RL 
          ZR     B2,FMT.T3   IF *TL*
          CLAS=  X3,ES,(TR) 
          SB2    X2-1RR 
          ZR     B2,FMT.T3   IF *TR*
          SB3    B3-1 
          EQ     FMT.INV     INVALID CODE 
  
 FMT.T3   SBIT   X1,ES.RPTP 
          PL     X1,FMT.T4   IF NOT REPEAT COUNT
          FATAL  E.FS04 
 FMT.T4   LX1    ES.RPTL+ES.RPTP
          BX6    X1+X3
          SA6    A1          UPDATE 
          =B3    B3-1 
          EQ     FMT.NX 
  
**        HERE ON *X*.
* 
*                (A1) _ EDIT DESCRIPTOR STATUS WORD 
*                (X1) = EDIT DESCRIPTOR STATUS (PREVIOUS) 
  
 FMT.X    BSS    0
          SBIT   X1,ES.RPTP 
          MI     X1,FMT.X1   IF COUNT PRESENT 
          FATAL  E.FS07      COUNT MISSING
 FMT.X1   LX1    ES.RPTL+ES.RPTP
          CLAS=  X2,ES,(FIN)
          BX6    X1+X2
          SA6    A1+         UPDATE EDIT DESCRIPTOR STATUS
          EQ     FMT.NX 
 FMT.ILL  SPACE  4,10 
*         HERE ON ALL ILLEGAL CHARACTER CODES.
  
 FMT.C    BSS    0
 FMT.H    BSS    0
 FMT.J    BSS    0
 FMT.K    BSS    0
 FMT.M    BSS    0
 FMT.N    BSS    0
 FMT.Q    BSS    0
 FMT.U    BSS    0
 FMT.V    BSS    0
 FMT.W    BSS    0
 FMT.Y    BSS    0
 FMT.INV  BSS    0
          FATAL  E.FS14 
          EQ     FMT=ILL1 
  
  
 FMT.ILL  EQ     "BLOWUP"    NON ALPHANUMERIC FOUND IN O.VAR OR O.CONS
  
          ERRPL  FMT.ILL-FMT.-400B
          TITLE  FMT. - DIGIT STRING PROCESSOR. 
 FMT.DIG  SPACE  4,10 
**        HERE ON DIGIT STRING. 
* 
*                (B3) = COUNT OF CHARACTERS REMAINING IN CURRENT TOKEN
*                (A4) _ CURRENT TOKEN IN T.TB 
*                (X4) = CHARS OF CURRENT TOKEN (CURRENT CHAR LOW ORDER) 
*                (X7) = CURRENT BUILD WORD
*                (B5) = BUILD WORD SHIFT COUNT
  
 FMT.DIG  BSS    0
          SA5    ="NUM09"    FOR DIGIT TEST 
          SX6    0           INITIALIZE BINARY WORD 
  
 DIG      ZR     B3,DIG1     IF CURRENT TOKEN USED UP 
          MX0    -CHAR
          BX2    -X0*X4      EXTRACT CHARACTER
          SB2    X2 
          LX3    B2,X5
          PL     X3,DIG5     IF NOT DIGIT 
          LX1    B1,X6       FORMER BINARY *2 
          SX0    X2-1R0 
          LX6    3           FORMER BINARY *8 
          IX6    X6+X1       EFFECTIVE MULTIPLY BY 10 
          IX6    X6+X0       ADD IN CURRENT DIGIT 
          =B3    B3-1 
          LX4    CHAR 
          EQ     DIG         CONTINUE 
  
*         TEST FOR CONTINUATION TOKEN 
  
 DIG1     SA1    A4+1        FETCH NEXT TOKEN 
          SB2    X1-O.CONS
          ZR     B2,DIG2     IF CONSTANT TOKEN
          SB2    X1-O.VAR 
          NZ     B2,DIG5     IF NOT VARIABLE TOKEN
  
 DIG2     SA4    A4+1 
          SA6    DIGA        PRESERVE 
          RJ     PFC         PROCESS STRING (FROM TOKEN)
          SA1    DIGA 
          LX4    CHAR 
          BX6    X1 
          EQ     DIG         CONTINUE 
  
*         ANALYZE THE DESCRIPTOR STATUS 
  
 DIG5     SA1    EDSTA
          LX4    -CHAR       RESTORE
          MX0    -ES.SCL
          BX2    X1 
          LX1    -ES.TBP
          SB4    X1          SET FOR POSSIBLE DIAGNOSTIC
          ERRNZ  18-ES.TBL
          LX1    ES.TBP 
          SBIT   X2,ES.ERRP 
          MI     X2,FMT.NX   IF PREVIOUS ERROR, IGNORE
          SBIT   X2,ES.ISP/ES.ERRP
          PL     X2,DIG10    IF NOT IN INITIAL STATE
  
 DIG7     LX1    -ES.SCP
          BX1    X0*X1       CLEAR STATUS CODE
          CLAS=  X2,ES,(RPT,RS) 
          LX1    ES.SCP 
          SA6    EDRPT       MUST BE REPEAT COUNT 
          BX6    X1+X2
          SA6    A1          UPDATE EDIT DESCRIPTOR STATUS
          EQ     FMT.NX      CONTINUE PROCESSING
  
 DIG10    SBIT   X2,ES.SSP/ES.ISP 
          MI     X2,DIG7     IF SCALE FACTOR STATE (TREAT AS RPT CNT) 
          SBIT   X2,ES.RSP/ES.SSP 
          PL     X2,DIG15    IF NOT IN REPEAT COUNT STATE 
          CLAS=  X6,ES,(ERR)
          BX6    X1+X6
          SA6    A1          UPDATE WITH ERROR FLAG 
          FATAL  E.FS15 
          EQ     FMT.NX 
  
 DIG15    SBIT   X2,ES.DSP/ES.RSP 
          PL     X2,DIG20    IF NOT IN EDIT DESCRIPTOR STATE
          LX1    -ES.SCP
          BX1    X0*X1       CLEAR STATUS CODE
          LX1    ES.SCP 
          SBIT   X2,ES.FINP/ES.DSP
          PL     X2,DIG16    IF NOT FINISHED
          FATAL  E.FS05 
          CLAS=  X2,ES,(ERR)
          BX6    X1+X2
          SA6    A1          UPDATE EDIT DESCRIPTOR STATUS
          EQ     FMT.NX 
  
 DIG16    CLAS=  X2,ES,(WF,WS)
          SA6    EDWID       MUST BE FIELD WIDTH
          BX6    X1+X2
          SA6    A1          UPDATE EDIT DESCRIPTOR STATUS
          EQ     FMT.NX      CONTINUE PROCESSING
  
 DIG20    SBIT   X2,ES.WSP/ES.DSP 
          PL     X2,DIG25    IF NOT IN FIELD WIDTH STATE
          LX1    -ES.SCP
          BX1    X0*X1       CLEAR STATUS CODE
          CLAS=  X2,ES,(MD,MS)
          LX1    ES.SCP 
          SA3    EDWID
          IX0    X3-X6
          PL     X0,DIG21    IF FIELD WIDTH .GE. M OR D 
          WARN   E.FS17 
  
 DIG21    BX6    X1+X2
          SA6    A1          UPDATE EDIT DESCRIPTOR STATUS
          EQ     FMT.NX      CONTINUE 
  
 DIG25    SBIT   X2,ES.MSP/ES.WSP 
          PL     X2,DIG30    IF NOT IN M OR D STATE 
          SBIT   X2,ES.EXPP 
          PL     X2,DIG30    IF NOT EXPONENT
          CLAS=  X2,ES,(EF,FIN)    MUST BE EXPONENT FIELD 
          BX6    X1+X2
          SA6    A1          UPDATE EDIT DESCRIPTOR STATUS
          EQ     FMT.NX 
  
 DIG30    CLAS=  X2,ES,(ERR)
          BX6    X1+X2
          SA6    A1 
          FATAL  E.FS15 
          EQ     FMT.NX 
  
 DIGA     BSS    1           SAVE BINARY CONSTANT 
          TITLE  SUBROUTINES. 
 AED      SPACE  4,10 
**        AED -  ANALYZE EDIT DESCRIPTOR
* 
*         ANALYZES THE EDIT DESCRIPTOR STATUS WORD TO DETERMINE IF ANY
*         UNDIAGNOSED ERRORS HAVE OCCURRED.  UPDATES THE CURRENT RECORD 
*         LENGTH WITH THE SIZE OF THE EDIT DESCRIPTOR (* REPEAT COUNT)
*         JUST PROCESSED.  RESETS EDIT DESCRIPTOR CELLS.
* 
*         USES   X1,X2,X3,X6  B2,B4,B7  A1,A2,A3,A6 
* 
*         CALLS  CRL
  
  
 AED      SUBR               ...ENTRY/EXIT... 
          SA1    EDSTA       EDIT DESCRIPTOR STATUS WORD
          ZR     X1,EXIT.    IF NOT EDIT DESCRIPTOR 
          LX1    -ES.TBP
          SB4    X1          SET IN CASE OF DIAGNOSTIC
          ERRNZ  18-ES.TBL
          LX1    ES.TBP 
          MX0    -ES.TGRPL
          LX1    -ES.TGRPP
          BX0    -X0*X1      EXTRACT TAB GROUP BITS 
          LX1    ES.TGRPP 
          SBIT   X1,ES.ERRP 
          MI     X1,AED40    IF ERROR 
          NZ     X0,AED30    IF TAB EDIT DESCRIPTOR 
          SBIT   X1,ES.HOLP/ES.ERRP 
          MI     X1,AED10    IF HOLLERITH/CHARACTER 
          SBIT   X1,ES.SSP/ES.HOLP
          MI     X1,AED40    IF SCALE FACTOR (ONLY) 
          SBIT   X1,ES.DESP/ES.SSP
          PL     X1,AED20    IF NO EDIT DESCRIPTOR
          BX0    X1 
          SBIT   X0,ES.SFP/ES.DESP
          PL     X0,AED1     IF NO SCALE FACTOR 
          SBIT   X0,ES.SPP/ES.SFP 
          MI     X0,AED1     IF SCALE FACTOR PERMITTED
          FATAL  E.FS25 
          EQ     AED40       FINISH UP
  
 AED1     SBIT   X1,ES.WRP/ES.DESP
          PL     X1,AED10    IF FIELD WIDTH NOT REQUIRED
          SBIT   X1,ES.WFP/ES.WRP 
          MI     X1,AED2     IF FIELD WIDTH PRESENT 
          FATAL  E.FS13 
          EQ     AED40       FINISH UP
  
 AED2     SBIT   X1,ES.PERP/ES.WFP
          PL     X1,AED3     IF *.* DIDNT OCCUR 
          SBIT   X1,ES.MDP/ES.PERP
          MI     X1,AED4     IF M OR D FIELD OCCURED
          FATAL  E.FS01 
          EQ     AED40       FINISH UP
  
 AED3     SBIT   X1,ES.PRP/ES.PERP
          PL     X1,AED10    IF *.* NOT REQUIRED
          FATAL  E.FS23 
          EQ     AED40       FINISH UP
  
 AED4     SBIT   X1,ES.EXPP/ES.MDP
          PL     X1,AED10    IF EXPONENT NOT PRESENT
          SBIT   X1,ES.EFP/ES.EXPP
          MI     X1,AED10    IF EXPONENT FIELD PERMITTED
          FATAL  E.FS24 
          EQ     AED40       FINISH UP
  
*         UPDATE RECORD LENGTH AND TEST FOR ERRORS. 
  
 AED10    SA2    EDRPT       EDIT DESCRIPTOR REPEAT COUNT 
          SA1    A1          RELOAD STATUS WORD 
          SA3    EDWID       EDIT DESCRIPTOR FIELD WIDTH
          NZ     X2,AED11    IF REPEAT COUNT NOT ZERO 
          FATAL  E.FS10 
          SX2    1
  
 AED11    NZ     X3,AED12    IF FIELD WIDTH NOT ZERO
          FATAL  E.FS13 
          SX3    1
  
 AED12    IX6    X2*X3
          HX1    ES.WLD 
          MI     X1,AED40    IF WIDTHLESS DESCRIPTOR (E.G. *BZ*)
          SA3    FMTRL       CURRENT RECORD LENGTH
          IX6    X3+X6
          SA6    A3          UPDATE RECORD LENGTH 
          RJ     CRL         CHECK RECORD LENGTH
          EQ     AED40
  
*         HERE WHEN NO EDIT DESCRIPTOR. (MUST BE REPEAT ON O.LP)
  
 AED20    SA2    A4          REFETCH TOKEN
          SB2    X2-O.LP
          ZR     B2,AED21    IF REPEAT COUNT ON *(* 
          FATAL  E.FS22 
          EQ     AED40       FINISH UP
  
 AED21    =X6    1
          SA6    EDWID
          MX6    0
          SA6    EDSTA       CLEAR EDIT DESCRIPTOR STATUS 
          EQ     EXIT.
  
*         HERE WHEN EDIT DESCRIPTOR IS *T*, *TL* OR *TR*
  
 AED30    SA2    EDWID       CHARACTER POSITION 
          SBIT   X1,ES.WFP/ES.ERRP
          PL     X1,AED31    IF NO CHARACTER POSITION SPECIFIED 
          NZ     X2,AED32    IF CHARACTER POSITION NOT NULL 
  
 AED31    FATAL  E.FS02 
          EQ     AED40       FINISH UP
  
 AED32    SA3    FMTRL       CURRENT RECORD LENGTH
          SBIT   X1,ES.TP/ES.WFP
          PL     X1,AED34    IF NOT *T* 
          SX6    X2-1 
          SA6    A3          UPDATE RL
          SB2    B6          PAREN NESTING LEVEL
          MX1    18 
          LX1    18+18
          LE     B2,AED40    IF NO LEVELS - FINISH UP 
  
 AED33    SA3    B2+LVSTAK-1
          BX6    -X1*X3      CLEAR LENGTH 
          SA6    A3 
          SB2    B2-1 
          NZ     B2,AED33    IF MORE LEVELS TO CLEAR
          EQ     AED40       FINISH UP
  
 AED34    SBIT   X1,ES.TLP/ES.TP
          PL     X1,AED36    IF NOT *TL*
          IX6    X3-X2
          PL     X6,AED35    IF NOT TAB LEFT PAST FRONT OF RECORD 
          TRIV   E.FS09 
          SX6    0
  
 AED35    SA6    A3 
          EQ     AED40       FINISH UP
  
 AED36    IX6    X3+X2
          SA6    A3 
          RJ     CRL         CHECK RECORD LENGTH
  
 AED40    MX6    0
          SA6    A1 
          =X6    1
          SA6    EDWID
          =A6    A6-EDWID+EDRPT 
          EQ     EXIT.
 CRL      SPACE  4,10 
**        CRL -  CHECK RECORD LENGTH
* 
*         CHECKS RECORD LENGTH AND OUTPUTS DIAGNOSTIC IF LENGTH IS
*         .GT. -- 137(WARNING) OR 131,071(FATAL). 
* 
*         ENTRY  (X6) = RECORD LENGTH 
* 
*         EXIT   DIAGNOSTIC OUTPUT IF NECESSARY 
* 
*         USES   X3,X6  B3,B7  A3 
  
  
 CRL      SUBR               ...ENTRY/EXIT... 
          SB3    X6-137-1 
          SA3    FMTRLC 
          MI     B3,EXIT.    IF COUNT IS .LE. 137 
          SB7    E.FS12 
          AX6    17 
          ZR     X6,CRL1     IF COUNT .LE. 131,071
          SB7    E.FS11 
  
 CRL1     SB3    X3+B7
          ZR     B3,EXIT.    IF ERROR ALREADY DETECTED
          SX6    -B7
          SA6    A3          UPDATE RECORD LENGTH ERROR 
          WARN   B7          OUTPUT RECORD LENGTH DIAGNOSTIC
          EQ     EXIT.
 PFC      SPACE  4,10 
**        PFC -  PROCESS FORMAT CHARACTER(S). 
* 
*         ENTRY  (X4) = TOKEN TO PROCESS. 
*                (X7) = CURRENT BUILD WORD. 
*                (B5) = CURRENT SHIFT POSITION. 
* 
*         EXIT   (X4) = STRING
*                (X7) = UPDATED 
*                (B3) = STRING COUNT
*                (B5) = UPDATED 
* 
*         USES   X0,X2,X3,X4  B3
  
  
 PFC      SUBR               ...ENTRY/EXIT... 
          MX0    TB.TOCL
          BX3    X0*X4       CHARACTERS ONLY
          MX0    -CHAR
          BX4    X3 
          =B3    0           INITIALIZE 
          LX3    CHAR 
          BX2    -X0*X3 
 PFC1     SB3    B3+1 
          LX2    X2,B5
          BX7    X7+X2       MERGE INTO BUILD WORD
          SB5    B5-CHAR
          MI     B5,PFC2     IF BUILD WORD FULL 
          LX3    CHAR 
          BX2    -X0*X3 
          ZR     X2,EXIT.    IF STRING PROCESSED
          EQ     PFC1 
  
 PFC2     =A7    A7+1        STORE BUILD WORD 
          MX7    0           RESET
          SB5    9*CHAR      SHIFT COUNT
          LX3    CHAR 
          BX2    -X0*X3 
          ZR     X2,EXIT.    IF STRING PROCESSED
          EQ     PFC1        CONTINUE 
 RED      SPACE  4,10 
**        RED -  RESTART EDIT DESCRIPTOR
* 
*         CALLED TO RESTART THE EDIT DESCRIPTOR STATUS WORD WHEN
*         A PUNCTUATION ERROR (OR LEGAL LACK OF PUNCTUATION) OCCURRED.
* 
*         ENTRY  (X4) = CHARACTERS TO PROCESS 
*                (A4) _ T.TB ENTRY
*                (B3) = NUMBER OF CHARACTERS REMAINING IN (X4)
* 
*         USES   X1,X6  A6
  
  
 RED      SUBR               ...ENTRY/EXIT... 
          CLAS=  X1,ES,(IS) 
          SX6    A4 
          LX6    ES.TBP 
          BX6    X6+X1
          SA6    EDSTA
          EQ     EXIT.
          SPACE  4,10 
          LIST   D
          END 
