;----------------------------------------------------------------------------
; File name:	LACE_400.S	Revised:	1992.05.04
; Created by:	U.R. Andersson	Created:	1990.12.07
; Project:	LACEPACK	Version:	3.01
;----------------------------------------------------------------------------
; Copyright:	(c)1991 by Ulf Ronald Andersson All rights reserved
; Shareware:	Rights to distribution and use released under the 10
;		conditions given in LACEPACK.DOC, without which file
;		distribution of other package parts is criminal.
;;----------------------------------------------------------------------------
; Recognition:	This work was partly inspired by the pioneering effort
;		of  Mick  West.  Indeed, my first "emu's" were merely
;		simple variations on his themes.
;		LACEPACK of course has no internal resemblance to
;		those, and has many novel features. (see LACEPACK.DOC)
;----------------------------------------------------------------------------
;
; This is a boot program to make the ST think it is in mono mode.
; It makes the system think that there is a mono screen, but actually
; be updating a medium screen from this under VBI interrupt
;
;
; Version 1:
; First version with useful interaction between MONODESK & lace_400.
; The XBIOS calls: Physbase,Setscreen and Getrez are revectored.
; and the XBIOS function "MO"=$4d4f is added
;
; Uses Mick West's "init delay" method to ensure TOS compatibility.
; But has new screen handling to gain speed, and for compatibility
; with programs that gave errors under Mick's emulator.
; (Such as: "Super Breakout" and "Little Painter")
;
; Version 2 also extended to give user defined optimization
; of program speed versus visual quality as well as update speed.
; Different emulation filters can be selected externally.
;
; Version 3 introduces XBRA protocol for all linked vectors.
; The "init delay" method is completely reworked, for safety.
;
; Version 3.01 Adds new emu methods, and yet another rewrite of
; the "init delay" to ensure palette initialization at boot.
;
;----------------------------------------------------------------------------
;
	nolist
	include	URAn_SYS.s
	include	URAn_DOS.s
	include	URAn_XB.S	; This defines 9 macros handling XBRA protocol
;
;   The first 4 alter no registers
; XB_define	xbstruct,xbra_id	Defines header for XBRA function code
; XB_gonext	xbstruct		Links to next XBRA function in chain
; XB_gonext_d	xbstruct		Links to next XBRA function in chain
; XB_donext_d	xbstruct		Calls next XBRA subroutine in chain
;
;   The next 2 alter only the choosen "areg"
; Find_Frame	areg			areg->exception argument -6
; XB_donext	xbstruct,areg		Calls next XBRA function in chain
;
;   The next 3 affect d0-d2/a0-a2, since they use XBIOS Supexec
; XB_check	xbstruct,root		d0= found_codead/zero  flagged NE/EQ
;   -"-           -"-			a0->found_vector/last_vector 
; XB_install	xbstruct,root		Installs xbstruct in chain(root)
; XB_remove	xbstruct,root		Removes xbstruct from chain(root)
;
; Legal forms for xbstruct & root here are mostly the same as for LEA & PEA,
;   except that for XB_define "xbstruct" is a free name for the new structure.
; "xbstruct" always refers to the first byte of the entire structure.
; "xbra_id" is a 4-character (longword) string
; "areg" is a free address register of your choice.
; XB_gonext_d & XB_donext_d are faster versions of XB_gonext & XB_donext,
;   but can only handle address modes where "xbstruct" begins with identifier.
;   eg: "XB_donext_d  my_ikbd_sub(pc)"  but  "XB_donext  (a5)+")
; Find_Frame makes XBRA exception functions (eg: gemdos etc.) TT compatible.
;
;----------------------------------------------------------------------------
;
repeat	macro	count,op
	ifne	(\1)&1
	\2
	endc
	ifne	(\1)&2
	\2
	\2
	endc
	ifne	(\1)&4
	\2
	\2
	\2
	\2
	endc
	ifne	(\1)>7
	repeat	(\1)/8,<\2>
	repeat	(\1)/8,<\2>
	repeat	(\1)/8,<\2>
	repeat	(\1)/8,<\2>
	repeat	(\1)/8,<\2>
	repeat	(\1)/8,<\2>
	repeat	(\1)/8,<\2>
	repeat	(\1)/8,<\2>
	endc
	endm
