*DECK     ENDPRO
          IDENT  ENDPRO 
 ENDPRO   TITLE  ENDPRO -    PASS 1 END PROCESSOR 
*CALL     SSTCALL 
          SPACE  4
 B=ENDPR  RPVDEF             DEFINE ROUTINE FWA FOR REPRIEVE UTILITY
  
 SYM1     EQU    12B
 SYMEND   EQU    13B
 DUKE     EQU    37B               BINARY LINE COUNT
 PROGRAM  EQU    56B
 NRLN     EQU    64B
 CLABEL   EQU    RA.SSW+23B        NZ FOR LABELED END 
  
          EXT    DOEND=,SYMORD,ST.,CON.,DATA.,DATA..,O.CBT,N.FP 
          EXT    DFLAG,MACFLAG,RSELECT,ERPRO,ERPROI,ASAER 
          EXT    LWAWORK,WB.ECGS,WB.PROG,WB.FP,WB.FMT 
          EXT    LSFLG,SAVTBL,PTU 
          EXT    N.TLAB,O.SCR,LABEL.
  
          TABLES DIM,SCA,FPBL,CON,DATA,EXT,UDV
  
 PEND     RMEQU  102B        EQ  END. MACRO 
 ENDMC    RMHDR  PEND,2 
          SPACE  4,8
**        ERROR MESSAGE NUMBER DEFINITIONS. 
  
 E15      =      15                DEBUG EXECUTION SUPPRESSED 
 E.NRS    EQU    227               END STMT ACTS AS RETURN ( USAS ) 
 E.FND    EQU    232               FUNCTION NOT DEFINED 
 E307     EQU    307         ANSI - CONTROL FLOW INTO END LINE NOT
*                            PERMITTED
  
  
          USE DEBUG 
  
           USE    CODE              FORCE LITERALS TO COME FIRST
          TITLE              MAIN LOOP
 ENTR     MACRO  NAME              ENTER A COMPILER GENERATED SYMBOL
          SA1    =8R_NAME.
          RJ     ECGS 
          SX6    B1 
          SA6    =X_NAME. 
          ENDM
  
 END      ENTRY. **                ** ENTRY/EXIT ** 
  
          IFNE   TEST,0,1 
          RJ     =XSYMDMP          *** DEBUG ***
          SPACE  2
**        WRITE OUT THE DIMENSION TABLE 
* 
          SA2    =XO.DIM
          SA3    =XL.DIM
          OUTSYM ZZ.DIM,X2,X3 
  
          SB1    1
          RJ     OSL         OUTPUT STATIC LOAD *LDSET USE* DIRECTIVES
          SB5    B1 
          RJ     IAC               INSERT ADDRESS S INTO COMMON VARIABLE
          RJ     PSS               PROCESS SPECIAL SYMBOLS
          RJ     DOEND= 
  
          WRM    =2000BS48         TERMINATE RLIST FILE WITH AN *EOQ* 
  
          RJ     DCT               DUMP CON TABLE 
          RJ     PST               PROCESS SYMBOL TABLE 
  
*         INITIALIZE FOR PASS 2 
  
          ENTR   OT          ENTER SPECIAL SYMBOLS FOR PASS 2 
          ENTR   IT 
          ENTR   VD 
  
          OUTUSE CODE.             SET RELOCATION BASE FOR PASS 2 
  
          SA5    RSELECT
          NZ     X5,END1           IF R .NE. 0
          MX6    0
          SA6    L.UDV             DONT SAVE UDV TAB
  
 END1     SA1    SAVTBL            PACK TABLES NEEDED FOR PASS 2
          RJ     PTU               UP TO HIGH CORE
  
*         DETERMINE IF OBJECT CODE IS TO BE GENERATED.
  
          SA1    =XN.FERR 
          ZR     X1,END      IF NO FATAL ERRORS, EXIT...
          SA1    =XDFLAG
          SA2    =XP2NOGO 
          MX6    1
          SA6    A2          PRESET *SUPPRESS OBJECT CODE*
          ZR     X1,END      IF DEBUG NOT SELECTED, EXIT... 
          ZR     X2,END2     IF NO FATAL-TO-DEBUG-EXECUTION ERRORS
          POSTER SEV=INF,NR=E15,RETURN=END     *DBG EXEC SUPPRESSED*
  
 END2     SA1    =XNOGOFLG
          NZ     X1,END      IF C$-NOGO STMT FOUND, EXIT... 
          MX6    0
          SA6    A6          SET *GENERATE OBJECT CODE* 
          EQ     END         EXIT...
          EJECT 
*** 
*         ECGS - ENTER COMPILER GENERATED SYMBOL
*         ENTERS SYMBOL IN SYMTAB, SETS TYPE TO T.CGS, RL = 1 AND RB TO 
*         CODE. 
* 
*         ON ENTRY: 
*                X1 = 8R_NAME 
* 
  
 ECGS1    SA3    WB.ECGS           TYPE RL AND RB 
          BX7    X3+X2             RL+RB
          SA7    A2 
 ECGS     ENTRY. **                ** ENTRY/EXIT ** 
          SYMBOL ,ECGS1            ENTER NAME IN SYMTAB 
          SPACE  3
*** 
*         DSS - DEFINE SPECIAL SYMBOL 
* 
*         ON ENTRY: 
*                X3 = WORD B BITS TO B SET
*                A2,X2 = LOCF(WORD B),WORD B
* 
 DSS      ENTRY. *                 ** ENTRY/EXIT ** 
          MX0    L.ADF
          LX0    L.ADF+P.ADF
          BX2    -X0*X2            CLEAR ADDRESS DEF FIELD
          BX6    X3+X2
          SA6    A2                 UPDATE WORD B 
          EQ     DSS
  
 ENTRY.D  ENTRY.                   RL,RA AND RB OF ENTRY. , SET BY PH1CT
          TITLE              PSS - PROCESS SPECIAL SYMBOLS
*** 
*         PSS - PROCESS SPECIAL SYMBOLS 
* 
 PSS      ENTRY. *                 ** ENTRY/EXIT ** 
          SA1    PROGRAM
          ZR     X1,PSS            EXIT IF A BLOCK DATA SUBPROGRAM
          UX2    B1,X1
          NZ     B1,PSS1           IF NOT A PROGRAM 
  
*         MAIN PROGRAM
  
          SA1    SYM1 
          SA2    X1-3 
          SA3    WB.PROG           RL AND RB
          SA5    =XCO.ER
          LX5    1+P.RA 
          IX3    X3+X5
          RJ     DSS               DEFINE PROGRAM NAME AS 0 IN CODE.
          SA2    =XLSFLG
          SA3    CLABEL 
