*DECK     DOPROC
          IDENT  DOPROC 
          TITLE              DOPROC - PASS 1 DO STATEMENT PROCESSOR 
*CALL     SSTCALL 
 B=DOPRC  RPVDEF             DEFINE ROUTINE FWA FOR REPRIEVE UTILITY
          EXT    ERPRO,ERPROI,PH2RETN,FATALER,DOITX,DONEX 
          EXT    DOFLAG,L.LOOP,E.UDEFL,VALUE.,CON.
          EXT    N.TLAB,TRACEL
  
          TABLES DOLST
  
 SYM1     EQU    12B
 SYMEND   EQU    13B
 DIM1     EQU    17B
 CLABEL   EQU    23B
 LTYPE    EQU    21B         STMT TYPE OF OBJECT OF LOGICAL IF
 TYPE     EQU    24B
 SELIST   EQU    32B
 DUKE     EQU    37B               BINARY LINE COUNT
 NRLN     EQU    64B               NEXT R NUMBER
  
 L.DOTAB  EQU    3*50+3            LENGTH OF THE DO TABLE 
 O.DOTAB  VFD    60/DOTAB          ADDRESS OF CURRENT DO TABLE ENTRY
  
          USE    DEBUG
          USE    *
          ENTRY  DOTAB
          USE    DOTAB
 DOTAB    BSSZ   3                 DOPROC MUST BECOME RIGHT BEFORE DPCLO
          USE    *                 BECAUSE THE DO TABLE OVERLAPS IT 
  
 M.LAB    RMEQU  104B        LABEL DEFINITION RMACRO
 M.DOBGN  RMEQU  2           DO BEGIN MACRO 
 M.DOEND  RMEQU  3           DO END MACRO 
 WLABM    EJECT 
 LABM     RMHDR  M.LAB,1           RLIST MACRO HEADER WORD
          BSS    1
 WLABM    SPACE  4,14 
**        WLABM - WRITE LABEL DEFINITION MACRO TO R-LIST FILE.
* 
*         ENTRY  (X5) = IH OF LABEL 
* 
*         CALLS  WRITEW 
* 
*         USES   X - 0, 3, 4, 6, 7
  
  
 WLABM    SUBR   =           ** ENTRY/EXIT ** 
          SA4    LABM 
          SA3    NRLN 
          MX0    -R1.RIL
          LX7    X5 
          BX4    X0*X4
          IX6    X3+X4       ADD CURRENT VALUE OF NRLN
          SA6    A4 
          SB1    1
          SA7    A6+B1
          WRITEW =XF.RLST,A4,2
          SB5    1
          EQ     EXIT.
          EJECT 
*         ERROR MESSAGES
  
 E.DO1    EQU    1                 LOOPS NESTED TOO DEEP
 E.DO2    EQU    2                 BAD DO LABEL 
 E.DO3    EQU    3                 DO LABEL PREVIOUSLY DEFINED
 E.DO4    EQU    4                 CONTROL VARIABLE NOT INTEGER, ETC. 
 E.DO5    EQU    5                 BAD DO STMT SYNTAX 
 E.DO6    EQU    6                 CONSTANT DO PARAM EXCEEDS LIMITS 
 E.DO7    EQU    7                 BAD DO PARAMETER SYNTAX
 E.DO8    EQU    8                 DUPLICATE STMT NUMBER
 E.DO9    EQU    9                 ILLEGAL STMT NUMBER REF
 E.DO10   EQU    10                SAME, BUT BACKWARD 
 E.DO11   EQU    11                ILLEGAL STMT TYPE FOR LOOP TERM
 E.DO12   EQU    12                ILLEGAL NESTING ( UNTERMINATED LOOPS 
 E.DO13   EQU    13                REDEF OF LOOP CONTROL VARIABLE OR PAR
 E.DO14   EQU    226               MAY REDEFINE CV OR INDEX 
 E.DO16   EQU    16                ILLEGAL ENTRY TO A LOOP
 E.DO17   EQU    17                UNDEFINED STMT LABEL(S), SEE BELOW 
 E.DOMUL  EQU    18                MISUSE OF A LABEL
 E.DO19   EQU    19                NEED MORE STORAGE FOR OPTIMIZATION 
 E.DO20   EQU    20                DO N  I = 1,I
 E.DO21   EQU    21                COMPILER ERROR 
 E.DO22   EQU    22                LOWER LIM .GE. UPPER LIM, 1-TRIP LOOP
 E.DO24   EQU    105               FMT IS AN ILLEGAL TERMINATOR 
 E.DO80   EQU    80                LABEL MORE THAN 5 CHARACTERS 
 E.DO130  EQU    130               0 STMT LABEL 
E.DO305   EQU    305         OBJECT OF LOG IF IS DO TERMINAL--NON-ANSI
 E.DOEXT  EQU    306               NON-INNER LOOP ENTERED FROM OUTSIDE
 E214     EQU    214
 E.DO154  EQU    154         REDEFINITION OF FPS IS NON-ANSI
          SPACE  3
*** 
*         "DOPROC" MANIPULATES 2 TABLES, "DOTOP" AND "DOLIST" . 
* 
*         "DOTAB" IS THE DO LOOP INFORMATION TABLE WHICH IS 3 
*         WORDS/ENTRY AND HAS ROOM FOR 50 ENTRIES ( THE NESTING 
*         LEVEL OF THE COMPILER ).  THE FORMAT OF AN ENTRY FOR THE
*         DO STATEMENT  "DO  S  IX  =  B,C,D"  IS:  
* 
*         12/S,30/0,18/B
*         12/IX,12/0,18/P,18/C
*         12/GL,20/0,3/CV(BCD),7/EXIMVJR,18/D 
* 
*         GL IS THE ORDINAL FOR THE LABEL ( ")XX" ) GENERATED FOR THE 
*         TOP OF THE LOOP.  P IS AN ORDINAL INTO "DOLIST" . 
*         THE CV BITS ARE SET IF THE CORRESPONDING ENTRY IS A VARIABLE
*         EXIMVJR ARE OPTIMIZATION FLAGS
* 
*         "DOLIST" IS A VARIABLE LENGTH LIST STARTING AT "DO1" IN 
*         WORKING STORAGE. EACH ENTRY IN DOLIST IS A SINGLE WORD
*         THE FOLLOWING ITEMS ARE KEPT TRACK OF:  
*         VARIABLE DEFINITIONS, FORMAT- 1/1,29/0,12/BASE,18/BIAS
*         REFERENCES TO LABELS, FORMAT:  60/SYMTAB ORDINAL
* 
  
          EJECT 
*         DEFINE WITH VALUE MACRO.
  
          MACRO  DEFINV,N,LONG,RESET
 N        DEFINE LONG,RESET 
          IFLE   ".P"N_P,21,1 
 ".P"N_V  BIT    ".P"N_P
 DEFINV   ENDM
          SPACE 2 
*         DOTAB DESCRIPTORS.
  
          DESCRIBE D1.,60    WORD 1 
 S        DEFINE 12          DO OBJECT-LABEL ORDINAL
 LC       DEFINE 18          LOOP COUNTER  ( 2*L.LOOP ) 
 OT       DEFINE 1           SET IF A ONE-TRIP LOOP 
          DEFINE 11 
 B        DEFINE 18          DO UPPER LIMIT 
  
          DESCRIBE D2.,60    WORD 2 
 IX       DEFINE 12          CONTROL VARIABLE 
          DEFINE 12 
 P        DEFINE 18          ORDINAL IN DOLIST
 C        DEFINE 18          DO LOWER-LIMIT 
  
          DESCRIBE D3.,60    WORD 3 
 GL       DEFINE 12          )XX ORDINAL
          DEFINE 20 
 CV       DEFINE 3           /B,C,D ARE VARIABLE/ FLAGS 
 OF       DEFINE 7           OPTIMIZATION FLAGS 
 D        DEFINE 18          INCREMENT ORDINAL
  
          DESCRIBE CV.,3     SET IF VARIABLE
 B        DEFINV 1           LOWER LIMIT
 C        DEFINV 1           UPPER LIMIT
 D        DEFINV 1           INCREMENT
  
          DESCRIBE OF.,7
 E        DEFINV 1           LOOP CONTAINS POSSIBLE ENTRY 
 X        DEFINV 1           LOOP CONTAINS POSSIBLE EXIT
 I        DEFINV 1           NON-INNER LOOP 
 M        DEFINV 1           MATERIALIZE IX 
 V        DEFINV 1           DO S I=1,N,I 
 J        DEFINV 1           EXTERNAL REFERENCE 
 R        DEFINV 1           INHIBIT OPTIMIZATION 
          TITLE              MACROS 
*** 
*         PSYM - PREPARE NAME FOR ERROR ROUTINE 
* 
*         ON ENTRY: 
*                X2 = SYMTAB ORDINAL
* 
*         ON EXIT:  
*                X3 = FORMATTED SYMBOL
*                X4 = 0 
* 
 PSYM     ENTRY.
          SA1    SYM1 
          LX2    1                 2*ORDINAL
          IX5    X1-X2
          SA4    X5                WORD A 
          MX0    L.NAME 
          BX1    X0*X4       EXTRACT SYMBOL 
          RJ     =XSTRIP     STRIP OFF TRAILING $ 
          LX1    60-12
          SX2    1R 
          PL     X4,PSYM1          IF A NAME
          SX4    1R.-1R 
          LX4    42 
          IX3    X1-X4       CHANGE . TO A BLANK
          SX2    2R 
  
 PSYM1    MX4    0                 CLEAR X4 
          BX3    X1+X2       ADD BLANK FILL 
          EQ     PSYM 
          SPACE  3
 ERNAME   MACRO  ORD
          IF     REG,ORD
          IFC    NE,/ORD/X2/,1
          SX2    ORD
          ELSE
          SA2    ORD
          ENDIF 
          RJ     PSYM              PREPARE SYMBOL FOR ERROR ROUTINE 
          ENDM
  
 LABCON   MACRO                    CONVERT LABEL AND ENTER IN SYMTAB
          SB7    *+2-*P/60D 
          EQ     LABCON 
          ENDM
          TITLE              DOPROC - PROCESS DO STMT 
