*DECK MAIN
          IDENT  MAIN 
 MAIN     SECT   (MASTER STATEMENT RECOGNITION.),1
  
          SST    A,B,D,EXIT.
          NOREF  A,B,D,EXIT.
  
 B=MAIN   RPVDEF             DEFINE ROUTINE FWA FOR REPRIEVE UTILITY
  
          ENTRY  PSP,CPM,CPM2,CPM5,CPM6,CUS.RET,CUSX,PSP.F,PSP.C,CPM=1ST
          ENTRY  CPM=IMP,PSFX,HDRBL,CPM=BY,TABX.F,IFS.X,CPM=ASF,PCDX
          ENTRY  CSK,GSNX,AFSX,LSL,WOF,WBL
          ENTRY  ASK,ASL,CSB,CST,CPM=EXU,CPM=END,CPM=NTR,CPM=OK,CPM=DAT 
          ENTRY  CPM=DEC,CPM=TYP,CPM=TPE,CPM=FMT,RNC
          ENTRY  BLL,LSS,PSP.Z
          ENTRY  RNS,PLO,AFS.ME,PLR 
  
*         IN FTN
          EXT    AMODE,CO.SNAP,CO.MODE,CP.CARD,CP.FLIN,LCP.PS,PDFLAG
          EXT    CP.PAGE,F.IN,F.OUT,LOP=O,LOP=X,O.TITL,L.TITL,TL.PAGE 
  
*         IN TABLES 
          EXT    ASFLEN,CARDS,CCNT,CDD,CSLIST,CSNTAG,CSSTMT 
          EXT    DEFERL,DTI,DXB,FIRSTV,FLOW 
          EXT    HANGER,ICONL,LASTCOL,LCNT,MOD
          EXT    MSF,MULS,NOLIST,NOPATH,NOREL,NSK,MLOP=O
          EXT    OPBSS,PASS,REFLIN
          EXT    REFNUM,REFVAR,SB.STNL,SB.STNR,STAGE,STN,TS=CON,TS.SYM
          EXT    T.DLBUF,T=DLBUF
          EXT    TT=ASF,TT.PAR,TP=DO,TS=CONB,TT=PAR,ZLE,ZLCOMMA,ZLEQUAL 
          EXT    ZLPAREN
  
*         IN ERRORS 
          EXT    E.ANS1,E.FM,E.MA,E.MB,E.MCA,E.MC1,E.MD,E.MDO 
          EXT    E.MH,E.MI,E.MK,E.ML,E.MLNL,E.MT,E.NLN,E.NP 
          EXT    E.SN16,E.TYH,FILL.,FILL.2,UEC
  
*         IN HEADER 
          EXT    PSF
  
*         IN ALLOC
          EXT    ALC,SSY
  
*         IN LEX
          EXT    TAB,BLANK
  
*         IN KEY
          EXT    CONTIN=,END=,ENTRY=
  
*         IN IF 
          EXT    INIF 
  
*         IN DECL 
          EXT    PCD
  
*         IN TYPE 
          EXT    TYPC 
  
*         IN FMT
          EXT    FORMAT=
  
*         IN IO 
          EXT    LGR,LG.LEN,NULL,REP.,DO.,IF.,ASF.,EOS
  
*         IN NUM
          EXT    GSN,CUA,CUAFLAG
  
*         IN PAR
          EXT    CURST
  
*         IN GEN
          EXT    CAI
  
*         IN INIT 
          EXT    SCR,CST.BOS
  
 LGR      SPACE  4,15 
**        CPM= - STAGE VECTORS ARE ROWS IN A TRANSITION TABLE WHICH 
*                DESCRIBES THE ACTION NECESSARY (AS A JUMP ADDRESS) UPON
*                ENCOUNTERING A STATEMENT WITH (SCPM) = ROW WHEN
*                (STAGE) = COLUMN.
*         THE FIRST 6 ENTRIES ARE ORDER-DEPENDENT (ONE FOR EACH VALUE OF
*                *STAGE*).  FURTHER ENTRIES ARE ADDED FOR STATEMENTS NOT
*                ACCURATELY DESCRIBED BY ANY PREVIOUS ROW.
  
  
          MACRO  CPM=,NAM,FST,IMP,DEC,ASF,EXU,SKP 
 A        MICRO  1,2, SKP_BY
 CPM=NAM  VFD    12/0,8/CPM."A",8/CPM.EXU,8/CPM.ASF,8/CPM.DEC,8/CPM.IMP,
,8/CPM.FST
 CPM=     ENDM
  
 CPM=     BSS    0
          LOC    0
****             (1ST IMP DEC ASF EXU)
 1ST      CPM=    OK_,EMH,EMH,EMH,EMH 
 IMP      CPM=    IMP,OK_,EMI,EMI,EMI 
 DEC      CPM=    IMP,DEC,OK_,EMD,EMD 
 ASF      CPM=    IMP,DEC,ASF,OK_,EMA 
 EXU      CPM=    IMP,DEC,ASF,EXU,OK_ 
 CPM=BY   BSS    0                          DEFINE COLUMN FOR SKIP-STAGE
 END      CPM=    EMT,DEC,ASF,EXU,OK_,OK
  
 DAT      CPM=    IMP,DEC,ASF,OK_,OK_ 
 FMT      CPM=    IMP,FMT,FMT,FMT,FMT 
 NTR      CPM=    IMP,DEC,OK_,OK_,OK_ 
 TYP      CPM=    OK_,DEC,OK_,EMD,EMD 
 TPE      CPM=    OK_,OK_,OK_,EMD,EMD 
 OK       CPM=    OK_,OK_,OK_,OK_,OK_,OK      ALWAYS PROCESS
****
          LOC    *O 
 HEREIF   SPACE  4,15 
 PSP      EJECT 
**        PSP -  RETURN TO MASTER LOOP FROM STATEMENT PROCESSING. 
  
  
**        PSP.Z - RETURN FROM COMPILER ERROR.  SET UP TO BYPASS 
*                COMPILATION OF REST OF PROGRAM UNIT
  
 PSP.Z    SX7    CPM=BY 
          SA7    STAGE
          SA1    PASS 
          SX1    X1-PASS=END
          MI     X1,PSP.F    IF NOT IN END OR MAP PROCESSING
          EQ     =XEND96
  
**        PSP.A - NON-ANSI STATEMENTS MAY RETURN TO HERE TO HAVE THE
*                STATEMENT FLAGGED. 
  
 PSP.A    SA1    LOP=X
          PL     X1,PSP      IF ANSI SWITCH OFF 
          EQ     E.ANS1      (RETURN TO *PSP*)..
  
  
**        PSP.C - RETURN TO MASTER LOOP FOR ALL PROCESSORS THAT RESET 
*                CONSTANT TABLE LENGTH. IE. *DATA*
  
  
 PSP.C    SA1    ICONL       SPECIAL ENTRY TO RE-SET CON TABLE
          SHRINK TS=CON,X1
  
**        PSP -  GENERAL RETURN TO MASTER LOOP FOR NON-EXECUTABLE 
*                STATEMENT PROCESSORS.
*                STATEMENT WILL BE FLAGGED IF A LABEL IS PRESENT. 
  
 PSP      SA3    SB.STNL
          ZR     X3,PSP.F    IF EMPTY LABEL FIELD 
          WARN   E.SN16      STATEMENT LABEL IGNORED (RETURN CPM) 
  
**        PSP.F - RETURN TO MASTER LOOP FOR *FORMAT* PROCESSOR. 
*                LABEL FIELD IS NOT CHECKED.
  
 PSP.F    BSS    0
 CPM      SPACE  4,30 
**        CPM -  COMPILER MASTER LOOP.
  
  
 CPM      SA1    =XT.SB 
          NO
          SA0    X1          RESTORE (A0) 
          RJ     RSC         RESET STATEMENT CELLS
  
 CPM1     RJ     AFS         ASSEMBLE FORTRAN STATEMENT 
  
          =A1    "SB.STN" 
          MX6    1           ALLOW ZERO STATEMENT LABELS
          SA6    CUAFLAG
          RJ     CUA         ASSEMBLE LABEL FIELD 
          BX7    0           RESET FLAG 
          SA7    CUAFLAG
          LX7    X6,B2       LEFT JUSTIFY 
          SA6    SB.STNR
          =A7    A6-1 
  
**        NORMALIZE THE STATEMENT -- CALL *TAB*.
  
          =B3    "SB.FWA"    FWA FOR STORE
          RJ     TAB         NORMALIZE STATEMENT
          SA2    BLANK
          SA1    MULS 
          SB3    A0-B3
          SX6    -B3         (LASTCOL) = ORDINAL OF *EOS* 
          SA6    LASTCOL
          NZ     X1,CPM1A    IF MULTIPLE STATEMENT IN LINE
          SX6    X6+2 
          SHRINK T=SB,X6
 CPM1A    ZR     X2,CPM8     IF THIS IS A NULL STATEMENT
  
**        CLASSIFY THE STATEMENT -- CALL *CST*. 
  
          =B4    "SB.FWA"    FWA OF STATEMENT 
          RJ     CST         CLASSIFY STATEMENT.
 TABX.F   BSS    0           .. EXIT FROM TAB WHEN *FORMAT* 
          MI     B5,E.FM     IF UNRECOGNIZABLE STATEMENT. 
          BX7    X5 
  
 CPM.MT   BSS    0           ** HERE IF EMPTY STATEMENT WITH LABEL
 AFS.EOS  BSS    0           .. EXIT FROM AFS WHEN END-OF-SECTION 
          =A7    "SB.KEY"    SAVE STATEMENT TYPE-KEY
  
 SNAP=M   IFNE   TEST        DUMP *SB*
          SA1    CO.SNAP
          LX1    1RM
          PL     X1,CPM1S    IF MASTER LOOP SNAP NOT REQUESTED
          RJ     =XSVR
          PLINE  (=C=  (DUMP OF *SB* -- FROM MASTER LOOP.)=),1
          RJ     =XSBL       LIST STRING BUFFER 
          RJ     =XRSR
 CPM1S    BSS    0
 SNAP=M   ENDIF 
  
  
**        NOW FOR MISCELLANEOUS CHECKS ON THE PROPERTIES OF THE 
*         STATEMENT.  SEE *HEREIF* MACRO FOR DEFINITIONS OF ATTRIBUTES. 
  
  
**        DIAGNOSE ILLEGAL STATEMENTS IN *BLOCKDATA* SUBPROGRAMS. 
  
          SA1    MOD
          SX4    M.PBLK 
          BX4    X4*X1       FORM MASK (=1 IF BLOCKDATA)
          SBIT   X4,PBLK/SBKD 
          BX4    -X5*X4      ISOLATE *LEGAL IN BKD* BIT (IF IN BKD) 
          NZ     X4,E.MB     IF NASTY IN BLOCKDATA, ERR.. 
 CPM2     SA5    "SB.KEY" 
  
  
**        INSURE THAT THIS STATEMENT IS IN ITS PROPER PLACE.
  
 PCDX     BSS    0           .. RETURN FROM *PCD*.
 PSFX     BSS    0           .. RETURN FROM *PSF*.
  
 CPM3     BX3    X5 
          MX0    -L.SCPM
          SA4    STAGE
          LX3    -P.SCPM
          BX2    -X0*X3      ISOLATE STATEMENT STAGE NUMBER 
          SA1    X2+CPM=     FETCH STAGE VECTOR 
          LX4    3           = ACTUAL (STAGE) * 8 
          SB7    X4 
          MX0    -8 
          AX1    B7 
          BX2    -X0*X1      ISOLATE COLUMN 
          SB2    X2 
          JP     B2+CPM.
  
 CPM.     BSS    0           BASE OF STAGE ACTIONS TABLE. 
          LOC    0
  
 CPM.IMP  EQ     PSF         SET STAGE = IMP
  
 CPM.DEC  =X6    CPM=DEC     SET STAGE = DEC
          SA6    A4 
          EQ     CPM3 
  
 CPM.ASF  EQ     PCD         SET STAGE = ASF
  
 CPM.EXU  =X6    CPM=EXU     SET STAGE = EXU
          SA1    TT=ASF 
          BX7    X1 
          SA6    A4 
          SA7    ASFLEN      SAVE REAL LENGTH OF TT.ASF 
          EQ     CPM3 
  
 CPM.FMT  EQ     FORMAT=
  
 CPM.EMA  EQ     E.MA        MISPLACED STMNT FUN (RETURN - PSP) 
 CPM.EMD  EQ     E.MD        MISPLACED DECLARATV (RETURN - PSP) 
 CPM.EMH  EQ     E.MH        MISPLACED HEADER    (RETURN - PSP) 
 CPM.EMI  EQ     E.MI        MISPLACED IMPLICIT  (RETURN - PSP) 
  
*         HERE IF NULL PROGRAM UNIT OCCURRED -- NEED TO LIST
*         ANY COMMENT LINES THAT MIGHT HAVE BEEN SAVED
*         IN *BEFORE HEADER* MODE.
  
 CPM.EMT  SA1    =XHDELAY 
          ZR     X1,=XE.MT   IF DONT NEED TO LIST ANYTHING
          RJ     LDB         LIST DEFERRED BUFFER 
          EQ     =XE.MT      NULL PROGRAM  (RETURN - RUN.X) 
  
 CPM.BY   SA1    =5A--       SKIP BY THIS STATEMENT 
          BX6    X1 
          SA6    CP.FLIN
          EQ     PSP.F
  
 CPM.OK   BSS    0           PROPERLY POSITIONED. 
          LOC    *O 
  
  
**               IF THIS IS A CODE-GENERATING STATEMENT, INVOKE *CUS* TO
*         FINISH UP ANY INCOMPLETE STUFF FROM PREVIOUS STATEMENT, 
*         PROCESS THE LABEL, AND RESET (A7).
  
          SA1    =XMOD
          SBIT   X1,PBLK
          SBIT   X5,SGEN
          MI     X1,CUSX     IF BLOCKDATA 
          MI     X5,CUS      IF A GENERATOR 
*         ... 
 CUSX     BSS    0           .. RETURN FROM *CUS* 
          =A5    "SB.KEY" 
          SA1    DTI
          SBIT   X5,SDON
          ZR     X1,CPM5     IF NO DO TERMINATION 
          PL     X5,CPM5     IF NOT DO TERMINAL 
          FATAL  E.MDO       *ILLEGAL DO TERMINAL*
 CPM5     BSS    0
  
  
**               LOGICAL (1-BRANCH) IF PROCESSOR RETURNS TO HERE AFTER
*         DETERMINING STATEMENT TYPE AND LEGALITY.
  
 IFS.X    BSS    0           ** ENTRY FROM 1-BRANCH IF
          RJ     UEC         UPDATE ERROR COUNT 
          =A1    "SB.BOS" 
          =A5    "SB.KEY" 
          =B4    X1 
          MI     X5,CPM6     IF NOT A KEYWORD STATEMENT 
  
          RJ     ASK         ADJUST KEYWORD STATEMENT 
          NZ     X3,E.MK     IF KEYWORD DOES NOT MATCH
  
**        JUMP - TO COMPILE THE STATEMENT.
  
 CPM6     SA5    "SB.KEY" 
          SB6    X5 
          JP     B6          JUMP TO ROUTINE
  
  
