*M*      ANALZO2  SECOND OVERLAY OF THE ANLZ LOAD MODULE
*
*P*      THIS MODULE EXISTS ONLY TO MOVE ROUTINES THAT DO NOT
*P*      REQUIRE CONSTANT CORE RESIDENCY. IT CONTAINS VARIOUS
*P*      DISPLAY SUB-ROUTINES THAT ARE CALLED EITHER BY USER
*P*      COMMAND OR IN THE GHOST MODE TO PRODUCE LISTINGS OF THEIR
*P*      INDIVIDUAL DISPLAYS.
*
*P*      THE FOLLOWING ROUTINES MAY BE FOUND IN THIS MODULE;
*P*
*P*      ROUTINE                  DESCRIPTION
*P*      -------------            -------------------------------
*P*
*P*      ERROR%LOG                DISPLAYS ERROR LOG CONTENTS
*P*      STXTVAL                  SYMBOL TEXT STRING TO VALUE ROUTINE
*P*      %DCTS                    DISPLAYS DCT TABLES
*P*      %CITS                    DISPLAYS CIT TABLES
*P*      %IOQS                    DISPLAYS IOQ TABLES
*P*      SYMTABLS                 DISPLAYS OUTPUT (ONLY) TABLES
*P*      RAT%TABLES               RESOURCE ALLOCATION TABLES
*P*      AVR%TABLES               AUTO-RECOGNITION TABLES
*P*
 TITLE '*** A N A L Y Z E   O V E R L A Y   T W O   D 0 0 ***'
*
P#       SET      S:UFV(P#)+1     USED FOR PASS SWITCHING IN PROCS
*
*
         PAGE
*
*        DECLARE SYSTEM USAGES
*
         SYSTEM   SIG7FDP
*
         CLOSE    PUSH,PULL,START
*
*        NOTE THAT THIS MODULE DOES NOT REQUIRE SYSTEM UTS
*
         PAGE
*
*        ANALYZE'S INTERNAL REFERENCES
*
         REF      #R16            * DATA CELL OF X'0000FFFF'
         REF      ADDEFEND        * POINTS TO TOP OF SYMBOL TABLE
         REF      AVR%MSG         * AUTO VOL. RECOG. TABLE TITLE LINE
         SREF     BATAPE            * ADDEND TO AVR INDEX FOR DCTX
         REF      BIGBUF          * POINTS TO SYMBOL TABLE
         REF      BLANK1          * ROUTINE TO BLANK PRINT ONE LINE
         REF      CITLIMS           * RANGE OF VALID CIT INDICES
         REF      CIT6              *
         REF      CITSMSG         * CIT DISPLAY TITLE LINE
         REF      CPOOLMSG        * CPOOL DISPLAY TITLE LINE
         REF      CURADRSS        * CLM PAIR OF CURRENT CORE ADDRESSES
         REF      DCTLIMS           * RANGE OF VALID DCT INDICES
         REF      DCTMSG1         * ADDITIONAL DCT TABLES TITLE LINE
         REF      DCTSMSG         * DCT DISPLAY TITLE LINE
         REF      DUMP:DIR        * SET SAYS RELATIVE ADDRESSING MODE
         REF      DUMPSOME        * ROUTINE TO DUMP REQUESTED AREA
         REF      ELOG%HDG1       * ERROR LOG DISPLAY TITLE LINE
         REF      FIELD#          * CONTAINS CURRENT COMMAND FIELD #
         REF      FIELDS          * POINTS TO FIELD BUCKETS
         REF      GETADDR         * ROUTINE TO FETCH ADDRS IN R14
         REF      GETHEX          * ROUTINE TO GET REQUESTED FIELD
         REF      GETLIST         * ROUTINE TO RETURN NEXT FIELD
         REF      GHTITLE           * GHOST JOB TITLE LINE
         REF      IOQLIMS           * RANGE OF VALID IOQ INDICES
         REF      IOQSMSG         * IOQ DISPLAY TITLE LINE
         REF      JITBUF          * POINTS TO JIT INPUT BUF
         REF      JITBURST        * SET SAYS DUMPING A JIT
         REF      LEGCORAD        * CLM PAIR OF LEGAL CORE ADDRESSES
         REF      LOCLOC          * ROUTINE TO GATHER LOC-LOC FIELDS
         REF      LOOKING         * SET = JUST POKIN AROUND FLAG
         REF      MPTITLE           * MULTI-PROCESSING TITLE LINE
         REF      M:LO            * USED FOR PRINTING INFORMATION
         REF      NOTRACE           *
         REF      OBUF            * PRINT BUFFER
         REF      PAGEBUF         * POINTS TO INPUT BUFFERS
         REF      PAGETABLE         * RECORDS PAGES IN MATRIX
         REF      PG:MODE           * INDICATES PAGE OWNER
         REF      PTR               * TAB COUNTER IN PRINT BUFFER
         REF      RATMSG          * RESOURCE TABLES TITLE LINE
         REF      SCANNER         * COMMAND PARSER
         REF      SPOOLMSG        * SPOOL DISPLAY TITLE LINE
         REF      STACK           * ANLZ'S TEMP STACK
         REF      SYMTMSG         * SYMBIONT DISPLAY TITLE LINE
         REF      TITEL           * ROUTINE TO PUT OUT PAGE/TITLE LINE
         REF      TRANTAB         * HEX TO EBCDIC TRANS TABLE
         REF      USER            * CELL CONTAING CURRENT USER #
         REF      USERLIST        * TABLE OF 32 ENTRIES TO USE
         REF      X1FF            * DATA =X'000001FF' IN ANALZ
SVALTXT  EQU      0               * ROUTINE RELOCATED - NOT USED HEREIN
         PAGE
*
*        REFERENCES THAT ARE SATISFIED FROM MONSTK AT LOAD TIME
*
*                                 * TAPE OPS IF TAPE
         SREF     AVRID           * USER # / SYS ID
         SREF     AVRNOU          * #DCBS+USERS IF PACK
         SREF     AVRTBL          * AUTO VOLUMN RECOGNITION TABLE
         SREF     AVRTBLNE        * NUM OF TAPES+PACKS IN AVRTBL
         SREF     AVRTBLSIZ       * NUM OF TAPES ONLY
         SREF     BUF1            * ERROR LOG BUFFER # ONE
         SREF     BUF2            * ERROR LOG BUFFER # TWO
         SREF     BUFTSIZ         * ERROR LOG MAX SIZE
         SREF     BUFMSIZ         * ERROR LOG USEFUL SIZE
         SREF     C:MSM             * MILLISECONDS SINCE MIDNIGHT..
         SREF     CITSIZ          * LENGTH OF CIT TABLES
         SREF     CIT1            * CHANNEL HEAD INDEX
         SREF     CIT2            * CHANNEL TAIL INDEX
         SREF     CIT3            * CHANNEL FLAGS
         SREF     CIT4            * QUEUEING OPTIMIZER TABLE (CITS)
         SREF     CIT5            * HOLDING REQUEST INDEX (IF ANY)
         SREF     CURBUF          * ERROR LOG CURRENT BUF POINTER
         SREF     DCTSIZ          * LENGTH OF DCT TABLES
         SREF     DCT1A           * ALTERNATE DEVICE ADDRESS
         SREF     DCT1P           * DEVICE PRIMARY ADDRESS
         SREF     DCT10           * RE-ENTRANCY COUNTER
         SREF     DCT11           * INT OVERDUE TIMEOUT TIME
         SREF     DCT12           * RAD/PACK ADDRESS
         SREF     DCT13           * TDV STATUS DBL-WORD
         SREF     DCT14           * CHAN FWD LINK (IOQ TABLES)
         SREF     DCT15           * CHAN BAK LINK (IOQ TABLES)
         SREF     DCT16           * CANNED DEVICE NAME (TEXTC MSG)
         SREF     DCT17           * HANDLER RETRY/FOLLOW ON CODES
         SREF     DCT18           * # OF TIMEOUT INCREMENTS
         SREF     DCT19           * SIO CONDITION CODES
         SREF     DCT2            * CHANNEL INFO TABLE INDEX TABLE
         SREF     DCT20           * TDV CONDITION CODES
         SREF     DCT21           * TIO STATUS (16 BITS WORHT)
         SREF     DCT22           * INDEX INTO DISC CONVERT TABLES
         SREF     DCT23           * 0=NOT DISC / OR HGP DISPLACEMENT
         SREF     DCT24           * RMA FLAGS (PARTITIONED--ETC)
         SREF     DCT25           * SIO COUNTS (1 PER SIO PERFORMED)
         SREF     DCT26             * FECP FLAGS
         SREF     DCT27             * DEFR I/O CONTROL
         SREF     DCT28             * DEFR I/O STATUS
         SREF     DCT29             * DEFR I/O COUNTER
         SREF     DCT3            * DEVICE FLAGS
         SREF     DCT4            * INDEX INTO OH:NM TABLE
         SREF     DCT5            * ADDITIONAL DEVICE FLAGS
         SREF     DCT6            * QUEUE HEAD POINTER
         SREF     DCT7            * DA CLIST SPACE
         SREF     DCT8            * WA OF PRE-HANDLER
         SREF     DCT9            * WA OF POST-HANDLER
         SREF     F:EADDR           * MULTI-PROCESSING
         SREF     FB:EFLG           *
         SREF     FB:FLT            *
         SREF     FH:SCRCH          *
         SREF     IOCLOCK         * I/O OVERDUE DEADLINE VALUE MATCHUP
         SREF     IOQ1            * FWD LINK IOQ TABLE
         SREF     IOQ10           * # OF RETRIES AS REQUESTED
         SREF     IOQ11           * # OF RETRIES AS REMAINING
         SREF     IOQ12           * RAD/PACK ADDRESS (PHYSICAL)
         SREF     IOQ13           * END ACTION/INFO DBL-WORD
         SREF     IOQ14           * I/O PRIORITY
         SREF     IOQ15           * USER'S NUMBER
         SREF     IOQ16           * ECB TABLE POINTER
         SREF     IOQ2            * BAK LINK "  "  " "
         SREF     IOQ3            * IOQ FLAGS
         SREF     IOQ4            * ORIGINAL FUNCTION STEP
         SREF     IOQ5            * CURRENT FUNCTION STEP
         SREF     IOQ6            * DCB SLOT IN IOQ TABLES
         SREF     IOQ7            * CLIST ADDRESS
         SREF     IOQ8            * #CDWS / OR BUF BYTE COUNT
         SREF     IOQ9            * BA OF BUF / OR CLIST DA
         SREF     JBUPVPA         * FIRST POSSIBLE USER ADDRESS
         SREF     MXSTRM          * LENGTH OF RESOURCE TABLES
         SREF     MAXG              * MAX GHOST JOBS IN SYSTEM
         SREF     NSCPU             *
         SREF     S:ADR             *
         SREF     S:GJOBTBL         *
         SREF     S:GJOBACN
         SREF     SB:GJOBUN         *
         SREF     SB:INIT           *
         SREF     SB:STATE          *
         SREF     S:PCUN            *
         SREF     SB:MPSW           *
         SREF     SB:PFLG           *
         SREF     SB:MINT           *
         SREF     SB:SFLG           *
         SREF     SB:RCVR           *
         SREF     SB:RCVA           *
         SREF     SB:RBDF         * BATCH RESOURCE DEFAULT COUNT
         SREF     SB:RBMX         * BATCH MAX RESOURCE COUNT
         SREF     SB:RGDF         * GHOST RESOURCE DEFAULT COUNT
         SREF     SB:RGMX         * GHOST MAX RESOURCE COUNT
         SREF     SB:RODF         * ONLINE RESOURCE DEFAULT COUN
         SREF     SB:ROMX         * ONLNE MAX RESOURCE COUNT
         SREF     SB:RTY          * DCT4 INDEX FOR USER NAMED RESOURCES
         REF      SCDEVTYP          *
         SREF     SCFBUF          * OFFSET IN CPOOL TO SPOOL ADDRESS
         SREF     SCNTXT          * DA OF CPOOL
         SREF     SH:MAXQ           *
         SREF     SH:MINQ           *
         SREF     SH:RBCU         * BATCH CURRENT RESOURCE COUNTS
         SREF     SH:RBSUM        * BATCH SUM OF RESOURCES
         SREF     SH:RGCU         * GHOST CURRENT RESOURCE COUNTS
         SREF     SH:RGSUM        * GHOST SUM OF RESOURCES
         SREF     SH:RNM          * STANDARD RESOURCE NAMES (16 BITS)
         SREF     SH:ROCU         * ONLINE CURRENT RESOURCE COUNTS
         SREF     SH:ROSUM        * ONLINE SUM OF RESOURCES
         SREF     SH:RTOT         * USER SPECIFIED VALUE FOR RESOURCE
         SREF     SNDDX           * LIST OF SYMBIONT DEV DCT X'S
         SREF     SOLICIT         * 0=NO / NOT 0=YES
         SREF     SQHD            * HEAD OF QUEUE
         SREF     SQTL            * TAIL OF QUEUE
         SREF     SQUE            * SYMBIONT QUEUE CHAIN
         SREF     SRET            * RETURN TO SYMBIONT ROUTINE ADDRS
         SREF     SSIG            * SYMBIONT SIGNAL CHARACTER
         SREF     SSTAT           * SYMBIONT DEVICE STATUS
         SREF     STB:LNK         * REMOTE CHAINS FOR IRBT
         SREF     STB:Q           * SYMBIONT IOQ ENTRY FOR IRBT
         SREF     STB:TYP         * IRBT DEVICE TYPE
         SREF     STH:FLG         * REMOTE FLAGS
         SREF     STH:SUS         * FCS SUSPEND BIT
         SREF     SV:RSIZ         * LENGTH OF RESOURCE TABLES
         SREF     SYMX            * 1 = INSYM  /  2= OUTSYM
         PAGE