*** 
*         DOPROC - DO STATMENT PROCESSOR
*         CHECK STATEMENT FOR A VALID STMT NUMBER,
*         CALL "DOTOP" TO PROCESS THE REST OF THE STATEMENT 
* 
  
 DOPRA    BSSZ   1           *LABEL PREVIOUSLY DEFINED* FLAG
  
 DOPROC   SUBR   =                 ** ENTRY/EXIT ** 
          SA3    SELIST 
          SA4    X3                (X4)=1ST ELIST ELEMENT 
          UX2    B2,X4
          NE     B2,B0,DOPR.E1     IF NOT A CONSTANT (LABEL)
          SA1    X2                (X1)=1ST WORD OF *CONSTOR* ENTRY 
*                                  FOR LABEL
          AX4    18 
          SB1    X4+               (B1)=NR OF CHARS IN LABEL
          LABCON                   CONVERT LABEL AND PUT IN SYMTAB
  
          SX0    T.LAB
          LX0    P.TYP             SET TYPE TO LABEL
          BX2    X0+X2
  
+         BX3    X2 
          LX3    59-P.DSN 
          SX7    B1 
          LX7    D1.SP
          SA7    LWD             STORE FOR DO TOP 
  
          MX5    2
          BX7    X5*X3           EXTRACT DSN + DFN BITS 
          LX3    1
          BX5    X5*X3           EXTRACT DFN + RFN BITS 
          BX7    X7+X5
          SA3    SELIST 
          SA7    IH              SAVE IN CASE OF CALL TO ERPRO
          SA4    X3 
          PL     X7,DOPROC2        IF LABEL NOT PREVIOUSLY DEFINED
          SA7    DOPRA       SET *LABEL PREVIOUSLY DEFINED* FLAG
          POSTER SEV=FE,NR=E.DO3,FMT=ELIST,TXT=X4,RETURN=DOPROC2
  
DOPROC2   SA5    IH 
          SA3    SELIST 
          IX6    X5+X5
          SA4    X3 
          PL     X6,DOPROC2A       IF DO NOT TERMINATED BY FORMAT STMT
          POSTER SEV=FE,NR=E.DO24,FMT=ELIST,TXT=X4,RETURN=DOPROC3 
 DOPROC2A MI     X5,DOPROC3        IF LABEL PREVIOUSLY DEFINED
          SX0    B5 
          LX0    P.DLT             SET DO LOOP TERMINATOR BIT 
          BX6    X0+X2
          SA6    A2 
 DOPROC3  SA5    =XRSELECT
          SA4    LWD
          ZR     X5,DOPROC1        IF R = 0 
          LX4    -D1.SP 
          SB1    X4 
          ADDREF B1,REF            A REFERENCE FOR THE LABEL
  
 DOPROC1  RJ     DOTOP       SETUP THE TOP OF THE LOOP
          EQ     DOPROC 
  
 DOPR.E1  POSTER SEV=FE,NR=E.DO2,FMT=ELIST,TXT=X4,RETURN=DOPROC 
          SPACE  2
*         TEMPORARIES ASSOCIATED WITH DOTOP,DOPROC,GENMAC,LIMIT, ETC. 
  
          USE    /MACBUF/ 
 SVELIST                           HOLDS SELIST WHEN PROC AN IMPLIED DO 
 LWD                               HOLDS THE FIRST WORD OF THE DOTAB
*                                  ENTRY TO BE FORMED 
 IH 
 CVAR                              USED TO SAVE THE ORDINALS OF THE 
          BSS    3                 LOOP CV AND LIMITS 
  
 RLSST    BSSZ   7                 R LIST MACRO BUFFER
          USE    *
  
 OTF      BSS    1           ONE-TRIP LOOP FLAG 
          TITLE              DOTOP - SET UP TOP OF DO LOOP
*** 
* 
*         DOTOP - PROCESS DO STMT AND FORM "DOTABLE" ENTRY FOR IT.
*         CALLS GENMAC TO GENERATE AN RLIST MACRO FOR THE TOP OF THE LOO
* 
 DOTOPX   SB7    *+1               ** ERROR EXIT ** 
          EQ     ERPRO
  
 DOTOPX1  SA1    LWD
          MX6    0
          SA6    DOPRA       DOPRA = 0
          SX2    X1 
          ZR     X2,DOTOP          IF WE DIDNT ADD AN ENTRY 
          SA2    DOFLAG 
          SX6    X2-1              DECREMENT DO NEST LEVEL
          SA6    A2 
          SA3    O.DOTAB
          SX7    X3-3              DECREMENT DO STACK POINTER 
          SA7    A3 
  
 DOTOP
          RJ     SYNCHEK           GO DO SYNTAX CHECK 
          SX0    B5 
          LX0    D3.OFP+OF.IP      I-BIT
          SA2    O.DOTAB           DO TABLE ADDRESS 
          SA3    X2+2              WORD 3 
          BX6    X0+X3             SET I BIT
          SA6    A3 
          SA5    SELIST 
          SA2    X5-1              FETCH SECOND ELEMNT
          RJ     INTVAR            GO CHECK FOR INTEGER VARIABLE
          SB6    -E.DO4            CV NOT AN INTEGER VARIABLE 
          EQ     DOTOPX 
  
          SX0    V.DEF
          BX6    X0+X1
          SA6    A1                SET DEFINED BIT
          SX0    V.EQU
          BX6    X0*X1
          LX1    59-P.COM 
          PL     X1,DOTOP0   IF COM BIT NOT SET 
          LX7    -P.RB
          MX0    -L.RB
          BX7    -X0*X7      NOT REALLY IN COMMON IF RB = 0 
          IX6    X6+X7
 DOTOP0   SA6    RLSST
  
          SX6    B1 
          SA6    CVAR              SAVE THE CONTROL VARIABLE
          MX7    0
          SA7    A6+B5             CLEAR OUT VARIABLE ORDINALS
          SA7    A7+B5
          SA7    A7+B5
  
*         FORM SECOND WORD OF ENTRY:  12/IX,12/0,18/P,18/C
  
          SA2    O.DOTAB
          SX4    B1 
          LX4    D2.IXP      ORDINAL OF CV
          SA3    L.DOLST
          LX3    D2.PP       ORDINAL IN DOLIST
          MX7    0
          SA7    =XNCAD 
          SA7    =XNRFD 
          BX7    X3+X4
          SA7    X2+4              STORE ORD OF CV ( IX ) AND P ORD 
          SA2    A1-1        GET WORD B 
          LX2    59-P.FPB 
          PL     X2,DOTOP0A  IF NOT FP
          LX2    P.FPB-P.RL 
          PL     X2,DOTOP0A  IF NOT RL
          SA1    A1          GET WORD A 
          MX3    L.NAME 
          BX3    X3*X1       EXTRACT SYMBOL 
          LX3    60-12
          SX5    1R 
          BX3    X3+X5       ADD BLANK FILL 
          POSTER SEV=ANSI,NR=E.DO154,FMT=DPC,TXT=X3 
 DOTOP0A  BSS    0
          RJ     DODEF             GO CHECK LOOP VARIABLE AND PUT IN DOL
  
          SA1    RLSST
          ZR     X1,DOTOP1   IF CV NOT COM OR EQV 
  
          POSTERR  SEV=INF,NR=301D  CV COM/EQV, OPTIMIZATION INHIBITED
  
 DOTOP1   SA4    O.DOTAB
          SX6    X4+3 
          SX7    X6-DOTAB-L.DOTAB 
          SB6    -E.DO1            TOO MANY DO LOOPS
          PL     X7,DOTOPX         IF NESTING LIMIT EXCEEDED
  
          SA6    A4                UPDATE TABLE POINTER 
          SA1    DOFLAG 
          SX7    X1+B5             INCREMENT LEVEL OF NESTING 
          SA7    A1 
  
          SA1    LWD               DO LABEL ORDINAL 
          BX7    X1 
          SA7    X6                STORE IN WORD 1
          MX7    0
          SA7    A7+2              CLEAR WORD 3 
          SX7    B5 
          SA7    A1                SET ENTRY ADDED FLAG 
 #DAL     IFNE   .DAL,0      .NZ. IF LCM DIRECT ACCESS ALLOWED
  
*         INHIBIT OPTIMIZATION IF CV IS LEVEL 2.
  
          SA1    CVAR 
          RJ     IOL
  
 #DAL     ENDIF 
  
*         PROCESS DO LIMITS AND FORM A DO TABLE ENTRY 
  
          SA5    SELIST 
          SA2    X5-3              E LIST FOR LOWER LIMIT 
          RJ     LIMIT             CHECK LIMIT FOR CONSTANT OR VARIABLE 
          EQ     FC2               CONSTANT 
  
          SA3    O.DOTAB
          SX2    B5 
          LX2    D3.CVP+CV.BP      LL IS VARIABLE 
          SA4    X3+2 
          BX7    X2+X4
          SA7    A4 
  
 #DAL     IFNE   .DAL,0      .NZ. IF LCM DIRECT ACCESS ALLOWED
          SA1    IH 
          RJ     IOL         CHECK FOR LEVEL 2 LL 
 #DAL     ENDIF 
  
  
          SA2    IH                ORDINAL
          BX6    X2 
          SA6    CVAR+1            SAVE FOR THE REFERENCE MAP 
          RJ     NAME 
          SB6    B1 
          SB7  B2 
          SA2  CVAR 
          RJ   NAME 
          NE     B1,B6,FC2         IF THE INITIAL VALUE IS NOT THE SAME 
          NE     B2,B7,FC2         THE INCREMENT
