;File name:	POOLFX92.S		Revision date:	1992.03.04
;Revised by:	Ulf Ronald Andersson	Disassembled:	1992.03.03
;File purpose:	Source for new poolfix debugged 1992
;
;The new poolfix has all the good points of POOLFIX4 & POOLFIX3
;but eliminates some fatal bugs that those had.
;
;The order of the routines has been changed completely to save RAM
;their content however is mainly the same, but debugged.
;
;FX92: all added lines will have a remark headed like this line
;;;All eliminated lines will remain, preceded by 3 semicolons, like this line
;
	include	TOS\URAn_SYS.S
	include	TOS\URAn_DOS.S
	include	TOS\URAn_XB.S
;
;
	text
;
;
startup:
bp	=	startup-$100
	bra	main		;FX92: new branch, to change order
;
;
	XB_define	nu_gemdos,'_OOL'
	move.b	poolfix_flag(pc),d0
	beq.s	L26E
	bsr.s	compact_all_sub
L26E:
	move	USP,a0
	btst	#5,(sp)
	beq.s	L282
	lea	6(sp),a0
	tst	(_longframe).w
	beq.s	L282
	addq	#2,a0
L282:
	move	(a0),d0			;Pterm0 ?
	beq.s	prepare_flag
	sub	#$31,d0			;Ptermres ?
	beq.s	prepare_flag
	sub	#$18,d0			;Mfree ?
	beq.s	prepare_flag
	subq	#1,d0			;FX92: Mshrink ?  previously ignored !!!
	beq.s	prepare_flag
	subq	#2,d0			;Pterm ?
prepare_flag:
	seq	poolfix_flag
go_os_gemdos:
	move.l	8+nu_gemdos(pc),a0
	jmp	(a0)
;
;
compact_all_sub:
	link	a6,#0
	movem.l	d2-d7/a3-a5,-(sp)
	suba.l	a5,a5
	move.l	L6A0(pc),a0
	move.l	(a0),a4
	clr	d3
	bra.s	L2FA
;
L2B4:
	tst.b	4(a4)
	ble.s	L2F8
	clr	d4
	clr	d5
	lea	6(a4),a3
	bra.s	L2DE
;
L2C4:
	cmpi.l	#1,12(a3)
	bne.s	L2D8
	addq	#1,d4
	move.l	a5,d0
	bne.s	L2D8
	move.l	a4,a5
	move	d5,d6
L2D8:
	addq	#1,d5
	adda	#$10,a3
L2DE:
	cmp	#4,d5
	blt.s	L2C4
	cmp	#4,d4
	bne.s	L2F6
	clr.b	4(a4)
	cmp.l	a4,a5
	bne.s	L2F4
	suba.l	a5,a5
L2F4:
	bra.s	L2F8
;
L2F6:
	add	d4,d3
L2F8:
	move.l	(a4),a4
L2FA:
	move.l	a4,d0
	bne.s	L2B4
	cmp	#4,d3
	blt	L4B4
	move.l	a5,a4
	move	d6,d7
L30A:
	addq	#1,d7
	cmp	#4,d7
	beq.s	L318
	tst.b	4(a4)
	bgt.s	L31C
L318:
	clr	d7
	move.l	(a4),a4
L31C:
	move.l	a4,d0
	beq.s	L33A
	tst.b	4(a4)
	ble.s	L30A
	move	d7,d0
	ext.l	d0
	asl.l	#4,d0
	add.l	a4,d0
	move.l	d0,a0
	cmpi.l	#1,18(a0)
	beq.s	L30A
L33A:
	bra	L4AA
;
L33E:
	bra.s	L3A8
;
L340:
	lea	6(a5),a3
	cmpi.l	#1,12(a3)
	bne.s	L3AC
	cmpi.l	#1,28(a3)
	bne.s	L3AC
	cmpi.l	#1,44(a3)
	bne.s	L3AC
	cmpi.l	#1,60(a3)
	bne.s	L3AC
	clr.b	4(a5)
	moveq	#3,d6
L372:
	addq	#1,d6
	cmp	#4,d6
	beq.s	L380
	tst.b	4(a5)
	bgt.s	L384
L380:
	clr	d6
	move.l	(a5),a5
L384:
	move.l	a5,d0
	beq.s	L3A2
	tst.b	4(a5)
	ble.s	L372
	move	d6,d0
	ext.l	d0
	asl.l	#4,d0
	add.l	a5,d0
	move.l	d0,a0
	cmpi.l	#1,18(a0)
	bne.s	L372
L3A2:
	move.l	a5,d0
	beq	L4B4
