;
; (c) Jouni 'Mr.Spiv' korhonen of Scoopex
; DOS loader for Smarty and the Nasty Gluttons
;

buffer=		$7b460				;MFM buffer ($3300 bytes)
prog=		$400				;place of loader & stack
first=		$4000				;load first program here


		org	$60000

		;section	code,code_c



;-------------------------------------------------
j:
		move.l	$4.w,a6
		lea	.gfxlib(pc),a1
		jsr	-$198(a6)		; OldOpenLibrary()
		move.l	d0,a5
		tst.l	d0
		bne.b   .ok
		moveq	#-1,d0
		rts
		;
.ok:		;jsr	-132(a6)		; Forbid()
		;
		; Traverse memlist - find largest RAM block beyond
		; 512K CHIP RAM
		; Returns largest memory block in
		;   D4 = memory start
		;   D5 = memory size
		;
		moveq	#$00,d4
		moveq	#$00,d5
		lea     $142(a6),a0
		move.l 	$08(a0),a1
		move.l 	(a0),a0
.loop:		move.w	$0E(a0),d2
		movem.l	$14(a0),d0-d1
		btst	#$01,d2
		beq.b	.notchip
		moveq	#$08,d0
		swap	d0
		cmp.l	d0,d1
		bhs.b	.notchip
		move.l	d0,d1
		;
.notchip:	clr.w	d0
		sub.l	d0,d1
		cmp.l	d5,d1
		bls.b	.skip
		move.l	d0,d4
		move.l	d1,d5
.skip:		cmpa.l	a0,a1
		beq.b	.done
		movea.l	(a0),a0
		bra.b	.loop
		;
.done:		exg	a6,a5
		; Take over the screen
		suba.l  a1,a1
		jsr     -$DE(a6)		; LoadView(NULL)
		jsr     -$10E(a6)		; WaitTOF()
		jsr     -$10E(a6)		; WaitTOF()
		lea     $DFF002,a4
		; Make sure AGA stuff is "off" and we are using ECS
		moveq   #$00,d0
		move.w  d0,$1FA(a4)
		move.w  #$0C00,$104(a4)
		move.w  #$0011,$10A(a4)
		; Force PAL
		move.w  #$0020,$1DA(a4)
		; Screen to black
		move.w  d0,$17E(a4)
		exg     a6,a5
		; Get Attn flags to check the CPU
		move.w  $128(a6),d2
		; Check for caches and stuff..
		btst	#1,d2
		beq.b	.not020
		;
		cmp.w	#37,$14(a6)		; LIBVERSION
		blo.b	.not020
		;
		move.l	#$101,d1		; CACRF_EnableI|CACRF_EnableD
		moveq	#0,d0
		jsr	-$288(a6)		; _LVOCacheControl
		; Switch to SuperVisor mode
.not020:	lea     .magic(pc),a5
		jmp     -$1E(a6)		; SuperVisor()

.gfxlib:	dc.b	"graphics.library",0
		even


; System off
.magic:		move.w  #$7FFF,$98(a4)
		move.w  #$7FFF,$94(a4)
		moveq   #$7F,d0
		move.b  d0,$BFDD00
		move.b  d0,$BFED01
		btst    #$00,d2
		beq.b   .68k
		; If we got better than 68000 clear VBR
		moveq   #$00,d0
		dc.w	$4e7b,$0801		; movec	d0,vbr
.68k:
		; D4=memstart, D5=memsize
		move.l  d4,d0
		beq.s   nomem
		; $8C = start of extra mem
		; $90 = end of extra mem
		move.l	d5,a0
		movem.l d0/a0,$8C.w
		; SSP to top of extra memory
		add.l	d0,a0
		move.l	a0,sp
		; USP 1K lower
		lea     -$400(a0),a0
		move    a0,usp
		; Back to user mode
		move    #$0000,sr
		lea     $C0.w,a3
		;lea     $800c0,a3
		move.l	a3,a4
		;
		; A0 = $7B460 -> MFM buffer ($3300 bytes)
		; A1 = $7E760 -> last track buffer ($18a0 bytes)
		; A2 = $7d8   -> file table
		; A3 = $C0    -> loader code
		; A4 = $880   -> loader code end
		;
		; $84 = loader address
		; $88 = file table
		;
		lea	loader_sta(pc),a0
		;move.w	#(loader_end-loader_sta)/2-1,d0
		move.w	#(fe-loader_sta)/2-1,d0