* 
          SB6    E.DO13            * REDEFINES LOOP CONTROL VARIABLE* 
          SB7  FC2
          ERNAME X2 
          EQ   ERPROI 
  
 FC2      SA2    IH                LOAD IH VALUE
          SA3    O.DOTAB
          SA4    X3                WORD 1 
          BX6    X4+X2
          SA6    X3                ADD B FIELD
  
*         PROCESS SECOND DO PARAMETER ( UPPER LIMIT ) 
  
          SA5    SELIST 
          SA2    X5-5              E LIST FOR THE UPPER LIMIT 
          RJ     LIMIT             CHECK UPPER LIMIT
          EQ     IHTC              GO PUT IH INTO C FIELD 
  
          SA3    O.DOTAB
          SA4    X3+2              THIRD WORD OF ENTRY
          SX0    B5 
          LX0    D3.CVP+CV.CP 
          BX6    X0+X4             SET CV(B) BIT
          SA6    A4 
  
 #DAL     IFNE   .DAL,0      .NZ. IF LCM DIRECT ACCESS ALLOWED
          SA1    IH 
          RJ     IOL         CHECK FOR LEVEL 2 UL 
 #DAL     ENDIF 
  
  
*         CHECK FOR UPPER LIMIT = CONTROL VARIABLE
  
          SA2    IH                ORDINAL
          BX6    X2 
          SA6    CVAR+2            SAVE FOR THE REF MAP 
          RJ     NAME 
          SB6    B1 
          SB7    B2                SAVE THE BASE AND BIAS 
          SA2    CVAR 
          RJ     NAME 
          NE     B1,B6,IHTC        IF NOT THE SAME BASE 
          NE     B2,B7,IHTC        IF NOT THE SAME BIAS 
  
          SA3    O.DOTAB
          SX0    OF.MV+OF.VV
          SA4    X3+2              WORD 3 
          LX0    D3.OFP 
          BX6    X0+X4             SET M AND V BITS 
          SA6    A4 
  
          SB6    E.DO20            DO N I = 1,I 
          SB7    IHTC 
          ERNAME X2                PREPARE SYMBOL 
          EQ     ERPROI 
  
 IHTC     SA4    IH 
          SA5    O.DOTAB
          SA3    X5+B5             WORD 2 
          BX6    X3+X4             ADD IH IN LOWER 18 BITS
          SA6    A3 
  
*         CHECK FOR THIRD PARAMETER 
  
          SA1    SELIST 
          SA2    X1-6              CHECK FOR THIRD PARAM
          UX3    B1,X2
          SB2    B1-EL.COMMA
          ZR     B2,DOTOP3         IF A COMMA 
  
          SA4    X5+2              WORD 3 
          SX0    B5                SET 1 AS LOOP INCREMENT
          BX6    X0+X4
          SA6    A4 
          EQ     DOTOP4            GO CHECK FOR LL @ UL 
  
*         PROCESS THIRD PARAMETER 
  
 DOTOP3   SA2    A2-B5             LOAD INCREMENT 
          RJ     LIMIT             GO CHECK LIMIT 
          EQ     IHD               CONSTANT 
  
          SA5    O.DOTAB
          SA4    X5+2              THIRD WORD 
          SX3    B5 
          LX3    D3.CVP+CV.DP 
          BX6    X3+X4
          SA6    A4 
  
 #DAL     IFNE   .DAL,0      .NZ. IF LCM DIRECT ACCESS ALLOWED
          SA1    IH 
          RJ     IOL         CHECK FOR LEVEL 2 INC
 #DAL     ENDIF 
  
  
          SA3    IH 
          SA1    CVAR              ORD OF THE CONTROL VARIABLE
          BX6    X3 
          SA6    CVAR+3            SAVE ORDINAL FOR THE REFERENCE MAP 
          IX7    X3-X1
          NZ     X7,IHD            IF CVAR .NE. INCREMENT 
  
          SB6    E.DO13            * REDEFINES LOOP CONTROL VARIABLE* 
          SB7  IHC
          ERNAME X3 
          EQ   ERPROI 
* 
 IHC      SA5    O.DOTAB           RESTORE REGISTERS AFTER ERPRO
          SA1    X5+2 
          BX6  X1 
          SA6  A1 
          SX0    CV.BV+CV.CV
          LX0    D3.CVP 
          BX7    X0*X6
          NZ     X7,SETFLAGS       IF B OR C IS A VARIABLE
  
          SA1    X5                WORD 1 
          SA2    X5+B5             WORD 2 
          SX1    X1                LOWER LIMIT
          SX2    X2                UPPER LIMIT
          LX1    1                 2*LL 
          IX7    X1-X2
          ZR     X7,IHD            IF 2*LL = UL 
  
 SETFLAGS SX0    OF.MV+OF.VV
          LX0    D3.OFP 
          BX6    X0+X6             SET V AND M BITS 
          SA6    A6 
  
 IHD      SA1    IH                ORDINAL OR CONSTANT
          SA5    O.DOTAB
          SA4    X5+2              WORD 3 
          BX6    X4+X1             ADD INCREMENT
          SA6    A4 
  
*         (X5) = (O.DOTAB) , (X4) = WORD 3 OF CURRENT LOOP
  
 DOTOP4   LX4    59-D3.CVP-CV.CP
          MX7    0
          SA7    OTF         OTF = 0
          MI     X4,DOTOP4A  IF UL IS A VAR 
          SA2    X5+B5       WORD 2 
          SB2    X2 
          EQ     B2,B5,DOTOP1T     IF UL = 1
          LX4    CV.CP-CV.BP
          MI     X4,DOTOP4A  IF LL IS A VAR 
          SA1    X5          WORD 1 
          SB3    X1 
          LT     B3,B2,FC4   IF LL < UL 
          EQ     DOTOP1T
  
*         UL AND/OR LL VARIABLE - CHECK FOR LL=UL 
  
 DOTOP4A  SA4    X5+2        WORD 3 
          MX0    -2 
          LX4    -D3.CVP-CV.CP
          BX7    X0+X4
          NZ     X7,FC4      IF LL AND UL NOT BOTH VARS 
          SA2    X5          WORD 1 
          SA1    X5+B5       WORD 2 
          SB3    X2 
          SB4    X1 
          NE     B3,B4,FC4   IF B"C 
  
*         ONE-TRIP DO LOOP
  
 DOTOP1T  SX7    1
          SA7    OTF         OTF = 1
          POSTERR NR=E.DO22,SEV=INF 
          SA5    O.DOTAB
  
*         STORE LOOP TABLE INDEX IN DOTAB 
  
 FC4      SA2    DOPRA
          NZ     X2,DOTOPX1  IF LABEL PREVIOUSLY DEFINED
          SA3    OTF
          SA2    L.LOOP      NUMBER OF LOOPS
          LX3    D1.OTP 
          SA1    X5          WORD 1 
          LX2    D1.LCP+1 
          BX0    X2+X3
          IX6    X0+X1       SET LC AND OTF 
          LX2    -D1.LCP-1
          SA6    A1 
  
*         GENERATE A LABEL FOR THE TOP OF THE LOOP
  
          SA1    =8R)AA 
          SX6    X2+B5             INCREMENT
          MX0    60-5              -37B 
          SA6    A2 
          BX3    -X0*X2            CONVERT LOOP NUMBER TO DISPLAY CODE
          BX4    X0*X2
          LX4    1
          BX5    X4+X3
          LX5    48-18
          IX1    X5+X1
          SB7    LABRTN      RETURN  ADDRESS
          EQ     =XLABEL     ENTER LABEL INTO SYMBOL TABLE
  
 LGEN     BIT    P.TYP-P.GEN
 LABRTN   SX3    T.LAB*LGEN+1 
          EQ     SLI2 
  
 ER21A    SB6    -E.DO21           COMPILER ERROR ( TOO MANY LOOPS )
          EQ     FATALER
  
 SLI2     LX3    P.GEN
          SA4    DUKE 
          LX4    P.TTLN 
          BX6    X2+X3             ADD TYPE AND G BIT 
          SA5    OTF
          IX7    X6+X4       ADD LINE NUMBER
          LX5    P.FLG+OF.RP       SET R BIT IF 1 TRIP LOOP 
          BX6    X5+X7
          SA6    A2                STORE IN SECOND WORD 
          SX6    B1 
          SA6    LABM+1            SAVE ORDINAL FOR RLIST MACRO 
  
          SA3    O.DOTAB
          SA4    X3+2              WORD 3 
          LX6    D3.GLP 
          BX6    X6+X4             ADD ORDINAL TO DOTAB ENTRY 
          SA6    A4 
  
*         ADD REFERENCES TO THE VARIABLES TO RMAP 
  
          SA5    RSELECT
          ZR     X5,DOTOP6         IF R = 0 
          ADDREF CVAR,DEF          A DEFINITION FOR THE LOOP INDEX
 X        SET    0
          DUP    3
 X        SET    X+1
+         SA1    CVAR+X 
          ZR     X1,*+2            REFERENCES FOR THE 
          ADDREF X1,REF            LOOP LIMITS
          ENDD
  
 DOTOP6   SB2    -M.DOBGN 
          RJ     GENMAC            GENERATE MACRO FOR TOP OF DO 
          SA4    OTF
          SA5    LABM+1 
          ZR     X4,DOTOP7   IF NOT A 1 TRIP LOOP 
          MX5    0
 DOTOP7   CALL   WLABM       )XX LABEL DEF TO RLIST 
          EQ     DOTOP
          SPACE  3
