home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.barnyard.co.uk
/
2015.02.ftp.barnyard.co.uk.tar
/
ftp.barnyard.co.uk
/
cpm
/
commercial-software
/
programming
/
Z80TOOLS.ZIP
/
DISK3.ZIP
/
SEQFILE2.ANT
< prev
next >
Wrap
Text File
|
1998-07-30
|
40KB
|
1,423 lines
name 'FOPNI'
title 'FOPNI -- open file for input'
;===============================================================
; Copyright (C) 1985 M&T Publishing Co. all rights reserved
;
; Prepare an existing file for use: assign a buffer (if needed),
; check for a device file, open a disk file.
;
; interface: FRESET macro
;
; History
; initial code 2 April 84
;===============================================================
maclib equates
maclib smallz80
maclib fcr
extrn @FBUFR,@FOPNC,@FOPNE,@FILLB
public @FOPNI
@FOPNI:
push b
push h
push d
xtix ; IX->FCR
; First off, get a buffer for the file if it doesn't have one.
call @FBUFR
; See if the file is really a device. If so, we are done.
call @FOPNC
bitx FcrDisk,FcrFlags
jrz exit
; It isn't a device, so let's try to open it as a disk file. If
; we can't, return Z true (instant eof).
mvi a,FilePMread ; want only to read it
call @FOPNE
bitx FcrNotEof,FcrFlags
jrz exit
; The file exists and is open to CP/M, at least for input (it
; may be writeable as well, but we don't check that). Fill the
; buffer with the first load of data from disk, setting Bufptr
; and Bufeod -- and maybe finding end of file if it's empty.
call @FILLB
; Exit, setting the Z flag FALSE if the file is capable of
; input (a device file might not be, and a disk file might
; have had no data in it).
exit:
bitx FcrNotEof,FcrFlags
xtix
pop d
pop h
pop b
ret
end
d a disk file might
; have had no data in it).
exit: name 'FOPNO'
title 'FOPNO -- open file for sequential output'
;===============================================================
; Copyright (C) 1985 M&T Publishing Co. all rights reserved
;
; Open for sequential output the file represented by DE->FCR.
; If it is a device, all we have to do is give it a buffer and
; check that it supports output.
;
; For disk files, we implement an elaborate method that (a)
; ensures data integrity and (b) allows a utility to take the
; same filespec as both its input and its output. We set aside
; the present filetype and replace it with "$$$" We also save
; the password. Any file "name.$$$" is erased and a new file of
; that name is created. It will receive the output. See FCLOS
; for the rest of the story.
;
; interface: FREWRITE macro
;
; History
; initial code 05 April 84
;===============================================================
maclib equates
maclib smallz80
maclib services
maclib fcr
extrn @FBUFR,@FOPNC,@FABTX,@FOPNE,@FMAKE,@BDOS
public @FOPNO
@FOPNO:
push psw
push b
push h
push d
xtix ; IX->FCR
; Save the last-rec-fill byte passed in register A
stx a,FcrFillbyte
; Get a buffer if we need one.
call @FBUFR
; Use FOPNC to see if the file is a device-name, setting it up
; for use if so.
call @FOPNC
bitx FcrDisk,FcrFlags
jrnz isdisk
; It appears to be a device. Some devices (KBD:, AXI:) are not
; allowed to be output files. If that's the case here, somebody
; has goofed, and we will abort with "read-only file."
bitx FcrOutput,FcrFlags
jnz exit ; (it's ok)
mvix 3+11,FcrRetcode ; fake CP/M 3 "r/o file" return
jmp @FABTX
; It's to be a disk file. Does a file of this name exist now,
; and if so is it protected by a password, and if so, do we have
; a password for it? @FOPNE will try to answer these questions.
isdisk:
mvi a,FilePMread+FilePMwrite+FilePMdelete
call @FOPNE ; any protect level is bad news
; If the file doesn't exist, we can just make it right now
; and have less to do at close time.
bitx FcrNotEof,FcrFlags
jrnz doesexist
call @FMAKE ; right, make it
jmp exit ; ..and done.
; "Filename.typ" does exist, so we will create our output as
; "filename.$$$" instead. Save the desired filetype for close
; time and move in the dollarsigns.
doesexist:
ldx a,FcrType
stx a,FcrOtype
ldx a,FcrType+1
stx a,FcrOtype+1
ldx a,FcrType+2
stx a,FcrOtype+2
mvix '$',FcrType
mvix '$',FcrType+1
mvix '$',FcrType+2
; Now erase any existing "name.$$$" file. We already know
; (from the success of @FOPNE) that the filename is unambiguous.
; If "name.$$$" does exist and is r/o or password-protected, or
; if the disk is r/o, we will crash right here.
pushix
pop d
mvi c,BdosErase
call @BDOS
; That done, we can make "name.$$$." FMAKE would apply a
; password to the file, but we don't want that here, since
; (a) it would give us two passwords to juggle at close time and
; (b) if we crash later, we'd leave behind a protected scratch
; file. So we'll do the make from here.
pushix
pop d
mvi c,BdosMake
call @BDOS
; The scratch file has been created and is ready for output.
; Record its status in the FCR flags.
nf equ (1 shl FcrOutput)+(1 shl FcrDisk)+(1 shl FcrBaktype)
mvix nf,FcrFlags ; disk output at end
exit:
xtix
pop d
pop h
pop b
pop psw
ret
end
isk)+(1 shl FcrBaktype)
mvix nf,FcrFl name 'FOPNA'
title 'FOPNA -- open file for append-output'
;===============================================================
; Copyright (C) 1985 M&T Publishing Co. all rights reserved
;
; Opens the file represented by DE->FCR for output to the end of
; the file. If the file is a device, just set it up as usual
; and return -- device output is always "appended."
;
; For a disk file, open it as for input. Then if it doesn't
; exist, make a new file of this name.
;
; If it does exist, make sure it is read-write. Then read the
; last record of the file and try to find the correct byte
; within the last record to set under the buffer-pointer.
;
; interface: FAPPEND macro
;
; History
; initial code 06 April 84
;===============================================================
maclib equates
maclib services
maclib smallz80
maclib fcr
extrn @FBUFR,@FOPNC,@FOPNE,@FABTX,@FMAKE,@BDOS
public @FOPNA
@FOPNA:
push psw
push b
push h
push d
xtix
; Save the last-record-fill byte passed in A
stx a,FcrFillByte
; assign a buffer to the file and reset the buffer pointer.
call @FBUFR
; check the filespec for a device name. If it is a device,
; set it up for use.
call @FOPNC
bitx FcrDisk,FcrFlags
jrnz isdisk
; Some device files aren't allowed to do output. If this is one
; such, abort with a "read-only file." Otherwise we are done.
bitx FcrOutput,FcrFlags
jnz exit
mvix 3+11,FcrRetcode ; fake CP/M 3 "r/o file" return
jmp @FABTX
; 'Pears to be a disk. Try try to open it as for input. The
; NotEof bit will be set if the file exists, the Output bit if
; it is read-write.
isdisk:
mvi a,FilePMread+FilePMwrite
call @FOPNE
bitx FcrNotEof,FcrFlags
jrnz itexists
; The file wasn't found. All we have to do is make a new
; file of this name. Output will be to end of new, empty file.
call @FMAKE
jmp exit ; that's it
; The file exists, is open, and is (@FOPNE says) writable. Now
; we have to position ourselves to its end. The first step is
; to get the file size, which is the relative record address
; of the last existing record, plus one.
itexists:
pushix
pop d ; DE->FCB again..
mvi c,BdosFileSize
call @BDOS ; updates FcrRRA (and saves DE)
; We want the last record itself, so we have to decrement the
; 3-byte number the BDOS set for us.
lxi h,FcrRRA
dad d ; HL->low byte of number
mov a,m ! sui 1 ; 1 from low byte
mov m,a ! inx h
mov a,m ! sbi 0 ; carry from middle byte
mov m,a ! inx h
mov a,m ! sbi 0 ; carry from high byte
mov m,a
; Now we can read that last 128-byte record into the buffer.
; Such a direct read sets the FCB so that a later sequential
; write will go to the same record (establishing the Sequential
; Output Condition).
push d
if CpmLevel gt 22h ; under CP/M Plus we have to
mvi e,1
mvi c,BdosSetMulti ; set multi-record count to 1
call @BDOS
endif ; under all systems we have to
ldbwx d,FcrBufadr
mvi c,BdosSetBuffer
call BdosJump ; set buffer address
pop d
; on this read, only two returns are reasonably possible,
; 0=success, and 10=media change. The latter is so unlikely
; I think we can ignore it.
mvi c,BdosDirRead
call @BDOS ; read last record
; The last record is in the buffer. Now we have to set the
; buffer pointer to address the byte after the last good one
; in that record. There's two ways to do it.
ldbwx h,FcrBufadr ; HL->data to scan
lxi b,128 ; count of bytes to check
ldx a,FcrFillByte
cpi CpmEof ; Ascii file, ending in ^Z?
jrnz binary ; (no, binary file)
; This is an Ascii file, or at least we aren't told otherwise.
; Now, some programs fill all unused bytes in the last record
; with ^Zs, while others make do with just one, leaving garbage
; after it. And of course the last record might be exactly full
; and have no ^Z in it at all. So we will scan left to right
; and stop at the first ^Z we see or at the end of the record.
; The Z80 CPIR instruction fits our needs precisely.
cpir ; if no hit at all,
jrnz nohit ; ..BC reduced to zero
inr c ; else reduced by 1 extra
nohit: mvi a,128
sub c ; A := # bytes preceding ^Z
stx a,FcrBufptr
jr exit
; This is a non-Ascii file, so we will assume that its last
; record was filled to the end with the fillbyte value. We
; want to scan right to left for the rightmost byte that is
; NOT equal to the fill value. The Z80 instruction CPD will
; do it, with some effort.
binary:
dad b ; HL->byte following record
dcx h ; HL->last byte of record
binloop:
cpd ; Z:=(A == *HL), HL--, BC--
jrnz hitx ; (found a non-fill byte)
jpo binloop ; (BC not down to zero)
jr nohitx ; (BC=0000, no hit)
hitx: inr c ; BC was reduced too far
nohitx: stx c,FcrBufptr
; Well, the file is ready for use. Load up the registers
; and exit.
exit: xtix
pop d
pop h
pop b
pop psw
ret
end
l, the file is ready for use. Load up the re name 'FOPNU'
title 'FOPNU -- open file for update'
;===============================================================
; Copyright (C) 1985 M&T Publishing Co. all rights reserved
;
; Prepare an existing file for use when the user plans to update
; it, that is, skip around and write in mid-file. Device files
; are not allowed -- we abort for "file not found." Read-only
; files are not allowed, they cause an abort (from @FOPNE).
;
; If the file does not exist, it is created. If it does exist,
; its first buffer of data is read. On exit, the Z flag is
; TRUE if the file is empty.
;
; interface: FUPDATE macro
;
; History
; initial code 23 April 84
;===============================================================
maclib equates
maclib smallz80
maclib fcr
extrn @FBUFR,@FOPNC,@FABTX,@FOPNE,@FMAKE,@FILLB
public @FOPNU
@FOPNU:
push b
push h
push d
xtix ; IX->FCR
; First off, get a buffer for the file.
call @FBUFR
; See if the file is really a device. If so, abort for "file
; not found," since a device can't be updated.
call @FOPNC
bitx FcrDisk,FcrFlags
jrnz isdisk
mvix 0+11,FcrRetcode ; fake CP/M 3 "not-found" error
jmp @FABTX
; The filespec isn't the name of a device, so try to open it
; as a disk file.
isdisk:
mvi a,FilePMread+FilePMwrite ; want rd/wrt access
call @FOPNE ; aborts on r/o file
bitx FcrNotEof,FcrFlags
jrnz exists
; The file doesn't exist. We will make a file of that name
; and exit with FcrNotEof false (and hence Z true).
call @FMAKE
jr exit
; The file exists and is open to CP/M for input and output.
; Now fill the buffer with the first load of data from disk,
; setting Bufptr and Bufeod, and maybe finding end of file if
; it's empty.
exists:
call @FILLB
; Exit, setting the Z flag FALSE if there is data to be read
; from the file.
exit:
bitx FcrNotEof,FcrFlags
xtix
pop d
pop h
pop b
ret
end
E if there is data to be read
; from the file.
exit:
bitx FcrNotEof,FcrFlags
xtix
pop d
po name 'FOPNC'
title 'FOPNC -- check filespec for device name'
;===============================================================
; Copyright (C) 1985 M&T Publishing Co. all rights reserved
;
; This subroutine of the file-open operations tests the filespec
; in IX->FCR to see if it names a device or not. As a byproduct
; it also clears the extent and current-record bytes of the FCB
; and the FcrFlags byte.
;
; If the file is NOT a device, the FcrDisk flag is set on. If
; it IS a device, the FcrFlags are set to reflect which device
; it is, the Output and NotEof flags are set to reflect whether
; that device can do output and/or input, and the Bdos request
; numbers for byte input and output are set in the FCR.
;
; History
; initial code 30 March 84
;===============================================================
maclib equates
maclib strings
maclib smallz80
maclib fcr
dseg
; These equates are used to assemble static FcrFlags bytes.
xCon equ 1 shl FcrCon
xAux equ 1 shl FcrAux
xLst equ 1 shl FcrLst
xLCR equ 1 shl FcrLastCR
xOut equ 1 shl FcrOutput
xInp equ 1 shl FcrNotEof
; These equates are the BDOS service numbers for device I/O
ICon equ 1
Ocon equ 2
IAux equ 3
OAux equ 4
OLst equ 5
colon: strconst ': ' ; comparand for e.g. CON:
devtab: strtable 9 ; lookup table for device names
; In the table entries, each string is followed by a flag byte
; and two Bdos request numbers. The entries are ordered by
; approximate frequency of use.
strentry 'CON' ; CON can do input, output
db xCon+xOut+xInp+xLCR,ICon,OCon
strentry 'LST' ; LST is only output
db xLst+xOut,0,OLst
strentry 'AUX' ; AUX is in or out
db xAux+xOut+xInp+xLCR,IAux,OAux
strentry 'RDR' ; RDR is the old name for AXI
db xAux+xInp+xLCR,IAux,0
strentry 'PUN' ; PUT is the old name for AXO
db xAux+xOut,0,OAux
strentry 'AXI' ; AXI is input only
db xAux+xInp+xLCR,IAux,0
strentry 'AXO' ; AXO is output only
db xAux+xOut,0,OAux
strentry 'KBD' ; KBD is console-input only
db xCon+xInp+xLCR,ICon,0
strentry 'CRT' ; CRT is console-output only
db xCon+xOut,0,OCon
cseg
extrn @STCMP,@STLOK
public @FOPNC
@FOPNC:
push psw
push h
push d
; clear the flags, current record, and extent bytes.
xra a
stx a,FcrExtent
stx a,FcrCurrec
stx a,FcrFlags
; To be a device, the FCB must have a default (zero) drivecode.
; We treat a filespec like "B:CON:" as a disk file.
cmpx Fcrdrive
jnz isdisk
; For a device, the "filenametyp" bytes look like "XXX:bbbbbbb"
; Since FcrExtent is zero, we can check for the colon and seven
; blanks with one string comparison.
pushix
pop d
lxi h,FcrName+3
dad d
xchg ; DE->":bbbbbbb" if present
lxi h,colon ; HL->comparand string
call @STCMP
jnz isdisk
; Now to check the XXX part. We will replace the colon with
; a NUL, then use a string table-search to look for the name.
; On a successful lookup, HL points to the NUL at the end of the
; matching entry, where we have assembled the proper FcrFlags
; bits and BDOS I/O service numbers.
mvix 0,FcrName+3
pushix
pop d
inx d ; DE->"XXX",0
lxi h,DevTab ; HL->lookup table
call @STLOK
mvix ':',FcrName+3 ; restore colon first
jnz isdisk ; (no match, not a device)
; The filespec is that of a device. Set it up for use.
inx h ! mov a,m ; A = flags
stx a,FcrFlags
inx h ! mov a,m ; A = Bdos input number
stx a,FcrBdosIn
inx h ! mov a,m ; A = Bdos output number
stx a,FcrBdosOut
jr exit
; The filespec is not valid for a device, ergo it will be
; treated as a disk. Set that flag and return.
isdisk:
bsetx FcrDisk,FcrFlags
exit:
pop d
pop h
pop psw
ret
end
reated as a disk. Set that flag and return.
isdisk:
bsetx FcrDisk,FcrFlags
exit:
pop d
pop h
pop psw
ret name 'FOPNE'
title 'FOPNE -- open existing disk file'
;===============================================================
; Copyright (C) 1985 M&T Publishing Co. all rights reserved
;
; This inner subroutine of the file-open operations has several
; functions. It:
;
; 1. ensures that the filespec in IX->FCR is not ambiguous,
; 2. ensures that its drivecode is valid,
; 3. determines if that file exists and if it does not, signals
; that by leaving FcrNotEof false,
; 4. if the file is protected by a password against what the
; caller plans to do to it, ensures that a password (not
; necessarily the right one) is available in the FCR,
; 5. if the file is read-only for any cause, signals that fact
; by leaving the FcrOutput flag bit false.
;
; interface: IX->FCR
; reg A = password-mode bits of interest,
; FcrFlags(NotEof,Output) presumed zero on entry,
; FCB extent and CR bytes assumed zero on entry,
;
; output: Sets FcrNotEof if file exists.
; Sets FcrOutput if file can be written.
; File-attribute bits set in FCB by CP/M
;
; History
; initial code 9 April 84
;===============================================================
maclib equates
maclib services
maclib smallz80
maclib fcr
extrn @FABTX,@BDOS
if CpmLevel gt 22h
extrn @FPASS
endif
dseg
Pmode db 0 ; desired password mode
cseg
public @FOPNE
@FOPNE:
push psw
push b
push d
push h
; Save the password-modes of interest
sta Pmode
if CpmLevel gt 22h ; in CP/M Plus only...
; Ask the Bdos to return the file's password mode. If the file
; doesn't exist, it returns A=FFh. If the drivecode is invalid
; or the filespec is ambiguous, we will be cancelled with a
; "CP/M Error" message right here.
pushix
pop d ; DE->file control block
mvi c,BdosFileInfo
call @BDOS
; If the file doesn't exist, we can exit right now.
inr a ; A=FF goes to A=00
jz exit ; (no such file, all done)
bsetx FcrNotEof,FcrFlags ; note it does exist
; The file exists, and its level of password protection is now
; in FcrExtent. We AND that with the byte we were given. If
; the result is nonzero, we require a password for this file.
lda Pmode
andx FcrExtent
jrz nopassprobs
; We do need a password. If the first byte of FcrPassword is
; blank, we don't have one. @FPASS will get one for us.
mvi a,AsciiBlank
cmpx FcrPassword
cz @FPASS
; Now we have a password (or don't need one), so we can try to
; open the file. First point the Bdos at our password field.
nopassprobs:
pushix
pop h
lxi d,FcrPassword
dad d
xchg ; DE->password field
mvi c,BdosSetBuffer
call @BDOS
endif ; CP/M Plus password preparation
; In CP/M Plus we have eliminated most of the errors that could
; occur on the open (if the password is wrong and the file
; is protected at the read level, that would crash us). In CP/M
; 2.2 we don't know anything yet.
pushix
pop d
mvi c,BdosOpen
call @BDOS
if CpmLevel lt 30h ; see if file exists
inr a ; A=FFh goes to 00h
jz exit ; file doesn't exist, all done
bsetx FcrNotEof, FcrFlags ; note it does exist
endif
; Now the file is open we can find out if it is read-only. That
; could be true for 3 reasons. (1) If it has been set read-only
; then attribute t1' is on -- in either version of CP/M.
bitx Bit7,FcrType
jrnz readonly
; (2) if it is a system file, stored under user 0, opened from a
; different user number, attribute f8' is on (CP/M Plus only).
bitx Bit7,FcrName+7
jrnz readonly
; (3) if it has a write-level password and we presented the
; wrong (or no) password, attribute f7' is on. That may not
; be an error -- our caller may intend only to read.
bitx Bit7,FcrName+6
jrnz readonly
; Writing is permitted on this file. Note that altho the file
; can be written, it could still have a delete-level password
; that we didn't match, which would prevent erase/renaming.
bsetx FcrOutput,FcrFlags
jmp exit
; The file is read-only for some reason. If our caller intended
; to write or delete it (as signalled by the byte passed) then
; we want to abort right now.
readonly:
lda Pmode ; caller plans to..
ani FilePMwrite+FilePMdelete ; ..write or delete?
jz exit ; (no, only plans reading)
; Our caller means to write, and the file won't allow it. Abort
; the program with an appropriate file error message.
mvi a,3+11 ; assume extended error code of r/o
bitx Bit7,FcrName+6
jrz aborting; (yes, "read-only file")
mvi a,7+11 ; set error code for "password error"
aborting:
stx a,FcrRetcode ; set fake Bdos return code
jmp @FABTX ; ..and abort the program
; The file doesn't exist, or exists and is amenable to actions
; the caller wants to do. FcrFlags are set appropriately,
; except for FcrLastCr which should be initially on in since
; eof on the very first read should be reported immediately.
exit:
bsetx FcrLastCr,FcrFlags
pop h
pop d
pop b
pop psw
ret
end
first read should be reported immediately.
exit:
bsetx FcrLastCr,FcrFlags
pop h
pop d
pop b
pop psw
ret
name 'FBUFR'
title 'FBUFR -- get buffer for a file'
;===============================================================
; Copyright (C) 1985 M&T Publishing Co. all rights reserved
;
; This subroutine of the file-open operations acquires a buffer
; for a file if it doesn't already have one (due to having been
; opened before). The buffer is allocated dynamically from the
; high end of the address space.
;
; It also clears the Bufptr and Bufeod fields so that when an
; FCR is reused these will be initialized. This code is called
; by all flavors of open, so the clearing will always be done.
;
; interface: IX->FCR
; output: FcrBufadr set.
;
; History
; add code to zero Bufeod and Bufptr 8/22/84
; initial code 06 April 84
;===============================================================
maclib smallz80
maclib fcr
extrn @RAMHI
public @FBUFR
@FBUFR:
xra a ; get a zero
stx a,FcrBufeod
stx a,FcrBufeod+1 ; zero end-of-data ptr
stx a,FcrBufptr
stx a,FcrBufptr+1 ; ..and next-byte ptr
ldx a,FcrBufadr
orx FcrBufadr+1 ; nonzero means a buffer exists
rnz
push b
push h
ldbwx b,FcrBufsize
call @RAMHI
stbwx h,FcrBufadr
pop h
pop b
ret
end
a buffer exists
rnz
push b
push h
ldbwx b,FcrBufsize
call @R name 'FMAKE'
title 'FMAKE -- create new output file'
;===============================================================
; Copyright (C) 1985 M&T Publishing Co. all rights reserved
;
; This subroutine of the output-open operations creates a new
; disk file, applying a password to it if one was supplied. The
; password is applied at the Read level.
;
; interface: IX->FCR
;
; History
; initial code 09 April 84
;===============================================================
maclib equates
maclib services
maclib smallz80
maclib fcr
extrn @BDOS
public @FMAKE
@FMAKE:
push psw
push b
push d
push h
; If a password has been assigned, set file attribute bit f6'
; and set the buffer address to the password data. This will
; have no effect in CP/M 2.2.
ldx a,FcrPassword
cpi AsciiBlank ; any password given?
jrz nopass
mvix FilePMread,FcrPMmake ; yes, set level
bsetx Bit7,FcrName+5 ; and set attribute f6'
pushix
pop h
lxi d,FcrPassword
dad d
xchg ; DE->password+mode
mvi c,BdosSetbuffer ; point Bdos to our password
call @BDOS
; Make the new file and set its flags to indicate it exists,
; has no data, and can do output.
nopass:
pushix
pop d ; DE->fcb
mvi c,BdosMake
call @BDOS ; create the file
mvix <(1 shl FcrDisk)+(1 shl FcrOutput)>,FcrFlags
bresx Bit7,FcrName+5 ; clear make-pass attribute
pop h
pop d
pop b
pop psw
ret
end
shl FcrOutput)>,FcrFlags
bresx Bit7,FcrName+5 ; clear make-pass attribute
pop h
pop d
po name 'FCLOS'
title 'FCLOS -- close a file'
;===============================================================
; Copyright (C) 1985 M&T Publishing Co. all rights reserved
;
; This modules completes the processing of DE->FCR, as follows:
;
; Device files: merely disable input and output.
;
; Disk files: write any final buffered data and issue a CP/M
; close request. If the file was opened under a scratch ($$$)
; filetype, erase the existing file, rename the scratch file to
; the proper type and if a password was given in the FCR, apply
; it to the new file.
;
; interface: FCLOSE macro
;
; History:
; initial code 06 April 84
;===============================================================
maclib equates
maclib services
maclib smallz80
maclib fcr
extrn @FDOUT,@BDOS
public @FCLOS
@FCLOS:
push psw
push b
push h
push d
xtix
; Separate disk and device files
bitx FcrDisk,FcrFlags
jz exit ; all the work done at the end
; Disk files: start by writing any modified data to disk.
call @FDOUT
; Close all disk files, because with seeking allowed, we
; can't tell what may have been modified.
pushix
pop d
mvi c,BdosClose
call @BDOS
; If the file was opened input, append, or update, or was a new
; output file, that's all we have to do.
bitx FcrBakType,FcrFlags
jz exit
; We've just closed an output file under its scratch name of
; "name.$$$," and there does exist a previous file "name.typ"
; which we have to erase. To do so, put back the correct type
; in the FCR.
call fixtype
; Before the erase we set up the one password we know, the one
; in the FCR. If the existing file is protected at the read or
; write level, this will be the correct password for the
; existing file, as verified at open time. If the existing file
; is protected only at the delete level, the password may not
; have been given or may be wrong, in which case we will be
; aborted on the erase. (And under CP/M 2.2 it doesn't matter
; one way or the other.)
pushix
pop d
lxi h,FcrPassword
dad d
xchg ; DE->new file's given password
mvi c,BdosSetbuffer
call @BDOS
pushix
pop d
mvi c,BdosErase ; now try the erase
call @BDOS
; Ok, any existing file "name.typ" is gone. In order to rename
; the new one from "name.$$$" to "name.typ" we have to put the
; desired name in the FCB+16 and put the $$$ back in the type.
pushix
pop d ; DE->FCB+0
lxi h,FcrDatamap
dad d ; HL->FCB+16
xchg ; (reverse the above)
lxi b,12 ; length to move
ldir ; "name.typ" to FCB+16
mvix '$',FcrType ; put back the darn dollars
mvix '$',FcrType+1
mvix '$',Fcrtype+2 ; "name.$$$" to FCB+0
pushix
pop d ; DE->FCB
mvi c,BdosRename
call @BDOS
; Fix the type one more time, so that the FCR can be reopened.
call fixtype
if CpmLevel gt 22h ; UNDER CP/M PLUS...
; We have but one thing left to do: if a password was given as
; part of the filespec, we have to apply it to the new file
; (we didn't do it when we made the file).
mvi a,AsciiBlank
cmpx FcrPassword ; was one given?
jrz exit ; (no, forget it)
; We have a choice of protection levels, but (in the absence of
; other information, and we have none) the only safe thing to
; do from a security standpoint is to set the read level, the
; most restrictive. The set-password (write XFCB) function
; wants the new password at the buffer-address plus 8.
pushix
pop d
lxi h,FcrPassword-8
dad d
xchg ; (DE+8)->given password
mvi c,BdosSetBuffer
call @BDOS
mvix FilePMread+1,FcrExtent ; assign at read level
pushix
pop d
mvi c,BdosPutXFCB
call @BDOS
endif ; continue for both systems...
; Clear the FcrFlags to prevent further I/O until an open is
; done again.
exit: mvix 0,FcrFlags ; eof, no output, etc.
xtix
pop d
pop h
pop b
pop psw
ret
; Subroutine to put back the old type in a scratch filespec.
fixtype:
ldx a,FcrOtype
stx a,FcrType
ldx a,FcrOtype+1
stx a,FcrType+1
ldx a,FcrOtype+2
stx a,FcrType+2
ret
end
ype:
ldx a,FcrOtype name 'FPASS'
title 'FPASS -- read password from keyboard'
;===============================================================
; Copyright (C) 1985 M&T Publishing Co. all rights reserved
;
; This inner subroutine of the file-open operations is called
; when we expect to need a password and none was given in the
; filespec assigned to IX->FCR. We prompt for a new password
; and read as many as 8 bytes into the FcrPassword field of
; IX->FCR. Lowercase letters are converted to uppercase.
;
; In order not to expose the password on the screen we read it
; using Bdos function 6, Raw Console Input, and echo only dots.
;
; If the user has set a default password that will apply, he
; or she need only reply with a single return.
;
; interface: IX->FCR
; output: new FcrPassword value on return
;
; History
; initial code 2 April 84
;===============================================================
maclib equates
maclib services
maclib smallz80
maclib fcr
extrn @FSTSP,@TOUPR,@BDOS
dseg
prompt db AsciiCR,AsciiLF,'Enter password for '
fspec ds 16 ; room for "x:filename.typ ", "$"
bspace db AsciiBS,AsciiBlank,AsciiBS,'$'
finis db AsciiCR,AsciiLF,'$'
cseg
public @FPASS
@FPASS:
push psw
push b
push d
push h
; blank the password field
pushix
pop d
lxi h,FcrPassword
dad d ; HL->password field of FCR
push h ; save ->password
mvi b,8
loop1 mvi m,AsciiBlank
inx h
djnz loop1
; get the filespec converted and inserted into the prompt
; string.
lxi h,fspec
mvi m,0 ; HL-> a null string
mvi a,0111b ; want drive, name, type
call @FSTSP ; fspecstr @D,@Hupdate,111b
mvi m,AsciiBlank
inx h ; one space after name
mvi m,'$' ; delimit message for the Bdos
; display prompt "Enter password for x:filename.typ "
lxi d,prompt
mvi c,BdosString
call @BDOS
; We will now accept as many as 8 bytes from the console,
; echoing each as a dot. Two control characters are
; also permitted: backspace means back up one in order to
; strike over, and CR means to quit. We stop reading
; when a CR comes, or when a ninth byte is typed.
pop h ; HL->current password byte
mvi b,0 ; B counts bytes received
Loop2: call get1 ; get one byte and store
cpi AsciiCR ; was it CR?
jrz done ; (yes)
mov a,b
cpi 9 ; was it the ninth?
jrnz Loop2 ; (no)
done: lxi d,finis
mvi c,BdosString
call @BDOS ; display CR, LF
pop h
pop d
pop b
pop psw
ret
; in this subroutine, read and handle one keystroke. It gets
; complicated: ignoring most control characters, handling
; backspaces, etc.
get1:
push b ! push h
mvi c,BdosRawkbd
mvi e,0fdh ; un-echoed input operation
call @BDOS
pop h ! pop b
cpi AsciiCR ; if CR, just return
rz
cpi AsciiBS ; if BS,
jrnz notBS ; (wasn't)
mov a,b ! ora a ; ..and if not at left margin,
rz ; (were, ignore)
dcr b ; then count one less byte
dcx h ; point back to prior byte
mvi m,AsciiBlank ; and blank it out
push b ! push h
mvi c,BdosString
lxi d,bspace; blank dot on screen, too
call @BDOS
pop h ! pop b
ret ; and continue loop
notBS: cpi AsciiBlank ; not BS, not CR -- was it a
rc ; control character? if so, ignore
call @TOUPR ; printable -- ensure uppercase
mov m,a
inr b ; and count it
inx h ; and point to next slot
push b ! push h
mvi e,'.' ; now echo a dot
mvi c,BdosType
call @BDOS
pop h ! pop b
ret
end
oint to next slot
push b name 'FASGN'
title 'FASGN -- process filespec string into FCR'
;===============================================================
; Copyright (C) 1985 M&T Publishing Co. all rights reserved
;
; This module parses a character string as a filespec, putting
; its various parts in the fields of a file control record to
; be opened and used. Its input and output are more complicated
; than most:
; HL->string to be parsed
; DE->FCR to be updated
; BC=0000, or BC->default FCR
; A = bitmap of parts to be assigned
; bit 0 = assign drivecode
; bit 1 = assign filename
; bit 2 = assign filetype
; bit 3 = assign password
;
; Normally, A=01111b and HL->a full filespec as given in the
; command line. The bitmap, however, allows a program to assign
; a full filespec and then override only its filetype, leaving
; the drive, filename, password as they were.
;
; After parsing a full (A=01111b), valid, filespec the module
; checks to see if the drivecode, filename, a/o filetype were
; omitted. If any were, and if a default FCR was passed, and if
; the new filespec can't be a device name, the missing fields
; are copied from the default FCR.
;
; Upon return, DE->updated FCR and HL->the last string byte
; examined. Register A reflects the filespec status:
; A = 00h = filespec valid and unambiguous
; A = question mark = filespec was valid but ambiguous
; A = exclamation = filespec was found invalid at HL->byte
; The Z flag is TRUE if an error occurred and FALSE if not.
;
; CP/M Plus contains a system function that parses filespecs
; into file control blocks, but I chose to write this one for
; several reasons: the CP/M operation won't handle a device
; filespec like "CON:"; it doesn't return the address of a byte
; that caused an error; it doesn't signal an ambiguous spec.
;
; interface: FASSIGN macro
;
; History
; don't require passwd bit for deflt in 2.2 10/17/85
; rewrite to use bitmap scheme 6 August 84
; don't do defaults when filename is XXX: (eg CON:) 12/4/84
; initial code 11 April 84
;===============================================================
maclib environ
maclib fcr
dseg
errbyte ds 1 ; 00, ?, or bang
bitmap ds 1 ; input value of bitmap
cseg
public @FASGN
@FASGN:
push b
mov c,a ; carry bitmap in C
sta bitmap ; ..and save it for later
xra a
sta ErrByte ; clear exit-flag value
xchg ; set up DE->string
strskip @Dupdate; skip leading whitespace
xchg ; DE->file, HL->nonwhite (or null?)
rarr c ; check bit 0
jrnc tryfn ; (drivecode not wanted)
call dodrive ; deal with drivecode
jrnz exit ; (error in drive)
tryfn:
rarr c ; bit 1
jrnc tryft ; (filename not wanted)
call doname ; deal with filename
jrnz exit ; (error in name)
tryft:
rarr c ; bit 2
jrnc trypw ; (filetype not wanted)
call dotype ; deal with filetype
jrnz exit ; (error in type)
trypw:
rarr c ; and bit 3
jrnc trydflt ; (password not wanted)
call dopass ; deal with password
jrnz exit ; (error in password)
trydflt:
lda bitmap
if CpmLevel eq 30h
cpi 01111b ; full spec handled?
else
cpi 00111b ; all of drive, name, type done?
endif
jrc exit ; (part spec, no default)
pop b ! push b ; restore BC=0000 or ->default
mov a,b ! ora c
cnz default
exit:
pop b ; BC restored
lda errbyte ; A = 00, query or bang
cpi '!' ; set Z true if error
ret
; Error: subroutines exit through here when they note an error.
Error:
mvi a,'!'
sta errbyte
ora a ; for not-Z
ret
; Ambig: called when a subroutine notices * or ?
Ambig:
mvi a,'?'
sta errbyte
ret
; Dodrive: set 00=default drive in FCB. Then if HL->X:,
; check X and set it as the drivecode. We have to keep in
; mind that HL->null string is valid.
dodrive:
mov a,m ! ora a ; HL->null string?
jrnz tstcolon ; (no)
stax d ; yes, set default drive = 00
ret ; ..and exit ok.
tstcolon:
inx h
mov a,m
dcx h
cpi ':' ; are we looking at X:?
jrz colon ; (yes, continue)
xra a ; no, set default drive
stax d
ret ; (and return w/ Z true)
colon:
mov a,m ; A = driveletter
toupper @A
cpi 'P'+1 ; letter < P?
jnc Error ; (no, bail out)
sui 'A' ; letter >= A?
jc Error ; (no, bail out)
inr a ; FCB code is A=1, B=2, etc
stax d ; set it
inx h ! inx h ; and step over X:
xra a
ret
; Doname: move up to 8 bytes of filename, making them uppercase,
; to the FCB. Pad the filename field with blanks.
doname:
mvi b,8 ; count of bytes in field
mvi a,FcrName ; offset to field
call copy ; name, type are the same
ret
; Dotype: move up to 3 bytes of filetype, making them uppercase,
; to the FCB. Pad the field with blanks.
dotype:
mov a,m ; we may be looking at
cpi '.' ; a dot...
jrnz nodot
inx h ; if so, step over it
nodot: mvi b,3 ; size of field
mvi a,FcrType ; offset to it
; Copy: handle filling the filename, filetype fields, allowing
; for "*" meaning "fill with ?s" and "?" meaning an ambiguous
; reference. At end, check that we advanced in the string to
; a filespec delimiter.
copy: push d ; save base of file
xchg ; DE->string
addhla ; HL->field of file structure
coploop:
ldax d
fdelim? @A ; reached a delimiter?
jrnz notdlm ; (no)
mvi a,' ' ; yes, store a blank
jr store
notdlm: cpi '*' ; found an asterisk?
jrnz notast ; (no)
call Ambig ; yes, note and set A='?'
jr store
notast: toupper @A
cpi '?' ; ambiguous single letter?
cz Ambig ; (yes, note it)
inx d ; X or ?, step on in string
store: mov m,a ; store blank, X, or ?
inx h
djnz coploop ; continue for size of field
xchg ; restore HL->string
pop d ; restore DE->file
mov a,m
cpi '*' ; did we hang on an asterisk?
jrnz ckdlm ; (no)
inx h ; yes, step over it now
ckdlm mov a,m ; now make sure we advanced to
fdelim? @A ; ..a filespec delimiter
rz ; (yes)
jmp Error ; no, input field too long
; Dopass: copy a password -- if any -- into the FcrPassword
; field for use during open. The * and ? have no special
; meaning in a password.
dopass:
push d
xchg ; HL->file, DE->string
mvi a,FcrPassword
addhla ; HL->FcrPassword
mvi b,8 ; field size
ldax d ; we could be looking at a ";"
cpi ';' ; are we?
jrnz pcopy
inx d ; if so, step over it
pcopy:
ldax d ; take byte,
inx d ; ..step past it
toupper @A ; ..make uppercase
fdelim? @A ; is it a filespec delimiter?
jrnz pstore ; (no)
mvi a,' ' ; if so, store a blank instead
dcx d ; ..and don't go past the delim.
pstore: mov m,a ; store blank or X
inx h
djnz pcopy ; continue for size of field
xchg ; restore HL->string
pop d ; and DE->file
mov a,m ; we should now be looking at a
fdelim? @A ; filespec delimiter
rz ; (yes)
jmp Error ; nope, password too long
; Default: A full filespec has been parsed (correctly) and
; a default FCR was passed. Take any omitted parts of the spec
; from the default FCR.
default:
push h ; save string
push d ; and file-base
; We don't do a default if the fourth byte of the filename is
; a colon. If we did there would be a conflict between an
; omitted filetype and a device-name which has no filetype.
lxi h,FcrName+3
dad d
mov a,m
cpi ':'
jz endefault
; Defaults are to be done. Get HL->default FCR.
mov h,b ! mov l,c
; If the drivecode was omitted, default it.
ldax d
ora a
jrnz havedrive
mov a,m
stax d
; If the filename was omitted, do likewise.
havedrive:
inx d ; DE->output FcrName
inx h ; HL->default FcrName
lxi b,8 ; BC=length of field
ldax d
cpi ' ' ; name given?
jrz dfltname; (no, copy it)
dad b ; yes, advance to type
xchg
dad b ; ..in both pointers
xchg
jr havename ; ..and don't copy
dfltname:
ldir ; copy name, advancing ptrs
; Likewise with the filetype
havename:
lxi b,3 ; BC=length of field
ldax d ; was it omitted?
cpi ' '
jrz dflttype ; (yes, copy it)
dad b ; no, advance ptrs
xchg
dad b
xchg
jr havetype ; ..and don't copy
dflttype:
ldir ; copy type, advancing ptrs
; So much for defaults. We could actually do a default for
; the password as well, but in general it seems better not to.
havetype:
endefault:
pop d
pop h
ret
end
ault for
; the password as well, but in general it seems better not to.
havetype:
endefa