A2osX/ProDOS.203/ProDOS.S.XDOS.C.txt
burniouf 9a7d20a7e1 ProDOS 203 / FX:TC mod for year 2022-2026
FORMAT: new switches & checks
SH:BREAK in FOR and WHILE
ASM / S-C MASM: new directives, CString support and .HX
LC / UC:bugfix
DHGR.DRV:bugfix
LIBGUI:wip
CC:wip
2022-12-07 08:02:29 +01:00

729 lines
24 KiB
Plaintext
Raw Permalink Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

NEW
AUTO 3,1
* deallocate a block's entry in bitmap
* on entry, x,a = address of block
dealloc stx bmcnt high address of block.
pha save low address.
ldx vcbptr check that bitmap block address is
lda vcbbuf+19,x valid given the total # of blocks
cmp bmcnt on the volume.
pla
bcc L3C8C branch if invalid
tax
and #$07 bit to be or'd in
tay
lda whichbit,y (shifting takes 7 bytes, but is slower)
sta nofree save bit pattern.
txa low block address.
lsr bmcnt
ror get pointer to byte in block that
lsr bmcnt represents the block address.
ror
lsr bmcnt
ror
sta bmptr save pointer.
lsr bmcnt transfer bit which is page of bitmap
rol half
jsr fndbmap make sure device is correct one.
bcs L3C8B error.
lda bmacmap current map.
cmp bmcnt is in-core bitmap the correct one ?
beq L3C64 branch if yes.
jsr upbmap put current map away.
bcs L3C8B error.
lda bmcnt get map #
ldx vcbptr
sta vcbbuf+28,x and make it current.
lda bmadev
jsr gtbmap read it into buffer
bcs L3C8B
L3C64 ldy bmptr index to byte
lsr half
lda nofree (get indiviual bit)
bcc bmbufhi branch if on page 1 of bitmap
ora bmbuf+$100,y
sta bmbuf+$100,y
bcs L3C7D always.
bmbufhi ora bmbuf,y this address + 2 is used as an absolute reference to bmbuf high byte.
sta bmbuf,y
L3C7D lda #$80 mark bitmap as modified
tsb bmastat
inc deblock inc count of blocks deallocated
bne L3C8A
inc deblock+1
L3C8A clc
L3C8B rts
L3C8C lda #$5A bitmap block # impossible.
sec bitmap disk address wrong
rts (maybe data masquerading as indx block)
alc1blk jsr fndbmap get address of bitmap.
bcs L3CB8 error.
L3C95 ldy #$00 begin search at start of bitmap block.
sty half which half (page) to search
L3C9A lda bmbuf,y
bne L3CB9 free blocks indicated by 'on' bits
iny
bne L3C9A check all in 1st page.
inc half now search page 2.
inc basval base value = base address / 2048.
L3CA8 lda bmbuf+$100,y search 2nd half for free block
bne L3CB9
iny
bne L3CA8
inc basval add 2048 offset for next page.
jsr nxtbmap get next bitmap (if exists) and
bcc L3C95 update vcb. branch if no error.
L3CB8 rts return error.
L3CB9 sty bmptr save index pointer to valid bit group.
lda basval prep for block address calculation
sta scrtch+1
tya address of bit pattern.
asl multiply this and basval by 8
rol scrtch+1
asl
rol scrtch+1
asl
rol scrtch+1
tax low address within 7 of actual address
sec
lda half
beq L3CDB branch if allocating from 1st half.
lda bmbuf+$100,y get pattern from 2nd page.
bcs L3CDE always.
L3CDB lda bmbuf,y get bit pattern from 1st page.
L3CDE rol find left most 'on' bit
bcs L3CE4 if found.
inx adjust low address.
bne L3CDE always.
L3CE4 lsr restore pos'n of all but left most bit.
bcc L3CE4 loop until mark moves into carry.
stx scrtch save low address.
ldx half which half of bitmap ?
bne L3CF4 if page 2.
sta bmbuf,y
beq L3CF7 always.
L3CF4 sta bmbuf+$100,y update to show allocated block in use.
L3CF7 lda #$80 indicate map is modified.
tsb bmastat
ldy vcbptr subtract 1 from total free vcb blocks
lda vcbbuf+20,y to account for newly allocated block.
sbc #$01 (carry is set)
sta vcbbuf+20,y
bcs L3D10 if high free count doesn't need adj.
lda vcbbuf+21,y adjust high count
dec
sta vcbbuf+21,y
L3D10 clc no errors.
lda scrtch return address in y,a of newly
ldy scrtch+1 allocated block.
rts
nxtbmap ldy vcbptr inc to next bitmap, but 1st make sure there is another one.
lda vcbbuf+19,y
lsr
lsr
lsr
lsr
cmp vcbbuf+28,y are there more maps ?
beq L3D60 if no more to look at.
lda vcbbuf+28,y add 1 to current map
inc
sta vcbbuf+28,y
jsr upbmap
fndbmap ldy vcbptr
lda vcbbuf+16,y get device #.
cmp bmadev does this map match this device ?
beq L3D4A yes.
jsr upbmap otherwise, save other volume's bitmap
bcs L3D5F
ldy vcbptr
lda vcbbuf+16,y
sta bmadev and read in fresh bitmap for this dev.
L3D4A ldy bmastat is it already modified ?
bmi L3D54 yes, return pointer
jsr gtbmap otherwise read in fresh bitmap.
bcs L3D5F if error.
L3D54 ldy vcbptr get relative block # of bitmap.
lda vcbbuf+28,y
asl 2 pages per block
sta basval
clc no errors.
L3D5F rts
L3D60 lda #$48 request can't be filled
sec error
rts
upbmap clc
lda bmastat is current map modified ?
bpl L3D5F no.
jsr wrtbmap update device.
bcs L3D5F if error on writing.
lda #$00
sta bmastat mark bitmap buffer as free
rts
gtbmap sta bmadev read bitmap specified by dev and vcb.
ldy vcbptr get lowest map # with free blocks in it
lda vcbbuf+28,y
sta bmacmap associate offset with bitmap ctrl block.
clc add this # to the base address of
adc vcbbuf+26,y 1st bitmap and save in bmadadr which
sta bmadadr is address of bitmap to be used.
lda vcbbuf+27,y
adc #$00
sta bmadadr+1
lda #$01 read device command
L3D92 sta A4L
lda devnum save current dev #
pha
lda bmadev get bitmap's dev #
sta devnum
lda bmadadr and disk address
sta bloknml
lda bmadadr+1
sta bloknml+1
lda bmbufhi+2 address of the buffer (low = 0)
jsr dobitmap
tax error code (if any).
pla restore current dev #
sta devnum
bcc L3DB6 and return it if no error.
txa error code
L3DB6 rts
rdblk sta bloknml
stx bloknml+1
jsr rdgbuf
rts
wrtbmap lda #$02 write command.
bne L3D92 always.
wrtgbuf lda #$02 write command
bne L3DC9 always.
rdgbuf lda #$01 read command.
L3DC9 sta A4L pass to device handler.
lda /gbuf general buffer.
dobitmap php no interrupts
sei
sta buf+1 buffer high.
stz buf buffer low (always on page boundary)
stz p8error clear global error code.
lda #$FF indicates reg call made to dev handler
sta ioaccess
lda devnum transfer dev # for dispatcher to
sta unitnum convert to unit #.
jsr dmgr call the driver.
bcs L3DE8 if error.
plp restore interrupts.
clc
rts
L3DE8 plp file i/o error. restore interrupts.
sec
rts
* get mark command
getmark ldx fcbptr index to open fcb.
ldy #$02 index to user's mark parmeter.
.1 lda fcbbuf+18,x transfer current position
sta (A3L),y to user's parameter list
inx
iny
cpy #$05 transfer 3 bytes
bne .1
clc
rts
L3DFD lda #$4D invalid position
sec
rts
* set mark command
setmark ldy #$04 index to user's desired position.
ldx fcbptr file's control block index.
inx inc by 2 for index to hi eof
inx
sec indicate comparisons are necessary.
.1 lda (A3L),y move it to 'tpos'
sta tposll-2,y
bcc .2 branch if mark < eof
cmp fcbbuf+21,x
bcc .2 branch if mark qualifies.
bne L3DFD branch if mark > eof (invalid position)
dex
.2 dey move/compare next lower byte of mark.
tya test for all bytes moved/tested.
eor #$01 preserves carry status.
bne .1 branch if more.
rdposn ldy fcbptr test to see if new position is
lda fcbbuf+19,y within the same (current) data block.
and #$FE
sta scrtch
lda tposlh middle byte of new position
sec
sbc scrtch
sta scrtch
bcc L3E44 branch if < current position.
cmp #$02 must be within 512 bytes of beginning
bcs L3E44 of current position.
lda tposhi make sure within the same 64k.
cmp fcbbuf+20,y
bne L3E44 branch if not.
jmp svmark if so, adj fcb, position ptr and return.
L3E44 lda fcbbuf+7,y determine file type for positioning.
beq L3E50 0 = invalid file type.
cmp #$04 tree class file?
bcc L3E59 yes, go position.
jmp dirmark no, test for dir type.
L3E50 ldy #$A4 clear illegal filetype entry in fcb
sta fcbbuf,y
lda #$43 and report error
sec
rts
L3E59 lda fcbbuf+7,y use storage type as # of index levels
sta levels since 1=seed, 2=sapling, 3=tree.
lda fcbbuf+8,y
and #$40 if previous data was modified then
beq L3E6B disk must be updated.
jsr wfcbdat
bcs L3ED4 if error.
L3E6B ldy fcbptr test to see if current index block
lda fcbbuf+20,y is usable by checking if new
and #$FE position is within 128k of the
sta scrtch beginning of current sapling level
lda tposhi chunk.
sec
sbc scrtch
bcc L3E9D branch if a new index block is needed.
cmp #$02 is new position within 128k of old ?
bcs L3E9D branch if not.
ldx levels is it a seed file ?
dex
bne datlevel no, use current indexes.
L3E89 lda tposlh is new position < 512 ?
lsr
ora tposhi
bne L3EEF no, mark both data and index block as
lda fcbbuf+12,y unallocated. 1st block is only block
sta bloknml and it's data.
lda fcbbuf+13,y high block address.
jmp rnewpos go read in block and set statuses.
L3E9D lda fcbbuf+8,y check to see if previous index block
and #$80 was modified.
beq L3EA9 read in over it if current up to date.
jsr wfcbidx go update index on disk (fcb block addr)
bcs L3ED4
L3EA9 ldx levels be sure there is a top index
cpx #$03 before reading it...
beq posindex branch if file is a tree.
lda tposhi is new position within range of a
lsr sapling file (less than 128k) ?
php save results
lda #$07 (no level is allocated for new pos'n)
plp restore z-flag.
bne L3F18 go mark all as dummy.
jsr clrstats clr status bits 0,1,2 (index/data/alloc)
dex check for seed
beq L3E89 if seed, check for position < 512.
jsr rfcbfst go get only index block.
bcs L3ED4 if error.
ldy fcbptr save newly loaded index block's address.
lda bloknml
sta fcbbuf+14,y
lda bloknml+1
sta fcbbuf+15,y
bcc datlevel branch always
L3ED4 rts
posindex jsr clrstats clr all alloc requirements for previous
jsr rfcbfst position. get highest level index block
bcs L3ED4
lda tposhi then test for a sap level index block
lsr
tay
lda (zpt),y
inc zpt+1
cmp (zpt),y (both high and low = 0 if no index exists)
bne saplevel
tax are both bytes 0 ?
bne saplevel
dec zpt+1
L3EEF lda #$03 show neither index or data block alloc'd
bra L3F18
saplevel sta bloknml read in next lower index block.
lda (zpt),y (high address)
sta bloknml+1
dec zpt+1
jsr rfcbidx read in sapling level
bcs L3ED4
datlevel lda tposhi get block address of data block
lsr
lda tposlh ( if there is one )
ror
tay
lda (zpt),y data block address low
inc zpt+1
cmp (zpt),y
bne L3F51
tax
bne L3F51
lda #$01 show data block as never been allocated
dec zpt+1
L3F18 ldy fcbptr set status to show what's missing
ora fcbbuf+8,y
sta fcbbuf+8,y
lsr discard bit that says data block
lsr unallocated because carry indicates if
jsr zipdata index block is invalid and needs to be
bcc svmark zeroed. branch if it doesn't need zeroed
jsr zeroindex zero index block in user's i/o buffer
bra svmark
zeroindex lda #$00
tay
L3F30 sta (zpt),y zero out the index half of the user's
iny i/o buffer
bne L3F30
inc zpt+1
L3F37 sta (zpt),y
iny
bne L3F37
dec zpt+1 restore proper address
rts
zipdata lda #$00
tay
L3F42 sta (datptr),y zero out data area
iny
bne L3F42
inc datptr+1
L3F49 sta (datptr),y
iny
bne L3F49
dec datptr+1
rts
L3F51 sta bloknml get data block of new position
lda (zpt),y (high address)
dec zpt+1
rnewpos sta bloknml+1
jsr rfcbdat
bcs L3F86 if error.
jsr clrstats show whole chain is allocated.
svmark ldy fcbptr update position in fcb
iny
iny
ldx #$02
L3F68 lda fcbbuf+18,y save old mark in case calling routine
sta oldmark,x fails later.
lda tposll,x
sta fcbbuf+18,y
dey
dex move 3 byte position marker
bpl L3F68
clc set up indirect address to buffer
lda datptr page pointed to by the current
sta sos position marker.
lda tposlh
and #$01
adc datptr+1
sta sos+1
L3F86 rts carry set if error
clrstats ldy fcbptr clear allocation states for data block
lda fcbbuf+8,y and both levels of indexes/
and #$F8
sta fcbbuf+8,y indicates that either they exist now
rts or unnecessary for current position.
dirmark cmp #$0D is it a directory ?
beq L3F9C yes...
lda #$4A no, so compatability problem.
jsr p8errv should not have been opened !!!
L3F9C lda scrtch recover results of previous subtraction.
lsr use difference as counter for how many
sta cntent blocks must be read to get to new pos'n.
lda fcbbuf+19,y test for positive direction
cmp tposlh indicated by carry.
bcc L3FB9 if set, position forward. otherwise,
L3FAB ldy #$00 read directory file in reverse order.
jsr dirpos1 read previous block.
bcs L3FD6 if error.
inc cntent count up to 128.
bpl L3FAB loop if more blocks to pass over.
bmi svmark always.
L3FB9 ldy #$02 position is forward from current.
jsr dirpos1 read next directory block
bcs L3FD6 if error.
dec cntent
bne L3FB9 loop if position not found in this block
beq svmark branch always.
dirpos1 lda (datptr),y get link address of previous or next
sta bloknml directory block.
cmp #$01 test for null byte into carry
iny but first be sure there is a link.
lda (datptr),y get the rest of the link.
bne L3FD8 branch if certain link exists.
bcs L3FD8 was the low part null as well ?
lda #$4C something is wrong with directory file!
L3FD6 sec error.
rts
L3FD8 sta bloknml+1
* read file's data block
rfcbdat lda #$01 read command
sta A4L
ldx #datptr points at address of data buffer.
jsr fileio1 go do file input.
bcs L3FF2 error.
ldy fcbptr
lda bloknml
sta fcbbuf+16,y save block # just read in fcb.
lda bloknml+1
sta fcbbuf+17,y
L3FF2 rts
rfcbidx lda #$01 prepare to read index block : read command
sta A4L
ldx #$48 address of current index buffer.
jsr fileio1 go read index block.
bcs L400C error
ldy fcbptr
lda bloknml
sta fcbbuf+14,y save block address of this index in fcb
lda bloknml+1
sta fcbbuf+15,y
clc
L400C rts
L400D lda #$02 write command
.HS 2C skip next instruction
rfcbfst lda #$01 read command.
pha save the command
lda #$0C
ora fcbptr add offset to fcbptr
tay
pla
ldx #$48 rd block into index portion of file buf
dofileio sta A4L command
lda fcbbuf,y get disk block address from fcb.
sta bloknml block 0 not legal
cmp fcbbuf+1,y
bne L4031
cmp #$00 are both bytes 0 ?
bne L4031 no, continue request
lda #$0C otherwise, allocation error.
jsr sysdeath doesn't return...
L4031 lda fcbbuf+1,y high address of disk block
sta bloknml+1
fileio1 php no interrupts
sei
lda $00,x get memory address of buffer from
sta buf page zero pointed to by x register
lda $01,x
sta buf+1 and pass address to device handler
ldy fcbptr
lda fcbbuf+1,y
sta devnum along with device #.
lda #$FF also, set to indicate reg call made to
sta ioaccess device handler.
lda devnum transfer device # for dispatcher
sta unitnum to convert to unit #.
stz p8error clear global error code.
jsr dmgr call the driver.
bcs L405E if error.
plp restore interrupts
clc
rts
L405E plp restore interrupts
sec
rts
wfcbfst jsr upbmap update the bitmap
bra L400D and write file's 1st block.
wfcbdat ldx #datptr point at memory address with x and
lda #$10 disk address with y.
ora fcbptr add offset to fcbptr
tay and put in y.
lda #$02 write data block.
jsr dofileio
bcs L4096 if errors.
lda #$BF mark data status as current.
bra L408D
wfcbidx jsr upbmap update bitmap.
ldx #$48 point to address of index buffer
lda #$0E and block address of that index block.
ora fcbptr
tay
lda #$02
jsr dofileio go write out index block.
bcs L4096 if errors.
lda #$7F mark index status as current.
L408D ldy fcbptr change status byte to reflect
and fcbbuf+8,y successful disk file update.
sta fcbbuf+8,y (carry is unaffected)
L4096 rts
openf jsr findfile look up the file.
bcc L40A0 if ok.
cmp #$40 is this opening a root directory ?
bne L40A7 if not, then error.
L40A0 jsr tstopen are any other files writing to this
bcc L40AD same file ? branch if not.
L40A5 lda #$50 file is busy, shared access not allowed.
L40A7 sec
rts
L40A9 lda #$4B file is wrong storage type.
sec
rts
L40AD ldy fcbptr get address of 1st free fcb found.
lda fcbflg if this byte <> 0 then free fcb found
bne L40B9 and available for use.
lda #$42 fcb full error.
sec
rts
L40B9 ldx #$1F assign fcb,
lda #$00 but clean it first.
L40BD sta fcbbuf,y
iny
dex
bpl L40BD
lda #$06 start claiming it by moving in file info
tax using x as source index
ora fcbptr and y as destination (fcb).
tay
L40CB lda d_dev-1,x move ownership info.
sta fcbbuf,y note: this code depends upon the defined
dey order of both the fcb and directory
dex entry buffer.
bne L40CB
lda d_stor get storage type and
lsr strip off file name length
lsr by dividing by 16.
lsr
lsr
tax save in x for later comparison
sta fcbbuf+7,y and in fcb for future access.
lda d_attr get file's attributes and use it
and #$03 as a default access request.
cpx #$0D if directory, don't allow write enable.
bne L40EB
and #$01 read enabled bit
L40EB sta fcbbuf+9,y
and #$02 check for write enabled request.
beq L40F7 branch for open as read-only
lda totent otherwise, be sure no one else is
bne L40A5 reading the same file. branch if busy.
L40F7 cpx #$04 is it a tree file type ?
bcc L40FF yes.
cpx #$0D is it a directory type ?
bne L40A9 if not, wrong storage type.
L40FF ldx #$06 move address of 1st block of file, end
L4101 sta bloknml+1 of file and current usage count.
lda fcbptr
ora ofcbtbl,x this is done via a translation table
tay between directory info and fcb.
lda d_frst,x
sta fcbbuf,y
dex
bpl L4101 last loop stores hi address of 1st block
sta bloknml and this is the low one.
ldy fcbptr
lda cntent this was set up by 'tstopen'.
sta fcbbuf,y claim fcb for this file.
jsr alcbuffr go allocate buffer in memory tables.
bcs L4147 if errors.
jsr fndfcbuf rtn addr of bufs in data & index ptrs.
lda flevel mark level at which
sta fcbbuf+27,y file was opened.
lda fcbbuf+7,y file must be positioned at beginning.
cmp #$04 is it a tree file ?
bcs L415E no, assume a directory.
lda #$FF fool the position routine into giving
sta fcbbuf+20,y a valid position with preloaded data,
ldy #$02 etc. set desired position to 0.
lda #$00
L413C sta tposll,y
dey
bpl L413C
jsr rdposn let tree position routine do the rest.
bcc L4163 if successful.
L4147 pha save error code.
ldy fcbptr free buffer space.
lda fcbbuf+11,y
beq L4156 if no bufnum, ok because never alloc'd.
jsr relbuffr go release buffer.
ldy fcbptr since error was before file was
L4156 lda #$00 successfully opened, then it is
sta fcbbuf,y necessary to release fcb also.
pla error code.
sec
rts
L415E jsr rfcbdat read in 1st block of directory file.
bcs L4147 return error after freeing buffer & fcb.
L4163 ldx vcbptr index to vcb.
inc vcbbuf+30,x add 1 to # of files currently open
lda vcbbuf+17,x and indicate that this volume has at
ora #$80 least 1 file active.
sta vcbbuf+17,x
ldy fcbptr index to fcb.
lda fcbbuf,y return ref # to user.
ldy #$05
sta (A3L),y
clc open is successful
rts
* test open
* is there an open file?
tstopen lda #$00
sta cntent returns the ref # of a free fcb.
sta totent flag to indicate file already open.
sta fcbflg flag indicates a free fcb is available.
L4188 tay index to next fcb.
ldx fcbflg test for free fcb found.
bne L4191 if already found.
inc cntent
L4191 lda fcbbuf,y is this fcb in use ?
bne L41A3 yes.
txa if not, should we claim it ?
bne L41C1 branch if free fcb already found.
sty fcbptr save index to new free fcb.
lda #$FF set fcb flag to indicate
sta fcbflg free fcb found.
bne L41C1 branch always to test next fcb.
L41A3 tya add offset to index to ownership info
ora #$06
tay and put it back in y.
ldx #$06 index to directory entry owner info.
L41A9 lda fcbbuf,y all bytes must match to say that it's
cmp d_dev-1,x the same file again.
bne L41C1 if not, then next fcb.
dey index to next lower bytes.
dex
bne L41A9 loop to check all owner info.
inc totent file is already open, now see
lda fcbbuf+9,y if it's already opened for write. and #$02 if so report file busy (with carry set).
and #$02 if so report file busy (with carry set).
beq L41C1 branch if this file is read access only.
sec
rts
L41C1 tya calc position of next fcb.
and #$E0 first strip any possible index offsets.
clc
adc #$20 inc to next fcb.
bne L4188 branch if more to compare.
clc report no conflicts.
rts
MAN
SAVE usr/src/prodos.203/prodos.s.xdos.c
LOAD usr/src/prodos.203/prodos.s
ASM