*********************************************************************
*M*      LINK     A ONE-PASS LOADER
*********************************************************************
*P*      NAME:    LINK
*P*      PURPOSE: LINK IS A ONE-PASS LINKING LOADER THAT MAKES FULL USE
*P*               OF MAPPING HARDWARE. IT IS AVAILABLE IN THE ONLINE
*P*               AND BATCH MODES. IT IS NOT AN OVERLAY LOADER.
*P*               THE LOAD MODULE RESULTING FROM A LINKING OPERATION
*P*               HAS THREE PROTECTION TYPES: ONE FOR DATA, ONE FOR PURE
*P*               PROCEDURE, AND ONE FOR DCBS.  THESE PROTECTION
*P*               TYPES BEGIN AT FIXED, PREDETERMINED LOCATIONS
*P*               IN THE USER'S VIRTUAL AREA.
*P*      DESCRIPTION: THIS MODULE IS ESSENTIALLY THE ENTIRE LINK
*P*               LOADER WITH THE EXCEPTION OF THE ABSOLUTE SYMBOLS
*P*               CONTAINED IN VDCB WHICH DEFINE THE VIRTUAL MEMORY
*P*               LAYOUT IN THE TARGET LOAD MODULE.
*P*               LINK LIVES IN THE SPECIAL SHARED PROCESSOR AREA
*P*               ABOVE X'1C000' AND CONSTRUCTS THE TARGET LOAD
*P*               MODULE IN CORE IN THE VIRTUAL AREA IN WHICH THE
*P*               LOAD MODULE WILL LATER BE RUN.  THIS ALLOWS FOR
*P*               EXECUTION OF THE LOAD MODULE TO BEGIN IMMEDIATELY
*P*               UPON ITS CREATION VIA THE !RUN COMMAND IN TEL.
*P*      REFERENCE:  LINK IS DESCRIBED IN THE CP-V TIMESHARING
*P*               REFERENCE MANUAL, 900907, AND THE CP-V BATCH
*P*               PROCESSING REFERENCE MANUAL, 901764.
*******************************************************************
         SYSTEM   SIG7
LINK     DSECT    0
         SYSTEM   BPM
*                        1. DUMMY SECTIONS MUST BE FIRST DECLARED       14100160
*                           AT MAXIMUM SIZE.                            14100170
*                        2. FIELD MUST BE WITHIN WORD.                  14100180
         PAGE                                                           14100190
*                 PARAMETERS FOR USE IN DEFINING SIGSAL.                14100220
*                                                                       14100230
TEMPN    EQU      1                 POSITION IN STACKS                  14100260
RFDFN    EQU      2                                                     14100270
EXPRN    EQU      3                                                     14100280
FREFN    EQU      4                                                     14100290
DECLN    EQU      5                                                     14100300
NSTKS    EQU      5                 NUMBER OF STACKS                    14100310
TMPSIZ   EQU      26                INITIAL SIZES
RFDFSIZ  EQU      1024              THEY                                141
DECLSIZ  EQU      128               VARY                                141
FREFSIZ  EQU      512               WITH                                141
EXPRSIZ  EQU      2048              DEMAND                              141
SUMSIZES EQU      TMPSIZ+RFDFSIZ+EXPRSIZ+FREFSIZ+DECLSIZ                14100370
CMPWDS   EQU      4                 WORDS FOR COMPILER USE.             14100380
TSASIZ   EQU      10                SIZES OF TABLES FOR USE BY          14100390
ERTSIZ   EQU      10                LIBRARY ERROR ROUTINE.              14100400
TCBSIZ   EQU      2+CMPWDS+10+TSASIZ+ERTSIZ                             141
DFLTTSS  EQU      64                DEFAULT  TSS                        14100450
NWDCB    EQU      51                NUMBER WORDS/DCB
         REF      VDCB,VLC,VPP,VDP
         REF      F:LINKIN
         REF      M:UC
         REF      J:CCBUF
         REF      J:AMR
         REF      J:JIT,M:GO
         REF      J:OPT             OPTION BIT FOR DEBUG MODE
         REF      M:LO
         REF      M:XX
         REF       M:C
          REF     M:DO
         REF      J:TELFLGS
         PAGE
F:LINK   DSECT    0
F:LINK   M:DCB    (FILE,'XXXXXXXXXXX'),(PASS,'XXXXXXXX'),;
                  (DIRECT),(SAVE)
         USECT    LINK
         PAGE                                                           14100490
*                 SYMBOLIC REGISTER DEFINITIONS.                        14100500
R0       EQU      0                                                     14100510
R1       EQU      1                                                     14100520
R2       EQU      2                                                     14100530
R3       EQU      3                                                     14100540
R4       EQU      4                                                     14100550
R5       EQU      5                                                     14100560
R6       EQU      6                                                     14100570
R7       EQU      7                                                     14100580
SR1      EQU      8                                                     14100590
SR2      EQU      9                                                     14100600
SR3      EQU      10                                                    14100610
SR4      EQU      11                                                    14100620
D1       EQU      12                                                    14100630
D2       EQU      13                                                    14100640
D3       EQU      14                                                    14100650
D4       EQU      15                                                    14100660
ADR      EQU       13
CNT      EQU       14
         PAGE                                                           14100670
HEAD     GEN,24,8   X'8400FF',HEADSIZE
STTADR1  DATA     X'80000000'       START ADDRESS
         DATA,2   0,DA(VLC)         TCB,MODULE BIAS
         DATA,2   0,DA(VLC)         00 SIZE, 00 LOC.
         DATA,2   0,DA(VPP)         01 SIZE, 01 LOC.
         DATA,2   0,12              MAX RFDF, TREE SIZE
         DATA,2   0,DA(VPP-1024)    DA(DCB SIZE),DA(DCB LOC)
         DATA     0                 GST SIZE, GST LOC.
         DATA     0                 IST SIZE, IST LOC.
CORENAME DATA     0,'    ','    '   TEXTC CORE LIBRARY (:PNN)
HEADSIZE EQU      BA(%)-BA(HEAD)
UNDERNAM DATA     0,'    ','    '   TEXTC DEBUG PROCESSOR (UNDER NAME)
         DATA     12
TREE     DATA     0,0,0             TEXTC OUTPUT FILE NAME
         DATA,2   0,0
         DATA,2   0,0
         DATA,2   0,DA(VLC)         00 SIZE, 00 LOC.
         DATA,2   0,0               RFDF SIZE, 0
         DATA,2   0,DA(VPP)         01 SIZE, 01 LOC.
         DATA,2   0,0
         DATA,2   0,DA(VDCB)        DA(SIZE),DA(LOC) 10DCB
         DATA,2   0,0
         PAGE
VPPM2    EQU      VPP-1024          HIGHEST STACK LOCATION + 1
         BOUND    8
*                 TABLE ADDRESSES FOR LOADER. TABLES EXTEND DOWNWARD.   14100680
*                 TABLES ARE ORGANIZED AS STACKS. STACK POINTERS ARE    14100690
*                 ADJUSTED AS NECESSARY WHEN TABLES OVERFLOW.           14100700
*                                                                       14100710
BASE     EQU      %-2               TOP OF ALL STACKS. INITIAL SETTINGS 14100720
*                                   OF TABLES DEPEND ON BASE.           14100730
*                                                                       14100740
TSTACK   DATA     VPPM2-SUMSIZES-1
         GEN,1,15,1,15   1,TMPSIZ,1,0                                   14100770
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *   141
*                 TABLES FOR STORAGE OF REF'S AND DEF'S.                14100790
*                 TYPICAL ENTRY IS AS FOLLOWS:                          14100800
*                   BYTE 0 -  WORD COUNT OF ENTRY.                      14100810
*                   BYTE 1 -  INDICATORS TELLING DEF,PREF,SREF          14100820
*                        BIT 0 - 1 IF DEF.                              14100830
*                        BIT 1 - 1 IF REF.                              14100840
*                        BIT 2 - 1 IF PREF.                             14100850
*                        BIT 3 - 1 IF DUMMY SECTION.                    14100860
*                        BIT 4 - IF CONSTANT.                           141
*                        BIT 5,6 RESOLUTION.                            141
*                        BIT 7 - IF PRINTED (MAP).                      141
*                            IF BIT 0 AND 3 SET-DOUBLE DEF.             141
*                   BYTE 2,3  SIZE-IF DUMMY SECTION.                    141
*                   WORD 1 -  IF DEF, VALUE OF DEF.                     14100870
*                             IF NOT, CHAIN ORIGIN                      141
*                   WORD 2 -
*                   BYTE 3    GLOBAL SYMBOL TBL. TYPE-RESOLUTION INFO.
*                   WORD 3,ETC. FIRST BYTE = NUMBER BYTES IN NAME.
*                             REMAINDER ARE NAME BYTES.                 14100900
*                                                                       14100910
RFDFSTK  DATA     VPPM2-DECLSIZ-FREFSIZ-EXPRSIZ-RFDFSIZ-1
         GEN,1,15,1,15   1,RFDFSIZ,1,0                                  14100940
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *   141
*                 EXPRESSION STACK.                                     14100960
*                 TYPICAL ENTRY IS AS FOLLOWS:                          14100970
*                   BYTE 0 -  NUMBER OF WORDS IN ENTRY.                 14100980
*                   BYTE 1                                              14100990
*                        BIT 0  -   1 IF ENTRY NOT USED.                14101000
*                        REMAINDER- WORD OF FIRST VALUE ITEM.           14101010
*                   BYTE 2 - TYPE OF DESTINATION.                       14101020
*                        BIT 0  -   PROGRAM. (ADDRESS WITH ADDEND)      141
*                        BIT 1  -   START ADDRESS.                      14101040
*                        BIT 2  -   (NOT USED)
*                        BIT 3  -   FORWARD REFERENCE.                  14101060
*                        BIT 4  -   DEF.                                14101070
*                        BIT 5  -   FIELD.                              14101080
*                        BIT 6  -   FREF AND HOLD.                      141
*                        BIT 7  -   INTERNAL SYMBOL TABLE.              141
*                        IF BITS 0-5=0, RESULT IS NOT STORED WHEN       14101090
*                        EVALUATED. (ORG)                               14101100
*                   BYTE 3,ETC. -   EXPRESSION CONTROL BYTES.           14101110
*                        BIT 0  -   ASSOCIATED VALUE WORD DEFINED       141
*                   NEXT WORD   -   DESTINATION OF VALUE OF EXPRESSION. 14101120
*                   REMAINDER OF WORDS SPECIFY ADDITIVE VALUES.         14101130
*                                                                       14101140
EXPRSTK  DATA     VPPM2-DECLSIZ-FREFSIZ-EXPRSIZ-1
         GEN,1,15,1,15   1,EXPRSIZ,1,0                                  14101170
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *   141
*                 FORWARD REFERENCE STACK.                              14101190
*                 TYPICAL ENTRY IS AS FOLLOWS:                          14101200
*                   WORD 0 -  FORWARD REFERENCE NUMBER.                 14101210
*                   BYTE 0                                              141
*                        BIT 0  -   DEFINED FREF AND HOLD               141
*                   BYTE 1                                              141
*                        BIT 0-4-   MODULE NUMBER                       141
*                        BIT 5  -   CONSTANT                            141
*                        BIT 6,7-   RESOLUTION                          141
*                   BYTE 2,3-   FREF NUMBER                             141
*                   WORD 1 -  VALUE OF FREF AND HOLD OR CHAIN ORIGIN    141
*                                                                       14101230
FREFSTK  DATA     VPPM2-DECLSIZ-FREFSIZ-1
         GEN,1,15,1,15   1,FREFSIZ,1,0                                  14101260
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *   141
*                 DECLARATION STACK.                                    14101280
*                 TYPICAL ENTRY IS AS FOLLOWS'                          14101290
*                   BYTE 0 -  INDICATORS DEFINING TYPE OF ENTRY.        14101300
*                        BIT 0  -   1 IF DEF.                           14101310
*                        BIT 1  -   1 IF PREF.                          14101320
*                        BIT 2  -   1 IF SREF.                          14101330
*                        BIT 3  -   1 IF DUMMY SECTION.                 14101340
*                        BIT 4  -   1 IF CONTROL SECTION.               14101350
*                        PROTECTION FIRST TWO BITS OF SIZE.             14101360
*                   BYTES 1,2,3 -   SIZE OF DUMMY OR CONTROL SECTION.   14101370
*                                   OR PREVIOUS SETTING OF RFDFSTK ENTRY
*                   WORD 1 - BA(BASE OF SECTION) OR POINT TO RFDFSTK    141
*                                                                       14101390
DECLSTK  DATA     VPPM2-DECLSIZ-1
         GEN,1,15,1,15   1,DECLSIZ,1,0                                  14101420
*                                                                       14101430
*                 BASE ADDRESSES OF ALL STACKS.                         14101440
BASES    EQU      %-1                                                   14101450
TEMPBAS  DATA     VPPM2-SUMSIZES
RFDFBAS  DATA     VPPM2-DECLSIZ-FREFSIZ-EXPRSIZ-RFDFSIZ
EXPRBAS  DATA     VPPM2-DECLSIZ-FREFSIZ-EXPRSIZ
FREFBAS  DATA     VPPM2-DECLSIZ-FREFSIZ
DECLBAS  DATA     VPPM2-DECLSIZ
         DATA     VPPM2             HIGHEST STAK CELL+1
         PAGE
