599 lines
7.1 KiB
Plaintext
599 lines
7.1 KiB
Plaintext
include 'gsos.equ'
|
|
include 'fst.equ'
|
|
include 'fst.macros'
|
|
include 'records.equ'
|
|
|
|
|
|
longa on
|
|
longi on
|
|
string asis
|
|
|
|
entry app_entry, sys_entry
|
|
|
|
header proc
|
|
str 'FST '
|
|
dc.l app_entry
|
|
dc.l sys_entry
|
|
dc.w fst_id
|
|
dc.w $0000 ; attributes
|
|
dc.w $0100 ; version
|
|
dc.w $0200 ; block size
|
|
dc.l $007FFFFF ; maximum volume size
|
|
dc.l 1 ; min volume size
|
|
dc.l $FFFFFFFF ; max file size
|
|
dc.l 0 ; reserved
|
|
str.b 'Host' ; name
|
|
str.b 'Host FST v01.00' ; comment
|
|
dc.w 0 ; reserved
|
|
; credits
|
|
str.b 'Host FST written by Kelvin W Sherlock.'
|
|
|
|
endp
|
|
|
|
data record
|
|
export dev_id
|
|
; device id of the .host driver.
|
|
dev_id ds.w 0
|
|
|
|
endr
|
|
|
|
sys_entry proc
|
|
|
|
phk
|
|
plb
|
|
rep #$30
|
|
|
|
cpx #max_sys_call+1
|
|
bge rtl_no_error
|
|
|
|
jmp (@sys_table,x)
|
|
|
|
@sys_table
|
|
dc.w rtl_no_error
|
|
dc.w sys_startup
|
|
dc.w sys_shutdown
|
|
dc.w rtl_no_error ; remove vcr
|
|
dc.w rtl_no_error ; deferred flush
|
|
max_sys_call equ *-@sys_table-2
|
|
|
|
endp
|
|
|
|
|
|
sys_startup proc
|
|
with dev_parms
|
|
|
|
; 1. find the .host device.
|
|
|
|
lda #1
|
|
sta dev_dev_id
|
|
stz dev_num
|
|
loop
|
|
lda #drvr_get_dib
|
|
sta dev_callnum
|
|
jsl dev_dispatcher
|
|
bcs no
|
|
; appletalk puts up a dialog box....
|
|
|
|
ldy #$34 ; dib device id
|
|
lda [dev_dib_ptr],y
|
|
cmp #$10 ; file server
|
|
bne next
|
|
|
|
short m
|
|
ldy #$0e ; name $04 H O S T
|
|
lda [dev_dib_ptr],y
|
|
cmp #$04
|
|
bne next
|
|
|
|
iny
|
|
lda [dev_dib_ptr],y
|
|
cmp #'H'
|
|
bne next
|
|
|
|
iny
|
|
lda [dev_dib_ptr],y
|
|
cmp #'O'
|
|
bne next
|
|
|
|
iny
|
|
lda [dev_dib_ptr],y
|
|
cmp #'S'
|
|
bne next
|
|
|
|
iny
|
|
lda [dev_dib_ptr],y
|
|
cmp #'T'
|
|
bne next
|
|
|
|
lon m
|
|
lda dev_dev_id
|
|
sta dev_id
|
|
bra got_device
|
|
|
|
next
|
|
long m
|
|
; try the next one.
|
|
inc dev_dev_id
|
|
bra loop
|
|
|
|
got_device
|
|
|
|
; sanity check that the global buffer location
|
|
; is where I expect it.
|
|
jsl get_sys_gbuf
|
|
cpy #$0000
|
|
bne no
|
|
cpx #$9a00
|
|
bne no
|
|
|
|
; check if host wdm active.
|
|
|
|
lda #0
|
|
sec
|
|
ldx #$8001
|
|
wdm #$ff
|
|
; wdm will clear carry if active.
|
|
rtl
|
|
|
|
no
|
|
sec ; unload me!
|
|
lda #0
|
|
rtl
|
|
endp
|
|
|
|
sys_shutdown proc
|
|
|
|
lda #0
|
|
clc
|
|
ldx #$8002
|
|
wdm #$ff
|
|
rtl
|
|
endp
|
|
|
|
rtl_no_error proc
|
|
lda #0
|
|
clc
|
|
rtl
|
|
endp
|
|
|
|
|
|
rtl_invalid_fst_op proc
|
|
lda #invalid_fst_op
|
|
sec
|
|
rtl
|
|
endp
|
|
|
|
rtl_bad_system_call proc
|
|
lda #bad_system_call
|
|
sec
|
|
rtl
|
|
endp
|
|
|
|
rtl_invalid_pcount proc
|
|
lda #invalid_pcount
|
|
sec
|
|
rtl
|
|
endp
|
|
|
|
|
|
app_entry proc
|
|
|
|
|
|
with dp
|
|
with fst_parms
|
|
|
|
import max_pcount
|
|
import want_fcr
|
|
import want_vcr
|
|
|
|
phk
|
|
plb
|
|
rep #$30
|
|
|
|
|
|
|
|
;brk $42
|
|
|
|
sty <call_class
|
|
|
|
; debug saves all registers.
|
|
IF DEBUG_S16 THEN
|
|
jsr debug
|
|
ENDIF
|
|
|
|
|
|
; check the class 0 or 1 only.
|
|
cpy #2+1
|
|
bge @bad_system_call
|
|
|
|
cpx #max_app_call+1 ; 66+1
|
|
bge @bad_system_call
|
|
|
|
; class 1 -- check the pcount maximum.
|
|
cpy #2
|
|
bne @ok
|
|
|
|
lda [param_blk_ptr]
|
|
; gs/os already checks the minimum and verifies non-null names, etc.
|
|
;cmp min_pcount,x
|
|
;blt @invalid_pcount
|
|
cmp max_pcount,x
|
|
bge @invalid_pcount
|
|
|
|
@ok
|
|
|
|
stz my_fcr
|
|
stz my_fcr+2
|
|
stz my_vcr
|
|
stz my_vcr+2
|
|
stz cookie
|
|
|
|
phx ; save...
|
|
lda want_fcr,x
|
|
beq @fcr
|
|
|
|
ldx fcr_ptr
|
|
ldy fcr_ptr+2
|
|
jsl deref
|
|
stx my_fcr
|
|
sty my_fcr+2
|
|
ldy #fcr.cookie
|
|
lda [my_fcr],y
|
|
sta cookie
|
|
|
|
@fcr
|
|
plx ; restore
|
|
phx ; save
|
|
|
|
lda want_vcr,x
|
|
beq @vcr
|
|
|
|
ldx vcr_ptr
|
|
ldy vcr_ptr+2
|
|
jsl deref
|
|
stx my_vcr
|
|
sty my_vcr+2
|
|
@vcr
|
|
|
|
plx ; restore
|
|
|
|
; check for dev num / :Host: path?
|
|
|
|
; fake an rtl address for sys_exit
|
|
; otherwise, would need to jml sys_exit from functions.
|
|
pea |(sys_exit-1)>>8
|
|
phb
|
|
lda #<sys_exit-1
|
|
sta 1,s
|
|
|
|
; call it...
|
|
jmp (@app_table,x)
|
|
|
|
|
|
@bad_system_call
|
|
lda #bad_system_call
|
|
sec
|
|
jml sys_exit
|
|
|
|
@invalid_pcount
|
|
lda #invalid_pcount
|
|
sec
|
|
jml sys_exit
|
|
endp
|
|
|
|
|
|
|
|
|
|
close proc
|
|
with dp
|
|
lda #invalid_fst_op
|
|
ldx call_number
|
|
ldy cookie
|
|
sec
|
|
wdm #$ff
|
|
bcc @ok
|
|
rtl
|
|
@ok
|
|
; destroy the fcr
|
|
lda [my_fcr]
|
|
jsl release_fcr
|
|
|
|
; decrement vcr
|
|
ldx vcr_ptr
|
|
ldy vcr_ptr+2
|
|
jsl deref
|
|
stx my_vcr
|
|
sty my_vcr+2
|
|
|
|
|
|
ldy #vcr.open_count
|
|
lda [my_vcr],y
|
|
beq fatal
|
|
dec a
|
|
sta [my_vcr],y
|
|
|
|
lda #0
|
|
clc
|
|
rtl
|
|
|
|
fatal
|
|
lda #vcr_unusable
|
|
jml sys_death
|
|
|
|
endp
|
|
|
|
read proc
|
|
; slightly special since newline mode may be in effect.
|
|
|
|
ldy #fcr.mask
|
|
lda [my_fcr],y
|
|
sta >$009a00 ; hardcoded...
|
|
beq fd_op
|
|
|
|
; zero-out the table.
|
|
ldx #256-2
|
|
lda #0
|
|
@zloop
|
|
sta >$009a00+2,x
|
|
dex
|
|
dex
|
|
bpl @zloop
|
|
|
|
; newline list is a virtual pointer.
|
|
ldy #fcr.newline
|
|
lda [my_fcr],y
|
|
tax
|
|
iny
|
|
iny
|
|
lda [my_fcr],y
|
|
tay
|
|
jsl deref
|
|
stx ptr
|
|
sty ptr+2
|
|
|
|
ldy #fcr.newline_length
|
|
lda [my_fcr],y
|
|
tay
|
|
dey
|
|
|
|
ldx #0
|
|
lda #0
|
|
short m
|
|
nloop
|
|
lda [ptr],y
|
|
tax
|
|
lda #$ff
|
|
sta >$009a00+2,x
|
|
dey
|
|
bpl nloop
|
|
long m
|
|
|
|
bra fd_op
|
|
|
|
endp
|
|
|
|
fd_op proc
|
|
|
|
; read, write, truncate, etc.
|
|
; everything (except close) that uses an fcr.
|
|
lda #invalid_fst_op
|
|
ldx call_number
|
|
ldy cookie
|
|
sec
|
|
wdm #$ff
|
|
rtl
|
|
endp
|
|
|
|
|
|
volume proc
|
|
; check if a volume is ours, create vcr if necessary.
|
|
|
|
lda fst_parms.dev1_num
|
|
beq no
|
|
|
|
cmp dev_id
|
|
bne no
|
|
; yes!
|
|
|
|
lda #unknown_vol
|
|
ldx call_number
|
|
sec
|
|
wdm #$ff
|
|
bcc @ok
|
|
rtl
|
|
@ok
|
|
; name is hardcoded to Host.
|
|
jsr build_vcr
|
|
rtl
|
|
|
|
|
|
no
|
|
lda #unknown_vol
|
|
sec
|
|
rtl
|
|
|
|
endp
|
|
|
|
build_vcr procname
|
|
|
|
; for now, volume hard coded as 'Host'.
|
|
|
|
|
|
with dp
|
|
|
|
ldx #default_name
|
|
ldy #^default_name
|
|
lda #0
|
|
jsl find_vcr
|
|
bcs create_vcr
|
|
jsl deref
|
|
|
|
stx my_vcr
|
|
sty my_vcr+2
|
|
ldy #vcr.fst_id
|
|
lda [my_vcr],y
|
|
cmp #fst_id
|
|
bne dump_vcr
|
|
|
|
ldy #vcr.status
|
|
lda [my_vcr],y
|
|
and #vcr_swapped
|
|
beq @exit
|
|
|
|
and #vcr_swapped_in
|
|
sta [my_vcr],y
|
|
|
|
;lda device
|
|
lda dev_id
|
|
ldy #vcr.device
|
|
sta [my_vcr],y
|
|
|
|
@exit
|
|
lda #0
|
|
clc
|
|
rts
|
|
|
|
dump_vcr
|
|
; vcr exists for the filename but it's not mine.
|
|
; if inactive, kick it out. otherwise, return dup error.
|
|
|
|
;
|
|
; todo -- prodos fst has kludge for change path which
|
|
; allows duplicates if using a device name or something...
|
|
;
|
|
|
|
ldy #vcr.open_count
|
|
lda [my_vcr],y
|
|
beq @dump
|
|
|
|
lda #dup_volume
|
|
sec
|
|
rts
|
|
|
|
@dump
|
|
ldy #vcr.id
|
|
lda [my_vcr],y
|
|
jsl release_vcr
|
|
; drop through.
|
|
|
|
create_vcr
|
|
lda #vcr.__sizeof
|
|
ldx #default_name
|
|
ldy #^default_name
|
|
jsl alloc_vcr
|
|
lda #out_of_mem
|
|
bcs exit
|
|
|
|
jsl deref
|
|
stx my_vcr
|
|
sty my_vcr+2
|
|
|
|
lda #0
|
|
ldy #vcr.status
|
|
sta [my_vcr],y
|
|
ldy #vcr.open_count
|
|
sta [my_vcr],y
|
|
|
|
lda #fst_id
|
|
ldy #vcr.fst_id
|
|
sta [my_vcr],y
|
|
|
|
lda dev_id
|
|
ldy #vcr.device
|
|
sta [my_vcr],y
|
|
|
|
lda #0
|
|
clc
|
|
exit
|
|
rts
|
|
|
|
default_name_colon
|
|
str.w ':Host'
|
|
|
|
default_name
|
|
str.w 'Host'
|
|
|
|
endp
|
|
|
|
get_dev_num proc
|
|
path equ path1_ptr
|
|
|
|
lda dev1_num
|
|
bne store
|
|
|
|
jsr check_path
|
|
bcs exit
|
|
|
|
jsr build_vcr
|
|
bcs exit
|
|
|
|
lda dev_id
|
|
store
|
|
ldx call_class
|
|
ldy table,x
|
|
sta [param_blk_ptr],y
|
|
lda #0
|
|
clc
|
|
exit
|
|
rtl
|
|
|
|
|
|
table
|
|
dc.w DevNumRec.devNum, DevNumRecGS.devNum
|
|
|
|
endp
|
|
|
|
;
|
|
; verify this path is for us
|
|
; (via dev number or :Host:)
|
|
;
|
|
check_path proc
|
|
lda dev1_num
|
|
beq path
|
|
cmp dev_id
|
|
beq ok
|
|
|
|
vnf
|
|
lda #vol_not_found
|
|
sec
|
|
rts
|
|
ok
|
|
lda #0
|
|
clc
|
|
rts
|
|
path
|
|
ldy #2
|
|
ldx #0
|
|
lda #0
|
|
short m
|
|
|
|
loop
|
|
lda [path1_ptr],y
|
|
cmp lower,y
|
|
beq @next
|
|
cmp upper,y
|
|
beq @next
|
|
long m
|
|
bra vnf
|
|
@next
|
|
iny
|
|
cpy #5+2
|
|
bne loop
|
|
|
|
; check for trailing null / :
|
|
lda [path1_ptr],y
|
|
beq @ok
|
|
cmp #':'
|
|
beq @ok
|
|
|
|
long m
|
|
bra vnf
|
|
@ok
|
|
long m
|
|
bra ok
|
|
|
|
|
|
lower str.w ':host'
|
|
upper str.w ':HOST'
|
|
end
|