*
*        LIST OF PROCS AVAIL IN ANALZO2 AND THEIR USAGE
*
*
*  NAME OF PROC     USAGE/DEFINITION
* -------------     --------------------------------------------------
*
* 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
         PAGE
*
*        DECLARE DATA AND PROCEDURE NAMES FOR CONTROL SECTION
*        SWITCHING.
*
%PSECT1  CSECT    0                 PURE DATA CONTROL SECTION
A2DATA   EQU      %
TXTSECT  CSECT    1                 PROCEDURE SECTION FOR TEXT STRINGS
%SECT1   CSECT    1                 PURE PROCEDURE SECTION
A2PP     EQU      %
         PAGE
*
*        DECLARE REGISTER NAMING CONVENTIONS AND HOW USED
*
*
         ASECT                    * THIS IS REQUIRED DUE TO PROC
%R       EQU      %               * REGISTER USAGE--DONT CHANGE..
*                                 *
*
*
*                     USED BY       WHOSAVES   USED FOR
*                     -------       --------   --------
*
R0       EQU    %R+0  PROCS         PROC       RESERVED FOR PROC
R1       EQU    %R+1  LINKING SUBS  CALLER     ALL LINKING
R2       EQU    %R+2  PROCS         PROC       RESERVED FOR PROC
R3       EQU    %R+3  PROCS         PROC       RESERVED FOR PROC
R4       EQU    %R+4  SUBROUTINES   SUBRTN     GLOBAL INDEX
R5       EQU    %R+5  SUBROUTINES   SUBRTN     GLOBAL INDEX
R6       EQU    %R+6  SUBROUTINES   SUBRTN     GLOBAL INDEX
R7       EQU    %R+7  SUBROUTINES   SUBRTN     GLOBAL INDEX
R8       EQU    %R+8  SUBROUTINES   SUBRTN     GLOBAL ARITHMETIC
R9       EQU    %R+9  SUBROUTINES   SUBRTN     GLOBAL ARITHMETIC
R10      EQU    %R+10 SUBROUTINES   SUBRTN     GLOBAL ARITHMETIC
R11      EQU    %R+11 SUBROUTINES   SUBRTN     GLOBAL ARITHMETIC
R12      EQU    %R+12 SUBROUTINES   VOLATILE   SUBROUTINE ARGS/RETURNS
R13      EQU    %R+13 SUBROUTINES   VOLATILE   SUBROUTINE ARGS/RETURNS
R14      EQU    %R+14 SUBROUTINES   VOLATILE   SUBROUTINE ARGS/RETURNS
R15      EQU    %R+15 SUBROUTINES   VOLATILE   SUBROUTINE ARGS/RETURNS
*
P0       EQU      R0
L1       EQU      R1
P2       EQU      R2
P3       EQU      R3
X4       EQU      R4
X5       EQU      R5
X6       EQU      R6
X7       EQU      R7
A8       EQU      R8
A9       EQU      R9
A10      EQU      R10
A11      EQU      R11
V12      EQU      R12
V13      EQU      R13
V14      EQU      R14
V15      EQU      R15
*
*
         USECT    %SECT1            CURRENT SECTION = USER PROCEDURE
         PAGE
*
*        INTERNAL DEFINITIONS
*
         DEF      %CITS           * DUMPS THE CITS
         DEF      %DCTS           * DUMPS THE DCTS
         DEF      %IOQS           * DUMPS THE IOQS
         DEF      AVR%TABLES      * DUMPS AVR TABLES
         DEF      A2DATA          * POINTS TO INTERNAL DATA START ADRS
         DEF      A2PP            * POINTS TO INTERNAL PROCEDURE START
         DEF      ERROR%LOG       * DUMPS THE ERROR LOG
         DEF      MPTABLES          RUNS MULTI-PROCESSING TABLES
         DEF      GHTABLES          RUNS GHOST JOB TABLES
         DEF      RAT%TABLES      * DUMPS THE RESOURCE ALLOCATION TABLES
         DEF      STXTVAL         * TEXT TO VALUE ROUTINE
         DEF      SYMTABLS        * DUMPS THE OUTPUT SYMBIONT TABLES
         PAGE
*
*        DEFINE PROCEDURES AND SYMBOLS ASSOCIATED WITH 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
         PAGE
*
*
*
S:S      FNAME
         PROC
         PEND     AF(AF(1)+1)
         PAGE
*
*
*        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       EQU      %
N    DO           2                    ITERATE FOR BOTH FIELDS
      DO          AFA(N,1)             IF INDIRECTION HAS BEEN SPCFD -
*                                   METASYM STRIKES AGAIN *
         GEN,8,4,20 X'32',N+1,AF(N,1) /LW OPCODE WOULD INCLUDE * BIT /
         SLS,N+1  2                      AND ADJUST TO BYTE ADDRESS
      DO1         AF(N,3)~=0             AND IF A DISPLACEMENT GIVEN -
         AI,N+1   AF(N,3)                  ADD IT IN ALSO
      ELSE
         LI,N+1   BA(AF(N,1))+AF(N,3)  NO * - GET ADRS AND DISP BOTH
      FIN                              END OF SUBFIELD 1 AND 3 PICKUP
      DO          ABSVAL(AF(N,2))>0    TEST IF AND INDEX REG GIVEN
         AW,N+1   AF(N,2)                YES - ADD ITS CONTENTS
      FIN                              END OF ARGUMENT FIELD
     FIN
         LI,P0    CF(2)                GET BYTE COUNT
         STB,P0   P3                     AND INSERT IT IN BYTE WORD
     DO           NAME=1               SELECT APPROPRIATE BYTE
         MBS,R2   0                 MOVE EM
     ELSE
         CBS,R2   0                 OR COMPARE EM
     FIN
         PEND
         PAGE
*************************************
TXT      CNAME
*************************************
         PROC
LF       EQU      %
         TEXT     AF
         PEND
         PAGE
*
*        SUBRTINE,CALL AND RETURN ARE USED FOR SUBROUTINE LINKAGE.  THEY
*                 DO NOT PERFORM ANY USEFUL FUNCTION(AT PRESENT) BEYOND
*                 ALLOWING DEBUG EXPANSION OF CODE.
*************************************
SUBRTINE CNAME
*************************************
         PROC
LF       EQU      %                 IN DEBUG MODE, GEN TEXT FOR AF
*                                     SO THAT DUMPS ARE EASY TO READ
         PEND
         PAGE
*************************************
CALL     CNAME
*************************************
         PROC
LF       BAL,L1   AF
         PEND
         PAGE
*************************************
RETURN   CNAME
*************************************
         PROC
LF       B        AF
         PEND
*
*        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
*
*************************************
         PAGE
BLANK    CNAME    1
ZERO     CNAME    2
*************************************
         PROC
LF       EQU      %
         LOCAL    ADRSS,N
ADRSS    EQU      #CBLANKS,#R0
         LW,P3    ADRSS(NAME)       GET WORD OF BLANKS OR ZERO
N   DO            NUM(AF)           ITERATE FOR ALL ADDRESSES
      DO          ABSVAL(AF(N,2))<2 TEST IF SIZE OF THIS ARRAY SPECFD
         STW,P3   AF(N,1)             NO. STORE SINGLE WORD
      ELSE
         ERROR,1,AFA(N,1) 'INDIRECTION NOT ALLOWED'
         LI,P2    -AF(N,2)           SET UP LOOP CONTROL WITH SIZE
         STW,P3   AF(N,1)+AF(N,2),P2 ZAP WORD
         BIR,P2   %-1                AND CONTINUE
      FIN
     FIN
*        EXTP
         PEND
         PAGE
*
*        SUBROUTINES FOR STACK OPERATIONS
*
*
*
PUSH     CNAME    X'8'
PULL     CNAME    X'7'
         PROC
LF       EQU      %
X        SET      NUM(AF)
         DO       P#=1
         RES      X                 RESERVE SPACE FOR AF COUNT
         ELSE
         DO       X=2
         LCI      AF(1)&X'F'
         FIN
         GEN,1,7,4,3,17  0,NAME(1)+(X|1),AF(X),0,STACK
         FIN
         PEND
         PAGE
*                                   THE PRINT PROC HAS TWO FORMS
*
*                 1   PRINT,COUNT    ADRS   COUNT BYTES AT WORD ADRS
*                 2   PRINT         TEXT   TEXT STRING IMMEDIATE
*************************************
PRINT    CNAME
*************************************
         PROC
LF       EQU      %
         LOCAL    TEXTFPT,PRINTEND,TEXTAF,SAVE%
     GOTO,(TCOR(AF(1),S:C))  TEXTAF
         ERROR,4,TCOR(AF(1),S:AAD,S:INT)>0 ;
                  'DON''T USE REGISTER FOR I/O, DUMMY'
         CAL1,1   TEXTFPT
SAVE%    EQU      %                 SET UP TO GEN FPT REMOTE
         USECT    TXTSECT
TEXTFPT  GEN,8,24 X'11',M:LO
         GEN,4,28 3,0               BUF - ADRESS BITS
         DATA     AF(1)             ADRS
         PZE      *TABPOS           LOC CONTAINING BUFFER 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 EQU      %
         PEND
         PAGE
*
*        THE FORMAT PROC SETS UP ARGUMENTS FOR THE FORMAT SUBROUTINE.
*        THE ADVANTAGES OF USING THIS PROC OVER CODING ENTRIES WITH GEN
*        STATEMENTS:
*           1. PROC PERMITS CALLS TO BE PARAMETERIZED.  THE CALLING
*                SEQUENCE CAN BE MADE WITHOUT CHANGING EXISTING CODING
*           2. ARGUMENTS MAY BE EXPRESSED AS WORD ADDRESSES AND CONVRTD
*                TO BYTE ADDRESSES AUTOMATICALLY.
*           3. NOTATION IS MORE COMPACT AND READABLE.
*           4. SEVERAL FORMAT TYPES HAVE INFORMATION SUPPLIED FOR THEM
*                BY PROC, MAKING CODING EASIER.
*
*        TYPICAL REFERENCE LINES:
*
*        FORMAT   ' TEXT INFO',3,(HEX,ADRS,NUMBRBYTES),(OP,ADRS,N),END
*        FORMAT   (BIT,BA(WORDADRS),NUMBR),(END)
*
* N      D0       4
*        FORMAT   1,(HEX,ADRS+N-1,4)
*        FIN
*        FORMAT   END
*
*        FORMAT OPCODES ARE AS FOLLOWS:
*           1 - EBCDIC       2 - HEX         3 - OPCODE
*           4 - BIT          5 - SPACE       6 - IMMEDIATE
*           7 - INSERTS      8 - TAB         9 - END
*          10 - PRINT       11 - SKIP       12 - START
*          13 - DECIMAL
*
*        THE  COMMANDS FOR EBC,HEX,BIT AND MOVE HAVE THE FOLLOWING
*        REFERENCE LINE SYNTAX:
*        (KEYWORD,(WORD ADRS,BYTE DISPLACEMENT),COUNT IN OUTPUT BUF)
*
*        THE OPCODE COMMAND HAS THE SYNTAX:
*        (OP,WORD ADRS)
*
*        THE TAB COMMAND HAS SYNTAX:  (TAB,COLUMN POSITION)
*
*        THE DECIMAL COMMAND HAS THE SYNTAX:
*        (DEC,WORD ADRS,BYTES IN OUTPUT LINE)
*
*        MORE INFORMATION ABOUT MEANING CAN BE FOUND IN LISTINGS OF
*        MDFORMAT.  THE LISTING OF MDSNAP4 CONTAINS EXAMPLES OF THE USE
*        OF THIS PROC
*
FORMAT   CNAME
         PROC
LF       EQU      %
         LOCAL    OP#,N,XXX,TEXTAD,SPACE,BYTERES,FLOOP,TEXT20,;
                  OPX,COUNT,OPNUM,STARTX,DECIMOP
*
*
N    DO           NUM(AF)           SCAN ARG LINE FOR ALL PARAMS
     GOTO,TCOR(AF(N,1),S:C,S:INT)           TEXT20,SPACE
*
         DO       P#=1
         RES      1                 RESERVE ONE WORD EACH PASS(PROC)
         ELSE
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'
         RES      1
*
     GOTO         FLOOP1
*
BYTERES  SET      0
         GEN,8,5,19   AF(N,3),OP#,BA(AF(N,2,1))+AF(N,2,2)
     GOTO         FLOOP1
*
OPX      SET      0
         GEN,8,5,19   4,OP#,AF(N,2)
     GOTO         FLOOP1
COUNT    SET      0
         GEN,8,5,19   AF(N,2),OP#,0
     GOTO         FLOOP1
OPNUM    SET      0
         GEN,8,5,19   0,OP#,0
     GOTO         FLOOP1
*
STARTX   BAL,1    FORMAT            SET UP BASIC ARGUMENT BAL,1
     GOTO         FLOOP1
DECIMOP  SET      0
         GEN,8,5,19   AF(N,3),OP#,AF(N,2)
         ERROR,4,N]=1   '*** START PARAM WAS NOT FIRST'
FLOOP1   FIN
     GOTO         FLOOP
TEXT20   SET      0                 SAVE USER CSECT ADDRESS
         GEN,8,5,19   S:NUMC(AF(N)),7,BA(%+1)
         TEXT     AF(N)
     GOTO         FLOOP
*
SPACE    SET      0
         GEN,8,5,19   AF(N),5,0
FLOOP FIN
*
         PEND
         PAGE