L3A8:
	tst	d6
	beq.s	L340
L3AC:
	bra.s	L412
;
L3AE:
	lea	6(a4),a3
	cmpi.l	#1,12(a3)
	beq.s	L416
	cmpi.l	#1,28(a3)
	beq.s	L416
	cmpi.l	#1,44(a3)
	beq.s	L416
	cmpi.l	#1,60(a3)
	beq.s	L416
	moveq	#3,d7
L3DC:
	addq	#1,d7
	cmp	#4,d7
	beq.s	L3EA
	tst.b	4(a4)
	bgt.s	L3EE
L3EA:
	clr	d7
	move.l	(a4),a4
L3EE:
	move.l	a4,d0
	beq.s	L40C
	tst.b	4(a4)
	ble.s	L3DC
	move	d7,d0
	ext.l	d0
	asl.l	#4,d0
	add.l	a4,d0
	move.l	d0,a0
	cmpi.l	#1,18(a0)
	beq.s	L3DC
L40C:
	move.l	a4,d0
	beq	L4B4
L412:
	tst	d7
	beq.s	L3AE
L416:
	cmp.l	a5,a4
	beq.s	L47A
	move	d6,d0
	ext.l	d0
	asl.l	#4,d0
	add.l	a5,d0
	move.l	d0,(sp)
	addq.l	#6,(sp)
	move	d7,d0
	ext.l	d0
	asl.l	#4,d0
	add.l	a4,d0
	move.l	d0,-(sp)
	addq.l	#6,(sp)
	bsr	compact_block_sub
	addq.l	#4,sp
	move	d7,d0
	ext.l	d0
	asl.l	#4,d0
	add.l	a4,d0
	move.l	d0,a0
	move.l	#1,18(a0)
L44A:
	addq	#1,d6
	cmp	#4,d6
	beq.s	L458
	tst.b	4(a5)
	bgt.s	L45C
L458:
	clr	d6
	move.l	(a5),a5
L45C:
	move.l	a5,d0
	beq.s	L47A
	tst.b	4(a5)
	ble.s	L44A
	move	d6,d0
	ext.l	d0
	asl.l	#4,d0
	add.l	a5,d0
	move.l	d0,a0
	cmpi.l	#1,18(a0)
	bne.s	L44A
L47A:
	addq	#1,d7
	cmp	#4,d7
	beq.s	L488
	tst.b	4(a4)
	bgt.s	L48C
L488:
	clr	d7
	move.l	(a4),a4
L48C:
	move.l	a4,d0
	beq.s	L4AA
	tst.b	4(a4)
	ble.s	L47A
	move	d7,d0
	ext.l	d0
	asl.l	#4,d0
	add.l	a4,d0
	move.l	d0,a0
	cmpi.l	#1,18(a0)
	beq.s	L47A
L4AA:
	move.l	a5,d0
	beq.s	L4B4
	move.l	a4,d0
	bne	L33E
L4B4:
	tst.l	(sp)+
	movem.l	(sp)+,d3-d7/a3-a5
	unlk	a6
	rts
;
;
compact_block_sub:
	link	a6,#-4
	movem.l	d6-d7/a3-a5,-(sp)
	move.l	8(a6),a5
	clr	d7
	bra.s	L4F4
;
L4CE:
	move	d7,a0
	adda.l	a0,a0
	adda.l	a0,a0
	adda.l	#L694,a0
	move.l	(a0),-4(a6)
	move.l	-4(a6),a3
	move.l	(a3),a4
	bra.s	L4EE
;
;
L4E6:
	cmp.l	a5,a4
	beq.s	L500
	move.l	a4,a3
	move.l	(a3),a4
L4EE:
	move.l	a4,d0
	bne.s	L4E6
	addq	#1,d7
L4F4:
	cmp	#2,d7
	blt.s	L4CE
	move	#1,d0
	bra.s	L52A
L500:
	move.l	L69C(pc),a0
	cmp.l	8(a0),a5
	bne.s	L514
	move.l	L69C(pc),a0
	move.l	12(a6),8(a0)
L514:
	move.l	12(a6),a0
	move.l	a5,a1
	rept	8			;FX92:\
	move	(a1)+,(a0)+		;FX92: >This replaces loop below
	endr				;FX92:/ to protect d1 (also faster)
;;;	move	#7,d1		;old:\ 
;;;L51E:			;old: \ This loop crashed d1 for gemdos exit
;;;	move	(a1)+,(a0)+	;old: / as would be legal only for 'Super'
;;;	dbf	d1,L51E		;old:/  This could cause BOMBs...
	move.l	12(a6),(a3)
	clr	d0
