;----------------------------------------------------------------------------
; File name:	PINHED18.S			Revised:	1997.01.25
; Disassembler:	U.R.Andersson			Disassembled:	1992.02.05
; Copyright:	1989, 1990 Charles F. Johnson.
; Release:	Shareware
; Purpose:	Improved fastload for TOS 1.6 & older
;----------------------------------------------------------------------------
;
	include	URAn_SYS.S
	include	URAn_DOS.S
	include	URAn_XB.S		;This defines 6 macros for XBRA control
;
;----------------------------------------------------------------------------
;
max_records	= 32		;18 bytes reserved per file record
;
;----------------------------------------------------------------------------
;
	text
;
;----------------------------------------------------------------------------
;
start_1:
	bra	start_2
;
;
codemove_base:
	XB_define	PH18_gemdos,'PH18'
	move.l	sp,a0
	tst	(_longframe).w
	beq.s	L1A
	tst	(a0)+
L1A:
	btst	#5,(sp)
	bne.s	L24
	move	USP,a0
	subq	#6,a0
L24:
	cmpi	#(Pexec&$ff),6(a0)
	bne.s	go_old_gemdos
	tst	8(a0)
	beq.s	MOVEM_D0_A0toA3_regsav	;use PH18 for mode 0 = Load & Run
	cmpi	#3,8(a0)
	bne.s	go_old_gemdos		;use PH18 for mode 3 = Load
MOVEM_D0_A0toA3_regsav:
	movem.l	d0/a0-a3,$ADEADBEE.l
	lea	PH__size(pc),a1
	clr.l	(a1)
	move	record_count(pc),d0
	beq.s	L9E
	subq	#1,d0
	move.l	10(a0),a0		;a0->filename to Pexec
	move.l	a0,a2			;a2->filename to Pexec
L56:			;loop start
	tst.b	(a0)+
	bne.s	L56	;loop to check name length
L5A:
	cmp.l	a0,a2
	beq.s	L66	;no name ?
	cmpi.b	#'\',-(a0)
	bne.s	L5A
	addq	#1,a0
L66:
	move.l	a0,a2
	lea	record_base(pc),a3
L6C:
	move.l	a3,a1
L6E:
	tst.b	(a0)
	beq.s	L78
	cmpm.b	(a0)+,(a1)+
	bne.s	L94
	bra.s	L6E
;
L78:
	tst.b	(a1)
	bne.s	L94
	tst.l	14(a3)
	bpl.s	L8A
	movem.l	LB8(pc),d0/a0-a3
	bra.s	go_old_gemdos
;
L8A:
	lea	PH__size(pc),a1
	move.l	14(a3),(a1)
	bra.s	L9E
;
L94:
	lea	18(a3),a3
	move.l	a2,a0
	dbra	d0,L6C
L9E:
	movem.l	LB8(pc),d0-d0/a0-a3
	lea	Pexec_flag(pc),a0
	st	(a0)
go_old_gemdos:
	move.l	(PH18_gemdos+8)(pc),a0
	jmp	(a0)
;
;
PH__size:
	dc.l	0
default_size:
	dc.l	$00008000
LB8:
	dc.l	0,0,0,0,0
;
;
	XB_define	PH18_ikbd,'PH18'
	lea	ikbd_return(pc),a0
	move.l	(sp)+,(a0)
	pea	MOVE_ioTailix_d0(pc)
	move.l	(PH18_ikbd+8)(pc),-(sp)
	rts	
;
;
MOVE_ioTailix_d0:
	move	$ADEADBEE.l,d0
CMP_ioHeadix_d0:
	cmp	$ADEADBEE.l,d0
	beq.s	go_old_ikbd
LEA_Iorec_a0:
	lea	$DEADBEEF.l,a0
LEA_Keytbl_a1:
	lea	$DEADBEEF.l,a1
	move.b	-1(a1),d0	;NB: orig assumes Kbshift stored at Keytbl-1
