****************************************************************
*M*      SYMCON   SYMBOL CONTROL PROCESSOR
****************************************************************
*P*      NAME:    SYMCON
*P*      PURPOSE: SYMCON PROVIDES A MEANS OF CONTROLLING THE EXTERNAL
*P*               SYMBOLS IN A LOAD MODULE.  ITS PRIMARY FUNCTION IS
*P*               TO GIVE THE PROGRAMMER A MEANS OF PREVENTING DOUBLE
*P*               DEFINITIONS OF EXTERNAL SYMBOLS. IT CAN ALSO BE USED
*P*               TO REDUCE THE NUMBEER OF EXTERNAL SYMBOLS AND TO
*P*               BUILD A DELTA-FORMAT GLOBAL SYMBOL TABLE.
*P*      DESCRIPTION: SYMCON CAN BE RUN EITHER ONLINE OR IN BATCH.
*P*               IT READS THE LOAD MODULE TO BE MODIFIED, PROCESSES
*P*               EACH COMMAND INDEPENDENTLY BY APPROPRAITELY
*P*               MODIFYING THE CORE IMAGE OF THE LOAD MODULE'S
*P*               REF/DEF AND EXPRESSION STACKS, AND THEN REWRITES
*P*               THE LOAD MODULE, PROVIDING NO MAJOR ERRORS ARE
*P*               ENCOUNTERED.  NOTE THAT THE OLD LOAD MODULE WILL
*P*               BE OVERWRITTEN.
*P*      REFERENCE: SYMCON IS DESCRIBED IN THE CP-V BATCH PROCESSING
*P*               REFERENCE MANUAL, 901764.
**********************************************************************
*
*  01/19/71 - S.P.OGARD
*  04/01/71 - C.H.KUHENBEAKER
*  LOAD MODULE SYMBOL CONTROL - SYMCON
*
*
         TITLE    '          SYMCON          6/20/75'
*
*
*  REGISTER DEFINITIONS
R0       EQU      0
R1       EQU      1                 STACK POINTER
R2       EQU      2
R3       EQU      3                 CONTROL BYTE DISP
R4       EQU      4                 EXPR TERM POINTER
R5       EQU      5                 SCRATCH INDEX
R6       EQU      6                      ''
R7       EQU      7                      ''
R8       EQU      8                 SUBR ARG
R9       EQU      9                    ''
R10      EQU      10                   ''
R11      EQU      11
R12      EQU      12                GENERAL USE
R13      EQU      13                    ''
R14      EQU      14                    ''
R15      EQU      15                RETURN ADDR FOR SUBRS
*
         SYSTEM   SIG7
         SYSTEM   BPM
*
         REF      M:SI,M:EI,M:LO     DCB'S
         REF      J:JIT,JSPVP
         DEF      SYMCON,S          PROCESSOR ENTRY
*
S        EQU      SYMCON            DEBUGGING LABEL
         PAGE
*
* INITIALIZATION
*
SYMCON   EQU      %
         M:TRAP   (IGNORE,FX)       IGNORE FIXED ARITH OVFL
         LW,R0    J:JIT             IS USER ON LINE ?
         BGEZ     SYMC1             NO
         LI,R8    MSG0              YES, PRINT:
         BAL,R15  PRINT1                     SYMCON HERE
         CAL1,1   =X'2C00005C'      SET PROMPT CHAR TO '*'
SYMC1    EQU      %
*                             READ TREE
         M:OPEN   M:EI,(ERR,WRONG),INOUT
         M:READ   M:EI,(BUF,TREE),(SIZE,TREESIZE),WAIT,(KEY,TREEKEY)
         LI,R8    X'20'              MAKE SURE FILE READ WAS KEYED
         CW,8     M:EI+5
         BAZ      NOTLMN            IT WASN'T
         CAL1,1   RHEAD             READ HEAD RECORD
         LB,R8    HEADBUF           FIND OUT WHAT KIND OF LM THIS IS
         CI,R8    X'82'
         BE       BADLMN
         CI,R8    X'84'
         BE       BADLMN
         MTB,1    TREE+1            SET FOR KEYS
         B        COMPROC
*
GETRFDF  RES
         LW,R8    RDCNT             DO WE ALREADY HAVE IT
         BNEZ     *R0               YES.
         LH,R8    TREE+7            GET REF/DEF SIZE
         AND,R8   =X'FFFF'          MASK
         STW,R8   RDCNT             SAVE COUNT
         AI,R8    511+3             ROUND AND ADD 3 WORDS FOR GST START
         SLS,R8   -9                SHIFT TO PAGE VALUE
         OR,R8    =X'08000000'      FORM P-LIST
         CAL1,8   R8                M:GP
         BCS,8    SYMC20            SPACE NOT AVAIL
         SLS,R8   11                CONVERT TO BYTES FOR BUF SIZE
         LB,R7    TREE+1            GET SEG NAME SIZE
         STB,R8   TREE+1,R7         SET SUFFIX TO 0
         AI,R9    3                 SET BUFFER ADDRESS
         STW,R9   RDSTRT            SAVE IIT
         AI,R8    -12               ADJUST SIZE
*                             READ REF/DEF STACK
,LMFILE  M:READ   M:EI,(BUF,*R9),(SIZE,*R8),WAIT,(KEY,TREE+1)
         B        *R0               RETURN
*
GETEXPR  RES
         LW,R8    DLIST             PREPARE TO READ EXPRESSION STACK
         BNEZ     *R0               WE ALREADY HAVE IT
         STW,R0   DLIST             SAVE RETURN
         BAL,R0   GETRFDF           GET RFDF IF WE DONT HAVE IT
         LW,R0    DLIST             RESTORE RETURN
         LI,R1    0                 INIT REF/DEF
         LI,R10   0                 INIT ITEM COUNT
SYMC10   BAL,R15  RDNEXT            COUNT ITEMS
         B        %+3               END OF STACK
         AI,R10   1                 INC COUNT
         B        SYMC10            NEXT
         LH,R8    TREE+9            GET EXPR STACK SIZE
         AND,R8   =X'FFFF'          MASK
         STW,R8   EXCNT             SAVE COUNT
         AW,R8    R10               ADD DLIST SIZE
         AI,R8    511               ROUND TO NEXT PAGE
         SLS,R8   -9                SHIFT TO PAGE VALUE
         OR,R8    =X'08000000'      FORM P-LIST
         CAL1,8   R8                M:GP
         BCS,8    SYMC20            SPACE NOT AVAIL
         LW,R12   EXCNT             IS EXPR STACK VOID
         BEZ      SYMC16            YES, DO NOT READ
         SLS,R8   11                CONVERT TO BYTES FOR BUF SIZE
         STW,R9   EXSTRT            SAVE START ADDR
         LI,R12   1
         LB,R7    TREE+1
         STB,R12  TREE+1,R7         SET SEG NAME SUFFIX TO 1
*                             READ EXPR STACK
         CAL1,1   LMFILE            M:READ
         AW,R9    EXCNT             ADD EXPR STACK SIZE TO START ADDR
SYMC16   STW,R9   DLIST             SAVE DLIST START ADDR
         B        *R0               RETURN
*
SYMC20   LI,R8    MSG6              PRINT MESSAGE
         BAL,R15  PRINT1            NOT ENOUGH SPACE
         B        FIN30             EXIT
*
TREESIZE EQU      768*4             PAGE & A HALF FOR TREE BUFFER
TREE     RES,1    TREESIZE
TREEKEY  TEXTC    'TREE'            TREE KEY
PATCH    RES      100               PATCH AREA
         PAGE
*
* COMMAND PROCESSOR
*
COMPROC  EQU      %
*                             READ NEXT CONTROL RECORD
         BAL,R15  READ              READ CONTROL RECORD
         B        FINISH            ABN READ: FINISH AND DUMP LOAD MOD
         LW,R0    J:JIT             IF USER IS ON LINE,
         BLZ      COM1                DON'T PRINT OUT COMMAND.
         LI,R7    3
         BAL,R15  SPACE             UPSPACE PRINTER
         LI,R8    COMPRT            PRINT COMMAND IMAGE
         BAL,R15  PRINT1
COM1     EQU      %
         LI,R7    0
         STW,R7   SYMNEX8           INIT SYMBOL SCAN
         STW,R7   SYMNEX9           SET COMMAND START FLAG
         LI,R8    SYMBOL
         BAL,R15  SYMNEX            SCAN COMMAND VERB
         B        COMPROC           BLANK CARD
         LW,R12   SYMBOL            GET FIRST WORD
         AND,R12  =X'FFFFFF'        MASK
         CW,R12   ='DEL'                DELETE S1,...,SN
         BE       DELETE            DELETE
         CW,R12   ='KEE'                KEEP   S1,...,SN
         BE       KEEP              KEEP
         CW,R12   ='CHA'                CHANGE S1/T1,...,SN/TN
         BE       CHANGE            CHANGE
         CW,R12   ='LIS'                LIST
         BE       LIST              LIST
         CW,R12   ='BUI'                BUILD (DST)
         BE       BUILDDST          BUILD DST
         CW,R12   ='DIS'                DISCARD (DST)
         BE       DISCARD           DISCARD DST
         CW,R12   ='END'                END
         BE       FINISH            FINISH AND DUMP LOAD MOD
         CW,R12   ='RET'                RETAIN S1,S2
         BE       RETAIN            RETAIN RANGE OF SYMBOLS
         CW,R12   ='SYM'            CALLED FROM BATCH
         BE       COMPROC           YEP: READ 1ST COMMAND
         M:PRINT  (MESS,EH)         SAY WHAT?
         B        COMPROC           TRY AGAIN
