         SYSTEM   UTS
*        704776   SIGMN 5/7         BPM M:PRGMLDR
*                 SYMBOLIC REGISTER DEF'S.
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
SR1      EQU      8
SR2      EQU      9
SR3      EQU      10
SR4      EQU      11
D1       EQU      12
D2       EQU      13
D3       EQU      14
D4       EQU      15
*
K        SET      0
         CLOSE    ERROR
ERRORN   CNAME    1
ERROR    CNAME    0
         PROC
LF       LCI      2
         STM,11   LOCSTK
         LI,11       AF(2)
         LI,12       AF(1)
         DO          NAME
         OR,11    Y8
         FIN
         B           ERSUBR
         PEND
         PAGE
         REF      M:XX,F:DB
         REF      M:EI
         REF      M:DO
         REF      J:ASSIGN
         REF      J:BUP,J:JIT,J:ACCN
         REF      J:EUP
         REF      JBPCP
         DEF      DP,DB
         DEF      RPATCH
         CSECT    0
DP       EQU      %
         RES      12
LMFPT    EQU      %-DP
         GEN,8,24 X'10',M:XX
         DATA     X'F8000010'
         DATA     LMER
         DATA     LMAB
         DATA     DP                BUF
         DATA     48                SIZ
         DATA     LMHEAD            KEY
LMHEAD   EQU      %-DP
         TEXTC    'HEAD'
LMTREE   EQU      %-DP
         TEXTC    'TREE'
RFDFKEY  EQU      %-DP
         DATA     0,0,0,0
RDSEGF   EQU      %-DP
         GEN,8,24 X'10',M:XX
         DATA     X'F8000010'
         DATA     SGER
         DATA     SGAB
         DATA     0                 BUF
         DATA     0                 SIZE
         DATA     RFDFKEY+DP        KEY
ODBFPT   EQU      %-DP
         GEN,8,24 X'14',F:DB
         DATA     X'E7000001'
         DATA     DBER
         DATA     DBAB
         DATA     DP+X'100'
         DATA     2                 ORG  KEYED
         DATA     2                 ACCESS- DIR
         DATA     4
FPAR     EQU      %
         DATA     X'01000101'
         DATA     0                 NAME
         DATA     X'02010202'
         DATA     0,0
RDDBFPT  EQU      %-DP
         GEN,8,24 X'10',F:DB
         DATA     X'F0000010'
         DATA     DBER
         DATA     DBAB
         DATA     DP+X'100'
         DATA     80
DELETE   GEN,8,24 X'0D',F:DB
         DATA     0
GVPFPT   EQU      %-DP
         DATA     X'8400000F'       PG ADR IN 15
FVPFPT   EQU      %-DP
         DATA     X'8500000F'
GCPFPT   EQU      %-DP
         DATA     X'8C000005'       # OF PGS IN 5
FCPFPT   EQU      %-DP
         DATA     X'8D000005'
CPGN     EQU      %-DP
         DATA     0                 # OF COMMON PGS REQ
RFDFTOP  EQU      %-DP
         DATA     0                 TOP OF RFDF AREA + 1
SYMBC    EQU      %-DP
         DATA     0
TBLSZ    DATA     0
CLBTBSZ  DATA     0
         BOUND    8
DATALIM  DATA     0,0
PPLIM    DATA     0,0
ALLLIM   DATA     0,0
BADNAME  DATA     0
TMP      RES      5
PMDBUF   RES      9
M2       DATA     3
M8       DATA     X'FF'
YFFFE    DATA     X'FFFE0000'
Y8       DATA     X'80000000'
M9       DATA     X'1FF'
M16      DATA     X'FFFF'
M17      DATA     X'1FFFF'
M24      DATA     X'00FFFFFF'
XF0      DATA     X'F0'
XC0      DATA     X'C0'
YFF      DATA     X'FF000000'
Y002     DATA     X'00200000'
Y06      DATA     X'06000000'
X1FE00   DATA     X'1FE00'
XFF00    DATA     X'FF00'
03ZD     DATA     X'030000C4'
LSTFLG   DATA     0
ENDCLPG  DATA     0
NXTAVPG  DATA     0
RFDF     DATA     0
RFDFS    DATA     0
CAL      DATA     X'04300000'
BP1      DATA     X'68000001'
DBGMSK   DATA     X'8001FFFF'
LW       DATA     X'72000000'
         DATA     X'52000000'
         DATA     X'32000000'
         DATA     X'12000000'
B        DATA     X'69200000'
         DATA     X'69100000'
         DATA     X'68300000'
         DATA     X'68100000'
         DATA     X'68200000'
         DATA     X'69300000'
WBUG     GEN,8,24 X'11',F:DB
         DATA     X'38000053'
         DATA     X'80000007',36,KEYRES
CDBFPT   GEN,8,24 X'15',F:DB
         DATA     X'80000000'
         DATA     2                 SAVE
BEGFPT   EQU      %
         GEN,8,24 X'1C',F:DB
         DATA     X'10'
KEYRES   RES      3
OPEN     GEN,8,24 X'14',M:EI
         DATA     X'C7480001'
         DATA     ERRADD            ERROR ADDRESS
         DATA     ABNADD            ABNORMAL ADDRESS (OPEN)
         DATA     2                 KEYED FILE
         DATA     2                 DIRECT ACCESS
         DATA     1                 IN MODE
         DATA     2                 SAVE
         DATA     4                 MAXIMUM KEY SIZE
         DATA     X'01000202'
         TEXTC    'ERRMSG'          FILE NAME
         DATA     X'02010202'
         TEXT     ':SYS    '        ACCOUNT
