;----------------------------------------------------------------------------
;File name:	F_BOOT.S		Revision date:	1995.09.15
;Creator:	Ulf Ronald Andersson	Creation date:	1995.07.26
;(c)1992 by:	Ulf Ronald Andersson	All rights reserved
;Released as:	FREEWARE		(NB: commercial sales forbidden!)
;----------------------------------------------------------------------------
;
	output	.GTP
;
;----------------------------------------------------------------------------
	include	URAn_SIM.S
	include	URAn_JAR.S
	include	URAn_XB.S
	include	URAn_LA.S
;
	include	FBoot.SH
;----------------------------------------------------------------------------
FB_ram_size	= 24*1024
;----------------------------------------------------------------------------
	SECTION	text
;----------------------------------------------------------------------------
;
	bra	startup
	illegal
;
;----------------------------------------------------------------------------
;
pre_install_f:	ds.w	1
la_base_p:	ds.l	1
os_base_p:	ds.l	1
stackframe_len:	ds.w	1
tos_sr:		ds.w	1
tos_regs:	ds.l	16
;
FB_struct:
		make	FB_def
FB_struct_p:
		dc.l	FB_struct
;
loc_cur_font:
		ds.l	1
;
org_sys_ix:
old_orig_t:
ram_head_t:
		ds.b	3*$58
;
intin:		ds.w	30
intout:		ds.w	45
ptsin:		ds.w	30
ptsout:		ds.w	12
message:	ds.b	16
;
font_base:	ds.b	FB_ram_size
;
;----------------------------------------------------------------------------
;Start of:	XBIOS functions with XBRA
;----------------------------------------------------------------------------
;
	illegal
	dc.l		'xbio','s   '
	XB_define	nu_xbios,'FBoo'
	Pass_Frame	a0
;
	cmp	#Setscreen&$ff,(a0)
	beq.s	nu_setscreen		;fix setscreen
go_old_xbios:
	move.l	nu_xbios+xb_next(pc),a0
	jmp	(a0)
;
;-------------------------------------
;
	illegal
	dc.l	'sets','cree'
nu_setscreen:
	tst	10(a0)
	bmi.s	go_old_xbios
;
	move.l	8(a0),-(sp)	;\
	move.l	4(a0),-(sp)	; >< repush the 12 argument bytes
	move.l	(a0),-(sp)	;/
;
	tst	(_longframe).w	;\
	beq.s	.done_frame	; \
	clr	-(sp)		;  \/ Push a simulated
.done_frame:			;  /\ exception stack frame
	pea	.end_setscreen	; /
	move	sr,-(sp)	;/
;
;;;	bsr	fix_flg_fonts
	bra.s	go_old_xbios
;
;-------------------------------------
;
.end_setscreen:
	lea	12(sp),sp		;remove argument copy from stack
	bsr	fix_flg_fonts
	rte
;
;----------------------------------------------------------------------------
;End of:	XBIOS functions with XBRA
;----------------------------------------------------------------------------
;Start of:	Supexec subroutine	'remove_XB'
;----------------------------------------------------------------------------
;entry:	a0 -> XBRA chain root
;  "	d0 =  XBRA id
;exit:	a0 = used link/garbage/garbage  \/ depending on
;  "	d0 = 0/E_FILNF/E_SEEK (flagged) /\ success/unfound/vector_smash
;
remove_XB:
	movem.l	a1,-(sp)
.loop:
	move.l	(a0),a1			;a1 -> xb_code of next vector
	lea	-xb_code(a1),a1		;a1 -> XBRA structure
	cmp.l	#'XBRA',xb_magic(a1)
	bne.s	.smashed
	cmp.l	xb_id(a1),d0
	beq.s	.found
	lea	xb_next(a1),a0		;a0 -> xb_next -> next xb_code
	tst.l	(a0)
	bgt.s	.loop
.unused:
	moveq	#E_SEEK,d0
	bra.s	.exit
;
.smashed:
	moveq	#E_CRC,d0
	bra.s	.exit
;
.found:
	move.l	xb_next(a1),(a0)
	moveq	#E_OK,d0
.exit:
	movem.l	(sp)+,a1
	rts