+         NZ     X3,*+1      IF END STMT IS LABELED 
          NZ     X2,PSS      IF LAST STMT WAS AN UNCONDITIONAL JUMP 
          RJ     ISE         ISSUE MACRO FOR RETURN IN MAIN PROG
          POSTER SEV=ANSI,NR=E307,RETURN=PSS
  
 ISE      ENTRY. *
          ADEXTS =8REND.
          SA1    ENDMC             MACRO HEADER 
          SA2    NRLN              NEXT R NUMBER
          SX5    B1                IH OF END. 
          BX6    X1+X2
          SA3    =XTRACE.          IH OF TRACE. 
          LX3    30 
          BX7    X5+X3
          SA6    MACBUF 
          SA7    A6+B5
          MX7    0
          SA7    A7+B5       K1,K2 = 0
          WRM    MACBUF 
          EQ     ISE
  
*         SUBPROGRAM
  
 PSS1     SA1    SYM1 
          SA0    X1 
          SA2    A0-3              WORD B OF SUBPROGRAM NAME
          SA3    ENTRY.D
          RJ     DSS               SET ADDRESS DEFINITION FIELDS
          SA3    VALUE. 
          NZ     X3,PSS.F          IF A FUNCTION
  
*         SUBROUTINE SUBPROGRAM 
  
          SA2    CLABEL 
          SA4    LSFLG
          NZ     X2,FTSUB2         IF LABELED END,
*                                  FORCE ISSUE OF RLIST *END* MACRO 
          NZ     X4,PSS3           IF LAST STMT WAS RETURN,GOTO, ETC
          EQ     FTSUB2 
  
*         FUNCTION SUBPROGRAM 
  
 PSS.F    LX3    1
          SB2    X3 
          SA1    A0-B2              WORD A OF VALUE.
          SX7    V.DEF
          BX7    X7+X1             SET DEFINED BIT
          SA7    A1 
  
          LX1    59-P.DEF 
          NG     X1,FTSUB1         IF DEFINED 
  
          SB6    -E.FND 
          SB7    FTSUB1 
          EQ     ERPRO             FLAG NO DEFINATION OF FUNCTION 
  
 FTSUB1   SA4    LSFLG
          NZ     X4,PSS3           IF LAST STMT WAS AN UNCONDITIONAL JUM
  
 FTSUB2   RJ     RETURN            OUTPUT RLIST FOR A RETURN STMT 
          SB6    -E.NRS 
          SB7    PSS3 
          EQ     ASAER             INFO DIAGNOSTIC OF NO RETURN STMT
  
*         MOVE F.P. BLOCK LENGTH ACCUMULATED DURING NAMELIST
*         PROCESSING TO WORD B OF THE FORMAL PARAMETERS 
*         SET UP THE ADDRESS DEFINITION FIELDS FOR PASS 2 
  
 PSS3     SA1    O.FPBL 
          SA2    L.FPBL 
          ZR     X2,PSS            IF NO F.P. S 
          SB1    X1 
          SB2    B1+X2             LWA+1
          MX0    L.ADF
          LX0    L.ADF+P.ADF
          SA4    SYM1 
          SA2    X4-5              WORD B OF FIRST F.P. 
          SX7    1S"P.RB" 
          SA5    WB.FP             RL = 1 AND RB = 7
          SA1    O.DIM
          SB4    X1-1              B4 = O.DIM-1 
          SB6    FAKE              ADDRESS OF FAKE SYMTAB ENTRY 
          MX4    L.DIMP 
          LX4    L.DIMP+P.DIMP
          SB3    B5+B5             B3 = 2 
  
 PSS4     SA1    B1                F.P. BLOCK LENGTH
          BX3    -X0*X2            CLEAR DEFINITION AREA
          LX1    P.RA 
          BX6    X5+X3             RL AND RB
          SA2    A2-B3
          BX6    X1+X6             RA 
          SB1    B1+B5
          SA6    A2+B3
          IX5    X7+X5             ADVANCE RB 
          BX1    X4*X6
          ZR     X1,PSS5           IF NO DIM TBL ENTRY
          LX6    59-P.EXT 
          AX1    P.DIMP-1 
          MI     X6,PSS5           IF AN EXTERNAL 
          SX6    B6 
          SA6    X1+B4             STORE FAKE SYMTAB ADDR FOR PST6
 PSS5     LT     B1,B2,PSS4 
          EQ     PSS
  
 FAKE     BSSZ   2                 FAKE SYMTAB ENTRY FOR F.P. S 
*                                  WITH DIMENSIONS
          TITLE              PST - PROCESS SYMBOL TABLE 
*** 
*         PST - PROCESS SYMBOL TABLE
*         SCAN SYMBOL TABLE FOR:  
*                EXTERNAL SYMBOLS 
*                SYMBOLS WITH DIMTAB ENTRIES
*                USEAGE DEFINED VARIABLES 
* 
*         FORM TEMPORARY TABLES FOR EXTERNAL SYMBOLS AND
*         USEAGE DEFINED VARIABLES
*         LINK DIMTAB TO SYMTAB BY STORING ADDRESS OF SYMTAB ENTRY
*         IN APPROPIATE DIMTAB ENTRY
* 
*         PROCESS THE TEMPORARY TABLES: 
*         APPEND SPECIAL CHARACTERS TO EXTERNALS
*         DEFINE THE ADDRESS"S OF THE USEAGE DEFINED VARIABLES
*         AND ISSUE STORAGE FOR THEM
*         DEFINE ALL SYMBOLS WITH DIMTAB ENTRIES
*         PROCESS USEAGE DEFINED VARIABLES IN DATA STMTS
* 
  
 PST      ENTRY. *                 ** ENTRY/EXIT ** 
          SA1    SYM1 
          SA2    ST.
          SA3    SYMORD 
          SA4    O.DIM
          SA5    L.DIM
  
*         SPACE NEEDED = SYMORD - ST. - L.DIM/2 
  
          AX5    1                 NOTE THAT BECAUSE OF THE SIZE OF 
          IX6    X3-X2             PHASE 2 OF THE COMPILER AND THE
          IX7    X6-X5             CONSTRAINT THAT SYMORD < 10000B
          SA7    F.UDV-1           THIS SPACE WILL ALWAYS BE AVAILABLE
          SB6    O.CBT             LWA+1 OF EXT TBL 
  
          SB7    A7+B5
          SB1    B7-B6             -(SPACE AVAIL) 
          SX0    X7+B1             SPACE NEEDED - SPACE AVAIL 
          PL     X0,=XCTBLOVL 
  
