*M*      RUNROM   INSERT MODIFY, SNAP, AND PMD'S INTO LOAD MODULE.
         DEF      DP                GENMD LABEL FOR DATA CSECT.
DP       CSECT    0
         DEF      DB                GENMD LABEL FOR PROCEDURE CSECT.
DB       CSECT    1
*P*
*P*      NAME:    RUNNER
*P*
*P*      PURPOSE: TO READ THE FILE OF DEBUG COMMANDS BUILT BY CCI
*P*               (ID-D) AND TO CONVERT THOSE COMMANDS INTO ABSOLUTE
*P*               RUN-TIME TABLES OF USER PROGRAM WORDS TO BE
*P*               REPLACED AND DUMPS TO BE TAKEN.
*P*
*P*  DESCRIPTION: RUNNER IS ENTERED WITH THE TOP WORD IN TSTACK
*P*               POINTING TO CCI'S RUN TABLE IN A COMMON PAGE,
*P*               AND M:XX DCB OPEN TO THE LOAD MODULE TO BE RUN.
*P*               IT COPIES THE RUN TABLE TO ITS OWN DATA PAGE AND
*P*               FREES CCI'S COMMON PAGE.
*P*               IT READS THE ID-D FILE BUILT BY CCI FROM USER
*P*               DEBUG CARDS (!SNAP,!MODIFY,!PMD,ETC.).
*P*               IT USES THE REFDEF-STACK RECORDS FROM THE LOAD
*P*               MODULE TO CONVERT  DEF+HEX  EXPRESSIONS FROM THE
*P*               DEBUG RECORDS INTO ABSOLUTE CORE ADDRESSES.
*P*               IT REWRITES !PMD RECORDS INTO ID-D FOR LATER USE
*P*               AT THE END OF THE JOB STEP, AND DELETES ALL OTHER
*P*               RECORDS.
*P*               IT BUILDS A 'CLOBBER TABLE' OF DOUBLEWORDS FROM
*P*               !MODIFY,!SNAP,!IF,!AND,!OR,!COUNT RECORDS --
*P*                                 LOCATION, NEW CONTENTS.
*P*               MODIFY CONTENTS ARE SPECIFIED BY THE USER; FOR
*P*               OTHER RECORDS, THE NEW CONTENTS ARE A CAL1,3
*P*               DEBUG CAL.
*P*               IT BUILDS A DEBUG FPT TABLE OF 8-WORD ENTRIES FROM
*P*               !SNAP,!IF,!AND,!OR,!COUNT RECORDS.  EACH ENTRY IN
*P*               THIS TABLE IS THE FPT FOR A DEBUG CAL.
*P*               IT GETS THE PAGE FOLLOWING USER PROGRAM PURE
*P*               PROCEDURE AND MOVES THE DEBUG FPTS AND CLOBBER TABLE
*P*               INTO THIS PAGE.
*P*               IT THEN EXITS TO JOB STEP MANAGEMENT.
*P*               AT EXIT, THE FOLLOWING DATA IS SET UP:
*P*               1.  DEBUGFPT/CLOBBERTABLE PAGE IN PROPER PLACE IN
*P*                 MEMORY. PP PAGE COUNT BUMPED TO REFLECT IT.
*P*               2.  USER LM HEAD RECORD IN FIRST 12 WORDS OF
*P*                 RUNNER'S DATA PAGE.  PP SIZE BUMPED TO REFLECT
*P*                 DBFPT/CLT PAGE.  START ADDRESS CHANGED IF USER
*P*                 SO SPECIFIED.
*P*               3.  END OF RUNNER'S DATA PAGE CONTAINS A TABLE TO
*P*                 BE COPIED INTO WORD 10 OF USER'S TREE TABLES
*P*                 WHEN LOAD MODULE IS READ IN.  TABLE CONTAINS
*P*                 SIZE AND ADDRESS OF CLOBBER TABLE FOR EACH
*P*                 PROGRAM OVERLAY SEGMENT.
*P*
         SYSTEM   SIG7
         PAGE
         REF      TSTACK      INPUT TEMPSTACK IN JIT HOLDS RUNTABLE
*,*                           OUTPUT RUNTABLE ADDR WORD IS PULLED
         REF      M:XX        DCB USED FOR READING USER LOAD MODULE
         REF      M:EI        DCB USED TO READ ERRMSG.:SYS FILE
         REF      M:DO        DCB USED TO PRINT ERRORS ENCOUNTERED
         REF      F:DB        DCB USED TO READ ID-D FILE & DELREC
         REF      J:JIT       BASE ADDRESS OF JIT
*,*                           BITS 16-31 INPUT = USER ID (ID-D FILE)
         REF      J:ASSIGN    BIT 14 INPUT = PMD'S EXIST
*,*                                  OUTPUT ZEROED IF LINK LM (EVIL)
         REF      J:BUP       INPUT PAGE# OF START OF USER AREA
         REF      JBPCP       OUTPUT +1 FOR EXTRA PP PAGE(CLT+DBFPT)
         PAGE
         CLOSE    ERROR
ERROR    CNAME    ERSUBR,0          ERROR NUMBER IN PROC.
ERRORN   CNAME    ERSUBRN,0
ERRORI   CNAME    ERSUBR,1          ERROR ADDRESS IN PROC
ERRORNI  CNAME    ERSUBRN,1
         PROC
LF       STW,11   ERRSTACK+11       SAVE R11.
         BAL,R11  NAME(1)           INVOKE ERROR ROUTINE.
         DO NAME(2)
         LW,7     AF(1)
         ELSE                       GET ERROR NUMBER.
         LI,7     AF(1)
         FIN
         DO1      NUM(AF)>1
         B        AF(2)             GO ELSEWHERE IF ELSEWHERE SPEC.
         PEND
*
ERRKEY   COM,32   AF
         PAGE
*                 SYMBOLIC REGISTER DEFINITIONS
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
R8       EQU      8
R9       EQU      9
R10      EQU      10
R11      EQU      11
R12      EQU      12
R13      EQU      13
R14      EQU      14
R15      EQU      15
         PAGE
         USECT    DP                DATA CONTROL SECTION.
*  THE HEAD SPACE MUST BE THE FIRST THING IN THE CSECT.
HEAD     DATA,8   0,0,0,0,0,0       SPACE FOR LM HEAD RECORD.
LMSETDCB GEN,8,7,17 X'06',0,M:XX ***M:SETDCB M:XX (LOAD MODULE) *****
         DATA     X'C0000000'        *
         PZE      LMER               *ERR
         PZE      LMER               *ABN
LMRESTOR GEN,8,7,17 X'06',0,M:XX ***M:SETDCB M:XX (LOAD MODULE) *****
         DATA     X'C0000000'        *
         PZE      0                  *ERR (THIS IS TO RESTORE
         PZE      0                  *ABN  PREVIOUS ERR/ABN ADDRESSES)
LMFPT    GEN,8,7,17 X'10',0,M:XX ***M:READ M:XX   (LOAD MODULE) *****
         DATA     X'F8000010'        *
         PZE      LMER               *ERR
         PZE      LMER               *ABN
         PZE      *R8                *BUF  IN R8
         PZE      *R9                *SIZE IN R9
         PZE      *R11               *KEY  IN R11