;
;----------------------------------------------------------------------------
;End of:	Supexec subroutine	'remove_XB'
;----------------------------------------------------------------------------
;Start of:	Supexec subroutine	'install_XB'
;----------------------------------------------------------------------------
;entry:	a0 -> XBRA chain root
;  "	a1 -> XBRA structure to install
;exit:	a0 = used link/garbage/garbage  \/ depending on
;  "	d0 = 0/E_ACCDN/E_SEEK (flagged) /\ success/conflict/vector_smash
;
install_XB:
	movem.l	a1-a3,-(sp)
	move	sr,-(sp)
	ori	#$0700,sr
	move.l	a0,a3
	move.l	xb_id(a1),d0
.loop:
	move.l	(a0),a2			;a2 -> xb_code of next vector
	lea	-xb_code(a2),a2		;a2 -> XBRA structure
	cmp.l	#'XBRA',xb_magic(a2)
	bne.s	.smashed
	cmp.l	xb_id(a2),d0
	beq.s	.found
	lea	xb_next(a2),a0		;a0 -> xb_next -> next xb_code
	tst.l	(a0)
	bgt.s	.loop
.unused:
.smashed:
	move.l	a3,a0
	move.l	(a0),xb_next(a1)
	lea	xb_code(a1),a1
	move.l	a1,(a0)
	moveq	#E_OK,d0
	bra.s	.exit
;
.found:
	moveq	#E_ACCDN,d0
.exit:
	move	(sp)+,sr
	tst.l	d0
	movem.l	(sp)+,a1-a3
	rts
;
;----------------------------------------------------------------------------
;End of:	Supexec subroutine	'install_XB'
;----------------------------------------------------------------------------
;Start of:	Supexec subroutine	'fix_fonts'
;----------------------------------------------------------------------------
;
fix_fonts:
	_a_init
	lea	FB_struct(pc),a5
	lea	FB_struct+FB_use_t(pc),a4	;a4 -> new font pointers
	move	sr,d5			;d5 = interrupt mask
	ori	#$0700,sr		;disable interrupts
;
	move.l	la_font_ring(a0),a2	;a2 -> old Small font
	move.l	a2,a1			;a1 -> old small font
	tst.l	4(a4)			;no new small font ?
	beq.s	.done_small_font
	move.l	4(a4),a1		;a1 -> new Small font
.done_small_font:
	move.l	a1,4(a4)		;store used small font
	move	#1,fnt_id(a1)		;force id 1
	and	#-2,fnt_flag(a1)	;pre_clear sysdef bit
	move.l	a1,la_font_ring(a0)	;activate new small font
	move.l	a1,a3			;a3 = a1 for linking
;
	move.l	la_font_ring+4(a0),a2	;a2 -> old Medium font
	move.l	a2,a1			;a1 -> old medium font
	tst.l	8(a4)			;no new medium font ?
	beq.s	.done_medium_font
	move.l	8(a4),a1		;a1 -> new Medium font
.done_medium_font:
	move.l	a1,8(a4)		;store used medium font
	move	#1,fnt_id(a1)		;force id 1
	and	#-2,fnt_flag(a1)	;pre_clear sysdef bit
	clr.l	fnt_next(a3)		;clear link of small font
	move.l	a1,la_font_ring+4(a0)	;activate new medium font
	move.l	a1,a3			;a3 = a1 for linking
;
	move.l	fnt_next(a2),a2		;a2 -> old Large font
	move.l	a2,a1			;a1 -> old large font
	tst.l	12(a4)			;no new large font ?
	beq.s	.done_large_font
	move.l	12(a4),a1		;a1 -> new Large font
.done_large_font:
	move.l	a1,12(a4)		;store used large font
	move	#1,fnt_id(a1)		;force id 1
	and	#-2,fnt_flag(a1)	;pre_clear sysdef bit
	move.l	a1,fnt_next(a3)		;link large font to medium font
	clr.l	fnt_next(a1)		;clear link of large font
;
	move.l	4(a4),a1
	move.l	8(a4),a2
	move.l	12(a4),a3
	move	fnt_charw(a1),la_siz_tab+0(a0)
	move	fnt_dtop(a1),la_siz_tab+2(a0)
	move.l	fnt_dtop(a3),d0
	cmp.l	fnt_dtop(a2),d0
	bge.s	.set_max_cell
	exg	a2,a3
.set_max_cell:
	move	fnt_charw(a3),la_siz_tab+4(a0)
	move	fnt_dtop(a3),la_siz_tab+6(a0)
