*DECK     DO
          IDENT  DO 
 DO       SECT   (*DO* STATEMENT PROCESSORS),1
  
          SST    B,D,EXIT.
          NOREF  B,D,EXIT.
  
 B=DO     RPVDEF             DEFINE ROUTINE FWA FOR REPRIEVE UTILITY
  
          ENTRY  CDI,CDO,DIP,PDT,SDO
  
*         IN FTN
          EXT    CO.SNAP
  
*         IN TABLES 
          EXT    ARGCOMA,ARGMODE,APLUG,CONONE,CALLIO,CDORD
          EXT    DOSTNO,DOIX,DO=CC,DO.CSKL,DOORD,DOARM,DO.BEG,DOLMR 
          EXT    NOOPP,REFNUM,REGFILE,TT.PAR,TT=PAR 
          EXT    TS.STN,TS.CON,TP.APL,TP.DO,TP=DO,UUC 
  
*         IN ERRORS 
          EXT    E.AS4,E.DO12,E.DO13,E.DO18,E.DO27,E.DO28,E.DO29
          EXT    E.IOL3,ERR=F 
  
*         IN ALLOC
          EXT    ADW,ALC.DO,ALC.REG,NCM 
  
*         IN MAIN 
          EXT    ASL
  
*         IN IO 
          EXT    IOLEN
  
*         IN NUM
          EXT    PSN,STN0R,CLK,ISN
  
*         IN REG
          EXT    GST,SDS
  
*         IN PAR
          EXT    IXLASTV,PAR
  
*         IN GEN
          EXT    CAI,EIS.PNX,MXP,NULLOP 
  
*         IN INIT 
          EXT    CDOTG,SCR
  
  
**        SDO -  SET-UP *DO* FOR PROCESSING 
* 
*         *SDO* ENTERED FROM COMPILERS MASTER LOOP.  (*CPM*)
*         ENTRY  (B4) _ *SB* WHERE *DO* STARTS. 
*         EXIT   (X6) = *DO* STATEMENT NUMBER (0L FORMAT) 
* 
*         USES   ALL REGISTERS. 
  
  
          CON    0           DUMMY FOR DUMB *ASK* 
  
 SDO      SA1    B4 
          SB7    X1-O.CONS
          NZ     B7,E.AS4    IF NO LABEL
          RJ     ASL         ADJUST STATEMENT LABEL 
          BX6    X1 
          SA4    B4          FETCH SUPPOSED VARIABLE
          SA6    DOSTNO 
          SB2    X4-O.COMMA 
          ZR     X4,E.DO27   ** PREMATURE E.O.S. ** 
          NZ     B2,SDO3     ALLOW LABEL TO END WITH A COMMA
          WARN   E.DO29      ** COMMA IGNORED **
          ANSI   E.DO28      ** COMMA NON-ANSI ** 
          =A4    B4+1 
          ZR     X4,E.DO27   ** PREMATURE E.O.S. ** 
  
 SDO3     =B4    A4+1        POINT TO *EQUAL* SIGN
          SB7    X4-O.VAR 
          MX0    LG.VAR*CHAR
          BX7    X0*X1
          SX6    B4 
          SA7    DOIX 
  
          SA6    IXLASTV     SAVE *B4*
          RJ     CAI         FLUSH PARSED FILE
          SA2    IXLASTV
          SA1    DOSTNO 
          MX0    5*CHAR 
          BX7    X0*X1       SAVE ONLY 5 DIGITS 
          SA7    A1 
          SB4    X2          RESTORE *B4* 
          BX6    X1 
          RJ     CDI         PROCESS *DO* DEFINITION. 
          SA3    =XFLOW 
          ZR     X3,PSN      IF DO IS ACCESSABLE (NOT NOPATH) 
  
*         NOTE - FOR DO LOOPS, ONLY THE DO STATEMENT WILL GET THE NOPATH
*                WARNING MESSAGE.  FLOW, NOPATH AND LDEAD ARE CLEARED,
*                AND THE DO LOOP CODE WILL BE GENERATED. CHECKING ALL 
*                CASES FOR NOPATH CONDITIONS DIDNT SEEM WORTH THE CODE
*                SAVINGS. 
  
          BX7    0
          SA7    A3 
          SA7    =XNOPATH 
          SA7    =XLDEAD
          EQ     =XE.NP1
 ACD      SPACE  4,8
