;******************************************
;*                                        *
;* SINGLE DRIVE FILECOPY V81.1  4 MAY 81  *
;*                                        *
;* WILL COPY FILES UP TO 65535 RECORDS    *
;* LONG (128 BYTES/REC) ONLY LIMITED BY   *
;* THE CONSTRAINTS OF AVAILABLE MEMORY    *
;* ALL CONSOLE AND DISK I/O               *
;* THROUGH BDOS CALL AT LOC 5             *
;*                                        *
;* REVISED BY SHELDON EICHENBAUM          *
;*                                        *
;* ORGINAL BY KEN BARBIER AS PUBLISHED IN *
;* MICROCOMPUTING  SEPT. 1980             *
;*                                        *
;******************************************
; CP/M BDOS ADDRESSES
RBOOT   EQU     0       ;RE-BOOT CP/M
BDOS    EQU     5       ;BDOS CALL ENTRY
FCB     EQU     5CH     ;DEFAULT FILE CONTROL BLOCK
INBUF   EQU     80H     ;DEFAULT DMA ADDRESS
;CP/M BDOS FUNCTIONS
READF   EQU     1       ;READ CONSOLE INTO (A)
TYPEF   EQU     2       ;READ CONSOLE FROM (E)
INIT    EQU     13      ;INITIALIZE DISC IN DRIVE A:
OPEN    EQU     15      ;OPEN FILE
CLOS    EQU     16      ;CLOSE FILE
FIND    EQU     17      ;FIND FILE IN DIRECTORY
DELE    EQU     19      ;DELETE FILE
READ    EQU     20      ;READ FILE
WRIT    EQU     21      ;WRITE FILE
MAKE    EQU     22      ;CREATE FILE DIRECTORY ENTRY
       ORG     0100H   ;TPA PROGRAM START ADDRESS
       JMP     START   ;GOTO PROGRAM START
; CONSOLE I/O THROUGH BDOS CALL
CI      PUSH    H       ;SAVE REGISTERS
       PUSH    D
       PUSH    B
       MVI     C,READF ;READ FUNCTION
       CALL    BDOS    ;RETURN CHAR IN (A)
       POP     B       ;RESTORE OTHER REGISTERS
       POP     D
       POP     H
       RET
CO      PUSH    H
       PUSH    D
       PUSH    B
       MOV     E,A     ;MOVE PRINT CHAR TO (E)
       MVI     C,TYPEF
       CALL    BDOS
       POP     B
       POP     D
       POP     H
       RET
CCRLF   MVI     A,0DH   ;CR LF TO CONSOLE
       CALL    CO
       MVI     A,0AH
       JMP     CO
MSGXP   POP     H       ;OUTPUT MESSAGE AND RETURN
MSGX1   MOV     A,M     ;THROUGH INDEX (H,L)
       CPI     0       ;TEXT TERMINATOR = 0
       JZ      MSGEX
       CALL    CO
       INX     H
       JMP     MSGX1
MSGEX   INX     H       ;POINT TO TEXT + 1
       PCHL            ;AND RETURN THERE
; FILECOPY CONSOLE MESSAGE SUBROUTINE
RDMSG   CALL    CCRLF   ;PROMPT FOR READ DISK
       CALL    MSGXP
       DB      'READ DISK IN DRIVE, THEN CR'
       DB      0
RDMS1   CALL    CI      ;GET RESPONSE
       CPI     'X'     ;ALLOW EXIT
       JZ      RBOOT   ;BACK TO CP/M
       CPI     0DH     ;ACCEPT CR ONLY
       JNZ     RDMS1
       CALL    CCRLF   ;ACKNOWLEDGE
       RET             ;AND RETURN
WRMSG   CALL    CCRLF   ;PROMPT FOR WRITE DISK
       CALL    MSGXP
       DB      'WRITE DISK IN DRIVE, THEN CR'
       DB      0
WRMS1   CALL    CI
       CPI     'X'
       JZ      RBOOT
       CPI     0DH
       JNZ     WRMS1
       CALL    CCRLF
       RET
RDERR   CALL    CCRLF   ;SHOW READ ERROR
       CALL    MSGXP
       DB      'READ ERROR!  ENTER X TO ABORT'
       DB      0DH,0AH
       DB      '                   CR TO IGNORE'
       DB      0
RDER1   CALL    CI      ;ACCEPT CR OR X
       CPI     'X'
       JZ      EXIT
       CPI     0DH
       RZ              ;RETURN MEANS IGNORE
       JMP     RDER1
WRERR   CALL    CCRLF   ;SHOW WRITE ERROR
       CALL    MSGXP
       DB      'PERMANENT WRITE ERROR!'
       DB      0
EXIT    CALL    MSGXP
       DB      'BACK TO CP/M?'
       DB      0
WRER1   CALL    CI      ;WAIT FOR CR    X
       CPI     0DH
       JZ      RBOOT
       CPI     'X'
       JZ      RBOOT
       JNZ     WRER1   ;AS ONLY LEGAL RESPONSE
; BEGIN FILECOPY PROGRAM
START   CALL    CCRLF   ;SIGN ON MESSAGE
       CALL    MSGXP
       DB      'SINGLE DRIVE FILECOPY  V81.1   4 MAY 81'
       DB      0DH,0AH
       DB      0
       CALL    RDMSG   ;PROMPT FOR READ DISK
       LXI     D,FCB   ;LOOK FOR FILE
       MVI     C,FIND  ;BEFORE GOING AHEAD
       CALL    BDOS
       CPI     255     ;DOES FILE EXITS?
       JNZ     RUN     ;YES. READ IT
       CALL    CCRLF   ;NO. GIVE UP
       CALL    MSGXP
       DB      'FILE DOES NOT EXIST!'
       DB      0
       JMP     EXIT    ;REBOOT CP/M
