*DECK     NUM 
          IDENT  NUM
 NUM      SECT   (STATEMENT NUMBER TRANSLATORS),1 
  
          SST    B,D,EXIT.
          NOREF  B,D,EXIT.
  
 B=NUM    RPVDEF             DEFINE ROUTINE FWA FOR REPRIEVE UTILITY
  
          ENTRY  PSN,GSN,STN0R,CUA,ISN,CLK,DLAB,DODO,ISN60,LABL 
          ENTRY  CUAFLAG,ISASG
          ENTRY  LBDO 
  
*         IN FTN
          EXT    CO.SNAP,LOP=R
  
*         IN TABLES 
          EXT    CDORD,CSNTAG,DOORD,DTI,NOPATH,REFNUM,STN,TS.STN
          EXT    TP.DO,TP=DO,TT=SCR,TT.SCR
  
*         IN ERRORS 
          EXT    E.DO12,E.DO24,E.DO25,E.DO25A,E.SN,E.SN9,E.SN12,E.SN13
          EXT    E.SN14,E.SN15,E.SN18,E.SN19,E.SN20 
          EXT    FILL.,FILL.2,STNTD,STNTND
  
*         IN PIG
          EXT    PIG
  
*         IN MAP
          EXT    SFN
  
*         IN ALLOC
          EXT    ERT,ESN,SSN
  
*         IN MAIN 
          EXT    CPM,GSNX,CSB,WBL,WOF 
  
*         IN IF 
          EXT    INIF 
  
*         IN DO 
          EXT    PDT
  
*         IN INIT 
          EXT    TRVA 
  
 NUM      SPACE  4,8
**        *NUM* IS A SECTION TO HANDLE MOST OF THE PROCESSING FOR 
*                STATEMENT NUMBER REFERENCES AND DEFINITIONS.  IT 
*                INTERFACES STRONGLY WITH *DO*, THE MASTER LOOP, AND
*                ALL KEYWORD STATEMENTS WHICH REFERENCE STATEMENT 
*                NUMBERS. 
 CUA      SPACE  4,8
**        CUA -  ASSEMBLE (UPCOMING) STATEMENT NUMBER 
*         ENTRY  X1 = DPC STATEMENT NUMBER TO BE ASSEMBLED
*                     (0L FORMAT, MUST HAVE AT LEAST 12 ZERO BITS TERM- 
*                     INATING FIELD)
*         EXIT   (B2) = SHIFT COUNT NECESSARY TO LEFT-JUSTIFY (X6). 
*                IF VALID LABEL --
*                  (X6) = DPC STATEMENT LABEL IN 0R FORM
*                IF ERROR --
*                  (X6) = -1
* 
*         POSTS ERRORS FOR ILL-FORMED STATEMENT LABELS. 
*         AND EXIT WITH STATEMENT NUMBER = TO *ERR.*
*         USES   A1,A2  B2,B7  X0,X6,X7 
  
  
 CUAFLAG  BSS    1           NEGATIVE IF ZERO STATEMENT LABELS ALLOWED
 CUA4     MI     B7,CUAE3    IF NON-NUMERIC 
          SB7    B7-10D 
          PL     B7,CUAE3    IF NON-NUMERIC 
  
 CUA6     BX2    -X0*X1      ISOLATE NEXT CHARACTER 
          LX1    CHAR 
          SB7    X2-1R
          ZR     B7,CUA6     IF BLANK, IGNORE 
          LX6    CHAR 
          IX6    X6+X2       MERGE CHARACTER INTO ASSEMBLY
          SB7    X2-1R0 
          SB2    B2-CHAR
          NZ     X2,CUA4     IF NOT ZERO CHARACTER
          BX2    X6 
          LX6    -CHAR
          AX2    6*CHAR 
          NZ     X2,CUAE2    IF OVER FIVE NUMERIC CHARACTERS
  
 CUA      SUBR   0
          BX6    X1 
          MX0    -CHAR
          SB2    10*CHAR
          SA6    FILL.
          LX1    CHAR 
          SX7    B0          IMPLIES NO LEADING ZERO FOUND
 CUA2     BX6    -X0*X1      ISOLATE LEADING CHARACTER
          LX1    CHAR 
          SB7    X6-1R
          ZR     B7,CUA2     IF BLANK, IGNORE 
          SB7    X6-1R0 
          ZR     B7,CUA3     IF LEADING ZERO
          NZ     X6,CUA4     IF SIGNIFICANT CHARACTER 
          ZR     X7,CUAX     IF NOT STATEMENT NUMBER ZERO 
          SA1    CUAFLAG
          NG     X1,CUAE1    IF STATEMENT LABEL ZERO ALLOWED
          FATAL  E.SN19      STATEMENT LABEL ZERO IS ILLEGAL
          MX6    -1 
          EQ     CUAX        EXIT.. 
  
 CUA3     SX7    B1          LEADING ZERO DETECTED
          EQ     CUA2 
  
*         ERROR PROCESSING
  
 CUAE1    NOTE   E.SN20      STATEMENT LABEL ZERO IGNORED 
          MX6    0
          EQ     CUAX        EXIT.. 
  
 CUAE2    SB7    E.SN14 
          JP     CUAE        CONTINUE.
  
 CUAE3    SB7    E.SN15 
  
 CUAE     FATAL  B7          OUTPUT ERROR MESSAGE 
          MX6    -1 
          EQ     CUAX        EXIT.. 
 GSN      EJECT  4,15 