**        ADL -  ANALYZE *DO* LOOP FOR OPTIMAL COUNTING MECHANISM.
* 
* 
*         ENTRY  (B5) _ START OF CURRENT *DO* IN *TP.DO*
*                (B7) = 0, IF PROCESSING PROGRAMMER DEFINED *DO*
* 
*         EXIT   DO CONCLUSION *TURPLES* ADDED TO PARSED FLE. 
* 
*         USES   ALL BUT A0, B4.
  
  
 OP.LEN   EQU    40          MAXIMUM LENGTH *DO* TO LOOK AT.
 L.NULDO  EQU    5*L.TURP    LENGHT OF A DUMMY DO, DEFINING INDEX AND 
*                            CONCLUSION ONLY. 
  
  
 ADL      SUBR               ENTRY/EXIT...
          SA2    B5+OR.DOLI  DO LIMIT 
          =X0    M.SHORT
          SA5    B5+OR.DOII  DO INCREMENT 
          BX3    X0*X2       BRING DOWN SHORT BITS
          BX6    X0*X5
          IX0    X3+X6
          SA1    TS.STN 
          IX6    X0+X3
          AX6    P.SHORT-1
          SA6    SCR         SAVE ORDINAL OF O=DOC
          ZR     B7,ADL5     IF NOT *I/O* *DO*
  
*         ANALYZE *I/O* DO. 
  
          RJ     AID         ANALYZE *I/O* DO FOR REDUCTION 
          MI     B5,EXIT.    IF *DO* COLLAPSED. 
          EQ     ADL30       CONTINUE 
  
**        ANALYZE *DO* TO DETERMINE IF ANYTHING CAN BE DONE TO IMPROVE
*         ITS COUNTING MECHANISM. 
* 
*         IN ORDER TO DO ANY EVALUATION OF THE *DO* THE FOLLOWING 
*         CONDITIONS MUST BE SATISFIED. 
* 
*         A.  DO MUST NOT HAVE ANY EXTERNAL REFERENCES. 
*         B.  DO MUST NOT HAVE AN EXIT. 
*         C.  NONE OF ITS *DO* INDICES MUST BE ALTERED. 
*         D.  DO MUST BE THE ZERO LEVEL OF A NEST.
  
 ADL5     SA2    B5+OR.DOSN 
          BX5    X2 
          AX2    P.DOTAG
          SB7    X2-C.STAT
          SA3    X1+B7       DO STATMENT TAG FROM ST.NO. TABLE
          BX0    X3 
          IFBIT  X0,SNEX,ADL30     IF EXTERNAL PROCESS INSIDE LOOP
          SA4    DOIX 
          IFBIT  X0,SNOPE/SNEX,ADL30
          IFBIT  X0,SNNS/SNOPE,ADL30
          MI     X4,ADL30    IF INDEX ALTERED INSIDE BODY 
  
**        *DO* IS DEFINED AS CLOSED, CHECK COUNTING MECHANISM 
* 
*         ENTRY  (X5) = (OR.DOSN) 
*                (A2) _ (OR.DOSN) 
  
          AX2    P.DFLAG-P.DOTAG
          SA1    TT.PAR 
          SA3    TT=PAR 
          IX7    X1+X2
          MX0    L.DFLAG
          SA1    X7+OR.DFLAG      LOAD FLAG WORD
          IX6    X3-X2
          BX4    -X0*X5      CLEAR PASS *1* FLAG BITS 
          SB7    X6-L.NULDO 
          LX3    P.DFLAG
          SA1    =XCO.ER
          PL     X1,ADL7     IF OTR NOT ON
          SB7    B7-L.TURP   ELSE MUST TAKE OTR TURPLE INTO ACCOUNT 
 ADL7     PL     B7,ADL10    IF NOT NULL *DO* 
          SA1    NOOPP
          BX6    X1 
          SA6    X7          NULLIFY *DO* BEGIN CODE
          SA6    X7+L.TURP
          NOTE   E.DO18      NULL DO LOOP - IGNORED 
          EQ     EXIT.
  
 ADL10    SA5    SCR
          IX6    X4+X3       ADD POINTER TO START FOR OPT=1 PROCESSING
          SB7    DO=CC
          SB7    -B7
          SB7    X5+B7
  
