*DECK     GOTO
          IDENT  GOTO 
 GOTO     TITLE  GOTO - ASSIGN AND GOTO STATEMENT PROCESSOR 
*CALL     SSTCALL 
 GOTO     SPACE  3
**        GOTO - ASSIGN AND GOTO STATEMENT PROCESSOR. 
* 
*         STATEMENTS PROCESSED -
* 
*                GOTO <LABEL> <EOS> 
*                GOTO <IVAR> , <LABEL LIST> <EOS> 
*                GOTO <LABEL LIST> , <EXPRESSION> <EOS> 
*                GOTO <LABEL LIST> <EXPRESSION> <EOS> 
*                <LABEL LIST> ::= (<LABEL>,<LABEL>,...) 
* 
  
 B=GOTO   RPVDEF             DEFINE ROUTINE FWA FOR REPRIEVE UTILITY
          EXT    ERPRO,ASAER,ERPROI 
          EXT    DFLAG,OPTLVL,IGCALL,RSELECT
          EXT    DOFLAG,GOTOSFL,LABEL.,ST.,TRACEL 
          TABLES LTAB 
  
 SYM1     EQU    12B
 DIM1     EQU    17B
 SELIST   EQU    32B
 CLABEL   EQU    23B
 DUKE     EQU    37B               BINARY LINE COUNT
 NLABEL   EQU    60B
 NRLN     EQU    64B
          EJECT 
*         ERROR NUMBERS 
  
 E.GO1    EQU    101               GO TO STMT - SYNTAX ERROR
 E.GO2    EQU    102               MISSING OR SYNTAX ERROR IN LABEL LIST
 E.GOASA  EQU    103               GO TO STMT - NON USASA USEAGES 
 E.GO193  EQU    193               STMT BRANCHS TO ITSELF 
 E.GOEFF  EQU    312         IF STATEMENT MORE EFFICIENT THAN GOTO
  
*         RLIST MACRO NUMBERS 
  
 M.UCJ    RMEQU  105B        UNCONDITIONAL JUMP MACRO ORDINAL 
 M.AGO    RMEQU  107B        ASSIGNED GO TO MACRO ORDINAL 
 M.CGO    RMEQU  110B        COMPUTED GO TO MACRO ORDINAL 
 M.LOAD   RMEQU  133B        LOAD 
 M.STOR   RMEQU  134B        STORE
 M.XMIT   RMEQU  135B        XMIT 
 M.JPB0   RMEQU  416B        JP B0+0 MACRO ORDINAL
  
*         RLIST MACRO HEADER WORDS
  
 UCJM     RMHDR  M.UCJ,1
 AGOMAC   RMHDR  M.AGO,2
 CGOM     RMHDR  M.CGO,3
 JPB0M    RMHDR  M.JPB0,0 
 LOAD     RMHDR  M.LOAD,3 
 XMIT     RMHDR  M.XMIT,1 
 STOR     RMHDR  M.STOR,3 
          SPACE  3
          USE    /MACBUF/ 
 BRSELF                            BRANCH TO CURRENT LABEL FLAG 
 ASA                               ASA FLAG 
 MACBUF   BSSZ   7                 MACRO BUFFER 
 TEMP     BSSZ   1                 A GENERAL TEMPORARY
          BSSZ   4                 PADDING
          USE    *
  
          USE    /STSORD/ 
 STSORD   BSS    1                 HOLDS ORDINAL FOR ST. ARRAY
          USE    *
  
 AGOCALL  EQU    MACBUF+6          4 WORD BUFFER FOR IGCALL PARAM LIST
          TITLE              PLAB - PROCESS A LIST OF TRANSFER LABELS 