*
*        EXPLAIN IS CALLED USING THE EXPLAIN PROC.  THIS PROC SETS
*        UP ARGUMENTS WHICH DEFINE A WORD  TO BE TESTED AGAINST AND
*        AN EXPLANATORY TEXTUAL DESCRIPTION OF THE MEANING IF THERE
*        IS A MATCH.  OPTIONAL ITEMS FOR ANY GIVEN SET  OF ARGUMENTS
*        IS THE WORD TESTING AND TH LOCATION OF THE BUFFER TO MOVE
*        THE TEXTUAL EXPLANATION.  EXAMPLE, USING THE PROC FOLLOWS
*
*        THE ASN FIELD OF DCB CONTAINS A CODE TO TELL WHAT KIND OF
*        ASSIGNMENT IS IN EFFECT FOR THE DCB. THE VALUES ARE 0=NULL,
*        1=FILE ,2=LABEL, 3=DEVICE. THE CODING TO TEST A WORD IN CORE
*        CALLED ASN FOR THESE VALUES AND PLACE A TEXTUAL DESCRIPTION IN
*        THE ASNTEXT DOUBLEWORD IS:
*
*                 CALL    EXPLAIN
*                 EXPLAIN (0,'**NULL**',ASN,ASNTEXT),(1,'FILE'),;
*                 (2,'LABEL'),(3,'DEVICE'),END
*
*        THE CODE GENERATED FOR THIS EXAMPLE WOULD BE:
*
*        BAL,1    EXPLAIN           GENERATED BY CALL
*        GEN,8,1,1,22  8,1,1,TEX1   TEXT BYTE COUNT,PARAM 3 PRESENT
*                                   PARAM 4 PRESENT,TEXT ADDRESS
*        DATA     0                 TESTING AGAINST 0
*        DATA     ASN               PARAM 3
*        DATA     ASNTEXT           PARAM 4 (WHERE TO PUT EXPLAIN)
*        GEN,8,1,1,22  4,0,0,TEX2   BYTE COUNT,P3 MISNG,P4 MISNG, TEXTAD
*        DATA     1                 TESTING AGAINST 1
*        GEN,8,1,1,22  5,0,0,TEX3  BYTE CNT,P3 ,P4,TEXT AD
*        DATA     2                 TESTING AGAINST 2
*        GEN,8,1,1,22  6,0,0,TEX4   BYTE CNT,P3,P4,TEXT AD
*        DATA     3                 TESTING AGAINST 3
*        DATA     0                 MARK END OF ARG LIST
*
*
*        GENERATED IN ANOTHER CONTROL SECTION WOULD BE:
*TEX1    TEXT     '**NULL**'
*TEX2    TEXT     'FILE'
*TEX3    TEXT     'LABEL'
*TEX4    TEXT     'DEVICE'
*
*
*************************************
EXPLAIN  CNAME
*************************************
         PROC
         LOCAL    %SECT,N,P3PRES,P4PRES,TEXTSTRT,TEXWORDS,P4GEN,LOOP,;
                  EXPEND,EXIT
LF       EQU      %
%SECT    SET      %                 SAVE CALLERS CONTROL  SECTION
N    DO           NUM(AF)
     GOTO,SCOR(AF(N,1),END)         EXPEND
P3PRES   SET      NUM(AF(N,3))~=0     1=PARAM PRESENT 0=NOT
P4PRES   SET      NUM(AF(N,4))~=0     1=PARAM PRESENT 0=NOT
         USECT    TXTSECT
TEXTSTRT SET      %                 GENERATE TEXT AND GET SIZE IN WDS
         TEXT     AF(N,2)
TEXWORDS SET      %-TEXTSTRT
         USECT    %SECT
         GEN,8,1,1,22  TEXWORDS,P3PRES,P4PRES,TEXTSTRT
         DATA     AF(N,1)           PASS VALUE PARAM
      GOTO,P3PRES=0  P4GEN          SKIP GEN IF PARAM MISSING
         DATA     AF(N,3)
P4GEN  GOTO,P4PRES=0  LOOP          SKIP GEN IF PARAM MISSING
         DATA     AF(N,4)
LOOP FIN
     GOTO         EXIT
EXPEND   DATA     0                 WORD OF 0 = END OF ARGS
EXIT     EQU      %
         PEND
         PAGE
*
*************************************
BITPIK   CNAME
*************************************
         PROC
         LOCAL    CUR%,CNTRLWD,X
LF       EQU      %
CUR%     EQU      %                 SAVE CURRENT %
         USECT    %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
         PEND
         PAGE
%TEXTBSZ EQU      34                SIZE OF PRINT BUFFER
*                 THE FOLLOWING PROCS SET UP CALLING SEQUENCES TO
*                 SYMBOL TABLE ROUTINES.  THE SYNTAX IS:
*
*                   FOUNTINE%NAME   (FROM,TO,(ERR,ADRS))
*                     WHERE         FROM=ADRS OF INPUT ARG
*                                   TO  =ADRS OF OUTPUT ARG
*                                   ERR =KEYWORD
*                                   ADRS=ADRS OF ERR PROCESS ROUTINE
*
*                                   THE SPEC OF ERR IS OPTIONAL
*
*************************************
SVALTXT  CNAME    1
SVALCON  CNAME    2
STXTVAL  CNAME    3
STXTCON  CNAME    4
*************************************
         PROC
LF       EQU      %
         LOCAL    FROM,TO,N,%SECT,TEXTAD,%SFROM,%STO,%SROUTIN,LAST,LAST
%SFROM   EQU      V12,V12,V13,V13
%STO     EQU      V13,V15,V12,V15
%SROUTIN EQU      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    TXTSECT             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
*
         BAL,R1   %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     EQU      %
         PEND
         PAGE
*
* THE FETCH PROC IS USED FOR OBTAINING THE CONTENTS OF CORE.
* IT PERMITS MUCH MORE FLEXIBILITY THAN ARE PERMITTED BY
* THE STXTCON AND SVALCON PROCS.
* THE BASIC SPECIFICATIONS REQUIRED ARE FROM AND TO ADDRESSES AND THE
* NUMBER OF UNITS TO TRANSFER. NOTE THAT THE UNITS
* TRANSFERRED ARE NOT RESTRICTED TO WORD RESOLUTION
*
* THE DETAILED SYNTAX IS:
*
*        FETCH,NUM  (*FROM,XF,RESF),(*TO,XT,REST)
*
*        NUM      NUMBER OF UNITS TO TRANSFER. DEFAULT = 1.
*        FROM     EITHER A TEXT STRING GIVING A MONITOR
*                   DEF NAME OR A COMPUTED ADDRESS. REQD.
*        XF       INDEX REGISTER TO APPLY TO FROM. OPTIONAL.
*        RESF     RESOLUTION OF XF. DEFAULT = WORD.
*                   KEYWORDS ARE : BA,HA,WA,DA
*        TO       DIRECT CORE ADDRESS TO TRANSFER TO. REQD.
*        XT       INDEX REGISTER TO APPLY TO TO. OPTIONAL
*        REST     RESOLUTION OF XT.
*                   KEYWORDS ARE : BA,HA,WA,DA
*
* EXAMPLES FOLLOW
*
*        FETCH    ('TIME'),TIME   FETCH MONITOR CELL FOR TIME
*                                   AND PLACE IN OWN CELL
*        FETCH,6  ('JIT'),MYJIT   FETCH FIRST 6 WORDS OF MON JIT
*        FETCH    ('DCT1',X4,HA),DCT1  FETCH FROM DCT1 USING
*                                        X4 AS HALFWORD INDEX
*
*        FETCH    (UH:FLG,R2,HA),(USRFLAG,,WA)  **FETCH USER FLAGS
*                                                 AND STORE INTO USRFLAG
*                                                 RIGHT ADJUSTED
*
*        FETCH    ('UH:FLG',R2,HA),(USRFLAG,,WA) **SAME AS ABOVE--BUT
*                                                  GOES TO SYMBOL TABLE
*                                                  TO EVALUATE 'UH:FLG'
*
FETCH    CNAME
         PROC
LF       EQU      %
         LOCAL    %SECT,PARMLIST,OPCODES,FFADR,RESL2,OPCODE2
%SECT    SET      %                 SAVE CURR CONTRL SECT
         USECT    TXTSECT
     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
         DO       P#=1
         RES      2
         ELSE
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
         FIN
         USECT    %SECT             RETURN  TO USER SECTION
         LD,V12   PARMLIST          TRANSMIT PARAMETERS
         BAL,R1   FETCH             AND PERFORM FUNCTION
         PEND
         PAGE
*
*        DATA FOR FORMATTING SUBROUTINES
*
*************************************
         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
WDEFENT  DO1      DESW
         DATA     0
WTEXT    EQU      WDEFENT+TXTOFSET  ADDRESS OF TEXT IN WDEFENT
DESB     EQU      DESW*4
DEFBUF   EQU      BIGBUF            SET IT
         BOUND    8
FPAKPRM  DATA     0,0
FSETTX   GEN,12,3,17  0,X6,0
         GEN,12,3,17  0,-1,0
         BOUND    8
IDCT13   DATA     0,0               RESERVE FOR IMAGES OF CURRENT
IDCT16   DATA     0,0                 DCT ENTRIES, COMMAND LIST,SIZE OF
IIOQ13   DATA     0,0
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
DCTSIZE  DATA     DCTSIZ
         PAGE
*
*        FOLLOWING CELLS CONTAIN AT RUN TIME THE CURRENT WORKING
*        VALUE FROM EACH TABLE THE NAMES REPRESENT.
*
DCTINDEX 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
IDCT26   DATA     0
IDCT27   DATA     0
IDCT28   DATA     0
IDCT29   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 #
IIOQ16   DATA     0                 C00 ECB DATA
ICIT1    DATA     0
ICIT2    DATA     0
ICIT3    DATA     0
ICIT4    DATA     0
ICIT5    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
         USECT    %SECT1            GENERATE PROCEDURE HERE
         DEF      PPO2              PATCHING DEF
PPO2     EQU      %
         BOUND    8
LOG:CODES DATA    X'11',X'57'       RANGE OF ERROR LOG CODES
LOG:CNTS DATA     2,18              RANGE OF ERROR LOG MSG COUNTS
         USECT    %PSECT1           BACK TO DATA SECTION
         BOUND    8
RC%BUF   DATA     0,0               CLM PAIR FOR ERROR LOG OBSERVATION
         DATA     0
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
         PAGE
*
*
*        TAPE HEADING
*
AVRTHDG  EQU      'DCTX','DEV#','SER#','PUB','POS','AVR','SCR','HLD',;
                  'PTL','UPL','OPN','NOU','TPOS','USER','SOL',;
                  'DCBS+USERS'
*
*        DISC HEADING
*
AVRDHDG  EQU      'DCTX','DEV#','SER#','PUB',' ','AVR','INI','VER',;
                  'MTD','PRIM',' ','NOU','HGPD','USER',;
                  'SOL','DCBS+USERS'
*
*        TAPE HEADING WIDTHS
*
TD       EQU      4,4,4,3,3,3,3,3,3,3,3,3,4,4,3,10
*
*        DISC HEADING WIDTHS
*
DD       EQU      4,4,4,3,3,3,3,3,3,4,3,3,4,4,3,10
*
*        SOURCES FOR LOOPS
*
AVRLIST  EQU      AVRTBL,0,0,0,0,0,0,0,0,0,0,AVRID,SOLICIT,AVRNOU,0,0
*
*        TAB COLUMNS
*
TAVR     EQU      1,6,11,16,20,24,28,32,36,40,45,49,53,58,63,67,78
*
         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     EQU      %
TP%CNT   DATA     AVRTBLSIZ
DP%CNT   DATA     AVRTBLNE-AVRTBLSIZ                                         A00
CNTRS    EQU      %
TP%CNTR  DATA     0
DP%CNTR  DATA     0                                                          A00
         USECT    %SECT1
#R0      DATA     0
#CBLANKS DATA     '    '
RPAGEMSK EQU      X1FF
ADMASK   EQU      %                 USE 19 BIT ADDRESS MASK
#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
BLWORD   GEN,8,24 X'40',0           FOR BLANKING THRU BUFFER
#R7F     DATA     127
#LFF     DATA     X'FF000000'
#RFF     DATA     X'FF'
         USECT    %PSECT1
TABPOS   EQU      PTR               USE SAME POINTER AS ROOT...
LOCALSV  DATA     0
*
*
*
*
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
         USECT    %SECT1            GENERATE PROCEDURE AGAIN
         PAGE
*
*        MOVE TRANSMITTED TEXTC STRING INTO WORK BUFFER TO
*        UTILIZE IN SCANNING FOR STRING IN THE SYMBOL TABLE
*
FETCHTXT EQU      %
         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
         PAGE
*F*
*F*    NAME:           STXTVAL
*F*
*F*    PURPOSE:        TO TAKE A SYMBOL TEXTC STRING AND SEARCH THE
*F*                    SYMBOL TABLE FOR IT.
*F*
*F*    DESCRIPTION:    THE CALLER IS REQUIRED TO PASS THE ADDRESS
*F*                    OF THE TEXTC STRING IN R13. STXTVAL WILL
*F*                    MOVE THE STRING INTO THE TEMPORARY SLOT
*F*                    'WTEXT' FOR COMPARISON WITH THE SYMBOL NAMES
*F*                    IN THE SYMBOL TABLE.
*F*
*F*                    IF THE SYMBOL IS FOUND IN THE TABLE - STXTVAL
*F*                    WILL RETURN THE VALUE IN R12 AND RETURN WITH
*F*                    CONDITION CODES SET TO 15.
*F*
*F*                    IF THE SYMBOL ISNT FOUND - STXTVAL WILL RETURN
*F*                    WITH THE CONDITION CODES SET TO ZERO.
*F*
*
STXTVAL  EQU      %
         PUSH     L1
         CALL     FETCHTXT          MOVE XMITTED TEXT TO WTEXT
         LW,V14   BIGBUF
         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
         AI,R2    1                 BUMP SOURCE BA
         AI,R3    1                 AND DEST BA BYPASSING COUNT FIELD
         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
         LI,R12   0                 INSURE ADDRESS IS RESET
         LCI      0                 SET ABNORMAL CONDITIONS
         B        0,L1