**        ADD *DO* CONCLUSION MACROS TO PARSED FILE FOR CURRENT *DO*
*         (B5) _ START OF CURRENT *DO* IN *TP.DO* 
  
 ADL30    SA1    SCR
          SA4    X1+DO.CSKL+1 
 ADL32    SA1    ALC.DO 
          SA5    ALC.REG
          BX6    X1 
          SA6    A5 
          ALLOC  TT.PAR,2*L.TURP
          BX6    X5 
          SA6    A5 
          SA3    B5+OR.DORT 
          =A5    B5+OR.DOLI 
          LX7    X5 
          BX6    X3 
          =A6    B7-1        OR.2OP = DO RETURN LABEL 
          =A2    A5-OR.DOLI+OR.DOII 
          =A7    A6-1        OR.1OP = DO LIMIT
          LX6    X4 
          =A6    A7-1        OR.OPR = DO MACRO
          =A3    A2-OR.DOII+OR.DOCI 
          BX7    X2 
          =A4    A4-1 
          =A7    A6-1        OR.2OP = DO INCREMENT
          LX6    X4 
          BX7    X3 
          =A7    A7-1        OR.1OP = DO CONTROL VARIABLE 
          =A6    A7-1        OR.OPR = DO MACRO
          EQ     EXIT.
 AID      EJECT  ANALYZE IMPLIED *DO* LOOP FOR LIST COLLAPSE. 