*** 
*         PLAB - PROCESS A LIST OF TRANSFER LABELS
* 
*         ENTRY:  
*                SELIST POINTS TO THE FIRST TRANSFER LABEL
*                A0 = ADDRESS FOR RETURN IN CASE OF AN ERROR
*                B6 = ERROR NUMBER TO BE USED IN CASE OF A SYNTAX ERROR 
*                B7 = E LIST CODE FOR LIST TERMINATOR 
* 
*         EXIT: 
*                A1,X1 = SELIST,(SELIST) POINTS PAST THE TERMINATOR 
*                O.LTAB = FWA OF THE LIST OF LABELS 
*                X6 = (L.LTAB) = NUMBER OF LABELS 
*                X7 = 10H_LABEL  FOR THE LAST LABEL 
*                A0 = (SYM1)
*                ENTRIES IN "LTAB" HAVE THE FORMAT: 
*                  12/2000B+OC.UCJ,48/SYMTAB ORDINAL
* 
  
 PLAB     ENTRY.
  
*         RUN A SYNTAX CHECK ON THE LIST AND COUNT THE NUMBER OF LABELS 
  
          SA1    SELIST 
          SB4    EL.COMMA 
          MX7    0                 NUMBER OF LABELS 
          SB1    X1 
          MX0    59                X0 = -1
  
 PLABL    SA3    B1                LABEL
          SA4    B1-B5             SEPERATOR
          UX5    B2,X3
          SB1    A4-B5             ADVANCE E LIST POINTER 
          UX6    B3,X4
          NZ     B2,PLABE          IF NOT A CONSTANT
          IX7    X7-X0             NLAB = NLAB+1
          AX5    45 
          SX6    X5-T.INT 
          NZ     X6,PLABE          IF NOT TYPE INTEGER
          EQ     B3,B4,PLABL       LOOP IF A COMMA
          NE     B3,B7,PLABE       IF NO PROPER TERMINATOR
  
          SA7    TEMP              SAVE NUMBER OF LABELS
          ALLOC  LTAB,X7           GET SPACE
          SA1    SELIST 
          SA2    TEMP 
          BX7    X2 
          SA7    L.LTAB 
          MX6    0
          SA6    A2                CLEAR INDEX TO LTAB
  
*         LOOP THROUGH THE LIST AGAIN AND FORM THE TABLE
  
 PLAB2    SA2    X1                E LIST FOR THE LABEL 
          CALL   DOLABR            GET SYMTAB ORDINAL, ETC. 
          SA3    CLABEL 
          SA4    O.LTAB 
          MX0    60-L.TRO 
          LX2    60-P.TRO          POSITION LABEL TABLE ORDINAL 
          BX5    -X0*X2            GET LABEL TABLE ORDINAL
          LX5    R1.INP 
          IX6    X7-X3
          SA3    TEMP              TABLE INDEX
          NZ     X6,PLAB2A         IF NOT A BRANCH TO THE CURRENT LABEL 
          SA6    BRSELF            CLEAR FLAG 
  
 PLAB2A   SA1    SELIST 
          SB3    OC.UJP 
          SX1    X1-2 
          IX0    X4+X3             TABLE ADDRESS
          BX6    X1 
          SA6    A1                UPDATE SELIST
          SX4    B1 
          BX4    X5+X4             FORM CA, I, H WORD 
          PX6    B3,X4
          SA6    X0                STORE ENTRY IN LTAB
  
          SA5    L.LTAB 
          SX6    X3+B5             INDEX = INDEX+1
          SA6    A3                UPDATE TEMP
          IX0    X6-X5
          NG     X0,PLAB2          LOOP IF TEMP < L.LTAB
          EQ     PLAB 
  
*         SYNTAX ERROR IN THE LIST OF LABELS
  
 PLABE    SB7    A0                RETURN ADDRESS 
          EQ     ERPRO
          SPACE  3
 PLAB     MACRO  TERM,ERNUM,RETURN
          SA0    RETURN 
          SB6    -ERNUM 
          SB7    TERM 
          RJ     PLAB 
          ENDM
          SPACE  4
 AGVARX   SX2    B1 
          RJ     PSYM 
          SB6    E.ASGN2
          SB7    =XPH2RETN
          EQ     ERPRO
          TITLE              AGVAR
