1143 lines
16 KiB
Plaintext
1143 lines
16 KiB
Plaintext
include 'gsos.equ'
|
|
include 'fst.equ'
|
|
include 'fst.macros'
|
|
include 'records.equ'
|
|
|
|
|
|
longa on
|
|
longi on
|
|
string asis
|
|
|
|
entry app_entry
|
|
entry sys_entry
|
|
|
|
entry rtl_no_error
|
|
entry sys_startup
|
|
entry sys_shutdown
|
|
|
|
entry check_path1, check_path2
|
|
entry build_vcr
|
|
|
|
entry fd_op_ro
|
|
|
|
entry create
|
|
entry destroy
|
|
entry change_path
|
|
entry set_file_info
|
|
entry get_file_info
|
|
entry judge_name
|
|
entry volume
|
|
entry open
|
|
entry close
|
|
entry read
|
|
entry write
|
|
entry flush
|
|
entry get_mark
|
|
entry set_mark
|
|
entry get_eof
|
|
entry set_eof
|
|
entry get_dir_entry
|
|
entry get_dev_num
|
|
entry format
|
|
entry erase_disk
|
|
|
|
|
|
macro
|
|
&lab call_host
|
|
&lab dc.b $42, $ff
|
|
endm
|
|
|
|
macro
|
|
&lab host_print
|
|
&lab dc.b $42, $a0
|
|
endm
|
|
|
|
macro
|
|
&lab host_hexdump
|
|
&lab dc.b $42, $a1
|
|
endm
|
|
|
|
|
|
|
|
header proc
|
|
str 'FST '
|
|
dc.l app_entry
|
|
dc.l sys_entry
|
|
dc.w fst_id
|
|
|
|
dc.w fst_attr ; 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 dc.w 0
|
|
|
|
export colon_host, colon_HOST, colon_Host
|
|
colon_host str.w ':host'
|
|
colon_Host str.w ':Host'
|
|
colon_HOST str.w ':HOST'
|
|
|
|
endr
|
|
|
|
sys_entry proc
|
|
|
|
phk
|
|
plb
|
|
long m,x
|
|
|
|
|
|
if 0 then
|
|
; debug
|
|
pha
|
|
phx
|
|
phy
|
|
lda #$8001
|
|
ldx #debugstr
|
|
ldy #^debugstr
|
|
host_print
|
|
lda #$18
|
|
ldx #$bd30
|
|
ldy #$0000
|
|
host_hexdump
|
|
ply
|
|
plx
|
|
pla
|
|
endif
|
|
|
|
|
|
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
|
|
|
|
debugstr str.b 'sys_entry'
|
|
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
|
|
|
|
|
|
|
|
find_host_device proc
|
|
with dev_parms
|
|
|
|
; find .host device. if no .host, returns to gs/os.
|
|
; entry via jsr
|
|
; exit via rts (success) / sys_exit (fail).
|
|
lda dev_id
|
|
beq @search
|
|
bmi @fail
|
|
rts
|
|
@fail plx
|
|
lda #unknown_vol
|
|
sec
|
|
jml sys_exit
|
|
@search
|
|
lda #-1
|
|
sta dev_id
|
|
lda #1
|
|
sta dev_dev_id
|
|
stz dev_num
|
|
@loop
|
|
lda #drvr_get_dib
|
|
sta dev_callnum
|
|
jsl dev_dispatcher
|
|
bcs @fail
|
|
|
|
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
|
|
|
|
long m
|
|
lda dev_dev_id
|
|
sta dev_id
|
|
clc
|
|
rts
|
|
|
|
@next
|
|
long m
|
|
; try the next one.
|
|
inc dev_dev_id
|
|
bra @loop
|
|
endp
|
|
|
|
sys_startup proc
|
|
|
|
|
|
stz dev_id
|
|
|
|
; 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
|
|
call_host
|
|
; wdm will clear carry if active.
|
|
; if carry set, a <> 0, gs/os halts
|
|
; "Sorry, system error $xxxx occurred while loading the FST file xxx"
|
|
lda #0
|
|
rtl
|
|
|
|
no
|
|
sec ; unload me!
|
|
lda #0
|
|
rtl
|
|
endp
|
|
|
|
sys_shutdown proc
|
|
|
|
lda #0
|
|
clc
|
|
ldx #$8002
|
|
call_host
|
|
rtl
|
|
endp
|
|
|
|
|
|
|
|
app_entry proc
|
|
|
|
|
|
with dp
|
|
with fst_parms
|
|
|
|
|
|
phk
|
|
plb
|
|
long m,x
|
|
|
|
|
|
if 0 then
|
|
; debug
|
|
pha
|
|
phx
|
|
phy
|
|
lda #$8001
|
|
ldx #debugstr
|
|
ldy #^debugstr
|
|
host_print
|
|
lda #$18
|
|
ldx #$bd30
|
|
ldy #$0000
|
|
host_hexdump
|
|
|
|
lda path_flag
|
|
and #$4000
|
|
beq @xx
|
|
|
|
lda #32
|
|
ldx path1_ptr
|
|
ldy path1_ptr+2
|
|
host_hexdump
|
|
|
|
@xx
|
|
ply
|
|
plx
|
|
pla
|
|
;
|
|
endif
|
|
|
|
; x = call number * 2
|
|
; y = call class * 2
|
|
sty <call_class
|
|
stx <tmp
|
|
|
|
; 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 table,x
|
|
and #$00ff
|
|
cmp [param_blk_ptr]
|
|
; gs/os already checks the minimum and verifies non-null names, etc.
|
|
bcc @invalid_pcount
|
|
|
|
@ok
|
|
|
|
stz my_fcr
|
|
stz my_fcr+2
|
|
stz my_vcr
|
|
stz my_vcr+2
|
|
stz cookie
|
|
|
|
|
|
; check fcr bit.
|
|
; n = fcr/vcr-based
|
|
; v = path-based
|
|
bit table,x
|
|
bmi @vcr
|
|
bvc @call
|
|
|
|
@path
|
|
; path checking...
|
|
|
|
jsr find_host_device
|
|
jsr check_path1
|
|
bcc @call
|
|
jml sys_exit
|
|
|
|
@vcr
|
|
; deref vcr and 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
|
|
|
|
ldx vcr_ptr
|
|
ldy vcr_ptr+2
|
|
jsl deref
|
|
stx my_vcr
|
|
sty my_vcr+2
|
|
|
|
@call
|
|
; 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...
|
|
ldx <tmp
|
|
jmp (app_table,x)
|
|
|
|
|
|
|
|
|
|
@bad_system_call
|
|
lda #bad_system_call
|
|
sec
|
|
jml sys_exit
|
|
|
|
@invalid_pcount
|
|
lda #invalid_pcount
|
|
sec
|
|
jml sys_exit
|
|
|
|
@vol_not_found
|
|
lda #vol_not_found
|
|
sec
|
|
jml sys_exit
|
|
|
|
|
|
|
|
|
|
|
|
app_table
|
|
dc.w rtl_bad_system_call ;
|
|
dc.w create ; ($01) Create
|
|
dc.w destroy ; ($02) Destroy
|
|
dc.w rtl_bad_system_call ; ($03) OS Shutdown
|
|
dc.w change_path ; ($04) Change Path
|
|
dc.w set_file_info ; ($05) Set File Info
|
|
dc.w get_file_info ; ($06) Get File Info
|
|
dc.w judge_name ; ($07) Judge Name
|
|
dc.w volume ; ($08) Volume
|
|
dc.w rtl_bad_system_call ; ($09) Set Prefix
|
|
dc.w rtl_bad_system_call ; ($0A) Get Prefix
|
|
dc.w rtl_invalid_fst_op ; ($0B) Clear Backup Bit
|
|
dc.w rtl_bad_system_call ; ($0C) Set Sys Prefs
|
|
dc.w rtl_no_error ; ($0D) Null
|
|
dc.w rtl_bad_system_call ; ($0E) Expand Path
|
|
dc.w rtl_bad_system_call ; ($0F) Get Sys Prefs
|
|
dc.w open ; ($10) Open
|
|
dc.w rtl_bad_system_call ; ($11) NewLine
|
|
dc.w read ; ($12) Read
|
|
dc.w write ; ($13) Write
|
|
dc.w close ; ($14) Close
|
|
dc.w flush ; ($15) Flush
|
|
dc.w set_mark ; ($16) Set Mark
|
|
dc.w get_mark ; ($17) Get Mark
|
|
dc.w set_eof ; ($18) Set EOF
|
|
dc.w get_eof ; ($19) Get EOF
|
|
dc.w rtl_bad_system_call ; ($1A) Set Level
|
|
dc.w rtl_bad_system_call ; ($1B) Get Level
|
|
dc.w get_dir_entry ; ($1C) Get Dir Entry
|
|
dc.w rtl_bad_system_call ; ($1D) Begin Session
|
|
dc.w rtl_bad_system_call ; ($1E) End Session
|
|
dc.w rtl_bad_system_call ; ($1F) Session Status
|
|
dc.w get_dev_num ; ($20) Get Dev Num
|
|
dc.w rtl_bad_system_call ; ($21) Get Last Dev
|
|
dc.w rtl_bad_system_call ; ($22) Read Block
|
|
dc.w rtl_bad_system_call ; ($23) Write Block
|
|
dc.w format ; ($24) Format
|
|
dc.w erase_disk ; ($25) Erase Disk
|
|
dc.w rtl_bad_system_call ; ($26) Reset Cache
|
|
dc.w rtl_bad_system_call ; ($27) Get Name
|
|
dc.w rtl_bad_system_call ; ($28) Get Boot Vol
|
|
dc.w rtl_bad_system_call ; ($29) Quit
|
|
dc.w rtl_bad_system_call ; ($2A) Get Version
|
|
dc.w rtl_bad_system_call ; ($2B) Get FST Info
|
|
dc.w rtl_bad_system_call ; ($2C) D_INFO
|
|
dc.w rtl_bad_system_call ; ($2D) D_STATUS
|
|
dc.w rtl_bad_system_call ; ($2E) D_CONTROL
|
|
dc.w rtl_bad_system_call ; ($2F) D_READ
|
|
dc.w rtl_bad_system_call ; ($30) D_WRITE
|
|
dc.w rtl_bad_system_call ; ($31) Alloc Interrupt
|
|
dc.w rtl_bad_system_call ; ($32) Dealloc Interrupt
|
|
dc.w rtl_invalid_fst_op ; ($33) FST Specific
|
|
max_app_call equ *-app_table-2
|
|
|
|
|
|
|
|
; insight - vcr and fcr always go together.
|
|
vcr_used equ $8000
|
|
fcr_used equ $0000
|
|
path_used equ $4000
|
|
|
|
table ; stores max pcount + 1
|
|
dc.w 0
|
|
dc.w 8+path_used ; ($01) Create
|
|
dc.w 2+path_used ; ($02) Destroy
|
|
dc.w 0 ; ($03) OS Shutdown
|
|
dc.w 4+path_used ; ($04) Change Path
|
|
dc.w 13+path_used ; ($05) Set File Info
|
|
dc.w 13+path_used ; ($06) Get File Info
|
|
dc.w 7 ; ($07) Judge Name
|
|
dc.w 7 ; ($08) Volume
|
|
dc.w 0 ; ($09) Set Prefix
|
|
dc.w 0 ; ($0A) Get Prefix
|
|
dc.w 2+path_used ; ($0B) Clear Backup Bit
|
|
dc.w 0 ; ($0C) Set Sys Prefs
|
|
dc.w 0 ; ($0D) Null
|
|
dc.w 0 ; ($0E) Expand Path
|
|
dc.w 0 ; ($0F) Get Sys Prefs
|
|
dc.w 16+path_used ; ($10) Open
|
|
dc.w 0 ; ($11) NewLine
|
|
dc.w 6+vcr_used+fcr_used ; ($12) Read
|
|
dc.w 6+vcr_used+fcr_used ; ($13) Write
|
|
dc.w 2+vcr_used+fcr_used ; ($14) Close
|
|
dc.w 3+vcr_used+fcr_used ; ($15) Flush
|
|
dc.w 4+vcr_used+fcr_used ; ($16) Set Mark
|
|
dc.w 3+vcr_used+fcr_used ; ($17) Get Mark
|
|
dc.w 4+vcr_used+fcr_used ; ($18) Set EOF
|
|
dc.w 3+vcr_used+fcr_used ; ($19) Get EOF
|
|
dc.w 0 ; ($1A) Set Level
|
|
dc.w 0 ; ($1B) Get Level
|
|
dc.w 18+vcr_used+fcr_used ; ($1C) Get Dir Entry
|
|
dc.w 0 ; ($1D)
|
|
dc.w 0 ; ($1E)
|
|
dc.w 0 ; ($1F)
|
|
dc.w 3+path_used ; ($20) Get Dev Num
|
|
dc.w 0 ; ($21) Get Last Dev
|
|
dc.w 0 ; ($22) Read Block
|
|
dc.w 0 ; ($23) Write Block
|
|
dc.w 7+path_used ; ($24) Format
|
|
dc.w 7+path_used ; ($25) Erase Disk
|
|
dc.w 0 ; ($26)
|
|
dc.w 0 ; ($27) Get Name
|
|
dc.w 0 ; ($28) Get Boot Vol
|
|
dc.w 0 ; ($29) Quit
|
|
dc.w 0 ; ($2A) Get Version
|
|
dc.w 0 ; ($2B) Get FST Info
|
|
dc.w 0 ; ($2C) D_INFO
|
|
dc.w 0 ; ($2D) D_STATUS
|
|
dc.w 0 ; ($2E) D_CONTROL
|
|
dc.w 0 ; ($2F) D_READ
|
|
dc.w 0 ; ($30) D_WRITE
|
|
dc.w 0 ; ($31) Alloc Interrupt
|
|
dc.w 0 ; ($32) Dealloc Interrupt
|
|
dc.w 0 ; ($33) FST Specific
|
|
|
|
debugstr str.b 'app_entry'
|
|
|
|
endp
|
|
|
|
|
|
|
|
|
|
close proc
|
|
with dp, fst_parms
|
|
|
|
lda #invalid_fst_op
|
|
ldx call_number
|
|
ldy cookie
|
|
sec
|
|
call_host
|
|
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
|
|
with dp, fst_parms
|
|
|
|
; slightly special since newline mode may be in effect.
|
|
|
|
ldy #fcr.mask
|
|
lda [my_fcr],y
|
|
sta >$009a00 ; hardcoded...
|
|
beq fd_op_ro
|
|
|
|
; 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_ro
|
|
|
|
endp
|
|
|
|
macro
|
|
&lab global
|
|
export &lab
|
|
&lab
|
|
endm
|
|
fd_op_ro proc
|
|
|
|
|
|
get_eof global
|
|
get_mark global
|
|
flush global
|
|
get_dir_entry global
|
|
|
|
|
|
with dp, fst_parms
|
|
|
|
; read, write, truncate, etc.
|
|
; everything (except close) that uses an fcr.
|
|
lda #invalid_fst_op
|
|
ldx call_number
|
|
ldy cookie
|
|
sec
|
|
call_host
|
|
rtl
|
|
endp
|
|
|
|
|
|
fd_op_rw proc
|
|
|
|
write global
|
|
set_eof global
|
|
set_mark global
|
|
|
|
with dp, fst_parms
|
|
|
|
; read, write, truncate, etc.
|
|
; everything (except close) that uses an fcr.
|
|
lda #invalid_fst_op
|
|
ldx call_number
|
|
ldy cookie
|
|
sec
|
|
call_host
|
|
post_event
|
|
rtl
|
|
endp
|
|
|
|
|
|
path_op_ro proc
|
|
|
|
|
|
get_file_info global
|
|
|
|
with dp, fst_parms
|
|
|
|
lda #invalid_fst_op
|
|
ldx call_number
|
|
sec
|
|
call_host
|
|
rtl
|
|
|
|
endp
|
|
|
|
path_op_rw proc
|
|
|
|
set_file_info global
|
|
create global
|
|
destroy global
|
|
erase_disk global
|
|
format global
|
|
|
|
with dp, fst_parms
|
|
|
|
lda #invalid_fst_op
|
|
ldx call_number
|
|
sec
|
|
call_host
|
|
post_event
|
|
rtl
|
|
|
|
endp
|
|
|
|
|
|
judge_name proc
|
|
|
|
with dp, fst_parms
|
|
|
|
; handle syntax message here. Need to return text pointer.
|
|
lda [param_blk_ptr]
|
|
cmp #3
|
|
bcc @no_syntax
|
|
ldy #JudgeNameRecGS.syntax
|
|
lda #syntax
|
|
sta [param_blk_ptr],y
|
|
iny
|
|
iny
|
|
lda #^syntax
|
|
sta [param_blk_ptr],y
|
|
|
|
@no_syntax
|
|
|
|
lda #invalid_fst_op
|
|
ldx call_number
|
|
sec
|
|
call_host
|
|
rtl
|
|
|
|
syntax str.b 'Names may contain any character except colon (:) or slash (/).'
|
|
|
|
endp
|
|
|
|
change_path proc
|
|
|
|
with dp, fst_parms
|
|
|
|
; todo -- verify both paths are on the device...
|
|
|
|
jsr check_path1
|
|
bcs exit
|
|
jsr check_path2
|
|
bcs exit
|
|
|
|
|
|
lda #invalid_fst_op
|
|
ldx call_number
|
|
sec
|
|
call_host
|
|
post_event
|
|
exit
|
|
rtl
|
|
|
|
endp
|
|
|
|
|
|
volume proc
|
|
; check if a volume is ours, create vcr if necessary.
|
|
|
|
with dp, fst_parms
|
|
|
|
;
|
|
; volume requires a device id. it doesn't fit
|
|
; into the standard table so we check for the
|
|
; .host device here.
|
|
;
|
|
|
|
jsr find_host_device
|
|
lda dev1_num
|
|
beq no
|
|
|
|
cmp dev_id
|
|
bne no
|
|
; yes!
|
|
|
|
lda #unknown_vol
|
|
ldx call_number
|
|
sec
|
|
call_host
|
|
bcc @ok
|
|
rtl
|
|
@ok
|
|
; name is hardcoded to Host.
|
|
jsr build_vcr
|
|
rtl
|
|
|
|
|
|
no
|
|
lda #unknown_vol
|
|
sec
|
|
rtl
|
|
|
|
endp
|
|
|
|
build_vcr proc
|
|
|
|
; for now, volume hard coded as 'Host'.
|
|
|
|
|
|
with dp
|
|
|
|
ldx #host_name
|
|
ldy #^host_name
|
|
lda #0
|
|
jsl find_vcr
|
|
bcs create_vcr
|
|
stx my_vcr_ptr
|
|
sty my_vcr_ptr+2
|
|
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 #host_name
|
|
ldy #^host_name
|
|
jsl alloc_vcr
|
|
stx my_vcr_ptr
|
|
sty my_vcr_ptr+2
|
|
|
|
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
|
|
|
|
host_name
|
|
str.w 'Host'
|
|
|
|
endp
|
|
|
|
get_dev_num proc
|
|
with dp, fst_parms
|
|
|
|
; have already verified path is valid.
|
|
lda dev_id
|
|
ldx call_class
|
|
ldy table,x
|
|
sta [param_blk_ptr],y
|
|
lda #0
|
|
clc
|
|
rtl
|
|
|
|
table
|
|
dc.w DevNumRec.devNum, DevNumRecGS.devNum
|
|
|
|
endp
|
|
|
|
;
|
|
; verify this path is for us
|
|
; (via dev number or :Host:)
|
|
;
|
|
check_path1 proc
|
|
|
|
with dp, fst_parms
|
|
|
|
lda dev1_num
|
|
beq path
|
|
cmp dev_id
|
|
beq ok
|
|
|
|
vnf
|
|
long m
|
|
lda #unknown_vol
|
|
sec
|
|
rts
|
|
|
|
bps
|
|
long m
|
|
lda #bad_path_syntax
|
|
sec
|
|
rts
|
|
|
|
ok
|
|
long m
|
|
lda #0
|
|
clc
|
|
rts
|
|
path
|
|
|
|
lda path_flag
|
|
and #$4000
|
|
beq bps
|
|
|
|
ldy #2
|
|
ldx #0
|
|
lda #0
|
|
short m
|
|
|
|
loop
|
|
lda [path1_ptr],y
|
|
cmp colon_host,y
|
|
beq @next
|
|
cmp colon_HOST,y
|
|
beq @next
|
|
bra vnf
|
|
@next
|
|
iny
|
|
cpy #5+2
|
|
bne loop
|
|
|
|
; check for trailing null / :
|
|
lda [path1_ptr],y
|
|
beq @ok
|
|
cmp #':'
|
|
beq @ok
|
|
|
|
bra vnf
|
|
@ok
|
|
bra ok
|
|
|
|
longa on
|
|
longi on
|
|
|
|
endp
|
|
|
|
|
|
check_path2 proc
|
|
|
|
with dp, fst_parms
|
|
|
|
lda dev2_num
|
|
beq path
|
|
cmp dev_id
|
|
beq ok
|
|
|
|
vnf
|
|
long m
|
|
lda #unknown_vol
|
|
sec
|
|
rts
|
|
|
|
bps
|
|
long m
|
|
lda #bad_path_syntax
|
|
sec
|
|
rts
|
|
|
|
ok
|
|
long m
|
|
lda #0
|
|
clc
|
|
rts
|
|
path
|
|
|
|
lda path_flag
|
|
and #$0040
|
|
beq bps
|
|
|
|
ldy #2
|
|
ldx #0
|
|
lda #0
|
|
short m
|
|
|
|
loop
|
|
lda [path2_ptr],y
|
|
cmp colon_host,y
|
|
beq @next
|
|
cmp colon_HOST,y
|
|
bne vnf
|
|
@next
|
|
iny
|
|
cpy #5+2
|
|
bne loop
|
|
|
|
; check for trailing null / :
|
|
lda [path2_ptr],y
|
|
beq @ok
|
|
cmp #':'
|
|
beq @ok
|
|
|
|
bra vnf
|
|
@ok
|
|
bra ok
|
|
|
|
longa on
|
|
longi on
|
|
|
|
endp
|
|
|
|
open proc
|
|
|
|
|
|
with dp, fst_parms
|
|
|
|
jsr build_vcr
|
|
bcs exit
|
|
|
|
lda #invalid_fst_op
|
|
ldx call_number
|
|
sec
|
|
call_host
|
|
bcs exit
|
|
stx cookie
|
|
sty tmp ; actual read/write access
|
|
|
|
; build the fcr.
|
|
lda #fcr.__sizeof
|
|
ldx #colon_Host
|
|
ldy #^colon_Host
|
|
jsl alloc_fcr
|
|
bcs close
|
|
|
|
jsl deref
|
|
stx my_fcr
|
|
sty my_fcr+2
|
|
|
|
; need to re-deref the vcr?
|
|
; vcr_ptr is actually a pathname.
|
|
ldx my_vcr_ptr
|
|
ldy my_vcr_ptr+2
|
|
jsl deref
|
|
stx my_vcr
|
|
sty my_vcr+2
|
|
|
|
|
|
ldy #vcr.open_count
|
|
lda [my_vcr],y
|
|
inc a
|
|
sta [my_vcr],y
|
|
|
|
lda tmp
|
|
ldy #fcr.access
|
|
sta [my_fcr],y
|
|
|
|
lda #fst_id
|
|
ldy #fcr.fst_id
|
|
sta [my_fcr],y
|
|
|
|
lda cookie
|
|
ldy #fcr.cookie
|
|
sta [my_fcr],y
|
|
|
|
|
|
ldy #vcr.id
|
|
lda [my_vcr],y
|
|
ldy #fcr.vcr_id
|
|
sta [my_fcr],y
|
|
|
|
; store the refnum for output.
|
|
; conveniently, call_class is the offset.
|
|
lda [my_fcr]
|
|
ldy call_class
|
|
sta [param_blk_ptr],y
|
|
|
|
exit_ok
|
|
lda #0
|
|
clc
|
|
exit
|
|
rtl
|
|
|
|
close
|
|
;; oops! close it!
|
|
lda #0
|
|
ldx #$2014
|
|
ldy cookie
|
|
call_host
|
|
sec
|
|
lda #out_of_mem
|
|
rtl
|
|
|
|
endp
|
|
|
|
|
|
end
|