**        GSN -  GET STATEMENT NUMBER.
* 
*         ENTRY  FROM *CUS*.  AN EXECUTABLE STATEMENT HAS BEEN
*                     ENCOUNTERED WITH A NON-BLANK LABEL. 
*                (X6) = STATEMENT LABEL FIELD.
*                (FILL.) = STATEMENT LABEL, LEFT-JUSTIFIED
* 
*         EXIT   INTO *CUS*.
*                (STN) =  STATEMENT LABEL FIELD OF SOURCE CARD IN 0R
*                     FORMAT. 
*                (CSNTAG) = TAG OF THE STATEMENT LABEL.  42/ 0,  18/TAG 
*                (DTI) = COPY OF (CSNTAG) IF THIS IS A DO-TERMINAL. 
* 
*         GENERAL FLOW
* 
*         IF THE STATEMENT LABEL ON THE SOURCE CARD  IS NOT 
*         IN TS.STN WE UPDATE (TG.SN) AND ADD TAG TO TS.STN SETTING THE 
*         DEFINED BIT.  IF IT IS IN TS.STN WE CHECK IF THE DEFINED BIT
*         IS ON, IF SO, WE PUMP OUT A *FATAL* ERROR OF A DUPLICATE
*         STATEMENT NUMBER AND CONTINUE, IGNORING THE STATEMENT LABEL.
* 
*         CALLS  ADDREF, ADSTN, RLK, SSN. 
  
  
 GSN      BSS    0           ENTRY/EXIT...
          MI     X6,GSNX     IF ERROR - EXIT..
          LX6    P.STN
          SCAN   TS.STN,SSN 
          =X7    M.SNDEF
          MI     B7,GSN5     IF *NIT* 
          IFBIT  X2,-SNDEF,GSN10     IF *NOT-DEFINED* 
  
**        HERE IF *STATEMENT NUMBER* IS IN TABLE AND *DEFINED*
*         ERROR - DUPLICATE STATEMENT NUMBER DEFINITION.
  
          FATAL  E.SN 
          SA1    ="SERR." 
          BX7    X1 
          SA7    STN
          EQ     GSN60       CONTINUE..  (TO ENTER REF-TAB) 
  
**        HERE IF *STATEMENT NUMBER* IS NOT IN TABLE. 
  
 GSN5     =X0    M.SNLAB
          BX7    X0+X7
          ADSTN  A1          ADD TO TABLE.
          SA3    DOORD
          =B7    B7+1        TAG ORDINAL
          ZR     X3,GSN45    IF NOT IN *DO* 
          SA1    TS.STN 
          RJ     SDL         SET DEFINITION LINK
          EQ     GSN45       CONTINUE.
  
**        HERE IF *STATEMENT NUMBER* IS IN TABLE. 
*                AND IS NOT-DEFINED.
  
 GSN10    SA3    DOORD
          IFBIT  X2,SNLAB/SNDEF,GSN11 
          SB2    B7 
          FATAL  E.SN13      PREVIOUS USE AS A FORMAT NUMBER. 
          SB7    B2 
          SA1    TS.STN 
          BX3    0
 GSN11    BX6    X6+X7
          IFBIT  X2,-SNDOT/SNLAB,GSN20
          BX7    X6 
          =X3    0
          AX7    P.TAG
          SA7    DTI         INDICATE *DO* TERMINATION
  
 GSN20    =B7    B7+1        ORDINAL OF *TAG* ENTRY.
          SA6    A2          RESET TAG INDICATING DEFINED.
          ZR     X3,GSN45    IF NOT IN *DO*.
          SA1    A1 
          RJ     SDL         SET DEFINITION LINK
 GSN45    AX6    P.TAG
          SA6    CSNTAG      SET CURRENT STATEMENT TAG. 
          LX6    P.TAG
 GSN60    ADDREF X6,CR.LAB,GSNX    ADD TO CROSS REF TABLE 
 ISN      EJECT 
**        ISN -  IDENTIFY STATEMENT NUMBER
* 
*         ENTRY  (X6) = STATEMENT NUMBER (0L FORMAT)
* 
*                (B2) = USAGE DEFINITION FOR STATEMENT NUMBER.
*                EITHER --
*                M.SNLAB = CONTROL LABEL, IE. GO TO 1 
*                M.SNFMT = FORMAT LABEL.  IE. PRINT 1 
*                M.SNDOT = DO DEFINITION. IE. DO    1 
* 
*                (REFNUM)= TYPE OF REFERENCE FOR *CROSS REFERENCE*
*                          PROCESSOR. 
* 
*         EXIT   (X6) = TAG FOR STATEMENT NUMBER. 
*                (B7) = ORDINAL OF TAG ENTRY IN TS.STN
* 
*         NOTE   (X6) = -1 IF SYNTAX ERROR IN STATEMENT NUMBER
* 
*         USES   A1,A2,A3,A6,A7  X0,X1,X3,X6,X7  B2,B7
*                FILL.2 = CURRENT STATEMENT NUMBER IN 0L FORM.
* 
*         CALLS  ADSTN, CUA, RLK
  
 ISASG    BSSZ   1           ASSIGN STATEMENT FLAG (.NE. 0 ON ASSIGN) 
  
