*M*      ANALZO5  FIFTH OVERLAY OF THE ANLZ LOAD MODULE
*
*        TREE STRUCTURE LOCATION IS NOT CRITICAL FOR THIS OVERLAY
*
 TITLE '*** A N A L Y Z E   O V E R L A Y   F I V E   D 0 0 ***'
         PAGE
*
*
*P*
*P*      PURPOSE: CONTAINS ALL ROUTINES IN ANLZ THAT DEAL WITH JITS
*P*               AND SYMBOLS.
*P*      DESCRIPTION: THE FOLLOWING ROUTINES ARE LOCATED IN THIS MODULE.
*P*               STXTVAL    GIVEN TEXT STRING FIND VALUE
*P*               STXTCON    GIVEN TEXT FETCH CONTENTS
*P*               SVALCON    GIVEN VALUE FETCH CONTENTS
*P*               FETCH      MOVE DATA PER REQUESTED ADDRESS/COUNT
*P*               MDSNAP4    4 WORD WIDE CORE DUMP DRIVER
*P*               MD:SUBQ    DRIVES RESOURCE SUB-QUEUE DISPLAY
*P*               MDDCB      DISPLAY DCBS/DCB STATUS IN CONTEXT DUMP
*P*               JITS       DUMPS REQUESTED JIT/MONITOR JIT
*P*               ALLJIT     DUMPS INCORE JITS AT TIME OF CRASH
*P*               ALLOUTJIT  DUMPS OUT OF CORE JITS AT CRASH TIME
*P*               CXTOUT     DRIVES CONTEXT DUMP OF USERS SELECTED
*P*               SPBCXT     DRIVES SPARE BUFFER DUMPS
*P*               DCBCXT     ESTABLISH CONTEXT DUMP LIMITS
*P*               AJOUT      INITIALIZES FLAGS FOR USER DUMP
*P*               AJO1       VALIDATE JIT AND DISPATCH DUMP ROUTINES
*P*               AJITA      CHECK FOR AJIT/VALIDATE AND DUMP
*P*               LASTBRNCH  ON XEROX 560'S DUMP J:ALB
*P*     RECOVERY%CONTEXT     DUMPS OUT RECOVERY'S CORE IF TAPE DUMP
*P*     CURRENT%USER         DUMPS CURRENT USER (S:CUN)
*P*               MD:CORE    ESTABLISHES ROOT DUMP LIMS AND CALLS MDSNAP4
*P*               DISPSTK    DRIVES TSTACK DISPLAY
*P*               LOOKATMON  TAKES ADDRESS IN TSTACK AND DISPLAYS SAME
*P*               OSTACK     DRIVES OSTACK DISPLAY
*P*               MDTRAPS    DRIVES FORMATTED TRAP/INT DISPLAY
*P*               SVALTXT    GIVEN VALUE RETURNS TEXT SYMBOL LOC
*P*               GRABSYM    GIVEN VALUE RETURNS CSECT PROXIMITY VALUE
*P*               STKCHK     EXAMINES TSTACK FOR VALIDITY
*P*               BUST4      PUTS OUT MSG AND USER'S NUMBER
*P*               SYM:SERCH  SYMBOL SLASH PROCESSOR
*P*               VALTEXT    VALUE LEFT PAREN PROCESSOR
*P*               DISP:OFF   TAKES SYMBOL VALUE/CUR VAL AND PUTS OUT OFFSET
         PAGE
*
*        DECLARE DATA/PROCEDURE NAMES FOR CONTROL SECTION
*        SWITCHING
*
DATA     CSECT    0                 DATA SECTION OF MODULE
TXTSECT  CSECT    1                 GENERATE PROCEDURE SECTION FOR
*                                   PROC TEXT STRINGS
PP       CSECT    1                 PROCEDURE SECTIION
         USECT    PP                BEGIN GENERATION OF PURE PROC.
MONPROC  SET      0
UFLAGS   SET      1
UTSPROC  SET      1
S69PROC  SET      1
         SYSTEM   UTS
         CLOSE    PUSH,PULL,UNMAP,TSTACK,X4,R4
         CLOSE    CUN,ISUN
         PAGE
*
*        REFERENCES THAT ARE SATISFIED FROM ANALZ
*
         REF      #OFREGS           # OF REG ADDRS WE KNOW ABOUT
         REF      #R16              DATA =X'0000FFFF'
         REF      #STATES           LENGTH OF STATE MESSAGES TABLE
         REF      ACT:INST          EBCDIC OF OPCODE FROM INST:SAVE
         REF      ADDEFEND          POINTS TO TOP OF SYMBOL TABLE
         REF      AJITBURST         DUMPING THE AJIT?
         REF      BALL              INDICATES DOING ALL OPTIONS
         REF      BATFLAG           DATA = X'40000000'
         REF      BIGBUF            POINTS TO SYMBOL TABLE BUFFER
         REF      BLANK1            PUT OUT ONE BLANK LINE
         REF      BLNKBUF           ROUTINE TO RESET PRINT BUF POINTERS
         REF      BUFOUT            PRINT ENTIRE PRINT BUFFER
         REF      CLOSEDCB          CLOSES DCB POINTED TO BY R7
         REF      CLOSESTADD        CLOSEST ADDRS TO CUR ADDRS
         REF      CLOSESTSYM        CLOSEST SYMBOL ADDRS TO CUR ADDRS
         REF      CPOINTER          POINTS TO CSECTS IN SYMBOL TABLE
         REF      CUJITMSG          CURRENT USER DUMP TITLE LINE
         REF      CUN               CONTAINS S:CUN'S VALUE
         REF      CURADRSS          CLM PAIR OF CURRENT ADDRS IN BUFS
         REF      CURR:LOC          CURRENT ADDRESS FROM TSTACK
         REF      DATA:AREA         CLM PAIR OF USER'S MEMORY LIMITS
         REF      DATAFLAG          CURRENTLY UNUSED
         REF      DISP:PP           DISPLAY PHYSICAL PAGE # AND WA MSGS
         REF      DUMPSOME          NORMAL (8 WIDE) DUMP ROUTINE
         REF      DUMP:DIR          SET SAYS BUFFER ALREDY IN CORE
         REF      FIELD1            CONTAINS FIRST FIELD IN COMMAND
         REF      FIELD3            CONTAINS THIRD INPUT FIELD
         REF      FINDER            TABLE TO QUICKLY FIND SYMBOLS
         REF      FIRSTPG           SAME AS LOW IN CP-V
         REF      FLDCNTS           * TABLE OF FIELD LENGTHS
         REF      GETADDR           FETCHES REQUESTED ADDRS IN R14
         REF      GETHEX            GETS NUMBER FROM FIELD# PASSED
         REF      GETLIST           RETURNS NEXT LIST ITEM IF ANY
         REF      GET1ADDR          GET ONE PAGE FOR PAGE # IN R1
         REF      GHST:STRT         CLM PAIR OF ADDRS USER OCCUPIES
         REF      GJOB%FLAG         * RUNNING AS GHOST FLAG
         REF      IMONLOC           IMAGE OF CONTENTS OF CURR:LOC
         REF      INST:SAVE         DITTO FROM IMONLOC
         REF      ISJITMSG          INSWAP USER TITLE LINE
         REF      ISUN              CONTAINS S:ISUN'S VALUE
         REF      J:PAGE            INDICATES IF JIT WAS IN CORE
         REF      JITBUF            POINTS TO BUFFER THAT CONTAINS JITS
         REF      JITBURST          FLAG INDICATING JIT DUMP IN PROGRESS
         REF      JITMSG            JIT TITLE LINE
         REF      JITPAGE           CONTAINS JIT PAGE #
         REF      JITSTAT           INDICATES PAGE FAULT STATUS
         REF      KEY               KEY FOR READING MONDUMP FILE
         REF      LAST:LINE         RELATIVE # OF LAST REG FOUND
         REF      LASTLOC           CURRENT LAST LOC WE DUMPED OUT
         REF      LEGCORAD          CLM PAIR OF VALID CORE ADDRESSES
         REF      LOCJIT            LOCATE USER'S JIT
         REF      LOCLOC            GETS TWO FIELDS CALCULATES DIFF.
         REF      LOOKING           FLAG SAYS "JUST LOOKING# NO ERR MSG
         REF      LPFLAG            SET IF WRITING ON LINE PRINTER
         REF      M:LO              ANLZ'S PRINTING DCB
         REF      MACHINE           DUPE OF BIF PROC DATA CELL
         REF      MAP:USER          OBTAIN REQUESTED USER'S MAP
         REF      MAPFLAG           FLAG INDICATING MAPPED MODE
         REF      MBB               MOVES MSG/PRINTS IT/BLANK LINE OUTPUT
         REF      MJITMSG           MONITOR JIT TITLE LINE MESSAGE
         REF      MRMSG             TITLE LINE FOR MONITOR ROOT DUMP
         REF      MSG               MOVES A MSG TO PRINT BUFFER
         REF      MSG%OUT           PRINTS BLANK/MSG/BLANK AGAIN
         REF      MTB               MOVES MSG/TRANSLATEX VALUE/PRINTS ALL
         REF      MTBB              MOVE MSG/TRANS/BUFOUT BLANK A LINE
         REF      NEXTLOC           ADVANCES FIELD TO NEXT LOGICAL #
         REF      NO:CORE           FLAG SAYS USER HAS NO CORE(JIT ONLY))
         REF      NOTCOM            RETURN IF CURRENT EBCDIC WASNT SYMBOL
         REF      NOTRACE           SAYS 'DOENST EXIST IN SYSTEM'
         REF      NULLPAGE          NMPC/FMPC CLM PAIR
         REF      OBUF              ANLZ'S PRINT BUFFER
         REF      OLDPAGEM          ORIGINAL REQUESTED PAGE #
         REF      OSJITMSG          OUTSWAP USER TITLE LINE
         REF      OUTUSERS          OUT OF CORE USERS TITLE LINE
         REF      PAGEBUF           POINTS TO DUMP INPUT BUFFERS
         REF      PAGEFPT           FPT FOR READING MONDUMP FILE
         REF      PAGETABLE         BUILDS PAGE MATRIX
         REF      PG:MODE           INDICATES OWNER OF PAGE
         REF      PAGLIMS           CLM PAIR OF VALID PAGE NUMS
         REF      PROCNAME          DLB-WORD FOR PROC. NAME
         REF      PUSH:FLAG         SET IF PUSHALL DISCOVERED
         REF      R:STITLE          TITLE LINE FOR RESOURCE SUB-Q DISP.
         REF      RANGE             CURRENT CLM PAIR OF ADDRS IN USE
         REF      RCVLIMITS         RECOVERY'S LIMITS IN CORE
         REF      RCVRY%CXT%MSG     TITLE LNE FOR ROUTINE
         REF      REG:REG           REGISTER # IN TSTACK
         REF      REGFLAG           SET IF REG ENVIRONMENT FOUND
         REF      REGIA             REG INST ADDRS
         REF      RES:JIT           RESTORE JIT FOR USER # PASSED
         REF      RUN%MODE          GHOST/BATCH/ONLINE MODE FLAG
         REF      SCANNER           COMMAND DECODER
         REF      SCREECH%CODE      SCREECH CODE FROM CRASH
         REF      SETR6             LOAD R6 WITH USER'S STATE (MSG)
         REF      SLCPUTIT          TITLE LINE FOR MP TABLES DISPLAY
         REF      SPACES            ROUTINE TO PLACE BLANKS IN PRINT BUF
         REF      SPACE2            SPACE OVER 2 BYTES ROUTINE
         REF      SPECIFIC%USER%DCBS     ANLZ ONE USER'S DCBS FLAG
         REF      SSDATU:           START OF UMOV
         REF      STACK             ANLZ'S TEMP STACK
         REF      STK:CNT           CURRENTLY UN-USED CELL
         REF      SYM:LIMS          CLM PAIR OF SYMBOL ADDRS
         REF      SYMBOL:FLAG       INDICATES IF SYMBOLS WERE GOTTEN
         REF      TAP%DMP           SET IF  DUMP COMING FROM TAPE
         REF      TBB               TRANS VALUE/PRINT IT/BLANK A LINE
         REF      TCONT             PUT OUT TABLE OF CONTENTS
         REF      TITEL             ROUTINE THAT PUTS OUT NEW PAGE/TITLE
         REF      TOPUMVDTA         END OF UMOV
         REF      TRANS             TRANS WORD W/LEADING ZEROS
         REF      TRANSSZ           TRANS VALUE W/O LEADING ZEROES
         REF      TRANTAB           HEX TO EBCDIC TRANS TABLE
         REF      TRMSG             TRAPPED PAGE TITLE LINE
         REF      TSIZE             # OF WORDS IN THE STACK IN USE
         REF      TSMSGM            MONITOR TSTACK MSG
         REF      TSMSG1            MONITOR TEMPSTACK TITLE LINE
         REF      TST:LIMS          CLM PAIR OF TSTACK VALID ADDRESSES
         REF      ULSTSIZE          * SIZE OF USERLIST TABLE
         REF      UMVMSG            TITLE OF UMOV DATA
         REF      UNMAP             RESTORE MAP TABLE TO REAL AGAIN
         REF      USER              CONTAINS CURRENT WORKING USER #
         REF      USER:MODE         FLAGS FOR BATCH/GHOST/ONLINE
         REF      USERLIST          TABLE SMUIS LONG IN ANLZ ROOT
         REF      USERLIMS          CLM PAIR OF VALID USER NUMBERS
         REF      USMSG             TITLE MSG LINE
         REF      USRMAP            POINTS TO MAP IMAGE TABLE
         REF      ZEROS             16 WORD TABLE OF ALL ZEROS
         PAGE
*
*        REFERENCES FROM MONSTK ONLY
*
         REF      CORE              SIZE OF MEMORY AS SYSGENED EQU
         REF      DCBLINK           DISP IN JIT TO J:DCBLINK
         REF      J:ALB             LAST BRANCH ADDRESS IN THE JIT
         REF      J:JIT             CORE ADDRS OF THE JOB INFO TABLE
         REF      J:START           USER'S START ADDRS CELL IN J:JIT
         REF      JAJ               DISP TO AJIT CELL IN J:JIT
         REF      JAJITVP           AJIT'S VIRTUAL PAGE #
         REF      JBLMAP            DISP TO LMAP IN J:JIT
         REF      JBUPVP            BEGINNING USER VIRTUAL PAGE
         REF      JBUPVPA           CURRENTLY X'A000'
         REF      JDCBLL            DCB LOWER LIMIT PAGE #
         REF      JDCBUL            DCB UPPER LIMIT PAGE #
         REF      JDDUL             DYNAMIC DATA UPPER LIMIT VALUE
         REF      JOVVP             INDEX TO OVERLAY LOC IN CMAP
         REF      JOVVPA            OVERLAY'S ADDRESS (CURRENTLY 8000)
         REF      JSPVP             SHARED PROCESSOR VIRTUAL PAGE
         REF      JTSTACKSZ         SIZE OF A USER'S TSTACK
         REF      JXBUFVP           INDEX INTO FIRST SPARE BUF IN CMAP
         REF      MAXG              LENGTH OF GHOST JOB TABLES
         REF      MONORG            MONITOR ROOT START
         SREF     NSCPU             NUMBER OF CPUS
         REF      P:NAME            DBL-WORD TABLE OF PROCESSOR NAMES
         REF      P:SA              WORD TABLE OF PROC START ADDRESSES
         REF      PB:DCBSZ          PROCESSOR DCB SIZE TABLE
         REF      PB:DSZ            PROCESSOR DATA SIZE TABLE
         REF      PB:PSZ            PROCESSOR PROCEDURE SIZE TABLE
         REF      PB:PVA            PROCESSOR TABLE
         REF      PNAMEND           LENGTH OF PROCESSOR SHORT TABLES
         REF      PPROCS            TOTAL LENGTH OF PROC TABLES
         REF      PPSTART           CLOSEST SYMBOL TO MONITOR PROCEDURE
         REF      PX:HPP            PROCESSOR HEAD PAGE # TABLE
         SREF     S:ADR             MP TABLES
         SREF     S:PCUN            SLAVE CPU USER NUMBER TABLE
         REF      S:GJOBTBL         DBL-WORD TABLE OF GHOST JOB NAMES
         REF      SAVEREGS          LOC WHERE RCVRY PUT 0-15 REGS
         REF      SB:GJOBUN         BYTE TABLE OF GHOST JOB USER #'S
         REF      SB:OSUL           OUTSWAP USER TABLE
         REF      SB:RQ             RESOURCE SUB-QUEUE TABLE
         REF      SMAXOUT           MAX # OF OUTSWAP USERS AT ONE TIME
         REF      SMUIS             # OF USER'S IN SYSTEM
         REF      SNULL             NULL STATE (NOBODY THERE)
         REF      SPDBASE           SHARED PROC. DATA LOCATION
         REF      SQR               QUEUED FOR RESOURCE IN CORE STATE
         REF      SQRO              Q'D FOR RESOURCE OUT OF CORE
         SREF     SX:SPP            SLAVE CPU PRIVATE PAGE TABLE
         REF      TSTACK            ADDRESS OF TSTACK IN CORE
         REF      U:MISC            USER TABLE (SLEEP CNT/SB:RQ LINKS)
         REF      UB:ACP            USER COMMAND PROCESSOR TABLE
         REF      UB:APO            USER PROCESSOR OVERLAY TABLE
         REF      UB:APR            USER ASSOCIATED PROC. TABLE
         REF      UB:ASP            USER TABLE FOR ASSOCIATED SHARED PRO.
         REF      UB:DB             USER TABLE FOR DEBUGGER #
         REF      UB:OV             USER TABLE FOR OVERLAY #
         REF      UB:PCT            USER TOTAL SIZE TABLE
         REF      UB:US             USER STATE TABLE
         REF      UH:FLG            USER'S FLAGS TABLE
         REF      TRAPSAVE          INTERRUPTS 40,46 FOR TAPE DUMPS
         PAGE
*
*        INTERNAL DEFINITIONS
*
         DEF      ALLJIT            ALL INCORE USERS DUMP ROUTINE
         DEF      ALLOUTJIT         ALL OUTOFCORE USERS DUMP ROUTINE
         DEF      CURRENT%USER     DUMPS CURRENT USER/JIT/CONTEXT
         DEF      DISPSTK           TSTACK ANALYSIS ROUTINE
         DEF      GRABSYM           VALUE TO CSECT OFFSET ROUTINE
         DEF      JITS              JIT DUMPS ROUTINE
         DEF      MD:CORE           DUMPS MONITOR ROOT ROUTINE
         DEF      MD:SUBQ           RESOURCE SUB-Q DISPLAY
         DEF      MDDCB             DCB ANALYSIS ROUTINE
         DEF      MDTRAPS           TRAP CELL DISPLAY
         DEF      RECOVERY%CONTEXT DUMPS RECOVERY'S CORE IF TAPE DMP
         DEF      SLCPU             SLAVE CPU PAGE DUMPER
         DEF      SVALTXT           VALUE TO SYMBOL ROUTINE
         DEF      SYM:SERCH         SYMBOL SLASH COMMAND PROCESSOR
         DEF      VALTEXT           VALUE TO SYMBOL OFFSET PROCESSOR
*
*
         PAGE
*
*        DECLARE REGISTER NAMING CONVENTIONS AND HOW USED
*
*
         ASECT                    * THIS IS REQUIRED DUE TO PROC
%R       EQU      %               * REGISTER USAGE--DONT CHANGE..
*                                 *
*
*
*                     USED BY       WHOSAVES   USED FOR
*                     -------       --------   --------
*
R0       EQU    %R+0  PROCS         PROC       RESERVED FOR PROC
R1       EQU    %R+1  LINKING SUBS  CALLER     ALL LINKING
R2       EQU    %R+2  PROCS         PROC       RESERVED FOR PROC
R3       EQU    %R+3  PROCS         PROC       RESERVED FOR PROC
R4       EQU    %R+4  SUBROUTINES   SUBRTN     GLOBAL INDEX
R5       EQU    %R+5  SUBROUTINES   SUBRTN     GLOBAL INDEX
R6       EQU    %R+6  SUBROUTINES   SUBRTN     GLOBAL INDEX
R7       EQU    %R+7  SUBROUTINES   SUBRTN     GLOBAL INDEX
R8       EQU    %R+8  SUBROUTINES   SUBRTN     GLOBAL ARITHMETIC
R9       EQU    %R+9  SUBROUTINES   SUBRTN     GLOBAL ARITHMETIC
R10      EQU    %R+10 SUBROUTINES   SUBRTN     GLOBAL ARITHMETIC
R11      EQU    %R+11 SUBROUTINES   SUBRTN     GLOBAL ARITHMETIC
R12      EQU    %R+12 SUBROUTINES   VOLATILE   SUBROUTINE ARGS/RETURNS
R13      EQU    %R+13 SUBROUTINES   VOLATILE   SUBROUTINE ARGS/RETURNS
R14      EQU    %R+14 SUBROUTINES   VOLATILE   SUBROUTINE ARGS/RETURNS
R15      EQU    %R+15 SUBROUTINES   VOLATILE   SUBROUTINE ARGS/RETURNS
*
P0       EQU      R0
L1       EQU      R1
P2       EQU      R2
P3       EQU      R3
X4       EQU      R4
X5       EQU      R5
X6       EQU      R6
X7       EQU      R7
A8       EQU      R8
A9       EQU      R9
A10      EQU      R10
A11      EQU      R11
V12      EQU      R12
V13      EQU      R13
V14      EQU      R14
V15      EQU      R15
*
         USECT    PP
         PAGE
*
*        ENTP AND EXTP PERFORM PROC ENTRY AND EXIT HOUSEKEEPING.  THE
*           PROC LEVEL IS MAINTAINED SO THAT ALL REFERENCES BEYOND A
*           CERTAIN LEVEL ARE  NOT LISTED.  BY DEFAULT- ALL GENERATED
*           CODE WILL BE DISPLAYED.  THIS CAN BE CHANGED BY SETTING
*           %LISTLVL TO A ANOTHER VALUE  AFTER  SYSTEM  MDSYSTEM IS
*           CALLED.
*
%SYMSZ   EQU      3                 SIZE OF DEF SYMBOLS IN WORDS
%LEVEL   SET      0                 CURRENT PROC LEVEL
%LISTLVL SET      50                LIST UP TO 50 LEVELS
*************************************
ENTP     CNAME
*************************************
         PROC
         LOCAL    N,SAVED%,CURENT%
LF       EQU      %
N   DO            (%LEVEL+%LISTLVL)=0  TEST FOR BOTH ZERO
CURENT%  EQU      %                 GET ADRS OF REMOTE SECTION SO THAT
         USECT    DATA                WE CAN DISPLAY IT IN THE
SAVED%   EQU      %                   GENRATED WORD SED TO DISPLAY
         USECT    CURENT%             THE PROC REFERENCE LINE.
         DATA     SAVED%            DISPLAY PROC REF LINE & REMOTE ADRS
         ORG      %-1                 BUT DONT GENERATE DATA
    FIN
%LEVEL   SET      %LEVEL+1
         LIST     %LEVEL<=%LISTLVL
         PEND
         PAGE
*
*************************************
EXTP     CNAME
*************************************
         PROC
LF       EQU      %
%LEVEL   SET      %LEVEL-1
         LIST     %LEVEL<=%LISTLVL
         PEND
         PAGE
*        INSTRUCTIONS USED FOR MONDUMP
*
%SIGMA   SET      7                 FOR UTS PURPOSES
*
*
*        MOVE HAS REFERENCE LINE OF FORM  MOVE,NUM  AD1,AD2
*
*                 NUM=NUMBER OF BYTES TO MOVE
*                 AD1,AD2 = (*WA,NDX,DISP)
*                    WHERE *= OPTIONAL INDIRECT
*                          WA=WORD ADDRESS OF BYTE STRING
*                          NDX=BYTE DISPLACEMENT INDEX.  NDX MAY BE ANY
*                              VALUE (NOT JUST 4-7) GREATER THAN 3.  IF
*                              NDX = 3-15, NDX=NDX+NUM.  OTHERWISE  NDX
*                              UNCHANGED.
*                          DISP=BYTE DISPLACEMENT (IMMEDIATE VALUE).
*                               WHILE TYPICALLY 0-3, THERE IS NO
*                               RESTRICTION ON VALUE
*
*        EXAMPLES: MOVE,2  (FROM,,2),(TO)  - LIKE 'STH,FROM TO'
*
*                  MOVE,200 (FROM,,-1),(FROM) - USED TO BLANK OUT FROM
*                        WITH CHARACTER AT BA(FROM)-1
*
*        THE CODE GENERATED FOR ADDRESS OF FORM (0,ANY) IS INEFFICIENT
*
*
*
*
*************************************
MOVE     CNAME    1
COMP     CNAME    2
*************************************
         PROC
         LOCAL    N
