mirror of
https://github.com/A2osX/A2osX.git
synced 2024-09-10 07:54:37 +00:00
1091 lines
28 KiB
Plaintext
1091 lines
28 KiB
Plaintext
NEW
|
||
AUTO 3,1
|
||
*--------------------------------------
|
||
XDOS.START
|
||
XDOS.MLI cld no decimal.
|
||
pla get processor status
|
||
sta spare1 save it temporarily
|
||
sty mliy save x and y
|
||
stx mlix
|
||
pla find out the address of the caller
|
||
sta A3L
|
||
clc preserve the address of the call spec.
|
||
adc #$04
|
||
sta mliretn last MLI call return address
|
||
pla
|
||
sta A3L+1
|
||
adc #$00
|
||
sta mliretn+1
|
||
lda spare1
|
||
pha pull processor status
|
||
plp to re-enable interrupts.
|
||
|
||
cld still no decimal
|
||
stz p8error clear any previous errors.
|
||
ldy #$01 find out if command is valid.
|
||
lda (A3L),y get command #
|
||
lsr and hash it to a range of 0-$1F
|
||
lsr
|
||
lsr
|
||
lsr
|
||
clc
|
||
adc (A3L),y
|
||
and #$1F
|
||
tax
|
||
lda (A3L),y check result to see if valid command #
|
||
cmp scnums,x
|
||
bne scnerr
|
||
|
||
iny index to call spec parm list.
|
||
lda (A3L),y make A3L point to parameter count byte
|
||
pha in parameter block.
|
||
iny
|
||
lda (A3L),y
|
||
sta A3L+1
|
||
pla
|
||
sta A3L
|
||
* ldy #$00
|
||
lda pcntbl,x make sure parameter list has the correct # of parameters.
|
||
beq goclock clock has 0 parameters.
|
||
|
||
cmp (A3L) ,y
|
||
bne scperr error if wrong count.
|
||
|
||
lda scnums,x get call # again
|
||
cmp #MLIQUIT is it quit?
|
||
beq special if so, then call quit dispatcher
|
||
|
||
asl carry set if bfm or dev mgr
|
||
bpl godevmgr
|
||
bcs gobfmgr
|
||
|
||
lsr shift back down for interrupt manager
|
||
and #$03 valid calls are 0 and 1
|
||
jsr XDOS.intmgr
|
||
bra exitmli
|
||
|
||
special jmp jspare P8 system death vector
|
||
|
||
goclock jsr clockv go read clock.
|
||
bra exitmli no errors possible
|
||
|
||
godevmgr lsr shift back down for device manager.
|
||
adc #$01 valid commands are 1 and 2.
|
||
sta A4L save command #.
|
||
jsr XDOS.devmgr execute read or write request.
|
||
bra exitmli
|
||
|
||
gobfmgr lsr shift back down for block file manager.
|
||
and #$1F valid commands are 0-$13
|
||
tax
|
||
jsr XDOS.bfmgr
|
||
|
||
exitmli stz bubit clear backup bit
|
||
ldy p8error P8 error code
|
||
cpy #$01 if > 0 then set carry
|
||
tya and set z flag.
|
||
php disable interrupts until exit complete.
|
||
sei
|
||
lsr mliact indicate MLI done.
|
||
plx save status register until return.
|
||
lda mliretn+1 place last MLI call return address
|
||
pha on stack. return is done via 'rti'
|
||
lda mliretn so the status register is restored
|
||
pha at the same time, so
|
||
phx place status back on stack
|
||
tya return error, if any.
|
||
ldx mlix MLI X register savearea
|
||
ldy mliy MLI Y register savearea
|
||
pha
|
||
lda bnkbyt1 restore language card status
|
||
jmp GP.MLIEXIT and return.
|
||
|
||
nodevice lda #MLI.E.NODEV no device connected.
|
||
jsr GP.P8errv
|
||
|
||
scnerr lda #MLI.E.BADCALL
|
||
.HS 2C BIT ABS
|
||
scperr lda #MLI.E.BADCNT
|
||
jsr gosyserr
|
||
bra exitmli
|
||
*--------------------------------------
|
||
* ProDOS Device Manager
|
||
*--------------------------------------
|
||
XDOS.devmgr php do not allow interrupts.
|
||
sei the call spec for devices must
|
||
|
||
ldy #$05
|
||
|
||
.1 lda (A3L),y be passed to drivers in page zero:
|
||
sta A4L,y
|
||
dey
|
||
bne .1
|
||
|
||
ldx buf+1 buffer page
|
||
stx usrbuf+1 to user buffer
|
||
inx
|
||
inx
|
||
lda buf 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 dvmgrerr conflicting with protected ram.
|
||
jsr dmgr call internal entry for device dispatch
|
||
bcs dvmgrerr branch if error
|
||
plp
|
||
clc no error
|
||
rts
|
||
|
||
dvmgrerr plp restore interrupt status
|
||
gosyserr jsr GP.P8errv
|
||
*--------------------------------------
|
||
dmgr lda unitnum get device # and
|
||
and #$F0 strip misc lower nibble
|
||
sta unitnum then save it.
|
||
lsr use as index to device table
|
||
lsr
|
||
lsr
|
||
tax
|
||
gocmd jmp (DEVPTRS,x) goto driver (or error if no driver)
|
||
*--------------------------------------
|
||
* ProDOS interrupt manager
|
||
*--------------------------------------
|
||
XDOS.intmgr sta A4L interrupt command
|
||
lsr allocate interrupt or deallocate?
|
||
bcs dealcint branch if deallocate.
|
||
|
||
ldx #$03 test for a free interrupt space in tbl.
|
||
|
||
.1 lda inttbl-2,x test high address for 0.
|
||
bne .2 branch if spot occupied.
|
||
|
||
ldy #$03 get address of routine.
|
||
lda (A3L),y must not be zero page.
|
||
beq badint error if it is.
|
||
sta inttbl-2,x save high address
|
||
dey
|
||
lda (A3L),y
|
||
sta inttbl-3,x and low address.
|
||
txa return interrupt # in range 1-4
|
||
lsr
|
||
dey
|
||
sta (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
|
||
badint lda #MLI.E.INVPARAM invalid parameter.
|
||
jsr GP.P8errv
|
||
|
||
dealcint ldy #$01 zero out interrupt vector
|
||
lda (A3L),y but make sure it is a valid #.
|
||
beq badint error if < 1
|
||
|
||
cmp #$05 or > 4
|
||
bcs badint
|
||
|
||
asl
|
||
tax
|
||
lda #$00 now clear it
|
||
sta inttbl-2,x
|
||
sta inttbl-1,x
|
||
clc
|
||
rts
|
||
*--------------------------------------
|
||
XDOS.syserr sta p8error P8 error code
|
||
plx
|
||
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 .1 if not, don't use super hires switch.
|
||
|
||
stz newvideo force off super hires.
|
||
|
||
.1 lda CLRPAGE2 switch in text page 1.
|
||
|
||
ldy #deathmsg.LEN-1
|
||
|
||
.2 lda deathmsg,y
|
||
sta $400,y 'RESTART SYSTEM-$'
|
||
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 #deathmsg.LEN
|
||
sta $400,y
|
||
|
||
lda #' '
|
||
|
||
.4 iny
|
||
sta $400,y
|
||
cpy #39
|
||
bne .4
|
||
|
||
bra *
|
||
*--------------------------------------
|
||
* ProDOS Block File Manager
|
||
*--------------------------------------
|
||
XDOS.bfmgr lda disptch,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 cmdtable,x move address to indirect jump
|
||
sta H3274+1
|
||
lda cmdtable+1,x high byte
|
||
sta H3274+2
|
||
lda #$20 init backup bit flag
|
||
sta bkbitflg to say 'file modified'
|
||
bcc nopath
|
||
|
||
jsr XDOS.GetPath process pathname before calling command
|
||
bcs errorsys branch if bad name.
|
||
|
||
nopath asl cmdtemp test for refnum processing
|
||
bcc nopreref
|
||
|
||
jsr findfcb set pointers to fcb and vcb of file
|
||
bcs errorsys
|
||
|
||
nopreref asl cmdtemp check for necessity of time stamp
|
||
bcc H3274
|
||
|
||
jsr clockv date/time
|
||
H3274 jsr $FFFF SELF MODIFIED : execute command
|
||
bcc goodop
|
||
|
||
errorsys jsr GP.P8errv
|
||
goodop 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 (A3L),y low pointer address
|
||
sta zpt
|
||
|
||
iny
|
||
lda (A3L),y hi pointer address
|
||
sta zpt+1
|
||
|
||
ldx #$00 x = index to pathbuf
|
||
ldy #$00 y = index to input pathname.
|
||
|
||
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 '/')
|
||
and #$7F
|
||
cmp #'/'
|
||
bne H32AD branch if prefix appended.
|
||
|
||
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 #'/' is it delimiter '/' ?
|
||
beq endname yes
|
||
|
||
.DO LOWERCASE=0
|
||
cmp #'a' lowercase?
|
||
bcc .1 no
|
||
|
||
and #$5F shift to uppercase
|
||
.1 .FIN
|
||
|
||
sta pathbuf,x store char
|
||
inc namcnt is it the 1st char of a local name?
|
||
bne .2 no
|
||
|
||
inc namcnt increment to 1
|
||
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 #16
|
||
bcs errsyn
|
||
|
||
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
|
||
*--------------------------------------
|
||
XDOS.SetPrefix jsr XDOS.GetPath 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 #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
|
||
cmp #$C0 too long?
|
||
bcc errsyn then error
|
||
|
||
tax
|
||
sta newpfxptr
|
||
sta preflag
|
||
lda d_dev save device #
|
||
sta p_dev
|
||
lda d_frst and address of 1st block
|
||
sta p_blok
|
||
lda d_frst+1
|
||
sta p_blok+1
|
||
|
||
.1 lda pathbuf,y
|
||
sta pathbuf,x
|
||
iny
|
||
inx
|
||
bne .1
|
||
|
||
clc good prefix
|
||
rts
|
||
|
||
ptyperr lda #MLI.E.UNSUPST filetype error (not a directory)
|
||
pfxerr sec
|
||
rts
|
||
*--------------------------------------
|
||
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
|
||
iny
|
||
lda (A3L),y
|
||
sta usrbuf+1
|
||
|
||
stz cbytes+1 set buffer length at 64 char max
|
||
lda #$40
|
||
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
|
||
|
||
lda #'/' otherwise, substitute a slash.
|
||
bne sndlimit branch always
|
||
|
||
H33B3 inx
|
||
bne sendprfx branch if more to send.
|
||
iny
|
||
lda #'/' end with '/'
|
||
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
|
||
ror
|
||
ror
|
||
ror multiply by 32.
|
||
sta fcbptr used as an index to fcb
|
||
tay
|
||
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)
|
||
beq fcbdead fcb corrupted
|
||
stx datptr+1 save ptr to data area of buffer
|
||
inx
|
||
inx index block always 2 pages after data
|
||
stx zpt+1
|
||
lda fcbbuf+1,y also set up device #
|
||
sta devnum
|
||
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
|
||
.HS 2C BIT ABS
|
||
|
||
fcbdead lda #$0B fcb error so
|
||
jsr sysdeath kill the system.
|
||
|
||
tstvopen lda vcbbuf,x make sure this vcb is open.
|
||
beq nxtfvol branch if it is not active.
|
||
stx vcbptr save ptr to good vcb.
|
||
clc no error
|
||
rts
|
||
|
||
errnoref lda #$00 put a zero into this fcb to
|
||
sta fcbbuf,y show free fcb.
|
||
|
||
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.
|
||
|
||
stz cbytes set this for valdbuf routine.
|
||
stz cbytes+1
|
||
ldy #$01
|
||
lda (A3L),y if 0 then cbytes=$100 else $010 for one
|
||
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.
|
||
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 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.
|
||
iny tell what error was encountered.
|
||
sta (usrbuf),y
|
||
cmp #$57 duplicate volume error?
|
||
bne H34CE no.
|
||
|
||
iny report which other device has same name
|
||
ldx vcbentry
|
||
lda vcbbuf+16,x
|
||
sta (usrbuf),y
|
||
stz duplflag clear duplicate flag.
|
||
lda #$57 duplicate volume error code.
|
||
|
||
H34CE sec flag error
|
||
rts
|
||
|
||
H34D0 lda vcbbuf,x get volume name count
|
||
sta namcnt
|
||
ldy namptr index to user's buffer.
|
||
|
||
H34D9 lda vcbbuf,x move name to user's buffer
|
||
sta (usrbuf),y
|
||
inx
|
||
iny
|
||
dec namcnt
|
||
bpl H34D9
|
||
|
||
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.
|
||
|
||
.DO LOWERCASE=0
|
||
|
||
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
|
||
|
||
.ELSE
|
||
|
||
ldx #XDOS.VolHdrDef.Cnt-1
|
||
|
||
.1 lda XDOS.VolHdrDef,x
|
||
sta gbuf+34,x
|
||
dex
|
||
bpl .1
|
||
|
||
.FIN
|
||
|
||
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 #MLI.E.NOTPRODOS 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
|
||
ASM
|