home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Oakland CPM Archive
/
oakcpm.iso
/
cpm
/
zcpr2
/
erase.mqc
/
ERASE.MAC
Wrap
Text File
|
1985-02-09
|
15KB
|
715 lines
; PROGRAM: ERASE
; VERSION: 4.0
; DATE: 16 JAN 83
; AUTHOR: RICHARD CONN
; PREVIOUS VERSION: 3.3 (6 JAN 83), 3.2 (7 DEC 82)
; PREVIOUS VERSION: 3.1 (9 NOV 82), 3.0 (18 OCT 82), 2.0 (18 NOV 81)
; PREVIOUS VERSION: 1.2 (12 APR 81), 1.3 (25 OCT 81), 1.4 (26 OCT 81)
; PREVIOUS VERSION: 1.0 (14 JUN 80), 1.1 (19 OCT 80)
VERS equ 40
;
; This program is Copyright (c) 1982, 1983 by Richard Conn
; All Rights Reserved
;
; ZCPR2 and its utilities, including this one, are released
; to the public domain. Anyone who wishes to USE them may do so with
; no strings attached. The author assumes no responsibility or
; liability for the use of ZCPR2 and its utilities.
;
; The author, Richard Conn, has sole rights to this program.
; ZCPR2 and its utilities may not be sold without the express,
; written permission of the author.
;
;
; ERASE COMMAND --
; Erase files specified in command line. Command is of the form --
; ERASE DIR:FILENAME.TYP ISR
; If I option is given, Inspection of each file is performed and
; the user is given the option to erase the file or not. If S option is
; given, System files are included in erase procedure. Drive specification
; is optional. If R option is given, R/O files are erased without prompting.
;
FALSE EQU 0
TRUE EQU NOT FALSE
ESIZE EQU 16 ; SIZE OF DIR ENTRY (FROM SYSLIB DIRF ROUTINE)
EXT DIRF ; DIRECTORY PROCESSOR
EXT ZFNAME ; FILE NAME PROCESSOR
EXT ZGPINS ; ZCPR2 BUFFER INIT
EXT PHLDC ; PRINT HL AS DECIMAL CHARS
EXT PRINT ; PRINT ROUTINE
EXT COUT ; CONSOLE OUTPUT ROUTINE
EXT CIN ; CONSOLE INPUT ROUTINE
EXT CAPS ; CAPITALIZE ROUTINE
EXT CRLF ; NEW LINE ROUTINE
EXT FILLB ; FILL ROUTINE
EXT CODEND ; CODE END COMPUTATION ROUTINE
;
; CP/M EQUATES
;
CPM EQU 0 ; WARM BOOT
BDOS EQU 5 ; BDOS ENTRY
FCB EQU 5CH ; FCB
BUFF EQU 80H ; INPUT LINE BUFFER
CR EQU 13 ; <CR>
LF EQU 10 ; <LF>
;
; Branch to Start of Program
;
JMP START
;
;******************************************************************
;
; SINSFORM -- ZCPR2 Utility Standard General Purpose Initialization Format
;
; This data block precisely defines the data format for
; initial features of a ZCPR2 system which are required for proper
; initialization of the ZCPR2-Specific Routines in SYSLIB.
;
;
; EXTERNAL PATH DATA
;
EPAVAIL:
DB 0FFH ; IS EXTERNAL PATH AVAILABLE? (0=NO, 0FFH=YES)
EPADR:
DW 40H ; ADDRESS OF EXTERNAL PATH IF AVAILABLE
;
; INTERNAL PATH DATA
;
INTPATH:
DB 0,0 ; DISK, USER FOR FIRST PATH ELEMENT
; DISK = 1 FOR A, '$' FOR CURRENT
; USER = NUMBER, '$' FOR CURRENT
DB 0,0
DB 0,0
DB 0,0
DB 0,0
DB 0,0
DB 0,0
DB 0,0 ; DISK, USER FOR 8TH PATH ELEMENT
DB 0 ; END OF PATH
;
; MULTIPLE COMMAND LINE BUFFER DATA
;
MCAVAIL:
DB 0FFH ; IS MULTIPLE COMMAND LINE BUFFER AVAILABLE?
MCADR:
DW 0FF00H ; ADDRESS OF MULTIPLE COMMAND LINE BUFFER IF AVAILABLE
;
; DISK/USER LIMITS
;
MDISK:
DB 4 ; MAXIMUM NUMBER OF DISKS
MUSER:
DB 31 ; MAXIMUM USER NUMBER
;
; FLAGS TO PERMIT LOG IN FOR DIFFERENT USER AREA OR DISK
;
DOK:
DB 0FFH ; ALLOW DISK CHANGE? (0=NO, 0FFH=YES)
UOK:
DB 0FFH ; ALLOW USER CHANGE? (0=NO, 0FFH=YES)
;
; PRIVILEGED USER DATA
;
PUSER:
DB 10 ; BEGINNING OF PRIVILEGED USER AREAS
PPASS:
DB 'chdir',0 ; PASSWORD FOR MOVING INTO PRIV USER AREAS
DS 41-($-PPASS) ; 40 CHARS MAX IN BUFFER + 1 for ending NULL
;
; CURRENT USER/DISK INDICATOR
;
CINDIC:
DB '$' ; USUAL VALUE (FOR PATH EXPRESSIONS)
;
; DMA ADDRESS FOR DISK TRANSFERS
;
DMADR:
DW 80H ; TBUFF AREA
;
; NAMED DIRECTORY INFORMATION
;
NDRADR:
DW 00000H ; ADDRESS OF MEMORY-RESIDENT NAMED DIRECTORY
NDNAMES:
DB 64 ; MAX NUMBER OF DIRECTORY NAMES
DNFILE:
DB 'NAMES ' ; NAME OF DISK NAME FILE
DB 'DIR' ; TYPE OF DISK NAME FILE
;
; REQUIREMENTS FLAGS
;
EPREQD:
DB 0FFH ; EXTERNAL PATH?
MCREQD:
DB 0FFH ; MULTIPLE COMMAND LINE?
MXREQD:
DB 0FFH ; MAX USER/DISK?
UDREQD:
DB 0FFH ; ALLOW USER/DISK CHANGE?
PUREQD:
DB 0FFH ; PRIVILEGED USER?
CDREQD:
DB 0FFH ; CURRENT INDIC AND DMA?
NDREQD:
DB 0FFH ; NAMED DIRECTORIES?
Z2CLASS:
DB 0 ; CLASS 0
DB 'ZCPR2'
DS 10 ; RESERVED
;
; END OF SINSFORM -- STANDARD DEFAULT PARAMETER DATA
;
;******************************************************************
;
;
; Start of Program
;
START:
LXI H,0 ; GET STACK PTR
DAD SP
SHLD STACK ; SAVE IT
LXI SP,STACK ; SET SP
MVI E,0FFH ; GET CURRENT USER
MVI C,32
CALL BDOS
STA CURUSER ; SAVE IT
MVI A,0FFH ; SET DEFAULT USER
STA USER
CALL ZGPINS ; INIT BUFFERS
CALL PRINT
DB 'ERASE Version '
DB VERS/10+'0','.',(VERS MOD 10)+'0',0
LDA FCB+1 ; GET FIRST CHAR OF FILE NAME
CPI '/' ; OPTION CAUGHT?
JNZ ECONT
; PRINT HELP INFORMATION
HELP:
CALL PRINT
DB CR,LF,'ERASE Command --'
DB CR,LF,' ERASE dir:filename.typ,dir:fn.ft,dir:fn.ft,... ooo'
DB CR,LF,LF,'d is disk, u is user, and o is one or more option '
DB 'letters.'
DB CR,LF,'If one or more options are specified, the o MUST be '
DB 'preceded by a space.'
DB CR,LF,'Nothing is required, and wild cards (?,*) are '
DB CR,LF,'permitted. o is optional, and valid options are -'
DB CR,LF,' I -- Inspect Mode (Give user option to delete)'
DB CR,LF,' R -- Erase R/O Files without prompting user'
DB CR,LF,' S -- Include System Files'
DB CR,LF,'dir: is a named directory or the form du:.'
DB CR,LF,'Named Directories are ',0
LDA NDREQD ; NAMED DIRS ON?
ORA A ; 0=NO
JNZ HELP1
CALL PRINT
DB 'NOT ',0
HELP1:
CALL PRINT
DB 'Permitted in this Version of ERASE'
DB CR,LF,'If u is omitted, current user is assumed, as with d.'
DB CR,LF,LF,'Special forms are:'
DB CR,LF,' ERASE dir: <-- Erase all files in named directory'
DB CR,LF,' ERASE du: <-- Erase all files in disk d, user u'
DB CR,LF,' ERASE u: <-- Erase all files in user u on '
DB 'current disk'
DB CR,LF,' ERASE d: <-- Erase all files on disk d in '
DB 'current user'
DB 0
JMP RETURN
; RESET USER NUMBER IF IT HAS CHANGED
RSETU:
PUSH H ; SAVE REGS
PUSH D
PUSH B
LDA CURUSER ; GET CURRENT USER
MOV E,A ; ... IN E
MVI C,32 ; PREP TO CHANGE USER
LDA USER ; USER CHANGED?
CPI 0FFH ; NO CHANGE?
CNZ BDOS ; IF NO 0FFH, THEN CHANGE OCCURRED
POP B ; RESTORE REGS
POP D
POP H
RET
; RETURN TO OS
RETURN:
CALL RSETU ; RESET USER IF NECESSARY
RETX:
LHLD STACK ; GET OLD STACK
SPHL ; SET IT
RET
; USER CHANGE NOT ALLOWED ERROR
UNOK:
CALL PRINT
DB CR,LF,'User Number Change Not Allowed -- Aborting',0
JMP RETURN
; DISK CHANGE NOT ALLOWED ERROR
DNOK:
CALL PRINT
DB CR,LF,'Disk Change Not Allowed -- Aborting',0
JMP RETURN
; PLACE ZERO AT END OF BUFFER
ECONT:
LXI H,BUFF ; PT TO BUFFER
MOV A,M ; GET COUNT
INX H ; PT TO FIRST CHAR
ADD L ; PT TO END OF BUFFER
MOV L,A
MOV A,H
ACI 0
MOV H,A
MVI M,0
; COPY BUFFER INTO TEMP BUFFER
LXI H,BUFF ; PT TO BUFFER
MOV B,M ; GET CHAR COUNT
INX H ; PT TO FIRST CHAR
INR B ; ADD ENDING 0
LXI D,CMDLNE ; PT TO CMDLNE BUFFER
CALL MOVEB ; COPY INTO COMMAND LINE BUFFER
; EXTRACT FLAGS IF PRESENT
XRA A ; SET NO INSPECT, NO R/O, AND NO SYSTEM FILES
STA INSPECT
STA READONLY
MVI A,80H ; SELECT NON-SYS
STA SYSTEM
LXI H,0 ; SET FILE COUNT
SHLD FILECNT
LXI H,CMDLNE ; PT TO BUFFER
; SKIP TO FILE NAME STRING
SBLANK:
MOV A,M ; SKIP TO NON-BLANK
CPI ' ' ; <SP>?
JNZ SBL1
INX H ; PT TO NEXT CHAR
JMP SBLANK
; SKIP TO END OF FILE NAME STRING
SBL1:
MOV A,M ; SKIP TO <SP> OR EOL
ORA A ; DONE?
JZ OPT
CPI ' ' ; <SP>
JZ OPT
INX H ; PT TO NEXT
JMP SBL1
; CHECK FOR LEADING SLASH ON OPTION AND SKIP IT IF SO
OPT:
CPI '/' ; OPTION CHAR?
JNZ OPTION
INX H ; SKIP SLASH
; PROCESS LIST OF OPTIONS
OPTION:
MOV A,M ; GET BYTE
ORA A ; DONE?
JZ DSPEC
INX H ; PT TO NEXT CHAR
CPI ' ' ; SKIP OVER SPACES
JZ OPTION
CPI '/' ; IF OPTION LETTER, OBVIOUS ERROR, SO HELP
JZ HELP
CPI 'I' ; INSPECT?
JZ OPTINS
CPI 'R' ; READ/ONLY?
JZ OPTRO
CPI 'S' ; SYSTEM FILES?
JNZ HELP
MVI A,0C0H ; SET FOR SYS AND NON-SYS FILES
STA SYSTEM
JMP OPTION
OPTINS:
MVI A,0FFH ; INSPECT
STA INSPECT
JMP OPTION
OPTRO:
MVI A,0FFH ; SET R/O
STA READONLY
JMP OPTION
; EXTRACT DISK, USER, AND FILE NAME INFORMATION
DSPEC:
LXI H,CMDLNE-1 ; PT TO BEFORE FIRST BYTE
DSPEC0:
INX H ; PT TO BYTE
MOV A,M ; GET BYTE
ORA A ; DONE?
JZ HELP
CPI ' ' ; <SP>?
JZ DSPEC0
;
; MAJOR REENTRY POINT WHEN FILE SPECS ARE SEPARATED BY COMMAS
; HL PTS TO FIRST BYTE OF NEXT FILE SPEC
;
DSPEC1:
CALL RSETU ; RESET USER IF NECESSARY
LXI D,FCB ; PT TO FCB IN DE, PT TO FIRST CHAR OF FILE NAME IN HL
PUSH H ; SAVE HL PTR
CALL CODEND ; GET ADDRESS OF SCRATCH AREA
MOV B,H ; ADDRESS IN BC
MOV C,L
POP H
CALL ZFNAME ; EXTRACT FILE NAME INTO FCB, AND GET DISK AND USER
JZ DERR ; ERROR HANDLER
SHLD NEXTCH ; SAVE PTR TO DELIMITER WHICH ENDED SCAN
PUSH B ; SAVE BC
LXI H,FCB+1 ; SEE IF FILE NAME IS ALL WILD
MVI B,11 ; 11 BYTES
WTEST:
MOV A,M ; GET BYTE
INX H ; PT TO NEXT
CPI '?' ; WILD?
JNZ NOWILD
DCR B ; COUNT DOWN
JNZ WTEST
LDA INSPECT ; INSPECT?
ORA A ; 0=NO
JNZ NOWILD
CALL PRINT
DB CR,LF,'Erase All Files? ',0
CALL CIN ; GET RESPONSE
CALL CAPS ; CAPITALIZE
CALL COUT ; ECHO
CPI 'Y' ; YES?
JZ NOWILD
CALL PRINT
DB CR,LF,'Aborting',0
JMP RETX
NOWILD:
POP B ; GET BC
MOV A,C ; GET NEW USER
STA USER ; SAVE IT
MOV A,B ; SAVE POSSIBLE DRIVE SPEC
CPI 0FFH ; CURRENT DISK?
JZ USPEC
LDA MDISK ; GET MAX DISK NUMBER
DCR B ; ADJUST TO WITHIN BOUNDS 0-15
CMP B ; WITHIN BOUNDS?
MOV A,B ; GET DISK NUMBER IN A
JNC DSPEC2
DERR:
CALL PRINT
DB CR,LF,'Invalid Drive or User Specification',0
JMP RETURN
; LOG IN SPECIFIED DISK
DSPEC2:
PUSH B ; SAVE BC
MOV E,A ; DISK NUMBER IN E
LDA DOK ; OK TO DO SO?
ORA A ; 0=NO
JZ DNOK ; NOT ALLOWED ABORT
MVI C,14 ; LOG IN DISK
CALL BDOS
POP B ; GET BC
; CHECK FOR USER NUMBER
USPEC:
MOV A,C ; GET NEW USER NUMBER
CPI 0FFH ; DEFAULT USER?
JZ ERASE
CPI '?' ; ALL USERS NOT ALLOWED?
JZ UERR
LDA MUSER ; GET MAX USER NUMBER
CMP C
MOV A,C ; USER NUMBER IN A
JNC ULOG
UERR:
CALL PRINT
DB CR,LF,'Invalid User Number',0
JMP RETURN
ULOG:
MOV E,A ; USER NUMBER IN E
LDA UOK ; ALLOWED?
ORA A ; 0=NO
JZ UNOK ; DISALLOWED AND ABORT
MVI C,32 ; SELECT USER
CALL BDOS
; LOAD DIRECTORY AND ERASE FILES
ERASE:
CALL CODEND ; PT TO END OF CODE
LDA SYSTEM ; GET SYS/NON-SYS FLAGS
LXI D,FCB ; PT TO FCB
CALL DIRF ; LOAD DIR, SELECT FILES, PACK, AND ALPHABETIZE
; ERASE DIR FILES; HL PTS TO FIRST FILE, BC=FILE COUNT
CALL ERAFILES
; CHECK FOR NEXT FILE SPEC
LHLD NEXTCH ; GET PTR
MOV A,M ; GET DELIM
CPI ',' ; ANOTHER FILE?
JNZ ERADONE
INX H ; PT TO CHAR AFTER COMMA
JMP DSPEC1 ; CONTINUE PROCESSING
; ERASE COMPLETE -- PRINT COUNT AND EXIT
ERADONE:
CALL PRCOUNT ; PRINT FILE COUNT
JMP RETURN
; ERASE SELECTED FILES
ERAFILES:
MOV A,B ; CHECK FOR ANY FILES LOADED
ORA C
RZ
; PRINT FILE NAME
ERAFLP:
PUSH B ; SAVE ENTRY COUNT
CALL CRLF ; NEW LINE
PUSH H ; SAVE PTR TO FCB
INX H ; PT TO FILE NAME
MVI B,8 ; PRINT NAME
CALL PRNT
MVI A,'.' ; DECIMAL
CALL COUT
MVI B,3 ; PRINT TYPE
CALL PRNT
POP H ; GET PTR
; CHECK FOR INSPECTION AND INSPECT IF SET
LDA INSPECT ; GET FLAG
ORA A ; 0=NO
JZ ERAIT
; PROMPT USER FOR ERASE
CALL ERAQ ; ERASE QUESTION
CPI 'Q' ; QUIT?
JZ QUIT
CPI 'Y' ; YES?
JZ ERAIT
; DON'T ERASE FILE
ERANO:
CALL PRINT
DB ' ++ NOT Erased ++',0
JMP ERATEST
; PROMPT USER FOR ERASE
ERAQ:
CALL PRINT ; PRINT PROMPT
DB ' -- Erase (Y/N/Q=Quit/other=N)? ',0
CALL CIN ; GET RESPONSE
CALL CAPS ; CAPITALIZE
CALL COUT ; ECHO
RET
; QUIT ERASE PROGRAM
QUIT:
CALL PRCOUNT ; PRINT COUNT OF FILES ERASED
CALL PRINT
DB ' ++ QUIT -- Returning to CP/M ++',0
JMP RETURN
; ERASE FILE
ERAIT:
PUSH H
LXI D,9 ; PT TO R/O ATTRIBUTE
DAD D
MOV A,M ; GET R/O ATTRIBUTE
POP H ; RESTORE PTR
ANI 80H ; R/O?
JZ ERAIT1 ; R/W - PROCEED
LDA READONLY ; GET R/O ERASE FLAG
ORA A ; 0=QUERY
JNZ ERAIT0 ; ERASE WITHOUT QUESTION IF FLAG SET
CALL PRINT ; NOTIFY USER AND PROMPT
DB CR,LF,' File is R/O',0
CALL ERAQ ; ASK QUESTION
CPI 'Q' ; QUIT?
JZ QUIT
CPI 'Y' ; ERASE R/O
JNZ ERATEST ; DO NOT ERASE IF NOT YES
; ERASE R/O FILE
ERAIT0:
CALL DET$VERS ; DETERMINE VERSION NUMBER
JZ ERAIT1 ; IF CP/M 1.X - DO NOT RESET ATTRIBUTE
PUSH H ; SAVE PTR TO FILE ENTRY
LXI D,9 ; PT TO R/O ATTRIBUTE
DAD D
MOV A,M ; GET ATTRIBUTE
ANI 7FH ; MAKE R/W
MOV M,A
POP H ; GET PTR TO FCB
PUSH H ; SAVE PTR AGAIN
XCHG ; DE PTS TO FCB
XRA A ; MAKE SURE CURRENT DISK IS SELECTED
STAX D
MVI C,30 ; SET FILE ATTRIBUTES
CALL BDOS
POP H
; ERASE R/W FILE
ERAIT1:
PUSH H ; SAVE PTR TO FILE NAME TO ERASE
INX H ; PT TO FIRST BYTE OF NAME
LXI D,ERAFCB ; SET UP FCB
PUSH D ; SAVE PTR
XRA A ; A=0
STAX D ; CURRENT DISK
INX D ; PT TO FIRST CHAR
MVI B,11 ; COPY 11 BYTES
CALL MOVEB ; COPY HL TO DE FOR 11 BYTES
XCHG ; HL PTS TO REST OF FCB
MVI B,24 ; FILL REST OF FCB WITH ZEROES
XRA A ; A=0
CALL FILLB
POP D ; GET PTR
MVI C,19 ; DELETE FILE
CALL BDOS
CALL PRINT
DB ' ++ Erased ++',0
LHLD FILECNT ; INCREMENT COUNT
INX H
SHLD FILECNT
POP H ; GET PTR TO DIRECTORY ENTRY
; PT TO NEXT ENTRY
ERATEST:
LXI D,ESIZE ; PT TO NEXT ENTRY
DAD D
POP B ; GET COUNT
DCX B ; COUNT DOWN
MOV A,B ; CHECK FOR ZERO
ORA C
JNZ ERAFLP
; RETURN TO CALLER
RET
;
; COPY HL TO DE FOR B BYTES
;
MOVEB:
MOV A,M ; GET BYTE
STAX D ; PUT BYTE
INX H ; PT TO NEXT
INX D
DCR B ; COUNT DOWN
JNZ MOVEB
RET
;
; PRINT CHARS PTED TO BY HL FOR B BYTES
;
PRNT:
MOV A,M ; GET CHAR
CALL COUT
INX H ; PT TO NEXT
DCR B ; COUNT DOWN
JNZ PRNT
RET
;
; PRINT COUNT OF NUMBER OF FILES ERASED
;
PRCOUNT:
CALL CRLF ; NEW LINE
CALL PRINT
DB CR,LF,'++ ',0
LHLD FILECNT ; GET COUNT
MOV A,L ; CHECK FOR NONE
ORA H
JZ PRNO
CALL PHLDC ; PRINT DECIMAL COUNT
JMP PRMS
PRNO:
CALL PRINT
DB 'No ',0
PRMS:
LHLD FILECNT ; 1 FILE ERASED?
MOV A,H ; HIGH ZERO?
ORA A
JNZ PRMULT
MOV A,L ; LOW ONE?
CPI 1
JZ PRSING
PRMULT:
CALL PRINT
DB ' Files Erased ++',0
RET
PRSING:
CALL PRINT
DB ' File Erased ++',0
RET
;
; DETERMINE CP/M VERSION NUMBER
; RETURN W/ZERO FLAG SET IF CP/M 1.X
;
DET$VERS:
PUSH B
PUSH D
PUSH H
MVI C,12 ; DET VERS
CALL BDOS
MOV A,H ; SET FLAG
ORA L
POP H
POP D
POP B
RET
;
; BUFFERS
;
INSPECT:
DS 1 ; INSPECT FLAG (0=NO, 0FFH=YES)
SYSTEM:
DS 1 ; SYSTEM FLAG (0=NO, 80H=YES)
READONLY:
DS 1 ; READ/ONLY FLAG (0=QUERY FOR R/O, 0FFH=DON'T)
USER:
DS 1 ; NEW USER, OR 0FFH IF NO CHANGE
CURUSER:
DS 1 ; CURRENT USER NUMBER
NEXTCH:
DS 2 ; PTR TO NEXT CHAR IN MULTIFILE COMMAND LINE
FILECNT:
DS 2 ; COUNT OF NUMBER OF FILES ERASED
ERAFCB:
DS 40 ; FCB FOR ERASE
CMDLNE:
DS 256 ; ALLOW MAX SIZE OF COMMAND LINE
DS 100 ; STACK AREA
STACK:
DS 2 ; OLD STACK PTR
END