**        HANDLE NULL (EMPTY -- ALL BLANK) STATEMENTS HERE. 
* 
*         ENTRY  (SB.STNR) = LABEL, DPC RIGHT JUSTIFIED, ZERO FILL
*                          = 0 IF NO LABEL
*                          = -1 IF ERROR IN LABEL 
* 
*         EXIT   (NSK) ADVANCED 
*                IF LABEL FIELD IS NON-BLANK, WE WILL TREAT IT AS A 
*                *CONTINUE* STATEMENT, WITH AN APPROPRIATE WARNING. 
  
 CPM8     SA1    NSK         COUNT NULL STATEMENTS
          SA2    SB.STNR
          =X7    X1+1 
          SA7    A1 
          ZR     X2,CPM1     IF NO LABEL
          MI     X2,CPM1     IF ILLEGAL LABEL 
          WARN   E.ML 
          SX5    NULL 
          SA5    X5+LGR 
          BX7    X5 
          EQ     CPM.MT      TREAT IT AS A *CONTINUE* STATEMENT 
 AFS      SPACE  4,8
**        AFS -  ASSEMBLE FORTRAN STATEMENT.
* 
*         READS A FORTRAN STATEMENT (INCLUDING CONTINUATION CARDS) AND
*         ASSEMBLES IT INTO THE *STRING BUFFER*.  EACH CHARACTER IS 
*         PACKED WITH AN EXPONENT FIELD EQUAL TO THE NUMBER OF PRECEDING
*         BLANKS, PLUS ONE.  IDEA AND CODE STOLEN FROM *FTNX*.
*         *END-OF-STRING* IS A *-1*, WITH A PACKED BLANK COUNT. 
* 
*         THE CARD IMAGE IS ALSO PRINTED, UNLESS A *SHORT LIST* WAS 
*         SELECTED.  IF SO, THE TEXT OF THE STATEMENT (UP TO "MAX.CONT" 
*         CARDS) IS SAVED IN THE DEFERRED LINE IMAGE AREA.
* 
*         ENTRY  (A0) _ FWA STATEMENT TO BE STORED. 
* 
*         EXIT   (A0) PRESERVED.
*                (B4) _ FWA BURST STATEMENT.
*                *SB* = THE BURST CARD(S).
*                (LASTCOL) = INDEX OF LAST CHARACTER. 
* 
*         USES   ALL
* 
*         CALLS  ACD,ACL,BUL,CLO,CNT,PLO,PLR,RNC,RNS
  
  
**        PROCESS MULTIPLE STATEMENTS PER CARD
  
 AFS.MS   =X6    1
          SB4    X1          POINT TO THE NEXT STATEMENT
          SA6    MSF         SET MULTIPLE STATEMENT FLAG. 
  
  
**        ****   MAIN ENTRY POINT. **** 
  
 AFS      SUBR   0
          SA2    =5L
          SA1    MULS 
          BX6    X2 
          =A6    "SB.STN"    CLEAR STATEMENT LABEL
          NZ     X1,AFS.MS   IF MULTIPLE STATEMENT
          SA2    =XL.CARD    (X2) = NR OF WDS IN LINE IMAGE AT (CP.CARD)
          SA3    =XHDELAY 
          SX7    "SB.FWA"-1 
          MX6    0
          BX2    -X2
          SA7    LASTCOL     PRESTORE IN CASE OF C/-LIST
          SA6    CCNT        CLEAR CONTINUATION COUNT 
          SA5    =XCP.CARD
          SB6    X2+1        (B6) = -NR OF USEABLE WORDS IN SOURCE LINE 
*                                     (I.E. DOES NOT INCLUDE EOL MARK)
          NZ     X3,AFS10    IF NOT IN *HEADER DELAY* MODE
          SHRINK T=DLBUF,X6 
  
  
**        READ STATEMENT FROM CARDS (NOT THE *SB*). 
  
 AFS10    RJ     RNS         READ NEXT STATEMENT
          ZR     X5,AFS.ME   IF END OF SECTION
  
*         PROCESS C/-LIST OPTIONS.
  
          RJ     PLO         PROCESS C/-LIST OPTIONS
          ZR     X5,AFS.ME   IF END OF SECTION ENCOUNTERED
          SA1    CO.MODE
          ZR     X1,AFS12    IF BATCH FORMAT
  
*         ASSEMBLE SOURCE INPUT IN SEQ FORMAT.
  
          SA1    SEQNO       (X1) = SEQUENCE NR OF INITIAL LINE OF STMT 
*                                     (0R FORMAT) 
          BX2    -X0*X5 
          LX6    X1 
          SX7    X2-1R+ 
          SB4    LG.STN 
          SA6    "SB.LN"
          NZ     X7,AFS11    IF NOT + (CONTINUATION)
          LX3    CHAR 
          PL     X3,AFS10A   IF WORD NOT EXHAUSTED
          SA5    A5+B1
          SB6    B6+B1
          PL     B6,AFS20    IF NULL STMT -- (CP.CARD) EMPTY NOW
  
 AFS10A   LX5    CHAR 
          WARN   E.MC1       INITIAL LINE IS CONTINUATION 
 AFS11    RJ     ACD         ASSEMBLE CODED DIGITS (STMT LABEL) 
          SB2    B2-B1       (B2) = NR OF BLANKS PRECEDING 1ST NON-BLANK
*                                    CHAR OF STMT. 1 HAS BEEN SUBTRACTED
*                                    FROM (B2) BECAUSE 1ST BLANK OF STMT
*                                    SPECIFIES THAT THIS IS AN INITIAL
*                                    LINE IN SEQ MODE, AND IS NOT 
*                                    CONSIDERED PART OF THE STMT. 
          LX6    X6,B5       LEFT JUSTIFY 
          SA6    "SB.STN"    STORE STATEMENT LABEL
          SA6    "SB.FWA"-1  INITIALIZE STORE ADDRESS 
          ZR     X6,AFS20    IF STATEMENT LABEL NOT PRESENT 
          SB2    -1777B      INDICATE NO LEADING BLANKS 
          EQ     AFS20
  
**        ASSEMBLE SOURCE INPUT IN BATCH FORMAT.
  
 AFS12    MX3    L.STN
          BX6    X3*X5       ISOLATE STATEMENT NR FIELD 
          LX5    6*CHAR 
          BX2    -X0*X5 
          SA3    AFSC 
          LX5    -6*CHAR     RESTORE (X5) 
          SB7    X2          (B7) = (COLUMN 6)
          AX1    X3,B7
          LX1    -1 
          MI     X1,AFS15    IF ZERO OR BLANK 
          WARN   E.MC1       INITIAL LINE IS CONTINUATION 
  
**        SAVE POSSIBLE STATEMENT LABEL FOR PROCESSING
*                (X6) = COLS 1-5 OF CARD (5L FORMAT). 
  
 AFS15    SA6    "SB.STN"    STORE STATEMENT LABEL FIELD
          MX0    -CHAR
          SB2    -1777B      INDICATE NO LEADING BLANKS 
          =A6    "SB.FWA"-1  INITIALIZE STORE ADDRESS 
  
  
 AFS20    RJ     BUL         BURST THE LINE AT (CP.CARD) ET SEQ 
          RJ     PLR         PROCESS LISTING REQUEST
  
  
  
**        CHECK FOR CONTINUATION CARDS. 
  
          RJ     RNC         READ NEXT CARD 
  
**        CHECK FOR AN *ANSI* END LINE.  IF FOUND, DO NOT LOOK
*         FOR CONTINUATION LINES. 
  
          SA5    CCNT 
          NZ     X5,AFS67    IF NOT FIRST LINE, NOT A SPECIAL END LINE
          SA4    LASTCOL
          SX5    "SB.FWA"+3 
          IX5    X4-X5
          NZ     X5,AFS67    IF NOT 3 CHARACTERS LING 
          SA3    X4-1        *D*
          UX3    X3 
          BX5    X3 
          =A3    A3-1        *N*
          UX3    X3 
          LX3    CHAR 
          BX5    X3+X5
          =A3    A3-1        *E*
          UX3    X3 
          LX3    2*CHAR 
          BX5    X3+X5
          SX5    X5-3REND 
          ZR     X5,AFS78    IF AN ANSI END LINE OCCURRED 
 AFS67    SA5    B4 
          SB6    -B7         (B6) = -NR OF USEABLE WORDS IN SOURCE LINE 
          NZ     X1,AFS78    IF END-OF-SECTION
          RJ     RNS         READ NEXT STATEMENT
          ZR     X5,AFS78    IF END OF SECTION
  
*         CHECK FOR C/-LIST OPTION. 
  
          RJ     CLO         CHECK FOR C/-LIST OPTION 
          ZR     X5,AFS78    IF END-OF-SECTION OR C/-LIST OCCURRED
  
*         CHECK FOR CONTINUATION LINE.
  
          RJ     CNT         CHECK FOR CONTINUATION LINE
          ZR     X1,AFS20    IF THIS LINE IS A CONTINUATION LINE
  
  
**        END OF STATEMENT. 
  
 AFS78    SA4    LASTCOL
          SX3    A0 
          IX7    X4-X3       (LASTCOL) = ORDINAL OF LAST WORD OCCUPIED
                             BY THIS STATEMENT IN *SB*
          SA7    A4 
          SB4    "SB.FWA" 
          SA2    CCNT 
          SB3    X2-ANS.CONT
          LE     B3,AFSX     IF NOT TOO MANY CONTINUATION CARDS 
          EQ     E.MCA       ** TOO MANY CONT CARDS (ANSI) ** 
  
  
**        HERE WHEN END-OF-SECTION ENCOUNTERED INSTEAD OF AN INITIAL
*                LINE.  FAKE UP AN *END* STATEMENT. 
  
 AFS.ME   SX5    EOS
          SA5    X5+LGR 
          BX7    X5 
          MX6    0
          SA6    SB.STNL     CLEAR STMT LABEL FOR FAKE END
          SB4    "SB.FWA" 
          SA6    LASTCOL
          SA6    B4          INDICATE EMPTY AFTER KEYWORD 
          SX6    A6 
          SA6    "SB.BOS" 
          EQ     AFS.EOS     EXIT.. 
  
 AFSC     BSS    0           MASK TO CHECK FOR ZERO OR BLANK
          ECHO   2,CC=(1R ,1R0) 
          POS    CC+1 
          VFD    1/1
          POS    0
 ACD      SPACE  4
**        ACD - ASSEMBLE CODED DIGITS.
* 
*         ENTRY  (A5) _ ADDRESS OF STATEMENT. 
*                (X0) = MX0  -CHAR
*                (X3) = CHARACTER POSITION. 
*                (X5) = STATEMENT WORD. 
*                (B3) = COLUMN NUMBER.
*                (B4) = NUMBER OF DIGITS TO ASSEMBLE. 
*                (B6) = NO. OF WORDS REMAINING. 
* 
*         EXIT   (A5) _ ADDRESS OF STATEMENT. 
*                (X3) = CHARACTER POSITION. 
*                (X5) = SHIFTED TO CHARACTER WHICH TERMINATED ASSEMBLY. 
*                (X6) = DIGITS IN 0R FORMAT.
*                (B2) = NR OF LEADING BLANKS (BIASED BY -1777B) 
*                         (E.G. FOR 1 LEADING BLANK, (B2) = -1776B) 
*                (B5) = LEFT JUSTIFY COUNT. 
*                (B6) = NUMBER OF WORDS REMAINING.
*                (B7) = CHARACTER WHICH TERMINATED ASSEMBLY.
* 
*         USES   A - 2, 4, 5. 
*                X - 1, 2, 3, 4, 5, 6, 7. 
*                B - 2, 3, 4, 5, 6, 7.
* 
*         CALLS  NONE.
  
  
 ACD      SUBR               ENTRY/EXIT...
          SA1    =1H
          SB5    10*CHAR     LEFT JUSTIFY SHIFT COUNT 
          BX6    X6-X6       CLEAR ASSEMBLY 
          SB2    0-1777B     INDICATE NO LEADING BLANKS 
          SA4    ="NUM09" 
  
**        SKIP OVER LEADING BLANKS. 
  
 ACD1     IX2    X5-X1
          NZ     X2,ACD3     IF NOT ALL-BLANK WORD
 ACD2     SB7    10 
          SB6    B6+B1       DECREMENT WORD COUNT 
          SA5    A5+B1       NEXT WORD
          SB2    B2+B7       INCREMENT BLANK COUNT
          SB3    B3-B7       DECREMENT COLUMN COUNT 
          PL     B6,ACDX     IF LAST WORD, EXIT 
          LX5    CHAR 
          EQ     ACD1 
  
 ACD3     BX2    -X0*X5      EXTRACT CHAR 
          SB7    X2-1R
          NZ     B7,ACD4     IF NOT BLANK 
          LX3    CHAR 
          SB2    B2+B1       INCREMENT BLANK COUNT
          LX5    CHAR 
          SB3    B3-B1
          PL     X3,ACD3     IF WORD NOT EXHAUSTED
          EQ     ACD2 
  
**        ASSEMBLE DIGITS.
  
 ACD4     SB7    X2 
          LX1    X4,B7
          PL     X1,ACDX     IF NOT DIGIT 
          ZR     B4,ACDX     IF NO MORE DIGITS TO ASSEMBLE
          SB4    B4-B1       DECREMENT NO. OF DIGITS
          LX6    CHAR 
          SB5    B5-CHAR
          LX3    CHAR 
          BX6    X6+X2       ADD IN NEW DIGIT 
          SB3    B3-B1
          PL     X3,ACD5     IF WORD NOT EXHAUSTED
          SB6    B6+B1       DECREMENT WORD COUNT 
          SA5    A5+B1       NEXT WORD
          PL     B6,ACDX     IF LAST WORD 
 ACD5     LX5    CHAR 
          BX2    -X0*X5      EXTRACT CHARACTER
          EQ     ACD4 
 ALN      SPACE  4
