         REF      SNULL
         DEF      MD:SUBQ
         SYSTEM   SIG7FDP
S:S      FNAME                                                               A00
         PROC                                                                A00
         PEND     AF(AF(1)+1)                                                A00
*
         CLOSE    PUSH,PULL,START
*************************************
*                                   *
*        ANALYZE OVERLAY #2         *
*                                   *
*  HANDLES VARIOUS DISPLAYS         *
*                                   *
*************************************
*
*
*
* ENTP-EXTP         PROC LISTING CONTROL
* MBS-CBS           MACHINE LANGUAGE INSTRUCTIONS FOR SIGMA 7 OR
*                     SIMULATION ROUTINES FOR SIGMA 5
* MOVE,COMPARE      DEFINE MBS/CBS EASILY WITHOUT REG LOADING,ETC.
* TXT               SAME AS TEXT WITHOUT GENERATED LISTING
* SUBRTINE-CALL-RETURN  SUBROUTINE LINKAGE
* BIL-BOL           SUPPLEMENTS TO BCR/BCS MNEMONICS
* BLANK-ZERO        BLANK OR ZERO OUT AREAS OF CORE
* PUSH-PULL-BUMP    REGISTER SAVE/RESTORE
* HEADING           WRITES HEADING ON OUTPUT LISTING
* PRINT             WRITES BODY OF OUTPUT LISTING
* FORMAT            SETS UP ARGUMENTS FOR FORMAT SUBROUTINE
* EXPLAIN           ARG SETUP FOR DECODING BITS INTO TEXT DESCRIPTIONS
* BITPIK            ARG SETUP FOR DECOMPOSING WORD INTO BITS
* FETCH             ARG SETUP FOR ACCESSING CONTENTS OF DUMP
* SVALCON           ARG SETUP FOR ADDRESS TO CONTENTS SEARCH
* SVALTXT           ARG SETUP FOR ADDRESS TO DEF NAME SEARCH
* STXTVAL           ARG SETUP FOR DEF NAME TO ADDRESS SEARCH
* STXTCON           ARG SETUP FOR DEF NAME TO CONTENTS SEARCH
         TITLE    'REGISTER ALLOCATION'
*
*
*        DECLARE REGISTERS AS ABSOLUTE ADDRESSES SO METASYM
*          ADDRESSING FUNCTIONS MAY BE APPLIED TO THEM
*          SUCCESSFULLLY
*
*
*
%PSECT1  CSECT    0                 PURE DATA CONTROL SECTION
A2DATA   EQU      %
         DEF      A2DATA
%SECT1   CSECT    1                 PURE PROCEDURE SECTION
A2PP     EQU      %
         DEF      A2PP
*
*
         ASECT                      FOR SOME REASON WE NEED THIS
%R       EQU      %                 FOR METASYM TO REACT PROPERLY
*
*
*
*                     USED BY       WHOSAVES   USED FOR
*                     -------       --------   --------
*
R0,P0    EQU    %R+0  PROCS         PROC       RESERVED FOR PROC
R1,L1    EQU    %R+1  LINKING SUBS  CALLER     ALL LINKING
R2,P2    EQU    %R+2  PROCS         PROC       RESERVED FOR PROC
R3,P3    EQU    %R+3  PROCS         PROC       RESERVED FOR PROC
R4,X4    EQU    %R+4  SUBROUTINES   SUBRTN     GLOBAL INDEX
R5,X5    EQU    %R+5  SUBROUTINES   SUBRTN     GLOBAL INDEX
R6,X6    EQU    %R+6  SUBROUTINES   SUBRTN     GLOBAL INDEX
R7,X7    EQU    %R+7  SUBROUTINES   SUBRTN     GLOBAL INDEX
R8,A8    EQU    %R+8  SUBROUTINES   SUBRTN     GLOBAL ARITHMETIC
R9,A9    EQU    %R+9  SUBROUTINES   SUBRTN     GLOBAL ARITHMETIC
R10,A10  EQU    %R+10 SUBROUTINES   SUBRTN     GLOBAL ARITHMETIC
R11,A11  EQU    %R+11 SUBROUTINES   SUBRTN     GLOBAL ARITHMETIC
R12,V12  EQU    %R+12 SUBROUTINES   VOLATILE   SUBROUTINE ARGS/RETURNS
R13,V13  EQU    %R+13 SUBROUTINES   VOLATILE   SUBROUTINE ARGS/RETURNS
R14,V14  EQU    %R+14 SUBROUTINES   VOLATILE   SUBROUTINE ARGS/RETURNS
R15,V15  EQU    %R+15 SUBROUTINES   VOLATILE   SUBROUTINE ARGS/RETURNS
*
         USECT    %SECT1            CURRENT SECTION = USER PROCEDURE
         TITLE    'ENTRY/EXIT CODE FOR OTHER PROCS'
*
*        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    %PSECT1             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
*
*************************************
EXTP     CNAME
*************************************
         PROC
LF       EQU      %
%LEVEL   SET      %LEVEL-1
         LIST     %LEVEL<=%LISTLVL
         PEND
*        INSTRUCTIONS USED FOR MONDUMP
*
%SIGMA   SET      7                 FOR UTS PURPOSES
*
         TITLE    'COMPARE, MOVE AND TXT'
*
*        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
*
*
*
*
*************************************
COMPARE  CNAME    2
MOVE     CNAME    1
*************************************
         PROC
         LOCAL    N
LF       ENTP
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
*************************************
TXT      CNAME
*************************************
         PROC
LF       ENTP
         TEXT     AF
         EXTP
         PEND
         TITLE    'SUBROUTINE LINKAGE  SUBRTINE/CALL/RETURN'
*
*        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
*************************************
CALL     CNAME
*************************************
         PROC
LF       BAL,L1   AF
         PEND
*************************************
RETURN   CNAME
*************************************
         PROC
LF       B        AF
         PEND
         TITLE    'ZERO/BLANK AND MISC.'
*
*        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
*
*************************************
BIL      COM,1,7,4,3,17 AFA(1),X'68',9,AF(2),AF(1)         BR IN LMTS
BLANK    CNAME    1
ZERO     CNAME    2
*************************************
         PROC
LF       ENTP
         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
         EXTP
         PEND
         TITLE    'REGISTER SAVE/RESTORE PUSH/PULL/BUMP'
         PAGE
*
*        SUBROUTINES FOR STACK OPERATIONS
*
         REF      STACK
*
*
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
         TITLE    'LISTING I/O  HEADING/PRINT'
*                                   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       ENTP
         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    %PSECT1
TEXTFPT  GEN,8,24 X'11',M:LO
         DATA     X'30000010'       BUF ADRS/SIZE WAIT
         DATA     AF(1)             ADRS
         DATA     4*CF(2)         BUF SIZE
         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 EXTP
         PEND
         TITLE    'FORMAT SUBROUTINE ARGUMENT SET-UP'
*
*        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       ENTP
         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    %PSECT1           GEN TEXT IN PROC AREA
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
         DATA     BA(OBUF)+1        DEFAULT BUFFER
     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
         EXTP
         PEND
         TITLE    'EXPLAIN SUBROUTINE - BIT TO TEXT'
*
*        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       ENTP
%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    %PSECT1
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     EXTP
         PEND
         TITLE    'BITPIK - FOR SPLITTING OUT BITS FROM A WORD'
*
*************************************
BITPIK   CNAME
*************************************
         PROC
         LOCAL    CUR%,CNTRLWD,X
LF       ENTP
CUR%     EQU      %                 SAVE CURRENT %
         USECT    %PSECT1           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
         EXTP
         PEND
%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
*
*************************************
SVALTXT  CNAME    1
SVALCON  CNAME    2
STXTVAL  CNAME    3
STXTCON  CNAME    4
*************************************
         PROC
LF       ENTP
         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      SVALTXT,SVALCON,STXTVAL,STXTCON
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    %PSECT1             GEN TEXT IN DATA SECTION
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
*
         CALL     %SROUTIN(NAME)    CALL PROPER SUB
*
      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     EXTP
         PEND
         TITLE '*** VARIABLES FOR MONDUMP STYLE OUTPUT ***'
*
* 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       ENTP
         LOCAL    %SECT,PARMLIST,OPCODES,FFADR,RESL2,OPCODE2
%SECT    SET      %                 SAVE CURR CONTRL SECT
         USECT    %PSECT1
     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,3,17  OPCODE2,A10,AF(2,2),AF(2,1)+F:STACK
         ELSE
         GEN,1,7,4,3,17 ;           SECOND PARM WORD.  STORE-TYPE INSTR.
         AFA(2,1),;                 TO ADDRESS INDIRECT
         OPCODE2,;                  TO OPCODE
         A10,;                      FETCH SUBR ALWAYS SETS A10
         AF(2,2),;                  TO INDEX REG
         AF(2,1)                    TO STORAGE ADDRESS
         ERROR,1,SCOR(AF(2,3),DA)&ABSVAL(AF(2,1))    'AF(2,1) NOT DA'
         ERROR,1,TCOR(AF(1,1),S:RAD)&AFA(1,1) ;
                  'INDIRECTION ALLOWED ONLY WITH TEXT ADDRESS'
         FIN
         USECT    %SECT             RETURN  TO USER SECTION
         LD,V12   PARMLIST          TRANSMIT PARAMETERS
         CALL     FETCH             AND PERFORM FUNCTION
     DO           SCOR(AF(1,4,1),ERR)
         B        AF(1,4,2)
     ELSE
     FIN
         EXTP
         PEND
*************************************
         DEF      INIT:MD
         REF      JITLOC,S:CUN,UNMAP                                         A00
         USECT    %PSECT1           GENERATE DATA SECTION
CPOOL    DO1      11
         DATA     0
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
         REF      UX:JIT,UH:JIT,UH:FLG
         REF      MBB               IN MAIN ANALYZE
IUH:FLG  DATA     UH:FLG
IUX:JIT  DATA     UX:JIT
PHY:PAGE DATA     0                 >0 SAYS PAGE IS IN PHYSICAL#
IUH:JIT  DATA     UH:JIT
WDEFENT  DO1      DESW
         DATA     0
WTEXT    EQU      WDEFENT+TXTOFSET  ADDRESS OF TEXT IN WDEFENT
DESB     EQU      DESW*4
         REF      BIGBUF            ANLZ'S SYMBOL BUFFER
DEFBUF   EQU      BIGBUF            SET IT
         USECT    %SECT1
RPAGEMSK DATA     X'1FF'            LOW ORDER 09 BITS
ADMASK   DATA     X'1FFFF'          SELECT SIGMA 7 ADDRESS
         REF      ADDEFEND,LASTSVTF,LOC0:2K,FIN0:2K
#D2#D2   DATA     2,2
         USECT    %PSECT1           GENERATE DATA HERE....
         BOUND    8
FPAKPRM  DATA     0,0
FSETTX   GEN,12,3,17  0,X6,0
         GEN,12,3,17  0,-1,0
EBCCHAR  EQU      %
         DATA     X'5C',X'7C'
         DATA     'A','9'
#CHARS   EQU      DA(%)-DA(EBCCHAR)-1
CORELIMS DATA     0,0               LIMITS FOR PRINTING
DEF:TAB  EQU      %
DEFSTART EQU      BIGBUF            RESIDES IN MAIN ANALYZE
         BOUND    8                                                          A00
IDCT13   DATA     0,0               RESERVE FOR IMAGES OF CURRENT
IDCT16   DATA     0,0                 DCT ENTRIES, COMMAND LIST,SIZE OF
IIOQ13   DATA     0,0
#D1#D1   DATA     1,1
OPRANGE  DATA     1,13              OPCODE RANGE
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)
*
*        REGS FOR FETCH OPERATIONS
*
F:STACK  DO1      16
         DATA     0
CONTENTS DO1      4
         DATA     0
NXTCON   DATA     0                 NEXT MON CONTENTS WORD
         REF      M:LO
EJECTFPT GEN,8,24 X'04',M:LO
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
DCTSIZE  DATA     DCTSIZ
         REF      DCTSIZ
         PAGE