READ     GEN,8,24 X'10',M:EI
         DATA     X'78000000'
         DATA     ABNREAD           ABNORMAL ADDRESS (READ)
         DATA     ERRBUF            BUFFER ADDRESS
         DATA     80                BUFFER SIZE
         DATA     KEY               KEY ADDRESS
KEY      DATA     0
CLOSE    GEN,8,24 X'15',M:EI
         DATA     X'80000000'
         DATA     2                 SAVE THE FILE
WRITERR  GEN,8,7,17 X'11',0,M:DO    WRITE ERROR MESSAGE TO PRINTER
         GEN,4,28 3,0
         DATA     ERRBUF            BUFFER ADDRESS
         DATA     80                BUFFER SIZE
SAVERR   DATA     0
SAVABN   DATA     0
ERRFLAG  DATA     0                 ERROR FLAG
ERRTN    RES      1
LOCSTK   RES      16
ERRBUF   RES      70                ERROR MESSAGE BUFFER
RPATCH   RES      X'1E0'-%+DP
RUN      EQU      %
         RES      X'20'
         PAGE
*
*                 ENTER WITH WD IN STACK POINTING TO RUN TABLE
*        IN PG EUP WHERE CCI LEFT IT.  MOVE IT INTO RUNNERS CONTEXT
*        PG (EUP+1) AND RELEASE PG.  EXIT WITH DB AND CL TABLES
*        IN APPRO PG OF USERS PURE P AREA WITH HEADER AT BEG OF
*        CONTEXT PG REFLECTING THESE ADDED PURE P WDS.  AND WITH
*        TREE WD 10S AT END OF THE CONTEXT PG.
*
*                 1) WD10 OF THE TREE IS SAVED AT THE
*        TOP OF RUNNER'S CONTEXT PG & STEP
*        LATER READS THE HEAD & TREE INTO
*        THIS PG (& CAN'T WIPE OUT THESE WD10'S)
*        THEN WE KNOW TREE SIZE IS LIMITED
*        TO LESS THAN ONE PG.   2) THE MANUAL
*        INDICATES DEGUBS FPTS (& I ASSUME
*        THIS INCLUDES THIS CLOBBER TABLE) CAN'T
*        BE GREATER THAN A PG. THIS
*        PROGRAM COULD BE MORE STRAIGHT FORWARD
*        IF IT TOOK INTO ACCT THAT TREE IS 1 PG
*        MAX AND THAT DB & CL TABLES ARE 1 PG
*        MAX RATHER THAN GOING THRU GYRATIONS
*        COMPUTING IRRELEVANT THINGS.
*
         PAGE
         CSECT    1
*
**       7  = RUN TABLE ADR
*        6  = BEG OF DATA PAGE
DB       EQU      %
*  SAVE M:XX ERR & ABN AND SET UP RUNNER'S
         LI,7     X'1FFFF'
         LW,6     M:XX+3
         STW,6    SAVERR
         LW,6     M:XX+4
         STW,6    SAVABN
         LI,6     LMER
         STS,6    M:XX+3
         STS,6    M:XX+4
* GET RUN TABLE OUT OF EUP PG
         LI,7     0
         STW,7    ERRFLAG
         PLW,6    TSTACK
         AI,6     -1
         BUMP     -19,5
         LI,5     24
         LW,8     *6,5
         STW,8    RUN-1,5
         BDR,5    %-2
         LI,7     RUN               ***FOR BTM DEBUGGING
         LI,6     DP
         LI,5     1
         CAL1,8   FCPFPT,6
* GET BYTE COUNT OF & PTR TO SYMBOLIC START
         LI,4     4*10
         LB,8     *7,4              BC OF SYMB START 0=NOT PRESENT
         STW,8    SYMBC,6
*  GET # OF DEBUGS & MODIFIES FROM RUN TABLE
         LI,1     1
         LB,2     *7,1              DEBUGS
         LI,1     2
         LB,3     *7,1              MODIFIES
*
*  READ LM HEAD
         STW,6    LMFPT+4,6         BUF ADR
         LI,8     48
         STW,8    LMFPT+5,6         SIZE
         LI,8     LMHEAD
         AW,8     6
         STW,8    LMFPT+6,6         KEY ADR
         CAL1,1   LMFPT,6           READ LM HEAD
*CHECK FOR LINKED LMN WITH PMD'S
         LW,8     0,6               FIRST RECORD OF HEAD
         SLS,8    -24
         CI,8     X'84'             IS IT LINKED?
         BNE      DB1               NO
         LI,8     0
         LI,9     X'20000'
         STS,8    J:ASSIGN          CLEAR PMD AND DEBUG FLAGS
         ERROR    X'04036C',ABORT
*  SET UP BEG LIMITS OF PROG'S DATA & PURE P
DB1      EQU      %
         LI,9     X'1FFFF'
         LW,8     3,6               BEG OF DATA
         SLS,8    1
         STS,8    DATALIM
         LW,8     4,6                      PURE P
         SLS,8    1
         STS,8    PPLIM
         LW,8     J:BUP
         LW,9     J:EUP
         SLD,8    9
         AI,9     X'1FF'
         STD,8    ALLLIM
*  ALLOCATE SPACE & SET FPT FOR LM TREE READ
         LW,8     5,6               TREE SIZE FROM HEADER
         AND,8    M16
         SLS,8    2
         STW,8    LMFPT+5,6         SIZE
         SLS,8    -2
         LW,0     6
         SW,0     8
         STW,0    LMFPT+4,6         BUF
         AI,0     1                 BEG OF TREE