*** 
*         SYNCHEK - SYNTAX CHECK A DO STATEMENT 
* 
 SYNCHEK
          SA1    SELIST 
          SB1    -2 
          SA2    X1+B1             E(2) = EC(=) 
          UX3    B2,X2
          SB3    B2-EL.=
          NZ     B3,ER5            IF NOT AN = S SIGN 
  
          SA5    LWD
          SB6    EL.EOS 
          SB7    EL.EOS 
          NZ     X5,SYNCHEK1       IF A DO STMT 
          SB6    EL.)              FOR AN IMPLIED DO
          SB7    EL.S)             SPECIAL PAREN
  
 SYNCHEK1 SA2    A2+B1             FIRST COMMA
          SB4    EL.COMMA 
          UX3    B2,X2
          NE     B2,B4,ER5         IF NOT A COMMA 
          SA2    A2+B1             E(6) 
          UX3    B2,X2
          NE     B2,B4,SYNCHEK2    IF NOT A COMMA 
          SA2    A2+B1
          UX3    B2,X2
  
 SYNCHEK2 EQ     B2,B6,SYNCHEK     EXIT IF EOS OR ) 
          EQ     B2,B7,SYNCHEK
  
 ER5      SB6    -E.DO5            DO STMT SYNTAX ERROR 
          EQ     DOTOPX 
          EJECT 
*** 
*         INTVAR - CHECK FOR INTEGER VARIABLE, ENTER NAME IN SYMTAB 
* 
*         ON ENTRY: 
*                X2 = ELIST ELEMENT 
* 
*         ON EXIT:  SYMTAB ORDINAL IN "IH"
* 
 INTVAR   ENTRY.
          UX1    B2,X2             UNPACK 
          NE     B2,B5,INTVAR      EXIT IF NOT A VARIABLE 
          SYMBOL
          EQ     INTVAR2
  
          NE     B1,B5,INTVAR0     IF NOT ORDINAL 1 
          SA1    VALUE. 
          ZR     X1,INTVAR         IF NOT A FUNCTION
          SB1    X1 
          SB2    B1+B1
          SA1    A0-B2
          SA2    A1-B5
  
 INTVAR0  SX0    V.FUN
          BX3    X0*X1
          LX4    X2 
          NZ     X3,INTVAR         ERROR IF FUNCTION OR DIMENSIONED 
          LX4    59-P.EXT 
          NG     X4,INTVAR         OR IF AN EXTERNAL
  
 INTVAR1  SX0    B5 
          LX0    P.VAR
          BX7    X0+X2             SET VAR BIT
          SA7    A2 
          AX2    P.TYP
          SX3    X2-T.INT 
          SB2    -1          LISTIO FLAG SUBSCRIPT PROCESSING 
          NZ     X3,INTVAR         ERROR IF NOT TYPE INTEGER
          SX0    V.DIM
          BX3    X0*X1
          ZR     X3,INTVAR3 
          POSTER SEV=ANSI,NR=E214 
 INTVAR3  BSS    0
  
          SA3    INTVAR 
          AX3    30 
          SB7    X3+B5
          JP     B7                SUCCESS EXIT 
  
*         FIRST OCCURRENCE - SET TYPE.
  
 INTVAR2  IX2    X6+X2             SET TYPE 
          ZR     X7,INTVAR1        IF NO PREVIOUS USE IN A DEBUG STMT 
          CFO    VAR               CHECK SETTING OF DEBUG BITS
          EQ     INTVAR1
          TITLE              LIMIT
*** 
*         LIMIT - CHECK LOOP LIMITS AND DETERMINE IF
*         CONSTANT OR VARIABLE
* 
 LIMIT
          UX3    B4,X2             SEPERATE EXPONENT FOR CHECKING 
          ZR     B4,CONEB          IF A CONSTANT
  
          RJ     INTVAR            GO SEE IF INTEGER VARIABLE 
          SB6    E.DO7
          EQ     ER7               NOT AN INTEGER VARIABLE
  
          SX7    B1 
          SA7    IH                PRESERVE ORDINAL OF VARIABLE 
  
          SA2    LIMIT             PICK UP RETURN LINKAGE 
          AX2    30 
          SB7    X2+B5
          JP     B7 
  
 ER7      ERNAME B1                NOT A CONSTANT OF VARIABLE 
          EQ     DOTOPX 
  
*         CHECK CONSTANT AND CONVERT TO BINARY
  
 CONEB    AX3    45                POSITION TYPE FIELD
          BX4    X2 
          SX5    X3-T.INT 
          ZR     X5,CONEB1         IF TYPE INTEGER
          SX5    X3-T.OCT 
          SB6    E.DO7             BAD DO LIMIT 
          MI     X5,DOTOPX         ERROR IF NOT TYPE OCTAL OR HOLLERITH 
  
 CONEB1   SB1    -B5
          BX1    X2 
          CALL   CONVERT
          BX6    X1 
          SX5    377777B
          IX1    X1-X5
          SA6    IH 
  
          PL     X1,ER6      IF INDEX EXCEEDS 131,070 
          NZ     X6,LIMIT          EXIT IF NOT ZERO 
  
 ER6      SX6    B5 
          SA6    A6                IH = 1 
          SB6    -E.DO6 
          SB7    LIMIT
          EQ     ERPRO
 IOL      EJECT 
**        IOL - INHIBIT OPTIMIZATION IF CV, LL, UL OR INC IS LEVEL 2. 
* 
*         ENTRY  (X1) = ORD OF VAR BEGIN CHECKED
* 
*         SETS R-BIT IN DOTAB WORD 3. 
  
  
 #DAL     IFNE   .DAL,0      .NZ. IF LCM DIRECT ACCESS ALLOWED
 IOL      ENTRY. *
          SA3    =XLEVEL2 
          ZR     X3,IOL      IF NO LEVEL 2 STATEMENTS 
          SB1    X1 
          SA1    SYM1 
          SB2    B1+B1
          SA2    X1-1 
          SA1    A2-B2       (X1) = SYMTAB WORD 2 
          MX0    -L.LVL 
          LX1    -P.LVL 
          BX4    -X0*X1      LEVEL
          SB7    X4-2 
          NZ     B7,IOL      IF LEVEL .NE. 2
          SA3    O.DOTAB
          SX0    B5 
          SA2    X3+2        (X2) = DOTAB WORD 3
          LX0    D3.OFP+OF.RP 
          BX6    X0+X2
          SA6    A2          SET R BIT
          EQ     IOL
 #DAL     ENDIF 
  
          TITLE              GENMAC - GENERATE RLIST MACROS 
**        GENMAC - GENERATE DO BEGIN/END MACROS FOR A LOOP
* 
*         ENTRY  (B2) = -(MACRO OPCDOE) 
  
 GENMAC   ROUTINE 
          SA5    O.DOTAB           A5,X5 ADDRESS OF DOTAB ENTRY 
          SA4    X5+2              WORD 3 
          MX0    D3.GLL 
          BX7    X0*X4
          LX7    D3.GLL      ORDINAL OF )XX 
          LX4    59-D3.CVP-CV.BP
          BX0    X4                SAVE CV(BCD) IN X0 
          MX6    D3.CVL 
          BX1    X6*X4
          LX1    D3.CVL+18
          SX3    6
          LX3    R1.INP 
          BX1    X1+X3
          PX6    B2,X1       12/P(-OC),18/WDS,12/CV(BCD),18/0 
          SA6    RLSST             STORE HEADER WORD
  
          SA1    X5                WORD 1 
          RJ     GET
          LX6    30                POSITION IH
          BX6    X6+X7
          SA6    A6+B5             WORD 1 IH(B),30/IH(L)
          BX7    X2                SAVE CA(B) 
  
          SA1    X5+B5             WORD 2 OF DOTAB ENTRY
          RJ     GET
          SA6    A6+B5             STORE
          NZ     X6,GENMAC1        IF C IS A VARIABLE 
  
          SX2    X2+B5             C+1
          MX3    42 
          BX4    -X2
          BX2    -X3*X4            -(C+1) 
 GENMAC1  LX2    18 
          BX7    X2+X7             CA(C),CA(B)
  
          SA1    X5+2              WORD 3 OF DOTAB ENTRY ( INCREMENT )
          RJ     GET
          SA3    A6                GET WORD 3 OF MACRO
          LX6    30 
          BX6    X6+X3             IH(D),IH(C)
          SA6    A6 
          LX2    36 
          BX7    X2+X7             CA(D),CA(C),CA(B)
  
          SA1    X5+B5             WORD 2 
          MX0    D2.IXL 
          BX2    X0*X1             EXTRACT ORD OF CV
          LX2    D2.IXL 
          RJ     NAME              GET BASE BIAS OF CONTROL VARIABLE
          SA1    NRLN              NEXT R NUMBER
          SX6    B1                BASE 
          SA6    A6+B5             WORD 3 
  
*         STORE INFO IN WORD 4 OF RLIST MACRO FOR LOOP MAP
  
          SA5    A5 
          MX0    D1.SL
          SA3    X5                WORD 1 
          LX2    48 
          BX4    X0*X3       ORD OF STMT LABEL
          LX4    D1.SL+36 
          BX0    X2+X4
          LX3    -D1.LCP
          IX6    X0+X1       12/ORD(CV),12/ORD(LABEL),18/LPCNT,18/NRLN
          SX3    X3 
          LX3    18 
          BX6    X3+X6
          SA6    A6+B5       STORE WORD 4 
          SA7    A6+B5             WORD 5 = CA(D) , CA(C) , CA(B) 
          SX6    B2                CA OF CVAR 
          SA6    A7+B5
          SX6    X1+B5             NRLN+1 
          SA6    A1 
          WRM    RLSST             DO BEGIN/END MACRO TO RLIST
          EQ     GENMAC 
          SPACE  3