*         SET UP THE REGISTERS
  
          SA0    X1                A0 = SYM1
          LX2    1
          SB1    X2                B1 = INDEX = 2*ORD(ST.)
          LX3    1
          SB2    X3                B2 = LIMIT = 2*(N.SYMBOLS+1) 
          SB3    B5+B5
          SB4    X4-1              B4 = O.DIM-1 
          SB7    59-P.EXT 
          SX4    T.LAB
          LX4    P.TYP
          MX3    L.DIMP 
          LX3    L.DIMP+P.DIMP
          MX0    L.TYP
          EQ     PST.I
  
 PST.E    ZR     X6,PST.I          IGNORE LABELS
          SX6    B1-B3             2*ORD
          SA6    B6-B5
          SB6    B6-B5
  
 PST.I    SA1    A0-B1             WORD A 
          SA2    A1-B5             WORD B 
          GE     B1,B2,PST.2       IF FINISHED
          BX5    X0*X2
          LX1    59-P.FUN 
          IX6    X5-X4             TYPE - T.LAB 
          SB1    B1+B3
          LX5    B7,X2             SHIFT( WORD B , 59-P.EXT ) 
          BX7    -X6+X1 
          NG     X5,PST.E          IF EXT OR LABEL WITH BIT SET 
          NG     X7,PST.I          IGNORE TYPES 6-15B AND LOCAL FUNCTION
  
*         MUST BE A VARIABLE OR ARRAY 
  
          BX5    X3*X2             EXTRACT DIMP FIELD 
          LX1    P.FUN-P.COM
          ZR     X5,PST.V          IF NOT DIMENSIONED 
          AX5    P.DIMP-1 
          SX6    A1 
          SA6    X5+B4             SYMTAB ADDRESS TO WORD 2 OF DIM ENTRY
          EQ     PST.I
  
*         USEAGE DEFINED VARIABLE - SAVE WC AND SYMORD IN UDV TBL 
  
 PST.V    NG     X1,PST.I          IGNORE COMMON VARIABLES
          AX2    P.TYP
          SX5    B5 
          SX1    X2-T.DBL 
          AX1    L.TYP             -0 IF SINGLE PRECISION, ELSE 0 
          BX6    -X1*X5            0 OR 1 
          SX1    X6+B5             WC = 1 OR 2
          SX7    B1-B3             2*ORD
          LX1    36 
          LX7    18-1 
          BX7    X1+X7
          SA7    A7+B5             STORE ENTRY
          EQ     PST.I
  
*         SAVE POINTERS TO THE TABLES 
  
 PST.2    SX7    F.UDV
          SX5    A7+B5             LWA+1
          IX6    X5-X7             LENGTH 
          SA7    O.UDV
          SA6    L.UDV
          SB7    O.CBT
          SX7    B7-B6
          SA7    L.EXT
          SX6    B6 
          SA6    O.EXT
          SA6    LI 
          SPACE  3
*         APPEND SPECIAL CHARACTERS TO THE EXTERNAL SYMBOLS THAT
*         ARE THE SAME AS THOSE IN THE LIBRARY
  
          ZR     X7,PST5           IF NONE
          SB1    B6                FWA
          SB2    B7                LWA+1
          SX5    3
          MX0    L.NAME 
          LX5    P.RL              RL = 3 FOR EXTERNALS 
  
 PST1     SA4    B1 
          SB3    X4 
          MX3    L.ADF
          SA1    A0-B3             WORD A 
          LX3    L.ADF+P.ADF
          SA2    A1-B5             WORD B 
          BX6    -X3*X2            CLEAR DEFINITION AREA
          IX7    X5+X6             SET RL = 3 
          SA7    A2 
          BX6    X0*X1
          SB1    B1+B5             ADVANCE INDEX
          LX1    59-P.FUN 
          NG     X1,PST1A          IF A FUNCTION
          NG     X2,PST3           IF A FILE NAME 
  
 PST1A    LX2    59-P.BEF 
          PL     X2,PST2           IF NOT BASIC EXTERNAL
 #LIB     IFNE   .CDCLIB,0
          SA1    =XUOFLAG 
          ZR     X1,PST1AA   IF *UO* NOT SELECTED 
          BX1    X2 
          LX1    1+P.BEF-P.RA 
          SX1    X1 
          LX1    P.RA 
          BX7    X1+X7       B-REGS PRESERVED IN CASE OPT=2 
          SA7    A7 
 PST1AA   BSS    0
 #LIB     ENDIF 
          MX1    60-L.TYP 
          LX2    1+P.BEF-P.TYP
          BX7    -X1*X2            TYPE FIELD 
          SX4    X7-T.CGS          CHECK FOR COMPILER GENERATED SYMBOL
          ZR     X4,PST2
  
          SX1    1R 
          MX3    1
          LX1    24 
          LX3    2+18 
  
 PST1B    BX7    X6*X1
          BX4    X7-X1
          NZ     X4,PST1C          SENSE NON BLANK CHARACTER
          LX1    6
          LX3    6
          EQ     PST1B
  
 PST1C    BX6    X6-X3             APPEND A . TO THE NAME 
  
 PST2     SA1    A2+B5             WORD A 
          BX2    -X0*X1            SYMTAB BITS
          IX6    X6+X2             NAME + SPECIAL CHAR
          SA6    A1                UPDATE SYMTAB ENTRY
 PST3     LT     B1,B2,PST1 
  
          SA5    MACFLAG
          ZR     X5,PST5           IF COMPS IMAGES NOT NECESSARY
  
          SA1    LI                O.EXT
 PST4     SA5    X1 
          AX6    B5,X5             SYMTAB ORD 
          SA1    =10H  EXT
          RJ     =XF1AMAC          OUTPUT EXT STMT
          SA1    LI 
          SX2    O.CBT
          SX6    X1+B5
          IX0    X6-X2             I - L
          SA6    A1 
          BX1    X6 
          NG     X0,PST4           IF NOT FINISHED
          SPACE  3