**        PROCESS ERROR  (X1) = - ERROR ADDRESS.
  
 ISNEX1   MX2    45          USAGE CONFLICT ERROR EXIT
          BX1    -X2*X1 
          SB2    X1 
  
**        OUTPUT ERROR  (B2) _ ERROR
  
 ISNEX    SX2    B7          SAVE ORDINAL 
          FATAL  B2          OUTPUT ERROR 
          SB7    X2          RESTORE ORDINAL. ( X6 PRESERVED ACROSS ERR)
          MX6    59          (X6) = -1 IMPLIES ERROR IN DO
          EQ     ISNX        EXIT.. 
  
**        SET TAG IN TABLE ADDING DEFINED BITS FOR USAGE
*         (X2) = USAGE. 
*         (X6) = TAG FOR STATEMENT NUMBER.
*         (B7) = TAG ORDINAL. 
  
 ISN60    SA1    TS.STN 
          BX6    X6+X2
          SA6    X1+B7       REPLACE TAG REFLECTING USE.
          SA3    DOORD
  
**        SET LINK IF INSIDE DO AND ADD NUMBER TO CROSS REF TABLE 
*         (X1) = (TS.STN) 
*         (X2) = USAGE. 
*         (X3) = (DOORD)
*         (X6) = UPDATED TAG. 
  
 ISN70    =X0    M.SNFMT
          BX7    X0*X2
          NZ     X7,ISN72    IF PROCESSING FORMAT 
          =X0    M.SNDOT
          ZR     X3,ISN72    IF NOT IN A *DO* 
          BX7    X0*X2
          SA2    ISASG
          NZ     X7,ISN72    IF DEFINES NESTING 
          SA7    A2 
          NZ     X2,ISN72    IF PROCESSING ASSIGN STATEMENT 
          RJ     SRL         SET REFERENCE LINK 
  
**        ADD NUMBER TO CROSS REFERENCE TABLE -- IF SELECTED. 
  
 ISN72    SA2    LOP=R
          PL     X2,ISNX     IF NO CROSS REFERENCE. 
          SA1    REFNUM 
          BX3    X6 
          SA6    TRVA        SAVE TAG 
          SX6    B7 
          =A6    A6+1        SAVE ORDINAL 
          ADDREF X3,X1
          SA1    TRVA 
          =A2    A1+1 
          BX6    X1          RESTORE TAG
          SB7    X2          RESTORE ORDINAL
  
  
 ISN      SUBR   0
  
*         FORM STATEMENT NUMBER 
  
          SX0    X6-O.CONS
          ZR     X0,ISN2     IF DIGIT STRING
          SX0    X6 
          NZ     X0,E.SN18   IF TYPED OTHER THAN DIGIT STRING 
 ISN2     MX0    L.SYM
          BX6    X0*X6
          SA3    DOORD
          SX2    B2          USAGE
          SA6    FILL.2      IN CASE OF ANY ERROR.
          BX0    0
          ZR     X3,ISN3     IF NOT INSIDE DO 
          =X0    M.SNREF
 ISN3     BX7    -X0*X2      SELECTIVELY BRING DOWN REF BIT 
          LX1    X6 
          SA7    STNUSE      SET USAGE DEFINITION.
          RJ     CUA
          SA6    STN0R       SAVE 0R NUMBER.
          MI     X6,ISNX     IF ERROR - EXIT..
          SA1    TS.STN 
          LX6    P.STN
          SCAN   A1,SSN 
          MI     B7,ISN40    IF *STATEMENT NUMBER* NOT IN TABLE.
  
**        STATEMENT NUMBER ALREADY IN TABLE 
*         CHECK VALIDITY OF CURRENT USE 
  
          BX0    X6 
          SB3    STNTD
          IFBIT  X0,SNDEF,ISN10 
          SB3    STNTND 
 ISN10    =X0    M.SNLAB+M.SNFMT+M.SNDOT
          BX2    X0*X6       BRING DOWN SELECTIVE BITS (TABLE)
          NX3,B2 X2 
          SA1    STNUSE 
          SB2    B2-47+P.SNLAB
          BX2    X0*X1       BRING DOWN SELECTIVE BITS (REFERENCE)
          SA1    B2+B3
          NX3,B2 X2 
          =B7    B7+1        ORDINAL OF TAG ENTRY 
          SX0    B2-47+P.SNLAB
          BX0    -X0
          LX0    4           *16
          SB2    X0 
          LX1    B2,X1
          SA2    STNUSE      USE
          AX1    60-16       BACK TO LOW ORDER. 
          SB2    X1 
          MI     X1,ISNEX1   IF ERROR.
  
          JP     B2          JUMP TO CHECK REFERENCE
  
 LBDO     BX0    X6 
          IFBIT  X0,-SNREF,LBDO1 IF STATEMENT NUMBER NOT DEFINED
          =X7    M.SNE       IS ENTRY TO *DO* 
          BX6    X7+X6
 LBDO1    BX6    X2+X6
          SA1    TS.STN      STATEMENT NUMBER TABLE 
          SA6    X1+B7
          EQ     ISN72
          SPACE  4,12 