**       0  = TREE ADR
*  SET PTRS & ALLOC SPACE FOR TABLES
**       12 = DEBUG TABLE ADR
**       13  = CLOBBER TABLE ADR
         LW,8     2                 DEBUGS
         AW,8     3                 MODS
         SLS,8    1                 DB+MOD*2 = CLOBBER SIZE
         LW,9     2
         SLS,9    3                 DB*8 = DB SZ
         LW,12    0
         AND,12   X1FE00
         STW,12   ENDCLPG
         STW,8    CLBTBSZ
         AW,8     9
         STW,8    TBLSZ
         CI,8     0
         BE       DB2
         AI,12    -X'200'
         LW,13    12
         AW,13    9
         AI,9     -410
         BLEZ     %+2               IF TBLS DONT FIT IN 1PG REDUCE BEG
         SW,13    9                 OF CLOB TBL TO OPTIMUM PT, BUT MAKE
*                                   CLOB TBL RUN OUT FIRST
DB2      EQU      %
         STW,12   NXTAVPG
         STW,12   RFDFTOP,6
*  ALLOCATE RFDF STK AREA
         LI,1     10
         LH,8     *6,1              MAX RFDF SZ FROM HEADER
         LW,10    12
         SW,10    8                 BEG OF RFDF STK
         SLS,10   -9
         LW,5     6
         SLS,5    -9
         SW,5     10
         STW,5    CPGN,6            # OF COMMON PGS NEEDED
         SLS,10   9
         STW,10   RFDF              BEG OF RFDF STK AREA
         CAL1,8   GCPFPT,6          GET COMMON PGS - # IN 5
         BCS,8    %
*  READ LM TREE
         LI,8     LMTREE
         AW,8     6
         STW,8    LMFPT+6,6         KEY
         CAL1,1   LMFPT,6
*  ARE THERE DEBUGS
         LI,8     0
         STW,8    LSTFLG            SET TO INDICATE NO DB & SO NO FLGTBL
         LW,3     TBLSZ             ANY DEBUGS
         BNEZ     DB3               YES
         LI,3     X'20000'
         CS,3     J:ASSIGN          ANY PMDS
         BNE      DB9               NO
*                                   *
* *      PROCESS DEBUGS             **
*                                   *
DB3      EQU      %
*  GET PG FOR FLG TABLE
         LW,15    J:BUP
         SLS,15   9
         STW,15   LSTFLG            FLG TABLE ADR
**       15 = FLAG TABLE ADR
         CAL1,8   GVPFPT,6          GET VP FOR FLG TB - ADR IN 15
         BCS,8    %
*  OPEN DEBUG RECORD
         LW,8     J:JIT
         AND,8    M16               USER ID
         SLS,8    8
         OR,8     03ZD              CNT,USERID,D
         STW,8    FPAR+1            SET UP FILE NAME
         LCI      2
         LM,8     J:ACCN
         STM,8    FPAR+3            ACCN
         LW,8     6
         AI,8     X'100'
         STW,8    ODBFPT+4,6
         CAL1,1   ODBFPT,6          OPN DB FILE
         PUSH     12,0
*************************************
* *      DEBUG LOOP                 **
*************************************
DBUG1    EQU      %
DB5      EQU      %
*  READ NXT DEBUG RECORD
         PULL     12,0
         CAL1,1   RDDBFPT,6
         CAL1,1   DELETE
*  EXIT LOOP ON EOF TO ABN AT DBAB
         LB,1     *F:DB+10          BC OF KEY
         LB,8     *F:DB+10,1        LAST BYTE OF KEY
*  INITIALIZE FOR SEG NAME SEARCH ETC
         LW,2     1
         AI,1     -1
         LB,3     *F:DB+10,2
         STB,3    KEYRES,2
         BDR,2    %-2
         STB,1    KEYRES
         CI,8     0
         BNE      DBRD7             NOT FINISHED WITH THIS SEG
         LI,4     KEYRES
         LW,5     RFDFTOP,6
         LI,14    0                 INIT CURRENT SEG IN TREE TO 0
         STW,14   RFDFS
*  READ BACK PATH RFDF STK IN
*        4  = ADR OF NAMED SEG
*        5  = TOP OF BUF AREA + 1
         BAL,11   SEGSRCH
**       14 = TREE ENTRY (FROM SEGSRCH)
         LI,2     5
         LI,3     X'FFFF'
         AND,3    *14,2
         LI,2     10
         AH,3     *14,2
         SLS,3    1
         STW,3    DATALIM+1         END OF THIS SEG'S DATA
         LI,2     7
         LI,3     X'FFFF'
         AND,3    *14,2
         LI,2     14
         AH,3     *14,2
         SLS,3    1
         STW,3    PPLIM+1           END OF THIS SEG'S PURE P
         CAL1,1   RDSEGF,6
         LI,2     10
         SLS,13   -1
         STW,13   *14,2             DA(CLOBBER TBL ADR) TO WD10 OF TREE
         SLS,13   1
DBRD6    EQU      %
         CI,4     0                 IS THERE MORE BACK PATH
         BE       DBRD7             NO
         LW,3     4                 ADR OF NAMED SEG
         LB,2     *4                BC OF NAME
         BAL,11   SSH5              SET FPT FOR NXT BACK PATH
         CAL1,1   RDSEGF,6
         B        DBRD6
DBRD7    EQU      %
         STW,5    RFDF
*  GO TO  APPRO DEBUG ROUTINE
         PUSH     12,0
         LI,5     DP+X'100'         BEG OF DEBUG RECORD
         LB,2     *5                BYTE 0 OF DB RECORD
         LI,1     0                 SET FOR SELF RELOCATING
         CI,2     1
         BLE      DBERR
         CI,2     12
         BGE      DBERR
*
*        HERE REGS CONTAIN
*        12 = DEBUG TABLE ADR - NXT ENTRY
*        13 = CLOBBER '    '     '    '
*        14 = ADR OF SEGS NAME IN TREE
*        15 = ADR OF FLG TABLE
*        5  = BEG OF DEBUG RECORD
*
*  RETURN IS TO DBUG1
*
         B        DBVECT,2