*         MOVE THE ADDRESS ASSIGNMENTS THAT WHERE MADE IN "DPCLOSE" 
*         FROM THE DIM TABLE TO SYMTAB
  
 PST5     SA1    O.DIM
          SA2    L.DIM
          ZR     X2,PST7           IF NONE
          SB1    X1                FWA
          SB2    B1+X2             LWA+1
          SA4    B1                WORD 1 
          SA5    B1+B5             WORD 2 
          SB3    B5+B5             B3 = 2 
          MX0    L.RL+L.RA
          SX7    V.COM
          LX0    L.RL+L.RA+P.RA      MASK TO CLEAR RL AND RA FIELDS 
  
 PST6     SA1    X5                WORD A 
          SA2    A1-B5             WORD B 
          BX5    X7*X1             COMMON BIT 
          SX6    X4                RA 
          IX3    X5+X7             RL = 1 OR 2
          LX6    P.RA 
          NZ     X5,PST6A          IF IN COMMON 
          SX4    5S"P.RB"          RB FOR DATA..
          IX6    X6+X4             RA + RB
 PST6A    SB1    B1+B3
          BX2    -X0*X2            CLEAR RL,RA
          SA4    B1                NEXT DIM WORD
          LX3    P.RL-P.COM 
          IX1    X6+X2             + RA 
          SA5    B1+B5
          BX6    X3+X1             + RL 
          SA6    A2                UPDATE WORD B
          LT     B1,B2,PST6 
          SPACE  3
*         ASSIGN ADDRESS"S TO THE USEAGE DEFINED VARIABLES
  
 PST7     SA2    L.UDV
          ZR     X2,PST9           IF NO USEAGE DEFINED VARIABLES 
          OUTUSE DATA.
          SA2    L.UDV
          SB1    F.UDV             FWA
          SB2    B1+X2             LWA+1
          MX0    L.ADF
          SA5    SYM1 
          SA0    X5                A0 = SYM1
          LX0    L.ADF+P.ADF
          SA4    DATA.             BLOCK LENGTH 
          BX7    X4 
          SA1    B1 
          SA5    WB.FMT 
          SB7    P.RA 
  
 PST8     AX1    18-1 
          SB4    X1+B5             2*ORD+1
          AX1    36-17             WC 
          SA2    A0-B4             WORD B 
          SB1    B1+B5             I = I+1
          BX3    -X0*X2            CLEAR DEFINITION AREA
          LX4    B7,X7
          BX6    X3+X5             + RL+RB
          IX7    X7+X1             INCREMENT BLOCK LENGTH 
          SA1    B1                NEXT WORD
          BX6    X4+X6             + RA 
          SA6    A2 
          LT     B1,B2,PST8        IF NOT FINISHED
          SA4    DATA.
          IX1    X7-X4             NUMBER OF NEW ADDITIONS TO DATA. 
          SA7    A4 
  
          SA2    MACFLAG
          ZR     X2,PST8A 
          SA2    L.UDV
          SX6    F.UDV             FWA
          SA5    BSS.OP 
          BX7    X2 
          RJ     OSC               ISSUE STORAGE TO COMPS 
          EQ     PST9 
  
PST8A     SA5    BSS.OP 
          SA2    =7L
          MX0    L.NAME 
          BX6    X2                BLANK LABEL FOR THIS LINE
          RJ     WST
  
          SPACE  3
*         DEFINE THE ADDRESS"S OF USEAGE DEFINED VARIABLES THAT FIRST 
*         APPEARED IN DATA STMTS
*         ALSO ADD NAMES TO UDV TABLE FOR STRAY NAME SEARCH IN "REFMAP" 
  
 PST9     SA1    O.DATA 
          SA2    L.DATA 
          ZR     X2,PST11    IF NO USAGE DEFINED DEFINED
          SA5    SYM1              VARIABLES IN DATA STMTS
          SA0    X5 
          MX0    L.ADF
          SB1    X2                LENGTH 
          LX0    L.ADF+P.ADF
          SA1    X1                FIRST MEMBER 
          SA3    L.UDV
          SX6    X3+B1             INCREMENT UDV LENGTH 
          SB6    F.UDV+X3          B6 = UDV STORE ADDRESS 
          SA6    A3 
          SX4    V.COM
          SA5    WB.FMT            RL = 1 , RB = DATA.
  
 PST10    BX6    X1 
          SX7    X1                RA 
          AX1    18-1 
          SA6    B6 
          SB2    X1                2*ORD
          LX7    P.RA 
          SA3    A0-B2             WORD A 
          SA2    A3-B5             WORD B 
          BX6    -X4*X3            TURN OFF COMMON BIT
          SA6    A3 
          SB1    B1-B5
          BX2    -X0*X2 
          IX7    X5+X7             RL,RA,RB 
          SA1    A1+B5             NEXT 
          BX6    X7+X2
          SB6    B6+B5             ADVANCE UDV STORE ADDRESS
          SA6    A2 
          NZ     B1,PST10          IF NOT FINISHED
          SPACE  3,8
*         PROPAGATE DEFINED BIT IN SYMTAB THROUGH NON-COMMON EQUIVALENCE
*         CLASSES.
  
PST11     SA1    SYM1 
          SA0    X1          A0 = BASE ADDRESS OF SYMBOL TABLE
          SA1    =XL.EQV
          ZR     X1,PST      IF NO EQUIVALENCE CLASSES
          SA2    =XO.EQV
          MX0    18 
          IX3    X1+X2
          SA1    X2          PRELOAD EQUIV ENTRY
          LX0    18+18
          SB1    X1+B5
          SX7    V.DEF
 PST12    EQ     B1,PST14    IF SCAN OF CLASS COMPLETE
          BX5    X0*X1
          SB1    B1-B5
          AX5    18-1 
          SB2    X5 
          SA5    A0-B2       WORD A 
          SA1    A1+B5
          BX4    X7*X5
          ZR     X4,PST12    IF NOT DEFINED 
          SA1    X2 
          SB1    X1+B5
 PST13    EQ     B1,PST14    IF UPDATE OF CLASS COMPLETE
          BX5    X0*X1
          SB1    B1-B5
          AX5    18-1 
          SB2    X5 
          SA5    A0-B2       WORD A 
          SA1    A1+B5
          BX6    X7+X5       SET DEF BIT
          SA6    A5          UPDATE WORD A
          EQ     PST13
  
 PST14    SX2    A1 
          SB1    X1+B5
          IX4    X2-X3
          MI     X4,PST12    IF NOT ALL CLASSES SCANNED 
          EQ     PST
          EJECT 
