         SYSTEM    BPM
         SYSTEM    SIG7FDP
         REF      C:DBD
         REF      C:TRN
         DEF      C:DBG,C:TRC,C:TRX
ATBLSZ   EQU      35
#OF%ABBREVIATIONS                   EQU    25
#OF%STMT%BRKS                       EQU    10
#OF%PRCD%BREAKS                     EQU    10
#OF%DATA%BREAKS                     EQU    10
SIZE%OFCOMMAND%STACK                EQU    500
SIZE%OF%STMT%TRACE%TBL              EQU    40
SIZE%OF%PRCD%TRACE%TBL              EQU    20
BKPTS    EQU       10
STMTS    EQU       40
PARAS    EQU       20
WHNSZ    EQU      4
UTS:D    EQU      1
CPV:A    EQU      2
CPV:B    EQU      3
CPV:D    EQU      4                                                     DBGR
MONITOR  EQU      CPV:D                                                 DBGR
         DO       MONITOR=CPV:B
         REF      J:CLM
         ELSE
         DO       MONITOR=UTS:D
J:CLM    EQU      X'8CCF'
         ELSE
         DO       MONITOR=CPV:A
J:CLM    EQU      X'8CD5'
         ELSE                                                           DBGR
         DO       MONITOR=CPV:D                                         DBGR
         REF      MXFPL                                                 DBGR
         FIN                                                            DBGR
         FIN
         FIN
         FIN
REGS     CNAME
         PROC
M        DO       NUM(AF)
AF(M)    EQU      M
         FIN
         PEND
         REGS     R1,R2,R3,R4,R5,R6,R7,R8,R9,R10,R11,R12,R13,R14,R15
*  PRECEDING LINE GENERATES THE EQUATES FOR R1 THRU R15
         PAGE
*
*        ENTER DEBUG BEFORE EACH STATEMENT
*
C:DBG    STW,11    SAVE11
         MTW,1     SAVE11
         MTW,1     PTRS
         LW,5      PTRS
         CW,5      MAXS
         BLE       %+3
         LW,5      MINS
         STW,5     PTRS
         LW,5      *11
         STW,5     *PTRS
         LI,R7    SBREAKS-1
         LI,R3    0
DBG:00   RES      0
         AI,R3    1
         AI,R7    1                 NEXT TABLE POSITION.
         LW,R6    0,R7
         BEZ      DBG:00            UNUSED..TRY AGAIN
         BLZ      DBG:10            ALL DONE
         CW,R5    SBREAKT,R3        IS IT A MATCH
         BNE      DBG:00            NO MATCH, KEEP TRYIN'
         BAL,R9   PULLNAME          GET ':'
         BAL,R9   PULLNAME          GET PROGNAME
         STW,R6   PULLADDR          SAVE CMD POINTER
         MTW,1    READCMD
         MTW,1    PULLFLAG
         B        BRKS
DBG:10   RES      0
         MTW,0     NEXTF
         BNEZ      BRKS
         MTW,0     LISTSF
         BEZ       %+2
         BAL,10    TYPES
BREAKD   RES      0
         LW,R7    WHNSIZE
BRKD:00  RES      0
         LW,R6    WHNTBL-1,R7
         BNEZ     BRKD:10
BRKD:01  RES      0
         BDR,R7   BRKD:00
         B        *SAVE11
BRKD:10  RES      0
         LW,R5    PGMLOC-1,R7
         LW,R4    DBGLOC-1,R7
         CBS,R4   0
         BE       BRKD:01
         LW,R5    DBGLOC-1,R7
         LW,R4    PGMLOC-1,R7
         LI,R6    WHNTBL-1          SET PULL START                      DBGR
         AW,R6    R7                                                    DBGR
         MBS,R4   0
         BAL,R9   PULLNAME          MOVE NAME TO STRING
         STW,R6   PULLADDR          SAVE CMD POINTER                    DBGR
         LI,6      DBREAK
         BAL,7     TYPENC
         LI,R6    STRING
         BAL,R7   TYPE              TYPE NAME WHICH CAUSED BREAK
         LW,R6    PULLADDR                                              DBGR
         BAL,R9   PULLNAME          SKIP :                              DBGR
         BAL,R9   PULLNAME          SKIP PROGRAM-ID                     DBGR
         STW,R6   PULLADDR                                              DBGR
         MTW,1    READCMD                                               DBGR
         MTW,1    PULLFLAG                                              DBGR
         B         BREAK1
BRKS     RES      0
         LI,R6    0
         STW,R6   NEXTF             TURN OFF NEXT STMT FLAG
BRKS0    RES      0
         LI,R6    SBREAK            GIVE BREAK MSSG
         BAL,7     TYPENC
         B         BREAK1
BRKP     RES      0
         LI,R6    0
         XW,R6    NEXTPF            TURN OFF NEXTP FLAG
         BGZ      BRKS0             NOT FIRST TIME
         B        NEXT              FIRST TIME...NO BREAK MSSG
         PAGE
*
*   PRINTX---PRINT AN IDENTIFIER IN HEXADECIMAL FORMAT
*
PRINTX   RES      0
         LI,R6    -1
         STW,R6   HEXSW             SET HEXADECIMAL SWITCH
         B        PRINT
         PAGE
*
*   STOP---STOP AT THIS BREAKPOINT
*
STOP     RES      0
         B        NEXT:RESET                                            DBGR
         PAGE
*
*        NEW TRACE - RECORDS PAR. NAME ANYWAY
*
C:TRC    MTW,0     *X'4F'
         BLZ       C:TRX+2
         STW,6     C:TRCPL+2
         CAL1,2    C:TRCPL
C:TRX    MTW,0     *X'4F'
         BGZ       *11
C:TRXS   RES      0
         STW,R11  SAVE11
         MTW,1     PTRP
         LW,5      PTRP
         CW,5      MAXP
         BLE       %+3
         LW,5      MINP
         STW,5     PTRP
         STW,6     *PTRP
         MTW,0     LISTPF
         STW,R6   NAMPTR            SAVE POINTER TO PNAME
         BEZ       %+2
         BAL,7     TYPE
         LI,R7    PBREAKS-1
TRC:30   RES      0
         AI,R7    1
         LW,R6    0,R7
         BEZ      TRC:30
         BLZ      TRC:40
         LI,R3    0
         LB,R4    R6
TRC:310  RES      0
         LW,R8    0,R6
TRC:314  RES      0
         CW,R8    *NAMPTR,R3
         BNE      TRC:312
         AI,R3    1
         AI,R6    1
         BDR,R4   TRC:310
*  FOUND A MATCH
         BAL,R9   PULLNAME          GET ':' OR '.'
         LW,R9    ACOLON
         CW,R9    STRING
         BE       TRC:313
         BAL,R9   PULLNAME
         BAL,R9   PULLNAME
TRC:313  RES      0
         BAL,R9   PULLNAME
         STW,R6   PULLADDR
         MTW,1    READCMD
         MTW,1    PULLFLAG
         MTW,1    NEXTPF                                                DBGR
         B        BRKP
TRC:312  RES      0
         CW,R8    =X'00FE0000'
         BANZ     TRC:32
         LW,R6    0,R6
         B        TRC:310
TRC:32   RES      0
         CI,R4    1                 LAST WORD
         BNE      TRC:30
         AW,R3    NAMPTR
         LB,R9    *R3
         CB,R9    R8
         BNE      TRC:30
TRC:34   RES      0
         LB,R9    R8,R4
         CI,R9    X'40'
         BNE      %+2
         STB,R9   *R3,R4
         AI,R4    1
         CI,R4    4
         BL       TRC:34
         SW,R3    NAMPTR
         LI,R4    0                 GOT TO BE LAST COMPARE
         B        TRC:314
TRC:40   RES      0
         MTW,0    NEXTPF            ARE WE IN NEXTP
         BEZ      *R11              NO...GET OUT
         B        BRKP              YES...GO DO IT
         PAGE
*
*   BREAK---HANDLE BREAK KEY INTERUPT
*
BREAK    RES      0
         LW,R6    0,R1
         AND,R6   =X'1FFFF'
         CLM,R6   MYLIMITS          ARE WE IN DEBUGGER
         BCS,9    BRKNXT            NO...BRK AT NXT STMT
         LI,R6    DBGBRK            YES.
         STW,R6   0,R1              GOT TO MSG
         M:TRTN                     GO BACK
DBGBRK   RES      0
         LI,R6    MYBRK
         BAL,R7   TYPE
         LI,R6    0
         STW,R6   CONTINUE
         STW,R6   READCMD
         STW,R6   PULLFLAG
         B        NEXT
BRKNXT   RES      0
         MTW,1    NEXTF             BREAK AT NEXT  STATEMENT
         M:TRTN                     GO BACK
*
*
BREAK1   RES      0
         LW,R5    B11               SET RETURN TO PROGRAM
         STW,5     RETURN
         LI,5      0
         STW,5     NEXTF
         LW,6      *PTRP
         BEZ       %+2
         BAL,7     TYPENC
         LI,R6    TWOSPC
         BAL,R7   TYPENC            SEPARATE PNAME, STMT
         LW,5      *PTRS
         BAL,10    TYPES
         B        NEXT
         PAGE
NEXT     RES      0
         MTW,0    READCMD           READ COMMAND
         BE       NEXTR             YES. GO DO IT
         MTW,0    PULLFLAG          NO. MORE TO PULL
         BE       NEXTRST           NO. RESET & READ
         MTW,0    CONTINUE          VALID TO CONTINUE
         BNE      NEXT:ER           NO. REPORT ERROR
         LW,R6    PULLADDR
         BAL,R9   PULLNAME          YES. PULL STRING
         STW,R6   PULLADDR
         LI,R6    STRING
         BAL,R7   TYPENC            PRINT STRING
         LB,R6    STRING
         STB,R6   MOV:CMD
         LW,R7    MOV:CMD
         LI,R6    BA(STRING)+1
         MBS,R6   0                 MOVE CMD TO INP BUFFR
         LI,R6    0
         STW,R6   NOLOOKI           RESET NOLOOKI
         B        NEXT00
NEXT:ER  RES      0
         LI,R6    NXT%ERR
         BAL,R7   TYPE
NEXT:RESET RES    0                                                     DBGR
         LI,R7    0
         STW,R7   PULLFLAG
NEXTRST  RES      0                                                     DBGR
         LI,R7    0                 RESET                               DBGR
         STW,R7   CONTINUE          .BOTH                               DBGR
         STW,R7   READCMD           ..FLAGS, GO ON                      DBGR
NEXTR    RES      0
         M:READ   M:UC,(BUF,BUFF),(SIZE,80)
NEXT00   RES      0
         LI,R5    BA(BUFF)
NEXT0    RES      0
         BAL,R9   GETSTRING         ISOLATE COMMAND STRING
         MTW,-1   LENGTH
         LI,R6    BA(COMMANDS)-2
         LW,R7    LENGTH
         STB,R7   CMP:CMD
NEXT10   RES      0
         AI,R6    2                 ADJUST FOR LENGTH, LINK
         LB,R7    0,R6
         CW,R7    LENGTH            CHECK FOR SAME LENGTH
         BE       NEXT20
         BG       INVALID
         AW,R6    R7                SKIP TO NEXT COMMAND
         B        NEXT10
NEXT20   RES      0
         LW,R7    CMP:CMD
         CBS,R6   1
         BE       NEXT30
         BG       INVALID
         SLS,R7   -24
         AW,R6    R7
         B        NEXT10            TRY NEXT COMMAND
NEXT30   RES      0
         AI,R6    1
         LB,R7    0,R6
         B        %+1,R7            JUMP TO COMMAND PROCESSING
         B        AT                AT
         B        GO                GO
         B        END               END
         B        OFF               OFF
         B        SET               SET
         B        DROP              DROP
         B        HELP              HELP
         B        WHEN              WHEN
         B        STOP              STOP
         B        IF                IF
         B        LISTBRKS          LISTBRKS
         B        NXT               NEXT
         B        NEXTP             NEXTP
         B        OFFP              OFFP
         B        OFFS              OFFS
         B        NOTRACE           OFFWN
         B        PTRACE            PTRACE
         B        RUN               RUN
         B        STRACE            STRACE
         B        DUMP              DUMP
         B        EQUATE            EQUATE
         B        LISTFILE          LISTFILE
         B        PRINT             PRINT
         B        PRINTX            PRINTX
         B        DELETE            DELEDTE
         B        INSERT            INSERT
         B        REPLACE           REPLACE
         B        SOURCE            SOURRCE
         B        SETFILES          SETFILES
         B        SLIST             SLIST
         B        PLIST             PLIST
         B        NEXT0             BLANKS AHEAD OF COMMAND
         B        QUALIFY           QUALIFY
         PAGE
*
* INITIALIZE DEBUGGER
         DEF      C:DB1
C:DB1    RES      0
         STW,11   SAVE11
         MTW,1    SAVE11
         MTW,-1   NEXTPF
         LI,6      HELLO
         BAL,7     TYPE
         M:INT    CAL1
         LW,R3    SAVE11
         STW,R3   LOWP
         LW,R5    SAVE11
         LW,R5    *R5
         LW,R5    1,R5
         STW,R5   BALTRC
*
*   GET ROOT REF/DEF STACK INTO CORE
*
GETSYMS  RES      0                                                     DBGR
*                                                                       DBGR
         DO       MONITOR=CPV:D     IF D00 CPV                          DBGR
         LI,R7    MXFPL             GET M:XX FPT LIST                   DBGR
         LCI      10                GET FPTS                            DBGR
         LM,R1    0,R7                                                  DBGR
         AND,R2   =X'0FFFFFFF'      GET RID OF MONITOR SET Y2 BIT       DBGR
         LCI      10                STORE IT AWAY                       DBGR
         STM,R1   FPTX+7                                                DBGR
*                                                                       DBGR
         ELSE                                                           DBGR
         LI,7     J:CLM                                                 DBGR
         LCI      7                 GET ACCOUNT PASSWORD NAME           DBGR
         LM,R2    0,R7                                                  DBGR
         LCI      2                                                     DBGR
         STM,R2   FPTX+12           STORE ACCOUNT                       DBGR
         LCI      3                                                     DBGR
         STM,R6   FPTX+8            STORE NAME                          DBGR
         CI,R4    0                 IS THERE A PASWORD ASSUME NOT IF ZERODBGR
         BEZ      GETSYM:OPEN       BRANCH IF NOT                       DBGR
         LCI      2                                                     DBGR
         STM,R4   FPTX+15           STORE PASSWORD                      DBGR
         LI,R2    2                 SET PRESENT FLAG                    DBGR
         STB,R2   FPTX+14,R2                                            DBGR
         FIN                                                            DBGR
*                                                                       DBGR
GETSYM:OPEN RES   0                                                     DBGR
*                                                                       DBGR
,FPTX    M:OPEN   M:BI,(FILE,'GARBAGED','ACCOUNT'),(PASS),;             DBGR
                  (KEYED),(DIRECT),(IN),;                               DBGR
                  (ERR,BADLM),(ABN,BADLM)                               DBGR
         M:READ M:BI,(BUF,BUFF),(WAIT),(SIZE,48),(KEY,HEADKEY)
         MTW,-1   LOWP
         LW,R2    BUFF+3
         SLS,R2   -15               SIZE OF PROGRAM
         STW,R2   SIZEP             STORED AWAY
         LW,R2    BUFF+3
         AND,R2   =X'FFFF'
         SLS,R2   1                 LOW ADDRESS OF PROG
         SW,R2    LOWP              MINUS PROGRAM START
         AWM,R2   SIZEP             USED TO ADJUST SIZE
         LW,R2    BUFF+5
         AND,R2   =X'FFFF'
         STW,R2   TREE:SZ           SAVE TREE SIZE
         LH,R2    BUFF+5
         AND,R2   =X'FFFF'
         STW,R2   RFDFSZ            REF/DEF STACK SIZE
         SLS,R2   2                 IN BYTES
         STW,R2   SYMSIZE           SYMBOL SIZE
         LW,R2    RFDFSZ
         AI,R2    511
         SLS,R2   -9                # OF PAGES NEEDED
         STW,R2   GTPAGE
         M:GP     *GTPAGE           GET REF/DEF BUFFER
         BCS,8    NOPAGES
         STW,R9   SYMBUF
         STW,R9   REFDEF
XXX      LCI       3
         LM,R6    FPTX+8
GETSYM   RES      0
         MTB,1     6
         LB,4      6
         CI,4      11
         BLE       %+2
         LI,4      11
         LI,R3    0
         STB,4     6
         STB,3     6,4
         LCI       3
         STM,6     TAILKEY
         M:READ   M:BI,(BUF,*SYMBUF),(SIZE,*SYMSIZE),;
                  (KEY,TAILKEY),(ERR,BADSYM)
         M:CLOSE   M:BI
         LW,R6    SYMSIZE
         SLS,R6   -2
         AW,R6    SYMBUF
         STW,R6   SYMEND
*
*        NOW OPEN SOURCE AND DEBUG FILES
*
GETSI    RES      0
         LI,6      SFNAME
         BAL,7     TYPENC
         M:READ M:UC,(BUF,BUFF),(SIZE,80)
         LI,5      0
SF1      RES      0
         STB,R5   FPTS+10
         LB,4      BUFF,5
         CB,4      CAR
         BE       SF1:1                                                 DBGR
         CB,4     LINE:FEED                                             DBGR
         BE       SF1:1                                                 DBGR
         AI,5      1
         STB,R4   FPTS+10,R5
         B         SF1
SF1:1,FPTS M:OPEN M:SI,(FILE,'GARBAGED'),(KEYED),(DIRECT),;             DBGR
                  (BUF,BUF1),(RECL,80),(INOUT),(ERR,GETSI),(ABN,GETSI)
         BAL,R10  GET%ID            GET PROGRAM-ID FROM SI FILE         DBGR
         B        GETSI1            COULDNT FIND IT.                    DBGR
         BAL,R10  GET:DEF           FIND DEF ADDR FOR W:PROGRAM-ID      DBGR
         B        GETSI1            MUST BE MAIN PROG NO W:PROG-ID      DBGR
         B        GETSI2            SAVE BEG OF CALLED PROG W/S         DBGR
GETSI1   RES      0                                                     DBGR
         LW,R6    DEFWK1            DEF%WK                              DBGR
         STW,R6   DEFNAM                                                DBGR
         LW,R6    DEFWK2                                                DBGR
         STW,R6   DEFNAM+1                                              DBGR
         LB,R6    DEFNAM            PICK UP LENGTH (TEXTC)              DBGR
         STW,R6   DEFNAML           STORE LENGTH                        DBGR
         BAL,R10  GET:DEF           GET W/S ADDR FOR DEF%WK             DBGR
         B        INVALID           NOT THERE ERROR                     DBGR
GETSI2   RES      0                                                     DBGR
         LW,R6    DEFLOC            GET ADDR OF W/S                     DBGR
         STW,R6   WRKLOC            SAVE FOR LATER USAGE                DBGR
         LW,R6    DEFCOM1           PICK UP TEXTC TALLY                 DBGR
         STW,R6   DEFNAM                                                DBGR
         LW,R6    DEFCOM2           PICK UP REST OF TALLY               DBGR
         STW,R6   DEFNAM+1                                              DBGR
         LB,R6    DEFNAM            PICK UP LENGTH                      DBGR
         STW,R6   DEFNAML                                               DBGR
         BAL,R10  GET:DEF           GET ADDR OF TALLY C/S               DBGR
         B        INVALID           NOT THERE ERROR                     DBGR
         LW,R6    DEFLOC            PICK UP ADDR OF TALLY               DBGR
         STW,R6   COMLOC            SAVE COMMON STORAGE ADDR FOR LATER  DBGR
         M:SETDCB M:SI,(ERR,ERM1),(ABN,ERM1)
SF2      LI,6      DFNAME
         BAL,7     TYPENC
         M:READ M:UC,(BUF,BUFF),(SIZE,80)
         LI,5      0
DF1      RES      0
         STB,R5   FPTC+9
         LB,4      BUFF,5
         CB,4      CAR
         BE       DF2                                                   DBGR
         CB,4     LINE:FEED                                             DBGR
         BE       DF2                                                   DBGR
         AI,5      1
         STB,R4   FPTC+9,R5
         B         DF1
DF2,FPTC M:OPEN   M:CI,(FILE,'GARBAGED'),(KEYED),(DIRECT),;             DBGR
                  (RECL,88),(INOUT),(ERR,SF2),(ABN,SF2)
         M:SETDCB M:CI,(ERR,NAMERR),(ABN,NAMERR)
         M:PC     '>'               ESTABLISH PROMPT CHARACTER
         M:XCON   C:EXIT              AND EXIT CONTROL
         M:INT    BREAK             AND BREAK CONTROL
         M:TRAP   C:TRP,(TRAP,ALL)
         B        C:DBG
*
BADSYM   RES      0
         LI,R6    OLAYMSG
         BAL,R7   TYPENC
         M:READ   M:UC,(BUF,BUFF),(SIZE,80)
         LW,R6    =X'40404040'
         LW,R7    =X'40404040'
         LI,R5    0
BADSYM0  RES      0
         LB,R4    BUFF,R5
         CI,R4    X'15'
         BE       BADSYMND
         CI,R4    X'0D'
         BE       BADSYMND
         AI,R5    1
         STB,R4   R6,R5
         B        BADSYM0
BADSYMND RES      0
         STB,R5   R6
         B        GETSYM
