*DECK     FMT 
          IDENT  FMT
 FMT      SECT   (FORMAT STATEMENT PROCESSOR),1 
  
          SST    B,D
          NOREF  B,D
  
 B=FMT    RPVDEF             DEFINE ROUTINE FWA FOR REPRIEVE UTILITY
  
          ENTRY  FMT6A
  
*         IN TABLES 
          EXT    CDD,LASTCOL,TP.FMT,TP=FMT,TS.STN 
  
*         IN ERRORS 
          EXT    E.FS1,E.FS2,E.FS3,E.FS4,E.FS5,E.FS6,E.FS5A,E.FS6A
          EXT    E.FS7,E.FS7A,E.FS7B,E.FS7C 
          EXT    E.FS8,E.FS8B,E.FS8C,E.FS8D,E.FS8E,E.FS8F,E.FS8A
          EXT    E.FS9,E.FS10,E.FS11,E.FS11A
          EXT    E.FS14,E.FS18,E.FS23,E.FS24,E.FS26,E.FS18A 
          EXT    E.FM,FILL. 
  
*         IN ALLOC
          EXT    ERT,ESN,MVE,SSN
  
*         IN MAIN 
          EXT    PSP.F
  
*         IN LEX
          EXT    THC,TSC
  
*         IN NUM
          EXT    CUA
  
*         IN INIT 
          EXT    FORSKEL,TRVA 
 ASD      SPACE  4,12 
**        ASD -  ASSEMBLE DIGITS FOR *FORMAT* PROCESSOR.
*         ENTRY  (B5) = 10- CURRENT CHAR COUNT. 
* 
*                IF (X0) = 0
*                   (X4) = CHARACTER BEFORE 1ST DIGIT.
*                IF (X0) < 0
*                   (X4) = 1ST DIGIT. 
* 
*                (X7) = CURRENT BUILD WORD. 
* 
*         EXIT   (A4) _ NEXT CHARACTER AFTER DIGIT. 
*                (X2) = ASSEMBLED BINARY NUMBER.
*                (X7) = UPDATED BUILD WORD. 
* 
*         USES   A1,A4-A6  X0-X5  B2,B5,B7
  
  
 ASD      SUBR   0
          SA5    ="NUM09" 
          BX2    0           INITIALIZE BINARY NUMBER 
          MI     X0,ASD1     IF 1ST DIGIT ALREADY IN REGISTER.
          SA4    A4+B1
          UX4    X4 
  
**        CHECK FOR *=* 
  
 ASD1     SB7    X4-1R= 
          NZ     B7,ASD5     IF NOT *=* 
          ANSI   E.FS9       *=* IS NON-ANSI
          BX5    0           FLAG THAT DIGIT IS *=* 
          MX2    60 
  
**        PACK CHARACTER IN BUILD WORD. 
  
 ASD5     SB2    X4 
          LX7    CHAR 
          SB5    B5-B1
          LX3    B2,X5
          BX7    X7+X4
          LX1    B1,X2
          SX0    X4-1R0 
          NZ     B5,ASD10    IF NOT FULL WORD 
          SB5    10 
          =A7    A7+1        STORE FORMAT WORD
          BX7    0
  
**        CONVERT TO BINARY 
  
 ASD10    PL     X3,ASD11    IF NOT DIGIT 
          LX2    3
          IX2    X2+X1
          SA4    A4+B1
          IX2    X2+X0
          UX4    X4 
          EQ     ASD5        LOOP 
  
 ASD11    NZ     X5,ASDX     IF DIGIT IS NOT *=*
          SA4    A4+B1       ASSEMBLY CHAR AFTER *=*
          =X5    1           FORCE EXIT AFTER NEXT CHAR 
          UX4    X4 
          EQ     ASD5 
 OFE      SPACE  4,12 