;
;----------------------------------------------------------------------------
;
;
dummylong	=	$12345678	;forces absolute long ref's (patches)
;
;
;----------------------------------------------------------------------------
	section	text	;text segment (only segment)
;
rz:	;relative zero: must be first code pos
bp	= rz-$100
	bra	init_emu
;
;----------------------------------------------------------------------------
;
s_user:		dc.l 0	;logbase screen
s_main:		dc.l 0	;main emulation screen
s_help:		dc.l 0	;help emulation screen
s_odds:		dc.l 0	;odd emulation screen screen
emu_cnt:	dc.w 0	; line quad/octet dbra-counter
emu_pos:	dc.w 0	; offset in both screens in bytes
emu_spd:	dc.w 0	; quads of medium lines -1 to do per vbi
emu_type_ix:	dc.w 0	; index for emulation type 0..3
ref_type_ix:	dc.w 0	; 4 * index for latest non-zero type
emu_block:	dc.w 0	; bit 15 flags emulation block
emu_flag:	dc.w 0	; bit 15 flags busy, bits 0..7 delay speed rise
laceflag:	dc.w 0	; bit 15 toggled for interlace
nonoflag:	dc.w 0	; it's a nono to emulate on mono monitor
gem_flag:	dc.w 0	; Flags post-GEM colour initialization
gem_check:	dc.l 0	;->initial XGEMDOS link (before GEM init)
;
def_type_ix	= 2
type_ix_lim	= 5
;
colourtab0:
	dc.l	$0000000,$0000777,$0000333,$0000333,$0000222
	dc.l	$0000000,$0000777,$3330777,$3330777,$4440777
colourtab2:
	dc.l	$0000000,$7770000,$7770444,$7770444,$7770555
	dc.l	$0000000,$7770000,$4440000,$4440000,$4440000
background:
	dc.w	$0777
;
iz_emu_t:
	dc.l	initF0,initF1,initF2,initF3,initF4
emu_type_t:
	dc.l	monoF0vbi,monoF1vbi,monoF2vbi,monoF3vbi,monoF4vbi
emu_spd_t:
	dc.l	200,92,160,56,56
;
;
;----------------------------------------------------------------------------
;XBRA	xbios_XB	= new xbios routine
;
	XB_define	xbios_XB,'MONO'
	lea	rz,a0
	move.l	sp,a1	; a1 -> the stack
	btst	#5,(a1)	; test if called from user mode
	bne.s	notuser	; skip if it is
	move.l	usp,a1	; otherwise get a1 = user stack
	subq	#6,a1	; offset it as if it were the ssp
notuser:
	move	6(a1),d0	; get xbios instruction code
	tst.b	nonoflag-rz(a0)	; real mono monitor ?
	bne.s	nonoxbios	; if so, emulation is nono
	cmp	#4,d0
	beq	nugetrez
	blo.s	q_physbase
	cmp	#5,d0	; if it is Setscreen
	beq	nusetscreen
nonoxbios:
	cmp	#'MO',d0	; if it is not special mono command
	beq.s	monocommand
	XB_gonext_d	xbios_XB
;
q_physbase:
	cmp	#2,d0	; if it is Physbase
	beq	nuphysbase	; then jump to new physbase routine
	XB_gonext_d	xbios_XB