.move:		move.w	(a0)+,(a4)+
		dbf	d0,.move
		movem.l	a3-a4,$84.w
		;
		moveq	#0,d0
		pea	$50000
		move.l	(sp),a1
		jmp	12(a3)

; "no memory" code here.
;
;
nomem:		lea	logo(pc),a0
		lea	logoscr+2(pc),a1
		moveq	#4-1,d0
.loop:		move.l	a0,d1
		move.w	d1,4(a1)
		swap	d1
		move.w	d1,(a1)
		addq.l	#8,a1
		add.w	#40,a0
		dbf	d0,.loop
		;		
		lea	logocopper(pc),a0
		move.l	a0,$80-2(a4)
		move.w	#$8380,$96-2(a4)
.forever:	bra.b	.forever

logocopper:
	dc.l	$01800214,$01820999,$01840645,$01860A89
	dc.l	$01880756,$018A0CAB,$018C0422,$018E0FFF
	dc.l	$01900CCC,$01920867,$01940555,$01960333
	dc.l	$01980EA4,$019A0B73,$019C0841,$019E0940
	dc.l	$01200000,$01220000,$01240000,$01260000
	dc.l	$01280000,$012A0000,$012C0000,$012E0000
	dc.l	$01300000,$01320000,$01340000,$01360000
	dc.l	$01380000,$013A0000,$013C0000,$013E0000
	dc.l	$01080078,$010A0078,$01020000,$00920038
	dc.l	$009400D0,$008E2C81,$00902CC1
logoscr:
	dc.l	$00E00000,$00E20000,$00E40000,$00E60000
	dc.l	$00E80000,$00EA0000,$00EC0000,$00EE0000
	dc.l	$780FFFFE
	dc.l	$01004000,$D10FFFFE,$01000000,$FFFFFFFE


logo:		incbin	"data:smarty1/1mb.bin"


;
;
;

loader_sta:	rts				; init
		bra.b	err0
		rts				; 4
		bra.b	err4
		bra.w	load_file		; 8
		bra.w	load_table		; 12
		rts
		bra.b	err16
		bra.w	save_file

err0:		move.w	#$00f,$dff180
		bra.b	err0
err4:		move.w	#$0f0,$dff180
		bra.b	err4
err16:		move.w	#$f00,$dff180
		bra.b	err16




save_file:	move.w	#$0f0,d0
		bra.b	ll
load_file:	moveq	#0,d0
ll		move.w	d0,$dff180
		not.w	d0
		bra.b	ll

;
; D0=file index
; A1=destination address
;
load_table:	add.w	d0,d0
		lea	filetable(pc),a0
		add.w	0(a0,d0.w),a0
		movem.l	a0/a1,-(sp)

		;
		moveq	#0,d0
		bsr.w	loadfile
		;
		movem.l	(sp)+,a0/a1
		tst.l	d0
		bpl.b	.ok
		rts
		;
.ok:		cmp.b	#"_",(a0)
		beq.b	.crunched
		rts
		;
.crunched:	move.l	a1,a0
		bsr.w	dec_s405
		moveq	#0,d0
		rts

filetable:	dc.w	f0-filetable
		dc.w	f1-filetable
		dc.w	f2-filetable
		dc.w	f3-filetable
		dc.w	f4-filetable
		dc.w	f5-filetable
		dc.w	f6-filetable
		dc.w	f7-filetable
		dc.w	f8-filetable
		dc.w	f9-filetable
		dc.w	f10-filetable
		dc.w	f11-filetable
		dc.w	f12-filetable
		dc.w	f13-filetable
		dc.w	f14-filetable
		dc.w	-1
		dc.w	-1
		;
;f0:		dc.b	"_file0.s405",0
f0:		dc.b	"_file0+.s405",0
f1:		dc.b	"_file1.s405",0
f2:		dc.b	"_file2.s405",0
f3:		dc.b	"file_3.bin",0
f4:		dc.b	"file_4.bin",0
f5:		dc.b	"_file5.s405",0
f6:		dc.b	"file_6.bin",0
f7:		dc.b	"file_7.bin",0
f8:		dc.b	"file_8.bin",0
f9:		dc.b	"_file9.s405",0
f10:		dc.b	"_file10.s405",0
f11:		dc.b	"_file11.s405",0
f12:		dc.b	"_file12.s405",0
f13:		dc.b	"_file13.s405",0
f14:		dc.b	"_file14.s405",0
		cnop	0,4



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; 
; Version: 4
;
; EXPERIMENTAL STC5 algorithm with original length at the end of file.
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; This file is released into the public domain for commercial
; or non-commercial usage with no restrictions placed upon it.
;
; This version adds a heapsort into tree building phase..
;
;
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

		rsreset	; DO NOT REARRANGE