**        FMT -  PROCESS "FORMAT" STATEMENT.
* 
*         *FMT* SCANS FORMAT FOR SYNTACTICAL CORRECTNESS CHECKING FOR 
*         ILLEGAL COMBINATIONS AN MISCELLANEOUS PROGRAMMER ERRORS.
*         *FMT*S GOAL IS TO CONTINUE TO VERIFY THE FORMAT IN ALL CASES
*         EVEN WHEN AN ERROR IS ENCOUNTERED 
* 
*         ENTRY  B4 _ START OF *SB* 
*                *SB* IS UNTABBED.
*         EXIT   TO *PSP.F* 
* 
*         CALLS  ANSI,CUA,ERT,ESN,MVE,PWE,SSN,THC,TSC 
* 
*         USES   ALL REGISTERS. 
  
  
          HEREIF FORMAT 
  
          SA2    B4 
          SA1    =XSB.STNR   STATEMENT LABEL IN 0R FORM 
          UX2    X2 
          SB6    X2-1R( 
          NZ     B6,E.FM     IF HERE FROM *KEYWORD* 
          BX5    0
          SB2    B0 
          ZR     X1,E.FS1    IF NO STMT NUMBER.  (RETURN TO FMT6A)
          MI     X1,FMT6A    IF BAD LABEL 
          BX6    X1 
          LX1    5*CHAR 
          MX0    -CHAR
          SA3    =5L
  
**        PACK STATEMENT NUMBER AND LINE NUMBER FOR I/O ROUTINES. 
  
 FMT1     LX1    CHAR 
          BX2    -X0*X1 
          ZR     X2,FMT1     IF NO DIGIT YET. 
 FMT1A    ZR     X2,FMT1B    IF END OF STATEMENT NUMBER.
          LX5    CHAR 
          SB2    B2+CHAR
          LX1    CHAR 
          BX5    X2+X5
          BX2    -X0*X1 
          EQ     FMT1A       CONTINUE 
  
**        (X5) = 0L "STATEMENT NUMBER"
  
 FMT1B    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    P.STN
          SCAN   TS.STN,SSN 
          PL     B7,FMT2     IF *IT*
          =X7    M.SNFMT+M.SNDEF
          ADSTN  A1          ADD TO TABLE.
          EQ     FMT6        CONTINUE.
  
 FMT2     IFBIT  X6,SNFMT,FMT4     IF FORMAT
          SB2    E.FS23 
          IFBIT  X6,SNDOT/SNFMT,FMT3
          SB2    E.FS24 
 FMT3     =X1    M.SNDEF
          BX6    X1+X2
          SA6    A2 
          FATAL  B2          OUTPUT ERROR.
          EQ     FMT6A
  
**        SET *FORMAT* DEFINITION INTO TS.STN 
  
 FMT4     SB2    E.FS26 
          IFBIT  X6,SNDEF/SNFMT,FMT3
          =X1    M.SNDEF
          BX6    X1+X2
          SA6    A2          RESET INDICATING *FORMAT* + *DEFINED*
  
**        HERE WITH REGISTERS = TO
**        (B7) _ SYMBOL ENTRY FOR STATEMENT NUMBER. 
**        (X5) = FORMAT NUMBER FOR ENTRY INTO FORMAT SKELETON TABLE.
  
 FMT6     SA3    TP=FMT 
          SA4    TS.STN 
          SB7    B7+B1       TS.STN ORDINAL 
          LX3    P.SNAD      TP.FMT ORDINAL 
          SA4    X4+B7       TAG. 
          IX6    X4+X3       ADD-IN POINTER ORDINAL.
          SA6    TRVA        SAVE TAG FOR REF-MAP (IF REQUESTED)
          SA6    A4          RESET TS.STN TO CONTAIN TP.FMT POINTER.
 FMT6A    SA2    LASTCOL
          SB2    X2-1 
          BX7    X5 
          SA1    A0+B2
          SX6    X1-1R) 
          SA7    FORSKEL     0L [STATEMENT NUMBER]
          NZ     X6,E.FS2    IF *)* - ERROR 
          SB6    -1776B 
          MX0    -1 
          PX6    B6,X0
          SA6    A1+B1       MARK *EOS* 
  