;
monocommand:
	moveq	#-38,d0	; prep "wrong screen rez" error
	tst.b	nonoflag-rz(a0)	; real mono monitor ?
	bne	checktype	; if so, just return -38, to say nono
	move	emu_spd(pc),d0
	addq	#1,d0	;adjust from dbra value
	asl	#2,d0	;and scale from quad to single line count
	swap	d0
	move	8(a1),d0
	bmi	checkspeed
	cmp	#10,d0
	bhs.s	setspeed
	swap	d0
	move	emu_type_ix(pc),d0
	swap	d0
	cmp	#type_ix_lim,d0
	bhs.s	checktype
	move	d0,emu_type_ix-rz(a0)
	asl	#2,d0
	lea	emu_type_t(pc),a1
	move.l	(a1,d0),d1
	move.l	d1,monotype+2-rz(a0)
	tst	d0
	beq.s	checktype
	cmp	ref_type_ix(pc),d0
	beq.s	checktype
	move	d0,ref_type_ix-rz(a0)
	lea	iz_emu_t(pc),a1
	move.l	(a1,d0),a1
	jsr	(a1)
	move	(hw_pal).w,d0
	move	d0,background-rz(a0)
	lea	colourtab2(pc),a1
	and	#1,d0
	bne.s	settypecol
	lea	colourtab0(pc),a1
settypecol:
	move	ref_type_ix(pc),d0
	move.l	00(a1,d0),(hw_pal+0).w
	move.l	type_ix_lim*4(a1,d0),(hw_pal+4).w
	move	emu_spd(pc),d0
	addq	#1,d0		;adjust from dbra value
	asl	#2,d0		;and scale from quad to single line count
setspeed:
	lea	emu_spd_t+2(pc),a1
	add	ref_type_ix(pc),a1
	cmp	(a1),d0
	bls.s	setspeed1
	move	(a1),d0
setspeed1:
	addq	#3,d0		;round up to quad count
	lsr	#2,d0		;new method uses groups of 4 medium lines
	subq	#1,d0		;but correct d0 for future dbra
	move	d0,emu_spd-rz(a0)
checkspeed:
checktype:
	clr	d0
	swap	d0
	rte	; return mono screen location
;
;
nuphysbase:
	move.l	s_user(pc),d0	; get address of mono screen
	rte	; return mono screen location
;
nugetrez:
	move	#2,d0	; pretend we are in mono resolution
	rte	; return code for mono resolution
;
nusetscreen:
	move	#-1,16(a1)	; alter rez.w to -1 (keep old)
	move.l	12(a1),d0	; get the PHYSBASE parameter
	cmp.l	#-1,d0		; if it is -1
	beq.s	xbios_gonext	; then continue with normal xbios
	move.l	d0,s_user-rz(a0)	; otherwise, new value goes to mono
	move.l	#-1,12(a1)	; set PHYSBASE to -1 (keep old)
xbios_gonext:
	XB_gonext_d	xbios_XB
;
;
nonolimit:	;program end if using mono monitor
;
;
;----------------------------------------------------------------------------
; swv_vec_XB replaces RESET on monitor swap
; and so does NOT execute the older XBRA chain
;
	XB_define	swv_vec_XB,'MONO'
swv_vec_sb:
	move.b	#1,(defshiftmd).w
	move.b	#2,(sshiftmd).w
	move.b	#1,(hw_rez).w
	rts
;
;
;----------------------------------------------------------------------------
; this is the first vbi init routine
;
	XB_define	init_vbi_XB,'MONO'
	movem.l	d0-d2/a0-a2,-(sp)
	lea	rz(pc),a2
	tst	emu_flag-rz(a2)
	bne	await_gem
	move	#150,emu_flag-rz(a2)
	XB_remove	init_vbi_XB,(ev_vbi).w
	XB_install	emu_vbi_XB,(ev_vbi).w
await_gem:
	movem.l	(sp)+,d0-d2/a0-a2
	XB_gonext_d	init_vbi_XB
;
;
;----------------------------------------------------------------------------
; this is the main vbi routine
;
	XB_define	emu_vbi_XB,'MONO'
	movem.l	d0-d2/a0-a2,-(sp)
	lea	rz(pc),a2
	tas	emu_block-rz(a2)
	bmi.s	.emu_blocked
	move.l	s_help(pc),a0
	move.l	s_main(pc),d2
