  TITLE  '* * A N A L Y Z E   C 0 0  C P - V * *'
**********************************************
*                                            *
*    ANALYZE OVERLAY NUMBER ONE              *
*                                            *
*        DUMPS PARTITIONS,RBBAT RECOVERY     *
*        FILE,ALLYCAT TABLES AND SWAPPER     *
*        TABLES.                             *
*                                            *
**********************************************
         CSECT    1
PP       EQU      %
         CSECT    0
DATA     EQU      %
R0       EQU      0                                                          A00
R1       EQU      1                                                          A00
R2       EQU      2                                                          A00
R3       EQU      3                                                          A00
R4       EQU      4                                                          A00
R5       EQU      5                                                          A00
R6       EQU      6                                                          A00
R7       EQU      7                                                          A00
R8       EQU      8                                                          A00
R9       EQU      9                                                          A00
R10      EQU      10                                                         A00
R11      EQU      11                                                         A00
R12      EQU      12                                                         A00
R13      EQU      13                                                         A00
R14      EQU      14                                                         A00
R15      EQU      15                                                         A00
         SYSTEM   SIG7FDP
UTSPROC  SET      1
MONPROC  SET      0
S69PROC  SET      1
         SYSTEM   UTS
*        ANALYZE DEFS
*
         DEF      PARTITIONS
         DEF      ADAMDUMP
         DEF      COCODE
         DEF      SYMBIONTS
*
*        ANALYZE REFS
*
*
         REF      MSG,MSG1,BUFOUT,TRANS,TRANSSZ
         REF      #STATES,SMUIS,SETR6
         REF      COC,LNOL
         REF      U:MISC,UH:DL,UB:PRIO,UB:PRIOB
         REF      PX:HPP,PX:TPP,PB:PSZ,PB:DSZ,PB:DCBSZ
         REF      STK:CNT,#OFREGS
         REF      CURR:LOC
         REF      USER:MODE
         REF      REGFLAG
         REF      LAST:LINE
         REF      REG:REG
         REF      INST:SAVE
         REF      IMONLOC
         REF      PUSH:FLAG
         REF      NO:CORE
         REF      TSIZE
         REF      RANGE
         REF      GHST:STRT
         REF      TST:LIMS
         REF      ACT:INST
         REF      REGIA
         REF      RES:JIT,SYM:LIMS,GRABSYM,DISP:OFF,BLNKBUF
         REF      CLOSESTADD,CLOSESTSYM
         REF      BMBB
         REF      ZEROS,J:JIT,J:START
         REF      JBUPVPA,MTBB,MONORG,CORE,JOVVPA,SB:GJOBUN
         REF      MAXG,S:GJOBTBL,SPDBASE,DATAFLAG,JITLOC,MPATCH
         REF      MX:PPUT,MAPFLAG,RCVLIMITS,MON:FLAG,MAP:USER,JB:PRIV
         REF      OPCODES,T:REG
         REF      PH:PDA,PH:DDA,PB:UC,PB:LNK,PB:PVA,PB:HVA
         REF      P:SA,P:TCB,PPROCS
         SREF     PB:C#,PB:DC#
         REF      SAVEREGS
         REF      P:NAME
         SREF     UB:DC,UB:PC
         REF      UB:NECB,UH:WL,UB:US,UB:BL,UB:FL,UH:FLG
         REF      UH:FLG2,UX:JIT,UB:SWAPI,UH:JIT,UH:AJIT
         REF      UB:PCT,UB:ACP,UB:APR,UB:APO,UB:ASP
         REF      UB:DB,UB:OV,UB:MF
         REF      LB:UN,COCTERM,EOMTIME,BUFCNT,CPOS,RSZ,MODE,MODE2,MODE3
         REF      MODE4,TL,COCII,COCIR,ARSZ,CPI,COCOI,COCOR,COCOC
         REF      CBAHD,MBB,COMBUF,CBFHD
         REF      GETADDR,SCANNER,SPACES
         REF         PAGETABLE,MSG%OUT,USER,SPACE2,BLANK1
         REF      LSWAP,M:SWAPD,MB:SDI,MB:SFC,PG:MODE
         REF      MB:#RTRY,M:CLBGN,MH:CLEND
         REF      S:HIR,S:SIP,#SWAP%DEV,S:CUN,S:ISUN
         REF      S:CUIS,SB:OSN,SB:OSUL,S:BECL,SB:NP
         SREF     S:IDLF,S:SIR
         REF      SB:PNL,SB:FPN,SB:FPL
         DEF      SWAP,PROCS
         DEF      ALLYTABL
         DEF      RA:TABL
         REF      STACK
         REF      PAGEBUF
*
*    MONITOR REFERENCES
*
         REF      LPART,PLH:FLG,PLH:QN,PLH:TOL
         REF      PLH:CUR,PLD:ACT,PLB:USR
         REF      PLH:TL,PLH:TU,PLH:SID
         REF      PUSHMSG           OVER IN MAIN ANALYZE
*
*        REFS FOR SYMBIONT TABLES
*
         REF      M:EI,DUMPSOME,NOFILMSG                                     A00
*
*
*    PROC FOR PARTITION TABLES
*
PARTAB   DSECT    1
LIPART   DSECT    1
LWPART   DSECT    1
PNUM     SET      0
PTAB     CNAME    1
PTAH     CNAME    2
PTAW     CNAME    3
         PROC
A        SET      %
         USECT    LIPART
         LI,14    AF(1)
         USECT    LWPART
         DO       NAME=1
         LB,3     *15,5
         ELSE
         DO       NAME=2
         LH,3     *15,5
         ELSE
         LW,3     *15,5
         FIN
         FIN
         USECT    PARTAB
         DATA,1   AF(2)
PNUM     SET      PNUM+1
         USECT    A
         PEND
         PAGE
*
*
*        PARTITION DUMP - ENTERED FROM SCANNER OR
*        ALL COMMAND, EXIT TO SCANNER
*
         USECT    PP                GENERATE PROCEDURE
PARTITIONS  EQU   %
         LI,1     PARTABMSG
         BAL,0    TITEL             SHOVE OUT TITLE LINE
         REF      TITEL
         LI,1     PARTMSG           HEADER
         BAL,0    MSG
         BAL,0    BUFOUT            PUT IT OUT
         LI,5     0                 PARTITION COUNT
         LI,6     LPART             TOTAL PARTITIONS
PARTLOOP EQU      %
         LI,R7    9                 TOTAL ENTRIES                            A00
         LI,2     0                 ENTRY COUNT
         LI,1     2                 CHECK FOR SECOND FIELD
         BAL,0    GETHEX            IN COMMAND
         REF      GETHEX
         AI,2     0                 WAS THERE ONE
         BEZ      GETPART           NO
         LI,6     1                 YES,SET FOR ONE LINE
         LW,5     2                 PUT PART# IN 5
         LI,2     0                 RESET INDEXER
         B        %+2
GETPART  AI,5     1                 POINT TO FIRST ENTRY
         LW,3     5                 FOR TRANSSZ
         BAL,0    TRANSSZ
PARTLOOP1  EQU    %
         LB,1     PARTAB,2          TAB
         BAL,0    SPACES
         EXU      LIPART,2          GET ADDRESS
         BAL,0    GETADDR
         CI,2     0
         BNE      NORMPART          NOT FIRST, HEX
         LD,8     *15,5
         BEZ      NEXTENTRY
         PSW,2    STACK
         LI,2     8                 CHARACTER COUNT
         LI,1     8                 ADDRESS OF MESSAGE
         BAL,0    MSG1
         PLW,2    STACK
         B        NEXTENTRY
NORMPART EQU      %
         EXU      LWPART,2          PICK UP ENTRY
         BAL,0    TRANSSZ           AND DUMP IN HEX
NEXTENTRY EQU     %
         AI,2     1
         BDR,7    PARTLOOP1         PICK UP ALL ENTRYS
         BAL,0    BUFOUT            PRINT THE STRING
         BDR,6    PARTLOOP          PICK UP ALL PARTITIONS
         B        SCANNER           FINISHED
         PAGE
*
*        TABLES TO DRIVE PARTITION DISPLAY
*
         PTAW     PLD:ACT,2
         PTAB     PLB:USR,11
         PTAH     PLH:FLG,16
         PTAH     PLH:QN,21
         PTAH     PLH:TOL,27
         PTAH     PLH:CUR,33
         PTAH     PLH:TL,38
         PTAH     PLH:TU,44
         PTAH     PLH:SID,50
         USECT    PP
*
PARTMSG  EQU      %
         TEXTC    '# ACCOUNT  USR  FLG  QN   ',;
                  'TOL   CUR   TL    TU    SID   '                           A00
         PAGE
SYMBIONTS EQU     %
         REF      MONFLAG
         REF      RES:BUF
         MTW,0    MONFLAG           LOOKING AT RUNNING MONITOR
         BNEZ     SCANNER           YEP - GET OUT
         BAL,R0   RES:BUF           INSURE DUMP INPUT BUFFERS R OK
         LI,1     SYMTAB
         BAL,0    TITEL             SHOVE OUT TITLE LINE
         BAL,7    GETONE            GET A PAGE TO READ FILE WITH
         BCS,8    NOBUF             CANT GET ONE
         MTW,1    FPGS              KEEP PAGE COUNT RIGHT
         STW,9    RVRBUF            SET UP CAL FPT
         LI,4     4
SYMBLOOP EQU      %
         BAL,R0   BLANK1
         LW,1     RBBMSGS,4
         BAL,0    MSG
         BAL,0    BUFOUT
         BAL,R0   BLANK1
         LW,1     KEYS,4
*
*
         REF      JITSTAT
SYMBLOOP1 LCI     1                 SET FLAG
         STCF     JITSTAT           IN CASE OF KEY ERROR
         CAL1,1   RDRVR             READ A RECORD
         REF      DUMP:DIR          SET SAYS GO DIRECT
         MTW,1    DUMP:DIR          SET FLAG TO DUMP FROM MY MEMORY
         LW,8     RVRBUF            GOT IT,SVET ADDRS OF BUF
         LW,R7    M:EI+13                                                    A00
         AI,7     3
         SLS,7    -2
         BAL,0    DUMPSOME
SYMOUT   BDR,4    SYMBLOOP
         CAL1,8   FPGS              FREE UP PAGES
         B        SCANNER
         PAGE
*
*        PROCESS ERROR ON CAL
*
         DEF      RBBREA
RBBREA   EQU      %
         LW,R3    L(X'00200000')                                             A00
         CW,R3    M:EI                                                       A00
         BAZ      M:EI%NOT%OPEN                                              A00
         LI,R3    1                                                          A00
         LB,2     10
         CI,2     7
         BE       MORPAGE           YES,GET ANOTHER PAGE
         LI,1     RBNFL
         CI,2     3
         BE       OUTARND
         LI,1     BADIOM
         CI,2     X'43'
         BNE      OUTARND
         LI,3     0
         LI,1     NONEM
