;
;
; loader
;
; currently limited to 512-byte blocks (32MB max filesystem)
; need to use smartport protocol to use > 65535 blocks anyhow.
;



	include 'hfs.aii'
	include 'macros.aii'
	include 'e16.gsos'

	string asis
	blanks on


__smartport__	set 1


	if __smartport__ then
	include 'smartport.aii'
	endif

;
; 32-bit version large volumes.
ExtendedExtent		RECORD 0
startBlock		ds.l	1	; offset: $0 (0)	;  first allocation block 
blockCount		ds.l	1	; offset: $4 (8)	;  number of allocation blocks 
sizeof			EQU *		; size:   $8 (8)
			ENDR



buffer	equ $3000

zp	record 0
ptr	ds.l 1
path	ds.l 1


r0	ds.w 1
r1	ds.w 1
r2	ds.w 1
r3	ds.w 1

; readfile
eof	ds.l 1
blocks	ds.w 1  ; shouldn't exceed $ffff blocks
ft	ds.w 1
at	ds.w 1
st	ds.w 1
file_id	ds.l 1



extents		ds.b	3*ExtendedExtent.sizeof

; multiplication stuff
m1		ds.w	1
m2		ds.l	1
m3		ds.l	1



; too much zp space...
	if not __smartport__ and * >= $42 then
	aerror 'too much zero-page space'
	endif

	endr




	if not __smartport__ then
pro		record $42
cmd		ds.b 1
unit		ds.b 1
dataBuffer	ds.b 2
blockNumber	ds.b 2
		endr

	endif


	entry read_block_abs, read_block_abs_long
	entry prepare_path, cat_lookup
	entry read_cat_block, read_file_block
	entry extent_to_extent


header	proc

	import readfile, getbootname, getfstname, startup
	entry auxtype

	jmp startup
	nop

	dc.w readfile
	dc.w getbootname
	dc.w getfstname
	dc.w startup-header ; size of permanent code
auxtype	dc.w 0

	endp


data	record
; store catalog info
;slot		dc.w 0
;unit		dc.w 0
;vector		dc.w 0

startingBlock	dc.w 0
blockMultiplier	dc.w 0


cat_extents	ds.b 3*ExtendedExtent.sizeof
file_extents	ds.b 3*ExtendedExtent.sizeof

cat_root	dc.w 0

system_id	dc.l 0
fsts_id		dc.l 0
drivers_id	dc.l 0


; ctree lookup
target_parent	dc.l 0

target_str_len	dc.w 0
target_str	dcb.b 32, 0

cat_str_len	dc.w 0
cat_str		dcb.b 32, 0

	endr

	if __smartport__ then
sp		record
pCount		dc.b	3
unit		dc.b	1
dataBuffer	dc.w	$3000 ; name conflict...
blockNumber	dc.l	0 ; actually 24-bit
		endr
	endif


_stack	ds.w 1

getbootname proc
	; getbootname(GSString *)
	; return string needs a leading colon.

	with zp

	plx ; rts
	ply
	sty ptr
	ply
	sty ptr+2
	phx

	phb
	phk
	plb

	; prepare the stack for emulation mode
	tsx
	stx _stack
	ldx #$01ff ; should be enough space
	txs


; get the volume name from the HFS MDB....
	if not __smartport__ then
	lda #buffer
	sta pro.dataBuffer
	endif
	lda #2
	ldx #0
	jsr read_block_abs

	; restore the stack. does not affect a/carry
	ldx _stack
	txs

	bcs exit	

	with HFSMasterDirectoryBlock
	lda buffer+drVN
	and #$ff
	inc a ; + 1 for :
	sta [ptr]
	inc a ; round up and divide
	lsr a
	tax ; count
	dex

	ldy #2
	lda #':'
	sta [ptr],y
	iny
@loop	lda buffer+drVN-2,y
	sta [ptr],y
	iny
	iny
	dex
	bpl @loop

	clc
	lda #0

exit
	plb
	rts

	endp	


getfstname proc
	; getfstname(GSString *)

	with zp

	plx ; rts
	ply
	sty ptr
	ply
	sty ptr+2
	phx

	phb
	phk
	plb

	ldy #10-2 ; 7 + 2 + 1 byte to round up.

@loop	lda name,y
	sta [ptr],y
	dey
	dey
	bpl @loop

	plb
	clc
	lda #0
	rts

name	str.w 'hfs.fst'
	dcb.b 1,0

	endp