**        ALN - ASSEMBLE LINE NUMBER. 
* 
*         ENTRY  (A5) _ FWA OF STATEMENT. 
*                (X5) = FIRST WORD OF STATEMENT.
*                (B6) = -NR OF USEABLE WORDS IN SOURCE LINE IMAGE 
*                         (I.E. DOES NOT INCLUDE FULL WORD EOL MARK)
* 
*         EXIT   (X0) = MX0  -CHAR
*                (X1) > 0 (BLANK OR PLUS (+) TERMINATED ASSEMBLY. 
*                (X3) = CHARACTER POSITION. 
*                (X5) = SHIFTED TO CHARACTER WHICH TERMINATED ASSEMBLY. 
*                (X6) = LINE NUMBER IN 0R FORMAT. 
*                (B2) = NR OF LEADING BLANKS (BIASED BY -1777B) 
*                         (E.G. FOR 1 LEADING BLANK, (B2) = -1776B) 
*                (B3) = NO. OF COLUMNS REMAINING. 
*                (B6) = -NR OF USABLE WORDS REMAINING IN SOURCE LINE, 
*                         ADJUSTED FOR ASSEMBLED LINE NR (IF NECESSARY) 
*                (B7) = CHARACTER WHICH TERMINATED ASSEMBLY.
* 
*         USES   A - 4. 
*                X - 0, 1, 3, 4, 5, 6.
*                B - 2, 3, 4, 6.
* 
*         CALLS  ACD. 
  
 LG.LN    EQU    5           NUMBER OF DIGITS TO ASSEMBLE FOR *LN*
  
  
 ALN      SUBR               ENTRY/EXIT...
          MX0    -CHAR
          SB3    80-2        (B3) = NR OF COLS TO PROCESS 
*                                     (ADJUSTED FOR *BUL*)
          LX5    CHAR 
          MX3    1
          SB4    -8 
          GE     B6,B4,ALN1  LIMIT BURST TO 8 WORDS 
          SB6    B4 
 ALN1     SB4    LG.LN
          RJ     ACD         ASSEMBLE LINE NUMBER 
          SA4    ALNA 
          AX1    X4,B7
          LX1    -1 
          LX7    X6,B5
          SA6    SEQNO       SAVE (X6) = SEQUENCE NR (0R FORMAT)
          SA7    A6+B1       SAVE (X7) = SEQUENCE NR (0L FORMAT)
          EQ     ALNX        RETURN 
  
 ALNA     BSS    0           MASK TO CHECK FOR BLANK OR PLUS (+)
          ECHO   2,CC=(1R ,1R+) 
          POS    CC+1 
          VFD    1/1
          POS    0
  
  
 SEQNO    BSSZ   2           CONTAINS THE SEQUENCE NR OF THE CURRENT
*                              LINE AT (CP.CARD) ET SEQ.
*                              (SEQNO) = 0R FORMAT, (SEQNO+1) = 0L FMT
*                              IF THIS LINE IS AN INITIAL LINE OF STMT, 
*                              THEN (SEQNO) WILL BE XFERRED TO ("SB.LN")
*                              AND (SEQNO+1) WILL BE USED TO SET UP 
*                              (REFLIN) 
 ASK      SPACE  4,30 
**        ASK -  ADJUST STATEMENT KEYWORD.
* 
*         REMOVES A KEYWORD FROM THE (NORMALIZED) STRING BUFFER,
*                AND ADJUSTS THE REMAINING CHARACTERS.
*         ENTRY  (X5) = (JUMPTO. TABLE ENTRY) 
*                (B4) _ KEYWORD IN *SB*.
*         EXIT   (B4) _ *SB* ENTRY PAST KEYWORD 
*                (B3) = JUMP ADDRESS FOR THE STATEMENT PROCESSOR
*                (X3) = 0 IFF KEYWORD WAS CORRECTLY SPELLED.
* 
*         USES   X - ALL
*                A - 2,4,6
*                B - ALL BUT B5 
* 
*         CALLS  NONE 
  
  
*         HERE WE THROW AWAY INTEGERAL WORDS (MULTIPLES OF 7 CHARS).
  
 ASK8     SB2    B7-B1       BIT COUNT = BITCOUNT MINUS 7CHARS
          SB4    B4+B1
          BX6    X7*X2
          IX3    X3-X6       COMPARE KEYWORD (1ST 7 CHAR) 
          NZ     B7,ASK2     IF MORE THAN 7 CHARACTERS IN KEY 
  
 ASK      SUBR   0
          MX0    4*CHAR 
          SB3    X5 
          SA4    B3-B1       HIJKLMNEFG  WHERE A-N ARE CHARS IN KEYWORD 
          BX3    X0*X5       ABCD------ 
          LX5    -P.SLEN
          SX1    X4          -------EFG 
          MX2    -L.SLEN
          IX6    X4-X1       HIJKLMN--- 
          BX7    -X2*X5      ISOLATE BIT COUNT
          SB2    X7-4*CHAR
          MI     B2,ASK1     IF 4 CHARACTER KEYWORD (OR LESS) 
          MX0    7*CHAR 
          SA2    B4 
          BX2    X0*X2
          BX2    X2-X3
          ZR     X2,E.FM     IF NOT ACTUALLY KEYWORD
 ASK1     SB2    X7 
          LX1    3*CHAR      ----EFG--- 
          BX4    X1+X3       ABCDEFG--- 
          SA6    FILL.2      SAVE KEYWORD FOR POSSIBLE ERROR MSG
          IX3    X4+X6
          MX7    7*CHAR 
          BX6    X4 
          SA6    A6-B1
  
 ASK2     SA2    B4 
          SB7    B2-7*CHAR+1
          SX1    X2-O.SEP 
          ZR     X2,ASKX     IF *EOS* 
          PL     X1,ASKX     IF SEPARATOR 
          PL     B7,ASK8     IF SEVEN OR MORE CHARS 
          MX4    1
          SB6    B4 
          AX0    X4,B2       MASK FOR UPPER PART
          BX1    X0*X2
          IX3    X3-X1       COMPARE KEYWORD
          SB7    B2+18+1
          SB2    B2+B1
          BX7    X7-X0       MASK FOR MIDDLE PART 
          BX1    X7*X2
          LX6    X1,B2
          BX1    X6 
          LX6    6
          =X4    O.VAR
          SX6    X6-1R0 
          MI     X6,ASK4     IF LETTER
          =X4    O.CONS 
  
*         NOW AN OFFSET CHARACTER MOVE UNTIL WE RUN INTO A SEPARATOR. 
  
 ASK4     SA2    B6+B1
          SX6    X2-O.SEP 
          ZR     X2,ASK6     IF *EOS* 
          PL     X6,ASK6     IF SEPARATOR ENCOUNTERED 
          SX6    X2-O.HOLL
          ZR     X6,ASK6     IF HOLLERITH ENCOUNTERED 
          BX6    X0*X2
          LX6    B7          MOVE NEXT UPPER TO RESULT MIDDLE 
          IX6    X6+X1
          SB6    B6+B1
          BX6    X6+X4       RESTORE O.VAR (OR O.CONS)
          SA6    B6-B1
          BX6    X7*X2
          LX1    X6,B2       MOVE CURRENT MIDDLE TO RESULT UPPER
          EQ     ASK4 
  
*         HAVE FOUND A STOPPER, IS A MOVE NEEDED QQQ. 
  
 ASK6     BX6    X4+X1
          SA6    B6          STORE ANY REMAINING PARTIAL WORD 
          NZ     X1,ASKX     IF THERE WAS ANYTHING IN THE PARTIAL WORD
  
          SB4    B4+B1       *SB* MUST BE ADJUSTED. 
 ASK7     SA2    B6-B1
          SB6    B6-B1       COUNT DOWN THE AUXILLARY COUNTER 
          BX6    X2 
          SA6    A2+B1
          GE     B6,B4,ASK7        IF NOT YET TO FRONT OF STRING
          EQ     ASKX              EXIT.. 
 ASL      SPACE  4,15 
**        ASL -  ADJUST STATEMENT LABEL.
* 
*         SPECIAL KLUDGE FOR *DO* AND *ASSIGN* STATEMENTS.  DETERMINES
*         LENGTH OF STATEMENT LABEL IN *SB*, AND CALLS *ASK* TO REMOVE
*         IT FROM THE STRING.  THUS, THESE POOR STATEMENTS CAN GET AT 
*         THE NEXT ELEMENT OF THE STATEMENT IN THE USUAL FASHION. 
* 
*         ENTRY  (B4) _ LABEL IN *SB*.
* 
*         EXIT   (B4) MAY BE ADJUSTED.  LOGICALLY, IT POINTS TO THE NEXT
*                     *SB* ELEMENT AFTER THE LABEL. 
*                (X1) = 0L_LABEL + O.CON. 
*                *SB* ADJUSTED, AS DEFINED BY *ASK*.
* 
*         USES   ALL BUT A0.
*                (SCR). 
*         CALLS  ASK. 
  
  
 ASL      SUBR               ENTRY/EXIT...
          SB5    -O.CONS
          SA2    =05050505050505BS18
          SA3    =40404040404040BS18
          SB6    B0          INITIALIZE *SB* POINTER
          SA1    B4          (X1) = START OF LABEL
 ASL1     IX4    X1+X2       SET SIGN BITS OF DIGITS
          BX7    -X3+X4      ISOLATE NON-DIGITS 
          NZ     X7,ASL2     IF NOT 7-DIGITS
          =B6    B6+B1       UPDATE *SB* POINTER
          SA1    B4+B6       PICK UP NEXT *SB* ENTRY
          SX5    X1+B5
          ZR     X5,ASL1     IF STILL A CONSTANT
          =B2    -1 
          EQ     ASL3 
  
 ASL2     LX7    -12
          NX2,B2 X7          LOCATE FIRST NON-DIGIT 
          =B2    B2-1 
          MX0    1
          AX4    X0,B2       MASK LENGTH = DIGIT LENGTH 
          ZR     B6,ASL4     IF LABEL ONLY 1 WORD LONG
 ASL3     MX4    7*CHAR 
          SA1    B4          RESET (X1) = START OF LABEL
          SB4    B4+B6       SET B4 TO LAST WORD OF LABEL 
 ASL4     BX6    X4*X1
          MI     B2,ASL5     IF LABEL MULTIPLE OF 7 CHARACTERS
          SX3    B2 
          MX4    -L.SLEN
          SX5    1+=0 
          BX3    -X4*X3 
          LX3    P.SLEN 
          SA6    SCR
          IX5    X5+X3       MANUFACTURE DUMMY *SATTR* WORD FOR *ASK* 
          RJ     ASK         ADJUST OFF THE LABEL 
          SA1    SCR
          EQ     EXIT.
  
 ASL5     SA1    B4 
          SX5    X1+B5
          NZ     X5,ASL6     IF NOT CONSTANT
          SX4    O.VAR-O.CONS 
          IX7    X1+X4
          SA7    B4 
 ASL6     BX1    X6 
          EQ     EXIT.
 BLL      SPACE  4
**        BLL - BREAK LONG LINE 
* 
*         WHEN PRINT LINE IS .GT. PAGE WIDTH, BLL PRINTS FIRST PART OF
*         LINE AND LEFT JUSTIFIES REMAINDER.
* 
*         ENTRY  (A2) = ADDRESS OF LAST WORD OF 1ST PART
*                (X2) = LAST WORD OF 1ST PART 
*                (B2) = FWA OF LINE - 1 
*                (B5) = NUMBER OF BITS TO PRINT OF LAST WORD OF 1ST PART
*                (B6) = LWA OF LINE - 1 
*         EXIT   (X1) = FWA OF 2ND PART 
*                (X2) = LENGTH OF 2ND PART
*                (X6) = 0  IF NO LINE PRINTED 
*                1ST PART PRINTED 
*         USES   A - 1-4, 6, 7
*                X - 1-4, 6, 7
*                B - 2, 3, 5, 6, 7
*         PRESERVES  A0, X0, A5, X5, B4 
*         CALLS  LSS, PLINE 
  
 BLL4     BX4    X1*X3
          BX6    X4+X2
          IX6    X3-X6
          NZ     X6,BLL2     IF NOT ALL BLANKS
          SX1    B2+B1       FWA OF LINE
          SB6    B6+B1       LWA OF LINE
          SX2    B6-B2       LENGTH OF LINE 
  
 BLL      SUBR               ENTRY/EXIT 
          MX1    0
          ZR     B5,BLL1     IF BREAK ON WORD BOUNDARY
          MX1    1
          SB7    B5-B1
          AX1    B7 
 BLL1     BX7    X1*X2       LEFT SIDE
          SB3    A2-B6
          BX2    -X1*X2      RIGHT SIDE 
          SA3    =10H 
          ZR     B3,BLL4     IF 2ND PART ONLY ONE PARTIAL WORD
 BLL2     RJ     LSS         LEFT SHIFT STRING
          SA6    BLL10       SAVE 1ST WORD OF 2ND LINE
          SA7    A2          SET LEFT SIDE INTO BUFFER
          SA3    A2+B1
          BX7    X3 
          SA7    A6+B1       SAVE 2ND WORD  OF 2ND LINE 
          SB6    B6+B1
          SB3    A2-B1
          SX6    B3 
          SA6    A7+B1       SAVE 2ND LINE FWA
          SB3    B3-B1
          SX7    B6-B3
          SA7    A6+B1       SAVE 2ND LINE LENGTH 
          MX6    0
          SA6    B6          EOL TERMINATOR FOR 2ND LINE
          SX2    A2-B2
          ZR     B5,BLL3     IF ALREADY HAVE 1ST LINE EOL 
          SX2    X2+B1
          SA6    A3          EOL TERMINATOR FOR 1ST LINE
 BLL3     PLINE  B2+B1,X2 
          SA2    BLL10+3     LENGTH 
          SA1    A2-B1       FWA
          SA3    A1-B1       2ND WORD 
          SA4    =10H   >>>>
          BX6    X4 
          SA6    X1          SET CONTINUE INDICATOR 
          SA4    A3-B1       1ST WORD 
          BX6    X4 
          SA6    A6+B1       RESET 1ST WORD 
          BX7    X3 
          SA7    A6+B1       RESET 2ND WORD 
          EQ     EXIT.
  
 BLL10    BSSZ   4
 BUL      SPACE  4,8
**        BUL - BURST A LINE. 
* 
*                BURSTS A LINE IN EITHER NORMAL UNCOMPRESSED FORMAT OR
*         UPDATE COMPRESSED FORMAT AND IN EITHER NORMAL BATCH FORMAT OR 
*         IN TIME-SHARING SEQ FORMAT FROM (CP.CARD) ET SEQ, ONE 
*         CHARACTER PER WORD WITH BLANKS SQUEEZED OUT, TO THE STRING
*         BUFFER. 
* 
* 
*         ENTRY  (AMODE)   = +0 IF NORMAL UNCOMPRESSED FORMAT 
*                          =  1 IF MODIFY COMPRESSED FORMAT (ERROR) 
*                          =  2 IF UPDATE COMPRESSED FORMAT(UNSUPPORTED)
*                (CP.CARD) =  PACKED SOURCE LINE (I.E. 10 CHARS/WORD) 
*                (B2)      =  NR OF LEADING BLANKS (BIASED BY -1777B) 
*                               (E.G. FOR 1 LEADING BLANK, (B2)=-1776B) 
*                (B6)      =  -NR OF USEABLE WORDS IN SOURCE LINE IMAGE 
*                               AT (CP.CARD) ET SEQ 
*                               (I.E. DOES NOT INCLUDE FULL WORD EOL MK)
*                (A6)+1    =  FWA TO STORE IN STRING BUFFER 
* 
*                IN BATCH --
*                (A5,X5)   =  ADDR + CONTENTS 1ST WORD OF LINE IMAGE TO 
*                               BE BURST FROM (CP.CARD).
* 
*                IN SEQ --
*                (X3)      =  CHARACTER POSITION IN WORD. CHARACTER 
*                               POSITIONS IN (X3) ARE NUMBERED -- 
*                               (01 10 09 08 07 06 05 04 03 02).
*                               E.G. WHEN THE 4TH CHARACTER IS IN BITS
*                               (05-00) OF (X5), THEN THE SIGN BIT WILL 
*                               BE ON IN THE 4TH CHAR POSITION IN (X3). 
*                               (X5) = (05 06 07 08 09 10 01 02 03 04)
*                               (X3) = (00 00 00 00 00 00 00 40 00 00B) 
*                (A5,X5)   =  ADDR + CONTENTS OF NTH WORD OF LINE IMAGE 
*                               IN (CP.CARD), 1ST COL TO BE BURST 
*                               IN BITS (05-00) 
*                (B2)      =  NR OF LEADING BLANKS (BIASED BY -1777B) 
*                               (E.G. FOR 1 LEADING BLANK, (B2)=-1776B) 
*                (B3)      =  NR OF COLUMNS REMAINING IN LINE IMAGE 
* 
*         EXIT   LINE COLUMNS 7-72 (BATCH FMT) BURST TO STRING BUFFER.
*                  BLANKS SQUEEZED OUT. LEADING BLANK COUNT (LBC) IS
*                  PACKED WITH NON-BLANK CHARACTER AS FOLLOWS --
*                            12/LBC-1777B+2000B,42/0,6/CHARACTER
*                  STRING BUFFER TERMINATOR FORMAT -- 
*                            12/-(LBC-1777B+2000B),48/-1
*                (LASTCOL) =  LWA OF STATEMENT IN STRING BUFFER 
* 
*         USES   ALL BUT A0 
* 
*         CALLS  ALLOC
  
  
 BUL      SUBR               ** ENTRY/EXIT ** 
  
*         ALLOCATE SPACE IN STRING BUFFER FOR NEW LINE, IF NECESSARY. 
  
          SA1    =XT=SB 
          SA2    =XT.SB 
          SB5    X2 
          SX7    A6-B5
          IX2    X1-X7
          SX6    X2-67
          PL     X6,BUL1     IF ENOUGH ROOM FOR 1 FULL CARD 
          SB5    A6          SAVE  A6 
          BX4    X3          SAVE  X3 
          ALLOC  =XT.SB,75
          SA1    B5 
          BX6    X1 
          SA6    B5          RESTORE A6 
          BX3    X4          RESTORE X3 
  
*         INITIALIZE FOR BURST. 
  
 BUL1     SA2    =XCO.MODE
          NZ     X2,BUL3     IF SEQ FORMAT
          MX3    1
          SB4    -7 
          LX3    -4*CHAR
          LX5    6*CHAR      (X5) = COL (07 08 09 10 01 02 03 04 05 06) 
          GE     B6,B4,BUL2  IF NR OF WDS TO BURST .LE. 7 
          SB6    B4          LIMIT BURST TO 7 WORDS 
 BUL2     SB3    72-6-2      NR OF COLS TO BURST - 2
          LX5    CHAR 
  
 BUL3     SA2    AMODE
          PL     B6,BUL15    IF NULL LINE, NOTHING TO BURST...
          SB5    -1R
          SA1    =1H
          MX0    -CHAR
          ZR     X2,BUL10    IF UNCOMPRESSED INPUT
          LX2    -1 
          PL     X2,BUL5     IF *UPDATE* FORMAT 
  
  
**        UNPACK *MODIFY* FORMAT COMPRESSED CARD. 
  
  
          TRUBL 
          EQ     BUL15       CONTINUE.. 
  
 MDFY     SKIP
**        UNPACK MODIFY COMPRESSED CARD.
  
          MX3    59 
          SB4    -B1
          SB5    1R 
          EQ     RNS4C
 RNS4A    LX5    CHAR        EXTRACT NEXT CHARACTER 
          BX3    -X0*X5 
          ZR     X3,RNS6     IF 0000 (END OF LINE)
 RNS4B    SX3    X3+B4
          SA6    A6+B1       STORE CHARACTER
          PL     X3,RNS4B    IF FILLING BLANKS, LOOP
          NZ     B7,RNS4C    IF SOURCE WORD NOT EXHAUSTED 
          SA5    A5+B1
          SB7    B3 
 RNS4C    LX5    CHAR 
          SB6    X6 
          BX6    -X0*X5      EXTRACT NEXT CHARACTER 
          LX4    X1,B6
          SB7    B7-B1
          BX7    X7+X4
          NZ     X6,RNS4B    IF NOT 00
          SB7    B7-B1
          SX6    B5 
          PL     B7,RNS4A    IF SOURCE WORD NOT EXHAUSTED 
          SA5    A5+B1
          SB7    B3-B1
          EQ     RNS4A
 MDFY     ENDIF 
  
**        UNPACK *UPDATE* FORMAT COMPRESSED CARD. 
  
 BUL5     BSS    0           ENTRY..
 #UPD     SKIP
  
          SB5    1R          LOOP CONSTANT
          SB7    4-1
          SB3    10          LOOP CONSTANT
          =B6    1           ANY OLD NON-ZERO 
          EQ     BUL7 
  
 BUL6     PX6    B2          PACK BLANK COUNT 
          =B2    1
          =A6    A6+1 
 BUL7     LX5    CHAR 
          =B7    B7-1 
          BX6    -X0*X5      EXTRACT NEXT CHARACTER 
          NZ     B7,BUL8     IF SOURCE WORD NOT EXHAUSTED 
          =A5    A5+1 
          SB7    B3 
 BUL8     ZR     B6,BUL9     IF LAST WAS 00, THEN 00XX CODE 
          SB6    X6 
          ZR     B6,BUL7     IF 00 CHARACTER, GO GET XX 
          NE     B6,B5,BUL6     NOT 55 GO STORE IT
          =B2    B2+1 
          EQ     BUL7 
  
 BUL9     SB6    X6 
          SB2    B2+B6
          GT1    B6,BUL7     IF 0002-0077 CODE, BLANKS COUNTED
          SB2    B2-B6
          BX6    0
          EQ1    B6,BUL6     IF 0001 CODE, GO STORE 00 CHARACTER
*                          ELSE 0000 CODE, END-OF-LINE
          SB3    -3 
          EQ     BUL15       CONTINUE.. 
 #UPD     ENDIF 
          TRUBL 
  
  
**        BURST CARD IMAGE INTO STRING BUFFER, PACKING BLANK COUNT. 
*                (LOOP STOLEN BODILY FROM *SCANNER* IN FTNX VER 4.0)
  
 BUL10    SB2    B2+B1       INCREMENT BLANK COUNT
          BX6    -X0*X5      EXTRACT NEXT CHAR
          SB4    X6+B5
          LX3    CHAR 
          SB3    B3-B1       DECREMENT COLUMN COUNTER 
          LX5    CHAR 
          ZR     B4,BUL11    IF BLANK 
          PX6    X6,B2       PACK CHARACTER AND BLANK COUNT 
          SB2    -1777B      BLANK COUNT BIAS 
          =A6    A6+1 
  
 BUL11    PL     X3,BUL10    IF WORD NOT EXHAUSTED
          SB4    10 
  
**        FETCH NEXT WORD AND CHECK FOR END OF THE IMAGE. 
  
 BUL12    SB6    B6+B1       DECREMENT WORD COUNT 
          SA5    A5+B1
          PL     B6,BUL14    IF LAST WORD OF IMAGE
  
**        CHECK FOR A WORD FULL OF BLANKS, AND IF SO, AVOID LOOPING 
*                THRU IT. 
  
 BUL13    IX2    X1-X5
          LX5    CHAR 
          NZ     X2,BUL10    IF NOT ALL-BLANK WORD
          SB2    B2+B4
          SB3    B3-B4
          EQ     BUL12       CONTINUE..  WITH NEXT WORD 
  
  
*         HERE BECAUSE (B6) SAY THAT THERE ARE NO MORE SOURCE IMAGE 
*           WORDS TO BURST.  CONDITIONS ARE AS FOLLOWS -- 
* 
*           IN BATCH -- 
*             1. IF (X5) ARE .ZR. (I.E. (X5) IS FULL WORD EOL MARK),
*                  THEN BURSTING IS DONE. 
*             2. IF (X5) ARE .NZ. (I.E. (X5) CONTAIN COLS 71-80), 
*                  THEN NEED TO GO BACK AND BURST COLS 71-72. 
* 
*           IN SEQ -- 
*             BECAUSE SEQ MODE INPUT CAN CONTAIN 80 COLUMNS OF SOURCE 
*               IMAGE AND BECAUSE 80 COLUMNS IS EXACTLY 8 WORDS,
*               BURSTING IS DONE. 
  
 BUL14    SA2    =XCO.MODE
          GT     B6,B0,BUL15 IF JUST FINISHED BURSTING COLS 71-72 
          MI     X2,BUL15    IF SEQ MODE
          ZR     X5,BUL15    IF NOTHING MORE TO BURST 
          MX3    1
          MX2    2*CHAR 
          LX5    CHAR 
          BX3    -X2+X3      FORCE STOP AT COL 73 
          EQ     BUL10       CONTINUE..  (TO COUNT DOWN THE LAST TWO) 
  
*         ALL BURSTERS REJOIN HERE. 
  
 BUL15    SB3    B3+3 
          MX0    -CHAR
          MX7    -1 
          SB2    B2+B3
          PX6    X7,B2       (X6) = 12/-(LBC-1777B+2000B),48/-1 
          SX7    A6+B1
          SA6    A6+B1       MARK END-OF-STMT 
          SA7    LASTCOL
          EQ     EXIT.
 CLO      SPACE  4,15 
 #NL      IFNE   #NL,0
**        CLO - CHECK FOR C/-LIST OPTION. 
* 
*                IF THIS LINE HAD A *C/    * IN COLUMNS 1-6, THEN --
*         1) AT THIS POINT IN TIME THE STRING BUFFER ALREADY CONTAINS A 
*         STATEMENT (FROM FWA OF STRING BUFFER THRU (LASTCOL)). THE 
*         *C/    * LINE AT (CP.CARD) ET SEQ WILL BE BURST STARTING AT 
*         (LASTCOL)+1.  E.G.       A=B
*                            C/    LIST,ALL 
*                       WILL BECOME --
*         WORD    1   2   3   4   5   6   7   8   9  10  11  12  13 
*                 A   =   B  EOS  L   I   S   T   ,   A   L   L  EOS
*                             .                                   . 
*                           (CLOA)                            (LASTCOL) 
*                       IN THE STRING BUFFER. 
*         2) PACK UP TO 10 CHARACTERS FROM THE STRING BUFFER AND
*         CHECK FOR THE OCCURRENCE OF --
*         1) LIST,ALL 
*         2) LIST,NONE
*         FOLLOWED BY AN END-OF-LINE MARK.
* 
* 
*         ENTRY  (CSSTMT)   = .NZ. IF C/ LINE OCCURRED, ELSE .ZR. 
*                (B6)      =  -NR OF USEABLE WORDS IN SOURCE LINE IMAGE 
*                               AT (CP.CARD) ET SEQ 
*                               (I.E. DOES NOT INCLUDE FULL WORD EOL MK)
* 
*                IN BATCH --
*                (A5,X5)   =  ADDR + CONTENTS 1ST WORD OF LINE IMAGE TO 
*                               BE BURST FROM (CP.CARD).
* 
*                IN SEQ --
*                (X3)      =  CHARACTER POSITION IN WORD. CHARACTER 
*                               POSITIONS IN (X3) ARE NUMBERED -- 
*                               (01 10 09 08 07 06 05 04 03 02).
*                               E.G. WHEN THE 4TH CHARACTER IS IN BITS
*                               (05-00) OF (X5), THEN THE SIGN BIT WILL 
*                               BE ON IN THE 4TH CHAR POSITION IN (X3). 
*                               (X5) = (05 06 07 08 09 10 01 02 03 04)
*                               (X3) = (00 00 00 00 00 00 00 40 00 00B) 
*                (A5,X5)   =  IF A *C/    * LINE DID NOT OCCUR, THE NTH 
*                               WORD IN (CP.CARD) WITH THE NON-DIGIT
*                               THAT TERMINATED ASSEMBLY OF LINE NR IN
*                               BITS (05-00); ELSE 1ST CHARACTER AFTER
*                               *C/    * IN BITS (05-00)
*                (B2)      =  NR OF LEADING BLANKS (BIASED BY -1777B) 
*                               (E.G. FOR 1 LEADING BLANK, (B2)=-1776B) 
*                (B3)      =  NR OF COLUMNS REMAINING IN LINE IMAGE 
* 
*         EXIT   (CSLIST)  =  1S59 IF C/-LIST,ALL OCCURRED
*                          =   1   IF C/-LIST,NONE OCCURRED 
*                          =  +0   IF C/ LINE DID NOT OCCUR OR IF LEGAL 
*                                    C/-LIST DIRECTIVE DID NOT OCCUR
*                (CSSTMT)  =  0    NO *C/    * LINE PENDING 
*                (X0)      =  MX0 -CHAR 
*                (X3)      =  AS SET BY *RNS* IF C/-LINE WAS A COMMENT
*                (A5,X5)   =  SAME AS ON ENTRY IF NO C/-LINE OCCURRED 
*                          =  AS SET BY *RNS* IF C/-LINE WAS A COMMENT
*                (X5)      =  0 IF C/-LIST DIRECTIVE OCCURRED OR IF 
*                                 *RNS* ENCOUNTERED AN END-OF-SECTION 
*                (B2)      =  AS SET BY *RNS* IF C/-LINE WAS A COMMENT
*                (B3)      =  AS SET BY *RNS* IF C/-LINE WAS A COMMENT
*                (B6)      =  AS SET BY *RNS* IF C/-LINE WAS A COMMENT
*                (B7)      =  AS SET BY *RNS* IF C/-LINE WAS A COMMENT
* 
*         USES   ALL BUT A0 
* 
*         CALLS  BUL,RNS
  
  
 CLO      SUBR               ** ENTRY/EXIT ** 
 CLO1     SA1    CSSTMT 
          ZR     X1,EXIT.    IF NOT A C/ LINE 
  
