Apple-2-SW/A2osX
1
0
Fork 0
mirror of https://github.com/A2osX/A2osX.git synced 2024-06-20 11:29:29 +00:00
Code Issues Projects Releases Wiki Activity

Kernel 0.93+

Browse Source
This commit is contained in:
Rémy GIBERT 2019-11-10 19:28:06 +01:00
parent a04fca1dc0
commit c43c51e28e
12 changed files with 836 additions and 509 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
.Floppies/A2OSX.BOOT.po
View File

Binary file not shown.

BIN
.Floppies/A2OSX.BUILD.po
View File

Binary file not shown.

BIN
.Floppies/A2OSX.TEST.po
View File

Binary file not shown.

109
ProDOS.FX/ProDOS.S.LDR.txt
View File

@ -151,37 +151,22 @@ m128k sta idapple Save MACHID in temp location
lda #$01 patch for the gs rom
trb statereg to force off intcxrom
lda PAKME.ILDR
sta ZPInBufPtr
lda PAKME.ILDR+1
sta ZPInBufPtr+1
lda #ILDR.START
sta ZPOutBufPtr
ldx #PAKME.ILDR-PAKME.Table
ldy #ILDR.START
lda /ILDR.START
sta ZPOutBufPtr+1
jsr X.Unpak
jsr X.Unpak.XatYA
lda PAKME.GP
sta ZPInBufPtr
lda PAKME.GP+1
sta ZPInBufPtr+1
lda #MLI
sta ZPOutBufPtr
ldx #PAKME.GP-PAKME.Table
ldy #MLI
lda /MLI
sta ZPOutBufPtr+1
jsr X.Unpak
jsr X.Unpak.XatYA
jsr lc1in switch in language card bank 1.
lda PAKME.XRW
sta ZPInBufPtr
lda PAKME.XRW+1
sta ZPInBufPtr+1
lda #$D000
sta ZPOutBufPtr
ldx #PAKME.XRW-PAKME.Table
ldy #$D000
lda /$D000
sta ZPOutBufPtr+1
jsr X.Unpak
jsr X.Unpak.XatYA
ldx #0
@ -196,15 +181,10 @@ m128k sta idapple Save MACHID in temp location
inx
bne .1
lda PAKME.XDOS
sta ZPInBufPtr
lda PAKME.XDOS+1
sta ZPInBufPtr+1
lda #$DE00
sta ZPOutBufPtr
ldx #PAKME.XDOS-PAKME.Table
ldy #$DE00
lda /$DE00
sta ZPOutBufPtr+1
jsr X.Unpak
jsr X.Unpak.XatYA
ldx #XDOS.DATA.LEN0
@ -212,15 +192,10 @@ m128k sta idapple Save MACHID in temp location
dex
bne .3
lda PAKME.IRQ
sta ZPInBufPtr
lda PAKME.IRQ+1
sta ZPInBufPtr+1
lda #$FF9B
sta ZPOutBufPtr
ldx #PAKME.IRQ-PAKME.Table
ldy #$FF9B
lda /$FF9B
sta ZPOutBufPtr+1
jsr X.Unpak
jsr X.Unpak.XatYA
LDR.IRQ lda RROMWRAMBNK2
ldy irqv interrupt vector
@ -269,19 +244,12 @@ LDR.IIGS sta cortflag
ldy PAKME.CCLK+1
jsr LDR.SetupCLK
ldx PAKME.SEL2
ldy PAKME.SEL2+1
* ldx #PAKME.SEL2-PAKME.Table
* ldy #$1000
* lda /$1000
* jsr X.Unpak.XatYA
stx ZPInBufPtr
sty ZPInBufPtr+1
lda #$1000
sta ZPOutBufPtr
lda /$1000
sta ZPOutBufPtr+1
jsr X.Unpak
ldx PAKME.SEL2
ldy PAKME.SEL2+1
ldx #PAKME.SEL2-PAKME.Table
jsr LDR.SetupQC
*--------------------------------------
lda LDR.BootFlag
@ -294,8 +262,7 @@ LDR.IIGS sta cortflag
.1 bra LDR.Common
*--------------------------------------
LDR.II ldx PAKME.SEL1
ldy PAKME.SEL1+1
LDR.II ldx #PAKME.SEL1-PAKME.Table
jsr LDR.SetupQC
jsr LDR.ClkDevScan
@ -366,18 +333,14 @@ LDR.ReadRoot lda LDR.MLIOL.P+1 place boot devnum in globals
.9 ldx #LDR.MSG.ROOTERR
jsr LDR.PrintX
bmi *
bra *
*--------------------------------------
LDR.SetupQC bit RRAMWRAMBNK2 read/write RAM bank 2
bit RRAMWRAMBNK2
stx ZPInBufPtr
sty ZPInBufPtr+1
lda #$D100
sta ZPOutBufPtr
ldy #$D100
lda /$D100
sta ZPOutBufPtr+1
jsr X.Unpak
jsr X.Unpak.XatYA
lda #$EE byte to distinguish LC bank 2
sta $D000
@ -520,29 +483,17 @@ LDR.SetupRAM lda DEVCNT
jsr lc1in
ldx PAKME.RAM
ldy PAKME.RAM+1
stx ZPInBufPtr
sty ZPInBufPtr+1
lda #$FF00
sta ZPOutBufPtr
ldx #PAKME.RAM-PAKME.Table
ldy #$FF00
lda /$FF00
sta ZPOutBufPtr+1
jsr X.Unpak
jsr X.Unpak.XatYA
sta SETWRITEAUX
ldx PAKME.RAMX
ldy PAKME.RAMX+1
stx ZPInBufPtr
sty ZPInBufPtr+1
lda #$0200
sta ZPOutBufPtr
ldx #PAKME.RAMX-PAKME.Table
ldy #$0200
lda /$0200
sta ZPOutBufPtr+1
jsr X.Unpak
jsr X.Unpak.XatYA
sta CLRWRITEAUX

503
ProDOS.FX/ProDOS.S.XDOS.A.txt
View File