LF       EQU       %
N    DO           2                    ITERATE FOR BOTH FIELDS
      DO          AFA(N,1)             IF INDIRECTION HAS BEEN SPCFD -
*                                   METASYM STRIKES AGAIN *
         GEN,8,4,20 X'32',N+1,AF(N,1) /LW OPCODE WOULD INCLUDE * BIT /
         SLS,N+1  2                      AND ADJUST TO BYTE ADDRESS
      DO1         AF(N,3)~=0             AND IF A DISPLACEMENT GIVEN -
         AI,N+1   AF(N,3)                  ADD IT IN ALSO
      ELSE
         LI,N+1   BA(AF(N,1))+AF(N,3)  NO * - GET ADRS AND DISP BOTH
      FIN                              END OF SUBFIELD 1 AND 3 PICKUP
      DO          ABSVAL(AF(N,2))>0    TEST IF AND INDEX REG GIVEN
         AW,N+1   AF(N,2)                YES - ADD ITS CONTENTS
      FIN                              END OF ARGUMENT FIELD
     FIN
         LI,P0    CF(2)                GET BYTE COUNT
         STB,P0   P3                     AND INSERT IT IN BYTE WORD
     DO           NAME=1               SELECT APPROPRIATE BYTE
         MBS,R2   0                 MOVE EM
     ELSE
         CBS,R2   0                 OR COMPARE EM
     FIN
         PEND
         PAGE
*************************************
TXT      CNAME
*************************************
         PROC
LF       EQU       %
         TEXT     AF
         PEND
         PAGE
*
*        SUBRTINE,CALL AND RETURN ARE USED FOR SUBROUTINE LINKAGE.  THEY
*                 DO NOT PERFORM ANY USEFUL FUNCTION(AT PRESENT) BEYOND
*                 ALLOWING DEBUG EXPANSION OF CODE.
*************************************
SUBRTINE CNAME
*************************************
         PROC
LF       EQU      %                 IN DEBUG MODE, GEN TEXT FOR AF
*                                     SO THAT DUMPS ARE EASY TO READ
         PEND
         PAGE
*************************************
CALL     CNAME
*************************************
         PROC
LF       BAL,L1   AF
         PEND
         PAGE
*************************************
RETURN   CNAME
*************************************
         PROC
LF       B        AF
         PEND
         PAGE
*
*        BLANK AND ZERO CHANGE CORE LOCATION CONTENTS TO
*        ALL BLANKS OR ALL ZEROS.  THEY OPERATE ONLY ON WORDS
*        AND THEY DO ACCEPT MULTIPLE SPECIFICATIONS IN THE SAME
*        REFERENCE LINE (THIS ALSO GENERATES OPTIMAL CODE).
*
*        TYPICAL CALL:  ZERO (ADRS1,5),ADRS2,(ADRS3,2)
*        THIS WOULD ZERO 5 WORDS STARTING AT ADRS1 , ADRS2 AND 2
*        WORDS STARTING AT ADRS3
*
*************************************
BLANK    CNAME    1
ZERO     CNAME    2
*************************************
         PROC
LF       EQU       %
         LOCAL    ADRSS,N
ADRSS    EQU      #CBLANKS,#R0
         LW,P3    ADRSS(NAME)       GET WORD OF BLANKS OR ZERO
N   DO            NUM(AF)           ITERATE FOR ALL ADDRESSES
      DO          ABSVAL(AF(N,2))<2 TEST IF SIZE OF THIS ARRAY SPECFD
         STW,P3   AF(N,1)             NO. STORE SINGLE WORD
      ELSE
         ERROR,1,AFA(N,1) 'INDIRECTION NOT ALLOWED'
         LI,P2    -AF(N,2)           SET UP LOOP CONTROL WITH SIZE
         STW,P3   AF(N,1)+AF(N,2),P2 ZAP WORD
         BIR,P2   %-1                AND CONTINUE
      FIN
     FIN
         PEND
         PAGE
*
*        SUBROUTINES FOR STACK OPERATIONS
*
*
*
PUSH     CNAME    X'9',X'B'
PULL     CNAME    X'8',X'A'
         PROC
         DO       NUM(AF)=1
LF       GEN,1,7,4,3,17             0,NAME(1),AF(1),0,STACK
         ELSE
         DO       AF(1)=1
LF       GEN,1,7,4,3,17             0,NAME(1),AF(2),0,STACK
         ELSE
         DO       AF(1)=16
LF       LCI      0
         ELSE
LF       LCI      AF(1)
         FIN
         GEN,1,7,4,3,17             0,NAME(2),AF(2),0,STACK
         FIN
         FIN
         PEND
         PAGE
*                                   THE PRINT PROC HAS TWO FORMS
*
*                 1   PRINT,COUNT    ADRS   COUNT BYTES AT WORD ADRS
*                 2   PRINT         TEXT   TEXT STRING IMMEDIATE
*************************************
PRINT    CNAME
*************************************
         PROC
LF       EQU       %
         LOCAL    TEXTFPT,PRINTEND,TEXTAF,SAVE%
     GOTO,(TCOR(AF(1),S:C))  TEXTAF
         ERROR,4,TCOR(AF(1),S:AAD,S:INT)>0 ;
                  'DON''T USE REGISTER FOR I/O, DUMMY'
         CAL1,1   TEXTFPT
SAVE%    EQU      %                 SET UP TO GEN FPT REMOTE
         USECT    TXTSECT           GENERATE PROCEDURE TEXT STRING
TEXTFPT  GEN,8,24 X'11',M:LO
         GEN,4,28 3,0               FLAG BUF ADDRS / NO WAIT  BIT
         DATA     AF(1)             ADRS
         PZE      *TABPOS           SIZE IS IN TABPOS
         USECT    SAVE%             RETURN TO MAIN CSECT
     GOTO         PRINTEND
TEXTAF   EQU      AF                FORCE EVAL OF REF LINE
         FORMAT   START,TEXTAF,PRINT,END  AND PASS RQST ALONG
PRINTEND EQU      %
         PEND
         PAGE
*
*        THE FORMAT PROC SETS UP ARGUMENTS FOR THE FORMAT SUBROUTINE.
*        THE ADVANTAGES OF USING THIS PROC OVER CODING ENTRIES WITH GEN
*        STATEMENTS:
*           1. PROC PERMITS CALLS TO BE PARAMETERIZED.  THE CALLING
*                SEQUENCE CAN BE MADE WITHOUT CHANGING EXISTING CODING
*           2. ARGUMENTS MAY BE EXPRESSED AS WORD ADDRESSES AND CONVRTD
*                TO BYTE ADDRESSES AUTOMATICALLY.
*           3. NOTATION IS MORE COMPACT AND READABLE.
*           4. SEVERAL FORMAT TYPES HAVE INFORMATION SUPPLIED FOR THEM
*                BY PROC, MAKING CODING EASIER.
*
*        TYPICAL REFERENCE LINES:
*
*        FORMAT   ' TEXT INFO',3,(HEX,ADRS,NUMBRBYTES),(OP,ADRS,N),END
*        FORMAT   (BIT,BA(WORDADRS),NUMBR),(END)
*
* N      D0       4
*        FORMAT   1,(HEX,ADRS+N-1,4)
*        FIN
*        FORMAT   END
*
*        FORMAT OPCODES ARE AS FOLLOWS:
*           1 - EBCDIC       2 - HEX         3 - OPCODE
*           4 - BIT          5 - SPACE       6 - IMMEDIATE
*           7 - INSERTS      8 - TAB         9 - END
*          10 - PRINT       11 - SKIP       12 - START
*          13 - DECIMAL
*
*        THE  COMMANDS FOR EBC,HEX,BIT AND MOVE HAVE THE FOLLOWING
*        REFERENCE LINE SYNTAX:
*        (KEYWORD,(WORD ADRS,BYTE DISPLACEMENT),COUNT IN OUTPUT BUF)
*
*        THE OPCODE COMMAND HAS THE SYNTAX:
*        (OP,WORD ADRS)
*
*        THE TAB COMMAND HAS SYNTAX:  (TAB,COLUMN POSITION)
*
*        THE DECIMAL COMMAND HAS THE SYNTAX:
*        (DEC,WORD ADRS,BYTES IN OUTPUT LINE)
*
*        MORE INFORMATION ABOUT MEANING CAN BE FOUND IN LISTINGS OF
*        MDFORMAT.  THE LISTING OF MDSNAP4 CONTAINS EXAMPLES OF THE USE
*        OF THIS PROC
*
*************************************
FORMAT   CNAME
*************************************
         PROC
LF       EQU       %
         LOCAL    OP#,N,XXX,TEXT,TEXT20,TEXT30,SPACE,BYTERES,FLOOP,;
                  OPX,COUNT,OPNUM,STARTX,DECIMOP
*
*
N    DO           NUM(AF)           SCAN ARG LINE FOR ALL PARAMS
     GOTO,TCOR(AF(N,1),S:C,S:INT)           TEXT,SPACE
*
OP#      SET      SCOR(AF(N,1),EBC,HEX,OP,BIT,XXX,XXX,MOVE,TAB,END,;
                  PRINT,SKIP,START,DEC)
     GOTO,OP#     BYTERES,BYTERES,OPX,BYTERES,XXX,XXX,BYTERES,;
                  COUNT,OPNUM,OPNUM,COUNT,STARTX,DECIMOP
*
XXX      ERROR,1,1  'ARGUMENT FIELD PARAMETER NOT RECOGNIZED'
     GOTO         FLOOP
*
TEXT     SET      %                 SAVE USER CSECT ADDRESS
         USECT    TXTSECT           GENERATE PROCEDURE TEXT STRING
TEXT20   SET      %
         TXT      AF(N)
         ORG,4    TEXT                AND RETURN TO USER CSECT
         GEN,8,5,19   S:NUMC(AF(N)),7,BA(TEXT20)
     GOTO         FLOOP
*
SPACE    SET      0
         GEN,8,5,19   AF(N),5,0
     GOTO         FLOOP
*
BYTERES  SET      0
         GEN,8,5,19   AF(N,3),OP#,BA(AF(N,2,1))+AF(N,2,2)
     GOTO         FLOOP
*
OPX      SET      0
         GEN,8,5,19   4,OP#,AF(N,2)
     GOTO         FLOOP
COUNT    SET      0
         GEN,8,5,19   AF(N,2),OP#,0
     GOTO         FLOOP
OPNUM    SET      0
         GEN,8,5,19   0,OP#,0
     GOTO         FLOOP
*
STARTX   CALL     FORMAT            SET UP BASIC ARGUMENT CALL
     GOTO         FLOOP
DECIMOP  SET      0
         GEN,8,5,19   AF(N,3),OP#,AF(N,2)
         ERROR,4,N~=1  'START PARAM NOT FIRST'
     GOTO         FLOOP
FLOOP FIN
         PEND
         PAGE
*
*        EXPLAIN IS CALLED USING THE EXPLAIN PROC.  THIS PROC SETS
*        UP ARGUMENTS WHICH DEFINE A WORD  TO BE TESTED AGAINST AND
*        AN EXPLANATORY TEXTUAL DESCRIPTION OF THE MEANING IF THERE
*        IS A MATCH.  OPTIONAL ITEMS FOR ANY GIVEN SET  OF ARGUMENTS
*        IS THE WORD TESTING AND TH LOCATION OF THE BUFFER TO MOVE
*        THE TEXTUAL EXPLANATION.  EXAMPLE, USING THE PROC FOLLOWS
*
*        THE ASN FIELD OF DCB CONTAINS A CODE TO TELL WHAT KIND OF
*        ASSIGNMENT IS IN EFFECT FOR THE DCB. THE VALUES ARE 0=NULL,
*        1=FILE ,2=LABEL, 3=DEVICE. THE CODING TO TEST A WORD IN CORE
*        CALLED ASN FOR THESE VALUES AND PLACE A TEXTUAL DESCRIPTION IN
*        THE ASNTEXT DOUBLEWORD IS:
*
*                 CALL    EXPLAIN
*                 EXPLAIN (0,'**NULL**',ASN,ASNTEXT),(1,'FILE'),;
*                 (2,'LABEL'),(3,'DEVICE'),END
*
*        THE CODE GENERATED FOR THIS EXAMPLE WOULD BE:
*
*        BAL,1    EXPLAIN           GENERATED BY CALL
*        GEN,8,1,1,22  8,1,1,TEX1   TEXT BYTE COUNT,PARAM 3 PRESENT
*                                   PARAM 4 PRESENT,TEXT ADDRESS
*        DATA     0                 TESTING AGAINST 0
*        DATA     ASN               PARAM 3
*        DATA     ASNTEXT           PARAM 4 (WHERE TO PUT EXPLAIN)
*        GEN,8,1,1,22  4,0,0,TEX2   BYTE COUNT,P3 MISNG,P4 MISNG, TEXTAD
*        DATA     1                 TESTING AGAINST 1
*        GEN,8,1,1,22  5,0,0,TEX3  BYTE CNT,P3 ,P4,TEXT AD
*        DATA     2                 TESTING AGAINST 2
*        GEN,8,1,1,22  6,0,0,TEX4   BYTE CNT,P3,P4,TEXT AD
*        DATA     3                 TESTING AGAINST 3
*        DATA     0                 MARK END OF ARG LIST
*
*
*        GENERATED IN ANOTHER CONTROL SECTION WOULD BE:
*TEX1    TEXT     '**NULL**'
*TEX2    TEXT     'FILE'
*TEX3    TEXT     'LABEL'
*TEX4    TEXT     'DEVICE'
*
*
*************************************
EXPLAIN  CNAME
*************************************
         PROC
         LOCAL    %SECT,N,P3PRES,P4PRES,TEXTSTRT,TEXWORDS,P4GEN,LOOP,;
                  EXPEND,EXIT
LF       EQU       %
%SECT    SET      %                 SAVE CALLERS CONTROL  SECTION
N    DO           NUM(AF)
     GOTO,SCOR(AF(N,1),END)         EXPEND
P3PRES   SET      NUM(AF(N,3))~=0     1=PARAM PRESENT 0=NOT
P4PRES   SET      NUM(AF(N,4))~=0     1=PARAM PRESENT 0=NOT
         USECT    TXTSECT           GENERATE PROCEDURE TEXT STRING
TEXTSTRT SET      %                 GENERATE TEXT AND GET SIZE IN WDS
         TEXT     AF(N,2)
TEXWORDS SET      %-TEXTSTRT
         USECT    %SECT
         GEN,8,1,1,22  TEXWORDS,P3PRES,P4PRES,TEXTSTRT
         DATA     AF(N,1)           PASS VALUE PARAM
      GOTO,P3PRES=0  P4GEN          SKIP GEN IF PARAM MISSING
         DATA     AF(N,3)
P4GEN  GOTO,P4PRES=0  LOOP          SKIP GEN IF PARAM MISSING
         DATA     AF(N,4)
LOOP FIN
     GOTO         EXIT
EXPEND   DATA     0                 WORD OF 0 = END OF ARGS
EXIT     EQU      %
         PEND
         PAGE
*************************************
BITPIK   CNAME
*************************************
         PROC
         LOCAL    CUR%,CNTRLWD,X
LF       EQU       %
CUR%     EQU      %                 SAVE CURRENT %
         USECT    DATA              GEN CONTROL WRD REMOTE
X        SET      1                 INITIAL
         DO1      NUM(AF(2))-1      GENERATE LIST OF 1,1,1,1...
X        SET      X,1                 TO PUT IN ARG OF GEN
CNTRLWD  GEN,AF(2) X
         ORG,4    CUR%              RETURN TO USER CSECT
*
         LW,V13   AF(1,1)           SET UP ARGS FOR  BITPIK
         LI,V14   AF(1,2)
         LW,V15   CNTRLWD
         CALL     BITPIK
         PEND
         PAGE
%TEXTBSZ EQU      34                SIZE OF PRINT BUFFER
*                 THE FOLLOWING PROCS SET UP CALLING SEQUENCES TO
*                 SYMBOL TABLE ROUTINES.  THE SYNTAX IS:
*
*                   FOUNTINE%NAME   (FROM,TO,(ERR,ADRS))
*                     WHERE         FROM=ADRS OF INPUT ARG
*                                   TO  =ADRS OF OUTPUT ARG
*                                   ERR =KEYWORD
*                                   ADRS=ADRS OF ERR PROCESS ROUTINE
*
*                                   THE SPEC OF ERR IS OPTIONAL
*
*************************************
SVALCON  CNAME    2
*************************************
         PROC
LF       EQU       %
         LOCAL    FROM,TO,N,%SECT,TEXTAD,%SFROM,%STO,%SROUTIN,LAST,LAST
%SFROM   EQU      V12,V12,V13,V13
%STO     EQU      V13,V15,V12,V15
%SROUTIN EQU      SVALCON
FROM     SET      %SFROM(NAME)
TO       SET      %STO(NAME)
N    DO           NUM(AF)
         DO       TCOR(AF(1,1),S:C)   TEST FOR TEXT STRING PRESENT
%SECT    SET      %                   REMEMBER CURRENT LOCATION/SECTION
         USECT    TXTSECT           GENERATE PROCEDURE TEXT STRING
TEXTAD   TEXTC    AF(N,1)             PRODUCE IT
         USECT    %SECT               GO BACK TO PROCECURE SECTION
         LI,FROM  TEXTAD              GENERATE POINTER
         ELSE
         DO       TCOR(S:EXT,AF(N,1)) TEST FOR EXTERNAL REFERENCE
         LI,FROM  AF(N,1)             CREATE POINTER IF TRUE
         ELSE
         LW,FROM  AF(N,1)             IF ADDRESS INTERNAL PICK IT UP
       FIN
      FIN
*
         BAL,R1   SVALCON           CALL SUBRROUTINE
*
      DO          SCOR(AF(N,3,1),ERR)  WAS ERR SPECIFIED
      ELSE
      FIN
*
      DO          NAME=1
         MOVE,%SYMSZ*4 *TO,AF(N,2)  PUT AWAY TEXT STRING
      ELSE
         STW,TO   AF(N,2)           PUT AWAY SINGLE VALUE
      FIN
     FIN
LAST     EQU      %
         PEND
         PAGE
*
* THE FETCH PROC IS USED FOR OBTAINING THE CONTENTS OF CORE.
* IT PERMITS MUCH MORE FLEXIBILITY THAN ARE PERMITTED BY
* THE STXTCON AND SVALCON PROCS.
* THE BASIC SPECIFICATIONS REQUIRED ARE FROM AND TO ADDRESSES AND THE
* NUMBER OF UNITS TO TRANSFER. NOTE THAT THE UNITS
* TRANSFERRED ARE NOT RESTRICTED TO WORD RESOLUTION
*
* THE DETAILED SYNTAX IS:
*
*        FETCH,NUM  (*FROM,XF,RESF),(*TO,XT,REST)
*
*        NUM      NUMBER OF UNITS TO TRANSFER. DEFAULT = 1.
*        FROM     EITHER A TEXT STRING GIVING A MONITOR
*                   DEF NAME OR A COMPUTED ADDRESS. REQD.
*        XF       INDEX REGISTER TO APPLY TO FROM. OPTIONAL.
*        RESF     RESOLUTION OF XF. DEFAULT = WORD.
*                   KEYWORDS ARE : BA,HA,WA,DA
*        TO       DIRECT CORE ADDRESS TO TRANSFER TO. REQD.
*        XT       INDEX REGISTER TO APPLY TO TO. OPTIONAL
*        REST     RESOLUTION OF XT.
*                   KEYWORDS ARE : BA,HA,WA,DA
*
* EXAMPLES FOLLOW
*
*        FETCH    ('TIME'),TIME   FETCH MONITOR CELL FOR TIME
*                                   AND PLACE IN OWN CELL
*        FETCH,6  ('JIT'),MYJIT   FETCH FIRST 6 WORDS OF MON JIT
*        FETCH    ('DCT1',X4,HA),DCT1  FETCH FROM DCT1 USING
*                                        X4 AS HALFWORD INDEX
FETCH    CNAME
         PROC
LF       EQU       %
         LOCAL    %SECT,PARMLIST,OPCODES,FFADR,RESL2,OPCODE2
%SECT    SET      %                 SAVE CURR CONTRL SECT
         USECT    TXTSECT           GENERATE PROCEDURE TEXT STRING
     DO           TCOR(AF(1,1),S:C) IS ADDRESS A TEXT STRING ?
FFADR    TEXTC    AF(1,1)           GENERATE TEXTC STRING
     ELSE
FFADR    EQU      AF(1,1)             NO. USE ADDRS TRANSMITTED
     FIN
*
         BOUND    8                 MAKE IT EASY FOR LD
PARMLIST GEN,8,2,3,1,1,17 ;         FIELDS FOR FIRST PARM WORD
         CF(2),;                    TRANSFER COUNT
         (SCOR(AF(1,3),BA,HA,WA,DA)|-(NUM(AF(1,3))=0))-1,;    RESOLUTION
         AF(1,2),;                  FROM INDEX REGISTER
         AFA(1,1),;                 INDIRECTION IN FROM AD.
         TCOR(AF(1,1),S:C),;        ADDRESS WAS TEXT TYPE
         FFADR                      FROM ADDRESS
*
OPCODES  EQU      X'75',X'55',X'35',X'15'    STB/STH/STW/STD
RESL2    EQU      SCOR(AF(2,3),BA,HA,WA,DA)
OPCODE2  EQU      OPCODES(RESL2|3*(NUM(AF(2,3))=0))
*
         DO       ABSVAL(AF(2,1))<16    DO IF A REGISTER USED
         GEN,8,4,20    OPCODE2,;    **GENERATE PROPER OPCODE
                       10,;         **FETCH ALWAYS USES R10
                       AF(2,1)+F:STACK   **PLOP IT INTO RETURN REGS
*
         ELSE
         GEN,1,7,4,3,17 ;           SECOND PARM WORD.  STORE-TYPE INSTR.
         AFA(2,1),;                 TO ADDRESS INDIRECT
         OPCODE2,;                  TO OPCODE
                  10,;              FETCH SUBR SETS R10 ALWAYS
         AF(2,2),;                  TO INDEX REG
         AF(2,1)                    TO STORAGE ADDRESS
         FIN
         USECT    %SECT             RETURN  TO USER SECTION
         LD,12    PARMLIST          LOAD PARAMETERS
         BAL,1    FETCH             AND GO ANALYZE EM
         PEND
         PAGE
         USECT    DATA
*************************************
*
*        REGS FOR FETCH OPERATIONS
*
F:STACK  DO1      16
         DATA     0
CONTENTS DO1      4
         DATA     0
NXTCON   DATA     0                 NEXT MON CONTENTS WORD
DEFHIT   DATA     0                 FLAG FOR PRINTING LINE IF DEF
NAME     DO1      12
         TEXT     '   '
CURADRS  DATA     0                 CURRENT ADDRESS
EQLFLAG  DATA     0                 1=IN SCOPE OF EQUALITY CHECK. 0=NOT
EQLADRS  DATA     0                 ADRS OF FIRST EQL LINE
EQLCONTS DATA     0                 CONTS OF FIRST EQL LINE
LOKAHEAD DATA     0                 SPECIAL KLUDGE DUE TO EQL LINE METHOD
         USECT    PP
         DEF      PPO5              PATCHING DEF
PPO5     EQU      %
#R0      DATA     0
#CBLANKS DATA     '    '
ADMASK   EQU      %
#R7FFFF  DATA     X'7FFFF'
#RF0     DATA     X'F0'
#R7      DATA     7
#R1C     DATA     X'1C'
#R80CFFF08 DATA   X'80CFFF08'
#RF      DATA     15
#R1F     DATA     31
#R7F     DATA     127
#LFF     DATA     X'FF000000'
#RFF     DATA     X'FF'
         USECT    DATA
BLANKFLG DATA     0                 0=BALNK OBUF      >1= NO.
         USECT    PP
JIT:ORIG EQU      %                 ORIGIN TABLE
         TEXT     'BATCH   '        JIT CODE=0
         TEXT     'GHOST   '        JIT CODE=40
         TEXT     'ONLINE  '        JIT CODE=80
         USECT    DATA