RUN     LXI     H,FCB   ;SET UP FCB'S FOR
       LXI     D,RFCB  ;READ AND WRITE
       MVI     C,16
RUN1    MOV     A,M
       STAX    D
       INX     H
       INX     D
       DCR     C
       JNZ     RUN1
       LXI     H,FCB
       LXI     D,WFCB
       MVI     C,16
RUN2    MOV     A,M
       STAX    D
       INX     H
       INX     D
       DCR     C
       JNZ     RUN2
       LXI     H,BUFFR ;INITIALIZE POINTER
       SHLD    HSAVE   ;INTO BUFFER
       XRA     A       ;ZERO RECORD COUNTS
       STA     ASAVE
       STA     ASAVE+1
       STA     RFCBN
       STA     WFCBN
; READ THE FILE INTO RAM
RFILE   LXI     D,RFCB  ;USE READ FCB
       MVI     C,OPEN  ;AND OPEN THE FILE
       CALL    BDOS
       CPI     255     ;ERROR?
       JNZ     RFIL1
       CALL    CCRLF
       CALL    MSGXP   ;YES. SHOW IT
       DB      'UNABLE TO OPEN FILE!'
       DB      0
       JMP     EXIT    ;AND ABORT
RFIL1   LXI     D,RFCB  ;READ A RECORD
       MVI     C,READ
       CALL    BDOS
       CPI     0       ;GOOD READ?
       JZ      RFIL2   ;YES. STORE IT
       CPI     1       ;OR END OF FILE?
       JZ      WFILE   ;YES. WRITE IT
       CALL    RDERR   ;NO. SHOW ERROR
RFIL2   LHLD    HSAVE   ;STORE THE RECORD
       LXI     D,INBUF
       MVI     C,80H
RFIL3   LDAX    D
       MOV     M,A
       INX     H
       INX     D
       DCR     C
       JNZ     RFIL3
       SHLD    HSAVE   ;AND NEXT ADDRESS
       PUSH    H
       LHLD    ASAVE
       INX     H
       SHLD    ASAVE
       POP     H
       LDA     7       ;ANY MEMORY LEFT?
       DCR     A
       CMP     H
       JNZ     RFIL1   ;YES. KEEP READING
       CALL    CCRLF   ;NO. ABORT
       CALL    MSGXP
       DB      'FILE IS TOO BIG!'
       DB      0
       JMP     EXIT
; WRITE THE FILE ONTO DISK
WFILE   CALL    WRMSG   ;PROMPT FOR WRITE DISK
       MVI     C,INIT  ;INITIALIZE DISK FOR WRITE
       CALL    BDOS
       LXI     D,WFCB  ;SEE IF FILE EXITS
       MVI     C,FIND
       CALL    BDOS
       CPI     255     ;WE CAN'T WRITE TWO
       JZ      WFIL1   ;NO. CONTINUE
       CALL    CCRLF   ;YES. ERASE OR ABORT?
       CALL    MSGXP
       DB      'FILE ALREADY EXITS. ENTER:X TO ABORT'
       DB      0DH,0AH
       DB      '                          CR TO ERASE IT'
       DB      0
WAIT1   CALL    CI
       CPI     'X'
       JZ      RBOOT
       CPI     0DH
       JNZ     WAIT1
       LXI     D,WFCB  ;ERASE THE OLD FILE
       MVI     C,DELE
       CALL    BDOS
WFIL1   LXI     D,WFCB  ;OPEN FILE FOR WRITE
       MVI     C,MAKE
       CALL    BDOS
       CPI     255     ;OPEN OK?
       JNZ     WFIL2   ;YES. CONTINUE
       CALL    CCRLF
       CALL    MSGXP   ;SHOW UNABLE TO OPEN
       DB      'OUT OF DIRECTORY SPACE!'
       DB      0
       JMP     EXIT
WFIL2   LXI     H,BUFFR ;INITIALIZE POINTER
       SHLD    HSAVE
WFIL3   LHLD    HSAVE   ;MOVE RECORD TO OUTPUT
       LXI     D,INBUF ;BUFFER (SAME AS INPUT)
       MVI     C,80H
WFIL4   MOV     A,M
       STAX    D
       INX     H
       INX     D
       DCR     C
       JNZ     WFIL4
       SHLD    HSAVE   ;SAVE NEXT ADDRESS
       LXI     D,WFCB  ;WRITE THE RECORD
       MVI     C,WRIT
       CALL    BDOS
       CPI     0
       CNZ     WRERR   ;SHOW WRITE ERROR
       LHLD    ASAVE   ;COUNT RECORD WRITTEN
       DCX     H
       SHLD    ASAVE
       MOV     A,H
       ORA     L
       JNZ     WFIL3   ;AND WRITE ANOTHER
       LXI     D,WFCB  ;DONE. CLOSE THE FILE
       MVI     C,CLOS
       CALL    BDOS
       CALL    CCRLF
       CALL    MSGXP   ;PROMPT FOR REBOOT
       DB      'ALL DONE!'
       DB      0
       JMP     EXIT    ;AND WE ARE ALL DONE
; RAM BUFFERS
HSAVE   DS      2       ;BUFFER ADDRESS STORE
ASAVE   DS      2       ;RECORD COUNT
RFCB    DS      33      ;READ FILE CONTROL BLOCK
WFCB    DS      33      ;WRITE FILE CONTROL BLOCK
BUFFR   DB      0       ;DATA BUFFER START
RFCBN   EQU     RFCB+32 ;RECORD COUNTS. READ
WFCBN   EQU     WFCB+32 ;AND WRITE
       END

You are viewing proxied material from gopher.floodgap.com. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.