*
*        THE FOLLWOING CELLS CONTAIN;
*
*        1. PREFIX 'A' POINTS TO CORE LOCATION OF TABLE.
*        2. PREFIX 'I' CONTAINS CURRENT WORKING VALUE.
*
         REF      DCT1,DCT1A,DCT1P,DCT2,DCT3,DCT4,DCT5
         REF      DCT6,DCT7,DCT8,DCT9,DCT10,DCT11,DCT12
         REF      DCT13,DCT14,DCT15,DCT16,DCT17,DCT18
         REF      DCT19,DCT20,DCT21,DCT22,DCT23
         REF      IOQ1,IOQ2,IOQ3,IOQ4,IOQ5,IOQ6
         REF      IOQ7,IOQ8,IOQ9,IOQ10,IOQ11,IOQ12,IOQ13
         REF      IOQ14,IOQ15
         REF      CIT1,CIT2,CIT3,CIT4,CIT5,CIT6
         REF      JBUPVPA           FIRST USER PAGE
         REF      DCT24,DCT25
         REF      UB:PRIO,UB:US
         REF      CORE
         REF      SQUE,SNDDX,SSTAT,SSIG,SRET,SQTL,SCNTXT
         REF      SYMX,SQHD                                                  A00
         SREF     STB:TYP,STB:LNK,STH:FLG,STH:SUS,STB:Q                      A00
         REF      CURADRSS,LEGCORAD
*
*
DCTINDEX DATA     0                   .
IDCT1    DATA     0
IDCT1A   DATA     0
IDCT1P   DATA     0
IDCT2    DATA     0                   .
IDCT3    DATA     0                   .
IDCT4    DATA     0                   .
IDCT5    DATA     0                   .
IDCT6    DATA     0                   .
IDCT7    DATA     0                   .
IDCT8    DATA     0                   .
IDCT9    DATA     0                   .
IDCT10   DATA     0                   .
IDCT11   DATA     0                   .
IDCT12   DATA     0                   .
IDCT14   DATA     0                   .
IDCT15   DATA     0                   .
IDCT17   DATA     0                   .
IDCT18   DATA     0                   .
IDCT19   DATA     0
IDCT20   DATA     0
IDCT21   DATA     0
IDCT22   DATA     0
IDCT23   DATA     0
IDCT24   DATA     0
IDCT25   DATA     0
IIOQMAX  DATA     0
IIOQNUM  DATA     0
IIOQ1    DATA     0
IIOQ2    DATA     0
IIOQ3    DATA     0
IIOQ4    DATA     0
IIOQ5    DATA     0
IIOQ6    DATA     0
IIOQ7    DATA     0
IIOQ8    DATA     0
IIOQ9    DATA     0
IIOQ10   DATA     0
IIOQ11   DATA     0
IIOQ12   DATA     0
IIOQ14   DATA     0
IIOQ15   DATA     0                 USER #
IIOQ6FCN DATA     0
ICIT1    DATA     0
ICIT2    DATA     0
ICIT3    DATA     0
ICIT4    DATA     0
ICIT5    DATA     0
ICIT6    DATA     0
ICITNUM  DATA     0
ISYMMAX  DATA     0
ISYMNUM  DATA     0
ISQUE    DATA     0
ISNDDX   DATA     0
ISSTAT   DATA     0
ISSIG    DATA     0
ISRET    DATA     0
ISQHD    DATA     0
ISCNTXT  DATA     0
ISYMX    DATA     0
ISQTL    DATA     0
ISMXSTRM DATA     0                                                          A00
ISTYP    DATA     0                                                          A00
ISLNK    DATA     0                                                          A00
ISFLG    DATA     0                                                          A00
ISSUS    DATA     0                                                          A00
ISQ      DATA     0                                                          A00
E%PTRS  DATA    0,0,0,0,0,0                                                  A00
E%CNT    DATA     0                                                          A00
         BOUND    8                                                          A00
EBUF1    DATA     BUF1                                                       A00
EBUF2    DATA     BUF2                                                       A00
C%BUF    DATA     0                 CURRENT BUF PTR                          A00
E%TIME1  DATA     0                                                          A00
E%TIME2  DATA     0                                                          A00
RC%BUF   DATA     0                 DUMP ADDR OF CURR BUF                    A00
         REF      SV:RSIZ,SH:RNM,SB:RTY,SH:RTOT,SH:RBCU,SH:ROCU,SH:RGCU      A00
         REF      SB:RBDF,SB:RODF,SB:RGDF,SH:RBSUM,SH:ROSUM,SH:RGSUM         A00
         REF      SB:RBMX,SB:RGMX,SB:ROMX                                    A00
         REF      SQR,SQRO,U:MISC,SB:RQ,MSG,TRANSSZ,SPACES,BUFOUT
         DEF      ERROR%LOG                                                  A00
I        DO       16                                                         A00
ARAT(I)  SET      %                                                          A00
         DATA     S:S(I,SH:RNM,SB:RTY,SH:RTOT,SH:RBCU,SH:ROCU,SH:RGCU,;      A00
                  SB:RBDF,SB:RODF,SB:RGDF,SH:RBSUM,SH:ROSUM,SH:RGSUM,;       A00
                  SB:RBMX,SB:ROMX,SB:RGMX)                                   A00
IRAT(I)  SET      %                                                          A00
         DATA     0                                                          A00
         FIN                                                                 A00
RAT%SIZ  DATA     0                                                          A00
D(1)     SET      '-'                                                        A00
I        DO       9                                                          A00
D(I+1)   SET      S:PT(D(I),'-')                                             A00
         FIN                                                                 A00
D(11)    SET      ' '                                                        A00
         REF      AVRTBL,AVRID,SOLICIT,AVRNOU,AVRTBLSIZ,AVRTBLNE             A00
AVRDHDG  EQU      'SER#','PUB',' ','AVR','INI','VER','MTD','PRIM',' ',;X     A00
                  'NOU','HGPDISP','USER','SOLICIT','DCBS+USERS'              A00
AVRTHDG  EQU      'SER#','PUB','POS','AVR','SCR','HLD','PTL','UPL',;         A00
                  'OPN','NOU','TPOS','USER','SOLICIT','DCBS+USERS'           A00
TD       EQU      4,3,3,3,3,3,3,3,3,3,4,4,7,10                               A00
DD       SET      TD                                                         A00
DD(3),DD(9)  SET  11                                                         A00
DD(8)    SET      4                                                          A00
DD(11)   SET      7                                                          A00
AVRLIST  EQU      AVRTBL,0,0,0,0,0,0,0,0,0,0,AVRID,SOLICIT,AVRNOU            A00
TAVR     EQU      3,8,12,16,20,24,28,32,36,40,44,52,57,65                    A00
         BOUND    8                                                          A00
I        DO       NUM(AVRLIST)                                               A00
         GOTO,TCOR(AVRLIST(I),S:INT)    FIN                                  A00
ASAVR(I) SET      %                                                          A00
         DATA     AVRLIST(I)                                                 A00
FIN      FIN                                                                 A00
         BOUND    8                                                          A00
I        DO       NUM(AVRLIST)                                               A00
ISAVR(I) SET      %                                                          A00
         DATA     0                                                          A00
         FIN                                                                 A00
         BOUND    8                                                          A00
CNTS,TP%CNT  DATA  AVRTBLSIZ                                                 A00
DP%CNT   DATA     AVRTBLNE-AVRTBLSIZ                                         A00
CNTRS,TP%CNTR DATA  0                                                        A00
DP%CNTR  DATA     0                                                          A00
#R0      DATA     0
#CBLANKS DATA     '    '
         USECT    %SECT1
#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
#R16     DATA     X'0000FFFF'       16 BIT MASK
#R7F     DATA     127
#LFF     DATA     X'FF000000'
#RFF     DATA     X'FF'
         USECT    %PSECT1
JDCB:LINK DATA    0                 CONTAINS PHYSICAL ADDRS OF DCB'S
BLANKFLG DATA     -1                0=BALNK OBUF      >1= NO.
JIT:ORIG EQU      %                 ORIGIN TABLE
         TEXT     'BATCH   '        JIT CODE=0
         TEXT     'GHOST   '        JIT CODE=40
         TEXT     'ONLINE  '        JIT CODE=80
*
*
         REF      OBUF              RESIDES IN MAIN ANALYZE
*
*
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
         REF      SMUIS
USRCNT   EQU      USER              IN MAIN ANALZ
USERX    DATA     0
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
         REF      MRMSG,DCTSMSG,CITSMSG,IOQSMSG,SYMTMSG,TRMSG,USMSG
         REF      TITEL
         TITLE    ' SHUFFLE FOR MOVING MANY WORDS IN CORE'
*
*        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    %SECT1            GENERATE PROCDURE
********************************
SHUFFLE  SUBRTINE 'SHUFFLE'
********************************
         PUSH     4,R12
         SLD,R14  2                 FROM/TO INTO BA'S
         SLS,R12  2                 MAKE WORDS INTO BYTE COUNT
         STB,R12  R15               SET UP MBS
         MBS,R14  0                 MOVE INTO PLACE
         PULL     4,R12
         B        0,R1              AND EXIT
         PAGE
*                                   PICK UP INPUT TEXT ARGUMENT AND PAD
*                                   W TRAILING BLANKS
********************************
FETCHTXT SUBRTINE 'FETCHTXT'
********************************
         LI,R0    0
         STW,R0   WTEXT
         STW,R0   WTEXT+1
         STW,R0   WTEXT+2
         LW,R2    R13
         SLS,R2   2                 TO BA
         LB,R0    0,R2              GET COUNT
         AI,R0    1                 PLUS ONE FOR BYTE COUNT
         LI,R3    BA(WTEXT)
         STB,R0   R3
         MBS,R2   0
         B        0,L1
         TITLE    'SYMBOL TABLE LOOKUP/RETURN ROUTINES'
*
*        STXTVAL - GIVEN  TEXT,     FIND VALUE (OR ADDRESS)
*        SVALCON - GIVEN  VALUE,    FIND CONTENTS
*        STXTCON - GIVEN  TEXT ,    FIND CONTENTS
*        SVALTXT - GIVEN  VALUE,    FIND TEXT
*
*
********************************
STXTVAL  SUBRTINE 'STXTVAL'
********************************
         DEF      STXTVAL
         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   #R1F              MASK TRUNCATED SYMBOL BIT
         CW,R3    R0                DOES OBSERVED CNT FIT REQUESTED
         BG       STVCONT           NO - OBSERVED IS LARGER STRING
         AI,R14   -1                OK - STRING IS A MATCH
*
*        R14 IS PASSED BACK POINTING TO VALUE LOCATION IN TABLE
*
         LW,V12   *V14
         PULL     L1
         LCI      15                SET NORMAL CONDITIONS
         B        0,R1
         PAGE
********************************
SVALTXT  SUBRTINE 'SVALTXT'
********************************
         DEF      SVALTXT
         MTW,0    JITBURST          IS A JIT DISPLAY
         BEZ      %+2               NO
         LW,R12   JITPOS            YES,GET CURRENT POSITION
         AND,R12  ADMASK            MASK TO 17 LOW ORDER BITS
         CI,R2    X'8C00'           IS THIS A JIT ADDRESS
         BL       %+2               NO, POINTER IS OK
         AI,R2    X'1000'           YES, BUMP TO NEXT HIGHER TABLE
         LI,R2    X'F000'           MASK TO GET
         AND,R2   R12               THOUSANDS FIELD
         SLS,R2   -12               POSITION INDEX
         AI,R2    DA(FIN0:2K)       GET TABLE ADDRESS
         LD,R2    0,R2              GET ENTRY IN TABLE
         AI,R2    0                 WAS A POINTER SAVED
         BLEZ     SVALTXT02         WE DIDNT SET UP THE TABLE EARLIER
         LW,R13   LASTSVTF          GET LAST SAVED LOC
         BLEZ     SVALTXT00         HAVENT SAVED ONE YET
         LW,R3    *R13              GET VALUE
         LW,R0    0,R2              GET VALUE FROM POINTER
         CW,R12   R3                IS SEARCH ITEM CLOSER TO LAST LOC
         BL       SVALTXT00         NO
         CW,R3    R0                YES - BUT IS IT GOOD ENUFF
         BG       SVTLOOP           YES - GO AHEAD