LMHEAD   TEXTC    'HEAD'              (KEY OF LM HEAD RECORD)
LMTREE   TEXTC    'TREE'              (KEY OF LM TREE RECORD)
         PAGE
IDDOPEN  GEN,8,7,17 X'14',0,F:DB ***M:OPEN F:DB   (DEBUG FILE) ******
         DATA     X'C7020001'        *
         PZE      DBER               *ERR
         PZE      DBAB               *ABN
         DATA     2                  *ORG = KEYED
         DATA     2                  *ACS = DIRECT
         DATA     4                  *INOUT
         DATA     0                  *BTD = 0
FPAR     DATA     X'01000101'        *FILENAME -
         GEN,8,16,8 3,0,'D'          *  ID-D.
         DATA     X'02000000'        *ACCOUNT# - RESET TO OURS.
         DATA     X'07000000'        *INSN     - MAKE SURE NONE.
         DATA     X'08010000'        *OUTSN    - MAKE SURE NONE.
IDDREAD  GEN,8,7,17 X'10',0,F:DB ***M:READ F:DB   (DEBUG FILE) ******
         DATA     X'F0000010'        *
         PZE      DBER               *ERR
         PZE      DBAB               *ABN
         PZE      DBBUFFER           *BUF
         DATA     80                 *SIZE
IDDDEL   GEN,8,7,17 X'0D',0,F:DB ***M:DELREC F:DB (DEBUG FILE) ******
         DATA     0                  *
IDDWRITE GEN,8,7,17 X'11',0,F:DB ***M:WRITE F:DB  (DEBUG FILE) ******
         DATA     X'30000050'        *ONEWKEY
         PZE      PMDBUF             *BUF
         DATA     36                 *SIZE
IDDCLS   GEN,8,7,17 X'15',0,F:DB ***M:CLOSE F:DB  (DEBUG FILE) ******
         DATA     X'80000000'        *
         DATA     2                  *SAVE
         PAGE
ERRMOPEN GEN,8,7,17 X'14',0,M:EI ***M:OPEN M:EI   (ERRMSG FILE) *****
         DATA     X'C1020001'        *
         PZE      ERRMERR            *ERR
         PZE      ERRMERR            *ABN
         DATA     1                  *IN
         DATA     0                  *BTD = 0
         DATA     X'01000202'        *FILENAME:
         TEXTC    'ERRMSG'
         DATA     X'02000202'        *ACCOUNT#:
         TEXT     ':SYS    '
         DATA     X'07000000'        * NO INSN
         DATA     X'08010000'        * NO OUTSN
ERRMREAD GEN,8,7,17 X'10',0,M:EI ***M:READ M:EI   (ERRMSG FILE) *****
         DATA     X'F8000000'        *
         PZE      ERRMERR            *ERR
         PZE      ERRMERR            *ABN
         PZE      ERRBUF             *BUF
         DATA     80                 *SIZE
         PZE      ERRMKEY            *KEY
ERRMKEY  DATA     0                 SPACE FOR KEY.
ERRMCLS  GEN,8,7,17 X'15',0,M:EI ***M:CLOSE M:EI  (ERRMSG FILE) *****
         DATA     X'80000000'        *
         DATA     2                  *SAVE
*
ERRWRITE GEN,8,7,17 X'11',0,M:DO ***M:WRITE M:DO  (LINE PRINTER) *****
         DATA     X'30000000'        *
         PZE      ERRBUF             *BUF
         PZE      *R5                *SIZE IN R5
ERRCLOSE GEN,8,7,17 X'15',0,M:DO ***M:CLOSE M:DO  (LINE PRINTER) *****
         DATA     X'80000000'        *
         DATA     2                  *SAVE
*
ERRSTACK RES      16                SAVE AREA FOR ERROR CALLER'S REGS.
ERRBUF   RES      70                BUFFER FOR ERROR MESSAGE.
         PAGE
GVPFPT   DATA     X'8400000F'       PAGE ADDRESS IN 15
*
GPFPT    DATA     X'08000001'       GET  ONE PAGE.
FPFPT    DATA     X'09000001'       FREE ONE PAGE.
*
GCPFPT   DATA     X'8C000005'       # OF PAGES IN 5
FCPFPT   DATA     X'8D000005'
*
CPGN     DATA     0                 # OF COMMON PAGES REQUIRED.
*
RFDF     DATA     0                 CURRENT START OF REFDEF STACKS
RFDFTOP  DATA     0                 END OF REFDEF (START OF TREE)
TREEADDR DATA     0                 START OF TREE IN CORE
DBFSTART DATA     0                 START OF DEBUG FPTS (END OF TREE)
CLBSTART DATA     0                 START OF CLOBBERS (END OF DBFPTS)
FLAGPAGE DATA     0                 ADDRESS OF PAGE FOR FLAGS
*
         BOUND    8
DATALIM  DATA     0,0               BOTTOM & TOP OF DATA THIS SEGMENT.
PPLIM    DATA     0,0               BOTTOM & TOP OF  PP  THIS SEGMENT.
ALLLIM   DATA     0,X'1FFFF'        BOTTOM & TOP OF USER AREA.
*
BADNAME  DATA     0                 ADDRESS OF BAD NAME TEXTC.
*
TMP      RES      5                 ***   TEMP SAVE FOR MISC   ***
*
HEX      TEXT     '0123456789ABCDEF'  FOR MAKING PRINTABLE.
Y8       DATA     X'80000000'
Y002     DATA     X'00200000'
X1FE00   DATA     X'0001FE00'
XFF00    DATA     X'0000FF00'
DBGMSK   DATA     X'8001FFFF'
*
CAL      CAL1,3   0                 BASIC DEBUG CAL INSTRUCTION.
BP1      B        0+1               BASIC  B LOC+1  INSTRUCTION.
LW       LB,0     0                 BASIC LOAD INSTRUCTIONS.
         LH,0     0
         LW,0     0
         LD,0     0
B        BG       0                 BASIC BRANCH INSTRUCTIONS.
         BL       0
         BE       0
         BGE      0
         BLE      0
         BNE      0
*
PMDBUF   BOUND    8                 PMDBUF MUST BE ON ODD WORD BOUND.
ERRFLAG  DATA     0                 SET NONZERO IF ANY ERRORS.
PMDBUF   RES      9                 BUFFER FOR BUILDING PMD RECORDS.
DBBUFFER RES      80/4              BUFFER FOR DEBUG FILE RECORDS
         DEF      RPATCH
RPATCH   RES      (DP-%)+(X'200'-X'20')   PATCH AREA
RUN      RES      X'20'             SPACE FOR RUN TABLE
         DISP     %   ************** SHOULD BE X'00200' ************
         PAGE
         USECT    DB                PURE PROCEDURE CONTROL SECTION.
RUNNER   EQU      %
*  SAVE M:XX ERR & ABN AND SET UP RUNNER'S.
         LI,R7    X'1FFFF'
         LW,R6    M:XX+3            SAVE ERR ADDRESS
         STS,R6   LMRESTOR+2         FROM M:XX
         LW,R6    M:XX+4             AND ABN ADDRESS
         STS,R6   LMRESTOR+3         FROM M:XX
         CAL1,1   LMSETDCB          AND SUBSTITUTE OURS.