*
COMPRT   GEN,8,24 83,X'404040'      PRINT COUNT
COMBUF   RES      20                INPUT BUFFER
         PAGE
*
* SYMNEX  - SCAN NEXT SYMBOL FROM COMMAND BUFFER
*         - SYMBOL IS SUPPLIED IN TEXTC FORM AT ADDRESS
*            SPECIFIED IN R8 (R8 LEFT UNCHANGED)
*
*        BAL,R15  SYMNEX
*         (END OF COMMAND)
*         (NORMAL RETURN, DELIMITER IN R9)
*
*                 REGS USED - 5,6,7,8,9,12,14,15
*
SYMNEX   LI,R12   X'4B'
         CW,R12   SYMNEX9           WAS LAST DELIM A PERIOD
         BE       *R15              YES, RETURN
         LW,R7    SYMNEX8           GET INPUT BUFFER DISP
         LI,R6    0                 INIT SYMBOL DISP
SYMNEX1  BAL,R14  CHARNX            GET CHAR
         CI,R12   2                 IS IT A BLANK
         BE       SYMNEX1           YES
SYMNEX2  CI,R12   1                 NO, IS IT A SYMBOL CHAR
         BE       SYMNEX2A          YES
         MTW,0    BUILDFLG          NO, IS THIS A BUILD SCAN (LIB)
         BEZ      SYMNEX4           NO
         CI,R12   8                 YES, IS IT A ( OR )
         BL       SYMNEX4           NO
SYMNEX2A CI,R6    63                YES, IS SYMBOL SIZE MAX
         BE       SYMNEX3           YES, DO NOT INCREASE
         AI,R6    1                 NO, INC SYMBOL DISP
         STB,R5   *R8,R6            STORE CHAR
SYMNEX3  BAL,R14  CHARNX            GET NEXT CHAR
         B        SYMNEX2
*
SYMNEX4  CI,R12   2                 IS CHAR BLANK
         BNE      SYMNEX5           NO
         LW,R12   SYMNEX9           YES
         CI,R12   0                 IS SCAN FOR COMMAND VERB
         BE       %+3               YES
         BAL,R14  CHARNX            NO, GET NEXT CHAR
         B        SYMNEX4
         LI,R9    X'6B'             SET DELIM TO COMMA
         B        SYMNEX6
*
SYMNEX5  BL       SYMNEX7           BRANCH IF NOT DELIM
         CI,R6    0                 IS SYMBOL NULL
         BE       SYMNEX1           YES
         LW,R9    R5                NO, DELIM TO R9
SYMNEX6  STB,R6   *R8               STORE CHAR COUNT
         STW,R7   SYMNEX8           SAVE DISP
         STW,R9   SYMNEX9           SAVE DELIM
         AI,R15   1                 INC RETURN ADDR
         B        *R15              RETURN
*
SYMNEX7  LI,R8    MSG8              BAD SYNTAX
         BAL,R15  PRINT1
         B        FIN30             ABORT
*
SYMNEX8  DATA     0                 BUFFER DISP
SYMNEX9  DATA     0                 LAST DELIM
*
* CHARACTER SCANNER   BAL,R14  CHARNX, CHAR PUT IN R5, TYPE IN R12
*
CHARNX   CI,R7    80                END OF BUFFER
         BNE      CHARNX2           NO
CHARNX1  CI,R6    0                 YES, IS SYMBOL NULL
         BE       *R15              YES, END OF COMMAND
         LI,R9    X'4B'             NO, SET DELIM TO PERIOD
         B        SYMNEX6
*
CHARNX2  LB,R5    COMBUF,R7         GET NEXT CHAR
         AI,R7    1                 INC BUF DISP
         LB,R12   SYMTAB,R5         GET CHAR TYPE
         CI,R12   0                 IS CHAR LEGAL
         BE       CHARNX5           NO, ERROR
         CI,R12   5                 IS IT .
         BE       CHARNX1           YES
         CI,R12   6                 NO, IS IT ;
         BE       CHARNX6           YES
         CI,R12   7                 NO, IS IT CARRIER RETURN. ETC.?
         BNE      *R14              NO, EXIT
         LI,R5    '.'               YES, CHANGE IT TO '.' IN BUFFER
         AI,R7    -1
         STB,R5   COMBUF,R7
         AI,R7    1
         B        CHARNX1           TREAT IT AS IF IT WERE '.'
*
CHARNX5  LI,R8    MSG10             ILLEGAL CHAR
         BAL,R15  PRINT1
         B        FIN30             ABORT
*
CHARNX6  EQU      %                 CONTINUATION
         STW,R8   CHARNX8           SAVE REGS
         STW,R15  CHARNX9
         BAL,R15  READ              READ CONTINUATION RECORD
         B        FIN20             ABN READ: INCOMPLETE COMMAND ABORT
         LW,R0    J:JIT             IF USER IS ON LINE,
         BLZ      %+3                 DON'T PRINT COMMAND CONTINUATION
         LI,R8    COMPRT            PRINT IMAGE
         BAL,R15  PRINT1
         LW,R8    CHARNX8           RESTORE REGS
         LW,R15   CHARNX9
         LI,R7    0                 RESET BUF DISP
         B        CHARNX2           CONTINUE
*
CHARNX8  DATA     0                 TEMP
CHARNX9  DATA     0                 TEMP
*
*
* COMMAND/CONTINUATION RECORD READER
*                   BAL,R15   READ
*                   (ABNORMAL-READ RETURN)
*                   (NORMAL RETURN, RECORD IN COMBUF)
*
*                   REGS USED - 7,8,15
*
READ     LW,R8    ='    '           BLANK OUT COMBUF
         LI,R7    20
         STW,R8   COMBUF-1,R7
         BDR,R7   %-1
         M:READ   M:SI,(BUF,COMBUF),(SIZE,80),(ABN,*R15)
         AI,R15   1
         B        *R15              NORMAL RETURN
*
*
* CHARACTER TYPE TABLE
*
*         0 - ILLEGAL CHAR
*         1 - LEGAL SYMBOL CHAR
*         2 - BLANK
*         3 - ,  SYMBOL DELIM
*         4 - /  SYMBOL DELIM
*         5 - .  COMMAND TERMINATOR
*         6 - ;  CONTINUATION
*         7 - CR,LF,EOF,... COMMAND TERMINATOR
*        8 - (  SYMBOL DELIM
*        9 - )  SYMBOL DELIM
*
CHAR     CNAME                      PROC TO GENERATE BYTES
*                                       CHAR,TYPE  CHAR
*                                           OR
*                                       CHAR,TYPE  1STCHAR,LASTCHAR
LAST     SET      0
         PROC
LF       EQU      %
NEXT     SET      1+AF(NUM(AF))
         ERROR,1,AF(1)-LAST<0   'INCORRECT SEQUENCE'
         DO1      AF(1)-LAST        STORE 0'S IN TABLE FROM PREVIOUS
         DATA,1   0                   END UP TO CURRENT 1STCHAR.
         DO1      NEXT-AF(1)
         DATA,1   CF(2)               CHAR TYPE CODES.
LAST     SET      NEXT              SET UP END FOR NEXT TIME
         PEND                             N2 = CONTENT
*
SYMTAB   CHAR,7   X'0C',X'0D'       FF,CR
         CHAR,7   X'15'             NL/LF
         CHAR,7   X'1C',X'1F'       FS,GS,RS,US
         CHAR,2   X'40'             BLANK
         CHAR,5   X'4B'             .
         CHAR,8   X'4D'             (
         CHAR,1   X'5B'             %
         CHAR,9   X'5D'             )
         CHAR,6   X'5E'             ;
         CHAR,4   X'61'             /
         CHAR,3   X'6B'             ,
         CHAR,1   X'6D'             -
         CHAR,1   X'7A',X'7C'       :#@
         CHAR,1   X'C1',X'C9'       A ... I
         CHAR,1   X'D1',X'D9'       J ... R
         CHAR,1   X'E2',X'E9'       S ... Z
         CHAR,1   X'F0',X'F9'       0 ... 9
         CHAR,0   X'FF'             TO FILL OUT TABLE
         PAGE
*
* DELETE COMMAND PROCESSOR
*
DELETE   RES
         BAL,R0   GETEXPR           GET RFDF AND EXPR STACKS
         LI,R12   -1
         STW,R12  DLISTE            START DELETE LIST POINTER