STVFOUND EQU      %
         LB,R3    *R14              GET STRING BYTE COUNT
         AND,R3   #R7               CLEAR FLAGS
         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
*
*        FETCH CONTENTS OF WORD GIVEN TEXTC STRING
*
STXTCON  EQU      %
         PUSH     R1
         CALL     STXTVAL           BUST TEXT TO VALUE
         PULL     R1
         B        SVALCON           AND THEN GET CONTENTS OF VALUE
         PAGE
*
*        R12 CONTAINS ADDRESS - FETCH SAME AND RETURN CONTENTS IN
*        R15
*
SVALCON  EQU      %
         AND,V12  ADMASK            MASK OFF
         CLM,V12  LEGCORAD          IS LEGAL CORE ADDRESS
         BCS,9    0,L1              NO,TAKE ERROR EXIT
         CLM,V12  CURADRSS          IS ADDRESS RQSTD IN CORE ?
         BCR,9    SVCFILE           YES - GO GET WORD
         MTW,1    LOOKING           NEVER NEED MORE THAN ONE PAGE
         LW,R14   R12               MOVE REQUESTED ADDRS
         BAL,R0   GETADDR           GO GET IT IN (AND SET UP TABLES)
         LW,R15   *R15              GET REQUESTED ADDRS
         B        0,R1              AND EXIT
*
*
SVCFILE  EQU      %
         LW,R15   PAGEBUF           ADDRS OF NORMAL DUMP BUFFER
         AND,R12  RPAGEMSK          CHANGE R12 TO PAGE OFFSET
         AW,R15   R12               CALCULATE ADDRS IN BUFFER
         LW,R15   *R15              AND GET THE NECESSARY WORD
         B        0,R1
         PAGE
*
*        RECEIVER OF 'FETCH' PROC - RETURN VALUE TO LOCATION
*        PROC POINTED TO
*
FETCH    EQU      %
         LCI      8
         STM,R0   F:STACK           SAVE R0 THRU R7
         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
         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      8
         LM,R0    F:STACK           RELOAD R0 THRU R7
         B        0,R1              AND  RETURN
*
FNOFND   DATA     0                 TRAP IF ERROR IN PROC
*
         PAGE
*F*
*F*    NAME:           %DCTS
*F*
*F*    PURPOSE:        TO DISPLAY DCT TABLES.
*F*
*F*    DESCRIPTION:    THE USER HAS THE OPTION OF IDENTIFYING UP
*F*                    TO 20 DIFFERENT DCT'S HE WOULD LIKE TO SEE
*F*                    DISPLAYED. %DCTS USES THE ROUTINE 'GETLIST'
*F*                    TO SCAN THE COMMAND LINE RETURNING EACH OF
*F*                    THE VALUES THE USER TYPED.
*F*
*F*                    IN THE GHOST 'ALL' MODE NO OPTION FIELDS ARE
*F*                    PRESENT SO %DCTS WILL DISPLAY ALL OF THE DCT
*F*                    TABLES.
*F*
*
*        COMMAND FORMAT.
*
*        DI(SPLAY)  DC(T)   (1)(,2)(,3)(,4)(,5)
*
*        NOTE THAT LIST IS OPTIONAL - THE LACK OF A LIST SPECIFIES
*        TO DUMP ALL OF THE DCT TABLES
*
%DCTS    EQU      %
         PUSH     L1
*
*        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      64                ACTIVITY COUNTER
TAD13    EQU      70                AC//IO DEADLINE
TAD14    EQU      80                AIO STATUS
TAD15    EQU      90                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
*
*
TAD001   EQU      1                 ROW NUMBER
TAD002   EQU      4                 DEFR I/O CONTROL
TAD003   EQU      13                DEFR I/O CONTROL
TAD004   EQU      18                DEFR I/O STATUS
TAD005   EQU      23                DEFR I/O COUNTER
         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),'4'
         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   END               RETURN HERE FROM FORMAT PROC
         FETCH    (IOCLOCK,,WA),IDCT1A **AND GET I/O CLOCK DEADLINE
         FORMAT   START,(TAB,TAD13-1),'*',(HEX,IDCT1A,8),'*'
         FORMAT   PRINT,(SKIP,2),PRINT,END
DCTSTRT  EQU      %
         BAL,R0   GETOPTION         GET POSSIBLE OPTION FIELD
         CI,R4    0                 RETURNED A VALUE
         BEZ      DCTLOOP           NOPE
         CLM,R4   DCTLIMS           IS VALID
         BCS,9    SCANNER           NOPE--> NO SHOW THEN
DCTLOOP  RES      0
         STW,X4   DCTINDEX
         FETCH    (DCT1A,R4,HA),(IDCT1A,,WA)
         FETCH    (DCT1P,R4,HA),(IDCT1P,,WA)
         FETCH    (DCT2,R4,BA),(IDCT2,,WA)
         FETCH    (DCT3,R4,BA),(IDCT3,,WA)
         FETCH    (DCT4,R4,BA),IDCT4
         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,4)
         FORMAT   (TAB,TAD3),(HEX,IDCT1A,4)
         FORMAT   (TAB,TAD4),(HEX,IDCT2,3)
         FORMAT   (TAB,TAD5),(HEX,IDCT3,2)
         FORMAT   (TAB,TAD6),(HEX,IDCT4,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,8)
         FORMAT   (TAB,TAD12),(HEX,IDCT10,4)
         FORMAT   (TAB,TAD13),(HEX,IDCT11,8)
         FORMAT   (TAB,TAD14),(HEX,IDCT12,8)
         FORMAT   (TAB,TAD15),' '
         FORMAT   PRINT,END
         MTW,0    USER              WERE WE DOING OPTIONS
         BGZ      NEXT%DCTS         YES - CHECK FOR NEXT OPTION FIELD
         AI,X4    1                 INCREMENT TO NEXT DCT
         CLM,R4   DCTLIMS
         BCR,9    DCTLOOP           MORE TO GO YET...
*
*
NEXT%DCTS EQU     %
         MTW,0    USER              WERE DOING OPTIONS
         BEZ      GO%DCT1           NO - DO ALL OF THEM
         LW,R1    FIELD#            GET CURRENT FIELD#
         AI,R1    1                 BUMP
         LW,R2    FIELDS,R1         GET NEXT OPTION
         BEZ      GO%DCT1           NONE - DO NEXT
         LW,R2    0,R2              GET NEXT VALUE
         BEZ      GO%DCT1           NONE
         B        DCTSTRT           DO NEXT ONE
         PAGE
*
*        DO THE REST OF THEM
*
GO%DCT1  EQU      %
         LI,R2    0
         STW,R2   USER              CLEAR VALUE TO START AT TOP AGAIN
         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),END
*
*
DCT1STRT EQU      %
         BAL,R0   GETOPTION         GET OPTION FIELDS
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
         MTW,0    USER              DID WE DO JUST ONE
         BGZ      DCT1STRT          YEP - WE'RE ALL DONE HERE
         AI,R4    1
         CLM,R4   DCTLIMS
         BCR,9    DCTLOOP1          MORE TO GO YET....
         PAGE
*
*        SOME NEW DCT'S  --  PUT IN AT F00 TIME
*
DCT%1B   EQU      %
         LI,R2    0
         STW,R2   USER              CLEAR VALUE TO RESTART LOOP
         LI,R1    DCTMSG1           TITLE LINE
         BAL,R0   TITEL             PRINT IT
*
*        ADDITIONAL DCT HEADINGS
*
         FORMAT   START,(SKIP,2),(TAB,TAD001),'#',
         FORMAT   (TAB,TAD002),'26',(TAB,TAD003),'27',,
         FORMAT   (TAB,TAD004),'28',(TAB,TAD005),'29',
         FORMAT   PRINT
*
*        SECOND LINE OF HEADING
*
         FORMAT   (TAB,TAD001),'#',(TAB,TAD002),'****',
         FORMAT   (TAB,TAD003),'DEFR',(TAB,TAD004),'DEFR',
         FORMAT   (TAB,TAD005),'DEFR',
         FORMAT   PRINT
*
*        THIRD LINE OF HEADING
*
         FORMAT   (TAB,TAD002),'FECP',(TAB,TAD003),'I/O',
         FORMAT   (TAB,TAD004),'I/O',(TAB,TAD005),'I/O',
         FORMAT   PRINT
*
*        FOURTH LINE OF HEADING
*
         FORMAT   (TAB,TAD002),'****',(TAB,TAD003),'CTL',
         FORMAT   (TAB,TAD004),'STAT',(TAB,TAD005),'CNTR',
         FORMAT   PRINT,
         FORMAT   (SKIP,2),END
*
*        THAT'S THE HEADING
*           -NOW DO THE REST OF THE DCT'S
*
DCT%2B   EQU      %
         BAL,R0   GETOPTION         GET OPTIONS FIELD
DCT%3B   EQU      %
         STW,R4   DCTINDEX
         LI,R0    DCT26
         BE       DCT%4B
         FETCH    (DCT26,R4,WA),(IDCT26,,WA)
DCT%4B   EQU      %
         FETCH    (DCT27,R4,BA),(IDCT27,,WA)
         FETCH    (DCT28,R4,BA),(IDCT28,,WA)
         FETCH    (DCT29,R4,HA),(IDCT29,,WA)
DCT%5B   EQU      %
         LI,R0    DCT26
         BE       DCT%6B
         FORMAT   START,(TAB,TAD001),(HEX,DCTINDEX,2)
         FORMAT   (TAB,TAD002),(HEX,DCT26,2)
         FORMAT   END
         B        DCT%7B
DCT%6B   EQU      %
         FORMAT   START,(TAB,TAD001),(HEX,DCTINDEX,2)
DCT%7B   EQU      %
         FORMAT   (TAB,TAD003),(HEX,IDCT27,2),
         FORMAT   (TAB,TAD004),(HEX,IDCT28,2)
         FORMAT   (TAB,TAD005),(HEX,IDCT29,4)
         FORMAT   PRINT,
         FORMAT   END
DCT%8B   EQU      %
         MTW,0    USER              ONE USER?
         BGZ      DCT%2B            YES--FINISHED HERE
         AI,R4    1
         CLM,R4   DCTLIMS
         BCR,9    DCT%3B            MORE TO GO
*                                     -ELSE ALL DONE
         PULL     R1
         B        0,R1              RETURN TO MAIN ANALYZE....
         PAGE
*
*        GET POSSIBLE OPTION FIELD
*
GETOPTION EQU     %
         PSW,R0   STACK             SAVE RETURN
         MTW,0    USER              HAVE BEEN DOING OPTIONS
         BGZ      GETOPTION2        YES - JUMP
         LI,R1    2                 ALWAYS FIELD # 2
GETOPTION1 EQU    %
         BAL,R0   GETHEX            GO GET IT
         LW,R4    R2                RETURN IT IN R4
         STW,R4   USER              SAVE IT FOR TESTS
         PLW,R0   STACK             GET LINK
         B        *R0               AND EXIT
GETOPTION2 EQU    %
         LI,R6    GETOPTION1        RETURN POINT
         B        GETLIST           IF THERE IS AN OPTION LIST
         PAGE
*
*F*
*F*    NAME:           %CITS
*F*
*F*    PURPOSE:        TO DISPLAY THE CHANNEL INFO TABLES.
*F*
*F*    DESCRIPTION:    THE USER HAS THE OPTION OF IDENTIFYING UP
*F*                    TO 20 DIFFERENT CIT'S HE WOULD LIKE TO SEE
*F*                    DISPLAYED. %CITS USES THE ROUTINE 'GETLIST' TO
*F*                    SCAN THE COMMAND LINE RETURNING EACH OF
*F*                    THE VALUES THE USER HAS TYPED.
*F*
*F*                    IN THE GHOST 'ALL' MODE NO OPTION FIELDS ARE
*F*                    PRESENT SO %CITS WILL DISPLAY ALL OF THE CIT
*F*                    TABLES.
*F*
*
*        COMMAND FORMAT.
*
*        DI(SPLAY) CI(T)  (1)(,2)(,3)(,4)(,5)
*
*        NOTE THAT THE LIST IS OPTIONAL - LACK OF A LIST
*        IMPLIES TO DISPLAY ALL CIT TABLES
*
%CITS    EQU      %
         PUSH     R1                SAVE LINK
         LI,1     CITSMSG           SEND
         BAL,0    TITEL             TITLE LINE OUT
ICTAB0   EQU      1
ICTAB1   EQU      4
ICTAB2   EQU      9
ICTAB3   EQU      14
ICTAB4   EQU      19
ICTAB5   EQU      28
ICTAB6   EQU      33
*
*
         FORMAT   START
         FORMAT   (TAB,ICTAB0),'#'
         FORMAT   (TAB,ICTAB1),'CIT1'
         FORMAT   (TAB,ICTAB2),'CIT2'
         FORMAT   (TAB,ICTAB3),'CIT3'
         FORMAT   (TAB,ICTAB4),'CIT4'
         FORMAT   (TAB,ICTAB5),'CIT5'
         FORMAT   (TAB,ICTAB6),'CIT6'
         FORMAT   PRINT,(SKIP,1),END
*
*
CITSTRT  EQU      %
         BAL,R0   GETOPTION         GO SEE ABOUT POSSIBLE OPTION
         AI,R4    0
         BEZ      CITLOOP           NO OPTION GIVEN
         CLM,R4   CITLIMS           IN RANGE
         BCS,9    SCANNER           NOPE
*
CITLOOP  EQU      %
         STW,R4   ICITNUM           SAVE CURRENT INDEX INTO CIT'S
         FETCH    (CIT1,R4,BA),ICIT1
         FETCH    (CIT2,R4,BA),ICIT2
         FETCH    (CIT3,R4,BA),ICIT3
         FETCH    (CIT4,R4,WA),ICIT4
         FETCH    (CIT5,R4,BA),ICIT5
         FETCH    (CIT6,R4,BA),IIOQ10