DBERR    EQU      %
         ERROR    X'04035F',DBUG1
*
DBAB     EQU      %
         LI,3     06
         CB,3     10                IS ABN CODE 06 IE. EOF
         BE       DB9               YES-END OF DBS
         ERROR    X'040362',IOABORT
*************************************
*        PROCESS SYMB START         *
*************************************
DB9      EQU      %
         CAL1,1   CDBFPT            CLOSE DB FILE
         LW,8     SYMBC,6
         BEZ      DB10              NO SYMB
*  INIT TO SET UP FOR ROOT RFDF READ
         LW,3     0
         LI,8     0
         STW,8    RFDFS
         LW,5     RFDFTOP,6
         LI,8     RFDFKEY
         AW,8     6
         STW,8    RDSEGF+6,6
         LB,2     *0                BC OF ROOT NAME
         BAL,11   SSH6              DO SEGSRCH TO SET UP FPT
         STW,5    RFDF
         CAL1,1   RDSEGF,6
         LI,5     5
         LI,3     X'FFFF'
         AND,3    *0,5
         LI,5     10
         AH,3     *0,5
         SLS,3    1
         STW,3    DATALIM+1
         LI,5     7
         LI,3     X'FFFF'
         AND,3    *0,5
         LI,5     14
         AH,3     *0,5
         SLS,3    1
         STW,3    PPLIM+1
*  START ADR TO HEADER
         LI,5     RUN+10
         LW,1     6
         PUSH     16,2
         LI,1     0                 SET FOR SELF RELOCATING
         BAL,7    LOCNAM
         B        ABG
         LB,5     RUN+10
         SLS,5    -2
         AW,6     RUN+11,5          ADD TO LOC DISP
         LI,7     X'1FFFF'
         PULL     1,1               GET BASE OF DATA
         CLM,6    DATALIM
         BCR,9    %+4
         CLM,6    PPLIM
         BCR,9    %+2
         B        ABH               START ADR NOT IN LIMITS
         STS,6    1,1               STORE START ARD INTO HEADER
         PULL     15,2
DB10     EQU      %
*  FREE FLG PG
         LW,15    LSTFLG
         BEZ      %+2
         CAL1,8   FVPFPT,6
*  FREE RFDF PGS  (GOT THEM IF EITHER DBS OR SYMB START)
         LI,1     10
         LH,5     *6,1
         SLS,5    -9
         CAL1,8   FCPFPT,6
         LCW,5    5
         AWM,5    CPGN,6            UPDATE # OF COMMON PGS STILL TO REL
*  GET PGS FOR MOVING DB & CLOB ABOVE PURE P
*  & UPDATE PURE P CNT IN HEADER
         LI,1     -1
         LW,7     *0,1
         AI,7     -2
         LI,1     X'1FF'
         LI,14    0
         STW,14   DP,1
         AI,1     -1
         AI,7     -11
         BGZ      %-3
         LW,7     TBLSZ
         BEZ      DB14              NO DBS
         LI,1     8
         LH,14    *6,1              # OF PURE P DBWDS
         LW,15    4,6               PURE P DBWD START ADR
         AW,15    14
         AI,15    -1
         SLS,15   -8
         AI,15    1                 1ST AVAIL PG FOLLOWING
         SLS,15   9
         LW,4     15                BEG OF TBLS ADR
         AI,14    X'FF'
         AND,14   XFF00
         LW,9     7
         AI,9     1
         SLS,9    -1                # OF DB & CLOB DBWDS
         AW,14    9                 # OF PURE P DBWDS
         LI,1     8
         STH,14   *6,1              UPDATE HEADER
         LI,3     JBPCP             COUNT DEBUG PAGE AS PROCEDURE
         MTB,1    J:JIT,3           **STEP WILL ADJUST FOR THIS
         LW,3     7
         AI,7     X'1FF'
         SLS,7    -9                # OF PGS TO GET
         CAL1,8   GVPFPT,6
         BCS,8    ABI
         AI,15    X'200'
         BDR,7    %-3
*  MOVE DB & CLOB TO ABOVE PURE P
         LCW,2    CLBTBSZ
         SAD,2    -1               2=-# OF CL DBWDS , 3=# OF CL + DB DBW
         AW,2     3
         LW,5     RFDFTOP,6
         AND,4    M17
         AND,5    M17
         AI,5     -2
         AI,4     -2
*  DO CL TABLE MOVE
DB11     EQU      %
         LD,8     *5,3
         CW,3     2                 IS THIS CL ENTRY
         BLE      DB116             NO, FINISHED WITH THEM
         CI,8     0
         BL       DB115             YES
         SW,9     5                 SUBST BEG OF SETUP AREA
         AW,9     4                 ADD BEG OF WHERE WILL BE IN USER
DB115    EQU      %
         STD,8    *4,3
         BDR,3    DB11
         B        DB119             DONE - NO DB TABLE
*  PREPARE FOR DEBUG TABLE MOVE
DB116    EQU      %
         AI,4     2
         AI,5     2
         SLS,3    1                 # OF WDS OF DB TBL
         B        DB118
*  DO DEBUG TABLE MOVE
DB117    EQU      %
         LCI      8
         LM,8     *5,3              GET DB TABLE ENTRY
*  CORRECT ADR FOR CHAINED PLISTS (WDO) & FOR FLAGS (WD7)
         LI,7     X'1FFFF'
         AND,7    8
         BEZ      %+3
         SW,8     5
         AW,8     4
         LW,7     Y8
         CW,7     15
         BAZ      %+3
         SW,15    5
         AW,15    4
         LCI      8
         STM,8    *4,3              MOVE IT