*         INITIALIZE FOR BURSTING C/ LINE.
  
          SA1    LASTCOL
          SA2    X1 
          BX7    X1 
          LX6    X2 
          SA7    CLOA        SAVE (LASTCOL) 
          SA6    A2          PRESTORE (A6)
          SB2    -1777B 
          RJ     BUL         BURST THE C/ LINE
  
*         INITIALIZE TO PACK UP C/ LINE.
  
          SA1    CSLIST 
          SA2    CLOA 
          SA3    LASTCOL
          BX6    X2 
          SA2    X2+B1
          SA6    A3          RESTORE (LASTCOL)
          SB6    9
          BX6    X6-X6       (X6) = PACKING REGISTER
          SX7    1
          SA6    CSSTMT      SET TO *NO C/-LINE PENDING*
  
*         PACK UP TO 10 CHARACTERS FROM STRING BUFFER TO X6.
  
 CLO2     MI     X2,CLO3     IF EOL SENTINEL
          SX2    X2+
          LX6    6
          SB6    B6-1 
          BX6    X6+X2
          SA2    A2+1 
          PL     B6,CLO2     IF STILL ROOM IN PACKING REGISTER
  
*         CHECK FOR LEGAL LIST DIRECTIVE. 
  
 CLO3     SA3    =R.LIST,ALL. 
          SA4    =R.LIST,NONE.
          BX5    X6-X3
          ZR     X5,CLO4     IF *LIST,ALL*
          BX5    X6-X4
          ZR     X5,CLO5     IF *LIST,NONE* 
  
*         HERE IF COMMENT LINE. 
  
          SA1    AMODE
          SA2    =XL.CARD 
          SA5    CP.CARD     RESTORE (A5,X5)
          ZR     X1,CLO3A    IF NOT COMPRESSED INPUT
          SA5    CP.CARD+2
  
 CLO3A    BX2    -X2
          SB6    X2+B1       (B6) = -NR OF USEABLE WORDS IN SOURCE LINE 
          SA7    A6          SET TO *C/-LINE PENDING(TO BE LISTED ONLY)*
          RJ     RNS         PROCESS C/-COMMENT LINE
          EQ     CLO1        CHECK FOR C/-LIST DIRECTIVE
  
*         HERE IF *LIST,ALL* OCCURRED.
  
 CLO4     MX7    1
          SA7    A1          SET TO *LIST,ALL OCCURRED* 
          EQ     EXIT.
  
*         HERE IF *LIST,NONE* OCCURRED. 
  
 CLO5     SA7    A1          SET TO *LIST,NONE OCCURRED*
          EQ     EXIT.
  
  
 CLOA     BSS    1           SAVED (LASTCOL)
 #NL      ELSE
 CLO      SUBR
          EQ     EXIT.
 #NL      ENDIF 
 CNT      SPACE  4,8
