         PCC      0
         TITLE    'CD:'
         SPACE    1
************************************************************************
*
* CD: - PROGRAM TO COPY & DELETE A RANGE OF FILES WITH A GIVEN PREFIX.
*
*       JUST SAY !CD: [prefix][.[acct][.pass]]
*       NOTE:    !CD: is equivalent to !CD: D:.j:accn
*       ALL FILES WITH THE SPECIFIED prefix WILL BE COPIED TO M:SL
*       AND THEN DELETED.  A BREAK WILL CAUSE AN EOF TO BE SIMULATED
*       ON THE CURRENT FILE.
*
************************************************************************
         SPACE    1
CD:00    CSECT    0                 DATA AREA
         SPACE    1
BRKFLAG  DATA     0
CRTFLAG  DATA     0                 NOT CRT
PREDEST  RES      1                 DESTINATION COUNT/BA
PRESAV   RES      8                 MAX FILE NAME - 8 WORDS
BUF      RES,140  1                 I/O BUFFER
         SPACE    1
M:EI     DSECT    1                 M:EI DCB
         SPACE    1
CD:01    CSECT    1                 READ ONLY
         SPACE    1
         SYSTEM   SIG9
         SYSTEM   BPM
         SPACE    1
         M:PT     1                 GENERATE FPT'S AS READ ONLY
         SPACE    1
         DEF      CD:GO,CD:01,CD:00
         SPACE    1
         REF      M:SL
         REF      SCAN:C            J:CCBUF SCANNER
         REF      ERREXIT,ERREPORT  ERROR MESSAGE PRINTER
         SPACE    1
         PAGE
CD:GO    EQU      %                 START OF PROGRAM
         M:INT    INT
         SPACE    1
         M:TS3                      GET TERMINAL ATTR
         CW,12    ='VP72'           CRT ?
         BNE      NOTCRT            NO - CONTINUE
         MTW,+1   CRTFLAG           REMEMBER WHETHER CRT
NOTCRT   RES      0
         SPACE    1
         LI,14    0                 CLEAR OUT
         STW,14   VLPFI              THE VLPS
         LI,8     VLPFI             BUFFER FOR VLP'S
         BAL,14   SCAN:C            GET F.A.P FROM J:CCBUF
         BCS,8    CD:03             ERROR IN SCAN - NOTIFY USER
         BCS,1    CD:FILE           GOT FILE, MAYBE MORE
         BCS,6    CD:SET            NO FILE, BUT ACCT OR PASS
         B        CD:02             NOTHING - DEFAULT TO 'D:'
CD:FILE  EQU      %
         M:PT     0                 GENERATE FPT IN CSECT-0
,,VLPFI  M:OPEN   M:EI,FILE,PASS,IN,TEST,(ERR,IGN0),(ABN,IGN0)
         B        CD:PREFIX         CONTINUE
IGN0     B        %-1               FOR DEBUGGING
CD:SET   EQU      %
         LCI      15                PREPARE TO
         LM,1     VLPFI              GET FVLPS
         STM,1    VLPSE               & SET THEM IN FPT
,,VLPSE  M:OPEN   M:EI,FILE,PASS,IN,TEST,(ERR,IGN1),(ABN,IGN1)
         M:PT     1                 REST OF BPM CSECT PROTECTED
         NOP      0                 FOR DEBUGGING
IGN1     NOP      0                 ..
CD:02    EQU      %
,,VLPD:  M:OPEN   M:EI,(FILE,'D:'),IN,TEST,(ERR,IGN2),(ABN,IGN2)
Z        EQU      %
         ORG,1    BA(VLPD:)+1
         DATA,1   1
         ORG,4    Z
         NOP      0                 FOR DEBUGGING
IGN2     NOP      0                 ..
CD:PREFIX EQU     %                 REMEMBER CURRENT PREFIX
         LB,10    M:EI+23           FILENAME - TEXTC
         LI,11    BA(PRESAV)        FOR MBS,CBS
         STB,10   11                ..
         STW,11   PREDEST           DESTINATION COUNT ETC TOO
         LI,10    BA(M:EI+23)+1     SOURCE
         MBS,10   0                 SAVE PREFIX