LTMTABLE	rs.b	(16*8+512*2)
HGHTABLE	rs.b	(16*8+256*2)
LOWTABLE	rs.b	(16*8+256*2)
PRETABLE	rs.b	(16*8+16*2)
TABLE_SIZE	rs.b	0
MTF		equ	LOWTABLE+64

dec_s405:

; A0=file
; A1=dest
; A2=tmp
;
;loadAddr:	lea	$40000,a1
workAddr:	lea	$7e760,a2
		;
		;lea	e+4(pc),a0
	addq.l	#4,a0
		move.l	a1,a3
		move.l	a0,a4
		moveq	#0,d0
.findEnd:
		move.w	(a4)+,d0
		add.l	d0,a4
		bne.b	.findEnd
		add.l	(a4),a3
		;
		; A4 = end of crunched data
		; A3 = end of decrunched area
		;
		cmp.l	a1,a4
		bls.b	decrunch
		cmp.l	a3,a4
		bhi.b	decrunch
		; move..
		move.w	-(a4),(a3)
.move:		move.w	-(a4),-(a3)
		cmp.l	a0,a4
		bhi.b	.move
		move.l	a3,a0
		;


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Parameters:
;  A0 - src i.e. a ptr to the compressed data. Must be 16bits aligned.
;  A1 - dst i.e. a ptr to the destination memory.
;  A2 = ptr yo work area (TABLE_SIZE bytes)

decrunch:	addq.w	#2,a0
		;
		; A0 = ptr to crunched data (ID already skipped) + 2
		; A1 = ptr to destination mem
		; A2 = ptr to work area

blockLoop:	tst.w	-(a0)		; Needed because the bit stream
					; extracting function is always
					; one word ahead.
		bne.b	blockCont
blockExit:	rts
		;
		; Initialize the bitshifter
blockCont:	move.l	(a0)+,d7
		moveq	#0,d6
		swap	d7
		;
		; A0 = src 
		; A1 = dst
		; a2 = tmp
		; D6 = _bc
		; D7 = _bb
		;
decodeTrees:	lea	PRETABLE+128(a2),a4	; was A4 = PRETABLE+16*8 - 2
		moveq	#16,d3

		; Init MTF table M

		moveq	#15,d0
		lea	MTF(a2),a3

.mtf:		move.b	d0,0(a3,d0.w)	; (a2+MTF+D0)
		dbf	d0,.mtf

		; Read in depths and store them into the PRETABLE
		; The format is: depth<<11 | leaf#

		move.l	a4,a3
		moveq	#29,d4
		moveq	#0,d5
.getb3:
		move.l	d7,d0
		lsr.l	d4,d0
		ror.w	#4+1,d0
		or.w	d5,d0
		move.w	d0,(a3)+
		moveq	#3,d1
		bsr.b	getB
		addq.w	#1,d5
		cmp.w	d3,d5
		blo.b	.getb3

		; Build pretree..
		; D3 = num symbols = 16
		; A4 = ptr to decoding structure

		bsr.w	buildDecodingTree	; PRETREE
donePreTable:

		lsl.w	#5,d3
		; D3 = 512
		move.l	a2,a4
		bsr.b	buildDecodingTree3

		lsr.w	#1,d3
		; D3 = 256
		; A4 = A2+HGHTABLE
		bsr.b	buildDecodingTree3
		;

		; D3 = 256
		; A4 = A2+LOWTABLE
		bsr.b	buildDecodingTree3
		;
		; D3 = 256
		; D5 = oldLength (PMR)      no init required
		; A4 = oldOffset (PMR)      no init required
		; A5 = oldOffsetLong (PMR)  no init required
		;
mainLoop:	move.l	a2,a6			; LTMTABLE
		bsr.b	getSyml
		sub.w	d3,d2
decodeLiteral:	;
		; Symbol > 256 => PMR or match

		bgt.b	matchFound

		;
		; Symbol = 256 => End of Block

		beq.b	blockLoop

		;
		; Symbol < 256 => Literal

		move.b	d2,(a1)+
		bra.b	mainLoop
		;