DB118    EQU      %
         CI,3     0
         BE       DB119             DONE
         AI,3     -8
         BGEZ     DB117
         ERROR    X'04036B',ABORT
DB119    EQU      %
*  MOVE LAST WD OF EACH SEG'S TREE TO CONTEXT AREA
         LI,1     -1
         LW,7     *0,1              TREE SIZE
         AI,7     -2
         LI,2     X'1FF'
         SLD,4    -1                MAK ADRS DW
DB12     EQU      %
         LW,8     *0,7
         BEZ      %+3
         SW,8     5                 COMPUTE DISP FROM BEG OF
*                                   TABLE WHERE BUILD BY RUNNER
         AW,8     4                 ADD LOC IN USER PURE P WHERE TBL NOW
         STW,8    *6,2
         AI,2     -1
         AI,7     -11
         BGZ      DB12
*  RELEASE REST OF PGS
DB14     EQU      %
         LW,5     CPGN,6
         BEZ      %+2
         CAL1,8   FCPFPT,6
         LW,5     ERRFLAG
         BNEZ     ABORT
         BUMP     19,5
         BAL,5    RESTADR
         CAL1,9   1
ABORT    EQU      %
         BUMP     19,5
         BAL,5    RESTADR
         CAL1,9   3
*  RESTORE M:XX ERR & ABN FOR STEP
RESTADR  EQU      %
         LI,7     X'1FFFF'
         LW,6     SAVERR
         STS,6    M:XX+3
         LW,6     SAVABN
         STS,6    M:XX+4
         B        *5
         PAGE
*************************************
*        SEGMENT SEARCH             *
*************************************
*        THIS FINDS SEG NAME IN TREE, SETS UP BUF, SIZE & KEY
*        IN FPT, & RETURNS TREE ADR OF BACK LINK
*
*        0  = TREE ADR
*        4  = ADR OF SEG NAME TO SEARCH FOR
*        5  = TOP OF RFDF BUF AREA
*        14 = RETURN WITH POINTER TO TREE NAME
*
SEGSRCH  EQU      %
         LW,3     0                 TREE ADR
         LB,2     *4                BC OF NAME 1E CNT FOR BYT STRNG COMP
         LI,1     -1
         LW,1     *0,1              TREE SIZE
SSH2     EQU      %
         CW,4     3
         BE       SSH3              SKIP TESTING NAME WITH ITSELF
*  SET UP FOR CBS
*  8  = SOURCE=NAME SEARCHING FOR
*  9  = DEST=CNT & NAME BEING TESTED FOR EQUALITY
         LW,8     4
         LW,9     3
         SLD,8    2                 BYTE ADRS
         STB,2    9
         MTB,1    9
         CBS,8    0
         BE       SSH4              FOUND NAME
SSH3     EQU      %
         AI,3     11                UP TREE ADR
         AI,1     -11               DECR # OF WDS LEFT
         BGEZ     SSH2
         ERROR    X'040366',ABORT
SSH4     EQU      %
         LW,14    3                 SET TREE ADR ONLY FOR 1ST SEG FOUND
SSH5     EQU      %
*        IF ENTRY HERE, 3= NAMED SEG ADR IN TREE
*        & 2= BC OF NAME
         LI,1     7
         LH,4     *3,1              BACK LINK DISP
         BNEZ     %+3
         CW,3     0
         BE       SSH6
         AW,4     0                 NXT NAME TO LOOK FOR
SSH6     EQU      %
         LI,1     12
         LH,8     *3,1              RFDF SIZE
         AWM,8    RFDFS
         SW,5     8
         STW,5    RDSEGF+4,6        BUF
         SLS,8    2
         STW,8    RDSEGF+5,6        SIZE
*  SET UP KEY
         AI,2     1
         LCI      3
         LM,8     *3
         STM,8    RFDFKEY,6
         LI,1     RFDFKEY
         SLS,1    2
         STB,2    *6,1
         AW,1     2
         LI,8     0
         STB,8    *6,1
         B        *11
         PAGE
LMER     EQU      %
LMAB     EQU      %
         ERROR    X'040360',IOABORT
DBER     EQU      %
         ERROR    X'040362',IOABORT
SGER     EQU      %
SGAB     EQU      %
         ERROR    X'040361',IOABORT
AB5      ERROR    X'04035D',ABORT
ABB      ERRORN   X'040358',DBUG1
ABC      ERRORN   X'040359',DBUG1
ABD      ERRORN   X'04035A',DBUG1
ABE      ERRORN   X'04035B',DBUG1
ABF      ERRORN   X'04035C',DBUG1
ABG      ERRORN   X'040363',ABORT
ABH      ERROR    X'040365',ABORT
ABI      ERROR    X'040367',ABORT
ERSUBR   EQU      %
         STW,11   ERRTN
         LCI      11
         STM,1    LOCSTK+2
         MTB,1    ERRFLAG
         BAL,11   ERRMSGE
         STW,4    WRITERR+3         PUT SIZE
         LW,6     ERRTN             GET EXIT ADR
         BGEZ     ERSUB3            FLAG ISN'T SET INDICATINGOUTPUT NAME
*        PUT BAD NAME INTO BUFFER
         AI,4     -1
         LI,6     X'40'
         STB,6    ERRBUF,4
         AI,4     1
         LW,5     BADNAME           POINTER TO BAD NAME
         LB,7     *5                GET NAME SIZE
         AW,4     7
         STW,4    WRITERR+3         SIZE TO FPT
         MTW,1    WRITERR+3
         LB,6     *5,7
         STB,6    ERRBUF,4
         AI,4     -1
         BDR,7    %-3
ERSUB3   EQU      %
         CAL1,1   WRITERR
         LCI      11
         LM,1     LOCSTK+2
         LCI      2
         LM,11    LOCSTK
         B        *ERRTN