;;;	clr.l	d0
;;;	move.b	(hw_vbase2).w,d0
;;;	swap	d0
;;;	move.b	(hw_vbase1).w,d0
;;;	asl	#8,d0
;;;	cmp.l	d0,a0
;;;	beq.s	.s_user_OK
;;;	cmp.l	d0,d2
;;;	beq.s	.s_user_OK
;;;	move.l	d0,s_user-rz(a2)
;;;.s_user_OK:
	move	#$0101,d1
	cmp.l	a0,d2
	beq.s	.keep_base
	move	#$0142,d1
	not.b	laceflag-rz(a2)
	bmi.s	.got_lace	; use even screen ( ptr in d2  lace in d1 )
	subq	#2,d1
	move.l	a0,d2		; use odd screen ( a0 to d2  d1 adjusted )
.got_lace:
	lsr	#8,d2			;\
	move.b	d2,(hw_vbase1).w	; \ Store medium screen base
	swap	d2			; / in the hardware pointer
	move.b	d2,(hw_vbase2).w	;/
.keep_base:
	move	d1,(hw_rez).w	; set hardware for new sync and medium rez
	tas	emu_flag-rz(a2)
	bmi.s	.emu_busy
	sf	emu_block-rz(a2)
	pea	emu_main	; push emulator routine address
	move	SR,-(sp)
.emu_exit:
	XB_gonext_d	emu_vbi_XB
; Here we ensure that VBI chain is exhausted before the main emulator work
; is performed, so that no interrupt conflict will arise.
;
.emu_busy:
	sf	emu_block-rz(a2)
.emu_blocked:
	movem.l	(sp)+,d0-d2/a0-a2
	bra.s	.emu_exit
;
;	
; At entry to "emu_main" d0-d2/a0-a2 lie on stack on top of SR & PC for RTE
; Entry SR is like interrupted SR, but always has supervisor bit set
; Also: a2->rz
;
emu_main:
	tst.b	emu_flag+1-rz(a2)
	beq.s	emu_old
	subq.b	#1,emu_flag+1-rz(a2)
	bne.s	emu_old
	tst.b	gem_flag-rz(a2)
	bne.s	emu_old
	move.b	#100,emu_flag+1-rz(a2)
	move.l	gem_check(pc),d0
	cmp.l	(ev_xgemdos).w,d0
	beq.s	emu_old
	clr.l	gem_check-rz(a2)
	tst.l	d0
	bne.s	emu_old
gem_ready:
	st	gem_flag-rz(a2)
	addq	#1,background-rz(a2)
	clr.b	emu_flag+1-rz(a2)
emu_old:
	move	ref_type_ix(pc),d2
	beq.s	monotype	;waste no time on NULL filter
	move	(_frclock+2).w,d0
	and	#$000f,d0
	bne.s	.medok
	move	(hw_pal).w,d0
	move	background(pc),d1
	eor	d0,d1
	and	#1,d1
	beq.s	.noinvert
	and	d0,d1	; Inverted ?
	beq.s	.invert	; jump if so
	lea	colourtab2(pc),a1
	bra.s	.setcolor
;
.invert:
	lea	colourtab0(pc),a1
.setcolor:
	move.l	00(a1,d2),(hw_pal+0).w
	move.l	type_ix_lim*4(a1,d2),(hw_pal+4).w
	move	d0,background-rz(a2)
.noinvert:
.medok:
	move	#3-1,d0		; default 3 screens/second
	tst	(flock).w	; test flock system variable
	bne.s	.filter1		; set speed to 3 if using drive & remember
	tst.b	emu_flag+1-rz(a2)
	bne.s	.filter2		; set speed to 3 if remembering flock
	move	emu_spd(pc),d0	; otherwise get preset speed
	bra.s	.filter2
;
.filter1:
	move.b	#100,emu_flag+1-rz(a2)
.filter2:
	move.l	s_user(pc),a0
	move.l	s_main(pc),a1
	move	emu_pos(pc),a2	; a1 = ram offset
	add	a2,a0
	add	a2,a1
	move	#32000,d2
	move	emu_cnt(pc),d1
monotype:
	jmp	(dummylong).l
;
;
initFx_dly:
	lea	rz(pc),a2
.delay_1:
	tas	emu_block-rz(a2)
	bmi.s	.delay_1