**        AID -  ANALYZE IMPLIED *DO* LOOP FOR LIST COLLAPSE. 
* 
* 
*         ENTRY  (B5) _ START OF CURRENT *DO* IN *TP.DO*
*                (X5) = (OR.DOII) 
*                (X6) = ORDINAL INTO *DO.CSKL* TABLE. 
* 
*         EXIT   (B5) > 0, NO LIST COLLAPSE 
*                     _ START OF CURRENT *DO* IN *TP.DO*
*                (B5) < 0, LIST COLLAPSED, NO DO CONCLUSION CODE NEEDED,
*                            O=DOB *TURPLES* NOOP.
*         TABLES MUST NOT BE MOVED UNLESS LIST IS COLLAPSED.
* 
*         FOR A COLLAPSIBLE LOOP, THE PARSED FILE TURPLES WILL APPEAR 
*         AS FOLLOWS (BEGINNING AT *B2*) -- 
*                0.  DOBEGIN
*                1.  DOBEGIN (INDEX-TAG)
*                2.  MRKEXT 
*                3.  ARY-LOD (ARRAY-TAG       ,  INDEX-TAG  ) 
*                4.  APLUG   (INTERMEDIATE(4.),  AP-TAG     ) 
*                5.  RJUMP   (AP-TAG + TRACE  ,  ROUTINE-TAG) 
*         WE ALSO REQUIRE THAT *INITIAL* AND *LIMIT* BE SHORT CONSTANTS,
*                AND THAT THE *INCREMENT* IS ONE. 
* 
*         IF THE ABOVE HOLDS, THEN THE LOOP IS COLLAPSIBLE.  THIS DOES
*         NOT EXHAUST THE CATEGORY OF LOGICALLY COLLAPSIBLE LOOPS, BUT
*         IT DOES DEFINE THE ONLY ONES THAT WE WILL (PRESENTLY) HANDLE. 
* 
*         THE COLLAPSE IS ACCOMPLISHED BY --
*                A.  CONSTRUCT AN AP-LIST ITEM ENTRY WHOSE FIELDS ARE 
*                    SET AS FOLLOWS --
*                            (ATAG)  = COPY (2TAG) OF 1OP OF TURPLE (3.)
*                            (ABIAS) = COPY (2BIAS)OF 1OP OF TURPLE (3.)
*                            (ATYP,  = ELEMENT LENGTH, WHICH IS EQUAL TO
*                             ASIZ)    THE TRIP COUNT OF THE LOOP.
*                B.  ENTER THE AP-ITEM FROM (A.) INTO THE AP-LIST TABLE 
*                    (*TP.APL*), AND INCREMENT (*IOLEN*).  *IOJ* WILL 
*                    LATER CONSTRUCT A NEW AP-LIST AND *RJUMP* TURPLE.
*                C.  RESET TURPLES (0.) THRU (5.) TO *O=NOOP*, AND ZERO 
*                    OUT THEIR OPERANDS.
*                D.  SET REPLY TO INDICATE COLLAPSE.
* 
*         NOTE   THIS WASTES THE AP-TAG AND AP-LIST ORIGINALLY SET UP TO
*                BE USED BY TURPLE (5.).  TO AVOID THIS, HOWEVER, WOULD 
*                REQUIRE CHANGES TO PREVIOUSLY CONSTRUCTED TABLES THAT
*                ARE NOT OBVIOUS TO THE CURRENT WRITER. 
* 
*         USES   ALL BUT A0, B4.
*         CALLS  ADDWD, NOTE. 
  
  
 AID      SUBR               ENTRY/EXIT...
          SA2    CONONE 
          BX7    X2-X5
          NZ     X7,EXIT.    IF INCREMENT NOT = 1 
  
          SA1    TT.PAR 
          SA2    TT=PAR 
          SB7    DO=CC
          SB7    -B7
          SB7    X6+B7
          IX0    X1+X2       = LWA+1 (TT.PAR) 
          SB2    X0-6*L.TURP
          NZ     B7,EXIT.    IF BOTH INDICES NOT CONSTANT 
  
          =A3    B2+0*L.TURP+OR.OPR 
          =A2    B2+1*L.TURP+OR.OPR 
          SX3    X3-O.DOB 
          SX2    X2-O.DOB 
          NZ     X3,EXIT.    IF *DOBEGIN* NOT WHERE EXPECTED
          NZ     X2,EXIT.    IF *DOBEGIN* NOT WHERE EXPECTED
  
          =A3    B2+3*L.TURP+OR.OPR 
          SB7    X3-O.ARY 
          NZ     B7,EXIT.    IF FIRST ITEM NOT AN ARRAY 
  
          SA2    B2+3*L.TURP+OR.2OP 
          SA1    B2+1*L.TURP+OR.1OP 
          BX6    X2-X1
          NZ     X6,EXIT.    IF INDEX NOT SAME AS SUBSCRIPT 
  
          =A3    A2+1        = 4*L.TURP+OR.OPR
          SA1    APLUG
          BX7    X3-X1
          NZ     X7,EXIT.    IF ARRAY NOT REALLY A LIST ITEM
  
          SA3    B2+5*L.TURP+OR.OPR 
          SA1    CALLIO 
          BX6    X3-X1
          NZ     X6,EXIT.    IF TOO MUCH STUFF IN LIST
  
          NOTE   E.IOL3      ** IMPLIED LOOP REDUCED ** 
  
          ERRNZ  L.ABIAS-L.2BIAS   BIAS FIELDS MUST BE SAME LENGTH
          ERRNZ  P.2BIAS+L.2BIAS-P.2TAG   (2TAG) AND (2BIAS) MUST BE ADJ
  
          =A2    A2-OR.2OP+OR.1OP 
          MX0    -L.ATAG
          =A1    B5+OR.DOSI 
          =A3    A1-OR.DOSI+OR.DOLI 
          SBIT   X2,ATAG/2TAG 
          LX2    -P.ATAG     (X2) =  24/ ABIAS,  18/ JUNK,  18/ ATAG
          BX5    -X0*X2      COPY (2TAG) INTO (ATAG)
          AX1    P.SHC       SIGN EXTEND *INITIAL*
          AX3    P.SHC       SIGN EXTEND COMPLEMENT OF (*LIMIT* + 1)
          SB7    5
          IX4    X3+X1       -(TRIP COUNT) = -(LIMIT+1) + INITIAL 
          AX2    -L.ABIAS    SIGN EXTEND *BIAS* 
          IX7    X2+X1       NEW BIAS = INITIAL + OLD BIAS
          MX0    L.ABIAS
          BX4    -X4         (X4) = TRUE TRIP COUNT 
          LX7    -L.ABIAS 
          BX3    X0*X7       ISOLATE NEW BIAS 
          SA1    NOOPP
          BX5    X3+X5
          =X7    0
          LX6    X1 
          SA6    B2          NO-OP TURPLE (0.)
          =A7    A6+OR.1OP
          LX5    P.ATAG 
          =A7    A7-OR.1OP+OR.2OP 
  
 AID50    =A6    A7-OR.2OP+L.TURP  --     (1, 2, 3, 4)
          =A7    A6+OR.1OP
          =B7    B7-1 
          =A7    A7-OR.1OP+OR.2OP 
          NZ     B7,AID50    IF MORE TURPLES TO KILL
  
          LX2    X4 
          =X3    X4+"AP=SIZ"S"ATYP"    SET ITEM LENGTH INDICATOR
          BX6    X5+X3
          AX2    L.ASIZ 
          =B5    -1          INDICATE LOOP COLLAPSED
          ZR     X2,AID60    IF SHORT ENUF TO PUT IN DIRECTLY 
          LX7    X4 
          SA7    SCR
          SB2    A7 
          SB3    A7 
          SCAN   TS.CON,NCM  ENTER TRIP COUNT INTO CONSTANT TABLE 
          SX4    B7+"AP=CON"S"ATYP" 
          BX6    X4+X5
  
 AID60    SA2    IOLEN
          =X7    X2+1        INCREMENT (IOLEN) FOR THIS ITEM
          SA7    A2 
          ADDWD  TP.APL 
          EQ     EXIT.
 CDI      EJECT  4,20 