DEL10    LI,R8    SYMBOL            SYMBOL ADDR
         BAL,R15  SYMNEX            GET NEXT SYMBOL FROM COMMAND
         B        DEL32             END OF COMMAND
         BAL,R15  RDSRCH            IS SYMBOL IN REF/DEF
         B        DEL30             NO, ERROR
         CI,R10   0                 IS IT A DEF
         BNE      DEL34             NO, ERROR
         LW,R7    DLISTE            YES, IS DELETE LIST EMPTY
         BLZ      DEL14             YES, ENTER SYMBOL
DEL12    CW,R1    *DLIST,R7         NO, IS IT ALREADY ENTERED
         BE       DEL10             YES, DO NOT ENTER IT
         AI,R7    -1                DEC INDEX
         BGEZ     DEL12             NOT DONE
DEL14    LW,R7    DLISTE            SET PREVIOUS DLIST POINTER
         STW,R7   DLISTP
         AI,R7    1                 INC DLIST END
         STW,R7   DLISTE
         STW,R7   DLISTW            SET DLIST WORKING POINTER
         STW,R1   *DLIST,R7         STORE SYMBOL DISP IN DLIST
DEL20    LI,R1    0                 INIT EXPR SCAN
DEL22    BAL,R15  EXNEXT            GET NEXT EXPR
         B        DEL26             END OF STACK
DEL24    BAL,R15  CBINT             EXAMINE NEXT CONTROL BYTE
         B        DEL22             EXPRESSION END
         LW,R7    DLISTW            GET WORKING POINTER
         CW,R9    *DLIST,R7         DOES TERM POINT TO SYMBOL
         BNE      DEL24             NO, GET NEXT TERM
         CI,R0    X'80'             IF IT'S NOT EVALUATED,
         BAZ      DEL28               DON'T LET HIM DELETE THIS SYMBOL.
         CI,R0    X'40'             IF CORE EXPR,
         BANZ     DEL22               SKIP ON BY.
         LW,R7    DLISTE            SET INDEX TO END OF DLIST
DEL25    CW,R8    *DLIST,R7         IS DEST ALREADY IN DELETE LIST
         BE       DEL22             YES, DO NOT ENTER IT
         AI,R7    -1                DEC INDEX
         BGEZ     DEL25             NOT DONE
         MTW,1    DLISTE            INC DLIST END
         LW,R7    DLISTE
         STW,R8   *DLIST,R7         STORE DEST INTO DLIST
         B        DEL22             GET NEXT EXPR
DEL26    LW,R12   DLISTW
         CW,R12   DLISTE            DOES WORKING = END
         BE       DEL10             YES, PROCESS NEXT SYMBOL
         MTW,1    DLISTW            NO, INC WORKING POINTER
         B        DEL20             SCAN EXPR STACK
DEL28    LW,R12   DLISTP            REMOVE ALL NEW ENTRIES
         STW,R12  DLISTE
         LI,R8    MSG1
         BAL,R15  PRINT             CANNOT DELETE
         B        DEL10             GET NEXT SYMBOL
DEL30    LI,R8    MSG2
         BAL,R15  PRINT             NOT FOUND IN REF/DEF
         B        DEL10             GET NEXT SYMBOL
DEL32    LW,R12   DLISTE            GET DLIST END
         CI,R12   -1                IS LIST EMPTY
         BNE      DEL40             NO, PROCESS DELETIONS
         LI,R8    MSG3              YES, TELL USER
         BAL,R15  PRINT1
         B        COMPROC           GET NEXT COMMAND
DEL34    LI,R8    MSG4
         BAL,R15  PRINT             SYMBOL NOT DEF
         B        DEL10             GET NEXT SYMBOL
DEL40    LW,R7    DLISTE            SET INDEX
         LI,R8    MSG5              PRINT DELETE LIST TITLE
         BAL,R15  PRINT1
DEL42    LW,R12   *DLIST,R7         GET DEF ADDR
         LW,R13   *R12              GET FIRST WORD
         OR,R13   =X'80000000'      SET DELETE FLAG
         STW,R13  *R12              RESTORE
         LH,R13   *R12              GET TYPE
         AND,R13  =X'F'             MASK
         CI,R13   0                 IS IT A DEF
         BNE      DEL44             NO, DO NOT PRINT
         LW,R8    R12               YES, PRINT NAME
         AI,R8    3                 NAME DISP
         BAL,R15  PRINT1            PRINT
DEL44    BDR,R7   DEL42             COOK UNTIL DONE.
*                             BUILD CORRELATION TABLE
DEL50    LI,R1    0                 INIT REF/DEF POINTER
         LI,R6    0                      CORR TABLE POINTER
         LI,R8    0                      NEW REF/DEF DISP
DEL52    BAL,R15  RDNEXT            GET NEXT ITEM
         B        DEL54             END OF STACK
         LB,R9    *R1               GET DELETE FLAG AND NO. WORDS
         CI,R9    X'7F'             IS FLAG SET
         BG       DEL52             YES, IGNORE ITEM
         LW,R10   R1                NO, GET ITEM ADDR
         SW,R10   RDSTRT            CONVERT TO REL DISP
         SLS,R10  16                OLD DISP TO LEFT HALF
         OR,R10   R8                NEW DISP TO RIGHT HALF
         STW,R10  *DLIST,R6         STORE IN CORR TABLE
         AI,R6    1                 INC CORR TABLE POINTER
         AW,R8    R9                ADD ITEM WD CNT TO NEW DISP
         B        DEL52             DO NEXT ITEM
*                             DELETE EXPRESSIONS
DEL54    LI,R1    0                 INIT EXPR POINTER
         LI,R5    0                      NEW STACK DISP
         LI,R6    0                      CORR TABLE POINTER
DEL56    BAL,R15  EXNEXT            GET NEXT EXPR
         B        DEL80             END OF STACK
         CI,R0    X'40'             IF IT'S A CORE EXPR, DON'T TRY TO
         BANZ     DEL58               CORREL ITS DESTINATION PNTR.
         LB,R12   *R8               GET FLAG FROM DEST
         CI,R12   X'7F'             HAS ITEM BEEN DELETED
         BG       DEL56             YES, GET NEXT EXPR
         SW,R8    RDSTRT            NO, CONVERT TO REL DISP
         BAL,R15  DEL70             CORREL AND STORE NEW DEST
DEL58    BAL,R15  CBINT             GET NEXT CONTROL BYTE
         B        DEL60             EXPR END
         LB,R12   *R9               GET FLAG
         CI,R12   X'7F'             HAS ITEM BEEN DELETED
         BG       DEL56             YES, GET NEXT EXPR
         SW,R9    RDSTRT            NO, CONVERT TO REL DISP
         LW,R8    R9                POINTER TO R8
         LW,R9    R4                LOC OF POINTER TO R9
         BAL,R15  DEL70             CORREL AND STORE NEW POINTER
         B        DEL58             NEXT CONTROL BYTE
DEL60    LW,R12   R5                NEW DISP
         AW,R12   EXSTRT            MAKE IT ABS
         CW,R12   R1                DOES IT EQUAL CURRENT DISP
         BE       DEL64             YES, NO MOVE REQ
         LI,R7    -1                SET INDEX
         LB,R13   *R1               GET WORD COUNT
DEL62    AI,R7    1                 INC INDEX
         CW,R7    R13               DOES IT EQUAL COUNT
         BE       DEL66             YES, DONE
         LW,R14   *R1,R7            NO, MOVE WORD
         STW,R14  *R12,R7
         B        DEL62             NEXT
DEL64    LB,R13   *R1               GET WORD COUNT
DEL66    AW,R5    R13               ADD COUNT TO NEW STACK DISP
         B        DEL56             GET NEXT EXPR
*
*                             CORRELATION SUBROUTINE
*                               - R8, REL POINTER TO REF/DEF
*                               - R9, LOC IN EXPR STACK
*                               - R6, CORREL TABLE POINTER
*                               -   BAL,R15   DEL70
*
*                                   REGS USED - 6,8,9,12,15
*
DEL70    LW,R12   *DLIST,R6         GET NEXT CORREL ENTRY
         BGEZ     %+3
         LI,R6    0                 RESET POINTER IF IN THE BOONIES
         B        *R15              AND LEAVE
         SLS,R12  -16               LEFT HALF (OLD REF/DEF)
         CW,R12   R8                ARE POINTERS EQUAL
         BE       DEL72             YES
         BG       %+4               NO
         AI,R6    1                 GO FORWARD
         STCF     R15               DONT GO BOTH WAYS
         B        DEL70
         AI,R6    -1                BACK UP
         LC       R15
         BNEZ     *R15              DON LOOOP
         B        DEL70
DEL72    LW,R12   *DLIST,R6
         AND,R12  =X'FFFF'          RIGHT HALF (NEW REF/DEF)
         STW,R12  *R9               STORE NEW POINTER
         B        *R15              RETURN
*
DEL80    STW,R5   EXCNT             STORE NEW EXPR STACK SIZE
*                             COMPRESS REF/DEF STACK
         LI,R1    0                 INIT REF/DEF
         LI,R5    0                      NEW DISP