readfile proc
; (eof, aux type, file type) readfile(GSString *, void *)
	with zp

	plx ; rts
	ply
	sty ptr ; data buffer
	ply
	sty ptr+2
	ply
	sty path ; pathname 
	ply
	sty path+2
	phx

	phb
	phk
	plb

	; prepare the stack for emulation mode
	tsx
	stx _stack
	ldx #$01ff ; should be enough space
	txs


	jsr prepare_path
	bcs exit

	jsr cat_lookup
	bcs exit




	; now read file, one block at a time,
	; and copy to ptr.
	lda blocks
	beq rdone
	stz r0 ; block

	if not __smartport__ then
	lda #buffer
	sta pro.dataBuffer
	endif
	; need to re-set cmd/slot as well?

@rloop
	lda r0
	jsr read_file_block
	bcs exit


	; copy to destination
	pea buffer>>16 ; src
	pea buffer
	pei ptr+2 ; dest
	pei ptr
	pea 0 ; count
	pea 512 
	_BlockMove


	lda ptr
	clc
	adc #512
	sta ptr
	lda ptr+2
	adc #0
	sta ptr+2

	inc r0
	dec blocks
	bne @rloop

rdone


; ...

	ldx _stack
	txs

	; stack: b, rts,
	lda ft
	sta 4,s
	lda at
	sta 6,s
	lda eof
	sta 8,s
	lda eof+2
	sta 10,s

	lda #0
	clc
	plb
	rts

exit
	ldx _stack
	txs
	plb
	rts

	endp

prepare_path proc
	
	with zp, data

; optimism
	stz r0 ; offset into path
	lda system_id
	sta target_parent
	lda system_id+2
	sta target_parent+2


	lda [path]
	cmp #8
	blt err

; SYSTEM ?
	ldx #3
	ldy #2
@loop
	lda [path],y
	cmp s1,y
	bne err
	iny
	iny
	dex
	bne @loop

	lda [path],y
	iny
	sty r0

	cmp #'D:'
	beq d
	cmp #'F:'
	beq f

	and #$ff
	cmp #':'
	beq sys
err	lda #fileNotFound
	sec
	rts

sys	brl target
	; check for more ':' ?

d	; check for a driver folder.
	lda [path]
	cmp #16
	blt sys
	ldx #4
@loop	lda [path],y
	cmp s2,y
	bne sys
	iny
	iny
	dex
	bne @loop
	; match!
	sty r0
	lda drivers_id
	sta target_parent
	lda drivers_id+2
	sta target_parent+2
	brl target

f	; check for FSTs folder
	lda [path]
	cmp #13
	blt sys
	ldx #2
@loop	lda [path],y
	cmp s3,y
	bne sys
	iny
	iny
	dex
	bne @loop
	lda [path],y
	and #$ff
	cmp #':'
	bne sys
	iny
	sty r0
	lda fsts_id
	sta target_parent
	lda fsts_id+2
	sta target_parent+2

	; drop through

target
; now set target_str / len
	lda [path]
	inc a
	inc a ; compensate for string length.
	sec
	sbc r0
	beq fnf ; close enough
	bmi fnf
	sta target_str_len
	cmp #16
	bcs fnf

	ldx #30
@zloop	stz target_str,x
	dex
	dex
	bpl @zloop

	short m
	ldx #0
@loop
	lda [path],y
	cmp #':'
	beq fnf
	cmp #'z'+1
	bge @next
	cmp #'a'
	blt @next
	and #$ff xor $20

@next	sta target_str,x
	iny
	inx
	cpx target_str_len
	blt @loop

	long m
	lda #0
	clc
	rts

fnf	long m
	lda #fileNotFound
	sec
	rts


s1	dc.b 'xxSYSTEM:'
s2	dc.b 'xxSYSTEM:DRIVERS:'
s3	dc.b 'xxSYSTEM:FSTS:'

	endp


read_file_block proc
; a = block #

	with data,ExtendedExtent

@0
	cmp file_extents+(sizeof*0)+blockCount
	bcs @1
;	clc
	ldx #sizeof*0+startBlock
	bra found

@1	sbc file_extents+(sizeof*0)+blockCount
	cmp file_extents+(sizeof*1)+blockCount
	bcs @2
;	clc
	ldx #sizeof*1+startBlock
	bra found

@2	sbc file_extents+(sizeof*1)+blockCount
	cmp file_extents+(sizeof*2)+blockCount
	bcs @3
	ldx #sizeof*2+startBlock
	bra found

@3
	lda #outOfRange ; too big
	sec
	rts


found	;
	clc
	adc file_extents,x
	sta sp.blockNumber
	lda #0
	adc file_extents+2,x
	sta sp.blockNumber+2

	clc
	lda startingBlock
	adc sp.blockNumber
	sta sp.blockNumber
	lda #0
	adc sp.blockNumber+2
	sta sp.blockNumber+2
	bra read_block_abs_long

	endp