**        CDI -  COMPILE *DO* INITIAL *TURPLE*. 
* 
*         ENTRY  (B4) _ *=* OF *DO* STATEMENT.
*                (X6) = 
*                1. IF LOW ORDER 18 BITS ARE ZERO 
*                   PROCESSING A PROGRAMMER *DO*
*                2. OTHERWISE ASSUMED TO BE A I/O LIST PROCESSOR CALL.
* 
*         EXIT   ENTRYS MADE INTO - 
*                (X6) = 0 
*                1. TS.STN OF STATEMENT NUMBER.(IF NOT I/O LIST PROCESS)
*                2. TP.DO  OF *DO* PARAMETERS. (SEE TP.DO WRITE-UP) 
* 
*                (X6) = 1S59
*                *DO* DEFINITION CONTAINED AN ERROR -- NO TABLE ENTRIES 
*                MADE IN *TP.DO*. 
* 
*         CALLS  ALLOC, ISN, MXP, PAR 
* 
*         USES   ALL REGISTERS. 
  
  
 CDI      SUBR               ENTRY/EXIT...
          SB7    X6 
          BX5    X6 
          NZ     B7,CDI15    IF IN I/O LIST PROCESSING. 
  
**        IDENTIFY STATEMENT NUMBER AS *DO* 
  
          =B2    M.SNDOT+M.SNLAB   DO TERM AND STMNT NO. MASK 
          =X7    CR.DO       MARK DO IN CROSS REF.
          SA7    REFNUM 
          RJ     ISN         IDENTIFY STATEMENT NUMBER. 
          NG     X6,EXIT.    IF ERROR IN DO STATEMENT NUMBER
          SX3    B7          ORD OF TAG ENTRY IN TS.STN 
          SA1    DOORD       ORD IN TS.STN OF CURRENT DO
          SX7    B7 
          SA2    TS.STN 
          BX5    X6          TAG FOR STATEMENT NUMBER.
          LX3    P.SLINK
          SB3    X2 
          SA7    A1          INDICATE *DO* PROCESSING. (SET DOORD)
          ZR     X1,CDI10    IF DOES NOT DEFINE NESTING 
  
**        1. ZERO LEVEL DO
*           A.  SET LINK TO ITSELF
*           B.  SET *CDORD* TO BASE OF DO NEST
* 
*         2. NESTED DO DEFINITION.
*           A.  IF PREVIOUSLY LINKED - CONTINUE WITH OLD LINK 
*           B.  SCAN LINK TO FIND LAST LINK IN PREVOUS DO CHAIN.
*           C.  SET LAST LINK OF PREVIOUS DO TO CURRENT DO
*           D.  SET CURRENT DO LINKED TO BASE OF NEST.
  
          MX0    -L.SLINK 
          LX0    P.SLINK
          BX4    -X0*X6 
          NZ     X4,CDI13    IF PREVIOUSLY LINKED 
          SA2    CDORD       ENDING LINK = START OF DO NEST 
          =X3    M.SNNS 
          SA1    X1+B3       START SCAN FROM LAST DO START
          BX4    -X0*X1 
          BX7    X3+X1       INDICATE LAST DO IS NESTED 
          AX1    P.2TAG 
          SB2    X2 
          LX4    -P.SLINK 
          SB6    X1-C.STAT
          SA7    A1          RESET *DO* IN TABLE
  
 CDI5     SB5    X4 
          SA1    X4+B3
          EQ     B5,B2,CDI7  IF END OF CURRENT *DO* LINK
          BX4    -X0*X1 
          SB6    B5 
          NO
          LX4    -P.SLINK 
          EQ     CDI5        CONTINUE 
  
**        END OF LAST DO LINK 
  
 CDI7     SA4    B3+B6       RELOAD LAST LINK 
          SX3    B7 
          BX7    X0*X4       CLEAR OLD LINK 
          LX3    P.SLINK
          BX7    X3+X7
          SA7    A4          RESET LAST LINK TO CURRENT DO
          BX1    -X0*X4 
          BX6    X6+X1
          SA6    B3+B7       SET CURRENT DO LINKED TO BASE OF NEST
          EQ     CDI13       CONTINUE 
  
  
**        SET CURRENT DO LINK 
*         (B3) = (TS.STN) 
*         (B7) = ORDINAL OF CURRENT DO RELATIVE TO (TS.STN) 
*         (X3) = LINK FIELD TO ITSELF 
*         (X5) = (X6) 
*         (X6) = TAG RETURNED FROM *ISN*
*         (X7) = (B7) 
*         (CDORD) = SET FOR BASE OF DO NEST 
  
 CDI10    BX6    X6+X3
          SA7    CDORD       SET BASE OF DO NEST = ORDINAL
          SA6    B3+B7       RESET TAG ENTRY WITH *DO* LINK.
  
 CDI13    AX5    P.2TAG 
          SA1    STN0R       STATEMENT NUMBER IN 0R FORM
          LX5    P.DOTAG
          BX6    X1 
  