OLAYMSG  TEXTC    'OVERLAID PROGRAM***SEGN='
*                                                                       DBGR
BADLM    RES      0                 UNABLE TO OPEN LOAD MODULE          DBGR
         LI,R6    BAD:LM            ISSUE MESS                          DBGR
         BAL,R7   TYPE                                                  DBGR
         B        END               QUIT ON THE GUY                     DBGR
*                                                                       DBGR
BAD:LM   TEXTC    'UNABLE TO READ LOAD MODULE'                          DBGR
NAMERR   RES      0
         STW,R7   NS7
         LW,R7    R8
         LW,R7    -1,R7             CAL TO R7
         AND,R7   =X'1FFFF'         FPT ADDR
         LW,R8    1,R7              IS ERR PRESENT
         BGE      ERM6
         LW,R8    2,R7              GET ERR ADDR
         LW,R7    NS7
         B        *R8
NS7      RES      1
         PAGE
* EXIT TO TEL
END      M:EXIT
         PAGE
* TURN ON STATEMENT LISTER
STRACE   RES      0
         STW,5     LISTSF
         LW,R6    PUNCTUATION
         CI,R6    BLANK             END WITH BLANK
         BNE      NEXT              NO.
         BAL,R9   GETSTRING         YES. CHK FOR 'OFF'
         LW,R6    STRING
         CW,R6    =X'03D6C6C6'
         BNE      INVALID           ERROR
         LI,R6    0
         STW,R6   LISTSF            TURN LIST OFF
         B         NEXT
         PAGE
* TURN ON PARAGRAPH LISTER
PTRACE   RES      0
         STW,5     LISTPF
         LW,R6    PUNCTUATION       ENDED WITH CARRIAGE RETN
         CI,R6    BLANK             END WITH BLANK
         BNE      NEXT              NO.
         BAL,R9   GETSTRING         YES. CHK FOR OFF
         LW,R6    STRING
         CW,R6    =X'03D6C6C6'
         BNE      INVALID
         LI,R6    0
         STW,R6   LISTPF            TURN LIST OFF
         B         NEXT
         PAGE
* DUMP STATEMENT BUFFER
SLIST    RES      0
         LW,R6    PUNCTUATION
         CI,R6    COMMA
         BE       SLIST:R
         LW,R5    PTRS
         STW,5     TEMP
STYPE1   MTW,1     TEMP
         LW,5      *TEMP
         BEZ       %+2
         BAL,10    TYPES
         LW,5      TEMP
STYPE2   CW,5      PTRS
         BE       SLST:10
         CW,5      MAXS
         BL        STYPE1
         LW,5      MINS
         STW,5     TEMP
         B         STYPE1+1
SLST:10  RES      0
         LW,R6    PUNCTUATION
         CI,R6    CARRET
         BE       NEXT
         B        NO:CONT           CAN'T BE CONTINUED
SLIST:R  RES      0
         BAL,R9   GETSTRING
         BAL,R9   DECBIN
         LW,R1    STRING            # OF STMTS TO SHOW
         LW,R5    PTRS
         STW,R5   TEMP
         LW,R5    *TEMP                                                 DBGR
         BAL,R10  TYPES             START WITH CURRENT                  DBGR
         AI,R1    -1                                                    DBGR
         BLEZ     SLST:10                                               DBGR
SLIST:R1 RES      0
         MTW,-1   TEMP
SLIST:R0 RES      0
         LW,R5    *TEMP
         BEZ      %+2
         BAL,R10  TYPES
         LW,R5    TEMP
         CW,R5    PTRS
         BE       SLST:10
         CW,R5    MINS
         BG       SLIST:R5
         LW,R5    MAXS
         STW,R5   TEMP
SLIST:R5 RES      0
         BDR,R1   SLIST:R1
         B        SLST:10
NO:CONT  RES      0
         LI,R6    NOCONTM
         BAL,R7   TYPE
         B        NEXT
         PAGE
* DUMP PARAGRAPH BUFFER
PLIST    RES      0
         LW,R6    PUNCTUATION
         CI,R6    COMMA
         BE       PLIST:R
         LW,R5    PTRP
         STW,5     TEMP
PTYPE1   MTW,1     TEMP
         LW,6      *TEMP
         BEZ       %+2
         BAL,7     TYPE
         LW,5      TEMP
PTYPE2   CW,5      PTRP
         BE       SLST:10           GO CHK FOR CONTINUE AFTER
         CW,5      MAXP
         BL        PTYPE1
         LW,5      MINP
         STW,5     TEMP
         B         PTYPE1+1
PLIST:R  RES      0
         BAL,R9   GETSTRING
         BAL,R9   DECBIN
         LW,R1    STRING            # OF PNAMES TO SHOW
         LW,R5    PTRP
         STW,R5   TEMP
         LW,R6    *TEMP                                                 DBGR
         BAL,R7   TYPE              START WITH CURRENT                  DBGR
         AI,R1    -1                                                    DBGR
         BLEZ     SLST:10                                               DBGR
         MTW,0    PULLFLAG                                              DBGR
         BNEZ     AT:CMD71                                              DBGR
PLIST:R1 RES      0
         MTW,-1   TEMP
PLIST:R0 RES      0
         LW,R6    *TEMP
         BEZ      %+2
         BAL,R7   TYPE
         LW,R5    TEMP
         CW,R5    PTRP
         BE       SLST:10
         CW,R5    MINP
         BG       PLIST:R5
         LW,R5    MAXP
         STW,R5   TEMP
PLIST:R5 RES      0
         BDR,R1   PLIST:R1
         B        SLST:10
         PAGE
*
*   HELP---LIST DEBUGGER COMMANDS
*
HELP     RES      0
         LI,R6    HELPM
HELP:00  RES      0
         BAL,R7   TYPE
         LB,R4    *R6
         BEZ      NEXT
         SLS,R4   -2
         AW,R6    R4
         AI,R6    1
         B        HELP:00
         PAGE
* TYPE ANY TEXTC STRING - SUPPLIES CR
TYPE     STW,6     FPT+2
         CAL1,2    FPT
         CAL1,2   FPT2
         B         *7
*        TYPES WITHOUT CR
TYPENC   STW,6     FPT+2
         CAL1,2    FPT
         B         *7
*
* TYPE LINENO|.SUBLINENO~
*
TYPES    RES      0
         LW,R6    R5                GET STATEMENT #
         BAL,R9   DECODE            DECODE IT,
         M:WRITE  M:UC,(BUF,BUFFR),(SIZE,13)
         B        *R10
         PAGE
*
*   OFFP---REMOVE ALL PROCEDURE-NAME BREAKPOINTS
*
OFFP     RES      0
         LI,R3    0
         LI,R7    PBREAKS-1
         BAL,R9   REMOVE
         B        NEXT
         PAGE
*
*   OFFS---REMOVE ALL STATEMENT BREAKPOINTS
*
OFFS     RES      0
         LI,R3    0
         LI,R7    SBREAKS-1
         BAL,R9   REMOVE
         B        NEXT
         PAGE
*
*   RUN---REMOVE ALL THREE KINDS OF BREAKPOINTS, THEN GO
*
RUN      RES      0
         STW,R5   R2                SAVE FOR GETSTRING                  DBGR
         LI,R3    0
         LI,R7    PBREAKS-1         REMOVE
         BAL,R9   REMOVE            PBREAKS
         LI,R7    SBREAKS-1
         BAL,R9   REMOVE            SBREAKS
         LW,R5    WHNSIZE
RUN:00   RES      0
         STW,R3   WHNTBL-1,R5
         BDR,R5   RUN:00            DATA BREAKS
         LW,R5    R2                RESTORE FOR GETSTRING               DBGR
         B        GO                NOW DO A GO
         PAGE
*
*   REMOVE
*
REMOVE   RES      0
         AI,R7    1
         LW,R6    0,R7              NEXT INDEX
         BEZ      REMOVE            NONE TRY AGAIN
         BLZ      *R9               ALL DONE
         LW,R6    R7                SET INITIAL POINTER
REMOVE0  RES      0
         LW,R5    0,R6              NEXT DYNAMIC WORD
         BEZ      REMOVE            END OF THIS CHAIN
         STW,R3   0,R6              ZERO THIS WORD
         AI,R6    1                 NEXT WORD OF CHAIN
         CW,R5    =X'00FE0000'      WAS THIS WORD A POINTER
         BANZ     REMOVE0           NO. KEEP ON
         LW,R6    R5                YES. FOLLOW POINTER
         B        REMOVE0
         PAGE
* TURN OFF SPECIFIED BKPT
OFF      RES      0
         BAL,R9   LOCATE
         B        OFF:S
         LI,R6    0
         STW,R6   SLENTH
         LW,R6    LENGTH
         AI,R6    3
         STB,R6   MOV%PAR
         SLS,R6   -2
         STW,R6   PLENTH
         LI,R2    BA(STRING)
         LW,R3    MOV%PAR
         MBS,R2   0
         LW,R6    PUNCTUATION
         CI,R6    CARRET
         BE       OFF:DFLT
         CI,R6    BLANK
         BNE      OFF:20
         BAL,R9   GETSTRING
         LW,R6    LENGTH
         CI,R6    2
         BNE      INVALID
         LH,R6    STRING
         CH,R6    ='IN'
         BE       OFF:10
         CH,R6    ='OF'
         BNE      INVALID
OFF:10   RES      0
         LW,R6    PUNCTUATION
         CI,R6    BLANK
         BNE      INVALID
         BAL,R9   GETSTRING
         LI,R2    BA(STRING)
         LW,R6    LENGTH
         AI,R6    3
         STB,R6   MOV%SEC
         SLS,R6   -2
         STW,R6   SLENTH
         LW,R3    MOV%SEC
         MBS,R2   0
         LW,R6    PUNCTUATION
         CI,R6    CARRET
         BE       OFF:DFLT
OFF:20   RES      0
         CI,R6    COLON
         BE       OFF:22
         CI,R6    SEMICOL
         BNE      INVALID
         B        OFF:DFLT
OFF:22   RES      0
         BAL,R9   GETSTRING
         LI,R2    BA(STRING)
         LW,R3    LENGTH
OFF:23   RES      0
         AI,R3    3
         STB,R3   MOV%PRG
         SLS,R3   -2
         STW,R3   PRLENTH
         LW,R3    MOV%PRG
         MBS,R2   0
* ALL SET, NOW FIND THE BREAK AND DROP IT
         LI,R7    PBREAKS-1
OFF:30   RES      0
         AI,R7    1
         LW,R6    0,R7
         BEZ      OFF:30
         BGZ      OFF:31
         B        INVALID
OFF:31   RES      0
         LI,R3    0
         LB,R4    R6
         CW,R4    PLENTH
         BNE      OFF:30
OFF:310  RES      0
         LW,R8    0,R6
         CW,R8    PNAME,R3
         BNE      OFF:312
         AI,R3    1
         AI,R6    1
         BDR,R4   OFF:310
         B        OFF:35
OFF:312  RES      0
         CW,R8    =X'00FE0000'
         BANZ     OFF:30
         LW,R6    0,R6
         B        OFF:310
OFF:35   RES      0
         LI,R3    0
         CW,R3    SLENTH
         BE       OFF:40
         LW,R6    0,R6
         LB,R4    R6
         CW,R4    SLENTH
         BNE      OFF:30
OFF:350  RES      0
         LW,R8    0,R6
         CW,R8    SNAME,R3
         BNE      OFF:352
         AI,R3    1
         AI,R6    1
         BDR,R4   OFF:350
         B        OFF:40
OFF:352  RES      0
         CW,R8    =X'00FE0000'
         BANZ     OFF:30
         LW,R6    0,R6
         B        OFF:350
OFF:40   RES      0
         LW,R6    0,R6                                                  DBGR
         LW,R8    0,R6
         CW,R8    =X'017A4040'      IS IT COLON PUNCTUATION
         BNE      INVALID           NO.  ..WRONG
         LI,R3    0
         AI,R6    1                                                     DBGR
         LW,R6    0,R6
         LB,R4    R6
         CW,R4    PRLENTH
         BNE      OFF:30
OFF:400  RES      0
         LW,R8    0,R6
         CW,R8    PRNAME,R3
         BNE      OFF:454
         AI,R3    1
         AI,R6    1
         BDR,R4   OFF:400
         B        OFF:45
* MATCHES UP, NOW DROP IT
OFF:45   RES      0
         LI,R3    0
         LW,R6    R7                                                    DBGR
         LW,R4    =X'00FE0000'
         B        OFF:452                                               DBGR
OFF:450  RES      0
         CW,R4    0,R6
         BAZ      OFF:452           NEW POINTER
         STW,R3   0,R6              ZERO CHAIN WORD
         AI,R6    1
         B        OFF:450
OFF:452  RES      0
         LW,R8    0,R6
         STW,R3   0,R6
         BEZ      NEXT              CHAIN OUT--AL DONE
         LW,R6    R8                PICK CHAIN
         B        OFF:450
OFF:454  RES      0
         CW,R8    =X'00FE0000'
         BANZ     OFF:30
         LW,R6    0,R6
         B        OFF:400
OFF:S    RES      0
         LI,R3    -1
OFF:S00  RES      0
         AI,R3    1
         LW,R6    SBREAKS,R3
         BLZ      INVALID
         BEZ      OFF:S00
         LW,R6    SBREAKT+1,R3
         CW,R6    STATEMENT
         BNE      OFF:S00
         LI,R6    0
         STW,R6   SBREAKS,R3
         B        NEXT
OFF:DFLT RES      0
         LI,R2    BA(DEFAULT)
         LW,R3    DEFAULTL          DEFAULT PROG NAME
         B        OFF:23
         PAGE
* TURN ON SPECIFIED BKPT
AT       RES      0
         BAL,R9   LOCATE
         B        AT:STATE          LOCATION IS STATEMENT
         LI,R7    PBREAKS-1
AT:PAR0  RES      0
         AI,7     1                 SET TO NEXT PNAME BRK
         LW,R6    0,R7              IS IT AVAILABLE
         BEZ      AT:PAR2           YES. GO ON
         BGZ      AT:PAR0           NO. TRY NEXT
         LI,R6    ERR2              OUT OF ENTRIES
         BAL,R7   TYPE              TELL THE USER
         B        NEXT              GET NEXT COMMAND
AT:PAR2  RES      0
         STW,R7   FSTLNK            SET END OF CIRCULAR CHAIN
         LI,R4    DYNAMIC-1         START SEARCH  AT 0
         BAL,R9   STORE             STORE PNAME  IN DYNAMIC
         LW,R6    PUNCTUATION
         CI,R6    BLANK             WAS STRING ENDED WITH BLANK
         BNE      AT:PAR6           NO..GO HANDLE PROG-NAME
         BAL,R9   GETSTRING         GET IN/OF
         LW,R3    PUNCTUATION
         CI,R3    BLANK             MUST BE ENDED WITH BLANK
         BNE      QUALERR
         LW,R6    LENGTH
         CI,R6    2
         BNE      QUALERR
         LH,R6    STRING
         AND,R6   =X'FFFF'
         CLM,R6   IN:OF
         BCR,12   %+2
         BCS,3    QUALERR
         BAL,R9   STORE
         BAL,R9   GETSTRING
         BAL,R9   STORE             STORE SECTION NAME
         LW,R6    PUNCTUATION
AT:PAR6  RES      00
         CI,R6    COLON
         BNE      AT:PAR7
         BAL,R9   STRCOLON          STORE COLON
         BAL,R9   GETSTRING         GET PROG NAM
         BAL,R9   STORE             STORE IN DYNAMIC
         B        AT:PAR8           GO PROCESS ATTACHED CMDS
AT:PAR7  RES      0
         BAL,R9   STRCOLON          STORE SEPARATOR COLON
         LW,R6    DEFAULT           MOVE DEFAULT PROG NAME
         STW,R6   STRING
         LW,R6    DEFAULT+1           TO STRING
         STW,R6   STRING+1
         LW,R6    DEFAULTL
         STW,R6   LENGTH
         BAL,R9   STORE             STORE IT
AT:PAR8  RES      0
         LW,R6    PUNCTUATION
         CI,R6    SEMICOL
         BE       AT:PAR9
         CI,R6    CARRET
         BNE      AT:PAR9
         LW,R6    STOPPR            STORE
         STW,R6   STRING
         LW,R6    STOPPR+1
         STW,R6   STRING+1
         LW,R6    STOPPRL             IMPLIED
         STW,R6   LENGTH
         BAL,R9   STORE                 STOP COMMAND
         B        AT:CMD4
AT:PAR9  RES      0
         LI,R3    1
AT:CMD0  RES      0
         LB,R6    0,R5              GET BUFFER CHAR
         STB,R6   STRING,R3         AND MOVE TO 'STRING'
         CI,R6    ';'               END OF COMMAND
         BE       AT:CMD2
         CI,R6    X'0D'
         BE       AT:CMD6
         CI,R6    X'15'
         BE       AT:CMD6
         AI,R5    1                 NEXT CHAR. IN
         AI,R3    1                 ..AND OUT
         B        AT:CMD0
AT:CMD2  RES      0
         AI,R3    1
         LI,R6    X'0D'             END STRING WITH RETURN
         STB,R6   STRING,R3
         STW,R3   LENGTH
         STB,R3   STRING
         BAL,R9   STORE             SAVE COMMAND STRING
         LW,R7    R4                SET NEW FLINK
         AI,R5    1
         BNEZ     AT:PAR9           GO BACK FOR NXT CMD
AT:CMD3  RES      0                                                     DBGR
         LW,R6    GOPR              SE WE HAVE COMMANDS DO DEFUALT GO   DBGR
         STW,R6   STRING                                                DBGR
         LB,R6    GOPR                                                  DBGR
         STW,R6   LENGTH                                                DBGR
         BAL,R9   STORE             STORE DEFAULT GO                    DBGR
AT:CMD4  RES      0
         LW,R6    FSTLNK            COMPLETE CIRCULAR
         STW,R6   0,R4               CHAIN
         B        NEXTRST                                               DBGR
AT:CMD6  RES      0
         CI,R3    1                 IS THIS A SEMI/RET SEQUENCE         DBGR
         BE       AT:CMD70          YES. SET TO CONTINUE                DBGR
         LI,R6    ';'                                                   DBGR
         STB,R6   STRING,R3         SET TO CONTINUE FOR THE GO COMMAND  DBGR
         LI,R5    -1
         B        AT:CMD2           GO DO LAST STORE
AT:CMD70 RES      0                                                     DBGR
         MTW,0    READCMD           FROM STORED LIST                    DBGR
         BEZ      AT:CMD7           NO.                                 DBGR
AT:CMD71 RES      0                                                     DBGR
         MTW,0    PULLFLAG          END OF STORED LIST                  DBGR
         BEZ      AT:CMD2           NO. GO CLEAN UP                     DBGR
         LW,R6    PULLADDR          SET PULL ADDRESS                    DBGR
         BAL,R9   PULLNAME          GET NEXT STORED CMD                 DBGR
         STW,R6   PULLADDR          SAVE PULL ADDRESS                   DBGR
         LI,R5    STRING            SET TO STORE                        DBGR
         LB,R6    STRING            THE CMD WE JUST                     DBGR
         STW,R6   LENGTH            PULLED                              DBGR
         BAL,R9   STORE             STORE IT                            DBGR
         B        AT:CMD71          GO 'ROUND AGAIN                     DBGR
AT:CMD7  RES      0
         M:READ   M:UC,(BUF,BUFF),(SIZE,80)
         LI,R5    BA(BUFF)
         B        AT:PAR9           GO DO CONTINUES COMMANDS
AT:STATE RES      0
         LW,R8    STATEMENT
         LI,R7    SBREAKS-1
         LI,R3    0
AT:S00   RES      0
         AI,R3    1
         AI,R7    1
         LW,R6    0,R7
         BEZ      AT:S10
         BGZ      AT:S00            TRY NEXT ENTRY
         LI,R6    ERR2              TOO MANY STATEMENT BREAKS
         BAL,R7   TYPE
         B        NEXT
AT:S10   RES      0
         STW,R8   SBREAKT,R3
         STW,R7   FSTLNK            SET END OF CIRCLE
         LW,R6    PUNCTUATION
         LI,R4    DYNAMIC-1
         B        AT:PAR6           GO STORE COMMANDS
*
STRCOLON RES      0
         LW,R6    ACOLON
         STW,R6   STRING
         LI,R6    2
         STW,R6   LENGTH
         B        STORE             STORE IT AND GO BACK
         PAGE
*
*   STORE---STORES A STRING IN THE DYNAMIC TABLE
*        R7 = POINTER TO WHERE A FLINK IS TO BE STORED
*        R4 = ADDRESS OF CURRENT WORD OF DYNAMIC TABLE
*        R9 = LINK REGISTER
*        R6, R1, R2 ARE WORK REGISTERS
*
STORE    RES      0
         LI,R2    0
         LW,R1    LENGTH
         AI,R1    3
         SLS,R1   -2                LENGTH IN WORDS
STORI    RES      0
         AI,R4    1                 NEXT DYNAMIC WORD
         CI,R4    ENDDYN            AT END OF ROOM
         BGE      OVERFLO           YES..DIAGNOSE
         LW,R6    0,R4              WORD AVAILABLE
         BNEZ     STORI             NO. ..GET ANOTHER
         LW,R6    S1                1ST WORD
         BNEZ     STOR2
         STW,R4   0,R7              YES. SET FLINK
         MTW,1    S1                SET NOT 1ST
         STB,R1   *R7
STOR2    RES      0
         LW,R6    1,R4              NEXT WORD AVAILABLE
         BEZ      STOR3             YES.  GO MOVE
         LW,R7    R4                NO. SET NEW FLINK POINTER
         MTW,-1   S1                SET 1ST WORD
         B        STORI             KEEP LOOKIN'