matchFound:	
		subq.w	#1,d2
		ble.b	copyLoop		; Symbol = 257 => PMR 

		; D2 = match_length-1
		move.w	d2,d5			; D5 = PMR oldLength
decodeOffset:
		lea	HGHTABLE(a2),a6
		bsr.b	getSyml

		move.w	d2,d4
		bne.b	.notoldoffsetlong
		move.w	a5,d4
		bra.b	oldOffsetLong
.notoldoffsetlong:
		bclr	#7,d4
		beq.b	oldOffsetLong
		;
		lsl.w	#8,d4

		;
		lea	LOWTABLE(a2),a6
		bsr.b	getSyml
		move.b	d2,d4
		;
		move.w	d4,a5			; A5 = PMR oldOffsetLong
oldOffsetLong:	move.w	d4,a4			; A4 = PMR oldOffset
copyLoop:	move.w	d5,d0			; D5 = PMR lonLength

		;
		; D3 = matchLength-1
		; D4 = offset

		move.l	a1,a6
		sub.l	a4,a6
		;
.copy:		move.b	(a6)+,(a1)+		
		dbf	d0,.copy
effect:
	;move.w	d6,$dff180
		bra.b	mainLoop

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Description:
;  This function decodes the next symbol from the given huffman tree.
;
; Parameters:
;  a6 = ptr to (huffman) tables..
;
; Returns:
;  D1 = cnt (num bits needed for symbol..)
;  D2 = symbol
;
; Trashes:
;  D0,D1,D2,A3,a6
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

getSyml:	move.l	a6,a3
.lut:		cmp.l	(a6)+,d7
		bhi.b	.lut
		;
		movem.w	16*4-4(a6),d0/d1	; Clears bits 31-16 of D1
		; D0 = base index
		; D1 = number of bits to extract

		move.l	d7,d2
		clr.w	d2
		rol.l	d1,d2
		sub.w	d0,d2
		add.w	d2,d2
		move.w	0(a3,d2.w),d2		;lea	(16*8,a6),a3

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; 
; Description:
;  This function extracts n bits from the compressed data stream.
;
; Parameters:
;  D1.w = num_bits_to_extract
;
; Returns:
;  Nothing.
;
; Trashes:
;  flags,D1
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

getB:		sub.w	d1,d6
		bge.b	.getb
		add.w	d1,d6
		lsl.l	d6,d7
		move.w	(a0)+,d7
		sub.w	d6,d1
		moveq	#16,d6
		sub.w	d1,d6
.getb:		lsl.l	d1,d7
return:
		rts


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Description:
;  Build huffman tree & decoding structures. This function also reads symbols
;  from the compressed stream and then does inverse MTF (move to front) to
;  symbols. This function is only used to decode/build the pretree.
;
; Parameters:
;  D3 = num symbold
;  A4 = dest
;  a2 = ptr to tmp
;
; Returns:
;  D3 = num of symbols
;  A4 = ptr to dest table
;
; Trashes:
;  D0,D1,D2,D5,A4,A5,a2
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


buildDecodingTree3:
		lea	128(a4),a4
		move.l	a4,a5
		moveq	#0,d5
.loop:		lea	PRETABLE(a2),a6		; PRETABLE
		bsr.b	getSyml			; trashes a6/A3

		; inverse MTF

		lea	MTF(a2),a6
		add.w	d2,a6
		move.w	d2,d0
		move.b	(a6),d2
		bra.b	.mtf1

		;
.mtf:		move.b	-(a6),1(a6)
.mtf1:		dbf	d0,.mtf
		move.b	d2,(a6)
		;
		ror.w	#4+1,d2
		or.w	d5,d2
		move.w	d2,(a5)+
		addq.w	#1,d5
		cmp.w	d5,d3
		bne.b	.loop


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Description:
;  Build huffman tree & decoding structures. This function assumes that all
;  symbols are already loaded into memory.
;
; Parameters:
;  D3 = num symbols
;  A4 = dest
;
; Returns:
;  D3 = num of symbols
;  A4 = ptr to next table
;
; Trashes:
;  r0,r1,r5,r6,r7
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

		;must	preserve a3/D3/D6/D7


