Apple-2-SW
/
A2osX
mirror of https://github.com/A2osX/A2osX.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity
A2osX/ProDOS.FX/ProDOS.S.XDOS.A.txt

1121 lines
27 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
*--------------------------------------
FCB.MAX .EQ 8
FCB.ID .EQ 0
FCB.DEVID .EQ 1 XDOS.DE.DevID -> XDOS.DE.DevID+5
FCB.DIRHBLK .EQ 2 2 bytes
FCB.DIREBLK .EQ 4 2 bytes
FCB.DIRENUM .EQ 6
FCB.STYPE .EQ 7
FCB.F .EQ 8
FCB.F.STMOD .EQ %00001000
FCB.F.UMOD .EQ %00010000
FCB.F.DBLKMOD .EQ %01000000
FCB.F.IBLKMOD .EQ %10000000
FCB.ACCESS .EQ 9
FCB.NLBYTE .EQ 10
FCB.BUFID .EQ 11
FCB.1stBLK .EQ 12 2 bytes
FCB.IBLK .EQ 14 2 bytes
FCB.DBLK .EQ 16 2 bytes
FCB.MARK .EQ 18 3 bytes
FCB.EOF .EQ 21 3 bytes
FCB.UBLK .EQ 24 2 bytes
FCB.FLEVEL .EQ 27
FCB.DIRTY .EQ 28
FCB.NLMASK .EQ 31
*
FCB .EQ 32
*--------------------------------------
VCB.DEV .EQ 16
VCB.OFCNT .EQ 17
VCB.BMAP .EQ 18 2 bytes
VCB.TBLK .EQ 20 2 bytes
VCB.FBLK .EQ 22 2 bytes
VCB.BMAPIDX .EQ 24
*
VCB .EQ 25
*--------------------------------------
XDOS.VCBPtr .EQ XDOS.VCBs+0
XDOS.VCBDupFlag .EQ XDOS.VCBs+1
XDOS.VCBDupEnt .EQ XDOS.VCBs+2
bmcnt .EQ XDOS.VCBs+3
bmptr .EQ XDOS.VCBs+4
basval .EQ XDOS.VCBs+5
XDOS.VCB0 .EQ XDOS.VCBs+6 range $D906-$DA00
*--------------------------------------
* ZERO Page
*--------------------------------------
zpt .EQ $48 highly used zero page index pointer
ZP.DataPtr .EQ $4A ptr to data area of buffer.
sos .EQ $4C sos buffer pointer.
ZP.UserBuf .EQ $4E data ptr in user buffer.
*--------------------------------------
XDOS.START .PH XDOS
.DO AUXLC=0
XDOS.MAIN cld no decimal.
sty GP.MLIY save x and y
stx GP.MLIX
ply get processor status
pla find out the address of the caller
sta ZP.A3L
clc preserve the address of the call spec.
adc #$04
sta GP.MLIRTN last MLI call return address
pla
sta ZP.A3L+1
adc #$00
sta GP.MLIRTN+1
phy pull processor status
.ELSE
XDOS.AUX cld
bit IO.RRAMWRAMBNK1
sty GP.BNKBYT2
stx GP.MLIEXIT.X+1
tsx
stx $100
ldx $101
txs
sec
ror GP.MLIACTV
pha
lda GP.MLIEXIT.PCL+1
sta ZP.A3L
clc
adc #$04
sta GP.MLIEXIT.PCL+1
lda GP.MLIEXIT.PCH+1
sta ZP.A3L+1
adc #$00
sta GP.MLIEXIT.PCH+1
.FIN
*--------------------------------------
plp to re-enable interrupts.
cld still no decimal
stz GP.ERROR clear any previous errors.
ldy #$01 find out if command is valid.
lda (ZP.A3L),y get command #
lsr and hash it to a range of 0-$1F
lsr
lsr
lsr
clc
adc (ZP.A3L),y
and #$1F
tax
lda (ZP.A3L),y check result to see if valid command #
cmp XDOS.CmdNums,x
bne XDOS.BadCall
iny index to call spec parm list.
lda (ZP.A3L),y make A3L point to parameter count byte
pha in parameter block.
iny
lda (ZP.A3L),y
sta ZP.A3L+1
pla
sta ZP.A3L
lda XDOS.ParamCnt,x make sure parameter list has the correct # of parameters.
beq .2 clock has 0 parameters.
cmp (ZP.A3L)
bne XDOS.BadCnt error if wrong count.
lda XDOS.CmdNums,x get call # again
cmp #MLI.QUIT is it quit?
beq .1 if so, then call quit dispatcher
asl carry set if BFMgr or DevMgr
bpl .3
bcs .4
lsr shift back down for interrupt manager
and #$03 valid calls are 0 and 1
jsr XDOS.IntMgr
bra XDOS.Exit
.1 jmp GP.DISPATCH P8 system death vector
.2 jsr GP.CLOCK go read clock.
bra XDOS.Exit no errors possible
.3 lsr shift back down for device manager.
adc #$01 valid commands are 1 and 2.
sta ZP.CMDNUM
jsr XDOS.DevMgr execute read or write request.
bra XDOS.Exit
.4 lsr shift back down for block file manager.
and #$1F valid commands are 0-$13
tax
jsr XDOS.BFMgr
*--------------------------------------
XDOS.Exit stz GP.BUBIT clear backup bit
ldy GP.ERROR P8 error code
cpy #$01 if > 0 then set C
tya and set Z
php disable interrupts until exit complete.
sei
lsr GP.MLIACTV indicate MLI done.
ply Get status register until return.
* Y = Status register
* A = MLI Error code
.DO AUXLC=0
ldx GP.MLIRTN+1 place last MLI call return address
phx on stack. return is done via 'rti'
ldx GP.MLIRTN so the status register is restored
phx at the same time, so
phy place status back on stack
pha Push return error, if any.
ldx GP.MLIX MLI X register savearea
ldy GP.MLIY MLI Y register savearea
lda GP.BNKBYT1 restore language card status
jmp GP.MLIEXIT and return.
.ELSE
tsx
stx $101
ldx $100
txs
jmp GP.MLIEXITX
.FIN
*--------------------------------------
XDOS.NoDevice lda #MLI.E.NODEV no device connected.
jsr GP.SYSERR
XDOS.BadCall lda #MLI.E.BADCALL
.HS 2C BIT ABS
XDOS.BadCnt lda #MLI.E.BADCNT
jsr XDOS.GoSysErr
bra XDOS.Exit
*--------------------------------------
* ProDOS Device Manager
*--------------------------------------
XDOS.DevMgr ldy #$05 the call spec for devices must
.1 lda (ZP.A3L),y be passed to drivers in page zero:
sta ZP.CMDNUM,y
dey
bne .1
ldx ZP.BUFPTR+1 buffer page
stx ZP.UserBuf+1 to user buffer
inx
inx
lda ZP.BUFPTR is buffer page aligned (nn00) ?
beq .2 branch if it is
inx else account for 3-page straddle
.2 jsr vldbuf1 make sure user buffer is not
bcs XDOS.GoSysErr conflicting with protected ram.
jsr XDOS.DevCall call internal entry for device dispatch
bcc XDOS.DevCall.RTS
XDOS.GoSysErr jsr GP.SYSERR
*--------------------------------------
XDOS.DevCall php do not allow interrupts.
sei
lda ZP.UNITNUM get device # and
and #$F0 strip misc lower nibble
sta ZP.UNITNUM then save it.
lsr use as index to device table
lsr
lsr
tax
jsr XDOS.DevCall.Jmp
bit IO.CLRC8ROM RELEASE $C800-$CFFF ROM space
bcs .9
plp
clc
rts
.9 plp
sec
XDOS.DevCall.RTS
rts
XDOS.DevCall.Jmp
jmp (GP.DEVPTRS,x) goto driver (or error if no driver)
*--------------------------------------
* ProDOS interrupt manager
*--------------------------------------
XDOS.IntMgr sta ZP.A4L interrupt command
lsr allocate interrupt or deallocate?
bcs .4 branch if deallocate.
ldx #$03 test for a free interrupt space in tbl.
.1 lda GP.IRQVs-2,x test high address for 0.
bne .2 branch if spot occupied.
ldy #$03 get address of routine.
lda (ZP.A3L),y must not be zero page.
beq .3 error if it is.
sta GP.IRQVs-2,x save high address
dey
lda (ZP.A3L),y
sta GP.IRQVs-3,x and low address.
txa return interrupt # in range 1-4
lsr
dey
sta (ZP.A3L),y pass back to user.
clc no errors.
rts
.2 inx
inx next lower priority spot
cpx #$0B are all 4 already allocated?
bne .1 branch if not.
lda #MLI.E.IRQFULL interrupt table full
.HS 2C BIT ABS
.3 lda #MLI.E.INVPARAM invalid parameter.
jsr GP.SYSERR
.4 ldy #$01 zero out interrupt vector
lda (ZP.A3L),y but make sure it is a valid #.
beq .3 error if < 1
cmp #$05 or > 4
bcs .3
asl
tax
stz GP.IRQVs-2,x
stz GP.IRQVs-1,x
* clc
rts
*--------------------------------------
XDOS.SysErr sta GP.ERROR P8 error code
plx
plx pop 1 level of return
sec
rts
*--------------------------------------
* $01 = more than 255 unclaimed irqs
* $0A = open file has no volume
* $0B = open file has no 1K buffer
* $0C = block allocation error.
*--------------------------------------
XDOS.SysDeath tax death error code.
sta IO.CLR80DISP disable 80 col hardware.
sta IO.SETTEXT switch in text.
lda XDOS.CortFlag is this a Cortland?
beq .1 if not, don't use super hires switch.
stz IO.GS.NEWVIDEO force off super hires.
.1 sta IO.CLRPAGE2 switch in text page 1.
ldy #XDOS.SysErrMsgL-1
.2 lda XDOS.SysErrMsg,y
sta $400,y 'SYS ERR-$'
dey
bpl .2
txa x = death error code
and #$0F convert to ascii
ora #$30
cmp #$3A
bcc .3 branch if not > 9.
adc #$06 inc to alpha a-f
.3 ldy #XDOS.SysErrMsgL
ora #$80
sta $400,y
lda #" "
.4 iny
sta $400,y
cpy #39
bne .4
bra *
*--------------------------------------
* ProDOS Block File Manager
*--------------------------------------
XDOS.BFMgr lda XDOS.CmdFlags,x translate into command address.
asl bit 7 indicates pathname to process
sta cmdtemp
and #$3F bit 6 is refnum, 5 is time to process
tax
lda XDOS.CmdJmps,x move address to indirect jump
sta .8+1
lda XDOS.CmdJmps+1,x high byte
sta .8+2
lda #$20 init backup bit flag
sta bkbitflg to say 'file modified'
bcc .1
jsr XDOS.GetPath process pathname before calling command
bcs .9 branch if bad name.
.1 asl cmdtemp test for refnum processing
bcc .2
jsr XDOS.GetFCB set pointers to fcb and vcb of file
bcs .9
.2 asl cmdtemp check for necessity of time stamp
bcc .8
jsr GP.CLOCK date/time
.8 jsr $FFFF SELF MODIFIED : execute command
bcc .10
.9 jsr GP.SYSERR
.10 rts
*--------------------------------------
* entry used by rename for 2nd pathname.
*--------------------------------------
XDOS.GetRenPath ldy #$03 get address to new pathname
.HS 2C
*--------------------------------------
XDOS.GetPath ldy #$01 index to pathname pointer
lda (ZP.A3L),y low pointer address
sta zpt
iny
lda (ZP.A3L),y hi pointer address
sta zpt+1
ldx #$00 x = index to XDOS.PathBuf
ldy #$00 y = index to input pathname.
stz prfxflg assume prefix is in use.
stz XDOS.PathBuf mark XDOS.PathBuf = nothing processed.
lda (zpt),y validate pathname length > 0 and < 65
beq .5
cmp #$41
bcs .5
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 '/')
and #$7F
cmp #'/'
bne .1 branch if prefix appended.
dec prfxflg set prefix flag = prefix not used.
iny index to 1st character of pathname.
.1 lda #$FF set current position of XDOS.PathBuf
sta XDOS.PathBuf,x to indicate end of pathname.
sta namcnt $FF = no chars processed in local name.
stx namptr pointer to local name length byte.
.2 cpy pathcnt done with pathname processing?
bcs .6
lda (zpt),y get character
and #$7F
inx prepare for next char
iny
cmp #'/' is it delimiter '/' ?
beq .8 yes
.DO LOWERCASE=0
cmp #'a' lowercase?
bcc .3 no
cmp #'z'+1
bcs .3
eor #$20 to uppercase
.3 .FIN
sta XDOS.PathBuf,x store char
inc namcnt is it the 1st char of a local name?
bne .4 no
inc namcnt increment to 1
jsr XDOS.IsValidFirstChar
bcc .2
bra errsyn
.4 jsr XDOS.IsValidChar
bcc .2
.5 bra errsyn
.6 lda #$00 end pathname with a 0
bit namcnt also make sure count is positive
bpl .7
sta namcnt
dex
.7 inx
sta XDOS.PathBuf,x
beq errsyn error if '/' only.
stx pathcnt save length of pathname
tax
.8 lda namcnt validate local name < 16
cmp #16
bcs errsyn
phx save pointer
ldx namptr get index to beginning of local name
sta XDOS.PathBuf,x save local name's length
plx restore pointer
bne .1 branch if more names to process
clc probably no error, but
lda prfxflg make sure all pathnames are prefixed
bne .9 or begin with a '/'.
lda GP.NEWPFXPTR must be non-zero
beq errsyn
.9 rts
*--------------------------------------
errsyn lda #MLI.E.INVPATH
.HS 2C BIT ABS
ptyperr lda #MLI.E.UNSUPST filetype error (not a directory)
pfxerr sec
pfx.RTS rts
*--------------------------------------
XDOS.SetPrefix jsr XDOS.GetPath call is made to detect if a null path.
bcc .1 path ok.
ldy XDOS.PathBuf is it a null pathname?
bne pfxerr error if not
sty GP.NEWPFXPTR fix appletalk PFI bug
sty GP.PFXPTR
clc no error
rts
.1 jsr XDOS.FindFileOrVol go find specified prefix directory.
bcs pfx.RTS branch if error is not root directory.
lda XDOS.DE.Filename 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 .2
lda GP.NEWPFXPTR append new prefix to old
.2 tay
sec find new beginning of prefix
sbc pathcnt
cmp #$C0 too long?
bcc errsyn then error
tax
sta GP.NEWPFXPTR
sta GP.PFXPTR
* lda XDOS.DE.DevID save device #
* sta p_dev
lda XDOS.DE.KeyPtr and address of 1st block
sta p_blok
lda XDOS.DE.KeyPtr+1
sta p_blok+1
.3 lda XDOS.PathBuf,y
sta XDOS.PathBuf,x
iny
inx
bne .3
clc good prefix
rts
*--------------------------------------
XDOS.GetPrefix ldy #$01 get index to users pathname buffer
lda (ZP.A3L),y
sta ZP.UserBuf user buffer ptr
iny
lda (ZP.A3L),y
sta ZP.UserBuf+1
* clc calc how big a buffer is needed.
stz cbytes+1 set buffer length at 64 char max
lda #$40
sta cbytes
jsr valdbuf go validate prefix buffer address
bcs pfx.RTS
ldy #$00 y = indirect index to user buffer.
lda GP.NEWPFXPTR get address of beginning of prefix
tax
beq .1 if null prefix.
eor #$FF get total length of prefix
adc #$02 add 2 for leading and trailing slashes.
.1 sta (ZP.UserBuf),y store length in user's buffer.
beq .8 branch if null prefix.
.2 iny inc to next user buffer location.
lda XDOS.PathBuf,x get next char of prefix.
.3 sta (ZP.UserBuf),y give char to user.
and #$F0 check for length descriptor.
bne .4 branch if regular character
lda #'/' otherwise, substitute a slash.
bne .3 branch always
.4 inx
bne .2 branch if more to send.
iny
lda #'/' end with '/'
sta (ZP.UserBuf),y
.8 clc no error
rts
*--------------------------------------
XDOS.GetFCB ldy #$01 index to ref#
lda (ZP.A3L),y is it a valid file# ?
beq badref must not be 0.
cmp #FCB.MAX+1
bcs badref
pha
dec
lsr
ror
ror
ror multiply by 32.
sta XDOS.FCBPtr used as an index to fcb
tax
pla restore ref# in acc
cmp XDOS.FCBs+FCB.ID,x
bne errnoref
*--------------------------------------
XDOS.GetFCBBufX lda XDOS.FCBs+FCB.BUFID,x get page address of file buffer.
tay index into global buffer table.
lda GP.BUFTABL-1,y
sta XDOS.BufAddr+1
beq .3 fcb corrupted
sta ZP.DataPtr+1 save ptr to data area of buffer
inc
inc index block always 2 pages after data
sta zpt+1
lda GP.BUFTABL-2,y ???? ALWAYS 0
sta XDOS.BufAddr
sta ZP.DataPtr index and data buffers always on
sta zpt page boundaries.
jsr XDOS.FCBDevIDSelect
lda #XDOS.VCB0
.1 tay search for associated vcb
lda XDOS.VCBs+VCB.DEV,y
cmp XDOS.FCBs+FCB.DEVID,x is this vcb the same device?
beq .4 if it is, make sure volume is active.
.2 tya adjust index to next vcb.
clc
adc #VCB
bcc .1 loop until volume found.
lda #$0A open file has no volume so
.HS 2C BIT ABS
.3 lda #$0B fcb error so
jsr GP.SYSDEATH kill the system.
.4 lda XDOS.VCBs,y make sure this vcb is open.
beq .2 branch if it is not active.
sty XDOS.VCBPtr save ptr to good vcb.
clc no error
rts Y = XDOS.VCBPtr, X = XDOS.FCBPtr
*--------------------------------------
errnoref stz XDOS.FCBs,x
badref lda #MLI.E.BADREF requested refnum is
sec illegal (out of range)
rts
*--------------------------------------
XDOS.Online jsr XDOS.GetUserBuf figure out how big buffer has to be.
stz cbytes set this for valdbuf routine.
stz cbytes+1
ldy #$01
lda (ZP.A3L),y if 0 then cbytes=$100 else $010 for one
and #$F0 device. mask out unused nibble.
sta GP.DEVNUM last device used.
beq .1 branch if all devices.
lda #$10 cbytes = $010
sta cbytes
bne .2 always taken
.1 inc cbytes+1 cbytes = $100
.2 jsr valdbuf go validate buffer range against
bcs .9 allocated memory.
lda #$00 zero out user buffer space
ldy cbytes
.3 dey
sta (ZP.UserBuf),y
bne .3
sta namptr used as pointer to user buffer.
lda GP.DEVNUM get device # again.
bne online1 branch if only 1 device to process.
ldx GP.DEVCNT
.4 phx save index to last item on list
lda GP.DEVLST,x active device list.
and #$F0 strip device type info.
sta GP.DEVNUM save desired device to look at.
jsr online1 log this volume and return it's name.
lda namptr inc pointer for next device
clc
adc #$10
sta namptr
plx get index to device list.
dex next device.
bpl .4 branch if there is another device.
lda #$00 no errors for multiple on-line
clc
.9 rts
*--------------------------------------
online1 jsr XDOS.FindVCBForDevNum see if it has already been logged in.
bcs online1.ERR branch if vcb is full.
lda #$02
ldx #$00 read in root (volume) directory
jsr XDOS.ReadGBufAX read ROOT VOL into general purpose buffer.
bcc .1 branch if read was ok.
ldx XDOS.VCBPtr
ldy XDOS.VCBs+VCB.OFCNT,x don't take the vcb offline if
bne online1.ERR there are active files present.
stz XDOS.VCBs,x now take the volume offline
stz XDOS.VCBs+VCB.DEV,x
bra online1.ERR branch if unable to read.
.1 .DO LOWERCASE=1
jsr XDOS.CheckAndUnpackGBuf
bcs online1.ERR
.FIN
ldx XDOS.VCBPtr
lda XDOS.VCBs,x has it been logged in before?
beq .2 if not.
lda XDOS.VCBs+VCB.OFCNT,x it has, are there active files?
bne .3 branch if volume is currently busy.
.2 jsr XDOS.VCBMountAtX
bcs online1.ERR branch if there is a problem.
lda #MLI.E.DUPVOL anticipate a duplicate active volume
bit XDOS.VCBDupFlag exits.
bmi online1.ERR branch if so.
.3 ldx XDOS.VCBPtr
jsr XDOS.VCBCmpGBUF does vol read compare with logged vol?
lda #MLI.E.DSKSWIT anticipate wrong volume mounted.
bcc online1.OK branch if ok.
*--------------------------------------
online1.ERR pha save error code.
jsr svdevn report what device has problem.
pla error code.
iny tell what error was encountered.
sta (ZP.UserBuf),y
cmp #MLI.E.DUPVOL duplicate volume error?
bne .1 no.
iny report which other device has same name
ldx XDOS.VCBDupEnt
lda XDOS.VCBs+VCB.DEV,x
sta (ZP.UserBuf),y
stz XDOS.VCBDupFlag clear duplicate flag.
lda #MLI.E.DUPVOL duplicate volume error code.
.1 sec flag error
rts
*--------------------------------------
online1.OK lda XDOS.VCBs,x get volume name count
sta namcnt
ldy namptr index to user's buffer.
.1 lda XDOS.VCBs,x move name to user's buffer
sta (ZP.UserBuf),y
inx
iny
dec namcnt
bpl .1
*--------------------------------------
svdevn ldy namptr index to 1st byte of this entry.
lda GP.DEVNUM upper nibble = device# and
ora (ZP.UserBuf),y lower nibble = name length.
sta (ZP.UserBuf),y
clc no errors
rts end of block file manager
*--------------------------------------
XDOS.Create jsr XDOS.CheckPath check for duplicate, get free entry
bcc .4 error code may be 'file not found'
cmp #MLI.E.FNOTFND 'file not found' is ok
bne .5 otherwise exit with error.
ldy #$07 test for tree or directory file,
lda (ZP.A3L),y no other kinds are legal.
cmp #$04 is it seed, sapling or tree?
bcc .1 branch if it is
cmp #$0D
bne .3 report type error if not directory.
.1 lda GP.DEVNUM make sure destination device
jsr XDOS.TestWPA is not write protected.
bcs H351D
lda nofree is there space in directory to
.DO DIREXTENDROOT=1
beq XDOS.DirExtend
bne XDOS.Create1
.ELSE
beq .2 add this file? branch if not
jmp XDOS.Create1 otherwise, go create file.
.2 lda XDOS.OH.Blk before extending directory,
ora XDOS.OH.Blk+1 make sure it's a subdirectory.
bne XDOS.DirExtend
lda #MLI.E.DIRFULL otherwise, directory full error
.HS 2C BIT ABS
.FIN
.3 lda #MLI.E.UNSUPST filetype error
.HS 2C BIT ABS
.4 lda #MLI.E.DUPFILE name already exists
.5 sec
H351D rts
*--------------------------------------
XDOS.DirExtend lda ZP.BLKNUM preserve disk address of current (last)
pha directory link, before allocating an
lda ZP.BLKNUM+1 extended block.
pha
jsr XDOS.GetFreeBlk allocate a block for extending directory
plx
stx ZP.BLKNUM+1 restore block addr of dir info in XDOS.GBuf
plx
stx ZP.BLKNUM
bcs H351D unable to allocate.
sta XDOS.GBuf+2 save block address in y,a to
sty XDOS.GBuf+3 current directory.
.DO LOWERCASE=1
jsr XDOS.WriteGBufDir
.ELSE
jsr XDOS.WriteGBuf update directory block with new link.
.FIN
bcs H351D if error
ldx #$01
.1 lda ZP.BLKNUM,x prepare new directory block
sta XDOS.GBuf,x using current block as back link
lda XDOS.GBuf+2,x
sta ZP.BLKNUM,x and save new block as next to be written
dex
bpl .1
jsr XDOS.ZeroGBuf
jsr XDOS.WriteGBuf write prepared directory extension.
bcs H351D if error
lda XDOS.OH.Blk
ldx XDOS.OH.Blk+1
.DO LOWERCASE=1
jsr XDOS.ReadGBufAXDir
.ELSE
jsr XDOS.ReadGBufAX read in parent directory block
.FIN
jsr XDOS.ZPT.InitGBuf
ldx XDOS.OH.EIB and calc entry address.
.3 dex has entry address been calculated?
beq .4 if yes.
lda XDOS.OH.EL next entry address
jsr XDOS.ZPT.NextA
bra .3
.4 ldy #$13 index to block count
clc
.5 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 .5 branch if not.
.DO LOWERCASE=1
jsr XDOS.WriteGBufDir
.ELSE
jsr XDOS.WriteGBuf go update parent.
.FIN
bcs crerr2
jmp XDOS.Create
crerr2 rts return and report errors
*--------------------------------------
XDOS.Create1 jsr XDOS.ZeroGBuf zero out XDOS.GBuf
ldy #$0B move user specified date/time
.1 lda (ZP.A3L),y to directory.
sta XDOS.DE.Type,y
txa if all 4 bytes of date/time = 0
ora (ZP.A3L),y then use built-in date/time.
tax
dey
cpy #$07
bne .1
txa does user want default time?
bne .3 if not.
ldx #$03
.2 lda GP.DATE,x move current default date/time
sta XDOS.DE.CTime,x
dex
bpl .2
.3 lda (ZP.A3L),y y = index to file kind.
cmp #$04
lda #$10 assume tree type
bcc .4
lda #$D0 it's directory.
.4 ldx namptr index to local name of pathname.
ora XDOS.PathBuf,x combine file kind with name length.
sta XDOS.DE.Filename 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
.5 lda XDOS.PathBuf,x move local name as filename
sta XDOS.DE.Filename,y
dex
dey
bne .5
ldy #$03 index to ACCESS parameter
lda (ZP.A3L),y
sta XDOS.DE.Access
iny also move TYPE
lda (ZP.A3L),y
sta XDOS.DE.Type
.6 iny move AUXTYPE
lda (ZP.A3L),y
sta XDOS.DE.AuxType-5,y
cpy #$06
bne .6
.DO LOWERCASE=0
lda xdosver save current xdos version #
sta XDOS.DE.Version
lda compat and backward compatibility #
sta XDOS.DE.MVersion
.FIN
lda #$01 usage is always 1 block
sta XDOS.DE.BlkUsed
lda XDOS.DE.DirHBlk place back pointer to header block
sta XDOS.DE.BlkPtr
lda XDOS.DE.DirHBlk+1
sta XDOS.DE.BlkPtr+1
lda XDOS.DE.Filename storage type.
and #$E0 is it a directory?
beq XDOS.CreateDBLK branch if seed file.
*--------------------------------------
* Create Dir First Block
*--------------------------------------
XDOS.Create2 ldx #$1E move header to data block
.1 lda XDOS.DE.Filename,x
sta XDOS.GBuf+4,x
dex
bpl .1
eor #$30
sta XDOS.GBuf+4 make it a directory header mark.
.DO LOWERCASE=0
ldx #$07 overwrite password area and other
.2 lda pass,x header info.
sta XDOS.GBuf+20,x
lda xdosver,x
sta XDOS.GBuf+32,x
dex
bpl .2
.ELSE
ldx #XDOS.VolHdrDef.Cnt-1
.2 lda XDOS.VolHdrDef,x
sta XDOS.GBuf+34,x
dex
bpl .2
lda #$75
sta XDOS.GBuf+20
ldx #7
.3 stz XDOS.GBuf+20,x
dex
bne .3
.FIN
ldx #$02 and include info about parent directory
stx XDOS.DE.EOF+1 set file size = 512
.4 lda XDOS.DE.DirEBlk,x
sta XDOS.GBuf+39,x
dex
bpl .4
lda XDOS.DH.EL lastly, the length of parent's
sta XDOS.GBuf+42 directory entries.
.DO LOWERCASE=1
jsr XDOS.PackGBuf
.FIN
*--------------------------------------
XDOS.CreateDBLK jsr XDOS.GetFreeBlk get address of file's data block
bcs crerr3
sta XDOS.DE.KeyPtr
sty XDOS.DE.KeyPtr+1
sta ZP.BLKNUM
sty ZP.BLKNUM+1
jsr XDOS.WriteGBuf go write data block of file
bcs crerr3
inc XDOS.DH.FileCnt add 1 to total # of files in this dir
bne .1
inc XDOS.DH.FileCnt+1
.1 jsr XDOS.DE.Update go revise directories with new file
bcs crerr3
jmp XDOS.FlushBM lastly, update volume bitmap
*--------------------------------------
XDOS.ZeroGBuf ldx #0
.1 stz XDOS.GBuf,x
stz XDOS.GBuf+$100,x
inx
bne .1
rts
*--------------------------------------
MAN
SAVE usr/src/prodos.fx/prodos.s.xdos.a
LOAD usr/src/prodos.fx/prodos.s
ASM
Reference in New Issue View Git Blame Copy Permalink