*
*
         FORMAT   START
         FORMAT   (TAB,ICTAB0),(HEX,ICITNUM,2)
         FORMAT   (TAB,ICTAB1),(HEX,ICIT1,2)
         FORMAT   (TAB,ICTAB2),(HEX,ICIT2,2)
         FORMAT   (TAB,ICTAB3),(HEX,ICIT3,2)
         FORMAT   (TAB,ICTAB4),(HEX,ICIT4,8)
         FORMAT   (TAB,ICTAB5),(HEX,ICIT5,2)
         FORMAT   (TAB,ICTAB6),(HEX,IIOQ10,2)
         FORMAT   PRINT,END
         AI,X4    1                 TO NEXT                                  A00
         MTW,0    USER              DID WE DO JUST ONE
         BGZ      CITSTRT           YES - WE'RE DONE HERE
         CLM,R4   CITLIMS
         BCR,9    CITLOOP           MORE TO GO YET
         PULL     R1
         B        0,R1
         PAGE
*F*
*F*    NAME:           %IOQS
*F*
*F*    PURPOSE:        TO DISPLAY THE INPUT/OUTPUT QUEUEING TABLES.
*F*
*F*    DESCRIPTION:    THE USER HAS THE OPTION OF IDENTIFYING UP
*F*                    TO 20 DIFFERENT IOQ'S HE WOULD LIKE TO SEE
*F*                    DISPLAYED. %IOQS USES THE ROUTINE 'GETLIST'
*F*                    TO SCAN THE COMMAND LINE RETURNING EACH OF
*F*                    THE VALUES THE USER HAS TYPED.
*F*
*F*                    IN THE GHOST 'ALL' MODE NO OPTION FIELDS ARE
*F*                    PRESENT SO %IOQS WILL DISPLAY ALL OF THE IOQ
*F*                    TABLES.
*F*
*
*        COMMAND FORMAT.
*
*        DI(SPLAY)  IQ   (1)(,2)(,3)(,4)(,5)(,6)
*
*        NOTE THAT LIST IS OPTIONAL - THE LACK OF A LIST SPECIFIES
*        TO DUMP ALL OF THE IOQ TABLES.
*
%IOQS    EQU      %
         PUSH     L1
         LI,R1    IOQSMSG
         BAL,0    TITEL             TITLE LINE
         FORMAT   START,(SKIP,2)
ITAB0    EQU      1
ITAB1    EQU      4
ITAB2    EQU      8
ITAB3    EQU      12
ITAB4    EQU      17
ITAB5    EQU      21
ITAB6    EQU      25
ITAB7    EQU      34
ITAB8    EQU      39
ITAB9    EQU      48
ITAB10   EQU      53
ITAB11   EQU      57
ITAB12   EQU      61
ITAB13   EQU      70
ITAB131  EQU      79
ITAB14   EQU      88
ITAB15   EQU      93
ITAB16   EQU      98
*
*
         FORMAT   (TAB,ITAB0),' '
         FORMAT   (TAB,ITAB1),'1'
         FORMAT   (TAB,ITAB2),'2'
         FORMAT   (TAB,ITAB3),'3'
         FORMAT   (TAB,ITAB4),'4'
         FORMAT   (TAB,ITAB5),'5'
         FORMAT   (TAB,ITAB6),'6'
         FORMAT   (TAB,ITAB7),'7'
         FORMAT   (TAB,ITAB8),'8'
         FORMAT   (TAB,ITAB9),'9'
         FORMAT   (TAB,ITAB10),'10'
         FORMAT   (TAB,ITAB11),'11'
         FORMAT   (TAB,ITAB12),'12'
         FORMAT   (TAB,ITAB13),'13<-----'
         FORMAT   (TAB,ITAB131),'----->13'
         FORMAT   (TAB,ITAB14),'14'
         FORMAT   (TAB,ITAB15),'15'
         FORMAT   (TAB,ITAB16),'16'
         FORMAT   PRINT
*
*
         FORMAT   (TAB,ITAB0),'#'
         FORMAT   (TAB,ITAB1),'BAK'
         FORMAT   (TAB,ITAB2),'FWD'
         FORMAT   (TAB,ITAB3),'STAT'
         FORMAT   (TAB,ITAB4),'OFC'
         FORMAT   (TAB,ITAB5),'CFC'
         FORMAT   (TAB,ITAB6),'DCB ADRS'
         FORMAT   (TAB,ITAB7),'DCTX'
         FORMAT   (TAB,ITAB8),'BUF WA'
         FORMAT   (TAB,ITAB9),'CNT'
         FORMAT   (TAB,ITAB10),'NRT'
         FORMAT   (TAB,ITAB11),'NRA'
         FORMAT   (TAB,ITAB12),'DISC ADRS'
         FORMAT   (TAB,ITAB13),'EA ADRS'
         FORMAT   (TAB,ITAB131),'EA INFO'
         FORMAT   (TAB,ITAB14),'PRIO'
         FORMAT   (TAB,ITAB15),'USER'
         FORMAT   (TAB,ITAB16),'ECB'
         FORMAT   PRINT,(SKIP,2),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.
*
IOQSTRT  EQU      %
         BAL,R0   GETOPTION         GET POSSIBLE OPTION FIELD
         AI,R4    0                 GOT AN OPTION
         BEZ      IIOQLOOP          NOPE
         CLM,R4   IOQLIMS           IS IT VALID
         BCS,9    SCANNER           NOPE
IIOQLOOP STW,X4   IIOQNUM
         FETCH    (IOQ1,R4,BA),IIOQ1
         FETCH    (IOQ2,R4,BA),IIOQ2
         FETCH    (IOQ7,R4,BA),IIOQ7
         FETCH    (IOQ3,R4,BA),IIOQ3
         FETCH    (IOQ4,R4,BA),IIOQ4
         FETCH    (IOQ5,R4,BA),IIOQ5
         FETCH    (IOQ6,R4,WA),IIOQ6
         FETCH    (IOQ8,R4,WA),IIOQ8
         FETCH    (IOQ9,R4,HA),IIOQ9
         LW,R5    IIOQ8             **GET IOQ8 CONTENTS
         LW,R6    R5                TEST FOR SHORT PATH
         BEZ      IOQ8SET           GO - NOTHING TO SHIFT
         LC       R5                TEST FOR BA OR DW ADDRESS
         BCS,12   IOQ8DA            ITS A DBL WORD ADDRESS
         LB,R6    R5                HOLD FLAG BYTE IN R6
         AND,R5   =X'FFFFFF'        SCRUB TO LIMIT POSSIBLE FOR BA
         CI,R5    3                 IS BA ON BA BNDRY
         BANZ     IOQ8SET           YEP - DONT SHIFT IT OFF THE END
         SLS,R5   -2                ITS A BYTE ADDRESS - SHIFT INTO WA
         B        IOQ8SET           AND JUMP
IOQ8DA   EQU      %
         LB,R6    R5                HOLD FLAG BYTE
         AND,R5   ADMASK            MASK OFF FLAG FROM OBJECT WORD
         SLS,R5   1                 SHIFT DA INTO WA FORMAT
IOQ8SET  EQU      %
         STB,R6   R5                REPLACE FLAG
         STW,R5   IIOQ8             AND REPLACE THE WHOLE THING
         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
         FETCH    (IOQ16,R4,WA),IIOQ16
         FORMAT   START
         FORMAT   (TAB,ITAB0),(HEX,IIOQNUM,2)
         FORMAT   (TAB,ITAB1),(HEX,IIOQ1,2)
         FORMAT   (TAB,ITAB2),(HEX,IIOQ2,2)
         FORMAT   (TAB,ITAB3),(HEX,IIOQ3,2)
         FORMAT   (TAB,ITAB4),(HEX,IIOQ4,2)
         FORMAT   (TAB,ITAB5),(HEX,IIOQ5,2)
         FORMAT   (TAB,ITAB6),(HEX,IIOQ6,8)
         FORMAT   (TAB,ITAB7),(HEX,IIOQ7,2)
         FORMAT   (TAB,ITAB8),(HEX,IIOQ8,8)
         FORMAT   (TAB,ITAB9),(HEX,IIOQ9,4)
         FORMAT   (TAB,ITAB10),(HEX,IIOQ10,2)
         FORMAT   (TAB,ITAB11),(HEX,IIOQ11,2)
         FORMAT   (TAB,ITAB12),(HEX,IIOQ12,8)
         FORMAT   (TAB,ITAB13),(HEX,IIOQ13,8)
         FORMAT   (TAB,ITAB131),(HEX,IIOQ13+1,8)
         FORMAT   (TAB,ITAB14),(HEX,IIOQ14,2)
         FORMAT   (TAB,ITAB15),(HEX,IIOQ15,2)
         FORMAT   (TAB,ITAB16),(HEX,IIOQ16,8)
         FORMAT   PRINT,END
         AI,X4    1
         MTW,0    USER              DID WE DO JUST ONE
         BGZ      IOQSTRT           YES - WE'RE DONE HERE
         CLM,R4   IOQLIMS           HAVE WE DONE ALL THE TABLE
         BCR,9    IIOQLOOP          NOT YET
         B        SCANNER           YES--> RETURN TO DO MORE
         PAGE
*F*
*F*    NAME:           SYMTABLS
*F*
*F*    PURPOSE:        TO PRODUCE A FORMATTED DISPLAY OF THE OUTPUT
*F*                    SYMBIONT TABLES.
*F*
*F*    DESCRIPTION:    THE USER HAS INPUT EITHER A SINGLE OPTION
*F*                    FIELD OR NO OPTION;
*F*                    NO OPTION FIELD CAUSES ALL SYMBIONT TABLES
*F*                    TO BE DISPLAYED.
*F*                    THE SINGLE OPTION FIELD WILL CAUSE ONLY THAT
*F*                    SYMBIONT TABLE TO BE DISPLAYED.
*F*
*F*                    IN THE GHOST 'ALL' MODE NO OPTION FIELDS ARE
*F*                    PRESENT SO SYMTABLS WILL DISPLAY ALL OF THE
*F*                    SYMBIONT TABLES.
*F*
*
*        COMMAND FORMAT.
*
*        DI(SPLAY)  ST(ABLES)   (X)
*
*        NOTE THAT THIS DISPLAY DOES NOT TAKE A LIST - LACK
*        OF AN OPTION FIELD INDICATES TO DISPLAY ALL SYMBIONT
*        TABLE ENTRIES.
*
*        WHERE X STANDS FOR THE TABLE ROW YOU WANT TO SEE
*
SYMTABLS EQU      %
         PUSH     L1
         LI,R12   SNDDX
         BAL,R1   SVALCON           GET CONTENTS
         LB,R8    R15               LENGTH OF SYMBIONT TABLES
         STW,R8   ISYMMAX           SAVE LOOP VALUE
         LI,R1    SYMTMSG
         BAL,0    TITEL
         LI,R8    0
         STW,R8   CPOOL             ZAP OLD ENTRIES
         MTW,0    ISYMMAX           WAS SNDDX COUNT PROPER
         BGZ      SYMTABLS1         YEP
         MTW,1    ISYMMAX           SET IT UP BY ONE TO SHOW IT
         FORMAT   START
         FORMAT   (TAB,3),'**SNDDX BYTE ZERO HAS BEEN RESET'
         FORMAT   PRINT,(SKIP,3),END
AS0      EQU      0                 SYMBIONT TABLE INDEX COLUMN
AS1      EQU      3                 SQUE
AS2      EQU      8                 SNDDX
AS2A     EQU      14                TYPE (DCT16)
AS3      EQU      23                SSTAT
AS4      EQU      29                SSIG
AS5      EQU      34                SRET
AS6      EQU      43                SCNTXT
AS7      EQU      50                SYMX
AS8      EQU      1
AS9      EQU      11
ASA      EQU      55                TYP
ASB      EQU      59                LNK
ASC      EQU      63                FLAG
ASD      EQU      68                SUSP
ASE      EQU      73                QUE
*
SYMTABLS1 EQU     %
         LI,R0    MXSTRM                                                     A00
         STW,R0   ISMXSTRM                                                   A00
         FORMAT   START
         FORMAT   (TAB,1),'#',(TAB,AS1),'SQUE'
         FORMAT   (TAB,AS2),'SNDDX'
         FORMAT   (TAB,AS2A),'TYPE'
         FORMAT   (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),(SKIP,1),(END)
         BAL,R0   GETOPTION         GET POSSIBLE OPTION FIELD
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)
         LD,R8    IDCT16            PICK UP DEVICE TEXTC NAME
         SLD,R8   24                SHIFT OFF TEXTC/NEW LINE CHARS
         STD,R8   IDCT16            AND REPLACE
         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
         FORMAT   (TAB,AS0),(HEX,ISYMNUM,2)  **PRINT SYMBIONT INDEX
         FORMAT   (TAB,AS1),(HEX,ISQUE,2)
         FORMAT   (TAB,AS2),(HEX,ISNDDX,2),END
         CI,R4    0                 ON FIRST ROW
         BEZ      DO%FORMATS1       YES - JUMP
         FORMAT   START             NO
         FORMAT   (TAB,AS2A),(EBC,IDCT16,5),END
DO%FORMATS1 EQU   %
         FORMAT   START
         FORMAT   (TAB,AS3),(HEX,ISSTAT,2)
         FORMAT (TAB,AS4),(EBC,ISSIG,1),'=',END
         LB,R9    ISSIG
         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
         FORMAT   (TAB,ASA),(HEX,ISTYP,2)
         FORMAT   (TAB,ASB),(HEX,ISLNK,2)
         FORMAT   (TAB,ASC),(HEX,ISFLG,4)
         FORMAT   (TAB,ASD),(HEX,ISSUS,4)
         FORMAT   (TAB,ASE),(HEX,ISQ,2)
         FORMAT   END                                                        A00
