mirror of
https://github.com/A2osX/A2osX.git
synced 2024-10-03 05:55:42 +00:00
356 lines
12 KiB
Plaintext
356 lines
12 KiB
Plaintext
NEW
|
||
AUTO 3,1
|
||
|
||
destroy .EQ *-ofsX
|
||
jsr findfile look for file to be destroyed.
|
||
bcs L4B66 if error.
|
||
jsr tstopen is it open ?
|
||
lda totent
|
||
bne L4B64 error if open.
|
||
stz reql force proper free count in volume.
|
||
stz reqh (no disk access occurs if already
|
||
jsr tstfrblk proper)
|
||
bcc L4B39 no errors.
|
||
cmp #$48 was error a full disk ?
|
||
bne L4B66 no, report error.
|
||
L4B39 lda d_attr make sure ok to destroy file.
|
||
and #$80
|
||
bne L4B45 branch if ok to destroy.
|
||
lda #$4E access error
|
||
jsr p8errv (returns to caller)
|
||
L4B45 lda devnum last device used.
|
||
jsr twrprot1 test for write protected hardware
|
||
bcs L4B66 before going thru deallocation.
|
||
lda d_frst 'detree' needs first block address
|
||
sta firstbl
|
||
lda d_frst+1
|
||
sta firstbh
|
||
lda d_stor find out which storage type.
|
||
and #$F0 strip off name length.
|
||
cmp #$40 is it a seed, sapling or tree ?
|
||
bcc L4B68 branch if it is.
|
||
bra L4BCF otherwise, test for directory destroy.
|
||
L4B64 lda #$50 file busy error.
|
||
L4B66 sec can't be destroyed
|
||
rts
|
||
L4B68 sta stortyp destroy a tree file. save storage type.
|
||
ldx #$05
|
||
lda #$00 set 'detree' input variables, must be
|
||
L4B6F sta stortyp,x in order: deblock, dtree, dsap, dseed.
|
||
dex
|
||
bne L4B6F loop until all zero'd.
|
||
lda #$02 this avoids an extra file i/o and pre-
|
||
sta dseed+1 vents destruction of any deleted data.
|
||
inc delflag don't allow detree to zero index blocks.
|
||
jsr detree make trees and saplings into seeds.
|
||
dec delflag reset flag.
|
||
bcs L4B93 (de-evolution)
|
||
L4B85 ldx firstbh
|
||
lda firstbl now deallocate seed.
|
||
jsr dealloc
|
||
bcs L4B93
|
||
jsr upbmap
|
||
L4B93 pha save possible error code.
|
||
lda #$00 update directory to free entry space.
|
||
sta d_stor
|
||
cmp h_fcnt file entry wrap ?
|
||
bne L4BA1 branch if no carry adjustment.
|
||
dec h_fcnt+1 take carry from hi byte of file entries.
|
||
L4BA1 dec h_fcnt mark header with one less file.
|
||
jsr dvcbrev go update block count in vcb (ignore
|
||
jsr drevise error, if any) and update dir last.
|
||
tax save possible new error code,
|
||
pla restore possible old error code.
|
||
bcc L4BAF branch if last call succeeded.
|
||
txa last call failed, use it's error code.
|
||
L4BAF cmp #$01 adjust carry accordingly
|
||
rts
|
||
dvcbrev .EQ *-ofsX update block free count in vcb.
|
||
ldy vcbptr point to vcb of correct device.
|
||
lda deblock get # of blocks recently freed.
|
||
adc vcbbuf+20,y
|
||
sta vcbbuf+20,y update current free block count.
|
||
lda deblock+1
|
||
adc vcbbuf+21,y
|
||
sta vcbbuf+21,y
|
||
lda #$00 force re-scan from 1st bitmap
|
||
sta vcbbuf+28,y
|
||
rts
|
||
L4BCD bcc L4B85 branch widened (always taken)
|
||
L4BCF cmp #$D0 is this a directory file ?
|
||
bne L4C1B no, file incompatible.
|
||
jsr fndbmap make sure a buffer available for bitmap
|
||
bcs L4C1A if error.
|
||
lda d_frst read 1st block of directory into gbuf
|
||
sta bloknml
|
||
lda d_frst+1
|
||
sta bloknml+1
|
||
jsr rdgbuf
|
||
bcs L4C1A
|
||
lda gbuf+37 do any files exist in this directory ?
|
||
bne L4BF1 if so, access error.
|
||
lda gbuf+38
|
||
beq L4BF6
|
||
L4BF1 lda #$4E access error.
|
||
jsr p8errv P8 error vector
|
||
L4BF6 sta gbuf+4 make it an invalid subdirectory
|
||
jsr wrtgbuf
|
||
bcs L4C1A
|
||
L4BFE lda gbuf+2 get forward link.
|
||
cmp #$01 test for null block into carry.
|
||
ldx gbuf+3 get the rest of the block address.
|
||
bne L4C0A branch if not null.
|
||
bcc L4BCD was the low part null as well ?
|
||
L4C0A jsr dealloc free this block.
|
||
bcs L4C1A
|
||
lda gbuf+2
|
||
ldx gbuf+3
|
||
jsr rdblk
|
||
bcc L4BFE loop until all freed
|
||
L4C1A rts
|
||
L4C1B lda #$4A file incompatible
|
||
jsr p8errv (returns to caller)
|
||
fcbused .EQ *-ofsX mark fcb as dirty so the directory
|
||
pha will be flushed on 'flush'.
|
||
tya save regs.
|
||
pha
|
||
ldy fcbptr
|
||
lda fcbbuf+28,y fetch current fcb dirty byte.
|
||
ora #$80 mark fcb as dirty.
|
||
sta fcbbuf+28,y save it back
|
||
pla and restore regs.
|
||
tay
|
||
pla
|
||
rts
|
||
|
||
* 'detree' deallocates blocks from tree files. it is assumed that the device has
|
||
* been pre-selected and the 'gbuf' may be used.
|
||
*
|
||
* on entry:
|
||
* stortype = storage type in upper nibble, lower nibble is undisturbed.
|
||
* firstbl & firstbh = first block of file (index or data).
|
||
* deblock = 0
|
||
* dtree = ptr to 1st block with data to be deallocated at tree level.
|
||
* dsap = ptr to 1st block at sapling level.
|
||
* dseed = byte (0-511) position to be zeroed from (inclusive).
|
||
*
|
||
* on exit:
|
||
* stortype = modified result of storage type (if applicable).
|
||
* firstbl & h = modified if storage type changed.
|
||
* deblock = total number of blocks freed at all levels.
|
||
* dtree, dsap, deseed unchanged.
|
||
*
|
||
* to trim a tree to a seed file, both dtree and dsap must be zero.
|
||
* to go from tree to sapling, dtree alone must be zero.
|
||
|
||
detree .EQ *-ofsX
|
||
lda stortyp which kind of tree ?
|
||
cmp #$20 is it a 'seed' ?
|
||
bcc L4C46 if yes.
|
||
cmp #$30 a sapling ?
|
||
bcc L4C51 if yes.
|
||
cmp #$40 is it at least a 'tree' ?
|
||
bcc L4C59 branch if it is.
|
||
lda #$0C block allocation error.
|
||
jsr sysdeath P8 system death vector
|
||
|
||
* seedling file type - make sure first desireable block is the only
|
||
* block available in a seedling file.
|
||
|
||
L4C46 lda dsap
|
||
ora dtree
|
||
bne L4CC2
|
||
jmp seedel0
|
||
|
||
* sapling file type - make sure first desireable block is within the range of
|
||
* blocks available in a sapling file
|
||
|
||
L4C51 lda dtree can't have any blocks in this range
|
||
bne L4CC2 if so then done
|
||
jmp sapdel0 else go deallocate
|
||
L4C59 lda #$80
|
||
sta topdest for tree top start at end, work backwards.
|
||
L4C5E jsr drdfrst read specified first block into gbuf.
|
||
bcs L4CC2 return errors.
|
||
ldy topdest get current pointer to top indexes.
|
||
cpy dtree have enough sapling indexes been
|
||
beq L4CC3 deallocated? yes, now deallocate blocks
|
||
ldx #$07 buffer up to 8 sapling index block
|
||
L4C6D lda gbuf,y addresses. fetch low block address
|
||
sta dealbufl,x and save it.
|
||
ora gbuf+$100,y is it a real block that is allocated?
|
||
beq L4C81 branch if phantom block.
|
||
lda gbuf+$100,y fetch high block address
|
||
sta dealbufh,x and save it.
|
||
dex decrement and test for dealc buf filled.
|
||
bmi L4C93 branch if 8 addresses fetched.
|
||
L4C81 dey look for end of deallocation limit.
|
||
cpy dtree is this the last position on tree level?
|
||
bne L4C6D if not.
|
||
iny
|
||
lda #$00 fill rest of dealc buffer with null addresses.
|
||
L4C8A sta dealbufl,x
|
||
sta dealbufh,x
|
||
dex
|
||
bpl L4C8A
|
||
L4C93 dey decrement to prepare for next time.
|
||
sty topdest save index.
|
||
ldx #$07
|
||
L4C99 stx dtmpx save index to dealc buf.
|
||
lda dealbufl,x
|
||
sta bloknml
|
||
ora dealbufh,x finished ?
|
||
beq L4C5E branch if done with this level.
|
||
lda dealbufh,x complete address with high byte,
|
||
sta bloknml+1
|
||
jsr rdgbuf read sapling level into gbuf.
|
||
bcs L4CC2 return errors.
|
||
jsr dealblk go free all data indexes in this block
|
||
bcs L4CC2
|
||
jsr wrtgbuf write the flipped index block
|
||
bcs L4CC2
|
||
ldx dtmpx restore index to dealc buff.
|
||
dex are there more to free?
|
||
bpl L4C99 branch if so.
|
||
bmi L4C5E branch always to get up to 8 more
|
||
L4CC2 rts sapling block numbers.
|
||
L4CC3 ldy dtree deallocate all sapling blocks greater
|
||
iny than specified block.
|
||
jsr dalblk1 (master index in gbuf)
|
||
bcs L4CC2 if errors.
|
||
jsr wrtgbuf write updated master index back to disk.
|
||
bcs L4CC2
|
||
ldy dtree figure out if tree can become sapling.
|
||
beq L4CEB branch if it can.
|
||
lda gbuf,y otherwise, continue with partial.
|
||
sta bloknml deallocation of last sapling index.
|
||
ora gbuf+$100,y is there such a sapling index block ?
|
||
beq L4CC2 all done if not.
|
||
lda gbuf+$100,y read in sapling level to be modified.
|
||
sta bloknml+1
|
||
jsr rdgbuf read highest sapling index into gbuf.
|
||
bcc L4CF5
|
||
rts
|
||
L4CEB jsr shrink shrink tree to sapling
|
||
bcs L4CC2
|
||
sapdel0 .EQ *-ofsX
|
||
jsr drdfrst read specified sapling level index
|
||
bcs L4CC2 into gbuf. branch if error.
|
||
L4CF5 ldy dsap pointer to last of desirable indexes.
|
||
iny inc to 1st undesirable.
|
||
beq L4D05 branch if all are desirable.
|
||
jsr dalblk1 deallocate all indexes above specified.
|
||
bcs L4CC2
|
||
jsr wrtgbuf write out the index block
|
||
bcs L4CC2
|
||
L4D05 ldy dsap prepare to clean up last data block.
|
||
beq L4D1F branch if possibility of making a seed.
|
||
L4D0A lda gbuf,y fetch low order data block address.
|
||
sta bloknml
|
||
ora gbuf+$100,y is it a real block ?
|
||
beq L4CC2 if not, then done.
|
||
lda gbuf+$100,y
|
||
sta bloknml+1
|
||
jsr rdgbuf go read data block into gbuf.
|
||
bcc L4D2E branch if good read
|
||
rts or return error.
|
||
L4D1F lda dtree are both tree and sap levels zero ?
|
||
bne L4D0A if not.
|
||
jsr shrink reduce this sap to a seed.
|
||
bcs L4D52 if error.
|
||
seedel0 .EQ *-ofsX
|
||
jsr drdfrst go read data block.
|
||
bcs L4D52 if error.
|
||
L4D2E ldy dseed+1 check high byte for no deletion.
|
||
beq L4D39 branch if all of 2nd page to be deleted.
|
||
dey if dseed > $200 then all were done.
|
||
bne L4D52 branch if that is the case.
|
||
ldy dseed clear only bytes >= dseed.
|
||
L4D39 lda #$00
|
||
L4D3B sta gbuf+$100,y zero out unwanted data
|
||
iny
|
||
bne L4D3B
|
||
ldy dseed+1 is that all ?
|
||
bne L4D4F yes.
|
||
ldy dseed
|
||
L4D49 sta gbuf,y
|
||
iny
|
||
bne L4D49
|
||
L4D4F jmp wrtgbuf update data block to disk.
|
||
L4D52 rts return error status.
|
||
drdfrst .EQ *-ofsX read specified 1st block into gbuf
|
||
lda firstbl
|
||
ldx firstbh
|
||
jmp rdblk go read it
|
||
|
||
* beware that dealloc may bring in a new bitmap block and may destroy
|
||
* locations 46 and 47 which are used to point to the current index block.
|
||
|
||
shrink .EQ *-ofsX
|
||
ldx firstbh first deallocate top index block
|
||
txa
|
||
pha
|
||
lda firstbl
|
||
pha save block address of this index block.
|
||
jsr dealloc free it from the bitmap
|
||
pla
|
||
sta bloknml set master of sapling
|
||
pla index block address.
|
||
sta bloknml+1
|
||
bcs L4D8D report errors.
|
||
lda gbuf get # of new 1st block from old index.
|
||
sta firstbl
|
||
lda gbuf+$100
|
||
sta firstbh
|
||
ldy #$00
|
||
jsr swapme flip that one entry in old top index.
|
||
sec now change file type,
|
||
lda stortyp from tree to sapling,
|
||
sbc #$10 or from sapling to seed.
|
||
sta stortyp
|
||
jsr wrtgbuf write the (deallocated) old top index.
|
||
L4D8D rts return error status.
|
||
dealblk .EQ *-ofsX
|
||
ldy #$00 start at beginning.
|
||
dalblk1 .EQ *-ofsX
|
||
lda bloknml save disk address of gbuf's data.
|
||
pha
|
||
lda bloknml+1
|
||
pha
|
||
L4D96 sty saptr save current index.
|
||
lda gbuf,y get low address of block to deallocate.
|
||
cmp #$01 test for null block into carry.
|
||
ldx gbuf+$100,y get remainder of block address.
|
||
bne L4DA5 branch if not null.
|
||
bcc L4DB0 was the low part null too ?
|
||
L4DA5 jsr dealloc free it up on volume bitmap.
|
||
bcs L4DB4 return any error.
|
||
ldy saptr get index to sapling level index block.
|
||
jsr swapme
|
||
L4DB0 iny next block address.
|
||
bne L4D96 if more to deallocate or test.
|
||
clc no error.
|
||
L4DB4 tax save error code, if any.
|
||
pla restore blocknm (16 bit)
|
||
sta bloknml+1
|
||
pla
|
||
sta bloknml
|
||
txa restore return code
|
||
rts
|
||
swapme .EQ *-ofsX
|
||
lda delflag swapping or zeroing ?
|
||
bne L4DC5 skip if swapping.
|
||
tax make x = 0.
|
||
beq L4DCB zero the index (always taken).
|
||
L4DC5 ldx gbuf+$100,y index high
|
||
lda gbuf,y index low
|
||
L4DCB sta gbuf+$100,y save index high
|
||
txa
|
||
sta gbuf,y save index low
|
||
rts done.
|
||
|
||
MAN
|
||
SAVE USR/SRC/PRODOS.203/PRODOS.S.XDOS.F
|
||
LOAD USR/SRC/PRODOS.203/PRODOS.S
|
||
ASM
|