**        CNT - CHECK FOR CONTINUATION. 
* 
* 
*         ENTRY  (CCNT)    =  NR OF CONTINUATION LINES
*                (CO.MODE) =  .ZR. IF NORMAL BATCH FORMAT INPUT 
*                          =  .NZ. IF SEQ FORMAT INPUT
*                (LASTCOL) =  LWA OF STATEMENT IN STRING BUFFER 
*                (B6)      =  -NR OF USEABLE WORDS IN SOURCE LINE IMAGE 
*                               AT (CP.CARD) ET SEQ 
*                               (I.E. DOES NOT INCLUDE FULL WORD EOL MK)
* 
*                IN BATCH --
*                (A5,X5)   =  ADDR + CONTENTS 1ST WORD OF LINE IMAGE TO 
*                               BE BURST FROM (CP.CARD).
* 
*                IN SEQ --
*                (X3)      =  CHARACTER POSITION IN WORD. CHARACTER 
*                               POSITIONS IN (X3) ARE NUMBERED -- 
*                               (01 10 09 08 07 06 05 04 03 02).
*                               E.G. WHEN THE 4TH CHARACTER IS IN BITS
*                               (05-00) OF (X5), THEN THE SIGN BIT WILL 
*                               BE ON IN THE 4TH CHAR POSITION IN (X3). 
*                               (X5) = (05 06 07 08 09 10 01 02 03 04)
*                               (X3) = (00 00 00 00 00 00 00 40 00 00B) 
*                (A5,X5)   =  ADDR + CONTENTS OF NTH WORD OF LINE IMAGE 
*                               IN (CP.CARD), COL TO CHECK FOR CONTINUA-
*                               TION IN BITS (05-00)
*                (B2)      =  NR OF LEADING BLANKS (BIASED BY -1777B) 
*                               (E.G. FOR 1 LEADING BLANK, (B2)=-1776B) 
*                (B3)      =  NR OF COLUMNS REMAINING IN LINE IMAGE 
*                (B7)      =  CHAR THAT TERMINATED ASSEMBLY OF LINE NR
* 
*         EXIT   (X1)      =  .ZR. IF THIS LINE IS A CONTINUATION LINE, 
*                                    ELSE .NZ.
*                (A5,X5)   =  AS ON ENTRY, POSSIBLY ADJUSTED IN SEQ 
*                (B6)      =  AS ON ENTRY, POSSIBLY ADJUSTED IN SEQ 
*                (A6)+1    =  FWA TO STORE IN STRING BUFFER 
* 
*                IN SEQ MODE, THE FOLLOWING REGISTERS ARE GLOBAL AND
*                  SIGNIFICANT ON EXIT -- 
*                (X3),(A5,X5),(B2),(B3) 
* 
*         USES   ALL BUT A0 
* 
*         CALLS  ALLOC
  
  
 CNT      SUBR               ** ENTRY/EXIT ** 
          SA2    CO.MODE
          SA4    LASTCOL
          MX0    -CHAR
          ZR     X2,CNT2     IF BATCH FORMAT
  
*         CHECK FOR CONTINUATION (SEQ FORMAT) 
  
          BX6    -X0*X5 
          SX1    X6-1R+ 
          NZ     X1,EXIT.    IF NOT PLUS(+) 
          LX3    CHAR 
          SB3    B3-B1
          BX6    X3 
          SX7    B3+3 
          SA6    CNTA        SAVE (X3)
          PL     X3,CNT3     IF WORD NOT EXHAUSTED
          SA5    A5+B1
          SB6    B6+B1       DECREMENT WORD COUNT 
          EQ     CNT3 
  
*         CHECK FOR CONTINUATION (BATCH FORMAT).
  
 CNT2     SX7    66+1 
          SA3    AFSC 
          LX5    6*CHAR 
          BX2    -X0*X5      ISOLATE COL 6
          SB3    X2 
          LX5    -6*CHAR     RESTORE (X5) 
          AX1    X3,B3
          LX1    -1 
          MI     X1,EXIT.    IF ZERO OR BLANK IN COL SIX -- INITIAL LINE
  
*         PREPARE FOR CONTINUATION LINE.
  
 CNT3     SA1    CCNT 
          SA2    =XT.SB 
          =X6    X1+1        (CCNT) = (CCNT)+1
          IX3    X4-X2
          SA2    =XT=SB 
          IX3    X2-X3
          IX7    X3-X7
          SA6    A1 
          PL     X7,CNT4     IF ENOUGH ROOM FOR NEXT LINE 
          ALLOC  T.SB,2*74   GET ENOUGH ROOM FOR 2 MORE FULL LINES. 
  
 CNT4     SA2    X4          FETCH PREVIOUS *EOS* MARK
          =A3    A2-1 
          UX1    B2,X2
          BX6    X3 
          SB2    B2-B1
          SA6    A2-B1       PRESTORE (A6)
          SA1    CO.MODE
          ZR     X1,EXIT.    IF BATCH FORMAT
          LX5    CHAR 
          =X1    0
          SA3    CNTA        RESTORE (X3) 
          EQ     EXIT.
  
  
 CNTA     BSS    1           SAVED (X3) 
 CSK      SPACE  4,15 
**        CSK -  CHECK STATEMENT KEYWORD. 
*         CHECKS SUB-KEYWORDS FOR TYPE AND IMPLICIT.  IF THE NEXT 
*         KEYWORD IS ONE OF A SPECIFIED SET, CSK WILL CHECK THE SPELLING
*         AND ADJUST THE *SB*, AND THEN EXIT TO THE APPROPRIATE 
*         PROCESSOR.  IF ANY CHECK FAILS, EXIT IS TO THE ERROR EXIT 
*         ADDRESS.
* 
*         ENTRY  (B4) _ *SB*. 
*                (B5) = LENGTH OF TABLE TO SEARCH.
*                (B7) = ERROR EXIT ADDRESS. 
*                (A1) _ TABLE OF ALLOWABLE CONTINUATIONS. 
*                (X1) = DITTO...
* 
*         EXIT   TO INDICATED KEYWORD PROCESSOR, IF FOUND, OR 
*                TO (B7) IF NOT IN TABLE. 
*                (B4) _ *SB* PAST NEW KEY (IF ANY). 
* 
*         CALLS  ASK
  
  
 CSK      SA3    B4          FETCH (*SB*) 
          MX0    4*CHAR 
          BX6    X0*X3       1ST 4 CHARS
          ZR     X3,E.TYH    IF -EOS- 
  
 CSK2     SA5    X1          FETCH LGR ENTRY
          SA1    A1+B1
          IX2    X5-X6
          SB5    B5-B1
          AX2    -4*CHAR
          ZR     X2,CSK4     IF HIT 
          PL     B5,CSK2     IF MORE ENTRIES IN TABLE 
          JP     B7          REPORT FAILURE.. 
  
 CSK4     SB5    LGR
          SB5    A5-B5       (B5) = JUMPTO ORDINAL
          RJ     ASK         ADJUST STATEMENT FOR NEW KEY 
          NZ     X3,E.MK     IF MIS-SPELLED 
          JP     B3          EXIT TO PROCESSOR..
 CST      SPACE  4,25 