**        VALIDATE *FORMAT* FOR SYNTACTICAL CORRECTNESS.
  
          SB6    B0 
          BX6    0
          SB5    9           CHAR/WORD CTR (NORMALLY 10 AT START) 
          SA4    B4          FETCH 1ST *(* OF FORMAT
          SA6    FMTRL       INITILIZE CHAR/RECORD CTR
          SA6    FMTRLC      CLEAR RECORD LENGTH CHECK. 
          SB3    B0          INITIALIZE PAREN LEVEL CTR 
          UX7    X4 
          EQ     FMT.NX      PROCESS 1ST CHAR AFTER LEFT PAREN
  
**        MASTER LOOP FOR CHECKING SYNTAX OF FORMAT.
*         REGISTERS CONTAIN 
*         (A4) = CURRENT *SB* WORD PROCESSING.
*         (A7) = SKELETON STORE ADDRESS-1.
*         (X2) = REPEAT COUNT.
*         (X7) = CURRENT BUILD WORD.
*         (B3) = PARENTHESIS LEVEL. 
  
**        ERROR ROUTINES CALLED SAVE ALL REGISTERS EXCEPT 
*         A1,A6  X0,X1  B7
  
**        HERE ON *(* 
*         UPDATE *(* COUNT, SAVE LEVEL STACK WORD, CHECK MAX PAREN LEVEL
  
 FMTBASE  BSS    0
 FMT.LP   NZ     X2,FMT.LP1  IF NOT NULL, ZERO, OR *=* AS REPEAT COUNT
          BX5    X2 
          =X2    1
          MI     X5,FMT.LP1  IF NULL OR *=* 
          =X2    0
          FATAL  E.FS8A      ZERO REPEAT COUNT
 FMT.LP1  SA3    FMTRL
          =B3    B3+1 
          LX3    18 
          BX6    X3+X2       24/0,18/FMTRL,18/REPEAT COUNT
          SX1    B3-LVMAX-1 
          SA6    B3+LVSTAK-1 NTH LEVEL STACK WORD 
          MI     X1,FMT.NX   IF PAREN LEVEL .LE. MAX -- OK
          FATAL  E.FS3       EXCEEDED MAX PAREN LEVELS
          =B3    B3-1        IN CASE MORE LEFT PARENS 
          EQ     FMT.NX 
  
**        HERE ON *)* 
  
 FMT.RP   ZR     B3,FMT.RP1  IF ZERO-LEVEL PAREN
          SA3    B3+LVSTAK-1
          SB3    B3-B1
          MI     X3,FMT.NX   IF A SLASH OR TAB WITHIN PAREN LEVEL 
          SX2    X3 
          SA1    FMTRL
          AX3    18 
          IX0    X1-X3
          IX1    X2*X0       REPEAT COUNT * GROUP LENGTH
          IX6    X1+X3       INCREMENT RECORD LENGTH
          SA6    A1 
          EQ     FMT.NX 
  
 FMT.RP1  SA4    A4+B1       CHECK FOR LEGAL TERMINAL *)* 
          MI     X4,FMT.EOS1 IF *EOS* 
          SX6    X4 
          LX6    9*CHAR 
          SA6    FILL.       BAD CHAR TO FILL.
          FATAL  E.FS18      CHAR FOLLOWS TERMINAL *)*
          EQ     FMT.EOS1    FINISH UP
  
  
**        HERE ON *A,D,E,F,G,I,L,O,R,V,Z* 
  
 FMT.O    BSS    0
 FMT.R    BSS    0
 FMT.V    BSS    0
 FMT.Z    BSS    0
          ANSI   E.FS8       O,R,V,Z ARE NON-ANSI 
 FMT.A    BSS    0
 FMT.D    BSS    0
 FMT.E    BSS    0
 FMT.F    BSS    0
 FMT.G    BSS    0
 FMT.I    BSS    0
 FMT.L    SB4    X4 
          NZ     X2,FMT.L1   IF NOT 0,NULL,OR *=* AS REPEAT COUNT 
          BX5    X2 
          =X2    1
          MI     X5,FMT.L1   IF NULL OR *=* AS REPEAT COUNT 
          =X2    0
          FATAL  E.FS8A      ZERO REPEAT COUNT
  
**        PROCESS FIELD WIDTH W 
  
 FMT.L1   BX6    X2 
          MX0    0
          SA6    FMTRC       SAVE REPEAT COUNT
          RJ     ASD         ASSEMBLY DIGITS
          NZ     X2,FMT.L3   IF NOT 0,NULL,OR *=* AS FIELD WIDTH
          MI     X2,FMT.L3   IF W IS *=*
          SX1    B4-1RV 
          ZR     X1,FMT.JP   IF V, MAY BE SUBSTITUTED BY P OR X 
          FATAL  E.FS8B      W IS ZERO OR NULL
  
**        PROCESS MINIMAL DIGITS Z
  
 FMT.L3   SA5    DEFG 
          BX6    X2 
          LX5    B4,X5
          BX1    X2 
          SA6    FMTFW
          MI     X5,FMT.L5   IF D,E,F,OR G
          SA5    IOV
          BX2    0
          LX5    B4,X5
          PL     X5,FMT.URL  IF NOT I,O,V 
          SB2    X4-1R. 
          NZ     B2,FMT.URL  IF MINIMUM DIGITS NOT SPECIFIED
          ANSI   E.FS8C      MINIMUM DIGITS IS NON-ANSI 
          MX0    0
          RJ     ASD         ASSEMBLY DIGITS
          SB2    B4-1RV 
          SA1    FMTFW
          NZ     B2,FMT.URL  IF NOT V 
          SX6    X2+3        W .GE. D+E+3 
          EQ     FMT.L9 
  