;
	move	FB_sys_ix(a5),d0
	bne.s	.have_sys_ix
	moveq	#2,d0
.have_sys_ix:
	move	d0,FB_sys_ix(a5)
	asl	#2,d0
	move.l	(a4,d0),a1		;a1 ->new system font
	or	#1,fnt_flag(a1)		;force to be system font
	move.l	a1,loc_cur_font		;local copy of system font ptr
	move	d5,sr			;restore interrupt mask
	rts
;
;----------------------------------------------------------------------------
;End of:	Supexec subroutine 	'fix_fonts'
;----------------------------------------------------------------------------
;Start of:	Supexec subroutines	'fix_xxx_fonts'
;----------------------------------------------------------------------------
;
fix_cur_fonts:
	move	sr,-(sp)
	ori	#$0700,sr
	move	(sp)+,tos_sr
	movem.l	d0-d7/a0-a6,tos_regs
	bra.s	_fix_cur_fonts
;
fix_flg_fonts:
	tst.b	FB_fontfix_0_f+FB_struct
	bpl.s	fix_new_fonts
fix_old_fonts:
	move	sr,-(sp)
	ori	#$0700,sr
	move	(sp)+,tos_sr
	movem.l	d0-d7/a0-a6,tos_regs
	moveq	#FB_old_t,d0
	bra.s	_fix_d0_fonts
;
fix_new_fonts:
	move	sr,-(sp)
	ori	#$0700,sr
	move	(sp)+,tos_sr
	movem.l	d0-d7/a0-a6,tos_regs
	moveq	#FB_new_t,d0
_fix_d0_fonts:
	move.l	FB_struct_p(pc),a5
	lea	(a5,d0),a0
	lea	FB_use_t(a5),a1
	move.l	(a0)+,(a1)+
	move.l	(a0)+,(a1)+
	move.l	(a0)+,(a1)+
	move.l	(a0)+,(a1)+
_fix_cur_fonts:
	move.l	FB_struct_p(pc),a5
	move.l	FB_fix_p(a5),a0
	jsr	(a0)
	movem.l	tos_regs,d0-d7/a0-a6
	move	tos_sr(pc),sr
	rts
;
;----------------------------------------------------------------------------
;End of:	Supexec subroutines	'fix_old_fonts' & 'fix_new_fonts'
;----------------------------------------------------------------------------
;	Resident library routines
;
	make	SIM_links
;
	_uniref	reset_old_jar
	make	JAR_links
;
resident_end:	;All code below is non-resident
;
;----------------------------------------------------------------------------
;Start of:	non-resident installation routines
;----------------------------------------------------------------------------
;
startup:
	include	URAn_APP.S
;
;----------------------------------------------------------------------------
;
init_app:
	lea	FB_struct(pc),a5
	lea	font_base(pc),a0
	move.l	a0,FB_ram_p(a5)
	move.l	a0,FB_end_p(a5)
	add.l	#FB_ram_size,a0
	move.l	a0,FB_lim_p(a5)
	lea	fix_fonts(pc),a0
	move.l	a0,FB_fix_p(a5)
;
	include	URAN_ARG.S
;
	lea	FB_struct(pc),a5
	tst	acc_flag
	bne.s	exec_acc
	xbios	Supexec,test_install
	tst	pre_install_f
	bne.s	.is_installed
	xbios	Supexec,find_old_fonts
	xbios	Supexec,try_install
.is_installed:
	rts
;
;----------------------------------------------------------------------------
;
exec_acc:
	xbios	Supexec,test_install
	clr.l	d0
	move	pre_install_f(pc),d0
	beq	error_d0
exec_app:
	move.l	FB_struct_p(pc),a5
	move.l	arg_ptr(pc),a4	;a4 = arg_ptr
	move	arg_cnt(pc),d0	;d0 = arg_cnt
	move	d0,d5
	subq	#1,d5			;arg 0 doesn't count (progname/dummy)
	bgt.s	.have_args
	lea	default_arg_t(pc),a4	;a4 -> 3 font number/name pairs
	moveq	#6,d5			;d5 = number of real arguments
.have_args:
	cmp	#8,d5			;8 real arguments is maximum allowed
	bhi	usage_error
	lsr	#1,d5			;we use 2 args/loop
	bcc.s	.accept_argc		;normal arguments are paired !
	bne	usage_error		;odd argument must be alone