*** 
*         OSC - OUTPUT STORAGE FOR SYMBOLS IN A TABLE 
*         ON ENTRY: 
*                X5 = PSEUDO OP WORD
*                X6 = FWA OF THE TBL, X7 = LENGTH 
*                ENTRIES IN THE TABLE FORMATTED AS: 
*                  6/J,18/WC,18/SYMORD,18/J 
* 
 OSC      ENTRY. **                ** ENTRY/EXIT ** 
          SA6    LI 
          IX7    X6+X7
          SA7    A6+B5             LIMIT
          BX7    X5 
          SA7    PSEUDO 
  
 OSC1     SA1    X6                6/J,18/WC,18/SYMORD,18/J 
          SA2    SYM1 
          AX1    18-1 
          SX3    X1 
          IX4    X2-X3
          SA2    X4                WORD A 
          AX1    36-17
          SX1    X1                X1 = WC
          MX0    L.NAME 
          BX6    X0*X2             X6 = 7L_NAME 
          SA5    PSEUDO 
          RJ     WST
  
          SA1    LI 
          SA2    A1+B5             LIMIT
          SX6    X1+B5             LI = LI+1
          IX0    X6-X2             I - L
          SA6    A1 
          NG     X0,OSC1           IF MORE MEMBERS
          EQ     OSC
  
 OSC.WD   DATA   7R      B
 BSS.OP   VFD    12/2LS ,30/48,18/3L BS 
          EJECT 
 LI       BSS    2                 LOOP INDEX AND LIMIT 
 PSEUDO   BSS    1                 PSEUDO OP
 CBUF     BSS    3                 3 WORD BUFFER FOR COMPS IMAGES 
  
*** 
*         WST - WRITE STORAGE TO COMPS
* 
*         ON ENTRY: 
*                X0 = MASK(42) , X1 = WORD COUNT IN BINARY
*                X5 = PSEUDO OP WORD , X6 = 7L_NAME 
* 
 WST      ENTRY. **                ** ENTRY/EXIT ** 
          BX7    -X0*X5 
          MX0    18 
          IX6    X6+X7             FIRST 3 CHARS OF OP TO NAME
          BX7    X5*X0             REMAINER OF THE OP 
          AX5    18 
          SB6    X5                SHIFT COUNT
          SA6    CBUF 
          SB1    1
          SA5    OSC.WD            7R      B
          SB2    6
          MX0    57 
          BX6    X5                INITIALIZE RESULT
 WST1     BX2    -X0*X1 
          AX1    3
          SX3    X2+1R0-1R
          LX4    B2,X3
          SB2    B2+6 
          IX6    X4+X6             ADD DIGIT TO STRING
          NZ     X1,WST1
          SB3    59 
          MX0    1
          SB3    B3-B2
          AX0    B3,X0             MASK(60-6*NCHAR) 
          BX6    -X0*X6            REMOVE LEADING BLANKS
          SB6    B6-B2
          LX6    B6,X6             LEFT ADJUST
          BX7    X7+X6
          SA7    A6+B1
          MX0    48 
          SB7    B1+B1             (B7) = 2 = WORD COUNT
          BX5    -X0*X7 
          SX6    B0 
          ZR     X5,WST2           IF WE HAVE A ZERO BYTE 
          SA6    A7+B1
          SB7    B7+B1             WORD COUNT = 3 
 WST2     WRITEC =XF.CMPS,CBUF,B7  PSEUDO-OP TO -COMPS- 
          SB5    B1+
          EQ     WST         EXIT 
          TITLE              DCT - DUMP THE CON TABLE 
*** 
*         DCT - DUMP CON TABLE
* 
 DCT      ENTRY. *                 ** ENTRY/EXIT ** 
          SA5    DATA.
          SA4    CON.              ORD(CON.)
          SA3    SYM1 
          LX4    1
          IX0    X3-X4
          SA2    X0-1              WORD B 
          LX5    P.RA 
          BX6    X5+X2             INSTALL BLOCK RELATIVE ADDRESS 
          AX5    P.RA 
          SA6    A2                UPDATE WORD B
  
          SA2    L.CON
          ZR     X2,DCT1           IF NO CONSTANTS
          IX6    X2+X5             UPDATE LENGTH OF DATA. BLOCK 
          SA6    A5 
          SA1    O.CON
          SA3    =18LCON. BSS 0B
          RJ     ODW               DUMP THE CON TABLE 
  
 DCT1     SA5    N.TLAB 
          ZR     X5,DCT            IF NOT TRACING LABELS
          ALLOC  SCR,X5            GET SPACE
  
          SA3    SYM1 
          SA4    LABEL. 
          LX4    1
          IX0    X3-X4
          SA2    X0-1              WORD B 
          SA4    DATA.
          SA5    N.TLAB 
          IX7    X4+X5             INCREMENT DATA. LENGTH 
          SA7    A4 
          LX4    P.RA 
          BX6    X4+X2             INSTALL BLOCK RELATIVE ADDRESS 
          SA6    A2 
  
*         SCAN THE SYMBOL TABLE FOR STATEMENT NUMBERS WITH
*         TRACE ORDINALS AND FORM A TABLE OF VFD STMT OF THE FORM:  
*         30/_NNNNN,30/BINARY LINE NUMBER THAT LABEL IS DEFINED ON
  
          SB7    X5 
          SB6    X5 
          SA5    O.SCR
          SB4    X5-1              B4 = FWA-1 OF TABLE OF VFD STMTS 
          SA1    SYM1 
          SA2    SYMEND 
          SA3    CON. 
          LX3    1
          IX1    X1-X3
          SB1    X1                B1 = INDEX 
          SB2    X2                LWA+1
  
          MX0    L.TYP+1           MASK FOR TYPE AND GEN BIT
          SX3    T.LAB
          SB3    B5+B5
          MX5    30 
          LX3    P.TYP             X3 = T.LAB S P.TYP 
          MX7    60-L.TRO 
  
 DCT2     SA2    B1-B5             WORD B 
          SB1    B1-B3
          LT     B1,B2,DCT3        IF FINISHED
          BX1    X0*X2             TYPE AND GEN LABEL BITS
          IX4    X1-X3
          NZ     X4,DCT2           IF NOT A STMT LABEL
          LX2    59-P.DSN 
          PL     X2,DCT2           IF A FORMAT LABEL
          AX2    59-P.DSN+P.TRO 
          SA1    A2+B5             WORD A 
          BX4    -X7*X2            LABEL TABLE ORDINAL
          ZR     X4,DCT2           IF NONE
          LX1    6
          BX1    X5*X1             5L_NNNNN 
          AX2    P.DLN-P.TRO
          BX2    -X7*X2            LINE NUMBER OF DEF 
          IX6    X1+X2
          SA6    X4+B4             STORE ENTRY
          SB7    B7-B5
          NZ     B7,DCT2           IF MORE TO GO
  
 DCT3     SX1    B4+B5             FWA
          SX2    B6                LENGTH 
          SA3    =18LLABEL. BSS 0B
          RJ     ODW
          EQ     DCT
          SPACE  3