buildDecodingTree:
		movem.l	d3/d6/d7,-(sp)
		moveq	#1,d4		; current heap max
		move.w	#$07ff,d6
		move.l	a4,a6		; A6 = heap and start of symbols
		;
buildHeap:	move.w	(a4)+,d0
		;
		; Format of D0 is:  "dddddnnn|nnnnnnnn" where
		;  'd' is the depth in the huffman tree and
		;  'n' is the leaf number.
		;
		cmp.w	d6,d0
		bls.b	.skipZero	; skip symbols with zero depth
		move.w	d4,d5
		add.w	d5,d5
		;
.buildLoop:
		move.w	d5,d2
		move.w	d0,-2(a6,d5.w)
		lsr.w	#2,d5
		beq.b	.root
		add.w	d5,d5
		move.w	-2(a6,d5.w),d1
		cmp.w	d1,d0
		bls.b	.root
		move.w	d1,-2(a6,d2.w)
		bra.b	.buildLoop
		;
.root:		addq.w	#1,d4		; increase size of heap
.skipZero:	subq.w	#1,d3
		bne.b	buildHeap
		subq.w	#2,d4
		bmi.s	allZero
		move.w	d4,d3		; D3 = heapsize-1
		;
		add.w	d4,d4
		lea	2(a6,d4.w),a3
		;
		; D3 = heapsize-1
		; D4 = (heapsize*2)-2
		; A3 = end of heap+2
		; A4 = end of symbols
		;
		clr.w	(a3)		; Termination code for
					; calculateCanonicalCodes
heapSort:	move.w	-(a3),d1
		move.w	(a6),(a3)
		moveq	#2,d5
.siftDown:	move.w	d5,d2
		; left leaf
		add.w	d2,d2
		cmp.w	d4,d2
		bhi.b	.done
		beq.b	.leftMax
		move.w	0(a6,d2.w),d0
		cmp.w	-2(a6,d2.w),d0
		bls.b	.leftMax
		addq.w	#2,d2
.leftMax:	cmp.w	-2(a6,d2.w),d1
		bhs.b	.done
		; swap leaf and parent
.move:		move.w	-2(a6,d2.w),-2(a6,d5.w)
		move.w	d2,d5
		bra.b	.siftDown
		;
.done:		move.w	d1,-2(a6,d5.w)
		subq.w	#2,d4
		bgt.b	heapSort
		;
calculateCanonicalCodes:
		lea	-128(a6),a5
		moveq	#64,d2		; artificial shift.. see getSyml()
		moveq	#0,d4
		
		; a6 = _alp+_start 
		; A4 = dest = _tlb
		; D3 = _alpsize-1
		; D4 = 0
		; d2 = 0
		;

		moveq	#11,d7
	

.loop:		move.w	(a6),d0
		move.l	(a6),d1		
		lsr.w	d7,d0
		lsr.w	d7,d1
		sub.w	d0,d1
		beq.b	.skip
		
		moveq	#-1,d5
		lsl.w	d0,d5
		or.w	d4,d5
		ror.l	d0,d5
		move.l	d5,(a5)+		; cde
		move.w	d4,d5
		sub.w	d2,d5			; ind = (unsigned short)(c-n)
		swap	d5
		move.w	d0,d5

		move.l	d5,16*4-4(a5)		; ind << 16 | bts

.skip:		addq.w	#1,d4
		lsl.l	d1,d4			; D1 can be zero..
		addq.w	#1,d2

		and.w	d6,(a6)+		; and.w	#$07ff,(a6)+
		dbf	d3,.loop

allZero:	movem.l	(sp)+,d3/d6/d7
		rts


;-------------------------------------------------
;loader program - begins at (prog).w
; D0=drive
; A0=filename
; A1=address
;
;-------------------------------------------------
loadfile:	movem.l	d2-d7/a0-a6,-(sp)
		lea	$dff024,a6
		lea	$bfd100,a5
		lea	v(pc),a4

		move.b	d0,drive-v(a4)
		movem.l	a0/a1,filename-v(a4)		;(a4)=filename

;-------------- some initializon: drive on etc.
		bsr.w	drive_on
		;move.l	(filename,pc),a0	; this is redundant
		bsr.w	lenght_hash

;-------------- load root block - 880
		lea	880.w,a0			;root block
		;lea	secbuffer(pc),a1
		lea	secbuffer,a1
		bsr.w	load
		bne.s	diskerror		

