;-----------------------------------------------------------------------------
;File name:	HOTDEBUG.S			Revised:	2000.07.17
;Revised by:	Ulf Ronald Andersson		Created:	1996.06.16
;						Version:	1.2
;File purpose:	Allow special debug operation using hotkeys
;-----------------------------------------------------------------------------
;Revision history:
;
;Version:	Updates:
;  1.0		First creation, to save restore ST shifter palette
;  1.2		evnt_multi implementation tester
;-----------------------------------------------------------------------------
	output	.TOS
;-----------------------------------------------------------------------------
;	Runtime commands:
;
; <CONTROL> <L.Shift>  <S>  Saves shifter palette
; <CONTROL> <L.Shift>  <R>  Restores shifter palette
; <CONTROL> <L.Shift>  <T>  Forces a timer event via latest AESPB ptr
;-----------------------------------------------------------------------------
	include	RA_TOS.I
	include	RA_XB.I
	include	RA_JAR.I
;-----------------------------------------------------------------------------
	TEXT
;-----------------------------------------------------------------------------
start:
	bra	install
;-----------------------------------------------------------------------------
HotD_ck:
	dc.w	$0101,$0101		;cur_vers = 1.2, I_F_vers = 1.2
	dc.l	0			;->AESPB for event generation tests
;-----------------------------------------------------------------------------
	XB_define	nu_ikbd_vec,'HotD'
	XB_donext_d	nu_ikbd_vec(pc)
	bra.s		UKEXcode
;-----------------------------------------------------------------------------
	XB_define	nu_timer,'HotD'
	move		4(sp),-(sp)	;copy argument
	XB_donext_d	nu_timer(pc)
	addq.l	#2,sp
UKEXcode:
	move	SR,-(sp)
	move.l	kb_iorec_p(pc),a0
	move	io_tail_ix(a0),d1	;tail index
	cmp	old_tail_ix(pc),d1	;test if changed
	beq.s	.return
	or	#$0700,SR
	move	io_tail_ix(a0),d1	;tail index
	move	d1,old_tail_ix		;save tail index at old_tail_ix
	cmp	io_head_ix(a0),d1
	beq.s	.return
	move.l	kbshift_p(pc),a1
	move.b	(a1),d2			;New! get kbshifts (** TOS independent **)
	and	#$0F,d2
	cmp	#6,d2			;Control + Left Shift ?
	bne.s	.return
	move.l	io_buffer_p(a0),a2	;get address of io-buffer
	move	(a2,d1),d0		;get 1'st word for this key = key code
	and	#$7F,d0
.check_ascii:
	move.l	keytbl_ptp,a2
	move.l	8(a2),a2	;a2 -> current capslock keytable
	move.b	(a2,d0),d0	;translate keycode to ascii code
	and	#$DF,d0		;enforce upper case
	cmp	#'I',d0		;Init command ?
	beq.s	.put_comd
	cmp	#'X',d0		;Exit command ?
	beq.s	.put_comd
	cmp	#'R',d0		;Restore palette command ?
	beq.s	.put_comd
	cmp	#'S',d0		;Save palette command ?
	beq.s	.put_comd
	cmp	#'T',d0		;force Timer event command ?
	bne.s	.return
.put_comd:
	move	d0,kbd_comd
	subq	#4,d1
	bge.s	.tail_shrunk
	move	io_size_ix(a0),d1
	subq	#4,d1
.tail_shrunk:
	move	d1,io_tail_ix(a0)
	move	d1,old_tail_ix
.return:
	move	(sp)+,SR
	rts
;-----------------------------------------------------------------------------
	XB_define	new_VBI,'HotD'
	tst		kbd_comd
	bne.s		DOcommand
old_VBI_jmp:
	XB_gonext_d	new_VBI(pc)
;
;
DOcommand:
	tas	new_comd
	bne.s	old_VBI_jmp
	move.b	kbd_comd+1(pc),new_comd+1
	clr	kbd_comd
	push_ex	commander(pc)
	bra.s	old_VBI_jmp
;
;
commander:
	movem.l	d0-d2/a0-a2,entry_regs
	move	sr,entry_sr
	ori	#$0700,sr
	bsr	commandsub
	move	entry_sr(pc),sr
	movem.l	entry_regs(pc),d0-d2/a0-a2
	clr	new_comd
	rte
;-----------------------------------------------------------------------------
real_return_p:	dc.l	-1
;-----------------------------------------------------------------------------
	XB_define	new_gemdos,'HotD'
;-------
	btst	#5,(sp)
	bne.s	.super_called