read_cat_block proc
; a = block #


	with data,ExtendedExtent

@0
	cmp cat_extents+(sizeof*0)+blockCount
	bcs @1
;	clc
	ldx #sizeof*0+startBlock
	bra found

@1	sbc cat_extents+(sizeof*0)+blockCount
	cmp cat_extents+(sizeof*1)+blockCount
	bcs @2
;	clc
	ldx #sizeof*1+startBlock
	bra found

@2	sbc cat_extents+(sizeof*1)+blockCount
	cmp cat_extents+(sizeof*2)+blockCount
	bcs @3
	ldx #sizeof*2+startBlock
	bra found

@3
	lda #outOfRange ; too big
	sec
	rts

found	;
	clc
	adc cat_extents,x
	sta sp.blockNumber
	lda #0
	adc cat_extents+2,x
	sta sp.blockNumber+2

	clc
	lda startingBlock
	adc sp.blockNumber
	sta sp.blockNumber
	lda #0
	adc sp.blockNumber+2
	sta sp.blockNumber+2
	bra read_block_abs_long

	endp




read_block_abs proc
	entry read_block_abs_long
	entry vector

	; input
	; a = hfs block #
	; will be adjusted for allocation block offset
	;
;	clc
;	adc data.startingBlock

	if __smartport__ then
	sta sp.blockNumber
	stx sp.blockNumber+2
	else
	sta pro.blockNumber
	endif

read_block_abs_long
	php
	sec
	xce
	dc.b $20 ; jsr
vector	dc.w $ffff
	if __smartport__ then
	dc.b Command.ReadBlock
	dc.w sp
	endif

	bcs @fail
	xce
	plp
	lda #0
	clc
	rts

@fail	
	clc
	xce
	plp
	and #$ff
	sec
	rts

	endp




cat_lookup proc

	import name_check, match

	with data

bnum	equ zp.r0
prev	equ zp.r1
count	equ zp.r2

	; search for a file and a parent directory.

	lda cat_root
	sta bnum


descend
	ldx #-1
	stx prev

next_index
	lda bnum
	jsr read_cat_block
	bcc @ok
	rts ; uhoh
@ok
	lda buffer+BTNodeDescriptor.numRecords
	beq advance
	xba
	sta count

	ldx #512-2 ; last entry
eloop
	lda buffer,x ; entry offset
	xba
	tay
	lda buffer+HFSCatalogKey.parentID,y
	xba
	cmp target_parent+2
	beq @p2
	blt @lt
	bge @gt

@p2	lda buffer+HFSCatalogKey.parentID+2,y
	xba
	cmp target_parent
	beq @nm
	blt @lt
	bge @gt

@gt
	; if this is an index node,
	; we overshot, so follow the tree via prev
	; to the next level.
	lda prev
	sta bnum
	; index map is 0xff so ora / bmi works.
	ora buffer+BTNodeDescriptor.kind-1
	bmi fnf ; index map
	bra descend

; now do a name check....
; target_name is UPPER CASE
@nm
	jsr name_check
	cmp #0
	beq @found
	bmi @lt
	bra @gt


@found
	; a match! if this is an index node,
	; descend....
	lda buffer+BTNodeDescriptor.kind-1
	bmi @leaf
	lda buffer+38+2,y
	xba
	sta bnum
	bra descend
@leaf	jmp match




; if this is an index node, keep it for later
@lt	lda buffer+38+2,y
	xba
	sta prev

@next
	dex
	dex
	dec count
	bne eloop

advance
	; wait a minute ... do we ever need to follow the next link?
	; first entry of next node is always > target.
	; so we can just descend via prev ptr.
;	lda buffer+BTNodeDescriptor.fLink+2
;	beq @last
;	xba
;	sta bnum
;	bra next_index
@last	; if there was a prev node, descend into it
	; but not if this is a map node
	lda prev
	sta bnum
	ora buffer+BTNodeDescriptor.kind-1
	bpl descend
;	bmi fnf
;	sta bnum
;	bra descend

fnf
	lda #fileNotFound
	sec
	rts
	endp

name_check proc
	; copy into catstr and upper case it.

	; save x and y.
	;
	; a = 0 if match
	; a = -1 if catalog entry < target
	; a = +1 if catalog entry > target

	with data

	phx
	phy ; save


;
; we need to handle 0-length strings (folder threads)
;


	ldx #30
@zloop	stz cat_str,x
	dex
	dex
	bpl @zloop
	stz cat_str_len
	ldx #0
	short m

	lda buffer+HFSCatalogKey.nodeName,y
	sta cat_str_len
	beq cmp