*** 
*         GET - GET IH AND CA FIELDS FOR GENMAC 
* 
*         EXIT:  X2 = CA   ,  X6 = IH 
* 
 GET
          SX2    X1                X2 = CA
          MX6    0                 X6 = IH
  
          PL     X0,GET1           IF NOT A VARIABLE
          RJ     NAME 
          SX6    B1                BASE 
          SX2    B2                BIAS 
          SA5    A5                RESTORE DO TABLE ADDRESS 
  
 GET1     LX0    1                 POSITION NEXT BIT
          EQ     GET
          TITLE              NAME - GET BASE/BIAS FOR SYMTAB ENTRY
*** 
*         NAME - CHECK FOR AN EQUIVALENCED VARIABLE 
*         RETURNS THE BASE AND BIAS OF A VARIABLE 
* 
*         ON ENTRY: 
*                X2 = SYMTAB ORDINAL
* 
*         ON EXIT:  
*                X2 = ORDINAL OF ORIGINAL ( UNTOUCHED ) 
*                B1 = ORDINAL OF BASE MEMBER
*                B2 = BIAS
* 
*         USES X1 - X5 , A1,A3,A4  ** DO NOT CHANGE, MANY SUBROUTINES 
*                                  DEPEND ON THIS FACT ** 
* 
 NAME     ENTRY. *
          SA1    SYM1 
          SB1    X2                B1 = ORDINAL 
          LX5    B5,X2             2*ORD
          IX4    X1-X5
          SA1    X4          WORD A 
          SB2    B0 
          LX1    59-P.EQU 
          PL     X1,NAME     IF NOT EQUIVALENCED
          SA3    A1-B5       WORD B 
          MX5    -L.DIMP
          LX3    -P.DIMP
          BX5    -X5*X3      DIMP 
          SA1    DIM1 
          LX5    1
          IX3    X1+X5
          SA4    X3                FETCH DIM ENTRY
          AX4    18 
          SB2    X4                B2 = CA
          AX4    18 
          SB1    X4 
          EQ     NAME 
          TITLE              DODEF - VARIABLE DEFINITION
*** 
*         DODEF - VARIABLE DEFINITION IN AN ASSIGNMENT STMT 
*         CHECK FOR REDEFINITION OF A LOOP CONTROL VARIABLE.
*         MAKE AN ENTRY IN *DOLIST*.
* 
*         ON ENTRY: 
*                B1 = ORDINAL OF VARIABLE, B1 < 0 IF IN BASE BIAS FORM
* 
 TEMP     BSSZ   3                 3 TEMPORARIES FOR DOSYM
  
 CHKBB    MACRO  ROUTINE           CHECK BASE/BIAS
          LOCAL  NEXT 
          LOCAL CHBB
          RJ     NAME              GET BASE AND BIAS
          NE     B1,B6,NEXT 
          SA1    =XNRFD 
          ZR     X1,CHBB     IF RF .EQ. 0 
          SB1    ERPROI 
          SB6    E.DO14 
          RJ     DODEF.E
          EQ     NEXT 
 CHBB     BSS    0
          NE     B2,B7,NEXT 
          SB1    ROUTINE
          SB6    E.DO13 
          RJ     DODEF.E
 NEXT     BSS    0
          ENDM
  
 CHKDO    MACRO  WORD              CHECK DO LIMIT 
          LOCAL  NOCHK
          SA5    B4+B5             WORD 3 
          LX5    59-D3.CVP-D3.CVL+WORD  POSITION CV BIT 
          PL     X5,NOCHK          IF A CONSTANT
 REG      MICRO  WORD*5-4,5,/B4-B5B4   B4+B5/ 
          SA3    "REG"
          SX2    X3 
          CHKBB  ERPROI            CHECK BASE BIAS
 NOCHK    BSS    0
          ENDM
          SPACE  3
 DODEF    ENTRY.
          SA4    DOFLAG 
          ZR     X4,DODEF          IF NO LOOPS
  
          SB5    1
          PL     B1,DODEF1
          SB1    -B1
          EQ     DODEF2 
  
 DODEF1   SX2    B1                GET BASE/BIAS FOR DEFINED SYMBOL 
          RJ     NAME 
  
 DODEF2   SB6    B1 
          SA4    =XNCAD 
          SB7    X4+B2       B6,B7 = BASE,BIAS OF REDEFINITION
          SA4    O.DOTAB
          SB4    X4+B5             B4 = CURRENT LOOP ADDR + 1 
          SX7    B7 
          LX7    18 
          SX6    B6 
          BX7    X7+X6
          SA7    TEMP+1            TEMP SAVE BASE/BIAS
          SB3    DOTAB+1           B3 = FWA+1 OF DOTAB
  
*         CHECK *DOTAB* FOR REDEFINITION OF LOOP CONTROL VARIABLES. 
  
 DODEF.L  SA4    B4                WORD 2 
          MX0    D2.IXL 
          BX2    X0*X4
          LX2    D2.IXL 
          CHKBB  ERPRO             CHECK FOR REDEF OF CONTROL VARIABLE
  
          CHKDO  1                 CHECK FOR
          CHKDO  2                 REDEFINITION OF
          CHKDO  3                 DO LIMITS
          SB4    B4-3 
          GT     B4,B3,DODEF.L     LOOP IF MORE ENTRIES 
          EQ     DODEF
          SPACE  3
*** 
*         DODEF.E - DO DEFINITION ERROR 
* 
*         ON ENTRY: 
*                X2 = ORDINAL OF SYMBOL 
*                B6 = ERROR NUMBER
*         ON EXIT:  
*                B3,B4,B6,B7 RESTORED 
* 
 DODEF.EX SA1    TEMP 
          SA2    A1+B5
          SB4    X1                RESTORE DOTAB ADDRESS
          SB6    X2 
          AX2    18 
          SB7    X2 
          SB3    DOTAB+1
 DODEF.E
          SX6    B4 
          SA6    TEMP              SAVE B4
          SX7    B1                SAVE B1
          SA7    A6+2 
          ERNAME X2                SYMBOL NAME TO X3
          SA1    TEMP+2 
          SB1    X1 
          SB7    DODEF.EX 
          JP     B1                JUMP TO ERROR ROUTINE
          TITLE              DOCALL - EXTERNAL REFERENCE IN A DO LOOP 
*** 
* 
*         DOCALL - EXTERNAL REFERENCE ENCOUNTERED 
*         LOOP THROUGH DOTAB AND SET J BIT FOR ALL LOOPS
* 
 DOCALL   ENTRY.
          SA1    DOFLAG 
          ZR     X1,DOCALL         IF NO DO LOOPS 
          MX0    1
          SX2    DOTAB             FWA
          LX0    1+D3.OFP+OF.JP 
          SA1    O.DOTAB
  
 DOCALL1  SA4    X1+2              WORD 3 
          BX7    X0+X4             SET J BIT
          SX1    X1-3 
          IX5    X1-X2
          SA7    A4 
          NZ     X5,DOCALL1 
  
          EQ     DOCALL 
  
*** 
*         XFERF - XFER FLAGS FROM DOTAB ENTRY TO SYMTAB ENTRY 
* 
*         ON ENTRY: X7 = NEW FLAGS TO BE SET
* 
*         ON EXIT:  A1,X1 = O.DOTAB,(O.DOTAB) , A2,X2 = WORD 3 OF ENTRY 
* 
 XFERF
          SA1    O.DOTAB
          MX0    D3.OFL 
          SA2    X1+2              WORD 3 
          LX0    D3.OFL+D3.OFP     POSITION MASK
          MX3    D3.GLL 
          BX4    X3*X2
          LX4    D3.GLL+1    SYMTAB ORDINAL OF )AA * 2
          SA5    SYM1 
          BX3    X0*X2             EXTRACT FLAGS
          BX3    X7+X3             SET NEW FLAGS
          LX3    P.FLG-D3.OFP 
          IX6    X5-X4
          SA4    X6-1              WORD B 
          BX6    X3+X4             ADD FLAGS
          SA6    A4 
          EQ     XFERF
          TITLE              DONE - POST I/O LIST PROCESSOR 
          ENTRY  DONE 
*** 
*         DONE - POST I/O LIST PROCESSOR
* 
 DONE     SA1    O.DOTAB
          SX2    X1-DOTAB 
          ZR     X2,DONEX          IF NO LOOPS
          SA3    X1          WORD 1 
          LX3    59-D1.OTP
          MI     X3,DONE1    IF A ONE TRIP LOOP 
          SB2    -M.DOEND 
          RJ     GENMAC            GENERATE A DO END MACRO
          EQ     DONE2
  
 DONE1    WRM    DOLABA 
  
 DONE2    MX7    1
          LX7    1+19 
          RJ     XFERF             SET J BIT AND XFER FLAGS 
  
*         COMPRESS DO TABLE 
  
          SX7    X1-3 
          SA7    O.DOTAB           O.DOTAB = O.DOTAB - 3
          SA2    DOFLAG 
          SX6    X2-1              DECREMENT NESTING LEVEL
          SA6    A2 
          EQ     DONEX
          TITLE              DOIT - PRE I/O LIST PROCESSOR
          ENTRY  DOIT 
*** 
*         DOIT - IMPLIED DO LOOP PROCESSING 
*         ENTRY:   B1 = E LIST POINTER
* 
 DOIT     SX6    B1+2              MOVE E LIST POINTER BACK 
          SA1    SELIST 
          BX7    X1 
          SA7    SVELIST           SAVE POINTER FOR LISTIO
          SA6    A1                POINT TO BEFORE THE = S
          MX7    0
          SA7    LWD               NO LABEL ASSOCIATED WITH AN I/O STMT 
          RJ     DOTOP             GENERATE THE TOP OF THE LOOP 
          SA1    SVELIST
          BX6    X1 
          SA6    SELIST            RESTORE E-LIST POINTER 
          EQ     DOITX
          SPACE  3