OUTARND  EQU      %
         BAL,0    MSG
         BAL,0    BUFOUT
         B        SYMOUT,3
MORPAGE  BAL,7    GETONE            TRY FOR ANOTHER PAGE
         BCS,8    NOBUF             CANT GET IT
         MTW,1    FPGS              BUMP PAGE COUNT
         LI,7     2048              INCREMENT READ SIZE
         AWM,7    RDVC              FOR NEXT CAL
         B        SYMBLOOP1
GETONE   CAL1,8   GETPAGE
         B        0,7
M:EI%NOT%OPEN  EQU  %                                                        A00
         LI,R1    NOFILMSG                                                   A00
         B        PUSHMSG                                                    A00
GETPAGE  GEN,8,24 8,1
         USECT    DATA
FPGS     GEN,8,24 9,0
RVRBUF   DATA     0
RDRVR    EQU      %
         GEN,8,24 X'10',M:EI                                                 A00
         DATA     X'F8000010'
         DATA     RBBREA
         DATA     RBBREA
         PZE      *RVRBUF           BUFFER POINTER
RDVC     DATA     2048
         PZE      *1
         USECT    PP
RBBMSGS  EQU      %-1
         DATA     DDMSG
         DATA     SDMSG
         DATA     IVMSG
         DATA     CMMSG
KEYS     EQU      %-1
         DATA     DDKEY
         DATA     SDKEY
         DATA     IVKEY
         DATA     CMKEY
NOBUF    CAL1,8   FPGS              FREE COUNT
         LI,1     BUF:MSG
         B        PUSHMSG
BUF:MSG TEXTC 'CANNOT OBTAIN BUFFER TO READ RBBAT FILE'
CMKEY    TEXTC    'RBBATCM'
IVKEY    TEXTC    'RBBATIV'
SDKEY    TEXTC    'RBBATSD'
DDKEY    TEXTC    'RBBATDD'
         REF      SYMTAB
CMMSG    TEXTC    '    ** GHOST COMMUNICATION BUFFERS **'
IVMSG    TEXTC    '    ** RBBAT ENVIRONMENT  **'
SDMSG    TEXTC    '    ** RBBAT STATIC DATA  **'
DDMSG    TEXTC    '    ** RBBAT DYNAMIC DATA  **'
RBNFL    TEXTC    '*** :RBBRVR DOES NOT EXIST ***'
NONEM    TEXTC    '**NONE**'
BADIOM   TEXTC    '*** CANNOT ACCESS :RBBRVR ***'
         REF      PARTABMSG
*
         PAGE
*
*        COMMAND WAS 'DISPLAY ALLYCAT'
*
ALLYTABL EQU      %
         LI,R1    ATMSG
         BAL,R0   TITEL             TITLE LINE OUT
         LI,R1    ATMSG1
         BAL,R0   MSG%OUT           MESSAGE HEADING
         LI,R4    0
ALLYTABL0 LI,R7   7
         LI,R1    1
         BAL,R0   SPACES
         LW,R1    ATABL4,R4
         BAL,R0   MSG
ALLYTABL1 LB,R1   ATABL3,R7
         BAL,R0   SPACES
         EXU      ATABL1,R7
         BAL,R0   GETADDR
         EXU      ATABL2,R7
         CI,R7    1
         BE       %+2
ALLYTABL2 AND,R3  #R16
ALLYTABL3 BAL,R0  TRANSSZ
         BDR,R7   ALLYTABL1
         BAL,R0   BUFOUT
         BAL,R0   BLANK1
         AI,R4    1
         CI,R4    4
         BL       ALLYTABL0
         B        GHOST:COM
         PAGE
*
*        ALLYCAT TABLE DISPLAY DATA
*
ATABL1   EQU      %-1
         LI,R14   GRAVAIL
         LI,R14   ADJSTCNT
         LI,R14   BUFLAGS
         LI,R14   TEMPBOT
         LI,R14   WORDCNT
         LI,R14   BOTTOM
         LI,R14   TOP
*
ATABL2   EQU      %-1
         LW,R3    *R15,R4
         DO1      6
         LH,R3    *R15,R4
ATABL3   DATA,1   69,60,50,41,33,24,16,11
*
*
         BOUND    4
ATABL4   DATA     RADMSG,PACKMSG,PERMSG,CYLMSG
*
*
RADMSG   TEXTC    'RAD'
PACKMSG  TEXTC    'PACK'
PERMSG   TEXTC    'SYMB'
CYLMSG   TEXTC    'CYL'
*
*
         REF      ATMSG
#R16     EQU      4F
*
ATMSG1   TEXTC    '          TOP  BOTTOM  WORDCNT  TEMPBOT  ',;
                  'BUFLAGS  ADJSTCNT  GRANULES AVAIL'
*
*
         REF      TOP,BOTTOM,WORDCNT,TEMPBOT,BUFLAGS,ADJSTCNT,GRAVAIL
         PAGE
*
*        DISPLAY READ-AHEAD TABLES FOR B00 CP-V FILE MANAGEMENT
*
RA:ADDRS EQU      %
         LI,R14   RAB:USER
         LI,R14   RAB:BLINK
         LI,R14   RAB:FLINK
         LI,R14   RAX:PAGE
         LI,R14   RAH:TIME
         LI,R14   RAH:DCB
         LI,R14   RA:DA
*
RA:LOAD  EQU      %
         LB,R3    *R15,R2
         LB,R3    *R15,R2
         LB,R3    *R15,R2
         LOAD,R3  *R15,R2
         DO1      2
         LH,R3    *R15,R2
         LW,R3    *R15,R2
RA:MASKS EQU      %
         NOP
         NOP
         NOP
         DO1      3
         AND,R3   #R16
         NOP
RA:SHFTS EQU      %
         DO1      5
         NOP
         SLS,R3   1
         NOP
RA:HEAD  TEXTC    ;
 'ENTRY  USER  BL  FL  PAGE  TIME  DCB    DISK ADDRESS'
*
         REF      RA:TITE
RA:SPACES DATA,1    7,13,17,21,27,33,40,52
         BOUND    4
*
         SREF     RAB:USER,RAX:PAGE,RAH:TIME,RAH:DCB,RA:DA
         SREF     RASIZE
         SREF     RAB:BLINK,RAB:FLINK
         PAGE
*
*        DRIVE DISPLAY OF READ-AHEAD TABLES
*
RA:TABL  EQU      %
         LI,R1    RA:TITE
         BAL,R0   TITEL             PUT OUT TITLE LINE
         LI,R1    RA:HEAD           PUT
         BAL,R0   MSG%OUT           HEADING
         LI,R5    RASIZE            LENGTH OF TABLES
         LI,R1    2                 MUST LOOK FOR AN OPTIONAL FIELD
         BAL,R0   GETHEX            GO LOOK FOR IT
         STW,R2   USER              SAVE NUMBER OR ZERO
RA:TABL1 LI,R4    0                 INDEX TO INTERNAL TABLES
         LW,R3    R2                PUT
         BAL,R0   TRANSSZ           OUT INDEX TO RA TABLES
RA:TABL2 LB,R1    RA:SPACES,R4      GET
         BAL,R0   SPACES            SPACING
         EXU      RA:ADDRS,R4       EXECUTE LOAD
         BAL,R0   GETADDR           GET ADDRESS
         EXU      RA:LOAD,R4        GET CONTENTS
         CI,R4    3                 JUST LOAD PAGE
         BNE      RA:TABL3          NO
         PSW,R4   STACK
         LCFI     7
         STCF     PG:MODE           STORE OWNER'S CODE
         LW,R4    R3                XFER PAGE #
         BEZ      %+2               NONE
         BAL,R0   PAGETABLE         INSERT IT INTO MATRIX
         PLW,R4   STACK
RA:TABL3 EXU      RA:MASKS,R4       MASK VALUE IF NECESSARY
         EXU      RA:SHFTS,R4       SHIFT VALUE IF NECESSARY
         BAL,R0   TRANSSZ           PUT IT OUT
         AI,R4    1
         CI,R4    7
         BL       RA:TABL2          DO NEXT ONE
         BAL,R0   BUFOUT            PRINT ENTIRE LINE
         MTW,0    USER              DID WE DO ONE PARTICUALR #
         BNEZ     SCANNER           YEP - ALL DONE HERE
         AI,R2    1                 NEXT ENTRY
         BDR,R5   RA:TABL1          DO NEXT ROW
         B        SCANNER           ALL DONE
         PAGE
*
*        ROUTINE TO DUMP THE SWAPPER TABLES
*
SWAP     LI,1     SWAPMSG
         BAL,0    TITEL             TITLE LINE OUT
         LI,4     0                 INITIALIZE THE POINTER
SWAPLOP1 EQU      %
         LW,1     MSGTAB,4
         BAL,0    MSG
         EXU      FINDTAB,4         GET THE VALUE
         BAL,0    GETADDR
         EXU      LOTAB,4           AND PICK IT UP
         BAL,0    TRANSSZ           AND PUT IT OUT
         AI,4     1
         LW,1     4
         CI,1     4
         BL       %+3
         BE       %+4
         AI,1     -4
         SLS,1    4                 16 SPACES FOR EACH COLUMN
         BAL,0    SPACES
         CI,4     4
         BL       SWAPLOP1
         BG       %+2
         BAL,0    BUFOUT
         CI,4     8
         BL       SWAPLOP1
         BG       %+2
SWAPLOP2 BAL,0    BUFOUT            PUT OUT AT 4 OR 8
         LW,1     MSGTAB,4
         BAL,0    MSG
         BAL,0    SPACE2
         EXU      FINDTAB,4         GET NEXT TABLE
         BAL,0    GETADDR
         EXU      LOTAB,4
         LW,3     6
         BAL,0    TRANSSZ           AND PUT OUT THE VALUE
         MTW,0    3
         BEZ      SINCRS1
         LI,1     16                16 SPACES AGAIN
         BAL,0    SPACES
         AI,4     1
SWAPLOP4 EQU      %
         LW,1     MSGTAB,4
         BAL,0    MSG               PUT OUT THE TITLE
         BAL,0    SPACE2            PUT IN TWO SPACES
         EXU      FINDTAB,4
         BAL,0    GETADDR           FIND THE TABLE
         LI,2     1                 INDEX INTO THIS LIST
SWAPLOP3 EXU      LOTAB,4           GET THE VALUE
         BAL,0    TRANSSZ
         AI,2     1                 BUMP THE LIST POINTER
         CW,2     6
         BG       SINCRS            FINISHED WITH THIS LIST
         LI,1     AND
         BAL,0    MSG
         B        SWAPLOP3          GET NEXT LIST ENTRY
         PAGE
*
*
SINCRS1  CI,4     OSN
         BNE      %+2
         AI,4     1
         AI,4     1
