*
* last modified 30/08/95
*
* AMIGA QDOS SCREEN ACCELERATOR for 32 bit AGA machines
* Version 3.21 by Simon N Goodwin, with thanks to Mark
* J Swift for scanning a listing when I lost the source!
* Listing assumes TABs set to 11 chars
*
qdos	equr	a0	Qdos screen pointer
Plane1	equr	a1	Least significant bitplane
Plane2	equr	a2
Plane3	equr	a3	MODE 8 only
table	equr	a4	Byte translator
*
* Interrupt servers must preserve A5, A6 and A7 (!)
* but all other registers are up for grabs.
*
* Bitplane accumulator registers, added in v3.11
*
RED	equr	d4
BLUE	equr	d5
GREEN	equr	d6
*
* Amiga hardware equates
*
COLOR00	EQU	$DFF180
COLOR01	EQU	$DFF182
COLOR02	EQU	$DFF184
COLOR03	EQU	$DFF186
COLOR04	EQU	$DFF188
COLOR05	EQU	$DFF18A
COLOR06	EQU	$DFF18C
COLOR07	EQU	$DFF18E
*
* QDOS equates
*
BP.INIT	equ	$110
CA.GTINT	equ	$112
BV.CHRIX	equ	$11A
*
* QDOS hardware equates
*
MC_STAT	equ	$18063
*
* Default addresses for Qdos and Amiga screen images
*
qlbase	equ	$20000	Base of first QL screen
qlsize	equ	$8000	Size of each QL screen
bp1base	equ	$10000	Base of first Amiga bitplane
bp3base	equ	$12000	Base of BLUE bitplane in MODE 8
bp2base	equ	$14000	Base of second bitplane
*
* Offsets of variables in interrupt linkage
*
link	equ	0	Interrupt link comes first
vector	equ	4	Offset of code address
marker	equ	8	Offset of "ACE3" signature
prefix	equ	12	Number of bytes so far
*
* These variables follow MARKER and are relative to PREFIX
*
limit	equ	0	Count fields down from this
count	equ	1	Current field in sequence
busy	equ	2	Set during interrupt handler
missed	equ	3	(Counted interrupts ignored)
chunks	equ	4	Number of 2K chunks at each pass
soFar	equ	5	Number of 2K chunks already done
smode	equ	6	current screen mode
varSize	equ	prefix+8	Total bytes of linkage
*
*  ROM header
*
BASE:
	dc.l	$4AFB0001		ROM recognition code
	dc.w	define-BASE	BASIC procs
	dc.w	ROM_START-BASE
	dc.b	0,30,'ACE screen accelerator v3.21 ',$A
*
*  start of ROM code
*
ROM_START:
	movem.l	d0-d3/a0-a3,-(a7)

	lea	BASE(pc),a0
	cmp.l	#$1000000,a0	FAST RAM?
	bmi	ROM_EXIT		No, user decides

	moveq	#0,d0
	trap	#1

	move.b	161(a0),d0 	Check CPU version
	cmp.b	#$30,d0		< 030, user decides
	bcs.s	ROM_EXIT

	bsr	mblit_on

ROM_EXIT:
	movem.l	(a7)+,d0-d3/a0-a3
	rts
*
* This is the routine that redraws the whole screen
* On entry A3 -> Linkage-8; A6 -> Qdos variables
*
AceVars	equ	prefix+8		A3 offset to LIMIT
*
redraw	btst	#7,$1813E
	beq	mblit_off

	tst.b	busy+AceVars(a3)	Prevent re-entrancy
	beq.s	update
*
* Code to work out the number of interrupts MISSED (while ACE is
* busy) commented out for version 3.16 as Qdos can't cope with
* missed interrupts anyway, and I needed the variable to set the
* proportion of the screen to be updated (1..16, as SCR_PRIORITY)
*
* ignore	addq.b	#1,missed+AceVars(a3)
skip	rts
*
update
*	move.b	missed+AceVars(a3),d1
*	beq.s	limit_ok		No interrupts missed
*
*	addq.b	#1,d1		Count one that worked
*	clr.b	missed+AceVars(a3)	Keep checking
*	cmp.b	limit+AceVars(a3),d1	Can the CPU keep up?
*	bls.s	limit_ok		There is enough time
*
*	move.b	d1,limit+AceVars(a3)	Increase limit
limit_ok	subq.b	#1,count+AceVars(a3)
	bne.s	skip		The time is NOT nigh