; copy and upper case the string.
copy
	lda buffer+HFSCatalogKey.nodeName+1,y
	cmp #'a'
	blt @store
	cmp #'z'+1
	bge @store
	and #$ff xor $20

@store
	sta cat_str,x
	iny
	inx
	cpx cat_str_len
	blt copy


cmp
	lda target_str_len
	ora cat_str_len
	beq eq ; folder thread - no name.

	ldx target_str_len
	cpx cat_str_len
	bge @x
	ldx cat_str_len
@x
	ldy #0
@loop
	lda cat_str,y
	cmp target_str,y
	beq @next
	blt lt
	bge gt

@next
	iny
	dex
	bne @loop

eq	long m
	lda #0
	bra exit

lt	long m
	lda #-1
	bra exit

gt	long m
	lda #1
	
exit	
	ply
	plx
	rts

	endp

match	proc
; a match!
; store the file type, aux type, eof, and extent pointers.

	with zp, data

	lda buffer+HFSCatalogKey.keyLength,y
;	and #$ff
	inc a ; length doesn't include itself
	inc a ; pad to a word boundary.
	and #$fe 
	sta r0

	lda buffer,x ; x still valid
	xba
	clc
	adc r0
	tay

	lda buffer+HFSCatalogFile.recordType,y
	and #$ff
	cmp #kHFSFolderRecord
	beq folder
	cmp #kHFSFileRecord
	beq file
	; folder thread, file thread.... invalid for us.
	lda #fileNotFound
	sec
	rts
folder
	with HFSCatalogFolder
	stz eof
	stz eof+2
	stz blocks
	stz at
	lda #$f
	sta ft
	lda #$0d
	sta st ; storage type
	ldx #3*ExtendedExtent.sizeof-2
@eloop
	stz file_extents,x
	dex
	dex
	bpl @eloop


	lda buffer+folderID+2,y
	xba
	sta file_id
	lda buffer+folderID,y
	xba
	sta file_id+2

	lda #0
	clc
	rts
	endwith

file
	with HFSCatalogFile
	lda buffer+dataLogicalSize+2,y
	xba
	sta eof
	lda buffer+dataLogicalSize,y
	xba
	sta eof+2

	; blocks
	; update if variable block size?
	lda buffer+dataPhysicalSize+2,y
;	xba
	lsr a ; >>9 since already xba
	and #%01111111
	sta blocks


	lda #1
	sta st ; storage type

	phy ; save
	tya
	clc
	adc #dataExtents
	tay
;	ldy #dataExtents
	jsr extent_to_extent
	lda #3*ExtendedExtent.sizeof-1
	ldx #extents
	ldy #file_extents
	mvn $00,$00
	; a, x, y clobbered.
	ply

	lda buffer+fileID+2,y
	xba
	sta file_id
	lda buffer+fileID,y
	xba
	sta file_id+2

; file type aux type logic.
; only support pdos encoding, nothing fancy.
; 'p' filetype aux type pdos
; where filetype = 8 bit, aux type = 16 bit big endian

	stz ft
	stz at
	lda buffer+userInfo+4,y
	cmp #'dp'
	bne noft
	lda buffer+userInfo+4+2,y
	cmp #'so'
	bne noft
pdos
	lda buffer+userInfo,y
	tax
	and #$ff
	cmp #'p'
	bne noft
	txa
	xba
	and #$ff
	sta ft
	lda buffer+userInfo+2,y
	xba
	sta at
noft

	lda #0
	clc
	rts
	endwith

	endp


	macro
&lab	ifc_fail &str
&lab	bcc @ok
	pha
	pea @str>>16
	pea @str
	_SysFailMgr
	brk $ea
@str	str.b &str
@ok
	mend

;
; everything below here will be clobbered.
;
startup proc
;
; load the catalog extents
; lookup :system, :system:driver, :system:fsts, system:system:setup folders to save time later?
;
;

; read :system:start.gsos, load into memory @ $6800
; aux type is stored in auxtype

	with zp, data

; assume 16-bit, etc.   

; unit still active from before, for now....

;	stx slot
	sty vector
;	sta unit

	lda #0
	tcd
	ldx #$1ff
	txs


	if not __smartport__ then
	lda #buffer
	sta pro.dataBuffer
	short m
	lda #1
	sta pro.cmd
	long m
	endif

	with HFSMasterDirectoryBlock
	lda #2
	ldx #0
	jsr read_block_abs
	; shouldn't fail.
	lda buffer+drAlBlSt
	xba
	sta startingBlock

	lda buffer+drAlBlkSiz+1
	xba
	lsr a ; / 2
	sta blockMultiplier