*** 
*         ODW - OUTPUT DATA WORDS 
*         OUTPUTS LINE IMAGES OF THE FORM  "  DATA  WORDN" FOR
*         EACH WORD IN THE TABLE DEFINED BY X1 AND X2 
*         ON ENTRY: 
*                X1,X2 = FWA AND LENGTH OF DATA TABLE 
*                A3 = FWA OF BCD FOR LABEL DEFINING TABLE 
* 
 ODW      ENTRY. *                 ** ENTRY/EXIT ** 
          SX7    A3 
          BX6    X1 
          SA7    CBUF              TEMP SAVE ADDR OF LABEL DEFINITION 
          SB1    1
          IX7    X1+X2             LWA+1
          SA6    LI 
          SA7    A6+B1
          OUTUSE DATA.             GET IN THE RIGHT RB
          SA1    CBUF 
          WRITEC =XF.CMPS,X1,2     LABEL DEFINITION TO -COMPS-
          SA1    LI 
          NO
          BX6    X1 
 ODW1     SA1    X6                TABLE ENTRY
          RJ     BTOCT             CONVERT IT 
          MX0    18 
          SA2    =7L  DATA
          BX3    -X0*X6            SAVE LOWEST 7
          BX6    X0*X6
          LX6    3*6               RIGHT JUSTIFL HIGHEST 3
          BX6    X2+X6             FORM 1ST WORD
          LX3    3*6               SHIFT LOWEST 7 TO HIGHEST 7
          BX4    -X0*X7            SAVE NEXT LOWEST 7 
          BX7    X0*X7
          LX7    3*6               RIGHT JUSTIFY NEXT HIGHEST 3 
          BX7    X3+X7             FORM 2ND WORD
          SA6    CBUF              1ST WORD  *  DATA NNN* 
          LX4    3*6
          SA7    A6+B1             2ND WORD 
          SX6    2S12              DIS B
          BX6    X4+X6
          SA6    A7+B1             3RD WORD  *7123456B00* 
          WRITEC =XF.CMPS,CBUF,3   *  DATA N...NB00* TO -COMPS- 
          SA4    LI 
          SA5    A4+B1             LWA+1
          SX6    X4+B1
          IX0    X6-X5             I - L
          SA6    A4 
          NG     X0,ODW1           IF NOT FINISHED
          SB5    B1+
          EQ     ODW
          SPACE  3
*** 
*         BTOCT - CONVERT BINARY NUMBER TO OCTAL
* 
*         ON ENTRY: X1 = NUMBER 
*         ON EXIT: X6,X7 OCTAL CONSTANT 
* 
 BTOCT    ENTRY. **                ** ENTRY/EXIT ** 
          SB4    6
          SX5    1R0
          MX3    3
          SB2    60 
          MX7    0
          SB6    B2+B2             B6 = 120 
  
 BTOCTL   BX4    X1*X3             EXTRACT A DIGIT
          SB2    B2-B4             B2 = B2-6
          LX4    3
          IX4    X4+X5
          SB6    B6-B4             B6 = B6-6
          LX4    B2,X4             POSITION 
          BX7    X4+X7             OR IN
          LX1    3                 NEXT DIGIT 
          NZ     B2,BTOCTL
  
          ZR     B6,BTOCT          IF FINISHED
          BX6    X7                SAVE FIRST 10 DIGITS 
          SB2    B6                B2 = 60
          MX7    0
          EQ     BTOCTL 
          TITLE              IAC - INSERT ADDRESS S INTO COMMON VARIABLE
,S
*** 
*         IAC - INSERT ADDRESS"S INTO COMMON VARIABLES
* 
*         WHEN THE D OPTION IS SELECTED, THE ADDRESS"S OF COMMON VARIABL
*         WITHOUT A DIM ENTRY MUST BE SAVED IN A TEMPORARY TABLE UNTIL
*         THE END OF PASS 1 WHEN THE DEBUG PROCESSOR NO LONGER
*         ACTIVE. AT THIS TIME THE ADDRESS"S CAN BE INSERTED INTO 
*         THE SYMBOL TABLE ENTRIES. 
* 
 IAC      ENTRY. *                 ** ENTRY/EXIT ** 
          SA1    O.SCA
          SA2    L.SCA
          ZR     X2,IAC            IF NO COMMON VARIABLES 
  
          SA5    SYM1 
          SB1    X1                FWA
          SB2    B1+X2             LWA+1
          SA0    X5                A0 = SYM1
          MX0    L.RL+L.RA
          SX5    B5+B5
          LX0    L.RL+L.RA+P.RA    POSITION MASK
          SA1    B1 
          LX5    P.RL              RL = 2 
  
 IAC1     SX7    X1                RA 
          AX1    18-1 
          SB3    X1+B5             2*ORD+1
          LX7    P.RA 
          SA2    A0-B3             WORD B 
          SB1    B1+B5
          BX3    -X0*X2            CLEAR DEFINITION AREA
          MX2    L.DIMP 
          LX2    L.DIMP+P.DIMP
          IX4    X5+X7             RL + RA
          SA1    B1                NEXT 
          BX6    X4+X3
          BX6    -X2*X6      CLEAR DIMP 
  
          SA6    A2 
          LT     B1,B2,IAC1 
          EQ     IAC
 OSL      TITLE  OSL - OUTPUT STATIC LOAD DIRECTIVES