L52A:
	tst.l	(sp)+
	movem.l	(sp)+,d7-d7/a3-a5
	unlk	a6
	rts
;
;
logout_cookies:			;NB: This is a reset routine
	clr.l	(_cookies).w
	move.l	old_resvalid(pc),(resvalid).w
	move.l	old_resvector(pc),(resvector).w
	jmp	(a6)		;NB: This is normal reset routine exit
;
;
basepage_p:	dc.l	0
L694:		dc.l	0
L698:		dc.l	0
L69C:		dc.l	0
L6A0:		dc.l	0
poolfix_flag:	dc.w	0
old_resvector:	dc.l	0
old_resvalid:	dc.l	0
;
;
tsr_limit:
;
;
already_in_s:
	dc.b	'Pool patch already installed.',NUL
not_needed_s:
	dc.b	'Pool patch not needed in this TOS',NUL
bad_linkage_s:
	dc.b	'Something linked into the GEMDOS trap',CR,LF
	dc.b	'without following XBRA rules.',CR,LF,NUL
strange_TOS_s:
	dc.b	"POOLFIX4 doesn't recognize this TOS.",NUL
	even
;
;
;int	find_cookie(long id, void **ptr)  /* not found => 0 */
find_cookie:
	movem.l	d6-d7/a6,-(sp)
	move.l	16(sp),d6
	move.l	20(sp),a6
	moveq	#0,d7
	move.l	#1,-(sp)
	move	#Super&$ff,-(sp)
	trap	#1
	tst.l	d0
	bne.s	L55E
	clr.l	2(sp)
	move	#Super&$ff,(sp)
	trap	#1
	move.l	d0,d7
L55E:
	addq.l	#6,sp
	move.l	(_cookies).w,a0
	move.l	a0,d0
	beq.s	L580
L568:
	move.l	(a0),d0
	cmp.l	d0,d6
	beq.s	L576
	tst.l	d0
	beq.s	L580
	addq.l	#8,a0
	bra.s	L568
;
L576:
	move.l	a6,d0
	beq.s	L57E
	move.l	4(a0),(a6)
L57E:
	moveq	#1,d0
L580:
	move.l	d0,d6
	tst.l	d7
	beq.s	L590
	gemdos	Super!_ind,d7
L590:
	move.l	d6,d0
	movem.l	(sp)+,d6-d7/a6-a6
	rts
;
;
error_exit:
	bsr	Cconws_a0
	lea	crlf_s(pc),a0
	bsr	Cconws_a0
	gemdos	Super!_ind,Saved_SSP(pc)
	pea	$4C0001.l
	trap	#1
	dc.b	'J',$FC	;	dc.w	$4AFC
;
;
main:
	move.l	4(sp),a6
;;;	clr.l	-(sp)		;old:\  TOS-dependent...?
;;;	move	#$20,-(sp)	;old: > Nonstandard call, ignored old SSP
;;;	trap	#1		;old:/
	gemdos	Super,!			;FX92: Standard call
	move.l	d0,Saved_SSP-bp(a6)	;FX92: Saves old SSP for exit
	gemdos	Sversion
	lea	not_needed_s(pc),a0
	cmp	#$1500,d0
	bne	error_exit
	lea	strange_TOS_s(pc),a0
	move.l	(_sysbase).w,a1
	move	2(a1),d0
	cmp	#$104,d0		;TOS 1.04 ?
	beq.s	L40
	cmp	#$106,d0		;TOS 1.06 ?
	bne	error_exit
L40:
	clr.l	-(sp)
	move.l	#'_OOL',-(sp)
	bsr	find_cookie		;test for own 'cookie'
	addq.l	#4,sp
	lea	already_in_s(pc),a0
	tst	d0
	bne	error_exit
	lea	bad_linkage_s(pc),a0
	bsr	find_os_gemdos
	tst.l	d0
	bmi	error_exit
	lea	strange_TOS_s(pc),a0
	cmpi	#$2EBC,-1796(a2)
	bne	error_exit
	cmpi	#$2A79,-1102(a2)
	bne	error_exit
	clr.l	-(sp)
	move.l	sp,a5
	move.l	a5,-(sp)
	clr.l	-(sp)
	bsr	find_cookie		;test for free 'cookie'
	addq.l	#4,sp
	addq.l	#8,(a5)
	move.l	(a5),-(sp)
	pea	tsr_limit(pc)
	clr.l	-(sp)
	move.l	#'_OOL',-(sp)
	bsr	place_cookie
	adda	#$10,sp
	moveq	#0,d7
	tst	d0
	bmi.s	LB6
	beq.s	LB6
	move.l	(a5),d7
	asl.l	#3,d7