*  GET RUN TABLE FROM CCI'S PAGE INTO RUNNER'S DATA PAGE.
         PLW,R6   TSTACK
         SLS,R6   +2                R6= BA(RUN TABLE)
         LW,R7    L(96**24+BA(RUN)) R7= (24 WDS), BA(WHERE TO PUT IT)
         MBS,R6   0                 MOVE IT.
         LI,R5    1                 FREE ONE
         CAL1,8   FCPFPT            COMMON PAGE WHICH HELD RUNTABLE.
*
*  READ LOAD MODULE HEAD RECORD.
*
         LI,R8    HEAD              BUF
         LI,R9    48                SIZE
         LI,R11   LMHEAD            KEY
         CAL1,1   LMFPT
*  DEBUGS NOT ALLOWED WITH LINK-LOADED LM.
         LB,R6    HEAD
         CI,R6    X'84'             CODE FOR LINK-TYPE LMN.
         BE       ABN6C             ---> BAD NEWS. ABORT.
*  SET UP BEGINNING OF LM'S DATA AND PURE PROCEDURE.
         INT,R7   HEAD+3            DA(DATA)
         SLS,R7   +1                WA(DATA)
         STW,R7   DATALIM
         INT,R7   HEAD+4            DA(PP)
         SLS,R7   +1                WA(PP)
         STW,R7   PPLIM
         LW,R6    J:BUP
         SLS,R6   +9                WA(FIRST USERPAGE)
         STW,R6   ALLLIM            IS LOWEST LEGAL ADDRESS.
*  ALLOCATE SPACE FOR DEBUG TABLES (DEBUG FPTS AND CLOBBER TABLE).
         LI,R2    1
         LB,R2    RUN,R2            # DEBUGS FROM RUN TABLE
         LI,R1    2
         LB,R1    RUN,R1            # MODIFIES FROM RUN TABLE
         AW,R1    R2
         SLS,R1   +1                CLOBBER SIZE = 2*(DEBUGS+MODS)
         SLS,R2   +3                DBUGFPT SIZE = 8*(DEBUGS)
         AW,R1    R2                TABLE SIZE = CLTSIZE + DBFPTSIZE
         LI,R8    DP                  (DEBUGS END @ OUR DATA START)
         SW,R8    R1
         AND,R8   X1FE00            START OF DEBUG TABLE PAGE.
         LW,R1    R8            R1=> START OF DEBUG FPTS.
         AW,R2    R8            R2=> START OF CLOBBER TABLE.
         STW,R1   DBFSTART          REMEMBER START OF DEBUG FPTS.
         STW,R2   CLBSTART          REMEMBER START OF CLOBBERS.
*  ALLOCATE SPACE FOR LM TREE RECORD.
         INT,R9   HEAD+5            TREE SIZE.
         SW,R8    R9
         STW,R8   TREEADDR          ADDRESS OF TREE RECORD IN MEMORY.
         STW,R8   RFDFTOP           TREE START IS REFDEF END.
*  ALLOCATE SPACE FOR REFDEF RECORDS FROM LM.
         SH,R8    HEAD+5              (MAX RFDF SIZE)
         AND,R8   X1FE00
         LI,R5    DP
         SW,R5    R8                SIZE OF TREE,DEBUGS,REFDEF.
         SLS,R5   -9                # PAGES NEEDED.
         CAL1,8   GCPFPT            GET # COMMON PAGES IN R5.
         BCS,8    ABN6D
         STW,R5   CPGN              # COMMON PAGES WE NOW HAVE.
*
*  READ LOAD MODULE TREE RECORD.
*
         LW,R8    TREEADDR          BUF
         INT,R9   HEAD+5
         SLS,R9   +2                SIZE
         LI,R11   LMTREE            KEY
         CAL1,1   LMFPT
         MTW,1    TREEADDR          MAKE TREEADDR => ROOT SEGMENT.
*  SEE THAT TREE IS GOOD, FIX TREE KEYS, AND ZERO DEBUG POINTERS.
         LW,R3    TREEADDR
         LI,R4    0
DB08     MTB,1    *R3               MAKE SEGMENT NAME 1 LONGER.
         LB,R5    *R3
         CI,R5    11                IS NAME EVIL (TOO BIG) ...
         BG       ABN6E             ---> YES. DIE.
         STB,R4   *R3,R5            NAME OK. LAST BYTE = 0 (REFDEFKEY)
         STW,R4   10,R3             NO CLOBBERTABLE FOR THIS SEG YET.
         AI,R3    11                ON TO NEXT OVERLAY SEGMENT.
         CW,R3    DBFSTART          ARE WE TO END OF TREE YET...
         BL       DB08              ---> NO.
         BG       ABN6E             ---> TREE SIZE IS BAD.
*        V        V                 ALL SETUP OKAY.  PROCEED.
         PAGE
***********************************************************************
*        COMMON STORAGE LAYOUT AND POINTERS (INITIAL SETUP)           *
***********************************************************************
*                               PAGE***********************************
*                                   */////////////////////////////////*
*        RFDF ----- (FLOATS) -----> *---------------------------------*
*                                   *                                 *
*                                   *  LM REFDEF RECORDS LIVE HERE.   *
*                                   *                                 *
*        RFDFTOP =================> *---------------------------------*
*        TREEADDR ================> *                                 *
*                                   *  LM TREE RECORD LIVES HERE.     *
*                                   *                                 *
*        DBFSTART ============> PAGE***********************************
*        R1 -- (MOVES) ---/         *     SPACE                       *
*                 V                 *      FOR                        *
*                                   *  DEBUG FPT'S                    *
*        CLBSTART ================> *---------------------------------*
*        R2 -- (MOVES) ---/         *     SPACE                       *
*                 V                 *      FOR                        *
*                                   * CLOBBER TABLE                   *
*                                   *---------------------------------*
*                                   */////////////////////////////////*
*                 DP     =      PAGE***********************************
***********************************************************************
*  ARE THERE DEBUGS...
         LI,R7    X'20000'
         AND,R7   J:ASSIGN          PMDS EXIST IF THIS FLAG NONZERO.
         AI,R7    DP                SNAPS OR MODS IF DP      NOT
         SW,R7    DBFSTART                     EQUAL DBFSTART.
         BEZ      DB09              ---> IF NONE, DON'T PROCESS ANY.
*************************************
***      PROCESS DEBUGS             ***
*************************************
*  GET A PAGE FOR FLAG TABLE.
         CAL1,8   GPFPT             GET A PAGE.  ADDRESS(PAGE) IN R9.
         BCS,8    ABN6D
         STW,R9   FLAGPAGE          REMEMBER ADDRESS OF FLAG PAGE.
*  OPEN DEBUG FILE.
         INT,R7   J:JIT
         SLS,R7   +8                JOB ID
         AWM,R7   FPAR+1            INTO DEBUG FILE NAME ('IDD').
         CAL1,1   IDDOPEN           OPEN DEBUG FILE.
         LI,R3    0
         B        DBUG2