**        OSL - OUTPUT STATIC LOAD DIRECTIVES.
* 
*         SCANS STATIC LOAD TABLE (LSTPRO/STLTAB).  FORMATS EACH
*         SELECTED DECK NAME AS A  *  LDSET USE=STLXYZ.* DIRECTIVE, 
*         AND WRITES IT TO THE *COMPS* FILE.
* 
* 
*         ENTRY  (B1) = 1.
*                STLTAB/LSTPRO - DECK NAME TABLE, FORMAT--
*                            1/SELECT BIT, 17/0, 42/0L DECK NAME
*                   WITH *SELECT*=1 FOR EACH DECK NAME TO BE OUTPUT.
*                   A ZERO WORD TERMINATES THE TABLE. 
* 
*         EXIT   (B1) = 1.
*                LDSET DIRECTIVES WRITTEN TO *COMPS* FILE.
* 
*         USES   ALL. 
* 
*         CALLS  WRITEC.
  
          QUAL   OSL
  
  
 OSL      SUBR               ** ENTRY/EXIT ** 
          SA2    =XCO.STA 
          SA3    PROGRAM
          SA1    =XSTLTAB-1 
          ZR     X2,EXIT.    IF STATIC LOAD OPTION NOT SELECTED 
          ZR     X3,EXIT.    IF BLOCK DATA SUBPROGRAM 
          LX3    11 
          MX0    1        SELECTION BIT MASK
          MI     X3,OSL2  IF NOT MAIN PROGRAM 
          SA2    A1+12    PICK UP LAST STLTAB ENTRY 
          IX6    X0+X2    SET SELECT BIT FOR CMM INTERFACE
          SA6    A2 
 OSL2     SA1    A1+B1
          SX6    A1 
          ZR     X1,EXIT.    IF END OF TABLE
          PL     X1,OSL2     IF ENTRY NOT SELECTED
          SA6    OSLA        SAVE CURRENT TABLE ADDR FOR RESTART
          SA2    OSLB+1 
          LX1    -1*6 
          MX0    4*6
          BX2    X0*X2       EXTRACT *USE=* 
          BX0    -X0*X1      EXTRACT *STLXYZ* 
          IX6    X2+X0
          SA6    A2 
          WRITEC =XF.CMPS,OSLB,3   *LDSET USE=STLXXX.* TO *COMPS* FILE
          SA2    OSLA 
          SA1    X2 
          EQ     OSL2 
  
  
 OSLA     BSS    1           SAVED CURRENT *STLTAB* WORKING ADDRESS 
 OSLB     DATA   10H  LDSET 
          DATA   10HUSE=STLXYZ
          DATA   1C.
 OSL      SPACE  4,2
          QUAL   *
 OSL      =      /OSL/OSL 
          TITLE                  BEFTB: BASIC EXTERNAL FUNCTION TABLE 
*CALL     COUNTMC 
 BASIC    SPACE  3,14 
**        BASIC - BASIC EXTERNAL FUNCTION ( *BEF* ) SPECIFICATION MACRO 
* 
* FNAME   BASIC  FTYP,(ARGTYPS),METHOD
* 
*         ARGTYPS - ARGUMENT TYPES
          NOREF  .1 
  
          MACRO  BASIC,FNAMEXX,FTYP,ARGS
 .ACNT    SET    0
 .DUM     SET    0
 TYMIC    MICRO  1,,
          COUNT  .ACNT,.DUM,ARGS
+         VFD    42/0H_FNAMEXX,18/V.FUN 
          VFD    L.TYP/FTYP 
          POS    P.EXT+1
          VFD    1/1
          POS    P.FARG+6 
          VFD    6/.ACNT
          POS    P.LIB+1
          VFD    1/1
          POS    P.BEF+1
          VFD    1/1
* 
          IF     -DEF,.FNAMEXX,1
 .FNAMEXX EQU    0
* 
          POS    P.RA+18
          VFD    18/.FNAMEXX,*P/0 
 .1       SET    6*.ACNT
          VFD    .1/"TYMIC"B,*P/0 
          ENDM
  
 LOGICAL  EQU    T.LOG
 INTEGER  EQU    T.INT
 REAL     EQU    T.REAL 
 DOUBLE   EQU    T.DBL
 COMPLEX  EQU    T.CPLX 
 OCTAL    EQU    T.OCT
 ANYSNGL  EQU    7
 ANYDBL   EQU    10B
 BRP      SPACE  3,14 
**        BRP - SPECIFY LIST OF B-REGISTERS PRESERVED BY A *BEF*
* 
*         BRP    FNAME,(LIST) 
* 
*         LIST - A LIST OF REGISTER NUMBERS, I.E. - (5,6,7) . 
 BRP      MACRO  FNAME,LIST 
 .1       SET    0
          IRP    LIST 
 .1       SET    .1+1S_LIST 
          IRP 
 .FNAME   EQU    .1 
          ENDM
 BRP      SPACE  2,14 
          BRP    ASIN,(6,7) 
          BRP    ACOS,(6,7) 
          BRP    ALOG,(5,6,7) 
          BRP    ALOG10,(5,6,7) 
          BRP    ATAN,(5,6,7) 
          BRP    ATAN2,(5,6,7)
          BRP    COS,(5,6,7)
          BRP    SIN,(5,6,7)
          BRP    EXP,(5,6,7)
          BRP    SQRT,(5,6,7) 
          BRP    COSH,(5,6,7) 
          BRP    SINH,(5,6,7) 
          BRP    DEXP,(5,6,7) 
          BRP    DTANH,(6,7)
          BRP    DCOSH,(6,7)
          BRP    DSINH,(6,7)
          BRP    DASIN,(6,7)
          BRP    DACOS,(6,7)
          BRP    ERF,(5,6,7)
          BRP    ERFC,(5,6,7) 
          BRP    ATANH,(5,6,7)
          BRP    SIND,(5,6,7) 
          BRP    COSD,(5,6,7) 
          BRP    TAND,(5,6,7) 
 DEFTB    TITLE  BEFTB - BASIC EXTERNAL FUNCTION TABLE
**        BEFTB - BASIC EXTERNAL FUNCTION TABLE 
*         EACH ENTRY CONSISTS OF 3 WORDS, THE FIRST 2 ARE WORDS A AND B 
*         OF A PROTOTYPE SYMBOL TABLE ENTRY. THE THIRD WORD CONTAINS A
*         LIST OF THE FUNCTION ARGUMENT TYPES.
          SPACE  1
          ENTRY  BEFTB,L.BEFTB     FWA AND LWA+1 OF BEFTB 
BEFTB     BSS    0               BASIC EXTERNAL FUNCTION TABLE
          LIST   -R 
EXP       BASIC  REAL,(REAL)
DEXP      BASIC  DOUBLE,(DOUBLE)
CEXP      BASIC  COMPLEX,(COMPLEX)
ALOG      BASIC  REAL,(REAL)
DLOG      BASIC  DOUBLE,(DOUBLE)
CLOG      BASIC  COMPLEX,(COMPLEX)
ALOG10    BASIC  REAL,(REAL)
DLOG10    BASIC  DOUBLE,(DOUBLE)
SIN       BASIC  REAL,(REAL)
DSIN      BASIC  DOUBLE,(DOUBLE)
 DASIN    BASIC  DOUBLE,(DOUBLE)
 SIND     BASIC  REAL,(REAL)
