mirror of https://github.com/A2osX/A2osX.git
671 lines
19 KiB
Plaintext
671 lines
19 KiB
Plaintext
NEW
|
||
AUTO 3,1
|
||
*--------------------------------------
|
||
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 HBFA0 and return.
|
||
|
||
nodevice lda #MLI.E.NODEV no device connected.
|
||
.HS 2C BIT ABS
|
||
scnerr lda #MLI.E.BADCALL
|
||
.HS 2C BIT ABS
|
||
scperr lda #MLI.E.BADCNT
|
||
jsr GP.P8errv
|
||
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 (drivertbl1,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
|
||
*--------------------------------------
|
||
irqrecev lda accsav get acc from where old ROM put it.
|
||
sta p8areg
|
||
stx p8xreg entry point on ram card interrupt
|
||
sty p8yreg
|
||
tsx
|
||
stx p8sreg
|
||
lda irqflag irq flag = 0 if old roms
|
||
bne .1 and 1 if new roms.
|
||
|
||
pla restore return address and p-reg.
|
||
sta p8preg
|
||
pla
|
||
sta intadr interrupt return address
|
||
pla
|
||
sta intadr+1
|
||
.1 txs
|
||
lda mslot set up to re-enable $Cn00 rom
|
||
sta irqdev+2
|
||
|
||
ldx #$FA save 6 bytes of page 0
|
||
|
||
.2 lda $00,x
|
||
sta svzerop-$FA,x
|
||
inx
|
||
bne .2
|
||
|
||
* poll interrupt routines for a claimer
|
||
|
||
ldx #0
|
||
.3 stx irqXindex
|
||
|
||
lda inttbl+1,x test for a valid routine.
|
||
beq .4 branch if no routine.
|
||
|
||
jsr gointX execute
|
||
|
||
bcc irqdone
|
||
|
||
.4 ldx irqXindex
|
||
inx
|
||
inx
|
||
cpx #10
|
||
bne .3
|
||
|
||
inc irqcount allow 255 unclaimed interrupts
|
||
bne irqdone before system death.
|
||
|
||
lda #$01 bad irq so
|
||
jsr sysdeath kill the system.
|
||
|
||
irqdone ldx #$FA
|
||
|
||
H31AE lda svzerop-$FA,x restore the zero page
|
||
sta $00,x
|
||
inx
|
||
bne H31AE
|
||
|
||
lda irqflag check for old roms.
|
||
bne H31DD branch if new roms.
|
||
|
||
ldy p8yreg restore registers.
|
||
ldx p8xreg
|
||
lda CLRC8ROM re-enable i/o card.
|
||
irqdev lda $C100 Cn is self modifying.
|
||
lda irqdev+2 restore device id.
|
||
sta mslot slot being accessed.
|
||
|
||
H31DD jmp GP.IrqExit do necessary bank switches and return.
|
||
|
||
irqflag .HS 00 0 = old roms. 1 = new roms.
|
||
irqcount .HS 00 # of unclaimed interrupts.
|
||
irqXindex .HS 00
|
||
svzerop .HS 000000000000
|
||
|
||
gointX jmp (inttbl,x) interrupt routine x
|
||
|
||
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 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
|
||
|
||
H321F lda #$20 inverse space border
|
||
sta vline11+10,y
|
||
sta vline13+10,y
|
||
lda deathmsg,y
|
||
sta vline12+10,y 'RESTART SYSTEM-$0x'
|
||
dey
|
||
bpl H321F
|
||
|
||
txa x = death error code
|
||
and #$0F convert to ascii
|
||
ora #$B0
|
||
cmp #$BA
|
||
bcc H323B branch if not > 9.
|
||
adc #$06 inc to alpha a-f
|
||
H323B sta vline12+28 death error code 1 to F
|
||
bra * end of xdos mli
|
||
*--------------------------------------
|
||
* 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 setpath 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
|
||
|
||
setpath ldy #$01 index to pathname pointer
|
||
lda (A3L),y low pointer address
|
||
sta zpt
|
||
iny
|
||
lda (A3L),y hi pointer address
|
||
sta zpt+1
|
||
|
||
* entry used by rename for 2nd pathname.
|
||
|
||
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.
|
||
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
|
||
bne H32AD branch if prefix appended.
|
||
sta 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 '/' ?
|
||
beq endname yes
|
||
cmp #$61 lowercase?
|
||
bcc H32CD no
|
||
and #$5F shift to uppercase
|
||
H32CD sta pathbuf,x store char
|
||
inc namcnt is it the 1st char of a local name?
|
||
bne H32DA 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
|
||
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
|
||
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
|
||
|
||
* set prefix command
|
||
|
||
setprefx 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
|
||
jsr stypfx indicate null prefix
|
||
clc no error
|
||
rts
|
||
H3333 jsr findfile go find specified prefix directory.
|
||
bcc H333C if no error.
|
||
cmp #$40 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
|
||
jsr stapfx
|
||
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
|
||
|
||
movprfx lda pathbuf,y
|
||
sta pathbuf,x
|
||
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.
|
||
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 #$2F otherwise, substitute a slash.
|
||
bne sndlimit branch always
|
||
|
||
H33B3 inx
|
||
bne sendprfx branch if more to send.
|
||
iny
|
||
lda #$2F 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
|
||
jsr sysdeath kill the system.
|
||
|
||
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
|
||
|
||
* 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
|
||
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
|
||
*--------------------------------------
|
||
MAN
|
||
SAVE USR/SRC/PRODOS.FX/PRODOS.S.XDOS.A
|
||
LOAD USR/SRC/PRODOS.FX/PRODOS.S
|
||
ASM
|