* * * ******************************************************************
*        BIT DEFINTIONS FOR PLISTORG                                   *
*                                                                      *
*    (   |                  4 2 1|8 4 2 1|8 4 2 1|8 4 2 1|             *
*    |                        | | | | | | | | | | | | | |              *
*GROUP INST                   | | | | | | | | | | | | | (NI)           *
*                             | | | | | | | | | | | | |                *
*                           | | | | | | | | | | | | | (NL)             *
*                             | | | | | | | | | | | |                  *
*                             | | | | | | | | | | | (NP)               *
*                             | | | | | | | | | | |                    *
*                             | | | | | | | | | | (ND)                 *
*                             | | | | | | | | | |                      *
*                             | | | | | | | | | (NC)                   *
*                             | | | | | | | | |                        *
*                             | | | | | | | | (M)                      *
*                             | | | | | | | |                          *
*                             | | | | | | | THIS IS A LIBRARY FILE     *
*                             | | | | | | |                            *
*                             | | | | | | THIS IS THE LAST FILE        *
*                             | | | | | |                              *
*                             | | | | | THIS IS A % M:GO FILE          *
*                             | | | | |                                *
*                             | | | | RUN AFTER LINKING                *
*                             | | | |                                  *
*                             | | | ON SPECIFIED                       *
*                             | | |                                    *
*                             | | CORE LIBRARY DEFD A REF              *
*                             | |                                      *
*                             | SYSTEM LIBRARY HAS BEEN SEARCHED       *
*                             |                                        *
*                             THIS FILE HAS DEFD A REF                 *
*                           |                                          *
*                           CORE LIB RFDFSTK IN CORE                   *
         PAGE
*        BIT DEFINITIONS FOR SWT
*
*                                             2 1|8 4 2 1|
*                                             | | | | | |
*                                             | | | | | INTERACTIVE MODE
*                                             | | | | |
*                                             | | | | BREAK DEPRESSED
*                                             | | | |
*                                             | | | BUF3 CONTAINS COMM
*                                             | | |
*                                             | | OUTPUT FILE SPECIFIED
*                                             | |
*                                             | (NP)
*                                             |
*                                             (M)
* * * ******************************************************************
         PAGE                                                           14101590
         BOUND    8                                                     14101600
LOC      DATA     0                 BA(CURRENT LOAD LOCATION)
BUF      RES,1    120               ODD WORD BOUNDARY I/O BUFFER        14101910
BUF2     RES,4    18                NAME AND EXPRESSION BUFFER          14101920
BUF2SIZ  EQU      18                                                    14101930
BUF3     RES,1    80                CONTROL CARD BUFFER
LIBSTORE DATA     0                 KEEP SECOND LIBRARY
LIBMODE  DATA,4   0                 IF 1, LIBRARY LOAD                  14102010
FIRSTRD  DATA     1                 INPUT FIRST READ (REW IF EOF)       141
CURBYTE  DATA     X'FFFFF'          CURRENT ROM BYTE IN BUF2(INIT INFIN)
RCDSIZE  DATA,4   0                 RECORD SIZE                         14102040
SEQNUM   DATA     0                 CARD SEQUENCE NUMBER                141
MODNUM   DATA     0                 CURRENT MODULE NUMBER               141
LASTCARD DATA,4   0                 INDICATOR =1 FOR END OF MODULE      14102090
SATIS    DATA,4   0                 INDICATOR =1 IF MODULE DEF'D A REF. 14102100
ROLLBACK DATA,4   0                 RFDFSTK INFO TO DELETE DEF'S AND    14102110
*                                   REF'S IF MODULE TO BE SKIPPED.      14102120
STTADR   DATA,4   0                 START ADDRESS.                      14102130
LEADPARN DATA     0                 LEADING ( PRESENT FLAG
PLISTBUF DATA     PLIST
PLISTORG DATA     PLIST
SWT      DATA     0                 ENDLOAD,OUTPUT,BUF3,BREAK,INTERACT
COMANSZE DATA     0                 SIZE OF INTERACTIVE COMMAND IN BUF3
SYMBOLTB DATA     VDP               SYMBOL TABLE ORG.
MINSYMTL DATA     VDP               LARGEST SYMBOL TABLE ORG.
RFDFBSZ  DATA     0                 RFDFSTK SIZE IN BYTES
GLOSIZE  DATA     0                 GLOBAL SYMBOL TABLE SIZE
GLOSYM   DATA     0                 GLOBAL SYMBOL TABLE LOC.
DCBSIZE  DATA     0                 BYTES IN DCB AND DCBTAB
DASIZE   DATA     0                 DATA AREA SIZE
PPSIZE   DATA     0                 PURE PROCEEDURE SIZE
MAXLOC   DATA     VLC               MAX LOAD LOCATION OF DATA AREA
MXPP     DATA     BA(VPP)           MAX LOAD LOCATION OF PURE PROCEEDURE
BADCB    DATA     BA(VDCB)          DCB ORIGIN IN JIT
         DATA     VPP-1024          DCB VIRTUAL AREA PRESENT
DCBBIAS  EQU      0                 DCB BIAS FACTOR
BACOREDA DATA     BA(VLC)           DATA AREA ORIGIN
         DATA     BA(VLC)           BACOREDA VIRTUAL AREA PRESENT
BACORE   DATA     BA(VPP)           PURE PROCEEDURE ORIGIN
         DATA     BA(VPP)           BACORE VIRTUAL AREA PRESENT
STKBASE  DATA     VPP-1024          STACK VIRTUAL AREA PRESENT
SYMBASE  DATA     VDP+3             SYMBOL TABLE VIRTUAL AREA
VIRTUAL  DATA     0                 ADDRESS OF REQUESTED PAGE
*                                   BE ALLOCATED.                       14102150
TCB      DATA,4   0                 TCB ADDR.                           14102160
*                 DUMMY SETUP FOR ERROR TABLE PART OF TCB.              14102190
DUMTCB   DATA     2+CMPWDS+10-TCBSIZ                                    141
         GEN,16,16  TSASIZ,0                                            14102210
         GEN,15,17  ERTSIZ-1,2+CMPWDS+10+TSASIZ-TCBSIZ+1                141
         GEN,15,17  ERTSIZ-3,2+CMPWDS+10-TCBSIZ+1                       141
DCBTAB   DATA     0                 ORG OF DCB                          14102240
DCBTABA  DATA     0                 LOADER ORG OF DCBTAB                14102250
*                                                                       14102260
PLIST    DATA     0,0               INITIAL OPTIONS,Z NO SPECIFIED INPUT
         RES      218               BUFF FOR INPUT PLISTS, LINK OR RUN
SEVERITY TEXTC   'SEVERITY  '
SEVERITYFLG EQU BA(%)-2
OPNXX    GEN,8,24 X'14',M:XX
         DATA     X'05000209'
         DATA     2                 KEYED
         DATA     1                 IN
OPNXXFPL RES      10
         PAGE
PLSECT   DSECT    1
PPLINK   DSECT    1
*
ADONSIZ  EQU      %-1               ADD ON STACK SIZES
         DATA     8                 TEMP
         DATA     64                RFDF
         DATA     64                EXPR
         DATA     16                FREF
         DATA     16                DECL
*
FPTVIR   GEN,8,7,17      X'84',0,VIRTUAL     GET VIRTUAL PAGE
FPTVIRLS GEN,8,7,17      X'85',0,VIRTUAL     FPT OR RELEASE VIRTUAL PAGE
         PAGE
LINKERR  EQU      %                 COMMAND ERROR
         BAL,SR2  PRINTQ            GO-PRINT QUESTION MARK CHAR NO.
         LI,R1    1
         CW,R1    SWT               INTERACTIVE MODE
         BAZ      SIGSAL1           NO-READ ANOTHER LINK OR RUN
         BAL,SR2  INTRACT1          GO-READ ANY INTERACTIVE COMMAND
         LW,R3    TXEND
         CW,R3    BUF2              END COMMAND
         BE       ENDLOAD1          YES-END THE LOAD PROCESSES
         LW,R1    COMANSZE          BUF3 LINK COMMAND SIZE
         B        SIGSAL3           PROCESSES THE LINK COMMAND
         PAGE
PRINTQ   EQU      %                 PRINT QUESTION MARK CHAR NO.
         LW,D4    EHAT
         STW,D4   BUF2              SET UP 'EH' PART OF ERROR MESSAGE
         LW,R7    R2
         BAL,SR4  BIN2BCD           GO-CONVERT CHAR NO.
         SLS,D4   8
         OR,D4    =X'40000015'
         STW,D4   BUF2+1            COL. NO. INTO 'EH' MESSAGE
         LI,ADR    WA(BUF2)
         LI,CNT    8
         M:WRITE,E MESSAGE
         B        *SR2
         PAGE
LINKERR2 EQU      %
FPTRDFL1 MTW,0    J:JIT
         BLZ      ONLINE3
         LI,ADR   WA(BTCHCANT)
         LI,CNT   20
         M:WRITE,E MESSAGE
         BAL,SR4  FPTLOAD2          PRINT ROM NAME
         CAL1,9   1
ONLINE3  LI,ADR   WA(CANT2)
         LI,CNT    BCNT:CANT2
         M:WRITE,E MESSAGE
         BAL,SR4  FPTLOAD2          PRINT FILE NAME
         LI,ADR    WA(BUF)
         LI,CNT    80
         M:READ,E  READ
         LW,R1     READ
         LW,R1     4,R1
         SLS,R1   -17
         CI,R1    1                 SKIP BAD FILE
         BG       CANT              NO-READ A CORRECTION
         PLW,SR4  TSTACK            RESTORE RETURN ADDRESS
         LI,R1    X'80'             YES-SKIP FILE
         CW,R1    *PLISTORG         LAST FILE
         BAZ      ADVNEFLE          NO-READ NEXT FILE
         LI,R1    X'FFFBF'
         AND,R1   *PLISTORG
         STW,R1   *PLISTORG         RESET LIBRARY FILE
         MTW,0    LIBMODE           LIBRARY MODE
         BEZ      MODEND5           NO-CHECK FOR IST CREATION
         B        TSTSTP2           YES-CHECK FOR MORE PREFS
CANT     EQU      %
         LI,R0    BUF               COMMAND LOCATION
         LI,R2    0                 START OF LINE
         LW,R3    TXBLK
         STW,R3   BUF2              SET BLANK
         LI,R3    BUF2              DESTINATION OF FILE NAME
         BAL,SR4  SCAN              GO-GET FILE NAME
         CI,R7    0                 FILE NAME PRESENT
         BE       LINKERR3          NO-RE READ CORRECTION
         LW,R3    TXDOLLAR
         CW,R3    BUF2              % FILE SPECIFICATION
         BNE      CANT1             NO
         LI,R3    X'100'
         STS,R3   *PLISTORG         SET % FILE
         B        ADVANCE3          GO READ % FILE
CANT1    EQU      %
         LI,R3    X'FFEFF'
         AND,R3   *PLISTORG
         STW,R3   *PLISTORG         REMOVE % FILE FLAG
         STB,R7   OPNIN+6
         LW,R4    R7
         AI,R4    -1
         LB,R3    BUF2,R4
         STB,R3   OPNIN+6,R7
         AI,R4    -1
         BDR,R7   %-3               COPY FILE NAME TO PLIST
         LW,R3    Y02000002
         STW,R3   OPNIN+9           ACCT. NUMBER CONTROL WORD
         LW,R3    =X'03010002'
         STW,R3   OPNIN+12
         CI,R6    '.'               ACCT. NUMBER OR PASS WORD PRESENT
         BNE      ADVANCE2          NO
         LW,R3    TXBLK
         STW,R3   BUF2
         STW,R3   BUF2+1            BLANK FILL ACCT
         LI,R3    BUF2
         BAL,SR4  SCAN              GO-GET ACCT. NUMBER
         CI,R7    0                 ACCT. NUMBER PRESENT
         BE       FPTRDFL2          NO
         CI,R7    8
         BG       LINKERR3          NO MORE THAN 8 CHARS IN ACCT. NO.
         LW,R3    BUF2
         STW,R3   OPNIN+10
         LW,R3    BUF2+1
         STW,R3   OPNIN+11          TRANSFER ACCT TO OPEN PLIST
         LI,R3    2
         STB,R3   OPNIN+9,R3        SET ACCT. NUMBER PRESENT
FPTRDFL2 CI,R6    '.'               PASS WORD PRESENT
         BNE      ADVANCE2          NO
         LW,R3    TXBLK
         STW,R3   BUF2
         STW,R3   BUF2+1            BLANK FILL PASSWORD
         LI,R3    BUF2
         BAL,SR4  SCAN              GO-GET PASSWORD
         CI,R7    0
         BE       LINKERR3          MUST HAVE PASSWORK IF INDICATED
         CI,R7    8
         BG       LINKERR3          NO MORE THAN 8 CHARS IN PASSWORD
         LW,R3    BUF2
         STW,R3   OPNIN+13
         LW,R3    BUF2+1
         STW,R3   OPNIN+14          TRANSFER PASS WORD TO OPEN PLIST
         LI,R3    2
         STB,R3   OPNIN+12,R3       SET PASSWORD PRESENT
         B        ADVANCE2
LINKERR3 EQU      %
         BAL,SR2  PRINTQ            GO-PRINT QUESTION MARK CHAR NO.
         B        FPTRDFL1
         PAGE
COREABN  EQU      %                 CORE LIBRARY ERROR
         LB,SR3   SR3               ISOLATE ABNORMAL CODE
         CI,SR3   7                 LOST DATA ON CORE LIB RFDFSTK READ
         BE       COREABN2          YES
COREABN3 LI,ADR    WA(CORELIBABN)
         LI,CNT    BCNT:CORELIBABN
         M:WRITE,E MESSAGE
         M:ERR     108
COREABN2 LI,R1    -512
         AWM,R1   SYMBOLTB          SET FOR MMSYMBTB ROUTINE
         AWM,R1   RDCORELB+3        SET NEW BUFFER ADDRESS
         LW,R1    SYMBOLTB
         SLS,R1   2
         CW,R1    BACORE
         BL       PA2               ERROR-CORE LIB OVERLAPS PP
         LI,R1    2048
         AWM,R1   RDCORELB+4        SET NEW BUFFER SIZE
         BAL,R0   MMSYMBTB          GO-GET ADDITIONAL PAGE
         B        RDCRELB1          TRY TO READ THE CORE LIB RFDFSTK
         PAGE
RAMRABN  LI,ADR    WA(ASSMESS)
         LI,CNT    BCNT:ASSMESS
         M:WRITE,E MESSAGE
         M:ERR     101
SYSLBABN LI,ADR    WA(SYSLIB)
         LI,CNT    BCNT:SYSLIB
         M:WRITE,E MESSAGE
         M:ERR     102
         PAGE                                                           14102660
*                 IMMEDIATE CONSTANTS FOR LOADER.                       14102670
K0       EQU      0                                                     14102680
K1       EQU      1                                                     14102690
K2       EQU      2                                                     14102700
K3       EQU      3                                                     14102710
K4       EQU      4                                                     14102720
K5       EQU      5                                                     14102730
K6       EQU      6                                                     14102740
K7       EQU      7                                                     14102750
K8       EQU      8                                                     14102760
K9       EQU      9                                                     14102770
KA       EQU      X'A'                                                  14102780
KB       EQU      X'B'                                                  14102790
KC       EQU      X'C'                                                  14102800
KF       EQU      X'F'                                                  14102810
K10      EQU      X'10'                                                 14102820
K13      EQU      X'13'                                                 14102830
K19      EQU      X'19'                                                 14102840
K20      EQU      X'20'                                                 14102850
K30      EQU      X'30'                                                 14102860
K39      EQU      X'39'                                                 14102870
K3F      EQU      X'3F'                                                 14102880
K40      EQU      X'40'                                                 14102890
K60      EQU      X'60'                                                 14102900
K6C      EQU      X'6C'                                                 14102910
K77      EQU      X'77'                                                 14102920
K80      EQU      X'80'                                                 14102930
K84      EQU      X'84'                                                 14102940
KF0      EQU      X'F0'                                                 14102950
KFF      EQU      X'FF'                                                 14102960
K100     EQU      X'100'                                                14102970
K102     EQU      X'102'                                                14102980
K180     EQU      X'180'                                                14102990
K1FF     EQU      X'1FF'                                                14103000
K200     EQU      X'200'                                                14103010
K3FF     EQU      X'3FF'                                                14103020
K800     EQU      X'800'                                                14103030
K1000    EQU      X'1000'                                               14103040
K1200    EQU      X'1200'                                               14103050
K7FFF    EQU      X'7FFF'                                               14103060
K8000    EQU      X'8000'                                               14103070
K8402    EQU      X'8402'                                               14103080
KA000    EQU      X'A000'                                               14103090
KA400    EQU      X'A400'                                               14103100
KE000    EQU      X'E000'                                               14103110
KFF00    EQU      X'FF00'                                               14103120
KFFFF    EQU      X'FFFF'                                               14103130
K10000   EQU      X'10000'                                              14103140
K1FFFF   EQU      X'1FFFF'                                              14103150
K20000   EQU      X'20000'                                              14103160
K30000   EQU      X'30000'                                              14103170
K40000   EQU      X'40000'                                              14103180
KN1      EQU      -1                                                    14103190
KN2      EQU      -2                                                    14103200
KN3      EQU      -3                                                    14103210
KN4      EQU      -4                                                    14103220
KN5      EQU      -5                                                    14103230
KN6      EQU      -6                                                    14103240
KN8      EQU      -8                                                    14103250
KN100    EQU      -X'100'                                               14103260
TXA      EQU      X'C1'             EBCDIC 'A'                          14103270
TXF:     EQU      'F:'                                                  14103410
TXEXCLM  EQU      '!'                                                   14103420
TXBLK    TEXT     '    '            BLANKS                              141
TXHEAD   TEXTC    'HEAD'
TXTREE   TEXTC    'TREE'
TXUNDE   TEXT     'UNDE'
TXR      TEXT     'R   '
TXRUN    TEXT     'RUN '
TXL      TEXT     'L   '
TXLINK   TEXT     'LINK'
TXEXEC   TEXT     'EX  '
TXEND    TEXT     'END '
         BOUND    8
TXDONETH TEXT     'DONE THR'
TXQUIT   TEXT     'QUIT'
TXOUTP   TEXT     'OUTP'
T9DBINIT TEXTC    '9DBINIT'
         PAGE                                                           14103430
*                 STATIC DATA FOR LOADER.                               14103440
M2       DATA,4   X'3'                                                  14103450
M3       DATA,4   X'7'                                                  14103460
M4       DATA,4   X'F'                                                  14103470
M7       DATA,4   X'7F'                                                 14103480
M8       DATA,4   X'FF'                                                 14103490
M15      DATA,4   X'7FFF'                                               14103500
M17      DATA,4   X'1FFFF'                                              14103510
M16      DATA     X'FFFF'                                               141
M19      DATA     X'7FFFF'
M20      DATA,4   X'FFFFF'                                              14103520
M24      DATA     X'FFFFFF'
M30      DATA     X'3FFFFFFF'
M31      DATA     X'7FFFFFFF'                                           14103530
M32      DATA,4   X'FFFFFFFF'                                           14103540
X4       DATA,4   4                                                     14103550
XF0      DATA     X'F0'                                                 141
X7FFF8   DATA     X'7FFF8'
XFFFF8   DATA,4   X'FFFF8'                                              14103580
XFFFFFFDF DATA    X'FFFFFFDF'
X20       DATA    X'20'
XFFFFFFEF DATA    X'FFFFFFEF'
X10       DATA    X'10'
XFFFFFFF7 DATA    X'FFFFFFF7'
X8        DATA    X'8'
XFFFFFFFB DATA    X'FFFFFFFB'
XFFFFFFFD DATA    X'FFFFFFFD'
X2        DATA    X'2'
XFFFFFFFE DATA    X'FFFFFFFE'
XFFFFFEFF DATA    X'FFFFFEFF'
X1        DATA    X'1'
Y01000303 DATA    X'01000303'
Y02000002 DATA    X'02000002'
Y03010202 DATA    X'03010202'
TXON     DATA     'ON  '
TXOVER   DATA     'OVER'
TXDOLLAR DATA     '%   '
Y0008    DATA     X'80000'                                              14103590
Y0001    DATA     X'00010000'                                           141
Y001     DATA,4   X'100000'                                             14103600
Y002     DATA,4   X'200000'                                             14103610
Y004     DATA,4   X'400000'                                             14103620
Y006     DATA,4   X'600000'                                             14103630
Y008     DATA,4   X'800000'                                             14103640
Y009     DATA,4   X'900000'                                             14103650
Y00C     DATA     X'00C00000'
Y00F     DATA     X'00F00000'
Y01      DATA,4   X'1000000'                                            14103660
Y0202    DATA,4   X'2020000'                                            14103670
Y068     DATA     X'06800000'                                           141
Y08      DATA,4   X'8000000'                                            14103720
Y1       DATA,4   X'10000000'                                           14103730
Y2       DATA,4   X'20000000'                                           14103750
Y4       DATA,4   X'40000000'                                           14103770
Y8       DATA,4   X'80000000'                                           14103800
YE       DATA,4   X'E0000000'                                           14103810
YFFFE    DATA     X'FFFE0000'
*                 CODES INDICATING TYPE OF MAP CODE TO PUT OUT          141
MAPCDS   DATA     X'4050005',X'1050005',X'4030203',X'2030203'           141
MAPTXTS  EQU      %                                                     141
TXREF    TEXT     'PREF'                                                14103840
TXSREF   TEXT     'SREF'                                                14103850
TXDEF    TEXT     'DEF '                                                14103860
TXDDEF   TEXT     'DDEF'                                                14103870
TXUDEF   TEXT     'UDEF'                                                14103880
TXDSEC   TEXT     'DSEC'                                                141
TXERR    TEXT     'ERR '                                                14103890
DUMEXPR  DATA,4   X'5038000'        PRE-FORMED EXPR. FOR RELOC. LOAD    14103910
LEGSRCH  DATA,4   X'30506'                                              14103920
*                 NAMES AND ASSIGNMENTS FOR ALL STANDARD FORT DCB'S.    14103960
*                 RECORD BYTE SIZE,FUNCTION,OPERATIONAL LABEL,NAME
         BOUND    8
STDDCBLT GEN,11,4,17,32  120,1,1,X'03D47AC3'      M:C
         GEN,11,4,17,32  80,1,9,X'03C67AF5'    F:5
         GEN,11,4,17,32  132,2,3,X'03C67AF6'   F:6
         GEN,11,4,17,32  120,2,7,X'03C67AF7'   F:7
         GEN,11,4,17,32  85,4,2,'M:OC'
         GEN,11,4,17,32  132,2,3,'M:LO'
         GEN,11,4,17,32  132,2,4,'M:LL'
         GEN,11,4,17,32  132,2,5,'M:DO'
         GEN,11,4,17,32  80,2,6,'M:PO'
         GEN,11,4,17,32  120,2,7,'M:BO'
         GEN,11,4,17,32  120,1,8,'M:LI'
         GEN,11,4,17,32  80,1,9,'M:SI'
         GEN,11,4,17,32  120,1,X'A','M:BI'
         GEN,11,4,17,32  132,2,X'B','M:SL'
         GEN,11,4,17,32  80,2,X'C','M:SO'
         GEN,11,4,17,32  120,1,X'D','M:CI'
         GEN,11,4,17,32  120,2,X'E','M:CO'
         GEN,11,4,17,32  80,2,X'F','M:AL'
         GEN,11,4,17,32  120,1,X'10','M:EI'
         GEN,11,4,17,32  120,2,X'11','M:EO'
         GEN,11,4,17,32  120,2,0,'M:GO'
         GEN,11,4,17,32  0,1,2,'F101'
         GEN,11,4,17,32  0,2,2,'F102'
         GEN,11,4,17,32  0,1,18,'F103'
         GEN,11,4,17,32  0,2,17,'F104'
         GEN,11,4,17,32  80,1,9,'F105'
         GEN,11,4,17,32  120,2,7,'F106'
         GEN,11,4,17,32  132,2,3,'F108'
NSTDDCBS EQU      DA(%)-DA(STDDCBLT)
PARAMLST EQU      %
         GEN,32,8,24      0,NWDCB,3 SIZE,DEVICE
         GEN,32,16,16    1,7,'ME'   IN/OUT,OP LABEL 'ME'
         DATA     2,X'0A000000'     NUMBER OF RETRIES
         DATA     3
         GEN,15,17       80,0       80 BYTES/RECORD
         DATA     5,X'80000011'     SAVE,CONSECUTIVE,SEQUENTIAL
         DATA     6,22              FILE LIST POINTER
         DATA     10,NWDCB-8        KEY BUFFER POINTER
         DATA     22,X'01000003'    FILE NAME
         DATA     26,X'02000002'    ACCT. NO.
         DATA     29,X'03000002'    PASS WORD
         DATA     32,X'04000002'    EXPIRATION DATE
         DATA     35,X'07000003'    INSN REEL NO.
         DATA     39,X'08010003'    OUTSN REEL NO.
NPARAMLT EQU      DA(%)-DA(PARAMLST)
         PAGE                                                           14104130
*                 START OF LOAD OPERATION. INITIALIZE ALL STACKS. SAVE  14104140
*                 INFORMATION FROM CONTROL CARD INTERPRETER.            14104150
LDR      EQU      %
         LCI      4                 PUT M:* DEF IN RFDFSTK
         LM,R1    DEFM:STAR
         STM,R1   BUF2
         BAL,SR4  ENNAM11
         LCI       5
         LM,R1     DEFM:UC
         STM,R1    BUF2             SET UP M:UC DEF.
         BAL,SR4   ENNAM11          GO ENTER M:UC DEF IN REFDEFSTK
         LCI      5
         LM,R1    DEFM:XX
         STM,R1   BUF2
         BAL,SR4  ENNAM11
         LW,R1    =X'05600000'
         STW,R1   BUF2              MAKE M:DO PREF ENTRY IN BUF2
         LI,R1    0
         STW,R1   BUF2+1            VALUE WORD
         STW,R1   BUF2+2            RESOLUTION(FILL BY DCB GENERATOR)
         LCI      2
         LM,R1    TXCM:DO
         STM,R1   BUF2+3            NAME
         USECT    PLSECT
TXCM:DO  TEXTC    'M:DO'
         USECT    PPLINK
         BAL,SR4  ENNAM11           GO-PUT M:DO PREF INTO RFDFSTK
         BAL,SR4  MMDCB             GO-GET MEMORY FOR ASSIGN MERGE REC.
         LI,R1    4
         CW,R1    *PLISTORG         CORE LIBRARY WHANTED
         BANZ     LDR8              NO
         LI,R1    'J'
         LI,R2    2
         CB,R1    PNSIZE,2          SEARCHING A 'J' CORE LIBRARY
         BE       LDR9              YES-IT HAS NO DATA AREA
         CAL1,1   FPTPNNNO          OPEN CORE LIB DATA AREA
         USECT    LINK
FPTPNNNO GEN,8,7,17      X'14',0,F:LINKIN
         DATA     X'41000009'
         DATA     COREABN3          ABNORMAL
         DATA     1                 IN
         DATA     X'01000101'
PNSIZE   TEXTC    ':P1'             CORE LIBRARY FILE NAME
         DATA     X'02010202'
         TEXT     ':SYS    '
         USECT    PPLINK
         CAL1,1   FPTPNNNR          READ CORE LIB DATA AREA TREE
         USECT    PLSECT
FPTPNNNR GEN,8,7,17      X'10',0,F:LINKIN
         DATA     X'38000010'
         DATA     VPP-1024          BUFFER
         DATA     2048              SIZE
         DATA     TXHEAD
         USECT    PPLINK
         M:CLOSE  F:LINKIN
         LW,R1    VPP-1024+7        BYTE SIZE OF CORE LIBRARY DATA
         AWM,R1   BACOREDA          RESERVE DATA FOR CORE LIBRARY
         BAL,SR4  MMDA              GO-GET THE DATA MEMORY
         B        LDR9
LDR8     EQU      %
         LI,R1    X'10'
         STS,R1   SWT               SET NO CORE LIBRARY IN SWT
         LI,R1    0
         STW,R1   CORENAME          SET NO CORE LIBRARY IN CORENAME
LDR9     EQU      %
         PAGE
         MTW,0    J:AMR             ASSIGN MERGE RECORD PRESENT
         BEZ      LDR4              NO
         CAL1,1   RAMR              READ ASSIGN MERGE RECORD
         USECT    PLSECT
RAMR     GEN,8,7,17      X'2D',0,F:LINKIN
         DATA     X'70000000'
         DATA     RAMRABN           ABNORMAL
         DATA     VPP-1024          BUFFER
         DATA     2048              SIZE
         USECT    PPLINK
         LW,R1    VPP-1024+1        ADDRESS OF FIRST ASSIGN ENTRY
         BEZ      LDR4              NO ENTRIES IN AMR
LDR12    AI,R1    VPP-1024          CONVERT TO CORE ADDRESS
         LW,R2    R1
         AI,R2    1                 POINT TO NAME OF ENTRY
         LW,R3    0,R2              FIRST WORD OF NAME
         SLS,R3   -8
         INT,R3   R3                ISOLATE FIRST TWO CHARS
         CI,R3    'F:'              POSSIBLE F: NUMERIC
         BNE      LDR10             NO
         LB,R3    *R2               NUMBER OF CHARS IN F: NAME
LDR11    LB,R4    *R2,R3
         CI,R4    X'F0'             NUMERIC CHAR
         BL       LDR10             NO
         CI,R3    3
         BE       %+2               DONT CHECK F: CHARS
         BDR,R3   LDR11             CHECK EVERY CHAR FOR NUMERIC
         LW,R3    Y006              PREF TYPE
         LI,R4    0                 CLEAR VALUE WORD
         LI,R5    X'32'             GST INFO-HEX,WORD RESOLUTION
         LCI      3
         STM,R3   BUF2
         LB,R3    *R2               CHAR COUNT OF NAME
         STB,R3   BUF2+3              IN RFDFSTK ENTRY
         AI,R3    16                3 WORDS PLUS CHAR COUNT
         SLS,R3   -2
         STB,R3   BUF2              ENTRY LENGTH IN WORDS
         LB,R3    BUF2+3            CHAR COUNT OF NAME
         LB,R4    *R2,R3
         STB,R4   BUF2+3,R3
         BDR,R3   %-2               COPY NAME TO RFDFSTK ENTRY
         PSW,R1   TSTACK            SAVE ASSIGN TABLE POINTER
         BAL,SR4  ENNAM11           PUT F:NUMERIC INTO RFDFSTK
         PLW,R1   TSTACK
LDR10    LW,R1    *R1               LAST ASSIGN ENTRY
         BNEZ     LDR12             NO-PROCESS NEXT ENTRY
         PAGE
LDR4     EQU      %                 ENTRY FOR SECOND LINK COMMAND
         LI,R1    X'20'
         CW,R1    *PLISTORG         MAP REQUESTED ANYWHERE ON COMMAND
         BAZ      %+2               NO
         STS,R1   SWT               YES-SET FLAG SO CAN ALWAYS SEE
         LI,R1    PLIST
         STW,R1   PLISTORG
         STW,R1   PLISTBUF          RESET LINK-RUN COMMAND BUFFER POINT.
         MTW,0    PLIST+1           INPUT SPECIFIED
         BNEZ     LDR3              YES-GO OPEN FIRST FILE
         LI,R1    X'100'            NO-SET M:GO DCB DEFALT
         STS,R1   PLIST
LDR3     EQU      %
         BAL,SR4  ADVNEFLE          GO-GET FIRST FILE
         PAGE
*                 START OF OBJECT MODULE. INITIALIZE CONTROL SECTION 0. 14104860
*                 INITIALIZE DECLSTK. INIT BACORE                       14104870
LDR2     PLW,R1   DECLSTK                                               14104880
         BCR,1    LDR2              EMPTY DECLARATION STACK             14104890
         LW,R5    Y08                                                   14104900
         LW,R6    BACOREDA          DS0 MUST BE IN DATA AREA
         BAL,SR4  ENDECL            GO-ENTER CONTROL SECT ZERO IN DECLST
         LI,R1    0                                                     14105060
         LI,D1    KN1                                                   14105070
         STB,D1   SEQNUM            INITIALIZE CARD SEQUENCE CHECK AT-1 14105080
         STW,R1   LASTCARD          ZERO LAST CARD                      14105090
*                 ACTUAL START OF LOADING PROCESS. WHEN AN ITEM OF      14105100
*                 OBJECT LANGUAGE COMPLETELY PROCESSED, CONTROL         14105110
*                 RETURNS HERE.                                         14105120
LDR1     BAL,SR4  GBYTE             GO GET CONTROL BYTE IN R5           14105130
*                 SPECIAL LIBRARY CHECK. WHILE LIBMODE IS SET AND SATIS 14105140
*                 IS CLEAR, ONLY 00-PADDING, 03-DDNAM, 05-DPNAM, AND    14105150
*                 06-DSNAM ARE ALLOWED. ANYTHING ELSE CAUSES STACKS     14105160
*                 TO BE ROLLED BACK.                                    14105170
         LW,R1    LIBMODE                                               14105180
         BEZ      LDR5                                                  14105190
         LW,R1    SATIS                                                 14105200
         BNEZ     LDR5                                                  14105210
         LI,R1    KN4                                                   14105220
LDR7     CB,R5    LEGSRCH+1,R1                                          14105230
         BE       LDR5                                                  14105240
         BIR,R1   LDR7                                                  14105250
*                 OBJECT MODULE TO BE SKIPPED. ROLL BACK RFDFSTK.       14105260
*                 ALSO RESTORE FORMER SREFS TO SREF IF UPDATED
SETSREF  LCI      2
         PLM,R1   DECLSTK
         BCS,1    ROLLRFDF          IF NOW EMPTY
         CW,R1    Y4                IS THIS DECL PREF
         BAZ      SETSREF           NO
         AND,R1   Y00F
         CW,R1    Y004              WAS IT SREF BEFORE
         BNE      SETSREF           NO
         LW,R0    Y004              YES TO BOTH, SET SREF
         LW,R1    Y00F
         STS,R0   *RFDFBAS,R2
         B        SETSREF           BACK FOR MORE
ROLLRFDF EQU      %
         LW,R1    ROLLBACK                                              14105270
         LW,R2    RFDFSTK+1                                             14105280
         AND,R1   M15                                                   14105290
         AND,R2   M15                                                   14105300
         SW,R1    R2                                                    14105310
         MSP,R1   RFDFSTK                                               14105320
*                 IGNORE REST OF CARDS IN MODULE. GET NEXT MODULE.      14105330
LDR6     LW,R1    LASTCARD                                              14105340
         BNEZ     TSTLIB2                                               14105350
         STW,SR4  CURBYTE           VORCE TO READ NEXT CARD             141
         BAL,SR4  GBYTE                                                 14105360
         B        LDR6                                                  14105370
*                 ITEM CHECKED FOR LEGITIMATE ITEM. LEGAL ITEMS ARE     14105380
*                 AS FOLLOWS:                                           14105390
*                   00-PADDING-LDR1, 03-DEF NAME-DDNAM, 04-ORIGIN-ORG   14105400
*                   05-PREF-DPNAM  , 06-SREF-DSNAM    , 07-FIELD-FIELD  14105410
*                   08-FORREF-DFREF, 09-DUMMYSECT-DDSECT,0A-DEF-DDEF    14105420
*                   0B-C.S.0-DCS0  , 0C-C.S.-DCS      , 0D-START-DSTRT  14105430
*                   0E-END-MODEND  , 0F-REPEAT-RLOAD  , 4X-ABS-LABS     14105440
*                   5X-REL.LOAD-LLREL, 8X-FX-SHORT REL.LOAD-LSREL       14105450
*                   10-DFREFH-DEFINE FORWARD REFERENCE AND HOLD.        14105460
LDR5     CI,R5    K80               LOAD RELOCATABLE SHORT FORM         14105470
         BGE      LSREL             YES-                                14105480
         CI,R5    KF                ANY OF FIRST F ITEMS                14105490
         BLE      ITEMTV,R5         YES-                                14105500
         CI,R5    X'11'             TYPE INFO FOR GLOBAL SYMBOL
         BE       GLBSYM            YES
         CI,R5    X'12'             TYPE INFO FOR INT. SYMBOL
         BE       INTSYM            YES
         CI,R5    X'13'             UNDEFINED SYMBOLS
         BE       UDEFSYM           YES
         CI,R5    X'1E'             IS IT A PSECT...
         BE       DCS               YEP: TREAT LIKE NONSTD. CSECT
         LW,R1    R5                                                    14105510
         SLS,R1   -4                                                    14105520
         CI,R1    K1                DEFINE FORWARD REF AND HOLD         14105530
         BE       DFREFH            YES-                                14105540
         CI,R1    K4                LOAD ABSOLUTE                       14105550
         BE       LABS              YES-                                14105560
         CI,R1    K5                LOAD RELOCATABLE LONG FORM          14105570
         BE       LLREL             YES-                                14105580
         B        PAA               ERROR                               14105590
ITEMTV   B        LDR1              PADDING- GO GET ANOTHER BYTE        14105600
         B        PAA               ERROR                               14105610
         B        PAA               ERROR                               14105620
         B        DDNAM             DECLARE EXTERNAL DEF NAME           14105630
         B        ORG               ORIGIN                              14105640
         B        DPNAM             DECLARE PRIMARY REFERENCE NAME      14105650
         B        DSNAM             DECLARE SECONDARY REFERENCE NAME    14105660
         B        FIELD             DEFINE FIELD                        14105670
         B        DFREF             DEFINE FORWARD REFERENCE            14105680
         B        DDSECT            DECLARE DUMMY SECTION               14105690
         B        DDEF              DEFINE EXTERNAL DEF.                14105700
         B        DCS0              DECLARE STANDARD CONTROL SECTION    14105710
         B        DCS               DECLARE NONSTANDARD CONTROL SECTION 14105720
         B        DSTRT             DEFINE START ADDRESS                14105730
         B        MODEND            MODULE END                          14105740
         B        RLOAD             REPEAT LOAD                         14105750
         PAGE                                                           14105760
*                 DECLARE EXT DEF NAME. PUT IN RFDFSTK IF NOT ALREADY   14105770
*                 IN. PUT POINTER TO NAME ENTRY IN DECLSTK. IF ALREADY  14105780
*                 DEFINED, FLAG MULTIPLY DEFINED. OTHERWISE SET NAME    14105790
*                 AS DEF.                                               14105800
DDNAM    LW,SR3   RFDFSTK+1         NO.OF WORDS IN RFDFSTK              14105810
         AND,SR3  M15                                                   14105820
         BAL,SR4  ENNAM             IF NAME NOT IN STK,ENTER,POINTER R6 14105830
         LW,R1    Y008                                                  14105860
         CW,R1    *RFDFBAS,R6       DOUBLE DEF                          14105870
         BAZ      DEFOK             NO-O.K.                             14105880
         MTW,0    LIBMODE           LIBRARY MODE                        14105890
         BNEZ     DEFOK1            YES- DOUBLE DEF O.K.                14105900
         LW,R5    Y009                                                  14105910
         STS,R5   *RFDFBAS,R6       SET RFDFSTK ENTRY AS DOUBLE DEF     14105920
         LI,R1    X'10'
         CW,R1    *PLISTORG         DISPLAY OF GLOBAL SYMBOL WHANTED
         BANZ     DEFOK             NO
         LI,ADR    WA(GDDEF)
         LI,CNT    BCNT:GDDEF
         M:WRITE,E MESSAGE
         LB,R1    BUF2+3
         AI,R1    1                 COUNT TRAILING NL CHAR
         LI,R2    X'15'
         STB,R2   BUF2+3,R1         PUT NL AT END OF NAME
         AI,R1    1                 COUNT LEADING BLANK
         LI,R2    ' '
         STB,R2   BUF2+3            PUT IN LEADING BLANK
         LI,ADR    WA(BUF2)+3
         LW,CNT    R1
         M:WRITE,E MESSAGE
DEFOK    EQU      %                 DEF OK
         CW,R6    SR3               NEW RFDFSTK ENTRY                   14105940
         BE       DEFOK1            YES                                 14105950
         LW,R1    Y002                                                *B14105960
         CW,R1    *RFDFBAS,R6       PRIMARY REF                         14105970
         BAZ      DEFOK1            NO                                  14105980
         STW,SR4  SATIS             YES-SET DEFD A PREF                 14105990
         LI,R1    X'2000'
         STS,R1   *PLISTORG             SET DEFD A REF FROM THIS FILE
DEFOK1   EQU      %                                                     14106000
         LW,R5    Y8                DEF BIT IN DECLSTK ENTRY
         BAL,SR4  ENDECL            ENTER NEW DECLARATION NUMBER        14106010
         B        LDR1                                                  14106020
*                 ORIGIN. READ EXPRESSION AND EVALUATE IT. SET UP LOC   14106030
*                 AND CHECK FOR IN BOUNDS. IF EXPRESSION NOT DEFINED,   14106040
*                 PRINT A7.         NO DESTINATION                      14106050
ORG      LI,R6    K0                                                    14106060
         BAL,SR4  EXPRIN                                                14106070
         B        PA7               ERROR-EXPRESSION NOT DEFINED        14106080
         STW,R7   LOC                                                   14106140
         BAL,SR4  CHKLOC                                                14106150
         B        LDR1                                                  14106160
*                 DECLARE PRIMARY EXT. REF. PUT NAME IN RFDFSTK IF NOT  14106170
*                 ALREADY IN. MARK NAME PRIMARY REF. PUT POINTER IN     14106180
*                 DECLSTK.          IF NAME NOT IN STK,ENTER,POINTER R6 14106190
DPNAM    BAL,SR4  ENNAM                                                 14106200
         LW,R1    Y006                                                  14106210
         XW,R1    *RFDFBAS,R6
         STS,R1   *RFDFBAS,R6       SET REF AND PREF IN RFDFSTK ENTRY   14106220
         LW,R5    Y4                                                    14106230
         AND,R1   M24
         OR,R5    R1                PUT FORMER TYPE WITH PREF DECL'S
         BAL,SR4  ENDECL            PUT ENTRY IN DECL STK               14106240
         B        LDR1                                                  14106250
*                 DECLARE SECONDARY EXTERNAL REF. PUT NAME IN RFDFSTK   14106260
*                 IF NOT ALREADY IN. MARK NAME REF. PUT POINTER INTO    14106270
*                 DECLSTK                                               14106280
DSNAM    BAL,SR4  ENNAM                                                 14106290
         LW,R1    Y004                                                  14106300
         STS,R1   *RFDFBAS,R6                                           14106310
         LW,R5    Y2                                                    14106320
         BAL,SR4  ENDECL                                                14106330
         B        LDR1                                                  14106340
*                 FIELD. LOAD AN EXPRESSION INTO ANY FIELD OF A WORD.   14106350
*                 EXPRESSION ROUTINE IS INFORMED THAT A FIELD IS TO BE  14106360
*                 LOADED AND THE FIELD IS DEFINED BY TERMINAL BIT(8-14) 14106370
*                 NUMBER OF BITS(0-7), AND LOCATION(15-31).             14106380
FIELD    BAL,SR4  GBYTE                                                 14106390
         LW,R6    R5                LOCATION CONSTANT                   14106400
         BAL,SR4  GBYTE             BIT LENGTH (R5)                     14106410
         LW,R2    LOC                                                   14106420
         LI,R3    K0                                                    14106430
         SLD,R2   -2                CURRENT WORD                        14106440
         SLS,R3   -27               CURRENT BIT RELATIVE TO WORD        14106450
         AW,R3    R6                +K   31 BIT, 255=K                  14106460
         AI,R3    KN100             - 256=INITIAL BIT RELATIVE TO WORD. 14106470
TESTFLD  BGEZ     FORMCW            IF POSITIVE, OK.                    14106480
         AI,R2    KN1               OTHERWISE DECR. WORD, ADD 32 TO BIT.14106490
         AI,R3    K20                                                   14106500
         B        TESTFLD                                               14106510
FORMCW   SLS,R3   17                                                    14106520
         OR,R2    R3                                                    14106530
         STB,R5   R2                                                    14106540
         LW,R7    R2                DESTINATION OF EXPRESSION           14106550
         LI,R6    K4                TYPE OF DESTINATION                 14106560
         BAL,SR4  EXPRIN                                                14106570
         B        LDR1                                                  14106580
*                 DEFINITION OF FORWARD REFERENCE. TWO BYTE FORWARD     14106590
*                 REFERENCE NUMBER IS DESTINATION OF EXPRESSION.        14106600
DFREF    BAL,SR4  2BNUM                                                 14106610
         LI,R6    K10                                                   14106620
DFREF1   OR,R7    MODNUM                                                141
         BAL,SR4  EXPRIN                                                14106630
         B        LDR1                                                  14106640
*                 DEFINE FREF AND HOLD. SATISFY ANY EXISTING REFERENCES 14106650
*                 AND SAVE VALUE FOR FUTURE REF'S. REF. NUM. IS DEST.   14106660
*                 OF EXPR.                                              14106670
DFREFH   BAL,SR4  2BNUM                                                 14106680
         LI,R6    K2                                                    14106690
         B        DFREF1                                                141
*                 DECLARE DUMMY SECTION.                                14106720
*                 DECLARE DUMMY SECTION. IF NOT ALREADY ALLOCATED,      14106730
*                 ALLOCATE FOR IT. OTHER WISE INSURE THAT SIZE NOT      14106740
*                 GREATER THAN ALLOCATED SIZE.                          14106750
DDSECT   EQU      %                                                     14106760
         BAL,SR4  12BNUM            GO GET ONE OF TWO BYTES # IN (R7)   14106770
         BAL,SR4  DECLCHK           CHK DECLARATION #
         LW,R6    R7                DECLARATION # (R6)                  14106780
         BAL,SR4  3BNUM             GO GET THREE BYTE SIZE: (R7)        14106790
         LD,R2    *DECLBAS,R6       (R2) TYPE, (R3) RFDFSTK POINTER
         LW,R6    R7
         AI,R7    7                                                     141
         AND,R7   XFFFF8            SET AT EVEN WORD SIZE               141
         SLS,R7   -3                SET DOUBLE WORD RES.                141
         LI,R4    K1                                                    14106820
         AW,R4    R3                RFDFSTK+1 (VALUE)                   14106830
         LW,D4    Y001                                                  14106990
         CW,D4    *RFDFBAS,R3       DEFINED DUMMY SECTION               14107000
         BANZ     DDSECT1           YES                                 14107010
         STS,D4   *RFDFBAS,R3       SET DEFINED                         14107020
         STS,R7   *RFDFBAS,R3       PUT SIZE IN ENTRY (DOUBLE WRD RES)  141
         SLS,R7   3                 INC BACORE AT BYTE RES.             141
         LI,R5    3
         AW,R5    R3                RFDFSTK+3 (NAME)
         LW,R1    *RFDFBAS,R5       FIRST WORD OF NAME
         LB,SR1   R1
         CI,SR1   3                 POSSIBLE DCB
         BL       DDSECT5           NO-DCB MUST BE GE 3 CHAR.
         SLS,R1   -8
         INT,R1   R1
         CI,R1    'F:'              USER SUPPLYED F: DCB
         BE       DDSECT3           YES
         CI,R1    'M:'              USER SUPPLYED M: DCB
         BNE      DDSECT5           NO
DDSECT3  LW,SR1   BADCB             VALUE OF DCB
         AI,SR1   7
         AND,SR1  XFFFF8            INSURE DW BOUND
         STW,SR1  BADCB
         AWM,R7   BADCB             ALLOCATE DCB
         PSW,SR1  TSTACK            SAVE DCB ADDRESS
         BAL,SR4  MMDCB             GO-CHECK IF MEMORY THERE
         CW,SR1   *TSTACK           CROSS A PAGE BOUNDARY
         BE       DDSECT7           NO
         STW,SR1  *TSTACK           CORRECT DCB ADDRESS
         AW,SR1   R7                ADD SIZE OF DCB
         STW,SR1  BADCB             YES-RESET BADCB IN NEXT PAGE
DDSECT7  PLW,SR1  TSTACK            CORRECT DCB ADDRESS
         B        DDSECT6
DDSECT5  EQU      %
         LW,R5    Y00C              PROTECTION BITS
         AND,R5   R6
         BEZ      DDSECT4           DATA AREA
         LW,SR1   BACORE            PP AREA
         AWM,R7   BACORE
         BAL,SR4  MMPP              GO CHECK IF MEMORY THERE
         B        DDSECT6
DDSECT4  LW,SR1   BACOREDA          DATA AREA
         AWM,R7   BACOREDA
         BAL,SR4  MMDA              GO CHECK IF MEMORY THERE
DDSECT6  EQU      %
         LW,R2    R4                                                    141
         PSW,R4   TSTACK                                                141
         PSW,R7   TSTACK                                                141
         BAL,SR4  DSECCHN           GO-SATIFY ANY CHAIN                 141
         PLW,R7   TSTACK                                                141
         PLW,R4   TSTACK                                                141
         B        DDSECT2                                               14107110
DDSECT1  LW,R1    *RFDFBAS,R3                                           14107120
         AND,R1   M16               SIZE OF DEFINED DUMMY SECTION       141
         CW,R1    R7                SIZE > = REQUEST                    14107140
         BL       PA3               ERROR-SEC. LARGER THAN PREV.        141
         LW,R7    R1                ACTUAL SIZE IN (R7)                 14107160
DDSECT2  LW,R5    Y1                                                    14107170
         OR,R5    R7                                                    14107180
         LW,R6    *RFDFBAS,R4                                           14107190
         BAL,SR4  ENDECL            GO-PUT ENTRY IN DECLSTK             14107200
         B       DCS1                                                   14107220
*                 DEFINITION OF PREVIOUSLY DECLARED EXT DEF. DESTINA-   14107230
*                 TION OF EXPRESSION IS NAME POINTER FROM DECLARATION   14107240
DDEF     BAL,SR4  12BNUM                                                14107250
         BAL,SR4  DECLCHK           CHK DECLARATION #
         LD,R6    *DECLBAS,R7       DESTINATION OF EXPRESSION IN (R7)   14107260
         LI,R6    K8                TYPE OF DESTINATION                 14107270
         BAL,SR4  EXPRIN            GO EVALUATE THE EXPRESSION          14107280
         B        LDR1                                                  14107290
*                 DECLARE STANDARD CONTROL SECTION.(0) PUT SIZE AND     14107300
*                 PROTECTION INTO DECLSTK. IF A SIZE IS ALREADY THERE,  14107310
*                 ERROR. UPDATE BACORE.                                 14107320
DCS0     BAL,SR4  3BNUM                                                 14107330
         OR,R7    Y08
         STW,R7   *DECLBAS          ALWAYS FIRST DECLSTK ENTRY          14107360
         AND,R7   M20                                                   14107370
         AW,R7    BACOREDA
         AI,R7    K7                                                    14107390
         AND,R7   X7FFF8
         STW,R7   BACOREDA          INC. DATA AREA WITH SIZE OF SECTION
         B        LDR1                                                  14107420
*                 DECLARE CONTROL SECTION. PUT SIZE, PROTECTION, AND    14107430
*                 BASE INTO DECLSTK. UPDATE BACORE. IF CS0 HAS BEEN     14107440
*                 REFERNCED, PUT IN SIZE. ELSE PUT NEW BACORE INTO      14107450
*                 BASE OF CS0.                                          14107460
DCS      BAL,SR4  3BNUM             GO GET SIZE IN (R7)                 14107470
         LW,R5    Y08                                                   14107480
         OR,R5    R7                                                    14107490
         LW,R4    Y00C
         AND,R4   R5                PROTECTION BITS
         BEZ      DCS2              DATA AREA
         LW,R6    BACORE            PP AREA
         B        %+2
DCS2     LW,R6    BACOREDA          DATA AREA
         BAL,SR4  ENDECL            GO-PUT ENTRY IN DECLSTK
         LW,R4    Y00C
         AND,R4   R5                PROTECTION BITS
         AI,R5    7
         AND,R5   XFFFF8
         AI,R4    0
         BEZ      DCS3              DATA AREA
         AWM,R5   BACORE            PP AREA
         BAL,SR4  MMPP              GO CHECK IF MEMORY THERE
         B        LDR1              DSEC0 DID NOT CHANGE
DCS3     AWM,R5   BACOREDA          DATA AREA
         BAL,SR4  MMDA              GO CHECK IF MEMORY THERE
DCS1     LW,R3    BACOREDA          CS0 ALWAYS IN DATA AREA
         LI,R1    K1                                                    14107590
         LW,R2   *DECLBAS                                               14107600
         AND,R2  M20                CONTROL SECTION ZERO DEFINED        14107610
         BNEZ    LDR1               YES                                 14107620
         STW,R3   *DECLBAS,R1       NO-REDEFINE ITS BASE
         B        LDR1                                                  14107640
*                 DEFINE START ADDRESS. SET UP DESTINATION FOR EXPRESS- 14107650
*                 ION AS STTADR.                                        14107660
DSTRT    LI,R6    K40                                                   14107670
         LI,R7    K0                                                    14107680
         STW,R7   STTADR                                                14107690
         LI,R7    STTADR                                                14107700
         BAL,SR4  EXPRIN                                                14107710
         B        LDR1                                                  14107720
*                 MODULE END. READ SEVERITY LEVEL. REPLACE PREVIOUS     14107730
*                 SEV. LEVEL IF GREATER.                                14107740
*                 CHECK FOR LAST CARD. CHECK FOR END OF LOAD PROCESS.   14107750
*                 CHECK FOR LIBRARY LOAD MODE.                          14107760
MODEND   EQU      %
         BAL,SR4  GBYTE             BE SURE TO GET LAST CARD
         LW,R7    R5                GET READY FOR BIN2BCD
         BAL,SR4  BINTOHEX          PRINT SEV IN HEX
         STB,D4      D4             ZERO OUT THE FIRST THREE BYTES
         LB,D4    D4                OF REGISTER D4 AND DETERMIN ITS
         CI,D4    X'40'             CONTENTS
         BNE      SEVNOTZ
         B         SEVZ             DON'T PRINT A SEVERITY 0 MSG.
SEVNOTZ  LI,R5    SEVERITYFLG       GET BYTE ADR. OF WHERE TO PUT
         STB,D4   0,R5              SEVERITY LEVEL AND PUT IT THERE
         M:PRINT (MESS,SEVERITY)
SEVZ     EQU       %
         LW,R1    LASTCARD                                              14107810
         BEZ      PA7                                                   14107820
*                 REMOVE ALL FORWARD REF AND HOLD ITEMS.                141
         MTH,4    MODNUM                                                141
         MTH,4    MODNUM                                                141
MODEND3  LI,R1    X'7FFF'                                               141
         AND,R1   FREFSTK+1                                             141
         SLS,R1   -1                NO. OF ENTRIES IN STK               141
         LI,R2    -1                                                    141
MODEND1  AI,R2    1                                                     141
         CW,R2    R1                                                    141
         BGE      MODEND2           CHECKED ALL ENTRIES                 141
         LD,SR1   *FREFBAS,R2                                           141
         CW,SR1   Y8                FREF AND HOLD                       141
         BAZ      MODEND1           NO                                  141
         LCI      2                                                     141
         PLM,SR1  FREFSTK                                               141
         STD,SR1  *FREFBAS,R2                                           141
         B        MODEND3                                               141
MODEND2  EQU      %                                                     14107930
         LW,R1    LIBMODE                                               14107940
         BNEZ     TSTSTP2           LIBRARY MODE SET
BYP1     BAL,SR4  CHK2EOF                                               14108010
         B        %+2               2 EOFS-ADVANCE TO NEXT FILE
         B        LDR2                                                  14108030
         M:CLOSE  F:LINKIN
         LI,R1    '('
         CB,R1    *PLISTORG         GROUP THE SYMBOL TABLE
         BE       MODEND4           YES
MODEND5  EQU      %
         LI,R1    1
         CW,R1    *PLISTORG         NI SET
         BANZ     MODEND8           YES- ADVANCE TO NEXT FILE
         LI,R1    VDP
         SW,R1    SYMBOLTB
         BEZ      MODEND8           NO IST TO WRITE
         SLS,R1   2                 BYTES IN SYMBOL TABLE
         STW,R1   WRTESYM+3         TO WRITE FPT.
         MTB,1    OPNIN+6           ONE MORE CHAR
         LB,R2    OPNIN+6
         LI,R1    X'10'             TRAILING 00 TO ROM NAME
         STB,R1   OPNIN+6,R2        FOR IST KEY
,WRTESYM M:WRITE  F:LINK,(BUF,*SYMBOLTB),(SIZE,1),(WAIT),(ONEWKEY);
                  ,(KEY,OPNIN+6)    FILE NAME IS SYMBOL TABLE KEY
         MTB,-1   OPNIN+6           CORRECT BACK FOR 'DONE THR' MES.
         LW,R1    SYMBOLTB
         CW,R1    MINSYMTL
         BGE      %+2
         STW,R1   MINSYMTL          SET AT MOST INTERNAL SYMBOL TBL SIZE
         LI,R1    VDP
         STW,R1   SYMBOLTB          SET FOR NEW SYMBOL TABLE
MODEND8  EQU      %
         LI,R1    X'80'
         CW,R1    *PLISTORG         LAST INPUT FILE
         BAZ      MODEND4           NO-ADVANCE TO NEXT FILE
         LI,R1    X'FDFFF'          YES-CLEAR DEFD A REF BIT
         AND,R1   *PLISTORG             SO DONT PRINT LINAING MESSAGE
         STW,R1   *PLISTORG             TWICE
         B        TSTSTP2           CHECK FOR PREFS
MODEND4  EQU      %
         BAL,SR4  ADVNEFLE          GO-ADVANCE FILE
         LI,R1    X'40'
         CW,R1    *PLISTORG         LIBRARY MODE
         BAZ      LDR2              NO-GO PROCESS FILE
         MTW,1    LIBMODE           SET LIBRARY MODE
         PAGE
TSTSTP2  EQU      %
         LI,R1    0                 CHECK TO SEE IF ALL PRIMARY REFS    14108170
         LW,R2    RFDFSTK+1         SATISFIED.                          14108180
         AND,R2   M15                                                   14108190
TSTLIB1  CW,R1    R2                                                    14108200
         BL       TSTLIB3           SEARCH ALL OF THE REFDFSTK
         LI,R1    X'2000'
         CW,R1    *PLISTORG         DEFD A REF FROM THIS FILE
         BAZ      TSTLIB9           NO-DONT PRINT 'LINKING' MESSAGE
         BAL,SR4  PNTFILE           YES-GO PRINT 'LINKING' MESSAGE
         B        TSTLIB9           NO MORE PREFS-WRAP UP THE LOAD
TSTLIB3  EQU      %
         LW,R3    *RFDFBAS,R1                                           14108220
         LB,R4    R3                                                    14108230
         AW,R1    R4                                                    14108240
         CW,R3    Y009                                                  14108250
         BANZ     TSTLIB1                                               14108260
         CW,R3    Y002                                                  14108270
         BAZ      TSTLIB1                                               14108280
         LW,R3    R1                                                    141
         SW,R3    R4                                                    141
         AI,R3    4                 POINT TO SECOND WORD OF NAME
         LW,R4    *RFDFBAS,R3
         SLS,R4   -24               ISOLATE FOURTH BYTE OF NAME
         AI,R3    -1                POINT TO NAME
         LW,R3    *RFDFBAS,R3       NAME WORD OF PREF                   141
         LB,R5    R3
         CI,R5    3                 POSSIBLE DCB REF
         BL       TSTLIB15          NO
TSTLIB14 SLS,R3   -8
         INT,R3   R3                                                    141
         CI,R3    TXF:              F:  PREF                            141
         BE       TSTLIB1           YES-SATIFY WITH DCB NOT LIBRARY     141
         CI,R3    'M:'              M: PREF
         BE       TSTLIB1           YES-SATIFY WITH DCB NOT LIBRARY
TSTLIB15 EQU      %
         PAGE
         LI,R1    X'40'
         CW,R1    *PLISTORG         ANY NAMED LIBRARIES PRESENT
         BAZ      TSTLIB5           NO
TSTLIB2  BAL,SR4  CHK2EOF           DOUBLE EOF
         B        TSTLIB6           YES
TSTLIB7  LW,R1    RFDFSTK+1         NO
         STW,R1   ROLLBACK          SAVE RFDFSTK SIZE SO CANT RESTORE
         LI,R1    0                 IF THIS ROM NOT REFD
         STW,R1   SATIS             CLEAR-A REF HAS BEEN DEFD-FLAG
         B        LDR2              CHECK IF ROM REFD
TSTLIB6  M:CLOSE  F:LINKIN          CLOSE THIS NAMED LIBRARY FILE
         LI,R1    X'2000'
         CW,R1    *PLISTORG         DEFD A REF FROM THIS FILE
         BAZ      %+2               NO-DONT PRINT 'LINKING' MESSAGE
         BAL,SR4  PNTFILE           YES-GO PRINT 'LINKING' MESSAGE
         LI,R1    X'80'
         CW,R1    *PLISTORG         LAST NAMED LIBRARY FILE
         BANZ     TSTLIB5           YES-CHECK FOR CORE LIBRARY
         BAL,SR4  ADVNEFLE          NO-ADVANCE TO NEXT NAMED LIBRARY
         B        TSTLIB7           SAVE RFDFSTK SIZE
         PAGE
TSTLIB5  EQU      %                 CORE LIBRARY LOAD
         LI,R1    X'4000'
         CW,R1    *PLISTORG         CORE LIB RFDFSTK IN CORE
         BAZ      TSTLIB13          NO-FIND OUT IF CORE LIB WANTED
         LI,R1    X'1000'
         CW,R1    *PLISTORG         HAS SYS LIB BEEN SEARCHED
         BAZ      TSTLIB8           NO-FIND OUT IF SYS LIB WANTED
         LW,R1    SYMBOLTB
         SLS,R1   2
         CW,R1    BACORE
         BL       PA2
         B        CORELIB1-1        YES-RESEARCH CORE LIB,REFS FROM SYS
TSTLIB13 EQU      %
         LI,R1    X'10'
         CW,R1    SWT               (NP) NO CORE LIBRARY SPECIFIED
         BANZ     TSTLIB8           YES-DO NOT ASSOCIATE A CORE LIB.
         LI,R1    X'40'
         STS,R1   *PLISTORG         SET NO IST FOR LIBS
         MTW,0    CORENAME          CORE LIBRARY SPECIFIED
         BNEZ     FDP5              YES-ASSCIATE IT
         LW,R2    RFDFBAS
         LI,R3    X'1FFFF'
FDP1     CS,R2    RFDFSTK           CHECKED ALL ENTRYS
         BG       FDP4              YES-DID NOT FIND A FDP REF,SEARCH P1
         LW,R4    *R2               TYPE WORD OF ENTRY
         CW,R4    Y009              DEF OR DSECT
         BANZ     FDP2              YES
         CW,R4    Y002              SREF
         BAZ      FDP2              YES
         LW,R1    3,R2              NAME WORD OF ENTRY
         CW,R1    T9DBINIT          FIRST WORD OF FDP REF
         BNE      FDP2              NO
         LW,R1    4,R2              YES-CHECK SECOND WORD
         CW,R1    T9DBINIT+1        FORTRAN DEBUG LIBRARY NEEDED
         BE       FDP3              YES-ERROR P0 CORE LIBRARY NEEDED
FDP2     LB,R4    *R2
         AW,R2    R4
         B        FDP1              ADVANCE TO NEXT RFDFSTK ENTRY
FDP3     LI,ADR    WA(DPER)
         LI,CNT    BCNT:DPER
         M:WRITE,E MESSAGE
         M:ERR     103
FDP4     LI,ADR    WA(FDP6)
         LI,CNT    BCNT:FDP6
         M:WRITE,E MESSAGE
         LI,R3    'P1'
         BAL,SR4  INSERTLB          GO-SET P1CORE LIBRARY
FDP5     EQU      %
         LI,R1    VDP-512           INITIAL CORE LIBRARY BUFFER ORG.
         STW,R1   SYMBOLTB
         BAL,R0   MMSYMBTB          GO-GET ROOM FOR CORE LIB. RFDFSTK
         CAL1,1   OPNCORLB
         USECT    LINK
OPNCORLB GEN,8,7,17      X'14',0,F:LINKIN
         DATA     X'41000009'
         DATA     COREABN3          ABNORMAL
         DATA     1                 IN
         DATA     X'01000101'
OPNCORL1 TEXTC    ':P1'             DEFAULT FILE NAME
         DATA     X'02010202'
         TEXT     ':SYS    '
         USECT    PPLINK
RDCRELB1 EQU      %
         CAL1,1   RDCORELB
         USECT    LINK
RDCORELB GEN,8,7,17      X'10',0,F:LINKIN
         DATA     X'78000010'
         DATA     COREABN           ABNORMAL
         DATA     VDP-512           BUFFER
         DATA     2048              SIZE
         DATA     COREKEY           KEY
COREKEY  TEXTC    ':P1 '            RFDFSTK KEY
         ORG      %-1
         DATA     0                 RFDFSTK CODE
         USECT    PPLINK
         LI,R1    X'4000'           SET CORE LIB RFDFSTK
         STS,R1   *PLISTORG         IN CORE
         LW,R1    F:LINKIN+13
         M:CLOSE  F:LINKIN
 SLS,R1 -2
         AW,R1    RDCORELB+3
         STW,R1   RDCORELB+4        SAVE TOP OF CORE LIBRARY RFDFSTK
         LW,R2    RFDFBAS
CORELIB1 LW,R4    0,R2
         CW,R4    Y009              DEF ENTRY
         BANZ     CORELIB3          YES-NO INTEREST
         CW,R4    Y004              REF
         BAZ      CORELIB3          NO-NO INTEREST
         AI,R2    3                 POINT TO NAME OF RFDFSTK ENTRY
         LW,R6    RDCORELB+3        CORE LIBRARY RFDFSTK ORG.
CORELIB2 EQU      %
         LI,R4    X'70000'
         CW,R4    *R6               DEF ENTRY FROM COR LIBRARY
         BANZ     CORELIB4+1        NO-SKIP
         AI,R6    3                 POINT TO NAME OF CORE LIBRARY ENTRY
         LB,R4    *R2               NUMBER OF BYTES IN NAME
         CB,R4    *R6               SAME AS CORE LIBRARY ENTRY
         BNE      CORELIB4          NO
         LB,R5    *R2,R4            YES-NOW CHECK BYTE BY BYTE
         CB,R5    *R6,R4
         BNE      CORELIB4          NOT SAME NAME
         BDR,R4   %-3
         LI,R1    X'800'
         STS,R1   *PLISTORG         SET CORE LIBRARY NEEDED(DEFED A REF)
         AI,R2    -3                POINT TO START OF ENTRY
         PSW,R2   TSTACK            SAVE RFDFSTK POINTER
         LW,SR1   -2,R6             VALUE OF DEF
         LW,SR3   R2
         SW,SR3   RFDFBAS           RELATIVE RFDFSTK POINTER
         AI,R6    -1                POINT TO RESOUTION WORD
         LI,R1    3
         MTB,0    *R6,R1
         BNEZ     CORELIB5
         BDR,R1   %-2               FIND RESOLUTION BYTE
         MTB,0    *R6               BYTE RESOLUTION
         BNEZ     CORELIB5+2        YES
         LI,R1    4                 NO-SET CONSTANT
         B        %+3
CORELIB5 SLS,SR1  0,R1              SHIFT TO BYTE RESOLUTION
         LI,R1    0
         PSW,R1   TSTACK            SET RESOLUTION
         BAL,SR4  RFDFCHN           GO-DEF THE REF
         PLW,R1   TSTACK            BALANCE RESOLUTION
         PLW,R2   TSTACK            RFDFSTK POINTER
CORELIB3 LB,R4    *R2
         AW,R2    R4                ADVANCE TO NEXT RFDFSTK ENTRY
         LI,R3    X'1FFFF'
         CS,R2    RFDFSTK           CHECKED ALL ENTRIES
         BGE      TSTLIB4           YES
         B        CORELIB1          NO-CHECK THIS ENTRY
CORELIB4 AI,R6    -3
         LB,R4    *R6
         AW,R6    R4                ADVANCE TO NEXT CORE LIB. ENTRY
         CW,R6    RDCORELB+4        CHECKED ALL OF CORE LIBRARY
         BL       CORELIB2          NO-CHECK THIS ENTRY
         AI,R2    -3                POINT TO START OF ENTRY
         B        CORELIB3          YES-ADVANCE TO NEXT RFDFSTK ENTRY
TSTLIB4  EQU      %
         LI,R1    X'FDFBF'          DEF'D AREF,LIB. FILE
         AND,R1   *PLISTORG
         STW,R1   *PLISTORG         REMOVE NAMED LIBRARY PRESENT
         CI,R1    X'1000'           HAS SYS LIB BEEN SEARCHED
         BAZ      TSTSTP2           NO-FIRST FIND IF ANY MORE PREFS
         PAGE
TSTLIB9  EQU      %
         LI,R1    VDP
         STW,R1   SYMBOLTB          RESET SYMBOL TABLE POINTER
         BAL,SR4  RELSYM            GO-RELEASE CORE LIB RFDFSTK PAGES
         LI,R1    X'10'
         CW,R1    SWT               (NP) NO CORE LIBRARY SPECIFIED
         BANZ     ENDLOAD           YES-WRAP UP THE LOAD
         LI,R1    X'800'
         CW,R1    *PLISTORG         CORE LIBRARY DEFED A REF (NEEDED)
         BAZ      TSTLIB11          NO-PRINT MESSAGE AND SET NO CORE LIB
         LI,R1    'J'
         LI,R2    2
         CB,R1    CORENAME,R2       JIT DEF LIBRARY
         BE       TSTLIB10          YES-SET NO CORE LIB TO ASSOCIATE
         B        ENDLOAD           NO-PN LIBRARY NEEDED
TSTLIB11 EQU      %
         MTW,0    CORENAME          CORE LIBRARY SPECIFIED
         BNEZ     TSTLIB12          YES-PUT ITS NAME IN MESSAGE
         B        ENDLOAD           WRAP UP THE LOAD
TSTLIB12 EQU      %
         LI,ADR    WA(CORL1)
         LI,CNT    BCNT:CORL1
         M:WRITE,E MESSAGE
         LI,R1    ' '
         STB,R1   CORENAME          BLANK COUNT
         LI,R2    1
         STB,R1   CORENAME,R2       BLANK :
         LI,R1    X'15'
         STB,R1   CORENAME+1        INSERT RETURN CHAR.
         LI,ADR    WA(CORENAME)
         LI,CNT    5
         M:WRITE,E MESSAGE
TSTLIB10 LW,R1    LIBSTORE
         CI,R1    1                 BOTH TYPES REQUESTED AND DONE
         BNE      TSTLB10A          NO JUST J TYPE
         LW,R1    LEADPARN          GET SAVE P TYPE FROM LEADPARN
         STW,R1   CORENAME          PUT IT IN HEAD RECORD
         STB,R1   CORENAME+1
         B        ENDLOAD
TSTLB10A LI,R1    0
         STW,R1   CORENAME
         B        ENDLOAD           WRAP UP THE LOAD
         PAGE
TSTLIB8  EQU      %                 SYSTEM LIBRARY LOAD
         LW,R1    *PLISTORG
         CI,R1    2                 SYSTEM LIBRARY (L) SPECIFIED
         BANZ     TSTLIB9           NO-WRAP UP THE LOAD
         AND,R1   =X'FFFFDEFF'      RESET-DEF'D A REF,%
         OR,R1    =X'1042'          SET-SYS LIB SEARCHED,LIB FILE,NSYSLB
         STW,R1   *PLISTORG         RESET SYSTEM LIBRARY
         MTW,1    LIBMODE           SET LIBRARY MODE
         LCI      3
         LM,R1    TXSYSLIB
         STM,R1   OPNIN+6           SET NAME FOR 'LINKING' MESSAGE
         USECT    PLSECT
TXSYSLIB TEXTC    'SYSTEM LIB'
         USECT    PPLINK
         CAL1,1   FPTSYS2           OPEN SYSTEM LIBRARY FILE
         USECT    PLSECT
FPTSYS2  GEN,8,7,17      X'14',0,F:LINKIN
         DATA     X'40000009'
         DATA     SYSLBABN          ABNORMAL
         DATA     X'01000202'
         TEXTC    ':BLIB'
         DATA     X'02010202'
         TEXT     ':SYS    '
         USECT    PPLINK
         B        TSTLIB7           LOAD THE SYSTEM LIBRARY
         PAGE
ADVNEFLE EQU      %
         LI,R1    2
         CW,R1    SWT               BREAK BIT SET
         BAZ      ADVANCE1          NO
         BAL,SR2  INTACTRD          GO GET AN INTERACTIVE COMMAND
ADVANCE1 EQU      %
         LW,R1    PLISTBUF
         STW,R1   PLISTORG          SET OPTIONS LOCATION
         LI,R1    1
         STW,R1   FIRSTRD           SET AT FIRST READ
         PSW,SR4  TSTACK            SAVE RETURN BECAUSE OF POS ERROR EXT
         LI,R1    X'100'
         CW,R1    *PLISTORG         % FILE
         BAZ      LINK6             NO-OPEN NEXT FILE
         MTW,1    PLISTBUF          INC. TO NEXT ENTRY
ADVANCE3 EQU      %                 ENTER FROM RETYPE %
         CAL1,1   FPTSET            LATER CLOSED DCB WILL BE CLOSED
         USECT    PLSECT
FPTSET   GEN,8,7,17      X'06',0,F:LINKIN
         DATA     X'40000000'
         DATA     0                 REMOVE ABNORMAL ADDRESS
         USECT    PPLINK
         LI,R1    X'015B'
         STH,R1   OPNIN+6           SET 01% FOR INTERNAL SYM TABLE KEY
         CAL1,1   FPTOPGO           OPEN M:GO IN MODE
         USECT    PLSECT
FPTOPGO  GEN,8,7,17      X'14',0,M:GO
         DATA     X'41000000'
         DATA     LINKERR2          ABNORMAL
         DATA     1                 IN MODE
         USECT    PPLINK
         PLW,SR4  TSTACK            RESTORE RETURN
         LI,R1    X'40'
         CW,R1    *PLISTORG         IS THIS A LIBRARY FILE
         BANZ     *SR4              YES-DONT PRINT'LINKING' MESSAGE
         M:DEVICE,E COMPARDO
         CI,SR1   1                 UC&DO COMPARE??
         BE       %+4               YES
         LI,ADR   WA(LOADB)         NO PUT BATCH MESSG OUT
         LI,CNT   BCNT:LOADB
         B        %+3
         LI,ADR    WA(LOADD)
         LI,CNT    BCNT:LOADD
         M:WRITE,E MESSAGE
         B        *SR4              RETURN
LINK6    EQU      %
         LI,R1    X'FFDFF'
         AND,R1   OPNIN+1
         STW,R1   OPNIN+1           REMOVE VARIABLE PARM. FLAGS.
         LI,R2    7                 ALWAYS 7 WORDS IN PLIST
         LW,R3    *PLISTBUF,R2
         STW,R3   OPNIN+4,R2
         BDR,R2   %-2               MOVE PLIST TO OPEN FPT.
         MTW,5    PLISTBUF          INC. TO +5
         LI,R1    X'10000'
         CW,R1    *PLISTBUF         PASS WORD PRESENT
         BANZ     LINK15            NO
         LI,R1    X'200'
         STS,R1   OPNIN+1           SET F3 TO PASS WORD PRESENT
         MTW,2    PLISTBUF          INC. TO +7
         LI,R2    3
         LW,R3    *PLISTBUF,R2
         STW,R3   OPNIN+11,R2
         BDR,R2   %-2               MOVE PASS WORD TO OPEN FPT.
         MTW,1    PLISTBUF
LINK15   MTW,3    PLISTBUF          INC. TO NEXT ENTRY
ADVANCE2 EQU      %
,OPNIN   M:OPEN   F:LINKIN,(FILE,'XXXXXXXXXXX','XXXXXXXX'),;
                  (IN),(PASS,'XXXXXXXX'),(ABN,LINKERR2),(CONSEC)
         PLW,SR4  TSTACK            RESTORE RETURN
         LI,R1    X'40'
         CW,R1    *PLISTORG         IS THIS A LIBRARY FILE
         BANZ     *SR4              YES-DONT PRINT 'LINKING' MESSAGE
PNTFILE  EQU      %
         LI,ADR    WA(LOADD)
         LI,CNT    BCNT:LOA
         M:DEVICE,E COMPARDO
         CI,SR1   0
         BNE      %+2
         AI,CNT   -2
         M:WRITE,E MESSAGE
FPTLOAD2 EQU      %
         LB,R1    OPNIN+6           NO. CHARS IN FILE NAME
         AI,R1    1
         LI,R2    ' '
         STB,R2   OPNIN+6           INSERT LEADING BLANK
         LI,ADR    WA(OPNIN)+6
         LW,CNT    R1
         M:WRITE,E MESSAGE
         AI,R1    -1              RESTORE BYTE COUNT
         STB,R1   OPNIN+6           RESTORE FILE NAME COUNT
         B        *SR4              RETURN
         PAGE
*                 REPEAT LOAD. ONLY ONE OF THREE LOAD ITEMS ARE LEGAL.  14108410
*                 IF 4X, GET ABSOLUTE DATA AND STOKE N TIMES. OTHERWISE 14108420
*                 SET UP CHAIN AND LOAD NORMALLY.                       14108430
RLOAD    BAL,SR4  2BNUM             REPEAT COUNT IN (R7)                14108440
         LW,SR1   R7                                                    14108450
         BEZ      PA7               ERROR-REPEAT COUNT ZERO             14108460
         BAL,SR4  GBYTE             GET LOAD ITEM CONTROL (R5)          14108470
         LW,R1    R5                                                    14108480
         SLS,R1   -4                                                    14108490
         CI,R1    K8                LOAD SHORT FORM                     14108500
         BGE      RLOAD1            YES                                 14108510
         CI,R1    K4                LOAD ABSOLUTE                       14108520
         BE       LABS1             YES-GO LOAD N TIMES                 14108530
         CI,R1    K5                                                    14108540
         BNE      PAA               ERROR-NOT A LOAD ITEM               14108550
RLOAD1   LW,SR2   LOC              %LOAD LONG FORM AND SHORT FORM       14108560
         SLS,SR2  -2                TOP OF CHAIN                        14108570
RLOAD3   LW,R2    LOC                                                   14108580
         SLS,R2   -2                                                    14108590
         STW,R2   *R2               CREATE CHAIN
         MTW,1    *R2               POINT TO NEXT CELL
         BDR,SR1  RLOAD2            REPEAT COUNT                        14108620
         CI,R1    K5                                                    14108630
         BE       LLREL1            GO LOAD LONG                        14108640
         B        LSREL1            GO LOAD SHORT                       14108650
RLOAD2   LI,R6    K4                                                    14108660
         BAL,SR4  INCLOC            INCREMENT LOC BY A WORD             14108670
         B        RLOAD3                                                14108680
*                 LOAD ABSOLUTE. REPEAT COUNT IN SR1. THIS ENABLES      14108690
*                 RLOAD TOUSE SAME ROUTINE. NUMBER OF BYTES TO LOAD     14108700
*                 SPECIFIED BY R5(28-31). 0 IMPLIES 16. DATA IS READ    14108710
*                 INTO D1-D4 AND STORED SPECIFIED NUMBER OF TIMES.      14108720
LABS     LI,SR1   K1                REPEAT COUNT OF ONE                 14108730
LABS1    AND,R5   M4                MASK OUT BYTE COUNT                 14108740
         BNEZ     LABS2             IF ZERO                             14108750
         LI,R5    K10               SET AT 16                           14108760
LABS2    LW,R7    R5                SAVE BYTE COUNT                     14108770
         PSW,R7   TSTACK                                                14108780
         LI,R6    K0                                                    14108790
LABS3    BAL,SR4  GBYTE             GET A LOAD ITEM BYTE IN R5          14108800
         STB,R5   D1,R6                                                 14108810
         AI,R6    K1                                                    14108820
         BDR,R7   LABS3             GET N BYTES & PUT TOG IN D1,D2,D3,D414108830
LABS4    LW,R7    *TSTACK           RESTORE BYTE COUNT                  14108840
         LI,R5    K0                                                    14108850
LABS5    LW,R1    LOC               CURRENT LOAD LOCATION COUNTER       14108860
         LB,R2    D1,R5                                                 14108870
         STB,R2   0,R1              STORE THE ABS BYTE
         LI,R6    K1                                                    14108890
         BAL,SR4  INCLOC            GO INCR LOAD LOC COUNTER BY 1 BYTE  14108900
         AI,R5    K1                                                    14108910
         BDR,R7   LABS5             PUT N BYTES INTO MEMORY             14108920
         BDR,SR1  LABS4             REPEAT M NO OF TIMES(REPEAT COUNT)  14108930
         PLW,R1   TSTACK            FREE TSTACK ENTRY                   14108940
         B        LDR1                                                  14108950
*                 LOAD RELOCATABLE LONG FORM. ROUTINE IS ORGANIZED SO   14108960
*                 IT CAN ALSO BE USED BY RLOAD AND LSREL. THE LOCATION  14108970
*                 (LOC) IS INCREMENTED. 1 OR 2 BYTES ARE READ FOR DECL  14108980
*                 OR FREF NO. (SR2). INDICATOR C TO SR1.RR TO R6.       14108990
*                 THEN AT LLREL2, THE WORD IS READ, 0 TO *LOC AND LOC   14109000
*                 IS CHECKED TO SEE IF IT IS A WORD ADDRESS. THEN AN    14109010
*                 EXPRESSION IS FORMED AND PUT IN THE TABLE.            14109020
LLREL    LW,SR2   LOC               NO CHAIN SO PICK UP CURRENT LOC     14109030
         SLS,SR2  -2                WORD RESOLUTION                     14109040
LLREL1   LW,R6    R5                                                    14109050
         BAL,SR4  12BNUM
         BAL,SR4  DECLCHK
LLREL4   AND,R6   M3                                                    14109130
LLREL2   BAL,SR4  3BNUM             GO GET 3 BYTES (R7)                 14109140
         BAL,SR4  GBYTE             GO GET A BYTE (R5)                  14109150
         STB,R5   R7                                                    14109160
         SCS,R7   8                 GET 4 BYTES OF LOAD INFO (R7)       14109170
         LI,R1    K3                                                    14109180
         AND,R1   LOC                                                   14109190
         BNEZ     PA7               ERROR-LOC NOT AT WORD BOUNDARY      14109200
         LW,R2    LOC                                                   14109210
         SLS,R2   -2                LOC-WORD RESOLUTION (R2)            14109220
         STW,R1   *R2               ZERO MEMORY TO END POSSIBLE CHAIN
         STW,SR2  BUF2+2            DISTINATION AT START OF CHAIN       141
         STW,R7   BUF2+4            SAVE LOAD ITEM                      14109250
         LI,R1    K8402             DEFINED CONSTANT(LOAD ITEM),EXP END 14109260
         STH,R1   BUF2+1                                                14109270
         LI,R5    K20               ADD DEC OR FREF                     14109280
         AW,R5    R6                0010-0CRR(R5) +VAL DEC OR FREF@RESOL14109290
         LW,R7    SR3               FREF OR DEC # IN R7                 14109300
         LW,R1    DUMEXPR           Y0300800                            14109310
         SW,R1    Y0202             DEVEL RELATIVE POINTER IN EXP (03)  14109320
         STW,R1   BUF2              FOR CHKFREFD OR CHKDECLD            14109330
         LI,SR3   K0                                                    14109340
         CI,R6    K4                                                    14109350
         BAZ      LLREL5            FREF                                14109360
         BAL,SR4  CHKFREFD          YES                                 14109370
         B        LLREL6                                                14109380
LLREL5   BAL,SR4  CHKDECLD          NO-DEC                              14109390
LLREL6   STW,R7   BUF2+3            1ST VALUE WORD OF EXP               14109400
         MSP,SR3  TSTACK            REMOVE ENTRY JUST PLACED            14109410
         OR,R5    DUMEXPR                                               14109420
         STW,R5   BUF2              05-03-80-00100CRR-1ST WORD OF EXP   14109430
*                 CHECK IF RELOCATABLE LOAD ITEM IS SIMPLE TYPE, I.E.   14109440
*                 ZERO ADDRESS FIELD AND WORD RESOLUTION.               14109450
         AND,R5   M8                                                    14109460
         CI,R5    K80               IS VALUE DEFINED                    14109470
         BGE      LLREL7            YES                                 14109480
         LI,R1    K3                                                    14109490
         AND,R1   R5                MASK OUT RR                         14109500
         CI,R1    K2                WORD RESOLUTION                     14109510
         BNE      LLREL7            NO                                  14109520
         LI,R1    K1FFFF                                                14109530
         AND,R1   BUF2+4            SIMPLE ADDR FIELD                   14109540
         BEZ      LLREL8            YES                                 14109550
LLREL7   EQU      %                 NO-ENTER EXP ANALYSE                14109560
         BAL,SR4  EXPTTB            PUT EXP IN EXP STK                  14109570
         BAL,SR4  EVEXP             GO EVALUATE EXP                     14109580
LLREL11  EQU      %                                                     14109590
         LI,R6    K4                                                    14109600
         BAL,SR4  INCLOC            INCR LOC BY A WORD                  14109610
         B        LDR1              NEXT LOAD ITEM                      14109620
*                 LOAD RELOCATABLE  SHORT FORM. INCREMENT LOC. R5(26-31)14109630
*                 TO SR2. C TO SR1. 2 TO R6. THEN TRANSFER CONTROL TO   14109640
*                 LLREL2.                                               14109650
LSREL    LW,SR2   LOC               CORE ADDR OF NXT PROGRAM BYTE       14109660
         SLS,SR2  -2                WORD RESOLUTION                     14109670
LSREL1   LI,SR3   K3F                                                   14109680
         AND,SR3  R5                MASK OUT DEC OR FREF # -(SR3)       14109690
         LW,R6    R5                                                    14109700
         SLS,R6   -4                                                    14109710
         AND,R6   X4                                                    14109720
         AI,R6    K2                0C10 -WORD RESOLUTION               14109730
         B        LLREL2                                                14109740
*                 INSTEAD OF INSERTING EXPRESSION INTO EXPRSTK, CHAIN   14109750
*                 THROUGH ADDRESS FIELD OF LOAD ITEM.                   14109760
LLREL8   EQU      %                                                     141
         LW,D1    BUF2+2            DESTINATION IN MEMORY               141
         LD,D3    BUF2+3            POINTER TO LAST ENTRY IN CHAIN      141
*                                   LOAD ITEM                           141
         CI,R5    4                 REF OR FREF                         141
         BANZ     LLREL9            FREF                                141
         AW,R0    RFDFBAS           CORE LOCATION OF CHAIN ORG.         141
         B        %+2                                                   141
LLREL9   AW,R0    FREFBAS                                               141
         STW,D3   *R0               RESET CHAIN ORG. TO LAST ENTRY      141
*                                   IN EXPRESSION STACK                 141
LLREL10  LB,R1    D3                POINT TO CORE OR LAST ENTRY         141
         BEZ      GOCORE            YES                                 141
         LW,R0    R1                                                    141
         AW,R0    D3                                                    141
         AW,R0    EXPRBAS           CORE LOCATION OF EXPSTK POINTER     141
         LW,D3    *R0               GET THE POINTER                     141
         B        LLREL10                                               141
GOCORE   STW,D1   *R0               NEW CORE ENTRY                      141
         MTW,0    *D1               CHAIN END
         BEZ      GOCORE1           YES                                 141
         STS,D4   *D1               NO-STORE LOAD ITEM INTO POINTER
         AI,D1    1                 NEXT MEMORY WORD                    141
         B        GOCORE+1                                              141
GOCORE1  OR,D4    D3                POINTER TO PREVIOUS CORE ITEM       141
         STW,D4   *D1               INTO MEMORY
         B        LLREL11                                               141
         PAGE
INTSYM   EQU      %                 TYPE INFO FOR INTERNAL SYMBOL
         LI,R5    0
         STW,R5   BUF2              CLEAN OUT NAME FIELD
         STW,R5   BUF2+1
         BAL,SR4  GBYTE             TYPE AND RESOLUTION %R5<
         SLS,R5   24
         STW,R5   BUF2+2            WORD 3 OF INT.SYMBOL TBL. ENTRY
         BAL,SR4  GBYTE             NAME LENGTH %R5<
         CI,R5    0
         BE       PA7               ERROR-NAME LENGTH ZERO
         CI,R5    63
         BG       PA7               ERROR-NAME LENGTH GT 63 BYTES
         STB,R5   BUF2
         LW,R6    R5
         CI,R6    7
         BLE      %+2
         LI,R6    7                 ALLOW NO MORE THAN 7 CHARS.
         LI,R7    1
INTSYM1  BAL,SR4  GBYTE
         STB,R5   BUF2,R7           PUT FIRST 7 CHARS IN NAME FIELD
         AI,R7    1
         BDR,R6   INTSYM1
         LB,R6    BUF2
         AI,R6    -7                MORE THAN 7 CHARS.
         BLEZ     INTSYM2           NO
         BAL,SR4  GBYTE             BURN REMAINING CHARS
         BDR,R6   %-1
INTSYM2  BAL,SR4  ENSYMTBL          GO PUT ENTRY IN SYMBOL TBL. PONT%R7<
         LI,R6    1                 INTERNAL SYMBOL TABLE DESTINATION
         BAL,SR4  EXPRIN            GO EVALUATE EXPRESSION
         B        LDR1              NEXT CONTROL BYTE
         PAGE
GLBSYM   EQU      %                 TYPE INFO. FOR GLOBAL SYMBOL
         BAL,SR4  GBYTE             TYPE,RESOLUTION (R5)
         PSW,R5   TSTACK
         BAL,SR4  12BNUM            DECL. NO. (R7)
         BAL,SR4  DECLCHK           CHK DECLARATION #
         PLW,R5   TSTACK
         LD,R6    *DECLBAS,R7       REF/DEF POINTER (R7)
         AI,R7    2                 POINT TO TYPE,RESOLUTION WORD
         STW,R5   *RFDFBAS,R7       PUT AWAY TYPE,RESOLUTION
         B        LDR1              NEXT CONTROL BYTE
         PAGE
UDEFSYM  EQU      %                 UNDEFINED SYMBOLS
         LI,R5    0
         STW,R5   BUF2
         STW,R5   BUF2+1
         BAL,SR4  GBYTE             NAME LENGTH (R5)
         CI,R5    0
         BE       PA7               ERROR-NAME LENGTH ZERO
         CI,R5    63
         BG       PA7               ERROR-NAME LENTH GT 63 BYTES
         STB,R5   BUF2
         LW,R6    R5
         CI,R6    7
         BLE      %+2
         LI,R6    7                 ALLOW NO MORE THAN 7 CHARS.
         LI,R7    1
UDEFSYM1 BAL,SR4  GBYTE
         STB,R5   BUF2,R7           PUT FIRST 7 CHARS IN NAME FIELD
         AI,R7    1
         BDR,R6   UDEFSYM1
         LB,R6    BUF2
         AI,R6    -7                MORE THAN 7 CHARS.
         BLEZ     UDEFSYM2          NO
         BAL,SR4  GBYTE             BURN REMAINING CHARS.
         BDR,R6   %-1
UDEFSYM2 LW,R1    Y8
         STW,R1   BUF2+2            UDEF TYPE CODE
         BAL,SR4  2BNUM             FREF. NO. (R7)
         OR,R7    MODNUM            PUT MODULE NO. INTO FR NO.
         LI,R1    -1
         LW,R2    FREFSTK+1
         AND,R2   M15
         SLS,R2   -1                NO. ENTRIES IN FR STACK
UDEFSYM3 AI,R1    1
         CW,R1    R2
         BGE      PA7               ERROR-FR NOT IN STACK
         LD,R4    *FREFBAS,R1
         CW,R7    R4
         BNE      UDEFSYM3          NOT THIS ENTRY
         LB,R1    R5                POINT TO CORE
         BEZ      UDEFSYM6          YES
UDEFSYM4 AW,R1    R5
         LW,R5    *EXPRBAS,R1       GET NEXT POINTER IN EXPRESSION CHAIN
         LB,R6    R5                POINT TO CORE
         BEZ      UDEFSYM5          YES
         LW,R1    R6
         B        UDEFSYM4          GET NEXT ITEM IN CHAIN
UDEFSYM5 LI,R2    0
         STW,R2   *EXPRBAS,R1       END THE CHAIN
UDEFSYM6 STS,R5   BUF2+2            PUT CORE CHAIN ORIGIN IN SYMTBL.
         LW,SR3   R7                DESTINATION ADDRESS
         BAL,SR4  ENSYMTBL          GO PUT ENTRY IN SYMBOL TBL.
         LI,SR1   0                 SET FR TO ZERO
         LI,SR2   0                 DESTINATION TYPE-NOT FR AND HOLD
         PSW,SR1  TSTACK            RESOLUTION
         BAL,SR4  FREFCHN           GO-SATISFY THE FR
         PLW,SR1  TSTACK
         LI,R1    X'49'
         CW,R1    *PLISTORG         DISPLAY OF USAT IST WHANTED
         BANZ     LDR1              NO
         LI,ADR    WA(TPREF)
         LI,CNT    BCNT:TPREF
         M:WRITE,E MESSAGE
         BAL,R7   INTRNAME          GO-PRINT INTERNAL NAME
         B        LDR1              NEXT CONTROL BYTE
         PAGE
ENSYMTBL EQU      %                 PUT AN ENTRY IN THE SYMBOL TABLE
         LI,R1    X'41'             LIBRARY MODE,NI
         CW,R1    *PLISTORG         IST TO BE CREATED
         BANZ     *SR4              NO
         LW,R1    SYMBOLTB
         LW,R3    M30               DO NOT CHECK TYPE
         LW,R2    BUF2
ENSYMTB1 CI,R1    VDP               CHECKED ALL ENTRIES
         BGE      ENSYMTB4          YES
         CS,R2    0,R1              COUNT AND 3 CHARS MATCH
         BE       ENSYMTB3          YES
ENSYMTB2 AI,R1    3                 ADVANCE TO NEXT ENTRY
         B        ENSYMTB1
ENSYMTB3 LW,R4    BUF2+1            CHECK LAST 4 CHARS
         CW,R4    1,R1              ENTRY IN IST
         BNE      ENSYMTB2          NO
         LI,R7    0                 YES-SET NO DESTINATION
         LI,R1    X'51'
         CW,R1    *PLISTORG         DISPLAY OF IST CONFLICT WHANTED
         BANZ     *SR4              NO
         LI,ADR    WA(TDDEF)
         LI,CNT    BCNT:TDDEF
         M:WRITE,E MESSAGE
         BAL,R7   INTRNAME          GO-PRINT INTERNAL NAME
         LI,R7    0                 SET-NO DESTINATION
         B        *SR4              AND RETURN (RETAIN FIRST ENTRY)
ENSYMTB4 EQU      %
         BAL,R0   MMSYMBTB          GO-GET ROOM FOR SYMBOL TABLE
         LI,R1    -3                3 WORD ENTRY
         LW,R2    BUF2+3,R1
         STW,R2   *SYMBOLTB,R1
         BIR,R1   %-2               COPY ENTRY TO SYMBOL TABLE
         MTW,-3   SYMBOLTB
         LW,R7    SYMBOLTB          POINTER TO THIS ENTRY
         B        *SR4
         PAGE
INTRNAME LB,R1    BUF2
         AND,R1   =X'3F'            GET COUNT OF CHARS
         CI,R1    7
         BLE      %+2
         LI,R1    7                 NO MORE THAN 7 CHARS ARE SAVED
         AI,R1    1                 COUNT TRAILING NL CHAR.
         LI,R2    X'15'
         STB,R2   BUF2,R1           PUT NL AT END OF NAME
         AI,R1    1                 COUNT LEADING BLANK
         LI,R2    ' '
         STB,R2   BUF2              PUT IN LEADING BLANK
         LI,ADR    WA(BUF2)
         LW,CNT    R1
         M:WRITE,E MESSAGE
         B        *R7
         PAGE                                                           14110040
*                 ENTER NAME. READ DECLARED NAME INTO BUF2. SEARCH      14110050
*                 RFDFSTK FOR NAME. IF NOT ALREADY IN, PUT NAME INTO    14110060
*                 RFDFSTK. RETURN POINTER TO ENTRY (R6)                 141
ENNAM    PSW,SR4  TSTACK            SAVE RETURN LINKAGE                 14110080
         BAL,SR4  GBYTE             GO GET NAME LENGTH IN R5            14110090
         CI,R5    K0                                                    14110100
         BE       PA7               ERROR- NAME LGTH ZERO               14110110
         CI,R5    K3F                                                   14110120
         BG       PA7               ERROR-LGTH > 63 BYTES               14110130
         STB,R5   BUF2+3            BUILD A RFDFSTK ENTRY IN BUF 2      141
         LW,R6    R5                                                    14110150
         LI,R7    K1                                                    14110160
ENNAM1   BAL,SR4  GBYTE                                                 14110170
         STB,R5   BUF2+3,R7                                             141
         AI,R7    K1                                                    14110190
         BDR,R6   ENNAM1            PUT THE NAME IN BUF2                14110200
         PLW,SR4  TSTACK            RESTORE RETURN LINKAGE              14110210
         LB,R1    BUF2+3            LENGTH OF NAME IN BYTES             141
         LI,R2    K0                                                    14110240
         STW,R2   BUF2              ZERO FIRST WORD OF ENTRY
         STW,R2   BUF2+1            ZERO VALUE WORD
         LI,R2    2                 INSTRUCTION TYPE-WORD RESOLUTION
         STW,R2   BUF2+2            INTO ENTRY (DEFAULTED-OVERIDEN ROM)
         AI,R1    16                3 WORDS PLUS CHAR COUNT
         SLS,R1   -2
         STB,R1   BUF2              ENTRY LENGTH IN WORDS
         LW,R6    RFDFBAS                                               14110310
ENNAM5   LI,R7    X'1FFFF'          MASK OUT STRAY BIT ON SIGMA 5       141
         CS,R6    RFDFSTK           CHECKED ALL ENTRIES                 141
         BG       ENNAM2            YES-NAME NOT IN STK - GO ENTER      14110330
         LI,R2    3                                                     141
         AW,R2    R6                POINTER TO NAME FIELD               14110350
         LB,R3    BUF2+3            NO. OF BYTES IN NAME                141
         CB,R3    *R2               NO OF BYTES IN ENTRY NAME           14110370
         BNE      ENNAM3            NO                                  14110380
ENNAM4   LB,R1    *R2,R3            YES-COMPARE BYTES 1 AT A TIME       14110390
         CB,R1    BUF2+3,R3                                             141
         BNE      ENNAM3            NOT SAME NAME                       14110410
         BDR,R3   ENNAM4                                                14110420
ENNAM6   SW,R6    RFDFBAS           FORM REL POINTER TO ENTRY-NAME FOUND14110430
         B        *SR4                                                  14110450
ENNAM3   LB,R1    *R6                                                   14110460
         AW,R6    R1                ADD LENGTH OF ENTRY                 14110470
         B        ENNAM5                                                14110480
*                 ALTERNATE ENTRY TO MERELY PUT NAME INTO TABLE.        14110490
ENNAM11  EQU      %                                                     14110500
ENNAM2   SW,R6    RFDFBAS           MAKE REL POINTER TO ENTRY           14110510
ENNAM8   LB,R1    BUF2              SIZE OF ENTRY                       14110520
         MSP,R1   RFDFSTK                                               14110530
         BCR,8    ENNAM9                                                14110540
         LI,R1    RFDFN                                                 14110550
         BAL,R4   STKOVF            GO EXPAND RFDFSTK                   14110560
         B        ENNAM8            TRY AGAIN                           14110570
ENNAM9   LW,D4    RFDFSTK                                               14110580
         SW,D4    R1                CORE ADDR OF NEW ENT IN RFDFSTR     14110590
ENNAM10  LW,D3    BUF2-1,R1                                             14110600
         STW,D3   *D4,R1            PUT ENTRY IN RFDFSTK                14110610
         BDR,R1   ENNAM10                                               14110620
         B        *SR4              RETURN
         PAGE                                                           14110640
*                 ENTER DECLARATION INTO DECLSTK. IF NECESSARY, EXPAND  14110650
*                 DECLSTK TO PROVIDE SPACE.                             14110660
ENDECL   LCI      K2                                                    14110670
         PSM,R5   DECLSTK                                               14110680
         BCR,8    *SR4                                                  14110690
         PSW,SR4  TSTACK                                                14110700
         LI,R1    DECLN                                                 14110710
         BAL,R4   STKOVF                                                14110720
         PLW,SR4  TSTACK                                                14110730
         B        ENDECL                                                14110740
         PAGE                                                           14110750
*                 READ EXPRESSION. PUT EXPR INTO EXPRSTK. EVALUATE.     14110760
*                 EXPRIN READS THE EXPRESSION AND BUILDS IT IN          14110770
*                 BUF2. THEN IT CALLS EXPTTB AND EVEXP FOR REMAINING    14110780
*                 ACTION.                                               14110790
EXPRIN   PSW,SR4  TSTACK                                                14110800
         STW,R7   BUF2+1            SAVE DESTINATION                    14110810
         SLS,R6   8                                                     14110820
         OR,R6    Y0202             MINIMUM ENTRY                       14110830
         STW,R6   BUF2              SAVE DESTIN TYPE AND CONTROL BYTE   14110840
         LI,R6    K2                EXP CONTROL BYTE COUNTER            14110850
         LI,SR3   K0                # OF UNDEFINED VALUE WORDS          14110860
*                 BYTE MUST BE SOME EXPRESSION CONTROL BYTE. THE VALID  14110870
*                 BYTES AND CORRESPONDING ROUTINES ARE:                 14110880
*                   01-ADD CONSTANT-ADCON1   02-EXPR. END-EXPREND1      14110890
*                   2X-ADD DECL -ADDECL1     24+X-ADD FREF-ADFREF1      14110900
*                   28+X-SUB DECL-SBDECL1    2C+X-SUB FREF-SBFREF1      14110910
*                   3X-CHANGE RESOLUTION- CHGRES1                       14110920
EXPRIN1  BAL,SR4  GBYTE             GO GET EXP CONTROL BYTE (R5)        14110930
         CI,R5    K0                                                    14110940
         BE       EXPRIN1           SKIP PADDING                        14110950
*                 PUT A BYTE INTO THE EXPRESSION CONTROL STRING OF      14110960
*                 BYTES.                                                14110970
PUTBYTE  AI,R6    K1                ADVANCE EXP CONTROL BYTE COUNTER    14110980
         LI,R1    K3                                                    14110990
         AND,R1   R6                                                    14111000
         BNEZ     PUTBYTE1          DIDNOT CROSS WORD BOUNDARY          14111010
         MTB,1    BUF2              ADVANCE SIZE OF EXP                 14111020
         MTH,1    BUF2              ADVANCE WORD OF 1ST VALUE ITEM      14111030
         LB,R1    BUF2              SIZE OF ENTRY (R1)                  14111040
         CI,R1    BUF2SIZ                                               14111050
         BG       PAA               ERR-SIZE OF ENT > BUF2 SIZE         14111060
         LH,R2    BUF2                                                  14111070
         AND,R2   M8                                                    14111080
         AI,R2    KN1               REL ADDR OF DESTIN WORD             14111090
         SW,R1    R2                NO. OF WORDS TO MOVE                14111100
         AI,R2    BUF2-1            TO  ADDR                            14111110
         LW,R3    R2                                                    14111120
         AI,R3    KN1               FROM ADDR                           14111130
PUTBYTE2 LW,R4    *R3,R1                                                14111140
         STW,R4   *R2,R1            EXPAND ENTRY TO MAKE ROOM           14111150
         BDR,R1   PUTBYTE2          FOR MORE CONTROL BYTES              14111160
         LI,R1    KN1                                                   14111170
         AW,R1    SR3                                                   14111180
         LW,R3    TSTACK                                                14111190
         AI,R3    K1                                                    14111200
         LW,R4    Y01                                                   14111210
         B        PUTBYTE4                                              14111220
PUTBYTE3 LW,R2    *R3,R1                                                14111230
         AWM,R4   *R2               ADJ REL POINTERS TO ALL WDS JUST MVD14111240
PUTBYTE4 BIR,R1   PUTBYTE3                                              14111250
PUTBYTE1 STB,R5   BUF2,R6           PUT AWAY EXP CONTROL BYTE           14111260
         CI,R5    K1                                                    14111270
         BE       ADCON1            ADD CONSTANT                        14111280
         CI,R5    K2                                                    14111290
         BE       EXPREND1          EXP END                             14111300
         LW,R1    R5                                                    14111310
         SLS,R1   -2                REMOVE RESOLUTION                   14111320
         CI,R1    K8                                                    14111330
         BE       ADDECL1           ADD VALUE OF DECLARATION            14111340
         CI,R1    K9                                                    14111350
         BE       ADFREF1           ADD VALUE OF FORWARD REF            14111360
         CI,R1    KA                                                    14111370
         BE       SBDECL1           SUB VALUE OF DECLARATION            14111380
         CI,R1    KC                                                    14111390
ABSSECT1 EQU      EXPRIN1                                               14111400
         BG       ABSSECT1          ADD ABS SECT-SUB ABS SECT(NO VAL WD)14111410
         BE       CHGRES1           CHANGE RESOL (NO VALUE WORD)        14111420
         CI,R1    KB                                                    14111430
         BNE      PAA               ERR-NOT LEGAL CONTROL BYTE          14111440
CHGRES1  EQU      EXPRIN1                                               14111450
SBFREF1  BAL,SR4  2BNUM            %SUB VAL OF FWD REF-GET FR# IN R7    14111460
         LB,R5    BUF2,R6           RESTORE CONTROL BYTE IN R5          14111470
         BAL,SR4  CHKFREFD          GO CHECK FREF                       14111480
PTWRD1   STB,R5   BUF2,R6           POSSIBLY DEFINED                    14111490
PTWRD    EQU      %                                                     14111500
*                 PUT AWORD INTO THE CUMULATIVE LIST OF ELEMENTS.       14111510
PUTWORD  LB,R1    BUF2                                                  14111520
         CI,R1    BUF2SIZ                                               14111530
         BG       PAA               ERR-EXP > BUF2 SIZE                 14111540
         MTB,1    BUF2              COUNT THE VALUE WORD                14111550
         STW,R7   BUF2,R1           PUT AWAY VALUE WORD (CHAINED)       14111560
         B        EXPRIN1                                               14111570
ADFREF1  EQU      SBFREF1          %SUB FR# SAME AS ADD FR#             14111580
ADDECL1  BAL,SR4  12BNUM           %ADD-SUB VALUE OF DECLAR (R7)        14111590
         BAL,SR4  DECLCHK           CHK DECLARATION #
         LB,R5    BUF2,R6                                               14111600
         BAL,SR4  CHKDECLD                                              14111610
         B        PTWRD1                                                14111620
SBDECL1  EQU      ADDECL1                                               14111630
ADCON1   BAL,SR4  3BNUM            %ADD CONSTANT                        14111640
         BAL,SR4  GBYTE                                                 14111650
         STB,R5   R7                                                    14111660
         SCS,R7   8                                                     14111670
         LI,R5    K84               SET DEFINED CONSTANT CNTRL BYTE     14111680
         B        PTWRD1                                                14111690
EXPREND1 BAL,SR4  EXPTTB           %EXP END-GO PUT EXP INTO EXPSTK      14111700
         MSP,SR3  TSTACK            REMOVE POINTERS TO STACKS           14111710
         PLW,SR4  TSTACK            RETURN ADDR                         14111720
         B        EVEXP                                                 14111730
         PAGE                                                           14111740
*                 ROUTINE ADDS ITEM TO CHAIN FOR DESIGNATED FREF. IF    14111750
*                 FREF NO. NOT IN FREFSTK, PUT IT IN. RETURN LINK FOR   14111760
*                 ENTRY IN R7. R5 CONTAINS EXPR. CONTROL BYTE. R7 CONT- 14111770
*                 AINS FREF NO. BUF2(BYTE 0) CONTAINS RELATIVE WORD.    14111780
*                 IF FREF NO. HOLD TYPE AND DEFINED, RETURN VALUE (VIA  14111790
*                 HASVAL).                                              14111800
CHKFREFD LW,R1    FREFSTK+1                                             14111810
         OR,R7    MODNUM                                                141
         AND,R1   M15               MASK OUT WORD COUNT                 14111820
         BE       FPSHAGN           FREF TABLE EMPTY                    14111830
         LI,R2    K0                                                    14111840
CHKFLOOP EQU      %                                                     14111850
         LW,R3    *FREFBAS,R2                                           14111860
         AND,R3   FREFMSK           GET FREF #                          141
         CW,R7    R3                FREF # SAME                         14111880
         BE       FREFIN1           YES                                 14111890
         AI,R2    K2                                                    14111900
         CW,R2    R1                                                    14111910
         BL       CHKFLOOP          KEEP CHECKING                       14111920
FPSHAGN  LCI      K2               %ENTRY NOT IN TABLE-SOENTER          14111930
         PSM,R7   FREFSTK           MAKE ROOM FOR 2 WORD ENTRY          14111940
         BCR,8    FPSHOK                                                14111950
         LI,R1    FREFN                                                 14111960
         BAL,R4   STKOVF                                                14111970
         B        FPSHAGN                                               14111980
FPSHOK   LI,R7    K0               %NEW ENTRY-END OF CHAIN              14111990
         LW,R2    FREFSTK                                               14112000
         SW,R2    FREFBAS           GET REL POINTER TO TOP OF ENT IN R2 14112010
         B        FIXHED                                                14112020
FREFIN1  LW,R3    *FREFBAS,R2      %ENTRY FOUND-FREF AND HOLD           14112030
         BGEZ     FREFIN            NO                                  14112040
         AI,R2    K1                YES POINT TO VALUE WORD             14112050
         SLS,R3   -16               PUT RESOL OF VALUE AT LOW END       14112060
         LW,R7    *FREFBAS,R2       VALUE IN (R7)                       14112070
         B        HASVAL                                                14112080
FREFIN   AI,R2    K1               %ENTERY NOT DEF-MV POINT TOP OF ENT  14112090
         LW,R7    *FREFBAS,R2       POINTER TO CHAIN (R7)               14112100
FIXHED   LW,R1    EXPRSTK+1                                             14112110
         AND,R1   M15               # OF ENTRIES IN EXP STK (R1)        14112120
         LB,R3    BUF2                                                  14112130
         STB,R3   R1                REL DIS, EXPSTK POINTER (R1)        14112140
         LW,R0    R2                POINTER TO VAL WORD OF ENTRY (R0)   14112150
         STW,R1   *FREFBAS,R2       NEW POINTER IN FREFSTK              14112160
         ANLZ,R2  %-1               CORE ADDR FREF VAL ENT(R2)(CHN ORG) 14112170
         B        COMLNK                                                14112180
FREFMSK  DATA     X'7FF8FFFF'                                           141
         PAGE                                                           14112190
*                 ROUTINE CHECKS DECLARATION FOR DEFINITION. IF DEFINED 14112200
*                 PUT IN VALUE (PROPER RESOLUTION) AND CHANGE R5 TO     14112210
*                 ADD CONSTANT. IF NOT, ADD TO CHAIN FOR REF. JUST      14112220
*                 RIGHT SHIFT IF DEST. CORE. R5 CONTAINS EXPR. CONTROL  14112230
*                 BYTE. R7 CONTAINS DECL. NO.                           14112240
CHKDECLD LD,R2    *DECLBAS,R7       GET DEC ENTRY R2,R3                 14112250
         LW,R7    R3                VALUE OR POINTER (R7)               14112260
         LI,R3    K0                                                    14112270
         CW,R2    YE                IS IT CONTROL SECTION               14112280
         BAZ      HASVAL            YES-IT HAS A VALUE                  14112290
         LW,R3    *RFDFBAS,R7       NO-1ST WD OF RFDFSTK ENTRY (R3)     14112300
         AI,R7    K1                POINT TO VALUE OR POINTER           14112310
         CW,R3    Y009              DEF OR DUMMY SECT                   14112320
         BAZ      LINKREF           NO-GO CHAIN THE REF                 14112330
         SLS,R3   -17                                                   14112340
         LW,R7    *RFDFBAS,R7       YES-VAL OF DEF IN R7                14112350
HASVAL   EQU      %                %ENTRY FROM FREF - HOLD(DEFINED)     14112360
COMRES   CI,R5    K8                IS THIS A SUBTRACT VALUE            14112370
         BAZ      NOCOMP            NO                                  14112380
         LCW,R7   R7                YES-COMPLEMENT THE VALUE            14112390
NOCOMP   AND,R3   M3                MASK OUT RESOL CODE OF VALUE        14112400
         AND,R5   M2                MASK OUT RESOL CODE OF DESTIN       14112410
         LI,R2    KA000             DESTINATION PROGRAM                 14112420
         CW,R2    BUF2                                                  14112430
         BAZ      %+2               NO                                  14112440
         STB,R5   R7                YES-PUT RESOL OF DESTIN IN VAL WORD 14112450
         CI,R3    K4                VALUE A CONSTANT                    14112460
         BNE      %+2               NO                                  14112470
         LI,R5    K4                YES-SET CONTROL BYTE ADD CONSTANT   14112480
         AI,R5    K80               SET DEFINED                         14112490
         B        *SR4              RETURN                              14112500
MSKS     DATA     X'7FFFF',X'3FFFF',X'1FFFF',X'FFFF'                    14112510
LINKREF  EQU      %                                                     14112520
         LW,R3    EXPRSTK+1                                             14112530
         AND,R3   M15               # WDS IN EXP STR (R3)               14112540
         LB,R2    BUF2              REL POINTER TO VALUE WORD           14112550
         STB,R2   R3                REL POINTER,POINTER (R3)            14112560
         LW,R0    R7                                                    14112570
         XW,R3    *RFDFBAS,R7       X NEW AND OLD POINTER               14112580
         ANLZ,R2  %-1                                                   14112590
         LW,R7    R3                OLD POINTER IN R7                   14112600
COMLNK   PSW,R2   TSTACK            CORE ADR-CHN ORG PTS LST ITEM IN CHN14112610
         AI,SR3   KN1               COUNT THE ENTRIES                   14112620
         B        *SR4              RETURN                              14112630
         PAGE                                                           14112640
*                 MOVE EXPRESSION FROM BUF2 TO EXPRSTK. EXPAND IF       14112650
*                 NECESSARY.                                            14112660
EXPTTB   PSW,SR4  TSTACK                                                14112670
EXPTTB1  LB,R1    BUF2              SIZE OF EXP                         14112680
         LW,R6    EXPRSTK                                               14112690
         SW,R6    EXPRBAS                                               14112700
         AI,R6    K1                REL POINTER TO EXP                  14112710
         MSP,R1   EXPRSTK           MAKE ROOM FOR EXP                   14112720
         BCR,8    MOVEIN                                                14112730
         LI,R1    EXPRN                                                 14112740
         BAL,R4   STKOVF                                                14112750
         B        EXPTTB1                                               14112760
MOVEIN   LW,R1    EXPRSTK                                               14112770
         LB,R2    BUF2                                                  14112780
         SW,R1    R2                                                    14112790
MOVEIN1  LW,R3    BUF2-1,R2                                             14112800
         STW,R3   *R1,R2                                                14112810
         BDR,R2   MOVEIN1           MOVE EXP TO EXP STACK               14112820
         PLW,SR4  TSTACK                                                14112830
         B        *SR4                                                  14112840
         PAGE                                                           14112850
*                 EVALUATE THE DESIGNATED EXPRESSION IF POSSIBLE.       14112860
*                 RELATIVE EXPR LOC IN R6.  THIS ROUTINE MAY BE         14112870
*                 CALLED RECURSIVELY.                                   14112880
*                 THE REGISTERS(NON-VOLATILE) ARE USED AS FOLLOWS:      14112890
*                   R5   -CONTROL BYTE INDEX
*                   R6   -BASE ADDRESS OF EXPR                          14112910
*                   R7   -ASSOCIATED VALUE WORD INDEX
*                   SR1  -EXPR.ACC.                                     14112930
*                   SR2  -DESTINATION TYPE
*                   SR3  -DESTINATION ADDRESS
*                   SR4  -RETURN                                        14112960
EVEXP    LCI      K5                SAVE SOME REGIS SO CAN CALL AGAIN   14112970
         PSM,SR1  TSTACK                                                14112980
         BCR,8    EVEXP1                                                14112990
         LI,R1    TEMPN                                                 14113000
         BAL,R4   STKOVF                                                14113010
         B        EVEXP                                                 14113020
EVEXP1   AW,R6    EXPRBAS           CORE ADDR OF EXP OF INTEREST        14113030
         LH,R7    *R6                                                   14113040
         AND,R7   M8                REL ADR OF 1ST VAL WD (R7)          14113050
         LI,R5    K2                                                    14113060
         LI,SR1   K0                SET EXPRESSION AT 0                 14113070
         LI,SR2   K4                SET RESOL AT CONSTANT               14113080
EVEXP2   AI,R5    K1                ADVANCE CONTROL BYTE COUNTER        14113090
EVEXP3   LB,R1    *R6,R5            EXP CONTROL BYTE IN (R1)            14113100
         LW,R2    *R6,R7            ASSOC VAL WORD (R2)                 14113110
*                 GO TO ROUTINE DICTATED BY BYTE IN R1.                 14113120
         CI,R1    K80               DEFINED ADDITIVE QUANTITY           14113160
         BGE      ADCON2            YES                                 14113170
         CI,R1    K2                EXP END                             14113180
         BE       EXPREND2          YES                                 14113190
         LW,R3    R1                                                    14113200
         SLS,R3   -2                REMOVE RESOLUTION (R3)              14113210
         AND,R1   M2                RESOLUTION (R1)                     14113220
         CI,R3    KC                CHG RESOL OR UNDEFINED              14113230
         BLE      %+3              %ADD OR SUB ABS SECT                 14113240
         LW,SR2   R1                SET THE RESOL AND CONTINUE          14113250
         B        EVEXP2                                                14113260
         BNE      EXPRUND           UNDEFINED-RETURN                    14113270
*                 CHANGE THE RESOLUTION OF THE EXPRESSION.              14113280
CHGRES2  CI,SR2   K4                CURRENT RES CONSTANT                14113290
         BE       EVEXP2            YES-NO CHANGE                       14113300
         XW,SR2   R1                NEW RES-SR2                         14113310
         SW,R1    SR2               DIFF BET NEW AND OLD                14113320
         SLS,SR1  0,R1              AND ADJUST ACCORDINGLY              14113330
         B        EVEXP2                                                14113340
ADCON2   LB,R3    R2               %RESOL OF DESTIN FROM VALUE          14113350
         LI,R4    K3                                                    14113360
         AND,R4   R1                CONTROL BYTE RES (R4)(RR)           14113370
         LCW,R4   R4                                                    14113380
         SAS,R2   0,R4              ADJUST RES OF ADDITIVE VALUE
         LI,R4    KA000                                                 14113400
         CW,R4    *R6               PROGRAM DESTINATION                 14113410
         BAZ      ADCON3            NO                                  14113420
         CI,R5    K4                CONTROL BYTE FOR LOAD ITEM          14113430
         BNE      ADCON4            NO                                  14113440
         LB,R3    SR1               RESOL OF DESTINATION                14113450
         XW,R2    SR1               ACC(R2), LOAD ITEM (SR1)            14113460
         LW,R3    MSKS,R3           GET ADDR MASK(R3)                   14113470
         AW,R2    SR1               ADD ADDR AND LOAD ITEM (R2)         14113480
         STS,R2   SR1               PUT ADDR-LOAD ITEM AT RESOL         14113490
         B        INCWRD            GO-PROCESS EXPRESSION END           14113500
ADCON4   STB,R3   R2                RESTORE RESOL OF DESTINATION        14113510
ADCON3   AW,SR1   R2                ACCUM THE EXPRESSION                14113520
         CI,R1    K84               ADD CONSTANT                        14113530
         BE       INCWRD            YES-NO CHANGE IN RESOLUTION         14113540
         AND,R1   M2                RR OF CONTROL BYTE (R1)             14113550
         CI,SR2   K4                PRESENT RESOLUTION CONSTANT         14113560
         BE       %+2               YES                                 14113570
         LI,R1    K4                NO-POSSIBLE MIXED RES SO SET CONST  14113580
         LW,SR2   R1                SET RES TO THAT OF ADDED QUANTITY   14113590
INCWRD   AI,R7    K1                ADVANCE VALUE WORD POINTER          14113600
         B        EVEXP2            GO-PROCESS NXT EXP ITEM BYTE        14113610
*                 EXPRESSION VALUE HAS BEEN FOUND. MARK IT DEFINED.     14113620
*                 IF A DESTINATION EXISTS, SATISFY IT. ELSE RETURN      14113630
*                 TO CALL+2. REMOVE EXPRESSION IF POSSIBLE. ATTEMPT     14113640
*                 TO EVALUATE ALL EXPR'S WHICH MAY BE SATISFIED.        14113650
EXPREND2 LW,R1    Y008                                                  14113660
         STW,SR2  *TSTACK           SAVE RESOL OF EXP                   14113670
         STS,R1   *R6               SET EXPRESSION FREE                 14113680
         LW,SR2   *R6               FIRST WORD OF EXPRESSION            14113690
         LH,R1    SR2                                                   14113700
         AND,R1   M7                                                    14113710
         AI,R1    KN1                                                   14113720
         LW,SR3   *R6,R1            DESTINATION WORD (R1)               14113730
*                 REMOVE ALL POSSIBLE FROM EXPRSTK.                     14113740
         LI,R1    K0                                                    14113750
         LI,R2    K0                                                    14113760
         LW,R3    EXPRSTK+1                                             14113770
         AND,R3   M15               # OF WORDS IN EXP STACK             14113780
CHKEXPN  CW,R1    R3                                                    14113790
         BGE      MODEXSTK          CHECK ALL ENTRIES                   14113800
         LW,D1    *EXPRBAS,R1                                           14113810
         LB,D2    D1                                                    14113820
         AW,R1    D2                INCR BY # OF WORDS IN EXP (R1)      14113830
         AW,R2    D2                                                    14113840
         CW,D1    Y008              ENTRY FREE                          14113850
         BANZ     CHKEXPN           YES                                 14113860
         LI,R2    K0                RESET FREE ENTRY COUNTER            14113870
         B        CHKEXPN                                               14113880
MODEXSTK LCW,R2   R2                                                    14113890
         MSP,R2   EXPRSTK           CLEAN-OUT TOP MOST FREE ENTRY (S)   14113900
         LW,R1    *TSTACK           RESOLUTION OF VALUE                 14113910
         CI,SR2   X'1800'           TRUNC TO ADDR FOR DEF AND FREF
         BAZ      NOTRUNC
         CI,R1    4                 IS IT CONSTANT
         BE       %+2               YES
         AND,SR1  MSKS,R1           NO-SAVE ONLY 'RES' BITS
NOTRUNC  AND,R1   M2                DONT SHIFT IF CONSTANT
         CI,SR2   KA400             PROGRAM OR FIELD                    14113930
         BANZ     %+2               YES-DO NOT                          14113940
         SLS,SR1  0,R1              ADJUST TO BYTE RESOLUTION           14113950
*                 INVESTIGATE DESTINATION. IF NONE, EXIT CALL+2         14113960
         CI,SR2   KFF00             DESTIN PRESENT                      14113970
         BANZ     YESDEST           YES                                 14113980
         LI,R1    KN1               POINT TO SR4                        14113990
         MTW,1    *TSTACK,R1        RETURN CALL + 2                     14114000
         LW,R7    SR1               VALUE OF EXP(R7)                    14114010
         B        EVEXIT            RETURN-CALL +2 (ORG)                14114020
YESDEST  CI,SR2   KE000            %PROGRAM OR START ADDR DESTIN        14114030
         BANZ     CORECHN           YES                                 14114040
         CI,SR2   X'100'            INTERNAL SYMBOL TABLE
         BANZ     INTSYMVL          YES
         LI,SR4   EVEXIT            SET EXIT ADDR                       14114050
         CI,SR2   K1200             FREF OR FREF + HOLD                 14114060
         BANZ     FREFCHN           YES                                 14114070
         CI,SR2   K800              EXTERNAL DEF                        14114080
         BANZ     RFDFCHN           YES                                 14114090
*                 MUST BE FIELD. DEST. HAS FORM 0-7 CNT, 8-14 TERM,     14114100
*                 15-31 LOC.                                            14114110
         LB,R1    SR3               N BITS                              14114120
         LH,R4    SR3                                                   14114130
         SLS,R4   -1                                                    14114140
         AND,R4   M7                TERM BIT                            14114150
         AI,R4    K1                +1                                  14114160
         LI,D2    K0                                                    14114170
         LI,SR2   K0                                                    14114180
         LI,D1    K1                                                    14114190
FLDLOP1  SLD,SR1  -1                ALIGN TERM BIT AND VALUE            14114200
         SCS,D1   -1                                                    14114210
         BDR,R4   FLDLOP1                                               14114220
FLDLOP2  OR,D2    D1                BUILD MASK                          14114230
         SCS,D1   1                                                     14114240
         BCR,8    FLDLOP3                                               14114250
         LI,SR4   FLDLOP3                                               14114260
STORFLD  LW,D4    D2                                                    14114270
         LI,D3    K0                                                    14114280
         AND,D4   *SR3              PART OF WORD TO BE AFFECTED         141
         AD,SR1   D3                + FIELD VALUE                       14114300
         AND,SR2  D2                SAVE FIELD PART                     14114310
         EOR,D2   M32                                                   14114320
         AND,D2   *SR3
         OR,D2    SR2                                                   14114340
         STW,D2   *SR3
         AI,SR3   KN1                                                   14114360
         LW,SR2   SR1               SET UP FOR OVER WORD BOUND          14114370
         LI,SR1   K0                                                    14114380
         LI,D2    K0                                                    14114390
         B        *SR4                                                  14114400
FLDLOP3  BDR,R1   FLDLOP2                                               14114410
         CI,D2    0                                                     141
         BE       %+2               IN CASE ON MEM BOUNDARY             141
         BAL,SR4  STORFLD           END OF FIELD                        14114420
EVEXIT   LCI      K5                                                    14114430
EXPRUND  EQU      EVEXIT                                                14114440
         PLM,SR1  TSTACK                                                14114450
         B        *SR4                                                  14114460
*                 CORE CHAIN. EXPRESSION VALUE IS TO BE STORED FOR ENT- 14114470
*                 IRE CHAIN. 0 LINK SIGNALS END OF CHAIN.               14114480
CORECHN  LW,R1    SR3               DESTINATION-(R1)                    14114490
         AND,R1   M17               MASK OUT ADDR                       14114500
         BEZ      EVEXIT            END OF CHAIN-EXIT                   14114510
         LW,SR3   *R1               NEW DESTIN-(SR3)                    141
         STW,SR1  *R1               STORE ITEM-ADDRESS WITH ADDEND
         B        CORECHN                                               14114570
*                 FORWARD REFERENCE CHAIN. REPLACE HEAD OF CHAIN BY     14114580
*                 VALUE. REPLACE FREF NO. BY COUNTER INITIALIZED TO     14114590
*                 ZERO WITH BIT 0=1. REPLACE SR1 BY DOUBLE WORD         14114600
*                 POINTER TO ENTRY. REPLACE SR3 BY HEAD OF CHAIN.       14114610
FREFCHN  LI,R1    KN1                                                   14114620
         LW,R2    FREFSTK+1                                             14114630
         AND,R2   M15                                                   14114640
         SLS,R2   -1                # OF ENTRIES IN FREFSTK             14114650
FRCHN10  AI,R1    K1                INC AN ENTRY                        14114660
         CW,R1    R2                                                    14114670
         BGE      FREFDECL          CHECKED ALL ENTRIES, NOT FOUND      14114680
         LD,D3    *FREFBAS,R1                                           14114690
         CW,SR3   D3                                                    14114700
         BNE      FRCHN10           ENTRY NOT THE ONE                   14114710
         CI,SR2   K200             %ENTRY FOUND-FREF + HOLD             14114720
         BANZ     FREFHCHN          YES                                 14114730
         LCI      K2                                                    14114740
         PLM,D1   FREFSTK                                               14114750
         STD,D1   *FREFBAS,R1       COMPACT FREF STK(REMV DEFND ENTRY)  14114760
         LW,SR3   D4                CHAIN POINTER (SR3)                 14114770
*                 SATISFY CHAIN OF EXPRESSIONS. ALSO CHECK IF EACH      14114780
*                 EXPR CAN BE SATISFIED.                                14114790
COMCHN   EQU      %                                                     14114800
CHNLOOP  LW,R6    SR3                                                   14114810
         BEZ      *SR4              POINTER ZERO SO EXIT                14114820
         LB,R1    R6                                                    14114830
         BEZ      CORCHN1           REL POINTER ZERO SO POINT TO CORE   14114840
         AND,R6   M17               REL EXPSTK POINTER                  14114850
         LW,R2    R1                REL POINTER TO THIS VALUE WORD      14114860
         AW,R1    R6                                                    14114870
         LW,SR3   *EXPRBAS,R1       NEW POINTER-(SR3)                   14114880
         LW,D1    EXPRBAS                                               14114890
         AW,D1    R6                CORE LOC OF EXPSTK ENTRY-(D1)       14114900
         LH,R3    *D1                                                   14114910
         AND,R3   M7                REL POINTER TO FIRST VALUE WORD     14114920
         SW,R2    R3                                                    14114930
         AI,R2    K1                NO. OF VALUE WORDS (FIRST=1)        14114940
         LI,R3    K2                                                    14114950
CHNLOOP1 AI,R3    K1                                                    14114960
         LB,R4    *D1,R3            GET AN EXPRESS CONTROL BYTE         14114970
         CI,R4    K10               THIS CONTROL BYTE HAVE VAL WORD     14114980
         BANZ     CHNLOOP1          NO                                  14114990
         BDR,R2   CHNLOOP1          YES-DEC. VALUE WORD COUNT           14115000
         LI,D2    K4                                                    14115010
         CW,D2    *TSTACK           EXP VALUE CONST                     14115020
         BE       %+3               YES                                 14115030
         LW,D2    R4                                                    14115040
         AND,D2   M2                RR OF CONTROL BYTE                  14115050
         AI,D2    K80               SET DEFINED                         14115060
         STB,D2   *D1,R3                                                14115070
         LI,R3    K3                RR                                  14115080
         AND,R3   R4                                                    14115090
TYP2RES1 LW,R7    SR1                                                   14115100
         LI,R2    KA000                                                 14115110
         CW,R2    *EXPRBAS,R6       DESTIN PROGRAM                      14115120
         BAZ      COMRES1           NO                                  14115130
         STB,R3   R7                PUT RR-VALUE (RESOL OF DESTIN)      14115140
COMRES1  CI,R4    K8                                                    14115150
         BAZ      NOCOMP1                                               14115160
         LCW,R7   R7                IF SUBTRACT COMPLEMENT              14115170
NOCOMP1  STW,R7   *EXPRBAS,R1       PUT VALUE IN EXP                    14115180
         LW,SR2   SR4                                                   14115190
NEXTEV   BAL,SR4  EVEXP             GO EVAL EXP                         14115200
         LW,SR4   SR2                                                   14115210
         B        CHNLOOP                                               14115220
*                 MARK FREF NO. AS HOLD ITEM. REPLACE CHAIN HEAD BY     14115230
*                 VALUE. THEN GO TO COMCHN TO SATISFY PREVIOUS REFER-   14115240
*                 ENCES.                                                14115250
FREFHCHN LW,SR3   D4                NEW POINTER                         14115260
         LW,D4    SR1               EXPRESSION VALUE                    14115270
         OR,D3    Y8                SET DEFINED FREF AND HOLD           14115280
         LW,R2    *TSTACK                                               14115290
         SLS,R2   16                INSERT RESOL OF VALUE               14115300
         OR,D3    R2                                                    14115310
         STD,D3   *FREFBAS,R1       BACK TO EXP STK                     14115320
         B        COMCHN                                                14115330
*                 XREF CHAIN. REPLACE HEAD OF CHAIN BY VALUE.           14115340
*                 REPLACE SR1 BY POINTER TO ENTRY. REPLACE SR3 BY HEAD  14115350
*                 OF CHAIN                                              14115360
RFDFCHN  LW,R1    *TSTACK                                               14115370
         SLS,R1   17                RESOL OF EXP VALUE                  14115380
         OR,R1    Y008              DEFINED DEF                         14115390
         LW,R2    SR3               DESTIN POINTER                      14115400
         LW,R3    Y009                                                  14115410
         CW,R3    *RFDFBAS,R2       DEFINED ALREADY                     14115420
         BANZ     *SR4              YES-RETURN                          14115430
         STS,R1   *RFDFBAS,R2       INSERT DEF + RESOL                  14115440
         AI,R2    K1                POINT TO VALUE WORD                 14115450
DSECCHN  EQU      %                                                     141
         LW,SR3   *RFDFBAS,R2       NEW POINTER                         14115460
         STW,SR1  *RFDFBAS,R2       VALUE                               14115470
         B        COMCHN                                                14115480
*                 SATISFY SIMPLE ADDRESS CHAINS.                        14115490
CORCHN1  LI,R4    K4                                                    14115500
         CW,R4    *TSTACK           RESOL OF VALUE CONSTANT             14115510
         BE       %+2               YES                                 14115520
         SLS,SR1  -2                CHANGE TO WORD RESOL                14115530
         LW,SR2   M17                                                   14115540
CORCHN2  LI,R4    K1FFFF                                                14115550
         AND,R4   *R6               NEW POINTER                         141
         STS,SR1  *R6               STORE ADDRESS OF SIMPLE FORM
         CI,R4    K0                END OF CHAIN                        14115580
         BE       *SR4              YES-RETURN                          14115590
         LW,R6    R4                                                    14115600
         B        CORCHN2                                               14115610
FREFDECL CI,SR2   K200              FREF - HOLD DESTIN                  14115620
         BAZ      *SR4              NO-RETURN                           14115630
FREF12   LI,R1    K2               %DEFINE A FREF AND HOLD ENTRY        14115640
         MSP,R1   FREFSTK           MAKE ROOM FOR 2 WORD ENTRY          14115650
         BCR,8    FREF11                                                14115660
         LI,R1    FREFN                                                 14115670
         BAL,R4   STKOVF                                                14115680
         B        FREF12                                                14115690
FREF11   LI,D4    K0                END CHAIN                           14115700
         LW,D3    SR3               FREF NO.(DESTIN WORD)               14115710
         LW,R1    FREFSTK+1                                             14115720
         AND,R1   M15                                                   14115730
         SLS,R1   -1                                                    14115740
         AI,R1    -1                POINT TO THIS ENTRY                 14115750
         B        FREFHCHN                                              14115760
INTSYMVL EQU      %
         CI,SR3   0                 POINT TO DUPLICATE IST  ENTRY
         BE       EVEXIT            YES-RETURN
         LI,R1    X'41'             LIBRARY MODE,NI
         CW,R1    *PLISTORG         IST TO BE CREATED
         BANZ     EVEXIT            NO
         LI,R2    2
         LI,R4    4
         CW,R4    *TSTACK           VALUE A CONSTANT
         BE       INTSYMV1          YES
         LW,R1    SR1
         AND,R1   M19
         LW,R3    *SR3,R2
         SLS,R3   -24
         AND,R3   M2                GET RESOLUTION
         LCW,R3   R3
         SLS,R1   0,R3              ADJUST TO RESOLUTION
         STS,R1   *SR3,R2           INSERT VALUE INTO INT. SYMBOL TBL.
         LW,R1    Y4                MARK VALUE LOCATION SYMBOL
         STS,R1   *SR3
         B        EVEXIT
INTSYMV1 STW,SR1  *SR3,R2           PUT CONSTANT INTO INT. SYMBOL TBL.
         LW,R1    Y8
         STS,R1   *SR3              MARK VALUE CONSTANT SYMBOL
         B        EVEXIT
MORELIB  LW,R3    CORENAME          SAVE P TYPE LIB NAME
         STW,R3   LEADPARN          IN LEADPARN FOR FUTURE USE
         LW,R3    LIBSTORE
         BAL,SR4  INSERTLB
         LI,R3    1                 LIBSTORE=1 MEANS BOTH TYPES WANTED
         STW,R3   LIBSTORE
         LW,R1    =X'FFFF87FF'
         AND,R1   *PLISTORG         RESET *PLISTORG
         STW,R1   *PLISTORG
         LI,R1    2048              RESET BUFFER SIZE FOR READ
         STW,R1   RDCORELB+4
         LI,R1    VDP-512           RESET BUFFER ADDRESS
         STW,R1   RDCORELB+3
         B        TSTSTP2
         PAGE                                                           14115770
*                 LOAD OF ALL OBJECT MODULES COMPLETE. PRINT MAP IF     14115780
*                 DESIRED.                                              14115790
*                 FORM DCB'S FOR STANDARD DCB NAMES AND FOR ALL         14115800
*                 ASSIGNMENTS. BUILD A TABLE OF NAMES AND DCB ADDRESSES 14115810
*                 PUT ADDRESS OF TABLE INTO TCB.                        14115820
ENDLOAD  EQU      %                                                     14115830
         LW,R3    LIBSTORE
         CI,R3    1                 DONE WITH ALL LIBRARIES?
         BG       MORELIB           NOPE
         LI,R1    X'40'
         STS,R1   *PLISTORG         SET NO IST FOR LIBS
         LI,R1    1
         CW,R1    SWT               INTERACTIVE MODE
         BAZ      ENDLOAD1          NO
         LI,R1    4
         CW,R1    SWT               COMMAND IN BUF3
         BAZ      ENDLOAD2          NO
         LW,R1    COMANSZE          SIZE OF COMMAND IN BUF3
         BAL,SR2  INTREAD           GO INTERPRET COMMAND TYPE
         B        %+2
ENDLOAD2 BAL,SR2  INTACTRD          GO READ AN INTERACTIVE COMMAND
         LI,R3    X'FFFFB'
         AND,R3   SWT
         STW,R3   SWT               CLEAR COMMAND IN BUF3
         LW,R1    COMANSZE          SIZE OF COMMAND IN BUF3
         LW,R3    TXLINK
         CW,R3    BUF2              ANOTHER LINK COMMAND
         BE       SIGSAL3           YES-PROCESS AND LOAD IT
ENDLOAD1 EQU      %                 WRAP-UP THE LOAD
         LW,R1    MXPP
         AI,R1    7                 ROUND UP TO DOUBLE WORD
         AND,R1   X7FFF8
         CW,R1    BACORE            LOADED AT HIGHER LOCATION
         BLE      %+3               NO
         STW,R1   BACORE            YES-SET HIGHEST LOC
         BAL,SR4  MMPP              AND GET THE MEMORY
         LW,R2    RFDFBAS
DCB7     LI,R3    X'1FFFF'
         CS,R2    RFDFSTK           LOOKED AT ALL ENTRYS
         BG       DCB17             YES
         LW,R4    *R2               TYPE WORD OF ENTRY
         CW,R4    Y009              DEF OR DSECT
         BANZ     DCB9              YES
         CW,R4    Y002              SREF
         BAZ      DCB9              YES
         LW,R1    3,R2              NAME WORD OF ENTRY
         LB,R3    R1
         CI,R3    3                 POSSIBLE DCB REF
         BL       DCB9              NO
         LW,R3    4,R2
         SLS,R3   -24               FOURTH BYTE OF NAME
DCB2     CW,R1    =X'04D47AE7'      M:XX REF
         BNE      DCB3              NO
         CI,R3    'X'
         BE       DCB9              YES-DONT BUILD DCB-MUST SAT FROM JIT
DCB3     EQU      %
         SLS,R1   -8
         INT,R1   R1
         CI,R1    'M:'              M: PREF
         BE       DCB8              YES
         CI,R1    'F:'              F: PREF
         BNE      DCB9              NO
DCB8     EQU      %
         LW,SR1   BADCB
         AI,SR1   7
         AND,SR1  XFFFF8            INSURE DW BOUND
         STW,SR1  BADCB
         LI,R1    4*NWDCB           BYTES/DCB
         AWM,R1   BADCB             ALLOCATE THE MEMORY
         PSW,SR1  TSTACK            SAVE ADDRESS OF DCB
         BAL,SR4  MMDCB             GO-CHECK IF MEMORY THERE
         CW,SR1   *TSTACK           CROSS A PAGE BOUNDARY
         BE       DCB1              NO
         STW,SR1  *TSTACK           YES-CORRECT DCB ADDRESS
         LI,R1    4*NWDCB           BYTES/DCB
         AW,R1    SR1
         STW,R1   BADCB             RESET BADCB IN NEXT PAGE
DCB1     LW,SR3   R2
         SW,SR3   RFDFBAS           RELATIVE RFDFSTK POINTER
         PSW,R2   TSTACK            SAVE RFDFSTK POINTER
         LI,R1    0
         PSW,R1   TSTACK            SET RESOLUTION AT BYTE
         BAL,SR4  RFDFCHN           GO-DEF THE DCB REF.
         PLW,R1   TSTACK            BALANCE RESOLUTION
         PLW,R2   TSTACK            RFDFSTK POINTER
         PLW,R3   TSTACK            DCB ADDRESS
         LI,R1    X'32'             HEX TYPE, WORD RES.
         STW,R1   2,R2              GLOBAL SYMBOL TABLE INFO FOD DCB
         SLS,R3   -2                WORD RES OF DCB ORG
         AI,R3    DCBBIAS           LOADER ADDRESS OF DCB
         LI,R1    0
         LI,R4    NWDCB-1           WORDS/DCB-1
         STW,R1   *R3,R4            ZERO THE DCB
         BDR,R4   %-1
         STW,R1   *R3               INCLUDEING FIRST WORD
         LW,R4    3,R2
         CW,R4    DEFM:STAR+3
         BNE      DCB1D
         LW,R4    BADCB             M:* DCB CONSISTS OF 41 WDS OF 0
         AI,R4    -40               ADJUST BYTE CNT
         STW,R4   BADCB
         B        DCB9
DCB1D    EQU      %
         LI,R5    NPARAMLT
         LD,R6    PARAMLST-2,R5
         STW,R7   *R3,R6            FILL IN STANDARD PARAMETERS
         BDR,R5   %-2
         LW,R4    3,R2              NAME FIELD OF REF
         LB,R5    R4
         CI,R5    3                 3 CHAR DCB NAME
         BE       DCB11             YES
         CI,R5    4                 4 CHAR NAME
         BE       DCB10             YES
         CI,R5    5                 5 CHAR DCB NAME
         BNE      DCB12             NOT STANDARD DCB
         LW,R5    4,R2              SECOND NAME WORD
         SLD,R4   -8
         SLS,R4   -8
         SLD,R4   24                PACK NAME WITHOUT COUNT OR :
         B        DCB11             NON PUT INFO IN STANDARD DCB
DCB10    LW,R5    4,R2              SECOND WORD NAME
         SLD,R4   8                 REMOVE COUNT
DCB11    LI,R5    NSTDDCBS          NO. STANDARD DCBS
         LD,R6    STDDCBLT-2,R5     STANDARD DCB INFO
         CW,R4    R7                THE DCB WE WHANT TO PUT INF4 IN
         BE       %+3               YES
         BDR,R5   %-3               FIND THIS STANDARD DCB IN TABLE
         B        DCB12             NOT STANDARD DCB
         LW,R7    =X'001FFFFF'
         STS,R6   1,R3              PUT DCB INFO INTO DCB (FUN,OPLB)
         SLS,R6   -4
         LW,R7    YFFFE
         STS,R6   3,R3              (ARS)
DCB12    EQU      %
         LI,R5    -DCBBIAS
         AW,R5    R3                CONVERT BACK ACCUAL ADDRESS
         AWM,R5   6,R3
         AWM,R5   10,R3             RELOCATE FILE POINTER AND KEY BUF
DCB9     LB,R4    *R2
         AW,R2    R4
         B        DCB7              ADVANCE  TO NEXT ENTRY
         PAGE
DCB17    EQU      %                 BUILD DCBTAB
         LW,R1    BADCB
         MTW,4    BADCB             COUNT THE DCBTAB LINKADDR POINTER
         SLS,R1   -2                SET BADCB AT WORD RESOLUTION
         STW,R1   DCBTAB            SET DCBTAB IN THE TCB
         AI,R1    DCBBIAS
         STW,R1   DCBTABA           SET LOADER LOCATION OF DCBTAB
         LW,R2    RFDFBAS
         LI,R3    X'1FFFF'
DCB13    CS,R2    RFDFSTK           DCBTAB COMPLETE
         BGE      DCB15             YES
         LW,R4    *R2
         CW,R4    Y009              DEF OR DSECT
         BAZ      DCB14             NO-ADVANCE TO NEXT ENTRY
         LW,R1    3,R2              NAME OF ENTRY
         LB,R4    R1
         CI,R4    3                 POSSIBLE DCB DEF
         BL       DCB14             NO
         LW,R4    4,R2
         SLS,R4   -24               FOURTH BYTE OF NAME
         CW,R1    =X'04D47AE4'      M:UC DEF
         BNE      DCB4              NO
         CI,R4    'C'
         BE       DCB14             YES-DONT INCLUDE IN DCBTAB-JIT DCB
DCB4     CW,R1    =X'04D47AE7'      M:XX DEF
         BNE      DCB5              NO
         CI,R4    'X'
         BE       DCB14             YES-DONT INCLUDE IN DCBTAB-JIT DCB
DCB5     EQU      %
         SLS,R1   -8
         INT,R1   R1
         CI,R1    'M:'              M:NAME
         BE       DCB16             YES
         CI,R1    'F:'              F:NAME
         BNE      DCB14             NO-ADVANCE TO NEXT ENTRY
DCB16    LW,R7    BADCB
         LI,R6    BA(VDCB)
         LW,R5    1,R2
         CLR,R6   R5                VALUE OF DCB DEF WITHIN DCB RANGE
         BCS,2    DCB14             NO-DO NOT INCLUDE IN DCBTAB
         BCR,8    DCB14
         SLS,R7   -2                WORD RESOLUTION
         AI,R7    DCBBIAS           LOC OF DCBTAB ENTRY
         LB,R4    *R2               NO. OF WORDS IN RFDFSTK ENTRY
         AI,R4    -2
         SLS,R4   2                 BYTE
         AWM,R4   BADCB             SIZE OF DCBTAB ENTRY
         BAL,SR4  MMDCB             GO-CHECK IF MEMORY THERE
         SLS,R4   -2                WORD SIZE OF DCBTAB ENTRY
         AI,R4    -1
         SLS,R5   -2
         STW,R5   *R7,R4            LOCATION OF DCB
         LI,R5    3
         AW,R5    R2                NAME OF ENTRY
         LB,R6    *R5
         STB,R6   *R7
         LB,R1    *R5,R6
         STB,R1   *R7,R6
         BDR,R6   %-2               COPY NAME TO DCBTAB ENTRY
DCB14    LB,R4    *R2               ADVANCE TO NEXT ENTRY
         AW,R2    R4
         B        DCB13
DCB15    EQU      %
         BAL,SR4  MMDCB             IN CASE NO DCBS PRESENT
         LW,R2    BADCB
         SLS,R2   -2                WORD RESOLUTION
         STW,R2   *DCBTABA          SET LINKADDR AT DCBTAB
         AI,R2    DCBBIAS
         LI,R1    0
         STW,R1   *R2               ZERO LINKADDR
         LW,R1    BADCB
         AI,R1    -BA(VDCB)+4       COUNT LINKADDR
         CI,R1    184               8+44*4  (ALLOW FOR M:*)
*                                   ARE THERE ANY DCBS
         BG       %+3               YES
         LI,R1    0                 NO-ZERO DCBTAB ADDRESS IN THE TCB
         STW,R1   DCBTAB
         STW,R1   DCBSIZE           BYTES IN DCB AREA
         AI,R1    7                 ROUND UP TO DOUBLE WORD
         SLS,R1   -3                DOUBLE WORD RESOLUTION
         STH,R1   HEAD+6            DCB+DCBTAB SIZE
         STH,R1   TREE+9            IN TREE
         PAGE                       MAKE GLOBOL SYMBAL TABLE
GLOSYM1  LW,R6    RFDFBAS
         LI,R7    X'1FFFF'
         LW,R5    Y009
         LI,R3    0                 NO. OF DEF ENTRIES
GLOSYM2  CS,R6    RFDFSTK
         BG       GLOSYM3           COUNT ALL ENTRIES IN RFDFSTK
         AI,R3    3                 YES-COUNT 3 WORDS/ENTRY
         LB,R4    *R6
         AW,R6    R4                INC. TO NEXT ENTRY
         B        GLOSYM2
GLOSYM3  EQU      %
         SLS,R3   1                 AT BIT 14
         STH,R3   HEAD+7            GLOBAL SYMBOL TABLE SIZE
         SLS,R3   1                 BYTE
         STW,R3   GLOSIZE           GLOBAL SYMBOL TABLE SIZE
         SLS,R3   -2                BACK TO WORDS
         LI,R1    VDP
         SW,R1    MINSYMTL
         SLS,R1   1                 AT BIT 14
         STH,R1   HEAD+8            LARGEST INTERNAL SYMBOL TABLE SIZE
         LW,R1    MINSYMTL
         STS,R1   HEAD+8            LOC OF LARGEST INTERNAL SYM TABLE
         SW,R1    R3                SIZE OF GLOBAL SYMBOL TABLE
         STS,R1   HEAD+7            LOC OF GLOBAL SYMBOL TABLE
         LI,R1    VDP               GENERATE GST HERE TO CONSERVE CORE
         SW,R1    R3
         STW,R1   GLOSYM            GLOBAL SYMBOL TABLE LOC
         STW,R1   SYMBOLTB
         SLS,R1   2                 BYTE RESOLUTION
         CW,R1    BACORE
         BL       PAD               ERROR-GST OVERLAPS PP
         BAL,R0   MMSYMBTB          GO-GET ROOM FOR GLOBAL SYMBOL TABLE
         LW,R6    RFDFBAS
GLOSYM4  CS,R6    RFDFSTK
         BG       GLOSYM10          GLOBAL SYMBOL TABLE COMPLETE
         LI,R1    3
         AW,R1    R6                POINT TO NAME OF ENTRY
         LI,R2    0
         STW,R2   BUF2
         STW,R2   BUF2+1            CLEAN OUT NAME FIELD OF SYMBLE TLB.
         LB,R2    *R1               LENGTH OF NAME
         STB,R2   BUF2
         CI,R2    7
         BLE      %+2
         LI,R2    7                 ALLOW NO MORE THAN 7 CHARS.
         LI,R4    1
GLOSYM5  LB,R3    *R1,R4
         STB,R3   BUF2,R4           COPY NAME TO SYMBOL TABLE
         AI,R4    1
         BDR,R2   GLOSYM5
         LW,R1    1,R6
         STW,R1   BUF2+2            VALUE OF ENTRY
         LW,R4    Y0008
         CW,R4    *R6               VALUE-CONSTANT
         BAZ      GLOSYM6           NO
         LW,R1    Y8
         STS,R1   BUF2              SET TYPE CONSTANT CODE
         B        GLOSYM7
GLOSYM6  EQU      %
         CW,R5    *R6               DEF OR DUMMY SECTION
         BAZ      GLOSYM11          NO
         LW,R1    Y4                VALUE-LOCATION SYMBOL
         STS,R1   BUF2              SET TYPE CODE
         LW,R1    2,R6
         AND,R1   M2                GET RESOLUTION CODE
         LCW,R1   R1
         LW,R2    BUF2+2
         SLS,R2   0,R1              SHIFT VALUE TO RESOLUTION
         STW,R2   BUF2+2
         LW,R1    2,R6
         SLS,R1   24                TYPE,RESOLUTION
         STS,R1   BUF2+2            PUT TYPE,RESOLUTION,VALUE TOGETHER
         LW,R1    Y01               BYTE  RESOLUTION
         STW,R1   2,R6              INTO RFDFSTK ENTRY
GLOSYM7  LI,R1    0
         LI,R2    3
GLOSYM8  LW,R3    BUF2,R1
         STW,R3   *SYMBOLTB,R1
         AI,R1    1
         BDR,R2   GLOSYM8           PUT ENTRY IN GLOBAL SYMBOL TABLE
         MTW,3    SYMBOLTB         INC. ENTRY ADDRESS
GLOSYM9  LB,R1    *R6
         AW,R6    R1                INC. TO NEXT RFDFSTK ENTRY
         B        GLOSYM4           PROCESS NEXT ENTRY
GLOSYM11 LW,R3    BUF2+2            UNDEFINED PREF OR SREF
         LB,R1    R3                POINT TO CORE
         BEZ      GLOSYM14          YES
GLOSYM12 AW,R1    R3
         LW,R3    *EXPRBAS,R1       GET NEXT POINTER IN EXPRESSION CHAIN
         LB,R4    R3                POINT TO CORE
         BEZ      GLOSYM13          YES
         LW,R1    R4
         B        GLOSYM12          GET NEXT ITEM IN CHAIN
GLOSYM13 LI,R2    0
         STW,R2   *EXPRBAS,R1       END THE CHAIN
GLOSYM14 OR,R3    Y8                UNDEFINED TYPE
         STW,R3   BUF2+2            POINTER TO CORE
         B        GLOSYM7           NEXT RFDFSTK ENTRY
GLOSYM10 EQU      %
         LW,R1    RFDFSTK+1
         AND,R1   M15               NO.OF WORDS IN RFDFSTK
         STH,R1   HEAD+5            IN HEAD
         STH,R1   TREE+6            IN TREE
         SLS,R1   2
         STW,R1   RFDFBSZ           NO. OF BYTES IN RFDFSTK
         PAGE
         LW,D1    MAXLOC
         AI,D1    1                 ROUND UP TO DOUBLE WORD
         SLS,D1   -1
         SLS,D1   3                 BA(MAX LOC USED)
         CW,D1    BACOREDA
         BLE      %+2
         STW,D1   BACOREDA          ALLOC. UNALLOCD ASECT CODE
         LW,D1    BACOREDA          TCB IN DATA AREA
         SLS,D1   -2                WORD RESOLUTION                     14117360
         STW,D1   TCB               DEFINE TCB ADDR (WORD RESOL)        14117430
         SLS,D1   2                                                     14117450
         STW,D1   BUF2+1                                                14117470
         LW,D1    =X'08800000'
         STW,D1   BUF2                                                  14117490
         LCI      5
         LM,R1    TXDATAMX
         STM,R1   BUF2+3            'DATA MAX(TCB ORG)'
         USECT    PLSECT
TXDATAMX TEXTC    'DATA MAX(TCB ORG)'
         USECT    PPLINK
         BAL,SR4  ENNAM11           DEFINE HIGHEST LOC (TCB ORIGIN)     14117540
         LW,D1    Y068
         STW,D1   BUF2
         LI,D1    BA(VLC)           LOWEST LOC
         STW,D1   BUF2+1                                                14117580
         LCI      K3                                                    14117590
         USECT    PLSECT
TXDATAOR TEXTC    'DATA ORG'
         USECT    PPLINK
         LM,D1    TXDATAOR          'DATA ORG'
         STM,D1   BUF2+3                                                141
         BAL,SR4  ENNAM11           DEFINE LOWEST LOC (BIAS)            14117630
         LW,D1    =X'07800000'
         STW,D1   BUF2
         LI,D1    BA(VPP)
         STW,D1   BUF2+1            LOWEST PURE POCEEDURE LOCATION
         LCI      4
         LM,R1    TXPUREOR
         STM,R1   BUF2+3
         USECT    PLSECT
TXPUREOR TEXTC    'PURE PROC ORG'
         USECT    PPLINK
         BAL,SR4  ENNAM11           GO-ENTER LOWEST PURE PROC IN RFDFSTK
         LW,D1    BACORE
         AI,D1    -4
         STW,D1   BUF2+1            HIGHEST PURE PROCEEDURE LOCATION
         LCI      4
         LM,R1    TXPUREMX
         STM,R1   BUF2+3            'PURE PROC MAX'
         USECT    PLSECT
TXPUREMX TEXTC    'PURE PROC MAX'
         USECT    PPLINK
         BAL,SR4  ENNAM11           GO-ENTER HIGHEST PURE PROC IN RFDFSK
         PAGE
MAPLOOP  LW,R1    RFDFSTK+1                                             14117640
         AND,R1   M15               SIZE OF RFDFSTK IN R1               14117650
         LW,D4    Y0001             FLAG TO SET ENTRY PRINTED           141
         LW,D2    M31                                                   14117670
         LI,R3    K0                                                    14117680
         LI,R2    KN1                                                   14117690
MAPLOOP1 LW,D1    *RFDFBAS,R3                                           14117700
         CS,D4    D1                                                    14117710
         BE       MAPLOOP2          ENTRY ALREADY PRINTED               14117720
         CW,D1    Y009              DEF OR DUMMY SECTION                14117730
         BAZ      MAPLOOP4          NO                                  14117740
         LW,R4    R3                                                    14117750
         AI,R4    K1                                                    14117760
         CW,D2    *RFDFBAS,R4                                           14117770
         BLE      MAPLOOP2                                              14117780
         LW,R2    R3                                                    14117790
         LW,D2    *RFDFBAS,R4                                           14117800
MAPLOOP2 LB,R4    D1                                                    14117810
         AW,R3    R4                                                    14117820
         CW,R3    R1                                                    14117830
         BL       MAPLOOP1                                              14117840
         LI,D3    X'20'             M MAP
         CW,D3    SWT               MAP REQUESTED
         BAZ      %+3               NO- REFS HAVE BEEN PRINTED-GO ON
         CI,R2    K0                                                    14117850
         BGE      MAPLOOP3                                              14117860
         PAGE
*                 FORM USERS TCB                                        141
         LW,D1    TCB               TCB ORIGIN (WORD)
         AI,D1    TCBSIZ+DFLTTSS    TCB SIZE+DEFLT TSS
         SLS,D1   2
         AI,D1    7
         AND,D1   X7FFF8
         STW,D1   BACOREDA          SET AT DOUBLE WORD (BYTE RES)
         BAL,SR4  MMDA              GO CHECK IF MEMORY THERE
         LW,D1    TCB               WORD RESOLUTION                     14117910
         LW,D4    TCB               TCB ORIGIN (WORD)
         AI,D1    TCBSIZ-1                                              14117930
         LI,D3    DFLTTSS           TSS SIZE
         LI,D2    K0                                                    14117950
         STH,D3   D2                TSS SIZE,0-D2                       14117960
         STD,D1   *D4               FIRST TWO WORDS OF TCB
         AI,D4    CMPWDS+2          MOVE TO TCB+6
         LCI      K5                                                    14118000
         LM,R7    DUMTCB
         AW,R7    D1
         AW,SR2   D1
         AW,SR3   D1
         LCI      5
         STM,R7   *D4               TCB+6 THRU TCB+10
         PAGE                       WRAP-UP THE ROOT                    141
         LW,R1    STTADR                                                141
         BNEZ       %+2           PROG HAS START ADR.
        M:PRINT,E  STADR
         SLS,R1   -2                                                    141
         STS,R1   STTADR1           SAVE PROGRAM START ADDRESS          141
LINKWRP3 BAL,SR4  REFSATY           GO-SATIFY ALL REFS WITH ZERO        141
         LB,R1    OPENOUT+7
         STB,R1   TREE
         LB,R2    OPENOUT+7,R1
         STB,R2   TREE,R1
         BDR,R1   %-2               COPY FILE NAME TO TREE
         LW,R1    TCB
         SLS,R1   -1                DA(TCB) INTO HEAD
         STH,R1   HEAD+2
         LW,R1    BACOREDA
         AI,R1    -BA(VLC)
         STW,R1   DASIZE            BA(00 SIZE)
         CI,R1    X'30000'
         BLE      %+3
         LW,R2    MAE
         B        ERRWRT
         SLS,R1   -3                DA(00 SIZE)
         STH,R1   HEAD+3
         STH,R1   TREE+5
         LW,R1    BACORE
         AI,R1    -BA(VPP)
         STW,R1   PPSIZE            BA(01 SIZE)
         SLS,R1   -3                DA(01 SIZE)
         STH,R1   HEAD+4
         STH,R1   TREE+7
         M:WRITE  F:LINK,(BUF,HEAD),(SIZE,HEADSIZE),(WAIT),(ONEWKEY),;
                  (KEY,TXHEAD)
         M:WRITE  F:LINK,(BUF,TREE-1),(SIZE,48),(WAIT),(ONEWKEY),;
                  (KEY,TXTREE)
         MTB,1    OPENOUT+7         MAKE ROOM FOR ADDITIONAL CHAR
         LB,R1    OPENOUT+7
         LI,R2    0
         STB,R2   OPENOUT+7,R1      REF/DEF STACK CODE
         M:WRITE  F:LINK,(BUF,*RFDFBAS),(SIZE,*RFDFBSZ),(WAIT),;
                  (ONEWKEY),(KEY,OPENOUT+7)
         LI,R2    3
         STB,R2   OPENOUT+7,R1      PUT 00 CONTROL SEC CODE AT END
         M:WRITE  F:LINK,(BUF,VLC),(SIZE,*DASIZE),(WAIT),(ONEWKEY),;
                  (KEY,OPENOUT+7)
         LI,R2    5
         STB,R2   OPENOUT+7,R1      PUT 01 CONTROL SEC CODE AT END
         M:WRITE  F:LINK,(BUF,VPP),(SIZE,*PPSIZE),(WAIT),(ONEWKEY),;
                  (KEY,OPENOUT+7)
         LI,R2    7
         STB,R2   OPENOUT+7,R1      PUT DCB-DCBTAB CODE AT END
         M:WRITE  F:LINK,(BUF,VPP-1024),(SIZE,*DCBSIZE),(WAIT),;
                  (ONEWKEY),(KEY,OPENOUT+7)
         LI,R2    9
         STB,R2   OPENOUT+7,R1      PUT GLOBAL SYMBOL TABLE CODE AT END
         M:WRITE  F:LINK,(BUF,*GLOSYM),(SIZE,*GLOSIZE),(WAIT),(ONEWKEY);
                  ,(KEY,OPENOUT+7)
         M:CLOSE  F:LINK,(SAVE)
         LI,R1    X'200'
         CW,R1    PLIST
         BANZ     %+2               RUN CARD
         CAL1,9   1                 EXIT FOR LINK CARD
         LW,R1    STKBASE           LOWEST STACK PAGE
LINKWRP4 CI,R1    VPP-1024          RELEASED ALL STACK PAGES
         BGE      LINKWRP5          YES
         STW,R1   VIRTUAL
         CAL1,8   FPTVIRLS          RELEASE VIRTUAL PAGE
         AI,R1    512
         B        LINKWRP4
LINKWRP5 BAL,SR4  RELSYM            GO-RELEASE GLOBAL SYMBOL TBL. PAGES
         LI,R1    X'80'
         LS,R1    J:TELFLGS
         BEZ      LINKWRP6          DONT ASSO DELTA
         LW,R1    =X'05C4C5D3'      5DEL
         STW,R1   UNDERNAM
         LW,R1    =X'E3C14040'      TABB
         STW,R1   UNDERNAM+1
LINKWRP6 EQU      %
         LI,R1    0
         STW,R1   HEAD+15           SET ZERO TO INDICATE RUN COMMAND
         LCI      10
         LM,R1    F:LINK+22         PICK UP FPL FOR LMN JUST BUILT
         STM,R1   OPNXXFPL          AND PREPARE TO GET NAME INTO...
         CAL1,1   OPNXX             ...M:XX BY OPENING IT TO LMN.
,CLSXX   M:CLOSE  M:XX,(SAVE)       THIS LETS DELTA FIND SYMBOLS
         CAL1,9   1                 EXIT FOR RUN COMMAND
         PAGE                                                           141
REFSATY  EQU      %                 SATIFY ALL REFS WITH ZERO           141
         PSW,SR4  TSTACK                                                141
         LW,SR3   RFDFBAS                                               141
         LW,R2    Y009              DEF BITS                            141
         LI,SR4   X'1FFFF'                                              141
ROTWRAP1 CS,SR3   RFDFSTK           CHECKED THEM ALL                    141
         BG       ROTWRAP3          YES                                 141
         CW,R2    *SR3              REF                                 141
         BAZ      ROTWRAP2          GO-ZERO REF                         141
         LB,R3    *SR3                                                  141
         AW,SR3   R3                SKIP REMAINING WORDS IN ENTRY       141
         B        ROTWRAP1                                              141
ROTWRAP2 LI,SR1   K0                VALUE OF ZERO                       141
         PSW,SR3  TSTACK                                                141
         PSW,SR1  TSTACK            BYTE RESOLUTION                     141
         SW,SR3   RFDFBAS           GET RELATIVE POINTER                141
         BAL,SR4  RFDFCHN           GO-DEF THE REF                      141
         PLW,R1   TSTACK                                                141
         PLW,SR3  TSTACK                                                141
         LB,R3    *SR3                                                  141
         AW,SR3   R3                SKIP REMAINING WORDS IN ENTRY       141
         B        ROTWRAP1-2        KEEP SEARCHING                      141
ROTWRAP3 EQU      %                                                     141
         PLW,SR4  TSTACK                                                141
         B        *SR4                                                  141
         PAGE                       ENTRY IS A SREF OR PREF
MAPLOOP4 LW,R2    R3                                                    14118270
MAPLOOP3 EQU      %                %ENTRY IS A DEF OR DSECT.
         STS,D4   *RFDFBAS,R2       MARK THIS ENTRY PRINTED.
         LI,R3    16                BLANK OUT 16 CHARS.
         LI,D1    K40                                                   14118300
         STB,D1   BUF,R3                                                14118330
         BDR,R3   %-1                                                   14118340
         LW,D1    *RFDFBAS,R2                                           14118350
         LW,SR3   RFDFBAS                                               14118370
         AI,SR3   K1                                                    14118380
         LW,R4    D1                                                    141
         SLS,R4   -20                                                   141
         AND,R4   M4                TYPE BITS                           141
         LB,R4    MAPCDS,R4                                             141
         LW,R4    MAPTXTS,R4        TEXT OF TYPE                        141
         CW,D1    Y009                                                  14118430
         BAZ      ISREF                                                 14118440
         LW,R7    *SR3,R2                                               14118540
         CW,D1    Y0008                                                 14118550
         BANZ     CONSCVT                                               14118560
         LI,R3    K3                                                    14118570
         AND,R3   *SR3,R2                                               14118580
         AI,R3    KF0                                                   14118590
         SLS,R3   16                                                    14118600
         STS,R3   BUF+3                                                 14118610
         SLS,R7   -2                                                    14118620
CONSCVT  EQU      %                                                     14118630
         BAL,SR4  BINTOHEX                                              14118640
         STD,D3   BUF+1                                                 14118650
ISREF    STW,R4   BUF                                                   14118670
         AW,SR3   R2                                                    14118680
         AI,SR3   2                 POINT TO NAME FIELD                 141
         LB,R3    *SR3                                                  14118700
         LI,R1    17
         AW,R1    R3                NO. OF CHARS IN NAME
         M:DEVICE,E  COMPARE
         CI,SR1   1                 PRE#21142 FROM B00H
         BNE      %+4
         LI,R2    X'15'             NL CHAR.
         STB,R2   BUF,R1            PUT NL INTO LINE
         AI,R1    1                 COUNT THE NL CHAR.
         LB,R4    *SR3,R3                                               14118710
         STB,R4   BUF+4,R3                                              14118720
         BDR,R3   %-2                                                   14118730
         LI,R4    X'20'
         CW,R4    SWT               MAP REQUESTED
         BAZ      MAPLOOP5          NO
         LI,ADR    WA(BUF)
         LW,CNT    R1
        M:WRITE,E  MESSAGE:LO
*
         B        MAPLOOP
MAPLOOP5 LI,R4    8                 DISPLAY
         CW,R4    *PLISTORG         DISPLAY REQUESTED
         BANZ     MAPLOOP           NO
         LW,R4    TXREF
         CW,R4    BUF               IS THIS A PREF
         BNE      MAPLOOP           NO
         LI,ADR    WA(BUF)
         LW,CNT    R1
        M:WRITE,E  MESSAGE:LO
         B        MAPLOOP                                               14118770
         PAGE                                                           14119200
*                 ROUTINES TO INCREMENT AND CHECK LOC.                  14119210
*                 INCREMENT LOC. INCREMENT CONTAINED IN R6.             14119220
INCLOC   AWM,R6   LOC                                                   14119230
*                 CHECK LOC FOR FOLLOWING CONDITIONS:                   14119240
*                   1. ABOVE X60                                 PA8    14119250
*                   2. BELOW LDR                                 PA8    14119260
*                   3. ABOVE LOLIM (MON VERSION)                 PA8    14119270
*                   4. BELOW HILIM (MON VERSION)                 PA8    14119280
*                   5. BELOW TEMPBAS (AFTER PRESS IF NECESSARY)  PA4    14119290
CHKLOC   EQU      %                                                     14119300
         LI,R0    BA(VPP)           PURE PROCEEDURE LIMITS
         LW,R1    MINSYMTL
         CW,R1    SYMBOLTB          TAKE CARE OF FIRST FILE
         BLE      %+2
         LW,R1    SYMBOLTB
         SLS,R1   2                 COMPARE BYTES WITH BYTES
         CLR,R0   LOC               LOADING INTO PURE PROCEEDURE
         BCS,2    CHKLOC1           BELOW PURE PROCEEDURE
         BCS,4    PAD               ERROR-GST OVERLAPS PP
         LW,R1    LOC
         CW,R1    BACORE+1          LOADING INTO REQUESTED CORE
         BL       *SR4              YES-RETURN
         CW,R1    MXPP
         BLE      %+2
         STW,R1   MXPP              KEEP TRACK OF HIGHEST PP LOC.
         SLS,R1   -2
         STW,R1   VIRTUAL           ASSUME ASECT
         CAL1,8   FPTVIR            AND REQUEST ISOLATED PAGE
         MTW,0    0,R1              TRAP IF DIDNT GET THE PAGE
         B        *SR4
CHKLOC1  EQU      %
         LW,R1    LOC
         CI,R1    BA(VPP)-4096      LOADING DCB INFO
         BGE      CHKLOC7           YES
         LI,R0    BA(VLC)           DATA AREA LIMITS
         LW,R1    BASES+1
         SLS,R1   2                 COMPARE BYTES WITH BYTES
         CLR,R0   LOC               LOADING INTO DATA AREA
         BCS,2    CHKLOC2           NO-CHECK FOR DCB
         BCS,4    CHKLOC3
CHKLOC4  LW,R1    LOC
         CW,R1    BACOREDA+1        REQUESTED CORE THIS FAR
         BL       *SR4              YES-RETURN
         SLS,R1   -2
         CW,R1    MAXLOC            KEEP TRACK OF SO TCB CAN BE
         BLE      %+2               PLACE AFTER ANY ASECT
         STW,R1   MAXLOC
         LW,R0    *DECLBAS
         AND,R0   M20               CONTROL SECTION 0 DEFINED
         BNEZ     CHKLOC5           YES-ASSUME ASECT
         LW,R1    BACOREDA+1        NO-ASSUME CS0
         SLS,R1   -2                WORD RESOLUTION
         STW,R1   VIRTUAL           REQUEST CONTINUSLY FOR CS0
         CAL1,8   FPTVIR
         MTW,0    0,R1              TRAP IF DIDNT GET THE PAGE
         LI,R1    2048
         AWM,R1   BACOREDA+1        UPDATE VIRTUAL AREA
         B        CHKLOC4           CHECK IF ALLOCATED FAR ENOGHT
CHKLOC5  EQU      %
         STW,R1   VIRTUAL           REQUEST ISOLATED PAGE FOR ASECT
         CAL1,8   FPTVIR            GO-GET A VIRTUAL PAGE
         MTW,0    0,R1              TRAP IF DIDNT GET THE PAGE
         B        *SR4              RETURN
CHKLOC3  BAL,R0   PRESSTK           GO PRESS THE STACKS
         LW,R1    LOC
         SLS,R1   -2
         CW,R1    BASES+1           ROOM FROM STACKS SUFFICENT
         BGE      PA4               NO-STACK OVERFLOW
         B        CHKLOC4           YES-RETURN
CHKLOC2  LI,R0    BA(VDCB)          DCB LIMITS
         LW,R1    BADCB
         CLR,R0   LOC               LOADING INTO DCB AREA
         BCS,2    PA8               ERROR-UNDER DCB AREA
         BCS,4    PA8
         LI,R1    DCBBIAS           YES-RELOCATE THE LOAD ADDRESS
         SLS,R1   2                 AT BYTE RES
         AWM,R1   LOC
         B        *SR4
CHKLOC7  LI,R1    -DCBBIAS
         SLS,R1   2                 AT BYTE RESOLUTION
         AWM,R1   LOC               GET ACTUAL MEMORY LOC
         B        CHKLOC2           GO CHECK LIMITS
         PAGE
MMDCB    EQU      %                 DCB MEMORY
         LW,R1    BADCB+1
         AI,R1    -DCBBIAS          CONVERT TO ACTUAL ADDRESS
         SLS,R1   2                 AT BYTE RESOLUTION
         CW,R1    BADCB             MEMORY PRESENT FOR THIS SECTION
         BG       *SR4              YES-RETURN
         LW,SR1   R1                SET ORG OF DCB AT PAGE ORG.
         LW,R1    BADCB+1
         STW,R1   VIRTUAL
         CAL1,8   FPTVIR            GO-GET A VIRTUAL PAGE
         MTW,0    0,R1              TRAP IF DIDNT GET THE PAGE
         LI,R1    512
         AWM,R1   BADCB+1
         LW,R1    BADCB+1
         CI,R1    VPP
         BG       PA9               ERROR-MORE THAN 2 PAGES REQUESTED
         B        MMDCB             CHECK IF THIS IS ENOUGHT
MMDA     EQU      %                 DSECT,CSECT,TCB DATA AREA MEMORY
         LW,R1    BACOREDA+1
         CW,R1    BACOREDA          MEMORY PRESENT FOR THIS SECTION
         BGE      *SR4              YES-RETURN
         SLS,R1   -2                WORD RESULUTION
         STW,R1   VIRTUAL
         CAL1,8   FPTVIR            GO-GET A VIRTUAL PAGE
         MTW,0    0,R1              TRAP IF DIDNT GET THE PAGE
         LI,R1    2048              WE HAVE ANOTHER PAGE
         AWM,R1   BACOREDA+1
         B        MMDA              CHECK IF THIS IS ENOUGHT
MMPP     EQU      %                 DSCET,CSECT PURE PROCEEDURE MEMORY
         LW,R1    BACORE+1
         CW,R1    BACORE            MEMORY PRESENT FOR THIS SECTION
         BGE      *SR4              YES-RETURN
         SLS,R1   -2                WORD RESOLUTION
         STW,R1   VIRTUAL
         CAL1,8   FPTVIR            GO-GET A VIRTUAL PAGE
         MTW,0    0,R1              TRAP IF DIDNT GET THE PAGE
         LI,R1    2048              WE HAVE ANOTHER PAGE
         AWM,R1   BACORE+1
         B        MMPP              CHECK IF THIS IS ENOUGHT
MMTBASE EQU       %
         LW,R1    STKBASE
         CW,R1    BASES+1           MEMORY PRESENT FOR STACKS
         BLE      *R0               YES-RETURN
         AI,R1    -512
         STW,R1   VIRTUAL
         CAL1,8   FPTVIR            GO-GET A VIRTUAL PAGE
         MTW,0    0,R1              TRAP IF DIDNT GET THE PAGE
         STW,R1   STKBASE           UPDATE STACK BASE
         B        MMTBASE+1         CHECK IF THIS ENOUGHT
MMSYMBTB EQU      %
         LW,R1    SYMBASE
         CW,R1    SYMBOLTB          MEMORY PRESENT FOR SYMBOL TABLE
         BLE      *R0               YES-RETURN
         AI,R1    -512
         STW,R1   VIRTUAL
         CAL1,8   FPTVIR            GO-GET A VIRTUAL PAGE
         MTW,0    0,R1              TRAP IF DIDNT GET THE PAGE
         STW,R1   SYMBASE           UPDATE SYMBASE
         B        MMSYMBTB+1        CHECK IF THIS IS ENOUGHT
RELSYM   EQU      %
         LW,R1    SYMBASE           LOWEST SYMBOL TABLE PAGE
         LI,R2    -3
         AW,R2    SYMBASE
         SLS,R2   2                 CNVT TO BYTES
         CW,R2    BACORE+1
         BL       RELSYM2
RELSYM1  CI,R1    VDP               RELEASED ALL SYMBOL PGS
         BGE      *SR4
         STW,R1   VIRTUAL
         CAL1,8   FPTVIRLS          RELEASE VIRTUAL PAGE
RELSYM2  AI,R1    512
         STW,R1   SYMBASE
         B        RELSYM1
         PAGE                                                           14119500
*                 STACK OVERFLOW HANDLER. SPACE IN STACK IS EXPANDED    14119510
*                 AS DESIGNATED. STACKS ARE PRESSED IF NECESSARY.       14119520
*                 ONLY DESIGNATED STACK IS EXPANDED.                    14119530
STKOVF   EQU      %                                                     14119540
         LI,D2    K0                                                    14119550
STKOV1   LD,D3    BASE,R1                                               14119560
         LH,D1    D4                                                    14119570
         AND,D1   M15                                                   14119580
         LW,R2    ADONSIZ,R1                                            14119590
         SW,R2    D1                                                    14119600
         LW,R3    MAXLOC                                                14119660
         AW,R3    R2                                                    14119670
         CW,R3    BASES+1                                               14119680
         BGE      PRESS                                                 14119690
         LW,R3    BASES+1                                               14119700
         SW,R3    BASES+1,R1                                            14119710
         LW,D4    BASES+1,R1                                            14119720
         LW,D3    BASES+1,R1                                            14119730
         SW,D3    R2                                                    14119740
         LW,D1    R1                SAVE STACK NUMBER
         LW,D2    BASES+1           SAVE OLD STACK BASE FOR CORRECTION
         LW,R0    BASES+1
         SW,R0    R2
         STW,R0   BASES+1           TEMPORARILY CORRECT STACK BASE
         BAL,R0   MMTBASE           SO CAN GET MEMORY FOR EXPANDED STACK
         STW,D2   BASES+1           SET BACK FOR CORRECTION LOOP
         LW,R1    D1                RESTORE STACK NUMBER
STKOV2   LW,D1    *D4,R3                                                14119750
         STW,D1   *D3,R3                                                14119760
         BIR,R3   STKOV2                                                14119770
         LD,D3    BASE,R1                                               14119780
         LW,R3    ADONSIZ,R1                                            14119790
         AI,R3    K8000                                                 14119800
         STH,R3   D4                                                    14119810
         STD,D3   BASE,R1                                               14119820
STKOV3   LD,D3    BASE,R1                                               14119830
         SW,D3    R2                                                    14119840
         STD,D3   BASE,R1                                               14119850
         LW,D3    BASES,R1                                              14119860
         SW,D3    R2                                                    14119870
         STW,D3   BASES,R1                                              14119880
         BDR,R1   STKOV3                                                14119890
         B        *R4                                                   14119900
PRESS    LW,D2    D2                                                    14119910
         BNEZ     PA4                                                   14119920
         BAL,R0   PRESSTK                                               14119930
         LW,R1    D2                                                    14119940
         B        STKOV1                                                14119950
         PAGE                                                           14119960
*                 PRESS ALL STACKS (REMOVE ALL 'SPACE') EXCEPT TSTACK.  14119970
*                 LEAVE A MINIMUM OF 'SPACE' IN TSTACK TO ALLOW FOR     14119980
*                 NON-RECURSIVE USE WHICH DOES NOT CHECK FOR STACK      14119990
*                 OVERFLOW.                                             14120000
PRESSTK  LW,D2    R1                                                    14120010
         LW,D1    R4                                                    14120020
         LI,R1    NSTKS                                                 14120030
PRES5    LD,R2    BASE,R1                                               14120040
         LH,D3    R3                                                    14120050
         AND,D3   M15                                                   14120060
         LI,D4    K8000                                                 14120070
         STH,D4   R3                                                    14120080
         CI,R1    TEMPN                                                 14120090
         BNE      PRES1                                                 14120100
         CI,D3    TMPSIZ            ANY EXCESS IN TEMP STACK
         BLE      PRES2             NO
         LI,R4    TMPSIZ+X'8000'    TRAP INHIBIT BIT
         STH,R4   R3                COMPRESS TSTACK TO THIS SIZE
         AI,D3    -TMPSIZ           REMOVE THIS MUCH FROM TSTACK
PRES1    STD,R2   BASE,R1                                               14120150
         LW,R4    R1                                                    14120160
PRES3    LD,R2    BASE,R4                                               14120170
         AW,R2    D3                                                    14120180
         STD,R2   BASE,R4                                               14120190
         LW,R2    BASES,R4                                              14120200
         AW,R2    D3                                                    14120210
         STW,R2   BASES,R4                                              14120220
         BDR,R4   PRES3                                                 14120230
         LD,R2    BASE,R1                                               14120240
         SW,R2    BASES+1                                               14120250
         LW,D4    BASES+1                                               14120260
         SW,D4    D3                                                    14120270
         LW,D3    BASES+1                                               14120280
         AI,R2    K1                                                    14120290
         AI,D4    KN1                                                   14120300
         AI,D3    KN1                                                   14120310
PRES4    LW,R4    *D4,R2                                                14120320
         STW,R4   *D3,R2                                                14120330
         BDR,R2   PRES4                                                 14120340
PRES2    EQU      %                                                     14120350
         BDR,R1   PRES5                                                 14120360
         LW,R4    D1                                                    14120370
         B        *R0                                                   14120380
         PAGE                                                           14120390
*                 GET BYTE IN R5.  READ A CARD IF NECESSARY. IF EOF     14120400
*                 OCCURS, DATA ERROR. IF LAST CARD OF BINARY DECK,      14120410
*                 SET LASTCARD. IF LASTCARD SET AND BYTES READ PAST     14120420
*                 END, DATA ERROR. CHECK SEQUENCE AND CHECKSUM. RECORD  14120430
*                 SIZE MUST BE LESS THAN OR EQUAL TO 108.               14120440
GBYTE    LW,R1    CURBYTE                                               14120450
         BLZ      GBYTE3            CARD IN BUF                         14120460
         CW,R1    RCDSIZE           EOC                                 14120470
         BL       NXTBYTE           NO                                  14120480
         PSW,SR4  TSTACK            YES-GO GET NXT CARD                 14120490
         BAL,SR4  READBILI                                              14120500
         B        PA1               ERROR-UNEXPECTED EOF
         PLW,SR4  TSTACK                                                14120520
GBYTE3   EQU      %                                                     14120530
         LB,R1    BUF                                                   14120540
         CI,R1    X'3C'             LAST CARD                           14120550
         BE       GBYTE1            NO                                  14120560
         CI,R1    X'1C'             CONFIRM LAST CARD                   14120570
         BNE      PA7               ERROR-DATA FORMAT                   14120580
         STW,R1   LASTCARD          SET LAST CARD                       14120590
GBYTE1   LI,R1    K1                                                    14120600
         LB,R2    SEQNUM                                                14120610
         AI,R2    K1                UPDATE SEQ. NUMBER                  14120620
         CB,R2    BUF,R1            CHECK WITH CARD                     14120630
         BNE      PA5               ERROR-SEQUENCE                      14120640
         STB,R2   SEQNUM            SAVE UPDATE SEQ. NUMBER             14120650
         LI,R1    K3                                                    14120660
         LB,R1    BUF,R1            RECORD SIZE - R1                    14120670
         CI,R1    K5                                                    14120680
         BL       PA7               ERR-NO INFO ON CARD                 14120690
         CI,R1    K6C                                                   14120700
         BG       PA7               ERR-CARD TOO LARGE                  14120710
         AI,R1    KN1                                                   14120720
         STW,R1   RCDSIZE           SAVE SIZE OF CARD 0-SCALE           14120730
         LI,R2    K2                                                    14120740
         LB,R3    BUF               CHECK SUM-R3                        14120750
GBYTE2   LB,R4    BUF,R1                                                14120760
         AW,R3    R4                ADD UP ALL BYTES-R3                 14120770
         BDR,R1   GBYTE2                                                14120780
         LB,R4    BUF,R2            READ CHECK SUM-R4                   14120790
         CI,R4    KFF               SKIP CHECKING                       14120800
         BE       CHKSMOK           YES-                                14120810
         SW,R3    R4                REMOVE CHECKSUM ITSELF              14120820
         CB,R3    BUF,R2                                                14120830
         BNE      PA6               ERR-CHECK SUM                       14120840
CHKSMOK  LI,R1    K3                                                    14120850
NXTBYTE  AI,R1    K1                                                    14120860
         STW,R1   CURBYTE           SET CURBYTE                         14120870
         LB,R5    BUF,R1            PUT BYTE IN R5                      14120880
         B        *SR4              RETURN                              14120890
         PAGE                                                           14120900
*                 ROUTINES TO READ 1,2,OR3 BYTE NUMBERS.                14120910
*                 READ A TWO BYTE NUMBER. RESULTS IN R7.                14120920
2BNUM    PSW,SR4  TSTACK                                                14120930
2BNUM2   BAL,SR4  GBYTE                                                 14120940
         LW,R7    R5                                                    14120950
2BNUM1   BAL,SR4  GBYTE                                                 14120960
         STB,R5   R7                                                    14120970
         SCS,R7   8                                                     14120980
         PLW,SR4  TSTACK                                                14120990
         B        *SR4                                                  14121000
*                 READ A THREE BYTE NUMBER. RESULTS IN R7.              14121010
3BNUM    PSW,SR4  TSTACK                                                14121020
         BAL,SR4  2BNUM                                                 14121030
         B        2BNUM1                                                14121040
*                 READ ONE OR TWO BYTES DEPENDING ON NUMBER OF DECL'S.  14121050
12BNUM   PSW,SR4  TSTACK                                                14121060
         LI,R1    K7FFF                                                 14121070
         AND,R1   DECLSTK+1                                             14121080
         CI,R1    K200                                                  14121090
         BG       2BNUM2                                                14121100
         LI,R7    K0                                                    14121110
         B        2BNUM1                                                14121120
DECLCHK  LI,R1    K7FFF             CHK FOR ENTRY WITHIN DECLARATION
         AND,R1   DECLSTK+1         STACK
         CW,R1    R7
         BGE      *SR4              BRANCH IF O.K.
         BAL,SR4  BINTOHEX          CONVERT OUT-OF-RANGE DECL. # TO HEX
         CB,D4    TXBLK
         BNE      %+2
         OR,D4    XF0
         LI,R1    41                DISPLACEMENT IN ERR MESSAGE
         STB,D4   MESA10,R1
         LI,R7    2
NXTDIGIT SLS,D4   -8                GET NEXT DIGIT
         AI,R1    -1
         STB,D4   MESA10,R1
         BDR,R7   NXTDIGIT
         LW,R2    MA10
         B        PERR
         PAGE                                                           14121130
*                 READ BI OR LI DEPENDING ON MODE. IF LIBMODE =1,       14121140
*                 READ LI. READ 120 BYTES INTO BUF. RETURN CALL+1 IF    14121150
*                 EOF. ELSE CALL+2.                                     14121160
READBILI EQU      %                                                     141
         LI,R1    X'100'
         CW,R1    *PLISTORG         M:GO
         BAZ      LINK7             NO
         LI,R1    M:GO              YES
         CAL1,1   FPTREAD           READ FROM % FILE
         USECT    PLSECT
FPTREAD  GEN,8,7,17      X'90',0,R1 READ A ROM CARD
         DATA     X'70000010'
         DATA     BILIABN           ABNORMAL ADDRESS
         DATA     BUF               BUFFER ADDRESS
         DATA     120               BUFFER SIZE
         USECT    PPLINK
         B        LINK14
LINK7    EQU      %
         LI,R1    F:LINKIN
         CAL1,1   FPTREAD           READ FROM F:LINKIN FILE
LINK14   EQU      %
         AI,SR4   K1                NORMAL RETURN                       14121240
         MTW,15   FIRSTRD           SET NOT FIRST TIME                  14121250
         B        *SR4              RETURN                              14121260
BILIABN  EQU      %                 EOF ENCOUNTERED                     141
         LB,SR3   SR3               ISOLATE ABNORMAL CODE               141
         CI,SR3   6                 EOF
         BE       %+3               YES-WHAT WE WHANTED
         CI,SR3   5                                                     141
         BNE      PA7               ERROR-NON EOD ABNORMAL              141
         MTW,-1   FIRSTRD                                               141
         BNEZ     *SR4              NOT FIRST READ-SO RETURN            14121280
         LI,SR3   X'100'
         CW,SR3   *PLISTORG         % FILE
         BAZ      LINK19            NO
         CAL1,1   REWGO             YES
         USECT    PLSECT
REWGO    GEN,8,7,17      X'01',0,M:GO
REWFIN   GEN,8,7,17      X'01',0,F:LINKIN
         USECT    PPLINK
         B        READBILI
LINK19   EQU      %
         CAL1,1   REWFIN
         B        READBILI          TRY AGAIN                           14121310
         PAGE                                                           14121360
*                 CHECK FOR TWO EOF RECORDS IN SEQUENCE. IF PRESENT,    14121370
*                 RETURN CALL+1. ELSE CALL+2.                           14121380
CHK2EOF  PSW,SR4  TSTACK                                                14121390
         LI,R7    K2                                                    14121400
CHK2E1   BAL,SR4  READBILI          READ A CARD                         14121410
         B        1EOF                                                  14121420
         LI,R1    KN1               A NEW DECK HAS STARTED              14121430
         MTW,1    *TSTACK           RETURN CALL +2                      14121440
CHK2E2   STW,R1   CURBYTE           -1,CARD ALL READY IN BUF            14121450
         PLW,SR4  TSTACK                                                14121460
         B        *SR4              RETURN                              14121470
1EOF     EQU      %                                                     141
         BDR,R7   CHK2E1            GO FOR SECOND EOF                   14121510
         LI,R1    KFF               SET CURBYTE AT INFINITY-BUF EMPTY   14121520
         B        CHK2E2                                                14121530
         PAGE                                                           14121720
*                 CONVERT BIN NO. IN R7 TO HEX(EBCDIC) IN D3,D4. SUPP-  14121730
*                 RESS LEADING ZEROES.                                  14121740
BINTOHEX PSW,R1   TSTACK                                                14121750
         LI,R1    K8                                                    14121760
         LI,R0    K0                                                    14121770
BXLOOP   LI,R6    K0                                                    14121780
         SLD,R6   4                                                     14121790
         CI,R6    K0                                                    14121800
         BE       ZSUP                                                  14121810
         LW,R0    R6                                                    14121820
FORMX    CI,R6    K9                                                    14121830
         BLE      DIGIT                                                 14121840
         AI,R6    TXA-KA                                                14121850
         B        STOIT                                                 14121860
DIGIT    AI,R6    KF0                                                   14121870
STOIT    STB,R6   D3                                                    14121880
         SCD,D3   8                                                     14121890
         BDR,R1   BXLOOP                                                14121900
         PLW,R1   TSTACK                                                14121910
         B        *SR4                                                  14121920
ZSUP     CI,R0    K0                                                    14121930
         BNE      DIGIT                                                 14121940
         LI,R6    K40                                                   14121950
         B        STOIT                                                 14121960
         PAGE
*                 INPUT  R7
*                 OUTPUT D3,D4      RIGHT JUSTIFIED BLANK FILLED
BIN2BCD  EQU      %                 BINARY TO DECIMAL
         LI,R1    7                 BYTE INDEX
         LW,D3    TXBLK             BLANK FILL
         LW,D4    TXBLK
BIN2BCD1 CI,R7    0                 DONE
         BE       *SR4              YES
         LI,R6    0
         DW,R6    =10               GET A DECIMAL DIGIT
         AI,R6    X'F0'             PUT IN EBCDIC BITS
         STB,R6   D3,R1             PUT BYTE INTO RETURN REG
         AI,R1    -1
         BGEZ     BIN2BCD1          ALLOW 8 DECIMAL DIGITS
         B        *SR4
* PATCH AREA FOR EXECUTION CODE  ONLY...NO DATA
*
PATCH    RES      30
         PAGE                                                           14121970
         USECT    LINK
ERRPLIST M:WRITE,L M:LL,(BUF,MESMOD),(SIZE,24)
MESCKS   TEXT     '          CARD CKS/COMPUTED CKS/  /  /'              141
MESMOD   TEXT     'MODULE#/SEQUENCE#/  /  /'                            141
MESA10   TEXT     'INVALID DECLARATION NUMBER REFERENCE /   /'
         USECT    PPLINK
MESA1    TEXT     'UNEXPECTED END OF ROM DATA'
MESA2    TEXT     'CORE LIBRARY OVERLAPS PURE PROCEDURE'
MESA3    TEXT     'DUMMY SECTION LARGER THAN PREVIOUS DEF.'    A3       141
MESA4    TEXT     'STACK OVERFLOW'                     A4               141
MESA5    TEXT     'SEQUENCE ERROR'                     A5               141
MESA6    TEXT     'CHECKSUM ERROR'                     A6               141
MESA7    TEXT     'ILLEGAL DATA FORMAT'                A7               141
MESA8    TEXT     'ILLEGAL LOAD ADDRESS'               A8               141
MESA9    TEXT     'MORE THAN 2 PAGES REQUESTED FOR DCBS'
MESAA    TEXT     'ILLEGAL LOAD ITEM TYPE'             AA               141
NOSTARTADR TEXTC   'NO PROGRAM START ADDRESS'
MESAD    TEXT     'GLOBOL SYMBOL TABLE OVERLAPS PURE PROCEDURE'
MESAF    TEXT     'DONT TRY TO USE TWO J OR TWO P L'
         TEXT     'IBRARIES AT ONCE'
MESAC    TEXT     'INSUFFICIENT PHYSICAL MEMORY TO CONTINUE'
MESAE    TEXT     'DATA LIMIT EXCEEDED'
         BOUND     4
CANT2    DATA,1    S:UT('CANT FIND-RETYPE')
BCNT:CANT2 EQU     BA(%)-BA(CANT2)
BTCHCANT TEXT     'CANT FIND - RESUBMIT'
         BOUND 4
CORELIBABN DATA,1  S:UT('I/O ERROR READING CORE LIBRARY')
BCNT:CORELIBABN EQU BA(%)-BA(CORELIBABN)
         BOUND 4
ASSMESS  DATA,1    S:UT('I/O ERROR READING THE ASSIGN MERGE RECORD')
BCNT:ASSMESS EQU   BA(%)-BA(ASSMESS)
         BOUND 4
SYSLIB   DATA,1    S:UT('I/O ERROR LINKING SYSTEM LIBRARY')
BCNT:SYSLIB EQU    BA(%)-BA(SYSLIB)
         BOUND 4
GDDEF    DATA,1    S:UT('GLOBAL DDEF')
BCNT:GDDEF EQU     BA(%)-BA(GDDEF)
         BOUND 4
DPER     DATA,1    S:UT('PROGRAM COMPILED FOR FDP')
         DATA,1    X'15',X'FF'
         DATA,1    S:UT('SPECIFY (P0) AND TRY AGAIN.')
         DATA,1    X'15'
BCNT:DPER EQU      BA(%)-BA(DPER)
         BOUND 4
FDP6     DATA,1  S:UT('''P1'' ASSOCIATED.'),X'15'
BCNT:FDP6 EQU      BA(%)-BA(FDP6)
         BOUND 4
CORL1    DATA,1    S:UT('YOU DO NOT NEED')
BCNT:CORL1 EQU     BA(%)-BA(CORL1)
         BOUND 4
LOADD    DATA,1    S:UT('     LINKING '),X'16'
BCNT:LOA EQU       BA(%)-BA(LOADD)
         DATA,1    X'5B',X'15'
BCNT:LOADD EQU     BA(%)-BA(LOADD)
         BOUND    4
LOADB    DATA,1   S:UT('     LINKING %')
BCNT:LOADB EQU    BA(%)-BA(LOADB)
         BOUND 4
TPREF    DATA,1    S:UT('IUSAT')
BCNT:TPREF EQU     BA(%)-BA(TPREF)
         BOUND 4
TDDEF    DATA,1    S:UT('IDDEF')
BCNT:TDDEF EQU     BA(%)-BA(TDDEF)
         BOUND    4
OUT1     DATA,1   S:UT('''ON''',' FILE ALREADY EXISTS')
BCNT:OUT1 EQU      BA(%)-BA(OUT1)
         BOUND 4
OPOUT    DATA,1    S:UT('I/O ERROR OPENING OUTPUT FILE')
BCNT:OPOUT EQU     BA(%)-BA(OPOUT)
         BOUND     4
LNKHR    DATA,1    S:UT('LINK HERE'),X'15'
BCNT:LNKHR EQU     BA(%)-BA(LNKHR)
         BOUND     4
EHAT     DATA      X'C5886F7C'             EH ?
MESSAGE:LO M:WRITE,L M:LO,(BUF,*ADR),(SIZE,*CNT)
MESSAGE M:WRITE,L  M:DO,(BUF,*ADR),(SIZE,*CNT)
READ     M:READ,L  M:C,(BUF,*ADR),(SIZE,*CNT),(WAIT)
DEFM:STAR DATA    X'04600000'
         DATA     0
         DATA     0
         TEXTC    'M:*'
COMPARE M:DEVICE,L M:LO,(CORRES,M:UC)
COMPARDO M:DEVICE,L M:DO,(CORRES,M:UC)
STADR   M:PRINT,L   (MESS,NOSTARTADR)
DEFM:UC  DATA      X'05800000'
         DATA      BA(M:UC)
         DATA      X'32'
         TEXTC     'M:UC'
DEFM:XX  DATA     X'05800000'       M:XX REF/DEF STACK ENTRY
         DATA     BA(M:XX)
         DATA     X'32'
         TEXTC    'M:XX'
MA1      GEN,15,17       26,MESA1
MA2      GEN,15,17       36,MESA2
MA3      GEN,15,17      39,MESA3                                        141
MA4      GEN,15,17      14,MESA4                                        141
MA5      GEN,15,17      14,MESA5                                        141
MA6      GEN,15,17      14,MESA6                                        141
MA7      GEN,15,17      19,MESA7                                        141
MA8      GEN,15,17      20,MESA8                                        141
MA9      GEN,15,17      36,MESA9
MAA      GEN,15,17      22,MESAA                                        141
MAC      GEN,15,17       40,MESAC
MAF      GEN,15,17   48,MESAF
MAD      GEN,15,17       43,MESAD
MAE      GEN,15,17  19,MESAE
MA10     GEN,15,17    42,MESA10
         PAGE                                                           141
PA6      EQU      %                 CHECK SUM ERROR                     141
         AND,R3   M8                R3 COPUTED CKS                      141
         LW,R7    R3                R4 CARD CKS                         141
         BAL,SR4  BINTOHEX                                              141
         LI,R1    36                                                    141
         STB,D4   MESCKS,R1                                             141
         SLS,D4   -8                                                    141
         CB,D4    TXBLK                                                 141
         BNE      %+2                                                   141
         LI,D4    X'F0'                                                 141
         LI,R1    35                                                    141
         STB,D4   MESCKS,R1         COMPUTED CKS                        141
         LW,R7    R4                                                    141
         BAL,SR4  BINTOHEX                                              141
         LI,R1    33                                                    141
         STB,D4   MESCKS,R1                                             141
         SLS,D4   -8                                                    141
         CB,D4    TXBLK                                                 141
         BNE      %+2                                                   141
         LI,D4    X'F0'                                                 141
         LI,R1    32                                                    141
         STB,D4   MESCKS,R1         CARD CKS                            141
         LW,R2    MA6                                                   141
         LI,R3    MESCKS                                                141
         STW,R3   ERRPLIST+2        SET UP FPT TO PRINT COMPLETE MES.   141
         LI,R3    64                                                    141
         STW,R3   ERRPLIST+3                                            141
         B        PERR                                                  141
PA1      LW,R2    MA1
         B        PERR
PA2      LW,R2    MA2
         B        PERR
PA3      LW,R2    MA3               DUMMY SECTION LARGER THAN PREV DEF  141
         B        PERR                                                  141
PA4      LW,R2    MA4               STACK OVERFLOW                      141
         B        PERR                                                  141
PA5      LW,R2    MA5               SEQUENCE ERROR                      141
         B        PERR                                                  141
PA7      LW,R2    MA7               ILLEGAL DATA FORMAT                 141
         B        PERR                                                  141
PA8      LW,R2    MA8               ILLEGAL LOAD ADDRESS                141
         B        PERR                                                  141
PA9      LW,R2    MA9               MORE THAN 2 PAGES REQUESTED FOR DCBS
         B        PERR
PAA      LW,R2    MAA               ILLEGAL LOAD ITEM TYPE              141
         B        PERR                                                  141
PAC      LW,R2    MAC
         B        PERR
PAD      LW,R2    MAD
PERR     EQU      %                 PRINT ERROR MES.                    141
         LW,R7    MODNUM                                                141
         SLS,R7   -19                                                   141
         BAL,SR4  BINTOHEX                                              141
         CB,D4    TXBLK                                                 141
         BNE      %+2                                                   141
         OR,D4    XF0               CONVERT BLANK TO ZERO               141
         LI,R1    19                                                    141
         STB,D4   MESMOD,R1                                             141
         SLS,D4   -8                                                    141
         LI,R1    18                                                    141
         STB,D4   MESMOD,R1         MODULE NO.                          141
         LB,R7    SEQNUM                                                141
         BAL,SR4  BINTOHEX                                              141
         CB,D4    TXBLK                                                 141
         BNE      %+2                                                   141
         OR,D4    XF0               CONVERT BLANK TO ZERO               141
         LI,R1    22                                                    141
         STB,D4   MESMOD,R1                                             141
         SLS,D4   -8                                                    141
         LI,R1    21                                                    141
         STB,D4   MESMOD,R1         SEQUENCE NO.                        141
         M:WRITE,E ERRPLIST
ERRWRT   LI,R3    X'1FFFF'
         STS,R2   ERRPLIST+2                                            141
         SLS,R2   -17                                                   141
         STW,R2   ERRPLIST+3                                            141
         M:WRITE,E ERRPLIST
         CAL1,9   1                 **** EXIT THE LOADER
         PAGE                                                           14127540
SIGSAL1  EQU      %                %ENTRY FOR CC ERROR RETRY
         CAL1,9   1                 ***EXIT LINK DUE TO COMMAND ERROR
* TO RUN LINK ON LINE UNDER DELTA CHANGE THIS CAL1,9  1
* TO A CAL1,1 TERMRD - ALSO LINK THE ROM FROM THE ASSEMBLY
* OF THIS MODULE WITH A SPECIAL VERSION OF THE MODULE VDCB.
* IN VDCB THE PARAMETERS SHOULD BE SET TO THESE VALUES:
*          VDCB   ORG   X'13C00'
*          VLC    ORG   X'A000'
*          VDA    ORG   X'A200'
*          VPP    ORG   X'14000'
*          VDP    ORG   X'18000'
SIGSAL3  EQU      %                 ENTRY FOR INTERACTIVE PRE-READ
         LI,R2    PLIST             INITIALIZE INPUT
         STW,R2   PLISTBUF
         STW,R2   PLISTORG
         LI,R2    0
         STW,R2   PLIST+1           SET DEFAULT INPUT FILE AT % (M:GO)
         STW,R2   *PLISTORG         RESET ALL OPTIONS
         STW,R2   LEADPARN          RESET LEAD ( FLAG
         LI,R0    BUF3              SET COMMAND BUFFER ADDRESS
         LI,R2    8
         CW,R2    SWT               OUTPUT SPECIFIED
         BANZ     LINK22            YES-DONT CHANGE OUTPUT FILE
SIGSAL   EQU      %
         LI,R2    X'30000'          INITIALIZE OUTPUT TO % FILE
         LI,R3    X'FFFF'
         LS,R2    J:JIT             SYSID
         LW,R3    TXL
         SLD,R2   8                 03SYSIDL
         STW,R2   OPENOUT+7
SIGSAL2  EQU      %                 FROM INITIALIZE INTERACTIVE MODE
         MTW,0     J:JIT            ARE WE ONLINE OR IN BATCH MODE
         BLZ       ONLINE1
         LW,R1     READ
         LW,R1     4,R1             GET BYTE COUNT FROM M:READ
         B         %+2
ONLINE1  EQU       %
         LW,R1    M:UC+4
         SLS,R1   -17               BYTE COUNT OR RUN OR LINK (INC.TERM)
LINK22   EQU      %
         LI,R2    0                 START SCAN AT FIRST CHAR.
         LW,R3    TXBLK
         STW,R3   BUF2              SET BLANK
         LI,R3    BUF2              STORE RUN OR LINK AT
         BAL,SR4  SCAN              GO GET RUN OR LINK
         LW,R3    TXRUN
         CW,R3    BUF2              RUN COMMAND
         BE       RUN               YES
         LW,R3    TXLINK
         CW,R3    BUF2              LINK COMMAND
         BNE      LINKERR           ERROR-NOT LINK COMMAND
         CI,R7    4                 4 CHAR NAME
         BNE      LINKERR           ERROR-NOT LINK COMMAND
         CI,R1    1
         BLE      LINKERR           ERROR INTERACTIVE MODE NOT THERE
*        BLE      INTERACT
         B        LINK17            CHECK FOR LIBRARY ONLY FIDS
LINK1    EQU      %
         CI,R6    '('               START GROUP
         BNE      LINK1A
         STB,R6   LEADPARN          YES-SET PRESENT
         LI,R3    X'10'
         STS,R3   *PLISTBUF         SET NC OPTION BY DEFAULT
         B        LINK2
LINK1A   EQU      %
         CI,R6    ','
         BNE      LINKERR           MUST BE NORMAL TERMINATOR
LINK2    EQU      %
         LW,R3    TXBLK
         STW,R3   BUF2              SET BLANK
         STW,R3   BUF2+1
         LI,R3    BUF2              FIELD STORED AT.
LINK20   BAL,SR4  SCAN              GO-GET A FIELD
         CI,R7    0                 HAVE A FIELD
         BNE      LINK18            YES
         CI,R6    '('               TERM ON (
         BNE      LINK17            NO-CHECK FOR START LIBRARY FILES
         CB,R6    LEADPARN
         BE       LINKERR           ERROR-LF ( NOT EQ RIGHT)
         STB,R6   LEADPARN          SET (PRESENT
         B        LINK20            GET A FIELD
LINK18   EQU      %
         LI,R3    '('
         CB,R3    LEADPARN          LEADING ( PRESENT
         BE       LINK9             YES-EITHER SYMBOL TBL GROUP OR PARM.
LINK11   EQU      %
         LW,R3    TXON
         CW,R3    BUF2
         BE       ON                NEW FILE
         LW,R3    TXOVER
         CW,R3    BUF2
         BE       OVER              REPLACE OLD FILE
         LW,R3    TXUNDE
         CW,R3    BUF2
         BE       UNDER             ASSOCIATED DEBUG PROCESSOR
         LW,R3    ='U   '
         CW,R3    BUF2
         BE       UNDELTA
LINK21   EQU      %
         LW,R4    PLISTBUF
         STW,R4   PLISTORG          ADVANCE TO NEXT ENTRY
         LW,R3    TXDOLLAR
         CW,R3    BUF2              % FILE
         BE       DOLLAR            YES
LINK30   MTW,1    PLISTBUF          INC TO +1
         LW,R3    Y01000303
         STW,R3   *PLISTBUF         SET FILE NAME CONTROL WORD
         MTW,1    PLISTBUF          INC. TO +2
         STB,R7   *PLISTBUF         NO. OF CHARS IN FILE NAME
         LW,R4    R7
         AI,R4    -1
         LB,R3    BUF2,R4
         STB,R3   *PLISTBUF,R7
         AI,R4    -1
         BDR,R7   %-3               COPY FILE NAME TO PLIST
         MTW,3    PLISTBUF          INC. TO +5
         LW,R3    Y02000002
         STW,R3   *PLISTBUF         ACCT. NO. CONTROL WORD
         MTW,1    PLISTBUF          INC. TO +6
         LW,R3    TXBLK
         STW,R3   *PLISTBUF
         LI,R4    1
         STW,R3   *PLISTBUF,R4      CLEAN OUT ACCT. NO.
         CI,R6    '.'               ACCT OR PASS WORD PRESENT
         BNE      LINK4             NO
         LW,R3    PLISTBUF          PUT ACCT. NO. IN PLIST
         BAL,SR4  SCAN              GO-GET THE ACCT. NUMBER
         AI,R7    0                 ACCT. NO. PRESENT
         BEZ      LINK3             NO
         CI,R7    8
         BG       LINKERR           ACCT. NO. NO MORE THAN 8 CHARS.
         LI,R3    X'0200'
         LI,R4    -1
         STS,R3   *PLISTBUF,R4      SET ACCT. NO. PRESENT
LINK3    CI,R6    '.'               PASS WORD PRESENT
         BNE      LINK4             NO
         MTW,2    PLISTBUF          INC. TO +8
         LW,R3    Y03010202         PASS WORD CONTROL WORD
         STW,R3   *PLISTBUF
         MTW,1    PLISTBUF          INC. TO +9
         LW,R3    TXBLK
         STW,R3   *PLISTBUF
         LI,R4    1
         STW,R3   *PLISTBUF,R4      CLEAN OUT PASS WORD
         LW,R3    PLISTBUF
         BAL,SR4  SCAN              GO-GET PASS WORD
         AI,R7    0
         BEZ      LINKERR           ERROR-PASS WORD NULL
         CI,R7    8
         BG       LINKERR           PASSWORD NO MORE THAN 8 CHARS.
         B        LINK5
LINK4    LI,R3    X'10000'
         LI,R4    -1
         STS,R3   *PLISTBUF,R4      TERMINATE ENTRY
LINK5    MTW,2    PLISTBUF          INC. TO NEXT ENTRY ORG.
         CI,R6    ')'               END OF SYMBOL TBL. GROUP
         BNE      LINK23            NO
         LI,R3    '('
         CB,R3    *PLISTORG
         BNE      LINKERR           ERROR-LEFT( NOT EQ  RIGHT)
         LI,R3    0
         STB,R3   *PLISTORG         CLEAR (
         LI,R6    ','               CLEAR )
LINK23   LW,R3    *PLISTORG
         AND,R3   XFFFFFEFF         REMOVE INPUT %(GO) FILE
         STW,R3   *PLISTBUF         RETAIN ALL OPTIONS FOR NEXT FILE
LINK17   CI,R1    1                 END OF COMMAND
         BLE      LINK8             YES
         CI,R6    ';'               START LIBRARY MODE
         BNE      LINK1             NO-GO READ NEXT FIELD
         LW,R3    PLISTORG
         CW,R3    PLISTBUF          ONLY LIBRARY FILES SPECIFIED
         BNE      LINK29            NO-SET LIBRARY MODE
         LI,R3    X'100'            YES-SPECIFY DEFAULT %(M:GO) FILE
         STS,R3   *PLISTBUF             BEFORE LIBRARY MODE
         MTW,1    PLISTBUF          MAKE ONE WORD ENTRY
         LW,R3    *PLISTORG
         AND,R3   XFFFFFEFF         REMOVE INPUT %(GO) FILE
         STW,R3   *PLISTBUF         RETAIN ALL OPTIONS FOR NEXT FILE
LINK29   EQU      %
         LI,R3    X'40'
         STS,R3   *PLISTBUF         SET LIBRARY MODE
         LI,R3    '('
         CB,R3    *PLISTBUF
         BE       LINKERR           ERROR-NO GROUPING OF LIBRARY
         B        LINK2             GO-READ NEXT FIELD
         PAGE
LINK9    EQU      %                %WITHIN A GROUP OR PARAMETERTER
         LI,R3    0
         STW,R3   LEADPARN          CLEAR (
         CI,R6    '.'               WITHIN A GROUP
         BE       LINK10            YES
         CI,R6    ','               WITHIN A GROUP
         BNE      LINK12            NO
         LW,R3    TXEXEC            LOOK FOR EXECUTE ACCT #S
         CW,R3    BUF2
         BE       EXECAC
LINK10   LI,R3    X'40'
         CW,R3    *PLISTBUF
         BANZ     LINKERR           ERROR-NO GROUPING OF LIBRARIES
         LI,R3    '('
         CB,R3    *PLISTBUF
         BE       LINKERR           ERROR-LEFT( NOT EQ RIGHT)
         STB,R3   *PLISTBUF         SET START OF IST GROUP
         B        LINK11            PROCESS THE FILE
LINK12   EQU      %                 PARAMETER ANALYSIS
         CI,R6    ')'
         BNE      LINKERR           ERROR-LEFT( NOT EQ RIGHT)
         LW,R3    BUF2              PICK UP OPTION
         LI,R4    OPTNSIZE          NO. OF OPTIONS
         LW,R5    *PLISTBUF         OPTION WORD
         CW,R3    OPTIONS,R4
         BE       LINK13            OPTION FOUND
         BDR,R4   %-2
         LI,R4    'P'
         CB,R4    R3                CORE LIBRARY SPECIFICATION
         BE       LINK28            YES-CHECK FOR LEGAL SPECIFCATION
         LI,R4    'J'
         CB,R4    R3                JIT DEF CORE LIBRARY
         BNE      LINK26            NO-TRY FOR FORTRAN DEBUG LIBRARY
LINK28   CI,R7    2                 LEGAL PN, IN SPECIFICATION
         BNE      LINKERR           NO-ERROR
         LW,R5    LIBSTORE
         CI,R5    0                 FIRST TIME THRU?
         BNE      STORELIB          NO
         MTW,1    LIBSTORE          YES - BUMP LIBSTORE
         SLS,R3   -16
         BAL,SR4  INSERTLB          PUT 1ST LIB IN OPNCORL1
         B        LINK24
STORELIB CI,R5    1                 SECOND TIME THRU?
         BNE      SAMELIB           NO-MORE THAN TWO IS NO GOOD
         LW,R5    OPNCORL1
         SLS,R5   -8                SEE IF SECOND LIB REQUEST
         AND,R5   =X'FF'            IS FOR THE SAME TYPE LIB
         CW,R5    R4                AS THE FIRST
         BE       SAMELIB           YES IT IS - ERROR
         SLS,R3   -16               NO ITS NOT -STORE SECOND LIB
         STW,R3   LIBSTORE          IN LIBSTORE
         CI,R5    X'D7'
         BE       LINK24
         LW,R5    OPNCORL1
         STW,R5   LIBSTORE
         BAL,SR4  INSERTLB
         B        LINK24
SAMELIB  LW,R2    MAF
         B        ERRWRT
LINK26   CW,R3    ='FDP '           FORTRAN DEBUG LIBRARY WHANTED
         BNE      LINKERR           ERROR-UNKNOWN PARAMETER OR CORE LIB.
         LW,R3    =X'D7F04040'
         LI,R4    'P'
         B        LINK28+2
LINK13   EXU      OPTIONS1,R4       SET/RESET OPTION
         STW,R5   *PLISTBUF         AND SAVE
LINK24   EQU      %
         CI,R1    1                 END OF COMMAND
         BLE      LINK8             YES
         B        LINK2             NO-GO READ NEXT FIELD
OPTIONS  EQU      %-1
         DATA     'NM  '
         DATA     'M   '
         DATA     'C   '
         DATA     'NC  '
         DATA     'D   '
         DATA     'ND  '
         DATA     'NP  '
         DATA     'L   '
         DATA     'NL  '
         DATA     'I   '
         DATA     'NI  '
OPTNSIZE EQU      %-OPTIONS-1
OPTIONS1 EQU      %-1
         AND,R5   XFFFFFFDF         NM
         OR,R5    X20               M
         AND,R5   XFFFFFFEF         C
         OR,R5    X10               NC
         AND,R5   XFFFFFFF7         D
         OR,R5    X8                ND
         OR,R5    X4                NP
         AND,R5   XFFFFFFFD         L
         OR,R5    X2                NL
         AND,R5   XFFFFFFFE         I
         OR,R5    X1                NI
RUN      EQU      %
         LI,R3    X'200'
         STS,R3   PLIST             SET RUN COMMAND
         B        LINK17            CHECK FOR LIBRARY ONLY FIDS
ON       EQU      %
         CI,R6    '.'               FILE NAME 'ON'
         BE       LINK21            YES
         LI,R3    X'400'
         STS,R3   *PLISTBUF         SET ON
         B        OVER1
OVER     EQU      %
         CI,R7    4
         BNE      LINK21            NOT OVER VERB
         CI,R6    '.'               NOT A ON/OVER VERB
         BE       LINK21            YES
OVER1    EQU      %
         LI,R3    8
         CW,R3    SWT               OUTPUT FILE PREVIOUSLY SPECIFIED
         BANZ     LINKERR           YES-ERROR
         CI,R6    ','
         BNE      LINKERR           ERROR-OUPUT FILE ONLY
         LI,R3    '('
         CB,R3    *PLISTBUF
         BE       LINKERR           ERROR-LEFT( NOT EQ RIGHT)
         LW,R3    TXBLK
         STW,R3   BUF2              CLEAR NAME OF FILE
         LI,R3    BUF2              FIELD STORED AT.
         BAL,SR4  SCAN              GO GET FILE NAME
         CI,R7    0
         BE       LINKERR           ERROR-THERE MUST BE A FILE
         LW,R3    TXDOLLAR
         CW,R3    BUF2              %IDL (DEFAULT) OUTPUT FILE WHANTED
         BE       LINK17            YES-IT IS ALREADY THERE
         STB,R7   OPENOUT+7
         LW,R4    R7
         AI,R4    -1
         LB,R3    BUF2,R4
         STB,R3   OPENOUT+7,R7
         AI,R4    -1
         BDR,R7   %-3               COPY FILE NAME TO PLIST
         CI,R6    '.'               ACCT OR PASS WORD PRESENT
         BNE      LINK17            NO
         LI,R3    OPENOUT+11        PUT ACCT. NO. IN PLIST
         BAL,SR4  SCAN              GO-GET THE ACCT. NUMBER
         AI,R7    0                 ACCT. NO. PRESENT
         BEZ      LINK16            NO
         CI,R7    8
         BG       LINKERR           ACCT.NO. NO MORE THAN 8 CHARS.
         LI,R3    X'0200'
         STS,R3   OPENOUT+10        SET ACCT. NO. PRESENT
LINK16   CI,R6    '.'               PASS WORD PRESENT
         BNE      LINK17            NO
         LI,R3    OPENOUT+14        INTO PASS WORD
         BAL,SR4  SCAN              GO-GET THE PASS WORD
         AI,R7    0
         BEZ      LINKERR           ERROR-PASS WORD NULL
         CI,R7    8
         BG       LINKERR           PASSWORD NO MORE THAN 8 CHARS.
         LI,R3    X'200'
         STS,R3   OPENOUT+13        SET PASS WORD PRESENT FLAG
         B        LINK17
UNDELTA  EQU      %
         LW,R3    ='DELT'
         STW,R3   BUF2
         LW,R3    ='A   '
         STW,R3   BUF2+1
         LI,R7    5                 COUNT OF UNDER NAME
         B        LINK25
UNDER    EQU      %
         LW,R3    TXR
         CW,R3    BUF2+1
         BNE      LINK21            NOT UNDER
         CI,R6    '.'               FILE NAME-NOT UNDER VERB
         BE       LINK21            YES
         LI,R3    '('
         CB,R3    *PLISTBUF
         BE       LINKERR           ERROR-LEFT( NOT EQ RIGHT)
         LW,R3    TXBLK
         STW,R3   BUF2              CLEAN BUF2
         LI,R3    BUF2
         BAL,SR4  SCAN              GO-GET UNDER NAME
         LW,R3    ='FDP '
         CW,R3    BUF2              FORTRAN DEBUF LIBRARY WHANTED
         BNE      LINK25            NO
         LI,R3    'P0'              YES-SET P0 CORE LIBRARY
         BAL,SR4  INSERTLB          GO-INSERT CORE LIBRARY NAME (P0)
         B        LINK17
LINK25   EQU      %
         LI,R3    X'200'
         CW,R3    *PLISTORG
         BAZ      LINKERR           NOT A RUN COMMAND
         LW,R3    TXBLK
         STW,R3   UNDERNAM          BLANK FILL UNDER NAME
         STB,R7   UNDERNAM          NO. CHARS IN UNDER NAME
         LW,R4    R7
         AI,R4    -1
         LB,R3    BUF2,R4
         STB,R3   UNDERNAM,R7
         AI,R4    -1
         BDR,R7   %-3               COPY UNDER NAME TO HEAD
         B        LINK17
DOLLAR   EQU      %
         MTW,0    J:JIT
         BLZ      DOLLAR1           ONLINE
         LI,R3    X'FFFF'           NO - BUILD FILE
         LS,R3    J:JIT
         SLS,R3   16
         AI,R3    'G '              G AND BLANK
         STW,R3   BUF2
         LI,R7    3                 CHAR COUNT OF FILE NAME
         B        LINK30
DOLLAR1  LI,R3    X'100'
         STS,R3   *PLISTORG         SET % FILE
         MTW,1    PLISTBUF          INC. TO NEXT ENTRY ORG.
         B        LINK5+1
CONTINUE EQU      %
         MTW,0    J:JIT
         BLZ      ONLNE
         LI,ADR   WA(BUF3)
         LI,CNT   80
         M:READ,E READ
         M:WRITE,E MESSAGE:LO
         LW,R1    READ
         LW,R1    4,R1
RESET    SLS,R1   -17
         LI,R0    WA(BUF3)
         LI,R2    0
         B        LINK2
ONLNE    CAL1,1   TERMRD
         USECT    PLSECT
TERMRD   GEN,8,24 X'10',M:UC
         DATA     X'30000010'
         DATA     BUF3
         DATA     80
         USECT    PPLINK
         LW,R1    M:UC+4
         B        RESET
LINK8    EQU      %                 TEST DEBUG MODE
         LI,R3    X'10000'          OFF-BR LINK31
         AND,R3   J:OPT
         BEZ      LINK31
         LI,R3    4                 NP OPTION SPECIFIED ?
         AND,R3   *PLISTORG         YES-BR LINK31
         BNEZ     LINK31            NO - ADJOIN LIBRARY
         LI,R3    'P0'              'P0'
         BAL,SR4  INSERTLB
LINK31   EQU      %
         LI,R3    X'8000'           IS IT CONTINUED
         CW,R3    *PLISTORG
         BANZ     CONTINUE
         LI,R3    '('               END OF MESSAGE HERE
         CB,R3    *PLISTBUF
         BE       LINKERR           ERROR -LEFT (NOT EQ RIGHT)
         LI,R2    X'80'
         OR,R2    *PLISTBUF         SET LAST FLAG
         LI,R3    X'8FEBF'          REMOVE ; AT END -DONT CRUNCH J-P FLAGS
         STS,R2   *PLISTORG         DONT BOTHER % FILE BIT
         LI,R3    8
         CW,R3    SWT               OUTPUT PREVIOUSLY SPECIFIED
         BANZ     LDR4              YES-LOAD THIS LINK COMMAND
         PAGE
         CAL1,1   OPENOUT           IS FILE NOW PRESENT
         USECT    LINK
OPENOUT  GEN,8,7,17      X'14',0,F:LINK
         DATA     X'45080209'
         DATA     LINKABN           ABNORMAL ADDRESS
         DATA     2                 KEYED
         DATA     1                 IN
         DATA     11                MAX KEY LENGTH
         DATA     X'01000303'
         DATA     0,0,0             OUTPUT FILE NAME
         DATA     X'02000002'
         DATA     '    ','    '     ACCT. NO.
         DATA     X'03010002'
         DATA     '    ','    '     PASS WORD
         DATA     X'14000010'       EXEC ACCTS CONTROL WD
         DATA     0,0
         DATA     0,0
         DATA     0,0
         DATA     0,0
         DATA     0,0
         DATA     0,0
         DATA     0,0
         DATA     0,0
         USECT    PPLINK
         CAL1,1   FPTCLSOT          YES-CLOSE TO RE-OPEN OUT
         USECT    PLSECT
FPTCLSOT GEN,8,7,17      X'15',0,F:LINK
         DATA     X'80000000'
         DATA     2                 SAVE
         USECT    PPLINK
         LI,R1    X'400'
         CW,R1    *PLISTORG         OVER SPECIFIED
         BAZ      REOPEN            YES-REOPEN OUTPUT AND LOAD
         LI,ADR    WA(OUT1)
         LI,CNT    BCNT:OUT1
         M:WRITE,E MESSAGE
         B        SIGSAL1           READ ANOTHER COMMAND
         PAGE
REOPEN   EQU      %
         LI,R1    0
         STW,R1   OPENOUT+2         LET MON HANDLE ABNORMALS
         LI,R1    2
         STW,R1   OPENOUT+4         SET OUT MODE
         CAL1,1   OPENOUT           RE-OPEN OUT MODE
         LI,R3    8
         STS,R3   SWT               SET OUTPUT SPECIFIED
         B        LDR               GO LOAD
LINKABN  EQU      %
         LB,SR3   SR3
         CI,SR3   3                 FILE NOT PRESENT
         BE       REOPEN            YES-REOPEN OUTPUT AND LOAD
         LI,ADR    WA(OPOUT)
         LI,CNT    BCNT:OPOUT
         M:WRITE,E MESSAGE
         M:ERR     109
         PAGE
INSERTLB EQU      %                 INSERT CORE LIBRARY NAME
         OR,R3    =X'037A0000'      INSERT COUNT :
         STW,R3   OPNCORL1          FILE NAME OF CORE LIB RFDFSTK(03:PN)
         STW,R3   PNSIZE
         MTB,1    R3
         STW,R3   COREKEY           KEY OF CORE LIBRARY RFDFSTK
         STW,R3   CORENAME          FILE NAME OF CORE LIBRARY(04:PNN)
         STB,R3   CORENAME+1
         LW,R3    *PLISTBUF
         AND,R3   XFFFFFFFB
         STW,R3   *PLISTBUF         SET CORE LIBRARY PRESENT
         B        *SR4
         PAGE
*
*
EXECAC   EQU      %
         CI,R7    2
         BNE      LINK10            CANT BE EX KEYWD
         LI,R4    0
         LI,R5    X'10000'
         STS,R4   OPENOUT+13        RESET LAST ENT INDICATOR
         STS,R5   OPENOUT+16        SET LAST ENT INDIC
EXECAC1  LW,R3    TXBLK
         STW,R3   BUF2
         STW,R3   BUF2+1
         LI,R3    BUF2
         BAL,SR4  SCAN
         CI,R7    8
         BG       LINKERR
         CI,R7    0
         BE       LINKERR
         LI,R4    2
         LB,R3    OPENOUT+16,R4     GET PRES WD COUNT
         CI,R3    14                EIGHT 2WD ENTRYS ALLOWED
         BG       LINKERR
         AI,R3    2
         STB,R3   OPENOUT+16,R4     PUT NEW COUNT AWAY
         LW,D1    BUF2
         STW,D1   OPENOUT+16-1,R3
         LW,D1    BUF2+1
         STW,D1   OPENOUT+16,R3
         CI,R6    ','               MORE??
         BE       EXECAC1           YES, GET IT.
         CI,R6    ')'               END OF ACCTS?
         BNE      LINKERR
         B        LINK2             DONE WITH EX ACCTS.
         PAGE
*
* THE SCAN SUB-ROUTINE PROGRESSES THROUGH THE INPUT COMMAND PICKING UP
* THE NEXT FIELD. IT PROVIDES THE BOOKEEPING TO ALWAYS START AT THE
* BEGINNING OF A FIELD. FIELD TERMINATORS ARE DETERMINED BY THE CONTENTS
* OF TABLE 'TERMS'. LEADING AND TRAILING BLANKS ARE SUPPRESSED AS WELL
* AS SERVING AS A TERMINATOR
*
* ENTRY IS MADE WITH A BAL,SR4 SCAN.
*   R2 =  BYTE DISPLACEMENT WITHIN INPUT FIELD(NEXT FIELDS' STARTING
*         POSITION).
*   R3 =  ADDRESS TO WHERE FIELD IS TO BE MOVED. ZERO IF NO MOVE IS TO
*         TAKE PLACE.
*   R1 =  REMAINING SIZE OF INPUT MESSAGE(ARS).
*
* ON EXIT, THE FOLLOWING IS IN THE REGISTERS:
*   R6 =  FIELD DELIMITER CHARACTER(EXCEPT EOM IS NEVER SEEN-R1=0).
*   R7 =  NUMBER OF CHARACTERS IN FIELD, EXCLUSIVE OF SEPERATORS.
*   SR1 = DESTROYED.
*   R5 =  INDEX INTO TERMS TABLE(CHARACTER TYPE THAT STOPPED THE SCAN).
*   R1 =  AS ABOVE BUT DECREMENTED BY NUMBER OF CHARACTERS SCANNED.
*   R2 =  AS ABOVE POSITIONED TO START OF NEXT FIELD
*
* NOTE-R1=0 IMPLIES END OF MESSAGE.
*
SCAN     LI,SR1   0
         LI,R6    0                 CLEAR TERMINATOR
         LI,R7    0
         CI,R1    0
         BE       LINKERR           NO MORE CHARS.
         CI,R2    0
         BE       CONTTEST
LOOP     BDR,R1   %+2               TEST FOR END OF MESSAGE AND SET
         B        *SR4              END OF MESSAGE-RETURN-NO TERM CHAR.
         LB,R6    *R0,R2            PICK UP CHAR FROM MESSAGE
         AI,R2    1                 AND INCREMENT TO NEXT POSITION
         CI,R6    ' '               BLANK TEST
         BE       YBLK
         CI,R6    ','
         BE       YBLK              TREAT COMMA AS BLANK
         CI,R6    X'05'             TAB TEST-SAME AS BLANK
         BNE      TERMTST
YBLK     CI,R7    0                 TEST FOR PREVIOUS DATA
         BEZ      LOOP              IGNORE LEADING BLANKS
         AI,SR1   1                 SET BLANK FLAG
         B        LOOP              SUPPRESS TRAILING BLANKS
TERMTST  EQU      %                 SCAN FOR TERMINATING CHARACTERS
         LI,R5    SIZETERM
         CB,R6    TERMS,R5
         BE       *SR4              TERM CHAR ENCOUNTERED SO-RETURN
         BDR,R5   %-2
         CI,SR1   0                 NOT A TERMINATOR-TRAILING BLANK ENCO
         BE       CHAROK            NO-CHAR PART OF FIELD
         AI,R1    1                 RESET POSITION TO START OF NEW FIELD
         AI,R2    -1
         LI,R6    ','               SET TERMINATOR TO COMMA
         B        *SR4              AND RETURN
CHAROK   CI,R7    10                CHECK MAX FIELD LENGTH
         BGE      LINKERR
         STB,R6   *R3,R7            YES
         AI,R7    1                 COUNT CHARACTER
         B        LOOP              AND GO FOR NEXT ONE
CONTTEST LW,R6    R1
         AI,R6    -2
         MTW,0    J:JIT
         BLZ      %+2
         AI,R6    1
         LB,R7    *R0,R6
         CI,R7    '<'
         BNE      NOTCONT
         LI,R7    X'8000'
         STS,R7   *PLISTORG
         AI,R1    -1
ENDCONT  LI,R7    0
         LI,R6    0
         B        LOOP
NOTCONT  LW,R7    =X'FFFF7FFF'
         AND,R7   *PLISTORG
         STW,R7   *PLISTORG
         B        ENDCONT
*
* THE TERMS TABLE IS A BYTE TABLE CONTAINING A TERMINATOR CHARACTER IN
* EACH ENTRY. THE SCAN SUB-ROUTINE LOOKS AT THE TABLE FROM BACK TO FRONT
* AND THE FIRST ENTRY MUST BE A DUMMY. A SPACE SEPERATOR IS NOT NEEDED
* AS THIS LOGIC IS PERFORMED MORE EFFICIENTLY OUTSIDE OF THE TABLE.
*
TERMS    DATA,1   C' '              DUM-DUMB
         DATA,1   C';'        1
         DATA,1   '.'        2
         DATA,1   C'('        3
         DATA,1   C')'        4
SIZETERM EQU      BA(%)-BA(TERMS)-1
         BOUND    4
         PAGE
INTERACT EQU      %
         LI,R3    1
         STS,R3   SWT               SET INTERACTIVE MODE
         LI,ADR    WA(LNKHR)
         LI,CNT    BCNT:LNKHR
         M:WRITE,E MESSAGE
         LI,R3    X'FFFFD'
         AND,R3   SWT
         STW,R3   SWT               CLEAR BREAK BIT
         LI,ADR    WA(BUF3)
         LI,CNT    80
         M:READ,E  READ
         LI,R0    BUF3              COMMAND BUFFER FOR SCAN
         B        SIGSAL2
INTACTRD EQU      %
         LB,R1    OPNIN+6           BYTE COUNT OF FILE
         AI,R1    1                 COUNT NL CODE
         LI,R2    X'15'
         STB,R2   OPNIN+6,R1        INSERT NL AT END OF FILE NAME
         AI,R1    9                 COUNT DONE THR-BLANK
         LD,R2    TXDONETH          DONE THR
         LI,R4    ' '
         STB,R4   OPNIN+6           BLANK THE FILE CHAR COUNT
         LW,R4    OPNIN+6           PUT THE FILE NAME IN REGISTERS
         LW,R5    OPNIN+7
         LW,R6    OPNIN+8
         LW,R7    TSTACK
         AI,R7    1                 SET DONE THR MESS BUFFER
         LCI      5
         PSM,R2   TSTACK            PUT MESS IN BUFFER
         CAL1,1   FPTDONE
         USECT    PLSECT
FPTDONE  GEN,8,7,17      X'11',0,M:UC
         DATA     X'30000010'
         PZE      *R7               MESSAGE BUFFER IN TSTACK
         PZE      *R1               SIZE
         USECT    PPLINK
         LCI      5
         PLM,R2   TSTACK            CLEAN MESS OUT OF TSTACK
         LI,R1    4
         STS,R1   SWT               SET BUF3
INTRACT1 EQU      %                 ERROR RE-TRY
         LI,R1    X'FFFFD'
         AND,R1   SWT
         STW,R1   SWT               CLEAR BREAK
         LI,ADR    WA(BUF3)
         LI,CNT    80
         M:READ,E  READ
         LW,R1    READ
         LW,R1     4,R1             GET THE BYTE COUNT
         SLS,R1   -17               BYTE COUNT OF INTERACTIVE COMMAND
         STW,R1   COMANSZE          SAVE COMMAND LINE SIZE
INTREAD  LI,R0    BUF3              BUFFER LOCATION
         LI,R2    0                 START SCAN AT FIRST CHAR.
         LW,R3    TXBLK
         STW,R3   BUF2              CLEAR OUT COMMAND TYPE
         LI,R3    BUF2              STORE COMMANDAT
         PSW,SR4  TSTACK            SAVE RETURN
         BAL,SR4  SCAN              GO GET COMMAND
         PLW,SR4  TSTACK
         LW,R3    TXLINK
         CW,R3    BUF2              LINK COMMAND
         BE       *SR2              YES-CONTINUE LOADING
         LW,R3    TXEND
         CW,R3    BUF2              END COMMAND
         BE       *SR2              YES-CONTINUE LOADING
         LW,R3    TXQUIT
         CW,R3    BUF2              QUIT COMMAND
         BNE      %+3               NO
         LI,D4    0                 YES-EXIT LOADER
         CAL1,9   1                 SO THAT FILES AND MEMORY GET REL.
         LW,R3    TXOUTP
         CW,R3    BUF2              OUTPUT
         BE       ENDLOAD1          YES-WRAP UP THE LOAD
         CAL1,1   INTACT1           OUTPUT '?'
         USECT    PLSECT
INTACT1  GEN,8,7,17      X'11',0,M:UC
         DATA     X'30000010'
         DATA     %+2               BUF
         DATA     1                 SIZE
         TEXT     '?   '
         USECT    PPLINK
         B        INTRACT1          READ ANOTHER COMMAND
         PAGE                                                           141
SIGSALS  EQU      %
         LI,R0    TSTACK             ADDRESS OF STACK POINTER
         CAL1,8   FPTRAP           SET TRAP CONTROL
         USECT    PLSECT
FPTRAP   GEN,8,7,17      X'14',0,PAC
         DATA     X'00200003'         MEMORY VIOLATE,FIX AND DEC OVERFLOW
         USECT    PPLINK
         BAL,R0   MMTBASE           GO GET ROOM FOR INITIAL STACKS
         MTW,0     J:JIT
         BLZ       ONLINE2
         LI,ADR    WA(BUF3)         IF WE ARE IN BATCH MODE READ
         LI,CNT    80               A CARD  THRU M:SI
         M:READ,E  READ
         LI,R0     WA(BUF3)
         B         SIGSAL
ONLINE2  EQU       %
         M:PC      ':'
         LI,R0    J:CCBUF           COMMAND BUFFER FROM TEL
         B        SIGSAL                                                14133870
         END      SIGSALS                                               141