SINCRS   AI,4     1
         CI,4     BECL
         BNE      SINCRS2
         BAL,0    BUFOUT
         LI,1     16
         BAL,0    SPACES
         B        SWAPLOP4
SINCRS2  EQU      %
         BAL,0    BUFOUT            PUT OUT THE LAST LIST
         CI,4     NUMSWAP
         BL       SWAPLOP2
R3SWAP   EQU      %                 NEW CODE FOR A01
         BAL,0    BLANK1
         LI,1     SWAP3MSG          SWAPPER TABLES
         BAL,0    MSG
         BAL,0    BUFOUT
         LI,2     LSWAP
         LI,4     LSWAP+1
R3SWAP1  EQU      %
         LI,5     0
R3SWAP2  EQU      %
         LB,1     TABTAB,5
         BAL,0    SPACES
         EXU      LISWAP,5
         BAL,0    GETADDR
         EXU      LWSWAP,5
         EXU      SW:SCRUB,R5       SCRUB VALUE
         BAL,0    TRANSSZ
         AI,5     1
         CI,5     NUSWAP
         BL       R3SWAP2
         BAL,0    BUFOUT
         AI,2     -1
         BDR,4    R3SWAP1
         B        SCANNER
         SPACE    5
SWAP3MSG TEXTC    '   M:SWAPD  MB:SDI  MB:SFC',;
                  '  MB:#RTRY  M:CLBGN    MH:CLEND'
*
*
SW:SCRUB EQU      %
         DO1      5
         NOP
         AND,R3   #R16
         PAGE
*
AND      TEXTC    ' & '
TABTAB   DSECT    1
LISWAP   DSECT    1
LWSWAP   DSECT    1
NUSWAP   SET      0
STAB     CNAME    1
STAH     CNAME    2
STAW     CNAME    3
         PROC
A        SET      %
         USECT    LISWAP
         LI,14    AF(1)
         USECT    LWSWAP
         DO       NAME=1
         LB,3     *15,2
         ELSE
         DO       NAME=2
         LH,3     *15,2
         ELSE
         LW,3     *15,2
         FIN
         FIN
         USECT    TABTAB
         DATA,1   AF(2)
NUSWAP   SET      NUSWAP+1
         USECT    A
         PEND
         STAW     M:SWAPD,3
         STAB     MB:SDI,12
         STAB     MB:SFC,20
         STAB     MB:#RTRY,28
         STAW     M:CLBGN,38
         STAH     MH:CLEND,49
*
         USECT    PP
FINDTAB  LI,14    S:SIR             TABLE FOR GETTING THE ADDRESS
         LI,14    S:HIR             INTO R14 FOR THE ROUTINE GETADDR
         LI,14    S:SIP
         LI,14    #SWAP%DEV
         LI,14    S:CUN
         LI,14    S:ISUN
         LI,14    S:CUIS
         LI,14    S:IDLF
*
*
         LI,14    SB:OSN
OSN      EQU      %-FINDTAB-1
         LI,14    SB:OSUL
         LI,14    S:BECL
BECL     EQU      %-FINDTAB-1
         LI,14    SB:NP
         LI,14    SB:PNL
         LI,14    SB:FPN
         LI,14    SB:FPL
NUMSWAP  EQU      %-FINDTAB
         PAGE
*
*
LOTAB    EQU      %
         DO1      8
         LW,3     *15
         LB,6     *15               OSN
         LB,3     *15,2             OSUL
         LW,3     *15,2             BECL
         LB,6     *15               NP
         LB,3     *15,2
         LB,6     *15               FPN
         LB,3     *15,2             FPL
*
*
MSGTAB   DSECT    1
SMSGS    DSECT    1
SMSG     CNAME
         PROC
U        SET      %
         USECT    SMSGS
P        SET      %
         TEXTC    AF(1)
         USECT    MSGTAB
         DATA     P
         USECT    U
         PEND
         SMSG     'S:SIR='
         SMSG     'S:HIR='
         SMSG     'S:SIP='
         SMSG     '#SWAP%DEV='
         SMSG     'S:CUN='
         SMSG     'S:ISUN='
         SMSG     'S:CUIS='
         SMSG     'S:IDLF='
         SMSG     'SB:OSN='
         SMSG     'SB:OSUL '
         SMSG     'S:BECL '
         SMSG     'SB:NP='
         SMSG     'SB:PNL'
         SMSG     'SB:FPN='
         SMSG     'SB:FPL '
         REF      SWAPMSG
         USECT    PP
         PAGE
*
*        DRIVE DISPLAY OF ALLYCAT'S COMBUF CHAIN
*
GHOST:COM EQU     %
         LI,R1    ATMSG2
         BAL,R0   MSG%OUT
         LI,R1    ATMSG3
         LI,R5    2                 TWO PASSES
         LI,R4    24                TOTAL MAX LOOP
         LI,R14   CBFHD             FIRST CELL/CHAIN
ALLYTABL4 BAL,R0  GETADDR
         LB,R3    *R15              GET HEAD
         BAL,R0   MSG
         LI,R1    16                SPACE
         BAL,R0   SPACES
ALLYTABL5 BAL,R0  TRANSSZ           PUT OUT THE VALUE
         LI,R1    ARROW
         BAL,R0   MSG
         CI,R3    0                 IS CURRENT NULL
         BEZ      ALLYTABL6         YEP . THATS THE TAIL
         LI,R14   COMBUF
         BAL,R0   GETADDR
         LW,R0    *R15,R3
         LB,R3    R0                GET FLINK
         BDR,R4   ALLYTABL5         CONTINUE
ALLYTABL6 LI,R1   TAILMSG
         BAL,R0   MBB               PUT IT OUT
         LI,R1    ATMSG4            NEXT MSG
         LI,R14   CBAHD             NEXT CHAIN
         BDR,R5   ALLYTABL4         GO
         B        SCANNER           ALL DONE....
ATMSG2   TEXTC    'GHOST COMMUNICATIONS:'
ATMSG3   TEXTC    'FREE CHAIN:'
ATMSG4   TEXTC    'IN USE CHAIN:'
         PAGE
*
*        COMMAND FORMAT:
*
*        DI(SPLAY)  CO(C)#N
*
*        N=       COC LINE# TO DISPLAY OR ALL COC
*                 LINES IF NO OPTION FIELD
*
COCODE   LI,1     COCMSG
         BAL,0    TITEL             TITLE LINE OUT
         LI,1     COC               IS THIS A TIMESHARING SYSTEM
         BEZ      SCANNER           NOPE
         LI,1     49                SPACE OVER
         BAL,0    SPACES            TO CORECT COLUMN
         LI,1     COCMSG2           TO PUT
         BAL,0    MSG               SECOND LINE
         BAL,0    BUFOUT            OF HEADER
         LI,1     COCTAB            AND THE TABLE HEAD
         BAL,R0   MSG%OUT
         LI,1     2                 GET ANY SPECIFIED LINE NUMBER
         BAL,0    GETHEX
         LI,R8    LNOL              ASSUME ALL LINES
         LW,R6    R2                IS THAT TRUE
         BEZ      %+2               YES - USER GAVE NO OPTION
         LI,R8    1                 NO - USER GAVE OPTION - SET ONE PAS
COCLOOP  LI,14    LB:UN             GET THE USER NUMBER ASSOCIATED
         BAL,0    GETADDR
         LB,7     *15,6             THE USER NUMBER
         BEZ      COCINCR1          IF ITS ZERO, CONTINUE
         LI,5     0                 TABLE POINTER
         LI,1     3
         BAL,0    SPACES            PUT OUT THE INITIAL SPACES
         LW,3     6                 PUT OUT THE LINE NUMBER
         BAL,0    TRANSSZ
COCLOOP1 EQU      %
         LB,1     COCSP,5
         BAL,0    SPACES            PUT OUT THE CORRECT SPACES
         EXU      GETCOC,5
         BAL,0    GETADDR           GET THE TABLE
         EXU      COCACT,5          AND THE VALUE
         CI,5     1                 IT IS TERMINAL TYPE?
         BNE      NOTYPE            NO, CONTINUE
         SLS,1    1                 * 2
         CI,1     TYPENUM           OUT OF BOUNDS?
         BLE      %+2
         LI,1     6                 NONE TYPE
         AI,1     TYPE
         BAL,0    MSG               PUT OUT THE TYPE
         B        COCINCR           AND GET NEXT TABLE
NOTYPE   EQU      %
NOTANY   BAL,0    TRANSSZ           PUT OUT HEX VALUE
COCINCR  AI,5     1                 NEXT TABLE
         CI,5     COCTABSIZ         FINISHED
         BL       COCLOOP1          NO, GET NEXT
         BAL,0    BUFOUT            PUT OUT WHAT WE GOT
COCINCR1 AI,6     1                 NEXT LINE
         BDR,8    COCLOOP           GET ALL THEM ACTIVE LINES
         B        SCANNER           FINISHED
         REF      COCMSG
COCMSG2  TEXTC    ' MODE BYTES  - - -INPUT TABLES- - -  ',;                  A00
                  'OUTPUT TABLES'
COCTAB   TEXTC    ' LINE  USER  TYPE  EOMTIME  BUFCNT  CPOS  RSZ  ',;
             '     2  3  4    TL   II   IR  ARSZ CPI   OI   OR   OC'         A00
COCSP    DATA,1   8,12,21,30,37,43,49,52,55,58,62,67,72,77,82,87,92,97       A00
         BOUND    4
GETCOC   LI,14    LB:UN
         LI,14    COCTERM
         LI,14    EOMTIME
         LI,14    BUFCNT
         LI,14    CPOS
         LI,14    RSZ
         LI,14    MODE
         LI,14    MODE2
         LI,14    MODE3
         LI,R14   MODE4                                                      A00
         LI,14    TL
         LI,14    COCII
         LI,14    COCIR
         LI,14    ARSZ
         LI,14    CPI
         LI,14    COCOI
         LI,14    COCOR
         LI,14    COCOC
COCTABSIZ EQU     %-GETCOC
COCACT   LB,3     *15,6
         LB,1     *15,6
         B        COCLH
         LB,3     *15,6
         LB,3     *15,6
         LB,3     *15,6
         LB,3     *15,6
         LB,3     *15,6
         LB,3     *15,6
         LB,R3    *R15,R6           MODE4                                    A00
         B        COCLH
         B        COCLH
         B        COCLH
         LB,3     *15,6
         LB,3     *15,6
         B        COCLH
         B        COCLH
         LB,3     *15,6
COCLH    LH,3     *15,6
         AND,3    4F
         B        NOTANY
*
4F       DATA     X'FFFF'
LINEST   TEXTC    'INAC'
         TEXTC    'IN  '
         TEXTC    'OUT '
         TEXTC    'IC  '
         TEXTC    'SI  '