CD:NXT   EQU      %
         LI,10    0
         STW,10   BRKFLAG           RESET BREAK FLAG
         MTW,0    CRTFLAG           CRT ?
         BE       NOTCRT1           NO
         M:OPEN   M:EI,NXTF,IN,REL,(ERR,NXER),(ABN,NXER)
         B        CRTGO1            CONTINUE
NOTCRT1  RES      0
         M:OPEN   M:EI,NXTF,INOUT,REL,(ERR,NXER),(ABN,NXER)
CRTGO1   RES      0
         LI,2     0                 SET AS NO ERROR ENCOUNTERED
CHKFID   LB,10    M:EI+23           GET SIZE OF FILE JUST OPENED
         CB,10    PREDEST           IS IT
         BLE      MEXIT              TOO SMALL - DONE
         LI,10    BA(M:EI+23)+1     SOURCE
         LW,11    PREDEST           DESTINATION
         CBS,10   0                 COMPARE AGAINST PREFIX
         BNE      MEXIT             NOPE - DONE
         LB,1     M:EI+23           GET FILENAME SIZE
         M:WRITE  M:SL,(SIZE,*1),(BUF,M:EI+23),(BTD,1),;
                  (ERR,ERR),(ABN,ERR)
         AI,2     0                 ERROR DURING OPEN ?
         BE       B01               NO - CONTINUE
         LW,10    14                GET ERROR CODE
         BAL,15   ERREPORT          TELL USER ABOUT IT
         B        CD:NXT            TRY NEXT FILE
NXER     LW,14    10                SAVE ERROR CODE
         LB,10    14                GET CODE
         CI,10    2                 END OF FILES?
         BE       MEXIT             YUP - SPLIT
         LI,2     1                 SET ERROR CONDITION
         B        CHKFID             & CONTINUE
B01      M:READ   M:EI,(SIZE,140),(ABN,ABN),(ERR,ERR),WAIT,(BTD,0),;
                  (BUF,BUF)
B02      LW,1     M:EI+4            PREPARE TO
         SLS,1    -17                GET ACTUAL RECORD SIZE
         MTW,0    BRKFLAG           SEE IF WE GOT A BREAK
         BNEZ     EICLOSE           YEP, CLOSE AND REL IT
WRITE    M:WRITE  M:SL,(SIZE,*1),(BUF,BUF),(ABN,ERR),(ERR,ERR),(BTD,0)
         B        B01               DO FOR COMPLETE FILE
ABN      EQU      %
         LB,1     10                GET ERROR CODE
         CI,1     X'06'             END OF FILE ?
         BE       EICLOSE           YES - CLOSE WITH RELEASE
         CI,1     X'05'             END OF DATA ?
         BE       EICLOSE           YES - CLOSE WITH RELEASE
         CI,1     X'07'             LOST DATA ?
         BE       B02               YES - TOUGH TITTIES
ERR      EQU      %
         B        ERREXIT           PRINT ERROR MESSAGE
EICLOSE  EQU      %
         MTW,0    CRTFLAG           CRT ?
         BE       NOTCRT2           NO
         M:CLOSE  M:EI,SAVE         YES - DON'T REL
         B        CRTGO2            CONTINUE
NOTCRT2  RES      0
         M:CLOSE  M:EI,REL          RELEASE THE FILE
CRTGO2   RES      0
         B        CD:NXT             & TRY NEXT
MEXIT    EQU      %
         M:EXIT                     DONE - EXIT TO MONITOR
INT      EQU      %                 SET FLAG ON BREAK
         M:STA    (BRKCNT,0)        RESET BREAK COUNT
         MTW,1    BRKFLAG           BUMP BREAK FLAG
         LI,2     X'1FFFF'          ADDRESS MASK
         AND,2    *1                GET ADDRESS FROM STACK PSD
         CI,2     WRITE
         BG       H01
         CI,3     WRITE-2           THIS CODE WILL MAKE SURE
         BL       H01               THAT NO LINES FOR THIS FILE
         LI,2     WRITE+1           ARE OUTPUT AFTER A BREAK
         STW,2    *1
H01      EQU      %
         M:TRTN                     CONTINUE
CD:03    EQU      %
         M:WRITE  M:SL,(BUF,EHH),(SIZE,3)
         B        MEXIT             SPLIT
EHH      TEXT     'Eh?'
         PAGE
         SPACE    1
M:EI     M:DCB    FILE,PASS
         END      CD:GO