.accept_argc:
	subq	#1,d5			;prep for dbra
.loop_1:
	tst.b	(a4)+			;pass arg 0 (progname or dummy)
	bne.s	.loop_1
	tst	d5
	bpl.s	.read_fonts
;
	bsr	eval_num
	bmi	usage_error
	cmp	#3,d0
	bhi	usage_error
	beq.s	.defer_turn_on
	cmp	#1,d0
	bhi.s	.defer_turn_off
	beq.s	.direct_turn_on
.direct_turn_off:
	xbios	Supexec,fix_old_fonts	;switch to old fonts
	bra	exit_ok			;direct turn-off complete !
;
.direct_turn_on:
	xbios	Supexec,fix_new_fonts(pc)
	bra	exit_ok			;direct turn-on complete !
;
.defer_turn_off:
	st	FB_fontfix_0_f(a5)
	bra	exit_ok			;deferred turn-off complete !
;
.defer_turn_on:
	clr	FB_fontfix_0_f(a5)
	bra	exit_ok			;deferred turn-on complete !
;
.read_fonts:
	xbios	Supexec,fix_old_fonts	;switch to original fonts
	sf	FB_somefont_f(a5)
	sf	FB_goodfont_f(a5)
	lea	FB_new_t(a5),a0
	moveq	#4-1,d0
.loop_2:
	clr.l	(a0)+			;pre_clear new font table
	dbra	d0,.loop_2
	move.l	FB_ram_p(a5),a3	;a3 -> first font buffer
main_loop:			;conversion process for each argument font_file
	bsr	eval_num
	bmi	usage_error
	cmp	#4,d0
	bhs	usage_error
	move	d0,current_code
	lea	fontpath_s(pc),a0
.str_loop:
	move.b	(a4)+,(a0)+
	bne.s	.str_loop
	gemdos	Fopen,fontpath_s(pc),!
	move.l	d0,d7
	bmi	open_error
	gemdos	Fseek,!,d7,!
	tst.l	d0
	bmi	read_error
	gemdos	Fread,d7,#$58,(a3)
	move.l	d0,d6
	bmi	read_error
	cmp	#$58,d6
	bne	font_error
	lea	(a3),a0			;a0 -> base of current font
	move.l	fnt_chr_tp(a0),d4
	move.l	fnt_hor_tp(a0),d3
	move	fnt_hasc(a0),d2
	move	fnt_lasc(a0),d1
	move	fnt_flag(a0),d0
	btst	#2,d0
	bne.s	.flag_is_68000
	rol	#8,d0			;reverse bytes of fnt_flag
	btst	#2,d0
	bne	font_error		;flags 68000 mode in Intel format !!!
.flag_is_intel:				;flag is legal intel flag, in motorola format
	rol	#8,d1	;reverse bytes of fnt_lasc
	rol	#8,d2	;reverse bytes of fnt_hasc
	rol	#8,d3	;\
	swap	d3	; X Reverse bytes of fnt_hor_tp
	rol	#8,d3	;/
	rol	#8,d4	;\
	swap	d4	; X Reverse bytes of fnt_chr_tp
	rol	#8,d4	;/
.flag_is_68000:				;flag has 68000 format, but retains correct mode flag
	move.l	d4,font_chr_tp
	move.l	d3,font_hor_tp
	move	d2,font_hasc
	move	d1,font_lasc
	move	d0,font_flag
	move	font_hasc(pc),d0
	sub	font_lasc(pc),d0
	blt	font_error
	cmp	#255,d0
	bgt	font_error
	addq	#1,d0		;d0 = total characters in font
	move	d0,font_size
	btst	#2,font_flag+1(pc)
	bne.s	.keep_68000_order
	move	(a0),d0		;\
	rol	#8,d0		; X Reverse bytes of fnt_id
	move	d0,(a0)+	;/
	move	(a0),d0		;\
	rol	#8,d0		; X Reverse bytes of fnt_pts
	move	d0,(a0)+	;/
	lea	32(a0),a0	; Pass fnt_name unchanged
	moveq	#(fnt_next+4-fnt_lasc)/2-1,d1	;prep d1 for dbra loop for the rest