.delay_2:
	tst.b	emu_flag-rz(a2)
	bmi.s	.delay_2
	rts
;
;
initF0:
initF1:
	movem.l	d0-d2/a0-a2,-(sp)
	bsr.s	initFx_dly
	move.l	s_odds(pc),d0
	bra.s	initFx_end
;
initF2:
	movem.l	d0-d2/a0-a2,-(sp)
	bsr.s	initFx_dly
	move.l	s_main(pc),d0
	bra.s	initFx_end
;
initF3:
initF4:
	movem.l	d0-d2/a0-a2,-(sp)
	bsr.s	initFx_dly
	move.l	s_main(pc),a0
	move.l	s_odds(pc),a1
	sub	#160,a0
	sub	#160,a1
	move	#202*160/4-1,d0
.initloop:
	clr.l	(a0)+
	clr.l	(a1)+
	dbra	d0,.initloop
	move.l	s_odds(pc),d0
initFx_end:
	move.l	d0,d1
	lsr.l	#8,d0			;\
	move.b	d0,(hw_vbase1).w	; \ Store medium screen base
	lsr.l	#8,d0			; / in the hardware pointer
	move.b	d0,(hw_vbase2).w	;/
	move.l	d1,s_help-rz(a2)
	sf	emu_block-rz(a2)
	movem.l	(sp)+,d0-d2/a0-a2
	rts
;
;
monoF0vbi:
	bra	monoFx_end
;
;
emu_1_line	macro
	repeat	40,emu_1_word
	exg	a1,a2
	endm
;
emu_1_word	macro
	move	(a0)+,(a1)
	addq	#4,a1
	endm
;
; here: a0->mono screen  a1->main medium  a2==screen offset
; d0==emu_spd  d1==emu_cnt  d2==32000
monoF1vbi:
	add.l	s_help(pc),a2
.emu_loop:
	repeat	8,emu_1_line
	dbra	d1,.fixed
	moveq	#400/8-1,d1
	sub	d2,a0
	sub	d2,a1
	sub	d2,a2
.fixed:
	dbra	d0,.emu_loop
	bra	monoFx_end
;
;
emu_2_pair	macro
	repeat	40,emu_2_long
	exg	a0,a2
	add	#160,a2
	endm
;
emu_2_long	macro
	move	(a0)+,(a1)+
	move	(a2)+,(a1)+
	endm
;
; here: a0->mono screen	 a1->main medium	 a2==screen offset
; d0==emu_spd  d1==emu_cnt  d2==32000
monoF2vbi:
	lea	laceflag(pc),a2
	clr.b	(a2)
	lea	80(a0),a2
.emu_loop:
	repeat	4,emu_2_pair
	dbra	d1,.fixed
	moveq	#400/8-1,d1
	sub	d2,a0
	sub	d2,a1
	sub	d2,a2
.fixed:
	dbra	d0,.emu_loop
	bra	monoFx_end
;
;
emu_3_line	macro
ix	set	0
	repeat	40,emu_3_word
	exg	a1,a2
	endm
;
emu_3_word	macro
	cmpm	(a0)+,(a2)+
	beq.s	.next\@
	move	-(a0),4*ix+2(a1)
	move	(a0)+,-2(a2)
.next\@:
	addq	#2,a2
ix	set	ix+1
	endm
;
; here: a0->mono screen	 a1->main medium	 a2==screen offset
; d0==emu_spd  d1==emu_cnt  d2==32000
monoF3vbi:
	add.l	s_help(pc),a2
	sub	#160,a2
.emu_loop:
	repeat	8,emu_3_line
	dbra	d1,.fixed
	moveq	#400/8-1,d1
	sub	d2,a0
	sub	d2,a1
	sub	d2,a2
.fixed:
	dbra	d0,.emu_loop
	bra	monoFx_end
;
;
emu_4_line	macro
ix	set	0
	repeat	40,emu_4_word
	exg	a1,a2
	endm