STOR3    RES      0
         LW,R6    STRING,R2         MOVE WORD FROM STRING
         STW,R6   0,R4              TO OPEN WORD
         AI,R2    1                 INCREMENT STRING POINTER
         BDR,R1   STORI
         LI,R6    0
         STW,R6   S1
         AI,R4    1                 SET UP NEW FLINK PTR
         LW,R7    R4
         B        *R9
QUALERR  RES      0
         LI,R6    ERR9
         BAL,R7   TYPE
         B        RECOVER
OVERFLO  RES      0
         LI,6     ERR8
         BAL,R7   TYPE
* RECOVER DYNAMIC SPACE WHEN ERROR ENCOUNTERED DURING STORE
RECOVER  RES      0
         LW,R6    FSTLNK
         LI,R3    0
RCVR:00  RES      0
         AI,R6    -1
RCVR:10  RES      0
         AI,R6    1
         LW,R5    0,R6
         STW,R3   0,R6
         BEZ      NEXT              ALL ZEROED OUT
         CW,R5    =X'00FE0000'
         BANZ     RCVR:10
         LW,R6    R5
         B        RCVR:00
         PAGE
* LIST BKPTS
*
LISTBRKS RES      0
         LI,R4    3
         LI,R3    0
         LI,R7    PBREAKS-1
LSTB:00  RES      0
         AI,R7    1
         LW,R6    0,R7              PBREAK POINTER
         BEZ      LSTB:00           NOT ACTIVE PBREAK
         BLZ      LSTB:20           ALL PBREAKS CHECKED
         LB,R8    R6
         STW,R8   LENGTH
         LW,R6    R7                SET POINTER
LSTB:10  RES      0
         LW,R5    0,R6              DATA OR POINTER
         CW,R5    =X'00FE0000'
         BAZ      LSTB:15           POINTER
         STW,R5   BUFFR,R3          DATA
         AI,R3    1
         AI,R6    1                 NEXT
         MTW,-1   LENGTH
         B        LSTB:10           NEXT WORD
LSTB:15  RES      0
         MTW,0    LENGTH            THIS WORD DONE
         BEZ      LSTB:17           YEP
         LW,R6    R5                NEW POINTER
         B        LSTB:10           KEEEP ON
LSTB:17  RES      0
         LW,R8    =' :: '
         STW,R8   BUFFR,R3          STORE SEPARATOR
         AI,R3    1
         SLS,R3   2                 NO
         STB,R3   BUFFR-1           TYPE THE WHOLE THING
         STW,R7   SAV7
         LI,R6    BUFFR-1
         BAL,R7   TYPE
         LI,R3    0
         LW,R7    SAV7
         B        LSTB:00
*     ALL PNAME BREAKS REPORTED
LSTB:20  RES      0
         LI,R3    0
         LI,R7    SBREAKS-1
LSTB:25  RES      0
         AI,R7    1
         AI,R3    1
         LW,R6    0,R7
         BEZ      LSTB:25           NOT ACTIVE SBREAK
         BLZ      LSTB:40           NO MORE SBREAKS
         LW,R5    SBREAKT,R3
         STW,R7   SAV7
         STW,R3   SAV3
         BAL,R10  TYPES
         LW,R7    SAV7
         LW,R3    SAV3
         B        LSTB:25
*      ALL STMT BREAKS REPORTED
LSTB:40  RES      0
         LW,R3    WHNSIZE
LSTB:41  RES      0
         LW,R6    WHNTBL-1,R3
         BNEZ     LSTB:42
LSTB:410 RES      0
         BDR,R3   LSTB:41
         B        NEXT
LSTB:42  RES      0
         STW,R3   SAV3
         BAL,R9   PULLNAME
         LW,R3    SAV3
         LI,R6    DBREAK
         BAL,R7   TYPENC
         LI,R6    STRING
         BAL,R7   TYPE
         B        LSTB:410
         PAGE
*
*   DECODE---CONVERT STATEMENT ID IN R6 TO 1ST 4 WORDS OF BUFFR
*
DECODE   RES      0
         LI,R3    0
         INT,R6   R6                VERB TO CC, SUB TO R6, # TO R7
         BCR,15   DECODE:B          NO VERB
         STCF     R3
         SCS,R3   4
         AND,R3   =X'0000000F'
         CI,R3    9
         BLE      DECODE:1
         AI,R3    -9
         AI,R3    X'100'
DECODE:1 RES      0
         SLS,R3   8
         OR,R3    =X'4DF0F05D'
DECODE:2 RES      0
         STW,R3   BUFFR+2           VERB NUMBER
         LW,R3    =X'4BF0F0F0'
         AI,R6    0
         BEZ      DECODE:C
DECODE:3 RES      0
         CI,R6    100
         BL       DECODE:4
         AI,R6    -100
         AI,R3    X'10000'
         B        DECODE:3
DECODE:4 RES      0
         CI,R6    10
         BL       DECODE:5
         AI,R6    -10
         AI,R3    X'100'
         B        DECODE:4
DECODE:5 RES      0
         OR,R3    R6
DECODE:6 RES      0
         STW,R3   BUFFR+1
         LW,R3    =X'F0F0F0F0'
DECODE:7 RES      0
         CI,R7    1000
         BL       DECODE:8
         AW,R3    =X'01000000'
         AI,R7    -1000
         B        DECODE:7
DECODE:8 RES      0
         CI,R7    100
         BL       DECODE:9
         AI,R3    X'10000'
         AI,R7    -100
         B        DECODE:8
DECODE:9 RES      0
         CI,R7    10
         BL       DECODE:A
         AI,R7    -10
         AI,R3    X'100'
         B        DECODE:9
DECODE:A RES      0
         OR,R3    R7
         STW,R3   BUFFR
         LI,R3    X'0D'
         STB,R3   BUFFR+3
         B        *R9
DECODE:B RES      0
         LW,R3    =X'40404040'
         B        DECODE:2
DECODE:C RES      0
         LW,R3    =X'40404040'
         B        DECODE:6
         PAGE
*
*        SET VARIABLE TO VALUE
*
SET      RES      0
         BAL,R9   FIND:DD           GET LOC'N, ETC
         BAL,R9   GETSTRING
         LW,R6    STRING
         CW,R6    =X'017E4040'      MUST BE AN EQUALS
         BNE      INVALID
         BAL,R9   GETSTRING
         LI,R4    0
         LI,R6    1
         LB,R6    STRING,R6         CHECK FOR VALID VALUE TYPE
         CI,R6    X'7D'             QUOTE IS CHARACTERS
         BE       SET:C
         CI,R6    'X'               'X' COULD BE HEX
         BE       SET:X
         LB,R4    STRING
SET:05   RES      0
         LB,R6    STRING,R4
         CI,R6    X'F0'
         BL       SET:10
         BDR,R4   SET:05            VERIFY NUMERIC INFO
SET:NUM  RES      0
         LI,R6    0
         STB,R6   STRING
         LW,R6    LENGTH
         AI,R6    1
         LI,R4    1
         AND,R4   R6                GET OFFSET FOR PACK
         SLS,R6   -1
         SCS,R6   -12
         OR,R6    APACK
         EXU      R6
         LW,R6    DCLASS
         CI,R6    12
         BE       SET:B             INDEX
         CI,R6    13
         BE       SET:B             BINARY
         BG       NONNUM
         CI,R6    6
         BE       SET:ND
         CI,R6    7
         BE       SET:ND
         CI,R6    8
         BE       SET:NP
         CI,R6    9
         BE       SET:NP
NONNUM   RES      0
         LI,R6    NONUM
         BAL,R7   TYPE
         B        NEXT
*        NUMERIC DISPLAY
SET:NP   RES      0
         LW,R6    DADDR
         LW,R5    DSIZE
         SCS,R5   -12
         OR,R5    ASTOR             SET DST INSTR
         EXU      R5                DO IT
         B        NEXT
*        NUMERIC PACKED
SET:ND   RES      0
         LI,R4    1
         UNPK,0   STRING,R4
         LI,R6    7
         CW,R6    DCLASS            IS IT NDU
         BNE      SET:ND0           NO. GO ON
         LB,R4    STRING+8          YES...UN-SIGN IT
         OR,R4    =X'F0'
         STB,R4   STRING+8
SET:ND0  RES      0
         LI,R4    31
         SW,R4    DSIZE
         LW,R6    DSIZE
         AI,R6    2
         STB,R6   STRING
         B        SET:C:00
SET:10   RES      0
         CI,R4    1                 FIRST CHARACTER
         BNE      SET:NAME          NO...MUST BE NAME
         CI,R6    '+'
         BE       SET:11            PLUS SIGN
         CI,R6    '-'
         BNE      SET:NAME          NOT MINUS MUST BE NAME
         LB,R3    STRING
         LB,R6    STRING,R3         GET SIGN CHAR
         AI,R6    -X'20'            SET MINUS
         STB,R6   STRING,R3
SET:11   RES      0
         LI,R6    X'F0'
         STH,R6   STRING            STORE AS LEADING ZERO
         LI,R4    0
         B        SET:NUM
SET:B    RES      0
         BAL,R9   DECBIN
         LW,R6    STRING
         LW,R4    DADDR
         SLS,R4   -2
         STW,R6   0,R4
         B        NEXT
SET:X    RES      0
         LB,R3    STRING
         LB,R6    STRING,R3
         CI,R6    X'7D'             END WITH QUOTE
         BNE      SET:NAME
         LI,R2    0
         STB,R2   STRING,R3         GET RID OF TRAILING QUOTE
         LI,R3    3                 SET TO FIRST 'REAL' CHARACTER
         LI,R4    6                 FIRST STRING IS SHORT
SET:X:00 RES      0
         LB,R6    STRING,R3
         BEZ      SET:X:10          ALL CONVERTED
         AI,R6    -X'F0'            CONVERT IF 0 THRU 9
         BGEZ     %+2
         AI,R6    X'39'             TAKE CARE OF A THRU F
         SLS,R10  4                 MAKE ROOM FOR NEW
         AW,R10   R6
         AI,R3    1                 NEXT CHAR.
         BDR,R4   SET:X:00          GO DO IT
         STW,R10  STRING,R2
         AI,R2    1
         LI,R4    8
         B        SET:X:00
SET:X:10 RES      0
         SLS,R4   2
         SLS,R10  0,R4              ADJUST TO LFT JUST
         STW,R10  STRING,R2           AND STORE
         LW,R6    LENGTH
         AI,R6    1
         SLS,R6   -1
         STB,R6   STRING
         AI,R6    1
         LI,R4    0
         B        SET:C:00
SET:NAME RES      0
         B        ERM3              NO NAME PROCESSING YET
SET:C    RES      0
         LB,R3    STRING            DOES STRING
         LB,R6    STRING,R3           END
         CI,R6    X'7D'                 WITH QUOTE
         BNE      SET:STRG          NO. GET REST OF LITERAL
         LI,R6    0
         CI,R3    1                 IS QUOTE ONLY CHAR
         BE       SET:STRG          YES. GET REST OF LITERAL
ST:C00   RES      0
         LI,R4    1
SET:C:00 RES      0
         LW,R7    DADDR
         LB,R6    STRING
         AI,R6    -2
         CW,R6    DSIZE
         BG       ERM7              LITERAL BIGGER THAN FIELD
         BL       SET:CP            LITERAL SHORT--NEED PAD
SET:C0   RES      0
         STB,R6   R7
         LI,R6    BA(STRING)+1
         AW,R6    R4
         MBS,R6   0
         B        NEXT
SET:STRG RES      0
         AI,R5    -2                BACKUP TO PUNCTUATION
SET:S:A  RES      0
         AI,R5    1
         CI,R6    X'5E'             WAS IT A SEMICOLON
         BNE      SET:S00           NO...KEEP LOOKIN'
         LB,R4    0,R5              IS NEXT CHAR
         CI,R4    X'0D'                SOME KIND OF
         BE       %+3
         CI,R4    X'15'             CARRIAGE RETURN
         BNE      SET:S00           NO.
         EXU      NEXTR             YES. GET ANOTHER LINE
         LI,R5    BA(BUFF)
         B        SET:S05           GO PROCESS IT
SET:S00  RES      0
         CI,R6    X'7D'             IS IT A QUOTE
         BE       SET:S10           YES.. END OF LITERAL
         STB,R6   STRING,R3         NO. STORE IT AND GO ON
         AI,R3    1
SET:S05  RES      0
         LB,R6    0,R5              NEXT CHAR
         CI,R3    253               TOO MANY CHAR
         BL       SET:S:A           NO. KEEP ON
         B        ERM7              YES. FORGET IT
SET:CP   RES      0                                                     DBGR
         LI,R6    X'40'                                                 DBGR
         STB,R6   STRING,R3                                             DBGR
         AI,R3    1                                                     DBGR
SET:S10  RES      0
         STB,R3   STRING            SET SIZE
         STB,R6   STRING,R3         PUT IN QUOTE FOR DRILL
         AI,R3    1
         STW,R3   LENGTH            SET TOTAL LENGTH
         B        ST:C00            GO BACK TO PROCESS
APACK    PACK,0   STRING,R4
APACK:0  PACK,0   0,R4              DUMMY PACK FOR IF                   DBGR
ASTOR    DST,0    0,R6              DUMMY DST INSTR
ACMP     DC,0     0,R6
         PAGE
*
*   PRINT---PRINT THE CONTENTS OF A DATA NAME
*
PRINT    RES      0
         BAL,R9   FIND:DD           GET DEBUG DATA
         MTW,1    HEXSW             ARE WE FORCING HEX FORMAT
         BEZ      PR:X              YES..
         LW,R6    DCLASS            JUMP ON TYPE-CLASS IND
         B        %+1,R6
         B        PR:C              0                                   DBGR
         B        PR:C              1
         B        PR:C              2
         B        PR:C              3
         B        PR:C              4
         B        PR:C              5
         B        PR:S              6
         B        PR:C              7--NDU
         B        PR:D              8
         B        PR:D              9
         B        PR:X              A
         B        PR:X              B
         B        PR:B              C
         B        PR:B              D
         B        PR:X              E
         B        PR:X              F
*
*  PR:C--PRINT IN CHARACTER MODE
PR:C     RES      0
         LW,R8    DSIZE             SIZE OF DATA
         LW,R6    DADDR             ADDRESS OF DATA
PR:C:00  RES      0
         CI,R8    60
         BLE      PR:C:10
         AI,R8    -60
         LI,R7    60
         STB,R7   DMOV
         AI,R7    1
         STW,R7   RECSIZE
         LW,R7    DMOV
         MBS,R6   0
         LI,R9    X'0D'
         STB,R9   0,R7
         M:WRITE  M:UC,(BUF,BUF1),(SIZE,*RECSIZE)
         B        PR:C:00
PR:C:10  RES      0
         STB,R8   DMOV
         AI,R8    1
         LW,R7    DMOV
         MBS,R6   0
         LI,R9    X'0D'
         STB,R9   0,R7
         STW,R8   RECSIZE
         M:WRITE  M:UC,(BUF,BUF1),(SIZE,*RECSIZE)
         B        NEXT
*
*  PR:X--PRINT IN HEXADECIMAL MODE
PR:X     RES      0
         LW,R8    DSIZE             SIZE OF DATA
         LW,R6    DADDR             ADDRESS OF DATA
         LI,R7    0                 OUTPUT COUNTER
PR:X:05  RES      0
         BAL,R9   FROM:X            CONVERT TO CHAR FROM HEX
         STH,R5   BUF1,R7           STORE TWO BYTES
         AI,R6    1                 NEXT INPUT BYTE
         AI,R7    1                 NEXT OUTPUT HALFWORD
         CI,R7    30
         BLE      PR:X:10
PR:X:07  RES      0
         SLS,R7   1
         STW,R7   RECSIZE
         MTW,1    RECSIZE
         LI,R9    X'0D'
         STB,R9   BUF1,R7
         M:WRITE  M:UC,(BUF,BUF1),(SIZE,*RECSIZE)
         LI,R7    0
PR:X:10  RES      0
         BDR,R8   PR:X:05
         CI,R7    0
         BNE      PR:X:07           OOPS..NOT PRINTED YET
         B        NEXT
*
*  PR:D--PRINT IN PACKED DECIMAL FORMAT
PR:D     RES      0
         B        PR:X              USE HEX FORMAT FOR NOW
*
*  PR:B--PRINT IN BINARY MODE
PR:B     RES      0
         LW,R6    =X'0D0D0D0D'
         STW,R6   BUF1+2
         LW,R6    DADDR             DATA ADDR
         SLS,R6   -2                IN WORDS
         LW,R6    0,R6              PICK UP DATA
         LI,R10   BA(BUF1)          SET OUTPUT ADDRESS
         BAL,R11  C:DBD             CONVERT
         M:WRITE  M:UC,(BUF,BUF1),(SIZE,12)
         B        NEXT
*
*  PR:S--PRINT IN SIGNED DISPLAY MODE
PR:S     RES      0
         B        PR:C              USE UNSIGNED MODE FOR NOW
*
*  FROM:X--CONVERT FROM BINARY TO HEX DISPLAY
FROM:X   RES      0
         LB,R4    0,R6
         SLD,R4   -4
         AI,R4    X'F0'
         CI,R4    X'F9'
         BLE      %+2
         AI,R4    -X'39'
         SLS,R4   8
         SLS,R5   -28
         AI,R5    X'F0'
         CI,R5    X'F9'
         BLE      %+2
         AI,R5    -X'39'
         AW,R5    R4
         B        *R9
         PAGE
*
*   EQUATE---ASSIGN AN ABBREVIATION TO A DATA NAME
*
EQUATE   RES      0
         BAL,R9   GETSTRING         GET ABBREVIATION
         MTB,1    STRING
         M:WRITE  M:CI,(KEY,STRING),(BUF,BUF1),;
                  (ERR,ERM6),(ABN,ERM6),(NEWKEY)
         M:DELREC M:CI,(KEY,STRING)
         LW,R8    LENGTH
         CI,R8    7
         BG       INVALID
         LI,R7    ABBREV-ATBLSZ
EQU:11   RES      0
         AI,R7    ATBLSZ            NEXT TABLE ENTRY
         LW,R6    0,R7
         BEZ      EQU:12            OPEN ENTRY
         BGZ      EQU:20            GO CHECK IF A DUPE                  DBGR
         B        ERM2              TABLE FULL
EQU:12   RES      0
         LD,R8    STRING            SAVE THE STRING DON'T ENTER NOW     DBGR
         STD,R8   STRING:SAVE:2                                         DBGR
         STW,R7   SAV7
         LW,R7    LENGTH
EQU:00   RES      0
         LB,R6    STRING,R7
         CLM,R6   F0:F9
         BCS,9    EQU:10            NOT ALL NUMERIC
         BDR,R7   EQU:00
         B        INVALID           NOT GOOD DNAME
EQU:10   RES      0
         STW,R5   SAV5              SAVE R5                             DBGR
         BAL,R9   GETSTRING         CHECK FOR OPTIONAL TO               DBGR
         LW,R6    =X'02E3D640'      IS IT A TO                          DBGR
         CW,R6    STRING                                                DBGR
         BE       EQU:15            BRACH IF IT IS                      DBGR
         LW,R5    SAV5              RESTORE R5 FOR FIND:DD              DBGR
EQU:15   RES      0                                                     DBGR
         BAL,R9   FIND:DD           GET DATA ON LONG NAME
         LW,R7    SAV7
         LD,R8    STRING:SAVE:2     GET STRING BACK                     DBGR
         STW,R8   0,R7              STORE FIRST PART                    DBGR
         STW,R9   1,R7              STORE SECOND HALF                   DBGR
         AI,R7    2
         SLS,R7   2
         OR,R7    =(ATBLSZ-2)**26
         LI,R6    BA(BUF1)
         MBS,R6   0
         B         NEXT
EQU:20   RES      0                                                     DBGR
         CW,R6    STRING            1ST WORD SAME                       DBGR
         BNE      EQU:11            NO. NO DUPE                         DBGR
         LW,R6    1,R7              HOW 'BOUT 2ND                       DBGR
         CW,R6    STRING+1                                              DBGR
         BNE      EQU:11            NOT A DUPE                          DBGR
         B        INVALID                                               DBGR
         PAGE
*
*   DROP---REMOVE AN ABBREVIATION FROM THE TABLE
*
DROP     RES      0
         BAL,R9   GETSTRING         GET ABBREVIATION
         MTB,1    STRING
         LI,R7    ABBREV-ATBLSZ
DROP:00  RES      0
         AI,R7    ATBLSZ
         LW,R6    0,R7
         BEZ      DROP:00           NOTHING TO DROP
         BG       DROP:10           MAYBE DROP THIS
         LW,R6    =X'04C1D3D3'      WAS IT  'ALL'
         CW,R6    STRING
         BE       NEXT              YEP, MUST BE DONE
         B        INVALID
DROP:10  RES      0
         CW,R6    STRING
         BNE      DROP:11
         LB,R6    R6
         CI,R6    4
         BLE      DROP:100
         LW,R6    1,R7
         CW,R6    STRING+1          DOES IT MATCH
         BNE      DROP:11           NOT EXACTLY
DROP:100 RES      0
         LI,R6    0
         STW,R6   0,R7              YES. DROP IT
         B        NEXT
DROP:11  RES      0
         LW,R6    =X'04C1D3D3'
         CW,R6    STRING            WAS IT  'ALL'
         BNE      DROP:00           NO
         LI,R6    0
         STW,R6   0,R7              YES. DROP AND GET ANOTHER
         B         NEXT
         PAGE