.fixloop_1:
	move	(a0),d0		;\
	rol	#8,d0		; X Reverse bytes of another word
	move	d0,(a0)+	;/
	dbra	d1,.fixloop_1
	lea	(a3),a0			;a0 -> base of current font
	move.l	fnt_hor_tp(a0),d0	;\
	swap	d0			; X Reverse words of fnt_hor_tp
	move.l	d0,fnt_hor_tp(a0)	;/
	move.l	fnt_chr_tp(a0),d0	;\
	swap	d0			; X Reverse words of fnt_chr_tp
	move.l	d0,fnt_chr_tp(a0)	;/
	move.l	fnt_fbase(a0),d0	;\
	swap	d0			; X Reverse words of fnt_fbase
	move.l	d0,fnt_fbase(a0)	;/
	move.l	fnt_next(a0),d0		;\
	swap	d0			; X Reverse words of fnt_next
	move.l	d0,fnt_next(a0)		;/
.keep_68000_order:
	move	font_flag(pc),d0
	move.l	font_chr_tp(pc),d1
	cmp.l	font_hor_tp(pc),d1
	bne.s	.keep_horoff
	bclr	#1,d0		;remove erroneous horoff flag
.keep_horoff:
	move	d0,font_flag
	bset	#2,d0		;enforce 68000 flag
	move	d0,fnt_flag(a0) ;in the header
;
; Here fonthead_t is mostly converted, only 4 ptrs remain to be fixed
;
	gemdos	Fseek,font_chr_tp,d7,!
	tst.l	d0
	bmi	read_error
	clr.l	d3
	move	font_size(pc),d3
	addq	#1,d3			;chr_tp table needs 1 more entry
	add	d3,d3			;and each entry uses 2 bytes
	gemdos	Fread,d7,d3,$58(a3)
	cmp.l	d3,d0
	bne	font_error
	moveq	#$58,d1
	lea	(a3,d1),a0		;a0 -> chr_off table
	move.l	a0,fnt_chr_tp(a3)	;fnt_chr_tp is completed !
	add.l	d1,d0
	move.l	fnt_fbase(a3),font_fbase
	lea	(a3,d0),a0		;a0 -> fontdata
	move.l	a0,fnt_fbase(a3)	;fnt_fbase is completed
;
	btst	#2,font_flag+1(pc)
	bne.s	.keep_chr_off
	lea	(a3,d1),a0		;a0 -> chr_off table
	move	font_size(pc),d1	;d1 =  entry_count - 1
.fixloop_2:
	move	(a0),d0		;\
	rol	#8,d0		; X Reverse another chr_off word
	move	d0,(a0)+	;/
	dbra	d1,.fixloop_2
.keep_chr_off:
;
; Here chr_off_t is completely converted and ready for use
;
	bclr	#1,font_flag+1		;hor_off table present ?
	beq.s	converted
	clr.l	d3
	move	font_size(pc),d3	;d3 = entry count for hor_tp table
	add	d3,d3			;and each entry uses 2 bytes
	add.l	font_hor_tp(pc),d3	;d3 = offset to fontdata in file
	gemdos	Fseek,d3,d7,!
	tst.l	d0
	bmi	read_error
	clr.l	fnt_hor_tp(a3)		;fnt_hor_tp is completed
;
; Here hor_off_t is completely eliminated
;
converted:
;
; Now we must read fontdata
;
	gemdos	Fseek,font_fbase(pc),d7,!
	tst.l	d0
	bmi	read_error
	move	fnt_fwidth(a3),d3
	mulu	fnt_fheight(a3),d3
	gemdos	Fread|_ind,d7,d3,fnt_fbase(a3)
	cmp.l	d3,d0
	bne	read_error
	clr.l	fnt_next(a3)
	gemdos	Fclose,d7
;
; Here the entire current font is completed, and ready for insertion
; but that will be done later, here we just save the pointer
;
	move	current_code(pc),d0
	asl	#2,d0
	lea	FB_new_t(a5),a0
	move.l	a3,(a0,d0)
	st	FB_somefont_f(a5)
;
; Here we repatch some header data for special cases
;
	move.l	fnt_fbase(a3),a3	;a3 -> font data
	add.l	d3,a3			;a3 -> header base for next font
;
open_error:
completed:
	dbra	d5,main_loop	;loop back for more fonts
	move.l	a3,FB_end_p(a5)
	move.b	FB_somefont_f(a5),FB_goodfont_f(a5)