SVALTXT00 CW,R12  0,R2              DOES REQUESTED VALUE FIT HERE
         BG       SVALTXT01         POSSIBLY....
         AI,R2    -3                BACK UP THE POINTER
         CW,R2    DEFSTART          DONT BACK UP TOO FAR...
         BL       STARTLP           TOO FAR NOW
         B        SVALTXT00         LOOK AGAIN FOR MATCH
SVALTXT01 EQU     %
         LW,R13   R2                MOVE POINTER FR SEARCH
         B        SVTLOOP           GO START SEARCH
SVALTXT02 EQU     %
         LW,R13   LASTSVTF          CHECK LAST ONE
         BLEZ     STARTLP           BLEW IT
         CW,R12   *R13              FIT IN HERE
         BG       SVTLOOP           POSSIBLY
STARTLP  LW,R13   DEFSTART          GET STARTING ADDRESS
         BLEZ     SET:LOCB          NONE OR ERROR
SVTLOOP  EQU      %
         CW,R12   *R13              IS VALUE IN RANGE
         BLE      ABSCHECK          MIGHT HAVE GOT IT
SVTLOOP1 AI,R13   3                 POINT TO NEXT ENTRY
         CW,R13   ADDEFEND          AT TOP
         BGE      SET:LOCB          PASED IT UP
         B        SVTLOOP
ABSCHECK LW,R2    R13               MOVE POINTER
         AI,R2    1                 POINT TO FLAGS
         LC       *R2               TEST ABS FLAG
         BCS,4    SVTLOOP1          IN ABS - KEEP GOING
         AI,R2    -1                NOT ABS - EVALUATE SYMBOL
         CW,R12   0,R2              WERE THEY EQUAL
         BG       SVTLOOP1          NOT THERE YET
         BL       SET:LOCB          PASSED IT UP
SVTLOOP2 CW,R12   3,R2              TEST VALUE AGAINST NEXT
         BNE      GOTCHA            NOPE
         CW,R12   6,R2              OR AGINST SECOND NEXT
         BE       SVTLOOP3          USE SECOND ONE
         AI,R13   3                 POINT TO SECOND ONE
GOTCHA   STW,13   LASTSVTF          REMEMBER LAST FOUND ADDRESS
SET:LOCA LW,R2    R13
         AI,R1    1                 BUMP RETURN POINT
         AI,R13   1                 POINT TO TEXT
         LI,R0    5                 SET FOUND FLAG
         B        SAVE:CLOSEST      AND SAVE DATA
SET:LOCB LW,R2    R13               POINTER TO VALUE
         AI,R2    -3                BACK IT UP
         BGZ      %+2               OKAY
         LI,R2    0                 NOT OKAY
         LI,R0    0                 SET CONDITION CODES
         B        SAVE:CLOSEST      AND SAVE POINTERS
SVTLOOP3 AI,R13   6                 USE SECOND ENTRY
         B        GOTCHA            AND GO ON...
         PAGE
*
*        SAVE CLOSEST SYMBOL ADDRESS AND VALUE IN CASE
*        WE ARE DUMPING OUT A TSTACK OVER IN MAIN ANALYZE
*
SAVE:CLOSEST EQU  %
         REF      CLOSESTADD,CLOSESTSYM
         LW,R13   0,R2              GET SYMBOL ADDRESS
         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.....
         PAGE
********************************
STXTCON  SUBRTINE 'STXTCON'
********************************
         PUSH     R1
         CALL     STXTVAL           BUST TEXT TO VALUE
         PULL     R1
         B        SVALCON           AND THEN GET CONTENTS OF VALUE
         PAGE
********************************
SVALCON  SUBRTINE 'SVALCON'
********************************
         AND,V12  ADMASK            MASK OFF
         CLM,V12  LEGCORAD          IS LEGAL CORE ADDRESS
         BOL      0,L1              NO,TAKE ERROR EXIT
         REF      DUMP:DIR
         LW,R0    DUMP:DIR
         AW,R0    JITBURST
         BNEZ     SVCFILE           ALREADY IN BUFFER
         CLM,V12  CURADRSS          IS ADDRESS RQSTD IN CORE ?
         BOL      NEWPAGE             NO
SVCFILE  PUSH     X4                  YES - FETCH IT
         LW,X4    V12
         AND,X4   RPAGEMSK
         LW,V15   *PAGEBUF,X4       GET WORD FROM PAGE BUFFER
         PULL     X4
         B        0,R1
         USECT    %PSECT1           PLACE INTO DATA AREA
JITPOS   DATA     X'8C00'           FOR JIT DUMPS
         USECT    %SECT1            BACK TO PROCEDURE
         PAGE
*
*        REQUIRE NEXT PAGE FOR DISPLAY,ENTRY
*        INTO ANLZ'S GETPAGE ROUTINE
*        IS SET UP AND CALLED
*
NEWPAGE  EQU      %
         REF      KEY,GETPAGE
         PUSH     8,R11
         LW,R1    R12               WORKING ADDRESS
         SLS,R1   -9                INTO A PAGE ADDRESS
         LW,R12   R1                MOVE IT BACK
         SLS,R12  9                 BASE PAGE ADDRESS
         STW,R12  CURADRSS          SAVED
         AI,R12   511               TOP OF PAGE
         STW,R12  CURADRSS+1        SAVED
         LCFI     4
         STCF     R1                POST ONE PAGE READ FLAG
         BAL,R0   GETPAGE           GO GET THE INTENDED PAGE
         PULL     8,R11
         B        SVCFILE           GO GET CONTENTS
         REF      PAGEBUF,SCANNER,JITBURST
         PAGE
*
*        INTERFACE BETWEEN MONDUMP SUBROUTINES
*        AND UTS ANALYZE.
*
*        INTIALIZE POINTERS HEREIN TO ENABLE DUMP
*        TO BE PROCESSED PROPERLY
*
         REF      STKSIZE
INIT:MD  SUBRTINE 'INIT:MD'
         PUSH     L1                SAVE RETURN LINK
         LW,L1    BIGBUF            GET SYMBOL TABLE BASE
         BLEZ     INIT:MD4          NONE OR ERROR
         STW,L1   DEFSTART          SAVED
         STW,L1   LASTSVTF          SET UP LAST ACCESS
         LW,R2    STKSIZE           NUMBER OF WORDS IN TABLE
         AW,R2    R1                END OF TABLE
         STW,R2   ADDEFEND          STORE STOP ADDRESS
         MTW,0    FIN0:2K           ALREADY DONE THIS
         BNEZ     INIT:MD4          YEP..SKIP OVER TABLE START-UP
         LI,R4   10                 MAX LOOP
         LI,R2    LOC0:2K           VALUE TABLE
         LI,R3    FIN0:2K           POINTER TABLE
INIT:MD1 LW,R5    0,R1              GET VALUE
         BLEZ     INIT:MD2          FORGET THOS
         MTW,0    0,R3              ALREADY HAVE A START POINT
         BNEZ     INIT:MD15         YEP
         CW,R5    0,R2              DOES VALUE BELONG IN THIS TABLE
         BLE      INIT:MD2          NO
         STW,R1   0,R3              STORE POINTER
INIT:MD15 CW,R5   1,R2              CHECK HIGH SIDE
         BGE      INIT:MD3          GOTCHA
INIT:MD2 EQU      %
         AI,R1    3                 BUMP TO NEXT ENTRY
         CW,R1    ADDEFEND          CHECK AGAINST STOP ADDRS
         BL       INIT:MD1          DO NEXT ENTRY
         BGE      INIT:MD4          ALL DONE
INIT:MD3 STW,R1   1,R3              STORE STOP FOR THESE VALUES
         STW,R1   2,R3              STORE START POINT FOR NEXT SET
         AD,R2    #D2#D2            BUMP POINTERS TO TABLES
         BDR,R4   INIT:MD2          DO NEXT ONE
INIT:MD4 LI,R1    CORE              HIGHEST WA WE'LL USE
         STW,L1   LEGCORAD+1        SET UP CLM PAIR
         LI,L1    -1
         STW,L1   CURADRSS+1        SET CURRENT MEMORY TABLE
         STW,L1   CURADRSS          SO WE FORCE IN A PAGE
         PULL     L1
         B        0,L1              RETURN TO ANLZ
         PAGE
*
*        CORE DUMP INTERFACE BETWEEN ALALYZE
*        AND MONDUMP SUBROUTINES
*
MD:CORE  EQU      %
         DEF      MD:CORE
         PUSH     L1                SAVE RETURN LINK
         LI,1     MRMSG             SEND
         BAL,0    TITEL             TITLE LINE OUT
         REF      GETHGP
         LI,1     GETHGP
         AI,1     512
         SLS,1    -9
         SLS,1    9
         STW,1    LOCLAST
         LI,R1    LOC:LOC           LOCATION TO DUMP FROM
         B        MDSNAP4
         USECT    %PSECT1           INTO DATA
LOC:LOC  DATA     0
LOCLAST  DATA     X'4000'
         PLW,R1   STACK
         B        0,R1
         USECT    %SECT1            BACK TO PROCEDURE
         PAGE
*********************************
FETCH    SUBRTINE 'FETCH'
*******************************
         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
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
         TITLE    '*** CORE DUMP DRIVER ***'
         PAGE
*
*
NUM      SET      4
*
*
*
* BASIC PROGRAM LOGIC:
*
*    THE CONTENTS OF LOCATIONS CURADRS THROUGH CURADRS+NUM-1 ARE TO BE
*    PRINTED.  HOWEVER, DURING EACH ITERATION, THE CONTENTS OF
*    LOCATIONS CURADRS+1 THROUGH CURADRS+NUM  ARE FETCHED. THIS IS DONE SO
*    THAT LOOK-AHEAD MAY BE PERFORMED FOR DUPLICATE  LINE SUPPRESSION.
*
*    DUPLICATE LINE SUPRESSION CHECKS TO SEE WHETHER ALL NUM  WORDS IN A
*    LINE ARE EQUAL.  THE FIRST TIME THEY ARE, EQLFLAG IS SET TO 1.
*    WHEN A NON-MATCH IS MADE,EQLFLAG IS RESET AND A DUPLICATE  LINE
*    FORMAT IS PRINTED USING VALUES SAVED WHEN  EQLFLAG WAS SET.
*
*
****************************
MDSNAP4  SUBRTINE 'MDSNAP4'
****************************
         DEF      MDSNAP4
         PUSH     8,R0
         BAL,0    BL:BUF            BLANK OUT PRINT LINE
         MOVE,8   *L1,CORELIMS      PICK UP ARGS FROM CALL SEQ
         ZERO     (CONTENTS,NUM),EQLFLAG,CURADRS,LOKAHEAD
         LI,R8    X'8C00'           INITIAL
         STW,R8   JITPOS            START
         LW,A8    CORELIMS          GET BEGINNING ADRS SPECIALLY
         STW,A8   CURADRS             (AND SET CURADRS)
         SVALCON  (CURADRS,NXTCON)