**        CST -  CLASSIFY STATEMENT.
* 
*         ENTRY  *STRING BUFFER* IS NORMALIZED. (EXCEPT IF *FORMAT(*) 
*                (B4) _ START OF *SB* 
*                (FIRSTV) = FIRST VARIABLE IN STATEMENT.
*                (ZLEQUAL)= 0 IF NO ZERO LEVEL *=* IN STATEMENT.
*                (ZLCOMMA)= 0 IF NO ZERO LEVEL *,* IN STATEMENT.
* 
*         EXIT   (B5) < 0  UNRECOGNIZABLE STATEMENT.
*                (B5) \ 0 
*                     = ORDINAL OF STATEMENT IN *JUMP TO* TABLE.
*                (X5) = *JUMP TO* WORD. 
*                ("SB.BOS") = ADDRESS OF BEGINNING OF STATEMENT.
* 
*         USES   A1,A2,A3,A4,A5,A6  X0  B2,B4,B5,B7 
  
  
**        EXIT HERE IF STATEMENT IS A NON-KEYWORD TYPE. 
*                (B5) = /JUMPTO/ ORDINAL
  
 CSTJX    SA5    B5+LGR 
  
 CST      SUBR   0
          SA4    FIRSTV 
          SA1    B4 
          =B5    -1          SET FLAG FOR ERROR EXIT
          BX0    X1-X4
          AX0    18 
          NZ     X0,CSTX     ERROR, KEYWORD NOT FIRST ITEM
          BX6    0
          SX7    B4 
          SA1    ZLEQUAL
          SB5    B0          INDICATE NON-FORTRAN STATEMENT.
          MX0    2*CHAR 
          SA6    ZLE         CLEAR LOCAL INDICATOR TO PARSER. 
          SA7    "SB.BOS"    SET LOCAL BEGINNING OF STATEMENT 
          BX2    X0*X4
          LX2    2*CHAR 
          SX3    X2-2RDO
          NZ     X3,CST10    IF 1ST 2 CHARACTERS NOT *DO* 
  
**        CHECK FOR POSSIBLE *DO* STATEMENT.
  
          SA2    ZLCOMMA
          SB2    CHAR 
          ZR     X1,CST20    IF NO ZERO LEVEL *=*.
          IX3    X2-X1       (ZLCOMMA)-(ZLEQUAL)
          MI     X3,CST20    NO ZLCOMMA AFTER ZLEQUAL 
**        STATEMENT IS A *DO* STATEMENT.
*         EXIT   (B4) _ *=* SIGN OF *DO*
  
          SB5    DO.
          EQ     CSTJX       EXIT.. (*DO* STATEMENT)
  
  
 CST10    SX3    X2-2RIF
          NZ     X3,CST20    IF 1ST 2 CHARACTERS NOT *IF* 
          SA2    B4 
          MX0    3*CHAR 
          LX0    CHAR 
          BX2    -X0*X2 
          NZ     X2,CST20    IF MORE THAN JUST *IF* 
  
**        CHECK FOR POSSIBLE *IF* STATEMENT.
  
          =A4    B4+1 
          SX2    X4-O.( 
          NZ     X2,CST20    IF NOT *IF(* 
          SA3    ZLPAREN
          ZR     X3,CST20    IF NOT SET 
          SA2    X3-1        DONT ASK 
          SB7    A2-B4
          PL     B7,CST15    IF NOT PAST ZLPAREN
          NZ     X1,CST20    MUST BE ARRAY OR ASF NAMED IF
          EQ     CST17       MUST BE IF 
 CST15    SA2    X3 
          SB2    X2-O.SEP 
          PL     B2,CST20    IF NOT NUMBER OR VARIABLE .. NOT *IF*. 
 CST17    SB5    IF.
          EQ     CSTJX       EXIT.. (*IF* STATEMENT)
  
**        HERE IF NOT *DO*, *IF*, MUST BE ASSIGNMENT OR ASF.
  
 CST20    ZR     X1,CST50    IF NO ZERO LEVEL *=* 
          =B5    REP. 
          =A1    B4+1 
          SX2    X1-O.VAR 
          NZ     X2,CST22    IF NAME LESS THAN 8 CHARACTERS 
          RJ     =XTLV       TRUNCATE NAME
          SX7    B4 
          SA7    "SB.BOS"    RESET LOCAL BEGINNING OF STATEMENT 
          =A1    B4+1 
 CST22    SX2    X1-O.( 
          NZ     X2,CSTJX    IF NOT *VARIABLE(* (*REPLACEMENT*) 
          SA2    FIRSTV 
          BX6    X2 
          SCAN   TS.SYM,SSY 
          =B5    ASF. 
          MI     B7,CSTJX    IF *NIT* MUST BE *ASF* 
          IFBIT  X2,-ARY,CSTJX     IF NOT ARRAY, MUST BE *ASF*
          =B5    REP. 
          EQ     CSTJX       EXIT..  (REPLACEMENT)
  
**        CHECK IF STATEMENT IS DEFINED IN *KEYWORD* TABLE. 
  
 CST50    SA1    FIRSTV 
          MX0    4*CHAR 
          SB5    LG.LEN 
          =X7    -1          INDICATE IN *LGR* TABLE. 
          BX6    X0*X1       1ST *4* CHARACTERS.
  
**        SCAN *KEYWORD* TABLE. 
  
 CST55    SA5    B5+LGR-1 
          SB5    B5-B1
          IX2    X6-X5
          AX2    -4*CHAR
          ZR     X2,CSTX     IF HIT 
          PL     B5,CST55    IF NOT FINISHED. 
  
**        NOT IN *KEYWORD* TABLE, NON-FORTRAN STATEMENT.
  
          EQ     CSTX        EXIT.. 
  
 CUS      SPACE  4,8
**        CUS -  CHECK UPCOMING STATEMENT.
* 
*                ROUTINE IS ENTERED FROM THE MASTER LOOP (*CPM*)
*         WHENEVER A STATEMENT WHICH MAY GENERATE CODE IS ENCOUNTERED.
* 
*         OUTPUT OBJECT TIME REPRIEVE TURPLE, WHEN NECESSARY
* 
*         IF (HANGER) " 0 -- JUMP TO IT TO COMPLETE ANY HANGING PARTS OF
*                PREVIOUS STATEMENT.
*         PROCESS STATEMENT LABEL OF THIS STATEMENT, IF ALLOWED.
* 
*                NOTE THAT A "CONTINUE" WITHOUT A LABEL CAN NEVER CAUSE 
*         ANY CODE TO BE GENERATED, AND IS THEREFORE IGNORED. 
* 
*         ENTRY  (X5) = ("SB.KEY") SHIFTED TO P.SGEN IN BIT 59. 
*                ("SB.STN") =  COLUMNS 1-5 OF STATEMENT.
* 
*         EXIT   INTO *CPM*.
* 
*         USES   ALL BUT  A0. 
* 
*         CALLS  ALLOC,CSB,E.NP,GSN,HANGER,SBIT 
  
  
 CUS      BSS    0           ENTRY... 
          SA1    SB.STNR
          SBIT   X5,SLBL/SGEN 
          SA3    SB.STNL
          BX6    X1 
  
**        GET STATEMENT NUMBER, IF ALLOWED. 
  
          PL     X5,CUS3     IF LABEL NOT ALLOWED 
          LX7    X3 
          SA6    STN
          SA7    FILL.
          NZ     X6,GSN      IF LABEL IS PRESENT
  
  
**        IF COMPILATION OF THE PRECEDING STATEMENT WAS DEPENDENT UPON
*         THE NEXT STATEMENT (I.E., THIS ONE), IT HAS BEEN LEFT HANGING.
*         IT IS NOW TIME TO FINISH IT UP -- 
*                WE JUMP TO WHOMSOEVER HATH PUT HIS ADDRESS IN (HANGER).
*                HE DOES HIS THING AND RETURNS TO *CUS.RET*.
*         NOTE THAT ONLY STATEMENTS WHICH MAKE PARSED FILE ENTRIES MAY
*                BE *HUNG*. 
  
 GSNX     BSS    0           ** RETURN FROM *GSN* 
 CUS3     SA3    HANGER 
          ZR     X3,CUS.RET  IF NO *HANGING* COMPILATION
          =X6 
          SB7    X3 
          SA6    A3          CLEAR *HANGER* FLAG
          JP     B7          COMPILE ANY HANGING PIECES 
  
  
**        CUS.RET -  RETURN TO *CUS* FROM *HANGER* PROCESSING.
*                PREPARE TO EXIT -- 
*         IF THIS IS THE END OF A BASIC BLOCK (SEQUENCE BREAK), THEN WE 
*                FLUSH THE PARSED FILE BY CALLING *ARITH*.
*         IF THERE WAS A LABEL, COMPILE THE BSS TO DEFINE IT, 
*                DEACTIVATE ANY DELAYED STORE, AND CLEAR REGISTER 
*                ASSOCIATES.
*         CHECK (NOPATH) AND ISSUE APPROPRIATE WARNING, AND SET (FLOW)
*                TO INDICATE DEAD CODE. 
  
 CUS.RET  BSS    0           ** RETURN FROM *HANGERS*.
          SA2    CSNTAG 
          RJ     CSB         CHECK FOR SEQUENCE BREAK 
          SA1    =XCO.ER
          ZR     X1,CUS5     IF OTR REPRIEVE CODE NOT REQUIRED
  
          ALLOC  TT.PAR,L.TURP
          SA1    REFLIN 
          SA2    SB.STNL
          SA3    =XOTROP
          LX1    P.TRC-CHAR  POSITION (REFLIN) FOR TURPLE 
          BX7    X2          (SB.STNL)
          LX6    X1 
          =A6    B7-L.TURP+OR.2OP  OPERAND 2 OF TURPLE
  
 #FID     IFNE   .FID,0 
          =A1    "SB.KEY" 
          SB2    ENTRY= 
          SB2    -B2
          SB2    X1+B2
          NZ     B2,CUS4     IF NOT ENTRY STATEMENT 
  
          =X7    1           INDICATE NO LNT ENTRY
 CUS4     BSS 
 #FID     ENDIF 
  
          =A7    A6-OR.2OP+OR.1OP  OPERAND 1
          BX6    X3 
          =A6    A7-OR.1OP+OR.OPR  (OTROP) -- OTR (REPRIEVE) OPERATOR 
  
 #FID     IFNE   .FID,0 
          SA3    =XCO.ID
          PL     X3,CUS5     IF FID CODE NOT REQUIRED 
  
          SA3    =XDOORD
          ZR     X3,CUS5     IF NOT INSIDE A DO 
  
          SA1    =XTS.STN 
          SB2    X3          (DOORD)
          SA3    X1+B2       GET TAG FOR DO FROM STATEMENT NUMBER TABLE 
          =X2    M.SNEX 
          BX7    X3+X2       INSERT EXT REF FLAG
          SA7    A3          REPLACE IN STATEMENT NUMBER TABLE
 #FID     ENDIF 
  
 CUS5     BSS 
          SA2    NOPATH 
          SA4    CSNTAG 
          SA3    FLOW 
          BX6    X2+X3
          ZR     X4,CUS6     IF NO LABEL PRESENT
          BX6    0           CLEAR (FLOW) IF LABEL
 CUS6     SA6    FLOW 
          SA6    A2          RESET (NOPATH) 
          ZR     X6,CUSX     IF NO STATEMENT NUMBER REQUIRED
          =A3    "SB.KEY" 
          SB7    END= 
          SB7    -B7
          SB7    X3+B7
          SB2    ENTRY= 
          SB2    -B2
          SB2    X3+B2
          ZR     B7,CUSX     IF *END* STATEMENT 
          ZR     B2,CUSX     IF *ENTRY* STATEMENT 
          EQ     E.NP        ** WARN -- NO PATH **  (RETURN .. PSP) 
 CSB      SPACE  4,8
**        CSB -  CHECK SEQUENCE BREAK.
* 
*                DECIDES WHETHER A SEQUENCE BREAK (END OF BASIC BLOCK)
*         IS NECESSARY, AND IF SO, CALLS *CAI* TO FLUSH THE CURRENT 
*         PARSED FILE.
*         IF "SB.KEY" HAS P.SCDS ON, WE WILL BREAK THE SEQUENCE.
* 
*         ENTRY  (X2) = LABEL FLAG. 
*                     IF " 0 FORCE BREAK, AND COMPILE *BSS*.
*                     IF = 0 DO NOT BREAK BECAUSE OF LABEL. 
*         USES   ALL BUT A0.
  
  
 PAR.TH   EQU    50*L.TURP
  
 CSBX     SA1    TT=PAR 
          =X2    PAR.TH 
          SA3    CURST
          IX6    X1-X2
          IX0    X3-X6
          PL     X0,CSB      IF THRESHOLD NOT REACHED 
          SA6    A3          INDICATE NO SQUEEZING PAST HERE
  
 CSB      SUBR   -           ENTRY/EXIT ... 
          =A5    "SB.KEY" 
          BX4    X2 
          SBIT   X5,SCDS
          ZR     X4,CSB5     IF NEXT NOT LABELED
  
**        EMIT AN *O=BSS* TURPLE FOR THE LABEL. 
  
          ALLOC  TT.PAR,L.TURP
          SA1    OPBSS
          BX6    X4 
          =A6    B7-1 
          LX7    X1 
          =A6    A6-1 
          SA3    TP=DO
          BX6    X2 
          =A7    A6-1 
          SA6    CURST       INDICATE NO SQUEEZING PAST HERE
          ZR     X3,CSB6     IF NOT IN A DO-LOOP
  
**        FLUSH PARSED FILE WHEN THE STATEMENT REQUIRES IT. 
  
 CSB5     PL     X5,CSBX     IF STATEMENT DOES NOT FORCE FLUSH
  
 CSB6     RJ     CAI         COMPILE ALL (PARSED) INSTRUCTIONS
          EQ     CSBX        EXIT.. 
  
 LDB      SPACE  4,8
**        LDB - LIST DEFERRED BUFFER. 
* 
* 
*         EXAMPLE OF DEFERRED LIST BUFFER FORMAT -- 
* 
*           FOR THE SOURCE STATEMENT BEGINNING AT LINE 10 --
*             COL 1     7 
*                       DIMENSIONS(1),
*                      , OF(2), 
*                      , THE(3),MIND(4) 
* 
*           *T.DLBUF* WOULD BE -- 
* 
*            WORD  0  1         2         3         4         5 
*                  6  .......10.................DIMENSIONS(1),0000000000
* 
*            WORD  6  7         8         9        10        11 
*                  6  .......11................,.OF(2),.......0000000000
* 
*            WORD 12 13        14        15        16        17 
*                  7  .......12................,.THE(3),MIND(4).........
* 
*            WORD    18 
*                     0000000000
* 
*           WHERE .=BLANK(55B),0=EOL BITS(00B)
* 
*         ENTRY  NONE 
* 
*         EXIT   (HDELAY)  = .ZR. 
* 
*         USES   ALL BUT A0,A5,X5  (INCLUDES ALL CALLS) 
* 
*         CALLS  LSL,SHRINK 
  
  
 LDB      SUBR   =           ** ENTRY/EXIT ** 
          SA1    =XT.DLBUF
          SA2    =XT=DLBUF
          SB4    X1+
          SX6    X2+
  
 LDB2     ZR     X6,LDB3     IF FINISHED DUMPING *T.DLBUF*
  
 .T       IFNE   TEST,0 
          MI     X6,*+4S15   IF SOMETHING TERRIBLE HAS HAPPENED...
 .T       ENDIF 
  
          SX1    B4+1 
          RJ     LSL         LIST SOURCE LINE 
          SA1    B4          (X1) = NR OF WRDS IN SAVED LINE JUST LISTED
          SA2    =XT=DLBUF   (X2) = LEN OF REMAINING SAVED LINES
          IX6    X2-X1       (X6) = TOT LEN - LEN OF LAST LINE LISTED 
          SB4    B4+X1       (B4) = ADDR OF LEN WD FOR NEXT LINE TO LIST
          SA6    A2 
          EQ     LDB2 
  
 LDB3     BX6    X6-X6
          SA6    =XHDELAY    SET TO *NOT HEADER DELAY*
          SHRINK T=DLBUF,X6 
          EQ     EXIT.
 LSL      SPACE  4,8
**        LSL -  LIST SOURCE LINE.
* 
*         IF INPUT IS UNCOMPRESSED, WILL PRINT FROM WHEREVER THE CARD 
*         CURRENTLY RESIDES.
* 
*         ENTRY  (X1)+2  =  FWA AREA TO FIND CARD.
*                (AMODE) = INPUT FORMAT.
*                LINE IMAGE IS IN (AMODE) FORMAT. 
* 
*         EXIT   (B6) = LWA + 1 THAT WAS LISTED.
* 
*         USES   ALL BUT  A0,A5  B4  X0,X5. 
  
  
 LSL50    SA3    =XCP.PW
          SA4    =10H 
          ZR     X3,LSL55    IF NOT PW MODE 
          SA2    X1 
          =X1    X1+1 
          BX6    X2 
          SA6    X1 
          SB2    X1          (B2) = FWA OF LINE 
          SB3    B0 
          SB6    B2+B1
 LSL51    SA2    B2+B3       (X2) = NEXT WORD OF LINE 
          SB3    B3+B1
          IX6    X2-X4
          ZR     X6,LSL51    IF BLANK WORD
          ZR     X2,LSL52    IF EOL 
          SB6    A2+B1
          EQ     LSL51
  
 LSL52    SB7    B6-B2       LENGTH - 1 
          MX6    0
          SA6    X1+B7
          SX2    B7+B1
 LSL53    SB5    X3+B1       PAGE WIDTH IN WORDS + 1
          SB3    B7-B5
          LT     B3,LSL54    IF LINE LENGTH .LE. PAGE WIDTH 
          SA2    B2+X3
          AX3    30          REMAINDER OF PAGE WIDTH MOD 10 IN BITS 
          SB5    X3 
          SB2    B2-B1
          SB6    B6-B1
          RJ     BLL         BREAK LONG LINE
          SA3    =XCP.PW
          SB2    X1          FWA OF LINE
          SB7    X2-1        LENGTH - 1 OF LINE 
          SB6    X1+B7       LWA OF LINE
          NZ     X6,LSL53    IF STILL POSSIBLE LONG LINE
  
 LSL54    PLINE  X1,X2
          EQ     LSLX        EXIT 
  
 LSL55    LX6    X4 
          =A6    X1+1 
          PLINE  X1 
  
 LSL      SUBR               ENTRY/EXIT...
          SA3    AMODE
          ZR     X3,LSL50    IF UNCOMPRESSED INPUT
  
 #UPD     SKIP
          SA4    X1          FETCH FIRST WORD OF CRUNCHED IMAGE 
          LX3    -1 
          SB7    10 
          BX6    X2 
          SA7    LINEBUF
          MX7    -CHAR
          =A6    A7+1 
          PL     X3,LSL40    IF *UPDATE* FORMAT 
          TRUBL 
  
 LSL40    SB2    B0 
          SB5    10*CHAR     INITIALIZE OUTPUT CHARACTER COUNT
          =B3    1
          EQ     LSL4C
  
 LSL4A    BX6    X6+X7
          SB5    B5-CHAR
          =B2    B2-1 
          LX7    CHAR 
          GT     B5,LSL4B    IF OUTPUT WORD NOT FULL
          =A6    A6+1 
          SB5    10*CHAR
 LSL4B    PL     B2,LSL4A    LOOP IF FILLING BLANKS 
  
 LSL4C    LX4    CHAR 
          =B7    B7-1 
          BX7    -X0*X4      EXTRACT NEXT CHARACTER 
          NZ     B7,LSL4D    IF SOURCE WORD NOT EXHAUSTED 
          =A4    A4+1 
          SB7    10 
 LSL4D    ZR     B3,LSL4E    IF 00XX CODE 
          SB3    X7 
          NZ     B3,LSL4A    IF NOT 00 CHARACTER, GO STORE IT 
          EQ     LSL4C       GO GET XX
  
 LSL4E    SB2    X7 
          SX7    1R 
          SB3    X7 
          GT1    B2,LSL4A    IF 0002-0077 CODE, GO STORE BLANKS 
          =B2    B2-1 
          BX7    0
          ZR     B2,LSL4A    IF 0001 CODE, GO STORE 00 CHARACTER
          LX6    B5                ELSE,    0000 CODE -- END OF LINE
          =A6    A6+1 
          =A7    A6+1        INSURE END-OF-LINE 
          SX1    LINEBUF-1
          EQ     LSL60
 #UPD     ENDIF 
          TRUBL 
 LSS      SPACE  4
**         LSS - LEFT SHIFT STRING
* 
*                SHIFTS A STRING OF GIVEN LENGTH UP TO 10 CHARACTERS
*                LEFT END AROUND. 
* 
*         ENTRY  (X1) = MASK OF SHIFT COUNT 
*                (X2) = FIRST WORD OF STRING
*                (X3) = WORD OF BLANKS
*                (A2) = FWA OF STRING 
*                (B5) = SHIFT COUNT 
*                (B6) = LWA OF STRING - 1 
*         EXIT   (X6) = NEW FIRST WORD OF STRING
*                STRING SHIFTED.
* 
*         USES   B3, B7 
*                X1, X2, X3, X4, X6 
*                A4, A6 
*         PRESERVES          A0, A2, A5, A7, X5, X7, B2, B4, B5, B6 
* 
 LSS20    BX6    X2 
  
 LSS      SUBR               ENTRY/EXIT 
          ZR     B5,LSS20    IF NO SHIFT NEEDED 
          SB7    A2 
          SB3    B6 
          BX3    X1*X3
 LSS10    SA4    B3 
          BX2    X1*X4
          BX4    -X1*X4 
          BX6    X3+X4
          LX6    B5 
          SA6    A4 
          SB3    B3-B1
          BX3    X2 
          GE     B3,B7,LSS10 IF SHIFT NOT FINISHED
          EQ     EXIT.
  
 PLO      SPACE  4,8
 #NL      IFNE   #NL,0
**        PLO - PROCESS C/-LIST OPTIONS.
* 
*                THIS ROUTINE ACTS AS THE EXECUTIVE FOR C/-LIST 
*         DIRECTIVE PROCESSING. IT ASSURES THAT C/-LIST DIRECTIVES ARE
*         RELATIVELY INVISIBLE TO THE REST OF *AFS* BY CYCLING OFF ALL
*         PENDING C/-LIST DIRECTIVES AND SETTING THE APPROPRIATE LISTING
*         CONTROL FLAGS. UPON EXIT FROM *PLO*, YOU ARE ASSURRED THAT THE
*         NEXT LINE PENDING IS NOT A C/-LIST DIRECTIVE. 
* 
* 
*         ENTRY  (CSLIST)  =  1S59 IF C/-LIST,ALL OCCURRED
*                          =    1  IF C/-LIST,NONE OCCURRED 
*                          =   +0  IF C/-LIST DIRECTIVE DID NOT OCCUR 
*                (CSSTMT)  =  .NZ. IF *RNS* DETECTED C/-LINE AS POSSIBLY
*                                    1ST LINE OF PROG UNIT, ELSE .ZR. 
*                (HDELAY)  =  .NZ. IF IN *HEADER DELAY* MODE
*                                  (I.E. SAVING ALL LINES IN AN ATTEMPT 
*                                  TO GET PROGRAM UNIT NAME FOR TITLE 
*                                  LINE), ELSE .ZR. 
*                (NOLIST)  =  1S59 IF C/-LIST,ALL ACTIVE
*                          =   +0  IF C/-LIST,NONE ACTIVE 
*                (B6)      =  -NR OF USEABLE WORDS IN SOURCE LINE IMAGE 
*                               AT (CP.CARD) ET SEQ 
*                               (I.E. DOES NOT INCLUDE FULL WORD EOL MK)
* 
*                IN BATCH --
*                (A5,X5)   =  ADDR + CONTENTS 1ST WORD OF LINE IMAGE TO 
*                               BE BURST FROM (CP.CARD).
* 
*                IN SEQ --
*                (X3)      =  CHARACTER POSITION IN WORD.  ACTER
*                               POSITIONS IN (X3) ARE NUMBERED -- 
*                               (01 10 09 08 07 06 05 04 03 02).
*                               E.G. WHEN THE 4TH CHARACTER IS IN BITS
*                               (05-00) OF (X5), THEN THE SIGN BIT WILL 
*                               BE ON IN THE 4TH CHAR POSITION IN (X3). 
*                               (X5) = (05 06 07 08 09 10 01 02 03 04)
*                               (X3) = (00 00 00 00 00 00 00 40 00 00B) 
*                (A5,X5)   =  IF A *C/    * LINE DID NOT OCCUR, THE NTH 
*                               WORD IN (CP.CARD) WITH THE NON-DIGIT
*                               THAT TERMINATED ASSEMBLY OF LINE NR IN
*                               BITS (05-00); ELSE 1ST CHARACTER AFTER
*                               *C/    * IN BITS (05-00)
*                (B2)      =  NR OF LEADING BLANKS (BIASED BY -1777B) 
*                               (E.G. FOR 1 LEADING BLANK, (B2)=-1776B) 
*                (B3)      =  NR OF COLUMNS REMAINING IN LINE IMAGE 
* 
*         EXIT   (X0)      =  MX0 -CHAR 
* 
*                IF NO PENDING C/-LIST DIRECTIVE, THE FOLLOWING 
*                  REGISTERS ARE AS ON ENTRY; ELSE THEY ARE AS SET BY 
*                  *RNS* -- (X3),(A5,X5),(B2),(B3),(B6) 
* 
*         USES   ALL
* 
*         CALLS  CLO,CNT,FATAL,LDB,RNC,RNS
  
  
 PLO      SUBR               ** ENTRY/EXIT ** 
 PLO2     SA1    CSLIST 
          SA2    NOLIST 
          SA4    CSSTMT 
          MX6    0
          BX7    X1+X4
          MX0    -CHAR
          ZR     X7,EXIT.    IF C/-LIST DIRECTIVE DID NOT OCCUR 
          NZ     X4,PLO7     IF POSSIBLY 1ST LINE OF PROG UNT IS C/-LIST
          AX1    59          (X1) = +0 IF C/-LIST,NONE IS NEW MODE
*                                 = -0 IF C/-LIST,ALL IS NEW MODE 
          AX2    59          (X2) = +0 IF C/-LIST,NONE IS CURRENT MODE
*                                 = -0 IF C/-LIST,ALL IS CURRENT MODE 
          BX7    X1-X2       (X7) = +0 IF NEW MODE.EQ.CURRENT MODE
*                                 = -0 IF NEW MODE.NE.CURRENT MODE
  
 .T       IFNE   TEST,0 
          SA4    =XCO.SNAP
          LX4    1RU
          MI     X4,PLO5     IF (SNAP=U), IGNORE C/-LIST LINES
 .T       ENDIF 
  
          MI     X7,PLO3     IF NEW MODE .NE. CURRENT MODE
  
*         HERE IF NEW MODE .EQ. CURRENT MODE. 
  
          RJ     PLR         PROCESS LISTING REQUEST (C/-LINE)
          EQ     PLO6 
  
 PLO3     MI     X1,PLO5     IF NEW MODE IS *LIST,ALL*
  
*         HERE IF C/-LIST,NONE OCCURRED.
  
          SA3    CARDS
          SX3    X3-1 
          NZ     X3,PLO4     IF THIS IS NOT LINE 1 OF PROG UNIT 
          SA6    NOLIST      SET TO *LIST,NONE* STATUS
  
 PLO4     RJ     LDB         LIST DEFERRED BUFFER(ONLY IF BEFORE HEADER)
          RJ     PLR         PROCESS LISTING REQUEST (C/-LIST,NONE LINE)
          MX6    0
          SA6    NOLIST      SET TO *LIST,NONE* STATUS
          SA6    LOP=O       SET TO *DO NOT LIST OBJECT CODE* 
          EQ     PLO6 
  
*         HERE IF C/-LIST,ALL OCCURRED. 
  
 PLO5     SA1    MLOP=O 
          MX6    1
          SA6    A2          SET TO *LIST,ALL* STATUS 
          BX6    X1*X6
          SA6    LOP=O       SET TO *LIST OBJECT CODE* IF *OL* ON 
          RJ     PLR         PROCESS LISTING REQUEST (C/-LIST,ALL LINE) 
  
*         REQUEST NEXT LINE AND CHECK FOR C/-LIST OPTION. 
  
 PLO6     BX6    X6-X6
          NO
          SA6    =XCSLIST    CLEAR TO *NO C/-LIST LINE PENDING* 
          RJ     RNC         READ NEXT CARD 
          BX5    0
          SB6    -B7         (B6) = -NR OF USEABLE WORDS IN SOURCE LINE 
          NZ     X1,PLO8     IF END OF SECTION ENCOUNTERED
          SA5    B4 
          RJ     RNS         READ NEXT STATEMENT
          ZR     X5,PLO8     IF END OF SECTION ENCOUNTERED
  
 PLO7     RJ     CLO         CHECK FOR C/-LIST OPTION 
          ZR     X5,PLO8     IF (1) A C/-LINE FOLLOWED BY EITHER ANOTHER
*                              C/-LINE OR AN END OF SECTION, OR 
*                              (2) POSSIBLY 1ST LINE OF PROG UNIT IS
*                              C/-LIST DIRECTIVE
          RJ     CNT         CHECK FOR CONTINUATION 
          NZ     X1,PLO8     IF THIS IS NOT A CONTINUATION LINE 
          RJ     PLR         PROCESS LISTING REQUEST (CONT LINE IN ERR) 
          EQ     PLO6 
  
 PLO8     SA1    CCNT 
          ZR     X1,PLO9     IF DO NOT NEED TO ISSUE CONTINUATN ERR MSG 
  
*         HERE IF READY TO ISSUE ERROR MESSAGE. 
  
          MX6    0
          SA6    A1          CLEAR CONTINUATION COUNT 
          FATAL  E.MLNL      ERR MSG NR - *C/-LIST CANT BE FLWED BY CNT*
  
*         INITIALIZE FOR NEXT CYCLE THROUGH *PLO* WITH INITIAL LINE 
*         OF STATEMENT FOLLOWING THE *C/-LIST* STATEMENT WE JUST
*         PROCESSED.
*           E.G. FOR
*              C/    LIST,ALL               << JUST PROCESSED THIS, AND 
*              C                            <<
*              C                            << CYCLED OFF THESE, AND
*                   ,BAD CONTINUATION LINE  << ISSUED ERR MSG FOR THIS. 
*                    NEW STATEMENT          << READY TO PROCESS WHATEVER
*                                              IS HERE
  
 PLO9     SA1    =XHDELAY 
          NZ     X1,PLO2     IF IN *HEADER DELAY* MODE
          SHRINK T=DLBUF,0
          EQ     PLO2 
  
 #NL      ELSE
 PLO      SUBR
          EQ     EXIT.
 #NL      ENDIF 
 PLR      SPACE  4,8
**        PLR - PROCESS LISTING REQUEST.
* 
* 
*         PERFORMS THE FOLLOWING TASKS -- 
*           1. IF THE SOURCE LISTING OPTION IS ON (L.NE.0,SL.NE.0)
*              AND A C/-LIST,NONE NOT ACTIVE -- 
*             A. IF NOT IN *HEADER DELAY* MODE, THEN LISTS EACH LINE
*                IMMEDIATELY.  ELSE,
*             B. IF IN *HEADER DELAY* MODE, THEN EVERY LINE IS
*                SAVED/ACCUMULATED IN THE DEFERRED LIST BUFFER   (UP TO 
*                A MAX OF *L.MAXDL* WORDS WORTH) IN AN ATTEMPT TO GET 
*                THE PROGRAM UNIT NAME FOR THE TITLE LINE.
*                  E.G. --
*                      C     COMMENT         .. 
*                      C     COMMENT          . 
*                            .                .. SAVED UNTIL WE GET 
*                            .                .  *PETRETR* FROM 
*                            PROGRAM PETRETR ..  *PROGRAM* STMT PROCESSR
* 
*           2. IF THE SOURCE LISTING OPTION IS OFF (L=0,SL=0) 
*              OR A C/-LIST,NONE ACTIVE, THEN ACCUMULATES AN ENTIRE 
*              STMT (INITIAL LINE PLUS CONTINUATION LINES) IN THE 
*              DEFERRED LIST BUFFER *T.DLBUF* FOR POSSIBLE LISTING BY 
*              THE ERROR PROCESSOR *ERRORS/LLN* IF THE STMT IS FOUND
*              TO BE IN ERROR.  IN THIS MODE, COMMENT LINES ARE 
*              DISCARDED. 
* 
*         ENTRY  (CCNT)    = NR OF CONTINUATION LINES 
*                (COMMENT) = .NZ. IF LINE TO PROCESS IS A COMMENT LINE. 
*                                 (ONLY USED AS A FLAG BETWEEN *RNS*
*                                 AND *PLR*...KLUGE), ELSE .ZR. 
*                (CO.MODE) = .NZ. IF *SEQ* MODE INPUT 
*                          = .ZR. IF NORMAL FTN INPUT 
*                (CP.CARD) = LINE IMAGE TO BE LISTED OR SAVED.  THE 2 
*                            WORDS PRECEDING *CP.CARD*, BEGINNING AT
*                            *CP.FLIN*, ARE USED FOR SPACING AND LINE 
*                            NUMBER SET UP. 
*                (CSLIST)  = .NZ. IF LINE TO PROCESS IS A C/-LIST 
*                                 DIRECTIVE, ELSE .ZR.
*                (HDELAY)  = .NZ. IF IN *HEADER DELAY* MODE 
*                                 (I.E. SAVING ALL LINES IN AN ATTEMPT
*                                 TO GET PROGRAM UNIT NAME FOR TITLE
*                                 LINE), ELSE .ZR.
*                (L.CARD)  = NR OF WORDS IN SOURCE LINE TO PROCESS
*                            (INCLUDES FULL ZERO WORD EOL MARK) 
*                (NOLIST)  = 1S59 IF C/-LIST,ALL ACTIVE 
*                          =  +0  IF C/-LIST,NONE ACTIVE
*                (SLIST)   = 1S59 IF (L.NE.0,SL.NE.0) ON CONTROL CARD 
*                          =  +0  IF (L=0,SL=0) ON CONTROL CARD 
* 
*         EXIT   (COMMENT) = .ZR. 
* 
*         USES   ALL BUT A0 
* 
*         CALLS  ALLOC,CDD,DXB,LDB,LSL
  
  
 PLR      SUBR               ** ENTRY/EXIT ** 
  
*         SET UP REFERENCE LINE NR OF INITIAL LINE OF STATEMENT 
*           FOR REF MAP GENERATION (ERT). 
  
          SA4    =10H 
          SA3    =XSLIST
          SA2    =XNOLIST 
          SA1    =XCOMMENT
          LX6    X4 
          BX5    X2*X3       (X5) = .ZR. IF (L=0) OR C/-LIST,NONE ACTIVE
          SA2    =XCCNT 
          SA3    CO.MODE
          BX2    X1+X2
          SA1    =XCARDS     (X1) = LINE NR OF THIS LINE  (BINARY)
          ZR     X3,PLR2     IF NOT SEQ MODE
  
          SA1    SEQNO+1     (X1) = SEQUENCE NR OF THIS LINE  (0L FMT)
          NZ     X2,PLR5     IF COMMENT OR CONTINUATION LINE
          RJ     =XDXB       CONVERT DECIMAL DPC TO BINARY
          LX6    CHAR 
          SA6    =XREFLIN 
          BX6    X4          RESTORE (X6) = 10H 
          EQ     PLR5 
  
 PLR2     BX7    X1 
          NZ     X2,PLR3     IF COMMENT OR CONTINUATION LINE
          LX7    CHAR 
          SA7    =XREFLIN 
  
*         SET UP LINE NUMBER FOR LISTING PURPOSES IN NON-SEQ MODE --
* 
*           IF IN LIST MODE (L.NE.0 .AND. C/-LIST,ALL ACTIVE) AND --
*             1. IF THIS LINE NR IS A MULTIPLE OF 5, OR 
*             2. IF THIS LINE IS A C/-LIST LINE, OR 
*             3. IF (CO.SNAP) .NZ. IN *TEST* MODE 
* 
*           IF IN DEFERRED LIST MODE (L=0 .OR. C/-LIST,NONE ACTIVE) AND 
*             1. IF THIS IS INITIAL LINE OF STATEMENT, OR 
*             2. IF NOT INITIAL LINE OF STMT .AND. LINE NR IS MULTIPLE
*                  OF 5 
  
          ZR     X5,PLR4     IF (L=0) OR C/-LIST,NONE ACTIVE
  
 PLR3     SA2    =XCSLIST 
          NZ     X2,PLR4     IF LISTING C/-LIST LINE
  
 .T       IFNE   TEST,0 
          SA3    =XCO.SNAP
          NZ     X3,PLR4     IF ANY SNAP IS ON, FORCE OUT LINE NR 
 .T       ENDIF 
  
          SX2    146315B     (X2) = MAGIC NR FOR SENSING MULTIPLES OF 5 
          SX3    5
          IX4    X1*X2
          AX4    18 
          IX2    X4*X3
          IX3    X1-X2
          NZ     X3,PLR5     IF LINE NR IS NOT MULTIPLE OF 5
  
 PLR4     RJ     =XCDD       CONVERT BINARY TO DECIMAL DPC
  
 PLR5     SA1    =XHDELAY 
          SA2    =XT=DLBUF
          SA3    =XCOMMENT
          SA4    =XL.CARD 
          LX6    CHAR 
          BX7    X7-X7
          SA6    =XCP.FLIN
          SA7    A3+         CLEAR TO *NOT COMMENT LINE*
  
*         LIST THE LINE AT (CP.CARD) IF IN *LIST* MODE
*           AND NO HEADER DELAY.
  
          ZR     X5,PLR7     IF (L=0) OR C/-LIST,NONE ACTIVE
          ZR     X1,PLR6     IF NO HEADER DELAY 
          SX6    X2-L.MAXDL 
          MI     X6,PLR8     IF WE WANT TO KEEP SAVING *BEFORE HEADER*
          RJ     LDB         LIST DEFERRED BUFFER 
  
 PLR6     SX1    =XCP.FLIN   (X1) = FWA OF PRINT LINE AREA
          RJ     LSL         LIST SOURCE LINE 
          EQ     EXIT.
  
*         HERE TO SAVE SOURCE LINE IN A *READY TO LIST* FORMAT
*         IN THE DEFERRED LIST BUFFER *T.DLBUF* BECAUSE --
*           1. IN *NOLIST* MODE, (L=0) OR C/-LIST,NONE ACTIVE, OR 
*           2. IN *DELAYED HEADER* MODE.
* 
*         *T.DLBUF* FORMAT FOR EACH SAVED LINE -- 
*           WORD  0        NR OF WORDS IN THIS ENTRY (INCLUDES ITSELF)
*           WORDS 1 THRU N-1 (WHERE N IS THE CONTENTS OF WORD 0)
*                          CONTAIN THE SAVED SOURCE LINE IN A 
*                          LISTABLE FORMAT. 
* 
*         SEE ROUTINE *LDB* FOR AN EXAMPLE. 
  
 PLR7     NZ     X3,EXIT.    IF THIS IS A COMMENT LINE
  
 PLR8     SA1    =XT.DLBUF
          SA5    =XT=DLBUF
          SB6    1+2+X4      (B6) = NR OF WORDS IN LINE TO SAVE 
          ALLOC  A1,B6
          IX5    X1+X5       (X5) = FWA TO STORE LINE 
          SX6    B6 
          SA6    X5 
          SX2    CP.FLIN     (X2) = FROM
          SX3    X5+B1       (X3) = TO
          SX1    B6-B1       (X1) = COUNT 
          MVE    X1,X2,X3 
          EQ     EXIT.
  
  
 L.MAXDL  =      404B        MAX NR OF WORDS TO TRY AND SAVE IN 
*                              DEFERRED LIST BUFFER *T.DLBUF* DURING
*                              *BEFORE HEADER* MODE.
*CALL COMFRNC 
          ENTRY  RNC
 RNS      SPACE  4,45 
**        RNS -  READ NEXT STATEMENT. 
* 
* 
*         READS CARD IMAGES UNTIL AN INITIAL LINE IS FOUND.  MERELY 
*         CALLS *RNC* AND LISTS THE LINE, REPEATEDLY, UNTIL A 
*         NON-COMMENT IS ENCOUNTERED.  ONLY PURPOSE FOR EXISTANCE IS TO 
*         MAKE COMMENTS COMPLETELY TRANSPARENT TO *AFS*, SO THAT HE IS
*         NOT FULL OF LISTING LOGIC FOR THEM. 
* 
*         NOTE   ACCORDING TO *ANSI*, THIS ROUTINE SHOULD NOT EXIST.
*                STANDARD FORTRAN DOES NOT PERMIT COMMENT LINES EMBEDDED
*                IN A CONTINUATION STRING.  HISTORICALLY, HOWEVER,
*                C.D.C. COMPILERS HAVE IGNORED SUCH COMMENTS, AND WHO 
*                ARE WE TO TINKER WITH PRECEDENT. ..QQ..
* 
*         ENTRY  (CSSTMT)  =  .NZ. IF A C/-LINE WAS DISCOVERED TO BE
*                                    ONLY A COMMENT, ELSE .ZR.
*                (A5,X5)   =  ADDR + CONTENTS OF 1ST WORD OF LINE IMAGE 
*                (B6)      =  -NR OF USEABLE WORDS IN SOURCE LINE IMAGE 
*                               AT (CP.CARD) ET SEQ 
*                               (I.E. DOES NOT INCLUDE FULL WORD EOL MK)
* 
*         EXIT   (CSSTMT)  =  .NZ. IF A *C/    * LINE OCCURRED,ELSE .ZR.
*                (X0)      =  MX0 -CHAR 
*                (B6)      =  -NR OF USEABLE WORDS IN SOURCE LINE IMAGE 
*                               AT (CP.CARD) ET SEQ 
*                               (I.E. DOES NOT INCLUDE FULL WORD EOL MK)
* 
*                IN BATCH --
*                (A5,X5)   =  ADDR + CONTENTS 1ST WORD OF LINE IMAGE TO 
*                               BE BURST FROM (CP.CARD).
* 
*                IN SEQ --
*                (X3)      =  CHARACTER POSITION IN WORD. CHARACTER 
*                               POSITIONS IN (X3) ARE NUMBERED -- 
*                               (01 10 09 08 07 06 05 04 03 02).
*                               E.G. WHEN THE 4TH CHARACTER IS IN BITS
*                               (05-00) OF (X5), THEN THE SIGN BIT WILL 
*                               BE ON IN THE 4TH CHAR POSITION IN (X3). 
*                               (X5) = (05 06 07 08 09 10 01 02 03 04)
*                               (X3) = (00 00 00 00 00 00 00 40 00 00B) 
*                (A5,X5)   =  IF A *C/    * LINE DID NOT OCCUR, THE NTH 
*                               WORD IN (CP.CARD) WITH THE NON-DIGIT
*                               THAT TERMINATED ASSEMBLY OF LINE NR IN
*                               BITS (05-00); ELSE 1ST CHARACTER AFTER
*                               *C/    * IN BITS (05-00)
*                (B2)      =  NR OF LEADING BLANKS (BIASED BY -1777B) 
*                               (E.G. FOR 1 LEADING BLANK, (B2)=-1776B) 
*                (B3)      =  NR OF COLUMNS REMAINING IN LINE IMAGE 
*                (B7)      =  CHAR THAT TERMINATED ASSEMBLY OF LINE NR
* 
*         USES   ALL BUT A0 
* 
*         CALLS  ALN,LSL,RNC,WARN 
  
  
 RNS      SUBR               ENTRY/EXIT...
 RNS0     SA1    CO.MODE
          ZR     X1,RNS2     IF BATCH FORMAT
  
**        ASSEMBLE SOURCE INPUT IN T/S FORMAT.
  
          RJ     ALN         ASSEMBLE LINE NUMBER 
          NZ     X6,RNS1     IF *LN* PRESENT
          SA1    A5          PICK UP POSSIBLE IDENT 
          MX4    36B         SET UP MASK FOR POSSIBLE IDENT 
          BX7    X4*X1       MASK OFF POSSIBLE IDENT
          SA2    =5LIDENT 
          IX7    X7-X2       CHECK IF IT IS IDENT 
          NZ     X7,RNS0A    IF NOT IDENT 
          RJ     LDB         LIST DELATE BUFFER(IF ANY) 
          WRITER =XF.OUT,RCL
          EQ     =XLDCOM     LOAD COMPASS (1,0) 
 RNS0A    WARN   E.NLN
          EQ     RNS3 
  
 RNS1     MI     X1,EXIT.    IF NEXT CHARACTER IS PLUS(+) OR BLANK
  
*         HERE IF COMMENT IN SEQ FORMAT -- PACK 1ST 6 CHARACTERS OF 
*           STATEMENT TO (X6) SO THAT WE CAN CHECK FOR *C/    *.
  
 #NL      IFNE   #NL,0
          SB4    6
          MX6    0
  
 RNS1A    BX1    -X0*X5 
          LX6    CHAR 
          SB3    B3-1        COLUMN COUNT - 1 
          BX6    X6+X1
          LX3    CHAR 
          SB4    B4-1 
          PL     X3,RNS1B    IF WORD NOT EXHAUSTED
          SA5    A5+B1
          SB6    B6-B1       WORD COUNT - 1 
  
 RNS1B    LX5    CHAR 
          GT     B4,B0,RNS1A IF STILL PACKING 1ST 6 CHARS OF STMT 
          PL     B6,EXIT.    IF (CP.CARD) IS EMPTY NOW --NULL STMT
          LX6    10*CHAR-6*CHAR    LEFT JUSTIFY 1ST 6 CHARS OF STMT 
          BX4    X5          (X4) = SAVED (X5)
          LX5    X6          DUMMY UP (X5)
 #NL      ENDIF 
          EQ     RNS2A
  
*         CHECK FOR COMMENT LINE IN BATCH FORMAT. 
  
 RNS2     MX0    -CHAR
          SA2    ="C$*" 
          LX5    CHAR 
          BX1    -X0*X5 
          LX5    -CHAR       RESTORE (X5) 
          SB7    X1 
          LX1    B7,X2
          PL     X1,EXIT.    IF NOT COMMENT LINE
  
*         CHECK FOR C/-LINE.
  
 RNS2A    BSS    0
 #NL      IFNE   #NL,0
          SA1    CSSTMT 
          SA2    =6LC/
          MX6    0
          SA6    A1 
          NZ     X1,RNS3     IF JUST LISTING C/-COMMENT LINE
          SX6    B1 
          MX7    6*CHAR 
          BX1    X5-X2
          BX1    X1*X7
          NZ     X1,RNS3     IF NOT A *C/    * LINE 
          SA2    CO.MODE
          SA6    A1          SET TO *C/-LINE OCCURRED*
          ZR     X2,EXIT.    IF NORMAL BATCH INPUT
          BX5    X4          RESTORE (X5) 
          EQ     EXIT.
 #NL      ENDIF 
  
**        PASS OVER COMMENT CARDS.
  
 RNS3     SX6    B1 
          NO
          SA6    =XCOMMENT   SET TO *THIS IS A COMMENT LINE*
          RJ     PLR         PROCESS LISTING REQUEST
          RJ     RNC         READ NEXT CARD 
          SA5    B4 
          SB6    -B7         (B6) = -NR OF USEABLE SOURCE LINE WORDS
          ZR     X1,RNS0     IF NOT END OF SECTION
          EQ     EXIT.
 RSC      SPACE  4,8
**        RSC -  RESET INTRA-STATEMENT CELLS. 
*         ENTRY  N/A
*         EXIT   TEM.MAX RESET TO MAXIMUM TEMPORARY TAG.
*                RESET OF CELLS.
  
  
 RSC      SUBR   0
          RJ     UEC         UPDATE ERROR COUNT 
  
          BX6    0
          =X7    CR.REF 
          SA6    TYPC        CLEAR IMPLICIT STATEMENT FLAG
          SA6    DTI           -   DO-TERMINATION INDICATOR 
          SA6    STN           -   CURRENT STATEMENT LABEL
          SA7    REFNUM        -   CURRENT VALUE FOR REFS TO STAT. NO.
          SA6    CSNTAG        -   CURRENT STATEMENT LABEL TAG
          SA6    INIF          -   LOGICAL IF INDICATOR 
          SA7    REFVAR 
          SA2    TS=CON 
          SA1    =XALC.00    POINTER TO NO REGISTERS TO RESTORE 
          LX7    X1 
          SHRINK TS=CONB,X2  RESET TO START OF CONSTANTS FOR THIS STAT. 
          SA7    =XALC.REG   RESET SO NO REGISTERS WILL BE RELOCATED
          EQ     RSCX        EXIT.. 
 WBL      SPACE  4,8
**        WBL -  WRITE BLANK LINES. 
* 
*         ENTRY  (X6) = NUMBER OF BLANK LINES.
*                (X1) = ADDRESS OF LINE TO BE PRINTED AFTER THE BLANKS. 
*                            (= ZERO IF NONE.)
*                (X2) = NUMBER OF WORDS IN LINE (ZERO IF UNKNOWN).
*         USES   A1, A3, A6, A7 
*                X0, X3, X4, X6, X7 
*                B7 
*         CALLS  WOF,WRITEC 
  
  
 WBL6     SA1    LCP.PS 
          =X6    X1+1 
          SA6    LCNT        FORCE EJECT
  
 WBL8     SA1    WOFA 
          ZR     X1,WBLX     IF NO LINE TO PRINT
          SX2    X1          RESTORE LENGTH 
          AX1    30          RESTORE ADDRESS
          RJ     WOF
  
 WBL      SUBR   0
          SA3    LCNT 
          LX1    30 
          SB7    X6 
          BX7    X1+X2
          IX4    X3+X6
          SA1    LCP.PS 
          IX2    X4-X1
          SX6    X3+B7
          SA7    WOFA 
          SA6    A3          UPDATE LINE COUNT
          PL     X2,WBL6     IF PAST BOTTOM OF PAGE 
          SX0    B4          SAVE (B4)
 WBL2     WRITEC F.OUT,HDRBL,1
          SB7    B7-B1
          GT     B7,B0,WBL2 
          SB4    X0          RESTORE (B4) 
          EQ     WBL8 
 WOF      SPACE  4,12 
**        WOF -  WRITE OUTPUT FILE
* 
*         ENTRY  (X1) _ FWA LINE (-C- FORMAT).
*         (X2) = LINE LENGTH IN WORDS (ZERO IF UNKNOWN).
*         USES   A1-A4,A6,A7  B3-B7 
*         CALLS  CDD, WRITEC, WRITEW
  
  
 WOF7     SX0    B4          SAVE (B4)
          ZR     X2,WOF9     IF LINE LENGTH NOT GIVEN 
          SA3    =XCP.PW
          ZR     X3,WOF9     IF NOT IN PW MODE
          SB6    X2-1 
          SA4    X1+B6       LAST WORD OF LINE
          NZ     X4,WOF8
          SA4    A4-B1
 WOF8     SX7    B1          (X4) = LAST WORD - BLANK FILLED
          SA3    =9R                          . 
          BX3    X4-X3
          IX7    X3-X7                        . 
          BX6    -X7+X3                       . 
          SB2    55                           . 
          SA3    =40404040404040404040B       . 
          BX7    X3*X6                        . 
          LX3    B2,X7                        . 
          IX3    X7-X3                        . 
          BX7    X7+X3
          BX6    X4*X7       (X6) = LAST WORD - ZERO FILLED 
          SA6    A4 
 WOF9     WRITEC F.OUT,X1,X2
          SB4    X0          RESTORE (B4) 
  
 WOF      SUBR   0
          SA3    LCNT 
          SA4     LCP.PS
          IX7    X3-X4
          SX6    X3+B1
          SA6    A3          UPDATE LINE COUNT
          MI     X7,WOF7     IF PAGE NOT FULL 
          SA4    =XCP.LSTF
          LX1    30 
          IX6    X1+X2
          SA2    =XCP.PW
          LX4    59 
          SX0    B4 
          SA6    WOFA        SAVE FWA AND LENGTH OF LINE
          AX4    60 
          SX6    B1 
          BX3    -X4*X2 
          SX4    3           LENGTH OF TITLE
          SA6    A3          RESET LINE COUNT 
          NZ     X3,WOF5     IF L=0 AND IN PW MODE
          SA4    CP.PAGE
          PL     X4,WOF1     IF PAGE PROPAGATION
          MX0    1
          BX4    X4-X0       CLEAR NON-PROPAGATION FLAG 
          SX7    X4+B1       ADVANCE PAGE NUMBER
          LX1    X7 
          LX4    1
          ZR     X4,WOF0     IF CP.PAGE IS NOT SET
          MX0    2
 WOF0     LX4    59 
          BX7    X7+X0       RESTORE FLAG 
          EQ     WOF2 
 WOF1     SX7    X4+B1       ADVANCE PAGE NUMBER
          LX1    X7 
 WOF2     SA7    A4 
          PL     X7,WOF3     IF PAGE PROPAGATION
          BX7    X7-X0       CLEAR NON-PROPAGATION FLAG 
 WOF3     RJ     CDD         CONVERT PAGE NUMBER
          SX0    B4          SAVE (B4)
          MX4    -6*CHAR
          SA2    =XCP.PW
          BX6    -X4*X6 
          SB3    X6-1A1      FOR TEST OF THE FIRST PAGE 
          NZ     X2,WOF4     IF PW MODE 
          LX6    10*CHAR-6*CHAR 
          =A6    TL.PAGE
          NZ     B3,WOF3A    IF NOT FIRST PAGE
          SA4    =XCP.LSTF
          ZR     X4,WOF3A    IF L = 0 
          SA4    =XCP.PAGE
          LX4    1
          MI     X4,WOF3A    IF PD IS ALREADY WRITTEN OUT TO OUTPUT 
          LX4    59 
          SX2    B1 
          LX2    58 
          BX6    X4+X2
          SA6    =XCP.PAGE   SET WRITE TO FILE BIT
          SA4    =XCP.PD
          SA2    =24550000000000000000B 
          IX2    X2-X4
          MI     X2,WOF3A    IF PD=6, DONOT OUTPUT PD 
          WRITEC F.OUT,CP.PD,1
          MX6    0
          SA6    PDFLAG      TURN PDFLAG OFF
 WOF3A    WRITEC F.OUT,O.TITL,L.TITL
          SA2    =XO.STITL
          SB2    X2 
          AX2    30 
          SB3    X2 
          WRITEC F.OUT,B2,B3
          EQ     WOF6 
  
 WOF4     SA1    =XTL.PAGE-1 (X1) = PAGE......   (.=BLANK(55B)) 
          BX1    X4*X1
          BX6    X6+X1
          SA6    A1 
          WRITEC F.OUT,=XO.TTLA,=XL.TTLA
          SX4    =XL.TTLB 
 WOF5     WRITEC F.OUT,=XTL.PTYP,X4 
 WOF6     WRITEC F.OUT,HDRBL,1
          SB4    X0          RESTORE (B4) 
          SA1    WOFA 
          SX2    X1          RESTORE LENGTH 
          AX1    30          RESTORE FWA
          EQ     WOF7 
  
 WOFA     BSS    1           SAVE CELL FOR ENTRY PARAMETER
  
 HDRBL    LIT    2L 
  
          LIST   D
          END 