;
	xbios	Supexec,fix_new_fonts(pc)
;
exit_ok:
	tst	tos_flag
	bmi.s	exit_tos
	aes_redraw
exit_tos:
	clr.l	d0
	tst	acc_flag
	bne.s	norm_exit
	tst	pre_install_f
	bne.s	norm_exit
resident_exit:
	move.l	#resident_end,d1
	sub.l	basepage_p(pc),d1
	move.l	#$ADD1,d0
norm_exit:
	rts
;
font_error:
read_error:
	move.l	d0,d6
	gemdos	Fseek,!,d7,#2
	gemdos	Fclose,d7
test_error:
	move.l	d6,d0
	bmi.s	error_d0
general_error:
	moveq	#-1,d0
error_d0:
	move.l	d0,d6
	sim_aes	form_alert,#1,error_alert_s(pc)
	move.l	d6,d0
	rts
;
usage_error:
	sim_aes	form_alert,#1,usage_alert_s(pc)
	moveq	#-1,d0
	rts
;
;----------------------------------------------------------------------------
;Start of:	Supexec subroutine	'find_old_fonts'
;----------------------------------------------------------------------------
;
find_old_fonts:
	move	sr,d0			;d0 = interrupt mask
	ori	#$0700,sr		;disable interrupts
;
	_a_init
	lea	old_orig_t(pc),a1
	move.l	la_cur_font(a0),(a1)
	move.l	la_font_ring(a0),d1
	move.l	d1,4(a1)	;-> old small font
	move.l	la_font_ring+4(a0),a2
	move.l	a2,8(a1)		;-> old medium font
	move.l	fnt_next(a2),a3
	move.l	a3,12(a1)		;-> old large font
	move.l	d1,a1
;
	moveq	#3,d0
	btst	#0,fnt_flag+1(a3)
	bne.s	.have_org_ix
	moveq	#2,d0
	btst	#0,fnt_flag+1(a2)
	bne.s	.have_org_ix
	moveq	#1,d0
	btst	#0,fnt_flag+1(a1)
	bne.s	.have_org_ix
;
	moveq	#3,d0
	cmp.l	la_cur_font(a0),a3
	beq.s	.have_org_ix
	moveq	#2,d0
	cmp.l	la_cur_font(a0),a2
	beq.s	.have_org_ix
	moveq	#1,d0
	cmp.l	la_cur_font(a0),a1
	beq.s	.have_org_ix
;
	moveq	#3,d0
	cmp.l	la_def_font(a0),a3
	beq.s	.have_org_ix
	moveq	#2,d0
	cmp.l	la_def_font(a0),a2
	beq.s	.have_org_ix
	moveq	#1,d0
	cmp.l	la_def_font(a0),a1
	beq.s	.have_org_ix
;
	clr.l	d0
.have_org_ix:
	move	d0,FB_org_ix+FB_struct
	bne.s	.have_sys_ix
	moveq	#2,d0
.have_sys_ix:
	move	d0,FB_sys_ix+FB_struct
;
;
	move	FB_sys_ix+FB_struct(pc),d0
	asl	#2,d0
	lea	old_orig_t(pc),a1
	move.l	(a1,d0),(a1)		;old system font
;
	move.l	4(a1),a1		;a1 -> old small font
	lea	ram_head_t+$58(pc),a0
	clr.l	d1
	moveq	#$58/4-1,d0
.loop:
	move.l	(a1)+,-$58(a0,d1)
	move.l	(a2)+,0000(a0,d1)
	move.l	(a3)+,$058(a0,d1)
	addq	#4,d1
	dbra	d0,.loop
;
	lea	-$58(a0),a1
	lea	0000(a0),a2
	lea	$058(a0),a3
;
	move.l	a2,fnt_next(a1)	;link medium to small
	move.l	a3,fnt_next(a2)	;link large to medium
	clr.l	fnt_next(a3)	;break chain at large
	move	#1,fnt_id(a1)
	move	#1,fnt_id(a2)
	move	#1,fnt_id(a3)
;
	lea	FB_struct+FB_old_t(pc),a0
	move.l	a1,4(a0)	;-> old small font ramhead
	move.l	a2,8(a0)	;-> old medium font ramhead
	move.l	a3,12(a0)	;-> old large font ramhead