;NB: So in all TOS supported Kbshift data lies at Keytbl-1 !!!
	and	#$F,d0
	cmp	#$E,d0		;LSHIFT, CTRL, ALT pressed together ?
	bne.s	go_old_ikbd
	move.l	(a0),a1		;a1->kbd buffer
	move	8(a0),d0	;d0= tailix
	move.b	1(a1,d0.w),d0	;d0= latest kbd key number
	lea	PH__flag(pc),a1	;a1->PH__flag
	cmp.b	#112,d0		;'0'
	beq.s	L12E
	cmp.b	#74,d0		;'-'
	beq.s	L128
	cmp.b	#78,d0		;'+'
	bne.s	go_old_ikbd
	clr	(a1)		;clr PH__flag= 0  (Turn PH on)
	bra.s	L136
;
L128:
	move	#$1,(a1)	;set PH__flag= 1  (Turn PH off)
	bra.s	L136
;
L12E:
	tst	(a1)
	bne.s	L136
	st	PH_skip-PH__flag(a1)	;skip PH18 next Pexec
L136:
	move	6(a0),8(a0)	;tailix= headix,  so kbd buffer emptied
go_old_ikbd:
	move.l	ikbd_return(pc),a0
	jmp	(a0)
;
;
PH__flag:
	dc.w	0
PH_skip:
	dc.b	0
Pexec_flag:
	dc.b	0
	dc.w	0,0,0,0
	dc.w	0,0,0,0
	dc.w	0
;
;
PH18_vblsub:
	lea	PH__flag(pc),a0
	tst	(a0)
	bne.s	L166
	tst.b	Pexec_flag-PH__flag(a0)
	bne.s	patch_L168
L166:
	rts
;
patch_L168:
	cmpi.l	#$FC4BDA,74(sp)
	bhi.s	L166
patch_L172:
	cmpi.l	#$FC4BB6,74(sp)
	blo.s	L166
	tst.b	PH_skip-PH__flag(a0)
	beq.s	L188
	clr	PH_skip-PH__flag(a0)
	rts
;
L188:
	clr	PH_skip-PH__flag(a0)
	move.l	68(sp),a0
patch_L190:
	move.l	-4(a0),a5
	move.l	-58(a0),a1
patch_L198:
	move.l	218(sp),a2
	cmp.l	(phystop).w,a2
	bhi.s	L1C2
	move.l	a2,d0
	btst	#0,d0
	bne.s	L1C2
	cmp.l	(a2),a2
	bne.s	L1C2
	move.l	4(a2),d0
	lea	OS_vernum(pc),a2
	cmpi	#$102,(a2)
	blt.s	L1C4
	cmp.l	110(sp),d0
	beq.s	patch_L1CE
L1C2:
	rts
;
L1C4:
	move.l	a5,d1
	add.l	-46(a0),d1
	cmp.l	d0,d1
	bne.s	L166
patch_L1CE:
	move.l	#$FC4BE2,74(sp)
	move.l	PH__size(pc),d2
	bne.s	L1E2
	adda.l	default_size(pc),a1
	bra.s	L1E4
;
L1E2:
	adda.l	d2,a1
L1E4:
	lea	0(a5,a1.l),a6
	cmp.l	d0,a6
	blo.s	L1EE
	move.l	d0,a6
L1EE:
	move.l	a1,d1
	and	#$FF,d1
	moveq	#0,d0
	bra.s	clr_bytes
;
clr_byte_loop:
	move.b	d0,-(a6)
clr_bytes:
	dbra	d1,clr_byte_loop
	moveq	#0,d1
	moveq	#0,d2
	moveq	#0,d3
	moveq	#0,d4
	moveq	#0,d5
	moveq	#0,d6
	moveq	#0,d7
	move	d0,a0
	move	d0,a1
	move	d0,a2
	move	d0,a3
	move	d0,a4
	bra.s	clr_pages
;
clr_page_loop:
	movem.l	d0-d7/a0-a4,-(a6)
	movem.l	d0-d7/a0-a4,-(a6)
	movem.l	d0-d7/a0-a4,-(a6)
	movem.l	d0-d7/a0-a4,-(a6)
	movem.l	d0-d7/a0-a3,-(a6)
clr_pages:
	cmp.l	a5,a6
	bhi.s	clr_page_loop
	rts
;
;
ikbd_return:
	dc.l	0