;-------------- load block from hash table
loadfromhash:	move	hash(pc),d0		;block from hash table
		lsl	#2,d0
		move.l	0(a1,d0.w),d0

;-------------- load block loop
loadnext:	beq.s	fileerror
		move.l	d0,a0
		bsr.w	load
		bne.s	diskerror

;-------------- test block type - file header, user directory or data
		move.l	127*4(a1),d0		;block type (dir/header...)
		move.l	(a1),d1			;more info about block type

		 addq.w	#3,d0			;file header block=-3
		bne.s	notfileheader
		cmp	#2,d1
		beq.s	fileheader

notfileheader:	 subq.w	#2+3,d0			;user directory block=2
		bne.s	notuserdirec
		cmp	#2,d1
		beq.s	userdirec

notuserdirec:	 subq	#8,d1			;data block
		beq.s	datadirect

;-------------- file not found - or read/write error
fileerror:	st	error-v(a4)		;file/dir not found
;-------------- file loaded ok
fileloaded:
diskerror:	bsr.w	drive_off
		moveq	#-1,d0
		move.b	error-v(a4),d1
		bne.s	negative
		move.l	fileaddr(pc),d0
		;sub.l	28(sp),d0		;sub #memaddr,#endaddr
	moveq	#0,d0
negative:	movem.l	(sp)+,d2-d7/a0-a6	;output=file lenght
		rts				;or -1 (error)

;-------------- user directory - search next if needed
userdirec:	bsr.s	testhash		;check user dir name
		add.l	(a4),a0			;namelen
		addq	#1,a0
		move.l	a0,filename-v(a4)
		bsr.s	lenght_hash
		bra.s	loadfromhash

;-------------- next block in hash chain if needed
testhash:	lea	108*4(a1),a3		;file/dir name
		moveq	#0,d1
		move.b	(a3)+,d1
		movem.l	(a4),d0/a0		;namelen
		bsr.s	testname
		bmi.s	nexthash
		rts
nexthash:	addq	#4,sp			;correct stack
		move.l	124*4(a1),d0		;next block in hash chain
		bne.s	loadnext
		bra.s	fileerror

;-------------- file header - search next if needed
fileheader:	bsr.s	testhash		;check filename
		move.l	77*4(a1),d0		;first data block

;-------------- load data - search next until zero
loaddata:	move.l	d0,a0
		bsr.w	load
		bne.s	diskerror
datadirect:	lea	6*4(a1),a3		;data starts
		move.l	3*4(a1),d2		;how many bytes
		subq.w	#1,d2
		move.l	fileaddr(pc),a2

dataloop:	move.b	(a3)+,(a2)+
		dbf	d2,dataloop
		move.l	a2,fileaddr-v(a4)
		move.l	4*4(a1),d0		;next data block
		bne.s	loaddata
dataend:	bra.s	fileloaded		;ok, file loaded

;-------------- test name - ok: d0=0  false: d0=-1
testname:	move.l	a0,a2
		cmp	d0,d1
		bne.s	nameerror
		subq	#1,d0
testloop:	move.b	(a3)+,d1
		bsr.s	uppercase
		move.b	d1,d2
		move.b	(a2)+,d1
		bsr.s	uppercase
		cmp.b	d1,d2
		bne.s	nameerror
		dbf	d0,testloop
		moveq	#0,d0
		rts
nameerror:	moveq	#-1,d0
		rts

;-------------- name lenght - calculate search lenght
lenght_hash:	moveq	#-1,d0
search1:	addq.l	#1,d0
		move.b	0(a0,d0.w),d1
		beq.b	out
		cmp.b	#'/',d1
		bne.b	search1
out:		move.l	d0,(a4)			;namelen

;-------------- calc hash - only for directory blocks
		move.w	#$07ff,d2
		moveq	#0,d1
hloop1:		move.b	(a0)+,d1
		beq.s	hout
		cmp.b	#'/',d1
		beq.b	hout
		bsr.s	uppercase
		mulu	#13,d0
		add	d1,d0
		and	d2,d0
		bra.s	hloop1

hout:		and	d2,d0
		divu	#72,d0
		swap	d0
		addq	#6,d0
		move	d0,hash-v(a4)
		rts

;-------------- all chars must be uppercased
uppercase:	cmp.b	#"a",d1
		blo.s	out2
		cmp.b	#"z",d1
		bhi.s	out2
		sub.b	#$20,d1
out2:		rts