**        PROCESS DECIMAL WIDTH D 
  
 FMT.L5   SB2    X4-1R. 
          ZR     B2,FMT.L7
          ANSI   E.FS8D      DECIMAL POINT EXPECTED FOR D,E,F,G 
          =X2    2
          BX1    X6          FIELD WIDTH
          EQ     FMT.URL
  
 FMT.L7   MX0    0
          RJ     ASD         ASSEMBLY DIGITS
          SX2    X2+2        W .GE. D+2 
          SA1    FMTFW
          SB2    B4-1RE 
          NZ     B2,FMT.URL  IF NOT E CONVERSION DESCRIPTOR 
          SX2    X2+3        W .GE. D+5 
          SX6    X2-2        W .GE. D+E+3 
  
**        PROCESS EXPONENT LENGTH E 
  
 FMT.L9   SA5    DE 
          SB2    X4 
          LX5    B2,X5
          PL     X5,FMT.URL  IF EXPONENT LENGTH IS NOT SPECIFIED
          MX0    0
          RJ     ASD         ASSEMBLY DIGITS
          ANSI   E.FS8E      EXPONENT LENGTH IS NON-ANSI
          SA1    FMTFW
          IX2    X6+X2
  
**        UPDATE RECORD LENGTH. 
*         CHECK W AGAINST SOME MINIMUM AND UPDATE RECORD LENGTH 
* 
*         ENTRY  (X1) = FIELD WIDTH.           (W)
*                (X2) = MINIMUM FIELD WIDTH 
  
 FMT.URL  SA3    FMTRC
          IX0    X1-X2       FIELD WIDTH - MINIMUM
          MX2    60 
          MI     X1,FMT.RL   IF FIELD WIDTH IS *=*
          IX6    X1*X3
          SA3    FMTRL
          PL     X0,FMT.URL5 IF FIELD WIDTH .GE. MINIMUM
          WARN   E.FS8F 
 FMT.URL5 IX6    X6+X3
          SA6    A3          STORE NEW RECORD LENGTH
          EQ     FMT.RL      CHECK CURRENT LINE LENGTH
  
**        HERE ON *H* 
  
 FMT.H    SA3    FMTRL
          NZ     X2,FMT.H5   IF COUNT SPECIFIED.
          FATAL  E.FS10      ZERO OR *=* COUNT SPECIFIED
          EQ     FMT.ENX     ADVANCE TO NEXT SEPARATOR. 
  
 FMT.H5   IX6    X3+X2
          SA1    A7 
          SA6    A3          UPDATE RECORD LENGTH.
          BX6    X1 
          SA6    A7          FWA-1
          SX0    X2          COUNT
          LX6    X7 
          =B4    A4+1 
          RJ     THC         TRANSLATE HOLLERITH
          SA3    A6 
          BX7    X3 
          SA7    A6          RESET *A7* 
          LX7    X2 
          SA4    B4 
          ZR     X1,FMT.ENX  IF ERROR OCCURRED
          EQ     FMT.SL5
  
**        HERE ON *T* 
  
 FMT.T    BX0    0
          RJ     ASD         ASSEMBLY DIGITS
          MX0    1
          SA1    LVSTAK 
          SB6    B0 
 FMT.T3   BX6    X0+X1       SET SLASH-TAB FLAG IN LEVEL STACK
          =B6    B6+1 
          SA6    A1 
          =A1    A1+1 
          LT     B6,B3,FMT.T3   IF MORE PRECEDING LEVELS
          SA3    FMTRL
          LX5    X2 
          MX2    60 
          ZR     X5,FMT.T5   IF *T* EDIT IS ZERO OR *=* 
          SX6    X5-1        TAB EDIT CONVERTED TO RECORD LENGTH
          IX0    X6-X3
          SA6    A3 
          PL     X0,FMT.RL   *T* EDIT .GE. CURRENT COLUMN 
          WARN   E.FS5       *T* CODE OVERLAYS PREVIOUS LINE IMAGE
          EQ     FMT.RL 
  
 FMT.T5   BX6    0
          SA6    A3 
          MI     X5,FMT.JP   IF *T* EDIT IS *=* 
          ANSI   E.FS5A      *T* EDIT IS ZERO, RESET TO ONE 
          EQ     FMT.JP 
  