.user_called:
	move.l	USP,a0
	bra.s	.common_tests
;-------
.super_called:
	lea	6(sp),a0
	tst	(_longframe).w
	beq.s	.done_frame
	addq	#2,a0
.done_frame:
.common_tests:
	move	(a0),d0
	beq.s	goto_old_gemdos
	cmp	#Super&$ff,d0
	beq.s	goto_old_gemdos
	cmp	#Pterm&$ff,d0
	beq.s	goto_old_gemdos
	cmp	#Ptermres&$ff,d0
	beq.s	goto_old_gemdos
;-------
	move.l	2(sp),real_return_p
	btst	#5,(sp)
	bne.s	.set_super_return
.set_user_return:
	move.l	#user_post_gemdos,2(sp)
	bra.s	.common_return
;-------
.set_super_return:
	move.l	#super_post_gemdos,2(sp)
.common_return:
	lea	(ev_gemdos).w,a0
	move.l	#'HotD',d0
	XB_kill_name
goto_old_gemdos:
	move.l	new_gemdos+xb_next(pc),-(sp)
	rts				;jump to older gemdos
;-------------------------------------
super_post_gemdos:
	cmp.l	#E_INVFN,d0
	bne.s	.done_break
	illegal
.done_break:
	move.l	real_return_p(pc),-(sp)
	bsr.s	init_new_gemdos_supx
	rts				;goto real return address
;-------------------------------------
user_post_gemdos:
	cmp.l	#E_INVFN,d0
	bne.s	.done_break
	illegal
.done_break:
	move.l	real_return_p(pc),-(sp)
	bsr.s	init_new_gemdos_sub
	rts				;goto real return address
;-----------------------------------------------------------------------------
init_new_gemdos_sub:
	movem.l	d0-d2/a0-a2,-(sp)
	xbios	Supexec,init_new_gemdos_supx(pc)
	movem.l	(sp)+,d0-d2/a0-a2
	rts
;-------------------------------------
init_new_gemdos_supx:
	movem.l	d0/a0-a1,-(sp)
	lea	(ev_gemdos).w,a0
	lea	new_gemdos(pc),a1
	XB_init
	movem.l	(sp)+,d0/a0-a1
	rts
;-----------------------------------------------------------------------------
commandsub:
	move	new_comd(pc),d0
	and	#$DF,d0			;force upper case
	cmp	#'I',d0
	beq.s	I_command
	cmp	#'X',d0
	beq.s	X_command
	cmp	#'S',d0
	beq.s	S_command
	cmp	#'R',d0
	beq.s	R_command
	cmp	#'T',d0
	beq.s	T_command
	bra.s	no_command
;-------------------------------------
I_command:
	bsr.s	X_command
	bsr.s	X_command
	lea	(ev_gemdos).w,a0
	lea	new_gemdos(pc),a1
	XB_init
	rts
;-------------------------------------
X_command:
	lea	(ev_gemdos).w,a0
	move.l	#'HotD',d0
	XB_kill_name
	rts
;-------------------------------------
S_command:
	lea	(hw_pal).w,a0
	lea	saved_pal(pc),a1
	moveq	#16-1,d0
.loop:
	move	(a0)+,(a1)+
	dbra	d0,.loop
	rts
;-------------------------------------
R_command:
	lea	saved_pal(pc),a0
	lea	(hw_pal).w,a1
	moveq	#16-1,d0
.loop:
	move	(a0)+,(a1)+
	dbra	d0,.loop
	rts
;-------------------------------------
T_command:
	move.l	HotD_ck+4(pc),a0	;a0 -> AESPB of registered APP
	move.l	a0,d0
	ble.s	.exit			;refuse if none registered
	move.l	8(a0),a0		;a0 -> intin array of registered APP
	bset	#5,0+1(a0)		;set MU_TIMER flag
	clr.l	30(a0)			;clear timeout period
.exit:
	rts
;-------------------------------------
no_command:
	rts
;-------------------------------------
entry_regs:	ds.l	6
entry_sr:	ds.w	1
keytbl_ptp:	dc.l	0	;-> table of 3 ptrs to keytables
kbshift_p:	dc.l	0	;-> OS variable for kbshift
kb_iorec_p:	dc.l	0	;-> keyboard iorec structure
old_tail_ix:	dc.w	-1
kbd_comd:	dc.w	0
new_comd:	dc.w	0
saved_pal:	ds.w	16
;-----------------------------------------------------------------------------
	_uniref	reset_old_jar
	make	JAR_links