;-------------------------------------------------
;-------------- hardware level load-routine for normal Amiga format
;               loads only one block (sector)
;
;		a0=starsector
;		a1=memaddress

load:		move.b	#3,times-v(a4)
load_again:	movem.l	a0/a1,-(sp)
		move.l	a7,stack-v(a4)
		clr.b	error-v(a4)
		tst.b	cylinder-v(a4)
		bpl.s	notzero
		bsr.b	zero_track
notzero:	move.w	cylinder(pc),oldcylinder-v(a4)
		bsr.w	load_mfm
err_exit:	move.l	stack(pc),a7
		movem.l	(sp)+,a0/a1
		tst.b	error-v(a4)
		beq.s	load_ok

		subq.b	#1,times-v(a4)
		bmi.s	load_ok
		st	cylinder-v(a4)
		bra.s	load_again

;-------------------------------------------------
;-------------- select drive (df0:) and turn on - set hardw.regs
drive_on:	move	#$9500,$09e-$24(a6)
		move	#$8210,$096-$24(a6)
		move	#$4489,$07e-$24(a6)
		move.l	#$000a000a,$09a-$24(a6)

		move.b	drive(pc),d0
		addq.b	#3,d0
		bclr	#7,(a5)
		bclr	d0,(a5)

;-------------- check rotating speed - wait for approx. 0.5 sec
		;move.w	#500/3,d1	; Do wait here as some
		moveq	#127,d1
waitmotor:	bsr.w	wait		; drives never set the
		btst	#5,$f01(a5)	; drive ready bit..
		dbne	d1,waitmotor
load_ok:
wait_ok:	rts

;-------------- turn selected drive off
drive_off:	move.b	drive(pc),d0
		addq.b	#3,d0
		bset	d0,(a5)
		bset	#7,(a5)
		bclr	d0,(a5)
		bset	d0,(a5)
		rts

;-------------- heads over the zero track
zero_track:	bset	#1,(a5)
zeroloop:	btst	#4,$f01(a5)
		beq.s	zero_reached
		bclr	#0,(a5)
		nop
		nop
		bset	#0,(a5)
		bsr.w	wait
		btst	#2,$f01(a5)		;test disk
		beq.w	nodiskindrive
		bra.s	zeroloop

zero_reached:	clr.b	cylinder-v(a4)
		rts

;-------------------------------------------------
;-------------- load raw mfm-data and decode sector
load_mfm:	move.l	a0,d0
		divu	#11,d0
		move.l	d0,d3

;-------------- select head side
		and	#$0001,d3
		bne.s	side_up
		bset	#2,(a5)
		bra.s	side_ok
side_up:	bclr	#2,(a5)
side_ok:	move.b	d3,side-v(a4)

;-------------- move head if needed
		lsr	#1,d0
		bsr.w	seek
		swap	d3			;d3=start mask

;-------------- d2=$55555555 a3=diskbuffer
		move.l	#$55555555,d2
		lea	buffer,a3
		lea	$3300(a3),a0

		move.b	cylinder(pc),d7		;is track already in buffer?
		cmp.b	oldcylinder(pc),d7
		bne.s	loadtrack
		move.b	side(pc),d7
		cmp.b	oldside(pc),d7
		beq.s	skipload

;-------------- load track into the buffer
loadtrack:	move.l	a3,$020-$24(a6)
		bsr.w	reslev1
		clr	(a6)
		move	#$9980,(a6)
		move	#$9980,(a6)
		bsr.w	block_wait
		clr	(a6)

;-------------- search through 11 sectors
skipload:	moveq	#11-1,d7
mfm_loop:	cmp.l	a0,a3
		bhs.w	sync_err
		cmp	#$4489,(a3)+
		bne.s	mfm_loop
		cmp	#$4489,(a3)
		bne.s	mfm_cont
		addq	#2,a3

;-------------- decode sector info
mfm_cont:	movem.l	(a3)+,d0/d1
		and.l	d2,d0
		and.l	d2,d1
		add.l	d0,d0
		or.l	d1,d0
		lsr.w	#8,d0		; Make the sector number
					; as the lowest byte

;-------------- check/store sector info
		move.l	d0,info-v(a4)
		addq.b	#1,info-v(a4)
		bne.w	format_err

;-------------- is this the sector we need?
format_ok:	cmp.b	d3,d0
		beq.s	sec_found