LB6:
	bsr.s	find_os_gemdos
	move.l	a2,a1
	move.l	-1794(a1),a2
	move.l	a2,L69C
	move.l	a2,L694
	addq.l	#4,a2
	move.l	a2,L698
	move.l	-1100(a1),L6A0
	move.l	(ev_gemdos).w,8+nu_gemdos
	move.l	#12+nu_gemdos,(ev_gemdos).w
	lea	installed_s(pc),a0
	bsr.s	Cconws_a0
	move.l	#tsr_limit-bp,d0
	add.l	d7,d0
	gemdos	Ptermres,d0,!
;
;
saved_SSP:	dc.l	0
;
;
Cconws_a0:
	gemdos	Cconws,(a0)
	rts
;
;
find_os_gemdos:
	movem.l	d1-d1/a1-a1,-(sp)
	moveq	#0,d0
	move.l	(ev_gemdos).w,a2
L130:
	cmpi.l	#'XBRA',-12(a2)
	bne.s	L140
	move.l	-4(a2),a2
	bra.s	L130
;
L140:
	move.l	a2,d1
	and.l	#$FFFFFF,d1
	move.l	(_sysbase).w,a1
	move.l	8(a1),a1
	sub.l	a1,d1
	bmi.s	L15C
	cmp.l	#$20000,d1
	bmi.s	L15E
L15C:
	moveq	#-1,d0
L15E:
	movem.l	(sp)+,d1-d1/a1-a1
	rts
;
;
place_cookie:
	link	a6,#0
	move.l	d7,-(sp)
	moveq	#1,d7
	move.l	d7,-(sp)
	moveq	#0,d7
	move	#$20,-(sp)
	trap	#1
	tst.l	d0
	bne.s	L5BA
	clr.l	2(sp)
	move	#$20,(sp)
	trap	#1
	move.l	d0,d7
L5BA:
	addq.l	#6,sp
	move.l	(_cookies).w,a0
	move.l	a0,d0
	beq.s	L5F0
	moveq	#0,d0
L5C6:
	addq.l	#1,d0
	tst.l	(a0)
	beq.s	L5D0
	addq.l	#8,a0
	bra.s	L5C6
;
L5D0:
	cmp.l	4(a0),d0
	beq.s	L642
	move.l	4(a0),12(a0)
	clr.l	8(a0)
	move.l	8(a6),(a0)
	move.l	12(a6),4(a0)
	moveq	#0,d0
	bra	L674
;
L5F0:
	cmpi.l	#2,20(a6)
	blt.s	L672
	lea	old_resvector(pc),a0
;;;	move.l	(memctrl).w,(a0)+	;NB:was 'move.l  (resvector)...' in POOLFIX3
;;;NB: Fatal POOLFIX4 error:  'memctrl'...'resvector' mixup  (lost bit...?)
	move.l	(resvector).w,(a0)+
	move.l	(resvalid).w,(a0)
	move.l	#logout_cookies,(resvector).w
	move.l	#$31415926,(resvalid).w
	move.l	16(a6),a0
	move.l	a0,(_cookies).w
	move.l	8(a6),(a0)+
	move.l	12(a6),(a0)+
	clr.l	(a0)+
	move.l	20(a6),(a0)
	moveq	#1,d0
	bra.s	L674
;
L642:
	cmp.l	20(a6),d0
	ble.s	L672
	move.l	d0,d1
	subq.l	#2,d1
	move.l	(_cookies).w,a0
	move.l	16(a6),a1
	move.l	a1,(_cookies).w
L658:
	move.l	(a0)+,(a1)+
	move.l	(a0)+,(a1)+
	dbf	d1,L658
	move.l	8(a6),(a1)+
	move.l	12(a6),(a1)+
	clr.l	(a1)+
	move.l	20(a6),(a1)
	moveq	#1,d0
	bra.s	L674
;
L672:
	moveq	#-1,d0
L674:
	tst.l	d7
	beq.s	L68A
	move.l	d0,8(a6)
	gemdos	Super!_ind,d7
	move.l	8(a6),d0
L68A:
	move.l	(sp)+,d7
	unlk	a6
	rts
;
;
installed_s:
	dc.b	'POOL PATCH OF 19-JAN-90 INSTALLED.',CR,LF
	dc.b	'Improved 27-MAR-90 by Claus Brod',CR,LF
	dc.b	'Debugged 4-MAR-92 by Ronald Andersson'
crlf_s:
	dc.b	CR,LF,NUL
	even
;
;	
	end	;of file:	POOLFX92.S