         PCC      0
         SYSTEM   BPM
         SYSTEM   SIG9
         TITLE    'DMPQ - QUEUE DUMP PROGRAM'
*
*        REFs and DEFs
*
         DEF      DMPQ:P
         DEF      SPILLFPT
         DEF      DMPQ:D
         DEF      FILLFPT
         DEF      FID
*
         REF      JB:PRIV
         REF      J:TCB
         REF      M:LO
         REF      M:DO
         REF      M:OC
         REF      M:UC
         REF      M:EI
         REF      PRINTHDR
         REF      PRINTFPT
*
*
*        Register equates
*
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
R8       EQU      8
R9       EQU      9
R10      EQU      10
R11      EQU      11
R12      EQU      12
R13      EQU      13
R14      EQU      14
R15      EQU      15
SR1      EQU      R8
SR2      EQU      R9
SR3      EQU      R10
SR4      EQU      R11
         PAGE
*
*        PROCS
*
TEXTCR   CNAME
         PROC
         BOUND    4
LF       EQU      %
         DISP     %
         LIST     0
         DATA,1   S:NUMC(S:UT(AF))+1,S:UT(AF),X'0D'
         BOUND    4
         LIST     1
         PEND
         PAGE
***********************************************************************
*                                                                     *
*                                                                     *
*     DMPQ is a program designed to run under F00 CP-V.  It makes     *
*     use of the symbiont file spill-fill capability, and may be      *
*     used to spill either the input queue, the output queue, or      *
*     both to a standard CP-V labeled tape.  It will *not* run        *
*     properly under any version of CP-V prior to F00!                *
*                                                                     *
*     The following point should be engraved upon your brain in       *
*     six-inch letters of incandescent fire:                          *
*                                                                     *
*       D O   N O T   M E S S   W I T H   T H E   D A T A ! !         *
*                                                                     *
*     This means - use Spill/Fill only for exact, mirror-image        *
*     dumps and restores.  Do NOT try to change *anything* in the     *
*     FPT passed to you by the M:OPEN of the spill stream DCB.        *
*     Do *not* try to hand-code FPTs for fill streams.  Do *not*      *
*     modify the spilled data in any way whatsoever.  Do *not*        *
*     change the workstation definitions of any RBTs that may be      *
*     defined in your system between spill time and fill time.        *
*     Such tampering can have numerous loathsome effects ranging      *
*     from lost data records, through lost data files and missing     *
*     symbiont granules, to the possible destruction of your entire   *
*     batch queue.                                                    *
*                                                                     *
*     Be it therefore known - if you try any such tricks and          *
*     begin having trouble with Spill/Fill - we out here at           *
*     LADC don't want to hear anything about it!!  I unofficially     *
*     assure you that any SIDRs submitted against Spill/Fill          *
*     that show any evidence of such game-playing will be returned    *
*     to the sender via high-speed air mail, wrapped around           *
*     something blunt and heavy, sharp and pointed, or explosive.     *
*                                                                     *
*                                                                     *
*     DMPQ was written at Honeywell LADC by Dave Platt on or about    *
*     8/28/78, and was tested on a Sigma 5 system running a           *
*     full-blown production version of CP-V F00 (with the patch       *
*     file current as of that date).  It works.                       *
*                                                                     *
***********************************************************************
         PAGE
DMPQ:P   CSECT    1
         M:INT    INTPROC
         LB,R1    JB:PRIV
         CI,R1    X'C0'
         BGE      GETCMD
         M:TYPE   (MESS,DMPQPRIV)
         M:EXIT
GETCMD   M:KEYIN  (MESS,DMPQHERE),(REPLY,COMMAND),(SIZE,11)
         LI,R1    1
         LB,R1    COMMAND,R1
         LB,R2    COMLIST
FINDCMD  CB,R1    COMLIST,R2
         BE       GOTCMD
         BDR,R2   FINDCMD
         B        GETCMD
GOTCMD   LW,R1    PRIOSET,R2
         STW,R1   SPILLPRIO