CSIN      BASIC  COMPLEX,(COMPLEX)
COS       BASIC  REAL,(REAL)
DCOS      BASIC  DOUBLE,(DOUBLE)
 DACOS    BASIC  DOUBLE,(DOUBLE)
 COSD     BASIC  REAL,(REAL)
CCOS      BASIC  COMPLEX,(COMPLEX)
TANH      BASIC  REAL,(REAL)
 ATANH    BASIC  REAL,(REAL)
 DTANH    BASIC  DOUBLE,(DOUBLE)
SQRT      BASIC  REAL,(REAL)
DSQRT     BASIC  DOUBLE,(DOUBLE)
CSQRT     BASIC  COMPLEX,(COMPLEX)
ATAN      BASIC  REAL,(REAL)
DATAN     BASIC  DOUBLE,(DOUBLE)
ATAN2     BASIC  REAL,(REAL,REAL) 
DATAN2    BASIC  DOUBLE,(DOUBLE,DOUBLE) 
DMOD      BASIC  DOUBLE,(DOUBLE,DOUBLE) 
CABS      BASIC  REAL,(COMPLEX) 
ACOS      BASIC  REAL,(REAL)
ASIN      BASIC  REAL,(REAL)
TAN       BASIC  REAL,(REAL)
 TAND     BASIC  REAL,(REAL)
 DTAN     BASIC  DOUBLE,(DOUBLE)
 SINH     BASIC  REAL,(REAL)
 DSINH    BASIC  DOUBLE,(DOUBLE)
 COSH     BASIC  REAL,(REAL)
 DCOSH    BASIC  DOUBLE,(DOUBLE)
 ERF      BASIC  REAL,(REAL)
 ERFC     BASIC  REAL,(REAL)
 L.BEFTB  DATA   0                 END OF THE TABLE 
          LIST   R
          TITLE              EXTERNAL NAME CHANGE TABLE 
*** 
* 
*         RETURN - "RETURN" STATEMENT PROCESSOR 
* 
 SELIST   EQU    32B
  
          EXT    TEMPA0.,ENTRY.,VALUE.
  
 M.RET    RMEQU  100B        SUBPROGRAM RETURN
 M.NSR    RMEQU              NON-STANDARD RETURN
  
 E.RIM    EQU    67                RETURN STMT IN MAIN PROGRAM
 E.RSS    EQU    68                RETURNS STMT MUST BE IN A SUBROUTINE 
 E.RSNE   EQU    69                ILLEGAL NAME IN RETURNS STMT 
 E.RSA    EQU    72                RETURNS STMT IS NOT USAS 
          SPACE  3
 RETM     RMHDR  M.RET,1
          BSS    1
 RSMAC    RMHDR  M.NSR,3
  
          USE    /MACBUF/ 
 MACBUF   BSS    4
          USE    *
          EXT    O.CEP             ORDINAL OF CURRENT ENTRY POINT 
          EJECT 
 ERTN     SB7    RETURN            B6 = ERROR NUMBER
          EQ     ERPRO
  
 RETURN   ENTRY. **                ** ENTRY/EXIT ** 
          MX2    0
          RJ     =XDOLABR    INHIBIT OPTIMIZATION IF IN DO LOOP 
          SA1    PROGRAM
          UX0    B4,X1
          ZR     B4,RTNS2          IF NOT A SUBPROGRAM
  
          SA3    SELIST 
          SA2    X3                FETCH FIRST ELEMENT
          UX1    B3,X2
          ZR     X1,RETRN          IF NOT A RETURNS STMT
  
*         PROCESS "RETURNS" STATEMENT 
  
          SB6    -E.RSS            RETURNS STMT MUST BE IN A SUBROUTINE 
          NE     B4,B5,ERTN        IF NOT A SUBROUTINE
  
          NE     B3,B5,ERTN1       IF NOT A NAME
          SYMBOL                   FIND NAME OF THE PARAMETER IN SYMTAB 
  
 ERTN1    SB6    -E.RSNE           RETURNS NAME ERROR 
          EQ     ERTN 
  
          AX2    P.TYP
          MX0    60-L.TYP 
          BX3    -X0*X2 
          SX4    X3-T.RTN 
          NZ     X4,ERTN1          IF TYPE .NE. RETURNS 
  
          SX7    B1-1 
  
*         FORM RLIST MACRO REFERENCE
  
          SA3    RSMAC
          SA4    TEMPA0.
          SA5    NRLN 
          BX6    X3 
          SA6    MACBUF            RLIST MACRO HEADER WORD
          BX6    X4                WORD 1 = ORD OF TEMPA0.
          SA6    A6+B5
          BX6    X5 
          SA6    A6+B5             WORD 2 = AN R NUMBER FOR THE REGISTER
                                   STORE
          SA7    A6+B5             WORD 3 = FP ORD
          SX6    X6+B5
          SA6    A5                NRLN = NRLN+1
  
          SA4    RSELECT
          ZR     X4,RTNS1          IF R = 0 
          ADDREF B1,REF            ADD A REFERENCE FOR THE PARAMETER
 RTNS1    WRM    MACBUF      RETURNS MACRO TO RLIST 
          SB7    RETURN            (B7) = -ERPRO- RETURN ADDRESS
          POSTERR   NR=E.RSA,SEV=ANSI,RETURN=B7    *RETURN IS NON-ANSI* 
  
 RTNS2    SA3    SELIST 
          SA2    X3 
          UX1    B3,X2
          SB6    -E.RSS            RETURNS STMT MUST BE IN A SUBPROGRAM 
          NZ     X1,ERTN           IF A RETURNS STATEMENT 
          RJ     ISE         ISSUE MACRO FOR RETURN IN MAIN PROG
          SB6    -E.RIM            RETURN STATEMENT IN A MAIN PROGRAM 
          SB7    RETURN 
          EQ     ERPROI 
          SPACE  3
*         PROCESS STANDARD RETURN STATEMENT 
  
 RETRN    SA1    =XEXIT.
          BX6    X1 
          SA6    RETM+1 
          WRM    RETM        RETURN MACRO TO RLIST
          SA5    RSELECT
          ZR     X5,RETURN         IF R = 0 
          ADDREF O.CEP,REF         A REFERENCE TO THE CURRENT ENTRY PT
          EQ     RETURN 
  
 F.UDV    END 