DEL82    BAL,R15  RDNEXT            GET NEXT ITEM
         B        DEL90             END OF STACK
         LB,R13   *R1               GET FLAG AND WORD COUNT
         CI,R13   X'7F'             HAS ITEM BEEN DELETED
         BG       DEL82             YES, IGNORE
         LW,R12   R5                NEW DISP
         AW,R12   RDSTRT            MAKE IT ABS
         CW,R12   R1                DOES IT EQUAL CURRENT DISP
         BE       DEL86             YES, NO MOVE REQ
         LI,R7    -1                SET INDEX
DEL84    AI,R7    1                 INC INDEX
         CW,R7    R13               DOES IT EQUAL COUNT
         BE       DEL86             YES, DONE
         LW,R14   *R1,R7            NO, MOVE WORD
         STW,R14  *R12,R7
         B        DEL84             NEXT
DEL86    AW,R5    R13               ADD COUNT TO NEW STACK DISP
         B        DEL82             GET NEXT ITEM
DEL90    STW,R5   RDCNT             STORE NEW REF/DEF STACK SIZE
         B        COMPROC           TO NEXT COMMAND
*
DLIST    DATA     0                 DELETE LIST AND CORREL TABLE ADDR
DLISTP   DATA     0                 DELETE LIST PREVIOUS SYMBOL POINTER
DLISTW   DATA     0                             WORKING POINTER
DLISTE   DATA     0                             CURRENT END POINTER
*
         BOUND    8                 I KNOW THIS LOOKS FUNNY, BUT...
         RES      1                 ...IT WORKS...
MAPBUF   DATA     X'40404040',0,0,0,X'40404040'
SYMBOL   RES,1    64                SYMBOL HOLDING AREA
SYMBOL1  RES,1    64                SECOND SYMBOL FOR RETAIN COMMAND
         PAGE
*
*   RETAIN COMMAND PROCESSOR
*
RETAIN   EQU      %
         BAL,R0   GETEXPR           GET RFDF AND EXPR STACS
         LI,R8    SYMBOL
         BAL,R15  SYMNEX            GET STARTING SYMBOL FOR RETENTION
         B        SYMNEX7           NONE: SYNTAX ERROR
         LI,R8    SYMBOL1           GET ENDING SYMBOL FOR RETENTION
         BAL,R15  SYMNEX
         B        SYMNEX7           NO ENDING SYMBOL: SYNTAX ERROR
         LI,R8    SYMBOL            RESET TO STARTING SYMBOL
         LI,R1    0                 INITIALIZE FOR RDNEXT
RETAIN10 BAL,R15  RDNEXT            GET NEXT REF/DEF ITEM
         B        RETAIN40          END OF STACK
         CI,R8    0                 DID WE HIT END OF RETAIN RANGE
         BE       RETAIN21          YES: WE MUST BE DELETING
         LH,R12   *R1
         AND,R12  =X'7'             GET ITEM TYPE
         CI,R12   3                 DOES IT HAVE A NAME
         BG       RETAIN21          NO
         LW,R9    R1
         AI,R9    3                 POINT TO ITS NAME
         BAL,R15  TEXCOM            AND COMPARE W/SYMBOL *R8
         B        RETAIN20          THEY DON'T COMPARE
         CI,R8    SYMBOL1           THEY DO: SWITCH KEEP/DELETE MODES
         BE       RETAIN15          WE HIT END OF KEEP RANGE
         LI,R8    SYMBOL1           WE HIT START OF KEEP RANGE
         B        RETAIN10
RETAIN15 LI,R8    0                 FLAG THAT WE'VE KEPT ALL WE'RE GONNA
         B        RETAIN10          KEEP THIS ONE LAST SYMBOL, THOUGH
RETAIN20 CI,R8    SYMBOL1           ARE WE KEEPING SYMBOLS
         BE       RETAIN10          YES, INDEED WE ARE.
RETAIN21 LH,R12   *R1
         AND,R12  =X'F'             GET ITEM TYPE
         BEZ      RETAIN30          ITS A DEF: DELETE IT
         CI,R12   5                 IS IT A FORWARD REFERENCE
         BE       RETAIN30          YEP: ZAP IT
         CI,R12   7
         BNE      RETAIN10          NOPE: KEEP IT AROUND
RETAIN30 LW,R11   =8**28
         STS,R11  *R1               SET DELETE FLAG
         B        RETAIN10          GO FOR NEXT SYMBOL
RETAIN40 CI,R8    SYMBOL            DID WE FIN START & END SYMBOLS
         BAZ      KEEP40            YEP: ENTER KEEP LOGIC TO FINISH UP
         BE       RETAIN50          NO: WE DIDN'T FIND 1ST SYMBOL
         LCI      4
         LM,R0    SYMBOL1
         STM,R0   SYMBOL            WE DIDN'T FIND 2ND SYMBOL
RETAIN50 LI,R8    MSG2              SO PRINT ERROR MSG
         BAL,R15  PRINT
         B        FIN30             AND ABORT
         PAGE
*
* KEEP COMMAND PROCESSOR
*
KEEP     EQU      %
         BAL,R0   GETEXPR           GET RFDF AND EXPR STACKS
         LI,R1    0                 INIT REF/DEF
KEEP10   BAL,R15  RDNEXT            GET NEXT ITEM
         B        KEEP30            END OF STACK
         LH,R12   *R1               GET TYPE
         AND,R12  =X'F'             MASK
         CI,R12   0                 IS IT A DEF
         BE       KEEP20            YES
         CI,R12   5                 IS IT A FORW REF
         BE       KEEP20            YES
         CI,R12   7
         BE       KEEP20            YES
         B        KEEP10            DO NEXT ITEM
KEEP20   LW,R12   *R1
         OR,R12   =X'80000000'      SET DELETE FLAG
         STW,R12  *R1
         B        KEEP10            DO NEXT ITEM
*
KEEP30   LI,R8    SYMBOL            SYMBOL ADDR
         BAL,R15  SYMNEX            GET NEXT SYMBOL FROM COMMAND
         B        KEEP40            END OF COMMAND
         BAL,R15  RDSRCH            IS SYMBOL IN REF/DEF
         B        KEEP32            NO, ERROR
         LW,R12   *R1               YES
         AND,R12  =X'7FFFFFFF'      RESET DELETE FLAG
         STW,R12  *R1
         B        KEEP30            DO NEXT SYMBOL
KEEP32   LI,R8    MSG2
         BAL,R15  PRINT             NOT FOUND IN REF/DEF
         B        KEEP30            GET NEXT SYMBOL
*
KEEP40   LI,R1    0                 INIT EXPR SCAN
KEEP42   BAL,R15  EXNEXT            GET NEXT EXPR
         B        KEEP50            END OF STACK
         CI,R0    X'C0'             IS EXPR EVALUATED OR CORE-DEST ?
         BANZ     KEEP42            YES, DO NEXT
         LW,R12   *R8               NO, GET REF/DEF TYPE
         CW,R12   =X'FFFFF'         IS DEST UNUSED DEF
         BAZ      KEEP42            YES, DO NOT KEEP
         BAL,R15  KEEP70            NO, PROCESS DEFINING TERMS
         B        KEEP42            DO NEXT
*
KEEP50   LI,R1    0                 INIT REF/DEF
         LI,R10   0                 INIT RESET FLAG COUNT
KEEP52   BAL,R15  RDNEXT            GET NEXT ITEM
         B        KEEP60            END OF STACK
         LH,R12   *R1               GET FLAG
         CI,R12   X'8000'           IS DELETE FLAG SET
         BANZ     KEEP52            YES, DO NEXT
         AND,R12  =X'F'             NO, MASK TYPE
         CI,R12   0                 IS IT A DEF
         BE       KEEP54            YES
         CI,R12   5                 IS IT A FORW REF
         BE       KEEP54            YES
         CI,R12   7
         BE       KEEP54            YES
         B        KEEP52
KEEP54   LW,R14   R1                SAVE REF/DEF DISP
         LI,R1    0                 INIT EXPR SCAN
KEEP56   BAL,R15  EXNEXT            GET NEXT EXPR
         B        KEEP58            END OF STACK, NO DEFINITION
         CW,R8    R14               DOES DEST POINT TO REF/DEF ITEM
         BNE      KEEP56            NO, DO NEXT
         BAL,R15  KEEP70            YES, PROCESS DEFINING TERMS
KEEP58   LW,R1    R14               RESTORE REF/DEF DISP
         B        KEEP52            DO NEXT REF/DEF ITEM
*
KEEP60   CI,R10   0                 ANY FLAGS RESET THIS PASS
         BE       DEL50             NO, GO TO DELETE PROCESSOR
         B        KEEP50            YES, MAKE ANOTHER PASS