IOABORT  EQU      %
         BAL,5    RESTADR
         OR,10    Y8
         CAL1,2   MERC              RETURN ERROR CONTROL TO MONITOR
MERC     DATA     X'10000000'
         PAGE
*
ERRMSGE  EQU      %
*
         STW,D1   KEY               STORE THE KEY
         LI,3     3
         STB,3    KEY
         LW,3     Y002
         CS,3     M:EI
         BE       %+2               ALREADY OPEN
         CAL1,1   OPEN              OPEN ERROR FILE
         CAL1,1   READ              READ RECORD
         LI,R4    4
         LW,R4    M:EI,R4           GET ACTUAL RECORD SIZE
         SLS,R4   -17               RIGHT JUSTIFY VALUE
CLOSFILE EQU      %
         LW,3     Y002
         CS,3     M:EI
         BNE      %+2
         CAL1,1   CLOSE
         B        *SR4              RETURN
*
*ALL ERROR AND ABNORMAL RETURNS ARE TREATED THE SAME
ERRADD   EQU      %
ABNADD   EQU      %
ABNREAD  EQU      %
         LI,R4    0                 INITIALIZE INDEX
GO       AND,D1   M24               MASK TO STRIP BYTE ZERO
         SLS,D1   4                 SHIFT A HALF BYTE
         LB,R2    D1                GET THAT BYTE
         CI,R2    9                 IS THE VALUE > 9
         BG       GREATER           YES:DIFFERENT CONVERSION
         OR,R2    XF0               HEX TO EBCDIC CONVERSION
         B        %+3
GREATER  OR,R2    XC0               HEX TO EBCDIC CONVERSION
         AI,R2    -9                FINISH CONVERSION
         STB,R2   ERRBUF,R4         STORE THE CONVERTED VALUE
         AI,R4    1
         CI,R4    6
         BL       GO                LOOP CONTROL
DONE     EQU      %                 CONVERSION COMPLETE
         LI,R4    6
         B        CLOSFILE
         PAGE
DBVECT   EQU      %-2
         B        MOD
         B        PMD
         B        PMD
         B        PMD
         B        SNAP
         B        SNAP
         B        IAO
         B        IAO
         B        IAO
         B        COUNT
WHATRES  AI,R5    3
         LI,R4    -4
WHATRES1 LB,SR2   *R5,R4
         BNEZ     WHATRES4,R1
         BIR,R4   WHATRES1,R1
         B        WHATRES5,R1
WHATRES2 LB,SR2   *R5,R4
         BNEZ     WHATRES5,R1
WHATRES3 BIR,R4   WHATRES2,R1
         AI,R5    -3
        B        1,R6
WHATRES4 LI,R3    2
         SW,R3    R4
         AI,R3    -4
         CI,SR2   1
         BE       WHATRES3,R1
         CI,SR2   X'FF'
         BE       WHATRES3,R1
WHATRES5 AI,R5    -3
         B        0,R6
         PAGE
MOD      EQU      %
         LCW,R0   *R5
         AI,R5    1
         AI,R0    2
         STW,5    BADNAME
         BAL,R7   FROMTOR,R1
         BAL,0    ABF,1
         CLM,10   DATALIM
         BCR,9    MOD2
         CLM,10   PPLIM
         BCR,9    MOD2
         ERRORN   X'040364',MOD2
MOD2     EQU      %
         AW,SR3   Y8
         BAL,R7   ENTCLT,R1
         B        DBUG1,R1
         PAGE
PMD      LW,SR2   *R5               SAVE PP INDICATORS
         STW,SR2  TMP+1,R1
         AI,R5    1
         STW,5    BADNAME
         BAL,R7   FROMTO,R1
         BAL,0    ABE,1
*  RETURN 10=FROM  11=TO
         CI,10    0
         BE       PMD03
         CLM,10   ALLLIM
         BCR,9    PMD03
         ERRORN   X'040368',PMD03
PMD03    EQU      %
         CI,11    0
         BE       PMD08
         CLM,11   ALLLIM
         BCR,9    PMD08
         LW,5     BADNAME
         BAL,7    PASSNAME
         AI,5     1
         STW,5    BADNAME
         ERRORN   X'040368',PMD08
PMD08    EQU      %
         LI,6     9
         LI,R5    0                 0 PP FROM TOS
         STW,5    PMDBUF-1,6
         BDR,6    %-1,1
         LW,9     TMP+1,1
         STW,9    PMDBUF            PUT 1ST WORD IN PMD
         LCI      2
         STM,10   PMDBUF+1          FROM TO INTO WDS 2 & 3
         LI,6     3                 CHECK FOR PP DUMPS
         LI,7     PMDBUF+1
       PUSH   14           SAVE TREE
PMD1     AI,R7    2
         CI,SR2   1                 CHECK BIT
         BANZ     PMDSEG,R1
PMD2     SLS,SR2  -1
         BDR,R6   PMD1,R1
         PULL  14             RESTORE TREE ADDRESS
         AI,R7    -7                BUF ADDR.
         MTB,1    KEYRES
         CAL1,1   WBUG,R1
         B        DBUG1,R1
PMDSEG   LW,R2    R6
         SLS,R2   1
         LW,5     PMDBUF            GET DUMP FLAGS
         CI,5     8                 BIT SET => NOTHING SPECIFIED
         BAZ      PMDSEG1           DONT DUMP ALL
         CI,2     2
         BNE      %+2               DATA NOT THERE YET
         AI,2     1                 SET DATA
         LW,14    DP                USE HEAD LIMITS, NOT TREE
         B        PMDSEG1+1
