*DECK,DUMPQCK 
USETEXT IP$COM
USETEXT MISC$ 
USETEXT TCH$COM 
USETEXT TSB$COM 
USETEXT ACN$COM 
USETEXT DCB$COM 
USETEXT TCB$COM 
USETEXT UCB$COM 
      PROC DUMPQCK ( DUMPACN ); 
      BEGIN 
 #
*1DC  DUMPQCK 
* 
*     1. PROC NAME           AUTHOR              DATE 
*        DUMPQCK             G. A. VALENCIA      11/06/80 
* 
*     2. FUNCTIONAL DESCRIPTION.
*        EXECUTE A PREDETERMINED SUBSET OF THE FORTRAN TABLE DUMPER 
*        ROUTINES ON A SPECIFIC ACN.  THIS ROUTINE IS NOT AS GENERAL
*        AS DUMPERS, WHICH IS CALLED DURING REPRIEVE PROCESSING.
*        THE OBJECT IS TO DUMP AS FEW TABLES AS POSSIBLE TO CUT DOWN
*        ON THE FIELD LENGTH WHENEVER THIS ROUTINE IS LOADED (FORTRAN 
*        DUMPERS USE LOTS OF CM). 
* 
*     3. METHOD USED. 
*        THE ACN WHOSE CONTROL BLOCK IS TO BE DUMPED IS PASSED AS A 
*        PARAMETER (DUMPERS DUMPS ALL NON-ZERO ACN ENTRIES).  THE ACTUAL
*        DUMPER ROUTINES WHICH GET CALLED ARE DETERMINED BY UPDATE
*        DIRECTIVES.  THE FOLLOWING UPDATE DIRECTIVES ARE REQUIRED TO 
*        CHANGE WHAT CODE IS COMPILED IN THIS ROUTINE...
* 
*        *DEFINE,TRACE             TO COMPILE ALL THE FORTRAN DUMPERS 
*        *DEFINE,XYZ               TO SELECT WHICH FORTRAN DUMPERS
*                                  DUMPQCK WILL CALL. 
*        *COMPILE,DUMPQCK          RECOMPILE THIS VERSION OF DUMPQCK
* 
*        WHERE XYZ IS ONE OF THE FOLLOWING SYMBOLS... 
* 
*        *DEFINE,ACN               DUMP THE ACN$TABLE ENTRY 
*        *DEFINE,TCB               DUMP THE TCB, TCB$DEVICE ENTRIES 
*        *DEFINE,UCB               DUMP THE UCB 
*        *DEFINE,DCB               DUMP THE DCB 
*        *DEFINE,CLOSE             FLUSH SPITOUT BUFFER, CLOSE FILE 
* 
*     4. ENTRY PARAMETERS.
*        DUMPACN - ACN TO BE DUMPED 
*        DUMPINDX - DUMMY INDEX PRINTED BY DUMPER ROUTINES, IT IS 
*                   DEFINED IN LOW CORE IN CASE THIS ROUTINE ENDS 
*                   UP IN A OVERLAY.  IT IS INCREMENTED EVERYTIME 
*                   THIS ROUTINE IS CALLED. 
* 
*     5. EXIT PARAMETERS. NONE
* 
*     6. SYMPL TEXTS USED.
*        IP$COM 
*        MISC$
*        TSB$COM
*        ACN$COM
*        DCB$COM
*        TCB$COM
*        UCB$COM
* 
*     7. ROUTINES CALLED. 
*        DMP$ACN
*        DMP$DCB
*        DMP$DCL
*        DMP$TCB
*        DMP$TCD
*        DMP$UCB
*        DMP$UCL
* 
*     8. DAYFILE MESSAGES. NONE 
* 
 #
  
# 
      CALL COMMON DECK DMP$PRT (INSTEAD OF USING SYMPLTEXT DMP$PRT) 
      TO GET THE TABLE DUMPER HEADER PROPERLY INITIALIZED.  SYMPL 
      DOES NOT ALLOW COMMON BLOCKS TO BE PRESET WITHIN SYMPL TEXTS. 
# 
      CONTROL PACK; 
      CONTROL PRESET; 
      CONTROL NOLIST;          # THE NEXT CARD IS *CALL,DMP$PRT        #