; catalog extents
	ldy #drCTExtRec ; offset
	jsr extent_to_extent

	lda #3*ExtendedExtent.sizeof-1
	ldx #extents
	ldy #cat_extents
	mvn $00,$00
	; a, x, y clobbered. 

; save the volume name while we're at it?

	endwith

; find the root node.
	lda #0
	jsr read_cat_block

	with BTHeaderRec
	lda buffer+BTNodeDescriptor.sizeof+rootNode+2
	xba
	sta cat_root

;
; lookup SYSTEM
;
	lda #kHFSRootFolderID
	sta target_parent
	lda #kHFSRootFolderID>>16
	stz target_parent+2
	ldx #30
@zloop	stz target_str,x
	dex
	dex
	bpl @zloop

	ldx #14-2
sloop
	lda sys,x
	sta target_str_len,x
	dex
	dex
	bpl sloop

	jsr cat_lookup
	ifc_fail 'Missing System folder. Error=$'

; also check if dir?

	lda file_id
	sta system_id
	sta target_parent
	lda file_id+2
	sta system_id+2
	sta target_parent+2

; lookup System:FSTs

	ldx #14-2
floop
	lda fsts,x
	sta target_str_len,x
	dex
	dex
	bpl floop

	jsr cat_lookup
	ifc_fail 'Missing System:FSTs folder. Error=$'

; also check if dir?

	lda file_id
	sta fsts_id
	lda file_id+2
	sta fsts_id+2

; lookup System:Drivers

	ldx #14-2
dloop
	lda drv,x
	sta target_str_len,x
	dex
	dex
	bpl dloop

	jsr cat_lookup
	ifc_fail 'Missing System:Drivers folder. Error=$'

; also check if dir?

	lda file_id
	sta drivers_id
	lda file_id+2
	sta drivers_id+2


; lookup System:Start.GS.OS
	ldx #14-2
@gloop
	lda gsos,x
	sta target_str_len,x
	dex
	dex
	bpl @gloop

	jsr cat_lookup
	ifc_fail 'Missing System:Start.GS.OS. Error=$'



read
	stz r0
	lda blocks
	beq bad

	lda #$6800
	if __smartport__ then
	sta sp.dataBuffer
	else
	sta pro.dataBuffer
	endif

@loop	lda r0
	jsr read_file_block
	bcs bad
;	clc
	lda #512
	if __smartport__ then
	adc sp.dataBuffer
	sta sp.dataBuffer
	else
	adc pro.dataBuffer
	sta pro.dataBuffer
	endif
	inc r0
	dec blocks
	bne @loop


	lda at
	sta auxtype

	lda #buffer
	if __smartport__ then
	sta sp.dataBuffer
	else
	sta pro.dataBuffer ; kind of important...
	endif

	lda #0
	jmp $6800

bad	pha
	pea @str>>16
	pea @str
	_SysFailMgr
	brk $ea
@str	str.b 'Error reading Start.GS.OS. Error=$'


; buffered out to same length.
sys	str.w 'SYSTEM'
	dcb.b  6,0
fsts	str.w 'FSTS'
	dcb. 8,0
drv	str.w 'DRIVERS'
	dcb.b 5,0
gsos	str.w 'START.GS.OS'
	dcb.b 1,0
	endp


multiply proc
; inputs: m1 (16-bit), m2 (32-bit)
; outputs: m3 (32-bit)
; m1, m2 clobbered
	with zp

	stz m3
	stz m3+2
	lda m1
	beq rts
	lda m2
	ora m3
	beq rts

loop
	lsr m1
	bcc next

add	clc
	lda m2
	adc m3
	sta m3
	lda m2+2
	adc m3+2
	sta m3+2

next	asl m2
	rol m2+2
	lda m1
	bne loop	

rts	rts
	endp

extent_to_extent proc
	; y = offset into buffer.
	; clobbers x, y
	with zp, data
	import multiply

	ldx #0
loop1
	lda buffer,y
	xba
	sta extents,x
	stz extents+2,x
	iny
	iny
	inx
	inx
	inx
	inx
	cpx #3*4*2
	blt loop1

; now multiply...
	lda blockMultiplier
	dec a
	beq rts

	ldx #3*4*2-4
loop2
	lda blockMultiplier
	sta m1
	lda extents+0,x
	sta m2
	stz m2+2
	jsr multiply
	lda m3
	sta extents+0,x
	lda m3+2
	sta extents+2,x

	dex
	dex
	dex
	dex
	bpl loop2


rts	rts
	endp


	end