SPILLGO  M:OPEN   F:TAPE,(ASN,DEVICE),(VOL,1),(OUT)
         M:REW    F:TAPE
         M:CLOSE  F:TAPE,(SAVE)
         BAL,R15  PRINTHDR
         SPACE    2
STRTSPILL EQU     %
         MTW,0    INTFLAG
         BNEZ     ENDOP
         LI,SR1   'SP'              INDICATE SPILL OPERATION
         M:LDEV,E SPILLFPT          TRY TO OPEN A SPILL STREAM
         BCS,8    BADSPILL
         M:OPEN   M:EI,(DEVICE,'C2'),(IN),(FPARAM,FILLFPT),;
                  (ABN,M:EICHK),(ERR,M:EICHK)
         BAL,R15  OPENTAPE
         M:WRITE  F:TAPE,(BUF,FILLFPT),(SIZE,56),(WAIT),;
                  (ABN,F:TAPECHK),(ERR,F:TAPECHK)
         SPACE    2
         BAL,R15  PRINTFPT
         SPACE    2
SPILLIT  M:READ   M:EI,(BUF,BUFFER),(SIZE,2048),(ABN,M:EICHK),;
                  (ERR,M:EICHK)
         LW,R1    M:EI+4
         SLS,R1   -17
         M:WRITE  F:TAPE,(BUF,BUFFER),(SIZE,*R1),(ABN,F:TAPECHK),;
                  (ERR,F:TAPECHK)
         B        SPILLIT
EOFHIT   M:CLOSE  F:TAPE,(SAVE)
         M:CLOSE  M:EI,(SAVE)
         LI,SR1   'SP'
         M:LDEV   'C2',(DELETE)     Purge spilled file from queue
         BCS,8    BADSPILL
         LI,R1    7
         STW,R1   PAUSECOUNT
         B        STRTSPILL         Go spill another file.
         SPACE    3
BADSPILL M:SNAP   'FPT REJ.',(SPILLFPT,BUFFER+511)
         M:TYPE   (MESS,DMPQFPT)
         M:XXX
         PAGE
*
*        ABN and ERR routines
*
M:EICHK  LB,R2    SR3               Get error code
         CI,R2    X'03'             0300 - no file to spill
         BE       NOFILE            Sleep for a bit & try again
         CI,R2    X'05'             0500 - !EOD encountered
         BE       *SR1              Write the record anyway
         CI,R2    X'06'             0600 - end of file
         BE       EOFHIT            Close file
         M:SNAP   'M:EI ERR',(SPILLFPT,BUFFER+511)
         M:TYPE   (MESS,DMPQABORT)
         M:XXX
         SPACE    2
F:TAPECHK EQU     %
         LB,R2    SR3               Get error code
         CI,R2    X'1C'             1C00 - end of tape on output
         BNE      SNAPTAPE          If not, croak noisily
         M:CVOL   F:TAPE            Switch to next reel
         B        *SR1              Go write record on next tape
SNAPTAPE M:SNAP   'TAPE ERR',(SPILLFPT,BUFFER+511)
         M:TYPE   (MESS,DMPQABORT)
         M:XXX
         SPACE    2
NOFILE   MTW,1    PAUSECOUNT
         LW,R1    PAUSECOUNT
         CI,R1    10
         BL       SLEEP
         LI,R1    0
         STW,R1   PAUSECOUNT
         M:TYPE   (MESS,DMPQIDLE)
SLEEP    LI,R1    0
         STW,R1   INTFLAG           Clear "INTed" flag
         M:WAIT   5
         B        STRTSPILL
         SPACE    3
ENDOP    M:KEYIN  (MESS,QUIT),(REPLY,COMMAND),(SIZE,11)
         LI,R1    1
         LB,R1    COMMAND,R1
         CI,R1    'Y'
         BE       ENDALL
         LI,R1    0
         STW,R1   INTFLAG
         M:KEYIN  (MESS,CHANGE),(REPLY,COMMAND),(SIZE,11)
         LI,R1    1
         LB,R1    COMMAND,R1
         CI,R1    'Y'
         BNE      STRTSPILL