*** 
*         AGVAR - PROCESS VARIABLE FOR ASSIGN AND ASSIGNED GOTO STMTS 
* 
*         ON ENTRY: 
*                X1 = NAME
* 
*         ON EXIT:  
*                B1 = SYMTAB ORDINAL
*                X5 = ORDINAL OF VARIABLE OR IH OF EQUIVALENT 
*                X7 = 0 OR CA OF EQUIVALENT 
* 
 AGVAR
          SYMBOL                   ENTER NAME IN SYMBOL TABLE 
          EQ     AGVAR.T           FIRST OCCURANCE
  
          EQ     B1,B5,AGVARX      ERROR IF ORDINAL 1 
          BX3    X1 
          LX3    59-P.FUN 
          BX4    X2 
          LX4    59-P.EXT 
          BX5    X3+X4
          NG     X5,AGVARX         ERROR IF A FUNCTION OR EXTERNAL
  
 AGVAR1   SX0    B5 
          LX0    P.VAR
          BX6    X0+X2             SET VAR BIT
          SA6    A2 
          AX6    P.TYP
          SX7    X6-T.INT 
          NZ     X7,AGVARX         ERROR IF NOT TYPE INTEGER
          SX5    B1                ORD = ORD OF VARIABLE
          LX1    59-P.EQU 
          PL     X1,AGVAR          EXIT IF NOT EQUIVALENCED 
  
*         FETCH BASE AND BIAS OF EQUIVALENCED ENTRY 
  
          SA3    DIM1 
          MX0    60-L.DIMP
          AX2    P.DIMP 
          BX2    -X0*X2            EXTRACT DIMP ORDINAL 
          LX2    1
          IX4    X3+X2
          SA5    X4                FETCH ENTRY
          AX5    18 
          SX7    X5                EXTRACT BIAS 
          AX5    18                POSITION ORDINAL 
          SX5    X5 
          EQ     AGVAR
  
*         FIRST OCCURANCE - SET TYPE
  
 AGVAR.T  IX2    X6+X2             ADD TYPE 
          ZR     X7,AGVAR1         IF NO PREVIOUS USE IN DEBUG STMTS
          CFO    VAR               CHECK SETTING OF DEBUG BITS
          EQ     AGVAR1 
          TITLE              UNCONDITIONAL AND ASSIGNED GOTO S
 GOTO     ENTRY.
          MX6    0
          SX7    B5 
          SA6    ASA
          SA7    BRSELF 
          SA6    =XEQCOUNT
  
          SA1    SELIST 
          SA2    X1 
          SA3    A2-B5             FETCH NEXT ENTRY 
          UX7    X2,B2             B2 = CODE FOR FIRST ENTRY
          UX6    X3,B3             B3 = CODE FOR SECOND ENTRY 
          SB4    B3-EL.EOS         FOR EOS TEST 
          NZ     B2,GOTOA          IF NOT A CONSTANT
  
          SB6    -E.GO1 
          NZ     B4,GOTOEX         IF NEXT IS NOT EOS 
  
          SA1    X2                GET LABEL CONSTANT 
          SA3    NLABEL            NEXT LINE LABEL
          IX6    X3-X1             COMPARE
          NZ     X6,GOTO. 
          SA4    DFLAG             BRANCH TO NEXT STATEMENT NOT 
          NZ     X4,GOTO.             OPTIMIZED IN DEBUG MODE 
          RJ     DOLABR            PROCESS LABEL
          SX0    B5 
          LX0    P.RSN             POSITION BIT 
          BX6    -X0*X2            CLEAR RSN BIT FROM WORD B
          BX7    X6+X4             RESTORE FORMER RSN BIT TO WORD B 
          SA7    A2 
          EQ     GOTO 
 GOTO.    BSS    0
  
          PLAB   EL.EOS,E.GO2,GOTOX    PROCESS THE LABEL
  
          SA1    TRACEL 
          SA2    DOFLAG 
          IX6    X1-X2
          NG     X6,NOTRU          BRANCH IF NO FLOW TRACING
          RJ     =XINITR           NEEDED TO SET UP ARLIST BUFFER 
          SX2    B1+B1             DOUBLE LABEL ORDINAL 
          SA1    SYM1              START OF SYMTAB
          IX3    X1-X2             ADDRESS OF SYMTAB ENTRY
          SA2    X3-1              WORD B OF LABEL ENTRY
          MX0    60-L.TRO 
          LX2    60-P.TRO          POSITION LABEL TABLE ORDINAL 
          BX3    -X0*X2            CA FIELD FOR APLIST
          SX3    X3-1              ADJUST ORDINAL 
          LX3    30 
          SA2    LABEL.            ORDINAL FOR LABEL TABLE
          BX6    X3+X2             FORM ARGLIST ENTRY 
          SA6    AGOCALL           WORD 1 
          MX7    0
          SA7    A6+B5             WORD 2 
          SX6    =8RBUGTRU
          SA6    A7+B5             WORD 3 
          SA2    =XN.AP 
          BX6    X2 
          SX7    X2+B5             INCREMENT APLIST NUMBER
          SA7    A2 
          SA1    AGOCALL
          RJ     IGCALL            GENERATE CALL
          SA1    =8RBUGTRU
          CALL   ODCM        OUTPUT DEBUG CALL MACRO
 NOTRU    BSS    0
  
          SA1    O.LTAB 
          SA3    UCJM 
          SA2    X1 
          BX6    X3 
          SX7    X2 
          SA6    MACBUF 
          SA7    A6+B5
          WRM    A6          UJP MACRO TO RLIST 
  