@ -203,13 +203,15 @@ XDOS.syserr sta p8error P8 error code
plx pop 1 level of return
sec
rts
*--------------------------------------
sysdeath1 tax death error code.
sta CLR80DISP disable 80 col hardware.
lda SETTEXT switch in text.
lda cortflag is this a Cortland?
beq H321A if not, don't use super hires switch.
stz newvideo force off super hires.
H321A lda CLRPAGE2 switch in text page 1.
ldy #$13
@ -263,7 +265,7 @@ H3274 jsr $FFFF SELF MODIFIED : execute command
errorsys jsr GP.P8errv
goodop rts
*--------------------------------------
setpath ldy #$01 index to pathname pointer
lda (A3L),y low pointer address
sta zpt
@ -275,101 +277,126 @@ setpath ldy #$01 index to pathname pointer
synpath ldx #$00 x = index to pathbuf
ldy #$00 y = index to input pathname.
stx prfxflg assume prefix is in use.
stx pathbuf mark pathbuf = nothing processed.
stz prfxflg assume prefix is in use.
stz pathbuf mark pathbuf = nothing processed.
lda (zpt),y validate pathname length > 0 and < 65
beq errsyn
cmp #$41
bcs errsyn
sta pathcnt this is used to compare for
inc pathcnt end of pathname processing.
iny now check for full pathname...
lda (zpt),y (full name if starts with '/')
ora #$80
cmp #$AF
and #$7F
cmp #'/'
bne H32AD branch if prefix appended.
sta prfxflg set prefix flag = prefix not used.
dec prfxflg set prefix flag = prefix not used.
iny index to 1st character of pathname.
H32AD lda #$FF set current position of pathbuf
sta pathbuf,x to indicate end of pathname.
sta namcnt $FF = no chars processed in local name.
stx namptr pointer to local name length byte.
H32B8 cpy pathcnt done with pathname processing?
bcs endpath
lda (zpt),y get character
and #$7F
inx prepare for next char
iny
cmp #$2F is it delimiter '/' ?
cmp #'/' is it delimiter '/' ?
beq endname yes
cmp #$61 lowercase?
bcc H32CD no
.DO LOWERCASE=0
cmp #'a' lowercase?
bcc .1 no
and #$5F shift to uppercase
H32CD sta pathbuf,x store char
.1 .FIN
sta pathbuf,x store char
inc namcnt is it the 1st char of a local name?
bne H32DA no
bne .2 no
inc namcnt increment to 1
bne H32E6 1st char must be alpha (always taken)
H32DA cmp #$2E is it '.' ?
beq H32B8 ok, then do next char
cmp #$30 at least a '0' ?
bcc errsyn error if not
cmp #$3A is it numeric?
bcc H32B8 yes, get next char
H32E6 cmp #$41 at least an 'a' ?
bcc errsyn error if not
cmp #$5B is it > 'z' ?
bcc H32B8 branch if valid alpha to get next char
errsyn sec bad pathname
lda #$40
jsr XDOS.IsValidFirstChar
bcc H32B8
bra errsyn
.2 jsr XDOS.IsValidChar
bcc H32B8
errsyn lda #MLI.E.INVPATH
sec
rts
endpath lda #$00 end pathname with a 0
bit namcnt also make sure count is positive
bpl H32FD
sta namcnt
dex
H32FD inx
sta pathbuf,x
beq errsyn error if '/' only.
stx pathcnt save length of pathname
tax
endname lda namcnt validate local name < 16
cmp #$10
cmp #16
bcs errsyn
phx save pointer
phx save pointer
ldx namptr get index to beginning of local name
sta pathbuf,x save local name's length
plx restore pointer
bne H32AD branch if more names to process
clc probably no error, but
lda prfxflg make sure all pathnames are prefixed
bne H3323 or begin with a '/'.
lda newpfxptr must be non-zero
beq errsyn
H3323 rts
* set prefix command
setprefx jsr setpath call is made to detect if a null path.
*--------------------------------------
XDOS.SetPrefix jsr setpath call is made to detect if a null path.
bcc H3333 path ok.
ldy pathbuf is it a null pathname?
bne pfxerr error if not
sty newpfxptr fix appletalk PFI bug
sty preflag prefix flag
clc no error
rts
H3333 jsr findfile go find specified prefix directory.
bcc H333C if no error.
cmp #$40 bad pathname.
cmp #MLI.E.INVPATH bad pathname.
bne pfxerr branch if error is not root directory.
H333C lda d_stor make sure last local name is dir type
and #$D0 (either root or sub).
eor #$D0 directory?
bne ptyperr wrong type
ldy prfxflg new or appended prefix?
bne H334D
lda newpfxptr append new prefix to old
H334D tay
sec find new beginning of prefix
sbc pathcnt
@ -391,15 +418,15 @@ movprfx lda pathbuf,y
iny
inx
bne movprfx
clc good prefix
rts
ptyperr lda #$4B filetype error (not a directory)
pfxerr sec
rts
* get prefix command
getprefx clc calc how big a buffer is needed.
*--------------------------------------
XDOS.GetPrefix clc calc how big a buffer is needed.
ldy #$01 get index to users pathname buffer
lda (A3L),y
sta usrbuf user buffer ptr
@ -411,16 +438,21 @@ getprefx clc calc how big a buffer is needed.
sta cbytes
jsr valdbuf go validate prefix buffer address
bcs pfxerr
ldy #$00 y = indirect index to user buffer.
lda newpfxptr get address of beginning of prefix
tax
beq nulprfx if null prefix.
eor #$FF get total length of prefix
adc #$02 add 2 for leading and trailing slashes.
nulprfx sta (usrbuf),y store length in user's buffer.
beq gotprfx branch if null prefix.
sendprfx iny inc to next user buffer location.
lda pathbuf,x get next char of prefix.
sndlimit sta (usrbuf),y give char to user.
and #$F0 check for length descriptor.
bne H33B3 branch if regular character
@ -435,11 +467,14 @@ H33B3 inx
sta (usrbuf),y
gotprfx clc no error
rts
findfcb ldy #$01 index to ref#
lda (A3L),y is it a valid file# ?
beq badref must not be 0.
cmp #$09 must be 1 to 8 only.
bcs badref
pha
dec
lsr
@ -451,6 +486,7 @@ findfcb ldy #$01 index to ref#
pla restore ref# in acc
cmp fcbbuf,y
bne errnoref
fndfcbuf lda fcbbuf+11,y get page address of file buffer.
jsr getbufadr get file's address into bufaddrl,h
ldx bufaddrh (y=fcbptr preserved)
@ -464,16 +500,19 @@ fndfcbuf lda fcbbuf+11,y get page address of file buffer.
lda bufaddrl
sta datptr index and data buffers always on
sta zpt page boundaries.
fndfvol tax search for associated vcb
lda vcbbuf+16,x
cmp fcbbuf+1,y is this vcb the same device?
beq tstvopen if it is, make sure volume is active.
nxtfvol txa adjust index to next vcb.
clc
adc #$20
bcc fndfvol loop until volume found.
lda #$0A open file has no volume so
jsr sysdeath kill the system.
.HS 2C BIT ABS
fcbdead lda #$0B fcb error so
jsr sysdeath kill the system.
@ -490,10 +529,9 @@ errnoref lda #$00 put a zero into this fcb to
badref lda #MLI.E.BADREF requested refnum is
sec illegal (out of range)
rts
*--------------------------------------
XDOS.Online jsr mvdbufr figure out how big buffer has to be.
* online command
online jsr mvdbufr figure out how big buffer has to be.
stz cbytes set this for valdbuf routine.
stz cbytes+1
ldy #$01
@ -501,21 +539,29 @@ online jsr mvdbufr figure out how big buffer has to be.
and #$F0 device. mask out unused nibble.
sta devnum last device used.
beq H343C branch if all devices.
lda #$10 cbytes = $010
sta cbytes
bne H343F always taken
H343C inc cbytes+1 cbytes = $100
H343F jsr valdbuf go validate buffer range against
bcs onlinerr allocated memory.
lda #$00 zero out user buffer space
ldy cbytes
H3449 dey
sta (usrbuf),y
bne H3449
sta namptr used as pointer to user buffer.
lda devnum get device # again.
bne online1 branch if only 1 device to process.
jsr mvdevnums get list of currently recognized dev's.
H3459 phx save index to last item on list
lda loklst,x
sta devnum save desired device to look at.
@ -527,37 +573,47 @@ H3459 phx save index to last item on list
plx get index to device list.
dex next device.
bpl H3459 branch if there is another device.
lda #$00 no errors for multiple on-line
clc
onlinerr rts
*--------------------------------------
online1 jsr fnddvcb see if it has already been logged in.
bcs olinerr1 branch if vcb is full.
ldx #$00 read in root (volume) directory
lda #$02
jsr rdblk read it into general purpose buffer.
ldx vcbptr index to the vcb entry.
bcc volfound branch if read was ok.
tay error value.
lda vcbbuf+17,x don't take the vcb offline if
bne rtrnerr there are active files present.
sta vcbbuf,x now take the volume offline
sta vcbbuf+16,x
rtrnerr tya error value.
bcs olinerr1 branch if unable to read.
volfound lda vcbbuf,x has it been logged in before?
beq H349E if not.
lda vcbbuf+17,x it has, are there active files?
bmi H34AA branch if volume is currently busy.
H349E jsr logvcb1 go log it in.
bcs olinerr1 branch if there is a problem.
lda #$57 anticipate a duplicate active volume
bit duplflag exits.
bmi olinerr1 branch if so.
H34AA ldx vcbptr
jsr cmpvcb does vol read compare with logged vol?
lda #$2E anticipate wrong volume mounted.
bcc H34D0 branch if ok.
olinerr1 pha save error code.
jsr svdevn report what device has problem.
pla error code.
@ -572,6 +628,7 @@ olinerr1 pha save error code.
sta (usrbuf),y
stz duplflag clear duplicate flag.
lda #$57 duplicate volume error code.
H34CE sec flag error
rts
@ -590,9 +647,373 @@ svdevn ldy namptr index to 1st byte of this entry.
lda devnum upper nibble = device# and
ora (usrbuf),y lower nibble = name length.
sta (usrbuf),y
clc no errors
rts end of block file manager
*--------------------------------------
XDOS.Create jsr lookfile check for duplicate, get free entry
bcc duperr error code may be 'file not found'
tstfnf cmp #MLI.E.FNOTFND 'file not found' is ok
bne crerr1 otherwise exit with error.
ldy #$07 test for tree or directory file,
lda (A3L),y no other kinds are legal.
cmp #$04 is it seed, sapling or tree?
bcc tstdspc branch if it is
cmp #$0D
bne ctyperr report type error if not directory.
tstdspc lda devnum make sure destination device
jsr twrprot1 is not write protected.
bcs H351D
lda nofree is there space in directory to
beq xtndir add this file? branch if not
jmp creat1 otherwise, go create file.
xtndir lda own_blk before extending directory,
ora own_blk+1 make sure it's a subdirectory.
bne H352A
lda #MLI.E.DIRFULL otherwise, directory full error
.HS 2C BIT ABS
ctyperr lda #MLI.E.UNSUPST filetype error
.HS 2C BIT ABS
duperr lda #MLI.E.DUPFILE name already exists
crerr1 sec
H351D rts
H352A lda bloknml preserve disk address of current (last)
pha directory link, before allocating an
lda bloknml+1 extended block.
pha
jsr alc1blk allocate a block for extending directory
plx
stx bloknml+1 restore block addr of dir info in gbuf
plx
stx bloknml
bcs H351D unable to allocate.
sta gbuf+2 save block address in y,a to
sty gbuf+3 current directory.
jsr wrtgbuf update directory block with new link.
bcs H351D if error
ldx #$01
swpbloks lda bloknml,x prepare new directory block
sta gbuf,x using current block as back link
lda gbuf+2,x
sta bloknml,x and save new block as next to be written
dex
bpl swpbloks
inx
txa x and a = 0
clrdir sta gbuf+2,x
sta gbuf+$100,x
inx
bne clrdir
jsr wrtgbuf write prepared directory extension.
bcs H351D if error
lda own_blk
ldx own_blk+1
jsr rdblk read in parent directory block
ldx own_ent and calc entry address.
lda /gbuf
sta zpt+1
lda #$04
ocalc clc
dex has entry address been calulated?
beq H3584 if yes.
adc own_len next entry address
bcc ocalc
inc zpt+1 entry must be in 2nd 256 bytes of block
bcs ocalc always taken.
H3584 sta zpt
ldy #$13 index to block count
H3588 lda (zpt),y
adc dinctbl-$13,y add 1 to block count and
sta (zpt),y
iny
tya $200 to the directory's eof.
eor #$18 done with usage/eof update?
bne H3588 branch if not.
jsr wrtgbuf go update parent.
bcs crerr2
jmp XDOS.Create
crerr2 rts return and report errors
creat1 ldx #$00 zero out gbuf
H35A0 stz gbuf,x
stz gbuf+$100,x and data block of file.
inx
bne H35A0
ldy #$0B move user specified date/time
cmvtime lda (A3L),y to directory.
sta d_filid,y
txa if all 4 bytes of date/time = 0
ora (A3L),y then use built-in date/time.
tax
dey
cpy #$07
bne cmvtime
txa does user want default time?
bne cmvname if not.
ldx #$03
mvdftime lda p8date,x move current default date/time
sta d_credt,x
dex
bpl mvdftime
cmvname lda (A3L),y y = index to file kind.
cmp #$04
lda #$10 assume tree type
bcc csvfkind
lda #$D0 it's directory.
csvfkind ldx namptr index to local name of pathname.
ora pathbuf,x combine file kind with name length.
sta d_stor sos calls this 'storage type'.
and #$0F strip back to name length
tay and use as counter for move.
clc
adc namptr calc end of name
tax
.DO LOWERCASE=1
stz d_sosver
stz d_comp
.FIN
crname lda pathbuf,x move local name as filename
sta d_stor,y
.DO LOWERCASE=1
cmp #'a'
bcc .3
cmp #'z'+1
bcs .3
eor #$20
sta d_stor,y
cpy #8
bcs .1
lda whichbit,y
tsb d_sosver
bra .2
.1 lda whichbit-8,y
tsb d_comp
.2 lda #$80
tsb d_sosver
.3 .FIN
dex
dey
bne crname
ldy #$03 index to 'access' parameter
lda (A3L),y
sta d_attr
iny also move 'file identification'
lda (A3L),y
sta d_filid
cmvauxid iny move auxillary identification bytes
lda (A3L),y
sta d_auxid-5,y
cpy #$06
bne cmvauxid
.DO LOWERCASE=0
lda xdosver save current xdos version #
sta d_sosver
lda compat and backward compatibility #
sta d_comp
.FIN
lda #$01 usage is always 1 block
sta d_usage
lda d_head place back pointer to header block
sta d_dhdr
lda d_head+1
sta d_dhdr+1
lda d_stor storage type.
and #$E0 is it a directory?
beq cralcblk branch if seed file.
ldx #$1E move header to data block
cmvheadr lda d_stor,x
sta gbuf+4,x
dex
bpl cmvheadr
eor #$30
sta gbuf+4 make it a directory header mark.
ldx #$07 overwrite password area and other
cmvpass lda pass,x header info.
sta gbuf+20,x
lda xdosver,x
sta gbuf+32,x
dex
bpl cmvpass
ldx #$02 and include info about parent directory
stx d_eof+1
cmvparnt lda d_entblk,x
sta gbuf+39,x
dex
bpl cmvparnt
lda h_entln lastly, the length of parent's
sta gbuf+42 directory entries.
cralcblk jsr alc1blk get address of file's data block
bcs crerr3
sta d_frst
sty d_frst+1
sta bloknml
sty bloknml+1
jsr wrtgbuf go write data block of file
bcs crerr3
inc h_fcnt add 1 to total # of files in this dir
bne credone
inc h_fcnt+1
credone jsr drevise go revise directories with new file
bcs crerr3
jmp upbmap lastly, update volume bitmap
entcalc lda /gbuf set high address of dir entry
sta zpt+1 index pointer.
lda #$04 calc address of entry based
ldx d_entnum on the entry #.
H3689 clc
H368A dex addr = gbuf + ((d_entnum-1) * h_entln)
beq H3696 branch with carry clear = no errors.
adc h_entln
bcc H368A
inc zpt+1 inc hi address.
bcs H3689 always.
H3696 sta zpt newly calculated low address.
crerr3 rts carry set if error.
drevise lda p8date
beq drevise1 if no clock, then don't mod date/time.
ldx #$03
modtime lda p8date,x move last modification date/time
sta d_moddt,x to entry being updated.
dex
bpl modtime
drevise1 lda d_attr mark entry as backupable
ora bkbitflg (bit 5 = backup needed)
sta d_attr
lda d_dev get device # of directory
sta devnum to be revised
lda d_entblk and address of direcotry block.
ldx d_entblk+1
jsr rdblk read block into general purpose buffer
bcs crerr3
jsr entcalc fix up ptr to entry location within gbuf.
ldy h_entln now move 'd.' info to directory.
dey
H36CA lda d_stor,y
sta (zpt),y
dey
bpl H36CA
lda d_head is the entry block same as
cmp bloknml the entry's header block?
bne H36E0 if no, go save entry block
lda d_head+1 then maybe, so test high addresses.
cmp bloknml+1
beq uphead branch if they are the same block.
H36E0 jsr wrtgbuf go write updated directory block.
bcs crerr3
lda d_head get address of header block and
ldx d_head+1
jsr rdblk go read in header block to modify.
bcs crerr3
uphead ldy #$01 update current # of files in this dir.
H36F2 lda h_fcnt,y
sta gbuf+37,y (current entry count)
dey
bpl H36F2
lda h_attr also update header's attributes.
sta gbuf+34
jsr wrtgbuf go write updated header
bcs H375A
ripple lda gbuf+4 test for 'root' directory because
and #$F0 if it is, then directory revision
eor #$F0 is complete (leaves carry clear).
beq H3770 branch if done.
lda gbuf+41 get entry #
sta d_entnum
lda gbuf+42 and the length of ertries in that dir
sta h_entln
lda gbuf+39 get addr of parent entry's dir block
ldx gbuf+40
jsr rdblk read it
bcs H375A
jsr entcalc get indirect ptr to parent entry in gbuf
lda p8date don't touch mod
beq H373B if no clock...
ldx #$03 update the modification date & time
ldy #$24 for this entry too
H3732 lda p8date,x
sta (zpt),y
dey
dex
bpl H3732
H373B jsr wrtgbuf write updated entry back to disk.
bcs H375A if error.
ldy #$25 compare current block # to this
lda (zpt),y entry's header block.
iny
cmp bloknml are low addresses the same?
sta bloknml
bne H3751 branch if entry doesn't reside in same
lda (zpt),y block as header.
cmp bloknml+1 are high address the same?
beq ripple they are the same, continue to root dir.
H3751 lda (zpt),y not same so read in this dir's header.
sta bloknml+1
jsr rdgbuf
bcc ripple continue if read was good
H375A rts
tsterr lda #$52 not tree or dir, unrecognized type
sec
rts
tstsos lda gbuf pointer to previous dir block
ora gbuf+1 must be null
bne tsterr
lda gbuf+4 test for header
and #$E0
cmp #$E0
bne tsterr
H3770 clc no error
rts
*--------------------------------------
MAN
SAVE USR/SRC/PRODOS.FX/PRODOS.S.XDOS.A
LOAD USR/SRC/PRODOS.FX/PRODOS.S