FORML    LI,5     511               ADDRS MASK
         LS,R5    CURADRS           GET PAGE INDEX
         LI,R6    X'8C00'           BASE ADDRESS
         STS,R5   R6                SET UP CURRENT ADDRS
         STW,R6   JITPOS            AND SAVE FOR EXAMINATION
         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
         FETCH,NUM CURADRS,CONTENTS+1    GET LOCATIONS
         MTW,-1   CURADRS           UNBUMP TO REFLECT TRUE VALUE
         ZERO     (DEFHIT,1)        INITIALIZE FOR ANY DEFS IN THIS LINE
         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
         REF      TRUNC%SYM                                                  A00
         CI,R0    X'80'             SELECT TRUNCATED FLAG
         BAZ      NO%TRUNC          NOT TRUNCATED
         MTW,1    TRUNC%SYM         SET FLAG                                 A00
         LI,R0    8                 SET COUNT                                A00
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   #R1F              MASK OFF FLAGS
         STB,0    3                 SET BYTE CNT
         MBS,2    0                 MOVE ANEM INTO PLACE
         MTW,0    TRUNC%SYM         TEST FOR TRUNC SYM                       A00
         BEZ      NO%TRUNC1         NO                                       A00
         AI,R3    -1                BACK UP ONE CHAR                         A00
         LI,R0    C'<'              TRUN SYM FLAG                            A00
         STB,R0   0,R3              OVLY LAST BYTE MOVED                     A00
         LI,R0    0                                                          A00
         STW,R0   TRUNC%SYM         RESET FLAG                               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
         COMPARE,NUM*4     CONTENTS,CONTENTS+1 ALL NUM  WORDS SAME ?
         BNE      NOTSAME
         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
         ZERO     EQLFLAG
         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
         COMPARE,(NUM-1)*4  CONTENTS,CONTENTS+1  CHECK ONLY CUR LINE
         BNE      SUPRSEQL          O.K. NOW TERM EQL LINE
         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
         ZERO     EQLFLAG,LOKAHEAD
NEXTNUM  LI,A8    NUM               NEXT BLOCK OF NUM
         AWM,A8   CURADRS
         LW,A8    CURADRS
         CLM,A8   CORELIMS          HAVE WE EXCEEDED CORE LIMITS ?
         BOL      CLEANUP             YES
         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     8,R0              GET REGS
         B        2,L1
         PAGE
***********************************
PUTSUPRS SUBRTINE 'PUTSUPRS'
***********************************
         PUSH     L1
         MTW,-1   CURADRS           POINT TO LAST LOC IN WHICH EQL
         FORMAT   START,(SKIP,1),(HEX,EQLADRS,5),2
         FORMAT   (HEX,EQLCONTS,8),PRINT,(SKIP,1),END
         MTW,1    CURADRS           RESTORE
         PULL     L1
         B        0,L1
         PAGE
         DEF      MDIOSYM
************************************
MDIOSYM SUBRTINE 'MDIOSYM'
************************************
         PUSH     L1
         DEF      %DCTS,%IOQS,%CITS,SYMTABLS                                 A00
%DCTS    EQU      DCTS                                                       A00
%IOQS    EQU      IOQS                                                       A00
%CITS    EQU      CITS                                                       A00
         CALL     DCTS              DCT LISTING
         CALL     IOQS              IOQ LISTING
         CALL     SYMTABLS          SYMBIONTS
         CALL     CITS
         PULL     L1
         B        0,R1              AND EXIT TO CALLER
         TITLE '*** I/O TABLE DISPLAY DRIVER ***'
************************************
DCTS     SUBRTINE 'DCTS'
************************************
         PUSH     L1
         BAL,0    BL:BUF            BLANK PRINT LINE
*
*        DCT TABS
*
TAD1     EQU      1                 TAB FOR ROW NUMBER
TAD2     EQU      4                 TAB FOR PRI DEV ADRS
TAD3     EQU      9                 TAB FOR ALT DEV ADRS
TAD4     EQU      14                TAB FOR CIT INDEX
TAD5     EQU      19                FOR I/O FLG
TAD6     EQU      24                FOR DEV TYP
TAD7     EQU      29                DEV FLAGS
TAD8     EQU      35                FOR IOQ X
TAD9     EQU      40                FOR CDW ADRS
TAD10    EQU      47                FOR PRE HANDLER
TAD11    EQU      54                POST HANDLER
TAD12    EQU      61                ACTIVITY COUNTER
TAD13    EQU      67                AC//IO DEADLINE
TAD14    EQU      77                AIO STATUS
TAD15    EQU      87                LAST POSITION ON PRINT LINE
*
*
TAD01    EQU      1                 ROW NUMBER
TAD02    EQU      5                 TDV STATUS
TAD03    EQU      14                SECOND WORD OF TDV STATUS
TAD04    EQU      24                CHAN FLINK
TAD05    EQU      31                PRE-EMPT FLAG
TAD06    EQU      37                HANDLER CODES
TAD07    EQU      44                TIME-OUT INCREMENTS
TAD08    EQU      50                SIO CC
TAD09    EQU      55                TDV CC
TAD010   EQU      60                TIO STATUS
TAD011   EQU      68                DISC FLAG
TAD012   EQU      74                HGP DISPLACEMNTS
TAD013   EQU      80                RMA FLAGS
TAD014   EQU      86                SIO COUNTER
TAD015   EQU      96                LAST POSITION ON PRINT LINE
         LI,1     DCTSMSG           SEND
         BAL,0    TITEL             TITLE LINE OUT
         FORMAT   START,(SKIP,2)
         FORMAT   (TAB,TAD1),'#',(TAB,TAD2),'1P',(TAB,TAD3),'1A'
         FORMAT   (TAB,TAD4),'2',(TAB,TAD5),'3',(TAB,TAD6),' '
         FORMAT   (TAB,TAD7),'5',(TAB,TAD8),'6',(TAB,TAD9),'7'
         FORMAT   (TAB,TAD10),'8',(TAB,TAD11),'9',(TAB,TAD12),'10'
         FORMAT   (TAB,TAD13),'11',(TAB,TAD14),'12',PRINT
         FORMAT   (TAB,TAD1),' ',(TAB,TAD2),'DEV ADRS'
         FORMAT   (TAB,TAD4),'CIT',(TAB,TAD5),'IO'
         FORMAT   (TAB,TAD6),'DEV',(TAB,TAD7),'DEV'
         FORMAT   (TAB,TAD8),'IOQ',(TAB,TAD9),'CDW'
         FORMAT   (TAB,TAD10),'PRE',(TAB,TAD11),'POST'
         FORMAT   (TAB,TAD12),'ACT',(TAB,TAD13),'IO  INT.'
         FORMAT   (TAB,TAD14),'AIO INT.',(TAB,TAD15),' ',PRINT
         FORMAT   (TAB,TAD1),' ',(TAB,TAD2),'PRI  ALT'
         FORMAT   (TAB,TAD4),' # ',(TAB,TAD5),'FLG',(TAB,TAD6),'TYP'
         FORMAT   (TAB,TAD7),'FLGS',(TAB,TAD8),' # ',(TAB,TAD9),'ADRS'
         FORMAT   (TAB,TAD10),'HAND',(TAB,TAD11),'HAND'
         FORMAT   (TAB,TAD12),'CNTR',(TAB,TAD13),'DEADLINE'
         FORMAT   (TAB,TAD14),'STATUS',(TAB,TAD15),' ',PRINT
         FORMAT   (SKIP,2),PRINT,END
         LI,R4    DCTSIZ+1
         STW,R4   DCTSIZE           INITIALIZE COUNTER
         LI,R4    0                 INITIAL INDEX
DCTLOOP  RES      0
         STW,X4   DCTINDEX
         FETCH    (DCT1A,R4,HA),(IDCT1A,,WA)
         FETCH    (DCT1P,R4,HA),(IDCT1P,,WA)
         FETCH    (DCT16,R4,DA),(IDCT16,,DA)
         LD,R6    IDCT16                                                     A00
         SLD,R6   24                                                         A00
         AND,R6   L(X'FFFF0000')                                             A00
         STW,R6   IDCT16                                                     A00
         FETCH    (DCT2,R4,BA),(IDCT2,,WA)
         FETCH    (DCT3,R4,BA),(IDCT3,,WA)
         FETCH    (DCT5,R4,BA),(IDCT5,,WA)
         FETCH    (DCT6,R4,BA),(IDCT6,,WA)
         FETCH    (DCT7,R4,HA),(IDCT7,,WA)
         LW,X5    IDCT7
         SLS,X5   1                 CHANGE IDWORID TO WORID
         STW,X5   IDCT7
         FETCH    (DCT8,R4,WA),(IDCT8,,WA)
         FETCH    (DCT9,R4,WA),(IDCT9,,WA)
         FETCH    (DCT10,R4,HA),(IDCT10,,WA)
         FETCH    (DCT11,R4,WA),(IDCT11,,WA)
         FETCH    (DCT12,R4,WA),(IDCT12,,WA)
         FORMAT   START,(TAB,TAD1),(HEX,DCTINDEX,2)
         FORMAT   (TAB,TAD2),(HEX,IDCT1P,3)
         FORMAT   (TAB,TAD3),(HEX,IDCT1A,3)
         FORMAT   (TAB,TAD4),(HEX,IDCT2,3)
         FORMAT   (TAB,TAD5),(HEX,IDCT3,2)
         FORMAT   (TAB,TAD6),(EBC,IDCT16,2)
         FORMAT   (TAB,TAD7),(HEX,IDCT5,2)
         FORMAT   (TAB,TAD8),(HEX,IDCT6,2)
         FORMAT   (TAB,TAD9),(HEX,IDCT7,5)
         FORMAT   (TAB,TAD10),(HEX,IDCT8,5)
         FORMAT   (TAB,TAD11),(HEX,IDCT9,5)
         FORMAT   (TAB,TAD12),(HEX,IDCT10,4)
         FORMAT   (TAB,TAD13),(HEX,IDCT11,8)
         FORMAT   (TAB,TAD14),(HEX,IDCT12,8)
         FORMAT   (TAB,TAD15),' '
         FORMAT   PRINT,END
         AI,X4    1                 INCREMENT TO NEXT DCT
         MTW,-1   DCTSIZE           TEST FOR END
         BGZ      DCTLOOP           MORE TO GO YET.....
         PAGE
         LI,R1    DCTMSG1           SECOND TITLE LINE
         BAL,R0   TITEL             OUTPUT....
*
*        NOW THE ADDITIONAL DCT TABLES GO OUT
*
         FORMAT   START,(SKIP,2),(TAB,TAD01),'#',(TAB,TAD02),'13'
         FORMAT   (TAB,TAD04),'14',(TAB,TAD05),'15',(TAB,TAD06),'17'
         FORMAT   (TAB,TAD07),'18',(TAB,TAD08),'19',(TAB,TAD09),'20'
         FORMAT   (TAB,TAD010),'21',(TAB,TAD011),'22'
         FORMAT   (TAB,TAD012),'23',(TAB,TAD013),'24'
         FORMAT   (TAB,TAD014),'25',(TAB,TAD015),' ',PRINT
         FORMAT   (TAB,TAD01),'#',(TAB,TAD02),'TDV  DBL-WORD'
         FORMAT   (TAB,TAD04),'CHAN',(TAB,TAD05),'PRE-'
         FORMAT   (TAB,TAD06),'HAND',(TAB,TAD07),'TIME'
         FORMAT   (TAB,TAD08),'SIO',(TAB,TAD09),'TDV'
         FORMAT   (TAB,TAD010),'TIO',(TAB,TAD011),'DISC'
         FORMAT   (TAB,TAD012),'HGP',(TAB,TAD013),'RMA'
         FORMAT   (TAB,TAD014),'SIO',(TAB,TAD015),' '
         FORMAT   PRINT
*
*
         FORMAT   (TAB,TAD01),' ',(TAB,TAD02),'   STATUS'
         FORMAT   (TAB,TAD04),'FLINK',(TAB,TAD05),'EMPT'
         FORMAT   (TAB,TAD06),'CODES',(TAB,TAD07),'INCR'
         FORMAT   (TAB,TAD08),'CC',(TAB,TAD09),'CC'
         FORMAT   (TAB,TAD010),'STATUS',(TAB,TAD011),'FLAG'
         FORMAT   (TAB,TAD012),'DISP',(TAB,TAD013),'FLGS'
         FORMAT   (TAB,TAD014),'COUNTER',(TAB,TAD015),' '
         FORMAT   PRINT
*
*
         FORMAT   (SKIP,2),PRINT,END