**        STATEMENT NUMBER PREVIOUSLY REFERENCED BUT NOT DEFINED. 
*         A.  CHECK IF DO LABEL ALREADY DEFINED AS A DO TERMINAL.  IF 
*             NOT -  GO TO B.  IF SO - CHECK FOR LEGAL NESTING. 
*         B.  CHECK IF DO LABEL REFERENCED OUTSIDE DO NEST.  IF SO -
*             SET ENTRY FLAG. 
*         C.  IF NOT - OK.
  
 DODO     BX0    X6 
          IFBIT  X0,-SNDOT,DODO1 IF NOT ALREADY DO TERMINAL 
          SA3    DOORD
          BX1    X6 
          LX1    -P.TAG 
          SX1    X1-C.STN 
          IX1    X1-X3
          ZR     X1,DODO1    IF LEGAL NESTING 
          SA1    TS.STN 
          SX0    M.SNDOT
          BX6    -X0*X6      CLEAR DO TERMINAL BIT
          SA6    X1+B7
          RJ     RDE         REMOVE DO ENTRY
          SB2    E.DO12 
          EQ     ISNEX
  
 DODO1    IFBIT  X0,-SNREF/SNDOT,ISN72  IF NOT REFERENCED 
          NZ     X3,DODO2    IF NESTING 
          BX6    X6+X2
 DODO2    =X7    M.SNE
          BX6    X6+X7
          SA1    TS.STN 
          SA6    X1+B7
          EQ     ISN72
          SPACE  4,12 
**        STATEMENT NUMBER PREVIOUSLY DEFINED 
*         A.  IF DO LOOP REFERENCING HAS AN EXTENDED RANGE - GO TO B. 
*             IF NOT FATAL ERROR -- TRANSFER TO CLOSED LOOP.
*         B.  IF DO LOOP NOT NESTED ON SAME NUMBER - TRANSFER OK.  IF SO
*             FATAL ERROR ILLEGAL TRANSFER. 
  
 DLAB     BX0    X6 
          SB2    E.SN9
          IFBIT  X0,-SNOPE,ISNEX   IF LOOP IS OPEN. (HAS EXTENDED RANGE)
          EQ     ISN60
  
**        C.  IF NUMBER REFERENCING IS ACTIVE - TRANSFER OK.  IF NOT
*             FATAL ERROR -- TRANSFER TO INSIDE A CLOSED D LOOP.
  
 LABL     SA3    DOORD
          NZ     X3,ISN60    IF IN *DO* 
          BX0    X6 
          IFBIT  X0,-SNINA,ISN60   IF NOT REFERENCE TO INACTIVE LABEL 
          SB2    E.DO24 
          EQ     ISNEX       ERROR EXIT.. 
          SPACE  4,12 
**        STATEMENT NUMBERS FIRST USE 
*         A.  ADD IN USAGE BITS 
*         B.  ADD NUMBER TO STATEMENT NUMBER TABLE
*         C.  CONTINUE, CHECKING CROSS REFERENCE, AND LINK
  
 ISN40    SA2    STNUSE 
          SX7    X2          TYPE OF REFERENCE. 
          ADSTN  A1          ADD STATEMENT NUMBER / TAG TO TABLE. 
          SA3    DOORD
          =B7    B7+1        TAG ORDINAL
          SA2    STNUSE      RELOAD USAGE 
          SA1    TS.STN      RELOAD TS.STN
          EQ     ISN70       CONTINUE 
          EJECT 
 STNUSE   DATA   0           TYPE OF REFERENCE ON ENTRY TO *ISN*
 STN0R    DATA   0           STATEMENT NUMBER IN 0R FORMAT. 
 PSN      EJECT  4,20 
**        PSN -  PROCESS STATEMENT LABEL. 
* 
*         ENTRY  (STN) = STATEMENT LABEL ON CURRENT CARD PROCESSING.
*                (DTI) = TAG OF STATEMENT LABEL IF THIS IS A DO-TERMINAL
*                (INIF) = L.TAG TO BE COMPILED IN FRONT OF NEXT STATEMEN
*                            FOR JUMP AROUND ANY ONE-BRANCH *IF*. 
* 
*         EXIT   IF STATEMENT LABEL PRESENT --
*                1. IF *DO* NUMBER PROCESS *DO* CONCLUSION CODE 
*                2. CLEAR ALL REGISTER ASSOCIATE. 
*                3. IF PART OF FORWARD *IF* CODE RESET REGISTER 
*                   ASSOCIATES TO WHAT THERE WHERE BEFORE IF JUMP WAS 
*                   PROCESSED.
*                4. CALL *PIG* TO PRINT INSTRUCTION GROUP COMPILED FOR
*                   THIS STATEMENT. 
* 
*                EXIT TO COMPILERS MASTER LOOP. 
* 
*         USES   ALL REGISTERS. 
* 
*         CALLS  CSB, PDT, PIG
  
  
 PSN      SA2    INIF 
          ZR     X2,PSN2     IF NO ACTIVE *IF*
          BX6    0
          SA6    NOPATH 
 PSN2     RJ     CSB         CHECK FOR SEQUENCE BREAK 
  
**        COMPILE DO-TERMINATION CODE, IF NECESSARY.
  
          SA2    DTI
          ZR     X2,PSN8     IF NO DO-TERMINATION 
          LX2    P.DOTAG
          RJ     PDT         PROCESS *DO* TERMINATION 
  
**        PROCESS INSTRUCTION GROUP.
  
 PSN8     RJ     PIG         PROCESS INSTRUCTION GROUP
          EQ     CPM         EXIT..  (TO MASTER LOOP) 
 CLK      SPACE  4,8
