 TITLE ' * * * C 0 0   C P - V   A N A L Y Z E  * * *'
         PAGE
UTSPROC  SET      1                 TURN ON THE MONITOR STUFF
MONPROC  SET      0
S69PROC  SET      1
         SYSTEM   UTS
         CLOSE    UNMAP
         CLOSE    MAP
         CLOSE    TSTACK
         CLOSE    PP
         CLOSE    LP
         CLOSE    BUFSIZ
         CLOSE    RSZ
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
R8       EQU      8
R9       EQU      9
R10      EQU      10
R11      EQU      11
R12      EQU      12
R13      EQU      13
R14      EQU      14
R15      EQU      15
*
         CSECT    1
PP       EQU      %               PURE PROCEEDURE
SYMTAB   TEXTC    'RBBAT RECOVERY FILE:'
         DEF      SYMTAB
PARTABMSG TEXTC   'PARTITION TABLES:'
         DEF      PARTABMSG
ATMSG    TEXTC    'ALLOCATION TABLES:'
         DEF      ATMSG
RA:TITE  TEXTC    'READ-AHEAD TABLES:'
         DEF      RA:TITE
SWAPMSG  TEXTC    'SWAPPER TABLES:'
         DEF      SWAPMSG
COCMSG   TEXTC    'COC TABLES:'
         DEF      COCMSG
U2:TITE  TEXTC    'ADDITIONAL USER TABLES:'
         DEF      U2:TITE
USRTMSG  TEXTC    'USER TABLES:'
         DEF      USRTMSG
PROTMSG  TEXTC    'PROCESSOR TABLES:'
         DEF      PROTMSG
TSMSG1   TEXTC    'CONTENTS OF TSTACK:'
         DEF      TSMSG1
TSMSGM   TEXTC    'CONTENTS OF MONITOR TSTACK:'
         DEF      TSMSGM
         DEF      FREEQS
FREEQS   TEXTC    'FREE IOQ ENTRIES:'
         DEF      EHLP:TITLE
EHLP:TITLE TEXTC  'ANALYZE COMMANDS AND OPTIONS:'
         DEF      IODISMSG
IODISMSG TEXTC    'I/O CHANNEL/DEVICE STATES:'
MRMSG    TEXTC    'MONITOR ROOT:'
DCTSMSG  TEXTC    'DEVICE CONTROL TABLES:'
CITSMSG  TEXTC    'CHANNEL INFORMATION TABLE:'                               A00
IOQSMSG  TEXTC    'IOQ TABLES:'
SYMTMSG  TEXTC    'OUTPUT SYMBIONT TABLES:'
TRMSG    TEXTC    'TRAPS/INTERRUPTS:'
USMSG    TEXTC    'USER DCB ANALYSIS:'
         DEF      MRMSG,DCTSMSG,CITSMSG,IOQSMSG,SYMTMSG,TRMSG,USMSG
ELOG%HDG1 TEXTC   'IN CORE ERROR LOG BUFFERS:'
         DEF      ELOG%HDG1
RATMSG   TEXTC    'RESOURCE ALLOCATION TABLES:'
         DEF      RATMSG
AVR%MSG  TEXTC    'VOLUMN TABLES:'
         DEF      AVR%MSG
R:STITLE TEXTC    'RESOURCE WAIT QUEUES:'
         DEF      DCTMSG1
DCTMSG1  TEXTC    'ADDITIONAL DCT TABLES:'
         DEF      R:STITLE
         CSECT    0
DATA     EQU      %               PROGRAM DATA
         BOUND    8
CURADRSS DATA     0,0               RANGE OF ADDRESSES NOW IN CORE
LEGCORAD DATA     0,0
         DEF      CURADRSS,LEGCORAD
ADDEFEND DATA     0                 END OF ALL SYMBOLS
LASTSVTF DATA     0                 LAST EVALUATED SYMBOL ADDRESS
         BOUND    8
LOC0:2K  DATA     1,X'1000'
         DATA     X'1001',X'2000'
         DATA     X'2001',X'3000'
         DATA     X'3001',X'4000'
         DATA     X'4001',X'5000'
         DATA     X'5001',X'6000'
         DATA     X'6001',X'7000'
         DATA     X'7001',X'8000'
         DATA     X'8001',X'8BFF'
         DATA     X'8BFF',X'8E00'
         DATA     X'8E01',X'9001'
*
FIN0:2K  DATA     0,0
         DATA     0,0
         DATA     0,0
         DATA     0,0
         DATA     0,0
         DATA     0,0
         DATA     0,0
         DATA     0,0
         DATA     0,0
         DATA     0,0
         DATA     0,0
         DATA     0,0
         DEF      ADDEFEND,LASTSVTF,LOC0:2K,FIN0:2K
STK:CNT  DATA     X'7A'
CURR:LOC DATA     -1
USER:MODE DATA    -1
REGFLAG  DATA     -1
LAST:LINE DATA    -1
REG:REG  DATA     -1
INST:SAVE DATA    -1
IMONLOC  DATA     -1
PUSH:FLAG DATA    -1
NO:CORE  DATA     -1
         BOUND    8
RANGE    DATA     0,0
         BOUND    8
GHST:STRT DATA    JBUPVPA,CORE-1    USER'S PROCEDURE
TST:LIMS DATA     TSTACK,TSTACK+130 RANGE OF LIKELY TSTACK ADDRESSES
ACT:INST DATA     0,0
         REF      IOSPIN
REGIA    DATA     0,T:REG,IOSPIN+7
#OFREGS  EQU      WA(%)-WA(REGIA)-1
*
PAGEBUF  DATA     0
*
COLPT    DATA     0
#R16     DATA     X'FFFF'
PTR      DATA     0
TYP:BUF  DATA,1   0,64,64,64
         DEF      PAGETABLE
         DEF      CLOSESTADD
         DEF      CLOSESTSYM
         DEF      #OFREGS
         DEF      BMBB,SYMBOL:FLAG
         DEF      PG:MODE
         DEF      OBUF
         REF      USERS
         REF      ADAMDUMP
         DEF      SETR6,#STATES
         DEF      STK:CNT
         DEF      CURR:LOC
         REF      JDDUL
         DEF      USER:MODE
         DEF      REGFLAG
         DEF      LAST:LINE
         DEF      REG:REG
         DEF      INST:SAVE
         DEF      IMONLOC
         DEF      PUSH:FLAG
         DEF      NO:CORE
         DEF      TSIZE
         DEF      RANGE
         DEF      GHST:STRT
         DEF      TST:LIMS
         DEF      ACT:INST
         DEF      REGIA
         REF      ALLYTABL,SWAP
         REF      RA:TABL
         REF      QFREELIST
         REF      DISPSTK,PROCS,ANLZ1RET
         REF      COCODE
         REF      A2RETALT
         DEF      MSG%OUT
         DEF      MTB
         DEF      MB
         DEF      MBB
         DEF      PTR
         DEF      SPACE2
*
*
OBUF     DO1      40
         TEXT     '   '             PRINT BUFFER FOR ALL OF ANALYZE
OBUFSIZ  EQU      %-OBUF
*
         REF      M:SI,M:LO,M:EI,M:EO
         REF      GIVE:HELP
         REF      IODISPLAY
         REF      CORE
         REF      M:SYM
*
*
         DEF      TRANTAB
         DEF      COLPT,INITIAL,PATCH
         DEF      BLANK1
         DEF      LOOKING,USER                                               B00
*
         DEF      MSG,MSG1,BUFOUT,TRANS,TRANSSZ
         DEF      TRAP%SAVE
         DEF      OPCODES
         DEF      BLNKBUF
         DEF      RES:JIT
         DEF      DISP:OFF
         DEF      GRABSYM
         DEF      SPECIFIC%USER%DCBS                                         A00
         DEF      DUMP:DIR,BUFLOC
         DEF      JITBURST
         DEF      NOFILMSG                                                   A00
         DEF      UNMAP
         DEF      GETADDR,SCANNER,GETPAGE,SPACES
         DEF      DUMPSOME,LOCJIT,STACK
         DEF      PAGEBUF         SAM KEYS UPDATE
         DEF      MONFLAG
         DEF      MTBB,DATAFLAG,RCVLIMITS,MON:FLAG
         DEF      ZEROS
         REF      UB:MF,UB:ACP
         DEF      PUSHMSG,TITEL,GETHEX
         DEF      TRUNC%SYM                                                  A00
         REF      %CITS,%DCTS,%IOQS,SYMTABLS                                 A00
         SREF     PB:C#,PB:DC#
         DEF      DATA,PP
*        MONITOR REFERENCES
*
         REF     UH:JIT,UH:AJIT,J:JIT,SMUIS
         REF      DLTSZ,DLTBIAS
         REF      J:START
         REF      SPDBASE,JBUPVPA
         REF      J:AJIT,JOVVPA
         REF      PPROCS,LOW,HIGH
         REF      T:REG
         REF      MAXG              MAX GHOST JOB COUNT
         REF      STXTVAL
         REF      JXCMAP
         REF      MD:SUBQ           IN ANALZO2--RESOURCE WAIT QUEUE--
         REF      DCBLINK
         REF      :BIG              INDICATES BIG MAP MODE SYSTEM
         REF      MING
         REF      1MIN
         REF      SYSVERS           SYSTEM ID SLOT (LIKE X'2B')
         REF      F:SCR
         REF      MONORG
         DEF      SYM:LIMS
         REF      REGIPSD
         REF      M:OC
         REF      UB:PCT,U:MISC,UB:OV,UB:BL,MODE2,JX:CMAP
         REF      MPATCH
         SREF     SNSTS,SBAT,SCOM,JXPPH,JXPPT,JBPPC,TSTACK
         SREF     PTEL
         SREF     PCCI
         REF      SB:HQ,S:CUIS,PX:HPP,P:NAME,PX:TPP,M:FPPH,S:FPPH
         REF      PB:PSZ,PB:DSZ,PB:DCBSZ,PH:PDA,PH:DDA
         REF      PB:UC,PB:LNK,PB:PVA,PB:HVA,P:SA,P:TCB
         REF      M:C
         REF      INIT:MD,MDTRAPS,MDIOSYM,MDDCB,MD:CORE
         SREF     SVALTXT
         REF      MODE4,RAT%TABLES,AVR%TABLES,ERROR%LOG,M:BI                 A00
         REF      F:PAT
         SREF     COC
         SREF     RCVPSD,RCVCODE,TRAPSAVE,TRAPPSD
         REF      RCVSIZE
         REF      MDSNAP4
         SREF     JDCBUL,JXBUFVP
         SREF     JDCBLL,JBUPVP
         DEF      MAP:USER,RES:BUF  FOR OTHER MODULES TO HIT
         SREF     JOVVP
         DEF      JITSTAT
         SREF     RBBREA            OVER IN ANALZO1 MODULE
         SREF     BOOTENT           FIRST LOC IN CP-V BOOTSTRAP
         REF      JAJ
         REF      JAJITVP,JJITVP,JSPVP
         SREF     SITEID            GET SITE ID
         REF      JITLOC
         REF      UH:FLG,UX:JIT,UB:US,UB:APR,UB:APO,UB:ASP,UB:DB,UB:FL
         REF      S:HIR
         SREF     S:SIR
         REF      MX:PPUT
         REF       SAVEREGS
         REF      S:CUN,JCMAP
         REF      SB:NP,SB:PNL,SB:FPN,SB:FPL
         REF      S:SIP
        SREF      S:EVF
         REF      S:ISUN
         SREF     S:IDLF
         REF      SB:OSN
         REF      SB:OSUL
         REF      ARSZ,BUFCNT,COCII,COCIR,COCOC,COCOI,COCOR
         REF      COCTERM,CPI,CPOS,EOMTIME,LB:UN,MODE,RSZ,TL
         REF      LNOL
         REF      RCVRCNT
         REF      DATE,TEMPT                                                 A00
         REF      F:SYMS,F:OSYMS
         REF      M:LL
         REF      SB:GJOBUN,S:GJOBTBL                                        B00
         SREF     RTICBHDR,RESDF
        SREF      PP:UPPH,MP:UPPH
         SREF     S:BADFLG
         SREF     COCFLAG,SAVEREGS1
         SREF     J:ALB
         REF      JBLMAP
         SREF     JB:PRIV
         SREF     J:DELENT
         REF      J:LMN
         REF      M:SWAPD,#SWAP%DEV,LSWAP,MB:SDI
         REF      MB:SFC,MB:#RTRY,M:CLBGN,MH:CLEND
         REF      UH:FLG2,UB:SWAPI,MODE3,S:BECL
*
*        ANLZ REFERENCES FOR B00 OVERLAY
*
         REF      PARTITIONS,SYMBIONTS
*
*
*
BAFCN    EQU      X'1C'             SAME AS SYSTEM UTS
*
*
*
         PAGE
         USECT    PP
*
*                                                                            A00
*           INITIALIZE FLAG 'RUN%MODE' SUCH THAT IT IS                       A00
*        -1 IF RUNNING ON-LINE                                               A00
*         0 IF RUNNING AS A GHOST                                            A00
*        +1 IF RUNNING BATCH                                                 A00
*
*        GJOB:    OPEN LAST RECOVERY DUMP,DISPLAY'ALL'
*        BATCH:   GO TO SCANNER FOR INPUT COMMAND
*        ONLINE:  INIT PROMPTS,GET BRK CONTROL,GO TO SCANNER
*
*
INITIAL  EQU      %
         LI,R1    -1                BEGIN INITIALIZATION OF RUN%MODE         A00
         LC       J:JIT             ACQUIRE ONLINE/GHOST FLAGS               A00
         BCS,8    GOT%MODE          WE'RE ON-LINE                            A00
         BIR,R1   %+1               BUMP R1 TO 0                             A00
         LC       J:JIT             GET C'S AGAIN
         BCR,4    B%MODE            NOT A GHOST
         MTW,1    GJOB%FLAG         KICK GHOST MODE FLAG
         B        GOT%MODE          AND SET OTHER FLAG
B%MODE   BIR,R1   %+1               SET R1 PLUS ONE IF BATCH
GOT%MODE NOP      %                 ALLOW A PATCH HERE
         STW,R1   RUN%MODE          SAVE FOR FUTURE REFERENCE                A00
         CAL1,8   GETTWO
         BCS,8    NODATA:BUF        **DISASTER**
         STW,9    PAGEBUF         WORKING BUFFER
         STW,9    BUFLIM          AND ITS LIMITS
         AWM,R9   ANLZLIMS+1        CREATE MESSAGE CLM PAIR
         AI,9     511
         STW,9    BUFLIM+1
         BAL,R0   UNMAP             INITIATILIZE MY MAP
         CAL1,8   TRPCONTROL        TAKE TRAP CONTROL
         MTW,0    RUN%MODE          ARE WE ON-LINE                           A00
         BLZ      INIT:UC           YES                                      A00
         BAL,1    OPNTOLP           OPEN LO TO LINE PRINTER
         MTW,0    RUN%MODE                                                   A00
         BEZ      LASTCRASH         WE'RE A GHOST                            A00
         B        BAT:MODE          RUNNING IN BATCH
INIT:UC  CAL1,1   PROMPTX           ONLINE SO SET PROMPT CHARACTER
         CAL1,8   BRKFPT          I'M TAKING BRK COMTROL
         BAL,R1   UCLO              SET UP M:LO
GO:ANLZ  LI,R1    ANLZMSG           SALUTATION MESSAGE
         BAL,0    MSG
         BAL,0    BUFOUT
         B        SCANNER           START SCANNING...
         PAGE
*
*
NODATA:BUF LI,R1  DATAB:MSG
         BAL,R0   MSG%OUT
         CAL1,9   1                 AND EXIT CAUSE WE'RE IN BAD SHAPE
DATAB:MSG TEXTC 'CAN''T GET DUMP INPUT BUFFERS'
*
*
ANLZMSG  TEXTC    'ANALYZE HERE'                                             A00
         USECT    DATA
         DEF      RUN%MODE                                                   A00
         DEF      BIGBUF,STKSIZE,KEY,MAPFLAG                                 A00
RUN%MODE DATA     'IBAD'            -1=ONLINE,0=GHOST,+1=BATCH               A00
HDMSG    TEXTC    '   TIME OF DAY XXXX        SITE ID:',;
                  'ELSEG CC',;
                  '    VERSION:',;
                  '    ',;
                 '   FILE#     PAGE#'  FILE#
MO%TBL   EQU      %-1                                                        A00
         DATA,4   ' JAN',' FEB',' MAR',' APR',' MAY',' JUN',;                A00
                  ' JUL',' AUG',' SEP',' OCT',' NOV',' DEC'                  A00
SITELOC  EQU      HDMSG+9           LOCATION OF SITE
VERSLOT  EQU      HDMSG+14
GJOB%FLAG  DATA   0                 WE SET TO 1 IF A GJOB TYPE GHOST         A00
MDP%ECB    DATA   0                                                          A00
CURR%STATE DATA   0                 USED BY USER STATE DISPLAY               A00
MDP%REPLY  DATA   0                 SHORT KEYIN REPLY BUFFER                 A00
MDP%MSG TEXTC 'ANLZ: ENTER COMMAND, N/L SAYS TO DO ALL < '
         USECT    PP                                                         A00
         PAGE