*
*                             DEFINING TERMS PROCESSOR
*                               - R10, COUNT OF FLAGS RESET
*                               -   BAL,R15   KEEP70
*
KEEP70   STW,R15  KEEP79            SAVE RETURN
KEEP72   BAL,R15  CBINT             GET NEXT CONTROL BYTE POINTER
         B        *KEEP79           EXPR END, RETURN
         LW,R12   *R9               GET FLAG FROM REF/DEF
         BGEZ     KEEP72            FLAG NOT SET
         AND,R12  =X'7FFFFFFF'      RESET FLAG
         STW,R12  *R9
         AI,R10   1                 INC COUNT
         B        KEEP72            DO NEXT CB
*
KEEP79   DATA     0                 TEMP FOR RETURN ADDR
         PAGE
*
* CHANGE COMMAND PROCESSOR
*
CHANGE   EQU      %
         BAL,R0   GETEXPR           GET RFDF AND EXPR STACKS
*                             BUILD LEFT HALF OF CORREL TABLE
         LI,R1    0                 INIT REF/DEF
         LI,R7    0                 INIT CORR TABLE POINTER
CHAN10   BAL,R15  RDNEXT            GET NEXT ITEM
         B        CHAN20            END OF STACK
         LW,R12   R1                ITEM ADDR
         SW,R12   RDSTRT            CONVERT TO REL DISP
         SLS,R12  16                SHIFT TO LEFT HALF
         STW,R12  *DLIST,R7         STORE IN CORR TABLE
         AI,R7    1                 INC CORR POINTER
         B        CHAN10            DO NEXT
*
CHAN20   LI,R8    SYMBOL
         BAL,R15  SYMNEX            GET NEXT SYMBOL
         B        CHAN50            END OF COMMAND
         CI,R9    X'61'             IS DELIM A /
         BNE      CHAN70            NO, ERROR
         BAL,R15  RDSRCH            YES, IS IT IN REF/DEF
         B        CHAN72            NO, ERROR
         STW,R9   R3                YES, SAVE ADDR OF NAME
         BAL,R15  RDNEXT            GET NO. OF WDS LEFT IN STACK
         STW,R13  RDLEFT            ITEM IS LAST, SET RDLEFT TO 0
         LW,R4    RDLEFT            SAVE NO. WDS LEFT IN STACK
         LI,R8    SYMBOL
         BAL,R15  SYMNEX            GET NEXT SYMBOL
         B        CHAN70            ERROR, END OF COMMAND
         CI,R9    X'6B'             IS DELIM A ,
         BE       CHAN22            YES, OK
         CI,R9    X'4B'             NO, IS IT A PERIOD
         BNE      CHAN70            NO, ERROR
CHAN22   BAL,R15  RDSRCH            YES, IS SYMBOL IN REF/DEF ALREADY
         B        %+2               NO, OK
         B        CHAN74            YES, ERROR
*
         LB,R12   SYMBOL            NEW NAME SIZE
         AI,R12   4                 CONVERT TO WORDS
         SLS,R12  -2
         LB,R13   *R3               OLD NAME SIZE
         AI,R13   4                 CONVERT TO WORDS
         SLS,R13  -2
         SW,R12   R13               COMPUTE DIFFERENCE
         BEZ      CHAN40            NONE, NO MOVE REQ
         BLZ      CHAN30            NEW NAME SMALLER
*                                   NEW NAME LARGER
         LW,R8    RDSTRT            COMPUTE OLD END ADDR
         AW,R8    RDCNT
         AI,R8    -1
         SW,R8    R4                FOR INDEXING
         LW,R9    R12               COMPUTE NEW END ADDR
         AW,R9    R8
         LW,R10   *R8,R4            MOVE STACK DOWN
         STW,R10  *R9,R4
         BDR,R4   %-2
         B        CHAN40            DONE
*
CHAN30   LW,R8    R3                COMPUTE OLD NEXT ITEM ADDR
         AW,R8    R13
         AW,R8    R4                FOR INDEXING
         LW,R9    R12               COMPUTE NEW NEXT ITEM ADDR
         AW,R9    R8
         LCW,R4   R4                NEG INDEX
         LW,R10   *R8,R4            MOVE STACK UP
         STW,R10  *R9,R4
         BIR,R4   %-2
*
CHAN40   LW,R7    R13               SET INDEX
         AW,R7    R12               ... TO NEW NAME SIZE
         AI,R3    -1                SET TO ADDR
         LW,R10   SYMBOL-1,R7       MOVE NAME
         STW,R10  *R3,R7
         BDR,R7   %-2
         AWM,R12  RDCNT             ADJUST STACK SIZE
         AI,R3    -2
         LB,R10   *R3               GET OLD ITEM WORD COUNT
         AW,R10   R12               FORM NEW COUNT
         STB,R10  *R3               RESTORE
         B        CHAN20            NEXT SYMBOL
*                             BUILD RIGHT HALF CORREL TABLE
CHAN50   LI,R1    0                 INIT REF/DEF
         LI,R7    0                 INIT CORR TABLE POINTER
CHAN52   BAL,R15  RDNEXT            GET NEXT ITEM
         B        CHAN54            END OF STACK
         LW,R12   R1                ITEM ADDR
         SW,R12   RDSTRT            MAKE IT REL DISP
         OR,R12   *DLIST,R7         MERGE LEFT HALF
         STW,R12  *DLIST,R7         RESTORE
         AI,R7    1                 INC CORR POINTER
         B        CHAN52            DO NEXT
*                             CORRELATE EXPR STACK
CHAN54   LI,R1    0                 INIT EXPR POINTER
         LI,R6    0                 INIT CORR POINTER
CHAN56   BAL,R15  EXNEXT            GET NEXT EXPR
         B        COMPROC           END OF STACK
         CI,R0    X'40'             IF IT'S A CORE EXPR, DON'T
         BANZ     CHAN58              CORREL DEST PNTR.
         SW,R8    RDSTRT            CONV DEST TO REL DISP
         BAL,R15  DEL70             CORR DEST
CHAN58   BAL,R15  CBINT             GET NEXT CONTROL BYTE
         B        CHAN56            EXPR END
         SW,R9    RDSTRT            CONV TO REL
         LW,R8    R9                SET UP ARGS
         LW,R9    R4
         BAL,R15  DEL70             CORR POINTER
         B        CHAN58            NEXT CB
*
CHAN70   LI,R8    MSG8
         BAL,R15  PRINT1            PRINT SYNTAX ERROR
         B        FIN30             EXIT
*
CHAN72   LI,R8    MSG2
         BAL,R15  PRINT             NOT IN REF/DEF
         LI,R8    SYMBOL            SKIP SYMBOL
         BAL,R15  SYMNEX
         B        CHAN50            END OF COMMAND
         B        CHAN20            DO NEXT
*
CHAN74   LI,R8    MSG9
         BAL,R15  PRINT             ALREADY IN STACK
         B        CHAN20            DO NEXT
         PAGE
*
*  BUILD COMMAND PROCESSOR
*
HEADSIZE EQU      48  BYTES
GST      EQU      7                 GLOBAL SYMBOL TABLE WORD IN HEAD
IST      EQU      8                 INTERNAL SYMBOL TABLE WORD IN HEAD
*
BUILDDST EQU      %                 BUILD DELTA SYMBOL TABLE
*                             READ HEADER RECORD
,RHEAD   M:READ   M:EI,(BUF,HEADBUF),;
                       (SIZE,HEADSIZE),;
                       (KEY,HEADKEY),;
                       WAIT
         LW,R2    HEADBUF+GST       IF GST ALREADY EXISTS,
         BNEZ     DST90               GIVE ERROR MSG AND FORGET IT.
*                             SCAN FOR OPTION
         LI,R8    -1                SET BUILD FLAG FOR SCAN
         STW,R8   BUILDFLG
         LI,R8    SYMBOL            SYMBOL ADDR
         BAL,R15  SYMNEX            SCAN FOR OPTION (LIB)
         B        DST8              NOT PRESENT
         LI,R1    1
         LB,R1    SYMBOL,R1         IS FIRST CHAR. (
         CW,R1    ='('
         BNE      DST89             NO, SYNTAX ERROR
         LB,R1    SYMBOL,R6
         CW,R1    =')'              IS LAST CHAR. )
         BNE      DST89             NO, SYNTAX ERROR
         LD,R10   SYMBOL
         SLD,R10  -16
         AND,R10  =X'FF'
         CD,R10   LIBKEY
         BNE      DST88             NO, ERROR
         MTW,2    BUILDFLG            SET BUILDFLG=1  (INCLUDE LIB DEFS)
*
DST8     RES
         BAL,R0   FINISHER          WRITE UPDATED STACKS IF REQUIRED
         BAL,R0   GETRFDF           GET RFDF STACK
         AI,R9    -3                SET GST BUFFER ADDRESS
         STW,R9   GSTSTART          ESTABLISH GST START LOC
         STW,R9   GSTEND            INITIALIZE GST END LOC
*                             SWEEP RD STACK TO BUILD GST
         LI,R1    0                 INITIALIZE RD PNTR
DST20    BAL,R15  RDNEXT            LOOK AT NEXT RD ITEM
         B        DST50              (END OF RD ITEMS)
         LW,R11   =X'000F0001'
         MTW,0    BUILDFLG            INCLUDE LIBRARY DEFS
         BLZ      DST22               NO
         LW,R11   =X'000F0000'