**        CLK -  CLEAR LINKS FOR STATEMENT NUMBERS INSIDE CURRENT *DO*
*         NEST BEING CLOSED.
* 
*         ENTRY  (DOORD) = STARTING ORDINAL FOR DO NEST 
*                (CDORD) = STARTING ORDINAL FOR CURRENT DO
* 
*         EXIT   LINKS CLEARED
* 
*         USES   A1,A2,A3,A4,A6,A7  X0  B2,B3,B6,B7 
  
  
 CLK      SUBR               ENTRY/EXIT.. 
 TEST     IFNE   TEST 
          RJ     PRLKH       PRINT LINK DUMP HEADER 
 TEST     ENDIF  TEST 
          SA2    DOORD
          SA1    TS.STN 
          SB6    X2 
          MX0    -L.SLINK 
          SA4    CDORD
          SA3    X1+B6       1ST LINKED NUMBER
          =X6    M.SNX
          SB3    X4          ENDING LINK
          LX0    P.SLINK
          BX4    -X0*X3 
          =X2    M.SNE
          =B7    -1 
          SB2    X1 
          =X7    0
  
**        SCAN LINKS TO SEE WHAT TYPE OF *DO* I HAVE
*         (B2) = (TS.STN) 
*         (B3) = (CDORD) BEGINNING OF NEST
*         (B6) = (DOORD) DO BEING DEFINED 
*         (X2) = M.SNE
*         (X6) = M.SNX
  
 CLK5     LX4    -P.SLINK 
          EQ     B7,B3,CLK30 IF END OF CURRENT *DO* LINK
          SB7    X4 
 TEST     IFNE   TEST 
          RJ     PRLINK 
 TEST     ENDIF  TEST 
          BX1    X6*X3
          ZR     X1,CLK7     IF DOES NOT DEFINE A POSSIBLE EXIT 
          BX1    X2*X3
          NZ     X1,CLK6     IF ALSO DEFINED IN LOOP - EXIT NOT SET 
  
**        NUMBER WAS REFERENCED INSIDE DO BUT NOT DEFINED 
*         SETS DO HAS AN EXTENDED RANGE 
  
          BX7    X7+X6       DEFINE DO HAS EXIT 
  
**        SET *SNREF* FOR NUMBERS THAT WERE REFERENCED INSIDE CURRENT DO
  
 CLK6     =X1    M.SNREF
          BX6    X1+X3
          SA6    A3          SET REFERENCE BIT
          =X6    M.SNX
          EQ     CLK10       CONTINUE 
  
**        NUMBER WAS NOT REFERENCED INSIDE DO - CHECK IF IT WAS DEFINED 
  
 CLK7     BX1    X2*X3
          ZR     X1,CLK10    IF DOES NOT DEFINE AN ENTRY
          BX7    X7+X2       DEFINE DO HAS AN ENTRY 
  
**        GET NEXT LINK 
  
 CLK10    SA3    X4+B2
          BX4    -X0*X3 
          EQ     CLK5        CONTINUE 
  
**        INFORMATION SCAN COMPLETE 
  
 CLK30    =X0    M.SNX
          BX6    X7*X0
          SA2    B2+B6
          =X3    M.SNINA     SET STATEMENT NUMBERS DEFINED IN LOOP INACT
          ZR     X6,CLK40    IF NO EXIT DEFINED - DO CONSIDERED CLOSED
          =X0    M.SNOPE     DEFINE DO LOOP IS OPEN 
          BX6    X0+X2
          =X3    0           BIT ADD IN 
          SA6    A2          DO HAS EXTENDED RANGE
          EQ     CLK50
  
**        DO IS CLOSED - CHECK IF THERE WAS AN ILLEGAL FORWARD REFERENCE
*         TO A NUMBER DEFINED INSIDE THIS DO
*         (X2) = CURRENT DO BEING DEFINED TAG.
  
 CLK40    IFBIT  X2,-SNE,CLK50     IF NO FORWARD REFERENCE INSIDE DO
          FATAL  E.DO25            ILLEGAL ENTRY
  
**        CLEAR LINKS FOR CURRENT *DO*
*         (X3) = BITS TO ADD TO STATEMENTS LINKED 
*         (B2) = (TS.STN) 
*         (B3) = (CDORD) BEGINNING OF NEST
*         (B6) = (DOORD) DO BEING DEFINED 
  
 CLK50    SX2    X3          BIT ADD IN 
 TEST     IFNE   TEST 
          RJ     PRLKH
 TEST     ENDIF  TEST 
          MX0    -L.SLINK 
          SA3    B2+B6
          SA1    MASKNE 
          LX0    P.SLINK
          =B7    -1 
          LX7    X1 
          EQ     B3,B6,CLK51 IF NO OUTER DO 
          SX4    M.SNX
          BX7    X7+X4       LEAVE SNX BIT ON IF THIS DO IS NESTED
 CLK51    BX4    -X0*X3 
  