OS_vernum:
	dc.w	0
record_count:
	dc.w	0
record_base:
	dcb.b	(max_records*18),0
codemove_limit:
	dc.w	0
;
;
start_2:
	move.l	4(sp),a0
	lea	128(a0),a0		;a0->arg in basepage
	lea	bp_arglbase_p(pc),a1
	move.l	a0,(a1)			;(bp_arglbase_p)->arg in basepage
	gemdos	Cconws,copyright_s(pc)
	moveq	#-1,d0
	xbios	Keytbl!_IND,d0,d0,d0
	lea	(LEA_Keytbl_a1+2)(pc),a0
	move.l	d0,(a0)
	xbios	Iorec,#1
	lea	(LEA_Iorec_a0+2)(pc),a0
	move.l	d0,(a0)
	move.l	d0,a1
	lea	8(a1),a2
	lea	(MOVE_ioTailix_d0+2)(pc),a0
	move.l	a2,(a0)
	lea	6(a1),a2
	lea	(CMP_ioHeadix_d0+2)(pc),a0
	move.l	a2,(a0)
	lea	PINHEAD_DAT_s(pc),a0
	bsr	Fopen_a0_RD
	bmi	records_done
	lea	file_data(pc),a5
	move	d0,d5
	gemdos	Fread,d5,#$1000,(a5)
	clr.b	0(a5,d0.w)	;Terminate file data with NUL
	bsr	Fclose_d5
	cmpi.l	#'PH13',(a5)+
	bne	records_done
	lea	record_base(pc),a4	;a4->room for compiled data
	lea	record_count(pc),a0
	clr	(a0)		;zero record_count
do_new_line:			;loop to compile file data (a5)+ to (a4)+
	cmpi.b	#CR,(a5)
	ble	do_next_line
	cmpi.b	#';',(a5)
	beq	do_next_line
	cmpi.b	#'*',(a5)
	bne.s	do_record_name
	cmpi.b	#'.',1(a5)
	bne.s	do_next_line
	cmpi.b	#'*',2(a5)
	bne.s	do_next_line
L53E:				;loop start to find default cleanup size
	cmpi.b	#CR,(a5)
	ble.s	do_next_line
	cmpi.b	#' ',(a5)+
	bne.s	L53E		;loop until a5->non_space
L54A:				;loop start
	cmpi.b	#' ',(a5)+
	beq.s	L54A		;loop until a5->non_space
	tst.b	-(a5)		;NB: orig never used this test result !!!
	bsr	conv_num
	mulu	#$400,d0	;bytes = Kbytes * 1024
	lea	default_size(pc),a2
	move.l	d0,(a2)		;store cleanup size in default_size
	bra.s	do_next_line
;
do_record_name:
	move.l	a4,a0
L564:				;loop start to get record name
	cmpi.b	#' ',(a5)
	beq.s	do_record_cleansize
	cmpi.b	#CR,(a5)
	ble.s	do_name_eol
	move.b	(a5)+,(a0)+	;move name char into record
	bra.s	L564		;loop back to complete name
;
do_name_eol:
	cmp.l	a4,a0		;no name ?
	beq.s	do_next_line	;then go try next line
	move.l	#-1,14(a4)	;set record cleanup size to whole memory
	bra.s	L598
;
do_record_cleansize:
	clr.b	(a0)		;terminate compiled data (possibly next name)
L584:				;loop start to get record cleanup size
	cmpi.b	#' ',(a5)+
	beq.s	L584		;loop until a5->non_space
	tst.b	-(a5)		;NB: orig never used this test result !!!
	bsr	conv_num
	mulu	#$400,d0	;bytes = Kbytes * 1024
	move.l	d0,14(a4)	;store cleanup size beyond record name
L598:
	lea	18(a4),a4	;a4->next record area for compiled data
	lea	record_count(pc),a0
	addq	#1,(a0)		;increment record count
	cmpi	#32,(a0)	;nor reached 32 records ?
	blt	do_new_line	;then go try another
	bra.s	records_done
;
do_next_line:			;loop start to end line
	cmpi.b	#CR,(a5)+
	bgt.s	do_next_line	;loop back until a5->beyond CR or lower char
	subq	#1,a5