;-----------------------------------------------------------------------------
;	The resident program will end here,
;	The following code only exists during installation,
;
install:
	move.l	4(sp),a5	;a5 -> basepage
	lea	pgm_len,a0
	lea	install,a1
	move.l	a1,d0
	sub.l	a5,d0		;* calculate length
	move.l	d0,(a0)
	move.l	(a0),d0
	add.l	#$1000,d0
	lea	(a5,d0.l),sp
	gemdos	Mshrink,!,(a5),d0
	xbios		Kbdvbase
	move.l		d0,a1
	XB_check	nu_ikbd_vec,32(a1)
	bpl		notagain
	XB_check	nu_timer,(etv_timer).w
	bpl		notagain
	XB_check	new_VBI,(ev_VBI).w
	bpl		notagain
	xbios	Iorec,#1
	move.l	d0,kb_iorec_p
	xbios	Keytbl,?,?,?
	move.l	d0,keytbl_ptp
	gemdos	Super,!
	lea	SSP_save,a0
	move.l	d0,(a0)
;
	make_cookie	#'HotD',HotD_ck
;
;*********; Here starts TOS identification/adaption
	move.l	(_sysbase).w,a0
	move.l	os_selfbeg_p(a0),a0
	move.l	$24(a0),a1	;->kbshift variable in modern TOS >= 1.2
	cmp	#$0102,2(a0)	;check OS version
	bhs.s	insta_OS
;this is an init of kbshift_p, valid for TOS <= TOS 1.02
	move.l	keytbl_ptp,a1
	subq	#1,a1		;NB: This assumes Kbshift stored at Keytbl-1.
;				;NB: All early TOS have Kbshift data there !!!
insta_OS:
	move.l	a1,kbshift_p
	gemdos	Super|_ind,SSP_save(pc)
	gemdos	Cconws,Activation_s(pc)
	xbios	Kbdvbase
	move.l	d0,a1		;* a1 = addr(kbdvbase)
	XB_install	nu_ikbd_vec,32(a1)
	XB_install	nu_timer,(etv_timer).w
	XB_install	new_VBI,(ev_VBI).w
	gemdos	Ptermres,pgm_len(pc),#0
;
;
notagain:
	gemdos	Cconws,Refusal_s
	gemdos	Crawcin
	gemdos	Pterm,!
;-----------------------------------------------------------------------------
	make	JAR_links
;-----------------------------------------------------------------------------
SSP_save:	dc.l	0
pgm_len:	dc.l	0
;
;
Activation_s:
	dc.b	CR,LF
	dc.b	"______ HotDebug 1.2 activated ! ______",CR,LF
	dc.b	CR,LF
	dc.b	"<Control> <L.Shift> <letter> = cmd",CR,LF
	dc.b	"letter 'I' => init gemdos breaker",CR,LF
	dc.b	"letter 'X' => exit gemdos breaker",CR,LF
	dc.b	"letter 'S' => save palette",CR,LF
	dc.b	"letter 'R' => restore palette",CR,LF
	dc.b	"letter 'T' => force timer event",CR,LF
	dc.b	CR,LF
	dc.b	"--------------------------------------",CR,LF
	dc.b	"Version 1.2  developed   July 2000 by:",CR,LF
	dc.b	CR,LF
	dc.b	"    Ulf Ronald Andersson",CR,LF
	dc.b	CR,LF
	dc.b	"    mailto://dlanor@ettnet.se",CR,LF
	dc.b	"    http://www.ettnet.se/~dlanor/",CR,LF
	dc.b	"--------------------------------------",CR,LF
	dc.b	NUL
;
Refusal_s:
	dc.b	CR,LF
	dc.b	"______ HotDebug already active ! _____",CR,LF
	dc.b	CR,LF
	dc.b	"Sorry, I will not install HotDebug,",CR,LF
	dc.b	"when it seems to be installed already.",CR,LF
	dc.b	"This should never happen, so please hit",CR,LF
	dc.b	"a key to acknowledge this warning.",CR,LF
	dc.b	"--------------------------------------",CR,LF
	dc.b	"Version 1.2   developed  July 2000 by:",CR,LF
	dc.b	CR,LF
	dc.b	"    Ulf Ronald Andersson",CR,LF
	dc.b	CR,LF
	dc.b	"    mailto://dlanor@ettnet.se",CR,LF
	dc.b	"    http://www.ettnet.se/~dlanor/",CR,LF
	dc.b	"--------------------------------------",CR,LF
	dc.b	NUL
;-----------------------------------------------------------------------------
	end
;-----------------------------------------------------------------------------
;End of file:	HOTDEBUG.S
;-----------------------------------------------------------------------------