GETCHNG  M:KEYIN  (MESS,DMPQHERE),(REPLY,COMMAND),(SIZE,11)
         LI,R1    1
         LB,R1    COMMAND,R1
         LB,R2    COMLIST
FINDCHG  CB,R1    COMLIST,R2
         BE       GOTCHNG
         BDR,R2   FINDCHG
         B        GETCHNG
GOTCHNG  LW,R1    PRIOSET,R2
         STW,R1   SPILLPRIO
         B        STRTSPILL
         SPACE    3
ENDALL   M:OPEN   F:TAPE,(IN),(ASN,DEVICE),(ABN,0),(ERR,0)
         M:CLOSE  F:TAPE,(REM)
         M:EXIT
         SPACE    2
INTPROC  MTW,1    INTFLAG
         M:TRTN
         PAGE
*
*        Open the tape DCB to the next output file
*
OPENTAPE EQU      %
         LW,R3    F:TAPE+23         Get current label
         STW,R3   FID               Store in M:OPEN FPT
         LI,R2    3
BUMPNAME MTB,1    FID,R2            Bump character of name
         LB,R4    FID,R2            Get incremented character
         CI,R4    '9'               Check against biggest
         BLE      OPENIT            If OK, go open the tape
         LI,R4    '0'               Reset this digit of file #
         STB,R4   FID,R2              back to a zero
         BDR,R2   BUMPNAME          Go increment higher digit(s)
         SPACE    2
OPENIT,,TAPEVLP ;
         M:OPEN   F:TAPE,(LABEL,'NNN'),(OUT),(ABN,F:TAPECHK),;
                  (ERR,F:TAPECHK)
FID      EQU      TAPEVLP+1
         B        *R15              Return to caller with DCB open
         PAGE
DMPQ:D   CSECT    0                 DATA CSECT
SPILLFPT DATA     X'1A000000'
         DATA     X'90080010'       P1, P4, P13, ASAVE
         DATA     C'C2'             STREAM TO USE
         DATA     2                 CODE FOR "SPILL"
SPILLPRIO DATA    0                 PRIORITY GOES HERE
         BOUND    8
FILLFPT  RES      14                FPT RETURNED BY M:OPEN
BUFFER   EQU      %
         LIST     0
         DO1      512
         DATA     0
         LIST     1
*
*        BUFFER is 512 words of zeros.
*
OUTBUF   RES      30
*
*
DMPQHERE TEXTC    'DUMP INPUT QUEUE, OUTPUT QUEUE, ZERO PRIO INPUT, ',;
                  'OR ALL (I/O/Z/A)? '
DMPQABORT TEXTCR  'FATAL I/O ERROR (SEE SNAPSHOT) - ABORTING'
DMPQPRIV TEXTCR   'I NEED C0 PRIVILEGE TO RUN PROPERLY!'
DMPQFPT  TEXTCR   'AN M:LDEV FPT WAS REJECTED'
DMPQIDLE TEXTCR   'ZZZZZ....'
QUIT     TEXTC    'TERMINATE SPILL (Y/N)? '
CHANGE   TEXTC    'CHANGE DUMP CRITERIA (Y/N)? '
INTFLAG  DATA     0
PAUSECOUNT DATA   7
COMLIST  TEXTC    'ZIOA'            ZERO/IN/OUT/ALL
PRIOSET  DATA     0                 NULL ENTRY
         DATA     X'00000000'       Prio 0 input jobs
         DATA     X'0000000F'       PRIO 0-F INPUT
         DATA     X'00001122'       PRIO 11-22 OUT, MFILE, NCTL
         DATA     X'00000022'       PRIO 0-22 EVERYTHING
COMMAND  RES      3
         PAGE
F:TAPE   DSECT    2
F:TAPE   M:DCB    (LABEL,'000'),(DEVICE,'9T'),(SN,'DMP0','DMP1',;
                  'DMP2','DMP3','DMP4','DMP5','DMP6','DMP7','DMP8'),;
                  (TRIES,15),(ERR,F:TAPECHK),(ABN,F:TAPECHK)
         USECT    DMPQ:P
         END      DMPQ:P
