mirror of https://github.com/A2osX/A2osX.git
608 lines
19 KiB
Plaintext
608 lines
19 KiB
Plaintext
NEW
|
||
AUTO 3,1
|
||
|
||
* close command
|
||
|
||
closef ldy #$01 close all ?
|
||
lda (A3L),y
|
||
bne L4683 no, just one of them.
|
||
|
||
sta cferr clear global close error.
|
||
lda #$00 start at the beginning.
|
||
L4654 sta fcbptr save current low byte of pointer.
|
||
tay get the level at which the file
|
||
lda fcbbuf+27,y was opened.
|
||
cmp flevel if file's level is < global level
|
||
bcc L4675 then don't close.
|
||
lda fcbbuf,y is this reference file open ?
|
||
beq L4675 no, try next.
|
||
jsr flush2 clean it out...
|
||
bcs L46B6 return flush errors.
|
||
jsr close2 update fcb & vcb
|
||
ldy #$01
|
||
lda (A3L),y
|
||
beq L4675 no error if close all.
|
||
bcs L46B6 close error.
|
||
L4675 lda fcbptr inc pointer to next fcb
|
||
clc
|
||
adc #$20
|
||
bcc L4654 branch if within same page.
|
||
lda cferr on final close report logged errors.
|
||
beq L46B4 branch if errors.
|
||
rts (carry already set).
|
||
L4683 jsr flush1 flush file 1st (including updating
|
||
bcs L46B6 bitmap). branch if errors.
|
||
|
||
close2 ldy fcbptr
|
||
lda fcbbuf+11,y release file buffer
|
||
jsr relbuffr
|
||
bcs L46B6
|
||
lda #$00
|
||
ldy fcbptr
|
||
sta fcbbuf,y free fcb too
|
||
lda fcbbuf+1,y
|
||
sta devnum go look for associated vcb
|
||
jsr fnddvcb
|
||
ldx vcbptr get vcb pointer.
|
||
dec vcbbuf+30,x indicate one less file open.
|
||
bne L46B4 branch if that wasn't the last...
|
||
lda vcbbuf+17,x
|
||
and #$7F strip 'files open' bit
|
||
sta vcbbuf+17,x
|
||
L46B4 clc
|
||
rts
|
||
L46B6 bcs L46E6 don't report close all error now.
|
||
|
||
* flush command
|
||
|
||
flushf ldy #$01 flush all ?
|
||
lda (A3L),y
|
||
bne flush1 no, just one of them.
|
||
sta cferr clear global flush error.
|
||
lda #$00 start at the beginning.
|
||
L46C3 sta fcbptr save current low byte of pointer.
|
||
tay index to ref #.
|
||
lda fcbbuf,y is this reference file open ?
|
||
beq L46D1 no, try next.
|
||
jsr flush2 clean it out...
|
||
bcs L46E6 return anty errors.
|
||
L46D1 lda fcbptr inc pointer to next fcb.
|
||
clc
|
||
adc #$20
|
||
bcc L46C3 branch if within same page
|
||
L46D9 clc
|
||
lda cferr on last flush,
|
||
beq L46E0 branch if no logged errors.
|
||
sec report error now
|
||
L46E0 rts
|
||
|
||
flush2 jsr fndfcbuf must set up vcb & buffer locations 1st.
|
||
bcc L46F1 branch if no error.
|
||
L46E6 jmp glberr error so check for close or flush all.
|
||
|
||
flush1 stz cferr for normal refnum flush, clear global error.
|
||
jsr findfcb setup pointer to fcb user references.
|
||
bcs L46E6 return any errors.
|
||
L46F1 lda fcbbuf+9,y test to see if file is modified.
|
||
and #$02 is it write enabled ?
|
||
beq L46D9 branch if 'read only'
|
||
lda fcbbuf+28,y has eof been modified ?
|
||
bmi L4704 if yes.
|
||
jsr gfcbstat has data been modified ?
|
||
and #$70 (was written to while it's been open?)
|
||
beq L46D9 if not.
|
||
L4704 jsr gfcbstat
|
||
and #$40 does current data buffer need to be
|
||
beq L4710 written ? branch if not.
|
||
jsr wfcbdat if so, go write it.
|
||
bcs L46E6 if error.
|
||
L4710 jsr gfcbstat check to see if the index block (tree
|
||
and #$80 files only) needs to be written.
|
||
beq L471C branch if not.
|
||
jsr wfcbidx
|
||
bcs L46E6 return any errors.
|
||
L471C lda #$06 prepare to update directory
|
||
tax
|
||
ora fcbptr
|
||
tay
|
||
L4723 lda fcbbuf,y note: this code depends on the defined
|
||
sta d_dev-1,x order of the file control block and the
|
||
dey temporary directory area in 'work space'
|
||
dex
|
||
bne L4723
|
||
sta devnum
|
||
lda d_head read the directory header for this file
|
||
ldx d_head+1
|
||
jsr rdblk into the general purpose buffer.
|
||
bcs L46E6 if error.
|
||
jsr movhed0 move header info.
|
||
lda d_entblk get address of directory block that
|
||
ldy d_entblk+1 contains the file entry.
|
||
cmp d_head test to see if it's the same block the
|
||
bne L474E header is in. branch if not.
|
||
cpy d_head+1
|
||
beq L4755 branch if header block = entry block
|
||
L474E sta bloknml
|
||
sty bloknml+1
|
||
jsr rdgbuf get block with file entry in general
|
||
L4755 jsr entcalc buffer. set up pointer to entry.
|
||
jsr moventry move entry to temp entry buffer in
|
||
ldy fcbptr 'work space'. update 'blocks used' count
|
||
lda fcbbuf+24,y
|
||
sta d_usage
|
||
lda fcbbuf+25,y
|
||
sta d_usage+1
|
||
ldx #$00 and move in end of file mark whether
|
||
L476C lda fcbbuf+21,y needed or not.
|
||
sta d_eof,x
|
||
inx
|
||
cpx #$03 move all 3 bytes
|
||
beq L4780
|
||
lda fcbbuf+12,y also move in the address of the file's
|
||
sta d_filid,x first block since it might have changed
|
||
iny since the file first opened.
|
||
bne L476C branch always.
|
||
L4780 lda fcbbuf+5,y the last thing to update is storage
|
||
asl type (y=fcbptr+2). shift into high
|
||
asl nibble.
|
||
asl
|
||
asl
|
||
sta scrtch
|
||
lda d_stor get old type byte (might be the same).
|
||
and #$0F strip off old type,
|
||
ora scrtch add in the new type
|
||
sta d_stor and put it away.
|
||
jsr drevise go update directory.
|
||
bcs glberr error.
|
||
ldy fcbptr mark
|
||
lda fcbbuf+28,y fcb/directory
|
||
and #$7F as
|
||
sta fcbbuf+28,y undirty.
|
||
lda d_dev see if bitmap should be written.
|
||
cmp bmadev is it in same as current file ?
|
||
bne L47B2 yes, put it on the disk if necessary.
|
||
jsr upbmap go put it away.
|
||
bcs glberr flush error
|
||
L47B2 clc
|
||
rts
|
||
|
||
* report error only if not a close all or flush all
|
||
|
||
glberr ldy #$01
|
||
pha
|
||
lda (A3L),y
|
||
bne L47C1 not an 'all' so report now
|
||
clc
|
||
pla
|
||
sta cferr save for later
|
||
rts
|
||
L47C1 pla
|
||
rts
|
||
|
||
gfcbstat ldy fcbptr index to fcb.
|
||
lda fcbbuf+8,y return status byte.
|
||
rts
|
||
L47CA lda #$4E access error
|
||
sec
|
||
L47CD rts
|
||
|
||
seteof jsr gfcbstyp can only move end of tree, sapling or seed.
|
||
cmp #$04 tree type ?
|
||
bcs L47CA if not then access error
|
||
asl
|
||
asl
|
||
asl
|
||
asl
|
||
sta stortyp may be used later.
|
||
lda fcbbuf+9,y
|
||
and #$02 is write enabled to set new eof ?
|
||
beq L47CA no, access error.
|
||
jsr tstwprot hardware write protected ?
|
||
bcs L47CA yes, access error.
|
||
ldy fcbptr save old eof so it can be seen
|
||
iny whether blocks need to be released
|
||
iny upon contraction.
|
||
ldx #$02 all 3 bytes of the eof
|
||
L47EF lda fcbbuf+21,y
|
||
sta oldeof,x
|
||
dey
|
||
dex
|
||
bpl L47EF
|
||
ldy #$04
|
||
ldx #$02
|
||
L47FD lda (A3L),y position mark to new eof
|
||
sta tposll,x
|
||
dey
|
||
dex
|
||
bpl L47FD
|
||
ldx #$02 point to 3rd byte.
|
||
L4808 lda oldeof,x see if eof moved backwards so blocks
|
||
cmp tposll,x can be released.
|
||
bcc eofset (branch if not)
|
||
bne purge branch if blocks to be released
|
||
dex
|
||
bpl L4808 all 3 bytes
|
||
|
||
eofset ldy #$04
|
||
ldx fcbptr place new end of file into fcb
|
||
inx
|
||
inx
|
||
L481C lda (A3L),y
|
||
sta fcbbuf+21,x
|
||
dex
|
||
dey
|
||
cpy #$02 all 3 bytes moved ?
|
||
bcs L481C no.
|
||
jmp fcbused mark fcb as dirty.
|
||
purge jsr flush1 make sure file is current
|
||
bcs L47CD
|
||
ldx datptr+1 pointer to index block
|
||
inx
|
||
inx
|
||
stx zpt+1 (zero page conflict with dir buf ptr)
|
||
ldx datptr
|
||
stx zpt
|
||
ldy fcbptr check if eof < mark
|
||
iny
|
||
iny
|
||
ldx #$02
|
||
L4840 lda fcbbuf+18,y
|
||
cmp tposll,x compare until not equal or carry clear.
|
||
bcc L485F branch if eof > mark.
|
||
bne L484E branch if eof < mark.
|
||
dey
|
||
dex
|
||
bpl L4840 compare all 3 bytes
|
||
L484E ldy fcbptr
|
||
ldx #$00
|
||
L4853 lda tposll,x fake position, correct position will
|
||
sta fcbbuf+18,y be made below...
|
||
iny
|
||
inx
|
||
cpx #$03 move all 3 bytes
|
||
bne L4853
|
||
L485F jsr tkfrecnt force free block count before releasing
|
||
lda tposll blocks. prepare for purge of excess...
|
||
sta dseed all blocks and bytes beyond new eof
|
||
lda tposlh must be zero'd
|
||
sta dsap
|
||
and #$01
|
||
sta dseed+1
|
||
lda tposhi
|
||
lsr
|
||
sta dtree
|
||
ror dsap pass position in terms of block & bytes.
|
||
lda dseed now adjust for boundaries of $200
|
||
ora dseed+1
|
||
bne L48A2 branch if no adjustment necessary.
|
||
lda dsap get correct block ositions for sap
|
||
sec and tree levels.
|
||
sbc #$01
|
||
sta dsap deallocate for last (phantom) block
|
||
lda #$02 and don't modify last data block.
|
||
bcs L489F branch if tree level unaffected.
|
||
dec dtree
|
||
bpl L489F branch if new eof not zero
|
||
lda #$00
|
||
sta dtree otherwise, make a null seed out of it.
|
||
sta dsap
|
||
L489F sta dseed+1
|
||
L48A2 ldy fcbptr also must pass file's 1st block address.
|
||
lda fcbbuf+12,y
|
||
sta firstbl
|
||
lda fcbbuf+13,y
|
||
sta firstbh
|
||
stz deblock lastly, initialize # of blocks to
|
||
stz deblock+1 be free'd.
|
||
jsr detree deallocate blocks from tree.
|
||
php save any error status until fcb
|
||
pha is cleaned up.
|
||
sec
|
||
ldy fcbptr
|
||
ldx #$00
|
||
L48C2 lda firstbl,x
|
||
sta fcbbuf+12,y move in possible new first file block
|
||
lda fcbbuf+24,y address. adjust usage count also
|
||
sbc deblock,x
|
||
sta fcbbuf+24,y
|
||
iny
|
||
inx
|
||
txa
|
||
and #$01 test for both bytes adjusted
|
||
bne L48C2 without disturbing carry.
|
||
lda stortyp get possibly modified storage type
|
||
lsr
|
||
lsr
|
||
lsr
|
||
lsr
|
||
ldy fcbptr and save it in fcb.
|
||
sta fcbbuf+7,y
|
||
jsr clrstats make it look as though position has
|
||
jsr dvcbrev nothing allocated, update total blocks
|
||
ldy fcbptr in fcb and correct position.
|
||
iny
|
||
iny
|
||
ldx #$02
|
||
L48F2 lda fcbbuf+18,y tell 'rdposn' to go to correct
|
||
sta tposll,x
|
||
eor #$80 position from incorrect place.
|
||
sta fcbbuf+18,y
|
||
dey
|
||
dex
|
||
bpl L48F2
|
||
jsr rdposn go to correct position.
|
||
bcc L490D if no error.
|
||
tax otherwise, report latest error.
|
||
pla
|
||
plp
|
||
txa restore latest error code to stack
|
||
sec
|
||
php
|
||
pha save new error.
|
||
|
||
* mark file as in need of a flush and update fcb with new end of file,
|
||
* then flush it.
|
||
|
||
L490D jsr eofset go mark and update
|
||
jsr flush1 then go do the flush.
|
||
bcc L491C branch if no error.
|
||
tax save latest error.
|
||
pla clean previous error off stack
|
||
plp
|
||
txa and restore latest error to stack.
|
||
sec show error condition.
|
||
php restore error status to stack
|
||
pha and the error code.
|
||
L491C pla report any errors that may have
|
||
plp appeared.
|
||
rts
|
||
|
||
geteof ldx fcbptr index to end of file mark
|
||
ldy #$02 and index to user's call parameters
|
||
L4924 lda fcbbuf+21,x
|
||
sta (A3L),y
|
||
inx
|
||
iny
|
||
cpy #$05
|
||
bne L4924 loop until all 3 bytes moved
|
||
clc no errors
|
||
rts
|
||
|
||
newline ldy #$02 adjust newline status for open file.
|
||
lda (A3L),y on or off ?
|
||
ldx fcbptr it will be 0 if off.
|
||
sta fcbbuf+31,x set new line mask
|
||
iny
|
||
lda (A3L),y and move in 'new-line' byte
|
||
sta fcbbuf+10,x
|
||
clc no error possible
|
||
rts
|
||
|
||
getinfo jsr findfile look for file.
|
||
bcc L4988 no error.
|
||
cmp #$40 was it a root directory file ?
|
||
sec (in case of no match)
|
||
bne L49A4 if not, then error.
|
||
lda #$F0
|
||
sta d_stor for get info, report proper storage
|
||
stz reql type. forca a count of free blocks.
|
||
stz reqh
|
||
ldx vcbptr
|
||
jsr tkfrecnt get a fresh count of free blocks on
|
||
ldx vcbptr this volume.
|
||
lda vcbbuf+21,x return total blocks and total in use.
|
||
sta reqh 1st transfer 'free' blocks to zpage
|
||
lda vcbbuf+20,x for later subtraction to determine
|
||
sta reql the 'used' count.
|
||
lda vcbbuf+19,x transfer to 'd.' table as aux id
|
||
sta d_auxid+1 (total block count is considered aux id
|
||
pha for the volume)
|
||
lda vcbbuf+18,x
|
||
sta d_auxid
|
||
sec subtract and report the number of
|
||
sbc reql blocks 'in use'
|
||
sta d_usage
|
||
pla
|
||
sbc reqh
|
||
sta d_usage+1
|
||
L4988 lda d_stor transfer bytes from internal order to
|
||
lsr call spec via 'inftabl' translation
|
||
lsr table but first change storage type to
|
||
lsr external (low nibble) format.
|
||
lsr
|
||
sta d_stor
|
||
ldy #$11 index to last of user's spec table.
|
||
L4994 lda inftabl-3,y
|
||
and #$7F strip bit used by setinfo
|
||
tax
|
||
lda d_stor,x move directory info to call spec. table
|
||
sta (A3L),y
|
||
dey
|
||
cpy #$03
|
||
bcs L4994 if all info bytes moved, retn carry clr
|
||
L49A4 rts
|
||
|
||
setinfo jsr findfile get the file to work on.
|
||
bcs L49CF if error.
|
||
lda bubit see if backup bit can be cleared
|
||
eor #$20
|
||
and d_attr
|
||
and #$20
|
||
sta bkbitflg or preserve current...
|
||
ldy #$0D init pointer to user supplied list.
|
||
L49B9 ldx inftabl-3,y get index to corresponding 'd.' table.
|
||
bmi L49C3 branch if parameter can't be set.
|
||
lda (A3L),y
|
||
sta d_stor,x
|
||
L49C3 dey has user's request been satisfied ?
|
||
cpy #$03
|
||
bcs L49B9 no, move next byte.
|
||
and #$18 make sure no illegal access bits were
|
||
beq L49D0 set !! branch if legal access.
|
||
lda #$4E otherwise, access error.
|
||
sec
|
||
L49CF rts
|
||
L49D0 ldy #$0B
|
||
lda (A3L),y was clock null input ?
|
||
beq L49D9 if yes.
|
||
jmp drevise1 end by updating directory.
|
||
L49D9 jmp drevise update with clock also...
|
||
|
||
rename jsr lookfile look for source (original) file.
|
||
bcc L4A1E if found.
|
||
cmp #$40 trying to rename a volume ?
|
||
bne L49FD no, return error.
|
||
jsr renpath syntax new name.
|
||
bcs L49FD rename error.
|
||
ldy pathbuf find out if only rootname for new name
|
||
iny
|
||
lda pathbuf,y must be $FF if volume name only.
|
||
bne L4A72 if not single name
|
||
ldx vcbptr check for open files before changing.
|
||
lda vcbbuf+17,x
|
||
bpl L49FF if volume not busy.
|
||
lda #$50 file busy error.
|
||
L49FD sec
|
||
rts
|
||
L49FF ldy #$00 get newname's length
|
||
lda pathbuf,y
|
||
ora #$F0 (root file storage type)
|
||
jsr mvrotnam update root directory.
|
||
bcs L4A74 rename error.
|
||
ldy #$00
|
||
ldx vcbptr update vcb also.
|
||
L4A10 lda pathbuf,y move new name to vcb.
|
||
beq L4A1C
|
||
sta vcbbuf,x
|
||
iny next character
|
||
inx
|
||
bne L4A10 always.
|
||
L4A1C clc no errors
|
||
rts
|
||
L4A1E jsr getnamptr set y = 1st char of path, x = 0.
|
||
L4A21 lda pathbuf,y move original name to gbuf
|
||
sta gbuf,x for later comparison to new name.
|
||
bmi L4A2D if last character has been moved
|
||
iny otherwise, get the next one.
|
||
inx
|
||
bne L4A21 always.
|
||
L4A2D jsr renpath get new name syntaxed.
|
||
bcs L4A74 rename error.
|
||
jsr getnamptr set y = path, x = 0.
|
||
lda pathbuf,y now compare new name with old name
|
||
L4A38 cmp gbuf,x to make sure they are in the same dir.
|
||
php save result of comparison.
|
||
and #$F0 was last char really a count ?
|
||
bne L4A46 if not.
|
||
sty rnptr save pointer to next name, it might
|
||
stx namptr be the last.
|
||
L4A46 plp result of last comparison ?
|
||
bne L4A52 branch if different character or count.
|
||
inx bump pointers.
|
||
iny
|
||
lda pathbuf,y was it the last character ?
|
||
bne L4A38 if not.
|
||
clc no operation, names were the same.
|
||
rts
|
||
L4A52 ldy rnptr index to last name in the chain.
|
||
lda pathbuf,y get last name length.
|
||
sec
|
||
adc rnptr
|
||
tay
|
||
lda pathbuf,y this byte should be $00 !
|
||
bne L4A72 if not, bad path error.
|
||
ldx namptr index to last of original name
|
||
lda gbuf,x
|
||
sec
|
||
adc namptr
|
||
tax
|
||
lda gbuf,x this byte should also be $00.
|
||
beq L4A76 if so, continue processing.
|
||
L4A72 lda #$40 bad pathname error.
|
||
L4A74 sec
|
||
rts
|
||
L4A76 jsr lookfile test for duplicate file name.
|
||
bcs L4A7F branch if file not found, which is ok !!
|
||
lda #$47 duplicate name error.
|
||
sec
|
||
rts
|
||
L4A7F cmp #$46 was it a valid file not found ?
|
||
bne L4A74 no, rename error.
|
||
jsr setpath syntax pathname of file to be changed.
|
||
jsr findfile get all the info on this file.
|
||
bcs L4A74 rename error.
|
||
jsr tstopen is file in use ?
|
||
lda #$50 anticipate file busy error.
|
||
bcs L4A74 error if in use.
|
||
lda d_attr test bit which allows rename.
|
||
and #$40
|
||
bne L4A9D branch if ok to rename
|
||
lda #$4E otherwise, illegal access.
|
||
L4A9B sec
|
||
rts
|
||
L4A9D lda d_stor find out which storage type.
|
||
and #$F0 strip off name length.
|
||
cmp #$D0 is it a directory ?
|
||
beq L4AAE then ok.
|
||
cmp #$40 is it a seed, sapling or tree ?
|
||
bcc L4AAE then ok.
|
||
lda #$4A file incompatible error.
|
||
bne L4A9B always.
|
||
L4AAE jsr renpath since both names go into the directory,
|
||
bcs L4A74 syntax the new name to get the local
|
||
ldy rnptr name address. y = index to local name
|
||
ldx pathbuf,y length. adj y to last char of new name. tya
|
||
tya
|
||
adc pathbuf,y
|
||
tay
|
||
L4ABE lda pathbuf,y move local name to dir entry workspace.
|
||
sta d_stor,x
|
||
dey
|
||
dex
|
||
bne L4ABE
|
||
lda d_stor preserve file storage type.
|
||
and #$F0 strip off old name length.
|
||
tax
|
||
ora pathbuf,y add in new name's length.
|
||
sta d_stor
|
||
cpx #$D0 that file must be changed also.
|
||
bne L4AF0 branch if not directory type.
|
||
lda d_frst read in 1st header block of subdir
|
||
ldx d_frst+1
|
||
jsr rdblk
|
||
bcs L4A74 errors.
|
||
ldy rnptr change the header's name to match the
|
||
lda pathbuf,y owner's new name. get local name length.
|
||
ora #$E0 assume it's a header.
|
||
jsr mvrotnam
|
||
bcs L4A74
|
||
L4AF0 jmp drevise1 end by updating all path directories.
|
||
|
||
mvrotnam ldx #$00
|
||
L4AF5 sta gbuf+4,x
|
||
inx
|
||
iny
|
||
lda pathbuf,y
|
||
bne L4AF5
|
||
jmp wrtgbuf write changed header block.
|
||
|
||
renpath ldy #$03 get address to new pathname
|
||
lda (A3L),y
|
||
iny
|
||
sta zpt
|
||
lda (A3L),y set up for syntaxing routine (synpath)
|
||
sta zpt+1
|
||
jmp synpath do syntax (returns y = local namelength)
|
||
|
||
getnamptr ldy #$00 return pointer to 1st name of path.
|
||
bit prfxflg is this a prefixed name ?
|
||
bmi L4B1A branch if not.
|
||
ldy newpfxptr
|
||
L4B1A ldx #$00
|
||
rts
|
||
|
||
MAN
|
||
SAVE usr/src/prodos.203/prodos.s.xdos.e
|
||
LOAD usr/src/prodos.203/prodos.s
|
||
ASM
|