;
emu_4_word	macro
	cmpm	(a0)+,(a1)+
	beq.s	.next\@
	move	-2(a0),d3
	move	d3,-2(a1)
	move	-162(a1),d4
	or	d3,d4
	move	d4,4*ix-158(a2)
	or	+158(a1),d3
	move	d3,4*ix+2(a2)
.next\@:
	addq	#2,a1
ix	set	ix+1
	endm
;
; here: a0->mono screen	 a1->main medium	 a2==screen offset
; d0==emu_spd  d1==emu_cnt  d2==32000
monoF4vbi:
	add.l	s_help(pc),a2
	movem.l	d3-d4,-(sp)
.emu_loop:
	repeat	8,emu_4_line
	dbra	d1,.fixed
	moveq	#400/8-1,d1
	sub	d2,a0
	sub	d2,a1
	sub	d2,a2
.fixed:
	dbra	d0,.emu_loop
	movem.l	(sp)+,d3-d4
monoFx_end:
	lea	rz(pc),a2
	move	d1,emu_cnt-rz(a2)
	sub.l	s_main(pc),a1
	move	a1,emu_pos-rz(a2)
	sf	emu_flag-rz(a2)
	movem.l	(sp)+,d0-d2/a0-a2
	RTE
;
;
;----------------------------------------------------------------------------
transform:	; position of runtime_redundant code
; so everything beyond this point may be overwritten
; by the medium screen (but at doublepage boundary)
;
;
s_notagain:
	dc.b	CR,LF
	dc.b	"Sorry, xbios XBRA = 'MONO' exists here.",CR,LF
	dc.b	"So LACE_400.PRG cannot be installed.",CR,LF
	dc.b	"( May be installed already ! )",CR,LF
	dc.b	"This attempt had no effect.",CR,LF
	dc.b	NUL
;
s_notmono:
	dc.b	CR,LF
	dc.b	"The hardware is already running at MONO speed,",CR,LF
	dc.b	"so the LACE_400.PRG emulation will not be installed.",CR,LF
	dc.b	"The xbios only is patched (XBRA = 'MONO'), for recognition,",CR,LF
	dc.b	"and to enable the options of MONODESK.ACC.",CR,LF
	dc.b	NUL
;
s_message:
	dc.b	27,"e"
	dc.b	"     LACEPACK 400-line emulator version: 3.01",CR,LF
	dc.b	"--------------------------------------------------",CR,LF
	dc.b	"(c)1991 Ulf Ronald Andersson, All rights reserved.",CR,LF
	dc.b	"Released as SHAREWARE under 10 conditions given",CR,LF
	dc.b	"in the file LACEPACK.DOC, without which file the",CR,LF
	dc.b	"distribution of any LACEPACK file is criminal.",CR,LF
	dc.b	"--------------------------------------------------",CR,LF
	dc.b	"If this program wasn't AUTO booted, I'm afraid you'll",CR,LF
	dc.b	"have to reboot now, unless you like confusing screens.",CR,LF
	dc.b	"Please read LACEPACK.DOC at least once. It contains",CR,LF
	dc.b	"information on how to use LACEPACK, plus some info",CR,LF
	dc.b	"on LACEPACK's history, and on video hardware.",CR,LF
	dc.b	CR,LF
	dc.b	"Send bug info, piracy info, complaints, requests etc.,",CR,LF
	dc.b	"to:",CR,LF
	dc.b	"	U. R. Andersson",CR,LF
	dc.b	"	Lokes Vaeg 6",CR,LF
	dc.b	"	S-145 70 Norsborg",CR,LF
	dc.b	"	Sweden",CR,LF
	dc.b	NUL
;
;
	even
;
;----------------------------------------------------------------------------
;
	XB_define	simp_vbi_XB,'MONO'
	addq	#1,emu_flag
	XB_gonext_d	simp_vbi_XB
;
;----------------------------------------------------------------------------
;
init_emu:
	lea	rz,a6
	gemdos	Super,!
	move.l	d0,d7
	move.b	(hw_rez).w,d0
	and.b	#3,d0
	cmp.b	#2,d0
	seq	nonoflag-rz(a6)
	XB_check	simp_vbi_XB,(ev_vbi).w
	bpl.s	.not_again
	XB_check	simp_vbi_XB,(ev_xbios).w
	bpl.s	.not_again