PMDSEG1  AI,2     3
         INT,R4   *D3,R2            GET PROT TYPE BOUNDS FROM TREE
         LW,R4    *D3,R2
         SLS,R4   -16               4 = SIZE
         SLD,R4   1                 R5 = BASE
         AW,R4    R5
         XW,R4    R5
         AI,R5    -1
         CI,6     1                 IS THIS 00 PROT TYPE
         BNE      PMDSEG2           NO
         LW,4     DP+2              USE BIAS IN
         SLS,4    1                 HEAD FOR START
         AND,4    M17
PMDSEG2  EQU      %
         LCI      2
         STM,R4   *R7               PUT HEX VALUES IN PMDBUF
         B        PMD2,R1
         PAGE
SNAP     BAL,R7   INITDB,R1
         LCI      2
         LM,SR3   0,R5              GET THE COMMENT
         STM,SR3  3,R6
         AI,R5    2
         STW,5    BADNAME
         BAL,R7   FROMTO,R1
         BAL,0    ABD,1
*  RETURN 10=FROM 11=TO
         CI,10    0
         BE       SNAP3
         CLM,10   ALLLIM
         BCR,9    SNAP3
         ERRORN   X'04036A',SNAP3
SNAP3    EQU      %
         CI,11    0
         BE       SNAP8
         CLM,11   ALLLIM
         BCR,9    SNAP8
         LW,5     BADNAME
         BAL,7    PASSNAME
         AI,5     1
         STW,5    BADNAME
         ERRORN   X'04036A',SNAP8
SNAP8    EQU      %
         LW,R6    D1
         LCI      2
         STM,SR3  1,R6
         AI,D1    8
         B        DBUG1,R1
         PAGE
IAO      EQU      %
         STW,R5   TMP+2,R1
         BAL,R7   INITDB,R1
         BAL,R7   HALF,R1           LEFT HALF
         LW,R6    D1
         STW,SR3  1,R6
         BAL,R7   HALF,R1           RIGHT HALF
         LW,R6    D1
         STW,SR3  2,R6
         LW,R4    TMP+2,R1
         LW,R4    *R4
         AI,R4    B
         LW,SR3   *R4,R1
         STW,SR3  3,R6
         AI,D1    8
         B        DBUG1,R1
HALF     LW,SR4   R7
         BAL,R7   LOCNAM,R1
         B        ABC,R1
         LW,SR3   R6
         BAL,R7   PASSNAME,R1
         LW,R2    *R5
         AND,R2   DBGMSK,R1
         AW,SR3   R2
         AND,SR3  DBGMSK,R1
         INT,R2   1,R5
         AI,R2    LW
         LW,R2    *R2,R1
         AW,SR3   R2
         SLS,R3   17
         AW,SR3   R3
         AI,R5    2
         B        *SR4
         PAGE
COUNT    BAL,R7   INITDB,R1
         LCI      3
         LM,SR2   *R5
         STM,SR2  1,R6
         LI,SR2   0
         STW,SR2  4,R6
         AI,D1    8
         B        DBUG1,R1
         PAGE
*        BAL,R7   INITDB            SUPPLIES WORDS 0,5,6, AND 7
*        R5 POINTS TO DBTABLE       OF DBUG PLIST
*        D1 POINTS TO DBPLIST
*        R5 RETS POINTING AFTER LOC VALUE
*        R6 RETS EQUAL TO D1
INITDB   STW,R7   TMP+3,R1
         LW,R6    *R5
         AND,R6   YFF
         SW,R6    Y06
         STW,R6   *D1               INIT 1ST WORD OF PLIST
         LCI      2                 PICK UP FLG NAME
         LM,SR3   1,R5
         BAL,7    ADFLG,1           GET FLG WD SET UP (WD 7)
         LW,SR4   CAL,R1
         LW,R6    D1
         AND,R6   M9
         AW,6     NXTAVPG,1
         AW,SR4   R6                SR4 CONTAINS CAL FOR CHKLOC
         AI,R5    3
         STW,5    BADNAME
         BAL,R7   LOCNAM,R1
         BAL,0    ABB,1
         LW,SR3   R6                SR3 = LOC
         BAL,R7   PASSNAME,R1
         LW,R7    *R5
         AW,R7    SR3
         AND,R7   M17
         CLM,7    DATALIM
         BCR,9    INIT4
         CLM,7    PPLIM
         BCR,9    INIT4
         ERRORN   X'040369',INIT4
INIT4    EQU      %
         AND,SR3  YFFFE
         AW,SR3   R7
         BAL,R7   CHKLOC,R1
         AI,R5    1
         LW,R7    TMP+3,R1
         B        0,R7
         PAGE
*        BAL,R7   LOCNAM            LOCATE NAME IN SEGS RFDFSTR.
*        R5 POINTS TO NAME
*        R6 RETURNS DEF VALUE
*        RET TO 0,R7 IF NOT FOUND, 1,R7 IF O.K.
LOCNAM   EQU      %
         LI,R0    0
LOCNAMR  EQU      %
         LW,R2    RFDF,R1           R2 = RFDFSTK BASE.
         LW,3     RFDFS,1
         AW,3     2
LOCNAM1  AI,R2    3
         LI,R6    0
         LB,R4    *R5
         BEZ      1,R7              NO NAME. RET 0
         CB,R4    *R2
         BNE      LOCNAM2,R1        DIFFERENT SIZE NAME
         LB,R6    *R5,R4
         CB,R6    *R2,R4
         BNE      LOCNAM2,R1
         BDR,R4   %-3,R1
         LW,SR1   R5
         LW,R5    R2
         AI,R5    -3
         BAL,R6   WHATRES,R1
         LI,R3    0
         LW,R5    SR1
         LCW,SR1  R3
         AW,SR1   R0
         LW,SR2   M8
         LI,3     X'FF'
         AND,3    8
         LW,R6    -2,R2
         SLS,6    0,3
         B        1,R7