*
*   WHEN---SET DATA BREAKPOINT
*
WHEN     RES      0
         LW,R3    WHNSIZE
WHN:00   RES      0
         LW,R4    WHNTBL-1,R3
         BEZ      WHN:01
         BDR,R3   WHN:00
         B        ERM2              OUT OF TABLE
WHN:01   RES      0
         STW,R3   WHNFLG
         STW,R5   SAV5
         BAL,R9   GETSTRING
         LI,R7    WHNTBL-1
         AW,R7    WHNFLG
         STW,R7   FSTLNK            SET BLINK TRLR                      DBGR
         LI,R4    DYNAMIC
         BAL,R9   STORE
         LW,R5    SAV5
         STW,R7   SAV7                                                  DBGR
         STW,R4   SAV4              SAVE STOR PTR                       DBGR
         BAL,R9   FIND:DD           GET LOCATION OF DATA
         LI,R3    0                                                     DBGR
         STW,R3   NOLOOKI                                               DBGR
         LW,R3    WHNFLG
         LW,R8    DSIZE
         STB,R8   DADDR
         STB,R8   NULLOC
         LW,R8    DADDR
         STW,R8   PGMLOC-1,R3       SET DATA LOC'N
         LW,R9    DBGLOC-1,R3       SET SAVE LOC'N
         OR,R9    NULLOC
         STW,R9   DBGLOC-1,R3
         MBS,R8   0                 SAVE DATA
         LI,R3    0
         STW,R3   WHNFLG
         LW,R4    SAV4                                                  DBGR
         LW,R7    SAV7                                                  DBGR
         BAL,R9   STRCOLON                                              DBGR
         LW,R6    WHNSV                                                 DBGR
         STW,R6   STRING                                                DBGR
         LW,R6    WHNSV+1                                               DBGR
         STW,R6   STRING+1                                              DBGR
         LW,R6    WHNSVL                                                DBGR
         STW,R6   LENGTH                                                DBGR
         BAL,R9   STORE                                                 DBGR
         B        AT:PAR8                                               DBGR
         PAGE
*
*   OFFWHN---REMOVE DATA BREAKPOINT
*
OFFWHN   RES      0
NOTRACE  RES      0
         BAL,R9   GETSTRING
         LW,R6    LENGTH
         STB,R6   OFFW:HA
         LW,R7    OFFW:HA
         LI,R6    BA(STRING)
         MBS,R6   0
         LW,R5    WHNSIZE
OFFW:00  RES      0
         LW,R6    WHNTBL-1,R5
         BNEZ     OFFW:10
OFFW:01  RES      0
         BDR,R5   OFFW:00
         B        ERM4
OFFW:10  RES      0
         BAL,R9   PULLNAME
         LI,R2    BA(STRING)
         LW,R3    OFFW:HA
         CBS,R2   0
         BNE      OFFW:01
         LW,R6    WHNTBL-1,R5
         LB,R7    R6
         LI,R3    0
OFFW:11  RES      0
         LW,R4    0,R6
         CW,R4    =X'00FE0000'
         BAZ      OFFW:12
         STW,R3   0,R6
         AI,R6    1
         B        OFFW:11
OFFW:12  RES      0
         CI,R4    0
         BEZ      OFFW:14
         LW,R6    0,R6
         B        OFFW:11
OFFW:14  RES      0
         LI,R2    0
         STW,R2   WHNTBL-1,R5
         LW,R3    =X'FF000000'
         STS,R2   DBGLOC-1,R5
         B         NEXT
         PAGE
*
*   SOURCE---PRINT SOURCE LINES
*
SOURCE   RES      0
         BAL,R9   CALC:LINE:SUB:LINE                                    DBGR
SOUR:10  RES      0
         LI,R1    0
         STW,R1   STRING
         CI,R6    COMMA             WAS THERE A NUMBER OF LINES
         BNE      SOUR:20           NO.
         BAL,R9   GETSTRING         YES. GET IT
         BAL,R9   DECBIN              CONVERT IT
         LW,R1    STRING                SAVE IT IN R1
         LW,R6    PUNCTUATION
SOUR:20  RES      0
         CI,R6    COLON             CHECK POSSIBLE PROG NAME
         BNE      SOUR:30
*  NO CODE TO HANDLE PROGRAM-NAME OR SOURCE-NAME
*
SOUR:30  RES      0
         CI,R6    CARRET            BETTER BE END OF LINE
         BNE      INVALID
         M:READ   M:SI,(BUF,BUF1),(KEY,KEY),;
                  (ABN,ERM1),(ERR,ERM1)
SOUR:35  RES      0
         LW,R6    M:SI+10           KAD
         AND,R6   =X'1FFFF'
         LW,R7    0,R6              ACTUAL KEY READ
         STW,R7   KEY
         BAL,R9   KEYTOPRT          PRINT LINE #
         LW,R6    M:SI+4            ARS
         SLS,R6   -17
         STW,R6   RECSIZE           AS OUTPUT SIZE
         LI,R7    X'0D'
         STB,R7   BUF1,R6
         MTW,1    RECSIZE
         M:WRITE  M:UC,(BUF,BUF1),(SIZE,*RECSIZE),(ERR,NULL),(ABN,NULL)
         MTW,-1   STRING
         BLEZ     NEXT              ENOUGH LINES PRINTED
         M:READ   M:SI,(ABN,END:SI)
         B        SOUR:35
END:SI   RES      0
         LI,R6    ALLOUT
         BAL,R7   TYPE              NO MORE SI
         B        NEXT
         PAGE
*
*   DECBIN---DECIMAL TO BINARY KLUDGEY ROUTINE
*
DECBIN   RES      0
         LI,R7    0
         LI,R6    1
DECBIN0  RES      0
         LB,R8    STRING,R6         GET A CHARACTER
         CI,R8    X'F0'             NUMBER
         BL       DECBIN8           NO. MAYBE ALL DONE
         CI,R8    X'F9'
         BG       INVALID           NO.  FOULED UP
         AND,R8   =X'F'
         MI,R7    10
         AW,R7    R8
         AI,R6    1                 NEXT
         B        DECBIN0
DECBIN8  RES      0
         CI,R8    X'40'             IF A BLANK ALL OVER
         BE       DECBIN9
         MI,R7    -10
         AND,R8   =X'F'
         SW,R7    R8
         LB,R8    STRING,R6
         CI,R8    X'D0'
         BL       DECBIN7
         CI,R8    X'D9'
         BG       DECBIN7
DECBIN6  RES      0
         AI,R6    1
         LB,R8    STRING,R6
         CI,R8    X'40'
DECBIN9  RES      0
         BNE      INVALID           OTHERWISE..ERROR
         STW,R7   STRING
         B        *R9
DECBIN7  RES      0
         LCW,R7   R7
         B        DECBIN6
*
*   KEYTOPRT---PRINT THE CURRENT LINE NUMBER
*
KEYTOPRT RES      0
         LW,R6    KEY               GET KEY
         AND,R6   =X'FFFFFF'
         LD,R4    KEYPATRN          SET KEY PATTERN IN 4 & 5
         LI,R1    7
KTP:00   RES      0
         CW,R6    FACTR,R1
         BL       KTP:10
         AD,R4    FACTRD,R1
         SW,R6    FACTR,R1
         B        KTP:00
KTP:10   RES      0
         BDR,R1   KTP:00
* NUMBER CONVERTED
         STD,R4   LINPRNT
         M:WRITE  M:UC,(BUF,LINPRT1),(SIZE,13)
         B        *R9
         PAGE                                                           DBGR
*                                                                       DBGR
*        CALC:LINE:SUB:LINE--CONVERT XXX.XXX TO KEY                     DBGR
*                                                                       DBGR
CALC:LINE:SUB:LINE RES 0                                                DBGR
         STW,R9   CALC:LINE:RTN:SAVE                                    DBGR
         BAL,R9   GETSTRING                                             DBGR
         BAL,R9   DECBIN                                                DBGR
         LW,R7    STRING                                                DBGR
         MI,R7    1000                                                  DBGR
         MTB,3    R7                                                    DBGR
         STW,R7   KEY                                                   DBGR
         LW,R6    PUNCTUATION                                           DBGR
         CI,R6    PERIOD                                                DBGR
         BNE      *CALC:LINE:RTN:SAVE                                   DBGR
         BAL,R9   GETSTRING                                             DBGR
         BAL,R9   DECBIN                                                DBGR
         LW,R7    STRING                                                DBGR
         LW,R6    LENGTH                                                DBGR
         CI,R6    4                                                     DBGR
         BG       ERM7                                                  DBGR
         MH,R7    SUBNUM,R6                                             DBGR
         AWM,R7   KEY                                                   DBGR
         LW,R6    PUNCTUATION                                           DBGR
         B        *CALC:LINE:RTN:SAVE                                   DBGR
*                                                                       DBGR
CALC:LINE:RTN:SAVE RES 1                                                DBGR
*                                                                       DBGR
         PAGE
*
*   INVALID---THE BAD COMMAND ANNOUNCER
*
INVALID  RES      0
         AI,R5    -BA(BUFF)
         LW,R1    BLNKBF
         MBS,0    BA(SPACE)
         LI,R1    '%'
         STB,R1   BUFF,R5
         AI,R5    1
         LI,R1    X'0D'
         STB,R1   BUFF,R5
         AI,R5    1
         STW,R5   RECSIZE           SET RECORD SIZE
         M:WRITE  M:UC,(BUF,BUFF),(SIZE,*RECSIZE),(ERR,NULL),(ABN,NULL)
         B        ERM3
         PAGE
*
*   INSERT---INSERT NEW LINES OF SOURCE
*
INSERT   RES      0
         BAL,R9   CALC:LINE:SUB:LINE                                    DBGR
INSRT:10 RES      0
         LI,R1    1000
         CI,R6    COMMA             IS THERE AN INCREMENT
         BNE      INSRT:20          NO.
         LW,R1    KEY               SAVE KEY                            DBGR
         BAL,R9   CALC:LINE:SUB:LINE                                    DBGR
         XW,R1    KEY               RESTORE OLD KEY GET INCR            DBGR
         MTB,-3   R1                GET RID OF KEY LENGTH               DBGR
INSRT:20 RES      0
         CI,R6    COLON
         BNE      INSRT:30
* CODE MISSING HERE FOR SOURCE NAME CHOICE
INSRT:30 RES      0
         CI,R6    CARRET            END OF LINE
         BNE      INVALID           OR ELSE
         MTW,1    INSRTNG           SET INSERTING FLAG
         M:READ   M:SI,(BUF,BUFF),(KEY,KEY),(ABN,NULL)
         B        ERM1:10           RECORD EXISTS...ERROR
* RECORD NONEXISTENT, OK TO INSERT
         LW,R6    M:SI+10
         AND,R6   =X'1FFFF'
         LW,R7    0,R6
         CW,R7    KEY               ARE WE AT EOF                       DBGR
         BGE      INSRT:50          BRANCH IF NOT                       DBGR
         LW,R7    MAXREC            PICK UP MAX KEY                     DBGR
INSRT:50 RES      0
         STW,R1   SAV1
         BAL,R9   KEYTOPRT          PROMPT WITH KEY
         LW,R1    SAV1
         EXU      NEXTR
         LW,R6    M:UC+4            GET ARS
         SLS,R6   -17
         CI,R6    1                 IS IT ONLY CR OR LF                 DBGR
         BLE      NEXT              IF SO QUIT INSERTING                DBGR
         STW,R6   RECSIZE
         M:WRITE  M:SI,(BUF,BUFF),(SIZE,*RECSIZE),(KEY,KEY),(NEWKEY)
         AWM,R1   KEY               NEXT CANDIDATE KEY
         CW,R7    KEY               IN RANGE
         BG       INSRT:50          OK...KEEP ON
         B        NEXT              OVER
         PAGE
*
*   DELETE---DELETE SOURCE RECORD(S)
*
DELETE   RES      0
         BAL,R9   CALC:LINE:SUB:LINE                                    DBGR
DELE:10  RES      0
         LI,R1    0
         CI,R6    COMMA             HOW MANY LINES
         BNE      DELE:20           ONLY 1
         BAL,R9   GETSTRING
         BAL,R9   DECBIN
         LW,R1    STRING            SET COUNT OF LINES
         LW,R6    PUNCTUATION
DELE:20  RES      0
         CI,R6    COLON
         BNE      DELE:30
*
DELE:30  RES      0
         CI,R6    CARRET            OVER
         BNE      INVALID           ERROR
         M:DELREC M:SI,(KEY,KEY)
         B        DELE:41
DELE:40  RES      0
         M:DELREC M:SI
DELE:41  RES      0
         BDR,R1   DELE:40
         B        NEXT
         B        INVALID
         PAGE
*
*   REPLACE--REPLACE A SINGLE SOURCE LINE
*
REPLACE  RES      0
         BAL,R9   CALC:LINE:SUB:LINE                                    DBGR
REPL:10  RES      0
         CI,R6    COLON
         BNE      REPL:20
* MISSSING CODE
REPL:20  RES      0
         CI,R6    CARRET
         BNE      INVALID
         BAL,R9   KEYTOPRT          PROMPT WITH KEY
         EXU      NEXTR             READ REPLACEMENT RECORD
         LW,R6    M:UC+4            GET ARS
         SLS,R6   -17
         STW,R6   RECSIZE
         M:WRITE  M:SI,(BUF,BUFF),(KEY,KEY),(ONEWKEY),;
                  (SIZE,*RECSIZE),(ERR,NULL),(ABN,NULL)
         B        NEXT
         PAGE
*
*        GO TO NEXT OR NAMED STMT
*
GO       RES      0
         LW,R6    PUNCTUATION
         CI,R6    CARRET            IF CARIAGE RETURN
         BE       RETURN            GO BACK TO USER
         BAL,R9   LOCATE            DECIDE PNAME OR STATEMENT
         B        GO:LINE           STATEMENT NUMBER
         LI,R2    BA(STRING)
         LW,R3    LENGTH
         STW,R3   PLENTH
         AI,R3    1
         STB,R3   MOV%PAR
         LW,R3    MOV%PAR
         MBS,R2   0
         B        GO:45
         LW,R6    PUNCTUATION
         CI,R6    CARRET            ENDED WIT CAR RET
         BE       GO:DFLT           YES GET DEFAULT PROG NAME
         CI,R6    BLANK             ENDED WITH BLANK
         BNE      GO:20             NO..MUST BE PROG NAME
         BAL,R9   GETSTRING         YES..MUST BE SECTION
         LW,R6    LENGTH
         CI,R6    2                 COULD IT BE IN OR OF
         BNE      INVALID           NO..MUST BE WRONG
         LH,R6    STRING
         CH,R6    'IN'              IS IT IN
         BE       GO:10
         CH,R6    'OF'              OR OF
         BNE      INVALID           NO..MUST BE WRONG
GO:10    RES      0
         LW,R6    PUNCTUATION       MUST HAVE ENDED WITH BLANK
         CI,R6    BLANK
         BNE      INVALID             OR IT'S WRONG
         BAL,R9   GETSTRING         GET SECTION NAME
         LI,R2    BA(STRING)-1
         LW,R3    LENGTH            AND MOVE TO HOLD
         STW,R3   SLENTH
         AI,R3    1
         STB,R3   MOV%SEC
         LW,R3    MOV%SEC
         MBS,R3   0
         LW,R6    PUNCTUATION
         CI,R6    CARRET            WAS IT ENDED WIT CAR RET
         BE       GO:DFLT           YES. GET DEFAULT PROG NAME
GO:20    RES      0
         CI,R6    COLON             ENDED WIT COLON
         BNE      INVALID           NO..MUST BE WRONG
         BAL,R9   GETSTRING         YES..GET PROG NAME
         LW,R3    LENGTH
         STW,R3   PRLENTH           MOVE PROG NAME TO HOLD
         AI,R3    1
         STB,R3   MOV%PRG
         LW,R3    MOV%PRG
         LI,R2    BA(STRING)-1
GO:25    RES      0
         MBS,R2   0
         BAL,R10  GET:DEF           FIND PROGRAM NAME DEF
         B        INVALID            NOT FOUND
         LW,R1    TREE:SZ
         LCI      3
         LM,R10   REF:FIL
         MTB,-1   R10               SET UP AND
         LB,R6    R10
         LI,R2    X'40'
         STB,R2   R10,R6            SEARCH TREE TABLE FOR SEGMENT
         LW,R3    TREEPTR
GO:30    RES      0
         CW,R12   2,R3              CHECK 1ST WORD OF SEG NAME
         BNE      GO:32             NO MATCH, TRY AGAIN
         CW,R11   1,R3              2ND WOR
         BNE      GO:32             NO MATCH, TRY AGAIN
         CW,R10   0,R3              FIRST WORD
         BE       GO:35             BINGO...WE GOT IT
GO:32    RES      0
         AI,R3    11                NEXT TREE ENTRY
         BDR,R1   GO:30             NEXT
* IF YOU GET HERE, THE TREE AND THE REF/DEF STACK DON'T AGREE
*    THIS IS A DISASTER OF THE FIRST WATER.. DIE QUICKLY
         DATA     X'F1'
GO:35    RES      0
         LW,R6    3,R3              IS IT IN CORE
         AND,R6   IN:CORE
         BNEZ     GO:350            YES.
         M:SEGLD  REF:FIL           NO. GET IT IN
GO:350   RES      0
         LW,R6    5,R3              LIMITS FOR PT 00
         LH,R7    R6
         SLD,R6   1                 SIZE IN R6, ADDR IN R7
         AND,R6   =X'1FFFF'
         AND,R7   =X'1FFFF'
         MTW,0    SLENTH            IS THER A SECTION NAME
         BEZ      GO:45             NO..DON'SEARCH FOR IT
GO:40    RES      0
         LI,R2    BA(SNAME)-1       SECTION TEXTC STRING
         BAL,R10  FND:PAR           FIND SSCTION
         B        INVALID           NONE HERE...WRONG
GO:45    RES      0
         LW,R6    LOWP
         LW,R7    SIZEP
         LI,R2    BA(PNAME)
         BAL,R10  FND:PAR           FIND PARAGRAPH NAME
         B        INVALID           NONESUCH..TSK, TSK
         STW,R6   GOBACK            STORE THE ADDRESS
         STW,R6   SAVE11
         B        RETURN            RETURN TO USER
* GO TO A STATEMENT (VERB) IDENTIFIER
GO:LINE  RES      0
         LW,R6    PUNCTUATION
         CI,R6    CARRET            END OF LINE
         B        GO:L350
         BE       GO:L60            YES USE DEFAULT PROG NAME
         CI,R6    COLON
         BNE      INVALID
         BAL,R9   GETSTRING         GET PROG NAME
         LW,R3    LENGTH
         STB,R3   PRLENTH
         STB,R3   MOV%PRG           MOVE PROGRAM NAME
         LI,R2    BA(STRING)
GO:L10   RES      0
         B        GO:L350
         LW,R3    MOV%PRG           TO HOLD
         MBS,R2   0
         BAL,R10  GET:DEF
         B        INVALID           NOT FOUND
         LW,R1    TREE:SZ
         LCI      3
         LM,R10   REF:FIL
         MTB,-1   R10
         LB,R6    R10
         LI,R2    X'40'
         STB,R2   R10,R6            SET UP SEG NAME
         LW,R3    TREEPTR           AND START SEARCH FOR SEG
GO:L30   RES      0
         CW,R12   2,R3              MATCH ON  LAST WORD
         BNE      GO:L32            NO. GET NEXT TREE ENTRY
         CW,R11   1,R3              2ND WORD
         BNE      GO:L32            NO
         CW,R10   0,R3              1ST WORD
         BE       GO:L35            ALL THREE HIT
GO:L32   RES      0
         AI,R3    11                NEXT TREE ENTRY
         BDR,R1   GO:L30
*   CAN'T GET HERE.....TREE AND REF/DEF DON'T MATCH
         DATA     X'F4'
GO:L35   RES      0
         LW,R6    3,R3              IS SEG IN CORE
         CW,R6    IN:CORE
         BANZ     GO:L350           YES
         LCI      3
         STM,R10  SEG:FIL
         M:SEGLD  SEG:FIL           NO..GET IT
GO:L350  RES      0
         LW,R8    BALDBG
         LW,R4    STATEMENT         GET ID TO SEARCH FOR
         LW,R6    LOWP
         LW,R7    SIZEP
GO:L355  RES      0
         CW,R8    -1,R6             LOOK FOR BAL TO C:DBG
         BE       GO:L357
GO:L356  RES      0
         AI,R6    1
         BDR,R7   GO:L355
         B        INVALID           NO SUCH STATEMENT
GO:L357  RES      0
         CW,R4    0,R6              LOOK FOR STMT #
         BE       GO:L40            HIT
         B        GO:L356           TRY AGAIN
GO:L40   RES      0
         AI,R6    -1                BACK UP TO DBGR CALL
         STW,R6   SAVE11
         STW,R6   GOBACK
         B        RETURN
GO:DFLT  RES      0
         LI,R2    BA(DEFAULT)
         B        GO:25
GO:L60   RES      0
         LI,R2    BA(DEFAULT)
         B        GO:L10
         PAGE
*
*   DUMP---GIVE SNAPSHOT OF DATA
*
DUMP     RES      0
         LW,R7    R5
         LI,R4    0
DMP:00   RES      0
         AI,R4    -1
         AI,R7    1
         LB,R6    0,R7
         CI,R6    X'0D'
         BE       DMP:05
         CI,R6    X'15'
         BNE      DMP:00