;-------------- no! next sector ...
		add	#1024+48,a3
		dbf	d7,mfm_loop

;-------------- strange error?? no right sector found...
		bra.w	sync_err

;-------------- sector found - continue
sec_found:	add	#10*4,a3
		move.l	(a3)+,d0
		move.l	(a3)+,d4
		and.l	d2,d0
		and.l	d2,d4
		add.l	d0,d0
		or.l	d0,d4
		moveq	#0,d6
		moveq	#128-1,d7

;-------------- decode mfm-data - check data checksum
decode:		move.l	$200(a3),d1
		move.l	(a3)+,d0
		eor.l	d0,d6
		eor.l	d1,d6
		and.l	d2,d0
		and.l	d2,d1
		add.l	d0,d0
		or.l	d1,d0
		move.l	d0,(a1)+
		dbf	d7,decode
		and.l	d2,d6
		cmp.l	d4,d6
		bne.w	check_err
		rts

;-------------- seek routine - move head over the right track
seek:		sub.b	cylinder(pc),d0
		beq.s	seek_ok
		add.b	d0,cylinder-v(a4)
		ext	d0
		move	d0,d1
		bge.s	direc_up
		bset	#1,(a5)
		neg	d1
		bra.s	direc_ok
direc_up:	bclr	#1,(a5)
direc_ok:	subq	#1,d1
seekloop:	bclr	#0,(a5)
		nop
		nop
		bset	#0,(a5)
		bsr.s	wait
		dbf	d1,seekloop
		bclr	#1,(a5)
seek_ok:	rts

;-------------------------------------------------
;-------------- correct wait routines - ciaa - timer b

;timerwait = 716*3 = 3 milliseconds
;timerwait = $aff = 3.93 milliseconds

wait:		move.b	#%10000010,$1c01(a5)
		st	$1501(a5)			;$bfe601
		move.b	#$0a,$1601(a5)			;$bfe701
		move.b	#%00011001,$1e01(a5)		;$bfef01
waitloop:	btst	#1,$1c01(a5)
		beq.s	waitloop
		move	#$0008,$09c-$24(a6)
		rts

;-------------- block finished wait
reslev1:
block_ok:	move	#$0002,$09c-$24(a6)
		rts
block_wait:	moveq	#127,d1			;max 0.512 sec
block_loop:	btst	#1,$01f-$24(a6)
		bne.s	block_ok
		bsr.s	wait
		dbf	d1,block_loop

;-------------------------------------------------
;-------------- no sync found - read/write error
read_write:	bsr.s	reslev1
		clr	(a6)
		moveq	#6,d0
		bra.s	err_exit_temp

;-------------- no sync found - only one found
sync_err:	cmp.b	#11-1,d7
		bne.s	too_few
		bpl.s	too_few
		moveq	#7,d0
		bra.s	err_exit_temp

;-------------- too few (below 11) syncs found
too_few:	moveq	#8,d0
		bra.s	err_exit_temp

;-------------- not amiga format
format_err:	moveq	#3,d0
		bra.s	err_exit_temp

;-------------- checksum error
check_err:	moveq	#5,d0
		bra.s	err_exit_temp

;-------------- no disk in drive
nodiskindrive:	clr.b	times-v(a4)
		moveq	#2,d0
err_exit_temp:	move.b	d0,error-v(a4)
		bra.w	err_exit

;-------------------------------------------------
cylinder:	dc.b	$ff		;$ff=setup
side:		dc.b	$ff		; 0 = down
					; 1 = up
oldcylinder:	dc.b	0
oldside:	dc.b	0
v:
;-------------- dosloader variables
end:
namelen:	dc.l	0
;nameaddr:	dc.l	0
filename:	dc.l	0
fileaddr:	dc.l	0
hash:		dc.w	0

;-------------- variables for loader system
stack:		dc.l	0
info:		dc.l	0			;sector info longword
checksum:	dc.l	0
error:		dc.b	0			;0=no error
						;1=not used
						;2=no disk in drive
						;3=not Amiga format
						;4=not used
						;5=checksum error (data)
						;6=read/write error
						;or same as 2 in some cases
						;7=no sync found
						;8=too few syncs
						;9=troubles in hashchain
						;-1=file/dir not found

drive:		dc.b	0
times:		dc.b	0
		cnop	0,4
loader_end:
fe:

secbuffer	equ	$7f200

;secbuffer:	blk.b	512,0
;------------------------------------------------