*
	st	busy+AceVars(a3)	Flag critical region
	move.b	limit+AceVars(a3),count+AceVars(a3)
	lea.l	bp1base,Plane1
	lea.l	bp2base,Plane2
	lea.l	qlbase+qlsize,qdos	Point at screen 2
	move.b	MC_STAT,d2 	Check if it's in use
	bmi.s	chkmod
*
	lea.l	-qlsize(qdos),qdos	Wind back to screen 1
*
* Check if mode has changed
*
chkmod
	cmp.b	smode+AceVars(a3),d2
	beq.s	chksho
*
	bsr	ace_cop
	move.b	d2,smode+AceVars(a3)
*
chksho
	btst	#1,d2		check blanking bit
	bne	done		and exit if set
*
* Work out which chunk needs to be updated next, and adjust pointers
*
based	move.w	#2048/8,d3 	Iterations per 2K chunk
	moveq	#0,d4
	move.b	chunks+AceVars(a3),d4
	moveq	#0,d5
	move.b	soFar+AceVars(a3),d5
*
* Advance input and output pointers past data previously processed
*
	move.l	d5,d6
	lsl.l	#8,d6
	add.l	d6,d6		* 512 for output offsets
	add.l	d6,Plane1
	add.l	d6,qdos
	add.l	d6,Plane2
	add.l	d6,qdos		Qdos gets scanned fastest
	add.l	d6,qdos
	add.l	d6,qdos		We'll need D6 again later
*
* Work out where we're going to end up
*
	add.b	d4,d5
	cmp.b	#16,d5		Up to end of screen?
	bcs.s	nextChunk
*
	sub.b	#16,d5		Compute potential overrun
	sub.b	d5,d4		Do that much less, then
	clr.b	d5		Restart at the beginning
*
nextChunk	move.b	d5,soFar+AceVars(a3)
	mulu.w	d4,d3		D3 is loop count
	subq.w	#1,d3		Adjust for DBRA
*
* If we're running on a CPU with a data cache, we should disable cache
* allocation while redrawing the screen to avoid swamping it with data
* that we do not intend to re-use, and wiping out MODE 8 table data.
*
	move.b	161(a6),d0 	Check CPU version
	cmp.b	#$30,d0
	bcs.s	decached		No data cache before 68030
*
* If we're in MODE 8 we need to prime the data cache with our byteTable
*
	 btst	#3,d2		MODE 8 ?
	 beq.s	noPrime
*
	lea.l     byteTable(pc),table
	moveq     #256/4-1,d1
primer	tst.l     (table)+		Get it all into the cache
	dbra      d1,primer
*
noPrime	cmp.b     #$30,d0		Is this a 68030?
	bne.s     after030
*
* 68030 data cache disabling code
*
	dc.w      $4E7A,$1002 	MOVEC CACR,D1
	move.l    d1,d7		Save old setting
	beq.s     decached
*
	bset      #9,d1		Disable data allocation
	dc.w      $4E7B,$1002 	MOVEC D1,CACR
	bra.s     decached
*
* 68040/060 data cache disabling code; leaves prior DTT0 in D7
*
after030	dc.w      $4E7A,$7006 	MOVEC DTT0,D7
	move.l    #$C060,d1		Don't cache 0..16 Mb
	dc.w      $4E7B,$1006 	MOVEC D1,DTT0
*
* Check the mode to determine the format of the Qdos screen
*
decached	btst      #3,d2		Mode 8 ?
	bne.s     mode8
*
* Algorithmic version, reads 8 bytes and unscrambles them to 2 bitplanes
* Input read to D0 and D5 goes to D2 and D3; D4 scratch, D6 counts loops
*
mode4	move.w    d3,d1
	add.l     d6,Plane1		MODE 4 outputs 2 for 1
	add.l     d6,Plane2