SYMPRINT EQU      %
         FORMAT   START,PRINT,END   AND PRINT THE BUFFER OUT
         MTW,0    USER              DID WE DO JUST ONE
         BGZ      SYMPRINT1         YES - JUMP
         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
SYMPRINT1 EQU     %                 COME HERE IF ONLY ONE DONE
         MTH,0    CPOOL             WERE ANY CPOOLS FOUND
         BEZ      SYMRET            NOPE
         LI,R1    CPOOLMSG          TITLE LINE
         BAL,R0   TITEL             PUT OUT
         LI,R4    2                 TWO PASSES
NXT:PL   LH,R5    CPOOL             GET ENTRY COUNT
NXT:PL1  EQU      %
         LH,R14   CPOOL,R5          GET NEXT ADDRESS
         BEZ      NXT:PL2           NONE
         AND,R14  #R16              SCRUB SIGN EXTENSION
         CI,R4    2                 WORKING ON THE CPOOLS
         BNE      NXT:PL16          NO--SPOOLS---JUMP
         SLS,R14  1                 IF CPOOL--CHANGE TO WORD ADDRS
         STW,R14  IDCT4         **SAVE CPOOL ADDRESS**
         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
         PSW,R14  STACK         **SAVE SPOOL ADDRS
         LB,R7    *R8           GET SNDDX VALUE
         LI,R14   SYMX          AND THEN
         BAL,R0   GETADDR       RESTORE SYMX TABLE
         LB,R6    *R15,R7       GET VALUE FROM SYMX
         PLW,R14  STACK         RESTORE SPOOL ADDRS
         CI,R6    1             IS SPOOL A BYTE ADDRS
         BAZ      %+2           NO (OUTPUT) ITS A WA.
         SLS,R14  -2                YES - MAKE A WA OUT OF IT
         PSW,R4   STACK
         LW,R4    R14               MOVE SPOOL WORD ADDRESS
         BEZ      NO:SPOOL          NONE
         SLS,R4   -9                MAKE IT A PAGE #
         LCFI     10                LOAD SYMBIONT PAGE OWNER'S CODE
         STCF     PG:MODE           STORE IT
         BAL,R0   PAGETABLE         RECORD SYMBIONT PAGE  IN MATRIX
NO:SPOOL EQU      %
         PLW,R4   STACK
         SLS,R14  -8                SHIFT SO IT FITS  IN A HALF-WORD
         STH,R14  CPOOL,R5          INSERT INTO TABLE
NXT:PL15 EQU      %
         CI,R4    2                 CORRECT
         BE       NXT:PL18          YES--CPOOLS ARE 40 WORDS
NXT:PL16 EQU      %
         SLS,R14  8                 SHIFT SPOOL ADDRESS BACK INTO WA
         LI,R7    256               LOAD SPOOL SIZE
         B        NXT:PL19          AND MERGE
NXT:PL18 EQU      %
         LW,R14   IDCT4             RESTORE CPOOL ADDRESS
         LI,R7    40                CPOOL SIZE IN WORDS
NXT:PL19 EQU      %
         BAL,R0   GETADDR           FETCH TARGET BUFFER
         LW,R8    R15               MOVE BUFFER ADDRS FOR DUMP ROUTINE
         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
         LI,R1    SPOOLMSG          TITLE LINE
         BAL,R0   TITEL             PUT OUT
         BDR,R4   NXT:PL            DO SPOOLS NOW
NXT:PL3  EQU      %
SYMRET   PULL     L1
         B        0,L1
         PAGE
*F*
*F*    NAME:           ERROR%LOG
*F*
*F*    PURPOSE:        TO PRODUCE A DISPLAY CONTAINING THE INDIVIDUAL
*F*                    ERROR LOG MESSAGES CURRENTLY IN THE BUFFERS.
*F*
*F*    DESCRIPTION:    ERROR%LOG USES THE POINTERS IN THE BUFFERS
*F*                    TO SCAN THRU DUMPING THE INDIVIDUAL RECORDS.
*F*                    VALIDATION OF EACH RECORD AND ITS POINTERS
*F*                    ALSO TAKES PLACE AS IT GOES THRU THE BUFFERS.
*F*                    ANY ERROR WILL PRODUCE A SNAP WITH AN
*F*                    APPROPRIATE ERROR MSG.
*F*
*
*        COMMAND FORMAT.
*
*        DI(SPLAY)  EL(OG)
*
*        NOTE THAT THERE IS NO OPTION FIELDS FOR THIS COMMAND
*
ERROR%LOG  EQU    %                                                          A00
         PSW,R1   STACK                                                      A00
         LI,R1    ELOG%HDG1                                                  A00
         BAL,R0   TITEL                                                      A00
         LI,R12   C:MSM             MILLISECONDS SINCE MIDNIGHT
         BAL,R1   SVALCON
         STW,R15  IDCT2             SAVE IT..
         FORMAT   START
         FORMAT   (SKIP,1),'** C:MSM = ',(HEX,IDCT2,8)
         FORMAT   PRINT,(SKIP,1),END
         LI,R14   CURBUF            ERROR LOG BUFFER POINTER
         MTW,1    LOOKING           ONLY NEED ONE PAGE FOR THIS FETCH
         BAL,R0   GETADDR           PICK IT UP
         LW,R4    *R15              GET POINTER
         CI,R4    BUF1              IS BUFFER # 1
         BE       BUFFEROK          YEP
         CI,R4    BUF2              IT HAD BETTER BE BUF2
         BNE      BAD%LOG           ERROR LOG BLEW IT
BUFFEROK EQU      %
         LW,R14   R4                LOAD CURBUF ADDRESS
         STW,R14  RC%BUF            STORE BEGINNING BUFFER WA
         AI,R14   BUFTSIZ           HIGHEST ADDRESS IN BUFFER
         STW,R14  RC%BUF+1          CREATE CLM PAIR
         BAL,R0   SCAN%BUF          GO PRINT OUT CONTENTS
         LW,R14   RC%BUF            GET THE ONE WE JUST DID
         CI,R14   BUF1              WAS IT BUF1
         BNE      BUFFEROK1         NOPE
         LI,R14   BUF2              YEP
         B        BUFFEROK2
BUFFEROK1 LI,R14  BUF1              WHICHEVER...
BUFFEROK2 STW,R14 RC%BUF            STORE WHICHEVER ONE WE DO NEXT
         AI,R14   BUFTSIZ           ADD LENGTH OF BUFFERS
         STW,R14  RC%BUF+1
         BAL,R0   SCAN%BUF
         B        SCANNER           AND RETURN FOR NEXT DISPLAY
         PAGE
*
*        SCAN THRU THE ERROR LOG BUFFER PICKING OUT
*        ERROR LOG ENTRIES
*
SCAN%BUF EQU      %
         PSW,R0   STACK             SAVE RETURN LINK
         LI,R3    3                 INITIALIZE FIRST INDEX INTO BUFFER
BUFLOOP  EQU      %
         LW,R14   RC%BUF            CURRENT BUF BASE ADDRESS
         BAL,R0   GETADDR           GO REFRESH R15 AGAIN.....
         LW,R6    R3                CURRENT INDEX INTO BUFFER
         SLS,R6   1                 INTO HALF WORD INDEX
         LH,R6    *R15,R6           GET CODE / COUNT
         BLEZ     BUFCHK            MEBBE AN ERROR
         LW,R5    R6                MOVE CODE AND COUNT
         SLS,R5   -8                POSITION CODE
         CLM,R5   LOG:CODES         FIT INTO SCHEME OF THINGS
         BCS,9    BUFCHK            NO
         AND,R6   #RFF              MASK COUNT
         CLM,R6   LOG:CNTS          COUNT FIT
         BCS,9    BUFCHK            NOPE
         LW,R14   RC%BUF            CURRENT BUFFER WE'RE ON
         AW,R14   R3                ADD IN CURRENT INDEX
         CLM,R14  RC%BUF            STILL IN RANGE
         BCS,9    BUFCHK            NOPE - GET OUT OF HERE
         BAL,R0   GETADDR           GO GET IT
         LW,R8    R15               BUFFER WA WE HAVE
         LI,R2    1                 INDEX TO SIZE
         LB,R7    *R15,R2           GET COUNT
         CLM,R7   LOG:CNTS          COUNT FIT
         BCS,9    BUFCHK            NO - SEE IF ERROR
         BAL,R0   BLANK1            PUT OUT A BLANK LINE BETWEEN EM.
         BAL,R0   DUMPSOME          DUMP IT
         AW,R3    R7                UPDATE INDEX INTO BUFFER
         B        BUFLOOP           DO NEXT ONE
BUFDONE  EQU      %
         PLW,R0   STACK             RETRIEVE LINK
         B        *R0               AND RETURN TO NEXT BUFFER
BUFCHK   EQU      %
         LW,R14   RC%BUF            GET CURRENT BUFFER POINTER
         AI,R14   -1                BUF-1 HAS NEXT WA POINTER
         BAL,R0   GETADDR           REAQUIRE IT
         INT,R5   *R15              GET NEXT WA POINTER
         BCS,4    BUFDONE           BUFFER BEING WRITTEN OUT NOW
         SW,R5    RC%BUF            CALCULATE # OF WORDS IN USE
         BLEZ     BUFDONE           ALL DONE W/BUFFER
         CW,R3    R5                DID WE JUST GO PAST END SPOT
         BGE      BUFDONE           YES - OUR MISTAKE
         FORMAT   START
         FORMAT   (SKIP,2),(TAB,3)
         FORMAT   '** BUFFER CONTAINS INVALID ENTRIES'
         FORMAT   PRINT,(SKIP,2),END
         LW,R14   RC%BUF            BUFFER WE'RE ON
         AI,R14   -1                POINT TO NAV WORD
         BAL,R0   GETADDR           INSURE WE GOT IT
         LW,R8    R15               POINTER FOR DUMPSOME
         LI,R7    BUFTSIZ+1         ONE BUFFERS WORTH
         BAL,R0   DUMPSOME          DUMP THIS BUFFER OUT
         B        BUFDONE           ADVANCE TO NEXT BUFFER
         PAGE
*
*        ERROR LOG POINTERS CLOBBERED
*
BAD%LOG  EQU      %
         FORMAT   START
         FORMAT   (SKIP,2),(TAB,3)
         FORMAT   '** CURRENT BUFFER POINTER DESTROYED'
         FORMAT   PRINT,(SKIP,2),END
BUFSNAP  EQU      %
         LI,R14   CURBUF-2          FIRST LOCATION TO DUMP
         BAL,R0   GETADDR           GO GET IT
         LW,R8    R15               POINTER FOR DUMPSOME
         LI,R7    (BUF2+BUFTSIZ+1)-CURBUF
         BAL,R0   DUMPSOME          DUMP OUT THOSE TABLES
         B        SCANNER
         PAGE
*F*
*F*    NAME:           RAT%TABLES
*F*
*F*    PURPOSE:        TO PRODUCE A FORMATTED DISPLAY OF ALL THE
*F*                    RESOURCE ALLOCATION TABLES.
*F*
*F*    DESCRIPTION:    EACH RESOURCE IS DISPLAYED ALONG WITH ITS
*F*                    CONTROLING TABLES (LIMITS,MAX,DEFAULT,ETC..)
*F*
*
*        COMMAND FORMAT.
*
*        DI(SPLAY)  RA(TS)
*
*        NOTE THAT THERE IS NO OPTION FIELD FOR THIS COMMAND
*
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
         PAGE
*F*
*F*    NAME:           AVR%TABLES
*F*
*F*    PURPOSE:        TO PRODUCE A FORMATTED DISPLAY OF ALL THE
*F*                    AUTOMATIC VOLUMN RECOGNITION (HENCE..AVR)
*F*                    TABLES.
*F*
*F*    DESCRIPTION:    EACH OF THE AVR TABLES IS TAKEN AND DISPLAYED
*F*                    INCLUDING THE REMOVABLE DISC PACKS.
*F*
*
*        COMMAND FORMAT.
*
*        DI(SPLAY)  AV(R TABLES)
*
*        NOTE THAT THERE IS NO OPTION FIELD FOR THIS COMMAND
*
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
         LI,R5    BATAPE-1
         STW,R5   IDCT2             INITIALIZE DCTX GOODIE...
AVR%LOOP EQU      %                                                          A00
         AI,X4    1                                                          A00
         MTW,1    IDCT2             BUMP DCT INDEX COUNTER
         FETCH    (ASAVR(1),X4,DA),(ISAVR(1),,DA)                            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
         LW,R7    IDCT2             GET CURRENT DCT INDEX
         FETCH    (DCT1P,R7,HA),(IDCT3,,WA)
         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
         FORMAT   (TAB,TAVR(1)),(HEX,IDCT2,2)  **PRINT DCT INDEX
         FORMAT   (TAB,TAVR(2)),(HEX,IDCT3,4)  ***DEVICE ADDRESS
         FORMAT   (TAB,TAVR(3)),(EBC,ISAVR(1),4) **SERIAL #
         FORMAT   (TAB,TAVR(4)),(HEX,ISAVR(2),1),END
         MTW,0    TP%CNTR           DOING TAPE DISPLAY
         BLEZ     DO%PK1            NO
         FORMAT   START,(TAB,TAVR(5)),(HEX,ISAVR(3),1),END
DO%PK1   EQU      %
         FORMAT   START
         FORMAT   (TAB,TAVR(6)),(HEX,ISAVR(4),1)
         FORMAT   (TAB,TAVR(7)),(HEX,ISAVR(5),1)
         FORMAT   (TAB,TAVR(8)),(HEX,ISAVR(6),1)
         FORMAT   (TAB,TAVR(9)),(HEX,ISAVR(7),1)
         FORMAT   (TAB,TAVR(10)),(HEX,ISAVR(8),1),END