L5B4:				;loop start to find line
	tst.b	(a5)
	beq.s	records_done	;break loops at end of data
	cmpi.b	#CR,(a5)+
	ble.s	L5B4		;loop back to skip CR's & LF's
	tst.b	-(a5)		;NB: orig never used this test result !!!
	bra	do_new_line	;loop back with a5->new line
;
records_done:
	lea	rec_cnt_himem(pc),a0
	move	record_count(pc),(a0)
	xbios	Supexec,get_OS_vernum_sup(pc)
	lea	OS_vernum(pc),a0
	cmpi	#$104,(a0)
	beq.s	L62A		;skip odd part (nonsense ???) if TOS 1.04
;NB: !!!	The code below opens a file, the name of which resides
;NB: !!!	in the PINHEAD.DAT area, which may never have been filled !!!
;NB: !!!	The file is opened, then closed, whereafter any file with a
;NB: !!!	handle immediately below that is also closed.
;NB: !!!	This should be PINHEAD.DAT itself, but the method stinks !!!
	gemdos	Fgetdta
	lea	entry_dta_p(pc),a0
	move.l	d0,(a0)
	lea	file_data(pc),a0
	bsr.b	Fsetdta_a0
	gemdos	Fsfirst,file_data+$188(pc),!
	tst	d0
	bne.s	skip_entry_nonsense	;here we skip nonsense if not found
	lea	file_data+30(pc),a0
	lea	filename_s(pc),a1
L610:				;loop start to copy name
	move.b	(a0)+,(a1)+
	bne.s	L610		;loop back for for full name
	lea	filename_s(pc),a0
	bsr.b	Fopen_a0_RD	;open file getting handle x
	bmi.s	skip_entry_nonsense
	move	d0,d5
	bsr.b	Fclose_d5	;close file x
	subq	#1,d5
	bsr.b	Fclose_d5	;close file x-1 !!! (insane ???)
;NB: !!!	The code above opens a file, the name of which resides
;NB: !!!	in the PINHEAD.DAT area, which may never have been filled !!!
;NB: !!!	The file is opened, then closed, whereafter any file with a
;NB: !!!	handle immediately below that is also closed.
;NB: !!!	This should be PINHEAD.DAT itself, but the method stinks !!!
skip_entry_nonsense:
	move.l	entry_dta_p(pc),a0
	bsr.b	Fsetdta_a0
L62A:
	xbios	Supexec,adapt_TOS_sup(pc)
	lea	fail_flag(pc),a0
	tst	(a0)
	beq.s	L642
	clr	-(sp)	;Pterm0
	trap	#1	;gemdos
;
L642:
	clr	-(sp)
	move	rec_cnt_himem(pc),d0
	mulu	#18,d0			;d0= size for record area
	lea	record_base(pc),a0
	lea	PH18_gemdos(pc),a1
	suba.l	a1,a0			;a0= code size up to records
	adda	#$80,a0			;a0+=$80 for remainder of basepage
	add.l	a0,d0			;d0= total size
	move.l	d0,-(sp)
	move	#(Ptermres&$FF),-(sp)
	trap	#1	;gemdos
;
;
Fclose_d5:
	gemdos	Fclose,d5
	rts
;
;
Fsetdta_a0:
	gemdos	Fsetdta,(a0)
	rts
;
;
Fopen_a0_RD:
	gemdos	Fopen,(a0),!
	tst.l	d0
	rts
;
;
conv_num:
	moveq	#0,d0	;init number to zero
L68E:			;loop start
	cmpi.b	#'9',(a5)
	bhi.s	got_num	;break loop if char > digits
	cmpi.b	#'0',(a5)
	blo.s	got_num	;break loop if char < digits
	lsl.w	#1,d0	;d0 *= 2
	move.l	d0,d1
	lsl.w	#2,d0	;d0 *= 4
	add.l	d1,d0	;d0 += d1 (==old_d0 * 10)
	move.b	(a5)+,d1
	and.l	#$F,d1
	add.l	d1,d0	;d0= old_d0 * 10 + new_digit
	bra.s	L68E	;loop for more digits
;
got_num:
	rts