**        HERE ON *+* OR *-*
  
 FMT.PL   BSS    0
 FMT.MIN  SB4    X4          SAVE CHAR, *+* OR *-*
          =A1    A4+1 
          MX0    0
          UX3    X1 
          SB7    X3-1RS 
          ZR     B7,FMT.NX   IF + OR - S
          RJ     ASD         ASSEMBLE DIGITS
          SB7    X4-1RP 
          ZR     B7,FMT.NX   IF NEXT IS *P* 
          SB6    X4-1RX 
          ZR     B6,FMT.X0   IF NEXT IS *X* 
          FATAL  E.FS6       SIGN CAN ONLY PRECEDE *P* OR *NX*
          =A4    A4-1 
          EQ     FMT.ENX     ADVANCE TO NEXT SEPARATOR
  
 FMT.S    ANSI   E.FS6A      S CODE IS NON-ANSI 
          EQ     FMT.NX 
  
**        PROCESS *+NX* OR *-NX*
  
 FMT.X0   ANSI   E.FS7       + OR - NX IS NON-ANSI
          SX4    B4-1R- 
          NZ     X4,FMT.X    IF SKIP COUNT IS FORWARD 
          BX2    -X2
  
**        HERE ON *X* 
  
 FMT.X    SA3    FMTRL
          NZ     X2,FMT.X2   IF SKIP COUNT IS NOT NULL, ZERO, OR *=*
          =A1    A4-1 
          SB7    E.FS7C      SKIP COUNT IS ZERO 
          SB2    X1-1R0 
          ZR     B2,FMT.X1   IF SKIP COUNT IS ZERO
          SB6    X1-1R= 
          ZR     B6,FMT.SL5  IF SKIP COUNT IS *=* 
          SB7    E.FS7B      NULL SKIP COUNT
          =X2    1
          NZ     X4,FMT.X1   IF SKIP COUNT IS FORWARD 
          =X2    -1 
 FMT.X1   ANSI   B7 
 FMT.X2   IX6    X2+X3
          PL     X6,FMT.X3   IF RECORD LENGTH UPDATE IS OK
          BX6    0           RESET RECORD LENGTH
          WARN   E.FS7A      BACKSPACE BEYOND 1ST COLUMN,RESET AT 1ST 
 FMT.X3   SA6    A3          UPDATE RECORD LENGTH 
          EQ     FMT.SL5
  
**        HERE ON DIGIT.
  
 FMT.=    BSS    0
 FMT.0    BSS    0
 FMT.1    BSS    0
 FMT.2    BSS    0
 FMT.3    BSS    0
 FMT.4    BSS    0
 FMT.5    BSS    0
 FMT.6    BSS    0
 FMT.7    BSS    0
 FMT.8    BSS    0
 FMT.9    BX0    X7 
          AX7    CHAR 
          NZ     X0,FMT.9A   IF DIGIT DID NOT CAUSE FLUSH OF BUILD WORD.
          SA1    A7-B1
          SA3    A7 
          MX0    CHAR 
          BX7    X1 
          SB5    B0 
          SA7    A1          RESET *A7* TO LAST 
          AX3    CHAR 
          BX7    -X0*X3      RESET BUILD WORD.
 FMT.9A   MX0    1           INDICATE CHARACTER ALREADY IN (X4) 
          SB5    B5+B1
          RJ     ASD         ASSEMBLE DIGITS. 
          SA3    FMTSPEC
          SB2    X4 
          LX0    B2,X3
          MI     X0,FMT.JP   IF NEXT CHAR ALLOWED AFTER REPEAT COUNT
          SX6    X4 
          LX6    9*CHAR 
          SA6    FILL.       CHARACTER FOR ERROR PROCESSOR
          FATAL  E.FS4       ILLEGAL CHAR FOLLOWING REPEAT COUNT
          EQ     FMT.JP 
  
**        HERE ON * OR "
*         CONVERT *---* OR "---" TO NNH---
  
 FMT.QT   BSS    0
 FMT.STR  SX5    X4          SET FLAG THAT CALLER IS *FMT*
          SB4    A4          FWA OF STRING
  
*         REPLACE *DELIM* WITH *,*, ENSURE SPACE FOR NN 
  
 FMT.S1   NZ     X7,FMT.S2   IF *DELIM* DID NOT FORCE NEW WORD
          SA3    A7 
          MX0    60-CHAR     REPLACE *DELIM* WITH *,* 
          BX1    X0*X3
          SX4    1R,
          BX7    X1+X4
          SA7    A7 
          BX7    0
          EQ     FMT.S4 
  
 FMT.S2   AX7    CHAR        REMOVE *DELIM* 
          NE     B5,B1,FMT.S3 IF THERE IS SPACE FOR NN
          LX7    2*CHAR      INSERT *, * AND FORCE NEW WORD 
          SX4    2R,
          BX7    X7+X4
          =A7    A7+1 
          BX7    0
          SB5    10 
          EQ     FMT.S4 
  
 FMT.S3   LX7    CHAR        INSERT *,* 
          SX4    1R,
          BX7    X7+X4
  