next8	movem.l   (qdos)+,d0/d5	Scrambled long words: ABCD EFGH
	move.l    d0,d2		Set A in high byte of result
	lsl.l     #8,d0		Align BC in the high word
	move.l    d2,d4		Save low byte in D for later
	swap      d0		Low word is now BC
	swap      d2		CDAB
	move.l    d0,d3		Set up B, but in low word
	move.b    d4,d3		Set up D, again low for now
	move.b    d0,d2		AC set in low word
*
* So far we have set AC and BD in the low word of our output registers
* Next step is to work out the other word, and get both words in order
*
	move.l	d5,d4		Save H for later
	swap	d5		GHEF
	swap	d2		AC??
	move.w	d5,d2		Set E in place
	move.l	d4,d5		EFGH
	lsr.l	#8,d5		0EFG
	move.b	d5,d2		Set G in place
	move.l	d2,(Plane2)+	Store ACEG green bits
	swap	d3		BD??
	move.w	d5,d3		BDF?
	move.b	d4,d3		BDFH
	move.l	d3,(Plane1)+	Write out red bits
	dbra	d1,next8
*
	bra	CacheIn
*
* MODE 8 support - added in version 3.11
*
mode8
	lea.l     byteTable(pc),table	Point to start of table
*
	moveq	#0,d0		Ensure byte values are unsigned longs
	move.l	a3,-(a7)		** fix? **
	lea.l	bp3base,Plane3	Extra plane pointer for eight colours
	add.l	d6,Plane3
*
next2	move.l	(qdos)+,d1
*
* Convert two Qdos screen bytes into three packed nybbles for the bitplanes
*
	rol.l	#8,d1		Move MSB (green byte) to LSB
	move.b	d1,d0		Make it an unsigned long value
	moveq	#15,d2		Mask for low nybble
	and.b	0(table,d0.l),d2	Get four packed green bits
	lsl.l	#4,GREEN		Make room
	or.b	d2,GREEN
	rol.l	#8,d1		Get blue and red byte to LSB
	move.b	d1,d0
	moveq	#15,d2		Mask for packed red bits
	move.b	0(table,d0.l),d0
	lsl.l	#4,RED		Make room
	and.b	d0,d2		Extract red bits
	lsl.l	#4,BLUE		Make room
	lsr.b	#4,d0		Move blue pack to low nybble
	or.b	d2,RED
	or.b	d0,BLUE
*
* Now do the next two Qdos bytes, from the other half of D1
*
	rol.l	#8,d1		Move MSB (green byte) to LSB
	move.b	d1,d0		Make it an unsigned long value
	moveq	#15,d2		Mask for low nybble
	and.b	0(table,d0.l),d2	Get four packed green bits
	lsl.l	#4,GREEN		Make room
	or.b	d2,GREEN
	rol.l	#8,d1		Get blue and red byte to LSB
	move.b	d1,d0
	moveq	#15,d2		Mask for packed red bits
	move.b	0(table,d0.l),d0
	lsl.l	#4,RED		Make room
	and.b	d0,d2		Extract red bits
	lsl.l	#4,BLUE		Make room
	lsr.b	#4,d0		Move blue pack to low nybble
	or.b	d2,RED
	or.b	d0,BLUE
*
* Pick up another Qdos long word and repeat to get a whole word for each bitplane
*
	move.l	(qdos)+,d1
*
* Optimisation to speed up black areas of the screen. Overhead is just this test
*
	beq.s	blackOut		Skip prevarication
*
	rol.l	#8,d1		Move MSB (green byte) to LSB
	move.b	d1,d0		Make it an unsigned long value
	moveq	#15,d2		Mask for low nybble
	and.b	0(table,d0.l),d2	Get four packed green bits
	lsl.l	#4,GREEN		Make room
	or.b	d2,GREEN
	rol.l	#8,d1		Get blue and red byte to LSB
	move.b	d1,d0
	moveq	#15,d2		Mask for packed red bits
	move.b	0(table,d0.l),d0
	lsl.l	#4,RED		Make room
	and.b	d0,d2		Extract red bits
	lsl.l	#4,BLUE		Make room
	lsr.b	#4,d0		Move blue pack to low nybble
	or.b	d2,RED
	or.b	d0,BLUE