*         DOGOOF - COMPRESS "DOTAB" AFTER AN I/O LIST ERROR 
  
          ENTRY  DOGOOF 
 DOGOOF   SA1    DOFLAG 
          ZR     X1,PH2RETN        IF NO LOOPS
          SB5    1
          SA2    O.DOTAB           CURRENT ENTRY ADDRESS
  
 DOGOOFL  SA3    X2                FIRST WORD 
          MX0    D1.SL
          BX4    X0*X3
          NZ     X4,DOGOOF1        IF NOT AN I/O LOOP 
          SX1    X1-1 
          SX2    X2-3 
          SX6    X2-DOTAB 
          NZ     X6,DOGOOFL        IF NOT FINISHED
  
 DOGOOF1  BX6    X1 
          LX7    X2 
          SA6    A1                UPDATE NESTING LEVEL 
          SA7    A2                AND DO STACK POINTER 
          EQ     PH2RETN
          TITLE              DOLAB - END OF LABELED STMT PROCESSING 
 PFIELD   EQU    TEMP+1            DO1 + P FIELD OF DO LOOP 
*** 
* 
*         DOLAB - OUTPUT "DOEND" MACROS FOR LOOPS THAT TERMINATE
*         ON THIS STATEMENT 
* 
 DOLAB    ENTRY.
          SA1    DOFLAG 
          ZR     X1,DOLAB          EXIT IF NO LOOPS 
  
*         SEARCH "DOTAB" FOR LOOPS THAT TERMINATE ON THIS STMT
  
 DOLAB1   SA1    LORD 
          SA2    O.DOTAB
          SB6    DOTAB
          LX1    D1.SP
          SB4    X2                CURRENT ENTRY ADDR 
          SB7    X2                LOOP INDEX 
  
 DOLAB2   EQ     B7,B6,DOLAB       EXIT IF FINISHED 
  
          SA3    B7                FIRST WORD 
          MX0    D1.SL
          BX4    X0*X3             EXTRACT ORD OF STMT LABEL
          IX5    X1-X4
          ZR     X5,DOLAB3         IF THE SAME
          SB7    B7-3 
          EQ     DOLAB2            LOOP FOR THE NEXT ENTRY
  
 DOLAB3   EQ     B4,B7,DOLAB4      IF AT THE TOP OF THE STACK 
  
*         ISSUE A DIAGNOSTIC FOR "ILLEGAL NESTING"
  
          SA4    B4 
          BX2    X0*X4             EXTRACT ORDINAL
          LX2    D1.SL
          SB7    DOLAB.D
          SB6    E.DO12 
          ERNAME X2                PREPARE SYMBOL 
          EQ     ERPRO
  
 DOLAB.D  SA2    O.DOTAB
          SX7    X2-3 
          SA3    DOFLAG 
          SX6    X3-1              DECREMENT NESTING LEVEL
          SA7    A2                REMOVE LAST ENTRY FROM THE STACK 
          SA6    A3 
          EQ     DOLAB1            LOOP 
  
  
*         CHECK FOR ILLEGAL DO STMT TERMINATOR
  
 DOLAB4   SA1    TYPE              CURRENT STMT TYPE
          SX2    643B              TEST FOR GO TO, IF(E) N1,N2,N3 
          LX2    15                RETURN , STOP , PAUSE
          LX3    -D1.OTP
          MX0    -D1.OTL
          BX6    -X0*X3 
          SA6    OTF         ONE-TRIP LOOP FLAG 
          SB2    X1 
          AX3    B2,X2
          LX3    59 
          SB2    B2-21B      TEST FOR LOGICAL IF
          ZR     B2,DOLAB4A  IF LOGICAL IF
          PL     X3,DOLAB5         IF NOT ONE OF THE ABOVE
  
 ER11     SB6    -E.DO11           ILLEGAL DO STMT TERMINATOR 
          SB7    DOLAB
          SX6    DOTAB
          SA6    O.DOTAB           FORGET ABOUT THE 
          MX7    0                 REST OF THE ENTRIES
          SA7    DOFLAG 
          SA7    L.DOLST
          EQ     ERPRO
  
*         IF OBJECT OF LOGICAL IF IS  GO TO, IF, RETURN, STOP, PAUSE, 
*         A NON-ANSI DIAGNOSTIC IS ISSUED.
  
 DOLAB4A  SA1    LTYPE       TEST TYPE CODE OF OBJECT 
          SB2    X1          OF LOGICAL IF
          AX3    B2,X2
          LX3    59 
          PL     X3,DOLAB5   IF OBJECT OF LOG IF IS OK
          POSTER SEV=ANSI,NR=E.DO305
  
*         REMOVE DEFINED LABELS FROM DOLIST 
*         SET X AND M BITS FOR REFERENCES TO UNDEFINED LABELS 
  
 DOLAB5   SA1    O.DOLST
          SA2    L.DOLST
          SA3    O.DOTAB
          SA4    X3+B5             WORD 2 
          AX4    D2.PL
          SX5    X4                P FIELD
          IX7    X1+X5             FWA OF DOLST FOR THIS LOOP 
          SA7    PFIELD 
          SB6    X1                B6 = FWA 
          IX0    X1+X2             LWA+1 OF DOLST 
          SB3    X0 
          BX6    X0-X7
          ZR     X6,DOLAB9         IF NO DOLST FOR THIS LOOP
  
          SB1    X7                B1 = LOOP INDEX
          SB2    X7                B2 = STORE ADDRESS 
          SA5    SYM1 
          SX0    OF.XV+OF.MV
          LX0    D3.OFP 
          BX6    X5                X6 = SYM1
          SB4    -B5               B4 = -1
          SB7    B1                SAVE DO1+P 
  
 DOLAB6   SA1    B1                FETCH DOLIST ENTRY 
          NG     X1,DOLAB6A        IF A VARIABLE
  
          LX1    1
          IX7    X6-X1             SYMTAB ADDRESS 
          SA4    X7+B4             WORD 2 OF SYMTAB 
          LX4    59-P.DSN 
          NG     X4,DOLAB6B        IF LABEL IS DEFINED
  
          SA5    X3+2              WORD 3 OF DOTAB ENTRY
          LX1    59                ADJUST X1
          BX7    X0+X5             SET X AND M BITS 
          SA7    A5 
  
 DOLAB6A  BX7    X1 
          SA7    B2                MOVE ELEMENT DOWN
          SB2    B2+B5             ADVANCE STORE ADDRESS
  
 DOLAB6B  SB1    B1+B5             ADVANCE LOOP INDEX 
          LT     B1,B3,DOLAB6      LOOP THROUGH LIST
          SX7    B2-B6
          SA7    L.DOLST           UPDATE LENGTH
          SX0    X3-DOTAB-3 
          NZ     X0,DOLAB9         IF NOT THE FIRST LOOP
  
*         ELIMINATE REFERENCES TO LABELS, SET RZ BIT FOR "LORD" 
*         IF DOLST CONTAINS LABELS SO THAT ONE MAY REENTER THE LOOP.
  
          SB3    B2                B3 = DOLAST
          MX0    0                 CLEAR RZ BIT 
          SB1    B7                RUNNING INDEX
          SB2    B7                STORE ADDRESS
  
 DOLAB7   SA1    B1                FETCH ENTRY
          EQ     B1,B3,DOLAB8 
          PL     X1,DOLAB7A        IF A LABEL 
  
          BX7    X1 
          SA7    B2                STORE VARIABLE DEF 
          SB2    B2+B5             UPDATE STORE ADDR
          SB1    B1+B5
          EQ     DOLAB7            LOOP 
  
 DOLAB7A  MX0    1                 SET RZ FLAG
          SB1    B1+B5
          EQ     DOLAB7 
  
 DOLAB8   SA2    LORD 
          LX2    1                 *2 
          IX3    X6-X2
          SA4    X3+B4             WORD B OF SYMTAB ENTRY 
          LX0    1+P.RZ 
          BX6    X0+X4             SET RZ BIT 
          SA6    A4 
          SX7    B2-B6
          SA7    L.DOLST           UPDATE LENGTH
  
 DOLAB9   MX7    0
          RJ     XFERF             GO XFER FLAGS TO )XX IN SYMTAB 
          SA5    OTF
          NZ     X5,DOLAB10        IF A ONE-TRIP LOOP 
          SB2    -M.DOEND 
          RJ     GENMAC      WRITE DO-END MACRO 
          EQ     DOLAB.D
  
 DOLAB10  WRM    DOLABA      WRITE DUMMY DO-END MACRO TO RLIST
          EQ     DOLAB.D
  
 DOLABA   RMHDR  M.DOEND,0
          TITLE              DOLABR 
*** 
*         DOLABR - PROCESS REFERENCE TO A LABEL 
* 
*         ENTRY  X2 = ELIST FOR LABEL OR ZERO IF CALLED FROM RETURN.
* 
*         ON EXIT:  
*         A0,A1,A2,X1,X2,B1,B2 SET AS IF CALLED "LABEL" 
*                X4 = PREVIOUS VALUE OF RSN BIT ( 0 OR 1S"P.RSN" )
*                X7 = LABEL IN FORMAT  10HLABEL ( NO LEADING . )
* 
 DOLABRV  ERNAME B1                ERROR EXIT 
