         PCC      0
         SPACE    1
************************************************************************
*
* CD - CP-V PROGRAM TO COPY & DELETE A FILE.
*
* PROGRAMMER : Jeff Sheinberg.
*
* PERFORMS THE FOLLOWING FUNCTIONS :
*
* 1. COPIES THE FILE "MAILBOX" IN THE CURRENT ACCOUNT TO THE M:SL
*    DCB, AND THEN DELETES "MAILBOX" FILE.
*
* 2. IF M:EI WAS !SET TO A FILE THEN THE FILE IS TREATED AS IF IT WERE
*    THE MAILBOX FILE; HOWEVER, PRECEDENCE IS GIVEN TO ANY FILENAME
*    SPECIFIED ON THE COMMAND LINE IF IT IS VALID SYNTACTICALLY.
*
* 3. IF ENTERED BY M:LINK THEN CONTROL IS RETURNED VIA M:LDTRC.
*
************************************************************************
         SPACE    1
CALL00   CSECT    0                 DATA AREA
         SPACE    1
BUF      RES,140  1                 I/O BUFFER
         SPACE    1
RES1     DATA     1                 TEMP STORAGE
         SPACE    1
LINK2FPT DATA     X'03000000',0     M:LDTRC FPT
M:EI     DSECT    1                 M:EI DCB
         SPACE    1
         SPACE    1
CALL01   CSECT    1                 READ ONLY
         SPACE    1
         SYSTEM   SIG9
         SYSTEM   BPM
         SPACE    1
         M:PT     1                 GENERATE FPT'S AS READ ONLY
         SPACE    1
         DEF      CALLGO,CALL01,CALL00
         SPACE    1
         REF      M:SL
         REF      SCAN:C            J:CCBUF SCANNER
         REF      ERREXIT           ERROR MESSAGE PRINTER
         SPACE    1
SR1      EQU      8                 CP-V SYSTEM REGISTER 1
SR3      EQU      10                CP-V SYSTEM REGISTER 3
         SPACE    1
CALLGO   EQU      %                 START OF PROGRAM
         SPACE    1
         STW,SR1  LINK2FPT+1        SET LMN IN FPT
         BAL,15   MAILBOXE          COPY & DELETE MAILBOX | M:EI FILE
         LW,8     LINK2FPT+1        CALLED BY M:LINK ?
         BEZ      MEXIT             NO - JUST EXIT
         M:LDTRC,E LINK2FPT         YES - RETURN TO CALLING PROGRAM
MEXIT    M:EXIT                     RELEASE CONTROL TO CP-V
         PAGE
************************************************************************
*
* MAILBOXE - ROUTINE TO COPY & DELETE MAILBOX (AS DEFAULT) OR WHATEVER
*            IS ASSIGNED TO M:EI.
*
************************************************************************
         SPACE    1
MAILBOXE EQU      %
         SPACE    1
         STW,15   RES1              SAVE RETURN ADDRESS
         LI,14    0                 CLEAR OUT
         STW,14   FPT+7              THE VLPS
         LI,8     FPT+7             BUFFER FOR VLP'S
         BAL,14   SCAN:C            GET F.A.P FROM J:CCBUF
         BCS,7    MAILSET           VLP(S) PRESENT
         BCS,8    MAIL01            ERROR IN SCAN - NOTIFY USER
         LW,12    M:EI+22           GET FILE NAME VLP
         CW,12    L(X'01000008')    ANYTHING THERE ?
         BNE      MAILSET           => YES. OPEN UP WHAT'S THERE
         B        MAIL02            => NO. OPEN UP MAILBOX
MAIL01   EQU      %
         M:WRITE  M:SL,(BUF,EHH),(SIZE,3)
         B        *RES1             DONE
MAIL02   EQU      %
         M:OPEN   M:EI,(FILE,'MAILBOX'),(BUF,BUF),INOUT,SEQUEN,;
                  (ABN,ABN),(ERR,ERR)
         LB,1     MAILMSG           GET SIZE OF MESSAGE
         M:WRITE  M:SL,(SIZE,*1),(BUF,MAILMSG),(BTD,1)
         B        B01               CONTINUE
         M:PT     0                 GENERATE FPT IN CSECT-0
MAILSET,FPT M:OPEN M:EI,FILE,PASS,(BUF,BUF),INOUT,SEQUEN,;
                  (ABN,ERR),(ERR,ERR)
         M:PT     1                 REST OF BPM CSECT PROTECTED
B01      M:READ   M:EI,(SIZE,140),(ABN,ABN),(ERR,ERR),WAIT,(BTD,0)
B02      LW,1     M:EI+4            PREPARE TO
         SLS,1    -17                GET ACTUAL RECORD SIZE
         M:WRITE  M:SL,(SIZE,*1),(BUF,BUF),(ABN,ERR),(ERR,ERR),(BTD,0)
         B        B01               DO FOR COMPLETE FILE
ABN      EQU      %
         LB,1     SR3               GET SR3 BYTE 0
         CI,1     X'03'             FILE DOESN'T EXIST ?
         BE       C05               YES - CONTINUE
         CI,1     X'06'             END OF FILE ?
         BE       SICLOSE           YES - CLOSE WITH RELEASE
         CI,1     X'05'             END OF DATA ?
         BE       SICLOSE           YES - CLOSE WITH RELEASE
         CI,1     X'07'             LOST DATA ?
         BE       B02               YES - TOUGH TITTIES
ERR      EQU      %
         B        ERREXIT           PRINT ERROR MESSAGE
C05      EQU      %
         B        *RES1             DONE - RETURN
SICLOSE  EQU      %
         M:CLOSE  M:EI,REL          RELEASE THE MAILBOX
         B        C05                & RETURN
EHH      TEXT     'Eh?'
         PAGE
         SPACE    1
         BOUND    8
MAILMSG TEXTC     '    DC/MAILBOX :'
M:EI     M:DCB    FILE,PASS
         END      CALLGO