**        IF IN I/O LIST MODE.
*                (X5) = (X6) = L-TAG RIGHT JUSTIFIED. 
* 
*         IF IN NORMAL DO.
*                (X5) = TAG RIGHT JUSTIFIED IN *DOTAG* FIELD. 
*                (X6) = STATEMENT NUMBER IN DPC RIGHT JUSTIFIED.
  
 CDI15    SA6    DOSTNO      SAVE *DO* STATEMENT NUMBER 
          BX6    0
          SA6    IXLASTV     CLEAR LAST INDEX VALUE CELL. 
          =B4    B4-1        POINT TO *INDEX* 
          ALLOC  TP.DO,L.DOE ALLOCATE ROOM FOR NEW *DO*.
          SB7    X2-L.DOE+OR.DOSN 
          LX7    X5 
          SB3    X5 
          SA7    X1+B7       STATEMENT NUMBER TO TP.DO
          ZR     B3,CDI20    IF NOT IN I/O LIST PROCESSING. 
          =X6    O.SLP
          SA6    B4-1        INDICATE TERMINATION OF MATCHING *)*.
          =B4    B4-1 
 CDI20    =X7    M.INT
          SA3    DOARM
          LX7    P.ACM
          BX6    X3 
          SA7    ARGCOMA
          SA6    ARGMODE
          RJ     MXP         MARK EXTERNAL PROCESS
          RJ     PAR         PARSE IT.
          SA2    ERR=F
          =X6                INDICATE NO ERRORS 
          ZR     X2,CDI25    IF NO ERRORS INSIDE DO 
 CDI21    SA3    TP.DO
          SA4    TP=DO
          BX7    0
          IX0    X3+X4
          SA2    X0-L.DOE+OR.DOSN 
          SA7    X0-L.DOE+OR.DORT  INDICATE ERROR IN DO 
          SB7    X2 
          MX6    1           INDICATE ERROR 
          ZR     B7,EXIT.    IF PROGRAM DEFINED *DO*
          SHRINK A4,X4-L.DOE ELIMINATE DO FROM TABLE IF I/O DO
          MX6    1           INDICATE ERROR 
          EQ     EXIT.
  
**        TERMINATE *DO* INITIAL PROCESSING BY ADDING INITIAL *DO*
*         TURPLE TO PARSED FILE.
*         FORM -
*                OR.OPR = O=DOB 
*                OR.1OP = DO INITIAL
*                OR.2OP = DO RETURN TAG 
* 
*                OR.OPR = O=DOB1
*                OR.1OP = DO INDEX
*                OR.2OP = FLAG, INITIALLY SET TO 0. 
  
 CDI25    ALLOC  TT.PAR,2*L.TURP
          SB5    X1          ORGIN OF *TT.PAR*
          SA3    TP.DO
          SA2    TP=DO
          IX0    X3+X2
          BX7    0
          SA4    X0-L.DOE+OR.DOCI 
          =A7    B7-1        OR.2OP = FLAG (INITIAL SET = 0)
          SA3    DO.BEG 
          BX6    X4 
          LX7    X3 
          =A5    A4-OR.DOCI+OR.DORT 
          =A6    A7-1        OR.1OP = CONTROL INDEX 
          LX6    X5 
          =A7    A6-1        OR.OPR = O=DOB1
          =A4    A5-OR.DORT+OR.DOSI 
          =A6    A7-1        OR.2OP = DO RETURN TAG 
          LX7    X4 
          BX6    X3 
          =A7    A6-1        OR.1OP = DO INITIAL
          =A6    A7-1        OR.OPR = O=DOB 
          SA3    X0-L.DOE+OR.DOSN 
          SX7    A6-B5       RELATIVE ADDRESS 
          LX7    P.DFLAG
          IX6    X3+X7
          SA6    A3          SET FLAG CELL TO POINT TO *DO* BEGIN TURPLE
          =X6                INDICATE NO ERROR
          EQ     EXIT.
 CDO      SPACE  4,8
**        CDO -  CLEAR *DO* REGISTER CONDITIONS.
* 
*         ENTRY  FROM PASS *2* ON TERMINATION OF *DO* CONCLUSION CODE.
* 
*         EXIT   BACK TO PASS *2*, CLEARING *B6* REGISTER FROM RGFILE 
*                AND USEFILE. 
  
  
 CDO      =X7    0
          LX3    X4 
          SA7    DOIX        CLEAR *DOIX* 
          SA7    R.B6        CLEAR REGFILE ENTRY
          EQ     NULLOP 
 DIP      EJECT  4,30 