*
*
*
*
TABPOS   DATA     0                 SIZEOF CURRENT  PRINT BUFFER
ARGS     DATA     0                 POINTER TO ARG LIST
TXTPOINT DATA     0                 TEMP CONTENTS OF FIRST ARG
TXTLENGW DATA     0                 BITPIK CONT OF TXTPOINT 0-7
P3PRESNT DATA     0                 BITPIK CONT OT TXTPOINT 8
P4PRESNT DATA     0                 BITPIK CONT OF TXTPOINT 9
TXTAD    DATA     0                 BITPIK CONT OF TXTPOINT 10-31
VALUE    DATA     0                 VALUE TESTING AGAINST
WORDTSTN DATA     0                   THIS WORD (ADDRESS OF)
RECVBLK  DATA     0                 ADDRESS OF WHERE GOES TEXT
PUTAD    DATA     0                 POINTER TO CURRENT ARRAY ENTRY
USFLG    DATA     0                 IMAGE OF CURENT UH:FLG ENTRY
ZAPFLAG  DATA     0                 CHECK IF INTERRUPT LOCS DESTROYED
TRAPLOC  DATA     0                 WORKING TRAP LOCATION
TRAPCONT DATA     0                 WORKING TRAP CONTENTS
TRAPNAME EQU      NAME+4            SPACE FOR DEF NAME
LOCTRAPD DATA     0                 IMAGE OF LOCATION INTRPT BY TRAP
NAMENPSD EQU      NAME              BUFFER FOR PSD NAME
DCBADRS  DATA     0                 ADDRESS OF DCB
DCB0PAK  DATA     0                 PACKED IMAGE OF DCB WD 0
DRES0    DATA     0,0,0,0           UNPAKED IMAGE DCB0PAK
DCB1     DATA     0                 IMAGE OF DCB WORD 1
TYC      DATA     0                 IMAGE OF TYPE COMPLETION BYTE DCB
FCIFCD   EQU      DRES0+1           FCI AND FCD FIELDS IN DCB
ASN      EQU      DRES0+3           ASN FIELD IN DCB
ASNTYPE  DATA     0,0               TEXT EXPANTION OF ASN CODE
LINKPTR  DATA     0  ***VIRTUAL*** POINTS TO DCB CHAIN
DTABSTP  DATA     0                 POINT TO ENTRY IN DCBTAB
DCBNAMSZ DATA     0                 SIZE OF DCBNAME IN WORDS
LINKINFO DATA     0,0,0,0,0,0,0,0,0 IMAGE OF ENTRY IN DCBTAB
NEWDTAB  DATA     0                 1= RESET DTABSTP <1 = DTABSTP 0K
DCBNAME  DATA     0,0,0             TEXT NAME OF DCB TRUNC TO 12 BYTES
VALOFSET EQU      0                 DISPLACEMENT OF ADDRESS IN WDEFENT
TXSB     EQU      4*%SYMSZ          SIZE OF TEXT IN WDEFENT (BYTES)
DESW     EQU      4                 SIZE OF WDEFENT IN WORDS
TXTOFSET EQU      DESW-%SYMSZ       OFFSET OF TEXT IN WDEFENT
WDEFENT  DO1      DESW
         DATA     0
WTEXT    EQU      WDEFENT+TXTOFSET  ADDRESS OF TEXT IN WDEFENT
DESB     EQU      DESW*4
DEFBUF   EQU      BIGBUF            SET IT
         USECT    PP
RPAGEMSK DATA     X'1FF'            LOW ORDER 09 BITS
#D2#D2   DATA     2,2
         USECT    DATA              GENERATE DATA HERE....
         BOUND    8
FPAKPRM  DATA     0,0
FSETTX   GEN,12,3,17  0,X6,0
         GEN,12,3,17  0,-1,0
         USECT    PP
         BOUND    8                                                          A00
#D1#D1   DATA     1,1
         USECT    DATA
         BOUND    8
CORELIMS DATA     0,0               LIMITS FOR PRINTING
DEFSTART EQU      BIGBUF            RESIDES IN MAIN ANALYZE
OLDPSD   DATA     0,0,0,0
         ORG      %-2               INDICATE FIELD OVERLAP
NEWPSD   DATA     0,0               IMAGE OF NEW PSD
USR:ORIG DATA     0,0               ORIGIN TEXT
USR:ACN# DATA     0,0               USER'S ACCOUNT#
FXFRCNT  DATA     0                 # OF INTEMS TO TRANSFER
FFRES    DATA     0                 RESOLUTIN FNDX. 0=BA 3=DA ETC.
FNDX     DATA     0                 VIRTUAL INDEX REG FOR FFADR
FSTAR    DATA     0                 INDIRECT SPECIFIED FFADR
FTXT     DATA     0                 IS FFADR DIRECT OR TEXT ADDRS
FFADR    DATA     0                 ADDRESS FETCHING FROM (WORD)
         PAGE
         USECT    PP
*F*      NAME:    FETCHTXT
*F*      PURPOSE: TO MOVE TEXT STRING AS PASSED TO SEARCH THRU THE
*F*               SYMBOL TABLE LOOKING FOR SAID TEXT STRING
*
FETCHTXT EQU      %
         LI,R0    0
         STW,R0   WTEXT
         STW,R0   WTEXT+1
         STW,R0   WTEXT+2
         LW,R2    R13               ADDRESS OF TEXT
         SLS,R2   2                 TO A BA
         LB,R0    0,R2              GET COUNT
         AI,R0    1                 PLUS TEXTC FIELD
         LI,R3    BA(WTEXT)         SLOT FOR IT
         STB,R0   R3
         MBS,R2   0                 MOVE STRING
         B        0,R1              AND RRETURN
         PAGE
*
*F*      NAME:    STXTVAL
*F*      PURPOSE: TO SEARCH FOR VALUE ASSOCIATED WITH TEXT STRING
*F*               AS PASSED
*
STXTVAL  EQU      %
         PUSH     L1
         CALL     FETCHTXT          MOVE XMITTED TEXT TO WTEXT
         LW,V14   DEFSTART
         BLEZ     STVNFOND          NONE OR EROR
         AI,V14   TXTOFSET          POINT TO TXT ENTRY IN DEF BLOCK
         AI,R0    -1                DECREMENT COUNT FOR TEXT ONLY
STVLOOP  LW,3     V14               V14 POINTS TO DEF BUFFER
         LI,2     BA(WTEXT)         WHERE TEXT TO FIND IS
         SLS,3    2                 SBA SET UP
         STB,0    3                 SET BYTE CNT FROM TEXT TRANS
         AD,R2    #D1#D1            BUMP BA'S PAST COUNTS
         CBS,2    0                 COMPARE TO SYMBOL TABLE
         BE       STVFOUND            EQUAL-GO TO FOUND
STVCONT  RES      0
         CW,V14   ADDEFEND          HAVE WE REACHED END OF ALL DEFS
         BGE      STVNFOND            YUP NOT FOUUND
         AI,R14   3                 POINT TO NEXT ENTRY
         B        STVLOOP
STVNFOND RES      0                 NOT FOUND EXIT
         PULL     L1
         LCI      0                 SET ABNORMAL CONDITIONS
         B        0,L1
STVFOUND EQU      %
         LB,R3    *R14              GET STRING BYTE COUNT
         AND,R3   #R7
         CW,R3    R0                DOES OBSERVED CNT FIT REQUESTED
         BG       STVCONT           NOPE
         AI,R14   -1                YEP
         LW,R12   *R14
         PULL     R1
         LCI      15
         B        0,R1              AND RETURN
         PAGE
*
*F*      NAME:    STXTCON
*F*      PURPOSE: TO FETCH CONTENTS OF AN ADDRESS IDENTIFIED
*F*               BY THE TEXT STRING PASSED
*
STXTCON  EQU      %
         PUSH     R1
         CALL     STXTVAL           BUST TEXT TO VALUE
         PULL     R1
         B        SVALCON           AND THEN GET CONTENTS OF VALUE
         PAGE
*
*F*      NAME:    SVALCON
*F*      PURPOSE: TO FETCH CONTENTS OF ADDRESS PASSED IN R12
*
SVALCON  EQU      %
         AND,V12  ADMASK            MASK OFF
         CLM,V12  LEGCORAD          IS LEGAL CORE ADDRESS
         BCS,9    0,R1            NOT LEGAL - EXIT
         LW,R14   DUMP:DIR          DIRECT FROM A BUFFER
         AW,R14   JITBURST          OR THE JIT BUFFER
         BNEZ     SVCFILE           ALREADY IN BUFFER
         CLM,V12  CURADRSS          IS ADDRESS RQSTD IN CORE ?
         BCR,9    SVCFILE         ALREADY GOT IT - BRANCH
         LW,R14   R12               MOVE REQUESTED ADDRS
         MTW,1    LOOKING           NEVER NEED MORE THAN ONE PAGE
         BAL,R0   GETADDR           GO GET IT IN (AND SET UP TABLES)
         LW,R15   *R15              GET REQUESTED ADDRS
         B        0,R1              AND EXIT
SVCFILE  EQU      %
         AND,R12  RPAGEMSK          CREATE A PAGE INDEX
         LW,R15   PAGEBUF           GET ADDRESS OF REGULAR BUFFER
         MTW,0    JITBURST          DUMPING A JIT
         BEZ      %+2               NOPE
         LW,R15   JITBUF            YES--GET ADDRESS OF JIT WINDOW
         AW,R15   R12               CREATE DIRECT ADDRESS
         LW,R15   *R15              AND FETCH THE WORD
         B        0,R1
*
*
         PAGE
*
*F*      NAME:    FETCH
*F*      PURPOSE: TO FETCH BLOCKS OF WORDS BY ADDRESS IDENTIFIED
*F*               IN PROC CALLING SEQUENCE.
*
FETCH    EQU      %
         LCI      0
         STM,0    F:STACK           PLACE AWAY ARGUMENTS
         STD,V12  FPAKPRM           SAVE XMITTED ARGUMENTS
         LH,X6    FPAKPRM+1         INDEX SPECIFIED
         CI,X6    X'E'
         BAZ      FTONOX              NO INDEX
         SLS,X6   -1                POSITION INDEX REG
         AND,R6   #R7               MASK AWAY
         LW,X6    F:STACK,X6        GET ITS VALUE FROM ARG STACK
         B        FXSET             AND GET INTO PROCESS
FTONOX   LI,X6    0                 SET 0 FOR NO INDEX REG
FXSET    LD,A10   FSETTX            GET MASK AND SETTER...
         STS,A10  FPAKPRM+1         AND SET IN 'INDEXED BY X6'
         BITPIK   (FPAKPRM,FXFRCNT),(8,2,3,1,1,17)  ISOLAT FROM PARAMS
         MTW,0    FTXT              IS FROM ADDRS TEXT ?
         BEZ      FFDIR               NO.  IS DIRECT
         LW,V13   FFADR               YES.  OBTAIN DIRECT FROM TEXT
         CALL     STXTVAL
         BEZ      FNOFND            SKIP OUT IF ERROR
         STW,V12  FFADR             FFADR IS NOW DIRECT ADRS
         B        FFCKSTAR
FFDIR    LI,P0    0                 INSURE ADDRESS OF 0 = NO DIRECT AD
         LW,V15   FFADR             GET ADDRESS PASSED IN PROC
         CI,V15   JBUPVPA           IS ADDRESS IN MONITOR
         BL       FFCKSTAR          YES - JUMP
*
*        'FFADR' COULD CONTAIN AN ADDRESS WITHIN THIS MODULE OR
*        OVER IN MAIN ANALYZE
*
         LW,V15   *FFADR            FROM ADRS POINTS TO WORD
         STW,V15  FFADR               CONTAINING REAL ONE.
FFCKSTAR MTW,0    FSTAR             INDIRECT ?
         BEZ      FCHKNDX             NO
         SVALCON  (FFADR,FFADR,(ERR,FNOFND))  YES. OBTAIN INDIRECT
FCHKNDX  LW,R7    FFADR             GET POINTER ADDRS
         AND,R7   ADMASK            MASK OFF TO 17 BITS
         STW,R7   FFADR             AND REPLACE
         LW,R7    FNDX              INDEX SPECIFED
         BEZ      FFRNOX              NO
         LW,X7    F:STACK,X7        GET ITS VALUE FROM ARGS
         AND,R7   RPAGEMSK          LIMIT INDEX TO 512
*
*        NOTE THAT INDEX IS ADDED TO BASE ADDRESS TO REACH
*        OBJECT ADDRESS - THEN TARGET VALUE IS FETCHED
*
FFRNOX   LI,X4    FRESTAB           TREATMENT OF INDEX FCN OF RESOL.
         B        *FFRES,X4
FRESTAB  B        FFRBA             BYTE RESOLUTION
         B        FFRHA             HALFWORD
         B        FFRWA             WORD
FFRDA    SLS,X7   1                 DUMMY DA INDEX TO LOOK LIKE WORD
FFRWA    AWM,X7   FFADR             WORD ADDRESS ADDED DIRECTLY
         LI,X7    0                 RESIDUE IN X7 IS 0
         B        FTRANS
FFRBA    SCS,X7   -2                ADD WORD PORTION TO FFADR
         AWM,X7   FFADR
         SLS,X7   -30               AND DISPLACEMENT IN WORD IN X7
         B        FTRANS
FFRHA    SCS,X7   -1
         AWM,X7   FFADR
         SLS,X7   -31
         B        FTRANS
FTRANS   LI,X5    FTRANTAB          START OF ITERATIVE LOOP TO
         B        *FFRES,X5
FTRANTAB B        FTRANBA
         B        FTRANHA
         B        FTRANWA
         B        FTRANDA
FTRANBA  SVALCON  (FFADR,A10,(ERR,FNOFND))
         LB,A10   A10,X7            ISOLATE BYTE FROM
         AI,X7    1                 FURTHER CODE MANAGES X7 AND FFADR
         CI,X7    4
         BNE      FTCONTIN
FBUMP    MTW,1    FFADR
         LI,X7    0
         B        FTCONTIN
FTRANHA  SVALCON  (FFADR,A10,(ERR,FNOFND))
         LH,A10   A10,X7
         AND,R10  #R16              MASK TO PREVENT SIGN EXTEND
         AI,X7    1
         CI,X7    2
         BNE      FTCONTIN
         B        FBUMP
FTRANWA  SVALCON  (FFADR,A10,(ERR,FNOFND))
         MTW,1    FFADR
         B        FTCONTIN
FTRANDA  SVALCON  (FFADR,A10,(ERR,FNOFND))
         MTW,1    FFADR
         SVALCON  (FFADR,A11,(ERR,FNOFND))
         MTW,1    FFADR
FTCONTIN EXU      FPAKPRM+1         STORE CONTENTS FETCHED
         AI,X6    1                 BUMP TO INDEX BY ONE ITEM
         MTW,-1   FXFRCNT           DECREMENT  ITEM COUNT
         BGZ      FTRANS            AND CONTINUE
         LCI      0                 RESTORE
         LM,0     F:STACK           REGSITERS
         LCI      15
         B        0,R1              SUCCESSFUL EXIT
FNOFND   LCI      0                 RESTORE
         LM,0     F:STACK           ARG REGSITERS
         LCI      0
         B        0,R1              ABNORMAL EXIT
         PAGE
*
*F*      NAME:    MDSNAP4
*F*      PURPOSE: TO PRODUCE THE 4 WORD DUMP FORMAT - HENCEFORTH
*F*               REFERRED TO AS THE 'MONDMP' METHOD.
*F*               THE CONTENTS OF THE DUMP LIMITS ARE OBTAINED 4 WORDS
*F*               AT A TIME, AND THE HEX,EBCDIC,OPCODE AND SYMBOL
*F*               VALUES ARE MOVED TO THE PRINT LINE
*
MDSNAP4  EQU      %
*
NUM      SET      4
*
*
         PUSH     R7                SAVE RETURN LINK
         STD,R8   CORELIMS          SAVE DUMP LIMITS AS PASSED
         ZERO     (CONTENTS,NUM),EQLFLAG,CURADRS,LOKAHEAD
         LI,R8    J:JIT             ADDRESS OF JIT
         STW,R8   JITPOS            START
         LW,A8    CORELIMS          GET BEGINNING ADRS SPECIALLY
         STW,A8   CURADRS             (AND SET CURADRS)
         SVALCON  (CURADRS,NXTCON)
FORML    EQU      %
         BAL,R0   BL:NAME           BLANK DEF BUFFER
         LW,X4    NXTCON            GET FIRST WORD OF CONTENTS BLOCK -
         STW,X4   CONTENTS            IT WAS READ LAST ITERATION
         MTW,1    CURADRS           BUMP TO GET NEXT CONTENTS
        LW,R0     DUMP:DIR
        AW,R0     JITBURST
         BNEZ     GO:FETCH          YUP--GO GET EM
         LW,R14   CURADRS           GET LOC WE GONNA FETCH
         AI,R14   4                 BUMP BY AMOUNT WE WILL FETCH
         CLM,R14  CURADRSS          IS ADDRESS IN LIMITS STILL
         BCR,9    GO:FETCH          YUP--> FETCH EM
         LW,R14   CURADRS           NOT DIRECT - AND IN LIMITS
         BAL,R0   GETADDR           GO PICK IT UP
GET:WORDS EQU     %
         LCFI     4
         LM,R0    *R15
         STM,R0   CONTENTS+1        STORE EM AWAY
         B        FETCH:DONE        CONTINUE PROCESSING
*
*        BUFFER NOW CONTAINS DATA
*
NO:FETCH EQU      %
         LW,R15   CURADRS           CURRENT ADDRESS WE WANT
         AND,R15  RPAGEMSK          PAGE MASKED
         AW,R15   JITBUF            ADD BUFFER WINDOW
         B        GET:WORDS         GO GET EM
*
*        BUFFER DOES NOT CONTAIN ADDRESS WE WANT
*
GO:FETCH EQU      %
         FETCH,NUM  CURADRS,CONTENTS+1   **PICK EM UP AND PUT EM DOWN
FETCH:DONE EQU    %
         MTW,-1   CURADRS           UNBUMP TO REFLECT TRUE VALUE
         LI,R7    511               MASK TO EXTRACT
         LS,R6    CURADRS           CURRENT INDEX INTO PAGE
         STS,R6   JITPOS            UPDATE JIT POSITION
         LI,R3    0
         STW,R3   DEFHIT            ZAP DEF FOUND FLAG
         LI,X4    -NUM              GET MONITOR DEFS FOR LOCATIONS
         LW,X7    CURADRS
         LI,X6    NAME
GETNAMEL LW,V12   X7                V12 = ADRS
         CALL     SVALTXT           ADRS --> DEF NAME
         BEZ      GETNAMEC          NO DEF NAME - CONTINUE
         LB,R0    *R2               GET BYTE COUNT OF TEXTC STRING
         LI,R5    0                 SET FLAG
         CI,R0    X'80'             SELECT TRUNCATED FLAG
         BAZ      NO%TRUNC          NOT TRUNCATED
         OR,R5    BATFLAG           SET TRUNCATED SYMBOL BIT
NO%TRUNC EQU      %                                                          A00
         SLS,2    2                 TO BA
         AI,2     1                 POINT TO TEXT
         LW,3     6                 6 POINT TO CURRENT SPOT
         SLS,3    2                 MAKE IT BA
         AND,R0   #R7
         STB,0    3                 SET BYTE CNT
         MBS,2    0                 MOVE ANEM INTO PLACE
         LC       R5                TEST FOR TRUNCATED SYMBOL
         BCR,4    NO%TRUNC1         NOPE---> JUMP
         LI,R0    C'<'              TRUN SYM FLAG                            A00
         STB,R0   0,R3              OVLY LAST BYTE MOVED                     A00
NO%TRUNC1 EQU     %                                                          A00
         MTW,1    DEFHIT            DEF ENCOUNTERED IN THIS LINE
GETNAMEC AI,X7    1                 NEXT ADRS
         MTW,1    JITPOS            BUMP JIT POSITION
         AI,X6    %SYMSZ            NEXT TEXT - ALLOW 1 WORD
         BIR,X4   GETNAMEL
         MTW,0    DEFHIT            IF ANY DEFS WERE ENCOUNTERED
         BNEZ     NOTSAME            BYPASS SUPRESSION CHECK
COND20   RES      0
         LW,R8    CONTENTS          CURRENT CONTENTS
         LI,R4    -NUM
         CW,R8    (CONTENTS+1)+NUM,R4
         BNE      NOTSAME           NOT EQUAL
         BIR,R4   %-2
         MTW,0    EQLFLAG           FIRST GROUP OF EQUAL LINES ?
         BNEZ     NEXTNUM             NO
         LW,A8    CURADRS             YES - SAVE STATUS
         STW,A8   EQLADRS
         LW,A8    CONTENTS
         STW,A8   EQLCONTS
         MTW,1    EQLFLAG             SET FLAG
         B        NEXTNUM