*
* Time to sort out the remaining Qdos word
*
	rol.l	#8,d1		Move MSB (green byte) to LSB
	move.b	d1,d0		Make it an unsigned long value
	moveq	#15,d2		Mask for low nybble
	and.b	0(table,d0.l),d2	Get four packed green bits
	lsl.l	#4,GREEN		Make room
	or.b	d2,GREEN
*
* If D3 is even we've got long words to write out
*
	btst	#0,d3
	bne.s	noWrite
*
* These three nybbles complete long bitplane values which must be stored
*
	move.l	GREEN,(Plane3)+
	rol.l	#8,d1		Get blue and red byte to LSB
	move.b	d1,d0
	moveq	#15,d2		Mask for packed red bits
	move.b	0(table,d0.l),d0
	lsl.l	#4,RED		Make room
	and.b	d0,d2		Extract red bits
	or.b	d2,RED
	move.l	RED,(Plane2)+
	lsl.l	#4,BLUE		Make room
	lsr.b	#4,d0		Move blue pack to low nybble
	or.b	d0,BLUE
	move.l	BLUE,(Plane1)+
	bra.s	CarryOn
*
* A quick hack to save time if even input long words are zero (8 black pixels)
*
blackOut	lsl.l	#8,GREEN
	lsl.l	#8,RED
	lsl.l	#8,BLUE
*
* If D3 is even we've got long words to write out
*
	btst	#0,d3
	bne.s	CarryOn		Go round again for the next word
*
	move.l	BLUE,(Plane1)+
	move.l	RED,(Plane2)+
	move.l	GREEN,(Plane3)+
	bra.s	CarryOn
*
* Continue to accumulate in registers as we have not yet got long values
*
noWrite	rol.l	#8,d1		Get blue and red byte to LSB
	move.b	d1,d0
	moveq	#15,d2		Mask for packed red bits
	move.b	0(table,d0.l),d0
	lsl.l	#4,RED		Make room
	and.b	d0,d2		Extract red bits
	lsl.l	#4,BLUE		Make room
	lsr.b	#4,d0		Move blue pack to low nybble
	or.b	d2,RED
	or.b	d0,BLUE
CarryOn	dbra	d3,next2
	move.l	(a7)+,a3		** fix? **
*
CacheIn	move.b	161(a6),d1 	Check for data cache
	cmp.b	#$30,d1		68030?
	bcs.s	done
*
	beq.s	enable030
*
* Revert to prior setting of DTT0 on 68040 or 68060
*
	dc.w	$4E7B,$7006	MOVEC D7,DTT0
	bra.s	done
*
* Revert to prior setting of CACR on 68030
*
enable030	dc.w	$4E7B,$7002	MOVEC D7,CACR
done	clr.b	busy+AceVars(a3)
	rts
*
* sub to change copper list to suit ace
*
ace_cop
	bset	#7,$1813E		disable screen blitter
	move.w	#$0000,COLOR00
	move.b	MC_STAT,d2
	btst	#3,d2
	bne.s	ace_cop8
*
ace_cop4
	move.w	#76,99974		DDFSTART
	move.w	#204,99978 	DDFSTOP
	move.w	#-4,99982		Modulo
	move.w	#-4,99986		Modulo
	move.w	#$A200,100002
	btst	#1,d2
	bne	blnkit
	move.w	#$0F00,COLOR01
	move.w	#$00F0,COLOR02
	move.w	#$0FFF,COLOR03
	rts
ace_cop8
	move.w	#72,99974		DDFSTART
	move.w	#200,99978 	DDFSTOP
	move.w	#-2,99982		Modulo
	move.w	#-2,99986		Modulo
	move.w	#$3200,100002
	btst	#1,d2
	bne.s	blnkit
	move.w	#$000F,COLOR01
	move.w	#$0F00,COLOR02
	move.w	#$0F0F,COLOR03
	move.w	#$00F0,COLOR04
	move.w	#$00FF,COLOR05
	move.w	#$0FF0,COLOR06
	move.w	#$0FFF,COLOR07
	rts