**        CLEAR LINK LOOP AND SET APPROPRIATE BITS IN CLASS FOR NUMBERS 
*         REFERENCED / DEFINED WITHIN CURRENT LOOP
*         A.  IF NUMBER HAD *SNX* SET - CHANGE TO *SNREF* 
*         B.  IF DO IS CLOSED LOOP - SET *SNINA* BIT TO INDICATE NUMBER 
*             IS INACTIVE.
  
 CLK52    LX4    -P.SLINK 
          EQ     B7,B3,CLK55 IF END OF CURRENT *DO* LINK
          BX6    X3*X7       CLEAR LINKS + SPECIAL BITS 
          SB7    X4 
          IFBIT  X3,SNREF,CLK53 
          BX6    X6+X2       ADD IN BITS
 CLK53    SA6    A3 
 TEST     IFNE   TEST 
          RJ     PRLINK 
 TEST     ENDIF  TEST 
          SA3    X4+B2
          BX4    -X0*X3 
          EQ     CLK52       CONTINUE 
  
**        RESET CURRENT DO LINK, SETTING IT LINKED TO BEGINNING OF DO 
*         NEST
  
 CLK55    SA1    B2+B6       CURRENT DO BEING CLOSED
          SX3    B3 
          LX3    P.SLINK
          BX6    X3+X1
          =X0    M.SNX
          SA6    A1          RELINK INNER DO NUMBER TO OUTER
          IFBIT  X1,-SNOPE,EXIT.
          BX7    X6+X0       SET EXIT ON DO NUMBER IF EXTENDED RANGE
          SA7    A1 
          EQ     EXIT.
  
  
 MASKNE   VFD    L.TAG/-0,L.SNAD/-0,L.SLINK/0,L.SNCLS/-M.SNE-M.SNX
 SRL      SPACE  4,8
**        SRL -  SET REFERENCE LINK 
* 
*         ENTRY  (X1) = (TS.STN)
*                (X3) = (DOORD) 
*                (X6) = CURRENT TAG PROCESSING. 
*                (B7) = ORDINAL OF CURRENT *TAG* ENTRY. 
* 
*         EXIT   (X6) = TAG UPDATED WITH LINK.
*                (B7) = UNTOUCHED.
* 
*         USES   A1,A2,A3  X0,X1,X2,X3,X6,X7  B2,B7 
  
  
 SRL      SUBR               ENTRY/EXIT.. 
  
**        CHECK IF CURRENT NUMBER HAS BEEN LINKED TO CURRENT *DO* NEST
  
          SB2    X3 
          MX0    -L.SLINK 
          BX3    X6          CURRENT TAG. 
          LX0    P.SLINK
          BX2    -X0*X3      CURRENT LINK FIELD FOR NUMBER
          ZR     X2,SRL10    IF NOT LINKED - 1ST USE INSIDE *DO*
  
**        IF STATEMENT NUMBER LINKED TO CURRENT *DO* NEST 
*         SET FIELD INDICATING NUMBER IS REFERENCED INSIDE A *DO* 
  
          =X0    M.SNX
          NE     B2,B7,SRL5  IF REFERENCE IS NOT TO CURRENT DO
          =X0    M.SNREF
 SRL5     BX6    X3+X0
          SA6    X1+B7       SET *M.SNX* BIT
          SA2    X1+B2
          =X0    M.SNX
          BX7    X2+X0
          SA7    A2          INDICATE *DO* HAS AN EXIT
          EQ     EXIT.
  
**        HERE IF 1ST REFERENCE TO STATEMENT NUMBER INSIDE
*         THIS *DO* NEST. 
  
 SRL10    BX0    X3 
          IFBIT  X0,-SNDEF,SRL20     IF NUMBER NOT PREVIOUSLY DEFINED 
          IFBIT  X0,-SNINA/SNDEF,SRL15
          SB3    B7 
          LX2    X6 
          FATAL  E.DO24      ILLEGAL TRANSFER TO INSIDE A CLOSED DO 
          LX6    X2 
          SB7    B3 
          EQ     EXIT.
  
 SRL15    IFBIT  X0,SNE/SNINA,SRL20 
          SA2    X1+B2
          =X0    M.SNX
          BX6    X2+X0
          SA6    A2          INDICATE *DO* HAS AN EXIT
  
**        LINK NUMBER TO CURRENT *DO* 
*         (X3) = TAG FOR CURRENT NUMBER 
  
 SRL20    SA2    X1+B2       CURRENT LINK FROM *DO* NUMBER
          =X7    M.SNX
          MX0    -L.SLINK 
          BX3    X7+X3       SET M.SNX
          SX7    B7          CURRENT TAG ORDINAL
          LX0    P.SLINK
          BX6    -X0*X2      CURRENT LINK FIELD 
          BX6    X6+X3       LINK NUMBER TO LAST LINK 
          SA6    X1+B7
          BX3    X0*X2
          BX0    X6 
          LX7    P.SLINK
          BX6    X7+X3       RESET *DO* LINK TO NUMBER
          SA6    A2 
          BX6    X0 
          EQ     EXIT.
 SDL      SPACE  4,8
**        SDL -  SET DEFINITION LINK. 
* 
*         ENTRY  (X1) = (TS.STN)
*                (X3) = (DOORD) 
*                (X6) = CURRENT TAG PROCESSING. 
*                (B7) = ORDINAL OF CURRENT *TAG* ENTRY. 
* 
*         EXIT   (X6) = TAG UPDATED WITH LINK.
*                (B7) = UNTOUCHED.
* 
*         USES   A1,A2,A3  X0,X1,X2,X3,X6,X7  B2,B7 
  
  
 SDL40    =X0    M.SNE
          BX6    X3+X0       SET *M.SNE* BIT
          SA6    X1+B7
  
 SDL      SUBR               ENTRY/EXIT.. 
  