DST22    CW,R11   0,R1
         BAZ      DST24
         AND,R11  =X'000B0000'      IS THIS A TYPE B DSECT
         CS,R11   0,R1
         BE       DST24
         AND,R11  =X'00030000'      IS THIS A TYPE 3 DSECT
         CS,R11   0,R1
         BNE      DST20
*        FORM GST TABLE
DST24    LCI      2                 GET FIRST TWO WORDS
         LM,R8    3,R1              OF SYMBOL
         LB,R7    R8                GET COUNT
         AI,R7    -7                PREPARE TO ZERO FILL
         BGEZ     DST40             NO NEED
         LI,R10   0
         STB,R10  R10,R7
         BIR,R7   %-1
*                             ADD IT ON TO GST
DST40    AND,R8   =X'3FFFFFFF'      SET TYPE CODE (BITS 0,1)
         AW,R8    =X'40000000'        TO 'LOCATION' TYPE (01).
         LW,R2    GSTEND            GET CURRENT END OF GST ADR
         STW,R8   0,R2              PUT OUT TYPE CODE AND SYMBOL NAME
         STW,R9   1,R2
         BAL,R15  RESCOM            GET VALUE OF SYMBOL (FROM R1 PNTR)
         CI,R11   X'40'             IS IT A CONSTANT VALUE ?
         BNE      DST43             NO
         LW,R11   =X'40000000'      YES, CHANGE TYPE CODE
         AWM,R11  0,R2                TO 'CONSTANT' TYPE (10).
         B        DST45
DST43    AND,R10  =X'1FFFF'         LOCATION TYPE, SET UP ADDRESS
         AW,R10   =X'02000000'       AND MODE/RESOLUTION TO 'WORD ADR'.
DST45    STW,R10  2,R2              STORE VALUE WORD
         MTW,3    GSTEND            BUMP END-OF-GST ADR
         B        DST20             PROCESS NEXT RD ITEM
*                             ALLOCATE GST LOAD LOC, SET HEAD GST WORD
DST50    LW,R3    HEADBUF+IST       IF LMN HAS AN IST, ALLOCATE GST
         AND,R3   =X'1FFFF'         IST ADDRESS
         BNEZ     DST53               JUST BELOW IT -
         LI,R3    JSPVP             ELSE, PUT IT AT DELTA LOWER LIMIT
         SLS,R3   9
DST53    EQU      %                 R3 = GST END LOC
         LW,R2    GSTEND
         SW,R2    GSTSTART          R2 = GST SIZE (WORDS)
         BEZ      DST91             NOTHING THERE
         STW,R13  RDCNT             ZAP RFDF STACK
         SW,R3    R2                R3 = GST START LOC
         SLS,R2   2
         STW,R2   GSTSIZE           SAVE GST SIZE (BYTES) FOR WRITE
         SLS,R2   15                FORM GST INFO WORD FOR HEAD:
         OR,R3    R2                    SIZE (15 BITS) + LOC (17 BITS)
         STW,R3   HEADBUF+GST       STORE INFO WORD IN HEAD
*                             WRITE OUT HEAD AND GST
,WHEAD   M:WRITE  M:EI,(BUF,HEADBUF),(SIZE,HEADSIZE),(KEY,HEADKEY)
         LB,R6    TREE+1            GEN KEY
         LI,R10   X'09'             = LMN NAME FOLLOWED BY X'09' BYTE
         STB,R10  TREE+1,R6
         M:WRITE  M:EI,(BUF,*GSTSTART),(SIZE,*GSTSIZE),;
                       (KEY,TREE+1),(ONEWKEY),WAIT
         M:FP     255               FREE THE BUFFER
         LW,R8    HEADBUF+5         WAS IT AN OVLAY PROGRAM
         AND,R8   =X'FFFF'
         CI,R8    X'C'
         BG       DST87             YES, NOTIFY USER
         B        COMPROC           DONE
*                             ERRORS
DST87    LI,R8    MSG16             OVLAY PROGRAM
         B        DST99
DST89    LI,R8    MSG8              BAD SYNTAX
         B        DST99
DST90    LI,R8    MSG12             DST ALREADY EXISTS
         B        DST99
DST91    LI,R8    MSG13             DST EMPTY
         B        DST99
DST88    LI,R8    MSG15
         B        DST99
DST92    LI,R8    MSG14             NO DST TO DISCARD
DST99    BAL,R15  PRINT1            PRINT ERROR MESSAGE
         B        COMPROC           GO SCAN NEXT COMMAND
*
GSTSTART RES      1                 START ADR OF GST
GSTEND   RES      1                 END ADR OF GST
GSTSIZE  RES      1                 SIZE (IN BYTES) OF GST
*
HEADBUF  RES,1    HEADSIZE          BUFFER FOR HEAD RECORD
HEADKEY  TEXTC    'HEAD'            KEY FOR READING/WRITING HEAD RECORD
BUILDFLG DATA     0                 BUILD COMMAND FLAG
         BOUND    8
LIBKEY   DATA     X'4D',X'D3C9C25D'
         PAGE
*
*  DISCARD COMMAND PROCESSOR
*
DISCARD  EQU      %                 DISCARD DELTA SYMBOL TABLE
         CAL1,1   RHEAD             READ HEAD RECORD
         LI,R2    0                 ZERO THE GST INFO WORD
         XW,R2    HEADBUF+GST       IF THERE WAS NO GST IN LM,
         BEZ      DST92               GIVE ERROR MSG AND FORGET IT.
         CAL1,1   WHEAD             WRITE HEAD RECORD BACK OUT
         LB,R2    TREE+1
         LI,R3    X'09'
         STB,R3   TREE+1,R2         MAKE KEY FOR SYMBOL TBL RECORD
         M:DELREC M:EI,(KEY,TREE+1) AND DELETE IT FROM THE LOAD MODULE
         B        COMPROC           DONE
         PAGE
*
* LIST COMMAND PROCESSOR
*
LIST     EQU      %
         BAL,R0   GETRFDF           GET REFDEF STACK
         LW,R0    J:JIT             IF USER IS ON LINE,
         BLZ      %+2                 DON'T UPSPACE.
         M:DEVICE M:LO,(PAGE)       TOP OF FORM
         LI,R1    0                 INIT REF/DEF
LIST10   BAL,R15  RDNEXT            GET NEXT ITEM
         B        LIST12            END OF STACK
         LH,R7    *R1               TYPE
         AND,R7   =X'7'             MASK
         B        %+1,R7            BRANCH TO PROPER ROUTINE
         B        LIST20            DEF  0
         B        LIST30            SREF 1
         B        LIST32            PREF 2
         B        LIST40            DSEC 3
         B        LIST42            CSEC 4
         B        LIST10            FREF 5   IGNORE
         B        LIST42            CSEC 6
         B        LIST10            FREF 7   IGNORE
*
LIST12   EQU      %
         LW,R0    J:JIT             IF USER IS ON LINE,
         BLZ      COMPROC             DON'T UPSPACE, GET NEXT COMMAND.
         M:DEVICE M:LO,(PAGE)       TOP OF FORM
         B        COMPROC           NEXT COMMAND
*
LIST20   LW,R12   *R1               GET FLAGS
         CI,R12   1                 IS IF LDEF
         BAZ      %+3               NO
         LW,R12   =C'LDEF'          YES, GET LABEL
         B        LIST22
         CI,R12   2                 IS IT UDEF
         BANZ     %+3               NO
         LW,R12   =C'UDEF'          YES, GET LABEL
         B        %+2
         LW,R12   =C' DEF'          DEF LABEL
LIST22   BAL,R15  LIST70            MOVE NAME, BLANK VALUE AND BYTE DISP
         LH,R12   *R1               GET DEFINED FLAG
         CI,R12   X'10'             IS IT DEFINED
         BAZ      %+2               NO
LIST24   BAL,R15  RESCOM            DETERM RES, STORE VALUE
         LI,R8    MAPBUF
         BAL,R15  PRINT1            PRINT LINE
         B        LIST10
*
LIST30   LW,R12   =C'SREF'          GET LABEL
         B        LIST22
LIST32   LW,R12   =C'PREF'          GET LABEL
         B        LIST22
*
LIST40   LW,R12   =C'DSEC'          GET LABEL
         B        LIST22
LIST42   LW,R12   *R1
         CI,R12   X'FFFF'           IS CSEC SIZE 0
         BAZ      LIST10            YES, IGNORE
         LW,R12   2,R1              GET RES
         CI,R12   X'100'            IS RES WORD
         BNE      LIST10            NO, IGNORE
         LW,R12   =C'CSEC'          YES, GET LABEL
         B        LIST22