*         ALLOCATE NN, SAVE POINTER TO NN 
  
 FMT.S4   LX7    2*CHAR      SPACE MADE FOR NN
          SB5    B5-2 
          SX0    B5+B5       2*SHIFT COUNT FOR NN 
          IX4    X0+X0       4* 
          SX3    A7 
          IX6    X4+X0       6* 
          LX3    18 
          BX6    X3+X6       24/0, 18/*A7*, 18/SHIFT COUNT
          SA6    FMTSTR 
          NZ     B5,FMT.S5   IF ROOM LEFT IN WORD 
          SB5    10 
          =A7    A7+1 
          BX7    0
  
*         INSERT H IN OUTPUT WORD AND TRANSFER X7,A7 TO X6,A6 
  
 FMT.S5   SA3    A7 
          SX1    1RH
          BX6    X3 
          LX7    CHAR 
          SA6    A7          SET *A6* TO *A7* 
          BX6    X7+X1       SET *X6* TO *X7* + *H* 
          =B5    B5-1 
          NZ     B5,FMT.S6   IF ROOM LEFT IN WORD 
          SB5    10 
          =A6    A6+1 
          BX6    0
  
 FMT.S6   RJ     TSC         TRANSLATE STRING DELIMITED CONSTANT
          SA3    A6 
          SX0    99 
          BX7    X3 
          SA4    B4          SET POINTER IN CASE OF ERROR 
          SA7    A6          *A7* SET TO *A6* 
          SB6    B3 
          LX7    X2          *X7* SET TO *X2* 
          ZR     X1,FMT.ENX  IF ERROR OCCURRED
          SX1    2R99 
          MI     X5,FMT.S7   IF MAX COUNT OF 99 REACHED 
          SX3    B2-99
          BX1    -X3
          LX0    X1          LENGTH OF CONSTANT 
          RJ     CDD         CONVERT DECIMAL TO DISPLAY 
          MX3    60-12
          SB3    B6 
          BX1    -X3*X6      ONLY 2 DIGITS ALLOWED
  
*         INSERT NN INTO ALOCATED SPACE 
  
 FMT.S7   SA3    FMTRL       UPDATE RECORD LENGTH 
          SA2    FMTSTR      FETCH POINTERS TO NN 
          IX6    X3+X0
          SB2    X2          SHIFT COUNT
          SA6    A3 
          AX2    18          (POINTER TO NN) - 1
          SX4    A7 
          IX3    X4-X2
          NZ     X3,FMT.S8   IF OUTPUT WORD HAS BEEN UPDATED
          SB7    B2-B7
          LX1    B7,X1
          BX7    X7+X1
          EQ     FMT.S9 
  
 FMT.S8   LX1    B2,X1
          =A3    X2+1 
          BX6    X3+X1       INSERT NN
          SA6    A3 
  
*         LOOP IF MORE CHAR TO PROCESS, ELSE EXIT 
  
 FMT.S9   SA4    B4 
          PL     X5,FMT.S11  IF ENTIRE STRING IS PROCESSED
  
*         EXIT IF *DELIM* FOLLOWS 99TH CHAR 
  
          =A4    B4+1        MOVE POINTER IN CASE END OF STRING 
          SX5    X5 
          UX4    B7,X4
          IX0    X4-X5
          NZ     X0,FMT.S10  IF NEXT CHAR NOT *DELIM* 
          SB7    B7+1777B 
          GT1    B7,FMT.S10  IF BLANKS BEFORE *DELIM* 
          SX3    X4-1R" 
          NZ     X3,FMT.S11  IF *DELIM* NOT *"* 
          =A2    A4+1 
          IX3    X2-X4
          NZ     X3,FMT.S11  IF NEXT CHARS NOT *""* 
          UX2    B7,X2
          SB7    B7+1777B 
          GT1    B7,FMT.S11  IF BLANKS BETWEEN *"*
 FMT.S10  SX6    X5 
          SA6    B4          FAKE A *DELIM* 
          NZ     B5,FMT.S1   CONVERT REST OF STRING INTO NNH
          SB5    10 
          =A7    A7+1 
          BX7    0
          EQ     FMT.S1      LOOP TO PROCESS REMAINING CHARACTERS 
  
 FMT.S11  LX7    60-CHAR
          =B5    B5+1 
          EQ     FMT.SL5
  
**        HERE ON */* 
  
 FMT.SL   BX6    0
          MX0    1
          SA6    FMTRL       RESTART RECORD LENGTH
          SA3    LVSTAK 
          SB6    B0 
 FMT.SL3  BX6    X0+X3       SET SLASH-TAB FLAG IN LEVEL STACK
          =B6    B6+1 
          SA6    A3 
          =A3    A3+1 
          LT     B6,B3,FMT.SL3  IF MORE PRECEDING LEVELS
  