*
blnkit
	move.w	#$0000,COLOR01
	move.w	#$0000,COLOR02
	move.w	#$0000,COLOR03
	rts
*
* sub to change copper list to suit blitter
*
blt_cop
	bclr	#7,$1813E		enable screen blitter
	move.w	#76,99974		DDFSTART
	move.w	#204,99978 	DDFSTOP
	move.w	#-4,99982		Modulo
	move.w	#-4,99986		Modulo
	move.w	#$A200,100002
	move.w	#$0000,COLOR00
	move.w	#$0FFF,COLOR03
*
	move.b	MC_STAT,d2
	btst	#1,d2
	bne.s	blnkit
	btst	#3,d2
	bne.s	blt_cop8
*
blt_cop4
	move.w	#$0F00,COLOR01
	move.w	#$00F0,COLOR02
	rts
*
blt_cop8
	move.w	#$0708,COLOR01
	move.w	#$00FA,COLOR02
	rts
*
* ACE_ON asks is it already on? if so, return no error
*
mblit_on	bsr.s	find_pos2
	beq.s	it_worked		Already on
*
* Otherwise, allocate linkage area in common heap
*
	moveq	#varSize,d1
	moveq	#0,d2		Owned by SuperBASIC
	moveq	#24,d0		MT.ALCHP trap key
	trap	#1
	tst.l	d0		Did we get it?
	bne.s	oops
*
	bsr	ace_cop
	move.b	d2,prefix+smode(a0)
*
	lea.l	redraw,a2
	move.l	a2,vector(a0)	Provide code address
	move.l	d7,marker(a0)	Add signature
	move.b	#2,prefix+limit(a0)	Update every other field
	move.b	#1,prefix+count(a0)
	move.b	#0,prefix+missed(a0)	Not currently used...
	move.b	#0,prefix+busy(a0)
	move.b	#8,prefix+chunks(a0)	Scan 8 x 2K per update
	move.b	#0,prefix+soFar(a0)
	moveq	#28,d0		Set up MT.LPOLL trap
trap1_out	trap	#1
it_worked	moveq	#0,d0
	rts
*
find_pos2	bsr.s	find_pos		Extra call for trapping
oops	rts
*
* ACE_OFF is pretty simple too
*
mblit_off	bsr.s	find_pos2		Is our interrupt link
	bmi.s	it_worked		If not, return at once
*
* Remove interrupt server and deallocate linkage memory
*
	bsr	blt_cop
*
not_opened lea.l	-prefix(a4),a0
	moveq	#29,d0		MT.RPOLL trap key
	trap	#1
	moveq	#25,d0		MT.RECHP trap key
	bra.s	trap1_out
*
bad_param	moveq	#-15,d0		ERR.BP code
no_luck	rts
*
setrate	move.w	CA.GTINT,a2	Integer fetch vector
	jsr	(a2)
	bne.s	no_luck
*
	subq.w	#2,d3
	bne.s	bad_param
*
* Check first parameter, number of 2K chunks to update each time
*
	move.w	0(a1,a6.l),d4
	ble.s	bad_param
*
	cmp.w	#16,d4
	bhi.s	bad_param
*
* Check second parameter, delay between updates in fields
*
	tst.b	2(a1,a6.l)
	bne.s	bad_param		Reject if <0 or >255
*
	move.b	3(a1,a6.l),d3
	beq.s	bad_param		Trap zero (aka 256!)
*
	bsr.s	find_pos
*
	move.b	d3,limit(a4)
	move.b	d4,chunks(a4)
	move.b	#1,count(a4)	Respond next field
	bra.s	it_worked
*
* ACE_STEP% returns the current setting of CHUNKS to SuperBASIC
*
step	bsr.s	find_pos
	moveq	#0,d4
	move.b	chunks(a4),d4
	bra.s	chk_integer
*
* ACE_RATE% returns the current setting of LIMIT to SuperBASIC
*
rate	bsr.s	find_pos
	moveq	#0,d4
	move.b	limit(a4),d4