*
*
         LI,R4    0                 INITIAL INDEX INTO TABLES
         LI,R5    DCTSIZ+1          SIZE OF DISPLAY
         STW,R5   DCTSIZE           INITILIZE CELL
DCTLOOP1 EQU      %
         STW,R4   DCTINDEX          REMEMBER ROW WE ARE ON
         FETCH    (DCT13,R4,DA),(IDCT13,,DA)
         FETCH    (DCT14,R4,BA),(IDCT14,,WA)
         FETCH    (DCT15,R4,BA),(IDCT15,,WA)
         FETCH    (DCT17,R4,HA),(IDCT17,,WA)
         FETCH    (DCT18,R4,BA),(IDCT18,,WA)
         FETCH    (DCT19,R4,BA),(IDCT19,,WA)
         FETCH    (DCT20,R4,BA),(IDCT20,,WA)
         FETCH    (DCT21,R4,HA),(IDCT21,,WA)
         FETCH    (DCT22,R4,BA),(IDCT22,,WA)
         FETCH    (DCT23,R4,HA),(IDCT23,,WA)
         FETCH    (DCT24,R4,BA),(IDCT24,,WA)
         FETCH    (DCT25,R4,WA),(IDCT25,,WA)
*
         FORMAT   START,(TAB,TAD01),(HEX,DCTINDEX,2)
         FORMAT (TAB,TAD02),(HEX,IDCT13,8),(TAB,TAD03),(HEX,IDCT13+1,8)
         FORMAT   (TAB,TAD04),(HEX,IDCT14,2)
         FORMAT   (TAB,TAD05),(HEX,IDCT15,2)
         FORMAT   (TAB,TAD06),(HEX,IDCT17,4)
         FORMAT   (TAB,TAD07),(HEX,IDCT18,2)
         FORMAT   (TAB,TAD08),(HEX,IDCT19,2)
         FORMAT   (TAB,TAD09),(HEX,IDCT20,2)
         FORMAT   (TAB,TAD010),(HEX,IDCT21,4)
         FORMAT   (TAB,TAD011),(HEX,IDCT22,2)
         FORMAT   (TAB,TAD012),(HEX,IDCT23,4)
         FORMAT   (TAB,TAD013),(HEX,IDCT24,2)
         FORMAT   (TAB,TAD014),(HEX,IDCT25,8)
         FORMAT   PRINT,END
         AI,R4    1
         MTW,-1   DCTSIZE           NEXT POSITION
         BGZ      DCTLOOP1          KEEP GOING
         PULL     R1
         B        0,R1              RETURN TO MAIN ANALYZE....
         REF      DCTMSG1
         PAGE
******************************
CITS     SUBRTINE 'CITS'
******************************
         PUSH     R1                SAVE LINK
         BAL,R0   BL:BUF            BLANK PRINT LINE
         LI,1     CITSMSG           SEND
         BAL,0    TITEL             TITLE LINE OUT
         FORMAT   START,(SKIP,2)
         FORMAT   (TAB,5),'CHANNEL INFORMATION',PRINT,(SKIP,3)               A00
         FORMAT   (TAB,5),' #  1  2  3  4  5  6',PRINT                       A00
         FORMAT   PRINT,(SKIP,3),END
         LI,X4    0                 STARTING AT ZERO                         A00
CITLOOP  EQU      %                                                          A00
         STW,R4   ICITNUM           SAVE VERTICAL ROW NUMBER
         FETCH    (CIT1,R4,BA),ICIT1
         FETCH    (CIT2,R4,BA),ICIT2
         FETCH    (CIT3,R4,BA),ICIT3
         FETCH    (CIT4,R4,BA),ICIT4
         FETCH    (CIT5,R4,BA),ICIT5
         FETCH    (CIT6,R4,BA),ICIT6
         FORMAT START,(TAB,5),(HEX,ICITNUM,2),END
 FORMAT START,(TAB,8),(HEX,ICIT1,2),1 OTHERWISE CONTINUE ICIT'S
         FORMAT   (HEX,ICIT2,2),1,(HEX,ICIT3,2),1
         FORMAT   (HEX,ICIT4,2),1,(HEX,ICIT5,2),1
         FORMAT   (HEX,ICIT6,2),PRINT,END                                    A00
         REF      CITSIZ                                                     A00
         AI,X4    1                 TO NEXT                                  A00
         CI,R4    CITSIZ            COULD BE LARGER
         BLE      CITLOOP           LOOP IF SO
         PULL     R1
         B        0,R1
         PAGE
************************************
IOQS     SUBRTINE 'IOQS'
************************************
         PUSH     L1
         LI,R1    IOQSMSG
         BAL,0    TITEL             TITLE LINE
         FORMAT   START,(SKIP,2)
         FORMAT   (TAB,7),'1   2',(TAB,23),'7    3  4  5  6'
         FORMAT   (TAB,43),'6',(TAB,52),'8     9  10  11',(TAB,74)
        FORMAT   '12 13<--',(TAB,89),'-->13   14  15',PRINT
         FORMAT   ' #  BAK FWD  DCT# & MNE STAT FCN CODS DCBAD '
         FORMAT   '   BUF/TIM/CDW NRA NRT   RAD AD'
        FORMAT   ' E A ADR  E A INFO PRIO USER'
         FORMAT   PRINT,(SKIP,3),END
*
*        SINCE THERE DOES NOT SEEM TO BE ANY STRAIGHT FORWARD WAY OF
*        OBTAINING THE LENGTH OF THE IOQ TABLES, USE DIFF IN ADRSS
*        BETWEEN IOQ8 AND IOQ9.
*
         LI,R9    IOQ9              TOP OF IOQ8
         AI,R9    -IOQ8             CALCULATE SIZE OF IOQ TABLES
         AND,R9   #RFF              LIMIT TO 255 IN CASE SYSGEN PUKED...
         STW,A9   IIOQMAX
         LI,4     0
IIOQLOOP STW,X4   IIOQNUM
         FETCH    (IOQ1,R4,BA),IIOQ1
         FETCH    (IOQ2,R4,BA),IIOQ2
         FETCH    (IOQ7,R4,BA),IIOQ7
         LW,X5    IIOQ7
         FETCH    (DCT16,R5,DA),(IDCT16,,DA)
         LI,R9    ' '               BLANK OUT COUNT OF TEXTC                 A00
         STB,R9   IDCT16                                                     A00
         FETCH    (IOQ3,R4,BA),IIOQ3
         FETCH    (IOQ4,R4,BA),IIOQ4
         FETCH    (IOQ5,R4,BA),IIOQ5
         FETCH    (IOQ6,R4,BA),IIOQ6
         FETCH    (IOQ8,R4,WA),IIOQ8
         FETCH    (IOQ9,R4,WA),IIOQ9
         FETCH    (IOQ10,R4,BA),IIOQ10
         FETCH    (IOQ11,R4,BA),IIOQ11
         FETCH    (IOQ12,R4,WA),IIOQ12
         FETCH    (IOQ13,R4,DA),(IIOQ13,,DA)
         FETCH    (IOQ14,R4,BA),IIOQ14
         FETCH    (IOQ15,R4,BA),IIOQ15
         LB,A8    IIOQ6             SEPARATE OUT FCN CODE SINCE HEX FORM
         STW,A8   IIOQ6FCN            REQUIRES RIGHT ADJUSTED WD
         FORMAT   START,(HEX,IIOQNUM,2),3,(HEX,IIOQ1,2)
         FORMAT   2,(HEX,IIOQ2,2),2
         FORMAT (HEX,IIOQ7,2),(EBC,IDCT16,8),3,(HEX,IIOQ3,2),1
         FORMAT   (HEX,IIOQ4,2),1,(HEX,IIOQ5,2),1,(HEX,IIOQ6FCN,2),1
         FORMAT   (HEX,IIOQ6,5),1,(HEX,IIOQ8,8),2,(HEX,IIOQ9,4),2
         FORMAT   (HEX,IIOQ10,2),2,(HEX,IIOQ11,2),1,(HEX,IIOQ12,8),1
         FORMAT   (HEX,IIOQ13,8),1,(HEX,IIOQ13+1,8),3,(HEX,IIOQ14,2),2
         FORMAT   (HEX,IIOQ15,2)
         FORMAT   PRINT,END
         AI,X4    1
         CW,X4    IIOQMAX
         BLE      IIOQLOOP          DO TILL 0
         PULL     L1
         B        0,L1
 TITLE '*** SYMBIONT TABLES DUMPER ***'
************************************
SYMTABLS SUBRTINE 'SYMTABLS'
************************************
         PUSH     L1
         LI,R12   SNDDX
         BAL,R1   SVALCON           GET CONTENTS
         LB,R8    R15               LENGTH OF SYMBIONT TABLES
         AI,R8    1                 PLUS ONE FOR SAM KEYS.....
         STW,R8   ISYMMAX           SAVE LOOP VALUE
         LI,R1    SYMTMSG
         BAL,0    TITEL
         LI,R8    0
         STW,R8   CPOOL             ZAP OLD ENTRIES
AS1      EQU      7     INDEX TO    SQUE                                     A00
AS2      EQU      12                SNDDX                                    A00
AS2A     EQU      18                DCT16                                    A00
AS3      EQU      26                SSTAT                                    A00
AS4      EQU      34                SSIG                                     A00
AS5      EQU      40                SRET                                     A00
AS6      EQU      51                SCNTXT                                   A00
AS7      EQU      59                SYMX                                     A00
AS8      EQU      15                SQHD                                     A00
AS9      EQU      27                SQTL                                     A00
ASA      EQU      65                STB:TYP                                  A00
ASB      EQU      70                STB:LNK                                  A00
ASC      EQU      76                STH:FLG                                  A00
ASD      EQU      83                STH:SUS                                  A00
ASE      EQU      90                STB:Q                                    A00
         REF      MXSTRM                                                     A00
         LI,R0    MXSTRM                                                     A00
         STW,R0   ISMXSTRM                                                   A00
         FORMAT   START,1,'#',(TAB,AS1),'SQUE'
         FORMAT   (TAB,AS2),'SNDDX&TYPE',(TAB,AS3)
         FORMAT   'SSTAT',(TAB,AS4),'SSIG',(TAB,AS5),'SRET'
         FORMAT   (TAB,AS6),'SCNTXT',(TAB,AS7),'SYMX'
         FORMAT   (TAB,ASA),'TYP',(TAB,ASB),'LNK',(TAB,ASC),'FLAG'           A00
         FORMAT   (TAB,ASD),'SUSP',(TAB,ASE),'QUE'                           A00
         FORMAT   PRINT
         FORMAT   1,'--',(TAB,AS1),'----',(TAB,AS2),'----------'
         FORMAT   (TAB,AS3),'-----',(TAB,AS4),'----',(TAB,AS5)
         FORMAT   '--------',(TAB,AS6),'------',(TAB,AS7)
         FORMAT   '----',(TAB,ASA),'---',(TAB,ASB),'---'                     A00
         FORMAT   (TAB,ASC),'----',(TAB,ASD),'----'                          A00
         FORMAT   (TAB,ASE),'---',PRINT,END                                  A00
         LI,R4    0                 INITIAL INDEX
SYMLOOP  STW,X4   ISYMNUM
         FETCH    (SQUE,R4,BA),ISQUE
         FETCH    (SNDDX,R4,BA),ISNDDX
         LW,R5    ISNDDX            GET CURRENT INDEX VALUE
         FETCH    (DCT16,R5,DA),(IDCT16,,DA)
         LI,R9    C' '                                                       A00
         STB,R9   IDCT16                                                     A00
         FETCH    (SSTAT,R4,BA),ISSTAT
         FETCH    (SSIG,R4,BA),ISSIG
         LW,R5    ISSIG
         SLS,R5   24
         STW,R5   ISSIG
         FETCH    (SRET,R4,WA),ISRET
         FETCH    (SCNTXT,R4,HA),ISCNTXT
         LW,X5    ISCNTXT           CHANGE FROM DOUBLEWORD
         BEZ      NO:POOL           NONE ASSIGNED
         LH,R3    CPOOL             GET CURRENT INDEX
         AI,R3    1                 INCREMENT
         STH,R5   CPOOL,R3          STORE DWD
         STH,R3   CPOOL             STORE INDEX
         SLS,R5   1                 MAKE WA
         STW,R5   ISCNTXT           FOR DISPLAY