+         SB7    *+1
          EQ     ERPRO
  
 DOLABRW  SA1    TEMP 
          SB1    X1                RESTORE B1 
  
 DOLABRX  SA5    RSELECT           ** NORMAL EXIT **
          ZR     X5,DOLABRY        IF R = 0 
          ADDREF B1,REF            ADD A REFERENCE FOR THE LABEL
  
 DOLABRY  SA3    SYM1 
          SA4    TEMP              ORDINAL
          SA0    X3 
          SA3    =5R    B 
          SB1    X4 
          SB2    B1+B1             2*ORD
          SA1    A0-B2             WORD A 
          SA2    A1-B5             WORD B 
          MX0    36 
          BX5    X0*X1
          LX5    6
          BX7    X5-X3             10H_LABEL
          SA4    A4+B5             TEMP+1 = PREVIOUS VALUE OF RSN 
  
 DOLABR   ENTRY.
          ZR     X2,DOLABR8  IF SPECIAL CALL FROM RETURN
          SA1    X2                FETCH CONSTANT 
          AX2    18 
          SB1    X2                DIGIT COUNT
          LABCON                   GO CONVERT THE LABEL AND ENTER IN SYM
  
          SX0    T.LAB
          LX0    P.TYP
          BX2    X0+X2             SET TYPE TO LABEL
  
+         SX7    B1 
          SA7    TEMP              SAVE THE ORDINAL 
          MX0    2
          LX0    2+P.RFN
          BX3    X0*X2
          SB6    E.DOMUL           PRESENT REF CONFLICTS WITH PREVIOUS
          NZ     X3,DOLABRV        USEAGE 
  
 RSNB     BIT    P.RSN-P.RAS       ACTIVE STMT NO AND REF IN CONTEXT AS 
          SX0    RSNB+1            A STMT NO
          LX0    P.RAS
          BX6    X0+X2             SET ACTIVE AND REFED AS STMT NO BITS 
          SA3    TRACEL 
          NG     X3,DOLABR1        IF NOT TRACING JUMPS 
          MX0    L.TRO
          LX0    L.TRO+P.TRO
          BX3    X0*X2
          NZ     X3,DOLABR1        IF THIS LABEL HAS A TRACE ORDINAL
          SA4    N.TLAB 
          SX7    X4+B5             INCREMENT NO OF LABELS BEING TRACED
          SA7    A4 
          LX7    P.TRO
          BX6    X7+X6             INSTALL TRACE ORDINAL
 DOLABR1  SA6    A2                UPDATE WORD B
          SX0    B5 
          LX0    P.RSN
          BX7    X0*X2             SAVE PREVIOUS VALUE OF RSN FOR IFBRT,
          SA7    TEMP+1            ETC
          LX2    59-P.DSN 
          MX0    L.LOR
          LX0    L.LOR+P.LOR
          BX3    X0*X6             ORD OF )XX OF ASSOC LOOP 
 DOLABR1A BSS    0
          SA5    DOFLAG 
          NZ     X5,DOLABR.L       IF WE ARE INSIDE A NEST
  
*         NO LOOPS
  
          PL     X2,DOLABR3        IF LABEL NOT DEFINED 
          ZR     X3,DOLABRX        IF NO REFS TO LABEL IN A PRIOR LOOP
 DOLABR2  AX3    P.LOR-1           2 * ORDINAL
          SB3    X3+B5
          SA4    A0-B3             WORD B OF )XX OF ASSOCIATED LOOP 
          MX0    1
          LX0    1+54              SET E BIT ( LOOP MAY BE ENTER FROM 
          BX7    X0+X4             POINTS OTHER THAN THE TOP )
          SA7    A4 
          EQ     DOLABRX
  
 DOLABR3  SX0    B5                LABEL NOT DEFINED, 
          LX0    P.RZ              SET RZ BIT 
          BX6    X6+X0             REFERENCE TO LABEL PRIOR TO NEXT DO N
          SA6    A2 
          EQ     DOLABRX
  
*         LOOPS 
  
 DOLABR.L SA5    O.DOTAB
          NG     X2,DOLABR6        IF LABEL IS DEFINED
  
          NZ     X3,DOLABR4        IF NOT FIRST REF IN THIS LOOP
          SA4    X5+2              WORD 3 OF THE CURRENT LOOP 
          MX0    D3.GLL 
          BX3    X0*X4             EXTRACT ORD FOR )XX OF LOOP
          LX3    D3.GLL+P.LOR 
          BX6    X6+X3             ADD LABEL OF CURRENT LOOP TO ENTRY 
          SA6    A2 
  
*         ADD A WORD TO DOLIST FOR THE REFERENCE TO THIS LABEL
  
 DOLABR4  ADDWD  DOLST,B1 
          SB1    X6 
          NZ     X7,DOLABRX        IF ENOUGH STORAGE
  
*         INSUFFICIENT STORAGE, SET M AND X BITS FOR ALL LOOPS
  
          SB3    DOTAB             FWA
          SA4    O.DOTAB
          SB4    X4                LWA+1
          SX0    OF.XV+OF.MV
          LX0    D3.OFP      POSITION X AND M BITS
  
 DOLABR5  SA5    B4+2 
          SB4    B4-3 
          BX6    X0+X5
          SA6    A5 
          GT     B4,B3,DOLABR5
  
          SB6    -E.DO19           INSUFFICIENT STORAGE TO OPTIMIZE 
          SB7    DOLABRW
          EQ     ERPROI 
  
*         LABEL IS DEFINED
*         CHECK ENTRIES IN DOTAB TO SEE IF IT IS DEFINED IN THIS NEST.
*         IF NOT IT IS A TRANSFER OUT OF THE LOOP.  SET M AND X BITS
  
 DOLABR6  SX0    OF.XV+OF.MV
          LX0    D3.OFP      X AND M BITS 
          SB4    X5                B4 = (O.DOTAB) 
          SB3    DOTAB
          MX7    D3.GLL 
          LX3    -P.LOR-D3.GLL     POSITION ORD OF )XX FOR LABEL
  
 DOLABRL1 SA4    B4+2 
          BX6    X7*X4             EXTRACT ORD OF LOOP )XX
          IX5    X3-X6
          ZR     X5,DOLABR7  IF IN THE SAME LOOP
          BX6    X0+X4             SET X AND M BITS 
          SA6    A4 
          SB4    B4-3 
          GT     B4,B3,DOLABRL1 
          ZR     X3,DOLABRX 
  
          SA4    DOTAB+5           WORD 3 OF FIRST LOOP 
          BX7    X7*X4             EXTRACT ORD OF )XX FOR LOOP
          LX3    P.LOR+D3.GLL 
          LX7    P.LOR+D3.GLL 
          IX1    X3-X7             ORD(LABEL) - ORD(OUTER LOOP) 
          NG     X1,DOLABR2        IF LABEL IS IN A PREVIOUS NEST 
*         NEST OF THE FORM:  ( ( L1:  )  ( GOTO L1 ) )
          SB6    E.DO10            ILLEGAL REF TO A PREVIOUS STMT IN THI
          EQ     DOLABRV           NEST 
  
*         BACKWARDS REFERENCES TO LABEL DEFINED IN THE LOOP, MARK IT AS 
*         NOT OPTIMIZABLE SINCE WE CANT OPTIMIZE LOOPS WITH LOOPS IN
*         OPT=1.
  
 DOLABR7  SA2    =XOPTLVL 
          SX6    X2-1 
          NZ     X6,DOLABRX  IF OPTLVL " 1
          SX0    OF.RV
          LX0    D3.OFP 
          BX6    X0+X4       SET R BIT TO INHIBIT OPTIMIZATION
          SA6    A4 
          EQ     DOLABRX
  
*         IF A RETURN STATEMENT IS WITHIN THE LOOP, INHIBIT OPTIMIZATION
  
 DOLABR8  SA5    DOFLAG 
          ZR     X5,DOLABR   IF NOT INSIDE A NEST 
          SX0    OF.RV
          SA5    O.DOTAB
          LX0    D3.OFP 
          SB4    X5 
          SA4    B4+2 
          BX6    X0+X4       SET R BIT TO INHIBIT OPTIMIZATION
          SA6    A4 
          EQ     DOLABR 
          TITLE              DOLABCN
*** 
*         DOLABCN - CONVERT AND CHECK LABEL 
*         ENTERED BEFORE CONTROL IS PASSED TO THE STMT PROCESSORS 
*         IN THE CASE OF EXECUTABLE STMTS 
* 
 LORD     ENTRY. 0
 ILLXFER  EQU    TEMP              ILLEGAL TRANSFER INTO A DO LOOP
  
 DOLABCN  ENTRY.
          SA1    CLABEL 
          SB1    B5 
          MX7    0
          SA7    ILLXFER           CLEAR ILLEGAL TRANSFER FLAG
          LABCON                   CONVERT LABEL AND ENTER IN SYMTAB
  
 BDEF     BIT    P.TYP-P.DSN
          SX0    T.LAB*BDEF+1      LABEL AND DEFINED BIT
          EQ     DOLABC3           NOT IN THE TABLE 
  
*         PREVIOUS REFERENCES TO THIS LABEL 
  
 DSF      BIT    P.DSN-P.DFN
          SX7    B1 
          SA7    LORD            SAVE ORDINAL FOR DOLAB 
          SX0    DSF+1             DEFINED BITS 
          LX0    P.DFN
          BX3    X0*X2
          ZR     X3,DOLABC1        IF NO PREVIOUS DEFINATIONS 
  
          SA3    CLABEL      GET THE DUPLICATE LABEL FOR ERR MSG LISTING
          SB6    E.DO8       ERR MSG NR - DUPLICATE STATEMENT LABEL 
          BX6    X6-X6
          LX3    60-12
          SX4    0           *ERPRO* FLAG - MSG IN X3 
          SA6    A3+               CLEAR DUPL LAB TO PREVENT MORE ERRS
 DOLABCX  SB7    DOLABCN
          EQ     ERPRO
  
 DOLABC1  BX3    X2 
          SX0    B5 
          LX3    59-P.RFN 
          PL     X3,DOLABC1A       IF NOT REFERENCED AS A FORMAT NUMBER 
          LX0    P.DFN             MAKE IT LOOK LIKE A FORMAT NUMBER
          BX6    X0+X2
          SA6    A2 
          ERNAME B1 
          SB6    E.DOMUL           CONFLICTING USES OF THIS LABEL 
          EQ     DOLABCX
  