*************************************
***      DEBUG LOOP                 ***
*************************************
*** NOW: R1=>CURR.DBFPT R2=>CURR.CLOBBER R3=>CURR.SEG R15=>CURR.FLAG
DBUG1    EQU      %
         CAL1,1   IDDDEL            DELETE IT FROM FILE.
*  READ NEXT RECORD FROM DEBUG FILE.
DBUG2    EQU      %
         CAL1,1   IDDREAD           READ RECORD.  GO TO DBAB ON EOF.
*  FIND OVERLAY SEGMENT IN TREE.  (RECORD KEY IS OVERLAY NAME).
         LB,R7    *F:DB+10          R7= KEYLENGTH.
         ANLZ,R6  %-1               R6= BA(KEY).
         STB,R7   R6                R6 SET FOR CBS.
         LW,R5    TREEADDR          R5 POINTS TO TREE ENTRY.
DBUG4    EQU      %
         ANLZ,R8  BA@R5
         LW,R9    R6
         CBS,R8   0                 IS THIS THE SEGMENT...
         BE       DBUG6             ---> YES. TREE ENTRY ADDR IN R5.
         AI,R5    +11               TO NEXT SEG.
         CW,R5    DBFSTART          MORE SEGMENTS...
         BL       DBUG4             ---> YES. KEEP LOOKING.
         ERROR    X'040366',ABORT   NO.  BAD NEWS.
*  SET UP LIMITS AND READ IN REFDEF STACKS.
DBUG6    EQU      %
         CW,R3    R5                IS THIS SEGMENT THE SAME AS PREV
         BE       DBUG8             ---> YES.
         STW,R2   10,R5             W10 OF TREE <= WA(CLOBBERTABLE).
         LW,R3    R5                NO.
         BAL,R7   SEGLREAD          SET DATA/PP UPPER LIM & READ RFDF
*  GO TO APPROPRIATE DEBUG ROUTINE.
DBUG8    EQU      %
         LI,R5    DBBUFFER          POINT TO DEBUG RECORD BUFFER.
         LB,R6    DBBUFFER          BYTE 0 IS RECORD TYPE.
         CI,R6    12
         BL       %+1,R6
         B        DBERR              0 ** BAD **
         B        DBERR              1 ** BAD **
         B        MOD                2 MODIFY
         B        PMD                3 PMD
         B        PMD                4 PMDE
         B        PMD                5 PMDI
         B        SNAP               6 SNAP
         B        SNAP               7 SNAPC
         B        IAO                8 IF
         B        IAO                9 AND
         B        IAO               10 OR
         B        COUNT             11 COUNT
*
* REGS:   1 => NEXT DEBUG FPT ENTRY
*         2 => NEXT CLOBBER TABLE ENTRY
*         3 => SEGMENT NAME IN TREE
*         5 => DEBUG RECORD
*         6 =  DEBUG RECORD TYPE
*
DBERR    ERROR    X'04035F',DBUG1
DBAB     EQU      %
         LB,R7    R10               GET ABN CODE.
         CI,R7    06                IS IT 06 I.E. EOF...
         BNE      DBER              ---> NO. MUST BE BAD NEWS.
*  END OF DEBUG FILE.  TIDY THINGS UP.
         CAL1,1   IDDCLS            CLOSE THE DEBUG FILE.
         CAL1,8   FPFPT             FREE THE FLAG TABLE PAGE.
*************************************
***      END PROCESSING DEBUGS      ***
*************************************
DB09     EQU      %
         LW,R5    RUN+10            WAS A START ADDRESS (NAME
         CW,R5    RUN+11             AND/OR ADDEND) SPECIFIED...
         BCR,7    DB10              ---> NO.
*  PROCESS SYMBOLIC START ADDRESS.
         LW,R5    TREEADDR          READ ROOT REFDEF RECORD AND
         BAL,R7   SEGLREAD           SET UP DATA/PP UPPER LIMITS.
         LI,R5    RUN+10
         BAL,R7   LOCATION       R10<- VALUE OF START ADDRESS.
         B        ABN63             ---> NAME IS BAD.
         ERRKEY   X'040365'         ---  VALUE NOT IN DATA OR PP.
         LI,R11   X'1FFFF'
         STS,R10  HEAD+1            STORE START ADDR IN HEAD RECORD.
*************************************
***      END PROCESSING SYMB START  ***
*************************************
         PAGE
*  NOW FINISHED SETTING UP DEBUGS.
DB10     EQU      %
*  MAKE A COPY OF W10 OF TREE ENTRIES AT THE END OF OUR DATA PAGE.
         INT,R7   HEAD+5            TREE SIZE.
         AI,R7    -2
         LI,R6    X'1FF'
         LW,R14   *TREEADDR,R7
         STW,R14  DP,R6
         AI,R6    -1
         AI,R7    -11
         BGEZ     %-4