NO:POOL  EQU      %
         FETCH    (SYMX,R4,BA),ISYMX
         MTW,0    ISMXSTRM                                                   A00
         BLEZ     DO%FORMATS                                                 A00
         FETCH    (STB:TYP,R4,BA),ISTYP
         FETCH    (STB:LNK,R4,BA),ISLNK
         FETCH    (STH:FLG,R4,HA),ISFLG
         FETCH    (STH:SUS,R4,HA),ISSUS
         FETCH    (STB:Q,R4,BA),ISQ
DO%FORMATS  EQU   %                                                          A00
         FORMAT START,1,(HEX,ISYMNUM,2)
         FORMAT   (TAB,AS1),(HEX,ISQUE,2)
         FORMAT   (TAB,AS2),(HEX,ISNDDX,2)
         FORMAT   (EBC,IDCT16,8)
         FORMAT   (TAB,AS3),(HEX,ISSTAT,2)
         FORMAT (TAB,AS4),(EBC,ISSIG,1),'=',END
         LW,9     ISSIG
         SLS,9    -24
         STW,9    ISSIG
         FORMAT START,(TAB,AS4+2),(HEX,ISSIG,2)
         FORMAT   (TAB,AS5),(HEX,ISRET,8)
         FORMAT   (TAB,AS6),(HEX,ISCNTXT,5)
         FORMAT   (TAB,AS7),(HEX,ISYMX,2),END
         MTW,0    ISMXSTRM                                                   A00
         BLEZ     SYMPRINT                                                   A00
         FORMAT   START,(TAB,ASA+1),(HEX,ISTYP,2),(TAB,ASB+1)                A00
         FORMAT   (HEX,ISLNK,2),(TAB,ASC),(HEX,ISFLG,4)                      A00
         FORMAT   (TAB,ASD),(HEX,ISSUS,4),(TAB,ASE+1),(HEX,ISQ,2)            A00
         FORMAT   END                                                        A00
SYMPRINT FORMAT   START,PRINT,END
         AI,X4    1
         CW,X4    ISYMMAX
         BLE      SYMLOOP
         FORMAT   START,(SKIP,2),(TAB,AS8),'SQHD',(TAB,AS9),'SQTL'           A00
         FORMAT   PRINT,(TAB,AS8),'--------',(TAB,AS9),'--------'            A00
         FORMAT   PRINT,END                                                  A00
         SVALCON  (SQHD,ISQHD)
         SVALCON  (SQTL,ISQTL)
         FORMAT   START,(TAB,AS8),(HEX,ISQHD,8)                              A00
         FORMAT   (TAB,AS9),(HEX,ISQTL,8),PRINT,END                          A00
         REF      DUMPSOME
         MTH,0    CPOOL             WERE ANY CPOOLS FOUND
         BEZ      SYMRET            NOPE
         CAL1,1   EJECTFPT          YES,OUTPUT NEW PAGE
         FORMAT   START,(TAB,5),'***ASSIGNED CPOOLS'
         FORMAT   PRINT,(SKIP,3),END
         REF      GETADDR,SCFBUF                                             A00
         LI,R4    2                 TWO PASSES
NXT:PL   LH,R5    CPOOL             GET ENTRY COUNT
NXT:PL1  LH,R14   CPOOL,R5          GET ENTRY ADDRS
         AND,R14  #R16              CLEAN UP SIGN EXTENSION
         BEZ      NXT:PL2           GO TO NEXT IF ZERO
         SLS,R14  1                 MAKE IT WA
         BAL,R0   GETADDR           GET ITS PAGE IN
         LW,R8    R15               SET UP DUMP LIMITS
         CI,R4    2                 IS THIS THE SPOOL PASS
         BNE      NXT:PL15          NOPE
         AI,R15   SCFBUF            POINT TO SPOOL SLOT                      A00
         LW,R14   *R15              GET SPOOL ADDRS
         AND,R14  =X'7FFFFF'
         CI,R14   X'E0000'          IS A BA
         BAZ      %+2               NO
         SLS,R14  -2                YES - MAKE A WA OUT OF IT
         SLS,R14  -1                TO DBL WA
         STH,R14  CPOOL,R5          INSERT INTO TABLE
NXT:PL15 LI,R7    40                CPOOL SIZE IN WORDS
         CI,R4    2                 CORRECT
         BE       %+2               YEP
         LI,R7    256               NOPE,SPOOL LIMITS
         BAL,R0   DUMPSOME          DUMP IT
         FORMAT   START,(SKIP,2),PRINT,END
NXT:PL2  BDR,R5   NXT:PL1           DO NEXT ONE
         CI,R4    1                 AT END
         BLE      NXT:PL3           YES
         FORMAT   START,(SKIP,3),(TAB,5),'***AND THEIR SPOOLS'
         FORMAT   PRINT,(SKIP,3),END
         BDR,R4   NXT:PL            DO SPOOLS NOW
NXT:PL3  EQU      %
SYMRET   PULL     L1
         B        0,L1
         TITLE    '*** ERROR LOG DISPLAY ***'                                A00
*        THIS ROUTINE DUMPS THE IN-CORE ERROR LOG BUFFERS                    A00
*                                                                            A00
         REF      CURBUF,BUF1,BUF2                                           A00
ERROR%LOG  EQU    %                                                          A00
         PSW,R1   STACK                                                      A00
         LI,R1    ELOG%HDG1                                                  A00
         BAL,R0   TITEL                                                      A00
         LI,R1    ELOG%HDG2                                                  A00
         BAL,R0   MSG                                                        A00
         BAL,R0   BUFOUT                                                     A00
         BAL,R0   BL:BUF
         FORMAT   START,(SKIP,3),(TAB,1),'CORE'                              A00
         FORMAT   PRINT,(TAB,1),'ADDR',PRINT,END                             A00
         LI,R14   CURBUF            ERR LOG CORE ADDR                        A00
         BAL,R0   GETADDR                                                    A00
         LW,R4    *R15                                                       A00
         AND,R4   ADMASK            MASK TO 17 BITS WORTH
         CW,R4    EBUF1             SEE IF BUF1 OR BUF2 WAS CURRENT          A00
         BE       BUF%ORDER%OK                                               A00
         XW,R4    EBUF1             EBUF1 TO CONTAIN CURRENT                 A00
         STW,R4   EBUF2                                                      A00
BUF%ORDER%OK  EQU  %                                                         A00
         LW,R14   EBUF1                                                      A00
         STW,R14  RC%BUF                                                     A00
         BAL,R0   SCAN%BUF                                                   A00
         BAL,R0   PRT%BUF                                                    A00
         LW,R14   EBUF2                                                      A00
         STW,R14  RC%BUF                                                     A00
         BAL,R0   SCAN%BUF                                                   A00
         BAL,R0   PRT%BUF                                                    A00
         PLW,R0   STACK                                                      A00
         B        *R0               ALL DONE                                 A00
SCAN%BUF EQU      %                                                          A00
         PSW,R0   STACK                                                      A00
         BAL,R0   GETADDR           BUF ADR ALREADY INR14                    A00
         LI,R4    0                                                          A00
         LI,R1    2                 INITIALIZE INBUF PTR                     A00
         MTW,0    *R15,R1           NO. OF BUF WDS USED                      A00
         BGZ      GET%EPTRS                                                  A00
         LI,R1    0                                                          A00
         STW,R1   E%CNT                                                      A00
         B        NO%MORE                                                    A00
GET%EPTRS EQU     %                                                          A00
         LI,R2    0                                                          A00
         LI,R1    -2                                                         A00
         LW,R1    *R15,R1           PTR TO 1ST UNUSED WD IN THIS BUFR        A00
         SW,R1    RC%BUF            WD DISP IN BUF TO 1ST UNUSED             A00
         BLEZ     E%LOG%ERR         ERROR***********
         LI,R3    3                 INITIALIZE ENTRY PTR                     A00
         LI,R4    1                 INITIALIZE SAVE PTR                      A00
         STB,R3   E%PTRS            WE KNOW ABOUT THE 1ST ENTRY              A00
         STW,R4   E%CNT             INITIALIZE CNTR                          A00
PTR%LOOP EQU      %                                                          A00
         LW,R6    R3                BUF PTR                                  A00
         SLS,R6   1                 MAKE HW DISP INDEX                       A00
         LH,R6    *R15,R6           GET ENTRY SIZE                           A00
         AND,R6   #RFF              MASK TO BYTES WORTH
         AW,R3    R6                BUMP BUF PTRS                            A00
         CW,R3    R1                R1 IS 1ST UNUSED WORD                    A00
         BGE      ELAST             NO MORE IN THIS BUF                      A00
         STB,R3   E%PTRS,R4         SAVE OFFSET                              A00
         AI,R4    1                                                          A00
         CI,R4    X'21'             MAX ENTRIES IN 1 BUF                     A00
         BG       E%LOG%ERR         CAN'T BE SO MANY ENTRIES                 A00
         B        PTR%LOOP                                                   A00
E%LOG%ERR  EQU    %                                                          A00
         LI,R1    E%ERR%MSG                                                  A00
         BAL,R0   MSG                                                        A00
         BAL,R0   BUFOUT                                                     A00
         B        NO%MORE           FOR THIS BUFFER, AT LEAST                A00
ELAST    EQU      %                                                          A00
         STB,R1   E%PTRS,R4                                                  A00
NO%MORE  EQU      %                                                          A00
         STW,R4   E%CNT                                                      A00
         PLW,R0   STACK                                                      A00
         B        *R0               RETURN TO 'BUF%ORDER%OK'                 A00
*                                                                            A00
*                                                                            A00
PRT%BUF  EQU      %                 PRINT OUT THE BUFFER NOW                 A00
         PSW,R0   STACK                                                      A00
         MTW,-1   E%CNT             START USING AS DYNAMIC COUNTER           A00
         BLEZ     PRT%NO%MORE                                                A00
E%PRT%LOOP  EQU   %                                                          A00
         LW,R1    E%CNT             GET INDEX PTR                            A00
         LB,R8    E%PTRS,R1         GET ENTRY OFFSET                         A00
         LW,R14   RC%BUF            REAL ADDR OF CURR BUFFER                 A00
         AW,R14   R8                ADD DISP TO CURRENT ENTRY                A00
         BAL,R0   GETADDR                                                    A00
         LW,R8    R15               ADR OF CURR ENTRY IN OUR BUF             A00
         LI,R2    1                                                          A00
         LB,R7    *R8,R2            GET COUNT                                A00
         REF      BLANK1
         BAL,R0   BLANK1
         BAL,R0   DUMPSOME          DUMP OUT BUFFER
         BAL,R0   BLANK1
         MTW,-1   E%CNT             BUMP CTR                                 A00
         BGEZ     E%PRT%LOOP                                                 A00
PRT%NO%MORE  EQU  %                                                          A00
         PLW,R0   STACK                                                      A00
         B        *R0                                                        A00
*                                                                            A00
         REF      ELOG%HDG1