TYPE     EQU      %
         TEXTC    'TTY33'
         TEXTC    'TTY35'
         TEXTC    'TTY37'
         TEXTC    ' 7015'
         TEXTC    'ESTDU'
         TEXTC    'ESTDL'
         TEXTC    'EAPLU'
         TEXTC    'EAPLL'
         TEXTC    'SSTDU'
         TEXTC    'SSTDL'
         TEXTC    'SAPLU'
         TEXTC    'SAPLL'
TYPENUM  EQU      %-TYPE
ARROW    TEXTC    ' > '
TAILMSG  TEXTC    'TAIL'
         PAGE
*
*        DISPLAY  USERS,(#)
*
         DEF      USERS
USERS    LI,1     USRTMSG
         BAL,0    TITEL             TITLE LINE OUT
         LI,1     USRMSG
         BAL,R0   MSG%OUT
         LI,R1    1                                                          A00
         STW,R1   CURR%STATE                                                 A00
         LI,1     2
         BAL,0    GETHEX
         STW,R2   USER              STORE NUMBER OR ZERO
         AI,R2    0                 WHICH ONE
         BEZ      UALL              ALL IF ZERO GIVEN, ONE IF NUM GIVEN
         LI,10    1
         LW,R4    R2                MOVE USER NUMBER TO INTERNAL INDEX
         B        US1
UALL     LI,4     1                 USER #
         LI,10    SMUIS
US1      LI,2     0                 TABLE #
US3      EXU      UTABS,2           LI,14  XXXX
         BAL,0    GETADDR
         EXU      ACTION,2          L(B,H,W),3  *15,4
US33     CI,R2    0                 ON THE STATE ENTRY
         BNE      US35              NO, CONTINUE
         MTW,0    USER              DOING JUST ONE USER
         BNEZ     US34              YEP
         LI,R0    #STATES                                                    A00
         CW,R0    CURR%STATE                                                 A00
         BL       U2:TABLES         DO NEXT SET OF TABLES
         CI,R3    #STATES           IS THE SNULL STATE
         BE       US4+1             YES, DONT DISPLAY
         CW,R3    CURR%STATE                                                 A00
         BNE      US4+1             SKIP THIS ONE                            A00
US34     XW,R3    R4                STATE TO R4 - USER # TO R3
         BAL,0    TRANSSZ           NO, PUT OUT THE USER #
         LB,R1    USER:SPC,R2       GET CORRECT SPACING
         BAL,0    SPACES            AND FIVE SPACES
         LW,6     4                 STATE# TO 6
         BAL,0    SETR6             ADJUST IT
         XW,4     3               GET USER BACK IN 4
         B        %+2
US35     BAL,0    TRANSSZ           PUT OUT THE TABLE VALUE
         CI,2     UTABS1Z-1
         BGE      US4
         AI,R2    1                 NEXT TABLE INDEX
         LB,R1    USER:SPC,R2       GET NEXT SPACING
         BAL,R0   SPACES            AND PUT IT IN
         B        US3
US4      BAL,0    BUFOUT
         AI,4     1
         BDR,10   US1
         MTW,0    USER              DOING JUST ONE USER
         BNEZ     U2:TABLES         YEP, AND WE'RE ALL DONE
         MTW,1    CURR%STATE        SET TO DO ONLY NEXT STATE                A00
         B        UALL                                                       A00
         PAGE
*
*        DISPLAY THE REMAINDER OF THE USER TABLES
*
U2:TABLES EQU     %
         LW,R2    USER              WAS THERE A USER NUMBER GIVEN
         BNEZ     US:ONE            YEP
         LI,R10   SMUIS             NO, SET UP TO DO ALL
         LI,R2    1                 STARTING AT NUMBER ONE
         B        U2:START          GO
US:ONE   LI,R10   1                 SET TO DO ONLY ONE
U2:START EQU      %
         LI,R1    U2:TITE           TITLE LINE
         BAL,R0   TITEL             OUT
         LI,R1    U2:HEAD           HEADING
         BAL,R0   MSG%OUT           OUT
U2:ROWS  LI,R14   UB:US             CHECK
         BAL,R0   GETADDR           FOR A USER THERE
         LB,R3    *R15,R2           IS THERE
         BEZ      U2:NOST           NO
         CI,R3    #STATES           IS THE SNULL STATE
         BE       U2:NOST           YES, DONT DISPLAY
         LI,R4    0                 YEP, SET INDEX REG
         LW,R3    R2                MOVE USER # FOR DISPLAY
         BAL,R0   TRANSSZ           USER'S #
U2:LOOP  LB,R1    U2:SPACES,R4      GET SPACING
         BAL,R0   SPACES
         EXU      U2TAB,R4          LOAD R14 WITH ADDRS
         BAL,R0   GETADDR           GET IT
         EXU      U2ACT,R4          LOAD R3 WITH CONTENTS
U2:SCR   BAL,R0   TRANSSZ           SHOVE OUT THE VALUE
         AI,R4    1                 NEXT ROW
         CI,R4    8                 DONE WITH ROW
         BL       U2:LOOP
         BAL,R0   BUFOUT            PRINT THE WHOLE THING
U2:NOST  AI,R2    1                 NEXT USER #
         BDR,R10  U2:ROWS           DO NEXT ONE IF WE SUPPOSED TO
         B        SCANNER           ALL DONE
         PAGE
*
*        TABLE DATA FOR ADDITIONAL USER TABLES
U2TAB    EQU      %
         LI,R14   U:MISC            0
         LI,R14   UH:DL             1
         LI,R14   UB:PC             2
         LI,R14   UB:DC             3
         LI,R14   UB:PRIO           4
         LI,R14   UB:PRIOB          5
         LI,R14   UB:NECB           6
         LI,R14   UH:WL             7
*
U2ACT    EQU      %
         LW,R3    *R15,R2           0
         B        U2SCRUB           SCRUB HALF - WORD ENTRIES
         LB,R3    *R15,R2           2
         LB,R3    *R15,R2           3
         LB,R3    *R15,R2           4
         LB,R3    *R15,R2           5
         LB,R3    *R15,R2           6
         B        U2SCRUB           SCRUB HAL - WORD ENTRIES
*
U2SCRUB  EQU      %
         LH,R3    *R15,R2           GET THHE HALF WORD
         AND,R3   #R16              SCRUB THE VALUE
         B        U2:SCR            REJOING MAIN PATH
U2:HEAD TEXTC 'USER MISC      UH:DL  PC#  DC#  PRI  PRIB  NECB  UH:WL'
*
U2:SPACES DATA,1  5,15,22,27,32,37,43,49,60
         BOUND    4
         REF      U2:TITE
         PAGE
*
*
UTABS    LI,14    UB:US
         LI,14    UB:BL
         LI,14    UB:FL
         LI,14    UH:FLG
         LI,14    UH:FLG2
         LI,14    UX:JIT
         LI,14    UB:SWAPI
         LI,14    UH:JIT
         LI,14    UH:AJIT
         LI,14    UB:PCT
         LI,14    UB:ACP
         LI,14    UB:APR
         LI,14    UB:APO
         LI,14    UB:ASP
         LI,14    UB:DB
         LI,14    UB:OV
         LI,14    UB:MF
UTABS1Z  EQU      %-UTABS
         PAGE
*
ACTION   EQU      %
         DO1      3
         LB,3     *15,4
         DO1      2
         B        UT:SCRUB          GET THE HALF WORDS
         LOAD,R3  *R15,R4           UX:JIT...
         LB,3     *15,4
         B        UT:SCRUB
         B        UT:SCRUB
         DO1      7
         LB,3     *15,4
         LB,3     *15,4
*
*
UT:SCRUB EQU      %
         LH,R3    *R15,R4           GET THE HALF WORD
         AND,R3   #R16              SCRUB IT DOWN
         B        US33              REJOING MAIN PATH
         REF      USRTMSG
USRMSG   TEXTC    'USER STATE   BL FL FLG  FLG2  JIT  ',;
                  'SWPI  HJIT  AJIT PCT ACP APR APO ASP ',;
                  'DB OV MF'
USER:SPC DATA,1 5,13,16,19,24,30,35,41,47,52,56,60,64,68,72,75,78,81,83
         USECT    DATA
         BOUND    4
CURR%STATE DATA   0
         USECT    PP
         PAGE
*
*        ROUTINE TO DUMP ADAM'S MEMORY
*
ADAMDUMP EQU      %
         CAL1,6   SYSFPT            ASK FOR MASTER MODE
         BCS,8    NOADAMPRIV        CANNOT DO IT
         LI,1     X'800'            UNUSED BIT IN STATUS
         RD,1     X'2FF0'           ADAM EXISTS AND STOPPED?
         CI,1     X'801'
         BANZ     DONE              NO DO NOTHING
         SLS,1    -12               LOOK AT PLUGBOARD
         CI,1     X'F'              DEFAULT PROGRAM?
         BNE      DONE              NO DO NOTHING
         LI,5     0                 INDEX INTO PAGEBUF
         LI,1     0                 TYPX OF ADAM MEMORYS
READSET  EQU      %
         LB,2     LNG,1             GET LENGTH OF THIS MEMORY
         LH,3     ADDR,1            GET THIS MEMORY'S ADDRESS
         WD,3     X'2FF2'           SET ADDRESS
READADAM EQU      %
         RD,4     X'2FF5'           READ AND INCREMENT ADDRESS
         STW,4    *PAGEBUF,5
         AI,5     1
         BDR,2    READADAM
         AI,1     1                 POINT TO NEW MENORY
         CI,1     4                 DONE?
         BNE      READSET           NO
         LI,5     5                 START SET NIA=1
         WD,5     X'2FF1'           CONTROL
DONE     EQU      %
         LPSD,0   ADAMPSD           GO BACK TO SLAVE
         CI,1     4                 DID WE READ ADAM
         BNE      SCANNER           NO, RETURN
*
*        ROUTINE TO DUMP PAGEBUF
*
AM       EQU      1
         LI,1     TABHEADER
         BAL,0    MSG
         BAL,0    BUFOUT
         LI,5     0                 COUNTER
TABDUMP  EQU      %
         LI,4     0                 TABLE POJMTER
         LW,3     5
         BAL,0    TRANSSZ
TABLOOP  EQU      %
         LB,1     ADAMSPS,4
         BAL,0    SPACES
         CB,5     COUNTERSIZE,4     OVER TABLE SIZE?
         BGE      TNEXT             YES
         LB,2     TABSTART,4
         AW,2     PAGEBUF           START OF TABLE
         EXU      ADAMLOAD,4        WORD TO 8,9
         LW,3     8
         BAL,0    TRANS             TRANSLATE 8
         CI,4     AM                WORD RESOLUTION
         BE       TNEXT             YES
         LW,3     9                 NI, DOWBLEWORD
         BAL,0    TRANS
TNEXT    EQU      %
         AI,4     1
         CI,4     4
         BL       TABLOOP
         BAL,0    BUFOUT
         AI,5     1
         CI,5     64                MAX COUNTERSIZE
         BL       TABDUMP
         B        SCANNER           RETURN, FINISHED
*
*
ADAMLOAD EQU      %
         LD,8     *2,5
         LW,8     *2,5
         LD,8     *2,5
         LD,8     *2,5
*
*
NOADAMPRIV  LI,R1 NAPM
         B        PUSHMSG
NAPM     TEXTC    'CANNOT GET INTO MASTER MODE TO READ ADAM MEMORY'
SYSFPT   GEN,8,24 8,0
         BOUND    8
ADAMPSD  GEN,12,20   12,DONE+1
         DATA     0
LNG      DATA,1   64,64,64,128
ADDR     DATA,2   0,X'1000',X'2000',X'3000'
TABSTART DATA,1   0,64,128,192
COUNTERSIZE  DATA,1  32,64,32,64
ADAMSPS  DATA,1   8,26,36,52
TABHEADER TEXTC   'NUM    AP               AM        BP              ',;
                  '  BM'
         PAGE
         USECT    PP
*
*        COMMAND FORMAT:
*
*        DI(SPLAY) PR(OCESSOR)#N
*
*        N=       PROCESSOR# TO DISPLAY OR ALL PROCESSORS
*                 IF NO OPTION FIELD
*
*
*
PROCS    LI,1     PROTMSG
         BAL,0    TITEL             TITLE LINE OUT
         LI,1     PROCMSG
         BAL,R0   MSG%OUT
         LI,1     2                 NOW CHECK FOR
         BAL,0    GETHEX            AN OPTIONAL #
         AI,2     0                 ANY GIVEN
         BEZ      PRLOOP0           NOPE
         LW,7     2                 YES,USE IT
         LI,10    0                 SET FOR ONE PASS
         B        PRLOOP1           DO IT
PRLOOP0  LI,7     1                 STARTING AT#1
         LI,10    PPROCS            SET MAXIMUM LOOP
PRLOOP1  LI,2     0                 SPACING INDEX
         LI,14    P:NAME
         BAL,0    GETADDR
         LD,8     *15,7
         AND,R8   =X'07FFFFFF'      NAME CANT BE >7 CHARACTERS
         STD,8    PROCNAME          SAVE NAME
         LB,1     SPROCT,2          ADJUST
         BAL,0    SPACES            SPACING
         LW,3     7                 PUSH
         BAL,0    TRANSSZ           PROCESSOR#
         AI,2     1                 NEXT COLUMN#
         LB,1     SPROCT,2          SEND
         BAL,0    SPACES
         LI,1     PROCNAME          SET
         MTB,0    PROCNAME          WAS REPLACED BY DRSP
         BNEZ     PRL1              NO
         LW,3     PROCNAME          YES,SHOW
         BAL,0    TRANSSZ           DISP
         B        %+2
PRL1     BAL,0    MSG               OR PROCESSOR NAME
         LI,4     0                 SET LOOP
         AI,2     1                 NEXT COLUMN#
         LB,1     SPROCT,2          SEND
         BAL,0    SPACES            SPACES TO THERE
PRLOOP2  EXU      LOADP,4           GET ADDRS
         BAL,0    GETADDR           INTO BUFFER
         EXU      ACTP,4
PRLOOP3  CI,R4    13                AT LAST TWO FIELDS
         BL       %+3               NO
         BAL,0    TRANS             YES,SHOW LEADING ZEROS
         B        %+2               JUMP
         BAL,0    TRANSSZ           NO SHOW NO LEADING ZEROS
         AI,2     1                 NEXT COLUMN#
         AI,4     1                 NEXT INDEX
         LB,1     SPROCT,2          GET
         BAL,0    SPACES            SPACING
         CI,4     PTABSIZ-1         DONE
         BG       %+2               YES,OUTPUT LINE,DO NEXT PROCESSOR
         B        PRLOOP2
         BAL,0    BUFOUT
PRCONT   AI,7     1                 BUMP TO NEXT PROCESSOR#
         BDR,10   PRLOOP1           DO NEXT TILL COUNT RUNSOUT
         B        SCANNER
         PAGE
*
*
ACTP     EQU      %
         DO1      2
         LOAD,3   *15,7
         DO1      3
         LB,3     *15,7
         DO1      2
         B        PR:SCRUB
         DO1      4
         LB,3     *15,7
         LB,3     *15,7
         LB,3     *15,7
         DO1      2
         LW,3     *15,7
*
*
PR:SCRUB EQU      %
         LH,R3    *R15,R7
         AND,R3   #R16
         B        PRLOOP3
         PAGE
*
*
LOADP    LI,14    PX:HPP
         LI,14    PX:TPP
         LI,14    PB:PSZ
         LI,14    PB:DSZ
         LI,14    PB:DCBSZ
         LI,14    PH:PDA
         LI,14    PH:DDA
         LI,14    PB:UC
         LI,14    PB:LNK
         LI,14    PB:PVA
         LI,14    PB:HVA
         LI,14    PB:C#
         LI,14    PB:DC#
         LI,14    P:SA
         LI,14    P:TCB
PTABSIZ  EQU      %-LOADP
         REF      PROTMSG
PROCMSG  TEXTC    ' P#  P:NAME  HPP   ',;
                  'TPP    PSZ  DSZ  DCBSZ',;
                  '  PDA   DDA   UC   LNK',;
          '  PVA  HVA  PC#   DC#   SA        TCB'
SPROCT   DATA,1   1,5,14,20,26,31,36,43,49,55,60,65,70,75,80,85
         DATA,1   95,105,115
         BOUND    4
         REF      PROCNAME
LBSIGN   TEXTC    '#'
         PAGE
*
*
TSMSG       TEXTC  ;
 'ADDRS     STACK OFFSET     CONTENTS      RELATIVE LOC',;
                   '     INSTRUCTION '
         REF      TSMSG1
         REF      SYMBOL:FLAG
INFOA    TEXTC    ' FLAGS =  '
INFOB    TEXTC    ' START =  '
USR:PGM TEXTC 'USRAREA'
PLUSDOT  TEXTC '+.'
MINUSDOT TEXTC    '-.'
         PAGE
*
*        IF SYMBOL TABLE WASNT BUILT - CNAT RUN THIS DISPLAY
*
*
NODISPLAY LI,R1   SYMBOL:MSG
         BAL,R0   BMBB              PUT OUT THE WARNING MSG
         PLW,R1   STACK             RETRIEVE THE LINK
         B        0,R1              RETURN TO CALLER
SYMBOL:MSG TEXTC 'TSTACK DISPLAY REQUIRES INITIALIZING THE SYMBOL MAP'
         REF      TSMSGM
*
         PAGE
*
*        COMMAND 'DISPLAY TSTACK'
*
         DEF      DISPSTK           FOR MAIN ANALZ TO USE
DISPSTK  EQU      %
         MTW,7    ANLZ1FLG          POST FLAG FOR THE ROOT
         PSW,R1   STACK
         MTW,0    SYMBOL:FLAG
         BEZ      NODISPLAY         CANNOT DO IT
         LCFI     9                 GET AND
         LM,R0    ZEROS             ZAP ALL THE
         STM,R0   CURR:LOC          VARIABLES
         LW,R2    USER              WAS A USER NUMBER PASSED
         BNEZ     DISPSTK1          YEP
         LI,R1    2                 NO, GO LOOK FOR AN OPTION
         BAL,R0   GETHEX
         STW,R2   USER              SAVE A ZERO OR USER NUMBER
         AI,R2    0                 WAS THERE A NUMBER
         BEZ      DISPSTK2          ITS THE MONITOR'S STACK
DISPSTK1 LI,R14   UH:FLG
         BAL,R0   GETADDR           FOR USER OWNING MEMORY
         LH,R3    *R15,R2           GET USER FLAGS
         AND,R3   #R16              AND MASK
         PSW,R3   STACK             SAVE VALUE
         LC       USER              SUPPOSED TO LOOK AT JIC BIT
         BCS,4    DISPSTK2          NOPE - GO ON - USER IN CORE OKAY
         CI,R3    X'200'            WAS HIS JIT IN CORE
         BANZ     DISPSTK2          YEP, GO ON
         LCI      8
         STCF     NO:CORE           TURN OFF FLAG IF HE HAS NONE
DISPSTK2 BAL,R0   RES:JIT           RESTORE THE JIT
         BCS,4    DISPSTK9          ERROR EXIT
         LI,R1    TSMSGM            ASSUME MONITOR STACK
         MTW,0    USER              CORRECT
         BEZ      %+2               YEP
         LI,R1    TSMSG1            NO
         BAL,R0   MSG%OUT           PUT OUT TITLE LINE
         LI,R1    TSMSG             AND
         BAL,R0   MSG%OUT           THEN HEADING
DISPSTK3 LI,R5    TSTACK-J:JIT      FIRST PLACE TO START
         LI,R7    TSTACK+1-(J:JIT)
         LI,R1    X'1FF'            MONITOR STACK LIMIT MASK
         LI,R8    X'1FF'
         SLS,R8   16                MASK TO GET SPACE COUNT IN POSITION
         AND,R8   *PAGEBUF,R7       GET IT
         SLS,R8   -16               RE-POSITION
         LI,R9    X'1FF'            MASK FOR WORD COUNT
         AND,R9   *PAGEBUF,R7       GET WORD COUNT
         LI,R6    21+21             MINUM DEPTH TO SHOW
         AW,R6    R9                ADD STACK WORD COUNT
         AND,R6   R1                MASK TO LIMIT
         STW,R6   TSIZE             SAVE FOR LOOP ON MONITOR STACK
         AW,R9    R8                ADD EM UP
         MTW,0    USER              DOING A USER'S STACK
         BEZ      %+2               NO - ALREADY GOT MASK IN R1
         LI,R1    X'7F'             YES - SET USER MASK
         AND,R9   R1                MASK STACK TO LIMIT POSSIBLE
         AW,R9    TST:LIMS          ADD BASE ADDRESS
         STW,R9   TST:LIMS+1        STORE FOR CLM PAIR
         LW,R9    *PAGEBUF,R5       GET TSTACK TOP POINTER
         AND,R9   =X'8DFF'          MASK TO LIMIT POSSIBLE
         AW,R9    R8                ADD SPACE COUNT
         SW,R9    TST:LIMS+1        CALCULATE OSTACK DEPTH
         STW,R9   STK:CNT           SAVE OSTACK SIZE
         LI,R6    J:START-J:JIT
         LW,R6    *PAGEBUF,R6       GET LMN START ADDRESS
         BNEZ     %+2               HAS ONE
         LI,R6    JBUPVPA           GIVE HIM THIS IF NONE THERE
         STW,R6   GHST:STRT         SAVE IT FOR LATER
         MTW,0    USER              IS THIS A SUER STA K
         BEZ      DISPSTK35         NO, MONITOR'S STACK
         PLW,R3   STACK             YEP, RETRIEVE USER'S FLAGS
         LI,R1    INFOA
         BAL,R0   MTBB              PUT IT OUT
         LW,R3    R6                MOVE USER'S START ADDRESS
         LI,R1    INFOB             YES
         BAL,R0   MTBB              PUT IT OUT
DISPSTK35 LI,R6   0                 INITIAL INDEX
DISPSTK4  EQU     %                 LOOP RETURN POINT
         CI,R6    2                 ABOUT TO START ON DATA PART OF STK
         BNE      STRT:STK          NOPE
         BAL,R0   ST:ENV            YEP . SAY INITIAL ENVIRONMENT
STRT:STK LI,R1    1                 INITIAL SPACING
         BAL,R0   SPACES            INSERRT FIRST SPACING
         LW,R3    R6                RELATIVE LOC IN TSTACK
         AI,R3    TSTACK            ADD CORE ADDRS
         BAL,R0   TRANSSZ           PUT THAT OUT
         LI,R1    11
         BAL,R0   SPACES
         LW,R3    R6
         BAL,R0   TRANSSZ
         LW,R3    *PAGEBUF,R5       GET WORD OUT OF STACK
         CW,R3    BAD:LOCA          UNUSED PART OF STACK
         BE       DISPSTK8          YEP, ALL DONE
         LI,R1    27
         BAL,R0   SPACES
         BAL,R0   TRANS
         LI,R1    41
         BAL,R0   SPACES
         CI,R3    0                 IS WORD ALL ZEROES
         BEZ      DISPSTK55         YES - DUMMP OUT AS DATA ONLY
         CI,R3    MONORG            WILL FIND SYMBOL
         BL       DISPSTK55         NO
         AND,R3   =X'FFFFF'         MASK OFF TWENTY BITS WORTH THEN
DISPSTK43 EQU     %
         CI,R3    CORE-1            FITS INTO CORE LIMITS
         BGE      DISPSTK55
         AND,R3   =X'1FFFF'         OK, MASK IT DOWN
         STW,R3   CURR:LOC          AND SAVE IT FOR LATER
         CI,R6    2                 PAST SPD YET
         BL       DISPSTK44         NO, HOP OVER THERE
         CLM,R3   JIT:LIMS          IS IN THE JIT
         BCR,9    DISPSTK44         IN THE JIT
NOT:JIT  CI,R3    JOVVPA            IS ADDRESS DOWN IN ROOT
         BL       DISPSTK44         YEP . LOOK DOWN THERE FOR A SYMBOL
         BAL,R7   GETOV             GET THE PROCESSOR DATA
         LW,R1    CLOSESTSYM        FIND ANYTHING
         BNEZ     DISPSTK45         YEP, USE IT
DISPSTK44 CLM,R3  SYM:LIMS          ANY REASON TO LOOK FOR A SYMBOL
          BCS,9  DISPSTK55    NOPE
         LW,R12   R3                OBJECT ADDRESS
         BAL,R1   GRABSYM           START SYMBOL SEARCH
         NOP      %
DISPSTK45 LW,R1   CLOSESTSYM        GET TEXTC STRING ADDRESS
         BLEZ     DISPSTK55         SOMEONE SCREWED UP
          BAL,R0  MSG               MOVE IT
         LW,R3    CURR:LOC          CURRENT OBSERVED ADDRESS
         BAL,R0   DISP:OFF          PUT OFFSET INTO PRINT LINE
         BAL,R7   LOOKATMON         LOOK AT ADDRESS TO SHOW INSTRUCTION
         MTW,0    REGFLAG           FOUND A REG ENVIRONMENT
         BNEZ     REG:HIT           YEP, START UP PROCESS
DISPSTK55 BAL,R0  BUFOUT
         LI,R0    0
         STW,R0   CLOSESTSYM
         STW,R0   PROCNAME
         STW,R0   CLOSESTADD
DISPSTK6 AI,R5    1                 NEXT TSTACK WORD INDEX
         AI,R6    1                 NEXT REL LOC INDEX
         MTW,1    REG:REG           BUMP UP REGISTER FROM REG
         BEZ      CHK:PUSH          JUST COMPLETED AN ENVIRONMENT
DISPSTK7 MTW,0    USER              IS THIS THE MONITOR'S STACK
         BNEZ     DISPSTK75         NO
         MTW,-1   TSIZE             YES, DECREMENT AMOUNT TO SHOW
         BLZ      DISPSTK8          ALL DONE
DISPSTK75 LW,R4   R6                RELATIVE INDEX INTO STACK
         AI,R4    TSTACK            ADD REAL ADDRS
         CLM,R4   TST:LIMS          STILL WITHIN TSTACK LIMITS
         BCR,9    DISPSTK4          YEP,,,GO
DISPSTK8 LI,R1    END:STKM          END OF STACK HIT
         BAL,R0   MSG%OUT
         PLW,R1   STACK             RETRIEVE THE LINK
         B        OSTACK            GO SHOW THE OSTACK
DISPSTK9 MTW,0    USER              WAS A USER TYPE RUN
         BEZ      %+2               NOPE
         PLW,R3   STACK             YES - BALANCE THE STACK
         PLW,R1   STACK             GET THE RETU4N LINK
         LI,R0    0
         STW,R0   ANLZ1FLG          RESET FLAG FOR THE ROOT
         B        0,R1              AND EXIT THE DISPLAY
         BOUND    8
JIT:LIMS DATA     J:JIT
         DATA     J:JIT+511
         PAGE
*
*        TRY TO DETECT USER'S PROCESSOR, ETC.
*
GETOV    MTW,0    USER              WORKING ON A USER
         BEZ      0,R7              NONE - SO EXIT
         LCFI     3
         PSM,R5   STACK
         LI,R1    0
         STW,R0   CLOSESTSYM
         STW,R0   CLOSESTADD        RESET POINTERS
         STW,R0   PROCNAME          PRIOR TO LOOKING AT ANYTHING
         LC       *PAGEBUF          GET USER'S ORIGIN
         STCF     USER:MODE         SAVED
         LC       USER:MODE         TEST FOR GHOST JOB
         BCS,4    GET:GHOST         GET THE GHOST
         LI,R7    4                 4 TYPES TO SCAN FOR
GETOV1   LW,R2    USER
         EXU      GET:OV,R7         LOAD UP ADDRESS
         BAL,R0   GETADDR           GO GET IT
         LB,R6    *R15,R2           CHECK FOR DB,ACP,OV
         BNEZ     GETOV25           MIGHT HAVE FOUND ONE
GETOV2   BDR,R7   GETOV1            CONTINUE SCAN
         B        USER:SET          CALL IT A USER ADDRS
GETOV25  B        T:TESTS,R7        EXECUTE PATH ACCORDING TO PROC TYP
GETOV26  LB,R1    USER:MODE         CHECK FOR BATCH JOB
         BNEZ     GETOV3            ONLINE/GHOST
         CI,R7    2                 DOING UB:ACP
         BNE      GETOV3            NOPE, NOT TIME TO WORRY ABOUT CCI
         LD,R4    CCI:RAN           BATCH, GET CCI LIMITS
         B        GETOV35           GET INTO LOOK
GETOV3   LD,R4    RANGE,R7          GET CORE LIMITS
GETOV35  STD,R4   RANGE             SAVED
         LW,R3    CURR:LOC          GET CURRENT ADDRESS
         CLM,R3   RANGE             TEST AGAINST LIMITS
         BCS,9    GETOV2            NOT IN RANGE, DO NEXT ONE
         B        L:TESTS,R7        PATH ACCORDING TO PROC TYPE
GETOV4   LB,R1    USER:MODE         GET ORIGIN
         SLS,R1   -6
         AND,R1   =3                MASK FOR SURE
         B        R:TESTS,R1        EXECUTE PATH ACCORDING TO ORIGIN
GETOV45  LI,R14   UH:FLG            NEED USER FLAGS IF COME TO HERE
         BAL,R0   GETADDR           GET EM
         LH,R3    *R15,R2           GET INTO R3
         CW,R3    L:TYPE,R1         TEST AGAINST INDICATORS
         BAZ      GETOV2            NO GOOD, CHECK NEXT ONE
GETOV5   LI,R14   P:NAME            NEED NAME NOW
         BAL,R0   GETADDR           READ IN THE NAME TABLE
         LD,R4    *R15,R6           GET USER'S PROCESSOR NAME
GETOV6   LI,R1    PROCNAME
         STW,R1   CLOSESTSYM        SAVE POINTER
         STD,R4   PROCNAME
         LI,R14   P:SA              NOW NEED PROCESSOR START ADDRESS
         BAL,R0   GETADDR           GO GET IT
         LW,R1    *R15,R6           GET IT
         AND,R1   =X'1FFFF'         MASK
         BNEZ     %+2               HAD AN ADDRESS
         LW,R1    LIKE:ADDRS,R7     GET MOST LIKELY START ADDRESS
GETOV7   AND,R1   =X'1FFFF'         MASK IT PROPERLY
         STW,R1   CLOSESTADD        SAVE IT
GETOV8   BAL,R0   RES:JIT           RESTORE THE USER JIT
         LCFI     3
         PLM,R5   STACK
         B        0,R7
         PAGE
*
*        IF CURRENT JIT INDICATES GHOST JOB, CHECK FOR GHOST
*        NAME IN GHOST TABLES
*
GET:GHOST LI,R14  SB:GJOBUN
         BAL,R0   GETADDR
         LI,R6    MAXG              MAX GHOST JOB INDEX TO TABLES
         LW,R2    USER              GET USER NUMBER FROM JIT
         CB,R2    *R15,R6           FIND THE MATCH
         BE       GOT:GHOST
         BDR,R6   %-2
         B        GETOV8            FORGET IT
GOT:GHOST LI,R14  S:GJOBTBL         NAME TABLE
         BAL,R0   GETADDR
         LD,R4    GHST:STRT         GET GHOST LIMITS
         STD,R4   RANGE             AND PUT AWAY
         LD,R4    *R15,R6           GET NAME
         LI,R6    PPROCS            MAX # OF PROCESSORS
         LI,R14   P:NAME
         BAL,R0   GETADDR           GET PROCESSOR NAME TABLE
         CD,R4    *R15,R6           LOOK FOR A MATCH
         BE       GETOV6
         BDR,R6   %-2               KEEP LOOKING
         STD,R4   PROCNAME          THE HECK W/IT , ITS STILL A GHOST
         LI,R1    PROCNAME
         STW,R1   CLOSESTSYM
         LW,R1    GHST:STRT         YES, SPECIAL HANDLING
         B        GETOV7
         PAGE
*
*        DATA FOR PROCESSOR DETECTION CODE
*
L:TYPE   EQU      %
BATCH:T  DATA     TIC+BAT           EQUAL CCI IN CONTROL
GHOST:T  DATA     0                 NONE
ONLINE:T DATA     DELA+TIC+DIC
L:TESTS  EQU      %-1
         B        GETOV4            UB:DB
         B        GETOV4            UB:ACP
         B        GETOV5            UB:OV
         B        GETOV5            UB:ASP
R:TESTS  B        GETOV45           BATCH JOB
         B        GETOV5            GHOST JOB
         B        GETOV45           ONLINE
T:TESTS  EQU      %-1
         B        GETOV26           UB:DB
         B        GETOV26           UB:ACP
         B        GETOV26           UB:OV
         B        GETOV3            UB:ASP
LIKE:ADDRS EQU    %-1
         DATA     SPDBASE,SPDBASE,JOVVPA,SPDBASE
*
GET:OV   EQU      %-1
         LI,R14   UB:DB
         LI,R14   UB:ACP
         LI,R14   UB:OV
         LI,R14   UB:ASP
         USECT    PP
         PAGE
*
*        IF ALL ELSE FAILS, CALL ADDRESS A USER PSD
*
USER:SET LW,R3    CURR:LOC          GET CURRENT OBJECT ADDRS
         LD,R0    ZEROS             ZAP MEMORY POINTER
         LI,R0    -1                SET UP NON-COMPARE DBL-WORD
         STD,R0   RANGE             ZAP THAT
         STD,R0   CLOSESTSYM        ZAP THAT TOO...NO-ONE GETS FOOLED
         CLM,R3   DATA:AREA         IN SPECIAL MEMORY
         BCS,9    USER:SET1         NOPE
         MTW,1    DATAFLAG          YES, SET FLAG FOR NO INST LOOK
         B        USER:SET2         JUMP
USER:SET1 CLM,R3  GHST:STRT         IS ADDRESS IN USER'S PROCDURE
          BCS,9   GETOV8            NOPE, JUST LEAVE THINGS AS THEY ARE
         LD,R0    GHST:STRT         YES
         STD,R0   RANGE             LEAVE POINTER
USER:SET2 LI,R1   USR:PGM           LEAVE TEXTC POINTER SET
         STW,R1   CLOSESTSYM
         LW,R1    GHST:STRT
         B        GETOV7            GO STORE IT
         BOUND    8
RANGES   DATA     SPDBASE,CORE-1    DEBUGGER CORE-1LIMITS
         DATA     SPDBASE,CORE-1    COMMAND PROCESSOR LIMITS
         DATA     JOVVPA,JOVVPA+X'BFF' LIKELY RANGE OF OVERLAYS
         DATA     SPDBASE,CORE-1       LIKELY RANGE OF LIBRARIES
MAP:AREA DATA     JOVVPA,CORE-1
CCI:RAN  DATA     JBUPVPA,CORE-1    CCI'S LIMITS
DATA:AREA DATA    J:JIT,JBUPVPA-1   SPECIAL NON-USER MEMORY
MON:AREA DATA     16,JITLOC
MON:DATA DATA     0,SAVEREGS+16     PRBOBABLY ALL DATA IN THERE
PATCHLOC DATA     MPATCH,MX:PPUT    AREA BELONGING TO XDELTA
         PAGE
*
*        DETECTED A REG ENVIRONMENT IN TSTACK
*
REG:HIT  EQU      %
         MTW,0    REGFLAG           DID FLAG GET RAISED
         BEZ      DISPSTK4          NOT FOUND ONE YET
         CW,R6    LAST:LINE         SAME AS LAST ONE
         BE       DISPSTK55         YEP, RESET FLAG/CONTINUE
         LW,R4    R6                MOVE FOR ARITH
         SW,R4    LAST:LINE         CALCULATE DISTANCE FROM LAST REG
         BLEZ     DISPSTK55         FORGET IT
         CI,R4    19                FAR ENUFF AWAY
         BL       DISPSTK55         NOPE
         STW,R6   LAST:LINE         OK, WE'LL CALL IT A REG ENVIRONMENT
         BAL,R0   BLNKBUF           BLANK BUFFER - RESET POINTERS
         LW,R1    REGFLAG           GET TYPE
         LW,R1    REGTYPE,R1        GET MSG ADDRESS
         BAL,R0   MSG%OUT           PRINT OUT MESSAGE
         LI,R1    -19               LENGTH OF ENVIRONMENT REGS
         STW,R1   REG:REG           INITIALIZE REGISTER #
         B        DISPSTK4          NOW REDO LINE CURRENT LINE
BAD:LOCA DATA     X'00000BAD'       INDICATES UN-USED PORTION OF STACK
END:STKM TEXTC    '*** END OF USED STACK ***'
         PAGE
*
*        USING I/A IN THE STACK , OBTAIN THE INSTRUCTION AT
*        THAT ADDRESS AND DISPLAY ALONG WITH IT'S ASSOCIATED
*        SYMBOL (WITH AN APPROPRIATE OFFSET OF COURSE)
*
*
LOOKATMON EQU     %
         LCFI     3
         PSM,R5   STACK
         LI,R1    58
         BAL,R0   SPACES
         LI,R0    0
         STW,R0   MAPFLAG           INSURE TRANSLATION IS PHYSICAL
         LW,R6    CURR:LOC          GET CURRENT LOC (ALREADY MASKED)
NXT:IN   CLM,R6   JIT:LIMS          IS LOC IN THE JIT
         BCS,9    NOJITCHK          ITS NOT IN THE JIT
         BAL,R0   RES:JIT           RESTORE THE JIT
         BCS,4    NO:LOOK           ERROR EXIT
         AND,R6   X1FF              FORM PAGE INDEX
         LW,R3    *PAGEBUF,R6       GET WORD
         STW,R3   INST:SAVE         PUT IT AWAY
         B        ALL:DATA          GO PRINT IT
NOJITCHK CLM,R6   RCVLIMITS         IS ADDRESS SITTING BEHHIND RCVRY..
         BCR,9    GET:CORE          YEP
         CLM,R6   MON:AREA          IS ADDRESS WITHIN RESIDENT MONITOR
         BCR,9    NOT:OVER          YEP , GO
CHK:IN   LC       NO:CORE           DOES USER OWN SOME MEMORY
         BCS,8    NO:LOOK           NO, NOTHING TO DO
         CLM,R6   MAP:AREA          IF HE HAS CORE, IS ADDRS IN VIRTUAL
         BCS,9    NOT:OVER          NOPE
         LW,R2    USER              IS IT A USER
         BEZ      NOT:OVER          NO
         MTW,0    MON:FLAG          ARE WE LOOKING AT RUNNING MONITOR
         BNEZ     NO:LOOK           YES, WE'LL NEVER DO IT RIGHT
         BAL,R0   MAP:USER          OK, USE HIS MAP IF TESTS PASS
NOT:OVER LW,R14   R6                MOVE ADDRESS WE WANT TO GETADDR'S
         BAL,R0   GETADDR           ITS IN THE DUMP FILE
         B        GET:INST
GET:CORE LB,R7    JB:PRIV           CHECK USER'S PRIV
         CI,R7    X'A0'             WILL WE BE ABLE TO DO CVM CAL
         BL       NO:LOOK           NO
         MTW,1    MONFLAG           YES, SET THE FLAG
         B        NOT:OVER          DRIVE ON OVER THERE
GET:INST LW,R3    *R15              PICK UP VALUE
         STW,R3   IMONLOC           SAVED
         STW,R3   INST:SAVE
         CI,R3    0                 IS DATA VALUE
         BEZ      ALL:DATA          YEP
         LB,R3    IMONLOC           GET THE OPCODE
         AND,R3   =X'0000007F'      MASK INDIRECT BIT
GOT:INST BAL,R9   INSRT:OP          BUILD OPCODE
INSRT:REG LI,R1   ACT:INST
         BAL,R0   MSG               PUT OUT INST IN EBCDIC
         LW,R3    IMONLOC           RESTORE VALUE TO R3
         AND,R3   =X'00F00000'      ISOLATE INDEX
         SLS,R3   -20
         BAL,R0   MOVE:CREG         PUT OUT REG IN DECIMAL
BB:PUSHED LI,R1   66                SPACING
         BAL,R0   SPACES
         LC       IMONLOC           INDIRECT
         BCR,8    NOT:IND           NOPE
         LI,R1    STARMSG
         BAL,R0   MSG
NOT:IND  LW,R3    IMONLOC           GET ADDRS AGAIN
         AND,R3   =X'1FFFF'         MASK IT
         STW,R3   IMONLOC           SAVE MASKED VALUE
         BEZ      DATA:INST         JUMP IF RESULT IS ZERO
         LW,R1    CLOSESTSYM        HAS ANYONE ESTABLISHED AN ADDRS
         BEZ      SYM:TEST          NOPE
         CLM,R3   RANGE             WILL ADDRS FIT RANGE
         BCR,9    MOVE:DISP         YEP
SYM:TEST CLM,R3   SYM:LIMS          NO, DOES SYMBOL BELONG TO MONITOR
         BCR,9    MON:INST          YEP
         CI,R3    16                IS IT A REGISTER
         BL       REG:INST          YEP
DATA:INST LI,R1   DOT:MSG           JUST A DOT FOR HEX READABILITY
         BAL,R0   MSG
         BAL,R0   TRANSSZ           PUT OUT VALUE
         B        CHK:INDX
MON:INST LW,R12   IMONLOC
         BAL,R1   GRABSYM
         NOP      %                 FORGET THIS RETURN
         LW,R1    CLOSESTSYM        TEXTC ADDRESS
         BLEZ     NO:LOOK           BLEW IT SOMEWHERE...
MOVE:DISP BAL,R0   MSG              MOVE TEXT STRING
         BAL,R2   REG:TEST          CHECK IT
         LW,R3    IMONLOC           CURRENT I/A CONTENTS
         BAL,R0   DISP:OFF          PUT OUT SYMBOL OFFSET
         B        %+2               JUMP OVER REGISTER MOVE
REG:INST BAL,R0   MOVE:REG          MOVE REGISTER INTO PLACE
CHK:INDX LW,R3    INST:SAVE         GET COMPLETE INST
         AND,R3   =X'000E0000'      EXTRACT INDEX REGISTER
         CI,R3    0
         BEZ      NO:LOOK           NONE
         SLS,R3   -17               NORMALIZE IT
         BAL,R0   MOVE:CREG         MOVE IT INOT PLACE
NO:LOOK  LI,R7    0
         STW,R7   DATAFLAG          TURN OFF THAT FLAG
         CW,R7    MON:FLAG
         BNE      NO:LOOK1          YES
         CW,R7    MONFLAG           DID WE TURN IT ON THO
         BE       NO:LOOK1          NO - SKIP RESTORING THE BUFFERS
         STW,R7   MONFLAG           TURN IT OFF THEN
         BAL,R0   RES:BUF           RESTORE THE DUMP BUFFERS
NO:LOOK1 BAL,R0   RES:JIT           RESTORE THE JIT
         LCFI     3
         PLM,R5   STACK
         B        0,R7
         PAGE
*
*        MOVE REGISTER NUMBER (DECIMAL) INTO PLACE
*
MOVE:CREG PSW,R0 STACK
         LI,R1    COMMA:MSG
         BAL,R0   MSG
         PLW,R0   STACK
MOVE:REG PSW,R0   STACK
         LW,R1    R3                INDEX NUMBER
         AI,R1    REG0              ADDRS OF TEXTC STRING
         PLW,R0   STACK
         B        MSG               GO INSERT STRING
COMMA:MSG  TEXTC  ','
REG0     TEXTC    '0'
REG1     TEXTC    '1'
REG2     TEXTC    '2'
REG3     TEXTC    '3'
REG4     TEXTC    '4'
REG5     TEXTC    '5'
REG6     TEXTC    '6'
REG7     TEXTC    '7'
REG8     TEXTC    '8'
REG9     TEXTC    '9'
REG10    TEXTC    '10'
REG11    TEXTC    '11'
REG12    TEXTC    '12'
REG13    TEXTC    '13'
REG14    TEXTC    '14'
REG15    TEXTC    '15'
STARMSG  TEXTC    '*'
         PAGE
*
*        AT THIS POINT R6 CONTAINS THE NEXT INDEX
*        INTO THE TEMP STACK AND WE'VE JUST COMPLETED
*        THE 19TH WORD OF THE LAST ENVIRONMENT
*
CHK:PUSH EQU      %
         PSW,R5   STACK             SAVE CURRENT INDEX
         MTW,0    PUSH:FLAG         JUST COMPLETE ONE
         BNEZ     PUSH:DONE         YEP, GO THERE
         AI,R5    7                 POINT TO PROBABLE STACK MARK
         LI,R7    X'FF'             MASK TO
         AND,R7   *PAGEBUF,R5       OBTAIN THAT POSITION
         AI,R7    1                 ADVANCE
         CW,R7    R5                IS IT A STACK MARKER
         BNE      PUSH:DONE         NOPE
         BAL,R0   BLNKBUF
         LI,R1    PUSHALL:MSG       YEP
         BAL,R0   MSG%OUT
         LI,R1    -8
         STW,R1   REG:REG
         MTW,1    PUSH:FLAG
         PLW,R5   STACK
         B        DISPSTK7
PUSHALL:MSG TEXTC '*** PUSHALLE REGISTERS ***'
DOT:MSG TEXTC '.'
         PAGE
*
*        AT THIS POINT WE'RE AT THE FIRST ENTRY IN THE STACK
*
ST:ENV   EQU      %
         MTW,0    USER              IS MONITOR'S STACK
         BEZ      STRT:STK          YEP, WHO KNOWS WHATS IN HIS STACK
         BAL,R0   BLNKBUF
         LI,R1    STENV:MSG         AHAH, LETS PRINT OUT A MSG
         BAL,R0   MSG%OUT           PUT OUT MSG
         LI,R1    -19               INIT COUNTER
         STW,R1   REG:REG
         B        STRT:STK
STENV:MSG TEXTC '*** INITIAL ENVIRONMENT ***'
ENV:DONE TEXTC '*** MISCELLANEOUS REGISTERS ***'
         PAGE
*
*        AT THIS POINT THE PUSHALL IS OUT, AND WE'LL SAY
*        SOMETHING ABOUT IT
*
PUSH:DONE LI,R1   0
         STW,R1   PUSH:FLAG
         BAL,R0   BLNKBUF
         LI,R1    ENV:DONE
         BAL,R0   MSG%OUT
         PLW,R5   STACK
         B        DISPSTK4          DO CURRENT LINE
         PAGE
*
*        AT THIS POINT WE'VE DETERMINED THAT THE ADDRESS
*        WITHIN THE STACK WE HAVE BEEN LOOKING AT IS NOT
*        AN ADDRESS MODIFYING INSTRUCTION. NOW PUT OUT
*        THE INSTRCUTION ITSELF FOR CLARITY.
*
INSRT:OP EQU      %
         MTW,0    DATAFLAG          SUPPOSED TO GET OPCODE
         BNEZ     ALL:DATA          NO
         CLM,R6   PATCHLOC          IS OBJECT ADDRESS IN MPATCH
         BCR,9    INSRT0            YES, SHOW INSTRUCTION
         CLM,R6   MON:DATA          NO, BUT IS IT IN MONITOR DATA
         BCR,9    ALL:DATA          YES, NO INST DISPLAY
INSRT0   AI,R3    OPCODES           NOPE, WE'LL SHOW THE INST.
         SLS,R3   2                 INTO BA
         LI,R4    4                 MAX CHARS
         LI,R5    0                 COUNTER OF TEXT
INSRT1   LB,R6    0,R3              GET ONE
         CI,R6    ' '               BLANK YET
         BE       %+3               DONE
         AI,R5    1
         STB,R6   ACT:INST,R5       STORE IT AWAY
         AI,R3    1
         BDR,R4   INSRT1            FINISH UP
INSRT2   CI,R5    0                 FIND ANY BYTES
         BEZ      ALL:DATA          DIDN'T FIND AN INSTRUCTION
         STB,R5   ACT:INST          YEP, STORE BYTE CNT
         B        INSRT:REG         GO DO REGISTER #
         PAGE
*
*        DISPLAY AS ALL DATA
*
ALL:DATA LI,R1    DOT:MSG
         BAL,R0   MSG
         LW,R3    INST:SAVE
         BAL,R0   TRANS
         B        NO:LOOK           AND EXIT
         PAGE
*
*        R3 CONTAINS THE CURRETNLY ANALYZED IA
*
REG:TEST LI,R5    2                 TWO PASS LOOP
         LW,R3    CURR:LOC          STARTING AT CURRENT I/A
REG:TEST1 LI,R7   #OFREGS           NUMBER TO LOOK AT
         CW,R3    REGIA,R7          FIND A MATCH
         BE       SET:REG           GOTCHA
         BDR,R7   %-2
         LW,R3    IMONLOC           NOW LOOK AT CURRENT I/A CONTENTS
         BDR,R5   REG:TEST1         CHECK IT
         STW,R5   REGFLAG           RESET THE FLAG - NO REG HERE
         B        0,R2              NONE FOUND
SET:REG STW,R7    REGFLAG           REMEMBER TYPE OF REG
         B        0,R2              EXIT
REGTYPE  DATA     0,REGTYP1,REGTYP2
REGTYP1 TEXTC '*** REPORT EVENT ENVIRONMENT ***'
REGTYP2 TEXTC '*** I/O IN PROGRESS ENVIRONMENT ***'
*
*
         PAGE
*
*        DISPLAY THE USER OSTACK
*
OSTACK   MTW,0    USER              USER DISPLAU
         BEZ      0,R1              YEP, EXIT
         PSW,R1   STACK             SAVE LINK
         LW,R5    TST:LIMS+1        GET THE TOP OF THE STACK POINTER
         AI,R5    1                 INCREMENT
         AND,R5   X1FF              MAKE A PAGE INDEX
         LW,R4    STK:CNT           # ANALYZE THINKS IN OSTACK
         AND,R4   =X'1F'            LIMIT TO 30
         BLEZ     OSTACK35          WE BLEW IT
         LI,R1    OSMSG
         BAL,R0   MSG%OUT           PUT OUT THE TITLE
         LI,R1    OSMSG1
         BAL,R0   MSG%OUT           PUT OUT THE HEADING
OSTACK1  BAL,R0   RES:JIT           RESTORE THE USER'S JIT
         LW,R12   *PAGEBUF,R5       GET OSTACK CONTENTS
         BEZ      OSTACK3           EMPTY
         CW,R12   BAD:LOCA          IS UN-USED
         BE       OSTACK3           NONE THERE
         LB,R6    R12               GET PROC NUMBER
         BEZ      OSTACK3           INVALID ENTRY
         CI,R6    PPROCS            IS IN RANGE
         BG       OSTACK3           NO GOOD
         LI,R14   P:NAME
         BAL,R0   GETADDR           GET PROCESSOR NAME TABLE
         LD,R0    *R15,R6           GET THE NAME
         STD,R0   PROCNAME
         LI,R1    PROCNAME
         BAL,R0   MSG
         LI,R1    #MS
         BAL,R0   MSG
         LW,R3    R6                THE PROCESSOR NUMBER
         BAL,R0   TRANSSZ           PUT IT OUT
         LI,R1    25
         BAL,R0   SPACES
         LI,R11   JOVVPA            FIRST OVERLAY VIRTUAL ADDRESS
         AND,R12  =X'1FFFF'         SCRUB RET ADDRESS
         CW,R12   R11               IS ADDRESS WITHIN AN OVERLAY
         BGE      OSTACK5           YES, ADJUST POINTERS
         BAL,R1   GRABSYM           OTHERWISE START SYMBOL SEARCH
         LW,R1    CLOSESTSYM        GET TEXTC ADDRESS
OSTACK15 BAL,R0   MSG               AND PRINT IT
         LW,R3    R12               THE ADDRESS WE ARE LOOKING AT
         BAL,R0   DISP:OFF          PUT IT OUT AS DISPLACMENT
         BAL,R0   SPACE2
         LI,R1    LCOLON
         BAL,R0   MSG
         LW,R3    R12               RESTORE THE COMPLETE ADDRESS
         BAL,R0   TRANSSZ           PUT IT INSIDE THE COLONS
         LI,R1    RCOLON
         BAL,R0   MSG               THERE, NICE N'PRETTY
OSTACK2  BAL,R0   BUFOUT
OSTACK3  AI,R5    -1                NEXT ENTRY IN OSTACK
         AI,R4    -1                NEXT COUNT IN OSTACK
         BGEZ     OSTACK1           KEEP GOING
OSTACK35 PLW,R1   STACK             RETRIEVE LINK
         LI,R0    0
         STW,R0   ANLZ1FLG          RESET FLAG FOR THE ROOT
         B        0,R1              AND LEAVE
OSTACK4  LW,R3    R12               MUST BE AN ABSOLUTE ADDRESS
         BAL,R0   TRANSSZ           PUT IT OUT
         B        OSTACK2           AND PRINT THE LINE
OSTACK5  STW,R11  CLOSESTADD        STORE JOVVPA AS CLOSESTADDRESS
         LI,R1    PROCNAME          THATS THE TEXTC ADDRESS
         B        OSTACK15          PRINT IT OUT
OSMSG    TEXTC    'CONTENTS OF OSTACK:'
OSMSG1   TEXTC    'PROCESSOR                RETURN ADDRESS'
#MS      TEXTC    '#'
X1FF     DATA     X'1FF'
LCOLON   TEXTC    ' ('
RCOLON   TEXTC    ') '
         PAGE
*
*        IN ORDER TO FACILITATE OVERLAY COMMUNICATIONS - THE FOLLOWING
*        ROUTINE EXISTS ONLY TO FORCE THIS OVERLAY BACK INTO CORE.
*
         DEF      ANLZ1RET
ANLZ1RET EQU      %
         B        0,R1              IMMEDIATE RETURN
         REF      ANLZ1FLG
         END