;
	move	FB_sys_ix+FB_struct(pc),d0
	asl	#2,d0
	move.l	(a0,d0),a1
	or.l	#1,fnt_flag(a1)	;set sysdef bit
	move.l	a1,(a0)		;-> old system font ramhead
;
	_a_init
	lea	FB_struct+FB_old_t(pc),a1
	move.l	4(a1),la_font_ring(a0)
	move.l	8(a1),la_font_ring+4(a0)
;	
	move	d0,sr			;restore interrupt mask
	rts
;
;----------------------------------------------------------------------------
;End of:	Supexec subroutine 	'find_old_fonts'
;
eval_num:
	move.l	d1,-(sp)
	clr	d1
	clr.l	d0
.loop:
	move.b	(a4)+,d1
	beq.s	.exit
	sub	#'0',d1
	blo.s	.error
	cmp	#9,d1
	bhi.s	.error
	mulu	#10,d0
	add	d1,d0
	bra.s	.loop
;
.error:
	moveq	#-1,d0
.exit:
	movem.l	(sp)+,d1
	rts
;
;----------------------------------------------------------------------------
;
test_install:
	clr	pre_install_f
	eval_cookie	#'FBoo'
	ble.s	.exit
	btst	#0,d0
	bne.s	.exit
	move.l	d0,a0
	cmp.l	#'FBoo',(a0)
	bne.s	.exit
	st	pre_install_f
	move.l	a0,FB_struct_p
.exit:
	rts
;
;----------------------------------------------------------------------------
;
try_install:
;
	_a_init
	move.l	a0,la_base_p
;
	move.l	(_sysbase).w,a0
	move.l	os_selfbeg_p(a0),os_base_p
	move.l	(ev_trap5).w,a0
	move.l	#.do_trap,(ev_trap5).w
	move.l	sp,d0
	trap	#5				;process exception at .do_trap
.do_trap:
	sub.l	sp,d0			;d0 = frame size
	add	d0,sp			;sp = pre_exception SSP
	move	d0,stackframe_len
	move.l	a0,(ev_trap5).w		;restore original trap5_handler
;
	lea	FB_struct(pc),a5
	make_cookie	#'FBoo',a5
	bmi.s	.exit
	move.l	a5,FB_struct_p
;
	lea	(ev_xbios).w,a0
	lea	nu_xbios(pc),a1
	bsr	install_XB
;
.exit:
	rts
;
;----------------------------------------------------------------------------
;
	make	SIM_links
	make	JAR_links
;
;----------------------------------------------------------------------------
	SECTION	data
;----------------------------------------------------------------------------
;
acc_name:	dc.b	'  F_BOOT is no ACC !',NUL
crlf_s:		dc.b	CR,LF,NUL
	even
;
usage_alert_s:
	dc.b	'[1]['
	dc.b	'F_BOOT usage:|'
	dc.b	'A code before each fontname, |'
	dc.b	'will decide its future use:  |'
	dc.b	'0:Default font   1:Small font|'
	dc.b	'2:Medium font    3:Large font]'
	dc.b	'[ Exit ]',NUL
	even
;
error_alert_s:
	dc.b	'[1]['
	dc.b	'F_BOOT error:|'
	dc.b	'  Something has gone wrong ! ]'
	dc.b	'[ Exit ]',NUL
	even
;
default_arg_t:
	dc.b	'F_BOOT.PRG',NUL
	dc.b	'1',NUL
	dc.b	'FBOO_??1.FNT',NUL
	dc.b	'2',NUL
	dc.b	'FBOO_??2.FNT',NUL
	dc.b	'3',NUL
	dc.b	'FBOO_??3.FNT',NUL
	dc.b	NUL
	even
;
;----------------------------------------------------------------------------
	SECTION	bss
;----------------------------------------------------------------------------
;
		ds.l	$1000
mystack:	ds.l	4
;
current_code:	ds.w	1
;
font_lasc:	ds.w	1
font_hasc:	ds.w	1
font_flag:	ds.w	1
font_hor_tp:	ds.l	1
font_chr_tp:	ds.l	1
font_fbase:	ds.l	1
;
font_size:	ds.w	1
;
fontpath_s:	ds.b	140
;
;----------------------------------------------------------------------------
	End
;----------------------------------------------------------------------------
;End of file:	F_BOOT.S
;----------------------------------------------------------------------------