**        CHECK IF CURRENT NUMBER HAS BEEN LINKED TO CURRENT *DO* NEST
  
          SB2    X3          DO STATEMENT TAG ORDINAL 
          MX0    -L.SLINK 
          BX3    X6          CURRENT TAG. 
          LX0    P.SLINK
          BX2    -X0*X3      CURRENT LINK FIELD FOR NUMBER
          ZR     X2,SDL20    IF NOT LINKED - 1ST USE INSIDE *DO*
  
**        IF STATEMENT NUMBER LINKED TO CURRENT *DO* NEST 
* 
*         CHECKS
*         A.  IF CURRENT NUMBER HAS *SNX* SET, SCAN LINK TO SEE IF
*             NUMBER WAS FIRST REFERENCED INSIDE CURRENT *DO*.  IF NOT
*             PREVIOUS FORWARD REFERENCE IS AN ILLEGAL TRANSFER FROM
*             OUTER DO TO INNER.
* 
*         IF NOT (A)
*         B.  SET FIELD INDICATING NUMBER IS DEFINED INSIDE *DO* NEST.
  
          BX2    X3 
          =X0    M.SNX
          BX7    X0*X3
          AX2    P.2TAG 
          ZR     X7,SDL40    IF NO PREVIOUS REFERENCE INSIDE A DO 
          SA1    TS.STN 
          SB3    X2-C.STAT
          MX0    -L.SLINK 
          SA2    X1+B2       LOAD CURRENT DO TAG TO GET LAST LINK 
          LX0    P.SLINK
          SB2    X1 
          SB3    -B3
          BX4    -X0*X2      LINK 
  
**        SCAN LINK TILL DO FOUND OR STATEMENT NUMBER 
*         A.  IF DO FOUND FIRST - CURRENT DEFINITION WAS PREVIOUSLY 
*             REFERENCED FROM OUTSIDE CURRENT DO AND IS AN ILLEGAL
*             TRANSFER FROM OUTER DO TO INNER.
*         B.  IF NUMBER FOUND FIRST - CURRENT DEFINITION WAS REFERENCED 
*             FROM INSIDE CURRENT DO, SET *SNE* BIT AND EXIT..
  
 SDL5     LX4    -P.SLINK 
          SX7    X4+B3
          SA2    X4+B2
          ZR     X7,SDL40    IF NUMBER 1ST REFERENCED INSIDE CURRENT DO 
          BX4    -X0*X2      ORDINAL FIELD OF NEXT LINK 
          IFBIT  X2,-SNDOT,SDL5 
  
**        ILLEGAL TRANSFER FROM INSIDE DO NEST FROM OUTER DO TO INNER 
  
          =X0    M.SNE
          BX6    X3+X0       SET *M.SNE* BIT
          SA6    B2+B7
          SB3    B7 
          FATAL  E.SN12      PREVIOUS TRANSFER ILLEGAL
          SB7    B3 
          RJ     RDE         REMOVE DO ENTRY
          SA1    TS.STN 
          SA1    X1+B7
          LX6    X1          RESTORE LABEL TAG
          EQ     EXIT.
  
**        HERE IF 1ST REFERENCE TO STATEMENT NUMBER INSIDE
*         THIS *DO* NEST. 
*         CHECKS
*         A.  FORWARD REFERENCE TO NUMBER FROM OUTSIDE CURRENT DO 
*             NEST.  IF SO, SET *SNE* IN *DO* NUMBER INDICATING *DO* HAS
*             BEEN ENTERED FROM OUTSIDE DO.  WHEN WE COME TO CONCLUSION 
*             *SNE* BIT IS CHECKED IF DO WAS DEFINED AS A CLOSED LOOP.
*             IF CLOSED THEN WE FATAL THE LOOP AND TELL THE PROGRAMMER
*             THAT CURRENT DO WAS ILLEGALLY ENTERED BY A FORWARD
*             TRANSFER OF THIS TYPE.
* 
*         IF NOT (A)
*         B.  SET *SNE* IN NUMBER, INDICATING IT DEFINES AN ENTRY INTO
*             CURRENT NEST. 
  
 SDL20    BX0    X3 
          IFBIT  X0,-SNREF,SDL25
          IFBIT  X0,SNX/SNREF,SDL25  IF REFERENCE IS FROM NESTED DO 
          SA2    X1+B2
          =X0    M.SNE
          BX6    X2+X0
          SB3    B7          SAVE ORDINAL 
          SA6    A2          INDICATE *DO* HAS BEEN ENTERED 
          NOTE   E.DO25A     POSSIBLE ILLEGAL TRANSFER
          SA1    TS.STN 
          SB7    B3 
  
**        LINK NUMBER TO CURRENT *DO* SETTING *SNE* BIT 
*         (X1) = (TS.STN) 
*         (X3) = TAG FOR CURRENT NUMBER 
  
 SDL25    SA2    X1+B2       CURRENT LINK FROM *DO* NUMBER
          =X7    M.SNE
          MX0    -L.SLINK 
          BX3    X7+X3
          SX7    B7          CURRENT TAG ORDINAL
          LX0    P.SLINK
          BX6    -X0*X2      CURRENT LINK FIELD 
          BX6    X6+X3       LINK NUMBER TO LAST LINK 
          SA6    X1+B7
          BX3    X0*X2
          BX0    X6 
          LX7    P.SLINK
          BX6    X7+X3       RESET *DO* LINK TO NUMBER
          SA6    A2 
          BX6    X0 
          EQ     EXIT.
 RDE      SPACE  4,8