**        HERE IF *,* CAN BE ELIMINATED IF NEXT CHARACTER.
  
 FMT.SL5  =A5    A4+1        NEXT CHARACTER 
          SB7    X5-1R, 
          NZ     B7,FMT.NX   IF NOT FOLLOWED BY *,* 
          SA4    A4+B1       BY-PASS *,*
  
**        LOAD NEXT CHARACTER.
*         CLEARS CURRENT REPEAT COUNT.
  
 FMT.CM   BSS    0
 FMT.P    BSS    0
 FMT.NX   MX2    60 
 FMT.NX1  SA4    A4+B1
          LX7    CHAR 
          MI     X4,FMT.EOS 
          UX4    X4 
          BX7    X7+X4       PACK CHARACTER 
          SB5    B5-B1       DECREMENT CHAR/WORD CTR
          NZ     B5,FMT.RL   IF WORD NOT FULL CONTINUE PROCESSING 
          SB5    10 
          =A7    A7+1        STORE FORMAT WORD
          BX7    0
  
**        CHECK RECORD LENGTH AND OUTPUT DIAGNOSTIC IF LENGTH IS GREATER
*         THAN -- 137 OR 131,071
* 
*         (X4) = NEXT CHARACTER.
  
 FMT.RL   SA1    FMTRL
          SB6    X1-137-1 
          SA3    FMTRLC 
          MI     B6,FMT.JP   IF COUNT IS .LE. 137 
          SB7    E.FS11A
          AX1    17 
          ZR     X1,FMT.RL5  IF COUNT .LE. 131,071
          SB7    E.FS11 
  
 FMT.RL5  SB6    X3+B7
          ZR     B6,FMT.JP   IF ERROR ALREADY DETECTED. 
          SX6    -B7
          SA6    A3          UPDATE R.L. ERROR. 
          WARN   B7          OUTPUT RECORD LENGTH DIAGNOSTIC
  
**        JUMP TO NEXT PROCESSOR UNIT 
*         (X4) = UNPACKED CHARACTER PROCESSING. 
  
 FMT.JP   SX1    3
          SX6    X4 
          BX0    X1*X4       2 BITS ONLY FOR SHIFT COUNT
          LX6    9*CHAR 
          BX1    X4 
          LX0    3           *8--SHIFT COUNT WITHIN JUMP WORD 
          AX1    2           INDEX TO JUMP WORD 
          SA6    FILL.       CHARACTER IN CASE OF ERROR 
          SA1    X1+FMTJT    JUMP WORD
          SB7    X0 
          AX1    X1,B7
          SX0    377B 
          BX1    X1*X0
          SB7    X1 
          JP     B7+FMTBASE  PROCESS NEXT.
  
**        HERE ON ALL UNKNOWN CHARACTER CODES.
  
 FMT.BE   BSS    0
 FMT.CE   BSS    0
 FMT.JE   BSS    0
 FMT.KE   BSS    0
 FMT.ME   BSS    0
 FMT.NE   BSS    0
 FMT.QE   BSS    0
 FMT.SE   BSS    0
 FMT.UE   BSS    0
 FMT.WE   BSS    0
 FMT.YE   BSS    0
 FMT.PDE  BSS    0
 FMT.$E   BSS    0
 FMT.BKE  BSS    0
 FMT.00   BSS    0
 FMT.EE   FATAL  E.FS14 
          EQ     FMT.ENX     TO NEXT CHARACTER. 
  