*CALL,DMP$PRT 
      CONTROL LIST; 
  
      XREF PROC CLOSE;         # CLOSE SPITOUT FILE (OPENED BY DMP$ZB5)#
      XREF PROC DMP$ACN;       # DUMP AN ACN$TABLE ENTRY               #
      XREF PROC DMP$DCB;       # DUMP A WORDS 0 THRU  1 OF A DCB       #
      XREF PROC DMP$DCL;       # DUMP A WORDS 2 THRU 13 OF A DCB       #
      XREF PROC DMP$TCB;       # DUMP A TERMINAL CONTROL BLOCK         #
      XREF PROC DMP$TCD;       # DUMP A TCB$DEVICE CONTROL BLOCK       #
      XREF PROC DMP$UCB;       # DUMP A WORDS 0 THRU  1 OF A UCB       #
      XREF PROC DMP$UCL;       # DUMP A WORDS 2 THRU  9 OF A UCB       #
      XREF PROC WRITER;        # WRITE AN -EOR- ON THE SPITOUT FILE    #
  
      XREF ARRAY SPITOUT[1:1] S(6);;# SPITOUT FET (DEFINED IN DMP$ZB5) #
  
      XREF ITEM DUMPINDX U;    # DEFINED IN DCB$COM, CANT BE IN OVERLAY#
  
      ITEM DUMPACN U;          # ACN TO BE DUMPED                      #
      ITEM I,J,SAVE;           # INDUCTION, TEMPORARY VARIABLES        #
      ITEM NOPARAM;            # UNUSED PARAMETER ON PROCEDURE CALLS   #
      ITEM OPTION C(10);       # CLOSE PROC PARAMETER (NO REWIND)      #
  
*IF,DEF,ACN 
      DMP$ACN(LOC(ACN$TABLE)+(DUMPACN-1), NOPARAM, DUMPINDX); 
*ENDIF
*IF,DEF,TCB 
      IF ACN$DEVTYPE[DUMPACN] EQ S"CONSOLE" 
      THEN
        BEGIN              # DUMP TCB AND ALL TCB$DEVICE ENTRIES       #
        DMP$TCB(ADDRESS[ACN$CB[DUMPACN]], NOPARAM, DUMPINDX); 
        SAVE = P<TCB>;
        P<TCB> = ADDRESS[ACN$CB[DUMPACN]];
        IF TCB$NDEVICE GR ZERO
        THEN
          BEGIN 
          FOR J=0 STEP 1 UNTIL TCB$NDEVICE - 1
          DO
            BEGIN 
            DMP$TCD(ADDRESS[ACN$CB[DUMPACN]] + TCB$SIZE + TCB$DEVSIZE*J,
                    NOPARAM, J+1);
            END 
          END 
        P<TCB> = SAVE;
        END                # DUMP TCB AND ALL TCB$DEVICE ENTRIES       #
*ENDIF
*IF,DEF,UCB 
      IF ACN$DEVTYPE[DUMPACN] EQ S"CARD$READER" 
      THEN
        BEGIN              # DUMP FULL UCB ONLY IF FILE IS ACTIVE      #
        DMP$UCB(ADDRESS[ACN$CB[DUMPACN]], NOPARAM, DUMPINDX); 
        SAVE = P<UCB>;
        P<UCB> = ADDRESS[ACN$CB[DUMPACN]];
        IF UCB$FILEACT
        THEN
          BEGIN 
          DMP$UCL(ADDRESS[ACN$CB[DUMPACN]], NOPARAM, DUMPINDX); 
          END 
        P<UCB> = SAVE;
        END                # DUMP FULL UCB ONLY IF FILE IS ACTIVE      #
*ENDIF
*IF,DEF,DCB 
      IF ACN$DEVTYPE[DUMPACN] EQ S"LINE$PRINTER"
      OR ACN$DEVTYPE[DUMPACN] EQ S"PUNCH" 
      OR ACN$DEVTYPE[DUMPACN] EQ S"PLOTTER" 
      THEN
        BEGIN              # DUMP FULL DCB ONLY IF FILE IS ACTIVE      #
        DMP$DCB(ADDRESS[ACN$CB[DUMPACN]], NOPARAM, DUMPINDX); 
        SAVE = P<DCB>;
        P<DCB> = ADDRESS[ACN$CB[DUMPACN]];
        IF DCB$FILEACT
        THEN
          BEGIN 
          DMP$DCL(ADDRESS[ACN$CB[DUMPACN]], NOPARAM, DUMPINDX); 
          END 
        P<DCB> = SAVE;
        END                # DUMP FULL DCB ONLY IF FILE IS ACTIVE      #
*ENDIF
*IF,DEF,CLOSE 
      I = 0;                   # SET LEVEL FOR -EOR- TO BE WRITTEN     #
      WRITER(SPITOUT,I);       # WRITE AN -EOR- ON THE SPITOUT FILE    #
      OPTION = "REWIND";       # REWIND SPITOUT AFTER CLOSING          #
      CLOSE(SPITOUT,OPTION);   # CLOSE SPITOUT FILE (FLUSH CIO BUFFER) #
*ENDIF
      DUMPINDX = DUMPINDX + 1; # INCREMENT THE DUMMY INDEX             #
      END 
      TERM