*
*                             FORMATTING SUBROUTINE
*                               - MOVE NAME TO SYMBOL AREA
*                               - BLANK VALUE, ETC.
*                               - COMPUTE TEXTC COUNT
*                               -   BAL,R15  LIST70
*
*                                   REGS USED - 1,5,6,7,12,13,15
*
LIST70   LW,R13   =C'    '          BLANKS
         STW,R12  MAPBUF+1          TYPE LABEL
         STW,R13  MAPBUF+2          VALUE
         STW,R13  MAPBUF+3
         STW,R13  MAPBUF+4          BYTE OFFSET
         LI,R7    20                CHAR COUNT
         CW,R12   =C'CSEC'          IS TYPE CSEC
         BE       LIST74            YES
         LI,R6    16                NO, MOVE NAME
         LW,R5    R1
         AI,R5    2                 FORM FROM ADDR
         LW,R12   *R5,R6
         STW,R12  SYMBOL-1,R6
         BDR,R6   %-2
         LB,R12   SYMBOL            GET NAME SIZE
         AW,R7    R12               ADD REST
LIST74   STB,R13  SYMBOL            BLANK COUNT
         STB,R7   MAPBUF            STORE COUNT
         B        *R15              RETURN
         PAGE
*
* RESCOM  - DETERMINE RESOLUTION, STORE VALUE AND BYTE DISP
*
*        BAL,R15  RESCOM  (R1 HAS REF/DEF ITEM ADDR)
*
*                 REGS USED - 4,5,6,7,8,9,10,11,12,14,15
*
RESCOM   STW,R15  R14               SAVE RETURN ADDR
         LI,R4    1                 INDEX FOR BYTE DISP
         LI,R5    4                 RES BYTE COUNT
         LW,R10   1,R1              GET VALUE
         LW,R7    2,R1              GET RES
RESCOM1  STB,R7   R8                GET NEXT RES
         SAS,R8   -24               EXTEND SIGN
         LAW,R8   R8                MAKE ABS
         CI,R8    1                 IS MAGNITUDE 1
         BL       RESCOM2           ZERO, DO NEXT
         BG       RESCOM3           MULTIPLE RES, TREAT AS CONST
         CI,R7    X'FFF00'          ONE, ARE OTHERS ZERO
         BAZ      RESCOM4           YES, RES IS OK
         B        RESCOM3           NO, RES MIXED, TREAT AS CONST
RESCOM2  SLS,R7   -8                SHIFT TO NEXT RES CODE
         BDR,R5   RESCOM1           PROCESS IT
RESCOM3  LI,R11   X'40'             BLANK FOR BYTE DISP
         B        RESCOM5
RESCOM4  LI,R11   0                 CLEAR R11
         SLS,R10  -1,R5             SHIFT VALUE TO BYTES
         SLD,R10  -2                SAVE BYTE DISP
         SCS,R11  2                 SHIFT TO LOW ORDER
         AI,R11   X'F0'             CONVERT TO EBCDIC
RESCOM5  STB,R11  MAPBUF+4,R4       STORE
         LW,R7    R10               VALUE
         BAL,R15  HEXBCD            CONVERT TO EBCDIC
         STW,R8   MAPBUF+2          STORE
         STW,R9   MAPBUF+3
         B        *R14
         PAGE
*
* HEXBCD  - CONVERTS A HEX VALUE TO EBCDIC FOR OUTPUT
*         - LOAD VALUE INTO R7
*         - RESULT IN R8 AND R9, LEADING ZEROS SUPPRESSED
*
*        BAL,R15  HEXBCD
*
*                 REGS USED - 5,6,7,8,9,12,15
*
HEXBCD   LI,R12   X'40'             SET LEADING 0 TO BLANK
         STB,R12  HEXBCD9
         LI,R5    -1                SET BYTE COUNT
HEXBCD1  AI,R5    1                 INC BYTE COUNT
         LI,R6    0                 CLEAR R6
         SLD,R6   4                 GET NEXT DIGIT
         CI,R6    0                 IS IT 0
         BE       HEXBCD2           YES, DO NOT CHANGE BLANK
         LI,R12   X'F0'             NO, CHANGE 0 TO EBCDIC 0
         STB,R12  HEXBCD9
HEXBCD2  LB,R12   HEXBCD9,R6        GET EBCDIC EQUIV
         STB,R12  R8,R5             STORE
         CI,R5    7                 IS IT LAST DIGIT
         BL       HEXBCD1           NO, DO NEXT
         CI,R12   X'40'             WAS LAST CHAR STORED A BLANK
         BNE      *R15              NO, RETURN
         LI,R12   X'F0'             YES, SET IT TO EBCDIC 0
         STB,R12  R8,R5
         B        *R15              RETURN
*
HEXBCD9  TEXT     '0123456789ABCDEF'
         PAGE
*
* TERMINATION ROUTINE - ENTERED ON ABNORMAL READ
*
FINISH   EQU      %
         BAL,R0   FINISHER          WRITE UPDATED PARTS
         M:EXIT                     AND RETURN TO MONITOR
*
FINISHER LI,R8    0                 ZAP EXPR STACK INDICATOR
         XW,R8    DLIST
         BEZ      FIN10             NONE HERE, DONT WRITE
         LW,R8    EXCNT             NO
         STH,R8   TREE+9            STORE NEW EXPR STACK SIZE
         LI,R12   1                 SET UP KEY NAME FOR  XPR STACK
         LB,R7    TREE+1
         STB,R12  TREE+1,R7
         SLS,R8   2                 CONVERT SIZE TO BYTES
         LW,R9    EXSTRT            GET BUF ADDR
*                             WRITE EXPR STACK
,OUTFIL  M:WRITE  M:EI,(BUF,*R9),(SIZE,*R8),(KEY,TREE+1)
FIN10    LI,R8    0                 TRY REFDEF STACK
         XW,R8    RDCNT
         BEZ      FIN15             NONE HERE EITHER
         STH,R8   TREE+7            STORE NEW REF/DEF SIZE
         LI,R12   0
         LB,R7    TREE+1            GET KEY SIZE
         STB,R12  TREE+1,R7         SET SUFFIX TO 0
         SLS,R8   2                 CONVERT SIZE TO BYTES
         LW,R9    RDSTRT            GET BUF ADDR
*                             WRITE REF/DEF STACK
         CAL1,1   OUTFIL            M:WRITE
FIN15    RES
         MTB,-1   TREE+1            RESET SEG NAME SIZE
*                             WRITE TREE
         LW,R8    HEADBUF+5         GET SIZE OF TREE RECD. FROM HEAD
         AND,R8   =X'FFFF'          MASK
         SLS,R8   2                 CONVERT SIZE TO BYTES
         M:WRITE  M:EI,(BUF,TREE),(SIZE,*R8),(KEY,TREEKEY),WAIT
         MTB,1    TREE+1            RESTORE KEY
         M:FP     255               AND BUFFER
         B        *R0
*
FIN20    LI,R8    MSG7              PRINT BAD COMMAND MESSAGE
         BAL,R15  PRINT1
FIN30    M:XXX                      TAKE ABORT EXIT
WRONG    LW,R7    R10               DISPLAY R10 ON I/O ERROR
         BAL,R15  HEXBCD
         LCI      2
         STM,R8   MSG11+4
         LI,R8    MSG11
         B        FIN20+1
BADLMN   LI,R8    BADLMSG
         B        FIN20+1
NOTLMN   LI,R8    NOTLMSG
         B        FIN20+1
         PAGE
*
* RDSRCH  - LOCATE SYMBOL IN REF/DEF STACK
*         - ADDR OF SYMBOL IN R8
*
*        BAL,R15  RDSRCH
*         (NOT IN STACK)
*         (NORMAL RETURN, TYPE CODE IN R10, DISP IN R1)
*
*                 REGS USED - 1,8,9,10,12,14,15
*
RDSRCH   STW,R15  R14               SAVE RETURN ADDR
         LI,R1    0                 INIT REF/DEF
RDSRCH1  BAL,R15  RDNEXT            GET NEXT ITEM
         B        *R14              NAME NOT FOUND
         LH,R10   *R1               GET TYPE
         AND,R10  =X'7'             MASK
         CI,R10   3                 DOES ITEM HAVE NAME
         BG       RDSRCH1           NO, DO NEXT ITEM
         LW,R9    R1                YES, COMPARE IT
         AI,R9    3                 FORM ADDR OF ITEM NAME
         BAL,R15  TEXCOM            COMPARE
         B        RDSRCH1           NOT SAME, DO NEXT ITEM
         AI,R14   1                 SAME, INC RETURN ADDR
         B        *R14              RETURN
         PAGE
*
* TEXCOM  - COMPARE TWO TEXTC NAMES
*         - ADDR OF FIRST NAME IN R8
*         - ADDR OF SECOND IN R9
*
*        BAL,R15  TEXCOM
*         (NOT EQUAL)
*         (EQUAL)
*
*                 REGS USED - 7,8,9,12,15
*
TEXCOM   LB,R7    *R8               GET BYTE COUNT 1
         CB,R7    *R9               DOES IT EQUAL BYTE COUNT 2
         BNE      *R15              NO, RETURN
TEXCOM1  LB,R12   *R8,R7            GET NEXT CHAR OF NAME 1
         CB,R12   *R9,R7            DOES IT EQUAL NAME 2
         BNE      *R15              NO, RETURN
         BDR,R7   TEXCOM1           YES, DEC INDEX
         AI,R15   1                 NAMES COMPARE, INC RETURN ADDR
         B        *R15              RETURN
         PAGE