NOTSAME  MTW,0    EQLFLAG           DOES THIS TERMINATE EQL CHECK ?
         BEZ      PUTLINE             NO - GO PUT NORMAL LINE
         LW,X5    CURADRS
         SW,X5    EQLADRS
         CI,X5    NUM*2-1           WERE 2 OR MORE LINES EQL ?
         BGE      KCHECK              YES - SEE IF OK TO PRINT
         LW,A8    EQLCONTS            NO - SET UP OLD CONTENTS AND ADRS
         LI,X5    -NUM                  FROM VALUES SAVED
         STW,A8   CONTENTS+NUM,X5
         BIR,X5   %-1
         STW,A8   NXTCON            RESET DUE TO LOOKAHEAD /SIG7-4252/*G6159
         LW,A8    EQLADRS
         STW,A8   CURADRS
         BAL,R0   BL:NAME           BLANK NAME BUFFER
         LI,R3    0
         STW,R3   EQLFLAG           ZAP EQUAL LINES FLAG
         B        PUTLINE               AND HANDLE AS NORMAL LINE
BL:NAME  BLANK    (NAME,NUM*%SYMSZ)
         B        *R0               AND RETURN
         PAGE
*
*        THE METHOD CHOSEN FOR DOING LINE COMPARISON MAY TERMINATE IF THE
*        FIRST WORD OF THE LINE FOLLOWING THE CURRENT
*        ONE IS NOT THE SAME AS THOS SUPRESSING.  RATHER THAN
*        PRINT A SUPRESSION LINE AND THEN ANOTHER LINE CONTAINING
*        THE SUPRESSED VALUE, WE FORCE THE EQUALITY CONDITION FOR ONE
*        MORE LINE
*
KCHECK   MTW,0    LOKAHEAD          TEST FOR FLAG SET DURING LAST ITER.
         BNEZ     SUPRSEQL            YES -GO PUT SUPRS LINE
         MTW,0    DEFHIT            RECHECK HOW WE GOT HERE
         BNEZ     SUPRSEQL          AND FORCE PRINT IF DEF NAME HERE
         LW,R8    CONTENTS
         LI,R4    -4
         CW,R8    (CONTENTS+1)+NUM,R4 **SCAN ALL LOOK AHEAD ENTRIES
         BNE      SUPRSEQL          O.K. NOW TERM EQL LINE
         BIR,R4   %-2
         MTW,1    LOKAHEAD            NO PICK UP EQL LINE NEXT
         B        NEXTNUM
SUPRSEQL CALL     PUTSUPRS          PUT OUT EQUALITY LINE
PUTLINE  RES      0
         FORMAT   START,(HEX,CURADRS,5)                    ADDRESS
NN   DO           NUM
         FORMAT   2,(HEX,CONTENTS+NN-1,8)              HEX CONTENTS
     FIN
         FORMAT   4,'|'
         FORMAT   (EBC,CONTENTS,NUM*4),'|'             TEXT CONTENTS
         FORMAT   4,'|'
NN   DO           NUM
         FORMAT   (OP,CONTENTS+NN-1,4)                 OPCODE  CONTENTS
     FIN
         FORMAT   '|'
         FORMAT   4
NN   DO           NUM
         FORMAT   '|',(MOVE,NAME+%SYMSZ*(NN-1),8)      DEF NAME - IF ANY
     FIN
         FORMAT   '|'
COND30   RES      0
         FORMAT   PRINT,END
         LI,R3    0
         STW,R3   EQLFLAG           ZAP EQUAL LINES FLAG
         STW,R3   LOKAHEAD          ZAP LOOK AHEAD FLAG
NEXTNUM  LI,A8    NUM               NEXT BLOCK OF NUM
         AWM,A8   CURADRS
         LW,A8    CURADRS
         CLM,A8   CORELIMS          HAVE WE EXCEEDED CORE LIMITS ?
         BCS,9    CLEANUP         YES - ALL DONE
         B        FORML               NO - CONTINUE
CLEANUP  MTW,0    EQLFLAG           DID WE FINISH WITH EQUALITY ?
         BEZ      EXIT                NOPE - EXIT
         CALL     PUTSUPRS            YUP - PUT OUT EQUALITY LINE
EXIT     LI,R8    0                 CLEAR
         STW,R8   JITBURST          JIT FLAG
         STW,R8   DUMP:DIR
         PULL     R7                GET RETURN LINK
         B        0,R7              RETURN TO CALLER
         PAGE
***********************************
PUTSUPRS SUBRTINE 'PUTSUPRS'
***********************************
         PUSH     L1
         MTW,-1   CURADRS           POINT TO LAST LOC IN WHICH EQL
         FORMAT   START
         FORMAT   (HEX,EQLADRS,5),2,(HEX,EQLCONTS,8),PRINT
         FORMAT   END                     ****AND CONTINUE ALONG...
         MTW,1    CURADRS           RESTORE
         PULL     L1
         B        0,L1
         PAGE
*        THE FORMAT  SUBROUTINE ACCEPTS A STRING OF ONE-WORD FORMAT
*                 SPECIFICATIONS.  EACH WORD HAS THE SAME GENERAL
*                 FORMAT:
*                         BITS  #  FUNCTION
*                       ------ --
*                         0-7   8  USUALLY THE NUMBER OF BYTES/WORDS/ETC
*                                    TO OPERATE ON.
*                        8-12   5  OPCODE-SPECIFY FUNCTION.  THE FOLLOW-
*                                    ING OPCODES ARE DEFINED:
*                                      1-EBCDIC EG  40-->40 & FF-->4B
*                                      2-HEX    EG  12-->F1F2
*                                      3 OPCODE EG  X'02'-->C'LCFI'
*                                      4 BIT EG OF-->F0F0F0F0F1F1F1F1
*                                      5 SPACE
*                                      6 INSERT IMMEDIATE (USE BITS16-31
*                                      7 INSERT STRING
*                                      8 TAB
*                                      9 END OF FORMAT LIST
*                                     10 PRINT
*                                     11 SKIP
*                                     12 START
*                                     13 DECIMAL
*                       13-31   19 USUALLY AN ADDRESS.  RESOLUTION IS A
*                                    FUNCTION OF OPCODE.
*
FORMAT   SUBRTINE 'FORMAT'
         PUSH     6,X4
         MTW,0    BLANKFLG          SUPPOSED TO BLANK BUFFER
         BNEZ     %+2               NO
         BAL,R0   BL:BUF            BLANK PRINT LINE
         LI,R4    BA(OBUF)          BUFFER REGISTER LOADED
         AI,R1    -1                ADJUST R1 TO POINT CORRECTLY
         LW,R12   R4                REMEMBER BASE BA OF BUFFER
*
*                 REGISTER CONVENTIONS WITHIN FORMAT MAIN LOOP
*
*                 L1 = ADDRESS OF SPECIFICATION WORD
*                 X4 = TARGET ADDRESS (BYTE RESOLUTION) WITH HIGH
*                   ORDER BITS MASKED OFF SO ADDRESS CAN BE USED
*                   FOR COMPARISONS,OR'ING, ETC
*                 X5 = COMMAND IMAGE (L1)
*                 X6-A8 = DEFINED BY SUBPROGRAM
*                 V12 = STARTING VALUE OF X4 (FOR USE IN TABS)
*
*
FLOOP    EQU      %
         AI,L1    1                 GET NEXT FORMAT SPEC
         LW,X5    0,L1                EXACT IMAGE IN X5
         LW,X6    0,L1                COPY TO X6
         SCS,X6   13                  & ISOLATE OPCODE FIELD
         AND,X6   #R1F
        EXU       FXFER-1,X6          YES - GO TO ROUTINE
FXFER    B        EBC
         B        HEX
         B        OPCODE
         B        BIT
         B        SPACE
         B        FORMATER          OPTION IMMED REMOVED
         B        MOVE
         B        TAB
         B        END
         B        PRINT
         B        SKIP
         B        FORMATER          START CODE IN PROC ONLY.
         B        DECIMAL
MAXOP    EQU      %-FXFER
EBC      EQU      %
         LB,R7    R5                GET COUNT
         AWM,R7   TABPOS            AND  UPDATE BUFFER  SIZE
EBCA1    LB,R6    0,R5              GET A BYTE
         LB,R6    TRANTAB,R6        GET EBCDIC BYTE                          A00
EBC1     STB,R6   0,R4              MOVE TO PRINT LINE
         AD,X4    #D1#D1            BUMP BOTH BYTE ADDRESSES
         MTB,-1   X5                  AND DECREMENT COUNT OF REMAINING BYTES
         BNEZ     EBCA1
         B        FLOOP
         PAGE
*
*        HEX CONVERSIONS ASSUMES THAT QUANTITIES ARE RIGHT ADJUSTED
*
*        IT CONVERTS 4 BIT QUANTITIES (OFTEN CALLED 'NIBBLES') INTO
*        8 BIT QUANTITIES (OFTEN CALLED 'BYTES').  THE COUNT PASSED
*        TO HEX IS THE NUMBER OF BYTES TO PLACE IN THE OUTPUT LINE
*
*        ASSUME A WORD CONTAINS, IN HEX, 01234567.  THE REQUEST FOR ONE
*        OUTPUT BYTE WOULD CAUSE HEX TO PICK UP THE NIBBLE 7 AND
*        CONVERT IT TO THE BYTE F7 - THE PRINTABLE REPRESENTATIONOF 7.
*        IF HEX WERE PASSED AN OUTPUT BYTE COUNT OF 8, IT WOULD CONVERT
*        ALL 8 NIBBLES.  A COUNT OF 5 CAUSES IT TO CONVERT 34567 TO
*        PRINTABLE REPRESENTATION.
*
*        IF THE COUNT WERE 11,HOWEVER, HEX ASSUMES THAT IT IS BEING PASSED
*        A DOUBLE WORD AND THAT THE 11 NIBBLES ARE RIGHT ADJUSTED WITHIN
*        THE DOUBLE WORD.  THUS 01234567 ABCDEF01 WOULD CAUSE
*        567ABCDEF01 TO BE CONVERTED.  HEX IS LIMITED TO HANDLING OUTPUT
*        BYTE COUNTS IN THE RANGES 0<N=<16 OR N=8,16,24,32,....
*
*
*
HEX      LB,X6    X5                GET # OF BYTES REQSTD
         AWM,R6   TABPOS            UPDATE  BUFFER SIZE
         CI,X6    7                 EXACT MULTIPLE OF 7 ?
         BAZ      HEXEXCT           YES-GO
         CI,X6    15                METHOD HANDLES DOUBLEWORD MAX
         BG       FORMATER            FORGET IT
         MOVE,8   (0,X5),A8       GET ENTIRE DOUBLEWORD
         SLS,X5   -22               TYPICAL* 5-->20  7--28  11-->44
         AND,X5   #R1C                           20     28       12
         LCW,X5   X5                            -20    -28      -12
         AI,X5    32                             12      4       20
         SLD,A8   0,X5              DO CALCULATED SHIFT
         MOVE,8   A8,X7           MOVE TO REGS USED WITHIN FORMAT
         LW,X5    *L1               REACQUIRE SPECIFICATION WORD
         AND,X5   #LFF              RETAIN BYTE COUNT
         AI,X5    BA(X7)            CHANGE ADDRESS TO CONSTRUCTED WORD
HEXEXCT  LB,X6    0,X5              GET BYTE TO CONVERT
         SLS,X6   -4                ISOLATE LEFT HALF
         LB,X6    HEXCHAR,X6
         STB,X6   0,X4              PUT IN DEST
         AI,X4    1
         MTB,-1   X5                DECR BYTE COUNT IN OUTPUT
         BEZ      FLOOP
         LB,X6    0,X5
         AND,X6   #RF
         LB,X6    HEXCHAR,X6
         STB,X6   0,X4
         AD,X4    #D1#D1            BUMP X4 AND X5
         MTB,-1   X5
         BNEZ     HEXEXCT
         B        FLOOP
HEXCHAR  TXT      '0123456789ABCDEF'
         PAGE
*
*        CONVERT HEX OPCODE TO TEXT OPCODE
*
OPCODE   LW,A8    0,X5              FETCH INSTRUCTION WORD
         LH,X6    A8                IF WORD IS ALL 1'S IN HIGH
         CI,X6    -1                  16 BITS, ASSUME IT IS NOT INSTR.
         BE       NOTOP               WOULD BE DST,F   *ADRS,7 IF SO.
MAYBEOP  RES      0
         LW,A8    0,X5              REFETCH ENTIRE INSTRUCTION
         LB,X7    A8                ISOLATE HIGH BYTE (INDIRECT AND OPCODE)
         AND,X7   #R7F              MASK OUT INDIRECT, LEAVING OPCODE
         LB,X7    LEGALOPS,X7       ANALYZE OPCODE TYPES
         B        OPTYPE,X7
OPTYPE   B        NOTOP             0 - LEGALOPS INDEX
         B        BCROP             1
         B        BCSOP             2
         B        SHIFTOP           3
         B        LCFIOP            4
         B        IMMEDOP           5
         B        OTHEROP           6
BCROP    LI,X7    1                 FETCH BYTE 1
         LB,X7    A8,X7               OF INSTRUCTION WORD
         SLS,X7   -4                ISOLATE R FIELD
         AND,X7   #RF
         CI,X7    4                 CHECK FOR SPECIAL MNEMONICS
         BGE      OTHEROP             TOO BIG-RETURN BCR
         LW,X7    BCREQV,X7         IS SPECIAL MNEMOIC -RETURN IT
         B        PLACEOP
BCREQV   TXT      'B   BGE BLE BE  '
BCSOP    LI,X7    1                 SIMILAR TO BCROP - SEE COMMENTS THER
         LB,X7    A8,X7
         SLS,X7   -4
         AND,X7   #RF
         CI,X7    4
         BGE      OTHEROP
         LW,X7    BCSEQV,X7
         B        PLACEOP
BCSEQV   TXT      'NOP BL  BG  BNE '
SHIFTOP  LW,X7    A8                IS INDIRECT BIT ON IN SHIFT ?
         BLZ      NOTOP               YES - TREAT AS NO SHIFT
SHIFNIND SLS,X7   -8
         AND,X7   #R7               ISOLATE SHIT TYPE BITS
         CI,X7    6                 ARE THEY LEGAL
         BGE      NOTOP               NO-NOT VALID SHIFT OPCODE
         LW,X7    SHIFTEQV,X7         YES- USE SPECIAL SHIFT OPCODE
         B        PLACEOP
SHIFTEQV TXT      'SLS SLD SCS SCD SAS SAD '
LCFIOP   LI,X7    1                 SIMILAR TO BCROP-SEE COMMENTS THERE
         CW,A8    #R80CFFF08        UNUSED BITS IN LCFI OFF ?
         BANZ     NOTOP               NO
         LB,X7    A8,X7
         SLS,X7   -4
         AND,X7   #RF
         CI,X7    4
         BGE      NOTOP
         LW,X7    LCFIEQV,X7
         B        PLACEOP
LCFIEQV  TXT      'NOP LFI LCI LCFI'
IMMEDOP  CI,A8    0                 DOES IMMED HAVE *
         BGZ      OTHEROP             NO - GO PROCESS
         B        NOTOP               YES-IS NOT VALID OPCODE
OTHEROP  LW,A8    0,X5              RE-FETCH INSTRUCTION WORD
         LB,X7    A8
         AND,X7   #R7F              STRIP * BIT FROM OPCODE
         LW,X7    OPCODES,X7
PLACEOP  MOVE,4   X7,(0,X4)         PLACE OPCODE IN PRINT LINE
         LI,R7    4                 SIZE OF MSG MOVED
         AWM,R7   TABPOS            UPDATE BUFFER SIZE
         AI,R4    R4                UPDATE CURRENT POINTER
         B        FLOOP
         PAGE
*        TABLE LEGALOPS - USED AS INDEX INTO TABLE OPTYPE.  ENTERED BY
*                 MASKING OUT * FROM OPCODE AND INDEXING BY RESULT
OPGEN    EQU      8,8,8,8,8,8,8,8
F6       EQU      6,6,6,6
LEGALOPS GEN,OPGEN  0,0,4,0,F6         0
         GEN,OPGEN  F6,0,0,6,6         0
         GEN,OPGEN  F6,0,6,0,0         1
         GEN,OPGEN  F6,F6              1
         GEN,OPGEN  5,5,5,5,6,3,0,0    2
         GEN,OPGEN  F6,0,0,6,6         2
         GEN,OPGEN  F6,0,6,6,6         3
         GEN,OPGEN  F6,F6              3
         GEN,OPGEN  6,6,0,0,F6         4
         GEN,OPGEN  F6,F6              4
         GEN,OPGEN  F6,0,6,6,6         5
         GEN,OPGEN  6,0,6,6,0,0,0,0    5
         GEN,OPGEN  6,6,0,6,F6         6
         GEN,OPGEN  1,2,6,6,F6         6
         GEN,OPGEN  F6,F6              7
         GEN,OPGEN  F6,F6              7
BIT      MOVE,4   (0,X5),A9         PICK UP 4 BYTES FROM SOURCE
         LB,R7    R5                GET  CNT
         AWM,R7   TABPOS            UPDATE BUFFER SIZE
BITLOOP  LI,A8    0
         SLD,A8   1                 GET HIGH BIT
         OR,A8    #RF0              ADD PRINT INFO
         STB,A8   0,X4
         AI,X4    1
         MTB,-1   X5
         BNEZ     BITLOOP
         B        FLOOP
         PAGE
*
*        TRANSFER RECORD TO PRINT BUFFER
*
*        INPUT:   R5 CONTAINS SOURCE BYTE ADDRESS
*                 R4 CONTAINS DEST.  BYTE ADDRESS
*
MOVE     EQU      %
         LI,R0    FLOOP             INTERNAL RETURN POINT
MOVE1    EQU      %                 EXTERNAL ENTRY POINT
         LB,R6    R5                GET COUNT
         AWM,R6   TABPOS            UPDATE BUFFER SIZE
         AND,R5   #R7FFFF           MASK SBA
         XW,R4    R5                SBA TO R4 / DBA TO R5
         STB,R6   R5                INSERT COUNT
         MBS,R4   0                 MOVE RECORD INTO PLACE
         XW,R4    R5                PUT DEST. BACK INTO R4 FOR FURTHER USE
         B        *R0               AND EXIT
         PAGE
*
*
*
NOTOP    EQU      %
         LW,R7    #CBLANKS          OPCODE NOT PROPER - LOAD BLANKS
         B        PLACEOP           GO INSERT BLANKS INTO PRINT BUFFER
TAB      SLS,X5   -24               GET POSITION IN TAB SPEC
         AI,X5    -1
         STW,X5   X4                UPDATE CURRENT POINTER
         AW,X4    V12
         B        STCHECK           CHECK  BUFFER SIZE
SPACE    SAS,X5   -24               BUMP CURRENT POSITION
         AW,X4    X5
STCHECK  EQU      %
         CI,R5    10                WHAT IS COUNT
         BG       STCHECK1          CHECK FOR NEW COLUMN POINTER
         AWM,R5   TABPOS            UPDATE IT
         B        FLOOP             REJOIN MAIN PATH
STCHECK1 EQU      %
         CW,R5    TABPOS            IS NEW .GT. OLD
         BLE      FLOOP             NO - SKIP IT
         STW,R5   TABPOS          YUP-SAVE NEW POINTER
         B        FLOOP             AND REJOIN...
END      RES      0
         LI,R4    0                 RESET
         STW,R4   BLANKFLG          BLANK BUFFER FLAG
         PULL     6,X4
         B        1,L1
PRINT    LI,R0    PRINTERM1         NORMAL RETURN
PRINTBUF EQU      %                 OR HERE WITH R0 SET
         PRINT,%TEXTBSZ  OBUF
*
*        FALL THRU AND BLANK BUFFER
BL:BUF   EQU      %
         LCFI     2
         PSM,R0   STACK
         LI,R1    -33               LENGTH OF PRINT BUFFER
         LW,R0    #CBLANKS          PICK UP SOME BLANKS
         STW,R0   OBUF+33,R1        ZAP IT
         BIR,R1   %-1
         LI,R0    0
         STW,R0   TABPOS            CLEAR BUFFER SIZE CELL
         LCFI     2
         PLM,R0   STACK
         B        *R0
PRINTERM1 LW,X4   V12               RESET POINTER
         B        FLOOP
         PAGE
*
*        SKIP BLANK LINES
*
SKIP     EQU      %
         SLS,R5   -24               POSITION COUNT PASSED
         AND,R5   #R1F              LIMIT MAX TO 31
         BAL,R0   BLANK1            PRINT BLANK LINE
         BDR,R5   %-1               FINISH W/COUNT
         B        PRINTERM1         GO WRAP UP
         PAGE
*
*        CONVERT HEX VALUE TO DECIMAL
*
DECIMAL  RES      0                 BINARY TO DECIMAL CONVERSION
         LB,X6    X5                GET BYTE COUNT OF LINE TO PUT
         AWM,R6   TABPOS            UPDATE BUFFER SIZE
         AW,X4    X6                ADJUST X4 BEYOND END
         LW,X6    X4                AND X6 TO LAST BYTE PLACED
         AI,X6    -1
         LW,A8    *X5               FETCH WORD TO CONVERT
         LI,X5    DECLOOP           SET UP LOOP RETURN ADDRS
DECLOOP  SAD,A8   -32               POSITION FOR DIVIDE
         DW,A8    L(10)             GET QUOTION/REMAINDER
         BNEZ     DECDIG            IGNORE UNLESS THIS LAST DIGIT
         LI,X5    FLOOP             MARK RETURN ADDRESS
         CI,A8    0                 IF ANS NEG, WANT TO PUT -
         BGEZ     DECDIG
         LI,A9    '-'
         AI,X6    -1
         STB,A9   0,X6
         AI,X6    1
DECDIG   LAW,X7   A8                GET THIS REMAINDER
         LB,X7    HEXCHAR,X7        CONVERT TO PRINTABLE
         STB,X7   0,X6              PLACE IN LINE IN REVERSE ORDER
         LW,A8    A9                RESET FOR DIVIDE
         BDR,X6   *X5               LOOP OR RETURN. CANNOT FALL THROUGH.
FORMATER B        END               SAYS GO TO END IF ERROR
         PAGE
*
*        BITPIK SEPARATES THE COMPONENT PARTS OF A WORD INTO SEVERAL
*        CONTIGUOUS WORDS IN CORE.  CALLING SEQUENCE:
*
*                 LW,V13   WORD     WORD TO SEPARATE
*                 LI,V14   ARRAY    ARRAY TO STORE INTO
*                 LW,V15   CNTRLWD  CONTROL WORD
*                 CALL     BITPIK
*
*        ASSUME A CONTROL WORD OF X'81120001'.  ITS MEANING IS:
*                 STORE FIELD   0  INTO ARRAY
*                             1-7       ARRAY+1
*                            8-11       ARRAY+2
*                           12-14       ARRAY+3
*                           15-31       ARRAY+4
*
*        NOTE THAT ABOVE EXAMPLE BREAKS INTSTRUCTION WORD INTO
*        ITS COMPONENT PARTS.  THE CODING FOR THE PROC IS:
*
*                 BITPIK (WORD,ARRAY),(1,7,4,3,17)
BITPIK   SUBRTINE 'BITPIK'
         LI,V12   0                 V12-13 HAVE WORD DECOMPOSING
         STW,V14  PUTAD             SAVE ARRAY ADDRESS
BITPLOOP CI,V15   0                 DONE YET?-(ALL BITS LOST CNTRL WD)
         BEZ      BITPEND             YUP
         SLD,V12  1                 SHIFT WORD DECOMPOSING
         SLS,V15  1                   AND CONTROL WORD 1 EACH
         BEV      BITPLOOP          GO BACK IF STORE BIT  NOT HIT
         STW,V12  *PUTAD            STORE BIT
         MTW,1    PUTAD             NEXT ARRAY ADDRESS
         LI,V12   0                 RESET HIGH PART O WORD
         B        BITPLOOP
BITPEND  B        0,L1              CONTROL WORD = 0, RETURN
         PAGE
*
*F*      NAME:    MD:SUBQ
*F*      PURPOSE: TO RUN THE USER RESOURCE SUB-QUEUE DISPLAY
*
*        REGISTER ASSIGNMENTS:
*
*        R1:      INTERNAL LINK
*        R2:      USER NUMBER
*        R3:      USED FOR DISPLAYING USER NUMBER
*        R4:      RESOURCE LIST NUMBER
*        R5:      USER'S ACTUAL STATE
*
*
         USECT    PP                GENERATE PROCEDURE
MD:SUBQ  EQU      %
         PSW,R1   STACK             SAVE RETURN LINK TO ANALYZE
         LI,R1    -128
         LI,R0    0
         LW,R2    USERLIST          ADDRESS OF TABLE
         AI,R2    128               TOP OF IT
         STW,R0   *R2,R1            CLEAR TABLE
         BIR,R1   %-1               CLEAR IT ALL
         LI,R1    R:STITLE          TITLE LINE
         BAL,R0   TITEL             OUT
         LI,R2    1                 INITIAL USER NUMBER
         LI,R4    0                 INITIAL RESOURCE LIST NUMBER
R:SUBQ1  EQU      %
         FETCH    (SB:RQ,R4,BA),(R2,,WA)  **GET HEAD OF LIST**
         CI,R2    0                 ANYBODY IN THIS QUEUE
         BEZ      R:SUBQ4           NOPE
         FETCH    (UB:US,R2,BA),R5  **GET STATE OF USER**
         CI,R5    0                 IS THERE REALLY A USER THERE
         BEZ      R:SUBQ4           NOPE
         CI,R5    SNULL             OR EMPTY SLOT
         BE       R:SUBQ4           YEP
*
*        USER SEEMS TO QUALIFY
*
         LW,R1    R4                MOVE LIST NUMBER
         SLS,R1   1                 DBL-WRD INDEX
         AND,R1   #RF
         AI,R1    R:SMSG            CREATE CORE ADDRESS OF MSG
         BAL,R0   MSG
         LI,R7    SMUIS             LIMIT LOOP TO THIS
R:SUBQ15 LI,R1    15                INITIAL SPACING
         BAL,R0   SPACES            INITIAL SPACING
         LI,R6    10
R:SUBQ2  EQU      %
         CI,R2    SMUIS             VALUE OUT OF RANGE
         BG       R:SUBQ36          YEP - END THE CHAIN
         LW,R3    R2                USER NUMBER
         BEZ      R:SUBQ36          DONE AT ZERO ENTRY
         BAL,R0   TRANSSZ
         FETCH    (UB:US,R3,BA),(R5,,WA)  **OBTAIN USERS STATE**
         CI,R5    SQR               IS ACTUALLY IN QUEUE
         BE       R:SUBQ3           YES
         CI,R5    SQRO              OR OUT OF CORE IN QUEUE
         BE       R:SUBQ3           YES
         LI,R1    ASTERISK          NO
         BAL,R0   MSG
R:SUBQ3  EQU      %
         LI,R1    ARROW
         BAL,R0   MSG
         FETCH    (U:MISC,R3,WA),(R2,,WA)  **OBTAIN FWD LINK**
         AND,R2   #RFF              EXTRACT FWD LINK
         BEZ      R:SUBQ36          HIT THE TAIL
         CW,R2    R3                DOES FLINK POINT TO HERE
         BE       R:SUBQ36          YEP - ITS THE END OF THE LIST
         MTB,0    *USERLIST,R2      SEEN THIS BEFO
         BNEZ     R:SUBQ5         YEP - THATS AN ERROR
         MTB,1    *USERLIST,R2      COUNT TIMES WE SEE HIM...
         AI,R6    -1
         BGEZ     R:SUBQ2           NOT TIME TO PRINT YET
R:SUBQ35 BAL,R0   BUFOUT            PRINT WHAT WE HAVE NOW
         BDR,R7   R:SUBQ15          LOOP ONWARDS...
R:SUBQ36 EQU      %
         LI,R1    TAILMSG
         BAL,R0   MBB               MSG/BUFOUT/BLANK1
R:SUBQ4  AI,R4    1                 NEXT LIST
         CI,R4    6                 AT TOP OF LIST
         BLE      R:SUBQ1           NOT YET
         PLW,R1   STACK             YEP
         B        0,R1              RETURN
TAILMSG  TEXTC    'TAIL'
*
*
R:SMSG   EQU      %
         TEXTC    'R:SYMF'
         TEXTC    'R:SYMD'
         TEXTC    'R:OCR '
         TEXTC    'R:CBA '
         TEXTC    'R:DPA '
         TEXTC    'R:QFAC'
         TEXTC    'R:NQW '
*************************************
ASTERISK TEXTC    '*'
ARROW    TEXTC    ' > '
         PAGE
*
*        ERROR DISCOVERED IN CURRENT RESOURCE SUB-QUEUE
*
R:SUBQ5  EQU      %
         LW,R3    R2                # THAT IS IN ERROR
         BAL,R0   TRANSSZ           PUT IT OUT
         BAL,R0   BUFOUT            PRINT EVERYTHING
         LI,R1    8
         BAL,R0   SPACES            AND SPACE OVER FOR ERROR MSG
         LI,R1    SUBQERR         MSG ADDRESS
         CI,R2    SMUIS             WAS FWD LINK IN ERROR
         BLE      %+2               NO
         LI,R1    SUBQERR1          YES - SEND THIS MSG INSTEAD
         BAL,R0   MBB             PUT OUT ERROR MSG
         B        R:SUBQ4         AND GO TO NEXT QUEUE
*
SUBQERR  TEXTC    '**ERROR - SUBQUEUE CHAIN IS CIRCULAR'
SUBQERR1 TEXTC    '**ERROR - INVALID FWD LINK IN SUBQUEUE CHAIN'
*
         PAGE
*
*
TB0      EQU      1
TB2      EQU      6
TB3      EQU      16
TB4      EQU      24
TB4A     EQU      6                 W/C FOR TB4
TB5      EQU      48
TB5A     EQU      12
TB6      EQU      60
TB6A     EQU      15
*
*F*      NAME:    MDDCB
*F*      PURPOSE: TO DRIVE THE DCB DUMP/STATUS DISPLAY ROUTINES
*
MDDCB    EQU      %
         PUSH     R1                SAVE RETURN
         STW,R3   LINKPTR           SAVE DCB ADDRESS IF COME FROM
*                                   CONTEXT DISPLAY
         MTW,0    SPECIFIC%USER%DCBS                                         A00
         BNEZ     NOT%ALL           ONLY DO ONE USER                         A00
         LI,R4    SMUIS                                                      A00
         STW,R4   USER              SET UP LOOP                              A00
         LI,R1    USMSG                                                      A00
         BAL,R0   TITEL                                                      A00
USRLOOP  LW,R4    USER              GET NEXT INDEX
         LI,R0    0
         STW,R0   MAPFLAG           RESET IT - LEAVE IMAGES
         LI,R14   UH:FLG
         BAL,0    GETADDR
         LH,R5    *R15,R4           GET USER'S FLAGS
         STW,R5   USFLG             AND SAVE
         CI,R5    JIC               IS JIT IN CORE
         BAZ      NXTUSR            NOPE,GO TO NEXT USER
         BAL,R0   RES:JIT           FIND HIS JIT
         BCS,4    NXTUSR            NO JIT TO BE HAD
         LI,R5    DCBLINK           INDEX INTO JIT
         LW,R12   *JITBUF,R5        GET IT
         STW,R12  LINKPTR           SAVE ADDRESS
NOT%ALL  EQU      %                 ENTRY FOR JUST ONE USER
         LW,2     USER              GET USER#
         BAL,0    MAP:USER          AND MAP IN USER
         MTW,0    SPECIFIC%USER%DCBS    DOING A PARTICULAR USER
         BNEZ     NO:HDR:INFO           YEP - SKIP THE HEADER
         LB,R1    *JITBUF           GET BYTE 0 OF THIS JIT
         SLS,R1   -5                MAKE IT AN INDEX
         LCI      2                 GET
         LM,R10   JIT:ORIG,R1       AND SAVE
         STM,R10  USR:ORIG          STORE USER ORIGIN
         LCI      3                 NOW
         LM,R11   *JITBUF           GET USER'S ACCOUNT#
         STD,R12  USR:ACN#          STORED
         BAL,R0   BLANK1
         LW,R12   LINKPTR
         BAL,R1   SVALCON
         FORMAT START,(TAB,TB0),'USER#   ->',(HEX,USER,3),PRINT
         FORMAT (TAB,TB0),'ACCOUNT ->',(EBC,USR:ACN#,8),PRINT
         FORMAT (TAB,TB0),'ORIGIN  ->',(EBC,USR:ORIG,8),PRINT,END
         FORMAT   START,(SKIP,3),END
NO:HDR:INFO EQU   %
         FORMAT   START,(TAB,TB2),'DCB NAME'
 FORMAT       (TAB,TB3),'ADDRS'
 FORMAT       (TAB,TB4),'CURRENT STATUS'
 FORMAT       (TAB,TB5),'ASSIGNMENT'
 FORMAT       (TAB,TB6),'CURRENT STATE',PRINT
 FORMAT       (TAB,TB2),'--------'
 FORMAT       (TAB,TB3),'-----'
 FORMAT       (TAB,TB4),'--------------'
 FORMAT       (TAB,TB5),'----------'
 FORMAT       (TAB,TB6),'-------------',PRINT,(SKIP,3),END
         LI,A8    1
         STW,A8   NEWDTAB
JIT:LOOP BAL,R1   DTABSRCH          GO LOOK FOR DCB CHAIN
         B        NXTUSR            END OF CHAIN RETURN
         BAL,R1   DCBSTAT           DISPLAY  TATUS
         BAL,R1   DCBPRINT
         BAL,R0   BLANK1
         LW,R14   DCBADRS           CURRENT ADDRS
         BAL,R0   GETADDR           SET UP PAGE
         LW,R8    R15               POSITION FOR SNAP
         MTW,0    *R15              IS THIS M:* ???
         BNEZ     REG:DCB           NO
         LI,R7    41                YES
         B        DCB:DUMP          GO DUMP IT
REG:DCB  LI,R6    10                LOC OF KBUF IN DCB
         LW,R7    *R15,R6           GET IT
         AND,R7   ADMASK            MASK TO 17 BITS WORTH
         BNEZ     GOTKBUF           HAS A KEY BUFFER
         LI,R7    21                MINIMUM SIZE OF A DCB
         AW,R7    DCBADRS           ADD BASE ADDRESS OF DCB
GOTKBUF  SW,R7    DCBADRS           CALCULATE LENGTH OF DCB
         AI,R7    9                 ADD LENGTH OF KEY BUFFER
         AND,R7   RPAGEMSK          IN ANY EVENT NEVER BIGGER THAN PAGE
DCB:DUMP BAL,R0   DUMPSOME          DUMP OUT DCB OR CFU...
         BAL,R0   BLANK1
         B        JIT:LOOP          GO TO NXT DCB IN THIS JIT
NXTUSR   EQU      %                                                          A00
         MTW,0    SPECIFIC%USER%DCBS                                         A00
         BNEZ     DCBRET            ONLY DO ONE USER                         A00
         MTW,-1   USER              GO TO NEXT USER #                        A00
         BGZ      USRLOOP           KEEP GOING TILL ZERO
DCBRET   LI,R0    0                 TURN OFF
         STW,R0   SPECIFIC%USER%DCBS    RESET FLAG BEFORE EXIT               A00
         PULL     R1
         B        0,L1
         PAGE
************************************
DTABSRCH SUBRTINE 'DTABSRCH'
************************************
         PUSH     R1                SAVE RETURN
         MTW,0    LINKPTR           AT END OF DCBTABLES ?
         BEZ      DTABEND             YES - TAKE ABN EXIT
         MTW,-1   NEWDTAB           HAVE WE SCANNED THIS DCB TABLE YET?
         BLZ      GETLINK             YES-DTABSTP POINTER IS OK
         LW,A8    LINKPTR             NO- INITIALIZE DTABSTP
         AI,A8    1
         STW,A8   DTABSTP
GETLINK  LW,R14   DTABSTP
         CI,R14   JOVVPA            IS DCB CHAIN POINTER VALID
         BL       BAD:DCBLINK       ***NOPE---> ERROR
         CLM,R14  LEGCORAD          IS IT IN CORE LIMITS
         BCS,9    BAD:DCBLINK       **ERROR
         BAL,R0   GETADDR
         LCI      9
         LM,R0    *R15
         STM,R0   LINKINFO
         BLANK    (DCBNAME,3)         ALTHOUGH I PRINT ONLY FIRST 12
         LW,X4    LINKINFO          IF NEXT WORD IS ZERO, HAVE REACHED
         BEZ      DTABEND           END OF CHAIN HIT
         LB,X4    LINKINFO          TEXTC COUNT OF NAME
         CI,X4    31                CANNOT GO OVER 31 CHAR
         BG       DTABABN
         AI,X4    4                 ROUND + TRUNCATE TO WORD COUNT
         SLS,X4   -2
         STW,X4   DCBNAMSZ          SAVE WORD COUNT OF DCBNAME
         LB,R4    LINKINFO          RESTORE THE BYTE COUNT
         CI,R4    12                IS MAX DCB NAME
         BLE      %+2               NOPE
         LI,R4    12                RESTRICT TO 12 BYTE NAME
         LI,R6    BA(LINKINFO)+1    SOURCE BYTE ADDRS
         LI,R7    BA(DCBNAME)       DEST. BYT ADDRS
         STB,R4   R7                STORE COUNTER
         MBS,R6   0                 MOVE NAME INTO PLACE
         LW,X4    DCBNAMSZ          ADVANCE DCB TAB STEP POINTER TO
         AWM,X4   DTABSTP             DCB ADDRS
         LW,R12   DTABSTP           CURRENT POINTER
         CLM,R12  LEGCORAD          TEST FOR LEGALITY
         BCS,9    BAD:DCBLINK       ***ERROR***
         BAL,R1   SVALCON           GET CONTENTS OF CURRENT POINTER
         STW,R15  DCBADRS           STORE IT AWAY
         SVALCON  (DCBADRS,DCB0PAK) **MOVE CONTENTS TO DCB WORD 0 SLOT
         LI,R4    9
         FETCH    (DCBADRS,R4,BA),TYC  ***GET TYC BYTE FROM DCB
         MTW,1    DTABSTP           ADVANCE TO POINT TO NEXT ENTRY
         SVALCON  (LINKPTR,X4)                     YES-CHAIN END
         CW,X4    DTABSTP           HAVE WE REACHED END THIS TABLE ?
         BG       DSRCHRET            NO
         SVALCON  (R4,LINKPTR)      TO TOP OF NEXT TABLE
         LI,X5    1                 SET NEWDTAB SO DTABSTP WILL BE
         STW,X5   NEWDTAB             INITIALIZED NEXT TIME
DSRCHRET RES      0
         PULL     R1
         B        1,L1
DTABABN  EQU      %
DTABEND  EQU      %
         PULL     R1
         B        NXTUSR            ERROR GO TO NEXT USER
         PAGE
*
*        EITHER J:DCBLINK HAS AN INVALID ADDRESS OR ONE OF THE
*        POINTERS IN THE DCB CHAIN HAS BEEN CLOBBERED
*
BAD:DCBLINK EQU   %
         FORMAT   START
         FORMAT   (SKIP,2),'*** INVALID ADDRESS IN DCB CHAIN '
         FORMAT   PRINT,END
         B        DTABABN           AND QUIT
         PAGE
************************************
DCBSTAT  SUBRTINE 'DCBSTAT'
************************************
         PUSH     R1                SAVE RETURN
         BITPIK   (DCB0PAK,DRES0),(9,2,17,4)
         BAL,R0   BL:BUF            BLANK OUT THE BUFFER
         LW,R4    TYC               ADJUST
         SLS,R4   -1                TO BYTE FORMAT
         STW,R4   TYC               AND REPLACE
         CALL     EXPLAIN
         EXPLAIN  (0,'CLOSED - NEVER OPEN ',FCIFCD,OBUF+TB4A)
         EXPLAIN  (1,'OPEN - NEVER CLOSED ')
         EXPLAIN  (2,'CLOSED - WAS OPENED ')
         EXPLAIN  (3,'OPEN-(MORE THAN 1ST)'),END
         CALL     EXPLAIN
         EXPLAIN (0,'INACTIVE',TYC,OBUF+TB6A)
         EXPLAIN  (1,'ACTIVE -NORMAL')
         EXPLAIN  (2,'LOST DATA')
         EXPLAIN  (3,'BOT')
         EXPLAIN  (4,'BOF')
         EXPLAIN  (5,'EOR')
         EXPLAIN  (6,'EOD')
         EXPLAIN  (7,'EOF')
         EXPLAIN  (8,'READ ERROR')
         EXPLAIN  (9,'WRITE ERROR')
         EXPLAIN  (10,'DISC SATURATED')
         EXPLAIN  (11,'SLIDES AT MAX')
         EXPLAIN  (12,'PARTIAL HIGHER LEVEL INDEX BUILT')
         EXPLAIN  (13,'PURGE CAL ENDED RD/WRT')
         EXPLAIN  (14,'LN HANG UP W/RD PENDING')
         EXPLAIN  (15,'LN HANG UP W/INCOMPLETE WRT')
         EXPLAIN  (16,' ')
         EXPLAIN  (17,' ')
         EXPLAIN  (18,' ')
         EXPLAIN  (19,'WRITE ERROR AFTER EOT')
         EXPLAIN  (20,' '),END
GETASN   CALL     EXPLAIN
         EXPLAIN  (0,'NONE  ',ASN,OBUF+TB5A)
         EXPLAIN  (1,'FILE  ')
         EXPLAIN  (2,'LABEL ')
         EXPLAIN  (3,'DEVICE')
         EXPLAIN  (4,'TP JRNL')
         EXPLAIN  (10,'ANSI TAPE'),END
STATRET  EQU      %
         PULL     R1
         B        0,L1
         PAGE
************************************
DCBPRINT SUBRTINE 'DCBPRINT'
************************************
         PUSH     L1
         MTW,7    BLANKFLG          SET NO BLANKING FLAG
 FORMAT START,(TAB,TB2),(EBC,DCBNAME,12),(TAB,TB3),(HEX,DCBADRS,5)
         FORMAT   PRINT,END
         PULL     L1
         B        0,L1
         PAGE
EXPLAIN  SUBRTINE 'EXPLAIN'
**************************
         STW,L1   ARGS
EXPLOOP  LW,A8    *ARGS
         MTW,1    ARGS
         STW,A8   TXTPOINT
         BITPIK   (TXTPOINT,TXTLENGW),(8,1,1,22)
         MTW,0    TXTLENGW
         BLEZ     EXPRETRN
         LW,A8    *ARGS
         MTW,1    ARGS
         STW,A8   VALUE
         MTW,0    P3PRESNT
         BEZ      TEST4
         LW,A8    *ARGS
         STW,A8   WORDTSTN
         MTW,1    ARGS
TEST4    MTW,0    P4PRESNT
         BEZ      CHECKVAL
         LW,A8    *ARGS
         STW,A8   RECVBLK
         MTW,1    ARGS
CHECKVAL LW,A8    VALUE
         CW,A8    *WORDTSTN
         BNE      EXPLOOP
         LW,V12   TXTLENGW
         LW,V14   TXTAD
         LW,V15   RECVBLK
         AWM,V12  RECVBLK
         CALL     SHUFFLE
         B        EXPLOOP
EXPRETRN EQU      %
         B        *ARGS
         PAGE
*
*
*
*
*        SHUFFLE - MOVES BLOCKS OF WORDS.  SHUFFLE TESTS FOR POSSIBLE
*          OVERLAP IN FROM/TO RANGES.  IF THIS OVERLAP CONDITION EXISTS,
*          EITHER A FORWARD OR BACKWARD MOVE IS PERFORMED.
*
*        V12 - WORD COUNT
*        V13 - X
*        V14 - FROM ADDRESS
*        V15 - TO ADDRESS
*
*
         USECT    PP
********************************
SHUFFLE  SUBRTINE 'SHUFFLE'
********************************
         PSW,R1   STACK           SAVE RETURN LINK
         SLD,R14  2                 FROM/TO INTO BA'S
         SLS,R12  2                 MAKE WORDS INTO BYTE COUNT
         LW,R1    R15             MOVE  DEST BA (IN OBUF)
         AI,R1    -BA(OBUF)       CALCULATE DISTANCE INTO PRINT BUF
         AW,R1    R12             ADD LENGTH OF MSG
         CW,R1    TABPOS          IS  NEW  VALUE  .LT. CURRENT
         BLE      %+2             YES-ALREADY HAVE PROPER VALUE
         STW,R1   TABPOS          NO-UPDATE CURRENT END OF BUF CNT
         STB,R12  R15               SET UP MBS
         MBS,R14  0                 MOVE INTO PLACE
         PLW,R1   STACK           RETRIEVE THE RETURN LINK
         B        0,R1              AND EXIT
         PAGE
         USECT    PP
*
*F*      NAME:    JITS
*F*      PURPOSE: TO OBTAIN VALUE THE USER TYPED AND DISPLAY
*F*               THE JIT ASSOCIATED WITH THAT NUMBER IF IT EXISTS.
*
*        COMMAND FORMAT:
*
* DI(SPLAY) JI(T)  N(USER NUM)  A(OFFSET START)  B(OFFSET END)
*
*        OFFSETS ARE OPTIONAL AND IN THEIR ABSENCE ALL OF THE JIT
*        IS ASSUMED TO BE DUMPED
*
*        NOTE THAT YOU CAN ASK FOR 10 DIFFERENT USERS/OFFSETS
*        IN ONE COMMAND LINE
*
JITS     LB,1     FIELD3           *
         BEZ      JITS1            *MUST MEAN MONITOR JIT
         CI,R1    'M'              *WANTS THE MONITOR JIT
         BNE      JITS2            *NO - A USER JIT
JITS1    EQU      %                *
         LI,R1    MJITMSG          *TITLE LINE MSG
         BAL,R0   TITEL            *OUTPUT
         LI,R2    0                *INSURE
         B        JITS3            *MERGE WITH COMMON CODE
JITS2    EQU      %                *
         LI,1     2                *
JITS21   EQU      %                *
         BAL,0    GETHEX           *
JITS3    EQU      %                *
         STW,2    USER             *SAVE USER#
         BAL,R0   RES:JIT          *GET THE JIT
         BCS,4    SCANNER          *NONE TO BE FOUND
         LW,R1    J:PAGE            * WAS JIT IN CORE
         BGZ      JITS4            *IN CORE
         LI,R1    OUTJITMSG        *OUT
         BAL,R0   MSG%OUT          *PUT OUT MSG ABOUT JIT
         B        JITS5            *
JITS4    BAL,R0   DISP:PP          *SHOW PHYSICAL PAGE # OF JIT
JITS5    EQU      %                *
         BAL,0    NEXTLOC          *
         AW,R9    R8                * TEST FOR OPTIONAL DISPLACEMENTS
         BEZ      JITS56            * USER DID NOT SPECIFIY DISP'S
         CI,R7    512               * TEST FOR MAXIMUM JIT SIZE
         BLE      %+2               * IS OK
JITS56   EQU      %                 *
         LI,R7    512               * LIMIT OF ONE PAGE FOR JITS
         AW,R8    JITBUF           *CREATE CORE ADDRESS
         MTW,1    JITBURST         *SET FLAG SAYING JIT DUMP
         BAL,R0   DUMPSOME         *DUMP OUT THE JIT
         MTW,0    USER             *JUST DO A USER JIT
         BNEZ     JITS6            *YES - RETURN
         LI,R1    SCANNER          *NO - MONITOR'S JIT
         B        DISPSTK          *OUTPUT THE MONITOR'S TSTACK
JITS6    EQU      %                *
         LI,R6    JITS21           *RETURN IF THERE
         B        GETLIST          *IS A LIST
*                                  *
*
CXTMSG   TEXTC    'CONTEXT AREA FOR'
         PAGE
*
*F*      NAME:    ALLJIT
*F*      PURPOSE: TO ESTABLISH THE LIST OF USERS INCORE AT CRASH TIME
*F*               AND TO DISPATCH THE DUMP DRIVERS TO DISPLAY THESE
*F*               SAME USERS.
*
*        COMMAND FORMAT:
*
*        DI(SPLAY)   AJ(ITS)
*
ALLJIT   EQU      %                                                  RL2
         LI,14    UH:FLG            NOW LETS LOOK
         BAL,0    GETADDR           FOR ALL OF THE
         LI,R0    0
         STW,R0   OSULSIZE          ZAP OUT SWAP USER TABLE SIZE
         STW,R0   OSUL              CLEAR PREVIOUS COUNTER
         LI,1     SMUIS             IN CORE USERS
         LI,2     1                 SET UP COUNTER
         LI,3     JIC               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
         BAL,R0   SCANLIST          RUN THRU THE LIST FRST
AJ15     BDR,1    AJ1               FINISH MAX LIST
         LI,14    SB:OSUL                                            RL2
         BAL,0    GETADDR                                            RL2
         LB,R3    *R15              GET LENGTH OF OUTSWAP LIST
         BEZ      AJ17              NONE IN LIST
         CI,R3    SMAXOUT           SEE IF TABLE WAS BLASTED
         BG       AJ17              YUP--> SKIP IT
         STW,R3   OSULSIZE          REMEMBER SIZE OF THE LIST
AJ16     EQU      %
         LB,R1    *R15,R3           GET AN ENTRY FROM OUTSWAP LIST
         BEZ      %+2
         BAL,R0   SCANLIST          RUN THE LIST
         BDR,R3   AJ16              RUN THRU THE ENTIRE LIST....-->
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     EQU      %
         LI,R1    ISJITMSG
         BAL,R0   PUTITOUT
AJ42     LW,R2    OSULSIZE          IS THERE AN OUTSWAP LIST
         BEZ      AJ43              NO
         LI,R1    OSJITMSG
         BAL,R0   PUTITOUT
         BDR,R2   %-2
AJ43     LI,R1    JITMSG
         BAL,R0   PUTITOUT
         B        %-2               UNITL LIST COMPLETED..
         PAGE
*
*        CHECK USER # IN R1 TO SEE IF IT ALREADY APPEARS IN
*        OUR LIST
*
SCANLIST EQU      %
         PSW,R2   STACK
         AI,R2    -1                ADJUST FOR COUNT NOW IN LIST
         BLEZ     SCANLIST1         AT START OF LIST ONLY
         CLM,R1   USERLIMS          IS VALID USER NUMBER
         BCS,9    SCANLIST2         NOPE--THROW IT AWAY
         CB,R1    OSUL,R2           CHECK TO SEE IF IN LIST ALREADY
         BE       SCANLIST2         YUP
         BDR,R2   %-2
SCANLIST1 EQU     %
         PLW,R2   STACK             RETRIEVE THE INDEX
         STB,R1   OSUL,R2           STORE THE USER NUMBER
         AI,R2    1                 BUMP INDEX
         B        *R0               AND RETURN
SCANLIST2 EQU     %
         PLW,R2   STACK
         B        *R0               REJECT THIS ONE
         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
*
*        FALL THRU TO SHOW OUT OF CORE PEOPLE
*
         PAGE
*
*F*      NAME:    ALLOUTJIT
*F*      PURPOSE: TO RUN THE USER TABLES DUMPING JITS OF USER'S
*F*               THAT WERE OUT OF CORE AT CRASH TIME.
*
*        COMMAND FORMAT:
*
*        DI(SPLAY)   OJ(ITS)
*
ALLOUTJIT EQU     %
         LI,R2    1
         STW,R2   USER              WILL START AT USER#1 (KEYIN)
NEXT:US  EQU      %
         LW,R2    USER
         CI,R2    3                 DONE RBBAT JIT YET
         BLE      NEXT:US1          NOT YET-> DRIVE ON
         LC       J:JIT
         BCS,4    TCONT             GHOST JOB IS DONE AFTER RBBAT
NEXT:US1 EQU      %
         CI,R2    SMUIS             DONE W/ALL USERS YET
         BG       TCONT             YES-> QUIT NOW
         LI,14    UB:US             USER STATE TABLE
         BAL,0    GETADDR           BRING IT IN
         LB,3     *15,2             GET USERS STATE
         CI,R3    #STATES
         BGE      NO:JIT            NO GOOD
         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     JITBUF
         LI,7     512
         BAL,0    DUMPSOME
         BAL,R1   DISPSTK           DISPLAY TSTACK CONTENTS
NO:JIT   EQU      %
         MTW,1    USER              STEP UP TO NEXT USER
         B        NEXT:US           LOOP TILL SMUIS USERS ARE DONE...
         USECT    DATA
USTATE   DATA     0
         USECT    PP
U1:MSG TEXTC 'USER''S STATE = '
         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    *JITBUF,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  EQU      %
         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
*
*F*      NAME:    CXTOUT
*F*      PURPOSE: TO DUMP A USER'S CONTEXT AREA AS INDICATED BY THE
*F*               CMAP IN THE USER'S 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
         MTW,2    SPECIFIC%USER%DCBS
         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
         STW,R2   USER              AND SAVE THE WHOLE THING
         BAL,0    MAP:USER          MAP USER INTO "MAP"
         LC       JITSTAT           CHECK FLAG
         BCS,4    FINCXT            DIDNT READ ONE
         LI,R1    CXTMSG
         BAL,R0   BLANK1
         BAL,R0   BLANK1
         BAL,R0   MSG
         BAL,R0   BUST4
         LI,R3    JDCBUL            CONTEXT UPPER LIMIT CELL
         LW,R1    *JITBUF,R3        GET IT
         BAL,R0   PAGE:CHK          EXAMINE IT
         B        FINCXT            ERROR EXIT
         STW,R1   ENDDCB            STOP POINT
         LI,R3    JDCBLL            CONTEXT LOWER LIMIT CELL
         LW,R1    *JITBUF,R3        GET IT
         BAL,R0   PAGE:CHK          CHECK IT
         B        FINCXT            ERROR EXIT
         LI,R3    DCBLINK           INDEX TO GET DCB POINTER
         LW,R3    *JITBUF,R3        USER HAVE DCBS
         BLZ      BAD:DCBP          BAD
         BEZ      NO%DCBS           DIDNT HAVE ANY
         BAL,R1   MDDCB             DISPLAY DCB INFORMATION
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  EQU      %
         LOAD,R1  *USRMAP,R4        **LOAD MAP IMAGE
         BEZ      MORECXT           SKIP ON IF ZERO
         CLM,R1   NULLPAGE          IS A NULL MAP CONSTANT
         BCR,9    MORECXT           YES, SKIP TO NEXT INDEX
         STW,R1   J:PAGE            REMEMBER PAGE #
         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
         LW,R1    R4                MOVE MAPPED PAGE #
         BAL,R0   GET1ADDR          TOO READ SAME IN NOW..
         BAL,R0   BLANK1
         LI,R1    VIRTUALMSG        LETS PUT OUT
         LW,R3    R4                A MSG ABOUT THE VIRTUAL PAGE #
         BAL,R0   MTB               NOW
         LW,R1    J:PAGE            RESTORE R1
         BAL,R0   DISP:PP           THEN ONE ABOUT THE PHYSICAL PAGE#
CXTDMP   EQU      %
         LW,R8    PAGEBUF           PICK UP BUFFER ADDRESS
         LI,7     512
         BAL,0    DUMPSOME        DUMP THAT CONTEXT PAGE
MORECXT  AI,4     1                 BUMP PAGE#
MORECXT1 EQU      %
         CLM,R4   CXTLIMS           STILL IN LIMITS
         BCR,9    CXTLOOP           YUP--> KEEP GOING
FINCXT   EQU      %
         LD,R0    ZEROS
         STD,R0   CXTLIMS           CLEAR FOR NEXT TIME
         PLW,R0   STACK             GET RETURN LINK
         B        UNMAP             RESET MAP IMAGES
         PAGE
*
*F*      NAME:    SPBCXT
*F*      PURPOSE: TO DUMP THE USER'S SPARE BUFFERS AS INDICATED BY THE
*F*               CMAP IN THE USER'S JIT.
*
SPBCXT   BAL,R0   BLANK1
         LI,1     IXMSG             BUFFER INDEX LINE
         LW,3     4                 BUFFER INDEX NUMBER
         AI,3     1-JXBUFVP
         BAL,R0   MTB               MSG / TRANS / BUFOUT / BLANK1
         LW,R1    J:PAGE            RESTORE R1
         BAL,R0   DISP:PP           DESCRIBE PHYSICAL PAGE #
         LOAD,R1  *USRMAP,R4        LOAD MAP IMAGE
         BEZ      MORECXT           NONE
         CLM,R1   NULLPAGE          IS ASSIGNED...
         BCR,9    MORECXT           NOPE-> GET OUT
         LI,R7    1
         STH,R1   KEY,R7            KEY FOR MONDUMP FILE
         CAL1,1   PAGEFPT           READ ONE PAGE
         B        CXTDMP            PRINT IT
         PAGE
*
*F*      NAME:    DCBCXT
*F*      PURPOSE: TO ESTABLISH THE CONTEXT AREA DUMP LIMITS DETERMINED
*F*               BY ANLZ'S RUN MODE. GHOST MODE PUTS OUT AN
*F*               ABBREVIATED DUMP - ALL OTHERS DUMP ALL OF A USER
*F*               OUT.
*
DCBCXT   EQU      %
         LD,R4    UDMP1
         MTW,0    GJOB%FLAG         RUNNING AS A GHOST JOB
         BEZ      %+2               NOPE--> R4 IS CORRECT
         LW,R5    ENDDCB            DECREASE DUMP LIMITS IF GHOST
         LW,R2    USER              GET THIS USER'S #
         AND,R2   #R16              SCRUB FLAGS
         CW,R2    CUN               IS THIS ONE THE S:CUN GUY
         BNE      %+2               NOPE
         LD,R4    UDMP1             YES--> EXPAND DUMP LIMITS
         STD,R4   CXTLIMS           STORE CONTEXT DUMP LIMITS
         B        MORECXT1          AND REJOIN LOOP
         BOUND    8
UDMP1    DATA     JBUPVP,255        DUMP LIMITS IF NOT A GHOST JOB
*
         USECT    DATA
         BOUND    8
CXTLIMS  DATA     0
ENDDCB   DATA     0                 CLM PAIR FOR PAGE DUMP LIMIT
*
*
         USECT    PP
IXMSG    TEXTC    '*** SPARE BUFFER INDEX#'
VIRTUALMSG TEXTC 'VIRTUAL PAGE # '
         PAGE
*
*F*      NAME:    AJOUT
*F*      PURPOSE: TO INITIALIZE USER FLAGS AND PRODUCE THE TITLE
*F*               LINE FOR THE CONTEXT DISPLAY.
*
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#
         AI,R2    0                 IS OKAY VALUE
         BEZ      AJERXIT           NO
         CI,R2    SMUIS             IS OKAY VALUE
         BG       AJERXIT           NO
         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
*
*        USER NUMBER IS INVALID
*
AJERXIT  EQU      %
         PLW,R6   STACK             RETRIEVE LINK
         B        AJO4              AND EXIT DISPLAY
         PAGE
BIFM     CNAME
         PROC
         LOCAL    P,BR
LF       LC       MACHINE           PICK UP CC BITS
P        SET      SCOR(CF(2),S7,S9,X560,S7S9,S9S7,;
                  S7X560,X560S7,S9X560,X560S9,UNK)
         ERROR,3,(P<1)|(P>10)  'CONFIGURATION CONDITION NOT',;
                                    ' RECOGNIZED'
BR       SET      8,4,2,12,12,10,10,6,6,15
         GEN,1,7,4,3,17  AFA(1),X'69'-(P=10),BR(P),AF(2),WA(AF(1))
         PEND
         PAGE
*
*F*      NAME:    AJO1
*F*      PURPOSE: TO EXAMINE THE JIT CURRENTLY IN 'JITBUF' AND TO
*F*               INSURE THAT IT IS MOST PROBABLY THE ONE WE WANT
*
AJO1     EQU      %
         OR,R2    BATFLAG           SET NO SCAN FLAG
         BAL,R0   RES:JIT           GET THE USERS JIT
         BCS,4    0,R4              NINE TO BE FOUND
         PSW,R4   STACK             SAVE EXIT LINK
         LI,3     JAJ               GET AJIT'S
         LW,5     *JITBUF,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 IN CORE
         LI,R1    OUTJITMSG         WAS OUT OF CORE
         BAL,R0   MSG%OUT           PRINT THAT LINE
         B        %+2               AND JUMP
AJO25    BAL,R0   DISP:PP           SHOW PHYSICAL PAGE #
         BAL,R7   STKCHK            EXAMINE STACK FOR POSSIBLE ERROR
         B        AJO55             ERROR RETURN
       BIFM,S7S9  %+2               BRANCH IF SIGMA TYPE CPU
         BAL,R0   LASTBRNCH         DUMP J:ALB IF XEROX 560 CPU
         MTW,1    JITBURST          NO,SET FLAG
         MTW,0    LPFLAG            GOING TO LINE PRINTER
         BEZ      AJO5              NOPE,DO ONLINE DUMP
         LD,R8    JIT:LIMS          GET DUMP LIMITS
         BAL,R7   MDSNAP4           DUMP OUT THE JIT
       BAL,R1  DISPSTK
         PLW,R1   STACK             GET RETIRN LINK
         B        0,R1              AND EXIT
AJO55    EQU      %
         MTW,1    JITBURST          SET FLAG
         LI,R1    BADJITMSG         PUT OUT WARNING MSG
         BAL,R0   MBB               MSG / BUFOUT / BLANK1
         LCFI     4                 AND SET ERROR
         STCF     JITSTAT           FLAGS FOR OTHERS TO SEE
AJO5     EQU      %
         LW,8     JITBUF
         LI,7     X'200'
         BAL,R0   DUMPSOME          DUMP IT OUT (GOOD OR BAD)
         LC       JITSTAT           WAS BAD / OR JUST ONLINE
         BCS,4    %+2               WAS BAD
         BAL,R1   DISPSTK           WAS GOOD - DUMP OUT THE TSTACK
         PLW,R0   STACK             GET RETURN LINK
         B        *R0               RETURN TO CALLER
BADJITMSG  TEXTC  '***WARNING: THIS DOESNT LOOK LIKE A GOOD JIT'
OUTJITMSG EQU     %
 TEXTC '**THIS JIT WAS OBTAINED FROM THE SWAPPER COPY'
         USECT    PP
         PAGE
*
*F*      NAME:    AJITA
*F*      PURPOSE: TO VALIDATE THE AJIT PAGE # AND DISPATCH THE AJIT
*F*               DUMP IF VALUE IS OK.
*
AJITA    EQU      %
         LW,2     USER              CURRENT USER WE'RE ON
         LW,1     JAJPAGE           AJIT'S PAGE#
         BEZ      0,R6            NO AJIT PAGE
         CLM,1    PAGLIMS           VALID PAGE#
         BCS,9    0,R6              NO,EXIT
         PSW,R6   STACK             SAVE EXIT ADDRESS
         STW,1    J:PAGE            SAVE PAGE#
         BAL,R0   GET1ADDR          GO GET ONE PAGE IN
         BAL,R0   BLANK1
         LI,1     AJITMSG
         BAL,R0   MBB               MSG / BUFOUT / BLANK1
         LI,R4    JAJITVP           SET TO DISPLAY VIRTUAL                   A00
         STW,R4   OLDPAGEM             ADDRESSES FOR AJIT                    A00
         LW,R1    J:PAGE            GET PHYSICAL PAGE #
         BAL,R0   DISP:PP           AND DISPLAY SAME
         LW,R8    PAGEBUF
          STW,R8   AJITBURST
         LI,R7    512               TO DUMP ENTRIRE PAGE
         PLW,R0   STACK             GET RETURN LINK
         B        DUMPSOME          AND DUMP OUT AJIT
         USECT    DATA
JAJPAGE  DATA     0
         USECT    PP
         PAGE
*
*F*      NAME:    LASTBRNCH
*F*      PURPOSE: TO EXTRACT J:ALB CONTENTS AND DISPLAY SAME
*
LASTBRNCH EQU     %
         LCFI     4
         PSM,R0   STACK
         LI,R3    J:ALB-J:JIT       OFFSET INTO THE JIT
         LW,R3    *JITBUF,R3        GRAB VALUE
         BAL,R0   BLANK1
         LI,R1    ALBMSG
         BAL,R0   MTBB              MSG / TRANSLATE R3 / BUFOUT
         LCFI     4
         PLM,R0   STACK
         B        *R0
         PAGE
AJITMSG  TEXTC    'USER ADDITIONAL JIT'
UJITMSG  TEXTC    'JIT OF'
ALBMSG   TEXTC    '** LAST BRANCH ADDRESS: '
         PAGE
*
*F*      NAME:    RECOVERY%CONTEXT
*F*      PURPOSE: TO PROVIDE A DUMP OF THAT PORTION OF CORE USED BY
*F*               RECOVERY AT CRASH TIME ONLY IF THE CURRENT DUMP
*F*               IS COMING FROM A TAPE.
*
RECOVERY%CONTEXT  EQU   %
         MTW,0    TAP%DMP           IS THIS A TAPE DUMP....
         BEZ      0,R1              NOPE..RETURN TO SCANNER
         PSW,R1   STACK             SAVE RETURN ADDRESS
         LI,R1    RCVRY%CXT%MSG
         BAL,R0   TITEL
         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
RCV%CXT%MSG    TEXTC      '(MONITOR AREA AS MODIFIED BY RECOVERY)'           A00
         PAGE                                                                A00
*
*F*      NAME:    CURRENT%USER
*F*      PURPOSE: TO DRIVE THE JIT / AJIT / CONTEXT DUMP FOR THE
*F*               USER POINTED TO BY S:CUN AT CRASH TIME
*
CURRENT%USER EQU  %                                                          A00
         LI,R1    SLVCPUS           FIRST TIME WE GO THERE
         LW,R2    CUN               FIRST USER TO DUMP IS THIS ONE
NXTCUN   EQU      %
         PSW,R1   STACK             SAVE RETURN LINK
         STW,R2   USER              SET UP DISP PARAM                        A00
         LI,R1    CUJITMSG          TITLE MSG
         STB,R2   R1                REMEMBER USER #
         BAL,R0   TITEL                                                      A00
         BAL,R4   AJO1              PUT OUT JIT                              A00
         LC       JITSTAT           ANY ERRORS
         BCS,4    NO:CUN            YES - ABORT THE DISPLAY
         BAL,R0   BLANK1
         BAL,R6   AJITA             PUT OUT AJIT                             A00
         BAL,R0   CXTOUT            PUT OUT CONTEXT                          A00
NO:CUN   EQU      %
         PLW,R1   STACK             GET LINK
         B        0,R1
         PAGE
*
*        RUN THE SLAVE CPU CURRENT USERS
*
SLVCPUS  EQU      %
         LI,R6    NSCPU             IS THIS A MULTI-PROCESSING SYSTEM
         BEZ      SCANNER           NOPE
         LI,R6    1                 FIRST ENTRY INTO TABLES
SLVCPUS0 EQU      %
         LI,R14   S:PCUN            CURRENT USER TABLE
         BAL,R0   GETADDR           FETCH IT
         LW,R2    *R15,R6           GET A USER #
         BEZ      SLVCPUS1          NONE
         PSW,R6   STACK             SAVE INDEX
         BAL,R1   NXTCUN            DUMP THIS GUY OUT
         PLW,R6   STACK             RETRIEVE INDEX
SLVCPUS1 EQU      %
         AI,R6    1                 NEXT INDEX INTO TABLES
         CI,R6    NSCPU+1           AT TOP YET
         BL       SLVCPUS0          NOT YET
         B        SCANNER           ALL DONE
         PAGE
*
*        DUMP THE SLAVE CPU PRIVATE PAGE
*
SLCPU    EQU      %
         LI,R1    SLCPUTIT          PUT OUT THE TITLE LINE
         BAL,R0   TITEL
         LI,R6    NSCPU             IS THIS A MP SYSTEM
         BEZ      NOTRACE           NOPE
         LI,R6    1                 INITIAL ENTRY INTO TABLES
SLCPU1   EQU      %
         LI,R1    MPMSG1
         BAL,R0   MSG
         LW,R3    R6                CPU'S NUMBER
         BAL,R0   TRANSSZ
         LI,R1    20
         BAL,R0   SPACES
         LI,R1    MPMSG2
         BAL,R0   MSG
         LI,R14   S:ADR
         BAL,R0   GETADDR
         LW,R3    *R15,R6           GET ADDRESS OF THE CPU
         BAL,R0   TRANSSZ
         LI,R1    50
         BAL,R0   SPACES
         LI,R1    MPMSG3
         BAL,R0   MSG
         LI,R14   SX:SPP
         BAL,R0   GETADDR
         LOAD,R3  *R15,R6           GET PHYSICAL PAGE ADDRES
         STW,R3   CORELIMS          REMEMBER IT
         SLS,R3   9
         BAL,R0   TRANSSZ
         BAL,R0   BUFOUT
         BAL,R0   BLANK1
         STW,R6   PG:MODE           REMEMBER CPU NUMBER
         LCFI     9
         STCF     PG:MODE           STORE OWNER'S CODE
         LW,R4    CORELIMS          GET PHYSICAL PAGE #
         BEZ      SLCPU2            NO CPU CONNECTED IN THIS SLOT
         BAL,R0   PAGETABLE         INSERT IT INTO PAGE MATRIX
         LW,R14   CORELIMS          GET PHYSICAL PAGE # AGAIN
         SLS,R14  9                 CONVERT IT TO A WA
         BAL,R0   GETADDR           AND GO FETCH IT
         LI,R8    X'200'
         LI,R9    X'3FF'            RANGE OF VIRTUAL ADDRESSES IN PAGE
         MTW,1    DUMP:DIR          SET FLAG FOR MD:SNAP4
         PSW,R6   STACK             SAVE INDEX INTO MP TABLES
         BAL,R7   MDSNAP4           DUMP OUT TABLE
         PLW,R6   STACK
SLCPU2   EQU      %
         BAL,R0   BLANK1
         AI,R6    1
         CI,R6    NSCPU+1
         BL       SLCPU1            NOT DONE YET
         B        SCANNER
MPMSG1   TEXTC    'SLAVE CPU # '
MPMSG2   TEXTC    'HARDWARE ADDRESS= '
MPMSG3   TEXTC    'PHYSICAL PAGE= '
         PAGE
*
*F*      NAME:    MD:CORE
*F*      PURPOSE: TO ESTABLISH CORE DUMP LIMITS FOR THE ROOT DUMP
*F*               UTILIZING THE 'MONDMP' DUMP FORMAT
*
MD:CORE  EQU      %                *
         LI,1     MRMSG            *SEND
         BAL,R0   TITEL            *SEND TITLE MSG OUT
         LI,R1    0                *
         STW,R1   CORELIMS         *
         LI,R1    PPSTART         CLOSEST SYMBOL TO PROCEDURE START
         AI,1     512              *
         SLS,1    -9               *
         SLS,1    9                *
         STW,1    CORELIMS+1       *
         LI,R1    2                *FIELD CONTAINING STARTING FIRST LOC
         BAL,R0   LOCLOC           *GO GET FIELDS
         CI,R8    0                *ANY THING GIVEN
         BNEZ     MD:CORE2         *VALUE WAS GIVEN - USE IT
         CI,R9    0                *NO VALUE IN R8 - HOW BOUT R9
         BEZ      MD:CORE3         *NO VALUES PASSED-USE DEFAULT
MD:CORE2 EQU      %                *
         BAL,7    MDSNAP4           THIS DUMPS ROOT IF LIMITS
         B        SCANNER           ARE SPECIFIED
MD:CORE3 EQU      %                *
         LD,R8    CORELIMS         *LOAD DUMP LIMITS
         BAL,R7   MDSNAP4          *AND DUMP IT OUT
         LI,1     UMVMSG
         BAL,0    TITEL
         LI,8     SSDATU:
         LI,9     TOPUMVDTA
         BAL,7    MDSNAP4
         B        SCANNER          *RETURN TO DO NEXT COMMAND
         PAGE
*
*
TSMSG       TEXTC  ;
 'ADDRS     STACK OFFSET     CONTENTS      RELATIVE LOC',;
                   '     INSTRUCTION '
INFOA    TEXTC    ' FLAGS =  '
INFOB    TEXTC    ' START =  '
USR:PGM  TEXTC    'USER'
PLUSDOT  TEXTC '+.'
MINUSDOT TEXTC    '-.'
         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                 '
         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                 '
         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     '                                '
SYMBOL:MSG TEXTC  '**SYMBOL TABLE NOT LOADED'
         PAGE
*
*F*      NAME:    DISPSTK
*F*      PURPOSE: TO DRIVE THE TSTACK DUMP FOR THE USER NUMBER AS
*F*               AS PASSED
*
DISPSTK  EQU      %
         PSW,R1   STACK
         LI,R1    SYMBOL:MSG        ASSUME SYMBOLS NOT PRESENT
         MTW,0    BIGBUF            IS TRUE
         BGZ      %+2               NOPE
         BAL,R0   MBB               PUT OUT MSG ABOUT NO SYMBOL TABLE
         LCFI     9                 GET AND
         LM,R0    ZEROS             ZAP ALL THE
         STM,R0   CURR:LOC          VARIABLES
         LW,R2    USER              WAS A USER NUMBER PASSED
         BNEZ     DISPSTK1          YEP
         LI,R1    2                 NO, GO LOOK FOR AN OPTION
         BAL,R0   GETHEX
         STW,R2   USER              SAVE A ZERO OR USER NUMBER
         AI,R2    0                 WAS THERE A NUMBER
         BEZ      DISPSTK2          ITS THE MONITOR'S STACK
DISPSTK1 LI,R14   UH:FLG
         BAL,R0   GETADDR           FOR USER OWNING MEMORY
         STW,R2   NO:CORE           CLEAR ANY EARLIER FLAGS
         LH,R3    *R15,R2           GET USER FLAGS
         AND,R3   #R16              AND MASK
         PSW,R3   STACK             SAVE VALUE
         LC       USER              SUPPOSED TO LOOK AT JIC BIT
         BCS,4    DISPSTK2          NOPE - GO ON - USER IN CORE OKAY
         CI,R3    JIC               WAS HIS JIT IN CORE
         BANZ     DISPSTK2          YEP, GO ON
         LCI      8
         STCF     NO:CORE           TURN OFF FLAG IF HE HAS NONE
DISPSTK2 BAL,R0   RES:JIT           RESTORE THE JIT
         BCS,4    DISPSTK9          ERROR EXIT
         LC       *JITBUF           GET JIT FLAGS
         STCF     USER:MODE         AND SAVE THEM FOR LATER
         MTW,0    FIELD3+2          ANYTHING IN FIELD4
         BNEZ     DISPSTK3          YUP--> SHOWS OSTACK ONLY REQUEST
         LI,R1    TSMSGM            ASSUME MONITOR STACK
         MTW,0    USER              CORRECT
         BEZ      %+2               YEP
         LI,R1    TSMSG1            NO
         BAL,R0   MSG%OUT           PUT OUT TITLE LINE
         LI,R1    TSMSG             AND
         BAL,R0   MSG%OUT           THEN HEADING
DISPSTK3 LI,R5    TSTACK-J:JIT      FIRST PLACE TO START
         LI,R7    TSTACK+1-(J:JIT)
         LI,R1    X'1FF'            MONITOR STACK LIMIT MASK
         LI,R8    X'1FF'
         SLS,R8   16                MASK TO GET SPACE COUNT IN POSITION
         AND,R8   *JITBUF,R7        GET IT
         SLS,R8   -16               RE-POSITION
         LI,R9    X'1FF'            MASK FOR WORD COUNT
         AND,R9   *JITBUF,R7        GET WORD COUNT
         LI,R6    21+21             MINUM DEPTH TO SHOW
         AW,R6    R9                ADD STACK WORD COUNT
         AND,R6   R1                MASK TO LIMIT
         STW,R6   TSIZE             SAVE FOR LOOP ON MONITOR STACK
         AW,R9    R8                ADD EM UP
         STW,R9   STK:CNT           REMEMBER STK CNT + WORD CNT
         MTW,0    USER              DOING A USER'S STACK
         BEZ      %+2               NO - ALREADY GOT MASK IN R1
         LI,R1    X'7F'             YES - SET USER MASK
         AND,R9   R1                MASK STACK TO LIMIT POSSIBLE
         AW,R9    TST:LIMS          ADD BASE ADDRESS
         STW,R9   TST:LIMS+1        STORE FOR CLM PAIR
         LI,R6    J:START-J:JIT
         LW,R6    *JITBUF,R6        GET LMN START ADDRESS
         BNEZ     %+2               HAS ONE
         LI,R6    JBUPVPA           GIVE HIM THIS IF NONE THERE
         STW,R6   GHST:STRT         SAVE IT FOR LATER
         AI,R6    -1                ADJUST FOR SPECIAL CLM TALBE
         STW,R6   DATA:AREA+1       INIT SPECIAL CLM TABLE
         AI,R6    1
         BAL,R7   PR:CHK            SCAN USER TABLES FOR PROCESSORS
         MTW,0    USER              IS THIS A USER STACK
         BEZ      DISPSTK35         NO, MONITOR'S STACK
         PLW,R3   STACK             YEP, RETRIEVE USER'S FLAGS
         MTW,0    FIELD3+2          WANTS ONLY OSTACK
         BNEZ     DISPSTK81         YUP--> GET OUT
         LI,R1    INFOA
         BAL,R0   MTBB              PUT IT OUT
         LW,R3    R6                MOVE USER'S START ADDRESS
         LI,R1    INFOB             YES
         BAL,R0   MTBB              PUT IT OUT
DISPSTK35 LI,R6   0                 INITIAL INDEX
DISPSTK4  EQU     %                 LOOP RETURN POINT
         CI,R6    2                 ABOUT TO START ON DATA PART OF STK
         BNE      STRT:STK          NOPE
         BAL,R0   ST:ENV            YEP . SAY INITIAL ENVIRONMENT
STRT:STK LI,R1    1                 INITIAL SPACING
         BAL,R0   SPACES            INSERRT FIRST SPACING
         LW,R3    R6                RELATIVE LOC IN TSTACK
         AI,R3    TSTACK            ADD CORE ADDRS
         BAL,R0   TRANSSZ           PUT THAT OUT
         LI,R1    11
         BAL,R0   SPACES
         LW,R3    R6
         BAL,R0   TRANSSZ
         LW,R2     USER
         BAL,R0   RES:JIT           RESTORE THE JIT PRIOR TO ANYTHING
         BCS,4    DISPSTK9          THERE IS NONE TO GET
         LD,R0    ZEROS             GET SOME ZEROES
         STD,R0   RANGE
         STD,R0   CLOSESTSYM        ZAP ALL THE POINTERS
         LW,R3    *JITBUF,R5        GET WORD OUT OF STACK
         CW,R3    BAD:LOCA          UNUSED PART OF STACK
         BE       DISPSTK8          YEP, ALL DONE
         LI,R1    27
         BAL,R0   SPACES
         BAL,R0   TRANS
         LI,R1    41
         BAL,R0   SPACES
         CI,R3    0                 IS WORD ALL ZEROES
         BEZ      DISPSTK55         YES - DUMMP OUT AS DATA ONLY
         AND,R3   ADMASK
DISPSTK43 EQU     %
         CLM,R3   LEGCORAD          LEGAL CORE ADDRESS...
         BCS,9    DISPSTK55         NOPE-->
         STW,R3   CURR:LOC          AND SAVE IT FOR LATER
         CI,R6    2                 PAST SPD YET
         BL       DISPSTK44         NO, HOP OVER THERE
         CLM,R3   JIT:LIMS          IS IN THE JIT
         BCR,9    DISPSTK44         IN THE JIT
NOT:JIT  CI,R3    JOVVPA            IS ADDRESS DOWN IN ROOT
         BL       DISPSTK44         YEP . LOOK DOWN THERE FOR A SYMBOL
         BAL,R7   GETOV             GET THE PROCESSOR DATA
         LW,R1    CLOSESTSYM        FIND ANYTHING
         BGZ      DISPSTK45         YEP - GO USE THE FOUND SYMBOL
DISPSTK44 EQU     %
         MTW,0    BIGBUF            SYMBOL TABLE LOADED
         BEZ      DISPSTK46         NOPE--> SKIP CHECKS FOR SYMBOL
         LW,R12   R3                OBJECT ADDRESS
         BAL,R1   GRABSYM           START SYMBOL SEARCH
         NOP      %
DISPSTK45 LW,R1   CLOSESTSYM        GET TEXTC STRING ADDRESS
         BLEZ     DISPSTK46         NONE
          BAL,R0  MSG               MOVE IT
         LW,R3    CURR:LOC          CURRENT OBSERVED ADDRESS
         BAL,R0   DISP:OFF          PUT OFFSET INTO PRINT LINE
DISPSTK46 EQU     %
         LW,R3    CURR:LOC          RELOAD R3
         BAL,R7   LOOKATMON         LOOK AT ADDRESS TO SHOW INSTRUCTION
         MTW,0    REGFLAG           FOUND A REG ENVIRONMENT
         BNEZ     REG:HIT           YEP, START UP PROCESS
DISPSTK55 BAL,R0  BUFOUT
DISPSTK6 AI,R5    1                 NEXT TSTACK WORD INDEX
         AI,R6    1                 NEXT REL LOC INDEX
         MTW,1    REG:REG           BUMP UP REGISTER FROM REG
         BEZ      CHK:PUSH          JUST COMPLETED AN ENVIRONMENT
DISPSTK7 MTW,0    USER              IS THIS THE MONITOR'S STACK
         BNEZ     DISPSTK75         NO
         MTW,-1   TSIZE             YES, DECREMENT AMOUNT TO SHOW
         BLZ      DISPSTK8          ALL DONE
DISPSTK75 LW,R4   R6                RELATIVE INDEX INTO STACK
         AI,R4    TSTACK            ADD REAL ADDRS
         CLM,R4   TST:LIMS          STILL WITHIN TSTACK LIMITS
         BCR,9    DISPSTK4          YEP,,,GO
DISPSTK8 LI,R1    END:STKM          END OF STACK HIT
         BAL,R0   MSG%OUT
DISPSTK81 EQU     %
         PLW,R1   STACK             RETRIEVE THE LINK
         B        OSTACK            GO SHOW THE OSTACK
DISPSTK9 MTW,0    USER              WAS A USER TYPE RUN
         BEZ      %+2               NOPE
         PLW,R3   STACK             YES - BALANCE THE STACK
         PLW,R1   STACK             GET THE RETU4N LINK
         B        0,R1              AND EXIT THE DISPLAY
         BOUND    8
JIT:LIMS DATA     J:JIT
         DATA     J:JIT+511
         PAGE
*
*F*      NAME:    PR:CHK
*F*      PURPOSE: TO SCAN THRU THE USER TABLES COLLECTING
*F*               INFO ON PROCESSORS USER WAS ASSOCIATED WITH.
*
PR:CHK   EQU      %                *
         LW,R2    USER             *GET USER'S NUMBER
         AND,R2   #R16             *CLEAR FLAGS
         BEZ      0,R7             *NONE - EXIT
         LCFI     3                *
         PSM,R5   STACK            *SAVE A WORK AREA
         LI,R14   UB:PCT           *
         BAL,R0   GETADDR          *
         LB,R7    *R15,R2          *GET USER'S PAGECNT
         SLS,R7   9                *INTO A WORD COUNT
         AI,R7    -1               *POINT INTO LAST PAGE
         AW,R7    GHST:STRT        *ADD BASE ADDRESS OF USER
         CI,R7    X'1FFFF'         *MAX OF 128K VIRTUAL MEMORY
         BLE      %+2              *OK
         LI,R7    X'1FFFF'         *LIMIT EM TO 128K
         STW,R7   GHST:STRT+1      *CREATE CLM PAIR
         LI,R7    6                *MAX LOOP
PR:CHK0  EQU      %                *
         LD,R4    ZEROS            *GET SOME ZEROS
         STD,R4   PR:RAN,R7        *AND CLEAR ENTRY
         EXU      PR:TAB,R7        *LOAD R14 WITH ADDRESS
         BAL,R0   GETADDR          *AND FETCH IT
         LB,R1    *R15,R2          *TEST FOR PROCESSOR ASSOCIATED
         BEZ      PR:CHK2          *NONE - JUMP
         LI,R14   P:SA             *NEED START ADDRESS
         BAL,R0   GETADDR          *
         LD,R4    PR:LIM,R7        *GET RANGE WE KNOW ABOUT
         CI,R1    PNAMEND-1        *DOES PROCESSOR HAVE P:SA ENTRY
         BG       PR:CHK1          *NO - JUMP
         LW,R0    *R15,R1          *GET ITS START ADDRESS
         AND,R0   ADMASK            EXTRACT START ADDRESS OF PROC.
         BEZ      PR:CHK1          *NONE
         STW,R0   R4               *CREATE CLM PAIR
PR:CHK1  EQU      %                *
         AND,R4   =X'1FE00'        *INSURE IT OWNS ENTIRE PAGE ITS IN
         LI,R5    0                *LOAD SIZE ACCUMULATOR
         LI,R14   PB:PSZ           *LETS GET PROCEDURE SIZE
         BAL,R0   GETADDR          *
         LB,R6    *R15,R1          *GET SIZE OF PROCESSOR'S PROCEDURE
         AW,R5    R6               *ADD IT IN
         LI,R14   PB:DSZ           *NOW FOR DATA
         BAL,R0   GETADDR          *
         LB,R6    *R15,R1          *GET IT
         AW,R5    R6               *ADD IT IN
         LI,R14   PB:DCBSZ         *NOW FOR DCB SIZE
         BAL,R0   GETADDR          *
         LB,R6    *R15,R1          *GET IT
         AW,R5    R6               *AND ADD THAT TOGETHER WITH OTHER
         CI,R5    0                *INSURE WE DIDNT BLOW IT
         BGZ      %+2              *OK
         LI,R5    255               *DEFAULT TOP PAGE #########
         SLS,R5   9                *NOW INTO TOTAL WORD COUNT
         AI,R5    -1               *POINT INTO LAST PAGE
         AW,R5    R4               *ADD IT WITH THE START ADDRESS
         CI,R5    X'1FFFF'         *CANT EXCEED VIRTUAL TOP OF 128K
         BLE      %+2              *IS OKAY
         LI,R5    X'1FFFF'         *MAKE IT MAX IF WE CALCULATED WRONG
         STD,R4   PR:RAN,R7        *LEAVE IT SETUP FOR LATER
         LI,R14   P:NAME           *NOW FOR NAME OF PROCESSOR
         BAL,R0   GETADDR          *
         LD,R4    *R15,R1          *GET NAME
         AND,R4   =X'07FFFFFF'     *LIMIT OF 7 BYTES TO NAME
         STD,R4   PR:NAME,R7       *SAVE NAME
PR:CHK2  EQU      %                *
         BDR,R7   PR:CHK0          *FINISH SCAN
         LCFI     3                *
         PLM,R5   STACK            *
         B        0,R7             *AND EXIT WHEN DONE
         PAGE
*
*        TABLES TO DRIVE PROCESSOR SCAN
*
PR:TAB   EQU      %
         NOP      %                 DUMMY FIRST ENTRY
         LI,R14   UB:ACP            COMMAND PROCESSOR TABLE
         LI,R14   UB:APR            ASSOCIATED PROCESSOR
         LI,R14   UB:APO            PROCESSOR'S OVERLAY
         LI,R14   UB:ASP            ASSOCIATED SHARED PROCESSOR
         LI,R14   UB:DB             DEBUGGER
         LI,R14   UB:OV             MONITOR OVERLAY
*
*
         BOUND    8
PR:LIM   EQU      %
         DATA     0,0               DUMMY FIRST ENTRY
         DATA     JBUPVPA,CORE-1    COMMAND PROCESSOR LIMITS
         DATA     JBUPVPA,CORE-1    APR LIMITS
         DATA     JBUPVPA,CORE-1    APO LIMITS
         DATA     JBUPVPA,CORE-1    ASP LIMITS
         DATA     SPDBASE,CORE-1    DB LIMITS
         DATA     JOVVPA,J:JIT-1    OV LIMITS
*
*
         USECT    DATA
         BOUND    8
PR:RAN   EQU      %
         DATA     0,0
         DO1      6                 GENERATE ROOM FOR 6 DBL-WORDS
         DATA     0,0
*
*
PR:NAME  EQU      %
         DO1      7                 GENERATE ROOM FOR NAMES
         DATA     0,0               OF PROCESSORS
*
         USECT    PP
*
         PAGE
*
*        SEE IF CURRENT ADDRESS IS REALLY A PROCEESSOR
*
GETOV    EQU      %
         MTW,0    USER              DOING A USER
         BEZ      0,R7              NOPE
         LCFI     4                 SAVE SOME WORK AREA
         PSM,R4   STACK
         LI,R7    6                 LOOP THRU TABLES
         LW,R4    CURR:LOC          CURRENT ADDRESS WE'RE LOOKING AT
GETOV1   EQU      %
         CLM,R4   PR:RAN,R7         TEST FOR FIT
         BCR,9    GETOV2            GOTCHA
         BDR,R7   GETOV1            KEEP GOING
         B        USER:SET          NONE - CALL IT A USER ADDRESS
GETOV2   EQU      %
         LD,R4    PR:RAN,R7         GET ADDRESS LIMITS
         STD,R4   RANGE             SAVED
         STW,R4   CLOSESTADD        SAVE IT FOR DISPLAY
         LD,R4    PR:NAME,R7        GET PROCESSOR NAME
         STD,R4   PROCNAME          SAVED
         LI,R4    PROCNAME          AND POINT TO IT
         STW,R4   CLOSESTSYM        FOR LATER
GETOV3   EQU      %
         LCFI     4
         PLM,R4   STACK
         B        0,R7              AND EXIT
         PAGE
*
*        IF CURRENT JIT INDICATES GHOST JOB, CHECK FOR GHOST
*        NAME IN GHOST TABLES
*
GET:GHOST LI,R14  SB:GJOBUN
         BAL,R0   GETADDR
         LI,R6    MAXG              MAX GHOST JOB INDEX TO TABLES
         LW,R2    USER              GET USER NUMBER FROM JIT
         CB,R2    *R15,R6           FIND THE MATCH
         BE       GOT:GHOST
         BDR,R6   %-2
         B        GETOV3            NONE - SO FORGET IT
GOT:GHOST LI,R14  S:GJOBTBL         NAME TABLE
         BAL,R0   GETADDR
         LD,R4    *R15,R6           GET NAME
         STD,R4   PROCNAME          THE HECK W/IT , ITS STILL A GHOST
         LI,R1    PROCNAME
SET:ADDRS EQU     %
         STW,R1   CLOSESTSYM
         LD,R2    GHST:STRT         LOADDD START ADDRESS OF GHOST
         STW,R2    CLOSESTADD        SAVE CLOSEST ADDRESS
         AND,R2   ADMASK
         STD,R2   RANGE             AND SET UP RANGE OF ADDRESSING
         B        GETOV3            AND EXIT
         PAGE
*
*        ADDRESS DID NOT BELONG TO A PROCESSOR - SEE IF ADDRESS
*        FITS INTO USER VIRTUAL MEMORY - IF SO CALL IT USER SPACE
*        IF NOT - NO NAME WILL BE ASSIGNED TO ADDRESS
*
*
USER:SET EQU      %
         LC       USER:MODE         IS THE USER A GHOST JOB
         BCS,4    GET:GHOST         YEP - GET HIS NAME
         CI,R4    JBUPVPA           IS ADDRESS A USER AREA ADDRS
         BL       GETOV3            NO-SKIP OUT
         LI,R1    USR:PGM           LOAD SPECIAL MSG ADDRESS
         B        SET:ADDRS         GO SET UP POINTERS
         BOUND    8
MAP:AREA DATA     JOVVPA,X'1FFFF'   USER MEMORY TO 128K MAX
MON:AREA DATA     MONORG,J:JIT-1    AREA BELONGING TO CP-V
         PAGE
*
*        DETECTED A REG ENVIRONMENT IN TSTACK
*
REG:HIT  EQU      %
         MTW,0    REGFLAG           DID FLAG GET RAISED
         BEZ      DISPSTK4          NOT FOUND ONE YET
         CW,R6    LAST:LINE         SAME AS LAST ONE
         BE       DISPSTK55         YEP, RESET FLAG/CONTINUE
         LW,R4    R6                MOVE FOR ARITH
         SW,R4    LAST:LINE         CALCULATE DISTANCE FROM LAST REG
         BLEZ     DISPSTK55         FORGET IT
         CI,R4    19                FAR ENUFF AWAY
         BL       DISPSTK55         NOPE
         STW,R6   LAST:LINE         OK, WE'LL CALL IT A REG ENVIRONMENT
         BAL,R0   BLNKBUF           BLANK BUFFER - RESET POINTERS
         LW,R1    REGFLAG           GET TYPE
         LW,R1    REGTYPE,R1        GET MSG ADDRESS
         BAL,R0   MSG%OUT           PRINT OUT MESSAGE
         LI,R1    -19               LENGTH OF ENVIRONMENT REGS
         STW,R1   REG:REG           INITIALIZE REGISTER #
         B        DISPSTK4          NOW REDO LINE CURRENT LINE
BAD:LOCA DATA     X'00000BAD'       INDICATES UN-USED PORTION OF STACK
END:STKM TEXTC    '*** END OF USED STACK ***'
         PAGE
*
*F*      NAME:    LOOKATMON
*F*      PURPOSE: USING CURRENT ADDRESS AS EXTRACTED FROM THE TSTACK,
*F*               FETCH THAT ADDRESS AND DISPLAY CONTENTS OF SAME
*F*               ON THE PRINT LINE.
*
LOOKATMON EQU     %                *
         LC       NO:CORE          *DOES USER OWN ANY MEMORY
         BCS,8    0,R7             *NO - EXIT NOW
         CI,R3    X'10'             IS CURRENT ADDRESS IN MAIN MEMORY
         BL       0,R7              NO-RETURN
         LCFI     3                *
         PSM,R5   STACK            *
         LI,R1    58               *
         BAL,R0   SPACES           *
         LI,R0    0                *
         STW,R0   MAPFLAG          *INSURE TRANSLATION IS PHYSICAL
         LW,R14   CURR:LOC         *GET CURRENT LOC (ALREADY MASKED)
         CLM,R14  JIT:LIMS         *IS ADDRESS IN THE JIT
         BCR,9    INSJIT           *YEP
         CLM,R14  MAP:AREA         *IS ADDRESS WITHIN USER'S VIRTUAL
         BCS,9    LOOKATMON1       *NO - NO NEED TO MAP ONTO HIM
         LW,R2    USER             *GET HIS NUMBEEER
         BEZ      LOOKATMON1       *DOING THE MONITOR
         BAL,R0   MAP:USER         *MAP ONTO HIM
LOOKATMON1 EQU    %                *
         BAL,R0   GETADDR          *GO PICK IT UP
         LW,R3    *R15             *
         STW,R3   IMONLOC          *SAVE IT
         STW,R3   INST:SAVE        *SAVE THE WHOLE WORD
         CI,R3    0                *IS ALL ZEROS
         BEZ      ALL:DATA         *YEP - NO NEED TO BUST IT
         LH,R9    R3               *GET 1ST 16 BITS OF WORD
         CI,R9    -1               *IS ALL ONES
         BE       ALL:DATA         *YES - NO INSTRUCTION
         LB,R3    IMONLOC          *GET INST OPCODE
         AND,R3   #R7F              DROP INDIRECT BIT
         BEZ      ALL:DATA         *ALL DATA
         MTB,0    LEGALOPS,R3      *TEST FOR A LEGAL INST
         BEZ      ALL:DATA         *NOPE
         BAL,R9   INSRT:OP         *BUILD OPCODE FROM WORD
         LI,R1    ACT:INST         *NOW MOVE
         BAL,R0   MSG              *MOVE OPCODE TO PRINT LINE
         LH,R3    IMONLOC          *GET WORD AGAIN
         AND,R3   #RF0              EXTRACT INDEX REGISTER
         SLS,R3   -4               *POSITION IT
         BAL,R0   MOVE:CREG        *MOVE REGISTER NUMBER TO PRINT LINE
         LI,R1    66               *NEXT SPACING
         BAL,R0   SPACES           *
         LC       IMONLOC          *WAS AN INDIRECT INSTRUCTION
         BCR,8    LOOKATMON2       *NOPE
         LI,R1    STARMSG          *
         BAL,R0   MSG              *MOVE A START TO PRINT LINE
LOOKATMON2 EQU    %                *
         LW,R3    IMONLOC          *GET THE WHOLE WORD AGAIN
         AND,R3   ADMASK
         STW,R3   IMONLOC          *SAVE IT
         CI,R3    JOVVPA           *IS LIKELY TO BELONG TO MONITOR
         BL       LOOKATMON3       *YES - JUMP
         CLM,R3   RANGE             DOES ADDRS FIT RANGE WE KNOW ABOUT
         BCR,9    LOOKATMON6        YEP-USE IT
         CI,R3    JBUPVPA           IS ADDRS A USER AREA TYPE
         BGE      LOOKATMON4        YEP-BRANCH
LOOKATMON3 CLM,R3 SYM:LIMS         *NO, DOES SYMBOL BELONG TO MONITOR
         BCR,9    LOOKATMON5       *YEP
         CI,R3    16               *IS IT A REGISTER
         BL       LOOKATMON7       *YEP
LOOKATMON4 EQU    %                *
         LW,R3    IMONLOC          *PICK IT UP AGAIN
         LI,R1    DOT:MSG          *
         BAL,R0   MSG              *
         BAL,R0   TRANSSZ          *PUT OUT VALUE
         B        LOOKATMON8       *
LOOKATMON5 LW,R12 IMONLOC          *
         BAL,R1   SVALTXT          *
         NOP      %                *FORGET THIS RETURN
LOOKATMON6 EQU    %                 COME HERE IF RANGE FITS...
         LW,R1    CLOSESTSYM       *TEXTC ADDRESS
         BLEZ     LOOKATMON4       *SHOW IT AS DATA THEN
         BAL,R0   MSG               INSERT TEXT STRING
         BAL,R2   REG:TEST         *CHECK IT
         LW,R3    IMONLOC          *CURRENT I/A CONTENTS
         BAL,R0   DISP:OFF         *PUT OUT SYMBOL OFFSET
         B        %+2              *JUMP OVER REGISTER MOVE
LOOKATMON7 BAL,R0 MOVE:REG         *MOVE REGISTER INTO PLACE
LOOKATMON8 LW,R3  INST:SAVE        *GET COMPLETE INST
         AND,R3   =X'000E0000'     *EXTRACT INDEX REGISTER
         CI,R3    0                *
         BEZ      LOOKATMON9       *NONE
         SLS,R3   -17              *NORMALIZE IT
         BAL,R0   MOVE:CREG        *MOVE IT INTO PLACE
LOOKATMON9  EQU   %                *
         LCFI     3                *
         PLM,R5   STACK            *
         B        0,R7             *
         PAGE
*
*        MOVE REGISTER NUMBER (DECIMAL) INTO PLACE
*
MOVE:CREG PSW,R0 STACK
         LI,R1    COMMA:MSG
         BAL,R0   MSG
         PLW,R0   STACK
MOVE:REG PSW,R0   STACK
         LW,R1    R3                INDEX NUMBER
         AI,R1    REG0              ADDRS OF TEXTC STRING
         PLW,R0   STACK
         B        MSG               GO INSERT STRING
COMMA:MSG  TEXTC  ','
REG0     TEXTC    '0'
REG1     TEXTC    '1'
REG2     TEXTC    '2'
REG3     TEXTC    '3'
REG4     TEXTC    '4'
REG5     TEXTC    '5'
REG6     TEXTC    '6'
REG7     TEXTC    '7'
REG8     TEXTC    '8'
REG9     TEXTC    '9'
REG10    TEXTC    '10'
REG11    TEXTC    '11'
REG12    TEXTC    '12'
REG13    TEXTC    '13'
REG14    TEXTC    '14'
REG15    TEXTC    '15'
STARMSG  TEXTC    '*'
         PAGE
*
*        AT THIS POINT R6 CONTAINS THE NEXT INDEX
*        INTO THE TEMP STACK AND WE'VE JUST COMPLETED
*        THE 19TH WORD OF THE LAST ENVIRONMENT
*
CHK:PUSH EQU      %
         PSW,R5   STACK             SAVE CURRENT INDEX
         MTW,0    PUSH:FLAG         JUST COMPLETE ONE
         BNEZ     PUSH:DONE         YEP, GO THERE
         AI,R5    7                 POINT TO PROBABLE STACK MARK
         LI,R7    X'FF'             MASK TO
         AND,R7   *JITBUF,R5        OBTAIN THAT POSITION
         AI,R7    1                 ADVANCE
         CW,R7    R5                IS IT A STACK MARKER
         BNE      PUSH:DONE         NOPE
         BAL,R0   BLNKBUF
         LI,R1    PUSHALL:MSG       YEP
         BAL,R0   MSG%OUT
         LI,R1    -8
         STW,R1   REG:REG
         MTW,1    PUSH:FLAG
         PLW,R5   STACK
         B        DISPSTK7
PUSHALL:MSG TEXTC '*** PUSHALLE REGISTERS ***'
DOT:MSG TEXTC '.'
         PAGE
*
*        AT THIS POINT WE'RE AT THE FIRST ENTRY IN THE STACK
*
ST:ENV   EQU      %
         MTW,0    USER              IS MONITOR'S STACK
         BEZ      STRT:STK          YEP, WHO KNOWS WHATS IN HIS STACK
         BAL,R0   BLNKBUF
         LI,R1    STENV:MSG         AHAH, LETS PRINT OUT A MSG
         BAL,R0   MSG%OUT           PUT OUT MSG
         LI,R1    -19               INIT COUNTER
         STW,R1   REG:REG
         B        STRT:STK
STENV:MSG TEXTC '*** INITIAL ENVIRONMENT ***'
ENV:DONE TEXTC '*** MISCELLANEOUS REGISTERS ***'
         PAGE
*
*        AT THIS POINT THE PUSHALL IS OUT, AND WE'LL SAY
*        SOMETHING ABOUT IT
*
PUSH:DONE LI,R1   0
         STW,R1   PUSH:FLAG
         BAL,R0   BLNKBUF
         LI,R1    ENV:DONE
         BAL,R0   MSG%OUT
         PLW,R5   STACK
         B        DISPSTK4          DO CURRENT LINE
         PAGE
*
*        AT THIS POINT WE'VE DETERMINED THAT THE ADDRESS
*        WITHIN THE STACK WE HAVE BEEN LOOKING AT IS NOT
*        AN ADDRESS MODIFYING INSTRUCTION. NOW PUT OUT
*        THE INSTRCUTION ITSELF FOR CLARITY.
*
INSRT:OP EQU      %
         AI,R3    OPCODES           POINT TO WORD HOLDING EBCDIC INST.
         SLS,R3   2                 INTO BA
         LI,R4    4                 MAX CHARS
         LI,R5    0                 COUNTER OF TEXT
INSRT1   LB,R6    0,R3              GET ONE
         CI,R6    ' '               BLANK YET
         BE       %+3               DONE
         AI,R5    1
         STB,R6   ACT:INST,R5       STORE IT AWAY
         AI,R3    1
         BDR,R4   INSRT1            FINISH UP
INSRT2   CI,R5    0                 FIND ANY BYTES
         BEZ      ALL:DATA          DIDN'T FIND AN INSTRUCTION
         STB,R5   ACT:INST          YEP, STORE BYTE CNT
         B        *R9               RETURN TO CALLER
         PAGE
*
*        DISPLAY AS ALL DATA
*
INSJIT   EQU      %
         LW,R6    CURR:LOC          GET CURRENT ADDRESS
         AND,R6   X1FF              MASK TO PAGE INDEX
         LW,R3    *JITBUF,R6        GET WORD OUT OF THE JIT
         STW,R3   INST:SAVE         AND REMEMBER IT FOR LATER
ALL:DATA LI,R1    DOT:MSG
         BAL,R0   MSG
         LW,R3    INST:SAVE
         BAL,R0   TRANS
         B        LOOKATMON9        AND EXIT
         PAGE
*
*        R3 CONTAINS THE CURRETNLY ANALYZED IA
*
REG:TEST LI,R5    2                 TWO PASS LOOP
         LW,R3    CURR:LOC          STARTING AT CURRENT I/A
REG:TEST1 LI,R7   #OFREGS           NUMBER TO LOOK AT
         CW,R3    REGIA,R7          FIND A MATCH
         BE       SET:REG           GOTCHA
         BDR,R7   %-2
         LW,R3    IMONLOC           NOW LOOK AT CURRENT I/A CONTENTS
         BDR,R5   REG:TEST1         CHECK IT
         STW,R5   REGFLAG           RESET THE FLAG - NO REG HERE
         B        0,R2              NONE FOUND
SET:REG STW,R7    REGFLAG           REMEMBER TYPE OF REG
         B        0,R2              EXIT
REGTYPE  DATA     0,REGTYP1,REGTYP2
REGTYP1 TEXTC '*** REPORT EVENT ENVIRONMENT ***'
REGTYP2 TEXTC '*** I/O IN PROGRESS ENVIRONMENT ***'
*
*
         PAGE
*
*F*      NAME:    OSTACK
*F*      PURPOSE: TO DRIVE THE DISPLAY OF THE USER'S OSTACK ENTRIES
*
OSTACK   MTW,0    USER             *USER DISPLAU
         BEZ      0,R1             *YEP, EXIT
         PSW,R1   STACK            *SAVE LINK
         LI,R4    JTSTACKSZ         MAX TOP OF STACK POSSIBLE
         SW,R4    STK:CNT           MINUS SPACE+IN COUNTS
         BLEZ     OSTACK35          NONE OR BLOWN
         LI,R1    OSMSG            *
         BAL,R0   MSG%OUT          *PUT OUT THE TITLE
         LI,R1    OSMSG1           *
         BAL,R0   MSG%OUT          *PUT OUT THE HEADING
OSTACK1  BAL,R0   RES:JIT          *RESTORE THE USER'S JIT
         LI,R5    TSTACK-J:JIT      OFFSET INTO ME BUFFER
         LI,R6    TSTACK+1-J:JIT    DITTO FOR WORD ONE OF S.P.D.
         LW,R7    *JITBUF,R5        GET TOP OF STACK POINTER
         SLS,R6   1                 R6 TO HAL-WORD INDEX
         MTH,1    *JITBUF,R6        BUMP THE SPACE COUNT SLOT
         AH,R7    *JITBUF,R6        CREATE POINTER INR7 INTO JIT
         AI,7     -TSTACK+2         R7 = PAGE OFFSET INTO BUFFER
         LW,R12   *JITBUF,R7        GET THE OSTACK WORD
         BEZ      OSTACK3          *EMPTY
         CW,R12   BAD:LOCA         *IS UN-USED
         BE       OSTACK3          *NONE THERE
         LB,R6    R12              *GET PROC NUMBER
         BEZ      OSTACK3          *INVALID ENTRY
         CI,R6    PPROCS           *IS IN RANGE
         BG       OSTACK3          *NO GOOD
         FETCH    ('P:NAME',6,DA),(PROCNAME,,DA)
         LI,R1    PROCNAME         *
         BAL,R0   MSG              *
         LI,R1    #MS              *
         BAL,R0   MSG              *
         LW,R3    R6               *THE PROCESSOR NUMBER
         BAL,R0   TRANSSZ          *PUT IT OUT
         LI,R1    25               *
         BAL,R0   SPACES           *
         LI,R11   JOVVPA           *FIRST OVERLAY VIRTUAL ADDRESS
         AND,R12  ADMASK
         CW,R12   R11              *IS ADDRESS WITHIN AN OVERLAY
         BGE      OSTACK5          *YES, ADJUST POINTERS
         BAL,R1   GRABSYM          *OTHERWISE START SYMBOL SEARCH
         LW,R1    CLOSESTSYM       *GET TEXTC ADDRESS
OSTACK15 BAL,R0   MSG              *AND PRINT IT
         LW,R3    R12              *THE ADDRESS WE ARE LOOKING AT
         BAL,R0   DISP:OFF         *PUT IT OUT AS DISPLACMENT
         BAL,R0   SPACE2           *
         LI,R1    LCOLON           *
         BAL,R0   MSG              *
         LW,R3    R12              *RESTORE THE COMPLETE ADDRESS
         BAL,R0   TRANSSZ          *PUT IT INSIDE THE COLONS
         LI,R1    RCOLON           *
         BAL,R0   MSG              *THERE, NICE N'PRETTY
OSTACK2  BAL,R0   BUFOUT           *
OSTACK3  EQU      %
         AI,R4    -1                DECREMENT COUNT REMAINING
         BGZ      OSTACK1          *KEEP GOING
OSTACK35 PLW,R1   STACK            *RETRIEVE LINK
         B        0,R1             *AND LEAVE
OSTACK4  LW,R3    R12              *MUST BE AN ABSOLUTE ADDRESS
         BAL,R0   TRANSSZ          *PUT IT OUT
         B        OSTACK2          *AND PRINT THE LINE
OSTACK5  STW,R11  CLOSESTADD       *STORE JOVVPA AS CLOSESTADDRESS
         LI,R1    PROCNAME         *THATS THE TEXTC ADDRESS
         B        OSTACK15         *PRINT IT OUT
OSMSG    TEXTC    'CONTENTS OF OSTACK:'
OSMSG1   TEXTC    'PROCESSOR                RETURN ADDRESS'
#MS      TEXTC    '#'
X1FF     EQU      RPAGEMSK
LCOLON   TEXTC    ' ('
RCOLON   TEXTC    ') '
         PAGE
*
*F*      NAME:    MDTRAPS
*F*      PURPOSE: TO PRODUCE A FORMATTED DISPLAY OF THE TRAPS
*F*               AND INTERRUPTS AT CRASH TIME
MDTRAPS  EQU      %
         PUSH     L1
         LI,R8    0                 SET TO CHECK AND
         STW,A8   ZAPFLAG             SAVE TO CHECK ALL PRINTED
         LI,R1    TRMSG
         BAL,R0   TITEL
         FORMAT   START,(SKIP,2)
 FORMAT ' INTRPT CONTENT  LAST PSD SAVED',4
         FORMAT   'CURRENT CONTENTS  NAME OF  NAME OF    NEW PSD'
         FORMAT   PRINT,END
         FORMAT   START,' LOC    OF LOC   BY THIS TRAP',6
 FORMAT 'OF TRAPPED CELL   '
 FORMAT 'RECEIVER '
 FORMAT 'HANDLER    IS',PRINT,END
         FORMAT   START,' ------ -------- -----------------'
         FORMAT   ' -----------------'
         FORMAT   ' -------- --------'
         FORMAT   '   ---------------',PRINT,END
         FORMAT   START,SKIP,END
         LI,X4    X'40'
         MTW,0    TAP%DMP           TAPE DUMPS ARE SPECIAL CASE
         BEZ      %+2
         LI,X4    TRAPSAVE
         STW,X4   TRAPLOC
         PAGE
*
*        LOOP POINT OBSERVING XPSD'S IN LOCATIONS X'40' THRU MONORG
*
INTRLOOP EQU      %
         SVALCON  (TRAPLOC,TRAPCONT) GET NEXT XPSD
         LB,R8    TRAPCONT          GET BYTE ZERO OF XPSD
         BEZ      XPSD:OK           THATS OKAY
         CI,R8    X'0F'             HAD BETTER BE AN XPSD THERE
         BE       GET:PSD           IS OKAY
         CI,R8    X'33'             IS IT A COUNTER THEN
         BE       XPSD:OK           YEP
         CI,R8    X'FF'             IS CJOB ???
         BE       GET:PSD           ITS CJOB OR SOMETHING LIKE IT
         CI,R8    X'B3'             INDIRECT COUNTING IS LEGAL TOO...
         BE       XPSD:OK           MERGE
         CI,R8    X'8F'             IF ITS NOT THIS ONE
         BNE      BAD:XPSD          SOMETHING IS WRONG IN PAGE ZERO
XPSD:OK  EQU      %
         LH,R8    TRAPCONT          GET COMPLETE INSTRUCTION THERE
         CI,R8    X'00FF'           IS THERE A USABLE INSTRUCTION
         BAZ      NEXTTRAP          NOPE - DONT DISPLAY UNUSED TRAPS
GET:PSD  EQU      %
         MTW,1    ZAPFLAG           COUNT THE USED INST/TRAP LOC'S
         BLANK    (TRAPNAME,%SYMSZ),(NAMENPSD,%SYMSZ)
FET:PSD  EQU      %
         FETCH,4  TRAPCONT,OLDPSD   GET CONTENTS OF PSDS
         LW,R12   NEWPSD
         MTB,0    TRAPCONT          IS TRAP LOC MAYBE CJOB
         BGZ      %+2               NOPE
         LW,R12   TRAPLOC           YES - GET CORRECT SYMBOL FOR CJOB
         CALL     SVALTXT
         BEZ      NONAM1            SKIP OUT - NO DEF THERE
         LW,R5    R2                MOVE TEXTC STRING ADDRS TO R2
         SLS,R5   2
         LB,R3    0,R5
         AND,R3   #R1F
         AI,R5    1
         LI,R4    BA(NAMENPSD)
         STB,R3   R5
         BAL,R0   MOVE1
NONAM1   LW,R12   TRAPCONT
         CALL     SVALTXT
         BEZ      NONAM2            SKIP OUT - NO DEF THERE
         LW,R5    R2                MOVE TEXTC STRING ADDRS TO R2
         SLS,R5   2
         LB,R3    0,R5
         AND,R3   #R1F
         AI,R5    1
         LI,R4    BA(TRAPNAME)
         STB,R3   R5
         BAL,R0   MOVE1
NONAM2   LW,A8    OLDPSD            ANALYZE LOC TRAPPED AT
         LH,R9    R8                GET MM/MS BITS                           A00
         AND,R8   ADMASK            MASK OFF TO 17 BITS WORTH                A00
         CI,A8    1                 DID TRAP OCCUR AT ALL                    A00
         BLE      INTPRIN             NO,PRINT BLANKS                        A00
         CI,R9    X'0040'           WAS IT A MAPPED TRAP                     A00
         BAZ      NOTMAPPED         NOPE                                     A00
         CI,R8    JOVVPA            IS IT ONE TO ONE MAP                     A00
         BL       NOTMAPPED         YES                                      A00
         LW,R2    CUN               GET CURRENT USER'S NUMBER
         BLEZ     NOTMAPPED         NONE OR ERROR
         STW,R2   USER
         STW,R2   LOOKING           SET FLAG FOR NO ERROR MSG
         BAL,R0   MAP:USER          DO IT                                    A00
NOTMAPPED    EQU  %                                                          A00
         SVALCON  (A8,LOCTRAPD,(ERR,OUTCORE))  PRINT LOC IF IN CORE
         MTW,1    BLANKFLG          SET FOR NO PRE-BLANK OF OBUF
         FORMAT   START,(TAB,36),(HEX,LOCTRAPD,8),2,(OP,LOCTRAPD),END
         MTW,1    BLANKFLG          SET FOR NO PRE-BLANK OF OBUF
INTPRIN  EQU      %
OUTCORE  EQU      %
         FORMAT   START
         FORMAT   (TAB,3),(HEX,TRAPLOC,3)    ***TRAP ADDRESS
         FORMAT   2,(HEX,TRAPCONT,8),1     ***CONTENTS OF XPSD
         FORMAT   1,(HEX,OLDPSD,8),1,(HEX,OLDPSD+1,8),(TAB,54)
         FORMAT   (MOVE,TRAPNAME,8),1,(MOVE,NAMENPSD,8),(TAB,74)
         FORMAT   (HEX,NEWPSD,8),1,(HEX,NEWPSD+1,8)
         FORMAT   PRINT,END         PRIN AND RETURN HERE
NEXTTRAP BAL,R0   UNMAP             UNMAP PRIOR TO NEXT ONE                  A00
         LW,R2    TRAPLOC
         CI,R2    TRAPSAVE          IF THIS IS LOCATION '40'
         BNE      %+2               OR '46' AND ALSO A TAPE DUMP
         LI,R2    X'40'             THEN TRAPLOC MUST BE RESTORED
         CI,R2    TRAPSAVE+1
         BNE      %+2
         LI,R2    X'46'
         STW,R2   TRAPLOC
         MTW,1    TRAPLOC           BUMP TO NEXT ONE                         A00
         LW,R2    TRAPLOC           CURRENT TRAP LOCATION
         CI,R2    X'46'             CHK FOR LOCATION .46
         BEZ      TPTRAPCK          BIF .46
         CI,R2    MONORG            AT TOP YET
         BLE      INTRLOOP
         B        TPTRDONE           ALL FINISHED--BRANCH AROUND THIS
TPTRAPCK EQU      %                 IS THIS A TAPE DUMP
         MTW,0    TAP%DMP           TAPE DUMP INDICATOR
         BEZ      INTRLOOP          JUST CONTINUE IF NOT
         LI,R2    TRAPSAVE+1
         STW,R2   TRAPLOC
         B        INTRLOOP
TPTRDONE EQU      %
         PAGE
*
*        SEE HOW MANY XPSDS WE FOUND
*
         LW,R14   ZAPFLAG           GET COUNTER
         CI,R14   26                SHOULD BE AT LEAST NNN XPSDS
         BG       INTRPRET          OKAY
BAD:XPSD EQU      %                 BAD
         FORMAT   START,(SKIP,2),1,'**INTERRUPT CELLS DESTROYED'
         FORMAT   PRINT,(SKIP,2),END
         LI,R14   X'40'
         BAL,R0   GETADDR
         LI,R7    MONORG-64         LENGTH OF TRAP TABLES
         LW,R8    PAGEBUF           WINDOW ADDRESS
         AI,R8    64                POINT TO FIRST TRAP LOC (X'40')
         BAL,R0   DUMPSOME
INTRPRET PULL     L1
         B        0,R1
         PAGE                      *
*
*F*      NAME:    SVALTXT
*F*      PURPOSE: GIVEN VALUE IN R12 - FIND SYMBOL (OR CLOSEST) ADDRESS
*F*               IN ANLZ'S SYMBOL TABLE
*
SVALTXT  EQU      %                *
         LW,R2    BIGBUF            * GOT THE TABLE
         BEZ      SVALTXT6          * NOPE--> RETURN
         AND,R12  ADMASK            * EXTRACT CORE ADDRESS ONLY
         MTW,0    JITBURST         *IS A JIT DISPLAY
         BEZ      %+2              *NO
         LW,R12   JITPOS           *YES,GET CURRENT POSITION
         LW,R2    R12              *MOVE VALUE TO WORK REG
         CI,R2    X'8E00'          *WILL VALUE FIT FINDER TABLE
         BLE      %+2              *YES - JUMP
         LI,R2    X'8E00'          *NO - SET TO FETCH TOP TABLE ENTRY
         SLS,R2   -8               *SHIFT TO CREATE INDEX INTO TABLE
         LW,R13   *FINDER,R2        * GET POINTER TO SYMBOL
         BGZ      SVALTXT1         *GO IF POINER OBTAINED
         BDR,R2   %-2              *GO TILL WE FIND ONE
         LW,R13   BIGBUF            * START AT THE BOTTOM THEN
SVALTXT1 EQU      %                *
         LW,R2    R13              *MOVE POINTER FOR SEARCHING LOOP
         LW,R13   BATFLAG         * LOAD ABS FLAG
SVALTXT2 EQU      %                *
         CW,R12   0,R2             *IS VALUE A ATCH HERE
         BE       SVALTXT4         *GO IF EQUAL
         BL       SVALTXT6         *PASSED IT UP - SO EXIT
SVALTXT3 EQU      %                *
         AI,R2    3                *POINT TO NEXT ENTRY
         CW,R2    ADDEFEND         *AT TOP
         BL       SVALTXT2         *HAVENT REACHED END YET
         B        SVALTXT6         *PASSED IT UP - SO QUIT
SVALTXT4 EQU      %                *
         CW,R13   1,R2            * TEST ABS FLAG IN SYMBOL
         BANZ     SVALTXT3        * IN ABS - KEEP SEARCHING
         CW,R12   3,R2             *IS EQUAL TO SECOND SLOT
         BNE      SVALTXT5         *NOPE
         AI,R2    3                *POINT TO SECOND ONE
SVALTXT5 EQU      %                *
         AI,R1    1                *BUMP RETURN POINT
         LI,R0    5                *SET FOUND FLAG
         B        SAVE:CLOSEST     *AND SAVE DATA
SVALTXT6 EQU      %
         AI,R2    -3               *BACK IT UP
         BGZ      %+2              *OKAY
         LW,R2    BIGBUF           *USE START ADDRESS THEN
         LI,R0    0                *SET CONDITION CODES
         B        SAVE:CLOSEST     *AND SAVE POINTERS
         PAGE
*
*        SAVE CLOSEST SYMBOL ADDRESS AND VALUE IN CASE
*        WE ARE DUMPING OUT A TSTACK OVER IN MAIN ANALYZE
*
SAVE:CLOSEST EQU  %
         LW,R13   0,R2              GET SYMBOL VALUE
         STW,R13  CLOSESTADD        SAVED.....
         AI,R2    1                 POINT TO TEXT STRING
         STW,R2   CLOSESTSYM        AND REMEMBER SYMBOL ADDRESS
         CI,R0    0                 SET CONDITIONS
         B        0,R1              AND EXIT.....
         USECT    DATA
JITPOS   DATA     J:JIT
         USECT    PP
         PAGE
*
*F*      NAME:    GRABSYM
*F*      PURPOSE: TO TAKE VALUE IN R12 AND CALCULATE WHAT CSECT IT
*F*               BELONGS TO
*
GRABSYM  PSW,R1   STACK            *SAVE LINK
         BAL,R1   SVALTXT          *GO SEARCH
         NOP      %                *IGNORE ERROR - ITS HANDLED HERE
         LD,R2    CLOSESTSYM       *GET RESULTS AS PASSED FROM SVALTXT
         LD,R0    ZEROS            *AND THEN
         STD,R0   CLOSESTSYM       *RESET EM
         CW,R12   R3               *WAS SEARCH AN EXACT HIT
         BE       GRABSYM4         *YES - EXIT NOW
         CLM,R12  JIT:LIMS         *OR IN THE JIT
         BCR,9    GRABSYM4         *YES - EXIT NOW
         LI,R2    160               *INIT SEARCH COUNTER
         LI,R3    0                *INDEX INTO TABLE
GRABSYM1 EQU      %                *
         LW,R1    *CPOINTER,R3      *GET LOC OF SYMBOL ENTRY
         BEZ      GRABSYM2         *AT END
         CW,R12   0,R1             *WILL SYMBOL FIT THIS CSECT
         BLE      GRABSYM3         *YES - RETURN IT
         AI,R3    1                *NEXT ONE
         AI,R2    -1               *
         BGZ      GRABSYM1         *MORE TO GO YET
GRABSYM2 EQU      %                *
         PLW,R1   STACK            *SEARCH FAILED
         B        0,R1             *SO JUST EXIT
GRABSYM3 EQU      %                *
         AI,R3    -1               *GOT THE FIT - CORRECT INDEX
         BLZ      GRABSYM2         *ERROR - EXIT
         LW,R2    *CPOINTER,R3      *GET SYMBOLS LOCATION
         LW,R3    0,R2             *GET SYMBOLS ADDRESS
         AI,R2    1                *ADJUST TO POINT TO TEXT STRING
GRABSYM4 EQU      %                *
         STD,R2   CLOSESTSYM       *STORE TEXT LOC / SYMBOL VALUE AWAY
         PLW,R1   STACK            *GET LINK
         B        0,R1             *AND EXIT
         PAGE
*
*        TABLE TO CONTAIN USER LIST TO DISPLAY
*
         USECT    DATA
OSULSIZE DATA     0
*
*
OSUL     EQU      %
         DO1      256/4             ROOM FOR 256 USERS TOTAL
         DATA     0
*
         USECT    PP
         PAGE
*
*F*      NAME:    STKCHK
*F*      PURPOSE: TO EXAMINE JIT IN BUFFER FOR ACCURATE TSTACK
*
STKCHK   EQU      %
         LCFI     2                 SAVE SOME WORK AREA
         PSM,R5   STACK
         LI,R6    TSTACK-J:JIT+1    INDEX TO TSTACK WORD 1
         INT,R5   *JITBUF,R6        EXTRACT CNT IN STACK
         AI,R6    -1                BACK UP TO WORD ZERO
         LW,R6    *JITBUF,R6        GET WORD ZERO
         BLEZ     STKCHK1           BAD STACK
         SW,R6    R5
         CI,R6    TSTACK+1          SHOULD COME OUT TO BE THIS
         BNE      %+2               ERROR RETURN TO BAL +1
         AI,R7    1                 NORMAL RETURN TO BAL +2
STKCHK1  EQU      %
         LCFI     2
         PLM,R5   STACK
         B        0,R7              AND RTURN NORMALY
         PAGE
*
*        BUILD USER# PRINT LINE
*
BUST4    EQU      %
         LI,R1    US:MSG            MSG ADDRESS TO PRINT
         LW,R3    USER              NUMERIC STRING TO PUT OUT
         AND,R3   #R16              SCREEN FLAGS
         B        MTBB              LINK HERE WAS R0 - GO PRINT INFO
US:MSG   TEXTC    ' USER # '
         PAGE
*
*F*      NAME:    SYM:SERCH
*F*      PURPOSE: TO PROCESS THE #SYMBOL# SLASH COMMAND. ROUTINE
*F*               TAKES THE SYMBOL IN TEXT AND CALLS ROUTINES
*F*               TO ESTABLISH THE SYMBOL'S ADDRESS.
*
SYM:SERCH EQU     %
         BAL,R0   BL:BUF            BLANK OUT THE INCOMING JUNK
         LB,R1    FLDCNTS           GET LENGTH OF THE FIRST FIELD
         CI,R1    7                 MAX
         BLE      %+2               NO
         LI,R1    7                 RESET
         LI,R2    BA(FIELD1)
         LI,R3    BA(PROCNAME)
         AI,R3    1                 FOR BYTE COUNT
         STB,R1   R3
         MBS,R2   0
         STB,R1   PROCNAME          MAKE IT TEXTC
         LI,R13   PROCNAME
         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,R8    LASTLOC           OBJECT ADDRESS
         AND,R8   X1FF              MASK TO PAGE INDEX
         AW,R8    PAGEBUF           ADD DUMP WINDOW
         LI,R7    1                 TO DUMP ONE WORD
         BAL,R0   DUMPSOME
         B        SCANNER
         PAGE
*
*F*      NAME:    VALTEXT
*F*      PURPOSE: GIVEN VALUE FIND SYMBOL TEXT STRING IN SYMBOL TABLE
*
VALTEXT  EQU      %
         LI,R1    0
         BAL,R0   GETHEX            GET THE VALUE
         STW,R2   LASTLOC           REMEBER INITIAL VALUE
         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
         B        SCANNER           AND RETURN
         PAGE
*
*F*      NAME:    DISP:OFF
*F*      PURPOSE: TO TAKE VALUE IN 'CLOSESTADD' AND CALULATE
*F*               DIFFERENCE AGAINST VALUE IN R3
*
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
         END