**        DIP -  *PASS 3* PROCESSING FOR A *DO* LOOP. 
* 
*         ENTRY  CALLED WHEN A *O=DOB* *TURPLE* WAS ENCOUNTERED IN
*                PARSED FILE SET DURING PASS *1*
*                *DIP* CHECKS *FLAG* TO DETERMINE WHAT HE CAN DO TO *DO*
*                LOOP COUNTING MECHANISM AND *DO* STRUCTURE.
* 
*         CHECKS
* 
*                FLAG (OR.2OP OF O=DOB1 *TURPLE*) 
*                < 0, *DO* IS EITHER *I/O*, *EXTENDED RANGE*, HAS AN
*                     *EXTERNAL PROCESS* INSIDE BODY, OR REDEFINES
*                     *DO* INDEX. 
* 
*                OUTPUT TURPLE AS DEFINED BY *PDT* DURING PASS *1*. 
* 
*                FLAG > 0, INDICATES *DO* IS CLOSED.
*                IN THIS CASE WE CAN OPTIMIZE *DO* COUNTING MECHANISM.
* 
* 
*         EXIT   DO BEGIN CODE ADDED TO INTERMEDIATE FILE.
  
  
 DIP      SA2    B4+OR.DFLAG
          SA5    B4+OR.1OP
          AX2    P.DFLAG
          =B4    B4+L.TURP
          SB5    X2          SAVE FLAG
          SB2    B0 
          SB7    B0 
          RJ     GST
          ZR     B5,DIP5     IF NOT CLOSED LOOP 
  
*         PROCESS CLOSED LOOP 
  
          SX6    R.B6-RGFILE
          SB6    X6          SAVE REGISTER
          SA5    B4+OR.1OP   *DO* INDEX TAG 
          SA6    DOIX 
          RJ     GST         GET STATUS OF *DO* INDEX 
          ZR     B2,DIP3     IF NOT ACTIVE IN ANOTHER REGISTER
          =X6    0
          SA6    B2+REGFILE  CLEAR OTHER ASSIGNMENT 
 DIP3     =X0    RLOCK
          SX6    B6 
          BX7    X0+X5       OR IN LOCK BIT 
          SA6    A1          INDICATE IN *B* REGISTER 
          SA7    B6+REGFILE  TAG + LOCK BIT + USE COUNT 
          =B4    B4+L.TURP
          EQ     EIS.PNX     NEXT.. 
  
*         PROCESS OPEN LOOP 
  
 DIP5     =X0    M.USTAT
          SB3    R.X6-RGFILE
          BX6    0
          SB2    B0 
          BX7    -X0*X1 
          =A5    B4+OR.1OP   *DO* INDEX TAG 
          =X0    RLOCK
          SA7    A1          INDICATE NOT IN REGISTER 
          BX5    -X0*X5 
          SA6    B3+REGFILE  CLEAR REGFILE
          SA6    DOIX 
          SA6    UUC
          RJ     SDS         SET DELAYED STORE IN MOTION
          =B4    B4+L.TURP
          EQ     EIS.PNX     NEXT.. 
 PDT      EJECT  4,20 
**        PDT -  PROCESS *DO* TABLES. 
* 
*         *PDT* WILL SET UP A *D0* CONCLUSION TURPLE TO BE PROCESSED
*         BY PASS 2, WHEN PARSED FILE IS FINALLY FLUSHED. 
* 
*         ENTRY  IF I/O LIST PROCESSING 
*                (X2) = TABLE FORMAT FOR AN I/O DO. 
*         TABLE FORMAT= 
*                       24/ 0,  18/ 0       18/ L.TAG 
* 
*                IF PROGRAMMER DEFINED *DO* 
*                (X2) = TABLE FORMAT FOR PROGRAMMER DO. 
*         TABLE FORMAT= 
*                       24/ 0,  18/ SN.TAG, 18/ 0 
* 
*         EXIT   DO CONCLUSION SKELETONS ADDED TO PARSED FILE.
* 
*                IF (X2) = A *DO* NUMBER
*                DO CONCLUSION CODE COMPILED. 
* 
*         USES   ALL REGISTERS EXCEPT *B4*
* 
*         CALLS  ADL, CDS, CIR, SSN 
  
  
 PDT      SUBR               ENTRY/EXIT...
  
 SNAP=Q   IFNE   TEST,0      DUMP(TP.DO)
          SA1    CO.SNAP
          LX1    1RN         DO SNAP FLAG 
          PL     X1,PDT1A 
          DUMPT  (TP.DO)
 PDT1A    BSS    0
 SNAP=Q   ENDIF 
  
          BX6    X2 
          SA4    TP=DO
          SA1    TP.DO
          SA6    CDOTG       SAVE STATEMENT TAG (LOWER ORDER) 
          IX2    X1+X4       LWA+1
          MX0    L.DFLAG
          SA3    X2-L.DOE+OR.DOSN 
          BX5    X3-X6       COMPARE TABLE ENTRY TO NUMBER
          SB5    A3-OR.DOSN+OR.DOSI 
          BX2    -X0*X5      ISOLATE TAG ONLY 
          ZR     X2,PDT5     IF NOT ILLEGALLY NESTED DO 
          FATAL  E.DO12 
          EQ     PDT40       CONTINUE CHECK 
  