**        HERE ON *EOS* 
*         *FMT.EOS1* WHEN TERMINAL *)* FOUND, AND 
*         *FMT.EOS* WHEN TERMINAL *)* NOT FOUND 
* 
*         (B5) = 10- CURRENT BUILD WORD CHARACTERS. 
  
 FMT.EOS  FATAL  E.FS18A     MISSING TERMINAL *)* 
  
 FMT.EOS1 ZR     X7,FMT130   IF NULL WORD 
          SB2    B5+B5       *2 
          SB3    B2+B2       *4 
          SB2    B3+B2       *6 
          SA1    =10H 
          MX0    6
          SB3    B2-6 
          AX0    X0,B3
          BX3    X0*X1
          BX0    X3+X7
          LX7    B2,X0       TO 0H FORM 
          =A7    A7+1 
  
**        ADD FORMAT TO TABLE AND EXIT. 
  
 FMT130   SB6    FORSKEL-1
          SB6    A7-B6       = LENGTH OF THIS FORMAT
          ALLOC  TP.FMT,B6
          SX1    B6          = W.C. 
          SX2    FORSKEL     = SOURCE 
          SX3    B7-B6       = DESTINATION = (LWA+1 OF TABLE) - (W.C.)
          RJ     MVE
          SA1    TRVA        REFERENCE TAG. 
          ADDREF X1,CR.LAB,PSP.F
  
**        HERE AFTER UNKNOWN CODE ERROR PROCESSED 
*         SCAN FORWARD TILL SEPARATOR FOUND AND EXIT TO 
*         NEXT CHARACTER LOOP.
  
  
 FMT.ENX  SA5    ="FMTSEP"
 FMT.ENX1 =A4    A4+1 
          MI     X4,FMT.EOS  IF *EOS* 
          SB2    X4 
          LX0    B2,X5
          PL     X0,FMT.ENX1 IF NOT SEPARATOR 
          =A4    A4-1 
          EQ     FMT.NX      CONTINUE 
  
 JTFMT    EJECT 
 FMTLNG   =      FMT.00-FMTBASE    SHOULD BE MAX OF 377B FOR JUMP TABLE 
**        JTFMT - FORMAT *CONO* TABLE.
  
  
 JTFMT    MACRO  JUMPS
          VFD    28/0 
          IRP    JUMPS
          VFD    8/FMT.JUMPS-FMTBASE
          IRP 
 JTFMT    ENDM
  
  
**        JUMP TABLE PARAMETERS.
  
  
 FMTJT    BSS    0
  
          JTFMT  (CE,BE,A,00) 
          JTFMT  (G,F,E,D)
          JTFMT  (KE,JE,I,H)
          JTFMT  (O,NE,ME,L)
          JTFMT  (SE,R,QE,P)
          JTFMT  (WE,V,UE,T)
          JTFMT  (0,Z,YE,X) 
          JTFMT  (4,3,2,1)
          JTFMT  (8,7,6,5)
          JTFMT  (STR,MIN,PL,9) 
          JTFMT  ($E,RP,LP,SL)
          JTFMT  (PDE,CM,BKE,=) 
          JTFMT  (EE,EE,EE,EE)
          JTFMT  (EE,EE,EE,QT)
          JTFMT  (EE,EE,EE,EE)
          JTFMT  (EE,EE,EE,EE)
 FMTRC    SPACE  4,8
  
 LVMAX    =      9           MAXIMUM LEVEL OF PARENS
 FMTRC    BSS    1           CURRENT REPEAT COUNT 
 LVSTAK   BSS    LVMAX       PAREN LEVEL STACK -- 1/SLASH-TAB, 23/0,
,                            18/FMTRL, 18/REPEAT COUNT
 FMTFW    DATA   0           (W) WIDTH LENGTH.
 FMTRL    DATA   0           CURRENT RECORD LENGTH. 
 FMTRLC   DATA   0           FLAG TO INDICATE WHETHER ERROR SHOULD BE 
,                            ISSUED FOR COLUMN COUNT EXCEEDED 
 FMTSTR   DATA   0           POINTERS FOR RETRIEVING NN FOR HOLL STRINGS
  
 FMTSPEC  BSS    0
          ECHO   2,X=(A,D,E,F,G,H,I,L,O,P,R,V,X,Z)
          POS    60-1R_X
          VFD    1/1
          POS    60-1R( 
          VFD    1/1
          VFD    *P/0 
 DEFG     BSS    0
          ECHO   2,X=(D,E,F,G)
          POS    60-1R_X
          VFD    1/1
          VFD    *P/0 
 IOV      BSS    0
          ECHO   2,X=(I,O,V)
          POS    60-1R_X
          VFD    1/1
          VFD    *P/0 
 DE       BSS    0
          ECHO   2,X=(D,E)
          POS    60-1R_X
          VFD    1/1
          VFD    *P/0 
  
          LIST   D
          END 