ELOG%HDG2 TEXTC   '(MOST RECENT ENTRY FIRST)'                                A00
E%ERR%MSG TEXTC   '''NEXT ENTRY'' PTR CLOBBERED - ',;                        A00
                  'INTEGRITY OF SUBSEQUENT DATA DOUBTFUL'                    A00
         TITLE    'RESOURCE ALLOCATION TABLE ROUTINE'                        A00
*                                                                            A00
*        THIS ROUTINE OUTPUTS A FORMATTED DISPLAY OF THE                     A00
*        RESOURCE ALLOCATION TABLES (RAT TABLES)                             A00
*                                                                            A00
         DEF      RAT%TABLES                                                 A00
RAT%TABLES  EQU   %                                                          A00
         PSW,R1   STACK                                                      A00
         LI,R1    RATMSG                                                     A00
         BAL,R0   TITEL                                                      A00
         LI,R1    SV:RSIZ           RAT TABLE SIZE                           A00
         STW,R1   RAT%SIZ           SAVE IT                                  A00
         FORMAT   START,(SKIP,2)                                             A00
         FORMAT   (TAB,28),'CURRENT',(TAB,48),'DEFAULT',(TAB,67),;           A00
                  'AVAILABLE',(TAB,88),'MAXIMUM',PRINT                       A00
         FORMAT (TAB,4),'NAME  TYPE TOTAL   BATCH ONLINE GHOST  ',;     X    A00
            'BATCH ONLINE GHOST  BATCH ONLINE GHOST  BATCH ONLINE GHOST'X    A00
         FORMAT   PRINT,(TAB,4),S:PT(D(4),' ',D(5),' ',D(5),'   ',;          A00
               D(5),' ',D(6),' ',D(5),'  ',D(5),' ',D(6),' ',;               A00
               D(5),'  ',D(5),' ',D(6),' ',D(5),'  ',D(5),' ',;              A00
               D(6),' ',D(5)),PRINT,(SKIP,1),END                             A00
         LI,X4    1                                                          A00
RAT%LOOP EQU      %                                                          A00
         FETCH    (ARAT(1),X4,HA),(IRAT(1),,WA)                              A00
         FETCH    (ARAT(2),X4,BA),(IRAT(2),,WA)                              A00
         FETCH    (ARAT(3),X4,HA),(IRAT(3),,WA)   SH:RTOT                    A00
I        DO       3                                                          A00
         FETCH    (ARAT(I+3),X4,HA),(IRAT(I+3),,WA)                          A00
         FETCH    (ARAT(I+6),X4,BA),(IRAT(I+6),,WA) DEFAULT                  A00
         FETCH    (ARAT(I+9),X4,HA),(IRAT(I+9),,WA) AVAILABLE                A00
         FETCH    (ARAT(I+12),X4,BA),(IRAT(I+12),,WA) MAXIMUM                A00
         FIN                                                                 A00
         FORMAT   START,(TAB,5),(EBC,(IRAT(1),2),2),3,(HEX,IRAT(2),2),4      A00
         FORMAT   (HEX,IRAT(3),4),4                                          A00
         FORMAT   (HEX,IRAT(4),4),2,(HEX,IRAT(5),4),2,(HEX,IRAT(6),4),5      A00
         FORMAT   (HEX,IRAT(7),2),4,(HEX,IRAT(8),2),4,(HEX,IRAT(9),2),5      A00
         FORMAT (HEX,IRAT(10),4),2,(HEX,IRAT(11),4),2,(HEX,IRAT(12),4),5     A00
         FORMAT   (HEX,IRAT(13),2),4,(HEX,IRAT(14),2),4,(HEX,IRAT(15),2)     A00
         FORMAT   PRINT,END                                                  A00
         AI,X4    1                 BUMP COUNTER                             A00
         MTW,-1   RAT%SIZ                                                    A00
         BGZ      RAT%LOOP          DO NEXT ITERATION                        A00
         PLW,R0   STACK                                                      A00
         B        *R0               RETURN                                   A00
         REF      RATMSG
         TITLE    'AVR DISPLAY ROUTINE'                                      A00
*                                                                            A00
*        THIS ROUTINE PUTS OUT A FORMATTED DISPLAY OF THE                    A00
*        AUTOMATIC VOLUME RECOGNITION TABLES.                                A00
*                                                                            A00
         DEF      AVR%TABLES                                                 A00
AVR%TABLES  EQU   %                                                          A00
         PSW,R1   STACK                                                      A00
         LD,R2    CNTS              GET TABLE SIZE INFO                      A00
         STD,R2   CNTRS                                                      A00
         LI,R1    AVR%MSG                                                    A00
         BAL,R0   TITEL                                                      A00
         MTW,0    TP%CNT            TEST IF ANY TAPES                        A00
         BEZ      AVR%DP            NOPE                                     A00
AVR%TAPE EQU      %                                                          A00
         FORMAT   START,(SKIP,3),(TAB,TAVR(1)),'MAGNETIC TAPES',PRINT        A00
         FORMAT   (SKIP,2)                                                   A00
I        DO       NUM(AVRTHDG)                                               A00
         FORMAT   (TAB,TAVR(I)),AVRTHDG(I)                                   A00
         FIN                                                                 A00
         FORMAT   PRINT                                                      A00
I        DO       NUM(AVRTHDG)                                               A00
         FORMAT   (TAB,TAVR(I)),D(TD(I))                                     A00
         FIN                                                                 A00
         FORMAT   PRINT,(SKIP,1),END                                         A00
         LI,X4    -1                                                         A00
AVR%LOOP EQU      %                                                          A00
         AI,X4    1                                                          A00
         FETCH    (ASAVR(1),X4,DA),(ISAVR(1),,DA)                            A00
         LW,R2    ISAVR(1)                                                   A00
         BAL,R5   TEST%0%1%M1       IS R2=0,1,OR-1                           A00
         STW,R2   ISAVR(1)                                                   A00
         LW,R2    ISAVR(2)                                                   A00
         SLS,R2   8                                                          A00
         SLD,R2   -24                                                        A00
         SLS,R3   -16                                                        A00
         STW,R3   ISAVR(11)                                                  A00
         STW,R2   ISAVR(10)                                                  A00
         FETCH    (ASAVR(12),X4,HA),(ISAVR(12),,WA)                          A00
         FETCH    (ASAVR(13),X4,BA),(ISAVR(13),,WA)                          A00
         FETCH    (ASAVR(14),X4,HA),(ISAVR(14),,WA)                          A00
         LB,R2    ISAVR(2)          PICK OFF FLAG BITS                       A00
         LI,R1    8                                                          A00
BLOOP    EQU      %                                                          A00
         LI,R3    1                 A ONE BIT MASK                           A00
         AND,R3   R2                SELECT A FLAG BIT                        A00
         STW,R3   ISAVR(2)-1,R1     DISTRIBUTE FLAGS FOR FORMATTING          A00
         SLS,R2   -1                SET UP TO SELECT NEXT FLAG BIT           A00
         BDR,R1   BLOOP                                                      A00
         FORMAT   START,(TAB,TAVR(1)),(EBC,ISAVR(1),4)                       A00
         FORMAT   (TAB,TAVR(2)+1),(HEX,ISAVR(2),1),END                       A00
         MTW,0    TP%CNTR           DOING TAPE TABLE                         A00
         BLEZ     DO%PK1            NO                                       A00
         FORMAT   START,(TAB,TAVR(3)+1),(HEX,ISAVR(3),1)                     A00
         FORMAT   (TAB,TAVR(9)+1),(HEX,ISAVR(9),1),END                       A00
DO%PK1   EQU      %                                                          A00
         FORMAT   START,(TAB,TAVR(4)+1),(HEX,ISAVR(4),1)                     A00
         FORMAT   (TAB,TAVR(5)+1),(HEX,ISAVR(5),1)                           A00
         FORMAT   (TAB,TAVR(6)+1),(HEX,ISAVR(6),1)                           A00
         FORMAT   (TAB,TAVR(7)+1),(HEX,ISAVR(7),1)                           A00
         FORMAT   (TAB,TAVR(8)+1),(HEX,ISAVR(8),1)                           A00
         FORMAT   (TAB,TAVR(10)),(HEX,ISAVR(10),2)                           A00
         FORMAT   (TAB,TAVR(11)),(HEX,ISAVR(11),4)                           A00
         FORMAT   (TAB,TAVR(12)+1),(HEX,ISAVR(12),3)                         A00
         FORMAT   (TAB,TAVR(13)+2),(HEX,ISAVR(13),2)                         A00
         FORMAT   (TAB,TAVR(14)+3),(HEX,ISAVR(14),4)                         A00
         FORMAT   PRINT,END                                                  A00
         MTW,-1   TP%CNTR           ANY MORE TO TAPE TABLES                  A00
         BGZ      AVR%LOOP          YES                                      A00
         BEZ      AVR%DP            NO                                       A00
         MTW,-1   DP%CNTR           WE'VE BEEN DOING DISK TABLES             A00
         BGZ      AVR%LOOP          DONE YET                                 A00
         PLW,R0   STACK             APPARENTLY                               A00
         B        *R0               RETURN                                   A00
AVR%DP   EQU      %                                                          A00
         FORMAT   START,(SKIP,3),(TAB,TAVR(1)),'DISK PACKS',;                A00
                  PRINT,(SKIP,2)                                             A00
I        DO       NUM(AVRDHDG)                                               A00
         FORMAT   (TAB,TAVR(I)),AVRDHDG(I)                                   A00
         FIN                                                                 A00
         FORMAT   PRINT                                                      A00
I        DO       NUM(AVRDHDG)                                               A00
         FORMAT   (TAB,TAVR(I)),D(DD(I))                                     A00
         FIN                                                                 A00
         FORMAT   PRINT,(SKIP,1),END                                         A00
         B        AVR%LOOP                                                   A00
TEST%0%1%M1  EQU  %                                                          A00
         CI,R2    1                                                          A00
         BNE      NOT%1                                                      A00
         LW,R2    L('   1')                                                  A00
         B        OK%NOW                                                     A00
NOT%1    EQU      %                                                          A00
         CI,R2    0                                                          A00
         BNE      NOT%0                                                      A00
         LW,R2    L('   0')                                                  A00
         B        OK%NOW                                                     A00
NOT%0    EQU      %                                                          A00
         CI,R2    -1                                                         A00
         BNE      OK%NOW                                                     A00
         LW,R2    L('  -1')                                                  A00
OK%NOW   EQU      %                                                          A00
         B        *R5                                                        A00
*                                                                            A00
         REF      AVR%MSG
 TITLE '*** FORMATTING SUBROUTINES ***'
         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,1    BLANKFLG          SHOULD WE BLANK OBUF     (FIRST TIME
         BNEZ     GBUFADRS            NO, GET BUFFER ADRS
         BAL,R0   BL:BUF            BLANK PRINT LINE
GBUFADRS RES      0
         LW,X4    *L1
         BGZ      TABSET              CHECK INDIRECT BIT
         LW,X4    *X4                   GET INDIRECT ADDRESS
         BLEZ     FORMATER            INDIRECT HERE IS ERROR
TABSET   LW,V12   X4                SET STARTING POSN FOR TAB COMND
*
*                 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    AND,X4   #R7FFFF           SCRUB HIGH BITS-IF ANY
         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
         CLM,X6   OPRANGE           WAS OPCODE IN RANGE ?
         BOL      FORMATER            NOPE - SCREAM
         B        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      PUSH     R1                SAVE R1
EBCA1    LB,R6    0,R5              GET A BYTE
         REF      TRANTAB                                                    A00
         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
         PULL     1                 RESTORE R1
         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
         CI,X6    7                 EXACT MULTIPLE OF 7 ?
         BAZ      HEXEXCT           YES-GO
         CI,X6    15                METHOD HANDLES DOUBLEWORD MAX
         BG       FORMATER            FORGET IT
         PUSH     A9
         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
         PULL     A9
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'
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.
         LI,X6    -4                IS ENTIRE WORD PRINTABLE ?
OPXLLOOP LB,X7    A8+1,X6
         CLM,R7   EBCCHAR           IS PRINTABLE
         BCR,9    OPXLCONT          YES,CHECK ALL CHARS
         B        MAYBEOP             NOPE-MAY BE INSTRUCTION
OPXLCONT BIR,X6   OPXLLOOP          CONTINUE
NOTOP    LW,X7    #CBLANKS          OPCODE = WORD OF BLANKS
         B        PLACEOP
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
         AI,X4    4                 BUMP BY # BYTES MOVED
         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
         REF      OPCODES
BIT      MOVE,4   (0,X5),A9         PICK UP 4 BYTES FROM SOURCE
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
MOVE     LI,0     FLOOP             SET RETURN
MOVE1    LB,R6    0,R5
         STB,R6   0,R4
         AD,R4    #D1#D1
         MTB,-1   R5
         BNEZ     MOVE1
         B        *R0               RETURN
TAB      SLS,X5   -24               GET POSITION IN TAB SPEC
         AI,X5    -1
         STW,X5   X4                UPDATE CURRENT POINTER
         AW,X4    V12
         B        FLOOP
SPACE    SAS,X5   -24               BUMP CURRENT POSITION
         AW,X4    X5
         B        FLOOP
END      RES      0
         PULL     6,X4
         B        1,L1
PRINT    LI,R0    PRINTERM          NORMAL RETURN
PRINTBUF EQU      %                 OR HERE WITH R0 SET
         PRINT,%TEXTBSZ  OBUF
         B        *R0
PRINTERM LI,0     PRINTERM1         STRAIGHT THRU
BL:BUF   B        BLNKBUF
         REF      BLNKBUF
PRINTERM1 LW,X4   V12               RESET POINTER
         B        FLOOP
SKIP     AND,X5   #R1F              LIMIT MAX LINE SKIP TO 31
         BAL,R0   PRINTBUF          PRINT SOME BLANKS
         BDR,X5   SKIP
         B        PRINTERM          GO WRAP UP
DECIMAL  RES      0                 BINARY TO DECIMAL CONVERSION
         LB,X6    X5                GET BYTE COUNT OF LINE TO PUT
         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
         DEF      MDTRAPS
         TITLE    'PROCESSING OF INTERRUPT AND TRAP LOCATIONS'
***********************************
MDTRAPS  SUBRTINE 'MDTRAPS'
***********************************
         PUSH     L1
         LI,R8    0                 SET TO CHECK AND
         STW,A8   ZAPFLAG             SAVE TO CHECK ALL PRINTED
         BAL,0    BL:BUF
         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',END
         CALL     BTMTRUNC          PRINT CONDITIONALLY
         FORMAT   START,' LOC    OF LOC   BY THIS TRAP',6
 FORMAT 'OF TRAPPED CELL   '
 FORMAT 'RECEIVER '
 FORMAT 'HANDLER    IS',END
         CALL     BTMTRUNC          PRINT CONDITIONALLY
         FORMAT   START,' ------ -------- -----------------'
         FORMAT   ' -----------------'
         FORMAT   ' -------- --------'
         FORMAT   '   ---------------',END
         CALL     BTMTRUNC          PRINT CONDITIONALLY
         FORMAT   START,SKIP,END
         LI,X4    X'40'
         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
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
         REF      USER,LOOKING
         STW,R8   LOOKING
         CI,R9    X'0040'           WAS IT A MAPPED TRAP                     A00
         BAZ      NOTMAPPED         NOPE                                     A00
         REF      JOVVPA                                                     A00
         CI,R8    JOVVPA            IS IT ONE TO ONE MAP                     A00
         BL       NOTMAPPED         YES                                      A00
         LI,R14   S:CUN             GET CURRENT USER'S                       A00
         BAL,R0   GETADDR           # SO WE                                  A00
         LW,R2    *R15              CAN MAP LIKE HIM                         A00
         BLEZ     NOTMAPPED         NONE OR ERROR
         STW,R2   USER
         BAL,R0   MAP:USER          DO IT                                    A00
NOTMAPPED    EQU  %                                                          A00
         SVALCON  (A8,LOCTRAPD,(ERR,OUTCORE))  PRINT LOC IF IN CORE
         FORMAT   START,(TAB,36),(HEX,LOCTRAPD,8),2,(OP,LOCTRAPD),END
INTPRIN,OUTCORE FORMAT START,(TAB,5),(HEX,TRAPLOC,3),1,(HEX,TRAPCONT,8),1
         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   END
         CALL     BTMTRUNC          PRINT CONDITIONALLY
NEXTTRAP BAL,R0   UNMAP             UNMAP PRIOR TO NEXT ONE                  A00
         MTW,1    TRAPLOC           BUMP TO NEXT ONE                         A00
         LW,R2    TRAPLOC           CURRENT TRAP LOCATION
         REF      MONORG
         CI,R2    MONORG            AT TOP YET
         BNE      INTRLOOP
         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
         PRINT    '*** INTERRUPT TABLES DESTROYED'
         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
****************************************
BTMTRUNC SUBRTINE 'BTMTRUNC'
****************************************
         PUSH     8,L1
NOTONLIN FORMAT   START,PRINT,END
         PULL     8,L1
         B        0,L1
         DEF      MDDCB
         TITLE '*** DCB SUBROUTINE ***'
         PAGE
*
*        DRIVE DISPLAY OF RESOURCE WAIT LISTS
*
*        REGISTER ASSIGNMENTS:
*
*        R1:      INTERNAL LINK
*        R2:      USER NUMBER
*        R3:      USED FOR DISPLAYING USER NUMBER
*        R4:      RESOURCE LIST NUMBER
*        R5:      USER'S ACTUAL STATE
*
*
         USECT    %SECT1            GENERATE PROCEDURE
MD:SUBQ  EQU      %
         PSW,R1   STACK             SAVE RETURN LINK TO ANALYZE
         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,R4,BA),(R5,,WA)  **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    128               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
         CW,R2    R3                DOES FLINK POINT TO HERE
         BE       R:SUBQ36          YEP - ITS THE END OF THE LIST
         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
         BAL,R0   BLNKBUF
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'
HDMSG    TEXTC    'HEAD'
*
*
R:SMSG   EQU      %
         TEXTC    'R:SYMF'
         TEXTC    'R:SYMD'
         TEXTC    'R:OCR '
         TEXTC    'R:CBA '
         TEXTC    'R:DPA '
         TEXTC    'R:QFAC'
         TEXTC    'R:NQW '
*************************************
         REF      R:STITLE
ASTERISK TEXTC    '*'
ARROW    TEXTC    ' > '
         PAGE
*
*
TB0      EQU      0
TB2      EQU      6
TB3      EQU      16
TB4      EQU      24
TB4A     EQU      6                 W/C FOR TB4
TB5      EQU      48
TB5A     EQU      12
TB6      EQU      72
TB6A     EQU      18
************************************
MDDCB    SUBRTINE 'MDDCB'
************************************
         PUSH     8,L1
         LW,R4    USER              GET USER NUMBER
         STW,R4   USRCNT            SAVED...
         REF      SPECIFIC%USER%DCBS                                         A00
         MTW,0    SPECIFIC%USER%DCBS                                         A00
         BNEZ     NOT%ALL           ONLY DO ONE USER                         A00
         LI,R4    SMUIS                                                      A00
USRCNT%  EQU      USRCNT            SAME SYM USED IN TWO MODULES             A00
         STW,R4   USRCNT            SET UP LOOP                              A00
         LI,R1    USMSG                                                      A00
         BAL,R0   TITEL                                                      A00
NOT%ALL  EQU      %                                                          A00
         BAL,R0   BL:BUF                                                     A00
USRLOOP  LW,R4    USRCNT            GET NEXT INDEX
         STW,R4   PHY:PAGE          SET PHYSICAL FLAG
         LI,R0    0
         STW,R0   MAPFLAG           RESET IT - LEAVE IMAGES
         LI,R14   UH:FLG
         BAL,0    GETADDR
         LW,R4    USRCNT
         LH,R5    *R15,R4           GET USER'S FLAGS
         STW,R5   USFLG             AND SAVE
         CI,R5    X'200'            IS JIT IN CORE
         BAZ      NXTUSR            NOPE,GO TO NEXT USER
         LW,R2    USRCNT            CURRENT USER#
         BAL,R0   LOCJIT            GET HIS JIT
         BCS,4    NXTUSR            NO JIT TO BE HAD
         BCS,8    %+2               ALREADY READ IN NOW
         BAL,R0   GETADDR           GET ITS ADDRESS
         LI,R5    DCBLINK           NOW GET
         LW,R12   *PAGEBUF,R5       GET IT
         STW,R12  LINKPTR           SAVE ADDRESS
         REF      DCBLINK
         REF      MAP:USER,MAPFLAG,LOCJIT
         LW,2     USRCNT            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    *PAGEBUF          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   *PAGEBUF          GET USER'S ACCOUNT#
         STD,R12  USR:ACN#          STORED
         BAL,R0   BLANK1
         LW,R12   LINKPTR
         BAL,R1   SVALCON
         NOP
         FORMAT START,(TAB,TB0),'USER#   ->',(HEX,USRCNT,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   BLNKBUF
         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   BLNKBUF
         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   USRCNT            GO TO NEXT USER #                        A00
         BNEZ     USRLOOP           KEEP GOING TILL ZERO
DCBRET   LI,R0    0                 TURN OFF
         STW,R0   SPECIFIC%USER%DCBS    RESET FLAG BEFORE EXIT               A00
         STW,R0   PHY:PAGE          PHYSICAL ADDRS FLAG
         STW,R0   MAPFLAG           LEAVE MAP IMAGES INTACT
         BAL,R0   BL:BUF            BLANK PRINT LINE
         PULL     8,L1
         B        0,L1
         TITLE    'DCB TABLE  SEARCH ROUTINE - GETS NAME + ADRS'
************************************
DTABSRCH SUBRTINE 'DTABSRCH'
************************************
         PUSH     8,L1
         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
         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
         LI,X4    12                RESTRICT # OF BYTES ACTUALLY MOVED
         CB,X4    LINKINFO            FROM DCB TAB TO 12
         BG       NAMXSTRT
         STB,X4   LINKINFO
NAMXSTRT LI,X4    0                 INITIALIZE BYTE POINTERS
         LI,X5    1
NAMEXFER LB,A8    LINKINFO,X5       TRANSFER 12 BYTES (OR LESS) OF
         STB,A8   DCBNAME,X4          DCB NAME
         AD,X4    #D1#D1
         CB,X5    LINKINFO
         BLE      NAMEXFER
         LW,X4    DCBNAMSZ          ADVANCE DCB TAB STEP POINTER TO
         AWM,X4   DTABSTP             DCB ADDRS
         SVALCON  (DTABSTP,DCBADRS)                GET ADDRESS OF DCB
         SVALCON  (DCBADRS,A8)                CHECK ADRS FOR LEGAL
         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     8,L1
         B        1,L1
DTABABN,DTABEND EQU %
         PULL     8,R1
         B        NXTUSR            ERROR GO TO NEXT USER
         TITLE    'ROUTINE TO GET STATUS OF DCB GIVEN ADDRESS'
************************************
DCBSTAT  SUBRTINE 'DCBSTAT'
************************************
         PUSH     8,L1
         ZERO     TYC
         SVALCON  (DCBADRS,DCB0PAK)
         BITPIK   (DCB0PAK,DRES0),(9,2,17,4)
         LI,X4    9
         FETCH    (DCBADRS,X4,BA),TYC
         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 UPPER LEVEL BUILT'),END
GETASN   CALL     EXPLAIN
         EXPLAIN  (0,'NONE  ',ASN,OBUF+TB5A)
         EXPLAIN  (1,'FILE  ')
         EXPLAIN  (2,'LABEL ')
         EXPLAIN  (3,'DEVICE'),END
STATRET  PULL     8,L1
         B        0,L1
************************************
DCBPRINT SUBRTINE 'DCBPRINT'
************************************
         PUSH     L1
 FORMAT START,(TAB,TB2),(EBC,DCBNAME,12),(TAB,TB3),(HEX,DCBADRS,5)
         FORMAT   PRINT,END
         PULL     L1
         B        0,L1
         PAGE
EXPLAIN  SUBRTINE 'EXPLAIN'
**************************
         PUSH     A8
         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 PULL     A8
         B        *ARGS
         PAGE
*
*
*
         DEF      A2RETURN
MDRET    EQU      %
         DEF      MDRET
A2RETURN EQU      %
         B        MDDCB             SNEAK OVER THERE
         DEF      A2RETALT
A2RETALT B        0,R1
         PAGE
*
*
         END