451
ProDOS.FX/ProDOS.S.XDOS.B.txt
View File

@ -1,341 +1,72 @@
NEW
AUTO 3,1
* create file
create jsr lookfile check for duplicate, get free entry
bcs tstfnf error code may be 'file not found'
lda #MLI.E.DUPFILE name already exists
crerr1 sec
rts
tstfnf cmp #MLI.E.FNOTFND 'file not found' is ok
bne crerr1 otherwise exit with error.
ldy #$07 test for tree or directory file,
lda (A3L),y no other kinds are legal.
cmp #$04 is it seed, sapling or tree?
bcc tstdspc branch if it is
cmp #$0D
bne ctyperr report type error if not directory.
tstdspc lda devnum make sure destination device
jsr twrprot1 is not write protected.
bcs H351D
lda nofree is there space in directory to
beq xtndir add this file? branch if not
jmp creat1 otherwise, go create file.
ctyperr lda #MLI.E.UNSUPST filetype error
sec
H351D rts
xtndir lda own_blk before extending directory,
ora own_blk+1 make sure it's a subdirectory.
bne H352A
lda #MLI.E.DIRFULL otherwise, directory full error
sec
rts
H352A lda bloknml preserve disk address of current (last)
pha directory link, before allocating an
lda bloknml+1 extended block.
pha
jsr alc1blk allocate a block for extending directory
plx
stx bloknml+1 restore block addr of dir info in gbuf
plx
stx bloknml
bcs H351D unable to allocate.
sta gbuf+2 save block address in y,a to
sty gbuf+3 current directory.
jsr wrtgbuf update directory block with new link.
bcs H351D if error
ldx #$01
swpbloks lda bloknml,x prepare new directory block
sta gbuf,x using current block as back link
lda gbuf+2,x
sta bloknml,x and save new block as next to be written
dex
bpl swpbloks
inx
txa x and a = 0
clrdir sta gbuf+2,x
sta gbuf+$100,x
inx
bne clrdir
jsr wrtgbuf write prepared directory extension.
bcs H351D if error
lda own_blk
ldx own_blk+1
jsr rdblk read in parent directory block
ldx own_ent and calc entry address.
lda /gbuf
sta zpt+1
lda #$04
ocalc clc
dex has entry address been calulated?
beq H3584 if yes.
adc own_len next entry address
bcc ocalc
inc zpt+1 entry must be in 2nd 256 bytes of block
bcs ocalc always taken.
H3584 sta zpt
ldy #$13 index to block count
H3588 lda (zpt),y
adc dinctbl-$13,y add 1 to block count and
sta (zpt),y
iny
tya $200 to the directory's eof.
eor #$18 done with usage/eof update?
bne H3588 branch if not.
jsr wrtgbuf go update parent.
bcs crerr2
jmp create
crerr2 rts return and report errors
creat1 ldx #$00 zero out gbuf
H35A0 stz gbuf,x
stz gbuf+$100,x and data block of file.
inx
bne H35A0
ldy #$0B move user specified date/time
cmvtime lda (A3L),y to directory.
sta d_filid,y
txa if all 4 bytes of date/time = 0
ora (A3L),y then use built-in date/time.
tax
dey
cpy #$07
bne cmvtime
txa does user want default time?
bne cmvname if not.
ldx #$03
mvdftime lda p8date,x move current default date/time
sta d_credt,x
dex
bpl mvdftime
cmvname lda (A3L),y y = index to file kind.
cmp #$04
lda #$10 assume tree type
bcc csvfkind
lda #$D0 it's directory.
csvfkind ldx namptr index to local name of pathname.
ora pathbuf,x combine file kind with name length.
sta d_stor sos calls this 'storage type'.
and #$0F strip back to name length
tay and use as counter for move.
clc
adc namptr calc end of name
tax
crname lda pathbuf,x move local name as filename
sta d_stor,y
dex
dey
bne crname
ldy #$03 index to 'access' parameter
lda (A3L),y
sta d_attr
iny also move 'file identification'
lda (A3L),y
sta d_filid
cmvauxid iny move auxillary identification bytes
lda (A3L),y
sta d_auxid-5,y
cpy #$06
bne cmvauxid
lda xdosver save current xdos version #
sta d_sosver
lda compat and backward compatibility #
sta d_comp
lda #$01 usage is always 1 block
sta d_usage
lda d_head place back pointer to header block
sta d_dhdr
lda d_head+1
sta d_dhdr+1
lda d_stor storage type.
and #$E0 is it a directory?
beq cralcblk branch if seed file.
ldx #$1E move header to data block
cmvheadr lda d_stor,x
sta gbuf+4,x
dex
bpl cmvheadr
eor #$30
sta gbuf+4 make it a directory header mark.
ldx #$07 overwrite password area and other
cmvpass lda pass,x header info.
sta gbuf+20,x
lda xdosver,x
sta gbuf+32,x
dex
bpl cmvpass
ldx #$02 and include info about parent directory
stx d_eof+1
cmvparnt lda d_entblk,x
sta gbuf+39,x
dex
bpl cmvparnt
lda h_entln lastly, the length of parent's
sta gbuf+42 directory entries.
cralcblk jsr alc1blk get address of file's data block
bcs crerr3
sta d_frst
sty d_frst+1
sta bloknml
sty bloknml+1
jsr wrtgbuf go write data block of file
bcs crerr3
inc h_fcnt add 1 to total # of files in this dir
bne credone
inc h_fcnt+1
credone jsr drevise go revise directories with new file
bcs crerr3
jmp upbmap lastly, update volume bitmap
entcalc lda /gbuf set high address of dir entry
sta zpt+1 index pointer.
lda #$04 calc address of entry based
ldx d_entnum on the entry #.
H3689 clc
H368A dex addr = gbuf + ((d_entnum-1) * h_entln)
beq H3696 branch with carry clear = no errors.
adc h_entln
bcc H368A
inc zpt+1 inc hi address.
bcs H3689 always.
H3696 sta zpt newly calculated low address.
crerr3 rts carry set if error.
drevise lda p8date
beq drevise1 if no clock, then don't mod date/time.
ldx #$03
modtime lda p8date,x move last modification date/time
sta d_moddt,x to entry being updated.
dex
bpl modtime
drevise1 lda d_attr mark entry as backupable
ora bkbitflg (bit 5 = backup needed)
sta d_attr
lda d_dev get device # of directory
sta devnum to be revised
lda d_entblk and address of direcotry block.
ldx d_entblk+1
jsr rdblk read block into general purpose buffer
bcs crerr3
jsr entcalc fix up ptr to entry location within gbuf.
ldy h_entln now move 'd.' info to directory.
dey
H36CA lda d_stor,y
sta (zpt),y
dey
bpl H36CA
lda d_head is the entry block same as
cmp bloknml the entry's header block?
bne H36E0 if no, go save entry block
lda d_head+1 then maybe, so test high addresses.
cmp bloknml+1
beq uphead branch if they are the same block.
H36E0 jsr wrtgbuf go write updated directory block.
bcs crerr3
lda d_head get address of header block and
ldx d_head+1
jsr rdblk go read in header block to modify.
bcs crerr3
uphead ldy #$01 update current # of files in this dir.
H36F2 lda h_fcnt,y
sta gbuf+37,y (current entry count)
dey
bpl H36F2
lda h_attr also update header's attributes.
sta gbuf+34
jsr wrtgbuf go write updated header
bcs H375A
ripple lda gbuf+4 test for 'root' directory because
and #$F0 if it is, then directory revision
eor #$F0 is complete (leaves carry clear).
beq H3770 branch if done.
lda gbuf+41 get entry #
sta d_entnum
lda gbuf+42 and the length of ertries in that dir
sta h_entln
lda gbuf+39 get addr of parent entry's dir block
ldx gbuf+40
jsr rdblk read it
bcs H375A
jsr entcalc get indirect ptr to parent entry in gbuf
lda p8date don't touch mod
beq H373B if no clock...
ldx #$03 update the modification date & time
ldy #$24 for this entry too
H3732 lda p8date,x
sta (zpt),y
dey
dex
bpl H3732
H373B jsr wrtgbuf write updated entry back to disk.
bcs H375A if error.
ldy #$25 compare current block # to this
lda (zpt),y entry's header block.
iny
cmp bloknml are low addresses the same?
sta bloknml
bne H3751 branch if entry doesn't reside in same
lda (zpt),y block as header.
cmp bloknml+1 are high address the same?
beq ripple they are the same, continue to root dir.
H3751 lda (zpt),y not same so read in this dir's header.
sta bloknml+1
jsr rdgbuf
bcc ripple continue if read was good
H375A rts
tsterr lda #$52 not tree or dir, unrecognized type
sec
rts
tstsos lda gbuf pointer to previous dir block
ora gbuf+1 must be null
bne tsterr
lda gbuf+4 test for header
and #$E0
cmp #$E0
bne tsterr
H3770 clc no error
rts
*--------------------------------------
findfile jsr lookfile see if file exists
bcs nofind
moventry ldy h_entln
H377A lda (zpt),y move entry into storage
sta d_stor,y
dey
bpl H377A
lda #$00 no errors
nofind rts
moventry ldy h_entln Get FileInfo From Directory Block Buffer
.1 dey
lda (zpt),y move entry into storage
sta d_stor,y
tya
bne .1
.DO LOWERCASE=1
lda d_stor
and #$F0
cmp #$F0
beq .8
bit d_sosver
bpl .8 no lowercase bitmap
lda d_stor
and #$0F
tax
beq .8 deleted entry
ldy #0
.2 iny
lda whichbit,y
bit d_sosver
beq .3
lda d_stor,y
jsr XDOS.ToLower
sta d_stor,y
.3 dex
beq .8
cpy #7
bne .2
.4 iny
lda whichbit-8,y
bit d_comp
beq .5
lda d_stor,y
jsr XDOS.ToLower
sta d_stor,y
.5 iny
dex
bne .4
.FIN
.8 lda #$00 no errors
clc
nofind rts
*--------------------------------------
lookfile jsr preproot go find volume
bcs fnderr
bne lookfil0 branch if more than root
lda /gbuf otherwise, report a bad path error
sta zpt+1 (but 1st create a phantom entry
lda #$04 for open)
@ -354,29 +85,37 @@ phantm2 lda rootstuf-$10,y
dey
cpy #$0F
bne phantm2
lda #$D0 fake directory file
sta d_stor
lda gbuf+2 check forward link.
ora gbuf+3 if non-zero, assume full sized directory
bne H37C2 else assume it's the slot 3 /RAM volume
lda #$02 so reset eof and blocks_used fields
sta d_eof+1
lda #$01
sta d_usage
H37C2 lda #MLI.E.INVPATH bad path (carry set)
rts
lookfil0 stz nofree reset free entry indicator.
sec dir to be searched has header in this block.
L37C9 stz totent reset entry counter.
jsr looknam look for name pointed to by pnptr.
bcc namfound if name was found.
lda entcntl have we looked at all of the
sbc totent entries in this directory?
bcc L37E2 maybe, check hi count.
bne L37EB no, read next directory block.
cmp entcnth has the last entry been looked at?
beq errfnf yes, give 'file not found' error
bne L37EB or branch always.
L37E2 dec entcnth should be at least one
bpl L37EB so this should be branch always...
@ -395,18 +134,21 @@ L37FC ldx gbuf+3 acc has value for block# (low).
jsr rdblk go read the next linked directory.
bcc L37C9 if no error.
rts return error in acc.
errfnf lda nofree was any free entry found?
bne fnf0
lda gbuf+2 test link
bne L3814
cmp gbuf+3 if both are 0 then give up.
beq fnf0 report 'not found'.
L3814 sta d_entblk
lda gbuf+3
sta d_entblk+1 assume 1st entry of next block
lda #$01 is free for use.
sta d_entnum mark as valid (for create)
sta nofree
fnf0 jsr nxtpnam1 'file not found' or 'path not found'?
errpath1 sec if non-zero then 'path not found'
beq fnf1
@ -416,14 +158,16 @@ errpath1 sec if non-zero then 'path not found'
fnf1 lda #MLI.E.FNOTFND file not found
rts
*--------------------------------------
namfound jsr nxtpname adj index to next name in path.
beq filfound branch if that was the last name.
ldy #$00 be sure this is a directory entry.
lda (zpt),y high nibble will tell.
and #$F0
cmp #$D0 is it a subdirectory?
bne errpath1 error if not.
ldy #$11 get address of 1st subdirectory block
lda (zpt),y
sta bloknml (no checking done for a valid block#)
@ -443,15 +187,18 @@ namfound jsr nxtpname adj index to next name in path.
sec
rol
L3869 bcc L386C
inx
L386C asl
bne L3869
cpx #$05 is password disabled?
beq movhead
lda #MLI.E.INCFF directory is not compatible
fnderr1 sec
rts
movhead jsr movhed0 move directory info.
jmp lookfil0 do next local pathname.
@ -470,7 +217,7 @@ L3893 lda gbuf+39,x this header.
dex
bpl L3893
L389C rts
*--------------------------------------
filfound lda h_maxent figure out which entry # this is
sec
sbc cntent max entries - count entries + 1
@ -482,13 +229,17 @@ filfound lda h_maxent figure out which entry # this is
sta d_entblk+1
clc
rts
looknam lda h_maxent reset count of files per block
sta cntent
lda /gbuf
sta zpt+1
lda #$04
L38C1 sta zpt reset indirect pointer to gbuf
bcs L38F8 branch if this block contains a header
ldy #$00
lda (zpt),y get length of name in directory.
bne isname branch if there is a name.
@ -498,21 +249,37 @@ L38C1 sta zpt reset indirect pointer to gbuf
inc nofree indicate a free spot has been found.
bne L38F8 always.
isname and #$0F strip byte (is checked by 'filfound')
inc totent inc count of valid files found.
sta namcnt save name length as counter.
ldx namptr get index to current path.
cmp pathbuf,x are both names the same length?
bne L38F8 no, inc to next entry.
cmpname inx (first) next letter index
iny
.DO LOWERCASE=0
lda (zpt),y compare names letter by letter
cmp pathbuf,x
.ELSE
lda pathbuf,x
jsr XDOS.ToUpper
cmp (zpt),y compare names letter by letter
.FIN
bne L38F8
dec namcnt all letters compared?
bne cmpname no, continue.
.DO LOWERCASEMATCH=1
.FIN
clc a match is found.
noname rts
L38F8 dec cntent checked all entries in this block?
sec
beq noname yes, no name match.
@ -520,6 +287,7 @@ L38F8 dec cntent checked all entries in this block?
clc
adc zpt
bcc L38C1 branch if still in 1st page.
inc zpt+1 look on 2nd page.
clc carry should always be clear before
bcc L38C1 looking at next.
@ -548,21 +316,25 @@ L3929 lda vcbbuf+18,x misc info includes
dex
dey
bpl L3929
nxtpname jsr nxtpnam1 get new namptr in y and namlen in acc.
sty namptr save new pathname pointer.
rts (status reg according to accumulator)
nxtpnam1 ldy namptr inc pathname pointer to next name
lda pathbuf,y in the path.
sec
adc namptr if this addition results in zero,
tay then prefixed directory has been moved
bne L395F to another device. branch if not.
lda devnum revise devnum for prefixed directory
sta p_dev
L395F lda pathbuf,y test for end of name.
clc no errors
novolume rts
*--------------------------------------
findvol lda #$00
ldy preflag use prefix volume name to look up vcb.
bit prfxflg is this a prefixed path?
@ -580,14 +352,21 @@ L397C ldy vnptr restore pointer to requested vol name.
adc #$20
bcc L3975 branch if more vcb's to check
bcs L39D4 otherwise go look for unlogged volumes.
L3987 sta namcnt save length of vol name to be compared.
L398A cmp pathbuf,y is it the same as requested vol name?
bne L397C branch if not
inx
iny next character
lda vcbbuf,x
dec namcnt last character?
bpl L398A if not.
.DO LOWERCASEMATCH=1
.FIN
plx restore pointer to matching vcb.
stx vcbptr save it for future reference.
lda vcbbuf+16,x get it's device #
@ -596,12 +375,14 @@ L398A cmp pathbuf,y is it the same as requested vol name?
lda #$02 that root directory is to be used.
sta bloknml
lda vnptr = 0 if no prefix.
L39AC tay if prefix then find ptr to prefixed
sta namptr dir name. save path ptr.
beq L39C2 branch if no prefix.
sec
adc pathbuf,y inc to next dir in prefix path.
bcc L39AC branch if another dir in prefix.
lda p_blok volume verification will occur at
sta bloknml subdirectory level.
lda p_blok+1
@ -654,6 +435,7 @@ L3A16 lda #$02 go read root dir into gbuf
jsr cmppnam is this the volume ?
bcs L39E2 if not
L3A29 rts
*--------------------------------------
mvdevnums ldx DEVCNT copy all dev #'s to be checked.
L3A2D lda DEVLST,x active device list.
and #$F0 strip device type info.
@ -715,6 +497,9 @@ L3A95 cmp pathbuf,y
dec namcnt
bpl L3A92 if more to compare.
.DO LOWERCASEMATCH=1
.FIN
clc match found
rts
@ -784,6 +569,7 @@ L3B1E sec anticipate different names.
clc indicate match.
L3B26 ldx xvcbptr offset to start of vcb (rev note #23)
rts
tstdupvol lda #$00 check for other logged in volumes with the same name.
L3B2C tax
jsr cmpvcb
@ -894,6 +680,7 @@ L3C0B tya
lsr
lsr
rts
*--------------------------------------
MAN
SAVE USR/SRC/PRODOS.FX/PRODOS.S.XDOS.B
LOAD USR/SRC/PRODOS.FX/PRODOS.S

36
ProDOS.FX/ProDOS.S.XDOS.C.txt
View File

@ -432,7 +432,8 @@ clrstats ldy fcbptr clear allocation states for data block
rts or unnecessary for current position.
dirmark cmp #$0D is it a directory ?
beq L3F9C yes...
lda #$4A no, so compatability problem.
lda #MLI.E.INCFF no, so compatability problem.
jsr GP.P8errv should not have been opened !!!
L3F9C lda scrtch recover results of previous subtraction.
@ -560,40 +561,52 @@ 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.
*--------------------------------------
XDOS.Open jsr findfile look up the file.
bcc L40A0 if ok.
cmp #$40 is this opening a root directory ?
cmp #MLI.E.INVPATH 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.
L40A5 lda #MLI.E.OPEN file is busy, shared access not allowed.
L40A7 sec
rts
L40A9 lda #$4B file is wrong storage type.
L40A9 lda #MLI.E.UNSUPST 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.
lda #MLI.E.FCBFULL fcb full error.
sec
rts
L40B9 ldx #$1F assign fcb,
lda #$00 but clean it first.
L40BD sta fcbbuf,y
lda #0
L40BD sta fcbbuf,y but clean it first.
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.
@ -609,13 +622,18 @@ L40CB lda d_dev-1,x move ownership info.
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

101
ProDOS.FX/ProDOS.S.XDOS.E.txt
View File

@ -1,9 +1,7 @@
NEW
AUTO 3,1
* close command
closef ldy #$01 close all ?
*--------------------------------------
XDOS.Close ldy #$01 close all ?
lda (A3L),y
bne L4683 no, just one of them.
sta cferr clear global close error.
@ -51,10 +49,8 @@ close2 ldy fcbptr
L46B4 clc
rts
L46B6 bcs L46E6 don't report close all error now.
* flush command
flushf ldy #$01 flush all ?
*--------------------------------------
XDOS.Flush ldy #$01 flush all ?
lda (A3L),y
bne flush1 no, just one of them.
sta cferr clear global flush error.
@ -125,7 +121,9 @@ 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
@ -374,12 +372,15 @@ newline ldy #$02 adjust newline status for open file.
sta fcbbuf+10,x
clc no error possible
rts
getinfo jsr findfile look for file.
*--------------------------------------
XDOS.GetFileInfo
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.
@ -402,13 +403,16 @@ getinfo jsr findfile look for file.
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
@ -417,90 +421,125 @@ L4994 lda inftabl-3,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.
L49A4 rts
*--------------------------------------
XDOS.SetFileInfo
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.
*--------------------------------------
XDOS.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.
bra 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.
.DO LOWERCASE=1
.FIN
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
@ -508,6 +547,7 @@ L4A52 ldy rnptr index to last name in the chain.
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
@ -515,48 +555,62 @@ L4A52 ldy rnptr index to last name in the chain.
tax
lda gbuf,x this byte should also be $00.
beq L4A76 if so, continue processing.
L4A72 lda #$40 bad pathname error.
L4A72 lda #MLI.E.INVPATH 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.
lda #MLI.E.DUPFILE duplicate name error.
sec
rts
L4A7F cmp #$46 was it a valid file not found ?
L4A7F cmp #MLI.E.FNOTFND 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.
lda #MLI.E.OPEN 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.
lda #MLI.E.LOCKED 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.
lda #MLI.E.INCFF 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
@ -564,15 +618,19 @@ L4ABE lda pathbuf,y move local name to dir entry workspace.
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
@ -582,6 +640,7 @@ L4AF5 sta gbuf+4,x
lda pathbuf,y
bne L4AF5
jmp wrtgbuf write changed header block.
renpath ldy #$03 get address to new pathname
lda (A3L),y
iny

107
ProDOS.FX/ProDOS.S.XDOS.F.txt
View File

@ -1,17 +1,21 @@
NEW
AUTO 3,1
*--------------------------------------
destroy jsr findfile look for file to be destroyed.
XDOS.Destroy 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 ?
cmp #MLI.E.VOLFULL 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.
@ -21,6 +25,7 @@ L4B39 lda d_attr make sure ok to destroy file.
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
@ -30,31 +35,39 @@ L4B45 lda devnum last device used.
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.
L4B64 lda #MLI.E.OPEN 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
@ -63,8 +76,10 @@ L4BA1 dec h_fcnt mark header with one less file.
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 ldy vcbptr update block free count in vcb. point to vcb of correct device.
lda deblock get # of blocks recently freed.
adc vcbbuf+20,y
@ -75,31 +90,41 @@ dvcbrev ldy vcbptr update block free count in vcb. point to vcb of correct
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.
L4BF1 lda #MLI.E.LOCKED access error.
jsr GP.P8errv
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
@ -107,6 +132,7 @@ L4C0A jsr dealloc free this block.
jsr rdblk
bcc L4BFE loop until all freed
L4C1A rts
L4C1B lda #MLI.E.INCFF file incompatible
jsr GP.P8errv
@ -415,11 +441,11 @@ L4E43 dex drop to next lower page.
bne L4E43 no.
L4E54 clc no error.
rts
*--------------------------------------
* calculate memory allocation bit position.
* on entry: x = high address of buffer, low address assumed zero.
* on exit: acc = allocation bit mask, x = unchanged, y = pointer to memtabl byte
*--------------------------------------
cmembit txa page address
and #$07 which page in any 2k set ?
tay use as index to determine
@ -432,6 +458,7 @@ cmembit txa page address
tay return it in y.
pla restore bit mask. return bit position
rts in a & y, pointer to memtabl in x.
valdbuf lda usrbuf+1 high address of user's buffer
cmp #$02 must be greater than page 2.
bcc L4E1E report bad buffer
@ -484,9 +511,52 @@ L4EB8 lda (usrbuf),y move all 4 pages of the buffer to
inc usrbuf+1
dex
bpl L4EB8
cmembit.CLCRTS
clc no errors
L4EC7 rts
*--------------------------------------
XDOS.IsValidChar
cmp #'0'
bcc XDOS.IsValidFirstChar
cmp #'9'+1
bcc XDOS.IsValidFirstChar.RTS
XDOS.IsValidFirstChar
.DO ENHFILENAME=1
cmp #'.'
beq cmembit.CLCRTS
cmp #'_'
beq cmembit.CLCRTS
.FIN
cmp #'A'
bcc XDOS.IsValidFirstChar.SEC
cmp #'Z'+1
.DO LOWERCASE=1
bcc XDOS.IsValidFirstChar.RTS
cmp #'a'
bcc XDOS.IsValidFirstChar.SEC
cmp #'z'+1
.FIN
XDOS.IsValidFirstChar.RTS
rts
XDOS.IsValidFirstChar.SEC
sec
rts
*--------------------------------------
XDOS.ToUpper cmp #'a'
bcc .8
cmp #'z'+1
bcs .8
eor #$20
.8 rts
*--------------------------------------
XDOS.ToLower cmp #'A'
bcc .8
cmp #'Z'+1
bcs .8
eor #$20
.8 rts
*--------------------------------------
* move 3 pages of dispatcher from 'displc2' to 'dispadr'
* this move routine must be resident above $E000 at all times
*--------------------------------------
@ -608,20 +678,21 @@ pcntbl .HS 02FFFFFF parameter counts for the calls
.HS 04070102070A0201
.HS 0103030404010102
.HS 02FF020202
cmdtable .DA create
.DA destroy
.DA rename
.DA setinfo
.DA getinfo
.DA online
.DA setprefx
.DA getprefx
.DA openf
cmdtable .DA XDOS.Create
.DA XDOS.Destroy
.DA XDOS.Rename
.DA XDOS.SetFileInfo
.DA XDOS.GetFileInfo
.DA XDOS.Online
.DA XDOS.SetPrefix
.DA XDOS.GetPrefix
.DA XDOS.Open
.DA newline
.DA readf
.DA writef
.DA closef
.DA flushf
.DA XDOS.Close
.DA XDOS.Flush
.DA setmark
.DA getmark
.DA seteof
@ -659,6 +730,7 @@ XDOS.DATA .DUMMY
own_blk .HS 0000
own_ent .HS 00
own_len .HS 00
h_credt .HS 0000 directory creation date
.HS 0000 directory creation time
.HS 00 version under which this dir created
@ -669,6 +741,7 @@ h_maxent .HS 00 maximum number of entries per block
h_fcnt .HS 0000 current # of files in this directory
h_bmap .HS 0000 address of first allocation bitmap
h_tblk .HS 0000 total number of blocks on this unit
d_dev .HS 00 device number of this directory entry
d_head .HS 0000 address of <sub> directory header
d_entblk .HS 0000 address of block which contains entry

19
ProDOS.FX/ProDOS.S.XRW.txt
View File

@ -1,8 +1,6 @@
NEW
AUTO 3,1
*--------------------------------------
FASTSEEK .EQ 0
*--------------------------------------
XRW.START cld $D8 to flag language card bank 1 (main)
jsr rsetphse
lda q7l,x turn off write enable
@ -10,14 +8,19 @@ XRW.START cld $D8 to flag language card bank 1 (main)
nop
jsr docheck
bcs L5334 branch if block # is out of range
ldy #$05
L5310 asl
rol ibtrk
dey
bne L5310
asl
bcc L531C
ora #$10 adjust for upper 4 bits of track
L531C lsr
lsr
lsr
@ -26,12 +29,16 @@ L531C lsr
jsr regrwts
pla
bcs L5330 if error
inc buf+1
adc #$02
jsr regrwts get 2nd half of block
dec buf+1
L5330 lda ibstat
rts
L5334 lda #MLI.E.IO
sec
rts
@ -859,12 +866,14 @@ prn3 lda $10AC,y warning: self modified. get byte from highest group.
sta nbuf2,x save in nibl buffer.
iny inc to next set.
bne prn1 loop until all $56 nibls formed.
ldy buf now prepare data bytes for write16 subr.
dey prepare end address.
sty A2H
lda buf
sta wrefd1+1 warning: the following storage addresses
beq L595F starting with 'wref' are refs into code
eor #$FF space, changed by this routine.
tay index to last byte of page in (buf).
lda (buf),y pre-niblize the last byte of the page
@ -873,9 +882,11 @@ prn3 lda $10AC,y warning: self modified. get byte from highest group.
and #$FC
tax
lda nibl,x get disk 7-bit nible equivalent.
L595F sta pch
beq L596F branch if data to be written is page
lda A2H aligned. check if last byte is even
beq L596F branch if data to be written is page aligned.
lda A2H check if last byte is even
lsr or odd address. shift even/odd -> carry.
lda (buf),y if even, then leave intact.
bcc L596D branch if odd.

17
ProDOS.FX/ProDOS.S.txt
View File

@ -4,6 +4,12 @@ NEW
.OP 65816
.OR $2000
.TF PRODOS.FX,TSYS
*--------------------------------------
ENHFILENAME .EQ 1
LOWERCASE .EQ 1
LOWERCASEMATCH .EQ 0
FASTSEEK .EQ 0
FASTWRITE .EQ 0
*--------------------------------------
.INB INC/ZP.I
.INB INC/IO.I
@ -113,15 +119,10 @@ txtp2 .EQ $0400 test location for aux card
vmode .EQ $04FB video firmware operating mode
ch80col .EQ $057B 80 column ch position
vline5 .EQ $0600 line 5 of display
vline10 .EQ $04A8 line 10 of display
vline11 .EQ $0528 line 11 of display
vline12 .EQ $05A8 line 12 of display
vline13 .EQ $0628 line 13 of display
vline14 .EQ $06A8 line 14 of display
vline16 .EQ $07A8 line 16 of display
vline23 .EQ $0750 line 23 of display
vline24 .EQ $07D0 line 24 of display
dbuf .EQ $0C00 8 page directory buffer
vblock1 .EQ $0E00 ramdisk directory block
@ -163,6 +164,12 @@ ZPBLLenBits .BS 1
.ED
*--------------------------------------
.INB USR/SRC/PRODOS.FX/PRODOS.S.LDR
X.Unpak.XatYA sty ZPOutBufPtr
sta ZPOutBufPtr+1
lda PAKME.Table,x
sta ZPInBufPtr
lda PAKME.Table+1,x
sta ZPInBufPtr+1
.INB USR/SRC/SHARED/X.UNPAK.S
*--------------------------------------
PAKME.Table

2
SYS/KM.RAMWORKS.S.txt
View File

@ -3,7 +3,7 @@ NEW
.LIST OFF
.OP 65C02
.OR $2000
.TF SYS/KM.RAMWORKS
.TF SYS/KM/KM.RAMWORKS
*--------------------------------------
.INB INC/MACROS.I
.INB INC/IO.I