*
*        INPUT (;V),(T),(#),((CR)),(L) WIL L GO TO
*        THE ROUTINES TO HANDLE ;V TAPES, LABEL TAPE, SPECIFIED CRASH
*        THE LAST TAPE INPUT, OR THE LAST CRASH RESPECTIVLY
*        AND WILL EXIT WITH M:EI OPEN TO COME FILE FOR INPUT
*
INPUT    EQU      %
         BAL,0    CLOSEIT           INSURE M:EI IS CLOSED
         BAL,R0   RES:BUF           RESTORE THE BUFFERS
         LH,R1    FIELD2            GET OPTION
         LI,R2    #INPUTS           MAX LOOP
         CH,R1    INPUTS,R2         FIND
         BE       INP:VEC,R2        A MATCH
         BDR,R2   %-2
INP:VEC  B        SPECFIL           ASSUME SPECIFIED MONDUMP #
         DO1      2
         B        TYP:SPEC          SPECIFIED LABEL TAPE TYPE
         B        LABEL%TAPE        GO FIND OUT THE TYPE
         B        NOT%GJOB          GET IN AT THAT POINT
         B        OPNUTSD           CP5DUMP FILE
INPUTS   DATA,2   '  '
         DATA,2   '9T'
         DATA,2   'BT'
         DATA,2   'TA'
         DATA,2   'LA'
         DATA,2   'CP'
#INPUTS  EQU      HA(%)-HA(INPUTS)-1
         BOUND    4
*
*        TAKE TYPE SPECIFIED AND SHOVE INTO OPEN FPT
*
TYP:SPEC AND,R1   #R16              DROP SIGN EXTENSION
         STW,R1   TAPE:TYP          AND PUT IT IN OPEN FPT
         B        LABEL%TAPE        GO TRY AND USE IT....
         PAGE
*
*        RUNNING IN BATCH ALL PROCESSORS HAVE THE
*        OBLIGATION TO READ ONE BANG CARD THRU THE
*        M:C DCB, HERES WHERE ANALYZE DOES IT.
*
BAT:MODE EQU      %
         CAL1,1   READCDEV          READ THAT STUPID BANG CARD
         LB,1     UCBUF             GET FIRST BYTE OF COMMAND
         CI,1     X'40'             RUNNING VIA 'RUN' LMN...
         BNE      SCANEP            NOPE,START OFF
         B        SCANNER
         PAGE
*
*        IF WE GET HERE - ANALYZE HAS TRAPPED
*
TRAPPED  EQU      %
         LW,R5    TRAP:RET          PSW0 TO RETURN TO....
         XW,R5    0,R1              TELL CP-V WHERE TO GO TO.
         STW,R1   TR:SNAP1          STORE LOWER SNAP LIMIT
         AI,R1    22                CREATE UPPER
         STW,R1   TR:SNAP2          AND STORE UPPER LIMIT FOR SNAP
         BAL,R10  TRSNAP            TAKE THAT SNAP
         LI,R1    STACK
         STW,R1   TR:SNAP1          LOWER PART OF STACK
         AI,R1    82                TO HIGHEST
         STW,R1   TR:SNAP2          PART
         BAL,R10  TRSNAP            SNAP THE STACK
         CAL1,9   5                 RETURN TO THE SCANNER
*
         USECT    DATA
TRSNAP   CAL1,3   TR:SNAP           SNAP INTENDED AREA
TR:SNAP  GEN,32   0
TR:SNAP1 DATA     0
TR:SNAP2 DATA     0                 UPPER/LOWER SNAP LIMITS
         TEXT     'TRAPPED'
         NOP
         B        *R10              RETURN TO CALLER
         USECT    PP                BACK TO PROCEDURE
TRAP:RET GEN,8,4,20   0,12,SCANNER
         PAGE
*
*        OPEN THE NAMED CRASH FILE (IE; MONDUMP(1)..(2)
*        ET CETERA...
*
*
SPECFIL  EQU      %
         LI,1     1
         BAL,0    GETHEX
         CLM,2    NUMERAL
         BCS,9    BADCOM          NOT A NUMBER
         LB,1     LIST,2
         STB,1    HDMSG+17          PUT # IN LO HEADER
         LI,2     7
         STB,1    PATNAME,2
         MTW,0    FIELD3            WAS ACCN# SPECIFIED
         BEZ      SPECFIL1          DEFAULT ACCOUNT NUMBER
         LD,2     BLANKS
         STD,2    PATACN            IT OUT
         LI,2     BA(FIELD3)        SET
         LI,3     BA(PATACN)        UP
         LW,4     FIELD3C           MOVE
         STB,4    3                 OF
         MBS,2    0                 ACCOUNT#
         B        CRASH1            AND OPEN FILE
SPECFIL1 EQU      %
         LD,R2    ACCOUNT           SET :SYS
         STD,R2   PATACN            AS ACCOUNT NUMBER IN FPT
         B        CRASH1
         PAGE
*
*        OPENS TO UTSDUMP
*
OPNUTSD  EQU      %
         BAL,R0   RESETM            TURN OFF MONITOR DISPLAY MODE
         CAL1,1   OPNFPT
         CAL1,1   SETEI           CHANE THE ERR/ABN
         BAL,0    GETHIGH
         B        SCANNER
         PAGE
FREEIT   GEN,1,7,24  1,5,9
GETIT    GEN,1,7,24  1,4,9
*
*
*        OPENS M:EI TO LAST RECOVERY FILE
*
LASTCRASH EQU     %
         LI,R1    X'F'              USER NUMBER MASK
         AND,R1   J:JIT             GET MY USER NUMBER
         CI,R1    MING+1            STARTED BY GHOST1
         BE       NOT%GJOB          YEP, FORGET ASKING OPERATOR
         MTW,0    GJOB%FLAG                                                  A00
         BEZ      NOT%GJOB                                                   A00
ASK%OPR  LI,R1    MDP%MSG           MESSAGE TO BE SENT
         BAL,R0   KEYINMSG          SEND MSG/WAIT FOR REPLY
         LI,R3    1                                                          A00
         CB,R3    MDP%REPLY         ONE CHAR IS A CR - THEN DEFAULT          A00
         BE       NOT%GJOB          DO LAST MONDMP                           A00
         LB,R3    MDP%REPLY,R3      GET 1ST & ONLY DATA CHAR                 A00
         AND,R3   L(X'FF')                                                   A00
         CI,R3    'N'               WANTS ANALYZE TO EXIT
         BE       EXIT              YEP, HONOR IT
         CI,R3    'H'               WANTS AN INTERACTIVE GHOST
         BE       INT:GHOST         YEP, DO IT THAT WAY
         CI,R3    'M'               HONOR 'ME' TOO
         BE       INT:GHOST         FOR BENEFIT OF OUR GROUP
         CI,R3    '?'               QUESTION MARK
         BNE      NO:QFORHLP        NOPE
         BAL,R0   GIVE:HELP         BUILD PRINT LINES OF COMMANDS
         BAL,R0   PRINT             PRINT IT OUT FOR HIM
         B        ASK%OPR           NOW LOOP BACK AND ASK HIM AGAIN
NO:QFORHLP EQU    %
         CI,R3    'T'               DIS IT A DUMP TAPE                       A00
         BE       LABEL%TAPE        YES                                      A00
         CI,R3    'C'               IS IT FILE 'CP5DUMP'                     A00
         BE       OPNUTSD           YES                                      A00
         CI,R3    X'F0'             X'F0' THRU X'F7' ARE THE ONLY LEGALS     A00
         BL       ASK%OPR                                                    A00
         CI,R3    X'F7'                                                      A00
         BG       ASK%OPR                                                    A00
         B        STORE%#           USE THIS MONDMP #                        A00
NOT%GJOB EQU      %                                                          A00
         LI,R14   RCVRCNT           LOCATION OF CRASH COUNTER
         BAL,R0   GETADDR           PICK IT UP
         LI,R3    7                 MASK TO EXTRACT
         LS,R3    *R15              COUNT
         BAL,R0   RESETM            TURN OFF MONITOR DISPLAY MODE
         LB,3     LIST,3
STORE%#  EQU      %                                                          A00
         STB,3    HDMSG+17          PUT DUMP# IN HEADER
         STB,3    GHMSG+5
         LI,2     7
         STB,3    PATNAME,2       STORE CORRECT EBCDIC INTO FILE NAME
         BAL,R0   RES:BUF           RESTORE THE BUFFERS
*
*        OPENS M:EI TO SPECIVIED FILE
*
CRASH1   EQU      %
         CAL1,1   OPNPFIL         OPEN PAT'S FILE
         CAL1,1   SETEI
         BAL,R0   GETHIGH           GET CORE LIMITS
         MTW,0    RUN%MODE                                                   A00
         BNEZ     SCANNER           NOT A GHOST                              A00
         LI,R1    GHMSG             GHOST FINISHED MSG
         BAL,R0   TYP:MSG           TYPE IT OUT
         B        ALL               DO ALL WHEN A GHOST
         PAGE
*
*        RESET MONITOR DISPLAY MODE (DEFAULT RUN MODE)
*
RESETM   EQU      %
         LD,R10   ZEROS
         STD,R10  MONFLAG           CLEAR FLAG
         B        *R0               AND RETURN
         PAGE
*
*        COULD NOT OPEN THE FILE THE USER POINTED ME TO
*
NOFIL    EQU      %
         LI,1     CANTMSG
         BAL,0    MSG             TELL THE USER I CAN'T OPEN THE FILE
         LI,1     X'1FFFF'
         AI,8     -1
         LS,1     *8              GET THE ADDRESS OF THE FPT
         AI,1     9               AND THE FILE NAME IN IT
         BAL,0    MSG
         BAL,0    BUFOUT
         MTW,0    RUN%MODE                                                   A00
         BLZ      SCANNER           ON-LINE                                  A00
         BGZ      ERRET             BATCH                                    A00
         LI,3     X'FF'             MUST BE A GHOST
         LS,R3    KEY               BEEN HERE BEFORE
         BNEZ     EXIT              YES, QUIT                                A00
         MTW,0    GJOB%FLAG                                                  A00
         BNEZ     EXIT                                                       A00
         B        LABEL%TAPE                                                 A00
*
*
*
CANTMSG  TEXTC    'CANNOT OPEN FILE '
                  PAGE
*
*                 USERS PRIVILEGE ISNT HIGH ENUFF
*
NOGOT    EQU      %
         LB,3     JB:PRIV           GET HIS PRIV
         BAL,0    TRANSSZ           PUT INTO PRINT LINE
         LI,1     NOGOTMSG          NOW SHOVE
         B        PUSHMSG           MSG INTO PRINTLINE
NOGOTMSG TEXTC    ' PRIVILEGE IS NOT HIGH ENOUGH'
         PAGE                                                                A00
*                                                                            A00
*SUBROUTINE TO PUT TIME OF CRASH IN HEADING                                  A00
*                                                                            A00
FIX%TIME EQU      %                                                          A00
         PSW,R0   STACK                                                      A00
         LI,R14   TEMPT             PTR TO TIME OF DUMP                      A00
         BAL,R0   GETADDR                                                    A00
         LW,R2    *R15                                                       A00
         AI,R15   1                                                          A00
         LW,R3    *R15                                                       A00
         SLD,R2   8                                                          A00
         STW,R2   HDMSG+1           STORE 'HH:M'                             A00
         SLD,R2   8                 NOW (R2)='...M'                          A00
         STB,R2   HDMSG+2           STORE LAST BYTE OF MINUTE
         LI,R2    1
         LI,R5    '.'
         STB,R5   HDMSG+2,R2        STORE DOT
         LI,R14   1MIN
         BAL,R0   GETADDR           GET # 1.2 SECONDS LEFT IN MINUTE
         LI,R5    60                COUNT IS IN 1.2 INCREMENTS
         SW,R5    *R15              GET SECONDS INTO MINUTE
         AND,R5   =X'3F'            MODULO 50
         LI,R1    BA(HDMSG)         LOC
         AI,R1    11                ASSUME TWO DIGITS
         CI,R5    10                CORRECT
         BGE      %+2               YES
         AI,R1    -1                NO
         BAL,R0   DECIMAL           INSERT
         LI,R2    ' '
         LI,R14   DATE              PTR TO DAY OF YEAR                       A00
         BAL,R0   GETADDR                                                    A00
         LB,R3    *R15                                                       A00
         AND,R3   L(X'0F')                                                   A00
         MI,R3    10                                                         A00
         LI,R4    1                                                          A00
         LB,R5    *R15,R4                                                    A00
         AND,R5   L(X'0F')                                                   A00
         AW,R3    R5                (R3)=MONTH AS HEX INTEGER                A00
         LW,R3    MO%TBL,R3         (R3)= ' MMM' - MONTH IN EBCDIC           A00
         SLD,R2   24                                                         A00
         STW,R2   HDMSG+3           STORE 'MO DADA'
         AW,R3    L(X'400000')      (R3)='M ..'                              A00
         LH,R2    *R15,R4                                                    A00
         AND,R2   #R16                                                       A00
         AW,R3    R2                                                         A00
         STW,R3   HDMSG+4           STORE
         LW,R2    L(','''**16)                                               A00
         AI,R15   1                                                          A00
         LH,R3    *R15,R4                                                    A00
         AND,R3   #R16                                                       A00
         AW,R2    R3                                                         A00
         STW,R2   HDMSG+5
         PLW,R0   STACK                                                      A00
         B        *R0               RETURN                                   A00
         PAGE
*
*        BUILDS 'UTSDUMP FROM LABEL TAPE BUILT BY RECOVER
*
LABEL%TAPE EQU    %
         BAL,0    CLOSEIT           INSURE M:EI IS CLOSED
         MTW,0    TAPE:TYP          ONE ALREADY SET
         BNEZ     TYP:SET           YESP, USE IT
         LI,R1    TAPE:MSG          HAVE TO FIND OUT
         LC       J:JIT             WHAT MODE
         BCS,8    ASK:ONLINE        ONLINE GOES AHEAD
         BAL,R0   TYP:MSG           BATCH/GHOST ASK AT M:OC DEVICE
         B        READ:REPLY        GO READ IT
ASK:ONLINE BAL,R0 MSG
         BAL,R0   BUFOUT
READ:REPLY EQU    %
         BAL,R1   READ:REC
         LH,R1    UCBUF
         AND,R1   #R16
         STW,R1   TAPE:TYP          HIS PROBLEM IF I CANNOT USE THIS
TYP:SET  EQU      %
         BAL,R0   RESETM            TURN OFF MONITOR DISPLAY MODE
         CAL1,1   OPNLT             OPEN THE TAPE UP
         CAL1,1   OPEN:CPV          OPEN UP THE OUTPUT FILE
         LW,1     KEEPKEY         RESTORE THE KEY
         STW,1    KEY
READLT   EQU      %
         CAL1,1   READBI            READ A PAGE FROM TAPE                    A00
         CAL1,1   WRITE:CP          WRITE A RECORD
         MTW,1    KEY             BUMP THE KEY
         B        READLT          AND CONTINUE...EXIT THRU ABN READ
         PAGE
*
*        EXIT ON ERR/ABN RETURN
*
ERRABN   EQU      %
         LI,R0    0                 ERASE
         STW,R0   TAPE:TYP          CELL
        LW,3      Y002            DONT CLOSE IT IF ITS CLOSED
         CW,R3    M:BI                                                       A00
         BAZ      %+2                                                        A00
         CAL1,1   CLOSE:BIREL       CLOSE IT
        CW,3      M:EO
        BAZ       %+2
         CAL1,1   CLOSE:EOSAVE      CLOSE THAT ONE TOO
         LB,3     10
         CI,R3    6                 EOD
         BE       TAPE:END          YEP
         CI,R3    5                 EOF
         BE       TAPE:END
         LI,R2    SCANNER           WE DONT HANDLE ANY OTHERS
         B        RERR1             PRINT ERR/ABN MSG
TAPE:END LW,R3    KEEPKEY           ALL DONE WITH TAPE
         XW,3     KEY
         SW,3     KEY
         AI,3     -1
         MTW,1    TAP%DMP           SET TAPE DUMP MODE FLAG
        LI,1      LSTPGMSG        TELL HIM THE LAST PAGE NUMBER
         BAL,0    MSG
         BAL,0    TRANSSZ         AND TRANSLATE THE NUMBER
         BAL,0    BUFOUT
         CAL1,1   OPNFPT          OPEN THE FILE FOR INPUT
         CAL1,1   SETEI
         BAL,R0   GETHIGH           GET CORE LIMITS
         MTW,0    RUN%MODE                                                   A00
         BEZ      ALL               GHOSTS DO 'ALL' EVERY TIME               A00
         B        SCANNER           ONLINE/BATCH GO ASK FOR COMMANDS
*
*
LSTPGMSG TEXTC    'THE LAST PHYSICAL PAGE IN THE FILE IS '
        PAGE
*
*  THIS ROUTINE OBTAINS THE XPSD INSTRUCTIONS FOR TRAP LOCATIONS
*  40 AND 46 WHICH HAVE BEEN SAVED BY RECOVERY AT THE DOUBLEWORD
*  DEF'D AS 'TRAPSAVE'.  THESE XPSDS ARE SAVED IN THE DYNAMIC DATA
*  AREA AND WHENEVER PAGE 0 IS READ IN ITS IMAGE IN THE BUFFER AREA
*  IS UPDATED.  (SEE THE ROUTINE 'RESTORE%TRAPS%40%46')
OBTAIN%40%46 EQU    %
         LCI      3                 SAVE REGS
         PSM,R14  STACK              14 THRU 0
         LW,R14   TRAP%SAVE         GET ADDR OF SAVED XPSDS
         BEZ      SKIP%40%46%STUFF  NOT AT LEAST A00 CP-V
         BAL,R0   GETADDR
         LD,R14   *15               GET BOTH XPSDS IN 14 AND 15
         STD,R14  TRAP%40%46        SAVE BOTH IN DATA AREA
         LW,R14   TRAP%SAVE         GET MONITOR SAVE ADDR AND
         CI,R14   512                SEE IF IN PAGE 0
         BGE      NOT%PAGE%0        IF NOT, CONTINUE
         BAL,R0   RESTORE%TRAPS%40%46  ELSE,RESTORE IN BUFFER IMAGE
NOT%PAGE%0  EQU   %
SKIP%40%46%STUFF  EQU  %
         LCI      3                 RESTORE REGS
         PLM,R14  STACK              14 THRU 0
         B        *R0               RETURN TO CALLER
*******************************************************************
*      DATA AREA
         USECT    DATA
         BOUND    8
TRAP%40%46,TRAP%40 DATA    0
TRAP%46  DATA     0
TRAP%SAVE  DATA   TRAPSAVE          'TRAPSAVE' MUST BE SREF'D FOR CODE TO WORK
         USECT    PP
         PAGE
*
*  ROUTINE TO PICK UP SAVED XPSDS FOR TRAPS 40 AND 46
*  FROM THE DYNAMIC DATA AREA AND RESTORE THEM IN PAGE
*  0'S IMAGE IN THE BUFFER AREA
*
RESTORE%TRAPS%40%46 EQU  %
         LCI      3                 SAVE REGS
         PSM,R1   STACK             1,2,AND 3
         LD,R2    TRAP%40%46        GET THE XPSDS
         BEZ      DONT%RESTORE%40%46   THEY WEREN'T SAVED
         LI,R1    X'40'
         STW,R2   *PAGEBUF,R1       RESTORE 40
         LI,R1    X'46'
         STW,R3   *PAGEBUF,R1       RESTORE 46
DONT%RESTORE%40%46  EQU  %
         LCI      3                 RESTORE REGS
         PLM,R1   STACK              1,2, AND 3
         B        *R0               RETURN
         PAGE
*
*        CREATE SYMBOL MAP. DEFAULT INPUT IS
*        'MONSTK.:SYS' BUT U CAN GET ANY OTHER FILE
*        BY SAYING 'SYM FILENAME.ACCOUNT.PASSWORD',ETC...
*
DO%SYMBOLS  EQU   %                                                          A00
         PSW,R0   STACK             SAVE RETURN                              A00
         BAL,R0   SYMBOLMAP                                                  A00
         BAL,R0   SYM:DISP                                                   A00
         PLW,R0   STACK                                                      A00
         B        *R0                                                        A00
SYMBOLMAP  EQU    %                                                          A00
         MTW,0    FIELD2            WAS THER E A FIELD # 2
         BNEZ     SYMBOLMAP1        YES - JUMP
         MTW,0    SYMBOL:FLAG       ALREADY DONE IT
         BNEZ     *R0               YEP
SYMBOLMAP1 PSW,R0 STACK             SAVE RETURN LINK
         MTW,0    BIGBUF            GOT A BUFFER                             A00
         BNEZ     GOT%BUF           YES                                      A00
         CAL1,8   GPGS              NO,GET ONE                               A00
         BCS,8    NO%SYM%BUF        CAN'T                                    A00
         AWM,R8   FPGS              UPDATE FREE PAGE COUNTER
         STW,R9   BIGBUF                                                     A00
GOT%BUF  EQU      %                                                          A00
         BAL,0    FILENAME          GET FILE NAME FOR SYMBOLS
         MTW,0    FILETEXT          ANY FILE NAME
         BEZ      CHK:FILE          DEFAULT - CHECK IF FILE THERE
         LCI      3                 GET
         LM,0     FILETEXT          AND
         STM,0    SYM:FIL           PUT INTO PLACE
SMAP1    MTW,0    ACCOUNT           ANY ACCOUNT
         BEZ      SMAP2             NOPE
         LCI      2                 GET
         LM,0     ACCOUNT           AND
         STM,0    SYM:ACN           PUT INTO PLACE
SMAP2    MTW,0    PASS              ANY PASSWORD
         BEZ      SMAP3             NOPE
         LCI      2                 GET
         LM,0     PASS              AND
         STM,0    SYM:PAS           PUT INTO PLACE
         B        SMAP4             GO ON
*
CHK:FILE LI,R1    0                 INITIALIZE
         STW,R1   WRITCNT           BYTE COUNT OF SYMBOLS
         CAL1,1   OPEN:SYMS         TRY TO OPEN SPECIAL FILE
READ:SFIL CAL1,1  READ:SYMS         READ THE RECORD IN
         LW,R6    F:SYMS+13         GET BYTE COUNT
         STW,R6   WRITCNT           SAVE COUNT TO WRITE OUT
         AI,R6    3
         SLS,R6   -2                INTO WORD COUNT
         STW,R6   STKSIZE           LEAVE WORD COUNT SET UP
         AW,R6    BIGBUF            R6 = TOTAL SPACE IN TABLE
         CAL1,1   CLOSE:SYMS        CLOSE THE FILE UP
         B        SYMS:END          JUMP
SMAP3    LI,1     1                 IF NO PASSWORD
         MTB,1    SYM:ACN-1,1       SET NONE FLAG
SMAP4    CAL1,1   OPNSTK            OPEN NAMED FILE
         LB,1     SYM:FIL           GET TEXTC COUNT
         AI,1     1                 STEP IT
         LI,0     0                 SET UP
         STB,0    SYM:FIL,1         TEXTC KEY
         STB,1    SYM:FIL           FOR READING FILE SYMBOLS
STKRD    CAL1,1   RDSTK             READ MONSTACK
         LW,0     M:SYM+13
         SLS,0    -2
         STW,0    STKSIZE           STORE IT AWAY
         LI,0     0                 POSITION IS STACK
         STW,0    SYMCNT            RESET SYMBOL COUNT
         LI,4     0                 POSITION IN BUFFER
         LW,6     BIGBUF            INITIALIZATION FOR SORT
STKLOOP  LI,9     0                 RESET ABS FLAG
         LW,1     0                 NEXT INDEX TO R1
         LW,2     *BIGBUF,1         FIRST WORD IN ENTRY
         LB,3     2                 SIZR IN WORDS
         CW,R2    SYMASK            CHECK FOR CSECT DEF
         BAZ      NOCSECT           NOPE
         CW,R2    TYP1CSECT         IS IT ONE OF THESE
         BANZ     SINCR1            YEP - THROW IT AWAY
         CW,R2    TYP4CSECT         SELECT FIRST TYPE
         BANZ     CSECTENT          OKAY TO USE
         CW,R2    TYP2CSECT         SELECT OTHER TYPE
         BAZ      SINCR1            SKIP IT
CSECTENT EQU      %
         MTW,1    CSECTFLAG         BUMP THE FLAG
NOCSECT  EQU      %
         CI,R3    4                 IS THIS A USABLE DEF ENTRY
         BL       SINCR1            NOPE - GO TO NEXT ONE
         AI,1     1
         LW,10    *BIGBUF,1         GET THE VALUE
         AI,1     1
         LW,7     *BIGBUF,1         GET THE VALUE
         BLEZ     ABSENTRY          SET ABS FLAG
         LI,5     3                 FOR BDR
         LB,11    7,5               GET THE BYTE
         BNEZ     %+2               FOUND IT
         BDR,5    %-2               GET NEXT
         EXU      SYMSHIFT,5        CORRECT TO WORD RES
         B        WORDRES           CONTINUE
*                                                                            A00
NO%SYM%BUF  EQU   %                                                          A00
         LI,R1    NOSYMBUFMSG                                                A00
         B        SYM:DISP6                                                  A00
*
SYMSHIFT SLS,10   -2
         SLS,10   -1
         B        WORDRES
         SLS,10   1
ABSENTRY LI,9     -1                SET ABS FLAG
WORDRES  EQU      %
         AI,1     1
         CW,R10   LASTEVAL          SAME VALUE AS LAST TIME
         BE       SINCR1            YES - DELETE DUPES
         STW,R10  LASTEVAL          MAKE IT THE CURRENT VALUE
         PAGE
*
*        THE DEF BUFFER WILL BE SORTED INTO NUMERICAL
*        ORDER IN THE FOLLOWING FORMAT:
*
*        WORD0:   DEF VALUE
*        WORD1:   SYMBOL IN
*        WORD2:   TEXTC FORMAT
*
         LCI      3
         LM,13    *BIGBUF,1         PICK UP THE SYMBOL
         LB,12    13                GET TEXTC COUNT
         CI,12    7                 WILL FIT NORMAL
         BLE      %+2               YEP
         LI,R12   X'87'   NO,TRUNC TO 7 BUT SET HI BIT TO SAY SO             A00
         AI,R9    0                 IS THIS A LIBRARY DEFINITION
         BEZ      NOTLIBE           NOPE
         OR,R12   =X'40'            YES - POST THE FLAG
         B        ENTERFLAG         AND JUMP
NOTLIBE  EQU      %
         MTW,0    CSECTFLAG         IS THIS A MODULE BASE DEFINITION
         BEZ      ENTERFLAG         NOPE
         OR,R12   =X'20'            YES - ENTER FLAG
ENTERFLAG EQU     %
         STB,R12  R13               PUT AWAY FLAGS AND BYTE COUNT
         AI,1     3         BUMP THE POINTER INTO BIGBUF
         LW,12    10                PICK UP ITS VALUE FROM 10
         LI,R4    -3
         LW,7     6                 SAVE 6 IN 7
         CW,7     BIGBUF            IS IT THE FIRST TIME
         BE       NOMOVE            YES, STORE THESE FOUR
MOVELOOP EQU      %
         LW,8     *6,4              PICK UP THE PREVIOUS VALUE
         CW,8     12       IS IT LESS THAN THIS ONE
         BL       NOMOVE            YES, RIGHT ORDER
         LCFI     3
         LM,8     *6,4              PICK UP VALUE AND SYMBOL
         STM,8    *6                INTO THE NEXT LOCATIONS
         AI,R6    -3
         CW,6     BIGBUF            TOP OF LIST?
         BNE      MOVELOOP          NO, TRY NEXT
NOMOVE   EQU      %
         LCFI     3
         STM,12   *6
         LW,6     7
         AI,R6    3
         LI,R9    0                 NOW ERASE THE CSECT FLAG
         STW,R9   CSECTFLAG         CAUSE WE'VE HANDLED IT NOW
         MTW,1    SYMCNT            COUNT OF SYMBOLS
SINCR1   EQU      %
         AW,0     3
         CW,0     STKSIZE           FINISHED
         BL       STKLOOP           NO, CONTINUE
         AI,R6    -3                AT END - POINT TO LAST ENTRY
SYMS:END EQU      %
         LW,R4    BIGBUF            BASE ADDRS OF TABLE
         AW,R4    STKSIZE           R4 = TOP ADDRS IN TABLE
         STW,R6   SORTALBE          SAVE SHELL SORT TABLE ADDRS
         SW,R6    BIGBUF            CALCULATE # OF WORDS IN SYM TABLE
         STW,R6   STKSIZE           REMEMBER IT
         LW,R5    R6                MOVE FOR ARITHMETIC
         DW,R5    =3                CALCULATE # OF STYMBOL ENTRIES
         STW,R5   SYMCNT            AND REMEMBER IT
         SW,R4    SORTALBE          CALCULATTE ROOM REMAINING
         BGZ      %+2               OKAY VALUE
         LW,R4    R5                NOT OKAY - ADJUST
         CW,R4    SYMCNT            ENUFF TO SHELL SORT ENTRIES
         BG       SCOUNT4           YEP - DONT NEED ANY MORE PAGES
         AI,R4    512               ROUND UP TO NEXT FULL PAGE
         SLS,R4   -9                # OF PAGES NEEDED
         LI,R1    1
         STH,R4   GPGS,R1           STORE PAGE COUNT AWAY
         CAL1,8   GPGS              ASK FOR PAGES
         STCF     R7                SAVE CCS
         AWM,R8   FPGS              UPDATE FREE PAGE COUNTER
         LC       R7                CHECK ANSWER
         BCS,8    SYM:DISP5         CANT SORT
SCOUNT4  LW,R2    STKSIZE           GET # OF WORDS
         SLS,R2   2                 TO BYTES
         STW,R2   WRITCNT           SAVE IT
         MTW,7    SYMBOL:FLAG       SAVE FLAG
         BAL,R1   INIT:MD           START UP MONDUMP
         LI,R0    0
         XW,R0    WRITESYMS         SUPPOSED TO WRITE
         BEZ      SCOUNT5
         CAL1,1   OPOUT:SYMS
         CAL1,1   WRIT:SYMS
         CAL1,1   CLOSE:SYMS1
SCOUNT5  PLW,R0   STACK             GET EXIT ADDRESS
         B        *R0                                                        A00
         PAGE
*
*        GOT AN ERROR WRITING OUT THE SYMBOL TABLE SAVE FILE
*
WRSYMS   BAL,R2   RERR1
         LI,R1    WRITERR
         B        PUSHMSG
WRITERR  TEXTC    'WRITING OUT THE SYMBOL TABLE'
         PAGE
*
*        GOT AN ERROR READING THE SYMBOL FILE
*
*
NOSYMBOLS EQU     %
         LB,R2    10                GET I/O ERROR CODE
         CI,R2    X'07'             LOSE DATA
         BE       GETSYMPAGE        YEP
         CI,R2    X'03'             DOESNT EXIST
         BE       SYMBOLFIL         IF IT DOESNT EXITST
         CI,R2    X'14'             TROUBLE W/IT..
         BE       SMAP3             YEP - FORGET IT
         BAL,R2   RERR1
         LI,R1    RDSYMSMSG
         B        PUSHMSG
RDSYMSMSG TEXTC 'READING/OPENING THE SYMBOL TABLE FILE'
         PAGE
*
*        GET ANOTHER PAGE TO READ THE SYMBOL FILE
*
GETSYMPAGE CAL1,8  GETONE
         BCS,8    NOMORPAGE
         CAL1,1   POS:BOF           BACK UP TO BEGINNING OF FILE
         LI,1     512*4
         AWM,1    RDSIZE
         MTW,1    FPGS              BUMP FREE PAGE COUNT
         B        READ:SFIL         READ IT AGAIN
NOMORPAGE LI,R1   PGSMSG
         B        PUSHMSG
PGSMSG TEXTC  'NOT ENUFF PAGES TO READ SYMBOL TABLE FILE'
         PAGE
*
*        IF FILE WASNT THERE - SAVE IT IF IN GHOST MODE
*
*
SYMBOLFIL LC      J:JIT             RUNNING AS A GHOST
          BCR,4   SMAP3             NO - FORGET IT
          MTW,1   WRITESYMS         YES - SET FLAG
          B       SMAP3             AND GO READ MONSTK...
         PAGE
*
*        SYMBOL TABLE IS COMPLETED,NOW TRY TO
*        OBTAIN AN AREA TO SORT SYMBOLS ALPHA-NUMERICLY
*
SYM:DISP EQU      %
         PSW,R0   STACK                                                      A00
         BAL,R0   SEGMAP            PUT OUT THE SEGMENT MAP
         LI,R1    SYMBOLMS                                                   A00
         BAL,R0   TITEL             TITLE LINE                               A00
         LI,R1    SYM%EXP           SYMBOL FLAG CODES FOR USER               A00
         BAL,R0   MSG%OUT
         LI,1     2                 TWO PASS DISPLAY
         STW,1    SYM:PASS          SET FOR LOOP
         LI,R1    0
         LW,R2    SYMCNT            # OF ENTRIES
         LW,R9    SORTALBE          ADDRESS OF SORT BUFFER
         BLEZ     SYM:DISP5         SOMEBODY BLEW IT
         LW,3     BIGBUF            LOCATION OF SYMBOL TABLE
         BLEZ     SYM:DISP5         NONE OR ERROR
         AI,3     1                 POINT TO FIRST SYMBOL
         PSW,2    STACK             SAVE VALUE FOR LATER
SYM:DISP1 STW,3   *9,1              SET INTO TABLE
         AI,R3    3
         AI,1     1                 UP INDEX
         BDR,2    SYM:DISP1         FINISH BUILDING TABLE
         LW,8     9                 FIRST KEY ADDRS
         STW,9    SORTALBE          SAVE TABLE ADDRS
         LW,9     SYMCNT            PUT COUNT INTO 9 ALSO
         BAL,15   SORTER            GO SORT TABLE
         LW,4     SORTALBE          SET UP DISPLAY LOOP
SYM:DISP2 LI,7    0                 INITIAL INDEX
SYM:DISP3 LW,5    *4                GET NEXT KEY POINTER
         AI,5     -1                POINT TO VALUE
         LW,3     0,5               GET VALUE
         BAL,0    TRANSSZ           AND PUT IT OUT
         LB,1     SYMSPACES,7       GET RIGHT SPACING
         BAL,0    SPACES
         AI,7     1                 BUMP COLUMN COUNT
         AI,5     1                 POINT BACK TO SYMBOL
         LI,1     ABSMSG            ASSUME ITS ABS DEF
         LC       *R5               TEST FLAG FOR ABS DEFINITION
         BCS,4    %+2               ITS ABS ALRIGHT...
         LI,1     SPCMSG            IT IS NOT ABS DEF
         BAL,0    MSG               IS ABS
         LW,1     5                 SET UP REGISTER
         BAL,0    MSG               INSERT STRING
         LB,1     SYMSPACES,7       GO TO NEXT COLUMN
         BAL,0    SPACES
         MTW,-1   SYMCNT            DECREMENT COUNT
         BLEZ     SYM:DISP4         DONE
         AI,4     1                 NOPE,NEXT POINTER
         AI,7     1                 NEXT POSITION IN ROW
         LI,8     13                13 ROWS IF BATCH
         MTW,0    LPFLAG            GOING TO LINE PRINTER
         BNEZ     %+2               YES,FULL PAGE OUTPUT
         LI,8     8                 YES,
         CW,7     8                 AT LIMIT YET
         BL       SYM:DISP3         NO
         BAL,0    BUFOUT            YES,OUTPUT BUFFER
         B        SYM:DISP2         AND CONTINUE ON NEXT ROW
SYM:DISP4 BAL,0   BUFOUT            LAST LINE OUT
         MTW,-1   SYM:PASS          TO NEXT PHASE
         BLEZ     NSF1              ALL DONE
         PLW,5    STACK             RESTORE COUNTER
         STW,5    SYMCNT            SYMBOL COUNTER
         STW,R5   SYMCNT1           REMEMBER INITIAL VALUE
         LI,1     0                 SET INDEX
         LW,3     BIGBUF
         LW,4     SORTALBE          SET POINTERS
         AI,3     1                 POINT TO 1ST TEXTC STRING
SYM:DISP41 STW,3  *4,1              BUILD TABLE
         AI,R3    3
         AI,1     1                 UP INDEX
         BDR,5    SYM:DISP41        FINISH UP
         CAL1,1   SKIP              NEW PAGE OUT
         B        SYM:DISP2         DO NEXT DISPLAY
SYM:DISP42 CAL1,8 FPGS              RELEASE ALL WE GOT
         B        NSF1              CLOSE FILE,GO TO SCANNER
SYM:DISP5 LI,1    NOSORT            SET MSG ADDRS
SYM:DISP6 BAL,0   MSG
         LI,8     0                 RESET
         STW,8    BIGBUF            BUFFER POINTER
         LI,0     SYM:DISP42        SET RETURN ADDRS
         B        BUFOUT
NOBUF    LI,1     NOBUFMSG        TELL HIM ABOUT IT
         B        SYM:DISP6         AND OUTPUT ERR MESSAGE
         PAGE
*
*        DISPLAY THE MONITOR ROOT SEGMENT NAMES/ADDRESSES
*
SEGMAP   EQU      %
         PSW,R0   STACK
         LI,R1    SEGMTIT
         BAL,R0   TITEL             PUT OUT TITLE LINE
         LW,R4    BIGBUF            BASE ADDRESS OF SORTED ENTRIED
SEGMAP0  LI,R2    -1                RESET TO FIRST COLUMN SPACING
SEGMAP1  EQU      %
         AI,R4    1                 POINT TO FIRST TEXT STRING
         CW,R4    SORTALBE          HIT TOP OF THE TABLE YET
         BGE      SEGMAP5           YEP - ALL STOP
         LC       *R4               TEST MODULE BASE DEF FLAG
         BCR,2    SEGMAP2           NOT THERE
         AI,R2    1                 NEXT SPACING
         AI,R4    -1                POINT TO VALUE
         LW,R3    0,R4              GET VALUE FROM ENTRY
         BAL,R0   TRANSSZ           PUT IT OUT
         LB,R1    SYMSPACES,R2      GET PROPER SPACING
         BAL,R0   SPACES
         AI,R4    1                 POINT TO TEXT STRING
         LW,R1    R4                MOVE SO
         BAL,R0   MSG               MESSAGE KNOW WHERE IT IS
         AI,R2    1
         LB,R1    SYMSPACES,R2
         BAL,R0   SPACES
SEGMAP2  EQU      %
         AI,R4    -1                POINT BACK TO VALUE SLOT
SEGMAP3  AI,R4    3                 NEXT ENTRY
         LI,R8    12                WIDTH IF GOING YO LP
         MTW,0    LPFLAG            WRITING HE LP
         BNEZ     %+2               YEP
         LI,R8    6                 NO
         CW,R2    R8                TIME TO PRINT A LINE
         BL       SEGMAP1           NO
SEGMAP4  BAL,R0   BUFOUT
         BAL,R0   BLANK1            DOUBLE SPACE THE DISPLAY
         B        SEGMAP0           START NEXT LINE
SEGMAP5  EQU      %
         BAL,R0   BUFOUT            PRINT LAST OF LINE...
         BAL,R0   BLNKBUF
         PLW,R0   STACK             RETRIEVE THE LINK REGISTER
         B        *R0
SEGMTIT  TEXTC    'CONTROL SECTION MAP:'
         PAGE
*
*        ALPHA-NUMERIC SORT SUBROUTINE
*
SORTER   EQU      %
         LCI      0
         PSM,0    STACK             SAVE ALL
         AI,8     -1
         LW,10    9                 COUNT IN 9
         BEZ      SSXIT             NOTHING TO DO
SSR3     SLS,10   -1                HALF IT
         AI,10    0                 ANYTHING TO DO AFTER HALFING
         BEZ      SSXIT             NOPE,EXIT
         LW,11    9                 COUNT TO 11
         SW,11    10                TAKE AWAY 1/2 COUNT
         LI,3     1                 SET INITIAL
SSR4     LW,1     3                 IN 3 AND 1
SSR2     LW,2     1                 SET INITIAL 2
         AW,2     10                POINT TO HALF WAY POINT
         LW,4     8                 *
         AW,4     1                 SET
         LW,5     8                  UP
         AW,5     2                   POINTERS
         LW,6     0,4               GET LOW VALUE
         LW,7     0,5               GET UPPER VALUE
         SLD,6    2                 BOTH INTO BA FORM
         LB,13    0,6
         CB,13    0,7
         BL       %+2
         LB,13    0,7
         AND,R13  =X'1F'            MASK OFF FLAGS
         STB,13   7
         AD,6     DOUBLEONE         BUMP BOTH
         CBS,6    0
         BLE      SSR1
         LW,6     0,4
         XW,6     0,5
         STW,6    0,4
         SW,1     10
         BGZ      SSR2
SSR1     AI,3     1
         CW,3     11
         BG       SSR3
         B        SSR4
SSXIT    LCI      0
         PLM,0    STACK
         B        *15
*
*
*
SYMSPACES DATA,1 6,16,22,32,38,48,54,64,70,80,86,96,102
         BOUND    4
         PAGE
*
*
*        DATA/FPT'S ETC FOR SYMBOL MANIPULATIONS
*
*
NOBUFMSG TEXTC    'CANT GET THE BUFFER'
NOSYMBUFMSG  TEXTC  'CAN''T GET SYMBOL TABLE BUFFER'                         A00
SYM%EXP  TEXTC    '(''-'' = ABS DEF; ''<'' = TRUNCATED SYMBOL)'              A00
         USECT    DATA
*
SPCMSG   TEXTC    ' '
         BOUND    8
DOUBLEONE DATA    1,1
SYMCNT   DATA     0
SYMCNT1  DATA     0
TYP4CSECT DATA    X'C0000'          SELECT DSECT / CSECT BITS
TYP2CSECT DATA    X'20000'          SELECT CSECT ALT BIT
TYP1CSECT DATA   X'10000'           NOT NEEDED ENTRY
SYMASK    DATA    X'E0000'
CSECTFLAG DATA    0
LASTEVAL DATA   '1234'              LAST OBSERVED VALUE
PG:MODE  DATA     0
SORTALBE DATA     0
NOSORT   TEXTC    'CANNOT OBTAIN SORTING BUFFER'
Y002     DATA     X'00200000'
GPGS     GEN,8,24 8,16            16 PAGE BUFFER
FPGS     GEN,8,24  X'09',0          FREE PAGE CAL - COUNT IS DYNAMIC
*
GETTWO   GEN,8,24 8,2
*
POSFPT   GEN,8,24 X'1D',M:EI
         GEN,1,31 1,0
         DATA     1
*
READFPT  GEN,8,24 X'10',M:EI
         GEN,4,28 X'F',X'10'
         DATA     RERR
         DATA     RERR
BIGBUF   DATA     0
         DATA     8192+8192+8192+8192
*
READBI   GEN,8,24 X'10',M:BI                                                 A00
         GEN,4,28 X'F',X'10'
         DATA     ERRABN
         DATA     ERRABN
         GEN,1,31  1,PAGEBUF
         DATA     4*512
*
OPEN:PATF GEN,8,24  X'14',F:PAT
         DATA     X'C7400009'
         DATA     NOTRACE,NOTRACE
         DATA     1,1,1
         DATA     2
         DATA     X'01000202'
         TEXTC    'PATCH'
         DATA     X'02010202'
         TEXT     ':SYS   '
*
*
SET:PATF GEN,8,24   X'06',F:PAT
         GEN,4,28   12,0
         DATA     PATCHES2,PATCHES2
*
*
READ:PATF  GEN,8,24  X'10',F:PAT
           DATA      X'F0000010'
           DATA      PATCHES2,PATCHES2
           DATA      OBUF,132
*
*
OPEN:SCR  GEN,8,24  X'14',F:SCR
          DATA    X'C7400009'
         DATA     NOSCRF,NOSCRF
         DATA     2,2
         DATA     1,2
         DATA     X'01000202'
         TEXTC    'ERRMSG'
         DATA     X'02010202'
         TEXT     ':SYS   '
*
SET:SCR GEN,8,24  X'06',F:SCR
         GEN,4,28  12,0
         DATA     NOSCRK,NOSCRK
*
READ:SCR GEN,8,24  X'10',F:SCR
         GEN,8,24   X'F8',16
         DATA     NOSCRK,NOSCRK
         DATA     OBUF,131
         DATA     ERRMSGKEY
CLOSE:R7  GEN,1,7,24   1,21,7
          PZE          *0
          DATA          2
*
         PAGE
*
*        ROUTINE TO REPORT ON M:LO THE TYPE OF ERROR/ABNORMAL
*
         USECT    PP
RERR     EQU      %
         LI,1     PGMSG
         BAL,0    MSG
         LI,R3    X'3FF'
         LS,3     KEY
         AI,3     -1
         BAL,0    TRANSSZ
         BAL,0    BUFOUT
         BAL,2    RERR1             TELL ABOUT ERR/ABN
         CAL1,8   FPGS
         B        ERRABN
*
*
RERR1    LI,1     RERRMSG           GET THE MSG
         BAL,0    MSG
         LW,3     10              GET CODE FROM SR3
         BAL,0    TRANSSZ
         BAL,0    BUFOUT
         LW,R0    R2                SHIFT LINK
         B        TYP:BUFR
*
RERRMSG  TEXTC    'ERR/ABN CODE = '
*
*
PGMSG    TEXTC    'UNABLE TO READ PAGE '
         PAGE
         USECT    DATA
*
KEY      DATA     X'03000000'
KEEPKEY  DATA     X'03000000'
*
OPNEI    GEN,8,24 X'14',M:EI
         DATA     X'01040040'
         DATA     1
         DATA     X'F9E3'
         DATA     X'07010101'
         TEXT     'DUMP'
*
*
         GEN,1,31 1,X'20'
         DATA     1
*
*
*
OPNSTK   GEN,8,24 X'14',M:SYM
         GEN,16,16 X'C748',9
         DATA     READERR
         DATA     READERR
         DATA     2,2,1,2,8
         DATA     X'01000303'
SYM:FIL  TEXTC    'MONSTK'
         TEXT     '   '
         DATA     X'02000202'
SYM:ACN  TEXT     ':SYS  '
         DATA     X'03010202'
SYM:PAS  TEXT     'PASSWORD'
*
RDSTK    GEN,8,24 X'10',M:SYM
         DATA     X'F8000000'
         DATA     READERR
         DATA     READERR
         GEN,1,31 1,BIGBUF
RDSIZE   DATA     X'8000'
         DATA     SYM:FIL           POINTS TO KEY TO READ
OPEN:SYMS GEN,8,24  X'14',F:SYMS
         GEN,32   X'C5400001'
         DATA     NOSYMBOLS,NOSYMBOLS
         DATA     1,1,2
         DATA     X'01000202'
         TEXTC    'SYMBOLS'
         DATA     X'02000202'
         TEXT     ':SYS  '
         DATA     X'03010002'
READ:SYMS GEN,8,24  X'10',F:SYMS
         DATA     X'F0000010'
         DATA     NOSYMBOLS,NOSYMBOLS
         PZE      *BIGBUF           BUFFER ADDRESS
         PZE      *RDSIZE           SIZE TO READ
CLOSE:SYMS GEN,8,24  X'15',F:SYMS
         PZE      *0
         DATA     2
WRIT:SYMS GEN,8,24  X'11',F:OSYMS
         DATA     X'F0000010'
         DATA     WRSYMS,WRSYMS
         PZE      *BIGBUF
WRITCNT  DATA     0                 WILL BE SETUP W/BYTE COUNT
OPOUT:SYMS  GEN,8,24  X'14',F:OSYMS
         DATA     X'F7400001'
         DATA     WRSYMS,WRSYMS
         PZE      *BIGBUF
         PZE      *RDSIZE
         DATA     1,1,2,2
         DATA     X'01000202'
         TEXTC    'SYMBOLS'
         DATA     X'02010002'
WRITESYMS DATA    0                 DEFAULT IS NOT TO WRITE
CLOSE:SYMS1 GEN,8,24  X'15',F:OSYMS
         PZE      *0
         DATA     2
POS:BOF  GEN,8,24  X'1C',F:SYMS     POSITION TO BOF CAL
         GEN,28,4   1,0             NECESSARY BIT
TRPCONTROL  GEN,8,24  X'14',TRAPPED
            GEN,8,8,8,8  0,X'38',3,0
*
*
*
STKSIZE  DATA     0
*
*
         PAGE
         USECT    PP
*
*        ABNORMAL FROM M:SYM DCB
*
READERR  EQU      %
         LB,2     10                GET AMJOR I/O CODE
         CI,2     X'07'             LOST DATA
         BE       READERR1          YES,GET ANOTHER PAGE
         CI,2     X'03'             NO SUCH FILE
         BE       NO:SYM:FIL        YES
         CI,2     X'14'             NO ACCESS
         BE       NO:SYM:FIL        YES
         CI,R2    X'2E'             FILE ALREADY OPEN
         BE       *R8               YEP, RETURN TO CAL PLUS ONE
         BAL,2    RERR1             RECORD ERROR
         LI,1     NSFMSG            SET UP
         B        SYM:DISP6         ERROR RETURN SEQUENCE
READERR1 CAL1,8   GETONE            GET NEXT PAGE
         BCS,8    NOBUF             GET IT
         MTW,1    FPGS              INCREMENT THE PAGES TO FREE
         LI,1     512*4             PAGE CNT INTO BYTES
         AWM,1    RDSIZE
         B        STKRD             TRY AGAIN
GETONE   GEN,8,24 8,1
FREEONE  GEN,8,24 9,1
         PAGE
*
*
*        BREAK HANDLER
*
BRKRTNE  MTW,1    BRKCNT          BREAK HAS OCCURRED
BREAK    EQU      %
         BAL,R0   BLANK1
         LI,R1    BRK:MSG           MESSAGE TO 'PRINT'
         BAL,R0   PRINTL            PRINT OUT THE BREAK SALUTATION
         BAL,R0   TYP:BUFR
         LI,R2    1                 SWITCH TO ONE BYTE
         XW,R2    READCOMS          READ FOR THIS FUNCTION
         BAL,R1   READ:REC          GO GET IT
         STW,R2   READCOMS          REPLACE ORIGINAL READ SIZE
         BAL,R0   BLANK1            MAKES IT PRETTY ON TERMINAL PLATEN
         LB,R1    UCBUF             GET REPLY
         CI,R1    'X'               WANTS TO STOP
         BE       %+2               WANTS TO ABORT CURRENT DISPLAY
         CAL1,9   5                 IF HE WANTS TO CONTINEU - GO BACK
         BAL,R0   BLNKBUF           RESET THE PRINT BUFFERS
         B        SCANNER           AND GO GET THE NEXT COMMAND
BRK:MSG  TEXTC    '-- X TO ABORT.'
         PAGE
*
*        ROUTINE TO 'PRINT' (VIA M:LL) MSG IN R1
*
PRINTL   EQU      %
         CAL1,2   PRNTFPT           PRINT IT
         B        *R0
*
*        PRINT FPT
*
PRNTFPT  GEN,8,24 X'01',M:LL
         PZE      *0
         PZE      *R1               MSG ADDRESS IN R1
*
*
         PAGE
*
*        PROBLEM ACCESSING FILE USER SAID TO USE
*        FOR SYMBOL MAP
*
NO:SYM:FIL EQU    %
         LI,1     NSFMSG
         BAL,0    MSG
         LI,1     SYM:FIL
         BAL,0    MSG
         BAL,0    BUFOUT
NSF1     LW,0     M:SYM             SEE IF OPEN
         CW,0     Y002              NOW...
         BAZ      %+2               NO
         CAL1,1   CLOSSYM           IF SO CLOSE IT NOW
         LW,R0    SYMCNT1           RESTORE
         STW,R0   SYMCNT            THE TABLE COUNTER FOR SYMBOL DISP.
         PLW,R0   STACK                                                      A00
         B        *R0                                                        A00
NSFMSG   TEXTC    'ERR/ABN TRYING TO ACCESS FILE '
ABSMSG   TEXTC    '-'
         PAGE
*
*        SET M:LO HEADER WITH SYSTEM VERSION
*
SETVERS  EQU      %
         PSW,0    STACK             SAVE LINK
         LI,R14   SYSVERS           LOC OF WORD / COPY OF X'2B'
         BAL,0    GETADDR           GET IT
         LH,2     *15               GET VERSION BITS
         AND,2    =X'01FF'          MASK DOWN
         SLD,2    -4
         SLS,3    -28
         LI,1     3
         CB,2     VTAB1,1
         BLE      SETVERS1          GOT A MATCH
         BDR,1    %-2
         B        SCANNER           CANT BE DETERMINED
SETVERS1 LB,4     VTAB2,1           GET EBCDIC BASE
         LB,5     VTAB3,1           GET SUBTRACTOR
         SW,2     5                 TAKE AWAY SET AMOUNT
         AW,4     2                 ADD EM UP
         AI,3     X'F0F0'           MAKE IT 00 SOMETHING
         STH,4    3                 SET EM TOGETHER
         SLS,3    8
         STW,3    VERSLOT           PUT INTO HDR MSG
         PLW,0    STACK
         B        *0                AND EXIT
VTAB1    DATA,1   0,X'1A',X'12',9
VTAB2    DATA,1   0,X'E1',X'D0',X'C0'
VTAB3    DATA,1   0,X'12',9,0
         PAGE
         USECT    DATA
BRKFPT   GEN,8,24 X'E',BRKRTNE
BRKCNT   DATA     0
*
OPNFPT   GEN,8,24 X'14',M:EI
         DATA     X'C7400001'
         DATA     NOFIL,NOFIL
         DATA     2,2,1,2
         DATA     X'07000002'
         DATA     '    ','    '
         DATA     X'01010202'
         TEXTC    'CP5DUMP'                                                  A00
SETEI    GEN,8,24 6,M:EI
         GEN,2,30 3,0
         DATA     PAGERR,PAGERR
*
OPNLT    GEN,8,24 X'14',M:BI                                                 A00
         DATA     X'C7040042'
         DATA     ERRABN,ERRABN
         DATA     1,1,1
TAPE:TYP DATA     0                 THATS THE DEFAULT
         DATA     X'01000202'
         TEXTC    'TAPDUMP'
         DATA     X'07000202'
         TEXT     'RCVT '
         DATA     X'02010202'
         TEXT     ':SYS '
         BOUND    8
OPNPFIL  GEN,8,24 X'14',M:EI
         DATA     X'C7400001'
         DATA     NOFIL,NOFIL
         DATA     2,2,1,2
         DATA     X'01000202'       FILE NAME,NOT LAST ENTRY
PATNAME  TEXTC    'MONDMP '
         DATA     X'02010202'
PATACN   TEXT     ':SYS  '          DEFAULT INPUT ACCOUNT#
BLANKS   TEXT     '      '
*
OPEN:CPV GEN,8,24  20,M:EO
         GEN,32   X'F7480001'       PARS
         DATA     ERRABN,ERRABN     ERROR HANDLERS
         PZE      *PAGEBUF          BUFFER ADDRS POINTER
         DATA     2048              RECL
         DATA     2,2,2,2           KEYED,DIRECT,OUT,SAVE
         DATA     3                 KEY MAX
         DATA     X'01010202'
CP5:NAME TEXTC    'CP5DUMP'         NAME OF OUTPUT FILE
WRITE:CP GEN,8,24  17,M:EO
         GEN,32   X'F8000030'
         DATA     ERRABN,ERRABN
         PZE      *PAGEBUF          BUFFERA DDRESS
         DATA     2048              SIZE
         DATA     KEY               KEY BUFFER
*
*
CLOSE:BIREL GEN,8,24  X'15',M:BI
         PZE      *X'20'            IMMEDIATE RELEASE OF RESOURCE
            DATA      1
*
*
CLOSE:EOSAVE GEN,8,24  X'15',M:EO
             PZE       *0
             DATA       2
*
SADCAL   GEN,8,24 7,0
VIRPAGE  DATA     0
*
*
PROMPTX  DATA,1   X'2C',0,0,'<'
         PAGE
*
*        ENTRY POINT TO ENABLE DELTA TO USE ANALYZE SUBROUTINES
*        TO GET AND PUT INFORMATION FROM A DUMP OR THE MONITOR
*
DELTAENT EQU      %
         DATA     DELTAGET
         DATA     DELTAPUT
         DATA     SCANNER           RETURN FROM DELTA
         DATA     ACCOUNT
         PAGE
*
*        DELTA INTERFACE SUB-ROUTINES
*
         USECT    PP                                                 RL2
DELTAGET EQU      %
         MTW,1    GETFLAG
DELTAPUT EQU      %
         MTW,1    UNDERDELTA
         LCI      14
         PSM,4    DSTACK            SAVE REGISTERS
         LW,14    3
         BAL,0    GETADDR           GET THE SPECIFIED ADDRESS
         MTW,0    GETFLAG
         BNEZ     GETWORD           GO DO A GET OPERATION
         LB,R13   JB:PRIV           GET USER'S PRIV LEVEL
         CI,R13   X'C0'             HAS PRIV SUFFICIENT TO STORE
         BL       NOGOT             NOPE
PUTIT    LCFI     2                 YEP
         PLM,R0   DSTACK
         STS,R0   *R15              PUT VALUE IN THROUGH CVM WINDOW
         LI,R2    0                 SET DELTA CC RETURN
         B        DELTARETURN
GETWORD  LW,R3    *R15              GET VALUE
         LCI      2
         PLM,0    DSTACK            ADJUST THE STACK
         MTW,-1   GETFLAG
         LI,2     0                 FOR CONDITION CODES
DELTARETURN EQU   %
         LCI      12
         PLM,4    DSTACK            RESTORE THE REGISTERS
         MTW,-1   UNDERDELTA
         SCS,2    -1                 SET HIGH BIT FOR CC'S
         LCF,2    2
         B        0,4
DELRET   EQU      %                 BAIL-OUT RETURN
         LCI      2
         PLM,0     DSTACK           ADJUST THE STACK
         LI,2      1
         B         DELTARETURN
         PAGE
*
*        DELTA INTERFACE DATA
*
         USECT    DATA
         BOUND    8
ACCOUNT  TEXT     ':SYS  '
PASS     DATA     0,0
FILETEXT TEXTC    'M:MON'
         TEXT     '    '
GETFLAG  DATA     0
UNDERDEL DATA     0                 SET IF CURRENTLY ASSOCIATED
UNDERDELTA DATA   0
         BOUND    8
DSTACK   EQU      %
         DATA     %+1
         GEN,16,16 20,0
         DO1      20
         DATA     0
         PAGE
*
*        IF RUNNING AS A GHOST AND WE WIND UP HERE, PROMPT
*        OPERATOR'S CONSOLE
*
         USECT    PP
READ:REC EQU      %
         PSW,R1   STACK             SAVE LINK ADDRESS
         LC       J:JIT             WHAT MODE
         BCR,4    READ:REC1         NOT A GHOST JOB
         LI,R1    PROMPT:CHAR       OC PROMPT
         BAL,R0   TYP:MSG
READ:REC1 CAL1,1  READCOM           AND THEN READ MSG
         PLW,R1   STACK
         B        0,R1
         PAGE
*
*
OPEN:OC  GEN,8,24 X'14',M:OC
         DATA     X'00040000'
         DATA     'OC'
*
*
*
PROMPT:CHAR  DATA,1   1,X'4C'       TO PROMPT OC LIKE ONLINE DOES
         BOUND    4
*
READCDEV GEN,8,24 16,M:C
         GEN,4,28 15,16
         DATA     EXITCAL,EXITCAL
         DATA     UCBUF,80
*
TYPONOC  GEN,8,24 2,0
         PZE      *0
         PZE      *R1               MSG ADDRS IN R1
*
KEYIN:OC GEN,8,24 4,0
         GEN,4,28 15,0
         PZE      *R1               MSG ADDRESS
         DATA     MDP%REPLY         REPLY BUFFER
         DATA     2                 COUNT OF REPLY
         DATA     MDP%ECB           EVENT CONTROL BLOCK
*
*
         PAGE
*
*        TYPE MESSAGE ONTO OC DEVICE
*
*
TYP:BUFR LI,R1    TYP:BUF
         MTW,0    INT:FLG           ARE WE INTERACTIVE
         BEZ      *R0               NO, SKIP IT
TYP:MSG  CAL1,2   TYPONOC           SEND MSG
         B        *R0               AND RETURN
*
*        SEND KEYIN TYPE MESSAGE ONTO OC
*
KEYINMSG CAL1,2   KEYIN:OC          SEND MSG
         MTW,0    MDP%ECB           TEST EVENT CONTROL BLOCK
         BLZ      %-1               NOT DONE YET
         B        *R0               MSG IN SO EXIT
*
         PAGE
         USECT    PP
*
*
*        MAIN SCANNING ROUTINE
*
SCANNER  EQU      %
         LD,2     STACKR
         STD,2    STACK
CHK:DELTA MTW,0   UNDERDELTA        ARE WE ASSOCAITED WITH DELTA
         BNEZ     DELRET            SO LETS RETURN TO DELTA
         MTW,0    BALL
         BNEZ     ALLEP             KEEP GOING ON THE 'ALL'
         CAL1,1   PROMPTX
         LI,R9    NEXTCRD           LOC TO RETURN TO IF NOT ONLINE
         BAL,R8   ONLINE            GO CHECK
         B        SCANEP            GO DO IT
NEXTCRD  BAL,R1   READ:REC          READ NEXT CARD/UC/OC/ETC....
SCANEP   LCI      10                3 SETS OF 10 TO ZERO
         LM,0     ZEROS
         STM,0    FIELD1
         STM,0    F1                INITIALIZE HE FIELDS
         STM,0    FLDCNTS           ZERO COUNTERS
         STW,0    REPFLAG
         STW,R0   USER              STAYS RESET
         STW,R0   JITBURST          AND ANOTHER FLAG THAT S/B RESET
         STW,R0   LOOKING
         LB,1     UCBUF
         LI,R7    #SPCS             # OF PRE-PROCESS SPECIAL CHARS
         CB,R1    SPCS,R7           EXAMINE FOR UNIQUE IINITIAL
         BE       SPCSV,R7          COMMAND
         BDR,R7   %-2               FINISH LOOK
         CAL1,1   CLR:PROM          OKAY - CLEAR THE PROMPT CHAR
         LI,7     0                 FIELD COUNT
         LI,1     -1                PTR INTO UCBUF
SLOOP1   LI,2     0                 PTR INTO FIELD
         AI,1     1
         LW,5     FIELDS,7          GET FIELD
         CI,5     0
         BE       IBADCOM
         AI,R1    0                 ON INITIAL PHASE OF SCAN...
         BLEZ     SLOOP2            YES - DONT BOTHER W/ONLINE CHK.
         LI,R9    SLOOP2            LOC TO GO IF NOT LINE
         BAL,R8   ONLINE            GO CHECK
         B        SLOOP25           JUMP - WE'RE ONLINE
SLOOP2   LB,3     UCBUF,1           PICK UP A BYTE
SLOOP25  LI,R4    CHRSIZE           # OF SPECIAL CHARACTERS
         CB,3     CHRS,4            PICK OFF SEPARATORS
         BE       SVEC,4
         BDR,4    %-2
         CI,R2    MAXFLD            HAVE ACCUMULATED MAX FIELD
        BG        %+2               YEP - KEEP SKIPPINNG ALONG...
         STB,3    *5,2              STORE IT AWAY
         MTW,0    SPFLAG
         BEZ      %+2
         MTW,-1   SPFLAG
         AI,2     1
SLOOP3   AI,1     1
         CI,1     80                AT FULL CARD IMAGE
         BGE      ENDCOM            YES..ALL STOP
         CI,2     MAXFLD            AT MAX COUNT
        BG        %+2               YES - SKIP ALONG
         STW,2    FLDCNTS,7         NO,STORE COUNT AWAY
SLOOP4   LI,R9    SLOOP2
         BAL,R8   ONLINE            GO CHECK
         B        SLOOP25           GO DO IT
CLR:PROM GEN,8,24 X'2C',0           CLEARS PROMPT CHARACTER
         PAGE
*
*        SPECIAL CHARACTERS ANALYZE USES
*
*
CHRS     EQU      %                 SEPARATORS AND TERMINATORS       RL2
         DATA,1   X'40'                                              RL2
         DATA,1   X'15'                                              RL2
         DATA,1   X'D'                                               RL2
         DATA,1   ','                                                RL2
         DATA,1   '+'                                                RL2
         DATA,1   '-'                                                RL2
         DATA,1   '*'
         DATA,1   ' '                                                RL2
         DATA,1   '='                                                RL2
         DATA,1   '.'                                                RL2
         DATA,1   '#'
         DATA,1   '('
         DATA,1   '/'
         DATA,1   '%'
CHRSIZE  EQU      BA(%)-BA(CHRS)                                     RL2
         BOUND    4
*
*
SVEC     B        SPACE
         B        ENDCOM
         B        ENDCOM
         B        SEPR
         B        PLUSMINUS
         B        PLUSMINUS
         B        PLUSMINUS
         B        SPACE
        B         REPLACE
         B        SEPR                                               RL2
         B        SEPR
         B        VALTEXT
         B        SYM:SERCH
         B        PLUSMINUS         SAVE THE DIVIDE SYMBOL
         PAGE
*
*        ACCOUNT FOR BLANKS IN INCOMING FIELD
*
*
SPACE    MTW,0    SPFLAG
         BNEZ     SLOOP3            CONSECUTIVE BLANKS DONT MATTER
         MTW,1    SPFLAG            SET FIRST TIME BLANK HIT FLAG
         AI,R7    1                 AND POINT TO 'NEXT FIELD'
         B        SLOOP1
SEPR     LW,R0    R1                POSITION WITHIN FIELD
         AW,R0    R7                ADD FIELD #
         BEZ      IBADCOM           SAYS IMMEDIATE FIELD SEPERATOR
         AI,R7    1                 OKAY TO GO ON
         B        SLOOP1
*
REPLACE EQU       %
        MTW,1     REPFLAG        SET THE REPLACEMENT FLAG
        B         SEPR
         PAGE
*
*        END OF INPUT - GO TO COMMAND ADDRESS
*
ENDCOM   LH,1     FIELD1
         LI,2     COMSIZE
         CH,1     COMMANDS,2
         BE       SCREEN
         BDR,2    %-2
NOTCOM   EQU      %
        MTW,0     REPFLAG
        BEZ       DUMP
        B         REPLACEMENT
         PAGE
*
*        SPECIAL COMMANDS
*
SPCS     EQU      %
         DATA,1   ' '
         DATA,1   X'15'             DUMP NEXT LOCATION
         DATA,1   X'0D'             DITTO
         DATA,1   '^'               (UP ARROW) DUMP LAST LOCATION
         DATA,1   '*'               DUMP INDIRECT CUR LOCATION
#SPCS    EQU      BA(%)-BA(SPCS)    # OF THEM ABOVE
         BOUND    4
*
*        ROUTINE ADDRESSES TO HANDLE ABOVE FUNCTIONS
*
SPCSV    EQU      %
         B        BADCOM            NO GOOD
         B        DNEXT             NEXT LOCATION
         B        DNEXT             DITTO
         B        DLAST             LAST LOCATION
         B        INDIR             INDIRECTION ON CUR LOC
         PAGE
*
*        IF ONLINE - READ ONE BYTE - IF NOT RETURN VIA R9
*
ONLINE   EQU      %
         MTW,0    RUN%MODE          WHAT IS MODE
         BGEZ     *R9               NOT ONLINE
         LC       J:JIT
         BCS,2    *R9               AT THE MC STATION - SKIP OUT
         LI,R3    1                 SWITCH TO ONE BYTE
         STW,R3   READCOMS          READS....
         CAL1,1   READCOM           READ A BYTE INTO BUFFER
         LB,R3    UCBUF             PICK IT UP
         STB,R3   TERM:CHAR         REMEMBER EACH ONE IN PROGRESSION
         B        *R8               RETURN
         USECT    DATA
TERM:CHAR DATA    0
         USECT    PP
         PAGE
*
*        HIT AN ERROR ON INCOMING COMMAND
*
IBADCOM  EQU      %
         BAL,R0   BLANK1
         AI,R1    0                 WHAT IS COUNT WITHIN COMMAND
         BNEZ     %+2
         AI,R1    1                 ONE MORE FOR CORRECT POSITION
         BAL,R0   SPACES            ELSE SPACE OVER TO IT
IBADCOM1 LI,R1    DOLLAR            MSG TO PRINT
         BAL,R0   MSG
         BAL,R0   BUFOUT
         B        BADCOM
DOLLAR   TEXTC    '%'
        PAGE
*
*        CHECK MAP/UNMAP  DEFAULT TABLE AND CALL
*        SUBROUTINE
*
SCREEN   EQU      %
         LI,R0    SCANNER           DEFAULT RETURN POINT
         LI,R1    SCANNER           DITTO.............
         EXU      CVEC,R2           CALL SUB-ROUTINE
         PAGE
*
*        SET UP FOR ONE LEVEL OF ADDITION OR SUBTRACTION
*
PLUSMINUS STB,3   OPS,7           SAVE OPERATION
         LW,5     OPFIELD,7       PUT EBCDIC IN OPFIELD
         MTW,0    *5              IS SOMETHING THERE
         BNEZ     BADCOM          YES, TOO MANY OPS
         LI,2     0
         AI,1     1
         B        SLOOP4            RE-ENTER SCANNING PROCESS...
*
         PAGE
*
*        COMMAND VECTOR LIST
*
CVEC     EQU      %-1
         B        DISPLAY
         B        SYMBOLMAP         INIT SYMBOL MAP
         B        RUN
         B        ALL
         B        SEARCH
         B        MASK
         B        LP
         B        UCLO
         B        ROWSS             ROW COMMAND
         B        CLOSEIT           CLOSE DUMP FILE
         B        SCANNER           IGNORE BATCH BANG COMMAND
         B        MAPMODE
         B        UNMAP
         B         DUM
EXIT     B        EXITCL
         B        INPUT
         B        SCANNER
         B        COMPARE
        B         MONITOR
         B        PRINT
         B        DO%SYMBOLS        SYMBOL TABLE BUILD / DISPLAY             A00
         B        COM:BF            SPECIAL ENTRY FOR 'BF' COMMAND
         B        ASSOCIATEDEL
         B        DISASSDEL
         B        GIVE:HELP
         B        SETWRITE          WITE
         PAGE
*
*        CLOSE BOTH FILES AND SAVE THEM
*
EXITCL   EQU      %
         LC       J:JIT
         BCR,4    NOT%GHST%XIT      NOT A GHOST JOB
         LI,R1    GXITMSG
         BAL,R0   TYP:MSG           TYPE IT OUT
NOT%GHST%XIT  EQU  %                                                         A00
         CAL1,4   DISASSFPT         DISASSOCIATE DELTA IF NECESSARY
         BAL,R0   CLOSEIT           CLOSE M:EI IF OPEN NOW
EXITCAL  CAL1,9   1
*
GXITMSG  TEXTC    'ANLZ GHOST FINISHED'                                      A00
CLOSSYM  GEN,8,24 X'15',M:SYM
         GEN,1,31 1,0
         DATA     2
*
CLOSE    GEN,8,24 X'15',M:EI
         GEN,1,31 1,0
         DATA     2
*
         PAGE
*
*        WRITE OUT SYMBOL TABLE
*
SETWRITE MTW,1    WRITESYMS         SET FLAG
         B        SCANNER           RETURN
         PAGE
*
*        COMMAND ACCEPTANCE LIST
*
*
COMMANDS EQU      %
         DATA,2   'XX'
         DATA,2   'DI'              DISPLAY
         DATA,2   'IS'              INIT SYMBOL TABLES
         DATA,2   'RU'              RUN
         DATA,2   'AL'              ALL
         DATA,2   'SE'              SEARCH
         DATA,2   'SM'              SMASK
         DATA,2   'LP'              LINE PRINTER
         DATA,2   'UC'              USERS CONSOLE
         DATA,2   'RO'              ROW COUNT
         DATA,2   'CL'              CLOSE DUMP FILE
         DATA,2   '!A'              BATCH BANG CARD '!ANLZ'
         DATA,2   'MA'              MAP MODE
         DATA,2   'UN'              UNMAP
         DATA,2   'DU'              DUMP
         DATA,2   'EN'              END
         DATA,2   'IN'              INPUT
         DATA,2   'AN'              ANALYZE (IGNORE)
         DATA,2   'CO'              COMPARE
         DATA,2   'MO'              MONITOR DISPLAY
         DATA,2   'PR'              CLOSE SYMBIONT FILE
         DATA,2   'SY'              SYMBOL MAP
         DATA,2   'BF'              SPECIFY BOOT FILE NAME
         DATA,2   'DE'              ASSOCIATE DELTA
         DATA,2   'NO'              DIS-ASSOCIATE DELTA
         DATA,2   'HE'              LIST COMMANDS
         DATA,2   'WR'
COMSIZE  EQU      HA(%)-HA(COMMANDS)-1
         BOUND    4
         PAGE
         USECT    DATA
SPFLAG   DATA     0
FIELDS   DATA     FIELD1
         DATA     FIELD2
         DATA     FIELD3
         DATA     FIELD4
         DATA     FIELD5
OPFIELD  DATA     F1,F2,F3,F4,F5
         BOUND    8
FIELD1   DATA     0,0
FIELD2   DATA     0,0
FIELD3   DATA     0,0
FIELD4   DATA     0,0
FIELD5   DATA     0,0
F1       DATA     0,0
F2       DATA     0,0
F3       DATA     0,0
F4       DATA     0,0
F5       DATA     0,0
MAXFLD   EQU      BA(%)-BA(F5)      MAX BYTE COUNT
FLDCNTS  EQU      %
FIELD1C  DATA     0
FIELD2C  DATA     0
FIELD3C  DATA     0
FIELD4C  DATA     0
FIELD5C  DATA     0
OPS      DATA,1   0,0,0,0,0
*
         BOUND    8
ZEROS    DO1      16
         DATA     0
         PAGE
*
*        COMMAND 'ROWS'
*        ROW COUNT COMMAND;
*        OPTIONS ARE 1 THRU 12,DEFAULTS ARE;
*
*        LP:      8
*        UC:      4
*
         USECT    PP
ROWSS    EQU      %
         PSW,R1   STACK             SAVE LINK
         LI,1     1                 GET FIELD 2
         BAL,0    GETHEX            IN R2
ROWS1    EQU      %                                                          A00
         LI,R1    3                 ASSUME ONLINE
         MTW,0    LPFLAG            WRITING THE LINE PRINTER
         BEZ      %+2               NO - RESTRICT TO 8 MAXIMUM
         LI,R1    0                 BATCH/GHOST DONT MATTER
CHK:ROW  EQU      %
         AI,2     0                 WAS THERE A VALUE GIVEN
         BEZ      ROWS3             NO,TAKE DEFAULTS
         CB,R2    MAXCNT,R1         COMPARE TO MAX POSSIBLE
         BLE      %+2               IS OKAY
ROWS3    LB,R2    COUNTS,R1         IS NOT OKAY
         STW,R2   BLKCNT            SAVE IT
         LW,R3    R2
         MI,R3    9                 CALCULATE
         AI,R3    15                WHERE
         LI,R2    60                TRANSLATE COLUMN
         MTW,0    LPFLAG
         BEZ      %+2
         LI,R2    90                SHOULD BE
         CW,R3    R2                WILL TRANS COLUMN BE OKAY HERE
         BLE      %+2               YEP
         LI,R3    0                 NO - NO TRANSLATING
         STW,R3   TPTRSV            REMEMBER IT FOR USE LATER
         PLW,R1   STACK             GET LINK
         B        0,R1              AND LEAVE HERE
         PAGE
         USECT    DATA
DATAFLAG DATA     0
MAXCNT   DATA     X'0C0C0808'
TAP%DMP  DATA     0                 SET = RECOVERY FROM A TAPE DUMP
TSIZE    DATA     0
UCTITLE  DATA     0                 SET = NO M:UC TITLE LINE
COUNTS   DATA     X'08080404'
BLKCNT   DATA     8                 DEFAULT IF GHOST IS 8
         USECT    PP
         PAGE
*
*        COMMAND 'CLOSE'
*        CLOSE DUMP FILE TO LOOK AT MONITOR RUNNING
*
CLOSEIT  PSW,0    STACK             SAVE RETURN
         LW,0     Y002              SEE IF
         CW,0     M:EI              ITS OPEN
         BAZ      NOCLOSE           NOPE,FORGET
         CAL1,1   CLOSE             DO SO IF OPEN
NOCLOSE  PLW,0    STACK             RESTORE LINK
         B        *0                AND TAKE IT
         PAGE
*
*        COULDNT UNDERSTAND COMMAND,TELL USER
*        AND GET NEXT COMMAND
*
         USECT    PP
BADCOM   LI,1     WHAT
         MTW,0    INT:FLG
         BEZ      EHTOLP
         LI,R0    ERRET
         B        TYP:MSG
EHTOLP   BAL,R0   MSG               ONLINE/BATCH
         BAL,0    BUFOUT
ERRET    EQU      %                                                          A00
         MTW,0    RUN%MODE                                                   A00
         BGZ      EXIT              BATCH MODE, MIGHT AS WELL QUIT           A00
         B        SCANNER         LET HIM TRY AGAIN
WHAT     TEXTC    'EH ?'
         PAGE
*
*        COMMAND 'PRINT'
*
PRINT    EQU      %
         CAL1,9   6                 SUPER CLOSE CAL
         B        *R0               EXIT TO CALLER / SCANNER
         PAGE
*
*        SUBROUTINE TO ASSOCIATE/DIS-ASSOCIATE DELTA
*
ASSOCIATEDEL EQU  %
         MTW,0    UNDERDEL          ARE WE ASSOCAITED NOW
         BNEZ     NONEED            YES,DONT DO IT AGAIN
         CAL1,4   ASSDELFPT         ASK TO ASSOCIATE WITH DELTA
         BCS,8    NOASSOCIATE       DIDNT GET HIM
         MTW,1    UNDERDEL          SET FLAG
         B        SCANNER           GOT HIM
*
*
DISASSDEL EQU     %
         CAL1,4   DISASSFPT         DIS-ASSOCIATE DELTA
         BCS,12   NODIS             SOMETHING WRONG
         LI,1     0                 RESET
         STW,1    UNDERDEL          FLAG
         CAL1,8   BRKFPT            RE-TAKE BREAK CONTROL
         B        SCANNER
*
*
ASSDELFPT EQU     %
         GEN,8,7,17   4,1,DELTAENT    GETS INTO DELTA RIGHT AWAY
         TEXTC    'DELTA'
*
*
DISASSFPT EQU     %
         GEN,8,24 5,0
         TEXTC    'DELTA'
*
*
NONEED   LI,1     ALLSET            TELL USER ALREADY
         B        PUSHMSG           ASSOCIATED
*
*
NOASSOCIATE EQU %
         LI,1     NOASSMSG
         B        PUSHMSG
NODIS    LI,1     NODISMSG
         B        PUSHMSG           OUTPUT MSG/GO TO SCANNER
*
*
NOASSMSG TEXTC    'COULDNT ASSOCIATE WITH DELTA'
NODISMSG TEXTC    'NOBODY TO DIS-ASSOCIATE WITH'
ALLSET   TEXTC    'WE ARE ALREADY ASSOCIATED WITH DELTA'
         PAGE
*
*
*        COMMAND 'BF'
*
*        CAN BE BAL'D HERE FROM SYMBOLMAP ROUTINE
*        TO PICK UP OPTIONAL FILE NAME
*
COM:BF   MTW,0    FIELD2C           CHECK COUNT FOR FIELD TWO
         BEZ      DUMP              NONE - MUST MEAN TO DUMP LOC 'BF'
FILENAME EQU      %
         LCI      8
         PSM,0    STACK             SAVE WORK ARGS
         LD,2     FIELD2            PICK UP THE NAME
         LI,1     0
         LI,4     0                 INIT REGISTERS FOR COUNTING
         LI,5     7
         LI,6     8
FILOOP   EQU      %
         LB,7     2,5               BUILD TEXTC NAME IN 2,3,4
         STB,7    2,6
         BEZ      %+2
         AI,1     1
         AI,5     -1
         AI,6     -1
         BGZ      FILOOP            GET ALL THE CHARACTERS
         STB,1    2                 FORM TEXTC
         LCI      3                 STORE FILE
         STM,2    FILETEXT          NAME
         LD,2     FIELD3            GET ACCOUNT#
         BAL,4    BLNKSTUF          SET IN BLANKS
         STD,2    ACCOUNT           AND STORE
         LD,2     FIELD4            GET PASSWORD
         BAL,4    BLNKSTUF          SET IN BLANKS
         STD,2    PASS              SAVE IT
         LCI      8                 RESTORE
         PLM,0    STACK             WORK ARGS
         CI,0     SCANNER           SCANNER CALLED
         BNE      %+2               NO
         MTB,1    DELTAENT+3        YES,SET DELTA FLAG
         B        *0                AND RETURN
BLNKSTUF EQU      %                                                  RL2
         BEZ      0,4                                                RL2
         LI,6     X'40'                                              RL2
         LI,5     7                                                  RL2
         MTB,0    2,5                                                RL2
         BNEZ     0,4                                                RL2
         STB,6    2,5                                                RL2
         BDR,5    %-3                                                RL2
         B        0,4                                                RL2
         PAGE
         USECT    DATA
BATFLAG GEN,4,28 4,0
READCOM  GEN,8,24 X'10',M:SI
         GEN,4,28 X'F',0
         DATA     BADCOM
         DATA     BADCOM
         DATA     UCBUF
READCOMS DATA     80
         BOUND    8                                                          A00
UCBUF    RES      20                ROOM FOR A FULL CARD IMAGE
         PAGE
*        ROUTINE TO SUMMARIZE THE TABLES
*
BALL     DATA     0               IN PROGRESS FLAG
NOPS     DATA     0
SCREECH%CODE DATA 'IBAD'                                                     A00
REG%FLAG DATA     0        0 MEANS REGS NOT DISPED, SCREECH NOT SAVED        A00
         PAGE
*
*        SET UP FOR RUNNING GHOST MODE INTERACTIVELY
*
         USECT    PP
INT:GHOST EQU     %
         CAL1,1   CLOSESI           CLOSE INPUT STREAM
         CAL1,1   OPENSI:OC         OPEN TO OC
         CAL1,1   OPEN:OC           OPEN M:OC FOR WRITING PROMPTS
         CAL1,8   BRKFPT            TAKE BREAK CONTROL
         BAL,R1   OPNTOLP           OPEN LO TO LP
         MTW,7    INT:FLG           SET FLAG
         LI,R1   1                  SET UP FLAG
         STW,R1   RUN%MODE          LIKE WE'RE RUNNING IN BATCH
         B        GO:ANLZ           TAKE OFF
CLOSESI  GEN,8,24 X'15',M:SI
         DATA     0,0
OPENSI:OC GEN,8,24  X'14',M:SI
         DATA     X'00040000'
         DATA     'OC'
         PAGE
*
*        COMMAND 'ALL'
*
*        SET UP ALL VECTOR LOOP
*
         USECT    PP
ALL      EQU      %
         BAL,R0   UNMAP
         BAL,R0   GETHIGH           GET PAGE LIMITS
         BAL,R0   FIX%TIME          GET CRASH TIME INTO HEADING
         BAL,R0   OBTAIN%40%46      GET TRAP LOCATIONS SAVED BY RCVRY
         BAL,R0   SYMBOLMAP         BUILD SYMBOL MAP, DON'T DISP YET         A00
         LI,1     -(AOPSCNT+1)      SET UP GHOST LOOP CNT
         STW,1    NOPS            # OF OPERATIONS
         MTW,1    BALL            SET FLAG
         LCI      10
         LM,0     ZEROS           ZERO FIELDS,
         STM,0    FIELD1          TAKE COMMAND DEFAULTS
         BAL,0    SETVERS           SET UP HEADER WITH VERSION
ALLEP    EQU      %
         LI,R0    0
         STW,R0   USER              THIS THING STAYS RESET
         STW,R0   MAPFLAG           TRANSLATION IS PHYSICAL
         MTW,1    NOPS              BUMP COUNTER
         BGZ      EXITCL            ALREADY BEEN THRU THERE....
         LI,1     SCANNER           SET RETURN FOR MD CODE
         LW,2     NOPS              GET VECTOR#
         B        ALLOPS,2          AND GO
         PAGE
*
*        GHOST DISPLAY VECTOR TABLE
*
AOPS     EQU      %
         B        INIT:MD           GET MONDMP INIT                          A00
         B        REGS              TRAP REGISTERS                           A00
         B        MDTRAPS           TRAPS/INTERRUPTS                         A00
         B        TRPAGE            TRAPPED PAGE                             A00
         B        USERS             USER TABLES                              A00
         B        STATES            USER STATE CHAINS                        A00
         B        MD:SUBQ           RESOURCE WAIT QUEUES
         B        SWAP              SWAPPER TABLES                           A00
         B        PARTITIONS        DISPLAY PARTITIONS                       A00
         B        PROCS             PROCESSOR TABLES                         A00
         B        MPAGES            MONITOR/SWAPPER PAGE CHAINS              A00
         B        UPAGES            USER PAGE CHAINS                         A00
         B        PPAGES            PROCESSOR PAGE CHAINS                    A00
         B        RA:TABL           DISPLAY READ-AHEAD TABLES
         B        RTPAGES           DISPLAY REAL TIME PAGES
         B        XDELPGS           DELTA/HANDLER PAGES
         B        PHYMAP            PHYSICAL MEMORY MAP                      A00
         B        ALLYTABL          ALLYCAT'S TABLES
         B        IODISPLAY         I/O TABLES                               A00
         B        %CITS             CITS/OPLBTS                              A00
         B        %DCTS             DCT TABLES                               A00
         B        %IOQS             IOQ TABLES                               A00
         B        COCODE            COC TABLES                               A00
         B        RAT%TABLES        RESOURCE ALLOCATION TABLES               A00
         B        AVR%TABLES        AUTOMATIC VOLUME RECOGNITION             A00
         B        ERROR%LOG                                                  A00
         B        SYMTABLS          SYMBIONT(OUTPUT)TABLES                   A00
         B        M:JIT             MONITOR JIT                              A00
         B        CURRENT%USER      DISPLAY CURRENT USER                     A00
         B        MONITOR%ROOT      DISPLAY MONITOR ROOT                     A00
         B        SYMBIONTS         RBBAT RECOVERY FILE                      A00
         B        UID               USER IDENTIFICATION                      A00
         B        PATCHES           DISPLAY SYSTEM PATCH FILE                A00
         B        END%GHOST%DEFAULT  QUIT HERE IF GHOST JOB                  A00
         B        RECOVERY%CONTEXT  DUMP RECOVERY CONTEXT
AOPSCNT  EQU      %-AOPS
         PAGE
*
*        GHOST DISPLAY FINISHED,DUMP ROOT OF MONITOR
*        IF RUNNING AS GHOST,OR RETURN TO SCANNER
*        IF RUNNING 'ALL' FOR AN ONLINE USER
*
ALLOPS   EQU      %
         MTW,7    NOPS              MAKE IT A POSITIVE NUMBER
ALLEXIT  EQU      %
         LI,R1    0                 RE-SET
         XW,R1    TAP%DMP           GET TAPE DUMP FLAG
         BEZ      %+2               WASNT FROM TAPE
         BAL,R1   RECOVERY%CONTEXT  DISPLAY RECOVERY AREA FOR GHOST
         B        ALLJIT            GO SHOW ALL THE USER JIT'S
TPMSG    TEXTC    'PAGE IN WHICH TRAP OCCURED:'
         PAGE
*
*        DISPLAY PATCH FILE IF IT EXISTS
*
PATCHES  EQU      %
         LI,1     PATFMSG
         BAL,0    TITEL             SHOVE OUT TITEL
         CAL1,1   OPEN:PATF         OPEN THE PATCH FILE
         CAL1,1   SET:PATF          SET ERR/ABN
PATCHES1 CAL1,1   READ:PATF         READ A RECORD
         LW,R1    F:PAT+13          GET RECORD SIZE
         STW,R1   BUFSIZ            STORE IT
         CAL1,1   WRITBUF           WRITE IT ON M:LO
         B        PATCHES1          CONTINUE
PATCHES2 LI,R7    F:PAT             SET DCB ADDRS
         BAL,R0   CLOSEDCB          AND CLOSE IT
         B        SCANNER           GO TO NEXT COMMAND
PATFMSG  TEXTC    'PATCH FILE:'
         PAGE
*
*        COMMAND WAS A SYMBOL/ SEE IF WE CAN FIND IT
*
SYM:LOOK EQU      PROCNAME
SYM:SERCH EQU     %
         BAL,R1   INIT:MD
         LW,R1    FIELD1C           GET SYMBOL BYTE COUNT
         CI,R1    7                 MAX
         BLE      %+2               NO
         LI,R1    7                 RESET
         LI,R2    BA(FIELD1)
         LI,R3    BA(SYM:LOOK)
         AI,R3    1                 FOR BYTE COUNT
         STB,R1   R3
         MBS,R2   0
         STB,R1   SYM:LOOK          MAKE IT TEXTC
         LI,R13   SYM:LOOK
         BAL,R1   STXTVAL           GO LOOK FOR IT
         BEZ      NOTCOM            DIDNT FIND ANYWHERE
         STW,R12  LASTLOC           SAVE AS LAST LOC DUMPED
         LW,R14   LASTLOC
         BAL,R0   GETADDR
         LW,R3    *R15              GT VALUE FROM CELL
         BAL,R0   TRANSSZ
         B        SERCHX
NOT:FIND LI,R1    NOSFIND
SERCHAX  BAL,R0   MSG               SHOVE OUT THE MESSAGE
SERCHX   BAL,R0   BUFOUT
         LI,R0    SCANNER           RETURN POINT
         B        TYP:BUFR          TYPE IT IF NECESSARY
SLSH:MSG TEXTC    ' / '
EQL:MSG  TEXTC    ' = '
NOSFIND  TEXTC    'CANNOT FIND THAT SYMBOL'
NOSFIND1 TEXTC    'CANNOT LOCATE SYMBOL FOR THAT VALUE'
         PAGE
*
*        GIVEN VALUE - FIND SYMBOL ASSOCIATION
*
VALTEXT  EQU      %
         BAL,R1   INIT:MD           START UP THE SYMBOL CODE
         LI,R1    0
         BAL,R0   GETHEX            GET THE VALUE
         STW,R2   LASTLOC           REMEBER INITIAL VALUE
         LI,R1    NOSFIND1          ASSUME VALUE OUT OF RANGE
         CLM,R2   SYM:LIMS          TEST AGAINST TABLE
         BCS,9    SERCHAX           OUT OF RANGE - EXIT
         STW,R2   LASTLOC           SAVE AS LAST USED LOCATION
         LW,R12   R2                MOVE IT FOR SEARCH
         BAL,R1   SVALTXT           GO GET IT
         NOP      %                 ****ERROR RETURN FROM SVALTXT****
         LW,R1    R2                TEXTC STRING ADDRESS
         BAL,R0   MSG               PUT OUT
         LW,R3    LASTLOC           RESTORE R3
         BAL,R0   DISP:OFF          PUT OUT OFFSET ETC...
         BAL,R0   BUFOUT            PRINT EVERYTHING
         LI,R0    SCANNER           SET RETURN POINT
         B        TYP:BUFR          AND TYP MSG IF APPROPRIATE
         PAGE
*
*        DISPLAY USER IDENTIFICATION;
*
*        EITHER FROM IN CORE JIT,OR JIT BEHIND
*        THE CORE DUMP PORTION OF THE CRASH FILE
*
UID      LI,1     USERIDMS          PUSH
         BAL,0    TITEL             HEADER TITLE
         LI,1     USERIDMS1         DO
         BAL,R0   MSG%OUT           PRINT LINE
         LI,1     2                 CHECK
         BAL,0    GETHEX            FOR AN OPTION
         LI,10    0                 PREPARE FOR IT
         AI,2     0                 WAS THERE
         BNEZ     UID2              YES,USE IT AS INDEX
         AI,2     1                 NO,POINT TO FIRST ONE
         LI,10    SMUIS             SET MAXIMUM LOOP
UID2     STW,R2   USER              INITIALIZE POINTER
         LI,1     %                 SET FLAG
         STW,1    LOOKING           TO PERUSE FILE
         BAL,R0   RES:JIT           FIND THE JIT
         BCS,4    UID4              NONE - SKIP TO NEXT
UID3     LI,1     1                 DO SPACING
         BAL,0    SPACES
         LW,3     2                 INSERT
         BAL,0    TRANSSZ           USER#
         LI,1     9                 SPACE
         BAL,0    SPACES            OVER
         LB,1     *PAGEBUF          GET USER
         SLS,1    -5                USER ORIGIN
         AND,1    =7                MASK DOWN
         CI,1     1                 ODD BIT SET
         BAZ      %+2               NO
         AI,1    -1                 YES,BUMP IT
         AI,1     UORIGIN           TYPE IN TEXT
         BAL,0    MSG
         LI,1     19                SPACE
         BAL,0    SPACES            PROPERLY
         LI,1     1
         LCI      2                 GET USERS
         LM,7     *PAGEBUF,1        ACCOUNT#
         PSW,2    STACK             SAVE #
         LI,2     8                 8 BYTE ACCOUNT#
         LI,1     7                 POINT TO MSG ADDRS
         BAL,0    MSG1              INSERT TO PRINT LINE
         LI,1     31                SPACE
         BAL,0    SPACES            PROPERLY
         LI,1     3                 INDEX TO USER
         LCI      3                 NAME IN JIT
         LM,7     *PAGEBUF,1        GET IT
         LW,R2    *STACK            GET USER ID                              B00
         LC       *PAGEBUF          GET JOB ORIGIN
         BCR,4    NOGHOST           NOT A GJOST JOB
         LI,R14   SB:GJOBUN                                                  B00
         BAL,R0   GETADDR                                                    B00
         LI,R7   MAXG                                                        B00
GJOB%SRCH  EQU    %                                                          B00
         CB,R2    *R15,R7           LOOK FOR INDEX INTO                      B00
         BE       GJOB%NAM             GJOBTABLE                             B00
         BDR,R7   GJOB%SRCH                                                  B00
         B        NOGHOST           COULDN'T FIND ONE                        B00
GJOB%NAM EQU      %                                                          B00
         LI,R14   S:GJOBTBL                                                  B00
         BAL,R0   GETADDR                                                    B00
         LD,R8    *R15,R7           GET EBCDIC OF GJOB NAME                  B00
         STD,R8   PROCNAME                                                   B00
         LI,R1    PROCNAME                                                   B00
         BAL,R0   MSG                                                        B00
         B        UBUFOUT                                                    B00
NOGHOST  EQU      %                                                          B00
         LI,2     3*4               BYTE LENGTH
         LI,1     7                 POINT TO MSG ADDRS
         BAL,0    MSG1              INSERT IT
UBUFOUT  EQU      %                                                          B00
         BAL,0    BUFOUT            PRINT THE WHOLE THING
         PLW,2    STACK             RESTORE R2
UID4     AI,2     1                 BUMP TO NEXT
         BDR,10   UID2              GO TO NEXT USER
         B        SCANNER           GO ON
UORIGIN  TEXTC    'BATCH'
         TEXTC    'GHOST'
         TEXTC    'ONLINE'
USERIDMS TEXTC    'USER IDENTIFICATION:'
USERIDMS1 TEXTC 'USER#    ORIGIN    ACCOUNT#    USER NAME'
SCR:CNT  DATA,1   3,X'7E',X'79',X'61'   ---TO SHOW TRAPPED PAGE
         PAGE
*
*        IF MONITOR ,TEL OR CCI HAS TRAPPED
*        DISPLAY THE PAGE IN WHICH THE TRAP
*        OCCURED.
*
TPAGE    EQU      %
         MTW,0    REG%FLAG          BEEN THRU REG CODE                       A00
         BGZ      TRPAGE            YES                                      A00
         BAL,R1   REGS              NO, GO DO IT                             A00
TRPAGE   EQU      %                                                          A00
         MTW,0    TRAP:SCR          WAS THE SCREECH DUE TO A TRAP
         BEZ      SCANNER           NO - EXIT FROM HERE
         LI,R14   TRAPPSD           ADDR OF PSD AT TIME OF LAST TRAP         A00
         BAL,R0   GETADDR                                                    A00
         LW,R14   *R15              PICK IT UP...
         LH,13    14                GET MS/MM BIT FIELDS
         AND,14   =X'1FFFF'         MASK DOWN ADDRS
         CI,13    X'0040'           IS A MAPPED TRAP
         BAZ      TRPAGE1           NO,REAL ADDRS IN 14
         PSW,14   STACK
         LI,14    S:CUN             YES,GET
         BAL,0    GETADDR           CURRENT USER'S
         LW,2     *15               NUMBER AND THEN
         BLEZ     TRPAGE2           NONE OR ERROR
         BAL,0    MAP:USER          HIS MAP
         PLW,14   STACK
TRPAGE1  LI,R1    TPMSG             TITLE LINE FOR TRAPPED PAGE DISP..
         BAL,R0   TITEL             OUTPUT
         CLM,R14  PATCHLOC          TRAP IN PATCH AREA
         BCS,9    TRPAGE15          NO
         LI,R1    TRAPATCH          YES
         BAL,R0   MSG%OUT           WARNING MSG
TRPAGE15 BAL,R0   GETADDR           GET THE TRAP ADDRESS
         LW,8     PAGEBUF
         LI,7     X'200'            SET UP DISPLAY
         BAL,0    DUMPSOME          DUMP THE PAGE
TRPAGE2  LI,0     SCANNER           RETURN FOR
         B        UNMAP             UNMAP ROUTINE
TRAPATCH TEXTC '** TRAP LOCATION IS IN PATCH AREA'
        PAGE
*
*       ROUTINE TO SET FLAG TO DISPLAY LOCATIONS IN THE
*       RUNNING MONITOR AND PERMIT CHANGING IT
*
MONITOR  EQU      %
         BAL,0    CLOSEIT           MAKE SURE DUMP ISNT OPEN
         LI,1     0                 ASSUME NO
         LB,1     FIELD2            GET OPTION FIELD
         CI,R1    'D'               DISPLAY MODE TO GO ON
         BNE      NOT:MDISP         NOPE
         STW,R1   MON:FLAG          YEP
         STW,R1   MONFLAG           SET BOTH FLAGS
         BAL,R0   UNMAP
         B        SETUPDISP         DO IT
NOT:MDISP LD,R0   ZEROS
         STD,R0   MONFLAG           THESE TWO FLAGS
         BAL,R0   RES:BUF           RESTORE THE BUFFERS
SETUPDISP MTW,0   MONFLAG           DID IT GO ON
         BEZ      %+2               YES
         BAL,0    GETHIGH           NO,GET SSSTEM LIMITS
         B        SCANNER           RETURN TO SCAN
*
*
        USECT     DATA
         BOUND    8
MONFLAG  DATA     8899
MON:FLAG DATA     7788
REPFLAG DATA      0
CVMPAGE  DATA     -1                CURRENT CVM PAGE # WE OWN
INT:FLG  DATA     0                 INTERACTIVE GHOST FLAG
         BOUND    8
RCVLIMITS DATA    X'4000',X'6200'
         USECT    PP                GENERATE PROCEDURE HERE
         PAGE
*
*        ROUTINE TO TRACE THE SPECIFIED NUMBER OF EVENTS
*        IN THE RECORDER
*
         USECT    DATA
USER:NUM EQU      %
USER     DATA     0                 SPECIFIED USER
         USECT    PP
         PAGE
*
*        TRANSLATE TABLE  OPCODE # ---> OPCODE MNEMONIC
*
*                  0   1   2   3   4   5   6   7
*                  8   9   A   B   C   D   E   F
*
OPCODES  TEXT     '        LCFI    CAL1CAL2CAL3CAL4'       0
         TEXT     'PLW PSW PLM PSM         LPSDXPSD'       0
         TEXT     'AD  CD  LD  MSP     STD         '       1
         TEXT     'SD  CLM LCD LAD FSL FAL FDL FML '       1
         TEXT     'AI  CI  LI  MI  SF  S           '       2
         TEXT     'CVS CVA LM  STM         WAITLRP '       2
         TEXT     'AW  CW  LW  MTW     STW DW  MW  '       3
         TEXT     'SW  CLR LCW LAW FSS FAS FDS FMS '       3
         TEXT     'TTBSTBS         ANLZCS  XW  STS '       4
         TEXT     'EOR OR  LS  AND SIO TIO TDV HIO '       4
         TEXT     'AH  CH  LH  MTH     STH DH  MH  '       5
         TEXT     'SH      LCH LAH                 '       5
         TEXT     'CBS MBS     EBS BDR BIR AWM EXU '       6
         TEXT     'BCR BCS BAL INT RD  WD  AIO MMC '       6
         TEXT     'LCF CB  LB  MTB STCFSTB PACKUNPK'       7
         TEXT     'DS  DA  DD  DM  DSA DC  DL  DST '       7
         PAGE
*
*        EVENT RECORDER DOESNT EXIST
*
         USECT    PP
NOTRACE LI,1      NOEVENTS
PUSHMSG  BAL,R0   BLANK1
         BAL,R0   MSG%OUT
         B        SCANNER
NOEVENTS  TEXTC   'IT DOES NOT EXIST IN THIS SYSTEM'
         PAGE                                                                A00
*                                                                            A00
*   DISPLAY JIT, AJIT, AND CONTEXT OF CURRENT USER                           A00
*                                                                            A00
CURRENT%USER EQU  %                                                          A00
         LCI      3                                                          A00
         PSM,R0   STACK                                                      A00
         LI,R14   S:CUN             ADDR OF CURRENT USER NUMBER              A00
         BAL,R0   GETADDR                                                    A00
         LW,R2    *R15              GET CURR USER NO.                        A00
         BLEZ     NO:CUN            NONE OR ERROR
         STW,R2   CUN               SAVE FOR FUTURE USE                      A00
         AND,R2   #R16              MASK PRIOR MASK
         OR,R2    BATFLAG           SET FOR NO SCAN OF TABLES
         STW,R2   USER              SET UP DISP PARAM                        A00
         LI,R1    CUJITMSG          PTR TO TITLE TEXT                        A00
         STB,R2   R1                REMEMBER USER #
         BAL,R0   TITEL                                                      A00
         BAL,R0   RES:JIT           LOOK FOR THE JIT
         BCS,4    SCANNER           NONE TO BE FOUND
         LI,R3    JDDUL             DYNAMIC DATA IPPER LIMIET
         LW,R3    *PAGEBUF,R3       GET IT
         STW,R3   ENDDCB            AND REMEMBER IT FOR CONTEXT DUMP
         BAL,R4   AJO1              PUT OUT JIT                              A00
         LC       JITSTAT           ANY ERRORS
         BCS,4    NO:CUN            YES - ABORT THE DISPLAY
         CAL1,1   SKIP                                                       A00
         BAL,R6   AJITA             PUT OUT AJIT                             A00
         LW,R6    SCREECH%CODE                                               A00
         CI,R6    X'61'                                                      A00
         BNE      NO%HI%CORE   ALLOW EXTENDED CXT ONLY FOR SCR 61'S          A00
         LW,R6    CUN               CURRENT USER NO.                         A00
         LI,R14   UB:ACP            LEARN ASSOCIATED PROCESSOR               A00
         BAL,R0   GETADDR                                                    A00
         LB,R6    *R15,R6           PROC # TO R6                             A00
         BEZ      NO%HI%CORE        NONE                                     A00
         LI,R14   PX:HPP            FIND OUT IF PROC HAS ANY PAGES           A00
         BAL,R0   GETADDR                                                    A00
         LB,R15   *R15,R6           HEAD PAGE # TO R15                       A00
         BEZ      NO%HI%CORE        NONE                                     A00
         LI,R14   PB:PVA      GET 1ST VIRT PAGE OF COMMAND PROC              A00
         BAL,R0   GETADDR                                                    A00
         LB,R15   *R15,R6           VIRT PAGE ADDR TO R15                    A00
         CW,R15   USER%CXT%TOP      IS IT SHARED IN HI CORE                  A00
         BL       NO%HI%CORE        NO                                       A00
         LI,15    X'FF'             MAX VIRT PAGE #...
         STW,R15  USER%CXT%TOP      CHANGE UPPER LIMIT FOR CXT DISP          A00
NO%HI%CORE  EQU   %                                                          A00
         BAL,R0   CXTOUT            PUT OUT CONTEXT                          A00
NO:CUN   LCI      3                 SET UP TO RETURN
         PLM,R0   STACK                                                      A00
         B        SCANNER                                                    A00
         PAGE                                                                A00
*                                                                            A00
*   DISPLAY MONITOR ROOT                                                     A00
*                                                                            A00
MONITOR%ROOT EQU  %                                                          A00
         LCI      3                                                          A00
         PSM,R0   STACK                                                      A00
         BAL,R1   MD:CORE           PUT OUT MONITOR ROOT                     A00
         LCI      3                                                          A00
         PLM,R0   STACK                                                      A00
         B        SCANNER                                                    A00
         PAGE                                                                A00
*                                                                            A00
*    TEST IF WE ARE RUNNING AS A GHOST                                       A00
*    IFSO, DO ABBREVIATED USER DISPLAY.                                      A00
*    IF NOT, CONTINUE JOB                                                    A00
*                                                                            A00
END%GHOST%DEFAULT EQU %                                                      A00
         LW,R3    GJOB%FLAG         RUNNING AS A GHOST JOB
         BNEZ     ALLEXIT           YES, GHOST GOES THERE
         MTW,0    RUN%MODE          RUNNING AS A BATCH JOB/ONLINE USER
         BNEZ     SCANNER           YES, GO THERE
         B        ALLEXIT           DONT KNOW ASSUME GHOST JOB
         PAGE
*
*        INSURE 6 IS VALID INDEX AND RETURN IT
*
SETR6    AND,6    =X'3F'            MASK TO LIMIT
         BNEZ     %+2               LOOK OUT DUMMY
         LI,6     1                 OH OH
         SLS,6    1                 DBL-WRD INDEX
         AND,6    =-2               MASK IT AGAIN
         AI,6     STATEX            GET MSG ADDRS
         LW,1     6                 MOVE TO R1
         B        MSG               LINK STILL IN R0...
*
         PAGE
*
*        STATES
*
STATEX   EQU      %-2
1ST%STATE  EQU    %                                                          A00
         TEXTC    'SRT   '          1 - REAL TIME EXECUTE
         TEXTC    'SC0   '          2 - BACKGROUND PRIO
         TEXTC    'SC1   '          3 -
         TEXTC    'SC2   '          4
         TEXTC    'SC3   '          5
         TEXTC    'SC4   '          6
         TEXTC    'SC5   '          7
         TEXTC    'SC6   '          8
         TEXTC    'SC7   '          9
         TEXTC    'SC8   '          10
         TEXTC    'SC9   '          11
         TEXTC    'SC10  '          12
         TEXTC    'SCU   '          13 - CURRENT USER
         TEXTC    'STOB  '          14 - TERMINAL OUTPUT BLOCKED
         TEXTC    'STOBO '          15 - TERMINAL OUTPUT BLOCKED - OUT
         TEXTC    'SIOW  '          16 - I/O WAIT
         TEXTC    'SIOMF '          17 - MF TOO HIGH
         TEXTC    'SW    '          18 - ASLEEP
         TEXTC    'SQA   '          19 - QUEUED FOR ACCESS
         TEXTC    'SQR   '          20 - QUEUED FOR RESOURCE
         TEXTC    'SQRO  '          21 - QUEUED FOR RESOURCE - OUT
         TEXTC    'STI   '          22 - TERMINAL OUTPUTTING
         TEXTC    'STIO  '          23 - TERMINAL OUTPUTTING - OUT
         TEXTC    'SQFI  '          24 - QUEUED FOR INTERRUPT
         TEXTC    'NULL  '          25 - NOT USED
         TEXTC    'NULL  '          26 - NOT USED
         TEXTC    'NULL  '          27 - NOT USED
         TEXTC    'NULL  '          28 - NOT USED
         TEXTC    'NULL  '          29 - NOT USED
         TEXTC    'SNULL '          30 - NULL STATE FOR NO USER THERE
#STATES  EQU      (%-1ST%STATE)/2                                            A00
         PAGE
         USECT    DATA
PGCOUNT  DATA     0                 RUNNING COUNTER OF PAGES
         USECT    PP
*
*        RUN (PPAGES,UPAGES,MPAGES,STATES),(#)
*
RUN      LB,1     FIELD2
         LB,R2    RUNCOM            GET NUMBER OF COMMANDS
         CB,1     RUNCOM,2
         BE       RUNVEC,2
         BDR,2    %-2
RUNVEC   B        BADCOM
         B        UPAGES
         B        MPAGES
         B        PPAGES
         B        STATES
         B        RTPAGES
         B        XDELPGS
RUNCOM   TEXTC    'UMPSRX'
         PAGE
*
*        COMMAND FORMAT:
*
*
*        RU(N)    U(SER)#N
*
*        N=       USER# TO DISPLAY,OR ALL USERS IF N OMITTED
*
UPAGES   LI,1     UPGMSG          GET HEADER MSG
         BAL,0    TITEL             TITLE LINE OUT
         LI,1     2               GET THE JIT SPECIFIED
         BAL,0    GETHEX          BY GETTING THE TYPED FIELD
         LI,10    0               INITIALIZE USER
         LW,2     2               USER # SPECIFIED
         BNEZ     ULOOP           YES, GET HIS PAGES ONLY
         AI,2     1               START WITH FIRST USER
         LI,10    SMUIS           AND GET THEM ALL
ULOOP    LI,14    UH:FLG          CHECK TO SEE IF HES IN
         BAL,0    GETADDR         CORE
         LH,1     *15,2           GET HIS FLAGS
         CI,1     X'200'          JIT IN CORE?
         BAZ      UCONT           NO CONTINUE WITH NEXT
         STW,2    PG:MODE           SAVE USER#
         STW,2    USER              SET HIM TOO
         LCI      4                 INDICATE USER
         STCF     PG:MODE           USER MODE
         BAL,0    BLANK1            ONE BLANK LINE
         BAL,R0   RES:JIT           FIND THE JIT
         BCS,4    UCONT             NONE FOUND
         LI,1     JXPPH             BYTE DISP TO HEAD
         SLS,R1   -:BIG             CHANGE DISP IF BIG MAP MODE
         LOAD,4   *PAGEBUF,1
         LI,1     JXPPT             TO TAIL
         SLS,R1   -:BIG             CHANGE DISP IF BIG MAP MODE
         LOAD,5   *PAGEBUF,1
         LI,1     JBPPC
         LB,6     *PAGEBUF,1        AND COUNT
         BEZ      UCONT           IF NO PAGES, GET NEXT USER
         LI,1     UPMG            IF PAGES, THEN PRINT
         BAL,0    MSG             A HEADER WITH USERS NUMBER
         LW,3     2
         BAL,0    TRANSSZ
         BAL,0    PGSOUT          PUT OUT THE PAGES
UCONT    AI,2     1               BUMP THE USER NUMBER
         BDR,R10  ULOOP             DO NEXT ONE
         B        SCANNER           ALL DONE
         PAGE
*
*        DRIVE DISPLAY OF REAL TIME PAGES
*
RTPAGES  EQU      %
         LI,R1    RTPMSG
         BAL,R0   TITEL             TITLE LINE...
         LI,R14   PP:UPPH           HEAD OF REAL TIME PAGE CHAIN
         BEZ      NOTRACE           NOT REAL-TIME SYSTEM
         BAL,R0   GETADDR           PICK UP TABLES
         LCFI     5                 REAL-TIME OWNERS CODE
         STCF     PG:MODE           SAVED
         LCFI     3
         LM,R4    *R15              GET HEAD/TAIL/COUNT REAL-TIME PAGES
         BAL,R0   PGSOUT            AND PUT OUT DISPLAY
         B        SCANNER           ALL DONE
         PAGE
*
*        DRIVE DISPLAY OF XDELTA/HANDLER PAGES
*
XDELPGS  EQU      %
         LI,R1    DELPGS
         BAL,R0   TITEL             OUTPUT
         LI,R14   MP:UPPH           HEAD OF PAGE CHAIN
         BAL,R0   GETADDR
         LCFI     3
         LM,R4    *R15              PICK UP HEAD/TAIL/COUNT
         LCFI     6                 DELTA'S OWNER CODE
         STCF     PG:MODE           SAVED....
         BAL,R0   PGSOUT            PUT OUT THE CHAIN
         B        SCANNER
DELPGS   TEXTC    'XDELTA/HANDLER PAGE CHAINS:'
         PAGE
*
*        ASSUMES H,T,C IN 4,5,6
*
PGSOUT   LW,4     4               IF HEAD IS ZERO, RETURN
         BEZ      *0
         PSW,0    STACK           SAVE RETURN
         AND,4    =X'3FF'           JUST FOR NOW MASK IT
         LI,14    MX:PPUT
         BAL,0    GETADDR
         BAL,12   HLOOP
         LOAD,4   *15,4
         LI,1     14                SPACE
         BAL,0    SPACES            TO COL#4
         LI,1     TAILMSG
         LW,R3    R5                MMOVE THE VALUE FOR
         BAL,R0   MTB               PUTTING IT OUT
         LI,R1    13                INDENT TO
         BAL,R0   SPACES
         LI,R1    CNTMSG
         LW,R3    R6                MOVE THE COUNT
         BAL,R0   MTB               PUT IT OUT
         PLW,0    STACK
         B        *0
ARROW    TEXTC    ' > '
RTPMSG   TEXTC    'REAL TIME PAGES:'
BADFLMSG TEXTC    'S:BADFLG  = '
         PAGE
*
*        4 CONTAINS DISPLACEMENT, 15 CONTAINS WA OF TABLE
*
HLOOP    LI,1     14                INDENT TO
         BAL,0    SPACES            COL#6
         LI,1     HEADMSG
         BAL,0    MSG               INSERT MSG
         LI,0     1                 SET COUNTER,1 FOR HEAD PAGE
         STW,0    PGCOUNT           PAGE COUNTER
         BAL,0    PAGETABLE         INSERT HEAD PAGE#
         LI,11    56                MAX ROW OF DISPLAY
         B        PLOOP2            START OFF ROW
PLOOP1   LI,1     20                INDENT
         BAL,0    SPACES            TO HERE
PLOOP2   LW,3     4
         BAL,0    TRANSSZ
CHNEXU   EXU      *12
         BEZ      PTAILX
         BAL,0    PAGETABLE         BUILD TABLE
         MTW,1    PGCOUNT           BUMP COUNTER
         LI,1     ARROW
         BAL,0    MSG
         CW,11    COLPT           IS THE MSG TOO BIG
         BG       PLOOP2
         BAL,0    BUFOUT          YES, PUT IT OUT
         LI,3     1024              THE MOST THERE CAN EVER BE
         CW,3     PGCOUNT
         BL       TOOMANY           CHAIN IS CIRCULAR
         B        PLOOP1            NEXT ROW STARTING
PTAILX   LI,1     TAILMSG
         BAL,R0   MB
         CI,13    X'E2E3'         IS THIS A STATE CHAIN
         BE       HLRET           YES, EXIT
         CW,5     3               TAIL = TAIL?
         BE       CHKCOUNT          YES,CHECK COUNT
         MTW,0    INSWAP%SWAPPER%MIX                                         A00
         BNEZ     HLRET             YES                                      A00
         LI,1     ERRMSG1
         BAL,R0   MB
CHKCOUNT CW,6     PGCOUNT           IS COUNT OK
         BE       HLRET             YES,EXIT
         MTW,0    INSWAP%SWAPPER%MIX                                         A00
         BNEZ     HLRET             YES                                      A00
         LI,1     ERRMSG2           NO
         BAL,R0   MB
HLRET    EQU      %                                                          A00
         AI,R12   1                                                          A00
         MTW,0    INSWAP%SWAPPER%MIX                                         A00
         BEZ      *R12              NO                                       A00
         LI,R1    INSWAP%SWAP%MSG                                            A00
         BAL,R0   MB
         LI,R0    0                                                          A00
         STW,R0   INSWAP%HEAD       RESET                                    A00
         B        *R12              RETURN                                   A00
TOOMANY  EQU      %                 CIRCULAR CHAIN HANDLER
         LI,1     CIRCMSG
         BAL,R0   MB
         B        PTAILX            AND EXIT
         PAGE
*
*
HEADMSG  TEXTC    ' HEAD '
TAILMSG  TEXTC    ' TAIL '
CNTMSG   TEXTC    ' COUNT '
ERRMSG1  TEXTC    '   ***TAIL ERROR'
ERRMSG2  TEXTC    '   ***COUNT ERROR'
CIRCMSG  TEXTC    '   ***CIRCULAR PAGE CHAIN'
INSWAP%SWAP%MSG TEXTC '***SWAP CHAIN INCONSISTENCIES DUE TO',;               A00
                      ' AN UNFINISHED INSWAP***'                             A00
         USECT    DATA                                                       A00
INSWAP%HEAD  DATA  0                                                         A00
DOING%SWAP%CHAIN DATA  0                                                     A00
INSWAP%SWAPPER%MIX  DATA  0                                                  A00
         USECT    PP                                                         A00
         PAGE
*
*
*        RUN THE MONITOR FREE PAGE CHAIN - AND SWAPPER PAGE CHAIN
*
MPAGES   LI,1     MPGMSG
         BAL,0    TITEL
         LCI      2                 STORE
         STCF     PG:MODE           MODE
         LI,14    M:FPPH
         BAL,0    GETADDR
         LCI      3
         LM,4     *15
         BAL,0    PGSOUT
SPAGES   EQU      %                                                          B00
         MTW,1    DOING%SWAP%CHAIN                                           B00
         LI,R14   S:ISUN                                                     A00
         BAL,R0   GETADDR                                                    A00
         LW,R2    *R15              GET INSWAP USER NO.                      A00
         LI,R14   UH:FLG                                                     A00
         BAL,R0   GETADDR                                                    A00
         LH,R4    *R15,R2           HIS STSTUS FLAGS                         A00
         CI,R4    X'200'            TEST FOR IN-CORE                         A00
         BAZ      INSWAP%NOT%INCORE                                          A00
         STW,R2   PG:MODE                                                    A00
         STW,R2   USER                                                       A00
         LCI      4                                                          A00
         STCF     PG:MODE                                                    A00
         BAL,R0   LOCJIT            FIND HIS JIT                             A00
         BCS,8    %+2               ALREADY IN BUFFER                        A00
         BAL,R0   GETADDR                                                    A00
         LI,R1    JXPPH                                                      A00
         SLS,R1   -:BIG             CHANGE DISP IF BIG MAP MODE
         LOAD,R4  *PAGEBUF,R1                                                A00
         STW,R4   INSWAP%HEAD       HEAD OF INSWAP USER PAGE CHAIN           A00
INSWAP%NOT%INCORE  EQU   %                                                   A00
         LI,R1    SPGMSG            ADDRESS OF TITLE TEXT                    B00
         BAL,0    TITEL             TITLE LINE OUT
         LCI      1                 STORE
         STCF     PG:MODE           MODE
         LI,14    S:FPPH
         BAL,0    GETADDR           GET SWAPPERS HEAD
         LCI      3                 PICK UP HEAD, TAIL, COUNT
         LM,4     *15
         BAL,0    PGSOUT            AND PUT THEM OUT
         LI,R4    0                 RESET SWITCHES                           B00
         STW,R4   DOING%SWAP%CHAIN                                           B00
         STW,R4   INSWAP%SWAPPER%MIX                                         B00
         B        SCANNER
         PAGE
*
*        COMMAND FORMAT:
*
*        RU(N)    P(ROCS)#N
*
*        N=       PROCESSOR# TO DISPLAY OR ALL PROCESSORS
*                 IF NO OPTION FIELD
*
PPAGES   EQU      %
         LI,1     PPGMSG            SEND THE
         BAL,0    TITEL             TITLE LINE
         LI,1     2                 GO LOOK FOR
         BAL,0    GETHEX            AN OPTION
         AI,2     0                 WAS THERE
         BNEZ     PPLOOP0           YES,USE IT
         AI,2     1                 NO,START AT #1
         LI,7     PPROCS            SET MAX LOOP
         B        PPLOOP1           START IT OFF
PPLOOP0  LI,7     1                 SET FOR ONE PASS THRU
PPLOOP1  LI,3     3
PPLOOP2  EXU      PLO,3
         BAL,0    GETADDR
         EXU      PLOEXU,3
         STW,4    3,3
         BDR,3    PPLOOP2
         BEZ      PPCONT
         LI,14    P:NAME          PUT OUT NAME FIRST
         BAL,0    GETADDR         BUT ONLY IF THE PROCESSOR
         LD,10    *15,2             GET PROC NAME
         STW,2    PG:MODE           SAVE PROCESSOR#
         LCI      3                 INDICATE
         STCF     PG:MODE           PROCESSOR MODE
         LI,1     10
         BAL,0    MSG
         LI,1     #MS               INSERT # SIGN
         BAL,0    MSG               INSERT # SIGN
         LW,3     2                 INSERT PROCESSOR#
         BAL,0    TRANSSZ           IN PRINT LINE
         BAL,0    PGSOUT
         BAL,0    BLANK1            ONE BLANK LINE
PPCONT   AI,2     1                 NEXT INDEX
         BDR,7    PPLOOP1           GET NEXT PROCESSOR
         B        SCANNER
*
*
PLO      EQU      %-1
         LI,14    PX:HPP
         LI,14    PX:TPP
         LI,14    PB:PSZ
*
PLOEXU   EQU      %-1
         LOAD,4   *15,2
         LOAD,4   *15,2
         LB,4     *15,2
         PAGE
*
*        COMMAND FORMAT:
*
*        RU(N)    S(TATE)#N
*
*        N=       STATE VALUE TO LOOK FOR OR ALL STATES
*                 IF NO OPTION FIELD
*
STATES   LI,1     STCMSG
         BAL,0    TITEL             TITLE LINE OUT
         LI,13    X'E2E3'         FROM STATE CHAIN
         LI,1     2
         BAL,0    GETHEX
         LI,10    0
         LW,2     2
         BNEZ     %+3
         LI,2     1
         LI,10    SNSTS
STLOOP   LI,14    SB:HQ
         BAL,0    GETADDR
         LB,4     *15,2
         BEZ      STLOOP2         LOOP IF NO ONE IN QUEUE
         LI,1     STATEMSG
         BAL,0    MSG
         LW,6     2                 SET
         BAL,0    SETR6             R6 UP
         LI,14    UB:FL
         BAL,0    GETADDR
         BAL,12   HLOOP
         LB,4     *15,4
         BAL,0    BLANK1            ONE BLANK LINE
STLOOP2  AI,2     1
         BDR,10   STLOOP
         LI,13    0               ZAP THE INDICATOR
         B        SCANNER
         PAGE
UPMG     TEXTC    'USER#'
         PAGE
STATEMSG TEXTC    'STATE  '
UPGMSG   TEXTC    'USER PAGE CHAINS:'
MPGMSG   TEXTC    'MONITOR (FREE) PAGE CHAIN:'
PPGMSG   TEXTC    'PROCESSOR PAGE CHAINS:'
STCMSG   TEXTC    'USER STATE CHAINS:'
SPGMSG   TEXTC    'SWAPPER PAGE CHAIN:'
         PAGE
*
*        BUILD PHYSICAL MEMORY PAGE MAP
*        THE PAGE# IS IN R4,THE OWNER'S CODE
*        IS IN PG:MODE
*
*        MODE SETTINGS:
*        7 =      READ AHEAD PAGE
*        6 =      XDELTA'S CORE
*        5 =      REAL TIME USERS PAGE
*        4 =      USERS PAGE
*        3 =      PROCESSOR
*        2 =      MONITOR
*        1 =      SWAPPER
*
PAGETABLE EQU     %
         CI,13    X'E2E3'           FROM STATE CHAIN
         BE       *0                YES,EXIT
         LCFI     6
         PSM,0    STACK             SAVE ALL REGS
         MTW,0    DOING%SWAP%CHAIN                                           A00
         BEZ      NOT%SWAP%CHAIN                                             A00
         CW,R4    INSWAP%HEAD                                                A00
         BNE      NOT%SWAP%CHAIN    NOT SAME PAGE AS SWAPPER HEAD            A00
         MTW,1    INSWAP%SWAPPER%MIX  SAME PAGES IN TWO CHAINS               A00
NOT%SWAP%CHAIN  EQU  %                                                       A00
         MTW,0    PG:ARRAY          GOT BUFER YET
         BNEZ     PG:IN             ALREADY GOT ONE
         CAL1,8   GETTWO            GET ONE THEN
         BCS,8    NO:PGS            CANT GET IT
         STW,9    PG:ARRAY          STORE ADDRESS
         LI,0     0                 SET UP
         LI,1     0
         STW,0    *9,1
         AI,1     1
         CI,1     1024
         BL       %-3               TILL 512K PAGES
PG:IN    AND,4    =X'3FF'           512K MAX
         LW,1     PG:MODE           GET TYPE OF OWNER
         LW,2     *PG:ARRAY,4       GET PREVIOUS CELL
         BEZ      STO:PG            IS OK
         LC       PG:MODE           IS THIS XDELTA'S PAGE
         BCS,6    NO:PGS            YEP..LEAVE IT AS A USER PAGE
         LC       R2                NO...BUT DID DELTA OWN IT
         BCS,6    STO:PG            YEP, GIVE IT TO THIS USER NOW..
         LI,5     X'FF'             SET MULTIPLE FLAG
         STB,5    1                 STORE RESULT
STO:PG   STW,1    *PG:ARRAY,4       AND STORE RESULTS
NO:PGS   LCFI     6
         PLM,0    STACK
         B        *0
         USECT    DATA
PG:ARRAY DATA     0                 POINTER TO BUFFER
         USECT    PP
         PAGE
*
*        DISPLAY PHYSICAL MEMORY MAP
*
PHYMAP   EQU      %
         MTW,0    PG:ARRAY          WAS IT BUILT
         BEZ      SCANNER           NO,EXIT
         LI,1     PGMAPMS           OUTPUT
         BAL,0    TITEL             TITLE LINE OUT
         LI,5     16                SET LOOP
         LI,2     -1                INIT ROW
         STW,2    ROW#              PROPERLY
         LI,3     0                 NOW SET INDEX
PHYMAP0  LB,1     PGSPAC,3
         BAL,0    SPACES
         BAL,0    TRANSSZ           INSERT#
         AI,3     1
         BDR,5    PHYMAP0
         BAL,0    BUFOUT            OUTPUT HEADER LINE
         LW,1     PG:ARRAY          GET POINTER
         AI,1     -16               ADJUST IT DOWN
         STW,1    PG:POINT          PROPERLY
PHYMAP1  BAL,0    BLANK1            ONE BLANK LINE
         LI,2     16
         AWM,2    PG:POINT          SET POINTER
         LI,4     0                 SET UP FOR NEXT ROW
         LW,1     ROW#              GET ROW#
         AI,1     1                 BUMP
         STW,1    ROW#              REPLACE
         CW,1     ROWCNT            AT MAX YET
         BL       PHYMAP11          KEEP GOING
         LI,2     0
         XW,2     ODDROW            ANY ODD COUNT TO DO
         BEZ      PHYMAP5           NO,ALL DONE
PHYMAP11 LW,3     ROW#              GET ROW NUMBER CURRENTLY
         BAL,0    TRANSSZ           IN COL#1
PHYMAP2  LB,1     PGSPAC,4          GET SPACING
         AI,1     -1                BACK UP FOR EASY READING
         BAL,0    SPACES            TO NEXT COL#
         LI,3     0
         XW,3     *PG:POINT,4       GET CELL
         LB,6     3                 GET POINTER
         SLS,6    -4                POSITION POINTER
         CI,R6    7                 IN RANGE
         BLE      PHYMAP3           YEP
         LI,1     DBLPG             NO,TWO OWNERS
         B        PHYMAP30          GO THERE TO PUT IT INTO TABLE
PHYMAP3  LW,1     PHOWN,6           GET OWNER
         AI,3     0                 IS THIS PAGE OWNED
         BNEZ     PHYMAP32          YEP
PHYMAP30 LW,0     ROW#              CALCULATE
         SLS,0    4                 POSITIONS THE TENS FIELD
         AW,0     4                 THE PHYSICAL PAGE#
         CW,0     JITPAGE           IS THIS THE JIT PAGE
         BNE      PHYMAP31          NO
         LI,1     JITPGMS           YES,LETS PUT
         B        PHYMAP32          MSG IN THAT ROW
PHYMAP31 CW,0     FIRSTPG           IS IT ALLOCATABLE AREA
         BGE      %+3               YES
         LI,1     UTSMSG            NO,IN ROOT
         B        PHYMAP32          PRINT 'UTS'
         LW,7     PG:ARRAY          ADDRESS OF TABLE
         LW,5     PAGECNT           CURRENT INDEX
         STW,0    *7,5              STORE PAGE# AWAY
         MTW,1    PAGECNT           BUMP INDEX
PHYMAP32 BAL,0    MSG               SHOVE OUT MSG
         LI,1     #MS
         CI,6     3                 IS MON/SWAP
         BL       PHYMAP4           YES
         CI,R6    4                 IS RT/XDELTA
         BG       PHYMAP4           YES
         BAL,0    MSG
         AND,3    =X'FF'            GET#
         BAL,0    TRANSSZ           PUT IN COLUMN
PHYMAP4  AI,4     1                 BUMP TO NEXT
         BDR,2    PHYMAP2           DO NEXT ONE
         BAL,0    BUFOUT            PUT OUT ROW
         B        PHYMAP1           DO NEXT ROW
         PAGE
*
*        NOW DISPLAY ALL THE UN-OWNED PAGES WE
*        FOUND IN THE PHYSICAL MEMORY MAP
*
PHYMAP5  EQU      %
         LW,2     PAGECNT           GET INDEX
         CI,2     1                 ANY GET MOVED
         BE       PHYMAP8           NO,EXIT
         LI,1     UNOWNMS
         BAL,0    TITEL             MAKE A TITLE LINE
         BAL,0    UNMAP
PHYMAP6  LW,3     *PG:ARRAY,2       GET A PAGE#
         BEZ      PHYMAP7           NOBODY THERE
         BAL,0    BLANK1            ONE BALNK LINE
         LI,1     UNOWNMS1
         BAL,R0   MTBB              PUT IT OUT
         LW,R1    R3                PHYSICAL PAGE #
         OR,R1    BATFLAG           SET ONE PAGE READ FLAG
         BAL,R0   GETPAGE           BRING IT IN
         LW,8     PAGEBUF
         LI,7     X'200'            SIZE OF IT
         BAL,0    DUMPSOME          DUMP IT OUT
PHYMAP7  BDR,2    PHYMAP6           KEEP GOING
PHYMAP8  LI,7     1                 INDEX
         STW,7    PAGECNT           COVER ALL TRACKS
         B        SCANNER           AND RETURNO NEXT
UNOWNMS  TEXTC    'UNALLOCATED PAGES:'
UNOWNMS1 EQU      TCMSG2
         USECT    DATA
PAGECNT  DATA     1                 INDEX TO TABL
ROW#     DATA     0
PG:POINT DATA     PG:ARRAY-16
         USECT    PP
PHOWN    DATA     PH0,PH1,PH2,PH3,PH4
         DATA     PH5
         DATA     PH6
         DATA     PH7
PH7      TEXTC    'RAPP'
PH0      TEXTC    '****'
PH1      TEXTC    'SWAP'
PH2      TEXTC    'FREE'
PH3      TEXTC    'P'
PH4      TEXTC    'U'
PH5      TEXTC    '*RT*'
PH6      TEXTC    'XDEL'
#MS      TEXTC    '#'
DBLPG    TEXTC    'MULT'
PGMAPMS  TEXTC    'PHYSICAL MEMORY ALLOCATION:'
JITPGMS  TEXTC    'JIT'
         USECT    DATA
JITPAGE  DATA     X'46'
FIRSTPG DATA      X'40'
         USECT    PP
SYMBOLMS TEXTC    'SYMBOL MAP:'
UTSMSG   TEXTC    'CP-V'                                                     A00
PGSPAC   DATA,1   5,12,19,26,33,40,47,54,61,68,75,82,89
         DATA,1   96,103,110,117,124
         BOUND    4
         PAGE
*
*        MASK     XXXXXXXX
*
MASK     LI,1     1
         BAL,0    GETHEX
         STW,2    MASQ
         B        SCANNER
         PAGE
         USECT    DATA
MASQ     DATA     -1
*
*        SEARCH   XXXXXXXX,LOC-LOC  (WITH MASK SPECIFIED)
*
SERVAL   DATA     0
*
         PAGE
*
*        COMMAND FORMAT:
*
*        SE(ARCH) VALUE,START,STOP
*
*        WHERE;
*
*        VALUE=   VALUE TO LOOK FOR
*        START=   STARTING WA IN CORE
*        STOP=    ENDING ADDRESS (WA) IN CORE
*
         USECT    PP
SEARCH   LI,1     1
         BAL,0    GETHEX
         STW,2    SERVAL
         LI,1     2
         BAL,0    LOCLOC
         LW,14    8
         BAL,0    GETADDR
SRLOOP1  EQU      %
         LW,R2    *R15              GET VALUE
         LW,R3    MASQ              GET MASK
         CS,R2    SERVAL            COMPARE TO VALUE GIVEN
         BE       SRFOUND           ***GOTCHA***
SRLOOP2  EQU      %
         AI,R15   1                 NEXT POSITION
         AI,R8    1                 NEXT ADDRESS
         CLM,R15  BUFLIM            STILL IN BUFFER
         BCR,9    SRLOOP3           YEP - GO ON
         LW,1     OLDPAGE
         AI,R1    1                 BUMP TO NEXT PAGE NUMBER
         BAL,0    GETPAGE
         LW,15    PAGEBUF
SRLOOP3  BDR,7    SRLOOP1
         B        SCANNER
         PAGE
*
*        FOUND WORD USER IS LOOKING FOR
*
SRFOUND  EQU      %
         STW,R8   LASTLOC           KEEP REMEMBERING LAST LOC
         LCFI     2
         PSM,R7   STACK
         LI,R7    1                 GONNA DUMP ONE WORD
         AND,R8   X1FF              MASK OFF TO PAGE INDEX
         AW,R8    PAGEBUF           POINTER INTO BUFFER
         BAL,R0   DUMPSOME          DUMP IT OUT
         LCFI     2
         PLM,R7   STACK
         B        SRLOOP2           GO ON TO NEXT WORD
         PAGE
*
*        ROUTINE  TO  ACT ON DISPLAY OPTIONS
*
DISPLAY  EQU      %
         LI,R2    #DISPLAYS         LOOP COUNT
         LI,R1    SCANNER           DEFAULT RETURN LINK
         LH,R3    FIELD2            GET OPTION
         CH,R3    DCOM,R2           FIND MATCH
         BE       GO:DISPLAY        GOT IT
         BDR,R2   %-2
         B        BADCOM
GO:DISPLAY EXU    DISP:ACT,R2       GO TO TARGET ROUTINE
         PAGE
*
*        SUBROUTINES TO PERFORM REQUESTED FUNCTION
*
DISP:ACT EQU      %
         GEN,8,24  X'68',SCANNER    0 -0 - NO OPTION
         GEN,8,24  X'68',REGS      X'681 - REGISTER DISPLAY
         GEN,8,24  X'68',TPAGE      2 -2 - PAGE WHERE TRAP OCCURED
         GEN,8,24  X'68',PATCHES    3 -3 - PATCH FILE CONTENTS
         GEN,8,24 X'68',ALLJIT      4 -4 - IN CORE USERS
         GEN,8,24 X'68',ALLOUTJIT   5 -5 - OUT OF CORE USERS
         GEN,8,24 X'68',MDTRAPS     6 -6 - TRAP LOCS (XPSD'S)
         GEN,8,24 X'68',USERS       7 -7 - USER TABLES
         GEN,8,24 X'68',UID         8 -8 - USER NAME/ACCOUNT
         GEN,8,24 X'68',PAGEDISP    9 -9 - PHYSICAL PAGE DUMP
         GEN,8,24 X'68',QFREELIST   10-10- FREE IOQ LIST
         GEN,8,24 X'68',PHYMAP      11-11- PHYSICAL PAGE MATRIX
         GEN,8,24 X'68',JITS        12-12- SPECIFIED JIT
         GEN,8,24 X'68',PROCS       13-13- PROCESSOR TABLES
         GEN,8,24 X'68',COCODE      14-14- COC TABLES
         GEN,8,24 X'68',SWAP        15-15- SWAPPER TABLES
         GEN,8,24 X'68',IODISPLAY   16-16- ALL I/O TABLES
         GEN,8,24 X'68',PARTITIONS  17-17- PARTITION TABLES
         GEN,8,24 X'68',SYMBIONTS   18-18- RBBAT RECOVERY FILE
         GEN,8,24 X'68',MDIOSYM     19-19- IOQ TABLES ONLY
         GEN,8,24 X'68',MD:CORE     20-20- MONITOR ROOT
         GEN,8,24 X'68',MDTRAPS     21-21- TRAP TABLES
         GEN,8,24 X'68',MDDCB       22-22- USER DCBS
         GEN,8,24 X'68',MONITOR%ROOT 2323- MONITOR ROOT
         GEN,8,24 X'68',%CITS       24-24- CIT TABLES
         GEN,8,24 X'68',%IOQS       25-25- IOQ ENTRIES
         GEN,8,24 X'68',%DCTS       26-26- DCT TABLES ONLY
         GEN,8,24 X'68',CURRENT%USER 2727- CURRENT USER MEMORY
         GEN,8,24 X'68',RECOVERY%CONTEXT 28- SELF EXPLANATORY
         GEN,8,24 X'68',RAT%TABLES  29- RESOURCE STUFF
         GEN,8,24 X'68',AVR%TABLES  30- VOLUMN TABLES
         GEN,8,24 X'68',SYMTABLS    31- SYMBIONT TABLES
         GEN,8,24 X'68',ALLYTABL    32- ALLYCAT'S TABLES
         GEN,8,24 X'68',ADAMDUMP    33- ADAM'S MEMORY
         GEN,8,24 X'68',DISPSTK     34- TSTACK BURST
         GEN,8,24 X'68',VIR:PAGE    35- VIRTUAL PAGE DUMP
         GEN,8,24 X'68',RA:TABL    35.5- B00 CP-V DISPLAY
         GEN,8,24 X'68',ERROR%LOG   36- ERROR LOG DUMP
         GEN,8,24 X'68',MD:SUBQ     37- RESOURCE WAIT QUEUE
         B        A2RETURN
         PAGE
DCOM     TEXTC    ' RE',;           REGS
                  'TP',;            TRAPPED PAGE
                  'PF',;            PATCH FILE
                  'AJ',;            ALL USER JIT/AJITS/CONTEXT
                  'OJ',;            OUT OF CORE JITS
                  'TR',;            TRAPS
                  'US',;            USERS
                  'ID',;            USER IDENTIFICATION
                  'PP',;            PHYSICAL PAGE DISPLAY
                  'FQ',;            DISPLAY FREE QUEUES
                  'PM',;            PHYSICAL PAGE MAP                        B00
                  'JI',;            JITS
                  'PR',;            PROCS
                  'CO',;            COC TABLES
                  'SW',;            SWAP
                  'IO',;            IO TABLES
                  'PA',;            PARTITIONS
                  'SY',;            SYMBIONT TABLES
                  'P1',;            MONDUMP STYLE
                  'P2',;
                  'P3',;
                  'P4',;            DCB'S                                    A00
                  'MR',;            MONITOR ROOT                             A00
                  'CI',;            CIT'S                                    A00
                  'IQ',;            IOQS                                     A00
                  'DC',;            DCTS                                     A00
                  'CU',;            CURRENT USER                             A00
                  'RC',;            RECOVERY CONTEXT                         A00
                  'RA',;            RESOURCE ALLOC TABLES                    A00
                  'AV',;            AVR TABLES                               A00
                  'ST',;            SYMBIONT TABLES                          A00
                  'AT',;            ALLYCAT TABLES
                  'AD',;            ADAM'S MEMORY DUMP
                  'TS',;            DISPLAY TSTACK CONTENTS
                  'VP',;            DISPLAY VIRTUAL PAGE #
                  'FM',;            FILE MANAGEMENT READ-AHEAD TABLES
                  'EL',;            ERROR LOG BUFFERS
                  'RQ'              RESOURCE WAIT QUEUES
#DISPLAYS EQU     HA(%)-HA(DCOM)-1
         PAGE
*
*        DUMP A PHYSICAL PAGE #; COMMAND FORMAT:
*
*        DI(SPLAY) PP#XX,YY,ZZ
*
*        WHERE;
*
*        XX:      PHYSICAL PAGE NUMBER
*        YY:      STARTING DISPLACEMENT OR ZERO OR NONE
*        ZZ:      ENDING DISPLACEMENT OR ZERO OR NONE
*
*        AS IN:
*
*        DI(SPLAY) PP#40,0,4
*
*        OR;
*
*        DI(SPLAY) PP#40      GETS YOU THE WHOLE PAGE
*
PAGEDISP EQU      %                 ALREADY UNMAPPED ENTRY
PAGEDISP1 LI,R1   2                 FIELD POSITION FOR PAGE #
         BAL,0    GETHEX            IN HEX
         LW,1     2                 CAME BACK IN TWO
         OR,R1    BATFLAG           SET ONE PAGE READ FLAG
         BAL,0    GETPAGE           READ THAT PAGE IN
         LW,R1    OLDPAGE           GET THE PHYSICAL PAGE #
         BAL,R0   DISP:PP           AND DISPLAY IT
         LI,1     3                 NOW GET DISPLACEMENTS
         BAL,0    LOCLOC
         AW,8     PAGEBUF           STARTING ADDRS
         CI,7     1                 WANTS AT LEAST 1
         BNE      %+2               YES
         LI,7     X'200'            NO,DUMP THE WHOLE THING
         LI,0     SCANNER           SET RETURN POINT
         B        DUMPSOME          AND DUMP PAGE OUT
         PAGE
*
*        COMMAND 'DISPLAY VP#X,Y,Z
*
*        WHERE:
*
*        X        IS VIRTUAL PAGE #
*        Y        IS STARTING INDEX (OR NONE)
*        Z        IS ENDING INDEX   (OR NONE)
*
VIR:PAGE EQU      %
         MTW,0    MAPFLAG           ARE WE MAPPED NOW
         BNEZ     PAGEDISP1         YEP
         LI,R1    NOMAP:MSG         NO
         LI,R0    SCANNER
         B        MSG%OUT           PRINT ERROR/RETURN TO SCANNER
NOMAP:MSG TEXTC 'YOU HAVE NOT MAPPED ANY USER YET'
         DEF      PROCNAME
         USECT    DATA
         BOUND    8
PROCNAME TEXTC    'METASYM'
MSG%OUT  EQU      BMBB
MSG%OUT1 EQU      MB
CLOSESTSYM DATA   0                 ADDRESS OF SYMBOL TEXTC (CLOSEST ONEE)
CLOSESTADD DATA   0                 SYMBOL'S ADDRESS (CLOSEST ONE)
UHFLGR   DATA     UH:FLG
UHFLGR1  DATA     UX:JIT+SMUIS
         PAGE
*
*        BLANK THE PRINT BUFFER / RESET PRINTING TABLES
*
         USECT    PP
BLNKBUF  LCFI     2
         PSM,R0   STACK
         LI,R1    0
         STW,R1   PTR
         STW,R1   TPTR
         STW,R1   COLPT
         LI,R1    BA(OBUF)
         LI,R0    OBUFSIZ*4
         STB,R0   R1
         LW,R0    BLNKBYT
         MBS,R0   0
         LCFI     2
         PLM,R0   STACK
         B        *R0
         PAGE
*
*        BLANK A LINE
*
BLANK1   EQU      %
         CAL1,1   WRITBLNK          WRITE THE BLANK LINE
         B        *R0               AND EXIT
*
*
*
WRITBLNK GEN,8,24  17,M:LO
         GEN,4,28   3,0
         DATA     BLANKS
         DATA     2
TAPE:MSG TEXTC 'ENTER TAPE TYPE: 7T,9T,BT ETC..'
         USECT    DATA
         BOUND    8
SYM:LIMS DATA     MONORG,J:JIT+511
JIT:LIMS DATA     J:JIT,J:JIT+511
PATCHLOC DATA     MPATCH,MX:PPUT+10
SYMBOL:FLAG DATA  0,0
         USECT    PP
*
         PAGE
*
*        RESTORE JIT FOR USER NUMBER IN 'USER'
*
RES:JIT  EQU      %
         LCFI     3
         PSM,R0   STACK
         LI,R0    0
         STW,R0   MAPFLAG
         LW,R2    USER
         BNEZ     RES:JIT1          GET THE USER JIT
         LI,R14   J:JIT             NEED THE MONITOR'S JIT
         B        RES:JIT2
RES:JIT1 BAL,R0   LOCJIT            FIND IT
         BCS,12   RES:JIT3          GOT IT / OR THERE IS NONE
RES:JIT2 LW,R1    R14               MOVE THE PHYSICAL PAGE WA
         SLS,R1   -9                INTO A PAGE NUMBER
         OR,R1    BATFLAG           ADD THE ONE PAGE READ FLAG
         BAL,R0   GETPAGE           GO GET THE PAGE INTO CORE
RES:JIT3 LCFI     3                 NOW RESTORE REGS
         PLM,R0   STACK
         LC       JITSTAT           RETURN CONDITIONS TO CALLER
         B        *R0               EXIT TO CALLER
         PAGE
*
*        INPUT IN R3 THE ADDRESS TO USE AGAINST
*        'CLOSESTADD' TO CALCULATE SYMBOL DISPLACEMENTS
*
DISP:OFF EQU      %
         PSW,R0   STACK
         SW,R3    CLOSESTADD        SUBTRACT IT OFF
         BEZ      DISP:OFF3         NONE
         BGZ      DISP:OFF1         POSITIVE
         LCW,R3   R3                FLIP IT OVER
         LI,R1    MINUSDOT
         B        DISP:OFF2         JUMP
DISP:OFF1 LI,R1   PLUSDOT
DISP:OFF2 BAL,R0  MSG
          BAL,R0  TRANSSZ
DISP:OFF3 PLW,R0  STACK
          B       *R0               AND EXIT
PLUSDOT  TEXTC    '+.'
MINUSDOT TEXTC    '-.'
         PAGE
*
*        R12 CONTAINS ADDRESS TO SEARCH FOR SYMBOL
*
GRABSYM  PSW,R1   STACK             SAVE LINK
         AND,R12  =X'1FFFF'         MASK
         CLM,R12  SYM:LIMS          WILL WE FIND A SYMBOL
         BCS,9    GRABSYM2          NO, JUST EXIT
         BAL,R1   SVALTXT           GO SEARCH
         BEZ      GRABSYM2          DIDNT FIND ANYTHING
         LI,R9    80                WE'LL WORK BACKWARDS FROM
         LW,R2    CLOSESTSYM        HERE
         CLM,R12  JIT:LIMS          IS VALUE IN THE JIT
         BCS,9    GRABSYM0          NOPE
         AI,R2    -4                BACK UP ONE ENTRY
         B        GRABSYM1          GO
GRABSYM0 AI,R2    -1                POINT TO VALUE SLOT
         CW,R12   0,R2              FIRST FIND WHERE SYMBOL FITS IN
         BG       GRABSYM01         GOTCHA
         BE       GRABSYM1          NEVER PASS UPP AN EQUALITY
         AI,R2    -3
         BDR,R9   %-4
GRABSYM01 AI,R2   1                 POINT TO TEXT SLOT
         LC       *R2               TEST FOR MODULE BASE DEF
         BCS,2    GRABSYM02         GOTCAH
         AI,R2    -3                BACK UP TO NEXT SLOT
         BDR,R9   %-3               KEEP GOING
GRABSYM02 AI,R2   -1                POINT BACK TO VALUE
GRABSYM1 LW,R1    0,R2              GET THE SYMBOL'S VALUE
         STW,R1   CLOSESTADD        AND SAVE
         AI,R2    1                 POINT TO TEXTC STRING
         STW,R2   CLOSESTSYM        SAVE TEXTC ADDRESS
GRABSYM2 EQU      %
         MTW,0    ANLZ1FLG          OVERLAY#1 CALLING
         BEZ      %+2               NO
         BAL,R1   ANLZ1RET          YES - FORCE IT BACK IN
         PLW,R1   STACK
         B        0,R1
         USECT    DATA
         DEF      ANLZ1FLG
ANLZ1FLG DATA     0
         USECT    PP
         PAGE
*
*        ROUTINE TO PRINT GENERAL REGISTERS
*
REGS     EQU      %
         PSW,1    STACK             SAVE LINK
         LI,1     REGMSG            SET HDR ADDRS
         BAL,0    TITEL             TITLE LINE OUT
         MTW,1    REG%FLAG          TELL WORLD WE'VE BEEN HERE               A00
         LI,14    RCVCODE
         BAL,0    GETADDR
         LH,3     *15               SCREECH CODE
         STW,R3   SCREECH%CODE   FOR LATER USE BY OTHER ROUTINES             A00
         LB,R1    SCR:CNT           LENGTH OF TABLE
         CB,R3    SCR:CNT,R1        SEE IF SCREECH CAUSED BY TRAP
         BE       REGS01            GOT EM
         BDR,R1   %-2
         B        REGS02            SCREECH NOT FROM A TRAP
REGS01   MTW,1    TRAP:SCR          BOOST THE FLAG HIGH
REGS02   LI,R1    RCMSG             NOW PUSH OUT TITLE LINE
         BAL,0    MSG
         BAL,0    TRANSSZ
         LW,3     *15               GET SUBCODE
         AND,R3   =X'FF'            MASK OFF SUBCODE...
         LI,1     RC1MSG
         BAL,R0   MTBB              PUT IT OUT
         STW,R3   SUBCODE           SAVE SUBCODE
         LI,R2    3                 INDEX TO
         STB,R3   ERRMSGKEY,R2      STORE SUBCODE IN KEY
         LW,R3    SCREECH%CODE      GET MAJOR PORTION OF CODE
         LI,R2    2                 INDEX TO STORE
         STB,R3   ERRMSGKEY,R2      STORE THAT
         LI,R2    1                 INDEX TO STORE
         LI,R3    X'08'             GROUP CODE
         STB,R3   ERRMSGKEY,R2      STORED
         LI,R3    X'03'             KEY LENGTH
         STB,R3   ERRMSGKEY
         CAL1,1   OPEN:SCR
         CAL1,1   SET:SCR           SET ERR/ABN
TRYAREAD CAL1,1   READ:SCR          TRY READING CURRENT KEY
         LW,R1    F:SCR+13          GOT IT - GET ARS
         AI,R1    -1
         STW,R1   BUFSIZ            STORE IT
         CAL1,1   WRITBUF           WRITE IT OUT
         LI,R7    F:SCR             SET DCB ADDRS
         BAL,R0   CLOSEDCB          CLOSE DCB OUT
         BAL,R0   BLANK1
         B        REGSOUT
NOSCRF   LI,R1    NOSCRFM           OPEN ERROR MSG
         B        ERRMSG110         JUMP
NOSCRK   LW,R3    ERRMSGKEY         GET KEY
         CI,R3    X'FF'             WAS THERE AN SUBCODE
         BAZ      NOSCRK1           NOPE
         AND,R3   =X'FFFFFF00'      STRIP SUBCODE
         STW,R3   ERRMSGKEY
         B        TRYAREAD          TRY READING AGAIN
NOSCRK1  LI,R1    NOSCRKM           KEYED READ ERROR MSG
ERRMSG110 BAL,R0  MSG%OUT           PRINT THAT LINE
REGSOUT  EQU      %
         LI,R14   S:BADFLG
         BEZ      REGSOUT1         ITS NOT B00
         BAL,R0   BLANK1
         BAL,R0   GETADDR          GET IT
         LI,R1    BADFLMSG
         LW,R3    *R15              GET VALUE
         BAL,R0   MTBB              PUT IT OUT
REGSOUT1 LI,R14   SAVEREGS         NLOC FOR REG BLOCK 0
         LI,R1    RBLOCK0           MESSAGE
         BAL,R0   MSG%OUT           OUTPUT TO LO
         BAL,0    GETADDR           THAT PAGE
         LI,7     16
         MTW,1    DUMP:DIR          SET DIRECT FLAG
         LW,8     15
         BAL,R0   DUMPSOME          PUT THAT OUT
         LI,R8    COCFLAG           COC TYPE SYSTEM
         BEZ      REGSOUT2          NOPE
         LI,R14   SAVEREGS1         YEP
         BAL,R0   GETADDR           GET REGISTER BLOCK 1
         LI,R1    RBLOCK1           MESSAGE
         BAL,R0   MSG%OUT           OUTPUT
         MTW,1    DUMP:DIR          RELATIVE ADDRESSING
         BAL,R0   DUMPSOME          PUT OUT THE BLOCK
REGSOUT2 EQU      %
         LI,R14   J:ALB             LAST BRANCH ADDRESS
         BEZ      REGSOUT3          NOT A C00 SYSTEM
         BAL,R0   UNMAP
         BAL,R0   GETADDR           GET IT
         LW,R3    *R15              GET VALUE
         BAL,R0   BLANK1
         LI,R1    ALBMSG            PUT OUT MSG
         BAL,R0   MTBB              MSG/TRANSSZ/BUFOUT/BLANK1
REGSOUT3 EQU      %
         PLW,R0   STACK
         B        *R0
ALBMSG   TEXTC    'LOCATION OF LAST BRANCH:  '
         USECT    DATA
TRAP:SCR DATA     0                 SET IF 7E / 79 / 61 TRAP
         USECT    PP
REGMSG   TEXTC    'REGISTERS:'
RCMSG    TEXTC    '   SCREECH CODE:  '
RC1MSG   TEXTC    '   SUB-CODE:  '
         USECT    DATA
ERRMSGKEY         DATA   X'03087E40'
SUBCODE  DATA     0
         USECT    PP
NOSCRFM  TEXTC    'CANNOT OPEN ERROR MESSAGE FILE'
RBLOCK0  TEXTC    '   ** REGISTER BLOCK 0 **'
RBLOCK1  TEXTC    '   ** REGISTER BLOCK 1 **'
NOSCRKM  TEXTC    '**** UNLISTED SCREECH ***'
         PAGE
         USECT    PP
*
*        ROUTINE TO PRINT LOC-LOC OF SPECIFIED USER JIT
*        DISPLAY JITS,(M,#),LOC-LOC
*
*
JITS     LB,1     FIELD3
         CI,1     X'D4'             M IN EBCDIC
         BNE      USRJIT
M:JIT    LI,1     MJITMSG           TITLE LINE MSG
         BAL,0    TITEL             TITLE LINE OUT
         LI,14    J:JIT
         LI,R0    JITMSGOUT         RETURN POINT
         B        GETADDR           FOR GET ADDRESS ROUTINE
USRJIT   LI,1     UJITMSG
         BAL,0    MSG
         LI,1     2
         BAL,0    GETHEX
         STW,2    USER              SAVE USER#
         BAL,0    BUST4             PRODUCE USER# MSG
         BAL,R0   RES:JIT           GET THE JIT
         BCS,4    SCANNER           NONE TO BE FOUND
         LW,1     JITPAGE           JIT'S PAGE #
         XW,1     OLDPAGEM          FOR DUMP ADDRESSING
         MTW,0    J:PAGE            WAS USER IN OR OUT
         BGZ      JITINCORE         IN CORE
         LI,R1    OUTJITMSG         OUT
         BAL,R0   MSG%OUT
         B        JITMSGOUT
JITINCORE BAL,R0  DISP:PP           SHOW JIT CORE ADDRESS
JITMSGOUT LI,R1   3                 NOW GO LOOK FOR OPTION#3
         BAL,0    LOCLOC
         CI,7     1
         BNE      %+2
         LI,7     X'200'
         AW,8     PAGEBUF
MJIT1    MTW,0    LPFLAG            GOING TO LINE PRINTER
         BEZ      MJIT2             NO,MUST DO IT OLD WAY
         MTW,0    USER              DOING MONITORS JIT...
         BEZ      MJIT2             BRANCH IF 8 COL (I.E. MON JIT)           A00
         LI,1     JIT1              LOCATION OF TABLE
         MTW,1    JITBURST          SET FLAG FOR ANALZO2
         BAL,7    MDSNAP4           DUMP IT
         B        SHOW:TSTACK
         USECT    DATA
JIT1     DATA     J:JIT
JIT2     DATA     J:JIT+511
         B        0,7
         USECT    PP
MJIT2    BAL,0    DUMPSOME          DO ONLINE MODE DUMP
         MTW,0    USER              DOING AN ONLINE REQUEST
         BNEZ     SCANNER           YES - QUIT
         BAL,R1   DISPSTK           NO - SHOW MONITOR'S TSTACK
SHOW:TSTACK B     SCANNER
*
*
CXTMSG   TEXTC    'CONTEXT AREA FOR'
MJITMSG  TEXTC    'MONITOR JIT:'
         PAGE
*                                                                    RL2
*        ROUTINE TO DUMP ALL IN-CORE USERS                           RL2
*                                                                    RL2
*
ALLJIT   EQU      %                                                  RL2
         LI,14    S:ISUN            GET INSWAP
         BAL,0    GETADDR           USER TO
         LW,1     *15               SAVE FOR LATER
         STW,1    ISUN              CHECKING
         LI,14    UH:FLG            NOW LETS LOOK
         BAL,0    GETADDR           FOR ALL OF THE
         LI,1     SMUIS             IN CORE USERS
         LI,2     1                 SET UP COUNTER
         LI,3     X'200'            IN CORE FLAG
AJ1      CH,3     *15,1             IS USERS JIT IN CORE
         BAZ      AJ15              NO ITS NOT
         CW,1     CUN               IS THIS ONE CURRENT USER
         BE       AJ15              YES,SKIP IT
         CW,1     ISUN              IS THIS ONE INSWAP USER
         BE       AJ15              YES,SKIP IT
         STB,1    OSUL,2            STICK THIS ONE INTO LIST
         AI,2     1                 BUMP COUNTER
AJ15     BDR,1    AJ1               FINISH MAX LIST
         LI,14    SB:OSUL                                            RL2
         BAL,0    GETADDR                                            RL2
         LB,1     *15                                                RL2
         STW,1    OSULSIZE                                           RL2
         BEZ      AJ17
AJ16     LB,3     *15,1             GET OUTSWAP USER#
         STB,3    OSUL,2                                             RL2
         AI,2     1                                                  RL2
         BDR,1    AJ16                                               RL2
AJ17     LW,3     ISUN              PUT INSWAP USER INTO LIST
         STB,3    OSUL,2                                             RL2
         STB,2    OSUL                                               RL2
AJ4      EQU      %                                                          A00
         LW,R3    ISUN              IS THERE AN INSWAP USER
         BGZ      AJ41              YES
         MTB,-1   OSUL              NO - DECREMENT LIST
         B        AJ42
AJ41     LI,R1    ISJITMSG          TITLE LINE
         BAL,R0   PUTITOUT
AJ42     LW,R2    OSULSIZE          IS THERE AN OUTSWAP LIST
         BEZ      AJ43              NO
         LI,R1    OSJITMSG          TITLE LINE
         BAL,R0   PUTITOUT
         BDR,R2   %-2               FINISH OUTSWAP LIST
AJ43     LI,R1    JITMSG            INCORE USER TITLE
         BAL,R0   PUTITOUT
         B        %-1               LOOP UNITL LIST COMPLETED...
         PAGE
*                                                                    RL2
*        DRIVE THE JIT-AJIT-CONTEXT DUMP DISPLAY HERE
*                                                                    RL2
PUTITOUT EQU      %                                                  RL2
         MTB,0    OSUL              LIST ZERO?
         BLEZ     AJOX              DONE
         LCI      3
         PSM,0    STACK
         BAL,6    AJOUT                                              RL2
         LC       JITSTAT           TEST JIT FOUND FLAG
         BCS,4    AJO4              GET OUT - JIT NOT FOUND
         BAL,6    AJITA             PUT OUT AJIT
         BAL,0    CXTOUT            PUT OUT CONTEXT AREA
AJO4     MTB,-1   OSUL              STEP LIST DOWN
         BAL,R0   BLANK1
         LCI      3
         PLM,0    STACK
         B        *0                                                 RL2
AJOX     EQU      %                                                          A00
         MTW,0    RUN%MODE                                                   A00
         BEZ      TCONT             GHOST IS FINISHED                        A00
         B        ALLOUTJIT         BATCH OR ONLINE ALL IN PROGRESS          A00
         PAGE
*
*        RUN THRU USER LIST DISPLAYING JITS
*        THAT WERE ON THE SWAPPER
*
ALLOUTJIT EQU     %
         LI,2     SMUIS             MAXIMUM LOOP
         STW,2    USER              SET MAXIMUM LOOP
NEXT:US  LW,2     USER              GET NEXT USER#
         LI,14    UB:US             USER STATE TABLE
         BAL,0    GETADDR           BRING IT IN
         LB,3     *15,2             GET USERS STATE
         CI,R3    #STATES
         BE       NEXTUSER          NULL STATE CHECK
         AND,3    =X'1F'            SCRUB EM DOWN
         STW,3    USTATE            SAVE STATE VALUE
         MTW,1    LOOKING           SET THE EXPLORATORY FLAG
         BAL,0    LOCJIT
         BCS,4    NO:JIT            NONE FOR THIS USER
         BCS,2    NO:JIT            IT WAS IN CORE
         LI,R1    OUTUSERS          TITLE LINE
         STB,R2   R1                REMEMBER USER #
         BAL,R0   TITEL             RECORD IT
         MTW,1    JITBURST          DIRECT DUMP
         LI,1     U1:MSG
         BAL,0    MSG               FIRST PART OF MSG LINE
         LW,6     USTATE            GET STATE#
         BAL,0    SETR6             AND PRODUCE MSG FROM IT
         BAL,R0   BUFOUT
         BAL,0    BUST4             PLACE USER# INTO MSG
         LW,8     PAGEBUF
         LI,7     512
         BAL,0    DUMPSOME
         BAL,R1   DISPSTK           SHOW TSTACK
NO:JIT   EQU      %
NEXTUSER EQU      %
         MTW,-1   USER              DECREMENT USER # TO NEXT ONE
         BGZ      NEXT:US           KEEP GOING TILL LIST DEPLETED
         B        TCONT             NOW DISPLAY TABLE OF CONTENTS
         USECT    DATA
USTATE   DATA     0
LOOKING  DATA     0
STLIST   EQU      %
MAXLP    EQU      BA(%)-BA(STLIST)-1
         USECT    PP
U1:MSG TEXTC 'USER''S STATE = '
LCOLON   TEXTC    ' ( '
RCOLON   TEXTC    ' ) '
         USECT    PP
         PAGE
*
*        CLOSE DCB ADDRESS IN R7
*
CLOSEDCB CAL1,1   CLOSE:R7
         B        *R0
         PAGE
*
*        INSURE VALIDITY OF PAGE # IN R1
*
PAGE:CHK CW,R1    FIRSTPG           IS PHYSICAL PAGE IN MONITOR
         BL       SADTEST           YES - POSSIBLE ERROR
         CLM,R1   PAGLIMS           NO -- IS IT A VALID PHYSICAL PAGE
         BCS,9    SADTEST           NO
         AI,R0    1                 ALL OKAY
         B        *R0               EXIT
*
*        CAN'T RESTORE THE JIT - EXIT OUT OF CONTEXT DISPLAY
*
LOSTJIT  LCFI     2
         PLM,R0   STACK
         B        FINCXT            GET COMPLETELY OUT OF DISPLAY
*
*        PAGE # IS IN MONITOR - SEE IF THE USER DID A CVM CAL
*
SADTEST  LCFI     2
         PSM,R0   STACK
         CI,R3    0                 ARE WE LOOKING AT THE USER'S CMAP
         BNEZ     BAD:CXT           ERROR IN DCBUL OR DCBLL
         BAL,R0   RES:JIT           RESTORE THE USER'S JIT
         BCS,4    LOSTJIT           ERROR EXIT
         LI,R1    JBLMAP            BYTE INDEX TO LMAP
         AW,R1    R4                ADD VIRTUAL INDEX INTO LMAP
         LB,R1    *PAGEBUF,R1       GET THE CONSTANT IN JB:LMAP
         CI,R1    X'01'             WAS PAGE GOTTEN BY CVM CAL
         BNE      BADPPC            NOPE
         LI,R1    SADPGMSG          YES - SHOW A MSG
PGMSGOUT BAL,R0   MSG%OUT           PUT OUT THE MSG
         LCFI     2
         PLM,R0   STACK
         B        *R0
*
*        USER HAS A PHYSICAL PAGE IN HIS CMAP WHICH SHOULD
*        NOT BE THERE - DISPLAY A WARNING MESSAGE
*
BADPPC   LI,R1    BADPMSG           ERROR IN CMAP MESSAGE
         B        PGMSGOUT
*
*        USER HAS AN INVALID DCB CHAIN POINTER IN HIS JIT
*
BAD:DCBP LI,R1    BADDCBMSG
         BAL,R0   MSG%OUT
         B        NO%DCBS           JUST SKIP THE DISPLAY
*
*        USER HAS AN INVALID SEQUENCE IN HIS SPARE BUFFER TABLES
*
BADSPBCXT LI,R1   SPBBADMSG
         BAL,R0   MSG%OUT
         B        DCBCXT            JUMP UP TO USER'S CONTEXT AREA
         PAGE
*
*        USER HAS BAD POINTERS TO HIS CONTEXT AREA (BCBLL & DCBUL)
*        DOCTOR UP OUR POINTERS AND CONTINUE THE DISPLAY
*
BAD:CXT LI,R4     JBUPVP
         STW,R4   STRTDCB
         LI,R4    JSPVP+1           PHONY UP THE POINTERS
         STW,R4   ENDDCB
         LI,R1    BADCXTMSG
         BAL,R0   MSG%OUT
         LCFI     2                 BALANCE THE STACK
         PLM,R0   STACK
         B        DCBCXT            RE-ENTER THE ROUTINE
         PAGE
*
*        ERROR MESSAGES TO PUT OUT DEPENDING ON THE ERROR TYPE
*
BADCXTMSG TEXTC '**DCBLL/DCBUL CLOBBERED '
SADPGMSG TEXTC '**FOLLOWING PAGE OBTAINED BY SAD CAL'
BADPMSG TEXTC '**FOLLOWING PAGE IS INVALID FOR THIS USER TO OWN'
BADDCBMSG TEXTC '**DCB POINTER CLOBBERED - DCBS LOST'
SPBBADMSG TEXTC '**ERROR IN SPARE BUFFER TABLES'
         PAGE
*
*        DISPLAY USER'S CONTEXT AREA AS INDICATED
*        IN CMAP IN HIS JIT
*
CXTOUT   EQU      %
         LW,1     ISUN              IN-SWAP USER#
         CW,1     USER              IS WE ON THIS USER#
         BE       *0                YES,HE HAS NO CONTEXT AREA
         PSW,0    STACK
         LI,R2    1                                                          A00
         STW,R2   SPECIFIC%USER%DCBS                                         A00
         LW,2     USER              GET CURRENT USER#
         BEZ      FINCXT            ERROR - GET OUT
         MTB,0    R2                ALREADY GOT A FLAG SET
         BNEZ     %+2               YEP
         OR,R2    BATFLAG           NO - SET IT NOW
         BAL,0    MAP:USER          MAP USER INTO "MAP"
         LC       JITSTAT           CHECK FLAG
         BCS,4    FINCXT            DIDNT READ ONE
         LI,R0    0                 NOW RESET
         STW,R0   MAPFLAG           MAP TRANSLATION (JUST NEED IMAGES)
         LI,3     JDCBUL            SET UPPER LIMIT OF CONTEXT
         LI,R1    CXTMSG
         BAL,R0   BLANK1
         BAL,R0   BLANK1
         BAL,R0   MSG
         BAL,R0   BUST4
         LI,R3    JDCBUL            CONTEXT UPPER LIMIT CELL
         LW,R1    *PAGEBUF,R3       GET IT
         BAL,R0   PAGE:CHK          EXAMINE IT
         B        FINCXT            ERROR EXIT
         MTW,0    ENDDCB            DOING CURRENT USER DUMP
         BNEZ     %+2               YES - JUMP OVER
         STW,R1   ENDDCB            STOP POINT
         LI,R3    JDCBLL            CONTEXT LOWER LIMIT CELL
         LW,R1    *PAGEBUF,R3       GET IT
         BAL,R0   PAGE:CHK          CHECK IT
         B        FINCXT            ERROR EXIT
         STW,R1   STRTDCB           SAVE IT
         LI,R3    DCBLINK           INDEX TO GET DCB POINTER
         MTW,0    *PAGEBUF,R3       USER HAVE DCBS
         BLZ      BAD:DCBP          BAD
         BEZ      NO%DCBS           DIDNT HAVE ANY
         BAL,R1   OVERLAY2          GO GET THE OVERLAY
NO%DCBS  EQU      %                                                          A00
         LI,4     JXBUFVP           FIRST SPARE BUFFER PAGE
         BNEZ     %+2               AHAH ITS B00 CP-V
         LI,R4    JOVVP             NO, ITS  A00 CP-V
CXTLOOP  LOAD,R1  MAP,R4            GET A PHYSICAL PAGE NO.                  A00
         BEZ      MORECXT           SKIP ON IF ZERO
         CLM,R1   NULLPAGE          IS A NULL MAP CONSTANT
         BCR,9    MORECXT           YES, SKIP TO NEXT INDEX
         LI,R3    0                 PASS ARG TO PAGE CHECK
         BAL,R0   PAGE:CHK          INSURE VALIDITY OF PAGE #
         NOP      %                 ERROR RETURN -- BUT WE'LL DUMP IT
         CI,R4    JOVVP             IS USER AREA -->X'8000'
         BL       SPBCXT            ITS A SPARE BUFFER
         BE       DCBCXT            DUMP DCB AREA
CXTDMP0  OR,R1    BATFLAG           SET ONE PAGE READ FLAG
         BAL,R0   GETPAGE           BRING IN THE PAGE
         STW,R4   OLDPAGEM          SAVE VIRTUAL MEMORY ADDRESS
CXTDMP   BAL,0    DISP:PP           DISPLAY PHYS PAGE #..
         LW,8     PAGEBUF
         LI,7     512
         BAL,0    DUMPSOME        DUMP THAT CONTEXT PAGE
MORECXT  AI,4     1                 BUMP PAGE#
         CW,R4    USER%CXT%TOP      AT TOP OF USER YET                       A00
         BL       CXTLOOP           NOPE
FINCXT   EQU      %
         LI,R0    0
         STW,R0   ENDDCB            RESET FOR NEXT TIME AROUND
         MTW,7    MAPFLAG
         PLW,R0   STACK             GET RETURN LINK
         B        UNMAP             RESET MAP IMAGES
         PAGE
*
*        DUMP THE 'B00' SPARE BUFFER TABLES
*
*
SPBCXT   BAL,R0   BLANK1
         LI,1     IXMSG             BUFFER INDEX LINE
         BAL,0    MSG
         LW,3     4                 BUFFER INDEX NUMBER
         AI,3     1-JXBUFVP
         AND,R3   =X'1F'            MASK TO LIMIT
         CI,R3    20                AT MAX LIMIT
         BG       BADSPBCXT         ERROR
         BAL,0    TRANSSZ
         BAL,0    BUFOUT
         LOAD,1   MAP,4
         B        CXTDMP0           GO GET PAGE / DUMP IT
         PAGE
*
*        DUE TO THE LOADER GOOFING UP THE 'BREF' MODE
*        ANALYZE IS FORCED TO OVERLAY THIS ONE ROUTINE ITSELF
*
OVERLAY2 EQU      %
         CAL1,8   SEGO2             GET IT
         B        A2RETURN          SNEAK UP THER TO THE OVERLAY
SEGO2    GEN,8,24 1,0
         DATA     %+1
         TEXTC    'ANALZO2'         SEGMENT NAME
         PAGE
*
*        SPARE BUFFERS ARE OUT - DUMP THE USER'S
*        CONTEXT AREA OF CORE
*
DCBCXT   LI,4     JBUPVP            ASSUME FULL DUMP
         MTW,0    RUN%MODE          IF BATCH/ONLINE GIVE FULL
         BNEZ     CXTLOOP           DUMP OF ALL USERS.. FROM
         LW,2     USER              BUP TO .FF...
         AND,R2   #R16              MASK OFF FLAGS IN BYTE ZERO
         CW,2     CUN               ALSO IF GHOST ANLZ AN CUN
         BE       CXTLOOP
         LW,2     ENDDCB            OTHERWISE, DUMP ONLY HIS
         AI,2     1
         STW,2    USER%CXT%TOP      DCB PAGES..
         LW,4     STRTDCB
         B        MORECXT+1
         BOUND    8
NULLPAGE DATA     X'20',X'22'
         USECT    DATA
SPECIFIC%USER%DCBS  DATA   0                                                 A00
         USECT    PP
PPMSG    TEXTC    '*** PHYSICAL PAGE#'
IXMSG    TEXTC    '*** SPARE BUFFER INDEX#'
         USECT    DATA
USER%CXT%TOP DATA 128
ENDDCB   DATA     0
STRTDCB  DATA     0
         USECT    PP
         PAGE
*
*        WE'LL INITIALIZE 'USER' HERE - FLAGS GET ADDED
*        BY 'AJO1' AND HONORED ELSEWHERE
*
AJOUT    EQU      %
         PSW,R6   STACK             SAVE LINK
         LB,3     OSUL              HEAD IS INDEX
         LB,2     OSUL,3            GET A USER#
         STW,2    USER              SAVE USER#
         BEZ      AJXIT             NONE THERE
         STB,R2   R1                REMEMBER USER NUMBER
         BAL,R0   TITEL             RECORD IT
         BAL,4    AJO1            PUT OUT THE JIT
AJXIT    PLW,R6   STACK
         B        0,R6              EXIT TO CALLER
         PAGE
*
*        CHECK IF THE JIT CONTAINS A LIKELY LOOKING TEMMP STACK
*        DOUBLE-WORD - IF IT DOES CALL THE JIT DISPLAYER
*
AJO1     EQU      %
         LW,2     USER              CURRENT USER#
         AND,R2   #R16              MASK PRIOR FLAGS
         CW,R2    ISUN              IS THIS THE INSWAP USER
         BE       %+2               YEP - HAVE TO FIND HIS JIT
         OR,R2    BATFLAG           NO - ADD THE NO SCAN FLAG
         STW,R2   USER              STORE IT BACK
         BAL,R0   RES:JIT           GET THE USERS JIT
         BCS,4    0,R4              NONE TO BE FOUND
         PSW,R4   STACK             SAVE EXIT LINK
         LI,3     JAJ               GET AJIT'S
         LW,5     *PAGEBUF,3        PAGE#
         STW,5    JAJPAGE           SAVED FOR LATER
AJO2     BAL,R0   BUST4             PUT OUT USER #
         LW,R1    J:PAGE            GET PHYSICAL PAGE #
         BGZ      AJO25             WAS ON CORE
         LI,R1    OUTJITMSG         WAS OUT OF CORE
         BAL,R0   MSG%OUT           PRINT THAT LINE
         B        AJO26             JUMP
AJO25    BAL,R0   DISP:PP           SHOW PHYSICAL PAGE #
AJO26    CI,R4    AJITA1            ARE WE SHOWING THE AJIT
         BE       AJO5              YEP, SKIP CHECKS
         LI,R3    TSTACK-J:JIT+1    NO, LETS SEE IF THE JIT LOOKS GOOD
         INT,R5   *PAGEBUF,R3       GET STACK WORD 1
         AI,R3    -1
         LW,R3    *PAGEBUF,R3       GET STACK WORD 2
         SW,R3    R5                SUBTRACT DIFFERENCE
         CI,R3    TSTACK+1          WELL
         BE       AJO261            OKAY, PROBABLY A GOOD JIT
         LI,R1    BADJITMSG         SHOW A WARNING MSG
         BAL,R0   MSG%OUT           PRINT THAT LINE
         LCFI     4                 SET CC'S TO INDICATE
         STCF     JITSTAT           BAD SEQUENCE
         B        AJO5              AND JUST SNAP IT OUT
AJO261   EQU      %
         MTW,1    JITBURST          NO,SET FLAG
         MTW,0    LPFLAG            GOING TO LINE PRINTER
         BEZ      AJO5              NOPE,DO ONLINE DUMP
         LI,1     JIT1
         BAL,7    MDSNAP4           DUMP IT
         PLW,R1   STACK             GET EXIT ADDRESS
         B        DISPSTK           AND DUMP TSTACK
AJO5     EQU      %
         LW,8     PAGEBUF
         LI,7     X'200'
         PLW,R0   STACK             GET EXIT ADDRESS
         B        DUMPSOME
BADJITMSG  TEXTC  '***WARNING: THIS DOESNT LOOK LIKE A GOOD JIT'
OUTJITMSG         TEXTC  '***THIS USER WAS OUT OF CORE'
         USECT    PP
         PAGE
*
*        DISPATCH THE AJIT DUMP FROM HERE
*
AJITA    EQU      %
         LW,2     USER              CURRENT USER WE'RE ON
         LW,1     JAJPAGE           AJIT'S PAGE#
         BEZ      *6              NO AJIT PAGE
         CLM,1    PAGLIMS           VALID PAGE#
         BCS,9    *6                NO,EXIT
         PSW,R6   STACK             SAVE EXIT ADDRESS
         STW,1    J:PAGE            SAVE PAGE#
         OR,R1    BATFLAG           ADD THE ONE PAGE READ FLAG
         BAL,0    GETPAGE
         BAL,R0   BLANK1
         LI,1     AJITMSG
         BAL,0    MSG
         LI,R4    JAJITVP           SET TO DISPLAY VIRTUAL                   A00
         STW,R4   OLDPAGEM             ADDRESSES FOR AJIT                    A00
         BAL,4    AJO2            PUT OUT THE JIT
AJITA1   B        0,6               AND EXIT
         USECT    DATA
JAJPAGE  DATA     0
         USECT    PP
         PAGE
         USECT    DATA
CUN      DATA     0                                                  RL2
ISUN     DATA     0                                                  RL2
OSULSIZE DATA     0                                                  RL2
OSUL     EQU      %
         DO1      64                                                 RL2
         DATA,1   0
         BOUND    4
         USECT    PP
AJITMSG  TEXTC    'ADDITIONAL JIT FOR'
CUJITMSG TEXTC    'CURRENT USER:'
OUTUSERS TEXTC    'OUT OF CORE USER:'
ISJITMSG TEXTC    'INSWAP USER:'
OSJITMSG TEXTC    'OUTSWAP USER:'
JITMSG   TEXTC    'INCORE USER:'
UJITMSG  TEXTC    'JIT OF'
         PAGE
*
*  PROVIDE A DUMP OF THAT PORTION OF MEMORY USED AT RECOVERY
*  TIME BY THE RECOVERY CODE.  THIS DUMP DOES NOT INCLUDE
*  THE RECOVERY MODIFIED TRAP LOCATIONS.
*
RECOVERY%CONTEXT  EQU   %
         PSW,R1   STACK             SAVE RETURN ADDRESS
         LI,R1    RCVRY%CXT%MSG
         BAL,R0   TITEL             PRINT TITLE
         LI,R1    RCV%CXT%MSG                                                A00
         BAL,R0   MSG%OUT           PRINT THE HEADING
         LW,R14   RCVLIMITS
         BAL,R0   GETADDR
         LW,R7    RCVLIMITS+1
         SW,R7    RCVLIMITS         SUBTRACT OFF THE BASE WA
         LW,R8    PAGEBUF
         PLW,R0   STACK             SET UP RETURN ADDR FOR DMP ROUTINE
         B        DUMPSOME          GO TO DUMP ROUTINE
RCVRY%CXT%MSG TEXTC         'RECOVERY CONTEXT:'                              A00
RCV%CXT%MSG    TEXTC      '(MONITOR AREA AS MODIFIED BY RECOVERY)'           A00
         USECT    PP
         PAGE
*
*        BUILD USER# PRINT LINE
*
BUST4    EQU      %
         LCFI     4
         PSM,0    STACK
         LI,1     US:MSG            FIRST SEND THIS MSG
         BAL,0    MSG               TO PRINT LINE
         LW,3     USER
         AND,R3   #R16              MASK IF OFF
         BAL,R0   TBB               PUT IT OUT
         LCFI     4
         PLM,0    STACK
         B        *0
US:MSG   TEXTC    ' USER# '
         PAGE
*
*        ROUTINE TO DUMP LOC-LOC
*
*
*
DUM      LI,1     1               DUMP COMMAND ENTRY
         B        DUMEP
DUMP     LI,1     0               LOC-LOC IN FIELDS 0-1
DUMEP    BAL,0    LOCLOC
         LI,2     0
         STW,9    LASTLOC         AND SAVE IT FOR INDIR
         LW,3     8
         SCD,2    -9                CONVERT ADDRESS TO PAGE #
         LW,1     3
         BAL,0    GETPAGE
         SLS,2    -23
         LW,8     2
         AW,8     PAGEBUF
         BAL,0    DUMPSOME
         B        SCANNER
*
        PAGE
*
*       ROUTINE TO REPLACE CELLS IN THE RUNNING MONITOR
*       IN RESPONSE TO  (LOCATION) = (VALUE)  WITH THE MONITOR
*       DUMP FLAG ON
*
REPLACEMENT EQU   %
        MTW,0     MONFLAG
        BEZ       NOREP
         LB,1     JB:PRIV
         CI,R1    X'B0'             IS PRIVILEGE HIGH ENUFF
         BL       NOGOT             NOPE
        LI,1      0
        LI,9      0
        BAL,0     LOCLOC          GET BOTH LOCATION AND VALUE
         STW,R8   LASTLOC           REMEMBER LAST LOCATION
         LW,R14   R8                GET BASE WA OF LOCATION
         BAL,R0   GETADDR           GET THE PAGE INTO MY MAP
         STW,R9   *R15              STORE VALUE AWAY
ZAPREP   EQU      %
         LI,0     0
         STW,0    REPFLAG
        B         SCANNER
*
NOREP   EQU       %
        LI,1      NOREPMSG
        BAL,0     MSG
        BAL,0     BUFOUT
         B        ZAPREP
*
NOREPMSG TEXTC    'YOU MUST BE LOOKING AT THE MONITOR TO CHANGE IT'
         USECT    DATA
LASTLOC  DATA     0               LAST LOCATION DUMPED
         PAGE
         USECT    PP
*
*        DRIVE THE INDIRECT(*) , NEXT(LF) , AND LAST(UP ARROW)
*        COMMANDS FROMM HERE
*
INDIR    LW,14    LASTLOC         GET LAST
         BAL,0    GETADDR
         LI,1     X'1FFFF'        MASK
         LW,8     *15             GET CONTENTS OF LAST
         AND,8    1               GET THE ADDRESS
INDREP   LW,9     8               FOR LAST LOCATION
         LI,7     1               NUMBER TO DUMP
         B        DUMEP+1         AND PRINT IT
*
DNEXT    LW,8     LASTLOC
         AI,8     1
         B        INDREP
DLAST    LW,8     LASTLOC
         AI,8     -1
         B        INDREP
*
         PAGE
*
*        ROUTINE TO COMPARE THE DUMP WITH THE RUNNING MONITOR
*
COMPARE  EQU      %
         LI,R1    COMP:HD           HEADING
         BAL,R0   MBB               MSG / BUFOUT / BLANK1
         LI,1     1
         BAL,0    LOCLOC            GET FIELDS
         LW,4     8
COMPLOOP EQU      %
         BAL,R0   COMP:SET          SET UP COMPARE PAGES
         LI,R5    X'1FE00'
         STS,R4   SADCAL1           STORE ADDRESS INTO SAD CAL
         LW,R14   R4
         BAL,R0   GETADDR           GET DUMP FILE ADDRESS
         CAL1,8   SADCAL1           MAP ONTO MONITOR
         BCS,8    NOSADPAGE         DIDNT WORK
         LW,R14   R4
         AND,R14  X1FF              DISPLACEMENT INTO PAGE
         AW,R14   VIRPAGE1          MAPPED ADDRESS
COMPLOOP1 EQU     %
         LW,R13   *R14              MONITOR CONTENTS
         CW,R13   *R15              COMPARED TO DUMP FILE
         BNE      PRINTCOM          PRINT IF DIFFERENT
CLP2     EQU      %
         AI,R14   1                 NEXT MONITOR CONTENTS
         AI,R15   1                 NEXT DUMP   ......
         AI,R4    1
         AI,R7    -1
         BLEZ     SCANNER           ALL DONE
         CLM,R15  BUFLIM            IS POINTER STILL IN RANGE
         BCS,9    COMPLOOP          NO, ADVANCE TO NEXT PAGE
         B        COMPLOOP1         YES, KEEP GOING
         PAGE
*
*        AT THIS POINT, R14 = ADDRESS OF LOCATION IN MONITOR
*                       R15 = ADDRESS OF DUMP LOCATION =/ R14
*                       R8  = ABSOLUTE ADDRESS OF BOTH
*                       R7  = NUMBER OF LOCATIONS LEFT TO PROSESS
*                       R9  = ADDRESS OF PAGE MONITOR IS BEING MAPPED
*                             INTO
*
PRINTCOM EQU %
         LW,R3    R4                ADDRESS WE'RE AT
         STW,R3   LASTLOC           REMEMBER LOCATION
         LI,R1    1                 SPACING FOR ADDRS
         BAL,R0   SPACES
         BAL,R0   TRANSSZ           ADDRS OUTPUT
         LI,R1    10                NEXT SPACING
         BAL,R0   SPACES
         LW,R3    *R14              CONTENTS OF MONITOR
         BAL,R0   TRANS             OUT
         LI,R1    20                NEXT
         BAL,R0   SPACES            SPACING
         LW,R3    *R15              CONTENTS OF DUMP FILE
         BAL,R0   TRANS
         BAL,R0   BUFOUT            PRINT THE WHOLE LINE
         B        CLP2              GO TO NEXT ADDRESS
COMP:HD  TEXTC    ' ADDRESS  MONITOR   DUMP FILE'
         PAGE
*
*        GET TWO PAGES FOR COMPARISON BUFFERS
*
COMP:SET EQU      %
         PSW,R0   STACK
         BAL,R0   RES:BUF           RESTORE ORIGINAL BUFFERS IF NECESSARY
         LW,R9    VIRPAGE1          ALREADY HAVE BUFFER
         BGZ      COMP:SET1         YEP - JUMP
         CAL1,8   GETTWO            GET TWO MORE
         BCS,8    NO:COMP           CANT DO IT
         STW,R9   VIRPAGE1          REMEMBER BASE ADDRESS
COMP:SET1 EQU     %
         CAL1,8   GETIT             RESTORE IT
         CAL1,8   FREEIT            AND FREE IT FOR CVM CAL
         AI,R9    512               NEXT HIGHER PAGE
         CAL1,8   GETIT             RESTORE IT
         CAL1,8   FREEIT            AND FREE IT FOR CVM PAGE
         PLW,R0   STACK
         B        *R0
*
*
NO:COMP  EQU      %
         LI,R1    COMPBUFMSG
         B        PUSHMSG
COMPBUFMSG TEXTC  'COULD NOT ACQUIRE BUFFERS FOR COMPARISON'
         USECT    DATA
SADCAL1  GEN,8,24 7,0
VIRPAGE1 DATA     -1
         USECT    PP
X1FF     DATA     X'1FF'
         PAGE
*
*
*        IN: R1  = NEXT FIELD #
*        OUT:R7  = # OF WORDS TO GO OUT
*            R8  = STARTING LOCATION
*            R9  = END LOCATION
LOCLOC   PSW,0    STACK             SAVE RETURN
         BAL,0    GETHEX            GET FIRST FIELD
         AI,1     1
         STW,2    8
         BAL,0    GETHEX            GET NEXT FIELD
         STW,2    9
         MTW,0    REPFLAG           REPLACING A CELL
         BNEZ     LOCLOC1           YEP, GET OUT NOW
         CI,R9    0                 WAS ONLY LOCATION GIVEN
         BNEZ     LOCLOC0           NO, TWO LOCS
         LW,R2    R8                YES, MAKE SECOND EQUAL TO FIRST
         LW,R9    R8                ALSO RETURN R9 SAME AS FIRST LOC
LOCLOC0  SW,R2    R8                CALCULATE LENGTH OF AREA TO DUMP
         BLZ      LOCERR            ERROR
         LW,R7    R2                PASS BACK LENGTH IN R7
         AI,R7    1                 PLUS ONE FOR START CELL
LOCLOC1  PLW,R0   STACK             GET LINK
         B        *R0               AND EXIT
*
LOCERR   LI,1     LOCMSG
         B        PUSHMSG           OUTPUT MSG/GO TO SCANNER
LOCMSG   TEXTC    'LOC1 > LOC2 '
         PAGE
*
*        ROUTINE  TO CONVERT FIELD IN R1 TO HEX
*        EQUIVALENT IN R2
*
GETHEX   LW,R2    FIELDS,R1         ANYTHING THERE
         BEZ      *R0               NOPE - EXIT
         LCFI     6                 YES - HAVE TO BREAK IT DOWN
         PSM,3    STACK             START WITH R3
         LW,4     FIELDS,1
         LI,6     0               INIT R6
GETHEX1 LI,R2     0                 CLEAR ACCUMULATOR
         LI,3     0                 PTR INTO FIELD
GLOOP    LB,5     *4,3
         BEZ      GEXIT             GUARANTEED <=8 BYTES BY SCANNER
         AI,5     -X'F0'
         BGEZ     %+2
         AI,5     X'39'
         CLM,5    NUMERAL
         BCS,9    BAD:HEX           BAD NUMBER
         SLS,2    4
         AW,2     5
         AI,3     1
         CI,3     8
         BGE      GEXIT             DONE AT 8
         B        GLOOP
         PAGE
*
*        HIT A CHARACTER THAT IS NOT HEXADECIMAL ORIENTED NUMMBER
*
*
BAD:HEX LI,R2     1                 FOR FIELD # 1 INDEX
         AI,R1    0                 IN FIELD 1
         BEZ      %+2               YEP
         AI,R2    1                 ELSE BUMP FOR FIELD 2 INDEX
         CI,R1    0                 WHAT FIELD WERE WE ON
         BEZ      %+2               FIELD NUMBER ONE
         AW,R2    FIELD1C           OR ADD FIELD ONE COUNT
         AW,R2    R3                ADD CURRENT INDEX
         LW,R1    R2                MOVE IT TO PROPER REG
         B        IBADCOM           GO PRINT % AND EH
         BOUND    8
NUMERAL  DATA     0,X'F'
                  PAGE
*
*        CHECK IF USER TO OPERATE ON NUMBERS IN SOME FASHION
*
*        WE'LL ADD,SUBTRACT OR MULTIPLY HERE
*
GEXIT    LB,5     OPS,1           ANY OPS TO DO
         BEZ      GEXIT1          NO, RETURN
         LW,6     6               GET IT ALREADY
         BNEZ     OPDIL             ALREADY GOT IT
         LW,R6    R2                HOLD FIRST FIELD IN R6
         LW,R4    OPFIELD,R1        GET POINTER TO LOC
         LI,R2    0                 RESET R2
         MTW,0    0,R4              IS THERE A VALUE IN THE FIELD
         BNEZ     GETHEX1           YES - GO CONVERT IT
OPDIL    LB,R3    OPERATOR          GET LENGTH OF TABLE
         CB,R5    OPERATOR,R3       FIND THE OPERATOR
         BE       OPLOC,R3          GOTCHA
         BDR,R3   %-2
OPLOC    B        SCANNER           NONE FOUND
         B        ADDIT             ADD TWO FIELDS
         B        SUBIT             SUB TWO FIELDS
         B        MWIT              MUL TWO FIELDS
         B        DIVIT             TO DIVIDE WORDS
OPERATOR TEXTC    '+-*%'
*
DIVIT    LW,R3    R6                NUMBER TO BE DIVIDED TO R3
         DW,R3    R2                DIVIDE BY DIVISOR (SEOND FIELD)
         XW,R3    R2                RETURN PRODUCT IN R2
         B        GEXIT1            MERGE WITH COMMON EXIT
ADDIT    AW,R2    R6
         B        GEXIT1            COMMON EXIT
SUBIT    XW,R2    R6                FLIP IT -(R2 IS RETURNEE)
         SW,R2    R6
         BLZ      BADCOM            WENT OUT OF RANGE
         B        GEXIT1
MWIT     LW,R3    R2
         MW,R3    R6
         LW,R2    R3                RETURN IT IN R2
GEXIT1   LCI      6
         PLM,3    STACK
         B        *0                RETURN
         PAGE
*
*        SWITCH TO LP OR UC
*
OPNTOLP  EQU      %
LP       EQU      %
         PSW,R1   STACK             SAVE LINK
         STW,R1   LPFLAG            SET LINE PRNTER FLAG
         CAL1,1   CLOSEUC           CLOSE UC DEVICE
         CAL1,1   OPNLP             AND OPEN M:LO TO LINE PRINTER
         B        HDR:SETUP         PERFORM HEADER CAL
UCLO     EQU      %
         PSW,R1   STACK             SAVE LINK
UCLO1    CAL1,1   CLOSEUC           ENTRY FOR BAL TO HERE
         CAL1,1   OPNUC             OPEN M:UC DCB
         LI,R0    0                 INSURE LP FLAG
         STW,R0   LPFLAG            IS RESET
         STW,R0   UCTITLE           RESET TITLE LINE SUPRESSION
HDR:SETUP EQU     %
         BAL,R1   ROWSS             SET UP DUMP ROW COLUMN COUNTER
          CAL1,1  HDR1:FPT
         CAL1,1   HDR:FPT
         PLW,R1   STACK
         B        0,R1              AND EXIT
         PAGE
*
*        M:LO PAGE HEADER FPT'S
*
HDR:FPT  GEN,8,24 X'26',M:LO
         GEN,4,28 12,0
         GEN,32   HDMSG
         GEN,32   4
HDR1:FPT GEN,8,24 X'24',M:LO
         GEN,4,28 8,0
         DATA     81
*
CLOSEUC  GEN,8,24 X'15',M:LO
         DATA     0,0
OPNLP    GEN,8,24 X'14',M:LO
         DATA     X'00040000'
         DATA     X'D3D7'
OPNUC    GEN,8,24 X'14',M:LO
         DATA     X'00040000'
         DATA     X'E4C3'
         PAGE
*
*        ROUTINE TO TRANSLATE WORD IN R3 TO EBCDIC
*        AND STORE IT IN OBUF
TRANSSZ  EQU      %
         LCI      7
         PSM,1    STACK
         LI,1     0
         STW,1    SUPPLZ
         LI,6     0
         B        T1
TRANS    EQU      %
         LCI      7
         PSM,1    STACK
         LI,6     1
T1       LI,2     0
         LW,7     3
         LI,4     8
         LW,1     PTR
         LI,5     8
TLOOP    SCD,2    4                 PICK OFF 4 BITS
         MTW,0    2
         BNEZ     TLOAD
         MTW,0    SUPPLZ
         BNEZ     TLOAD
         AI,4     -1
         BDR,5    TLOOP           IGNORE LEADING ZEROS
TLOAD    LB,2     LIST,2            PICK UP CHR
         MTW,1    SUPPLZ
         CI,R1    OBUFSIZ*4         TEST FOR BUFFER OVRFLO        #11705     B00
         BG       DONTRANS          YUP,TOO MUCH                  #11705     B00
         STB,2    OBUF,1            PUT IT OUT
         MTW,1    COLPT
         MTW,1    PTR
         AI,1     1
         LI,2     0
         BDR,4    TLOOP
         LI,1     1
         STW,1    SUPPLZ          STORE DEFAULT
         LW,1     TPTR              TRANSLATE
         BEZ      DONTRANS
         LW,6     6
         BEZ      DONTRANS
         MTW,4    TPTR
         LI,2     3                 YES
         LI,3     4
         AI,1     3                 TRANSLATE BACKWARDS
STUFFIT  EQU      %
         LB,6     7,2
         LB,6     EBCDIC,6
         STB,6    OBUF,1
         AI,1     -1
         AI,2     -1
         BDR,3    STUFFIT           GET ALL FOUR
DONTRANS EQU      %
         LCI      7
         PLM,1    STACK
         B        *0
LIST     TEXT     '0123456789ABCDEF'
EBCDIC   EQU      %                 TRANSLATE TABLE
TRANTAB  EQU      %
         DO1      X'40'
         DATA,1   '.'
         DATA,1   X'40'
         DO1      9
         DATA,1   '.'
         DATA,1   '`','.','<','(','+','|',' '
         DO1      9
         DATA,1   '.'
         DATA,1   '!','%','*',')',';','~',' ','/'
         DO1      8
         DATA,1   '.'
         DATA,1   ' ',',',' ',' ','>','?'
         DO1      X'A'
         DATA,1   '.'
         DATA,1   ':','#','@',X'7D','=',X'7F'
         DO1      X'31'
         DATA,1   '.'
         DATA,1   X'B1',X'B2',X'B3',X'B4',X'B5'
         DO1      11
         DATA,1   '.'
         DATA,1   'A','B','C','D','E','F','G','H','I'
         DO1      7
         DATA,1   '.'
         DATA,1   'J','K','L','M','N','O','P','Q','R'
         DO1      8
         DATA,1   '.'
         DATA,1   'S','T','U','V','W','X','Y','Z'
         DO1      6
         DATA,1   '.'
         DATA,1   '0','1','2','3','4','5','6','7','8','9'
         DO1      6
         DATA,1   '.'
         BOUND    4
         PAGE
         USECT    DATA
SUPPLZ   DATA     1               0 => SUPPRESS LEADING ZEROS
*                                 1 => PUT THEM IN
LPFLAG   DATA     0
*
TPTR     DATA     0                 TRANSLATE POINTER
*
TPTRSV   DATA     0                 AND ITS SAVED VALUE
*
         PAGE
         USECT    PP
*
*        ROUTINE  TO PUT OUT OBUF
*
BUFOUT   MTW,0    PTR             ANYTHING TO GO OUT?
         BEZ      *0              NO,RETURN
         PSW,R1   STACK             SAVE VOLATILE REG
         LW,1     TPTR              TRANSLATING?
         BNEZ     %+2               YES, THIS IS THE BUFFER SIZE
         LW,1     PTR               NO, THIS IS
         STW,1    BUFSIZ
         LW,R1    PTR               THIS IS THE COUNT TO TYPE WITH
         AI,R1    3                 ADD BLANKS COUNTER
         STB,R1   TYP:BUF           REMEMBER BYTE COUNT FOR TYPING
         CAL1,1   WRITBUF
         LI,1     0
         STW,1    PTR               RE-INITIALIZE
         STW,1    COLPT
         STW,1    TPTR
         STW,1    MSGCNT
         PLW,R1   STACK
         B        *0
         PAGE
         USECT    DATA
WRITBUF  GEN,8,24 X'11',M:LO        FPT FOR DUMPING STUFF FROM OBUF
         GEN,4,28 3,0
         DATA     OBUF
BUFSIZ   DATA     0
         PAGE
         USECT    PP
*
*        ROUTINE TO PUT IN 2 SPACES
*
SPACE2   EQU      %
         LCFI     3
         PSM,R0   STACK
         LI,R2    2                 NUMMBER
         MTW,0    LPFLAG            GOING TO LP
         BNEZ     %+2               YEP
         LI,R2    1                 NO - M:UC
         AWM,R2   COLPT
         LI,R1    BA(OBUF)          BASE BA
         AW,R1    PTR               CURRENT POSITION
         AWM,R2   PTR               UPDATE THE POINTERS
         STB,R2   R1
         LW,R0    BLNKBYT
         MBS,R0   0                 BLANK IT
         LCFI     3
         PLM,R0   STACK
         B        *0
         PAGE
*
*        CREATE TITLE LINE:
*
*        MSG ADDRESS IN R1
*
TITEL    EQU      %
         LCI      4
         PSM,0    STACK
         MTW,0    LPFLAG            GOING TO THE LINE PRINTER
         BNEZ     TITEL0            YEP
         MTW,0    UCTITLE           HAVE DONE ONE TITLE LINE FOR M:UC
         BNEZ     TITEL0+1          YES, DONT DO IT AGAIN UNTIL LATER
         MTW,1    UCTITLE           NOW WE HAVE
TITEL0   CAL1,1   SKIP              OUT GOES NEW PAGE / TITLE LINE
         BAL,R0   BMBB              PUT IT OUT
         LCI      4
         PLM,0    STACK             RESTORE
TITEL2   LCI      4                 PUSH EM
         PSM,0    STACK             FOR ALTERNATIVE ENTRY
         LW,2     LIST1             GET HEAD OF LIST
         BLEZ     TITEL1            NO MORE ROOM
         MTW,-1   LIST1             DECREMENT FOR NEXT
         STW,1    LIST1,2           SAVE MSG ADDRS
         INT,1    M:LO+20           GET PAGE COUNT VALUE
         STW,1    LIST2,2           SAVE IT FOR DISPLAY
         BAL,R0   BLNKBUF           BLANK OUT THE BUFFER COMPLETELY
TITEL1   LCI      4
         PLM,0    STACK             REGISTERS
         B        *0                AND EXIT
         PAGE
*
*        TITLE TABLES
*
         USECT    DATA
LIST1    DATA     AOPSCNT+13+13+13
         DO1      AOPSCNT+13+13+14
         DATA     0
LIST2    DATA     AOPSCNT+13+13+13
         DO1      AOPSCNT+13+13+14
         DATA     0
         USECT    PP
         PAGE
*
*        DEFINITIONS:
*
*        MTBB =   MOVE MSG, TRANSLATE R3, PRINT BUFFER/BLANK A LINE
*        MBB  =   MOVE MSG, PRINT BUFFER/BLANK A LINE
*        TBB  =   TRANSLATE R3,PRINT BUFFER/BLANK A LINE
*        TSBB =   TRANSLATE R3,PRINT BUFFER/BLANK A LINE
*        BMBB =   BLANK A LINE, MOVE MSG,PRINT BUFFER/BLANK A LINE
*        TB   =   TRANSLATE R3,PRINT BUFFER
*        MB   =   MOVE MSG AND PRINT BUFFER
*
*
MTBB     PSW,R0   STACK             SAVE RETURN LINK
         BAL,R0   MSG               PUT OUT THE MESSAGE
MTBB0    BAL,R0   TRANSSZ           PUT OUT VALUE WITH NO LEAD ZEROES
MTBB1    BAL,R0   BUFOUT            PRINT OUT THE ENTIRE BUFFER
         PLW,R0   STACK             RESTORE THE RETURN LINK
         B        BLANK1            AND BLANK OUT THE BUFFER
MBB      PSW,R0   STACK             SAVE THE LINK
         BAL,R0   MSG               PUT OUT THE MMESSAHE
         B        MTBB1             GET INTO THE OTHER ROUTINE
TBB      PSW,R0   STACK             SAVE THE LINK
         B        MTBB0             JOIN UP
TSBB     PSW,R0   STACK
         B        MTBB0             JOIN UP
BMBB     PSW,R0   STACK
         BAL,R0   BLANK1            BLANK THE BUFFER
         BAL,R0   MSG               PUT IN THE MESSAGE
         B        MTBB1             JOIN IN THE OTHER ROUTINE
TB       PSW,R0   STACK
         BAL,R0   TRANSSZ
         PLW,R0   STACK
         B        BUFOUT            FINISH PRINT LINE
MB       PSW,R0   STACK
         BAL,R0   MSG
         PLW,R0   STACK
         B        BUFOUT
MTB      PSW,R0   STACK
         BAL,R0   MSG
         BAL,R0   TRANSSZ
         PLW,R0   STACK
         B        BUFOUT
         PAGE
*
*        DISPLAY PHYSICAL PAGE# IN REG#1
*
DISP:PP  EQU      %
         LCFI     4
         PSM,0    STACK
           AND,R1   =X'3FF'
         STW,1    PP:NUM            SAVE PAGE #
         BAL,0    BLANK1
         LI,1     PPMSG
         BAL,0    MSG
         LW,3     PP:NUM            THE PHYSICAL PAGE#
         BAL,0    TRANSSZ           CONVERTED
         BAL,0    SPACE2            SPACE 2 BYTES
         SLS,3    9                 MAKE WA FROM PAGE#
         LI,1     LCOLON
         BAL,0    MSG
         BAL,0    TRANSSZ
         LI,1     RCOLON
         BAL,R0   MBB               PUT IT OUT
         LCFI     4
         PLM,0    STACK             VOLATILES
         B        *0                AND EXIT
         USECT    DATA
PP:NUM   DATA     -1
         USECT    PP
         PAGE
         BOUND     8
STACKR   DATA     STACK+1
         GEN,16,16  80,0
         USECT    DATA
         BOUND    8
STACK    GEN,32   %+1
         GEN,16,16   80,0
         DO1      80
         TEXT     'BAD'             INDICATES NOT USED
         USECT    PP
         PAGE
*
*        ROUTINE TO FIND MAX PAGE IN THE DUMP FOR GETPAGE
*
GETHIGH  EQU      %
         LCI      3
         PSM,0    STACK             SAVE WORKING REGS
         BAL,R0   FIX%TIME          GET CURRENT TIME
         BAL,R0   SETVERS           GET SYSTEM VERSION
         BAL,R0   OBTAIN%40%46      GET TRAP LOCS
         LI,14    SITEID            FROM ROOT
         BAL,0    GETADDR
         LCI      2
         LM,0     *15
         STM,0    SITELOC           INTO HEADER MSG
         LI,R14   RCVSIZE
         BAL,R0   GETADDR
         LI,R14   X'7FFFF'          BA MASK
         LI,R7    -1
         AND,R14  *R15,R7           GET RECOVERY'S BA IN CORE
         SLS,R14  -2
         STW,R14  RCVLIMITS
         LW,R7    *R15              GET SIZE
         SLS,R7   -2                INTO WORDS
         AW,R7    R14               ADD BASE WA
         STW,R7   RCVLIMITS+1       CREATING CLM PAIR
         LI,14    HIGH
         BAL,0    GETADDR
         LI,3     CORE-1
         SLS,3    -9                #PAGES IN CORE
         LW,1     *15
         BGZ      %+2               GOOD VALUE
         LW,1     3                 SET IT TO MAX
         CW,1     3                 IS IT OK
         BLE      %+2               YES
         LW,1     3                 NO,USE CORE PAGE COUNT
         STW,1    HIGHPAGE
         LW,3     1                 MOVE FOR ARITH
         LI,2     0
         DW,2     SIXTEEN           CALCULATE ROWS
         LI,2     16                THINK ABOUT THAT...
         STW,3    ROWCNT
         STW,2    ODDROW            SAVE ODD COUNT
         LI,1     JITLOC            CALCULATE
         AI,1     X'200'            FIRST VIRTUAL PAGE
         CI,R1    X'8000'           HOW HIGH DID JITLOC GET
         BLE      %+2               OK
         LI,R1    X'8000'           IN ANY EVENT NEVER HIGHER
         SLS,1    -9                NUMBER
         STW,1    FIRSTPG           SAVED
         LI,R14   LOW               GET
         BAL,R0   GETADDR           LOWEST PAGE
         LW,R14   *R15              NUMBER
         BLEZ     FIRST:OK          ERROR/NONE
         CW,R14   FIRSTPG           CHECK AGAINST CALCULATED
         BE       FIRST:OK          ALRIGHT
         STW,R14  FIRSTPG           NO, USE THEIRS
FIRST:OK LI,R1    J:JIT             NOW JIT'S PAGE
         SLS,1    -9                PAGE#
         STW,1    JITPAGE           SAVED
         LI,R0    0                 RESET
         STW,R0   UCTITLE           M:UC TITLE LINE SUPRESSION
         LW,R9    UHFLGLOC          ALREADY GOT THE BUFFER
         BNEZ     SETUP0            YEP
         CAL1,8   GETONE            SEE IF WE CAN GET ONE MORE PAGES
         BCS,8    NOSETUP           NOPE
         STW,R9   UHFLGLOC          SAVE ADDRESS OF THEM
SETUP0   LI,R1    SMUIS
         SLS,R1   -2                NUMBER OF BYTES IN UX:JIT
         SLS,R1   :BIG              INCREASE SIZE IF SIGMA 9
         AI,R1    UX:JIT+3          ADD LENGTH OF JIT  TABLES
         STW,R1   UHFLGR1           STORE CLM PAIR UPPER LIMIT
         LI,R14   UH:FLG-1          BASE ADDRESS OF NECESSARY TABLES
         SW,R1    R14               SIZE TO READ IN
         LI,R3    0                 STARTING INDEX
SETUP    BAL,R0   GETADDR           GET IT
         AI,R15   1                 NOW THAT WE FOOLED GETADDR
SETUP1   LW,R5    *R15,R3
         STW,R5   *UHFLGLOC,R3      IT INTO SPECIAL TABLE
         AI,R3    1
         BDR,R1   SETUP1
         MTW,7    FLGSETUP
         B        SETUP2
NOSETUP  LI,R1    0
         STW,R1   FLGSETUP          RESET FLAG
         STW,R1   UHFLGLOC          ZAP THE POINTER
SETUP2   EQU      %
         LCI      3
         PLM,0    STACK             RESTORE REGS
         B        *0
         USECT    DATA
ODDROW   DATA     0
ROWCNT   DATA     16
SIXTEEN  DATA     16
TEN      DATA     10
UHFLGLOC DATA     0
FLGSETUP DATA     0
         USECT    PP
         PAGE
*
*        OUTPUT TABLE OF CONTENTS FOR GHOST JOB
*
TCONT    EQU      %
         BAL,R0   SYM:DISP          LAST REAL DISP IS SYMBOL TABLE           A00
         LI,1     TCMSG             SEND
         BAL,0    TITEL             TITEL LINE
         LI,1     TCMSG1            SEND
         BAL,0    MSG
         LI,1     45
         BAL,0    SPACES            OTHER
         LI,1     TCMSG2
         BAL,R0   MBB               PUT IT OUT
         LW,2     LIST2             GET LENGTH OF LIST
TCONT1   LI,1     3                 SPACE
         BAL,0    SPACES            IT
         LW,1     LIST1,2           GET ENTRY
         BEZ      TCONT2            NOTHING
         BAL,0    MSG               PUT IT ON PRINT LINE
         LB,R3    R1                WAS A USER NUMBER PASSED
         BEZ      TCONT15           NOPE
         BAL,R0   SPACE2            YES
         LI,R1    #MS
         BAL,R0   MSG
         BAL,R0   TRANSSZ           PUT OUT USER NUMBER HERE
TCONT15  LI,R1    50                NEXT SPACING
         BAL,0    SPACES            SPACES
         LW,5     LIST2,2           GET PAGE#
         LI,1     BA(OBUF)
         AI,1     47                TO ROW POSITION
         BAL,0    DECIMAL           MAKE IT DECIMAL
         BAL,0    BUFOUT            SEND THE BUFFER
TCONT2   BDR,2    TCONT1            FINISH UP
         MTW,0    GJOB%FLAG         RUNNING AS A GHOST
         BNEZ     EXIT              YES - EXIT NOW
         LI,R1    0                 NO - RESET
         STW,R1   BALL              'ALL' FLAG
         B        SCANNER
TCMSG    TEXTC    'TABLE OF CONTENTS:'
TCMSG1   TEXTC    'DISPLAY ITEM'
TCMSG2   TEXTC    'PAGE#'
         PAGE
*
*        HEX TO DECIMAL
*
DECIMAL  EQU      %
         LI,4     0
         DW,4     TEN               TO BASE TEN
         AI,4     X'F0'
         STB,4    0,1               MOVE TO PRINT LINE
         AI,1     -1
         AI,5     0                 DONE
         BLEZ     *0                YES
         B        DECIMAL           NOPE
         PAGE
*
*
*        ROUTINE TO CONVERT ADDRESS IN R14 TO PAGE NUMBER
*        PLUS DISPLACEMENT, AND RETURN WITH ADDRESS IN R15
*
GETADDR EQU       %
         LCI      2
         PSM,0    STACK
         MTW,0    MONFLAG           IN MONITOR DISPLAY MODE
         BNEZ     GETADDR1          YEP - NO TEST HERE
         CLM,R14  UHFLGR            SEE IF ADDRESS IS IN SPECIAL TABLE
         BCS,9    GETADDR1          NOPE
         LW,R15   UHFLGLOC          DO WE HAVE THE TABLE
         BEZ      GETADDR1          NOPE
         SW,R14   UHFLGR            YES - CALCULATE INDEX FOR REQUEST
         AW,R15   R14               CREATE CORE ADDRESS
         B        GETADDR2          AND GET OUT
GETADDR1 LI,R15   0                 DONT HAVE IT - RESET R15
         AND,R14  L(X'3FFFFF')      MAX POSSIBLE SIGMA 9 ADDR EVER           B00
         SCD,14   -9
         LW,1     14
         BAL,0    GETPAGE
         SLS,15   -23
         AW,15    PAGEBUF
GETADDR2 EQU      %
         LCFI     2                 I/O IS COMPLETED
         PLM,0    STACK
         B        *0
         USECT    DATA
WINDOW   DATA     0
         USECT    PP
        PAGE
*
*       ROUTINE TO GET A MONITOR PAGE VIA THE
*       SEEK AND DESTROY (SAD) CAL
*
GETMONPG EQU      %
         LCFI     11
         PSM,R0   STACK
         LW,R6    R1                REQUESTED PAGE #
         AND,R6   =X'3FF'
         STW,R1   OLDPAGEM          STORE ORIGINAL REQUEST
         CW,R6    HIGHPAGE          WILL CVM WORK
         BG       NO:MONPG          NOPE - SKIP OUT
         MTW,0    MAPFLAG           OUR MAP IS ON                    RL2
         BEZ      MONMAP                                             RL2
         BGZ      USRSMAP           GET USER'S MAP
         LI,R5    JXBUFVP           B00 FIRST VP
         BNEZ     %+2               ITS DEFINITELY B00 CP-V
         LI,R5    JOVVP             MUST BE A00/A01 CP-V
         CW,R1    R5                IS MAP REQUEST IN VIRTUAL MEMORY
         BL       MONMAP            NO - ONE TO ONE IN LOW CORE
         LOAD,R7  JX:CMAP,R1        GET VIRTUAL AREA PHYSICAL PAGE #
         B        %+2               CHECK IF NULL MAP CONSTANT
USRSMAP  LOAD,R7  MAP,R1            GET USER'S AREA PHYSICAL PAGE #
         CLM,7    NULLPAGE          IS WORKING PAGE
         BCR,9    MONMAP            NO
         LW,6     7                                                  RL2
MONMAP   EQU      %                                                  RL2
         LW,R1    R6                REMEMBER STARTING PAGE #
         STW,R6   OLDPAGE           SAVE PHYSICAL PAGE #
         SLS,6    9                 PAGE NUMBER
         STW,R1   CVMPAGE           NOPE- REMEMBER IT
         BAL,R0   CVM:SETUP         FINAGLE THE DYNAMIC PAGES AROUND
         LI,R3    X'0700'           SET UP
         STH,R3   SADCAL            CVM CAL FPT
         LI,7     X'1FE00'          MASK FOR ADDRESS
         STS,6    SADCAL            SET UP THE SAD FPT
        CAL1,8    SADCAL          GET THE MONITOR PAGE
         BCS,8    NOSADPAGE         DIDNT GET IT
         AI,R1    1                 NEXT PAGE
         CW,R1    HIGHPAGE          COMPARE TO HIGHEST PAGE
         BG       NO:MONPG          TOO FAR
         LI,R9    512               UPDATE
         AWM,R9   VIRPAGE           VIRTUAL PAGE ADDRS
         AWM,R9   SADCAL            AND SAD POINTR
         CAL1,8   SADCAL            MAP ONTO THAT PAGE
         BCS,8    NOSADPAGE         GOT REJECTED
         LI,R9    -512              NOW BACK
         AWM,R9   VIRPAGE           DOWN THE VIRTUAL PAGE POINTER
NO:MONPG EQU      %
         LCFI     11
         PLM,R0   STACK
         B        *R0
*
*
*
NOSADPAGE1 LI,R1  NOPGS:MSG
         B        %+2
NOSADPAGE LI,R1   NOSAD:MSG
         BAL,R0   MSG%OUT
         B        SCANNER
NOPGS:MSG TEXTC 'CAN''T GET PAGES TO PERFORM CHANGE VIRTUAL MAP'
NOSAD:MSG TEXTC 'CHANGE VIRTUAL MAP REQUEST REJECTED'
         PAGE
*
*        ROUTINE TO READ PAGE # IN R1 INTO PAGEBUF
*
GETPAGE  EQU      %
         MTW,0    MONFLAG
         BNEZ     GETMONPG          DO CVM CAL IF MONITOR DISPLAY MODE
         LCI      11                IN CASE OF I/O ERROR
         PSM,0    STACK
         LW,0     Y002
         CW,0     M:EI
         BAZ      PAGERR0           FILE NOT OPEN
         STW,1    OLDPAGEM          SAVE THE ORIGIONAL REQUEST
           AND,R1    =X'3FF'
         LW,0     PAGEBUF
         STW,0    BUFLOC
         MTW,0    MAPFLAG           ARE WE MAPPED
         BEZ      %+2               NO, GET SPECIFIED PAGE
         LOAD,R1  MAP,R1            YES, GET THE REAL (VIRTUAL) PAGE         A00
CHKOLD   EQU      %
         CW,1     OLDPAGE           DO WE ALREADY HAVE IT
         BE       GETEXIT           YES,EXIT
         STW,1    OLDPAGE           NO,MAKE IT CURRENT #
         LI,3     X'0300'           SET UP
         STH,3    KEY               KEY LENGTH
         LI,R0    0                 NEED TO RESET STATUS
         STW,R0   JITSTAT           FOR PAGE FAULTS
         LI,3     1                 HALFWORD INDEX
PG:LOOP  CLM,1    PAGLIMS           IS VALID PAGE#
         BCS,9    GETEXIT           NO,STOP NOW
         STH,1    KEY,3             SET PAGE# IN FPT
         CAL1,1   PAGEFPT           READ PAGE IN
         LW,R1    OLDPAGE           PAGE IN BUFFER                           A00
         LW,0     PAGEBUF           BUFFER BASE
         STW,R0   WINDOW            LEAVE IT SET FOR DELTA INTERFACE
         AI,0     512               INCREMENT UP
         STW,0    BUFL2             NEXT BUF ADDRS
         CI,R1    0                 TEST IF PAGE 0
         BNE      WAS%NOT%PAGE%0
         PSW,R1   STACK
         BAL,R0   IO:SPIN
         PLW,R1   STACK
         BAL,R0   RESTORE%TRAPS%40%46
WAS%NOT%PAGE%0  EQU   %
         LC       OLDPAGEM          CHHECK FLAG
         BCS,4    GETEXIT           DONT READ ANY MORE FOR REQUESTOR
         MTW,0    LOOKING           OR IF THIS FLAG
         BNEZ     GETEXIT           IS SET GET OUT - ITS EXPLORATORY
         AI,1     1                 NEXT KEY#
         CLM,1    PAGLIMS           WITHIN RANGE
         BCS,9    GETEXIT           NO,EXIT
         MTW,0    MAPFLAG           ARE WE MAPPED
         BEZ      NOMAPEE           NO
         LI,R2    128-JXBUFVP       HIGHEST MAP INDEX
         LW,R1    OLDPAGEM          YES, GET THE ORGINAL REQ
NXTPHYS AI,R1     1                 NEXT INDEX
         LOAD,R1  MAP,R1            GET THE NEXT PHYSICAL PAGE #
         CLM,R1   NULLPAGE          NEXT EQUAL NULL MAP PAGE
         BCS,9    NOMAPEE           NO - USE THIS ONE
         BDR,R2   NXTPHYS           YES - GET NEXT
NOMAPEE  STH,R1   KEY,R3            AND INSERT THE PHYSICAL PAGE #
         CAL1,1   BUFL              DO A NO WAIT READ
GETEXIT  EQU      %
         BAL,R0   IO:SPIN           WAIT FOR I/O TO DIE DOWN
         LI,R0    0
         STW,R0   LOOKING
         LCFI     11                EXTRACT REGISTERS FROM STACK
         PLM,0    STACK
         B        *0
         PAGE
*
*        WAIT FOR I/O TO COMPLETE
*
IO:SPIN  EQU      %
         LI,R1    BAFCN
         MTB,0    M:EI,R1           CHECK FCN COUNT
         BNEZ     %-1               NOT DONE YET
         B        *R0               ALL DONE
         PAGE
         USECT    DATA
PAGEFPT  GEN,8,24 X'10',M:EI
         DATA     X'38000000'
BUFLOC   GEN,1,31  1,PAGEBUF
         DATA     512+512+512+512
         DATA     KEY
BUFL     GEN,8,24 16,M:EI
         DATA     X'38000000'
BUFL2    PZE      *PAGEBUF
         DATA     2048
         DATA     KEY
OLDPAGEM DATA     0
OLDPAGE  DATA     X'FFF'
         BOUND    8
PAGLIMS  DATA     0
HIGHPAGE DATA     255               INITIAL VALUE
         PAGE
*
*        AN I/O ERROR OF SOME VARIETY HAS OCCURED
*
*        NOTE THAT THERE IS A POSSIBILITY OF OTHER ROUTINES
*        LEAVING FLAGS SET SAYING THAT THEY ARE JUST LOOKING
*        FOR DATA IN THE MONDUMP FILE - DONT CHANGE THIS
*
         USECT    PP
PAGERR   EQU      %
         LC       JITSTAT           TRYING TO READ A KEY FOR A JIT
         BCS,4    LOCJIT3           YES,RETURN THERE
         BCS,1    RBBREA            READING THE RBBAT RECOVERY FILE
         LB,R0    R10               GET I/O MAJOR CODE
         CI,R0    X'03'             FILE NOT OPEN
         BNE      PAGERR1         IGNORE IF NOT A NO FILE
PAGERR0  LI,1     NOFILMSG
         B        PUSHMSG           MSG OUT/GO TO SCANNER
PAGERR1  BAL,R2   RERR1             RECORD I/O ERROR MSG
         BAL,R0   BLANK1
         LW,R3    KEY               GET KEY WE TRIED TO USE
         LI,1     PERRMSG
         BAL,R0   MTBB              PUT IT OUT
PAGERR2  LI,0     0                 IN ANY EVENT
         STW,0    DUMP:DIR          AND THIS FLAG TOO
         BAL,0    UNMAP             GET US UNMAPPED
         LI,R0    -1
         STW,R0   OLDPAGE           ZAP POINTER TO BUFFER CONTENTS
         B        SCANNER
         USECT    DATA
SKIP     GEN,8,24 X'04',M:LO        TOP OF FORM
JITBURST DATA     0
*                                   DUMP PORTION OF FILE
GHMSG    TEXTC    ' ANLZ USING MONDMP# '
         USECT    PP
PERRMSG TEXTC 'THIS FILE ACCESS KEY CAUSED AN ERROR: '
NOFILMSG TEXTC 'NO CRASH FILE OPEN FOR INPUT'
NOSJIT   TEXTC    '**NO JIT TO BE FOUND FOR '
*
         PAGE
*
*        ROUTINE TO LOAD THE USER'S MAP
*
MAPMODE  PSW,0    STACK             SAVE LINK
         LI,1     1                 SEE IF USER# SPECIFIED
         BAL,0    GETHEX            GO GET EM
         PLW,0    STACK             RESTORE LINK
MAP:USER LCFI     5                 FOR VOLATILES
         PSM,0    STACK             ALL
         LW,2     2                 USER# PASSED
         BEZ      MAPME             NO,MAP MYSELF
         BAL,R0   RES:JIT           FIND THE JIT
         BCS,4    NOMAP             NONE TO BE FOUND
         LI,R2    JXCMAP            INDEX INTO JX:CMAP
         SLS,R2   -:BIG             NOW HALF-WORD OR BYTE
         LI,R3    JXBUFVP           FIRST VPX IN B00
         BNEZ     %+2               ITS B00 FOR SURE
         LI,R3    JOVVP             OR IF ITS A00
         AW,R2    R3                R2 NOW DIRECT DISP INTO JX:CMAP
MAPLOAD  LOAD,R4  *PAGEBUF,R2       GET ENTRY FROM JX:CMAP
         STORE,R4 MAP,R3            AND PUT INTO MY MAP IN RIGHT SPOT
         AD,R2    DOUBLEONE         BUMP BOTH INDEXES
         CI,R3    256               VIRTUAL INDEX UP TO LIMIT YET
         BL       MAPLOAD           GO UNTIL END OF VIRTUAL LIMIT
MAPOK    EQU      %                 ALL SET UP W/VIRTUAL MAP IMAGES
         MTW,1    MAPFLAG           TURN ON THE MAP
NOMAPGOT LCFI     5
         PLM,0    STACK             RESTORE REGS
         B        *0                AND RETURN
MAPME    LI,2     -2                                                 RL2
         STW,2    MAPFLAG                                            RL2
         B        MAPOK                                              RL2
NOMAP    BAL,0    UNMAP             INSURE ITS RESET
         B        NOMAPGOT          AND EXIT
         PAGE
*
*        KEEP DYNAMIC PAGES CORRECT FOR SAD CALS
*
CVM:SETUP EQU     %
         LW,R9    PAGEBUF
         BNEZ     %+3
         CAL1,8   GETTWO
         BCS,8    NOSADPAGE1
         STW,R9   VIRPAGE
CVM:SET  CAL1,8   GETIT
         CAL1,8   FREEIT            FREE IT FOR CVM
         AI,R9    512               NEXT PAGE
         CAL1,8   GETIT
         CAL1,8   FREEIT
         AI,R9    -512
         STW,R9   WINDOW            SAVE FOR REPLACEMENTS
         B        *R0               ALL DONE
*
RES:BUF  LW,R9    PAGEBUF
         CAL1,8   FREEIT
         CAL1,8   GETIT
         AI,R9    512
         CAL1,8   FREEIT
         CAL1,8   GETIT
         LI,R15   -1
         STW,R15  CVMPAGE           ERASE CELL EVERY TIME WE DO THIS
         B        *R0               RETURN
        PAGE
         USECT    PP
*
*        RESET MAP TO REAL TRANSLATION
*
UNMAP    EQU      %
         MTW,0    MAPFLAG           HAVE WE BEEN MAPPED BEFORE NOW
         BEZ      *R0               NO, NO REASON TO RESET TABLE
         PSW,R1   STACK
         LI,R1    128*2             128 K PAGES COUNT
         STORE,R1 MAP,R1            STORE PAGE #
         BDR,R1   %-1
         STW,R1   MAPFLAG           RESET FLAG
         PLW,R1   STACK
         B        *R0
*
*
         USECT    DATA
MAPFLAG  DATA     128               FOR INITIALIZATION PURPOSES
MAP      EQU      %
I        DO       128*2             GENERATE 128 HALF WORDS
         DATA,2   I-1               GENERATE PAGE #
         FIN
         PAGE
         USECT    PP
*
*        IN:  R2 = USER #
*        OUT: R14= HIS JIT ADDRESS
*
LOCJIT   EQU      %
         LCFI     4                 PUSH MINIMUM SET
         PSM,R0   STACK             OF REGS
         MTW,0    FLGSETUP          WERE THE TABLES READ IN EARLIER
         BNEZ     QUICKCHK          YES - JUMP
         LC       R2                CHECK NO SCAN FLAG
         BCS,4    LOCJIT1           JUMP - NO CHECK OF UH:FLG TABLE
         MTW,0    MON:FLAG          MONITOR DISLAY MODE
         BNEZ     LOCJIT1           YES, BYPASS LOOK AT UH:FLG
         LI,14    UH:FLG            SEE IF ITS IN CORE
         BAL,0    GETADDR           BRING IT IN
         LH,14    *15,2             GET FLAGS
         CI,14    X'200'            JIT IN CORE
         BANZ     LOCJIT1           YES,BRING IT IN NORMAL
LOOK4JIT LW,R0    M:EI              ARE WE DEALING W/FILE....
         CW,0     Y002              FOR INPUT
         BAZ      LOCJIT1           NO,FORGET IT
         SLS,2    16                NO,POSITION USER#
         LI,0     -1                SET OLD PAGE#
         STW,0    OLDPAGE           TO FORCE A RE-READ LATER
         STW,R0   J:PAGE            RESET IF USER WAS OUT OF CORE
         LCI      4                 INDICATE READ BEING TRIED
         STCF     JITSTAT           AT THIS POINT
         LCFI     3                 SAVE R8 THRU R10 HERE
         PSM,R8   STACK             IN CASE OF CAL ERROR
         STW,2    KEY               SET KEY WORD UP
         LI,3     X'03'             SET
         STB,3    KEY               KEY BYTE COUNT
         CAL1,1   PAGEFPT           READ THAT PAGE
         BAL,R0   IO:SPIN           WAIT FOR I/O TO COMPLETE
         LI,R0    0                 SET TO ZAP
         STB,R0   USER              ANY FLAGS LEFT SITTING AROUND
*
*        IF USER BYTE ZERO IS RESET IT WILL ALOOW PROPER
*        SELECTION OF THIS USER JIT EACH TIME WE GET HERE
*
         LCFI     3
         PLM,R8   STACK             RESTORE R8 THRU R10 - CAL GOOD
         LCI      8                 INDICATE READ SUCESSFUL
         B        LOCJIT2           AND EXIT
LOCJIT1  LI,14    UX:JIT            SINCE JIT WAS IN CORE
         BAL,0    GETADDR           READ IT FROM DUMP FILE
         LOAD,R14 *R15,R2           GET ADDRESS                              A00
LOCJIT15 BLEZ     LOCJIT31          NONE OR ERROR
         CW,R14   FIRSTPG           IS PAGE IN USER MEMORY
         BL       LOOK4JIT          NO - LOOK FOR JIT ELSEWHHERE
         STW,14   J:PAGE            SAVE PAGE# (PHYSICAL)
         SLS,14   9                 FORM PAGE ADDRESS
         LCI      2                 INDICATE INCORE JIT
LOCJIT2  STCF     JITSTAT           SAVE CONDITION CODES
         LCFI     4
         PLM,R0   STACK             GET THE REGISTERS BACK
         LC       JITSTAT           SET CC'S
         B        *0
LOCJIT3  LCFI     3                 RESTORE R8 THRU R10
         PLM,R8   STACK
LOCJIT31 MTW,0    LOOKING           WERE WE LOOKING FOR A JIT
         BNEZ     LOCJIT4           YES,NO ERROR MSG
         LI,1     NOSJIT
         BAL,R0   MSG               PRINT THE FIRST MSG
         BAL,R0   BUST4             PRINT THE REST OF IT
LOCJIT4  LCI      4                 SET NO JIT FLAG
         B        LOCJIT2           EXIT
         USECT    DATA
JITSTAT  DATA     0
J:PAGE   DATA     -1
         USECT    PP
         PAGE
*
*        THE TABLES 'UH:FLG' THRU 'UX:JIT'+SMUIS HAVE
*        BEEN READ INTO A BUFFER AT UHFLGLOC
*
QUICKCHK EQU      %
         LI,R1    UX:JIT-UH:FLG     INDEX TO REACH UX:JIT IN BUFFER
         AW,R1    UHFLGLOC          INTO A CORE ADDRESS
         LC       R2                CHECK FOR NO UH:FLG SCAN
         BCS,4    QUICKCHK1         JUMP
         LH,14    *UHFLGLOC,R2      GET USER'S FLAGS
         CI,14    X'200'            JIT IN CORE FLAG SET
         BAZ      LOOK4JIT          NOPE - READ IT FROM FILE
QUICKCHK1 LOAD,R14  *R1,R2          GET USER'S JIT PHYSICAL PAGE #
         B        LOCJIT15          AND JUMP
         PAGE
         USECT    PP
*
*        DUMPS MEMORY: R8 = STARTING ADDRESS
*                      R7 = #TO DUMP
*
DUMPSOME LCI      9
         PSM,0    STACK
         LB,R2    TERM:CHAR         GET LAST CHAR USER TYPED
         CI,R2    '/'               WAS 'ADDRESS/'
         BNE      DUMP00            NO - GO FWD...
         CI,R7    1                 YES - BUT IS ONLY ONE TO DUMP
         BE       DUMP04            YEP - JUMP AND DUMP ONE
         BAL,R0   BLANK1            NO  - POSITION PLATEN PROPERLY
DUMP00   EQU      %
         LI,5     0
         STW,5    PFLAGS            INITIALIZE THE PRINT FLAGS
DUMP01   EQU      %
         MTW,0    DUMP:DIR          IS BUFFER ALREADY THERE ???
         BNEZ     DUMP02            NOPE
         LI,R5    X'46'
         MTW,0    JITBURST          DUMMPING A JIT
         BEZ      %+2               NO
         STW,R5   OLDPAGEM          YES - SET IN JIT PAGE NUMBER
         LW,5     OLDPAGEM          FOR PRINTING ADDRESS
         SLS,5    9
         AW,5     8
         SW,5     PAGEBUF
DUMP02   LI,0     0                 RESET
         STW,0    PTR               ALL PRINT LINE POINTERS
         STW,0    COLPT
         LW,0     TPTRSV
         STW,0    TPTR
DUMPO26  LW,R3    R5                MOVE ADDRESS TO TRANSLATE
         LI,2     0
         BAL,0    TRANSSZ           PUT OUT THE ADDRESS
         LC       PFLAGS            DID WE SKIP A LINE
         BCR,4    DUMP03            NO
         LI,0     '*'               YES, FLAG THE ADDRESS
         LW,3     PTR               BY PUTTING AN *
         STB,0    OBUF,3            NEXT TO IT AND
         MTW,1    PTR               BUMP THE POINTERS
         MTW,1    COLPT
DUMP03   LI,R1    7                 FIRST SPACING TO DUMP COLUMN
         BAL,0    SPACES
DUMP04   MTW,0    DUMP:DIR          DUMPING DIRECTLY
         BNEZ     DUMP05            YEP
         CLM,8    BUFLIM            NO,IS AREA IN BUFFER
         BCR,9    DUMP05
         LW,R1    OLDPAGEM          GET LAST PAGE WE READ
         AI,1     1
         BAL,0    GETPAGE
         LW,8     PAGEBUF
DUMP05   LW,3     *8
         CW,3     LASTWORD          ANY CHANGE IN THIS LINE
         BE       DUMP08            NOPE
DUMP06   LCI      1                 SET UNEQUAL FLAG
DUMP07   STCF     PFLAGS
         STW,3    LASTWORD          SAVE CURRENT WORD
         BAL,0    TRANS
         BAL,0    SPACE2
         AI,8    1
         AI,2     1               BUMP LOC
         CW,2     BLKCNT            ROW DONE
         BGE      DUMP09            YES,UPDATE ADDRESS
         BDR,7    DUMP04            NO,DO REST OF LINE
         LCI      8                 SET DUMP ENDING BIT
         STCF     PFLAGS            AWAY
         B        DUMP10            AND FINISH UP
DUMP08   LC       PFLAGS            FIRST OCCURENCE
         BCS,1    DUMP06            YES,FINISH LINE
         LW,1     2                 NO,GET LINE POSITION FOR SCAN
DUMP081  CW,1     7                 ABOUT TO SCREW UP
         BGE      DUMP082           YEP,BAIL OUT
         CW,3     *8,1              TEST DOWN THE LINE
         BNE      DUMP06            NONE
         AI,1     1
         CW,1     BLKCNT            MUST BE ONE FULL LINE
         BLE      DUMP081           IN ORDER TO SKIP WORDS
         MTW,0    LINECNT           HAVE WE PRINTED A LINE YET
         BEZ      DUMP06            NO,MUST PRINT AT LEAST ONE LINE
DUMP082  LCI      4                 LINE EQUAL FLAG
         B        DUMP07            CONTINUE ON...
DUMP09   AW,5     BLKCNT            UPDATE ADDRESS
DUMP10   MTW,0    TPTR              HAVE BEEN TRANSLATING
         BEZ      DUMP11
         LW,4     TPTRSV            YES, MAKE SURE
         CW,4     PTR               THE NUMBERS AND THE LETTERS
         BLE      DUMP11            IS FILLED WITH BLANKS
         SW,4     PTR
         BLEZ     DUMP11            NOTHHING TO DO....
         LI,R1    BA(OBUF)          BASE BA
         AW,R1    PTR               PLACE TO START MOVING BLANKS
         STB,R4   R1                STORE BYTE COUNT
         LW,R0    BLNKBYT           GET OBJECT WORD
         MBS,R0   0                 MOVE BLANKS INTO PLACE
DUMP11   LC       PFLAGS            GET FLAG
         BCS,8    DUMP14            ALL DONE SET,SO QUIT
         BCS,4    DUMP13            SKIP ON TO NEXT LINE
DUMP12   LCI      2                 SET PRINTING FLAG
         STCF     PFLAGS            IN EFFECT
         MTW,1    LINECNT           BUMP LINE COUNTER
         BAL,0    BUFOUT            AND PRINT CURRENT LINE
DUMP13   BDR,7    DUMP02            GO ON TO NEXT ROW
         LC       PFLAGS            FINISH ON EQUALITY
         BCR,4    %+2               NOPE
DUMP14   BAL,0    BUFOUT            PRINT LAST LINE
         LI,0     0
         STW,0    LINECNT           RESET LINE COUNTER
         STW,0    TPTR              TURN OFF TRANSLATION
         STW,0    DUMP:DIR          DIRECT FLAG
         STW,0    JITBURST          RESET HIM TOO...
         LCI      9
         PLM,0    STACK
         B        *0
         PAGE
*
*        DUMP DRIVING DATA CELLS DEFINITION
*
*        CELL     MEANING
*        ------   ----------------
*
*      PFLAG      1 = CURRENT WORD IS NE TO LAST WORD
*                 2 = LAST LINE WAS PRINTED
*                 4 = CURRENT WORD EQUALS ENTIRE PRINT LINE
*                 8 = DUMP ENTIRELY COMPLETED
*
*      LINECNT    COUNT OF PRINT LINES
*      DUMP:DIR   DUMP DIRECTLY FROM ADDRESS IN R8
*
         USECT    DATA
SYM:PASS DATA     2
LINECNT  DATA     0
DUMP:DIR DATA     0                 NE ZERO SAYS DUMP ACTUAL CORE
         BOUND    8
BUFLIM   DATA     0,0
PFLAGS   DATA     0
LASTWORD DATA     X'12345678'
         USECT    PP
*
         PAGE
*
*        ROUTINE TO OUTPUT TEXTC MSG
*        IN:  R2 = COUNT FOR MSG1 ENTRY
*             R1 = MSG LOCATION (TEXT FOR MSG1,TEXTC FOR MSG)
*
MSG1     MTW,1    MSGCNT
MSG      LCFI     6
         PSM,R0   STACK             SAVE VOLATILES
         LW,3     MSGCNT            FROM TEXT FLAG SET
         BNEZ     NO%TRUNC          YES, COUNT IS IN R2                      A00
         LB,R2    *R1               GET TEXTC BYTE COUNT
         LC       *R1               TEST FLAGS
         BCS,8    MSG0              TRUNCATED TEXTC STRING
         BCR,6    NO%TRUNC          NOT A LIBRARY DEF
         CLM,R1   ANLZLIMS          IS TEXT FROM INTERNAL SOURCE
         BCR,9    NO%TRUNC          YES - GO ON
*
*        MUST NOT SCRUB INTERNAL TEXTC STRINGS - ONLY SYMBOLS FROM
*        THE TABLE WE BUILT FROM MONSTK.
*
         AND,R2   =X'1F'            OKAY - SCRUB SYMBOL TABLE FLAGS
         B        NO%TRUNC          AND JUMP
MSG0     EQU      %
         MTW,1    TRUNC%SYM         SET TRUNCATED SYMBOL FLAG
         LI,R2    8                 FORCE ROOM FOR AN EXTRA CHAR             A00
NO%TRUNC EQU      %                                                          A00
         LW,4     1                 WA TO R1
         SLS,4    2                 TO BYTE ADDRESS
         AI,3     0                 FROM TEXTC STRING
         BEZ      %+2               YES
         AI,4     -1                NO,ADJUST BYTE ADDRS
         LW,5     PTR               GET CURRENT COLUMN POINTER
         AI,5     BA(OBUF)          CREATE CORE BYTE ADDRS
         CI,R5    BA(OBUF)+OBUFSIZ*4   WILL IT OVERFLOW BUFFER
         BGE      NO%TRUNC1         YEP..SKIP OUT
         CI,R2    OBUFSIZ*4         WOULD BYTE COUNT BE TOO BIG
         BGE      NO%TRUNC1         YEP, SKIP THIS MOVE
         AWM,2    PTR               BUMP BUFFER POINTER
         AWM,2    COLPT             BUMP COLUMN POINTER
         STB,2    5                 SET COUNT INTO RU1
         MBS,4    1                 MOVE TEXT/TEXTC STRING INTO BUF
         MTW,0    TRUNC%SYM                                                  A00
         BEZ      NO%TRUNC1                                                  A00
         AI,R5    -1                PT TO LAST BYTE PUT INTO BUFFER          A00
         LI,R4    C'<'              PUT IN A LISTING FLAG TO INDICATE        A00
         STB,R4   0,R5                 A TRUNCATED SYMBOL                    A00
NO%TRUNC1 EQU     %                                                          A00
         LI,4     0
         STW,4    MSGCNT            RE-INITIALIZE
         STW,R4   TRUNC%SYM         RE-INITIALIZE                            A00
         LCFI     6
         PLM,R0   STACK             RETRIEVE VOLATILES
         B        *0
*
*
         USECT    DATA
MSGCNT   DATA     0
TRUNC%SYM DATA    0                 FLAG SET WHEN DOING A TRUNCATED SYMBOL   A00
         BOUND    8
ANLZLIMS DATA     DATA,-1
         USECT    PP
         PAGE
*
*        ROUTINE TO SPACE TO COLUMN # IN R1
*
SPACES   LCFI     3
         PSM,R0   STACK
         SW,R1    COLPT             GET NUMBER OF BYTES TO MOVE
         BGZ      %+2               POSITIVE VALUE
         LI,R1    1                 GONNA DO AT LEAST ONE BYTE
         AWM,R1   COLPT             UPDATE COLUMN POINTER
         LW,R2    PTR               GET CURRENT POINTER
         AWM,R1   PTR               THEN UPDATE IT
         AI,R2    BA(OBUF)          ADD CORE BYTE ADDRESS
         CI,R2    BA(OBUF)+(OBUFSIZ*4)  AT MAX LOCATION
         BG       SPACES0           YEP - EXIT
         STB,R1   R2                STORE BYTE COUNT IN REGISTER
         LW,R1    R2                NO - MMOVE BYTE ADDRESS
         LW,R0    BLNKBYT           GET BYTE TO MOVE
         MBS,R0   0                 MOVE BLANK BYTES INTO POSITION
SPACES0  LCFI     3                 RETRIEVE REGISTERS
         PLM,R0   STACK
         B        *R0               AND EXIT
BLNKBYT  GEN,8,24 X'40',0
         B        A2RETALT
         REF      A2RETURN
         REF      MDRET
         BAL,1    MDRET
         PAGE
*
*
*
         USECT             DATA
PATCH    DO1      36
         DATA     0
         END      INITIAL         START AT INITIAL