*         CHECK FOR REFS TO THE LABEL FROM OUTSIDE THE CURRENT LOOP 
  
 DOLABC1A SA4    DOFLAG 
          ZR     X4,DOLABC3        IF NO LOOPS
          SA3    O.DOTAB           ADDRESS OF CURRENT DO LOOP 
          SA5    X3+2              WORD 3 
          MX7    -D3.GLL
          BX6    X2 
          LX5    D3.GLL 
          BX4    -X7*X5            X4 = ORD OF )XX OF CURRENT LOOP
          AX6    P.LOR
          LX5    -D3.GLL
          BX6    -X7*X6            X6 = ORD OF LOOP LAST REFERENCED IN
          IX1    X6-X4
          BX7    X2 
          LX7    59-P.RZ
          NG     X7,DOLABC2        IF REFS FROM OUTSIDE THE NEST
          ZR     X6,DOLABC3        IF NO PREVIOUS REFS IN A LOOP
          PL     X1,DOLABC3        IF REFS ARE IN THE LOOP
          SA6    ILLXFER           ILLXFER " 0 IF REFS IN A PREVIOUS NES
*                                  ( GOTO L )  ( L: ) IS ILLEGAL
*                                  ( GOTO L ( L: ) ) IS ILLEGAL 
  
*         LABEL IS REFERENCED PRIOR TO LOOP IN WHICH IT IS DEFINED
*         SET E BIT - LOOP MAY BE ENTERED FROM POINTS OTHER THAN THE TOP
  
 DOLABC2  SX7    B5 
          LX7    D3.OFP+OF.EP 
          BX7    X7+X5             SET E BIT FOR INNERMOST LOOP 
          SA7    A5 
  
*         PLACE ORDINAL OF GL FOR THE PRESENT LOOP IN WORD B OF SYMTAB
  
 DOLABC3  SA3    O.DOTAB
          SA4    X3+2              WORD 3 
          LX0    P.DSN
          BX2    X0+X2             SET BITS IN SYMTAB ENTRY 
          MX0    D3.GLL 
          BX5    X0*X4             ORD OF )XX FOR CURRENT LOOP
          LX0    D3.GLL+P.LOR 
          BX2    -X0*X2            REMOVE OLD ORDINAL 
          LX5    D3.GLL+P.LOR 
          BX6    X5+X2             OR IN LABEL OF CURRENT LOOP
          SA3    DUKE 
          LX3    P.DLN             SAVE LINE NO OF DEFINITION 
          BX6    X3+X6
          SA6    A2 
  
          SX7    B1 
          SA7    LORD              SAVE ORDINAL FOR DOLAB 
  
          SA5    RSELECT
          ZR     X5,DOLABC4        IF R = 0 
          ADDREF B1,DEF            DEFINE THE STMT NUMBER 
  
 DOLABC4  SA5    LORD 
          CALL   WLABM       LABEL DEFINITION MACRO TO RLIST
          SA1    ILLXFER
          ZR     X1,DOLABCN 
          ERNAME LORD 
          SB6    E.DO9             ILLEGAL XFER INTO A DO LOOP
          EQ     DOLABCX
          EJECT 
*** 
*         LABCON - CONVERT A LABEL TO INTERNAL FORM 
*         ON ENTRY: 
*                X1 = LABEL LEFT JUSTIFIED WITH BLANK FILL
*                B1 = CHARACTER COUNT 
*                B7 = RETURN ADDRESS FROM "LABEL" 
* 
*         ON EXIT:  
*                RETURN FROM "LABEL" WITH A0 - A2, X1,X2,B1,B2 SET
* 
          ENTRY  LABCON 
 LABCON   SX2    1R0
          SX3    1R.-1R 
          SB2    B1-6 
          PL     B2,LAB.E1         IF MORE THAN 5 DIGITS
          LX2    54 
          MX4    6
          SX0    1R -1R0
  
 LABCONL  BX5    X4*X1             EXTRACT A CHARACTER
          IX6    X2-X5
          NZ     X6,LABCON1        IF NOT A ZERO
          SB1    B1-B5             DECREMENT CHARACTER COUNT
          ZR     B1,LAB.E          IF 0 CHARACTERS
          LX1    6
          IX1    X0+X1             CHANGE 0 TO A BLANK
          EQ     LABCONL
  
 LABCON1  IX1    X1+X3
          LX1    42                POSITION LABEL 
          EQ     =XLABEL           GO ENTER NAME IN SYMTAB
  
 LAB.E1   SB6    E.DO80            LABEL MORE THAN 5 DIGITS 
          LX1    60-12             LEFT ADJUST TO BIT 48
          MX0    12 
          BX3    -X0*X1            X3 = CONSTANT
          SX4    B0 
          EQ     LAB.E+1
  
 LAB.E    SB6    -E.DO130          0 STMT LABEL 
+         SB7    PH2RETN
          EQ     ERPRO
          TITLE              DOEND - END PROCESSING OF DO TABLES
**        DOEND - END PROCESSING OF THE DO TABLES.
* 
*         SCAN THE SYMBOL TABLE FOR MISSING STATEMENT LABEL DEFINITIONS 
*         AND FOR LOOPS ENTERED FROM OUTSIDE THEIR RANGE. 
  
  
 DOEND=   SUBR   =                 ** ENTRY/EXIT ** 
          SA1    SYM1 
          SA2    CON. 
          LX2    1                 2*ORD(CON.)
          IX1    X1-X2
 DOEND2   SB1    X1-2              (B1) = SYMTAB ADDRESS
          SA2    SYMEND 
          SX7    T.LAB
          LX7    P.TYP
          SB2    X2                (B2) = LWA+1 
          MX0    L.TYP
          SB3    B5+B5             (B3) = 2 
          MX1    2
          LX1    2+P.SLD           FOR CHECKING FOR UNDEFINED LABELS
  
*         SYMBOL TABLE SCAN LOOP. 
  
 DOENDL   SA5    B1-B5             WORD B 
          EQ     B1,B2,DOEND10     IF TABLE SCAN FINISHED 
          BX4    X0*X5
          SB1    B1-B3             ADVANCE TABLE ADDRESS
          IX3    X7-X4
          NZ     X3,DOENDL         IF NOT A LABEL 
          BX2    X1*X5             EXTRACT DEFINITION BITS
          LX5    59-P.GEN 
          MI     X5,DOEND3         IF A GENERATED LABEL 
          NZ     X2,DOENDL         IF LABEL IS DEFINED
          SA7    =XE.UDEFL         SET FLAG 
  
          SA4    =XDFLAG
          ZR     X4,DOENDL         IF NOT IN DEBUG MODE 
          MX6    1
          LX5    P.GEN-P.DLT
          MI     X5,DOENDL2        IF DO TERMINATOR LABEL 
          LX5    P.DLT-P.RAS
          MI     X5,DOENDL1        IF STATEMENT LABEL REFERENCE 
 DOENDL2  SA6    =XP2NOGO          SET *SUPPRESS OBJ CODE GENERATION* 
          EQ     DOENDL            LOOP 
  
 DOENDL1  SX6    B1+B3
          SA6    TEMP              SAVE ADDRESS 
          SX4    A5+B5             ADDRESS OF WORD A
          SA2    SYM1              START OF SYMTAB
          IX6    X2-X4
          AX5    B5,X6
          CALL   WLABM             LABEL MACRO DEFINITION TO *RLIST*
          SA1    TEMP 
          EQ     DOEND2 
  
*         CHECK FOR A LOOP THAT IS ENTERED ILLEGALLY. 
  
 DOEND3   LX5    1
          PL     X5,DOENDL         E = 0, NO ENTRIES TO THE LOOP
          LX5    1
          LX6    B5,X5
          SB7    B0          SET *FATAL ERROR* STATUS 
          PL     X5,DOEND4   IF LOOP HAS NO EXITS 
          PL     X6,DOENDL   IF INNER LOOP
          SB7    B5          SET *INFORMATIVE ERROR* STATUS 
 DOEND4   SX7    B1+B3
          MX0    -15
          SA7    TEMP              SAVE SYMTAB ADDRESS
          AX5    24+59-P.GEN+2     POSITION LINE COUNT
          BX1    -X0*X5            EXTRACT
          SB1    1
          CALL   CDD               RETURNS (X4) = INTEGER, DPC, -H- FMT 
          MX0    12 
          SB5    B1 
          AX4    12                LEFT JUSTIFY TO BIT 48 
          BX3    -X0*X4 
          ZR     B7,DOEND5         IF FATAL ERROR (INNER LOOP)
          POSTER SEV=INF,NR=E.DOEXT,FMT=DPC,TXT=X3,RETURN=DOEND6
  
 DOEND5   MX6    1
          SA6    =XP2NOGO          SET *SUPPRESS OBJ CODE GENERATION* 
          POSTER SEV=FE,NR=E.DO16,FMT=DPC,TXT=X3
 DOEND6   SA1    TEMP 
          EQ     DOEND2            CONTINUE SYMTAB SCAN 
  
*         TERMINAL PROCESSING.
  
 DOEND10  SA1    =XE.UDEFL
          ZR     X1,EXIT.          IF NO UNDEFINED LABELS 
          POSTER SEV=FE,NR=E.DO17,RETURN=EXIT.
  
  
          END 