*  FREE THE REFDEF AND TREE PAGES.
         LW,R5    DBFSTART
         AI,R5    -DP               -(NUMBER OF WORDS IN DEBUG AREA)
         SAS,R5   -9                -(# DB PAGES)
         AW,R5    CPGN              # PAGES WE DON'T NEED ANY MORE
         CAL1,8   FCPFPT            FREE THAT MANY PAGES.
         LCW,R5   R5
         AWM,R5   CPGN              UPDATE # COMMON PAGES STILL HELD.
*  MOVE DEBUG FPTS AND CLOBBERS ABOVE PROGRAM'S PURE PROCEDURE.
*  GET PAGES TO MOVE THEM INTO AND UPDATE PPSIZE IN HEAD RECORD.
         LW,R7    R1
         SW,R7    DBFSTART          R7 = DBFPT SIZE.
         SW,R7    CLBSTART
         LW,R5    R7                R5 = -(DBFSTART + UNUSED SPACE)
         AW,R7    R2                R7 = DBFPT SIZE + CLOBBER SIZE
         BEZ      DB14              ---> GO IF NO DEBUGS.
         LW,R6    HEAD+4            DA(PP)
         AH,R6    HEAD+4            DA(PP END)+1
         AI,R6    X'FF'
         AND,R6   XFF00             DA(PAGE PAST PP)
         LW,R15   R6
         SLS,R15  1                 WA(PAGE PAST PP)
         SLS,R7   -1                DC(DEBUGS)
         AW,R6    R7                DA(NEW PP END)+1
         SW,R6    HEAD+4            DC(NEW PP SIZE)
         STH,R6   HEAD+4            UPDATE PP SIZE IN HEAD RECORD.
         LW,R4    R15
         SW,R4    DBFSTART          R4 = (NEW - OLD)  DBFPT LOC.
         AW,R5    R15               R5 = NEW CLT LOC - OLD CLT LOC.
DB11     CAL1,8   GVPFPT            GET PAGE FOR DEBUGS (ADDR IN R15).
         BCS,8    ABN67             ---> CAN'T GET PAGE.
         LI,R6    JBPCP
         MTB,1    J:JIT,R6          INCREMENT # OF PP PAGES.
         AI,R15   X'200'            TO NEXT PAGE.
         AI,R7    -X'100'           GOT X'100' DOUBLEWORDS.
         BGZ      DB11              ---> AND NEED MORE.
*  MOVE DEBUG FPT'S.
DB116    EQU      %
         AI,R1    -8                ANY MORE...
         CW,R1    DBFSTART
         BL       DB118             ---> NO.
         LCI      8
         LM,R8    0,R1              GET A DEBUG FPT.
         CI,R8    X'1FFFF'          IS IT LINKED...
         BAZ      %+2               ---> NO.
         AW,R8    R4                YES. RELOCATE IT.
         CI,R15   X'1FFFF'          DOES IT HAVE AN INDIRECT FLAG...
         BAZ      %+2               ---> NO.
         AW,R15   R4                YES. RELOCATE IT.
         LCI      8
         STM,R8   *R4,R1            PUT DEBUG FPT WHERE IT BELONGS.
         B        DB116             ---> REPEAT.
*  MOVE CLOBBER TABLE ENTRIES.
DB118    EQU      %
         AI,R2    -2                ANY MORE...
         CW,R2    CLBSTART
         BL       DB119             ---> NO.
         LD,R8    *R2               GET A CLOBBER TABLE ENTRY.
         BLZ      %+2               ---> DON'T RELOCATE MODIFIES.
         AW,R9    R4                RELOCATE DEBUG CAL ADDRESSES.
         LCI      2
         STM,R8   *R5,R2            PUT CLOBBER WHERE IT BELONGS.
         B        DB118             ---> REPEAT.
DB119    EQU      %
*  MOVE W10 OF EACH SEGMENT'S TREE TO CONTEXT AREA.
DB14     EQU      %
         INT,R7   HEAD+5            TREE SIZE.
         AI,R7    -2
         LI,2     X'1FF'
DB16     EQU      %
         LW,8     DP,2
         BEZ      %+2
         AW,8     5                 RELOCATE CLOBBER TABLE POINTER.
         SLS,8    -1                MAKE ADDRESS DOUBLEWORD.
         STW,8    DP,2
         AI,2     -1
         AI,7     -11
         BGZ      DB16
*  RELEASE REST OF PAGES AND EXIT.
ABORT    EQU      %
         LW,R5    CPGN              GET # COMMON PAGES STILL HELD.
         BEZ      %+2               ---> NONE.
         CAL1,8   FCPFPT            FREE THEM ALL.
         CAL1,1   LMRESTOR          RESTORE M:XX ERR/ABN ADDRESSES.
         MTW,0    ERRFLAG           ANY ERRORS...
         BNEZ     ABORTXIT          ---> YES.
         LW,R5    Y002                NO.
         CW,R5    M:DO              IS M:DO OPENED...
         BAZ      %+2               --->NO.
         CAL1,1   ERRCLOSE            YES. CLOSE IT BEFORE EXIT.
         CAL1,9   1                 *** NO ERRORS  QUIT NORMALLY.
ABORTXIT CAL1,9   3                 *** ERRORS.  ABORT.  *****
         PAGE
*        BAL,R7   SEGLREAD          SET DATA/PP LIM & READ BASE RFDF
* IN:             R5 POINTS TO SEGMENT'S TREE ENTRY.
*        RETURN 0,R7 AFTER SETTING UP LIMITS AND READING.
* OUT:            R5 POINTS TO ROOT TREE ENTRY.
* OUT:            R8 & RFDF POINT TO START OF REFDEF IN MEMORY.
*                 R9,R10,R11 DESTROYED.
SEGLREAD EQU      %
         LI,R11   X'1FFFF'
         LW,R10   5,R5              GET DC(DATA), DA(DATA START)
         AH,R10   R10               GET DA(DATA END)+1
         SLS,R10  1                 GET WA(DATA END)+1
         AI,R10   -1                GET WA(DATA END)
         STS,R10  DATALIM+1            INTO DATA UPPER LIMIT WORD.
         LW,R10   7,R5              GET DC(PP), DA(PP START)
         AH,R10   R10               GET DA(PP END)+1
         SLS,R10  1                 GET WA(PP END)+1
         AI,R10   -1                GET WA(PP END)
         STS,R10  PPLIM+1              INTO  PP  UPPER LIMIT WORD.
         LW,R8    RFDFTOP           START REFDEF AREA OFF EMPTY.
*
SEGL4    LW,R9    6,R5
         SLS,R9   -16               R9 IS REFDEF SIZE IN WORDS.
         SW,R8    R9                R8 IS NEW BUFFER ADDRESS.
         STW,R8   RFDF              REMEMBER IT; START OF RFDF AREA.
         SLS,R9   +2                R9 IS REFDEF SIZE IN BYTES.
         LW,R11   R5                R11 IS KEY.
         CAL1,1   LMFPT             READ REFDEF RECORD.
         CW,R5    TREEADDR          IF WE JUST READ IN ROOT REFDEF,
         BE       0,R7              ---> RETURN TO CALLER.
         INT,R5   3,R5              ELSE GET ADDRESS
         AW,R5    TREEADDR          OF NEXT LOWER SEGMENT
         B        SEGL4             ---> AND READ ITS REFDEF TOO.
         PAGE
ABN6C    LI,R6    0
         LI,R7    X'20000'
         STS,R6   J:ASSIGN
         ERROR    X'04036C',ABORT
ABN58    ERRORN   X'040358',DBUG1   BAD LOCATION NAME
ABN59    ERRORN   X'040359',DBUG1   BAD IF/AND/OR NAME
ABN5A    ERRORN   X'04035A',DBUG1   BAD SNAP NAME
ABN5B    ERRORN   X'04035B',DBUG1   BAD PMD NAME
ABN5C    ERRORN   X'04035C',DBUG1   BAD MODIFY NAME
ABN63    ERRORN   X'040363',ABORT   BAD START NAME
ABN67    ERROR    X'040367',ABORT   CAN'T GET CLOBBER TABLE PAGE
ABN6D    ERROR    X'04036D',ABORT   NOT ENOUGH MEMORY TO DO IT.
ABN6E    ERROR    X'04036E',ABORT   MALFORMED HEAD OR TREE
*
LMER     STW,R11  BADNAME           DISPLAY OFFENDING KEY IN MESSAGE.
         BAL,R6   IOABORT           REPORT WHICH I/O ERROR.
         ERRORN   X'040360',ABORT   I/O ERROR READING LM RECORD
DBER     BAL,R6   IOABORT           REPORT WHICH I/O ERROR.
         ERROR    X'040362',ABORT   I/O ERROR READING DEBUG RECORD
*
IOABORT  EQU      %
         LI,R11   0
         SCD,R10  +8                I/O ERROR CODE IN R11
         SLS,R10  -1
         SCD,R10  +8                I/O ERROR CODE/SUBCODE IN R11
         LW,R7    R11
         ERRORI   R7                PRINT I/O ERROR OUT.
         B        0,R6
         PAGE
ERSUBRN  OR,R11   Y8
ERSUBR   LCI      10
         STM,R1   ERRSTACK+1        SAVE R1-R10 (R11 ALREADY SAVED)
         MTW,1    ERRFLAG           SAY WE'VE HAD AN ERROR.
         EXU      *R11            R7<- ERROR NUMBER.
         MTB,3    R7                  MAKE INTO ERRMSG FILE KEY.
         BAL,R4   ERRMSGE           GET MESSAGE FROM ERRMSG. R5= SIZE.
         LC       R11
         BCR,8    ERSUB3            ---> GO IF PLAIN ERROR (NO NAME).
         AI,R5    -1
         LI,R8    X'40'             REPLACE C/R WITH BLANK AT END
         STB,R8   ERRBUF,R5           OF CANNED MESSAGE.
         AI,R5    BA(ERRBUF)+1    R5-> END OF CANNED MESSAGE + 1.
         ANLZ,R4  BA@BN           R4-> TEXTC OF BAD NAME.
BA@BN    LB,R8    *BADNAME
         STB,R8   R5                GET SIZE OF BAD NAME
         MBS,R4   1                 AND ADD TO MESSAGE.
         AI,R5    -BA(ERRBUF)     R5= NEW SIZE OF MESSAGE.
ERSUB3   EQU      %
         CAL1,1   ERRWRITE
         LCI      10
         LM,R1    ERRSTACK+1        RESTORE REGISTERS.
         XW,R11   ERRSTACK+11       RESTORE R11.
         MTW,+1   ERRSTACK+11       INCREMENT RETURN OVER ERRMSG KEY
         B        *ERRSTACK+11      ---> AND RETURN TO CALLER.
         PAGE
ERRMSGE  EQU      %
         STW,R7   ERRMKEY
         LW,R9    Y002              DCB-IS-OPEN FLAG.
         CS,R9    M:EI
         BE       %+2               ---> ALREADY OPEN.
         CAL1,1   ERRMOPEN          OPEN ERROR MESSAGE FILE.
         CAL1,1   ERRMREAD          READ ERROR MESSAGE FROM FILE.
         LW,R5    M:EI+4
         SLS,R5   -17             R5= RECORD SIZE.
ERRMOUT  CS,R9    M:EI
         BNE      0,R4              ---> DCB ALREADY CLOSED.
         CAL1,1   ERRMCLS
         B        0,R4              ---> RETURN.
*
*  ALL ERROR AND ABNORMAL RETURNS ARE TREATED THE SAME.
ERRMERR  EQU      %
         LI,R5    0                 INITIALIZE INDEX.
         SLS,R7   +8                STRIP BYTE COUNT FROM ERROR KEY.
ERRMCONV LI,R6    0
         SLD,R6   +4                GET A HALFBYTE OF KEY.
         LB,R6    HEX,R6            CONVERT IT TO PRINTABLE.
         STB,R6   ERRBUF,R5         PUT IT INTO ERROR MESSAGE BUFFER.
         AI,R5    1
         CI,R5    6                 REPEAT FOR SIX HALF-BYTES.
         BL       ERRMCONV          ---> REPEAT.
         B        ERRMOUT           ---> ALL DONE.
         PAGE
MOD      EQU      %
         LCW,R12  0,R5              GET RESOLUTION.(4B,3H,2W,1D)
         AI,R12   2
         AI,R5    1                 INCREMENT TO LOC/CONTENTS.
         BAL,R7   LOCATION       R10<- VALUE OF MODIFY LOCATION.
         B        ABN5C             ---> BAD NAME IN LOC EXPRESSION.
         ERRKEY   X'040364'         ---  LOCATION NOT IN DATA OR PP.
         OR,R10   Y8             R10= (SIGN BIT) + MOD LOCATION.
         LW,R4    R12               GET RESOLUTION FOR LOCNAMR.
         BAL,R6   LOCNAMR         R8<- MODIFY CONTENTS.
         B        ABN5C             ---> BAD NAME IN CONTENTS EXPR.
         LW,R11   R8         R10/R11= MODIFY LOCATION/CONTENTS.
         BAL,R7   ENTCLT            ENTER INTO CLOBBER TABLE.
         B        DBUG1             ---> ON TO NEXT DEBUG.
         PAGE
PMD      EQU      %
         LW,R9    0,R5              SAVE PP INDICATORS
         STW,R9   PMDBUF
         AI,R5    1                 INCREMENT TO FROM-TO LIMITS.
         BAL,R7   FROMTO     R10/R11<= FROM-ADDRESS, TO-ADDRESS.
         B        ABN5B             ---> BAD FROM OR TO NAME.
         ERRKEY   X'040368'         ---  FROMTO NOT IN USER AREA.
         STD,R10  PMDBUF+1          PUT FROM,TO INTO PMDBUF.
         LI,R6    3                 CHECK FOR PP DUMPS.
         LW,R9    PMDBUF            GET PP INDICATORS AGAIN.
         LI,R10   PMDHEAD           ASSUME HEAD LIMITS TO BE USED.
         CI,R9    8                 BIT SET => NOTHING SPECIFIED.
         BANZ     PMD1              ---> ASSUMPTION CORRECT.
         LI,R10   PMDTREE                  TREE LIMITS TO BE USED.
PMD1     EQU      %
         LI,R4    0
         LI,R5    0
         CI,R9    4                 IS DUMP BIT SET...
         BAZ      PMD3              ---> NO.
         EXU      *R10,R6           R4<= DC(PROT TYPE),DA(PROT TYPE).
PMD1A    SLD,R4   -16               R4= DC(PROT TYPE)
         SLS,R5   -16               R5= DA(PROT TYPE)
         AW,R4    R5                R4= DA(PROT END +1)
PMD2     SLD,R4   +1                GET WA(PROT END +1), WA(PROTBGIN)
         XW,R4    R5                GET WA(PROT BEGIN), WA(PROT END)
         AI,R5    -1
PMD3     EQU      %
         STD,R4   PMDBUF+1,R6       PUT LIMITS INTO PMDBUF
         SLS,R9   +1                NO.
         BDR,R6   PMD1              ---> CHECK ALL 3 BITS.
         CAL1,1   IDDWRITE          WRITE MODIFIED PMD RECORD TO DB.
         B        DBUG2             ---> ALL DONE.
*
PMDHEAD  EQU      %-1               GET PROTECTION LIMITS FROM HEAD:
         LW,R4    HEAD+6            DC(DCBS),DA(DCBS)
         LW,R4    HEAD+4            DC( PP ),DA( PP )
         B        %+1               <DATA FUNNY FOR ROOT>
         LW,R4    HEAD+3            DC(REAL DATA), DA(REAL DATA)
         B        PMD8
PMDTREE  EQU      %-1               GET PROTECTION LIMITS FROM TREE:
         LW,R4    9,R3              DC(DCBS),DA(DCBS) FROM TREE
         LW,R4    7,R3              DC( PP ),DA( PP ) FROM TREE
         B        %+1               <DATA FUNNY FOR ROOT>
         LW,R4    5,R3              DC(DATA),DA(DATA) FROM TREE
         CW,R3    TREEADDR          IS IT THE ROOT...
         BNE      PMD1A             ---> NO. WE GOT IT.
PMD8     EQU      %
         AH,R4    R4                R4= DA(PROT END +1)
         AND,R4   L(X'FFFF')
         INT,R5   HEAD+2            R5= DA(ROOT LIB/BCOMMON)
         B        PMD2
         PAGE
SNAP     EQU      %
         BAL,R7   INITDB
         LCI      2
         LM,R12   0,R5       R12/R13<= COMMENT FOR SNAP.
         AI,R5    2                 INCREMENT OVER COMMENT.
         BAL,R7   FROMTO     R10/R11<= FROM-ADDRESS, TO-ADDRESS.
         B        ABN5A             ---> BAD FROM OR TO NAME.
         ERRKEY   X'04036A'         ---  FROMTO NOT IN USER AREA.
         LCI      4
         STM,R10  1,R1              W1W2= COMMENT;  W3= FROM;  W4= TO.
         B        ENDDB             ---> FINISH UP & ON TO NEXT DEBUG.
         PAGE
IAO      EQU      %
         LW,R7    0,R5              W0 OF DB RECORD HAS BRANCH #.
         LW,R12   B,R7           R12<- BRANCH INSTRUCTION.
         BAL,R7   INITDB
         BAL,R7   HALF              LEFT HALF
         STW,R8   1,R1              W1=  FIRST LOAD INSTRUCTION.
         BAL,R7   HALF              RIGHT HALF
         STW,R8   2,R1              W2= SECOND LOAD INSTRUCTION.
         STW,R12  3,R1              W3= BRANCH INSTRUCTION.
         B        ENDDB             ---> FINISH UP & ON TO NEXT DEBUG.
*
HALF     LW,R11   R7                SAVE RETURN.
         BAL,R6   LOCNAM            EVALUATE NAME.
         B        ABN59             ---> UNRECOGNIZED NAME.
         AND,R8   DBGMSK
         INT,R6   0,R5
         AW,R8    LW,R6
         SLS,R7   17
         AW,R8    R7
         AI,R5    1
         B        *R11
         PAGE
COUNT    EQU      %
         BAL,R7   INITDB
         LCI      3
         LM,R8    0,R5
         STM,R8   1,R1              W123 OF FPT FROM DB RECORD.
         LI,R8    0
         STW,R8   4,R1              W4 IS ZERO.
         B        ENDDB             ---> FINISH UP & ON TO NEXT DEBUG.
         PAGE
*        BAL,R7   INITDB            DO FPTCODE, FLAG, CAL LOC.
* IN:             R1 POINTS TO DEBUG FPT TO BE SET UP.
* IN:             R5 POINTS TO DB RECORD.
* IN:             R6 IS DEBUG RECORD TYPE.
*        RETURN TO 0,R7.
* OUT:            R5 INCREMENTED PAST W0,FLAG,NAME/VALUE OF CAL LOC.
*                 R0,R4,R6,R7,R8,R9,R10 DESTROYED.
INITDB   EQU      %
         STW,R7   TMP+3             SAVE RETURN ADDRESS.
         AI,R6    -6                CONVERT TO FPT CODE.
         SCS,R6   -8                GET TO BITS 0-7.
         STW,R6   0,R1              SET INTO W0 OF FPT.
         LCI      2
         LM,R8    1,R5              GET FLAG TEXT.
         LW,R6    R1
         SW,R6    DBFSTART          GET CURRENT DEBUGFPT.
         SLS,R6   -3                GET CURR DBFPT INDEX.
         STD,R8   *FLAGPAGE,R6      (ALSO IS CURR FLAGTABLE INDEX)
         LI,R7    -1
ADFLG    AI,R7    1                 SEARCH FOR
         CD,R8    *FLAGPAGE,R7      MATCHING FLAG TEXT.
         BNE      ADFLG             ---> NOT YET.
         SW,R7    R6                IS CURRENT ONE ONLY MATCH...
         BEZ      NOFLG             ---> YES.
         SAS,R7   +3                R7 IS BACK DISPL IN DBFPTS.
         AW,R7    R1                R7 POINTS TO PREV DBFPT.
         AI,R7    7                   (WORD 7 IS FLAG WORD)
         AW,R7    Y8                (SIGN BIT SAYS INDIRECT)
NOFLG    STW,R7   7,R1              ZERO OR =>PREV  TO  FPT W7.
         AI,R5    3                 INCREMENT OVER W0 & FLAGNAME.
         BAL,R7   LOCATION       R10<- VALUE OF DEBUG LOCATION.
         B        ABN58             ---> BAD NAME IN LOC EXPRESSION.
         ERRKEY   X'040369'         ---  LOC NOT WITHIN PROGRAM.
         STW,R10  6,R1              REMEMBER LOCATION IN W6 FOR NOW.
         B        *TMP+3            ---> RETURN.
         PAGE
*        B        ENDDB             INSERT CLOBBER AND BUMP FPT PTR.
* IN:             R1 POINTS TO DEBUG FPT TO BE SET UP.
* IN:             R2 POINTS TO CURRENT PLACE IN CLOBBERTABLE.
* IN:             R3 POINTS TO TREE ENTRY FOR CURRENT SEG.
*        RETURN TO DBUG1.
* OUT:            R1 = R1+8.
* OUT:            R2 = R2+2 IF CLOBBER ENTRY MADE.
*                 R7,R8,R10,R11 DESTROYED.
ENDDB    EQU      %
         LW,R10   6,R1           R10= ADDRESS OF CAL.
         LW,R11   BP1               PUT BRANCH TO (CAL ADDR +1)
         AWM,R11  6,R1              INTO FPT W6.
         LI,R7    X'1FFFF'
         AND,R7   10,R3             GET START OF THIS SEG'S CLOBBERS.
CHKLOC1  CW,R7    R2                ANY MORE CLOBBERS...
         BGE      NOLOC             ---> NO. MAKE A NEW ONE.
         CW,R10   0,R7              CLOBBER ALREADY ON OUR LOC...
         BE       YESLOC            ---> YES. CHAIN US TO IT.
         AI,R7    2                 ADVANCE TO NEXT CLOBBER.
         B        CHKLOC1
NOLOC    EQU      %
         LW,R11   CAL               R11 IS CAL1,3 TO REPL INSTR THERE.
         AW,R11   R1
         BAL,R7   ENTCLT            ENTER A NEW CLOBBER INTO TABLE.
         B        CHKLOCEX
YESLOC   EQU      %
         AI,R7    1                 R7 POINTS TO CAL FOR THIS LOC.
         LI,R8    X'1FFFF'            (GET COMPARISON MASK)
YESLOC1  LW,R7    0,R7              R7 FOLLOWS CHAIN OF DEBUG FPTS.
         CW,R8    0,R7              ARE THERE MORE CHAINED...
         BANZ     YESLOC1           ---> YES. KEEP FOLLOWING CHAIN.
         AWM,R1   0,R7              NO. CHAIN NEW FPT TO END.
CHKLOCEX EQU      %
         AI,R1    8                 BUMP FPT POINTER.
         B        DBUG1             ---> GO ON.
         PAGE
*        BAL,R7   ENTCLT            ENTER DOUBLEWORD IN CLOBBER TABLE
* IN:             R2 POINTS TO CURRENT PLACE IN CLOBBER TABLE.
* IN:             R3 POINTS TO TREE ENTRY FOR CURRENT SEG.
* IN:             R10 LOCATION.
* IN:             R11 CONTENTS.
*        RETURN 0,R7.
* OUT:            R2 = R2+2.
*                 R8 DESTROYED.
ENTCLT   EQU      %
         CI,R2    DP                ANY ROOM LEFT...
         BL       ENTCLT2           ---> YES.
         ERROR    X'04035E',ABORT   NO. BAD NEWS.
ENTCLT2  EQU      %
         LI,R8    X'40000'
         AWM,R8   10,R3             2 MORE WORDS OF CLOBBER NOW.
         STD,R10  *R2               INSERT CLOBBER.
         AI,R2    2
         B        0,R7
         PAGE
*        BAL,R7   LOCATION          EVALUATE LOCATION EXPRESSION.
* IN:             R5 => NAME TEXTC, ADDEND.
*        RETURN 0,R7 IF BAD NAME IN EXPRESSION.
*                 R0,R4,R6,R8,R9 DESTROYED.
*        ERROR  1,R7 IF LOCATION NOT IN DATA OR PROCEDURE.
*        RETURN 2,R7 IF OKAY OR AFTER ERRORING.
* OUT:            R5 INCREMENTED PAST NAME & ADDEND.
* OUT:            R8 = VALUE OF LOCATION (32 BITS).
* OUT:            R10= VALUE OF LOCATION (17 BITS).
*                 R0,R4,R6,R9 DESTROYED.
LOCATION EQU      %
         BAL,R6   LOCNAM          R8<- VALUE(NAME)+ADDEND.
         B        0,R7              ---> BAD NAME.  RETURN +0.
         LI,R10   X'1FFFF'
         AND,R10  R8             R10= VALUE(NAME)+ADDEND.
         CLM,R10  DATALIM
         BCR,9    2,R7              ---> LOC IN DATA OKAY. RET +2.
         CLM,R10  PPLIM
         BCR,9    2,R7              ---> LOC IN  PP  OKAY. RET +2.
         ERRORNI  (1,R7)            REPORT CALLER'S ERROR.
         B        2,R7              ---> RETURN +2.
         PAGE
*        BAL,R7   FROMTO            SET UP FROM/TO VALUES.
* IN:             R5 => NAME1 TEXTC, ADDEND1, NAME2 TEXTC, ADDEND2.
*        RETURN 0,R7 IF BAD NAME IN EXPRESSION.
*                 R0,R4,R6,R8,R9,R10 DESTROYED.
*        ERROR  1,R7 IF FROM OR  TO  NOT IN USER AREA.
*        RETURN 2,R7 IF OKAY OR AFTER ERRORING.
* OUT:            R5 INCREMENTED PAST NAMES AND ADDENDS.
* OUT:            R10 = FIRST  NAMEVALUE+ADDENDVALUE. ('FROM')
* OUT:            R11 = SECOND NAMEVALUE+ADDENDVALUE. ( 'TO' )
*                 R0,R4,R6,R8,R9 DESTROYED.
FROMTO   EQU      %
         BAL,R6   LOCNAM          R8<- VALUE(NAME1)+ADDEND1.
         B        0,R7              ---> BAD FROM NAME.  RETURN +0.
         LI,R10   X'1FFFF'
         AND,R10  R8             R10= FROM VALUE.
         BEZ      FROMTO3           ---> OKAY IF ZERO.
         CLM,R10  ALLLIM
         BCR,9    FROMTO3           ---> OKAY IF IN USER AREA.
         ERRORNI  (1,R7)              **  EVIL OTHERWISE.  **
         MTW,-1   ERRFLAG             (NON-ABORTING EVIL, HOWEVER)
FROMTO3  BAL,R6   LOCNAM          R8<- VALUE(NAME2)+ADDEND2.
         B        0,R7              ---> BAD  TO  NAME.  RETURN +0.
         LI,R11   X'1FFFF'
         AND,R11  R8             R11=  TO  VALUE.
         BEZ      2,R7              ---> OKAY IF ZERO.
         CLM,R11  ALLLIM
         BCR,9    2,R7              ---> OKAY IF IN USER AREA.
         ERRORNI  (1,R7)              **  EVIL OTHERWISE.  **
         MTW,-1   ERRFLAG             (NON-ABORTING EVIL, HOWEVER)
         B        2,R7              ---> RETURN +2.
         PAGE
*        BAL,R6   LOCNAM            LOCATE NAME IN SEG'S RFDFSTK.
* IN:             R5 => NAME TEXTC FOLLOWED BY ADDEND VALUE WORD.
*        RETURN 0,R6 IF NOT FOUND.
*                 R0,R4,R8,R9 DESTROYED.
*        RETURN 1,R6 IF FOUND.
* OUT:            R5 INCREMENTED PAST NAME & ADDEND.
* OUT:            R8 = VALUE OF NAME  +  ADDEND.
*                 R0,R4,R9 DESTROYED.
LOCNAM   EQU      %
         LI,R4    0                 SET FOR WA RELOCATION.
LOCNAMR  EQU      %                 (LOCNAMR: R4 = 2BA, 1HA, 0WA, -1DA)
         STW,R5   BADNAME           SAVE ADDRESS OF NAME IN CASE BAD.
BA@R5    LB,R8    *R5
         BEZ      LOCNAM8           ---> NO NAME. RETURN VALUE = 0.
         ANLZ,R0  BA@R5
         AI,R8    +1
         STB,R8   R0                R0= NAMESIZE,BA(NAME) FOR CBS.
         LW,R5    RFDF              R5= WA(RFDFSTK START).
LOCNAM1  ANLZ,R8  BA@R5
         LW,R9    R0
         CBS,R8   12                  (NAME IS 3 WORDS INTO RFDFENTRY)
         BE       LOCNAM2           ---> FOUND IT.
         LB,R8    *R5
         AW,R5    R8
         CW,R5    RFDFTOP
         BL       LOCNAM1           ---> KEEP LOOKING.
         LW,R5    BADNAME           RESTORE R5.
         B        0,R6              ---> CAN'T FIND IT.
LOCNAM2  LW,R8    1,R5            R8=   NAME'S VALUE WORD.
         LW,R9    2,R5              R9= NAME'S RELOCATION WORD.
         BEZ      LOCNAM7           ---> ZERO RESOLUTION IS  WA  .
         LI,R5    -3                R5= RES. -2B, -1H, 0W, 1D.
LOCNAM3  AI,R5    1                   INCREMENT ONE TYPE.
         SCS,R9   +8                R9(24-31) IS CURRENT RESOLUTION.
         CI,R9    X'FF'             ANY OF THIS KIND...
         BAZ      LOCNAM3           ---> NO. KEEP LOOKING.
         BE       LOCNAM6           ---> EXACTLY ONE -1 IS A HIT.
         CI,R9    1                      EXACTLY ONE +1 IS A HIT.
         BNE      LOCNAM7           ---> OTHERWISE USE  WA  .
LOCNAM6  AW,R4    R5                ADD OUR RES TO INPUT RES.
LOCNAM7  SAS,R8   0,R4            R8= NAME'S VALUE WITH PROPER RES.
         LB,R5    *BADNAME          R5= LENGTH OF NAME(BYTES).
         SLS,R5   -2                R5= NAMELENGTH -1(WORDS).
         AW,R5    BADNAME           R5=> LAST WORD OF NAME.
LOCNAM8  AW,R8    1,R5            R8= NAME VALUE + ADDEND.
         AI,R5    2                 INCREMENT PAST NAME & ADDEND.
         B        1,R6              ---> RETURN SKIPPING.
         END      RUNNER