*
* Return the integer in D4.W to SuperBASIC via the RI stack
*
chk_integer moveq	#2,d1		Number of bytes needed
	move.w	BV.CHRIX,a2	Find the BV.CHRIX vector
	jsr	(a2)		Allocate RI space
	subq.l	#2,$58(a6) 	Update BV.RIP
ret_integer move.l	$58(a6),a1 	Get BV.RIP
	move.w	d4,0(a1,a6.l)	Stack the result
	moveq	#3,d4		Type = 16 bit Integer
no_error	moveq	#0,d0		No run-time error
	rts
*
* FIND_POS points A4 at ACE variables in the interrupt list
*
* LONG link address
* LONG code address
* LONG "ACE3" marker
* BYTE count
* BYTE limit
*
* Result in A4, "ACEn" marker in D7; job ID in D1, uses D0
* Returns NOT FOUND to prior caller if the server is absent
*
find_pos	moveq	#0,d0		MT.INF
	trap	#1
	move.l	#'ACE3',d7
	lea.l	60(a0),a4		Locate polled list
find_loop	move.l	(a4),d0
	beq.s	not_found		Report to prior caller
*
	movea.l	d0,a4
	cmp.l	marker(a4),d7	Check signature
	bne.s	find_loop
*
found_it	lea.l	prefix(a4),a4	Point at the data
	rts
*
not_found	addq.l	#4,a7		Discard return address
	moveq	#-7,d0		ERR.NF report code
	rts
*
* Mode 8 byte conversion table, generated by ACE3_BAS
*
* Index:  0..255	A B C D E F G H
* Result: 0..255	B D F H A C E G
*
byteTable	dc.b	0,16,1,17,32,48,33,49
	dc.b	2,18,3,19,34,50,35,51
	dc.b	64,80,65,81,96,112,97,113
	dc.b	66,82,67,83,98,114,99,115
	dc.b	4,20,5,21,36,52,37,53
	dc.b	6,22,7,23,38,54,39,55
	dc.b	68,84,69,85,100,116,101,117
	dc.b	70,86,71,87,102,118,103,119
	dc.b	128,144,129,145,160,176,161,177
	dc.b	130,146,131,147,162,178,163,179
	dc.b	192,208,193,209,224,240,225,241
	dc.b	194,210,195,211,226,242,227,243
	dc.b	132,148,133,149,164,180,165,181
	dc.b	134,150,135,151,166,182,167,183
	dc.b	196,212,197,213,228,244,229,245
	dc.b	198,214,199,215,230,246,231,247
	dc.b	8,24,9,25,40,56,41,57
	dc.b	10,26,11,27,42,58,43,59
	dc.b	72,88,73,89,104,120,105,121
	dc.b	74,90,75,91,106,122,107,123
	dc.b	12,28,13,29,44,60,45,61
	dc.b	14,30,15,31,46,62,47,63
	dc.b	76,92,77,93,108,124,109,125
	dc.b	78,94,79,95,110,126,111,127
	dc.b	136,152,137,153,168,184,169,185
	dc.b	138,154,139,155,170,186,171,187
	dc.b	200,216,201,217,232,248,233,249
	dc.b	202,218,203,219,234,250,235,251
	dc.b	140,156,141,157,172,188,173,189
	dc.b	142,158,143,159,174,190,175,191
	dc.b	204,220,205,221,236,252,237,253
	dc.b	206,222,207,223,238,254,239,255
*
* SuperBASIC extension details for the BP.INIT vector
*
define	dc.w	3+1		Three procedures
	dc.w	mblit_off-*
	dc.b	7,'ACE_OFF'
	dc.w	mblit_on-*
	dc.b	6,'ACE_ON'
	dc.w	setrate-*
	dc.b	12,'ACE_PRIORITY'	Long name hence +1
	dc.w	0
*
	dc.w	2		Two functions
	dc.w	rate-*
	dc.b	9,'ACE_RATE%'
	dc.w	step-*
	dc.b	9,'ACE_STEP%'
	dc.w	0
*
	end