*         GO TO EXIT - ISSUE INFORMATIVE DIAGNOSTICS
  
 GOTOX    SA1    BRSELF 
          NZ     X1,GOTOXX         IF NO BRANCHS TO THE CURRENT LABEL 
          SB6    -E.GO193 
          SB7    GOTOXX 
          EQ     ERPROI 
  
 GOTOXX   SA1    ASA
          ZR     X1,GOTO           EXIT IF NO NON USASA USEAGES 
          SB6    -E.GOASA 
          SB7    GOTO 
          EQ     ASAER
  
*         ERROR EXIT - B6 = ERROR NUMBER
  
 GOTOEX   SB7    GOTOX             ERROR EXIT RETURN ADDRESS
          EQ     ERPRO
          SPACE  3
 GOTOA    NE     B2,B5,GOTOC       IF NOT A NAME
  
*         PROCESS ASSIGNED "GO TO" STATEMENT
  
          SB6    -E.GO2 
          ZR     B4,GOTOEX         IF NO LIST OF LABELS 
          SX6    B3-EL.COMMA
          SA6    ASA               SET ASA FLAG 
  
          NZ     X6,GOTOA1         IF NEXT IS NOT A COMMA 
          SA3    A3-B5             NEXT ELEMENT 
          UX7    B3,X3
  
 GOTOA1   SB4    B3-EL.(
          NZ     B4,GOTOEX         IF NOT A ( 
  
          SX6    A3-B5
          BX1    X2                VARIABLE NAME TO X1
          SA6    SELIST            SAVE E LIST POINTER
          RJ     AGVAR             GO ENTER NAME IN SYMTAB AND CHECK  VA
  
*         FORM RLIST MACRO
  
          SA2    AGOMAC            MACRO HEADER WORD
          SA7    MACBUF+2    CA TO SECOND WORD
          LX7    30 
          IX7    X7+X5             30/CA,30/IH
          SA7    AGOCALL           IN CASE DEBUG IS SELECTED
          SX7    X7 
          SA7    MACBUF+1    WORD 1 = ORDINAL OF VARIABLE 
          BX7    X2 
          SA7    A7-B5
  
          SA2    RSELECT
          ZR     X2,GOTOA2         IF R = 0 
          ADDREF B1,REF            ADD A REFERENCE FOR THE VARIABLE 
  
 GOTOA2   PLAB   EL.),E.GO2,GOTOX  PROCESS THE LIST OF LABELS 
  
          SA2    X1                CHECK FOR EOS
          UX3    B3,X2
          SB4    B3-EL.EOS
          SB6    -E.GO1 
          NZ     B4,GOTOEX         IF NO END OF STMT
  
          SA5    GOTOSFL
          SA2    OPTLVL 
          NZ     X5,GOTOA3         IF DEBUG SELECTED
          SX3    X2-2 
          ZR     X3,GOTOA3         IF OPT = 2 
          SA1    TRACEL 
          SA2    DOFLAG 
          IX0    X1-X2
          PL     X0,GOTOA3         BRANCH IF FLOW TRACING 
  
          WRM    MACBUF      ASSIGNED GOTO MACRO TO RLIST 
          EQ     GOTOX
  
*         REMOVE REDUNDANT LABELS FROM LTAB 
  
 GOTOA3   SA1    O.LTAB 
          SX0    B5                X0 = 1 
          SB2    X6-1              L.LTAB - 1 
          MX7    0
          SA7    MACBUF+3    CLEAR LABEL FLAG 
  
 GOTOAL   SA2    X1+B2             LAST ELEMENT 
          SB3    B2-B5             J = I-1
  
+         SA3    X1+B3
          NG     B3,GOTO.L1 
          IX4    X3-X2
          SB3    B3-B5
          NZ     X4,*-1            IF NOT THE SAME
          IX7    X6-X0             ELIMINATE THE LAST ELEMENT 
  
 GOTO.L1  SB2    B2-B5             DECREMENT LOOP INDEX 
          GT     B2,B5,GOTOAL 
  
          ZR     X5,GOTOA3.        IF NO INDEX CHECKING 
  
*         SET UP CALL "BUGGTA( IVAR , #GLN )" 
  
          RJ     =XINITR           NEEDED TO SET UP ARLIST BUFFER 
          SA2    =XN.GL 
          SX6    X2+I.GL     IH   = GL(NGLN)
          SA6    MACBUF+3    FLAG = GL(NGLN)
          SX7    X2+B5             INCREMENT NGLN 
          SA6    AGOCALL+1         STORE IH FOR GL IN IGCALL LIST 
          SA7    A2 
          MX6    0
          SA6    A6+B5             WORD 3 = 0 
          SX7    =8RBUGGTA
          SA7    A6+B5             WORD 4 = 60/ADDRESS OF NAME
          SA1    AGOCALL
          SA2    N.AP 
          BX6    X2 
          SX7    X2+B5             INCREMENT APLIST NUMBER
          SA7    A2 
          RJ     IGCALL 
          SA1    =8RBUGGTA
          CALL   ODCM        OUTPUT DEBUG CALL MACRO
  
 GOTOA3.  SA1    TRACEL 
          SA2    DOFLAG 
          IX6    X1-X2
          NG     X6,GOTOA4         BRANCH IF NO FLOW TRACING
          RJ     =XINITR           NEEDED TO SET UP ARLIST BUFFER 
          SA2    N.GL 
          SA3    MACBUF+3 
          ZR     X3,GLP0     IF GOTOS NOT USED
          SX2    X2-1              ADJUSTMENT IF GOTOS USED 
          EQ     GLP1 
 GLP0     SX6    X2+I.GL
          SA6    MACBUF+3 
 GLP1     SX7    X2+B5             INCREMENT NGLN 
          SA7    A2 
          SX6    X2+I.GL
          SA6    AGOCALL+1         WORD 1 OF ARGLIST
          MX7    0
          SA7    A6+B5             WORD 2 
          SX6    =8RBUGTRA
          SA6    A7+B5             WORD 3 
          SA2    N.AP 
          BX6    X2 
          SX7    X2+B5             INCREMENT APLIST NUMBER
          SA7    A2 
          SA1    AGOCALL
          RJ     IGCALL            GENERATE CALL
          SA1    =8RBUGTRA
          CALL   ODCM        OUTPUT DEBUG CALL MACRO
  
 GOTOA4   SA1    =XL.LTAB 
          SA2    MACBUF+2 
+         SA3    A2+B5
          ZR     X3,*+1            IF NO LABEL
          SX1    X1+B5
          LX1    18          SAVE NUMBER OF LABELS AS SECOND CON
          BX6    X1+X2
          SA6    A2 
          WRM    MACBUF      ASSIGNED GOTO MACRO TO R-LIST
          SA5    MACBUF+3 
          ZR     X5,GOTOA5   IF NO LABEL DEFINITION 
          SB2    OC.LAB 
          PX6    B2,X5
          SA6    A5 
          WRITEW =XF.RLST,A6,B1 
  
  
 GOTOA5   SA1    =XO.LTAB 
          SA3    =XL.LTAB 
          WRITEW =XF.RLST,X1,X3    LABEL LIST TO -RLIST-
          SA1    OPTLVL 
          NZ     X1,GOTOX    IF NOT DEBUG MODE ( OPTLVL " 0 ) 
          WRM    JPB0M       JP  B0+0 MACRO TO RLIST
          EQ     GOTOX
  
          TITLE              COMPUTED GOTO
*         PROCESS COMPUTED GOTO 
  
 GOTOC    SB4    B2-EL.(
          SB6    -E.GO2 
          NZ     B4,GOTOEX         IF FIRST IS NOT A (
          SX6    A3 
          SA6    SELIST            UPDATE SELIST
          PLAB   EL.),E.GO2,GOTOX  PROCESS THE LIST OF LABELS 
          SA2    X1                FIRST AFTER )
          UX3    B2,X2
          SX6    B2-EL.COMMA
          SA6    ASA
          NZ     X6,GOTOC1         IF NOT A COMMA, FLAG AS NON-ANSI 
  
          SA2    A2-B5             NEXT 
          UX3    B2,X2
          SX7    A2 
          SA7    A1                UPDATE SELIST
  
 GOTOC1   SB3    EL.COMMA          PLACE A COMMA PRIOR TO THE EXPRESSION
          PX7    X7,B3             FOR 'ARITH', SO THAT A MONADIC MINUS 
          SA7    A2+B5             WILL BE INTERPRETED PROPERLY.
          SA4    A2-B5
          SB7    EL.EOS 
          UX5    B4,X4
          SB6    -E.GO1 
          EQ     B2,B7,GOTOEX      IF NO VARIABLE 
  
          NE     B2,B5,GOTOC2      IF FIRST IS NOT A NAME 
          EQ     B4,B7,GOTOC3      IF NEXT IS A EOS 
  
 GOTOC2   MX7    59 
          SA7    ASA               SET ASA FLAG 
  
 GOTOC3   CALL   ARITH             EVALUATE THE EXPRESSION
          ADEXTS =8RGOTOER. 
  
*         FORM MACRO CALL 
  
 GOTOC5   SA1    TRACEL 
          SA2    DOFLAG 
          IX6    X1-X2
          NG     X6,NOTRC          BRANCH IF NO FLOW TRACING
          RJ     =XINITR           NEEDED TO SET UP ARLIST BUFFER 
          SX6    B1 
          SA6    TEMP+4            SAVE ACGOER. ORDINAL 
          SA3    XMIT              MACRO HEADER WORD
          SA2    NRLN              NEXT R NUMBER
          BX7    X3+X2
          SA7    MACBUF 
          SX3    X2-1              FORMER R NUMBER
          LX3    16 
          BX6    X3+X2             MACRO WORD 
          SA6    A7+B5
          SA3    STOR              MACRO HEADER WORD
          BX6    X3+X2
          SA6    A6+B5
          SA1    ST.               IH FIELD 
          BX7    X2 
          SA3    STSORD            CA FIELD 
          BX6    X1 
          SA6    A6+B5             IH 
          SA7    A6+B5             NRLN 
          SX6    X7+B5             INCREMENT R NUMBER 
          SA6    A2 
          BX7    X3 
          SA7    A7+B5             CA 
          SB1    1
          WRITEW =XF.RLST,MACBUF,6 TRANSMIT AND STORE MACROS TO -RLIST- 
          SA3    STSORD            ST INDEX 
          SA2    ST.               ST. SYMTAB ORDINAL 
          SB5    1
          LX3    30 
          BX6    X3+X2             IH FOR ARGLIST 
          SA6    AGOCALL           WORD 1 OF ARGLIST
          SA1    N.GL 
          SX7    X1+I.GL
          SA7    A6+B5             WORD 2 
          SA1    L.LTAB            NUMBER OF LABELS 
          SB1    B5 
          RJ     =XCONVERT         LABEL COUNT TO CONS TABLE
          SB5    1
          BX6    X1 
          MX7    0
          SA1    AGOCALL
          SA6    AGOCALL+2         WORD 3 
          SA7    A6+B5             WORD 4 
          SX6    =8RBUGTRC
          SA6    A7+B5             WORD 5 
          SA2    N.AP 
          BX6    X2 
          SX7    X2+B5             INCREMENT APLIST NUMBER
          SA7    A2 
          RJ     IGCALL            GENERATE CALL
          SA1    =8RBUGTRC
          CALL   ODCM        OUTPUT DEBUG CALL MACRO
          SA3    LOAD              MACRO HEADER WORD
          SA2    NRLN 
          BX6    X3+X2
          SX7    X2+B5             INCREMENT R NUMBER 
          SA6    MACBUF 
          SA7    A2 
          SA5    ST.               IH FIELD 
          LX7    X5 
          BX6    X2 
          SB1    1
          SA7    A6+B5
          SA6    A7+B5
          SA3    STSORD            CA FIELD 
          BX7    X3 
          SA7    A6+B5
          SX6    X3+B5             INCREMENT STSORD 
          SA6    A3 
          WRITEW =XF.RLST,MACBUF,4 LOAD MACRO TO -RLIST-
          SA1    TEMP+4            SAVED ACGOER. ORDINAL
          SB5    1
          SB1    X1 
  
 NOTRC    SA3    CGOM              MACRO HEADER WORD
          SA4    N.GL 
          SA5    NRLN 
          SX6    X5+B5             NRLN = NRLN+1
          SA6    A5 
          SB7    MACBUF 
          LX7    X3 
          SX6    B1 
          LX6    30 
          SX0    X4+I.GL
          BX6    X6+X0             30/IH ACGOER,30/IH FOR GL
          SA7    B7 
          SA6    A7+B5             WORD 1 
          SX7    X4+B5             NGLN = NGLN + 1
          SA7    A4 
          SX6    X5-1 
          LX5    16 
          BX6    X5+X6             16/R NO FOR RS,16/R NO OF LOAD 
          SA6    A6+B5             WORD 2 
  
          SA1    L.LTAB            NUMBER OF BRANCHS
          SA2    DUKE 
          SX1    X1+B5
          SX7    X2+B5
          AX7    12 
          LX2    18 
          MX0    42 
          BX1    -X1
          BX4    -X0*X1 
          IX6    X2+X4             18/LINE NUMBER,18/-(NOB+1) 
          ZR     X7,GOTOC6   IF LINENUM < 4096
          SX7    59 
          LX7    36 
          BX6    X7+X6       K3 = 59
 GOTOC6   SA6    A6+B5
          WRM    B7          COMPUTED GOTO MACRO TO RLIST 
          SA1    =XO.LTAB 
          SA3    =XL.LTAB 
          WRITEW =XF.RLST,X1,X3    LABEL LIST TO -RLIST-
          SB5    1
          SA3    =XL.LTAB 
          SX3    X3-4 
          PL     X3,GOTOX    IF MORE THAN 3 BRANCHES
          SB6    -E.GOEFF 
          SB7    GOTOX
          EQ     ERPROI      IF STATMENT MORE EFFICENT THAN CGOTO 
 ODCM     SPACE  4,14 
**        ODCM - OUTPUT DEBUG CALL MACRO. 
* 
*         ENTRY  (X1) = NAME OF EXECUTION TIME ROUTINE. 
* 
*         CALLS  SYMBOL, DARLIST
  
 ODCM     ENTRY. *
          SB7    ODCM1
 ODCM1    EQ     =XSYMBOL 
          SX6    T.CGS
          LX6    P.TYP
          BX7    X6+X2       SET TYPE = CGS 
          SA7    A2 
          MX4    0
          SA5    =XARLPT
          CALL   DARLIST     FLUSH DEBUG MACRO CALL TO RLIST
          EQ     ODCM 
          TITLE              ASSIGN STATEMENT PROCESSOR 
*** 
*         "ASSIGN" STATEMENT PROCESSOR
* 
*         SYNTAX:   ASSIGN <LABEL> TO <VARIABLE> <EOS>
*         ELIST:           -------    ----------------
* 
*         THE VARIABLE MUST BE AN INTEGER VARIABLE
* 
          SPACE  3
 E.CUL    EQU    18                CONFLICTING USE OF A LABEL 
 E.ASGN   EQU    111               ASSIGN STMT SYNTAX ERROR 
 E.ASGN2  EQU    179               VARIABLE NOT INTEGER 
          SPACE  3
 M.ASGM   RMEQU  106B        ASSIGN MACRO ORDINAL 
  
 ASGM     RMHDR  M.ASGM,2 
          SPACE  3
 ASGNX    SB7    ASSIGN            RETURN ADDRESS 
          EQ     ERPRO
  
 ASSIGN   ENTRY.
          SA1    SELIST 
          SA2    X1                FIRST ENTRY
          UX3    B2,X2
          SB6    -E.ASGN           BAD SYNTAX 
          NZ     B2,ASGNX          IF NOT A CONSTANT
          SA1    X2                FETCH CONSTANT 
          AX2    18 
          SB1    X2                B1 = CHAR COUNT
          AX3    48-3              POSITION TYPE
          SB3    X3 
          NE     B3,B5,ASGNX       IF NOT TYPE INTEGER
  
+         SB7    *+1
          EQ     =XLABCON          GO CONVERT THE LABEL AND ENTER IN SYM
  
          SX0    T.LAB
          EQ     ASGN1
  
          MX3    2                 LABEL IN THE TABLE 
          LX3    2+P.RFN
          BX0    X3*X2
          ZR     X0,ASGN1          IF NO PREVIOUS REF AS A FORMAT LABEL 
          SX2    B1 
          CALL   PSYM              FORMAT NAME FOR ERPRO
          SB6    E.CUL
          EQ     ASGNX
  
 ASGN1    LX0    P.TYP
          BX2    X0+X2             SET TYPE 
 RSN      BIT    P.RSN-P.RAS
          SX3    RSN+1
          LX3    P.RAS
          BX6    X3+X2             SET RSN AND RAS BITS 
          SA6    A2                STORE IN SYMTAB
  
          SA4    ASGM 
          SX7    B1 
          BX6    X4 
          SA6    MACBUF            STORE THE HEADER WORD
          SA7    A6+B5             SAVE ORDINAL OF THE LABEL
  
*         CHECK FOR "NAME" AND "EOS"
  
          SA1    SELIST 
          SA5    X1-2              X5 = EOS 
          SB6    -E.ASGN           BAD SYNTAX 
          SA1    A5+B5             X1 = VARIABLE
          UX4    B1,X5
          SB2    B1-EL.EOS
          NZ     B2,ASGNX          IF NOT EOS 
          UX1    B1,X1
          NE     B1,B5,ASGNX       IF NOT A VARIABLE
          RJ     AGVAR             GO PROCESS VARIABLE
          SA1    A1                WORD A 
          SX0    V.DEF
          BX6    X0+X1             SET DEFINED BIT
          SA6    A1 
  
*         FORM MACRO CALL 
  
          SA1    MACBUF+1          X1 = ORD OF THE LABEL
          LX5    30 
          BX6    X5+X1             30/SYM ORD,30/LABEL ORD
          SA6    A1 
          SA7    A6+B5       STORE CA OF VARIABLE AS SECOND WORD
  
          SA4    RSELECT
          ZR     X4,ASGN5          IF R = 0 
          ADDREF B1,DEF            A DEFINITION FOR THE VARIABLE
          ADDREF MACBUF+1,REF      A REFERENCE FOR THE LABEL
  
 ASGN5    WRM    MACBUF      ASSIGN MACRO TO R-LIST 
          EQ     ASSIGN            EXIT 
  
          END 