DMP:05   RES      0
         AI,R4    70
         BGEZ     DMP:10
         LI,R4    0
DMP:10   RES      0
         LCW,R2   R4
         SLS,R4   -1
         STB,R4   MOV:TITL
         LW,R1    MOV:TITL
         MBS,0    BA(SPACE)
         LW,R3    R1
         AI,R2    70
         STB,R2   R3
         LW,R2    R5
         MBS,R2   0
         AI,R3    -BA(BUF1)
         M:WRITE  M:DO,(SIZE,*R3),(BUF,BUF1),(WAIT)
         BAL,R9   FIND:DD
         LW,R6    DADDR
         SLS,R6   -2
         STW,R6   DMP:FRM
         BAL,R9   GETSTRING
         LW,R6    =X'02E3D640'
         CW,R6    STRING            'TO' GIVEN
         BNE      DMP:15
         BAL,R9   FIND:DD           YES.
DMP:15   RES      0
         LW,R6    DADDR
         AW,R6    DSIZE
         AI,R6    3
         SLS,R6   -2
         STW,R6   DMP:TO
         M:SNAP   'DUMP',(*DMP:FRM,*DMP:TO)
         B        NEXT
         PAGE
*
*   LISTFILE---LIST STATUS OF A FILE
*
LISTFILE RES      0
         BAL,R9   GETSTRING         GET FD NAME
         LB,R7    STRING
         LB,R4    STRING
         AI,R4    5
         AI,R7    3
LSTF:00  RES      0
         LB,R6    STRING,R7
         STB,R6   STRING,R4         SHIFT OVER
         AI,R4    -1
         BDR,R7   LSTF:00
         LI,R6    ':'               AND INSERT
         STB,R6   STRING,R4
         AI,R4    -1
         LI,R6    'F'
         STB,R6   STRING,R4         'F:'
         MTW,2    LENGTH
         MTB,2    STRING
         LW,R1    0
         AI,R1    10                POINT TO POINTER
         LW,R6    0,R1              GET SAME
         LW,R7    0,R6
LSTF:011 RES      0
         STW,R7   LINKPTR
         AI,R6    1
LSTF:020 RES      0
         LW,R8    R6
         LB,R9    *R6
         CB,R9    STRING
         BNE      LSTF:DC1
         STB,R9   BA%STRNG
         LW,R9    BA%STRNG
         SLS,R8   2
         CBS,R8   1
         BE       LSTF:03
LSTF:DC1 RES      0
         LB,R9    *R6
         AI,R9    3
         SLS,R9   -2
         AW,R6    R9
         AI,R6    1
         CW,R6    LINKPTR
         BL       LSTF:020
         LW,R7    0,R6
         BNEZ     LSTF:011
         B        INVALID
LSTF:03  RES      0
         AI,R8    4
         SLS,R8   -2
         LW,R4    *R8               DCB ADDR TO R4
         LI,R6    ASGNTO            TYPE OUT
         BAL,R7   TYPENC            'ASSIGNED TO'
         LI,R3    X'F'
         AND,R3   0,R4
         BEZ      LSTF:N            NOT ASSIGNED
         CI,R3    1
         BE       LSTF:F            FILE
         CI,R3    2
         BE       LSTF:L            LABEL
         CI,R3    3
         BE       LSTF:D            DEVICE
         CI,R3    X'A'
         BE       LSTF:A            ANS
LSTF:N   RES      0
         LI,R6    DEVNO
         BAL,R7   TYPE
         B        NEXT
LSTF:F   RES      0
         LI,R6    FIL
LSTF:40  RES      0
         BAL,R7   TYPENC
         LI,R3    X'1FFFF'
         AND,R3   6,R4
         STW,R3   FLP
         LI,R6    1
LSTF:45  RES      0
         CB,R6    *R3
         BE       LSTF:50
         LI,R6    X'FF'
         AND,R6   0,R3
         AW,R3    R6
         AI,R3    1
         B        LSTF:45
LSTF:50  RES      0
         LW,R6    R3
         AI,R6    1
         BAL,R7   TYPE
LSTF:55  RES      0
         LI,R6    CSTAT
         BAL,R7   TYPENC
         LW,R3    0,R4
         AND,R3   =X'200000'        FCD
         BNEZ     LSTF:60           OPEN
         LI,R6    CCLS
LSTF:57  RES      0
         BAL,R7   TYPE
         B        NEXT
LSTF:60  RES      0
         LI,R6    COPN
         BAL,R7   TYPENC
         LW,R3    1,R4
         SLS,R3   -17
         AND,R3   =X'7F'
         BEZ      LSTF:EH                                               DBGR
         LI,R6    CINOUT
         CI,R3    4
         BE       LSTF:57
         BG       LSTF:EH                                               DBGR
         LI,R6    COUT
         CI,R3    2
         BE       LSTF:57
         LI,R6    CIN
         CI,R3    1
         BE       LSTF:57
LSTF:EH  RES      0                                                     DBGR
         LI,R6    WHOKNOWS                                              DBGR
         B        LSTF:57                                               DBGR
LSTF:L   RES      0
         LI,R6    LABL
         B        LSTF:40
LSTF:A   RES      0
         LI,R6    ANS
         B        LSTF:40
LSTF:D   RES      0
         LI,R6    DEV
         B        LSTF:40
*
*  PULLNAME--EXTRACT A NAME FROM DYNAMIC AREA
*
PULLNAME RES      0
         LI,R3    0
         STW,R7   SAV7
         LB,R7    *R6               GET # OF WORDS
PULL:00  RES      0
         LW,R4    0,R6
         CW,R4    =X'00FE0000'
         BAZ      PULL:10           POINTER--NOT WORD
                  STW,R4   STRING,R3         MOVE NAME WORD TO STRING
         AI,R3    1
         AI,R6    1
         BDR,R7   PULL:00           NEXT WORD
         LB,R3    STRING
         AI,R3    -1
         LB,R7    STRING,R3
         CI,R7    X'5E'             SEMICOL NEXT TO LAST CHAR
         BE       %+2               YES. SET PULLFLAG
         LI,R7    0                 NO. RESET PULLFLAG
         STW,R7   PULLFLAG
         LW,R7    SAV7              NO NEXT WORD
         B        *R9               ..GET OUT
PULL:10  RES      0
         LW,R6    0,R6              FOLLOW POINTER
         B        PULL:00           TRY AGAIN
*
* FND:PAR---FINDS A PARTICULAR PROCEDURE NAME ADDRESS
*        R6 = ADDR OF 1ST WORD TO BE SEARCHED
*        R7 = # OF WORDS TO BE SEARCHED
*        R2 = ADDR OF TEXTC NAME TO BE SEARCHED FOR
*        R10 = LINK REGISTER
*        RETURNS TO BAL +1 IF NOT FOUND
*        RETURNS TO BAL +2 WITH ADDRESS IN R6, IF FOUND
FND:PAR  RES      0
         STW,R2   PSAVE
         LW,R8    BALTRC
FND:00   RES      0
         CW,R8    0,R6              FIND A BAL TO TRACE
         BE       FND:10
FND:05   RES      0
         AI,R6    1
         BDR,R7   FND:00            TRY NEXT WORD
         B        *R10              OUT OF NEXT WORDS
FND:10   RES      0
         LW,R3    -1,R6             GET SDDR OF PNAME
         AND,R3   =X'1FFFF'
         SLS,R3   2
         LB,R9    0,R2              LENGHT
         AI,R9    1
         STB,R9   R3
         CBS,R2   0
         BE       FND:44
         LW,R2    PSAVE             RESTORE SEARCH ARG ADDR
         B        FND:05            TRY AGAIN
FND:44   RES      0
         AI,R6    -1
         AI,R10   1
         B        *R10