;patch add emu_dependent XBRA tests here
	bra.s	.XB_not_present
;
.not_again:
	gemdos	Cconws,s_message(pc)
	gemdos	Cconws,s_notagain(pc)
	gemdos	Super!_IND,d7
	gemdos	Pterm,#0
;
.XB_not_present:
	clr	emu_type_ix-rz(a6)		; set up filter type index 0
	tst.b	nonoflag-rz(a6)
	beq.s	nothigh
	gemdos	Cconws,s_message(pc)
	gemdos	Cconws,s_notmono(pc)
	XB_install	xbios_XB,(ev_xbios).w
exit_noemu:
	gemdos	Super!_IND,d7
	gemdos	Ptermres,#nonolimit-rz+$200,#0
;
nothigh:
	move	#11,emu_spd-rz(a6) 	;default is 48 lines/VBI = 12 screens/second
	move	#def_type_ix,emu_type_ix-rz(a6)	; set up default filter type index
	move	#def_type_ix*4,d0
	move	d0,ref_type_ix-rz(a6)
	lea	emu_type_t(pc),a0
	move.l	(a0,d0),monotype+2-rz(a6)	; set up filter type vector
	move.l	colourtab2+def_type_ix*4(pc),(hw_pal).w
	move.l	colourtab2+def_type_ix*4+type_ix_lim*4(pc),(hw_pal+4).w
	move	(hw_pal).w,background-rz(a6)
	XB_install	swv_vec_XB,(swv_vec).w	;Forbid mono-switch RESET
	xbios	Setscreen,?,?,#2		;Fool TOS into using MONO
	clr	emu_flag-rz(a6)			;zero delay ctr
	XB_install	simp_vbi_XB,(ev_vbi).w	;use vbi delay
initwait:
	cmp	#1,emu_flag-rz(a6)		;test vbi delay
	blo	initwait			;wait until sure TOS is in MONO
	move.b	#1,(hw_rez).w			;set hardware to medium
	XB_remove	simp_vbi_XB,(ev_vbi).w	;remove vbi delay
	XB_install	xbios_XB,(ev_xbios).w	;Forbid rez tampering
;
	gemdos	Cconws,s_message(pc)		;Tell user what's up
;
	lea	transform(pc),a2	; a2 = start of free memory (overlaps program!)
	move.l	a2,d0			; d0 = a2 = start of free memory
	add.l	#$1ff,d0		; force it to a 512 byte boundary
	and.l	#-$200,d0		; by rounding up
	add.l	#$200,d0		; and reserve 2 pages extra header
	move.l	d0,s_main-rz(a6)	; and that is the even medium screen
	add.l	#$8000,d0		; point 32768 (128 pages) beyond this
	move.l	d0,s_odds-rz(a6)	; and we have odd medium screen
	move.l	_v_bas_ad,s_user-rz(a6)	; old logbase is initial mono screen
	clr	emu_pos-rz(a6)		; set offset to top of screen
	move	#400/8-1,emu_cnt-rz(a6)	; set emulation countdown for top of screen
	move.l	(ev_xgemdos).w,gem_check-rz(a6)
	move	ref_type_ix(pc),d0
	lea	iz_emu_t(pc),a0
	move.l	(a0,d0),a0
	jsr	(a0)				;initialize filter mode
	XB_install	init_vbi_XB,(ev_vbi).w	;use special vbi to allow exit
	gemdos	Super!_IND,d7
	clr	emu_flag-rz(a6)		; allow new emulation (delayed!)
	move.l	s_odds(pc),d0
	add.l	#32256,d0		;d0->beyond emu screens
	lea	bp(pc),a0
	sub.l	a0,d0			;d0 = Total program ram need
	gemdos	Ptermres,d0,!
;
;
;----------------------------------------------------------------------------
	END
;----------------------------------------------------------------------------
;End of file:	LACE_400.S
;----------------------------------------------------------------------------