;
;
get_OS_vernum_sup:
	move.l	(_sysbase).w,a0
	lea	OS_vernum(pc),a1
	move	2(a0),(a1)
	rts
;
;
adapt_TOS_sup:
	lea	OS_vernum(pc),a0
	cmpi	#$100,(a0)
	bne	not_TOS_100
	lea	patch_L198+2(pc),a1
	move	#220,(a1)
	cmpi.l	#$FC0000,(ev_gemdos).w	;NB: orig assumes TOS gemdos link !!!
	bhi.s	got_ROMTOS_100
	move.l	(ev_gemdos).w,a0	;NB: This assumes TOS gemdos link !!!
	move	#$3A98,d0
L6E4:					;loop start to find RAMTOS code
	cmpi	#$2046,(a0)
	bne.s	L72E
	cmpi.l	#$20BC0000,2(a0)
	bne.s	L72E
	cmpi.l	#$5885,6(a0)
	bne.s	L72E
	cmpi.l	#$5886BAAE,10(a0)
	bne.s	L72E
	cmpi.l	#$FFD26DEE,14(a0)
	bne.s	L72E
	subq	#1,a0
	lea	patch_L172+2(pc),a1
	move.l	a0,(a1)
	lea	19(a0),a0
	lea	patch_L168+2(pc),a1
	move.l	a0,(a1)
	lea	patch_L1CE+2(pc),a1
	move.l	a0,(a1)
	bra	L804
;
L72E:
	addq	#2,a0
	subq	#2,d0
	bne.s	L6E4			;loop back to seek code
;NB:	if this falls through TOS will be assumed ROMTOS !!!
;NB:	which can ONLY be correct if some prog has linked to gemdos
;
;
got_ROMTOS_100:
	lea	patch_L168+2(pc),a1
	move.l	#$FC859C,(a1)
	lea	patch_L172+2(pc),a1
	move.l	#$FC858A,(a1)
	lea	patch_L1CE+2(pc),a1
	move.l	#$FC859C,(a1)
	bra	L804
;
not_TOS_100:
	cmpi	#$102,(a0)
	bne.s	not_TOS_102
	lea	patch_L198+2(pc),a1
	move	#$F4,(a1)
	bra	L804
;
not_TOS_102:
	cmpi	#$104,(a0)
	bne.s	not_TOS_104
	lea	patch_L168+2(pc),a1
	move.l	#$FC1F3E,(a1)
	lea	patch_L172+2(pc),a1
	move.l	#$FC1F1A,(a1)
	lea	patch_L1CE+2(pc),a1
	move.l	#$FC1F46,(a1)
	bra.s	L7F2
;
not_TOS_104:
	cmpi	#$106,(a0)
	bne.s	not_TOS_106
	move.l	(_sysbase).w,a2
	cmpi.l	#$6191989,24(a2)
	bne.s	L7C2
	lea	patch_L168+2(pc),a1
	move.l	#$E02002,(a1)
	lea	patch_L172+2(pc),a1
	move.l	#$E01FDE,(a1)
	lea	patch_L1CE+2(pc),a1
	move.l	#$E0200A,(a1)
	bra.s	L7F2
;
L7C2:
	cmpi.l	#$7291989,24(a2)
	bne.s	not_TOS_106
	lea	patch_L168+2(pc),a1
	move.l	#$E02116,(a1)
	lea	patch_L172+2(pc),a1
	move.l	#$E020F2,(a1)
	lea	patch_L1CE+2(pc),a1
	move.l	#$E0211E,(a1)
	bra.s	L7F2
;
not_TOS_106:
	pea	unknown_TOS_s(pc)
	bra.s	adapt_fail
;
L7F2:
	lea	patch_L190(pc),a1
	move.l	#$2A6F0062,(a1)		;patch MOVE.L	$62(sp),a5
	move.l	#$2268FFCC,4(a1)	;patch MOVE.L	-$34(a0),a1