* R10 IS THE LINK REG R10+2 NORMAL RET R10+1 ERROR RETURN
* THIS ROUTINE SEARCHES M:SI (M:SO DURING COMPILATION)
* FOR THE PROGRAM-ID (FOUND AFTER ACTUAL WORD 'PROGRAM-ID.'
* IT APPENDS A W: INFRONT OF THE ID AND EXITS TO GET THE
* MATCHING DEF (IF FOUND PROG IS CALLED) (IF NOT FOUND IS A MAIN PROG)
* PROGRAM-ID MUST BE SECOND NON COMMENT RECORD IN M:SI
GET%ID   RES      0                                                     DBGR
         STW,R10  GET%IDRT          SAVE RETURN ADDR                    DBGR
         LI,R6    X'07D0'           KEY VAL FOR SECOND REC              DBGR
         MTB,3    R6                PUT IN 3 AS KEY LENGTH              DBGR
         STW,R6   KEYSPOT           FOR I/O OPR                         DBGR
GET%ID1  RES      0                                                     DBGR
         M:READ M:SI,(BUF,BUF1),(KEY,KEYSPOT),(ABN,ERRSI),(ERR,ERRSI)  DBGR
         LW,R6    M:SI+4            PICK UP ARE WORD TO SEE HOW BIG     DBGR
         SLS,R6   -17               THE RECORD READ REALLY IS           DBGR
         CI,R6    73                AFTER END OF AREA B                 DBGR
         BL       %+2               LEAVE ALONE                         DBGR
         LI,R6    71                END OF AREA B                       DBGR
         OR,R6    =X'21600000'      BECAUSE EDIT MAY NOT BE 80 CHA      DBGR
         STW,R6   GET%ID40          PUT IN CI,6   END OF AREA B         DBGR
         STW,R6   GET%ID51          HAVE TO STOP AT END AREA B          DBGR
         LI,R6    X'03E8'           INCR FOR NEXT REC IF NECC           DBGR
         AWM,R6   KEYSPOT           UP TO NEXT VAL                      DBGR
         LI,R6    6                 INDEX VAL                           DBGR
         LB,R10   BUF1,R6           SEE IF 7TH SPOT IS * (COMMNT REC)  DBGR
         CI,R10   C'*'                                                  DBGR
         BE       GET%ID1           YES READ ANOTHER REC                DBGR
GET%ID2  RES      0                                                     DBGR
         MTW,0    GET%IDSW          HAVE WE ALREADY GOTTEN 2ND REC      DBGR
         BEZ      GET%ID3           NO SEARCH FOR 'PROGRAM-ID.' RESWD   DBGR
         LI,R6    10                INDEX VAL TO GET REAL ID NAME       DBGR
         B        GET%ID4           GO SEARCH FOR REAL ID NAME          DBGR
GET%ID3  RES      0                                                     DBGR
         AI,R6    1                 UP INDEX VAL TO POS 8 OR 'MORE'     DBGR
         CI,R6    11                'PROGRAM-ID' MUST BE IN 8-11        DBGR
         BGE      ERRSI             2ND REC IS NOT 'PROGRAM-ID.'        DBGR
         LB,R10   BUF1,R6           SEE IF BYTE IS 'P'                  DBGR
         CI,R10   C'P'                                                  DBGR
         BNE      GET%ID3           NO, SEE NEXT BYTE IN 8-11           DBGR
         AI,R6    10                UP INDEXVAL TO END OF 'PROGRAM-ID.'DBGR
         LB,R10   BUF1,R6           SEE IF THERE IS A '.'               DBGR
         CI,R10   C'.'                                                  DBGR
         BNE      ERRSI             ERROR IN 'PROGRAM-ID.'              DBGR
GET%ID4  RES      0                 NOW SCAN FOR REAL ID NAME           DBGR
         AI,R6    1                 UP INDEXVAL                         DBGR
         LB,R10   BUF1,R6           SEE WHAT IS NEXT                    DBGR
         CI,R10   X'40'             ANY NUMBER OF BLANKS                DBGR
         BNE      GET%ID5           MUST BE REAL ID NAME                DBGR
GET%ID40 RES      0                 FOLLOWING   CI INST WILL BE CHGD    DBGR
         CI,R6    72                ARE WE AT END OF AREA B             DBGR
         BL       GET%ID4           NO SO LOOK FURTHER                  DBGR
         MTW,1    GET%IDSW          AT END AND NO REAL ID NAME          DBGR
         B        GET%ID1           READ ANOTHER REC FOR REAL ID NAME   DBGR
GET%ID5  RES      0                 IF HERE WE HAVE REAL ID NAME        DBGR
         LI,R4    3                 INDEX VAL                           DBGR
GET%ID50 RES      0                                                     DBGR
         STB,R10  DEFNAM,R4         CONSTRUCT ID NAME                   DBGR
         AI,R6    1                 UP INDEX VALUE                      DBGR
         LB,R10   BUF1,R6           PICK UP NEXT BYTE                   DBGR
         CI,R10   C'.'              TERMINATES REAL ID NAME             DBGR
         BE       GET%ID6           END                                 DBGR
         CI,R4    10                8 BYTES MAX SIZE REAL-ID NAME       DBGR
         BE       GET%ID6           MAX SIZE IS (8)
GET%ID51 RES      0                 THE FOLLOWING CI INST WILL BE CHGD  DBGR
         CI,R6    72                END OF AREA B ALSO TERMINATES       DBGR
         BG       GET%ID6           TERMINATED IN POS 72                DBGR
         AI,R4    1                 UP INDEX VAL                        DBGR
         B        GET%ID50          LOOP THROUGH AGAIN                  DBGR
GET%ID6  RES      0                 HAVE ALL OF REAL ID NAME            DBGR
         STB,R4   DEFNAM            1ST BYTE WILL BE LENGTH             DBGR
         STW,R4   DEFNAML           LENGTH HERE ALSO                    DBGR
         LI,R4    1                 INDEX VAL                           DBGR
         LI,R10   C'W'              STORE IN W: INFRONT OF ID NAME      DBGR
         STB,R10  DEFNAM,R4                                             DBGR
         LI,R4    2                 INDEX VAL                           DBGR
         LI,R10   C':'                                                  DBGR
         STB,R10  DEFNAM,R4                                             DBGR
         MTW,1    GET%IDRT          NORMAL RETURN                       DBGR
         B        *GET%IDRT                                             DBGR
GET%IDRT DATA     0                 RETURN ADDR                         DBGR
GET%IDSW DATA     0                 IF NON 0;REAL ID NAME NOT ON        DBGR
* SAME RECORD AS THE 'PROGRAM-ID.'
KEYSPOT  DATA     0                 HOLDS KEY VALUE                     DBGR
ERRSI    RES      0                                                     DBGR
         LI,R6    ERR0              ERROR MSG                           DBGR
         BAL,R7   TYPE              TELL CUSTOMER                       DBGR
         B        *GET%IDRT         GET OUT (ERROR)                     DBGR
*
* GET:DEF---FINDS THE VALUE OF A DEF
*        EXPECTS THE DEF IN DEFNAME, AND THE LENGTH IN
*          DEFNAML
*        RETURNS TO BAL +1 IF CAN'T FIND IT
*        RETURNS TO BAL +2 WITH VALUE IN DEFLOC, IF FOUND
GET:DEF  RES      0
         STW,R5   5SAV
         LW,R6    DEFNAML
         AI,R6    1
         STB,R6   DEFCMP
         LW,R5    REFDEF            ADDRESS OF REF/DEF STACK
GET:00   RES      0
         LW,R6    0,R5
         B        GET:10
GET:05   RES      0
         LB,R6    R6
         AW,R5    R6                TO NEXT ENTRY
         CW,R5    SYMEND
         BL       GET:00            NEXT ENTRY
         B        *R10
GET:10   RES      0
         LW,R3    3,R5              CHECK NAME
         LB,R2    R3                FIRST CHECK SIZE
         CW,R2    DEFNAML
         BNE      GET:05
         LW,R2    R5
         AI,R2    3
         SLS,R2   2
         LW,R3    DEFCMP
         CBS,R2   0
         BNE      GET:05            TRY AGAIN
         LW,R6    1,R5              GET VALUE OF DEF
         LW,R2    2,R5
         BEZ      GET:20
GET:15   RES      0
         MTB,0    R2                DETERMINE RESOLUTION
         BNEZ     GET:20
         SLS,R2   8
         SLS,R6   1                 AND SHIFT AMOUNT
         B        GET:15
GET:20   RES      0
         STW,R6   DEFLOC
         LW,R5    5SAV
         AI,R10   1
         B        *R10
         PAGE
*
*   NEXTP---EXECUTE UP TO NEXT PROCEDURE-NAME
*
NEXTP    RES      0
         MTW,1    NEXTPF            SET NEXT PROCEDURE FLAG
         B        GO                TAKE OFF
*
*   NXT---EXECUTE UP TO NEXT STATEMENT
*
NXT      RES      0
         MTW,1    NEXTF             SET NEXT STATEMENT FLAG
         B        GO                START RUNNING
         PAGE
*
*   SETFILES---MAKE DCBS CONFORM TO A FILE OF ASSIGN COMMANDS
*
SETFILES RES      0
         BAL,R9   GETSTRING         GET ASSIGN-FILE NAME
         LW,R7    LENGTH
         AI,R7    3
         SLS,R7   -2
         SLS,R7   8
         OR,R7    FILEVPL
         STW,R7   SETF:FNM
         LI,R7    8
SETF:00  RES      0
         LW,R6    STRING-1,R7       MOVE NAME TO FPT
         STW,R6   SETF:FNM,R7
         BDR,R7   SETF:00
,SETFOPN M:OPEN   M:EI,(FILE,'123456789012345678901234567890'),;
                  (IN)
SETF:02  RES      0
         M:READ   M:EI,(BUF,BUFF),(SIZE,81),;
                  (ABN,SETF:99)
         LI,R5    BA(BUFF)
         BAL,R9   GETSTRING         CHECK FOR ASSIGN
         LI,R6    BA(STRING)
         LW,R7    ASSIGN
         CBS,R6   0
         BNE      SETF:02           NOT ASSIGN TRY NEXT
         BAL,R9   GETSTRING         GET DCB NAME
         LW,R3    LENGTH
         LI,R6    ':'
         STB,R6   STRING,R3
SETF:02A RES      0
         AI,R3    1
         LB,R6    0,R5
         CI,R6    ','
         BE       SETF:02B
         STB,R6   STRING,R3
         AI,R5    1
         B        SETF:02A
SETF:02B RES      0
         STB,R3   STRING
         STW,R3   LENGTH
         MTB,-1   STRING
         LI,R6    X'40'
         STB,R6   STRING,R3
         AI,R3    1
         STB,R6   STRING,R3
         AI,R3    1
         STB,R6   STRING,R3
         LW,R1    0
         AI,R1    10                POINT TO DCBPTR
         LW,R6    0,R1              GET DCB PTR
         LW,R7    0,R6              GET DCB LINK
SETF:011 RES      0
         STW,R7   LINKPTR           SAVE LINK PTR
         AI,R6    1                 SET TO 1ST NAME WORD
SETF:020 RES      0
         LW,R8    R6                SET UP CBS
         LB,R9    *R6               SIZE OF NAME
         CB,R9    STRING            SAME AS STRING
         BNE      SETF:DC1          NO. CAN'T BE THE ONE
         STB,R9   BA%STRNG
         LW,R9    BA%STRNG
         SLS,R8   2
         CBS,R8   1
         BNE      SETF:DC1          NO MATCH , TRY AGAIN
         AI,R8    4                 DCB ADDR IN NXT WORD
         SLS,R8   -2
         LW,R7    *R8
         OR,R7    =X'14000000'
         STW,R7   BASICFPT
         B        SETF:03
SETF:DC1 RES      0
         LB,R9    *R6
         AI,R9    3
         SLS,R9   -2
         AW,R6    R9
         AI,R6    1
         CW,R6    LINKPTR           OUT OF THIS TABLE PART
         BL       SETF:020          NO..KEEP TRYIN'
         LW,R7    0,R6
         BEZ      SETF:02           NO DCB FOR AN ASSIGN
         B        SETF:011
SETF:03  RES      0
         LI,R6    X'E000'
         STW,R6   BASICFPT+1
         LI,R7    22
         LI,R6    0
SETF:030 RES      0
         STW,R6   BASICFPT+1,R7
         BDR,R7   SETF:030          ZERO OUT BASIC FPT
         LI,R7    12
SETF:031 RES      0
         STW,R6   DEVICEFPT-1,R7
         BDR,R7   SETF:031          ZERO OUT DEVICE FPT
         LI,R7    VLP
         LI,R3    2
SETF:032 RES      0
         LW,R8    0,R7
         STB,R6   *R7,R3
         CW,R8    =X'00FF0000'
         BANZ     SETF:033
         AND,R8   =X'FF'
         AW,R7    R8
         AI,R7    1
         B        SETF:032
SETF:033 RES      0
         BAL,R9   GETPARM           GET ASSIGN PARAMETER
         B        SETF:033          UNPROCESSABLE
         B        SETF:50           NO MORE PARAMETERS
         B        SETF:FIL          (FILE,.....
         B        SETF:DEV          (DEVICE,....
         B        SETF:LAB          (LABEL,....
         B        SETF:ANS          (ANSLBL,...
         B        SETF:SN           (SN,....
SETF:50  RES      0
         LW,R8    BASICFPT+2
         LI,R7    2
         LI,R6    2
SETF:501 RES      0
         LW,R9    BASICFPT,R6
         STW,R9   BASICFPT,R7
         AI,R7    1
SETF:502 RES      0
         AI,R6    1
         AI,R8    0
         SLS,R8   1
         BGZ      SETF:502
         BLZ      SETF:501
         LI,R8    30
         LI,R6    0
SETF:505 RES      0
         LW,R9    VLP,R6
         STW,R9   BASICFPT,R7
         AI,R6    1
         AI,R7    1
         BDR,R8   SETF:505
*
* NO CONCERN WITH DEVICE FPT OPTIONS YET
         CAL1,1   BASICFPT          M:ADJUSTDCB
         B        SETF:02           GET NEXT ASSIGN
SETF:FIL RES      0                 ASSIGN TO A FILE
         BAL,R9   GETSTRING         GET FILE NAME
         LI,R7    8
SETF:F00 RES      0
         LW,R6    STRING-1,R7
         STW,R6   VLP,R7            MOVE FILE NAME
         BDR,R7   SETF:F00
         LW,R6    LENGTH
         AI,R6    3
         SLS,R6   -2
         SLS,R6   8
         AWM,R6   VLP               SET LENGTH OF NAME
         MTW,1    BASICFPT+1        SET FILE
         LW,R6    PUNCTUATION
         CI,R6    RHTPAR
         BE       SETF:033          NO ACCOUNT # GET NEXT
         BAL,R9   GETSTRING         GET NEXT (MUST BE ACCT#)
         LW,R6    STRING
         SLS,R6   8                                                     DBGR
         LB,R7    STRING+1                                              DBGR
         OR,R6    R7                                                    DBGR
         STW,R6   VLP+10
         LW,R6    STRING+1
         SLS,R6   8                                                     DBGR
         LB,R7    STRING+2                                              DBGR
         OR,R6    R7                                                    DBGR
         STW,R6   VLP+11
         LW,R6    LENGTH
         AI,R6    2
         SLS,R6   -2
         SLS,R6   8
         AWM,R6   VLP+9
         B        SETF:033
SETF:DEV RES      0
         BAL,R9   GETSTRING         GET DEVICE OPLBL/DEVICE TYPE
         LW,R6    STRING
         SLS,R6   -8
         AND,R6   =X'FFFF'
         STW,R6   BASICFPT+16       SET OPLBL                           DBGR
         LI,R6    X'FF'             IF ALREADY FILE, OR                 DBGR
         AND,R6   BASICFPT+1        SOMETHING...                        DBGR
         BNEZ     %+2               LEAVE IT ALONE                      DBGR
         MTW,3    BASICFPT+1        ELSE SET DEVICE                     DBGR
         B        SETF:033
SETF:LAB RES      0                 ASSIGN TO LABEL
         LI,R6    2                                                     DBGR
         LI,R7    X'F'                                                  DBGR
         STS,R6   BASICFPT+1                                            DBGR
SETF:LAA RES      0                                                     DBGR
         BAL,R9   PARSER
         LI,R6    8
SETF:L00 RES      0
         LW,R7    STRING-1,R6
         STW,R7   VLP,R6            MOVE FILE NAME
         BDR,R6   SETF:L00
         LW,R6    LENGTH
         AI,R6    3
         SLS,R6   -2
         SLS,R6   8
         AWM,R6   VLP               SET NAME LENGTH
         LW,R6    PUNCTUATION
         CI,R6    RHTPAR
         BE       SETF:L10          NO ACCOUNT #
         BAL,R9   PARSER            GET ACCOUNT #
         LW,R6    STRING
         STW,R6   VLP+10
         LW,R6    STRING+1
         STW,R6   VLP+11
         LW,R6    LENGTH
         AI,R6    3
         SLS,R6   -2
         SLS,R6   8
         AWM,R6   VLP+9
SETF:L10 RES      0
         B        SETF:033          GO FOR MORE PARAMTERS
*
SETF:ANS RES      0
         LI,R6    X'5'                                                  DBGR
         LI,R7    X'F'                                                  DBGR
         STS,R6   BASICFPT+1                                            DBGR
         B        SETF:LAA                                              DBGR
*
SETF:SN  RES      0
         BAL,R9   PARSER            GET SN
         LW,R6    STRING
         LW,R7    STRING+1
         SLD,R6   8
         LW,R8    LENGTH
         CI,R8    5                 LOOK FOR ONE MORE SINCE LENGTH      DBGR
         BLE      SETF:SN10         NOT ANS SN
*   HASH 6 CHAR ANS SN TO 4 CHAR                                        DBGR
         LI,R9    0                 CLEAR RESULT (NUMERIC)              DBGR
         LI,R1    6                 SET BIR LOOP CTL                    DBGR
SIXPACK1 RES      0                                                     DBGR
         LB,R7    STRING,R1         GET NEXT BYTE                       DBGR
         SLS,R7   26                STRIP OFF HI 2 BITS                 DBGR
         SLD,R6   2                 PUSH ZONE BITS INTO R6              DBGR
         SLS,R7   -28               RE-POSITION NUMERIC BITS            DBGR
         MI,R9    10                PREV NUMERIC TIMES 10               DBGR
         AW,R9    R7                NEW TOTAL                           DBGR
         AI,R1    1                                                     DBGR
         CI,R1    6                                                     DBGR
         BLE      SIXPACK1                                              DBGR
         SLS,R6   20                POSITION ZONE BITS                  DBGR
         OR,R6    R9                ALL TOGETHER NOW                    DBGR
SETF:SN10 RES     0
         LI,R7    2
         LB,R7    VLP:SN,R7
         AI,R7    1
         CI,R7    4
         BGE      SETF:033          CAN'T HANDLE MORE THAN 4 SN'S
         STW,R6   VLP:SN,R7         STORE SN
         LI,R6    2
         STB,R7   VLP:SN,R6         UPDATE SN COUNT
         LW,R6    PUNCTUATION
         CI,R6    RHTPAR                                                DBGR
         BNE      SETF:SN           MORE...GO BACK
         B        SETF:033          NO MORE...NEXT PARM
*
PARSER   RES      0
         STW,R9   PSV
         BAL,R9   GETSTRING
         LW,R6    PUNCTUATION
         CI,R6    COLON
         BNE      *PSV
         LI,R7    ':'
         LW,R6    LENGTH
         AI,R6    1
         STB,R7   STRING,R6
         B        SCAN00
SETF:99  RES      0
         M:CLOSE  M:EI
         B        NEXT
*
*  GETPARM--ISOLATE AND IDENTIFY ASSIGN PARAMETERS
*
GETPARM  RES      0
         STW,R9   SAV9
GETP:00  RES      0
         BAL,R9   GETSTRING
         LW,R6    PUNCTUATION
         CI,R6    SEMICOL
         BE       GETP:RD
         CI,R6    CARRET
         BE       GETP:END
         CI,R6    PERIOD
         BE       GETP:END
         CI,R6    LFTPAR
         BNE      GETP:00
         BAL,R9   GETSTRING         GET KEYWORD
         MTW,-1   LENGTH
         LI,R6    BA(PARMS)-2
         LW,R7    LENGTH
         STB,R7   CMP:PARM
GETP:10  RES      0
         AI,R6    2
         LB,R7    0,R6
         CW,R7    LENGTH
         BE       GETP:20
         BG       GETP:NO
         AW,R6    R7
         B        GETP:10
GETP:20  RES      0
         LW,R7    CMP:PARM
         CBS,R6   1
         BE       GETP:30
         BG       GETP:NO
         SLS,R7   -24
         AW,R6    R7
         B        GETP:10
GETP:30  RES      0
         AI,R6    1
         LB,R6    0,R6
         B        *SAV9,R6
GETP:NO  RES      0
         B        *SAV9
GETP:RD  EXU      SETF:02
         B        GETP:00
GETP:END RES      0
         LI,R6    1
         B        *SAV9,R6
         PAGE
*
*   IF---CONDITION EVALUATION
*
IF       RES      0
         BAL,R9   FIND:DD           RESOLVE SUBJECT
         LW,R6    DADDR
         STW,R6   SADDR
         LW,R6    DSIZE
         STW,R6   SSIZE
         LW,R6    DCLASS
         STW,R6   SCLASS            SAVE SUBJECT INFO
         BAL,R9   GETSTRING         GET OPERATOR
         LW,R6    STRING
         LI,R7    9
IF:00    RES      0
         CW,R6    OPERATOR,R7       WHICH OPERATOR
         BE       IF:02
         BDR,R7   IF:00
         B        INVALID           NO OPERATOR
IF:02    RES      0
         LW,R6    IF:TBL,R7
         STW,R6   IF:BR
         BAL,R9   GETSTRING         GET OBJECT
         LI,R4    0
         LI,R6    1
         LB,R6    STRING,R6
         CI,R6    X'7D'             QUOTE
         BE       IF:C              YES. NONUMERIC LITERAL
         CI,R6    'X'
         BE       IF:X
         LB,R4    STRING
IF:05    RES      0
         LB,R6    STRING,R4
         CI,R6    X'F0'
         BL       IF:10
         BDR,R4   IF:05             CHECK FOR ALL NUMERIC
IF:NUM   RES      0
         LI,R6    0
         STB,R6   STRING
         LW,R6    LENGTH
         AI,R6    1
         LI,R4    1
         AND,R4   R6
         SLS,R6   -1
         SCS,R6   -12
         OR,R6    APACK
         EXU      R6
         LW,R6    DCLASS
         CI,R6    12
         BE       IF:B              INDEX
         CI,R6    13
         BE       IF:B
         BG       NONNUM
         CI,R6    6
         BE       IF:ND
         CI,R6    7
         BE       IF:ND
         CI,R6    8
         BE       IF:NP
         CI,R6    9
         BE       IF:NP
         B        NONNUM
IF:10    RES      0
         CI,R4    1                 FIRST CHARACTER
         BNE      IF:NAME           NO...MUST BE NAME
         CI,R6    '+'
         BE       IF:11             PLUS SIGN
         CI,R6    '-'
         BNE      IF:NAME           NOT MINUS MUST BE NAME
         LB,R3    STRING
         LB,R6    STRING,R3         GET SIGN CHAR
         AI,R6    -X'20'            SET MINUS
         STB,R6   STRING,R3
IF:11    RES      0
         LI,R6    X'F0'
         STH,R6   STRING            STORE AS LEADING ZERO
         LI,R4    0
         B        IF:NUM
*  NUMERIC PACKED
IF:NP    RES      0
         LW,R6    DADDR
         LW,R5    DSIZE
         SCS,R5   -12
         OR,R5    ACMP
         EXU      R5                DO DECIMAL COMPARE
         EXU      IF:BR             MAKE DECISION
         B        IF:FALSE
*  NUMERIC DISPLAY
IF:ND    RES      0
         DST,0    BUFF
         LW,R4    DADDR
         LW,R6    DSIZE
         CI,R4    1
         BANZ     IF:ND00
         LI,R5    BA(STRING)+1
         STB,R6   R5
         MBS,R4   0
         LI,R4    BA(STRING)
         LI,R7    '0'
         STB,R7   STRING
IF:ND00  RES      0
         AI,R6    2
         SLS,R6   -1                                                    DBGR
         SCS,R6   -12
         OR,R6    APACK:0           SET UP PACK  (PACK,0 0,4)           DBGR
         EXU      R6                PACK IT
         DST,0    STRING                                                DBGR
         DL,0     BUFF                                                  DBGR
         DC,0     STRING                                                DBGR
         DC,0     BUFF
         EXU      IF:BR             TAKE CONDITIONAL BRANCH
         B        IF:FALSE
*  NUMERIC BINARY
IF:B     RES      0
         BAL,R9   DECBIN
         LW,R6    STRING
         LW,R4    DADDR
         SLS,R4   -2
         CW,R6    0,R4
         B        IF:BR
IF:C    RES      0
         LB,R3    STRING            DOES STRING
         LB,R6    STRING,R3           END
         CI,R6    X'7D'                 WITH QUOTE
         BNE      IF:STRG          NO. GET REST OF LITERAL
         LI,R6    0
         CI,R3    1                 IS QUOTE ONLY CHAR
         BE       IF:STRG          YES. GET REST OF LITERAL
IFF:C00   RES      0
         LI,R4    1
IF:C:00 RES      0
         LW,R7    DADDR
         LB,R6    STRING
         AI,R6    -2
         CW,R6    DSIZE
         BG       ERM7              LITERAL BIGGER THAN FIELD
         BL       IF:CP            LITERAL SHORT--NEED PAD
IF:C0   RES      0
         STB,R6   R7
         LI,R6    BA(STRING)+1
         AW,R6    R4
         CBS,R6   0
         B        IF:BR
IF:STRG RES      0
         AI,R5    -2                BACKUP TO PUNCTUATION
IF:S:A  RES      0
         AI,R5    1
         CI,R6    X'5E'             WAS IT A SEMICOLON
         BNE      IF:S00           NO...KEEP LOOKIN'
         LB,R4    0,R5              IS NEXT CHAR
         CI,R4    X'0D'                SOME KIND OF
         BE       %+3
         CI,R4    X'15'             CARRIAGE RETURN
         BNE      IF:S00           NO.
         EXU      NEXTR             YES. GET ANOTHER LINE
         LI,R5    BA(BUFF)
         B        IF:S05           GO PROCESS IT
IF:S00  RES      0
         CI,R6    X'7D'             IS IT A QUOTE
         BE       IF:S10           YES.. END OF LITERAL
         STB,R6   STRING,R3         NO. STORE IT AND GO ON
         AI,R3    1
IF:S05  RES      0
         LB,R6    0,R5              NEXT CHAR
         CI,R3    253               TOO MANY CHAR
         BL       IF:S:A           NO. KEEP ON
         B        ERM7              YES. FORGET IT
IF:CP    RES      0                                                     DBGR
         LI,R6    X'40'                                                 DBGR
         STB,R6   STRING,R3                                             DBGR
         AI,R3    1                                                     DBGR
IF:S10  RES      0
         STB,R3   STRING            SET SIZE
         STB,R6   STRING,R3         PUT IN QUOTE FOR DRILL
         AI,R3    1
         STW,R3   LENGTH            SET TOTAL LENGTH
         B        IFF:C00            GO BACK TO PROCESS
IF:X    RES      0
         LB,R3    STRING
         LB,R6    STRING,R3
         CI,R6    X'7D'             END WITH QUOTE
         BNE      IF:NAME
         LI,R2    0
         STB,R2   STRING,R3         GET RID OF TRAILING QUOTE
         LI,R3    3                 IF TO FIRST 'REAL' CHARACTER
         LI,R4    6                 FIRST STRING IS SHORT
IF:X:00 RES      0
         LB,R6    STRING,R3
         BEZ      IF:X:10          ALL CONVERTED
         AI,R6    -X'F0'            CONVERT IF 0 THRU 9
         BGEZ     %+2
         AI,R6    X'39'             TAKE CARE OF A THRU F
         SLS,R10  4                 MAKE ROOM FOR NEW
         AW,R10   R6
         AI,R3    1                 NEXT CHAR.
         BDR,R4   IF:X:00          GO DO IT
         STW,R10  STRING,R2
         AI,R2    1
         LI,R4    8
         B        IF:X:00
IF:X:10 RES      0
         SLS,R4   2
         SLS,R10  0,R4              ADJUST TO LFT JUST
         STW,R10  STRING,R2           AND STORE
         LW,R6    LENGTH
         AI,R6    1
         SLS,R6   -1
         STB,R6   STRING
         AI,R6    1
         LI,R4    0
         B        IF:C:00
IF:NAME RES      0
         B        ERM3              NO NAME PROCESSING YET
IF:BR    RES      0
         BCR,0    INVALID
IF:FALSE RES      0
         LI,R6    0
         STW,R6   PULLFLAG          RESET
         STW,R6   CONTINUE           ATTACHED COMMANDS
         STW,R6   READCMD             FLAGS
         B        *SAVE11             & GET OUT
         PAGE
*
*    QUALIFY---CHANGE DEFAULT VALUES
*
QUALIFY  RES      0
         LI,R6    ERR10             ERROR MESSAGE FOR QUALIFY           DBGR
         B        ERTY              PRINT IT, GO TO NEXT                DBGR
* UNIMPLEMENTED
         PAGE
*
*   FIND:DD---FIND THE DATA DEFINITION FOR THE INPUT STREAM
*                 R5 MUST POINT TO INPUT BUFFER
*                 OUTPUT IS   DATA CLASS IN DCLASS,
*                             DATA SIZE IN DSIZE,
*                             DATA ADDRESS IN DADDR
*
FIND:DD  RES      0
         STW,R9   9SAV
         LI,R9    0
         STW,R9   QUALCTR
         BAL,R9   GETSTRING         SET UP INITIAL KEY
         BAL,R9   FINDREC           GET DATA-NAME
         BAL,R9   MOVEKEY
         BAL,R9   GETQUAL           GET FIRST QUALIFIER
         B        FIND:50           ..NONE
         BAL,R9   MOVEKEY
         BAL,R9   GETQUAL           GET 2ND QUALIFIER
         B        FIND:50           ..NONE
         BAL,R9   MOVEKEY
         BAL,R9   GETSTRING
FIND:50  RES      0
         MTW,-1   QUALCTR           REDUCE QUALIFIER COUNT
         BEZ      FIND:60           NONE LEFT..DO SUBSCRIPTS
FIND:51  RES      0
         LW,R1    QUALCTR
         LD,R2    RECORDNM,R1
         CBS,R2   0                 ARE NAMES THE SAME
         BE       FIND:53             FOR RECORD AND BASE
         LD,R2    RECORDNM,R1
         LI,R4    X'40'             IF HIGHER QUAL IS
         CB,R4    0,R3                RECORD OR FILE
         BE       FIND:53           YES. OK
FIND:52  RES      0
         LW,R3    BUFTBL,R1
         AI,R3    25
         LB,R2    *R3               GET LENGTH OF KEY                   DBGR
         MTB,1    *R3,R2            BUMP BLANK AT END T NEXT KEY        DBGR
         LW,R6    BUFTBL,R1
         M:READ   M:CI,(KEY,*R3),(BUF,*R6),(ERR,FIND:55)
         B        FIND:51
FIND:53  RES      0
         LD,R2    RECORDLN,R1
         CBS,R2   0
         BG       FIND:50           GOOD QUAL
         B        FIND:52           TRY ANOTHER LOWER LEVEL
FIND:55  RES      0
         B        INVALID           BAD QUALIFIER
FIND:60  RES      0
         LW,R6    BUFTBL            GET BUFFER ADDRESS                  DBGR
         LI,R9    %+3               SET UP RETURN POINT                 DBGR
         STW,R9   FINDRECX          S                                   DBGR
         B        FINDR:02          GO FIND BASE DSP ETC.               DBGR
         LW,R1    BUFTBL
         LCI      3
         LM,R7    22,R1
         STW,R7   DSIZE
         STW,R8   DCLASS
         STW,R9   DADDR
FIND:SUB RES      0
         CI,R6    COLON                                                 DBGR
         BNE      FIND:80                                               DBGR
         BAL,R9   GETSTRING         GET PROGRAM-ID                      DBGR
         LW,R6    STRING                                                DBGR
         STW,R6   WHNSV                                                 DBGR
         LW,R6    STRING+1          SAVE FOR POSSIBLE                   DBGR
         STW,R6   WHNSV             USE IN WHEN CMD                     DBGR
         LW,R6    LENGTH                                                DBGR
         STW,R6   WHNSVL                                                DBGR
         B        FIND:85           NOW CHECK FOR SUB                   DBGR
FIND:80  RES      0                                                     DBGR
         LW,R6    DEFAULT           SAVE DEFAULT                        DBGR
         STW,R6   WHNSV                                                 DBGR
         LW,R6    DEFAULT+1                                             DBGR
         STW,R6   WHNSV+1                                               DBGR
         LW,R6    DEFAULTL                                              DBGR
         STW,R6   WHNSVL                                                DBGR
FIND:85  RES      0                                                     DBGR
         LW,R6    PUNCTUATION
         CI,R6    LFTPAR
         BNE      FIND:90
         LW,R6    STRING
FIND:600 RES      0
         BAL,R9   GETSTRING
         LB,R4    STRING
         LI,R6    X'F0'
FIND:61  RES      0
         CB,R6    STRING,R4
         BG       FIND:70           DATA NAME
         BDR,R4   FIND:61
FIND:610 RES      0
         LI,R9    X'40'
         LB,R6    STRING
         AI,R6    1
         STB,R9   STRING,R6
         BAL,R9   DECBIN            CONVERT TO BINARY
FIND:62  RES      0
         LW,R7    STRING
FIND:63  RES      0
         MTW,1    SUBCTR
         LW,R6    SUBCTR
         AI,R7    -1
         MH,R7    DSUB,R6
FIND:64  RES      0
         AWM,R7   DADDR
         LW,R6    PUNCTUATION
         CI,R6    RHTPAR
         BNE      FIND:600
         LI,R6    0
         STW,R6   SUBCTR
         BAL,R9   GETSTRING
FIND:90  RES      0
         LW,R6    PUNCTUATION
         CI,R6    CARRET
         BE       *9SAV
         MTW,1    NOLOOKI
         B        *9SAV
FIND:70  RES      0                 DATA NAME SUBSCRIPT
         MTW,1    QUALCTR
         BAL,R9   FINDREC
         MTW,-1   QUALCTR
         LW,R6    QUALCL            CLASS OF SUB
         AI,R6    -6
         BL       INVALID
         B        %+1,R6
         B        FIND:7D           ND
         B        FIND:7D           NDU
         B        FIND:7P           NP
         B        FIND:7P           NPU
         B        INVALID
         B        INVALID
         B        FIND:7X           INDEX
         B        FIND:7B           NB
         B        INVALID
         B        INVALID
FIND:7X  RES      0                 INDEX
         LW,R7    QUALAD
         SLS,R7   -2
         LW,R7    0,R7
         B        FIND:64
FIND:7B  RES      0
         LW,R7    QUALAD
         SLS,R7   -2
         LW,R7    0,R7
         B        FIND:63
FIND:7D  RES      0                 DISPLAY
         LI,R7    BA(STRING)+1
         LW,R6    QUALSZ
         STB,R6   STRING
         STW,R6   LENGTH
         STB,R6   R7
         LW,R6    QUALAD
         MBS,R6   0
         B        FIND:610
FIND:7P  RES      0                 PACKED
         LW,R6    QUALAD
         LW,R7    QUALSZ
         SCS,R7   -12
         OR,R7    ALOAD
         EXU      R7
         BL       FIND:75
         UNPK,4   STRING
         LI,R6    7
         STB,R6   STRING
         AI,R6    1
         STW,R6   LENGTH
         LI,R7    X'F0'
         STS,R7   STRING+1
         B        FIND:610
FIND:75  RES      0
         LI,R6    BADSIGN
         BAL,R7   TYPE
         B        *9SAV
BADSIGN  TEXTC    'NEGATIVE SUBSCRIPT??'
FINDREC  RES      0
         STW,R9   FINDRECX
         MTW,1    QUALCTR
         MTB,1    STRING
         LI,R6    ABBREV-ATBLSZ
FINDR:00 RES      0
         AI,R6    ATBLSZ
         LW,R7    0,R6
         BEZ      FINDR:00          NON-ENTRY
         BLZ      FINDR:01          NO MO' ENTRIES
         CW,R7    STRING            CHECK MATCH ON 1ST WORD
         BNE      FINDR:00          NO. TRY 'GIN
         LB,R7    R7                SINGLE WORD
         CI,R7    4
         BLE      FINDR:0A          YEP..WE DONE
         LW,R7    1,R6
         CW,R7    STRING+1          NOPE.. NEXT WORD
         BNE      FINDR:00          NO MATCH, GO BACK
FINDR:0A RES      0
         LW,R2    QUALCTR
         LW,R7    BUFTBL,R2
         AI,R6    2
         SLS,R6   2
         AW,R7    =ATBLSZ**24
         SLS,R7   2
         MBS,R6   0
FINDR:98 RES      0
         B        *FINDRECX
FINDR:01 RES      0
         LW,R1    QUALCTR
         LW,R6    BUFTBL,R1
         M:READ   M:CI,(KEY,STRING),(BUF,*R6),(ERR,ERM6)
FINDR:02 EQU      %                                                     DBGR
         STW,R6   CURBUF
         LI,R6    4
         LH,R7    *CURBUF,R6
         AND,R7   =X'FFFF'          SIZE
         LI,R6    16
         LB,R8    *CURBUF,R6        CLASS
         LI,R6    52
         LB,R9    *CURBUF,R6        CHECK WHICH BASE
         CI,R9    'W'
         BE       FINDR:W            --WORKING-STORAGE
         CI,R9    31
         BL       FINDR:F            --FD/SD
         CI,R9    'C'
         BE       FINDR:C            --COMMON-STORAGE
         B        INVALID
FINDR:W  RES      0
         LW,R9    WRKLOC
FINDR:10 RES      0
         LI,R6    1
         AW,R9    *CURBUF,R6
         B        FINDR:92
FINDR:F  RES      0
         STW,R9   DEFNAML
         LI,R6    8
         LI,R4    21
FINDR:F0 RES      0
         AI,R4    -1
         LW,R9    *CURBUF,R4
         STW,R9   DEFNAM-1,R6
         BDR,R6   FINDR:F0
         CI,R8    12                INDEX DATA ITEM
         BNE      FINDR:F8          NO.
         LI,R4    21*2-1            YES. SHIFT
         LI,R6    8*2-1               NAME
FINDR:F1 RES      0
         AI,R4    -1                  OVER
         LH,R9    *CURBUF,R4          BY
         STH,R9   DEFNAM,R6         2 BYTES
         BDR,R6   FINDR:F1
         MTW,2    DEFNAML           UPDATE LENGTH
         LW,R9    DEFNAM
         AND,R9   =X'FF'
         OR,R9    =X'00C97A00'
         STW,R9   DEFNAM
         LW,R9    DEFNAML
         STB,R9   DEFNAM
FINDR:F8 RES      0
         BAL,R10  GET:DEF
         B        INVALID           NO SUCH DEF
         LW,R9    DEFLOC
         B        FINDR:10
FINDR:C  RES      0
         LW,R9    COMLOC
         B        FINDR:10
FINDR:92 RES      0
         LI,R6    22
         LCI      3
         STM,R7   *CURBUF,R6
         B        *FINDRECX
*
*
*
GETQUAL  RES      0
         STW,R9   GETQUALX
         BAL,R9   CHKANY            ANY STRINGS LEFT
         B        *GETQUALX         NO
         BAL,R9   GETSTRING
         LW,R6    STRING
         CLM,R6   IN:OF:2
         BCR,12   GQE
         BCS,3    *GETQUALX
GQE      RES      0
         BAL,R9   CHKANY            ANOTHER STRING AVAIL
         B        QUALERR           NO. BAD QUALIFICATION
         BAL,R9   GETSTRING
         BAL,R9   FINDREC
         MTW,1    GETQUALX
         B        *GETQUALX
*
CHKANY   RES      0
         LW,R6    PUNCTUATION       IF LAST PUNCTUATION
         CI,R6    CARRET            WAS CARRIAGE RETURN
         BE       *R9
         CI,R6    SEMICOL             OR SEMICOLON
         BE       *R9
         CI,R6    COLON               OR COLON
         BE       *R9               REPORT NO STRING AVAIL
         AI,R9    1
         B        *R9
*
MOVEKEY  RES      0
         LB,R1    STRING
         LW,R1    QUALCTR
         LW,R7    BUFTBL,R1
         AW,R7    =25+32**22
         SLS,R7   2
         LI,R6    BA(STRING)
         MBS,R6   0
         B        *R9
*
NOPAGES  RES      0
         LI,R6    BYEBYE
         BAL,R7   TYPE
         B        END
         PAGE
*
*   C:EXIT---EXIT CONTROL ROUTINE FOR THE DEBUGGER
*
C:EXIT   RES      0
         STW,R6   EXIT:R6:SAVE      SAVE R6                             DBGR
         LW,R6    0,R1
         AND,R6   =X'1FFFF'         OF THE EXIT CAUSE
         CI,R6    END
         BE       END               IF END COMMAND, HONOR IT
         LI,R5    0
         B        NEXT:11
EXIT:10  RES      0
         AI,R5    1
         SLS,R8   -1
NEXT:11  RES      0
         CI,R8    0
         BG       EXIT:10
         BE       C:XIT00
C:XIT10  RES      0
         LI,R6    EXITPRE
         BAL,R7   TYPENC
         LW,R6    EXITBL,R5
         BAL,R7   TYPE
         B        %+1,R5
         B        RTNEXT            0 = NORMAL
         B        RTNEXT            1 = TRAP
         B        IOERROR           2 = I/O ERROR
         B        LIMIT             3 = LIMIT EXCEEDED
         B        RTNEND            4 = DISCONNECT
         B        RTNEND            5 = OPERATOR ABORT
         B        RTNEND            6 = OPERATOR ERR
         B        RTNEXT            7 = M:XXX OR CONTROL Y
         B        RTNEXT            8 = M:ERR
*
*  LIMIT EXCEEDED
LIMIT    RES      0
         LI,R5    0
LIMIT:10 RES      0
         CI,R9    1
         BAZ      %+2
         AI,R5    1
         SLS,R9   -1
         CI,R9    0
         BG       LIMIT:10
         LW,R6    LIMITBL,R5
         BAL,R7   TYPE
         B        %+1,R5
         B        RTNEND            0 = UNKNOWN
         B        RTNEND            1 = PUNCHED OUTPUT
         B        RTNEND            2 = PROCESSOR PRINTG
         B        RTNEND            3 = USER PRINTING
         B        RTNEND            4 = DIAGNOSTIC PRTG
         B        RTNEXT            5 = OUT OF PERM DISC
         B        RTNEXT            6 = OUT OF TEMP DISC
         B        RTNEXT            7 = OUT OF SCRATCH TAPES
         B        RTNEND            8 = CPU
         B        RTNEXT            9 = ACCOUNT OUT OF DISC
*
IOERROR  RES      0
         SLS,R10  8
         AW,R10   R11
         LW,R6    R10
         LI,R10   BA(BUF1)+1
         BAL,R11  C:DBD
         LI,R6    4
         STB,R6   BUF1
         LI,R6    BUF1
         BAL,R7   TYPE
         B        RTNEXT
*
*
RTNEXT   RES      0
         LC       R12               WAS THIS AN M:LINK                  DBGR
         BCS,4    LINKED            YES                                 DBGR
         LI,R6    RTNEXT0
         LI,R7    X'1FFFF'
         STS,R6   0,R1
         M:TRTN   XCON
RTNEXT0  RES      0
         M:INT    BREAK
         B        BRKS
LINKED   RES      0                                                     DBGR
         BCS,8    RE:LINK           IS PSD IN R2 AND R3                 DBGR
         LW,R2    0,R1              NO. GET 1ST WORD                    DBGR
RE:LINK  RES      0                                                     DBGR
         AND,R2   =X'1FFFF'         ISOLATE M:LINK ADDR                 DBGR
         STW,R2   RESTRT            SAVE IT                             DBGR
         LW,R6    EXIT:R6:SAVE      RESTORE R6                          DBGR
         EXU      0,R2              RE-LINK                             DBGR
         M:XCON   C:EXIT                                                DBGR
         M:PC     '>'                                                   DBGR
         M:INT    BREAK                                                 DBGR
         M:TRAP   C:TRP,(TRAP,ALL)                                      DBGR
         MTW,1    RESTRT                                                DBGR
         B        *RESTRT                                               DBGR
*
*
RTNEND   RES      0
         B        END
C:XIT00  RES      0
         CW,R12   =X'40000000'
         BANZ     RTNEXT            YES ITS A LINKED TO PROGRAM         DBGR
         STW,R6   C:XITR
         EXU      *C:XITR
         M:XCON   C:EXIT
         M:INT    BREAK
         M:TRAP   C:TRP,(TRAP,ALL)
         MTW,1    C:XITR
         B        *C:XITR
C:XITR   DATA     0
EXIT:R6:SAVE RES  1                                                     DBGR
*
*   C:TRP---REPLACES COBOL RUN-TIME TRAP ROUTINE
*
         DEF      C:TRP2
C:TRP2   RES      0
C:TRP    RES      0
         LI,R6    CR                                                    DBGR
         BAL,R7   TYPENC                                                DBGR
         LW,R6    0,R1
         AND,R6   =X'1FFFF'
         CLM,R6   MYLIMITS          ARE WE IN DEBUGGER
         BCS,9    C:TRPU            NO...REPORT USER ERROR
         LI,R6    ATRAPM
         BAL,R7   TYPE
         LI,R6    NEXTR             GO ASK FOR HELP
         LI,R7    X'1FFFF'
         STS,R6   0,R1
         M:TRTN
*        USER HAS TRAPPED .... GOT TO TELL HIM
C:TRPU   RES      0
         LW,R4    18,R1             TRAP INTERUPT LOC'N
         AI,R4    -X'40'
         BLZ      MYSTERY           UNKNOWN TRAP
         CI,R4    X'B'
         BG       MYSTERY           DITTO
         B        %+1,R4            JUMP ON TRAP NUMBER
         B        MYSTERY
         B        MYSTERY
         B        MYSTERY
         B        MYSTERY
         B        MYSTERY
         B        TRAP45            DECIMAL TRAP WE KNOW ABOUT
         B        MYSTERY
         B        MYSTERY
         B        MYSTERY
         B        MYSTERY
         B        MYSTERY
         B        MYSTERY
*
*  DECIMAL TRAP HANDLER
TRAP45   RES      0
         LW,R5    C:TRN             IF 'IF NUMERIC'
         BGZ      TRAPXIT           GO BACK
         LCF      *R1               BAD DATA
         BCR,8    TRAPXIT           ..NO GO BACK
         LW,R5    0,R1
         AND,R5   =X'1FFFF'         INSTR ADDR TO R5
         LW,R5    0,R5              INSTR TO R5
         BLZ      TRAP45I           INDIRECT
         LB,R6    R5                OP CODE
         CI,R6    X'76'             IS IT A PACK
         BNE      TRAP45E           NO..MUST BE AN ERROR
         STW,R5   TRAPINS           SAVE INSTRUCTION
TRAP451  RES      0
         AND,R5   =X'1FFFF'
         SLS,R5   2
         LW,R7    TRAPINS
         AND,R7   =X'000E0000'      INDEX SPECIFIED
         BEZ      TRAP452           NO.
         SCS,R7   15                YES REGISTER TO LO ORDER
         AW,R7    R1                 PLUS STACK ADDR
         AW,R5    4,R7              ADD INDEX VALUE
TRAP452  RES      0
         LW,R7    =X'00F00000'
         AND,R7   TRAPINS           GET LENGTH
         BNEZ     %+2
         LW,R7    =X'01000000'
         SCS,R7   12
         STW,R7   LENGTH            SAVE LENGTH
TRAP453  RES      0
         LB,R6    0,R5
         CI,R6    X'40'             ALL SPACES
         BNE      TRAP45E           NO. BAD DATA
         BDR,R7   TRAP453           CAN'T TELL YET
         DL,1     DECZERO           YES. BACK TO USER WITH ZERO
         DST,0    16,R1             IN DECA
         B        TRAPXIT
TRAP45I  RES      0
         EOR,R5   =X'80000000'      STRIP INDIRECT BIT
         LB,R6    R5                PICK UP OP CODE
         CI,R6    X'76'
         BNE      TRAP45E
         STW,R5   TRAPINS
         LW,R5    0,R5
         B        TRAP451
TRAP45E  RES      0
TRAPE    RES      0
         LW,R6    TRAPMSG,R4
         BAL,R7   TYPE
         LI,R6    BRKS
         LI,R7    X'1FFFF'
         STS,R6   0,R1
         M:TRTN
MYSTERY  RES      0
         LI,R4    -1
         B        TRAPE
TRAPXIT  RES      0
         MTW,1    *R1               TO NEXT INST
         M:TRTN                       AND CONTINUE
         PAGE
*
*                 L O C A T E
*        SCANS THE INPUT COMMAND LINE AND  DETERNINES IF TH
*        LOCATION REFERENCED IS A STATEMENT(VERB) IDENTIFIER,
*        OR A PROCEDURE-NAME IDENTIFIER..
*        RETURNS TO BAL +1 IF IT IS A STATEMENT(VERB) IDENTIFIER
*                 AND GIVES THE ENCODED IDENTIFIER IN 'STATEMENT'
*        RETURNS TO BAL +2 IF IT IS A PROCEDURE-NAME IDENTIFIER
*        EXPECT THE BYTE ADDRESS OF THE NEXT CHARACTER IN THE
*                 INPUT COMMAND TO BE IN R5...R5 IS UPDATED AT EXIT...
*        ISSUES APPROPRIATE ERROR MESSAGE IF ERROR IS FOUND
*
*
LOCATE   RES      0
         STW,R9   LOC:XIT           SAVE RETURN
         BAL,R9   GETSTRING         GET LINE/PARAGRAPH
         LW,R6    LENGTH
         AI,R6    -1
LOCT00   RES      0
         LB,R7    STRING,R6         GET CHAR
         CLM,R7   F0:F9             NUMERIC
         BCS,9    LOCT10            NO. MUST BE PNAME
         BDR,R6   LOCT00            TRY ALL CHARCTERS
*        MUST BE LINE NUMBER
         LI,R3    0
         LI,R6    1
LOCT02   RES      0
         LB,R7    STRING,R6
         AND,R7   =X'0F'
         MH,R3    =X'A0000'
         AW,R3    R7
         AI,R6    1
         CW,R6    LENGTH
         BL       LOCT02
         STW,R3   STATEMENT
         LW,R4    PUNCTUATION
         CI,R4    PERIOD
         BNE      LOCT06
*   SUB LINE NUMBER EXISTS -- CONVERT IT TOO
         LI,R6    0
         BAL,R9   GETSTRING         GET SUB-LINE
         LI,R3    0
LOCT04   RES      0
         LB,R7    STRING,R6
         AND,R7   =X'0F'
         AW,R3    R7
         MH,R3    =X'A0000'
         AI,R6    1
         CW,R6    LENGTH
         BNE      LOCT04
         STH,R3   STATEMENT
         LW,R4    PUNCTUATION
LOCT06   RES      0
         CI,R4    LFTPAR
         BNE      LOCT08            NO VERB NUMBER
         BAL,R9   GETSTRING         GET VERB
         LB,R6    STRING
         LB,R7    STRING,R6
         AND,R7   =X'0F'
         SCS,R7   -4
         AWM,R7   STATEMENT
         LW,R4    PUNCTUATION
         CI,R4    RHTPAR
         BNE      INVALID
LOCT08   RES      0
         B        *LOC:XIT
LOCT10   RES      0
         CI,R6    1                 WE ARE AT LEFTMOST BYTE             DBGR
         BNE      LOCT20            NO                                  DBGR
         CI,R7    X'7B'             IS THAT BYTE A #                    DBGR
         BNE      LOCT20            NO                                  DBGR
         MTW,-1   LENGTH            ALL NUMERIC PROCEDURE NAME          DBGR
         LW,R9    LENGTH            GET IT                              DBGR
         MTW,-1   R9                REDUCE AGAIN FOR MOVE   CONTROL     DBGR
         LI,R7    2                 PRIME THE INDEX                     DBGR
LOCT11   RES      0                                                     DBGR
         LB,R3    STRING,R7         MOVE BYTE 1 POS TO LEFT             DBGR
         STB,R3   STRING,R6         SHIFTING NUMERIC NAME 1 POS LEFT    DBGR
         MTW,1    R7                UP INDEX FOR NXT BYTE               DBGR
         MTW,1    R6                UP INDEX FOR NEXT BYTE              DBGR
         BDR,R9   LOCT11            DO AGAIN                            DBGR
         LI,R7    X'40'             INSURE A BLANK                      DBGR
         STB,R7   STRING,R6         AFTER THE PROCEDURE NAME            DBGR
         MTB,-1   STRING            REDUCE LENGTH (NO # ANYMORE)        DBGR
LOCT20   RES      0
         MTW,1    LOC:XIT
         B        *LOC:XIT
         PAGE
*
*  INPUT LINE SCAN ROUTINE
*     INPUT--ADDRESS OF INPUT BUFFER IN R5
*     OUTPUT---TEXT STRING IN 'STRING',
*        LENGTH OF STRING IN BYTES IN 'LENGTH',
*        PUNCTUATION CHARACTER (ENCODED) WHICH ENDED THE
*        STRING IN 'PUNCTUATION'....
*
GETSTRING RES     0
         LI,R6    0
         XW,R6    NOLOOKI
         BNEZ     *R9               WE ALREADY LOOKED
SCAN00   RES      0
         AI,R6    1
         LB,R4    0,R5              PICK UP CHARACTER
         LI,R3    #PUNCTUATION      SET TO COMPARE TO PUNCT.
SCAN01   RES      0
         CB,R4    PUNCT:TB,R3
         BE       SCAN99            PUNCTUATION FOUND
         BDR,R3   SCAN01
         STB,R4   STRING,R6         STORE BYTE IN OUTPUT STRING
         AI,R5    1                 NEXT
         B        SCAN00
SCAN99   RES      0
         STW,R6   LENGTH            SET LENGTH
         STB,R6   STRING
         MTB,-1   STRING
         CI,R3    LINFEED           LINEFEED
         BNE      %+2               SAME AS
         LI,R3    CARRET              CARRIAGE RETURN
         STW,R3   PUNCTUATION       SET PUNCT.
         CI,R3    BLANK
         BNE      SCAN996
         CI,R6    1
         BNE      SCAN996
         LI,R3    X'40'
SCAN995  RES      0
         AI,R5    1                 SET TO 1ST CHAR OF NXT
         CB,R3    0,R5              SKIPPING SPACES
         BE       SCAN995
         B        GETSTRING
SCAN996  RES      0
         LI,R3    X'40'
         STB,R3   STRING,R6
         AI,R6    1
         STB,R3   STRING,R6
         AI,R6    1
         STB,R3   STRING,R6         INSURE BLANK FILLED WORD
         AI,R5    1
         B        *R9
*
* NULL ERROR AND ABNORMAL ROUTINE....
*   INCLUDED TO FORCE WAIT ON IO
*
NULL     RES      0
         B        *R8               GO ON
ERM1     RES      0
         LW,R6    INSRTNG
         BEZ      ERM1:20                                               DBGR
         MTW,-1   INSRTNG
         B        *R8,R6
ERM1:10  RES      0
         LI,R6    0                 ZERO OUT INSRTNG                    DBGR
         STW,R6   INSRTNG                                               DBGR
ERM1:20  RES      0                                                     DBGR
         LI,R6    ERR1
         B         ERTY
ERM2     LI,6      ERR2
         B         ERTY
ERM3     LI,6      ERR3
         B         ERTY
ERM4     LI,6      ERR4
         B         ERTY
ERM5     LI,6      ERR5
         B         ERTY
ERM6     LI,6      ERR6
         B         ERTY
ERM7     LI,6      ERR7
ERTY     BAL,7     TYPE
         B         NEXT
PSV      DATA     0
RESTRT   DATA     0                                                     DBGR
ERR5     TEXTC     'NOT ASSIGNED'
ERR6     TEXTC     'BAD DATA NAME'
ERR7     TEXTC     'BAD VALUE'
ERR8     TEXTC    'TOO MANY COMMANDS...TABLE OVERFLOW'
ERR9     TEXTC    'INVALID QUALIFICATION'
ERR10    TEXTC    'QUALIFY COMMAND NOT IMPLEMENTED'                     DBGR
NOGOMSG  TEXTC    'FUNCTION NOT CURRENTLY OPERATIONAL'
*
GETQUALX RES      1
         BOUND    8
IN:OF:2  TEXTC    'IN'
         TEXTC    'OF'
FINDRECX DATA     0
CURBUF   DATA     0
BUFTBL   DATA     BUF1,BUF1
         DATA     QUAL1
         DATA     QUAL2
QUAL1    RES      35
QUAL2    RES      35
SUBCTR   DATA     0
STRINGSV RES      1
ALOAD    DL,0     0,R6
QUALCTR  DATA     0
         BOUND    8
RECORDNM DATA     0,0
         DATA     BA(BUF1)+20
         GEN,8,24 64,BA(QUAL1)+20
         DATA     BA(QUAL1)+20
         GEN,8,24 64,BA(QUAL2)+20
RECORDLN DATA     0,0
         DATA     BA(BUF1)
         GEN,8,24 8,BA(QUAL1)
         DATA     BA(QUAL1)
         GEN,8,24 8,BA(QUAL2)
*
OPLBLSZ  EQU      12
OPTBSET  DATA     0
         DATA     X'100'
         DATA     X'400'
         DATA     X'500'
         DATA     X'600'
         DATA     X'700'
         DATA     X'8800'
         DATA     X'8900'
         DATA     X'8A00'
         DATA     X'B00'
         DATA     X'000'
         DATA     X'D00'
         DATA     X'1000'
OPLBLTBL DATA     0
         DATA     X'E3E8',X'C3D9'
         DATA     X'C3D7',X'D3D7'
         DATA     X'C4C3',X'F9E3'
         DATA     X'F7E3',X'D4E3'
         DATA     X'C4E7',X'D5D6'
         DATA     X'C3D6',X'E4C3'
*        DATA AREAS FOR SCAN
*
         BOUND    8                                                     DBGR
STRING:SAVE:2 RES 2                                                     DBGR
*                                                                       DBGR
STRING   RES      65                                                    DBGR
LENGTH   RES      1
WHNSV    RES      2                                                     DBGR
WHNSVL   RES      1                                                     DBGR
         BOUND    8
F0:F9    DATA     X'F0'
         DATA     X'F9'             DOUBLE WORD FOR NUMERIC CHK
IN:OF    DATA     X'C9D5'
         DATA     X'D6C6'
LOC:XIT  RES      1
STATEMENT RES     1
PUNCTUATION RES   1
*
PUNCT:TB RES,1    1
ENTRY    CNAME
         PROC
LF       EQU      BA(%)-BA(PUNCT:TB)
         DATA,1   AF
         PEND
COMMA    ENTRY    ','
BLANK    ENTRY    ' '
SEMICOL  ENTRY    ';'
PERIOD   ENTRY    '.'
LFTPAR   ENTRY    '('
RHTPAR   ENTRY    ')'
COLON    ENTRY    ':'
CARRET   ENTRY    X'0D'
LINFEED  ENTRY    X'15'
#PUNCTUATION ENTRY X'FF'            END OF TABLE
*
*        DEBUGGER COMMAND LIST INCLUDING LEGAL ABBREVIATIONS
*         NOTE: COMMANDS IN ORDER BY SIZE & ALPHABET
*
COMMAND  CNAME
         PROC
Q        SET      S:UT(AF(1))
QQ       SET      S:NUMC(AF(1))
QQQ      SET      0
         DATA,1   QQ
         WHILE    QQQ<QQ
QQQ      SET      QQQ+1
         DATA,1   Q(QQQ)
         FIN
         DATA,1   AF(2)
         PEND
         BOUND    4
CMP:CMD  DATA     BA(STRING)+1
COMMANDS RES      0
         COMMAND  ' ',31            THE BLANK COMMAND
         COMMAND  'AT',0
         COMMAND  'GO',1
         COMMAND  'IF',9
         COMMAND  'END',2
         COMMAND  'OFF',3
         COMMAND  'RUN',17
         COMMAND  'SET',4
         COMMAND  'DROP',5
         COMMAND  'DUMP',19
         COMMAND  'HELP',6
         COMMAND  'NEXT',11
         COMMAND  'OFFP',13
         COMMAND  'OFFS',14
         COMMAND  'STOP',8
         COMMAND  'WHEN',7
         COMMAND  'NEXTP',12
         COMMAND  'OFFWN',15
         COMMAND  'PLIST',30
         COMMAND  'PRINT',22
         COMMAND  'SLIST',29
         COMMAND  'DELETE',24
         COMMAND  'EQUATE',20
         COMMAND  'INSERT',25
         COMMAND  'PRINTX',23
         COMMAND  'PTRACE',16
         COMMAND  'SOURCE',27
         COMMAND  'STRACE',18
         COMMAND  'QUALIFY',32                                          DBGR
         COMMAND  'REPLACE',26
         COMMAND  'LISTBRKS',10
         COMMAND  'LISTFILE',21
         COMMAND  'SETFILES',28
         BOUND    4
LINKPTR  RES      1
SAV9     RES      1
CMP:PARM EQU      CMP:CMD
PARMS    RES      0
         COMMAND  'SN',6
         COMMAND  'FILE',2
         COMMAND  'LABEL',4
         COMMAND  'ANSLBL',5
         COMMAND  'DEVICE',3
         BOUND   4
*
*  ADJUST DCB FPT AREAS -- USED BY SETFILES COMMAND
BASICFPT RES      68
VLP      DATA     X'01000008'        FILE NAME
         RES      8
VLP:ACC  DATA     X'02000002'       ACCOUNT NUMBER
         RES      2
VLP:PASS DATA     X'03000002'        PASSWORD
         RES      2
VLP:EXP  DATA     X'04000002'        EXPIRE DATE
         RES      2
VLP:READ DATA     X'05000002'       READ ACCOUNTS
         RES      2
VLP:WRT  DATA     X'06000002'       WRITE ACCOUNTS
         RES      2
VLP:SN   DATA     X'07010004'       SERIAL NUMBERS
         RES      4
DEVICEFPT RES     12                DEVICE FPT--UNUSED
*
FILEVPL  GEN,8,24 1,8
SETF:FNM EQU      SETFOPN+3
ASSIGN   GEN,8,24 7,BA(ASSIGND)
ASSIGND  TEXTC    '!ASSIGN'
BA%STRNG EQU      CMP:CMD
         BOUND    4
         PAGE
*
*                  DATA AND CONSTANTS
*
MINS     PZE       %+2
PTRS     PZE       %+1
         DO1       STMTS
         DATA      0
MAXS     PZE       %-1
MINP     PZE       %+2
PTRP     PZE       %+1
         DO1       PARAS
         DATA      0
MAXP     PZE       %-1
BREAKT   EQU       %
         DO1       BKPTS+1
         DATA      0
BREAKS   DATA      BKPTS
LISTSF   DATA      0
LISTPF   DATA      0
SAVE6    DATA      0
SAVE5    PZE
PGMLOC   EQU       %
         DO1       10
         DATA      0
DBGLOC   RES      0
         DATA      BA(DB0)
         DATA      BA(DB1)
         DATA      BA(DB2)
         DATA      BA(DB3)
         DATA      BA(DB4)
         DATA      BA(DB5)
         DATA      BA(DB6)
         DATA      BA(DB7)
         DATA      BA(DB8)
         DATA      BA(DB9)
DB0      RES      64
DB1      RES      64
DB2      RES      64
DB3      RES      64
DB4      RES      64
DB5      RES      64
DB6      RES      64
DB7      RES      64
DB8      RES      64
DB9      RES      64
NAMPTR   RES      1
NULLOC   DATA     0
WHNFLG   DATA     0
OFFW:HA  DATA     BA(OFFW:HLD)
OFFW:HLD RES      8
KEY      RES       1
KEYKEY   RES       4
TAILKEY  RES       3
HEADKEY  TEXTC     'HEAD'
         DATA     TWOSPC            DUMMY PARA PTR
BALTRC   RES       1
TREEKEY  TEXTC     'TREE'
BASE     RES       1
         REF       M:UC,M:BI,M:SI,M:CI
BUF1     RES       33
BUF2     RES       20
NEXTF    PZE
NEXTPF   DATA     0
HEXSW    DATA     0
RFDFSZ   DATA     0
BASENAME DATA      BA(BUF1)+84
SIZE     DATA      BA(BUF1)+51
BALDBG   BAL,11    C:DBG
GST      PZE
SYMBUF   PZE
SYMSIZE  PZE
SYMEND   RES      1
GTPAGE   PZE
SADDR    DATA     0
SSIZE    DATA     0
SCLASS   DATA     0
OPERATOR DATA     0
         TEXTC    'NG'
         TEXTC    'NL'
         TEXTC    'GT'
         TEXTC    'LT'
         TEXTC    'EQ'
         TEXTC    'NE'                                                  DBGR
         TEXTC    '<'
         TEXTC    '>'
         TEXTC    '='
         BOUND    4
*    - - - - C A U T I O N - - - -                                      DBGR
* IF:TBL CORRESPONDS TO THE OPERATOR TABLE, BY POSITION'.               DBGR
*  SINCE THE INPUT SYNTAX IN 'A VS B', AND THE COMPARES                 DBGR
*  ARE ACTUALLY DONE 'B VS A', THE ACTUAL RELATIONS                     DBGR
*  USED MUST BE REVERSED.....                                           DBGR
*     --- A WORD TO THE WISE . . . .                                    DBGR
IF:TBL   RES      0
         B        INVALID
         BGE      NEXT                                                  DBGR
         BLE      NEXT                                                  DBGR
         BL       NEXT                                                  DBGR
         BG       NEXT                                                  DBGR
         BE       NEXT                                                  DBGR
         BNE      NEXT                                                  DBGR
         BG       NEXT                                                  DBGR
         BL       NEXT                                                  DBGR
         BE       NEXT                                                  DBGR
CONTINUE DATA     0                 VALID TO CONTINUE
READCMD  DATA     0                 READ CMD
PULLFLAG DATA     0
PULLADDR DATA     DYNAMIC
ACOLON   TEXTC    ':'
APERIOD  TEXTC    '.'
NXT%ERR  TEXTC    'PREV CMD MUST END SERIES'
MOV:CMD  DATA     BA(BUFF)
SFNAME   TEXTC     'SOURCE FILE='
DFNAME   TEXTC     'DEBUG FILE ='
DBREAK   TEXTC    'DATA BREAK '
SBREAK   TEXTC    'BREAK AT '
         LIST     1
S1       DATA     0
RETURN   B         *SAVE11
CAL1     CAL1,9    5
B11      B         *SAVE11
         GEN,8,24  14,X'404040'
BUFF     RES       20
XF0      DATA      X'F0'
RETN     DATA     X'010D0000'
SUBNUM   DATA,2   0,0,100,10,1
         BOUND    4
XF       DATA      15
HELLO    TEXTC     'COBOL DEBUG HERE'
ERR3     TEXTC     'BAD COMMAND'
ERR2     TEXTC     'NO ROOM IN TABLE'
ERR4     TEXTC     'NOT A BREAKPOINT'
ERR1     TEXTC     'BAD NUMBER'
ERR0     TEXTC    'DEBUGSO FILE IS BAD OR CAN-T GET PROGRAM-ID'        DBGR
SAVE10   PZE
SAVE11   PZE
SAV1     RES      1
SAV3     RES      1
SAV4     RES      1                                                     DBGR
SAV5     RES      1
INSRTNG  DATA     0
CR       DATA      X'010D0000'
CAR      DATA      X'0D0D0D0D'
LINE:FEED DATA    X'15151515'                                           DBGR
TWOSPC   DATA     X'02404040'
SPACE    TEXT      '    '
TEMP     PZE
INTFLG   DATA      0
         REF       M:EI
CIN      TEXTC    'INPUT '
COUT     TEXTC    'OUTPUT '
CINOUT   TEXTC    'I/O '
COPN     TEXTC    'OPEN '
CCLS     TEXTC    'CLOSED '
CSTAT    TEXTC    'CURRENTLY '
FIL      TEXTC    'FILE '
DEV      TEXTC    'DEVICE '
ANS      TEXTC    'ANS '
LABL     TEXTC    'LABEL '
DEVNO    TEXTC    '**UNASSIGNED**'
ASGNTO   TEXTC    'ASSIGNED TO '
MOV:TITL DATA     BA(BUF1)
DMP:FRM  RES      1
DMP:TO   RES      1
FLP      RES      1
FPT2     GEN,8,24 2,M:UC
         DATA     X'80000000'
         DATA     RETN
MYBRK    TEXTC    'BRK IN DEBUGGER'
NOCONTM  TEXTC    'CANNOT CONTINUE THIS COMMAND'
NONUM    TEXTC    'INVALID DATA TYPE FOR NUMERIC MOVE'
ALLOUT   TEXTC    'EOF HIT '
*
         BOUND    8
KEYPATRN TEXT     '0000.000'
FACTR    DATA     0,1,10,100,1000,10000,100000,1000000
         BOUND    8
FACTRD   RES      0
         DATA     0,0,0,1
         DATA     0,X'100',0,X'10000'
         DATA     1,0,X'100',0,X'10000',0
         DATA     X'1000000',0
         DATA     0
LINPRT1  DATA     X'40404015'
LINPRNT  RES      2
         DATA     X'15000000'
MAXREC   DATA     X'03989680'       KEY OF 1000.000                     DBGR
RECSIZE  DATA     0
BLNKBF   GEN,8,24 80,BA(BUFF)
BYEBYE   TEXTC    'INSUFFICIENT CORE  TO INITIATE DEBUGGER'
*
EXITM    DATA     EXITPRE
EXITBL   DATA     EXIT0M
         DATA     ATRAPM
         DATA     IOERRM
         DATA     LIMITM
         DATA     DEAD,DEAD,DEAD
         DATA     ABORTM,ABORTM
EXITPRE  TEXTC    'EXIT DUE TO '
EXIT0M   TEXTC    'STOP VERB '
IOERRM   TEXTC    ' NON-COBOL I/O ERROR'
LIMITM   TEXTC    ' LIMIT EXCEEDED'
DEAD     TEXTC    ' IRREVOCABLE PROCESSES'
ABORTM   TEXTC    ' M:XXX OR M:ERR'
*
LIMITBL  DATA     WHOKNOWS
         DATA     PNCHM
         DATA     PPGM
         DATA     UPGM
         DATA     UPGM
         DATA     PGRANM
         DATA     TGRANM
         DATA     TAPEM
         DATA     CPUM
         DATA     ACCTGM
WHOKNOWS TEXTC    ' UNKNOWN'
PNCHM    TEXTC    'PUNCHED CARDS'
PPGM     TEXTC    'PROCESSOR PRINTING'
UPGM     TEXTC    'USER PRINTING'
DPGM     TEXTC    'DIAGNOSTIC PRINTING'
PGRANM   TEXTC    'PERM DISC'
TGRANM   TEXTC    'TEMP DISC'
TAPEM    TEXTC    'TAPE DRIVES'
CPUM     TEXTC    'EXECUTION TIME'
ACCTGM   TEXTC    'ACCOUNT DISC'
ATRAPM   TEXTC    'TRAP IN DEBUGGER'
         DATA     MYSTERYM
TRAPMSG  DATA     T40M,T41M,T42M,T43M,T44M,T45M,T46M,T47M,;
                  T48M,T49M,T4AM,T4BM
MYSTERYM TEXTC    'UNIDENTIFIED TRAP'
T40M     TEXTC    'TRAP40'
T41M     TEXTC    'TRAP41'
T42M     TEXTC    'TRAP42'
T43M     TEXTC    'TRAP43'
T44M     TEXTC    'TRAP44'
T45M     TEXTC    'DECIMAL TRAP'
T46M     TEXTC    'TRAP 46'
T47M     TEXTC    'TRAP47'
T48M     TEXTC    'TRAP48'
T49M     TEXTC    'TRAP49'
T4AM     TEXTC    'TRAP4A'
T4BM     TEXTC    'TRAP4B'
TRAPINS  RES      1
DECZERO  DATA     X'0C0C0C0C'
HELPM    TEXTC    '....DEBUG COMMANDS ARE...'
         TEXTC    'AT--ESTABLISH BREAKPOINTS'
         TEXTC    'GO--PROCEED WITH USER PROGRAM'
         TEXTC    'END--EXIT TO TEL'
         TEXTC    'OFF--REMOVE BREAKPOINT'
         TEXTC    'SET--SET DATA VALUE'
         TEXTC    'EQUATE--ESTABLISH AN ABBREVIATION'
         TEXTC    'DROP--DELETE AN ABBREVIATION'
         TEXTC    'WHEN--ESTABLISH DATA BREAKPOINT'
         TEXTC    'STOP--SUSPEND EXECUTION OF USER PROGRAM'
         TEXTC    'IF--EVALUATE CONDITION'
         TEXTC    'LISTBRKS--LIST ACTIVE BREAK POINTS'
         TEXTC    'NEXT--EXECUTE NEXT STATEMENT'
         TEXTC    'NEXTP--EXECUTE UNTIL NEXT PARAGRAPH'
         TEXTC    'OFFP--REMOVE ALL PROCEDURE-NAME BREAKPOINTS'
         TEXTC    'OFFS--REMOVE ALL STATEMENT BREAKPOINTS'
         TEXTC    'STRACE--SET STATEMENT TRACE MODE'
         TEXTC    'PTRACE--SET PROCEDURE-NAME TRACE MODE'
         TEXTC    'OFFWN-REMOVE DATA BREAK POINT'
         TEXTC    'LISTFILE--DISPLAY STATUS OF AN FD'
         TEXTC    'PRINT--PRINT THE CONTENTS OF A DATA ITEM'
         TEXTC    'PRINTX--PRINT THE CONTENTS OF A DATA ITEM IN HEX.'
         TEXTC    'SETFILES--EXECUTE A FILE OF !ASSIGN CARDS'
         TEXTC    'SLIST--LIST LAST N STATEMENT #S EXECUTED'
         TEXTC    'PLIST--LIST LAST N PROCEDURE-NAMES EXECUTED'
         TEXTC    'RUN--REMOVE BREAKPOINTS AND PROCEED'
         TEXTC    'SOURCE, DELETE,REPLACE,INSERT--MISC SOURCE PROGRAM'
         TEXTC    'QUALIFY---CHANGE DEFAULT VALUES'
STOPPR   DATA     X'05E2E3D6',X'D70D4040'
STOPPRL  DATA     5
GOPR     DATA     X'03C7D60D'       GO COMMAND                          DBGR
TEN      DATA      10
FPT      GEN,8,24     2,M:UC
         DATA         X'80000000'
         DATA          0
         REF M:EO
C:TRCPL  GEN,8,24  X'01',M:LL
         DATA      X'80000000'
         DATA      0
         REF       M:LL
DEFAULT  TEXTC    'DEFAULT'
DEFAULTL DATA     8
FSTLNK   DATA     0
DYNAMIC  RES      0
MRGL     DO       500
         LIST     MRGL<2
         DATA     0
         FIN
         LIST     1
ENDDYN   RES      0
PSAVE    RES      1
PLENTH   DATA     0
PNAME    RES      8
SLENTH   DATA     0
SNAME    RES      8
PRLENTH  DATA     0
PRNAME   RES      8
MOV%PAR  DATA     BA(PNAME)
MOV%SEC  DATA     BA(SNAME)
MOV%PRG  DATA     BA(PRNAME)
MOV%ABRV GEN,8,24 32,BA(BUF1)
GOBACK   DATA     0
DSIZE    EQU      BUF1+22
DCLASS   EQU      BUF1+23
DADDR    EQU      BUF1+24
QUALSZ   EQU      QUAL1+22
QUALCL   EQU      QUAL1+23
QUALAD   EQU      QUAL1+24
DSUB     EQU      BUF1+2
SAV7    DATA     0
DEFCMP   DATA     BA(DEFNAM)
NOLOOKI  DATA     0
5SAV     RES      1
9SAV     RES      1
DMOV     DATA     BA(BUF1)
COMLOC   RES      1
WRKLOC   RES      1
DEFWK1   TEXTC    'DEF%WK'
DEFWK2   EQU      DEFWK1+1
DEFCOM1  TEXTC    'TALLY'
DEFCOM2  EQU      DEFCOM1+1
WHNSIZE  DATA     7
WHNTBL   DATA     0,0,0,0,0,0,0
ABBREV   RES      0
MRGL     DO       ATBLSZ*#OF%ABBREVIATIONS
         LIST     MRGL<2
         DATA     0
         FIN
         LIST     1
         DATA     -1                TABLE STOPPER
DEFNAML  DATA     0
DEFNAM   RES      8
DEFLOC   DATA     0
PBREAKS  RES      0
MRGL2    DO       BKPTS
         LIST     MRGL2<2
         DATA     0
         FIN
         LIST     1
         DATA     -1
SBREAKT  RES      11
         DATA     -1
SBREAKS  RES      0
MRGL3    DO       BKPTS
         LIST     MRGL3<2
         DATA     0
         FIN
         LIST     1
         DATA     -1
         TEXTC   '   '
BUFFR    RES      33
         DATA     -1
TREE:SZ  DATA     0
TREEPTR  DATA     0
LOWP     RES      1
SIZEP    RES      1
REF:FIL  RES      8
SEG:FIL  RES      8
IN:CORE  DATA     X'80000000'
REFDEF   DATA     0
         BOUND    8
MYLIMITS DATA     C:DBG,LAST
LAST     END