*
*
         MTW,0    TP%CNTR           DOING TAPE TABLE
         BLEZ     DO%PK2            NO
*
         FORMAT   START
         FORMAT   (TAB,TAVR(11)),(HEX,ISAVR(9),1),END
DO%PK2   EQU      %
*
         FORMAT   START
         FORMAT   (TAB,TAVR(12)),(HEX,ISAVR(10),2)
         FORMAT   (TAB,TAVR(13)),(HEX,ISAVR(11),4)
         FORMAT   (TAB,TAVR(14)),(HEX,ISAVR(12),3)
         FORMAT   (TAB,TAVR(15)),(HEX,ISAVR(13),2)
         FORMAT   (TAB,TAVR(16)),(HEX,ISAVR(14),4)
         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
         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   EQU      %
         PUSH     6,X4
         LI,R4    BA(OBUF)          SET R4 WITH BYTE ADDRESS OF BUFFER
         AI,R1    -1                ADJUST R1 TO POINT CORRECTLY
         PAGE
*
*        REGISTER CONVENTIONS WITHIN FORMAT ROUTINES
*
*        R1 -     ADDRESS OF SPECIFICATION WORD
*        R4 -     CURRENT BA WITHIN PRINT BUFFER
*        R5 -     COMMAND IMAGE (POINTED TO BY R1)
*        R6 -     SCRATCH/USED BY SUB-PROGRAM
*        R7 -     SCRATCH/USED BY SUB-PROGRAM
*        R8 -     SCRATCH/USED BY SUB-PROGRAM
*
FLOOP    EQU      %                 LOOP RETURN POINT
         AI,L1    1                 GET NEXT FORMAT SPEC
         LW,X5    0,L1                EXACT IMAGE IN X5
         LW,X6    0,L1                COPY TO X6
         SCS,X6   13                  & ISOLATE OPCODE FIELD
         AND,X6   #R1F
         EXU      FXFER-1,R6        DISPATCH TO PROPER 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
         PAGE
*
*        MOVE EBCDIC INTO PRINT BUFFER
*
EBC      EQU      %
         LB,R7    R5                GET COUNT
         AWM,R7   TABPOS            AND UPDATE COLUMN POSITION IN BUFR
EBCA1    LB,R6    0,R5              GET A BYTE
         LB,R6    TRANTAB,R6        GET EBCDIC BYTE                          A00
EBC1     STB,R6   0,R4              MOVE TO PRINT LINE
         AI,R4    1                 BUMP DEST BA
         AI,R5    1                 BUMP DEST BA
         MTB,-1   X5                  AND DECREMENT COUNT OF REMAINING BYTES
         BNEZ     EBCA1
         B        FLOOP
         PAGE
*
*        HEX CONVERSIONS ASSUMES THAT QUANTITIES ARE RIGHT ADJUSTED
*
*        IT CONVERTS 4 BIT QUANTITIES (OFTEN CALLED 'NIBBLES') INTO
*        8 BIT QUANTITIES (OFTEN CALLED 'BYTES').  THE COUNT PASSED
*        TO HEX IS THE NUMBER OF BYTES TO PLACE IN THE OUTPUT LINE
*
*        ASSUME A WORD CONTAINS, IN HEX, 01234567.  THE REQUEST FOR ONE
*        OUTPUT BYTE WOULD CAUSE HEX TO PICK UP THE NIBBLE 7 AND
*        CONVERT IT TO THE BYTE F7 - THE PRINTABLE REPRESENTATIONOF 7.
*        IF HEX WERE PASSED AN OUTPUT BYTE COUNT OF 8, IT WOULD CONVERT
*        ALL 8 NIBBLES.  A COUNT OF 5 CAUSES IT TO CONVERT 34567 TO
*        PRINTABLE REPRESENTATION.
*
*        IF THE COUNT WERE 11,HOWEVER, HEX ASSUMES THAT IT IS BEING PASSED
*        A DOUBLE WORD AND THAT THE 11 NIBBLES ARE RIGHT ADJUSTED WITHIN
*        THE DOUBLE WORD.  THUS 01234567 ABCDEF01 WOULD CAUSE
*        567ABCDEF01 TO BE CONVERTED.  HEX IS LIMITED TO HANDLING OUTPUT
*        BYTE COUNTS IN THE RANGES 0<N=<16 OR N=8,16,24,32,....
*
*
*
HEX      LB,X6    X5                GET # OF BYTES REQSTD
         AWM,R6   TABPOS            UPDATE TAB POSITION IN BUFR
         CI,X6    7                 EXACT MULTIPLE OF 7 ?
         BAZ      HEXEXCT           YES-GO
         CI,X6    15                METHOD HANDLES DOUBLEWORD MAX
         BG       FORMATER            FORGET IT
         MOVE,8   (0,X5),A8       GET ENTIRE DOUBLEWORD
         SLS,X5   -22               TYPICAL* 5-->20  7--28  11-->44
         AND,X5   #R1C                           20     28       12
         LCW,X5   X5                            -20    -28      -12
         AI,X5    32                             12      4       20
         SLD,A8   0,X5              DO CALCULATED SHIFT
         MOVE,8   A8,X7           MOVE TO REGS USED WITHIN FORMAT
         LW,X5    *L1               REACQUIRE SPECIFICATION WORD
         AND,X5   #LFF              RETAIN BYTE COUNT
         AI,X5    BA(X7)            CHANGE ADDRESS TO CONSTRUCTED WORD
HEXEXCT  LB,X6    0,X5              GET BYTE TO CONVERT
         SLS,X6   -4                ISOLATE LEFT HALF
         LB,X6    HEXCHAR,X6
         STB,X6   0,X4              PUT IN DEST
         AI,X4    1
         MTB,-1   X5                DECR BYTE COUNT IN OUTPUT
         BEZ      FLOOP
         LB,X6    0,X5
         AND,X6   #RF
         LB,X6    HEXCHAR,X6
         STB,X6   0,X4
         AI,R4    1                 BUMP DEST BA
         AI,R5    1                 BUMP DEST BA
         MTB,-1   X5
         BNEZ     HEXEXCT
         B        FLOOP
HEXCHAR  TXT      '0123456789ABCDEF'
         PAGE
*
*        FOLLOWING CODE DISABLED TO NO LONGER IN USE BY ANALZO2 - IF
*        AT SOME TIME SOMEONE WISHES TO USE IT YOU CAN
*
         DO       0
OPCODE   LW,A8    0,X5              FETCH INSTRUCTION WORD
         LH,X6    A8                IF WORD IS ALL 1'S IN HIGH
         CI,X6    -1                  16 BITS, ASSUME IT IS NOT INSTR.
         BE       NOTOP               WOULD BE DST,F   *ADRS,7 IF SO.
MAYBEOP  RES      0
         LW,A8    0,X5              REFETCH ENTIRE INSTRUCTION
         LB,X7    A8                ISOLATE HIGH BYTE (INDIRECT AND OPCODE)
         AND,X7   #R7F              MASK OUT INDIRECT, LEAVING OPCODE
         LB,X7    LEGALOPS,X7       ANALYZE OPCODE TYPES
         B        OPTYPE,X7
OPTYPE   B        NOTOP             0 - LEGALOPS INDEX
         B        BCROP             1
         B        BCSOP             2
         B        SHIFTOP           3
         B        LCFIOP            4
         B        IMMEDOP           5
         B        OTHEROP           6
BCROP    LI,X7    1                 FETCH BYTE 1
         LB,X7    A8,X7               OF INSTRUCTION WORD
         SLS,X7   -4                ISOLATE R FIELD
         AND,X7   #RF
         CI,X7    4                 CHECK FOR SPECIAL MNEMONICS
         BGE      OTHEROP             TOO BIG-RETURN BCR
         LW,X7    BCREQV,X7         IS SPECIAL MNEMOIC -RETURN IT
         B        PLACEOP
BCREQV   TXT      'B   BGE BLE BE  '
BCSOP    LI,X7    1                 SIMILAR TO BCROP - SEE COMMENTS THER
         LB,X7    A8,X7
         SLS,X7   -4
         AND,X7   #RF
         CI,X7    4
         BGE      OTHEROP
         LW,X7    BCSEQV,X7
         B        PLACEOP
BCSEQV   TXT      'NOP BL  BG  BNE '
SHIFTOP  LW,X7    A8                IS INDIRECT BIT ON IN SHIFT ?
         BLZ      NOTOP               YES - TREAT AS NO SHIFT
SHIFNIND SLS,X7   -8
         AND,X7   #R7               ISOLATE SHIT TYPE BITS
         CI,X7    6                 ARE THEY LEGAL
         BGE      NOTOP               NO-NOT VALID SHIFT OPCODE
         LW,X7    SHIFTEQV,X7         YES- USE SPECIAL SHIFT OPCODE
         B        PLACEOP
SHIFTEQV TXT      'SLS SLD SCS SCD SAS SAD '
LCFIOP   LI,X7    1                 SIMILAR TO BCROP-SEE COMMENTS THERE
         CW,A8    #R80CFFF08        UNUSED BITS IN LCFI OFF ?
         BANZ     NOTOP               NO
         LB,X7    A8,X7
         SLS,X7   -4
         AND,X7   #RF
         CI,X7    4
         BGE      NOTOP
         LW,X7    LCFIEQV,X7
         B        PLACEOP
LCFIEQV  TXT      'NOP LFI LCI LCFI'
IMMEDOP  CI,A8    0                 DOES IMMED HAVE *
         BGZ      OTHEROP             NO - GO PROCESS
         B        NOTOP               YES-IS NOT VALID OPCODE
OTHEROP  LW,A8    0,X5              RE-FETCH INSTRUCTION WORD
         LB,X7    A8
         AND,X7   #R7F              STRIP * BIT FROM OPCODE
         LW,X7    OPCODES,X7
PLACEOP  MOVE,4   X7,(0,X4)         PLACE OPCODE IN PRINT LINE
         LI,R7    4                 CHAR COUNT MOVED
         AWM,R7   TABPOS            UPDATE TAB POSITION IN BUFR
         AW,R4    R7                KEEP R4 ACCURATE ALSO
         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
         PAGE
*
*        TRANSLATE TABLE  OPCODE # ---> OPCODE MNEMONIC
*
*                  0   1   2   3   4   5   6   7
*                  8   9   A   B   C   D   E   F
*
OPCODES  TEXT     '        LCFI    CAL1CAL2CAL3CAL4'       0
         TEXT     'PLW PSW PLM PSM         LPSDXPSD'       0
         TEXT     'AD  CD  LD  MSP     STD         '       1
         TEXT     'SD  CLM LCD LAD                 '
         TEXT     'AI  CI  LI  MI  SF  S           '       2
         TEXT     'CVS CVA LM  STM         WAITLRP '       2
         TEXT     'AW  CW  LW  MTW     STW DW  MW  '       3
         TEXT     'SW  CLR LCW LAW                 '
         TEXT     'TTBSTBS         ANLZCS  XW  STS '       4
         TEXT     'EOR OR  LS  AND SIO TIO TDV HIO '       4
         TEXT     'AH  CH  LH  MTH     STH DH  MH  '       5
         TEXT     'SH      LCH LAH                 '       5
         TEXT     'CBS MBS     EBS BDR BIR AWM EXU '       6
         TEXT     'BCR BCS BAL INT RD  WD  AIO MMC '       6
         TEXT     'LCF CB  LB  MTB STCFSTB PACKUNPK'       7
         TEXT     '                                '
         FIN                        END OF DISABLED CODE
         PAGE
*
*        MOVE INDIVIDUAL BITS INTO PRINT BUFFER
*
BIT      MOVE,4   (0,X5),A9         PICK UP 4 BYTES FROM SOURCE
         LB,R7    R5                GET COUNT
         AWM,R7   TABPOS            AND ADVANCE COLUMN POINTER
BITLOOP  LI,A8    0
         SLD,A8   1                 GET HIGH BIT
         OR,A8    #RF0              ADD PRINT INFO
         STB,A8   0,X4
         AI,X4    1
         MTB,-1   X5
         BNEZ     BITLOOP
         B        FLOOP
         PAGE
*
*        TRANSFER RECORD TO PRINT BUFFER
*
*        INPUT:   R5 CONTAINS SOURCE BYTE ADDRESS
*                 R4 CONTAINS DEST.  BYTE ADDRESS
*
MOVE     EQU      %
         LB,R6    R5                GET COUNT
         AWM,R6   TABPOS            ADVANCE COLUMN POSITION IN BUFR
         AND,R5   #R7FFFF           MASK SBA
         XW,R4    R5                SBA TO R4 / DBA TO R5
         STB,R6   R5                INSERT COUNT
         AI,R6    3                 ROUND UP
         SLS,R6   -2                TOTAL WORD COUNT IN TEXT STRING
         AW,R1    R6                ADVANCE R1 BY WORD COUNT IN TEXT
         MBS,R4   0                 MOVE RECORD INTO PLACE
         XW,R4    R5                PUT DEST. BACK INTO R4 FOR FURTHER USE
         B        FLOOP             GO EXECUTE NEXT COMMAND
         PAGE
*
*        NOT A VIABLE OPCODE - MOVE BLANKS INTO BUFFER
*
         DO       0
NOTOP    EQU      %
         LW,R7    #CBLANKS          OPCODE NOT PROPER - LOAD BLANKS
         B        PLACEOP           GO INSERT BLANKS INTO PRINT BUFFER
         FIN
         PAGE
*
*        TAB TO SPECIFIED POSITION IN BUFFER
*
TAB      EQU      %
         SLS,R5   -24               SHIFT TO EXTRACT NEW TAB POSITION
         CW,R5    PTR               IS PASSED VALUE .LT. CURRENT
         BL       %+2               YUP----> JUMP
         STW,R5   PTR               ELSE REMEMBER NEW HIGH..
         LI,R4    BA(OBUF)          RE-INIT R4 WITH PRINT BUF PTR
         AW,R4    R5                POINT TO PROPER SPOT IN BUF
         B        FLOOP             AND MERGE UP
         PAGE