*
* RDNEXT  - SET R1 TO NEXT ITEM IN REF/DEF STACK
*         - IF R1 IS 0, SET IT TO START OF STACK
*
*        BAL,R15  RDNEXT
*         (END OF STACK)
*         (NORMAL RETURN)
*
*                 REGS USED - 1,12,13,15
*
RDNEXT   CI,R1    0                 IS R1 0
         BNE      RDNEXT1           NO
         LW,R1    RDSTRT            YES, SET R1 TO START OF REF/DEF
         LW,R12   RDCNT             INIT NO. OF WORDS LEFT
         STW,R12  RDLEFT
         B        RDNEXT2
RDNEXT1  LB,R12   RDNEXT9           GET ITEM WORD COUNT
         AND,R12  =X'7F'            MASK VALUE
         AW,R1    R12               ADD COUNT TO POINTER
         LW,R13   RDLEFT
         SW,R13   R12               DEC NO. WORDS LEFT
         CI,R13   0                 IS IT 0
         BE       *R15              YES, RETURN
         STW,R13  RDLEFT            NO, RESTORE NO. LEFT
RDNEXT2  LW,R12   *R1               SAVE WORD COUNT
         STW,R12  RDNEXT9
         AI,R15   1                 INC RETURN ADDR
         B        *R15              RETURN
*
RDNEXT9  DATA     0                 PREVIOUS WORD COUNT
RDSTRT   DATA     0                 STARTING ADDR OF REF/DEF
RDCNT    DATA     0                 SIZE OF REF/DEF (WORDS)
RDLEFT   DATA     0                 NO. WDS LEFT IN REF/DEF
         PAGE
*
* EXNEXT  - SET R1 TO NEXT ITEM IN EXPR STACK
*         - IF R1 IS 0, SET IT TO START OF STACK
*         - THE CONTROL BYTE INTERPRETER IS INITIALIZED
*         -  (R3 IS THE CONTROL BYTE DISP, R4 POINTS TO WORD N)
*
*        BAL,R15  EXNEXT
*         (END OF STACK)
*         (NORMAL RETURN, DESTINATION IN R8, ITS LOC IN R9,
*                         EXPR FLAGS IN R0)
*
*                 REGS USED - 0,1,3,4,8,9,12,13,15
*
EXNEXT   CI,R1    0                 IS R1 0
         BNE      EXNEXT1           NO
         LW,R1    EXSTRT            YES, SET R1 TO START OF EXPR STACK
         LW,R12   EXCNT             INIT NO. OF WORDS LEFT
         BEZ      *R15              STACK VOID, RETURN
         STW,R12  EXLEFT
         B        EXNEXT2
EXNEXT1  LB,R12   EXNEXT9           GET ITEM WORD COUNT
         AW,R1    R12               ADD COUNT TO POINTER
         LW,R13   EXLEFT
         SW,R13   R12               DEC NO. WORDS LEFT
         CI,R13   0                 IS IT 0
         BE       *R15              YES, RETURN
         STW,R13  EXLEFT            NO, RESTORE NO. LEFT
EXNEXT2  LI,R3    2                 INIT CONTROL BYTE DISP
         LH,R4    *R1               GET WORD 1 DISP
         AND,R4   =X'3F'            MASK
         AI,R4    -2                POINTS TO DEST
         AW,R4    R1                ADD ITEM START
         LW,R9    R4                DEST POINTER IN R9
         AI,R4    1                 R4 POINTS TO WORD BEFORE WORD 1
         LW,R8    *R9               GET DESTINATION
         LH,R0    *R1               GET FLAGS ('CORE' AND 'EVAL')
         AND,R8   =X'FFFF'          MASK
         AW,R8    RDSTRT            MAKE IT ABSOLUTE
         LW,R12   *R1               SAVE WORD COUNT
         STW,R12  EXNEXT9
         AI,R15   1                 INC RETURN ADDR
         B        *R15              RETURN
*
EXNEXT9  DATA     0                 PREVIOUS WORD COUNT
EXSTRT   DATA     0                 STARTING ADDR OF EXPR STACK
EXCNT    DATA     0                 SIZE OF EXPR STACK (WORDS)
EXLEFT   DATA     0                 NO. WDS LEFT IN EXPR STACK
         PAGE
*
* CBINT  - EXPR STACK CONTROL BYTE INTERPRETER
*        - SKIPS TERMS WHICH DO NOT POINT TO REF/DEF STACK
*
*        BAL,R15  CBINT
*         (EXPRESSION END)
*         (NORMAL RETURN, POINTER IN R9)
*
*                 REGS USED - 1,3,4,9,12,15
*
CBINT    LB,R12   *R1,R3            GET NEXT CONTROL BYTE
         AI,R3    1                 INC CB POINTER
         CI,R12   2                 IS IT EXPR END
         BE       *R15              YES, RETURN
         CI,R12   1                 NO, IS IT CONSTANT
         BNE      %+3               NO
         AI,R4    1                 YES, INC WORD POINTER
         B        CBINT
         AND,R12  =X'F0'            MASK CB
         CI,R12   X'20'             DOES IT POINT TO REF/DEF
         BNE      CBINT             NO
         AI,R4    1                 YES, INC WORD POINTER
         LW,R9    *R4               GET POINTER TO REF/DEF
         AND,R9   =X'FFFF'          MASK
         AW,R9    RDSTRT            MAKE IT ABSOLUTE
         AI,R15   1                 INC RETURN ADDR
         B        *R15              RETURN
         PAGE
*
* PRINT  - PRINTS SYMBOL WITH MESSAGE (BOTH IN TEXTC FORM)
*        - MESSAGE ADDR IN R8
*
*        BAL,R15  PRINT    SYMBOL AND MESSAGE (2 LINES)
*
*        BAL,R15  PRINT1   MESSAGE ONLY
*
*                 REGS USED - 8,9,15
*
PRINT    STW,R8   PRINT9            SAVE ARG
         LI,R8    SYMBOL            ADDR OF SYMBOL
         LB,R9    SYMBOL            SIZE
,PRTL    M:WRITE  M:LO,(BUF,*R8),(SIZE,*R9),(WAIT),(BTD,1)
         LW,R8    PRINT9            RESTORE ARG
*
PRINT1   LB,R9    *R8               SIZE
         CAL1,1   PRTL              PRINT MESSAGE
         M:CLOSE  M:LO,(SAVE)
         B        *R15              RETURN
*
PRINT9   DATA     0                 TEMP
         PAGE
*
* SPACE  - UPSPACES NO. OF LINES GIVEN IN R7
*
*        BAL,R15  SPACE
*
*                 REGS USED - 7,8,9,14,15
*
SPACE    LI,R8    =X'03404040'      ADDR OF NULL LINE
         STW,R15  R14               SAVE RETURN
         BAL,R15  PRINT1            UPSPACE
         BDR,R7   %-1
         B        *R14              RETURN
         PAGE
*
* MESSAGES
*
MSG0     TEXTC    'SYMCON HERE'
MSG1     TEXTC    '...USED IN UNEVALUATED EXPRESSION, NOT DELETED'
MSG2     TEXTC    '...NOT FOUND IN REF/DEF STACK'
MSG3     TEXTC    'NO DELETIONS RESULTED FROM THIS COMMAND'
MSG4     TEXTC    '...APPEARS AS TYPE OTHER THAN DEF, NO ACTION'
MSG5     TEXTC    'THESE SYMBOLS WERE DELETED...'
MSG6     TEXTC    'REQUIRED CORE SPACE NOT AVAILABLE'
MSG7     TEXTC    'INCOMPLETE COMMAND, LOAD MODULE UNCHANGED'
MSG8     TEXTC    'INCORRECT SYNTAX'
MSG9     TEXTC    '...ALREADY IN STACK, CHANGE NOT MADE'
MSG10    TEXTC    'COMMAND CONTAINS ILLEGAL CHARACTER'
MSG11    TEXTC    'M:EI I/O ERR:  XXXXXXXX'
MSG12    TEXTC    'DELTA SYMBOL TABLE ALREADY IN LOAD MODULE, ',;
                  'NO ACTION TAKEN'
MSG13    TEXTC    'NO SYMBOLS FOR DELTA SYMBOL TABLE, TABLE NOT BUILT'
MSG14    TEXTC    'NO DELTA SYMBOL TABLE TO DISCARD, NO ACTION TAKEN'
MSG15    TEXTC    'ILLEGAL OPTION'
MSG16    TEXTC    'OVERLAY PROGRAM, DELTA SYMBOL TABLE BUILT FOR',;
                  ' ROOT ONLY'
EH       TEXTC    'EH?'
BADLMSG  TEXTC    'CAN''T USE SYMCON ON LINK OR LIBRARY LOAD MODULES'
NOTLMSG  TEXTC    'INPUT M:EI FILE IS NOT A LOAD MODULE'
*
         END      SYMCON