**        CHECK IF *DO* DEFINITION HAD ERRORS.
*         (B5) = FWA FROM *DO* TABLE FOR CURRENT *DO*.
*         (X3) = CURRENT *DO* ENTRY TAG.
*         (X4) = CURRENT LENGTH OF DO TABLE 
  
 PDT5     SA2    B5+OR.DORT 
          NZ     X2,PDT7     IF NO ERROR IN DO DEFINITION 
          NOTE   E.DO13      DEFINITION ERROR 
          RJ     CLK         CLEAR LINKS
          BX2    X2-X2       *NOT ILLEGALLY NESTED DO* FLAG 
          EQ     PDT40
  
 PDT7     SB7    X3          =0, IN PROGRAMMER DO 
          LX6    X3 
          =X7    0
          NZ     B7,PDT10    IF CURRENT IS AN I/O IMPLIED DO
          BX5    X4 
          RJ     CLK         CLEAR CURRENT DO LINKS 
          BX4    X5 
          =B7    0           INDICATE PROGRAMMER *DO* 
 PDT10    SB3    X4-L.DOE 
          BX7    0
          ZR     B3,PDT15    IF ZERO LENGTH TABLE.
          SA2    B5-L.DOE+OR.DOSN 
          SB2    X2 
          AX2    P.DOTAG
          NZ     B2,PDT15    IF NEXT IS AN I/O IMPLIED DO 
          =X7    X2-C.STAT   ORDINAL OF NEXT DO 
  
**        RESET *DOORD* AND ANALYZE *DO* FOR PASS *1*.
*                (B5) _ START OF CURRENT *DO* IN TP.DO
*                (X7) = NEW *DOORD* FOR DO GOING INTO 
  
 PDT15    SA7    DOORD       RESET *DO* ORDINAL 
          RJ     ADL         ANALYZE *DO* 
  
**        CLEAR *DO* CELLS - CHECK IF MORE THAN ONE *DO* IN NEST. 
  
          MX2    0           *NOT ILLEGALLY NESTED DO* FLAG 
 PDT40    =X6    0
          BX7    0
          SA6    DOLMR       CLEAR DO-LIMIT 
          =A7    A6+1          -   DO-INCREMENT 
          =A6    A7+1          -   DO-INDEX 
          SA4    TP=DO
          =A7    A6+1          -   DO-INDEX REGISTER
          NZ     X2,EXIT.    IF ILLEGAL NEST
          SX6    X4-L.DOE 
          SHRINK A4,X6       RESET LENGTH 
  
**        CHECK IF MORE THAN ONE LOOP TERMINATES ON THIS *DO* NUMBER. 
*         (X6) = CURRENT LENGTH OF DO TABLE 
  
          SA2    CDOTG       CURRENT *DO* TAG.
          SA1    TP.DO
          SB2    X6-L.DOE+OR.DOSN 
          ZR     X6,EXIT.    IF EMPTY TABLE.
          MX0    -L.DOTAG 
          SA3    X1+B2
          LX0    P.DOTAG
          BX3    -X0*X3 
          BX7    X3-X2
          NZ     X7,EXIT.    IF NOT CURRENT *DO* NUMBER.
  
**        NESTING OF *DO* WITH SINGLE TERMINATOR
*         RESET LINK FIELD IN *DO* NUMBER TO ITSELF, CHECKING FIRST IF
*         DO IS PROGRAMMER DEFINED. 
  
          SB7    X3 
          BX4    X6 
          SB5    A3-OR.DOSN+OR.DOSI 
  
          NZ     B7,PDT5     IF IN *I/O* DO 
          BX6    X3 
          SA1    TS.STN 
          AX6    P.DOTAG
          SB2    X6-C.STAT
          =X0    M.SNNS 
          SA2    X1+B2       LOAD NUMBER FROM TS.STN
          BX6    X2+X0
          SA6    A2          INDICATE NUMBER TERMINATES MORE THAN 1 LOOP
          EQ     PDT5        CONTINUE 
  
          LIST   D
          END 