L804:
	xbios	Kbdvbase
	move.l	d0,a0
	lea	32(a0),a0	;a0->ikbd_vec
	lea	(PH18_ikbd+8)(pc),a1
	move.l	(a0),(a1)	;store ikbd_vec in PH18_ikbd+8
	lea	ikbd_vec_p(pc),a1
	move.l	a0,(a1)		;store &ikbd_vec in ikbd_vec_p
	move	(nvbls).w,d0
	move.l	(_vblqueue).w,a0
	addq	#4,a0
	subq	#2,d0
L82A:
	tst.l	(a0)+
	beq.s	relocate_PH18
	dbra	d0,L82A
	pea	vblank_full_s(pc)
adapt_fail:
	gemdos	Cconws,()
	lea	fail_flag(pc),a0
	move	#$1,(a0)
	rts
;
;
relocate_PH18:
	lea	(PH18_gemdos+8)(pc),a1
	move.l	(ev_gemdos).w,(a1)
	move.l	bp_arglbase_p(pc),a1	;a1->arg in basepage
	lea	codemove_base(pc),a2
	move.l	a2,d0
	sub.l	a1,d0		;d0= distance for move
	lea	(MOVEM_D0_A0toA3_regsav+4)(pc),a3
	lea	LB8(pc),a4
	move.l	a4,(a3)
	sub.l	d0,(a3)		;relocate abs ref to be moved
	lea	codemove_limit(pc),a3
	lea	codemove_base(pc),a4
	suba.l	a4,a3		;a3= size for move
	subq	#1,a3		;adjust for dbra
	move.l	a3,d1		;d1= dbra count for move
codemove_loop:				;loop start to move PH18_gemdos etc.
	move.b	(a2)+,(a1)+		;move (shrink) code down
	dbra	d1,codemove_loop	;loop back for all needed code
	lea	PH18_vblsub(pc),a1
	suba.l	d0,a1			;a1->new loc PH18_vblsub
	move.l	a1,-(a0)		;store new PH18_vblsub in vbl queue
	lea	PH18_gemdos+12(pc),a1
	suba.l	d0,a1			;a1->new loc PH18_gemdos+12
	move.l	a1,(ev_gemdos).w	;store new PH18_gemdos+12 in ev_gemdos
	lea	PH18_ikbd+12(pc),a1
	suba.l	d0,a1			;a1->new loc PH18_ikbd+12
	move.l	ikbd_vec_p(pc),a0
	move	SR,-(sp)
	or	#$700,SR		;disable interrupts
	move.l	a1,(a0)			;store new PH18_ikbd+12 in ikbd_vec
	move	(sp)+,SR		;enable interrupts
;NB:	Interrupts are processed between instructions,
;NB	so the orig interrupt disabling is unnecessary for long move.
	rts
;
;
fail_flag:
	dc.w	$0
rec_cnt_himem:
	dc.w	$0
bp_arglbase_p:
	dc.l	0
entry_dta_p:
	dc.l	0
ikbd_vec_p:
	dc.l	0
filename_s:
	dc.b	'*.*',NUL
	dcb.b	10,0
PINHEAD_DAT_s:
	dc.b	'PINHEAD.DAT',NUL
vblank_full_s:
	dc.b	CR,LF,' No vblank slots left...',CR,LF,LF
	dc.b	' PinHead 1.8 installation cancelled!',CR,LF,LF,NUL
unknown_TOS_s:
	dc.b	CR,LF
	dc.b	" PinHead 1.8 doesn't recognize this",CR,LF
	dc.b	' version of TOS!',CR,LF,LF
	dc.b	' installation cancelled!',CR,LF,LF,NUL
copyright_s:
	dc.b	CR,LF,LF
	dc.b	' ',ESC,'p PinHead 1.8 ',ESC,'q',CR,LF,LF
	dc.b	' Copyright ',$BD,' 1989, 1990 Charles F. Johnson',CR,LF
	dc.b	' Shareware from Little Green Footballs',CR,LF,LF
	dc.b	' XBRA for ikbd_vec added February 1992',CR,LF
	dc.b	' by Ulf Ronald Andersson.',CR,LF,LF
	dc.b	' Please support shareware authors!',CR,LF,LF,NUL
file_data:
	dc.w	0
;
	end
;
;----------------------------------------------------------------------------
;End of file:	PINHED18.S
;----------------------------------------------------------------------------