LOCNAM2  AI,R2    -3
         LB,R4    *R2
         AW,R2    R4
         CW,R2    R3
         BL       LOCNAM1,R1
         B        0,R7
         PAGE
*        BAL,R7   CHKLOC
*        SR3 CONTAINS LOC           0,R7 RET IF NOT CHAINED
*        SR4 CONTAINS CAL           1,R7 RET IF        CHAINED
*        SR3,SR4 RET REPLACED INSTAND B CAL+1 IF CHAINED
CHKLOC   EQU      %
          LW,SR2        R5
         LW,SR1   R7
         LW,R3    D3
         INT,R2   10,R3
         SLS,R3   1                 R3 = BOTTOM OF CLTAB
         AW,R2    R3                R2 TOP       OF CLTAB
         CW,R2    R3
         BE       NOLOC,R1
CHKLOC1  CW,SR3   *R3
         BE       YESLOC,R1
CHKLOC3   AI,R3         2
         CW,R3    R2
         BGE      NOLOC,R1
         B        CHKLOC1,R1
NOLOC    BAL,R7   ENTCLT,R1         NOT IN CLTAB. ADD IT.
         AW,10    BP1
          B             CHKLOCEX,R1
YESLOC   AI,R3    1                 GET CAL ADDR
         LW,R4    *R3
         LW,R5    YFFFE
         CS,R4    CAL,R1
          BNE           CHKLOC2,R1
YESLOC1  LW,R3    *R3
         AND,R3   M9
         LI,R4    X'1FE00'
         AND,4    12
         AW,R3    R4
         LW,R4    *R3
         AND,R4   M17
         BEZ      %+3,R1
         LW,R3    R4
         B        YESLOC1+1,R1
         LW,SR3   NXTAVPG,R1
         LW,SR4   M9
         AND,SR4  D1
         AW,SR4   SR3
         AWM,SR4  *R3
         LW,10    6,3
CHKLOCEX  LW,R5         SR2
         LW,6     12
         STW,10   6,6
         B        *SR1
CHKLOC2   AI,R3         -1
          B             CHKLOC3,R1
         PAGE
*        BAL,R7   ADFLG             ADDS OR LOCATES FLAG IN FLAG TABLE
*        SR3,SR4 CONTAIN FLAG
*
*        PUTS CORRECT FLAG WORD IN DBUG TABLE
*
ADFLG    LW,R3    D1                LAST DBUG ADDR.
         LW,2     15
ADFLG1   CW,R2    LSTFLG,R1
         BGE      NOFLG,R1
         LW,SR1   *R2
         LW,SR2   1,R2
         CD,SR1   SR3
         BE       YESFLG,R1
         AI,R2    3
         B        ADFLG1,R1
YESFLG   LW,R6    2,R2              FLAG FOUND
         OR,R6    Y8                FORM IND. FLAG ADDR.
STOFLG   STW,R6   7,R3              STORE FLAG
         B        0,R7
NOFLG    LW,R4    LSTFLG,R1         FLAG NOT FOUND. ADD IT.
         AI,R4    3
         LW,6     4
         AND,6    M9,1
         CI,6     2
         BLE      AB5,1             TOO MANY FLGS
         STW,R4   LSTFLG,R1
         LCI      2
         STM,SR3  *R2
         ANLZ,R4  STOFLG,R1         IF DBUG TABLE MOVES RELOCATE FLAGS.
         AND,R4   M9
         AW,4     NXTAVPG,1
         STW,R4   2,R2
         LI,R6    0
         B        STOFLG,R1
         PAGE
*        BAL,R7   PASSNAME          INCREASES R5 PAST TEXTC NAME
*        R5 POINTS TO NAME
*
PASSNAME LB,R2    *R5
         AI,R2    4
         SLS,R2   -2
         AW,R5    R2
         B        0,R7
         PAGE
*        BAL,R7   ENTCLT            ENTER DBLWD IN CLOBBER TABLE
*        SR3 AND SR4 CONTAIN LOC. AND WORD
*
ENTCLT   LI,R2    X'20000'
         LW,R6    D3
         AWM,R2   10,R6             INCREASE NO OF CLOBS IN TREE
         STD,SR3  *D2
         AI,D2    2
         CW,D2    ENDCLPG
         BL       ENTCLT2
*  TOO MANY DEBUG COMMANDS-ABOUT TO EXCEED SPACE AVAILABLE
         ERROR    X'04035E',ABORT
ENTCLT2  EQU      %
         B        0,R7
         PAGE
*        BAL,R7   FROMTO            RET 0,R7  FOR  BAD  NAME
*        R5 POINTS TO 1ST NAME      RET 1,R7  OK.
*        SR3,SR4 FRETURN FROM AND TO. R5 POINTS TO WORD AFTER FROM,TO.
FROMTO   LI,R0    0
FROMTOR  STW,R7   TMP,R1
         STW,R0   TMP+4,R1
         BAL,R7   LOCNAM,R1         FROM NAME
         B        FROMTO1,R1
         LW,R0    TMP+4,R1
         LW,SR3   R6
         BAL,R7   PASSNAME,R1       SKIP NAME
         LW,7     10
         AW,SR3   *R5               ADD FROM VALUE
         AND,7    YFFFE
         AND,10   M17
         AW,10    7
         AI,R5    1
         BAL,R7   LOCNAMR,R1
         B        FROMTO1,R1
         LW,SR4   R6
         BAL,R7   PASSNAME,R1       SKIP NAME
         AW,SR4   *R5               ADD TO VALUE
         AI,R5    1
         MTW,1    TMP,R1
FROMTO1  LW,SR1   TMP,R1
         B        *SR1
         END      DB