*
*        SPACE BY COUNT TO POSITION IN PRINT BUFFER
*
SPACE    EQU      %
         SLS,R5   -24               EXTRACT COUNT
         AWM,R5   PTR               BOOST PRINT BUFFER SIZE
         AW,R4    R5                UPDATE PRINT BUFFER POINTER
         B        FLOOP             AND MERGE UP
         PAGE
*
*        END - EXIT TO CALLER
*
OPCODE   EQU      %                 REMOVE WHEN YOU WANT TO USE CODE
PLACEOP  EQU      %                 "  "  "  DITTO "  "  "  "
END      RES      0
         PULL     6,X4
         B        1,L1
         PAGE
*
*        PRINT THE BUFFER
*
*
PRINT    EQU      %                 INTERNAL (FORMAT) ENTRY
         PRINT    OBUF              PRINT ONLY WHAT WE HAVE MOVED
         LI,R0    0
         XW,R0    PTR               OBTAIN END OF BUFFER COUNTER
         STW,R1   LOCALSV           SAVE R1 FOR A FEW INSTRUCTION
         LI,R1    BA(OBUF)          BASE B.A
         STB,R0   R1                INSERT COUNT
         LW,R0    BLWORD            GET MBS REGISTER LOADED
         MBS,R0   0                 AND BLANK BUFFER
         LW,R1    LOCALSV           RESTORE R1
         LI,R4    BA(OBUF)          RESTORE R4 TO BEGINNING BYTE ADDRS
         B        FLOOP
         PAGE
*
*        SKIP BLANK LINES
*
SKIP     EQU      %
         SLS,R5   -24               ISOLATE COUNT
         AND,R5   #R1F              LIMIT MAX TO 31
         BAL,R0   BLANK1            PRINT BLANK LINE
         BDR,R5   %-1               FINISH W/COUNT
         B        FLOOP             GO TO NEXT COMMAND
         PAGE
*
*        CONVERT VALUE AND MOVE TO PRINT BUFFER IN DECIMAL MODE
*
DECIMAL  RES      0                 BINARY TO DECIMAL CONVERSION
         LB,X6    X5                GET BYTE COUNT OF LINE TO PUT
         AWM,R6   TABPOS            UPDATE TAB POSITION IN BUFFER
         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 EQU      END
         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   EQU      %
         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      0,R1               YUP - RETURN TO CALLER
         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
         PAGE
*
*        RUN THE MULTI-PROCESSING TABLES
*
MP1      EQU      1
MP2      EQU      3
MP3      EQU      8
MP4      EQU      13
MP5      EQU      16
MP6      EQU      21
MP7      EQU      26
MP8      EQU      31
MP9      EQU      36
MPA      EQU      41
MPB      EQU      46
MPC      EQU      51
MPD      EQU      56
MPE      EQU      61
MPF      EQU      66
MP10     EQU      70
MP11     EQU      77
*
MPTABLES EQU      %
         LI,R1    MPTITLE           PUT OUT THE
         BAL,R0   TITEL             TITLE LINE
         LI,R1    NSCPU             IS THIS A MULTI-PROCESSING SYSTEM
         BEZ      NOTRACE           NOPE
         FORMAT   START,(SKIP,2)
         FORMAT   (TAB,MP1),'#',(TAB,MP2),'ADR',(TAB,MP3),'INIT'
         FORMAT   (TAB,MP4),'ST',(TAB,MP5),'PCUN',(TAB,MP6)
         FORMAT   'MINQ',(TAB,MP7),'MAXQ',(TAB,MP8),'MPSW'
         FORMAT   (TAB,MP9),'PFLG',(TAB,MPA),'MINT',(TAB,MPB)
         FORMAT   'SFLG',(TAB,MPC),'RCVR',(TAB,MPD),'RCVA'
         FORMAT   (TAB,MPE),'EFLG',(TAB,MPF),'FLT',(TAB,MP10)
         FORMAT   'EADR',(TAB,MP11-2),'SCRCH'
         FORMAT   PRINT,(SKIP,1),END
*
*
MPTABLE0 EQU      %
         BAL,R0   GETOPTION         GO GET POSSIBLE OPTION
         LI,R5    NSCPU+1           LOAD LENGTH OF TABLES
         STW,R5    DCTSIZE          SAVE FOR LOOPE THRU TABLES
MPTABLE1 EQU      %
         STW,R4    DCTINDEX         SAVE CURRENT INDEX
         FETCH    (S:ADR,R4,WA),IDCT1A
         FETCH    (SB:INIT,R4,BA),IDCT2
         FETCH    (SB:STATE,R4,BA),IDCT3
         FETCH    (S:PCUN,R4,WA),IDCT4
         FETCH    (SH:MINQ,R4,HA),IDCT5
         FETCH    (SH:MAXQ,R4,HA),IDCT6
         FETCH    (SB:MPSW,R4,BA),IDCT7
         FETCH    (SB:PFLG,R4,BA),IDCT8
         FETCH    (SB:MINT,R4,BA),IDCT9
         FETCH    (SB:SFLG,R4,BA),IDCT10
         FETCH    (SB:RCVR,R4,BA),IDCT11
         FETCH    (SB:RCVA,R4,BA),IDCT12
         FETCH    (FB:EFLG,R4,BA),IDCT13
         FETCH    (FB:FLT,R4,BA),IDCT14
         FETCH    (F:EADDR,R4,WA),IDCT15
         FETCH    (FH:SCRCH,R4,HA),IDCT16
*
*
         FORMAT   START
         FORMAT   (TAB,MP1),(HEX,DCTINDEX,2)
         FORMAT   (TAB,MP2),(HEX,IDCT1A,4)
         FORMAT   (TAB,MP3),(HEX,IDCT2,2)
         FORMAT   (TAB,MP4),(HEX,IDCT3,2)
         FORMAT   (TAB,MP5),(HEX,IDCT4,4)
         FORMAT   (TAB,MP6),(HEX,IDCT5,4)
         FORMAT   (TAB,MP7),(HEX,IDCT6,4)
         FORMAT   (TAB,MP8),(HEX,IDCT7,2)
         FORMAT   (TAB,MP9),(HEX,IDCT8,2)
         FORMAT   (TAB,MPA),(HEX,IDCT9,2)
         FORMAT   (TAB,MPB),(HEX,IDCT10,2)
         FORMAT   (TAB,MPC),(HEX,IDCT11,2)
         FORMAT   (TAB,MPD),(HEX,IDCT12,2)
         FORMAT   (TAB,MPE),(HEX,IDCT13,2)
         FORMAT   (TAB,MPF),(HEX,IDCT14,2)
         FORMAT   (TAB,MP10-1),(HEX,IDCT15,6)
         FORMAT   (TAB,MP11-1),(HEX,IDCT16,4)
         FORMAT   PRINT,END
         AI,R4    1                 NEXT TABLE SLOT
         MTW,0    USER              WERE DOING OPTIONS
         BNEZ     MPTABLE2          YUP
         MTW,-1    DCTSIZE          NOPE
         BGZ      MPTABLE1          DO NEXT  ROW
         B        SCANNER           ALL DONE
*
*        CHECK FOR NEXT OPTION NUMBER
*
MPTABLE2 EQU      %
         LW,R1    FIELD#            GET CURRENTFIELD NUM
         AI,R1    1
         LW,R2    FIELDS,R1         GET NEXT FIELD ADDRS
         BEZ      SCANNER           AT END
         LW,R2    0,R2              GET NEXT OPTION VALUE
         BEZ      SCANNER           ALL DONE
         B        MPTABLE0          DO NEXT OPTION
MPHDR    EQU      %
         TEXTC    '#  ADR  INIT STATE PCUN MINQ MAXQ MPSW PFLG',;
                  ' MINT SFLG RCVR RCVA EFLG FLT  EADDR    SCRCH '
*
         PAGE
*
*        RUN DISPLAY OF GHOST JOBS
*
GHTABLES EQU      %
         LI,R1    GHTITLE
         BAL,R0   TITEL
         FORMAT   START,(SKIP,2)
         FORMAT   (TAB,1),'#'
         FORMAT   (TAB,4),'NAME'
         FORMAT   (TAB,14),'USER#'
         FORMAT   (TAB,21),'ACCOUNT'
         FORMAT   PRINT,(SKIP,1),END
*
*
GHTABLE0 EQU      %
         BAL,R0   GETOPTION
         LI,R5    MAXG
         STW,R5   DCTSIZE           STORE  MAX LENGTH OF TABLES
GHTABLE1 EQU      %
         STW,R4   DCTINDEX          SAVE CURRENT  INDEX
         FETCH    (S:GJOBTBL,R4,DA),(IDCT13,,DA)
         FETCH    (SB:GJOBUN,R4,BA),IDCT14
         FETCH    (S:GJOBACN,R4,DA),(IIOQ13,,DA)
*
*
         FORMAT   START
         FORMAT   (TAB,1),(HEX,DCTINDEX,2)
         FORMAT   (TAB,4),(EBC,IDCT13,8)
         FORMAT   (TAB,14),(HEX,IDCT14,2)
         FORMAT   (TAB,21),(EBC,IIOQ13,8)
         FORMAT   PRINT,END
*
*
         AI,R4    1                 NEXT SLOT
         MTW,0    USER              WERE DOING OPTIONS
         BNEZ     GHTABLE2          YUP
         MTW,-1   DCTSIZE           NO
         BGEZ     GHTABLE1          DO NEXT SLOT
         B        SCANNER
*
*
GHTABLE2 EQU      %
         B        GHTABLE0          GET NEXT FIELD
*
GH:HDR   EQU      %
         TEXTC    '#   NAME      USER#  ACCOUNT'
         SREF     FECP#,FECPD#
         REF      FDB:TIT,FEB:TIT
         SREF     FDB:TO,FDH:CLS,FDB:FEX,FDB:LNK,FDB:DCT
*
         SREF     FEB:IHD,FEB:CIO,FEB:CDX,FE:CRD,FEH:BUF,FEH:ADR
         PAGE
*
*        DISPLAY THE FECP  TABLES
*
FED:TAB  EQU      %
         DEF      FED:TAB
         LI,R1    FECP#             # OF ENTRIES IN TABLE
         BEZ      SCANNER           NOT PRESETN
         LI,R1    FEB:TIT
         BAL,R0   TITEL
         FORMAT   START,(TAB,5),'IHD'
         FORMAT   (TAB,10),'CIO'
         FORMAT   (TAB,15),'CDX'
         FORMAT   (TAB,20),'CRD'
         FORMAT   (TAB,30),'BUF'
         FORMAT   (TAB,36),'ADR'
         FORMAT   PRINT
         FORMAT   (TAB,5),'---',(TAB,10),'---',(TAB,15),'---'
         FORMAT   (TAB,20),'--------',(TAB,30),'----',(TAB,36),'----'
         FORMAT   PRINT,END
         LI,R4    0                 INDEX INTO FEB TABLES
FEB:TAB1 EQU      %
         FETCH    (FEB:IHD,R4,BA),IIOQ1
         FETCH    (FEB:CIO,R4,BA),IIOQ2
         FETCH    (FEB:CDX,R4,BA),IIOQ3
         FETCH    (FE:CRD,R4,WA),IIOQ4
         FETCH    (FEH:BUF,R4,HA),IIOQ5
         FETCH    (FEH:ADR,R4,HA),IIOQ6
         FORMAT   START
         FORMAT   (TAB,5),(HEX,IIOQ1,2)
         FORMAT   (TAB,10),(HEX,IIOQ2,2)
         FORMAT   (TAB,15),(HEX,IIOQ3,2)
         FORMAT   (TAB,20),(HEX,IIOQ4,8)
         FORMAT   (TAB,30),(HEX,IIOQ5,4)
         FORMAT   (TAB,36),(HEX,IIOQ6,4)
         FORMAT   PRINT,END
         AI,R4    1
         CI,R4    FECP#             AT TOP OF TABLES...
         BLE      FEB:TAB1          NOT YET
*
*        FALL THRU AND PUT OUT THE REST OF THE FECP TABLES
*
         PAGE
*
*        DISPLAY THE FECPD TABLES
*
         LI,R1    FDB:TIT
         BAL,R0   TITEL
         FORMAT   START
         FORMAT   (TAB,5),'TO'
         FORMAT   (TAB,9),'CLS'
         FORMAT   (TAB,14),'FEX'
         FORMAT   (TAB,19),'LNK'
         FORMAT   (TAB,24),'DCT'
         FORMAT   PRINT
         FORMAT   (TAB,5),'--',(TAB,9),'----',(TAB,14),'---'
         FORMAT   (TAB,19),'---',(TAB,24),'---'
         FORMAT   PRINT,END
         LI,R4    0                 STARTING INDEX
FDB:TAB1 EQU      %
         FETCH    (FDB:TO,R4,BA),IIOQ1
         FETCH    (FDH:CLS,R4,HA),IIOQ2
         FETCH    (FDB:FEX,R4,BA),IIOQ3
         FETCH    (FDB:LNK,R4,BA),IIOQ4
         FETCH    (FDB:DCT,R4,BA),IIOQ5
         FORMAT   START
         FORMAT   (TAB,5),(HEX,IIOQ1,2)
         FORMAT   (TAB,9),(HEX,IIOQ2,4)
         FORMAT   (TAB,14),(HEX,IIOQ3,2)
         FORMAT   (TAB,19),(HEX,IIOQ4,2)
         FORMAT   (TAB,24),(HEX,IIOQ5,2)
         FORMAT   PRINT,END
         AI,R4    1
         CI,R4    FECPD#
         BLE      FDB:TAB1          FINISH TABLES
         B        SCANNER           ALL DONE
*
*
*
         END