**        RDE  - REMOVE DO ENTRY
* 
*                CALLED WHEN AN ERROR IS DETECTED IN DO PROCESSING
*                WHICH RENDERS THE DO TERMINAL UNCOMPILABLE.
* 
*         ENTRY  (X6) = DO TERMINATOR TAG 
* 
*         EXIT   ALL DO ENTRIES ON TP.DO PERTAINING TO THAT TERMINATOR
*                ARE REMOVED. 
* 
*         USES   A1,A2,A3,A6  X0,X1,X2,X3,X6  B2,B3 
* 
*         CALLS  ALC, MVE 
  
  
 RDE3     SHRINK TP=DO
          SA2    TT=SCR 
          ALLOC  TP.DO,X2 
          LX3    X1          NEW ORIGIN 
          BX1    X2          NEW LENGTH 
          SA2    TT.SCR      NEW DO LIST
          RJ     =XMVE
          SHRINK TT=SCR 
          SB7    B2          RESTORE (B7) 
  
  
 RDE      SUBR
          SA2    TP=DO
          ZR     X2,RDE 
          SB2    B7          PRESERVE (B7)
          AX6    P.TAG
          SB3    X6 
          SB3    -B3         PRESERVE TAG OF DO TERMINAL
          SHRINK TT=SCR 
  
 RDE1     SA2    TP.DO
          SA1    X2+OR.DOSN 
          AX1    P.DOTAG
          SX1    X1+B3
          ZR     X1,RDE2     IF DO ENTRY MATCH
  
*         IF NOT A DO ENTRY TO DISCARD, SAVE ON TT.SCR
  
          ALLOC  TT.SCR,L.DOE 
          SX1    L.DOE
          SA2    TP.DO
          SX3    B7-L.DOE 
          RJ     =XMVE
  
*         RESET TP.DO FOR LOOP
  
 RDE2     SA1    TP.DO
          SA2    TP=DO
          SX6    X1+L.DOE 
          SX0    X2-L.DOE 
          ZR     X0,RDE3     IF LOOP DONE 
          SA6    A1 
          SHRINK TP=DO,X0 
          EQ     RDE1        CONTINUE.. 
          EJECT 
 TEST     IFNE   TEST 
 PRLINK   SPACE  4,8
**        PRLINK - PRINT LINKED STATEMENT NUMBER IF SNAP *N* ON.
* 
*         ENTRY  (A3) = STATEMENT NUMBER TAG WORD 
*         EXIT   LINKED NUMBER PRINTED. 
* 
*         NOTE - DESTROYS *A1* ONLY.
  
  
 PRLINK   SUBR   0
          SA1    CO.SNAP
          LX1    1RN
          PL     X1,PRLINKX 
          RJ     =XSVR=      SAVE REGISTERS 
          SA2    =XSVA+3
          SA5    X2-1        LOAD STATEMENT NUMBER DPC
          MX0    L.SYM
          BX1    X0*X5
          MX0    CHAR 
 PRLNK1   BX3    X0*X1
          NZ     X3,PRLNK5   IF LEFT JUSTIFIED
          LX1    CHAR 
          EQ     PRLNK1 
  
 PRLNK5   RJ     SFN         SPACE FILL NAME
          SA6    PRLNKL      SAVE NAME
          SA5    A5+1        LOAD TAG 
          SA1    =1H
          IFBIT  X5,-SNDEF,PRLNK7 
          SA1    =10H DEFINED 
 PRLNK7   BX6    X1 
          =A6    A6+1 
          SA1    =1H
          IFBIT  X5,-SNREF/SNDEF,PRLNK8 
          SA1    =10H REFER 
 PRLNK8   BX6    X1 
          =A6    A6+1 
          SA1    =1H
          IFBIT  X5,-SNX/SNREF,PRLNK9 
          SA1    =10H EXIT SET
 PRLNK9   BX6    X1 
          =A6    A6+1 
          SA1    =1H
          IFBIT  X5,-SNE/SNX,PRLNK10
          SA1    =10H ENTER SET 
 PRLNK10  BX6    X1 
          =A6    A6+1 
          SA1    =1H
          IFBIT  X5,-SNDOT/SNE,PRLNK11
          SA1    =10H DO NUMBER 
 PRLNK11  BX6    X1 
          =A6    A6+1 
          BX6    0
          =A6    A6+1        END OF LINE
          PLINE  PRLNKL      LINK INFORMATION 
          RJ     =XRSR=      RESTORE REGISTERS
          EQ     PRLINKX
 PRLKH    SPACE  4,8
**        PRINT LINE HEADER 
* 
*         DESTROYS A1 ONLY
  
  
 PRLKH    SUBR   0
          SA1    CO.SNAP
          LX1    1RN
          PL     X1,PRLKHX
          RJ     =XSVR=      SAVE REGISTERS 
          PLINE  PRLNKH,4,2  HEADER 
          RJ     =XRSR=      RESTORE REGISTERS
          EQ     PRLKHX      EXIT.. 
  
 PRLNKH   DIS    ,/        DUMP OF LINKS FOR CURRENT DO/
 PRLNKL   BSSZ   12 
 TEST     ENDIF  TEST 
          LIST   D
          END 
