;INTA.68K	AUG-05-90
;XPL intrinsics for the 68000
;Written by Loren Blaney
;This is derived from 6502 code written by P.J.R. Boyle.
;
;REVISION HISTORY:
;DEC-84, Original, known as: INT.68K.
;DEC-85, Added floating point intrinsics.
;FEB-86, Modified for 32-bit operations for DFM engineering.
;MAR-86, Modified for double-precision floating point.
;SEP-86, Converted to ASM68K conventions and modified.
;OCT-86, Modified to run in supervisor mode and to interface cleanly
;	with assembly language.
;NOV-86, Modified for second terminal (device 1)
;DEC-86, Added OPENF intrinsic and removed FASAVE
;FEB-87, Fixed test for file too long.
;MAR-87, Added graphics routines for the Amiga.
;	 Added 32-bit multiply and divide.
;	 Added intrinsics: SWAP_W, PEEK, POKE, EXT_L, and CARRY.
;APR-87, Changed string convention, BLIT(FROM, TO, SIZE), remainder.
;MAY-87, Cleaned up graphics intrinsics.
;JUL-87, Speed up CLEAR and VIEW, fix infinite loop in LINE clipping.
;AUG-87, Speed up LINE slightly.
;NOV-87, Fix line clipping.
;JUN-88, Modified for increased screen height (240/480), fixed CLEAR
;	 intrinsic.
;JUL-07-88, Fix point plot on screens larger than 640x400.
;AUG-09-89, Fix glitch in VIEW & CLEAR intrinsics (removed CLR.Ws).
;AUG-05-90, Fixed CLEAR to work for all bit map dimensions, and added
;	BUTTON and JOYSTICK.
;
;NOTES:
;These intrinsics, unlike subroutines in general, may destroy the
; contents of registers D0 and A6. If, in the interest of speed,
; registers are not saved and restored, this should be clearly stated
; as part of the operation of the subroutine.
;
	NOLIST
	INCLUDE	SYSPAG		;Get system page definitions
	LIST

;-----------------------------------------------------------------------
;INTRINSIC JUMP TABLE

	ORG	INTTBL		;Compiler expects the jump table here

	JMP	ABS.L		;0
	JMP	RAN.L		;1
	JMP	REM.L		;2
	JMP	RESERV.L	;3
	JMP	SWAP.L		;4
	JMP	EXTEND.L	;5
	JMP	RESTAR.L	;6
	JMP	CHIN.L		;7
	JMP	CHOUT.L		;8
	JMP	CRLF.L		;9
	JMP	INTIN.L		;10
	JMP	INTOUT.L	;11
	JMP	TEXT.L		;12
	JMP	OPENI.L		;13
	JMP	OPENO.L		;14
	JMP	CLOSE.L		;15
	JMP	ABORT.L		;16
	JMP	TRAP.L		;17
	JMP	FREE.L		;18
	JMP	RERUN.L		;19
	JMP	GETHP.L		;20
	JMP	SETHP.L		;21
	JMP	GETERR.L	;22
	JMP	CURSOR.L	;23
	JMP	SCAN.L		;24
	JMP	SETRUN.L	;25
	JMP	HEXIN.L		;26
	JMP	HEXOUT.L	;27
	JMP	CHAIN.L		;28
	JMP	OPENF.L		;29
	JMP	WRITE.L		;30
	JMP	READ.L		;31
	JMP	BADINT.L	;TESTPT.L	;32
	JMP	FGET.L		;33
	JMP	BADINT.L	;FASAVE.L	;34
	JMP	FSAVE.L		;35
	JMP	BLIT.L		;36 BLIT(FROM, TO, BYTES)
	JMP	BUTTON.L	;37
	JMP	JOYSTICK.L	;38
	JMP	BADINT.L	;SOUND.L	;39
	JMP	CLEAR.L		;40
	JMP	POINT.L		;41
	JMP	LINE.L		;42
	JMP	MOVE.L		;43
	JMP	BADINT.L	;44
	JMP	BADINT.L	;BLOCK.L	;45
	JMP	RLRES.L		;46
	JMP	RLIN.L		;47
	JMP	RLOUT.L		;48
	JMP	FLOAT.L		;49
	JMP	FIX.L		;50
	JMP	RLABS.L		;51
	JMP	FORMAT.L	;52
	JMP	SQRT.L		;53
	JMP	LN.L		;54
	JMP	EXP.L		;55
	JMP	SIN.L		;56
	JMP	ATAN2.L		;57
	JMP	MOD.L		;58
	JMP	LOG.L		;59
	JMP	COS.L		;60
	JMP	TAN.L		;61
	JMP	ASIN.L		;62
	JMP	ACOS.L		;63
	JMP	BACKUP.L	;64
	JMP	BADINT.L	;HICHAR.L	;65
	JMP	BADINT.L	;PEEK.L		;66
	JMP	BADINT.L	;POKE.L		;67
	JMP	BADINT.L	;68
	JMP	BADINT.L	;69
	JMP	BADINT.L	;70
	JMP	BADINT.L	;71
	JMP	BADINT.L	;72
	JMP	BADINT.L	;73
	JMP	BADINT.L	;74
	JMP	BADINT.L	;75
	JMP	BADINT.L	;76
	JMP	BADINT.L	;77
	JMP	BADINT.L	;78
	JMP	BADINT.L	;79
	JMP	BADINT.L	;80
	JMP	BADINT.L	;81
	JMP	BADINT.L	;82
	JMP	BADINT.L	;83
	JMP	BADINT.L	;84
	JMP	BADINT.L	;85
	JMP	BADINT.L	;86
	JMP	BADINT.L	;87
	JMP	BADINT.L	;88
	JMP	BADINT.L	;89
	JMP	BADINT.L	;90
	JMP	BADINT.L	;91
	JMP	BADINT.L	;92
	JMP	BADINT.L	;93
	JMP	BADINT.L	;94
	JMP	BADINT.L	;95
	JMP	BADINT.L	;96
	JMP	BADINT.L	;97
	JMP	BADINT.L	;98
	JMP	BADINT.L	;99
	JMP	BADINT.L	;100
	JMP	BADINT.L	;101
	JMP	BADINT.L	;102
	JMP	BADINT.L	;103
	JMP	BADINT.L	;104
	JMP	BADINT.L	;105
	JMP	BADINT.L	;106
	JMP	WAITVB.L	;107
	JMP	BITMAP.L	;108 BITMAP(ADDR, WIDTH, HEIGHT, DEPTH)
	JMP	BITMAP2.L	;109 BITMAP2(MAGX, Y, OFFX, Y, INVX, Y)
	JMP	VIEW.L		;110 VIEW(ADDR, BPLCON0)
	JMP	PALETTE.L	;111 PALETTE(N, VAL)
	JMP	CARRY.L		;112
	JMP	PEEK_W.L	;113
	JMP	POKE_W.L	;114
	JMP	PEEK_L.L	;115
	JMP	POKE_L.L	;116
	JMP	SWAP_W.L	;117
	JMP	EXT_L.L		;118
	JMP	CURSOR1.L	;119
	JMP	BUTES1.L	;120
	JMP	SHOCUR1.L	;121
	JMP	DEVINFO.L	;122
	JMP	UNTINFO.L	;123
	JMP	BUTES.L		;124
	JMP	GETKEY.L	;125
	JMP	KEYHIT.L	;126
	JMP	SHOCUR.L	;127

REMAIN	DS.L	1		;Remainder of most recent divide

;32-bit multiply routines:
	JMP	MUL1.L		;D1:= D1 * D2
	JMP	MUL2.L		;D2:= D2 * D3
	JMP	MUL3.L		;D3:= D3 * D4
	JMP	MUL4.L		;D4:= D4 * D5
	JMP	MUL5.L		;D5:= D5 * D6
	JMP	MUL6.L		;D6:= D6 * D7

;32-bit divide routines:
	JMP	DIV1.L		;D1:= D1 / D2
	JMP	DIV2.L		;D2:= D2 / D3
	JMP	DIV3.L		;D3:= D3 / D4
	JMP	DIV4.L		;D4:= D4 / D5
	JMP	DIV5.L		;D5:= D5 / D6
	JMP	DIV6.L		;D6:= D6 / D7

;-----------------------------------------------------------------------
;All INT.68K variables are stored here. The 68020 compiler must know the
; location of REMAIN. The rest are grouped here for convenience when
; they are saved and restored by the multitasking exec.
;
RANK	DC.L	2537		;Random number seeds (initialized at
RANL	DC.L	5149		; load time)
RANM	DC.L	7026		;Random number that is actually output

BACKFL	DS.B	1		;Backup flag, used to re-read last char
LASTCH	DS.B	1		;The last character read by BYTEIN

RASTER	DC.L	$60000		;Location of current bit map

WIDTH	DC.L	640		;Dimensions of RASTER in pixels
HEIGHT	DC.L	240
DEPTH	DC.L	1

MAGX	DC.L	0		;Parameters affecting how coordinates
MAGY	DC.L	0		; are remapped from specified to
OFFSETX	DC.L	0		; actual hardware values
OFFSETY	DC.L	0
INVERTX	DC.L	0
INVERTY	DC.L	0

X0	DC.L	0		;Graphics coordinates (these might have
Y0	DC.L	0		; been remapped by the above parameters)
X1	DC.L	0
Y1	DC.L	0

COLOR	DC.L	0		;Only lowest byte specifies color reg.
MODES	EQU	COLOR+2		;Bit 0: complement
				;Bit 1: fast (i.e. don't clear zeros)
TEXTURE	EQU	COLOR		;For dotted lines, etc. Ones indicate
				; where points are NOT plotted. 16 bits.

	IF	@ # $B96
	ERROR - AMIGAHAN.68K EXPECTS THESE VALUES TO BE AT $B5A
	ENDIF

	IF	@ >= $C00
	ERROR - CHIN3, CHOUT3
	ENDIF

	ORG	$C10		;KLUDGE TO SKIP CHIN3, CHOUT3

COPLST1	DS.L	32		;(7 bit planes *2 +2) *2 = 32
COPLST2	DS.L	32		;Second list is used when first is busy
COPFLAG	DC.B	0		;Flag used to double-buffer copper lists

	ORG	MEMTOP -$4000

;----------------------------------------------------------------------
;MULTIPLY ROUTINES:
;
;Routine to multiply two signed, 32-bit numbers and produce a signed,
; 32-bit product.  D1:= D1 * D2  or  D1:= X * Y.
; Registers D0, D2, and A6 are destroyed.
;
MUL1	MOVEA.W	D1,A6		;(4) Save XL
	MOVE.L	D1,D0		;(4) Save XH
	MULU	D2,D1		;(70) D1:= XL * YL

	SWAP	D0		;(4)
	MULU	D2,D0		;(70) D0:= XH * YL

	SWAP	D1		;(4) Accumulator is word swapped
	ADD.W	D0,D1		;(4) Accumulate high words in D1

	MOVE.W	A6,D0		;(4)
	SWAP	D2		;(4)
	MULU	D2,D0		;(70) D0:= XL * YH

	ADD.W	D0,D1		;(4) Accumulate high word in D1
	SWAP	D1		;(4) Restore proper order
	RTS			;(16) Return product in D1
				;(262) Total cycles, worst case

;D2:= D2 * D3
; Registers D0, D3, and A6 are destroyed.
MUL2	MOVEA.W	D2,A6
	MOVE.L	D2,D0
	MULU	D3,D2
	SWAP	D0
	MULU	D3,D0
	SWAP	D2
	ADD.W	D0,D2
	MOVE.W	A6,D0
	SWAP	D3
	MULU	D3,D0
	ADD.W	D0,D2
	SWAP	D2
	RTS

;D3:= D3 * D4
; Registers D0, D4, and A6 are destroyed.
MUL3	MOVEA.W	D3,A6
	MOVE.L	D3,D0
	MULU	D4,D3
	SWAP	D0
	MULU	D4,D0
	SWAP	D3
	ADD.W	D0,D3
	MOVE.W	A6,D0
	SWAP	D4
	MULU	D4,D0
	ADD.W	D0,D3
	SWAP	D3
	RTS

;D4:= D4 * D5
; Registers D0, D5, and A6 are destroyed.
MUL4	MOVEA.W	D4,A6
	MOVE.L	D4,D0
	MULU	D5,D4
	SWAP	D0
	MULU	D5,D0
	SWAP	D4
	ADD.W	D0,D4
	MOVE.W	A6,D0
	SWAP	D5
	MULU	D5,D0
	ADD.W	D0,D4
	SWAP	D4
	RTS

;D5:= D5 * D6
; Registers D0, D6, and A6 are destroyed.
MUL5	MOVEA.W	D5,A6
	MOVE.L	D5,D0
	MULU	D6,D5
	SWAP	D0
	MULU	D6,D0
	SWAP	D5
	ADD.W	D0,D5
	MOVE.W	A6,D0
	SWAP	D6
	MULU	D6,D0
	ADD.W	D0,D5
	SWAP	D5
	RTS

;D6:= D6 * D7
; Registers D0, D7, and A6 are destroyed.
MUL6	MOVEA.W	D6,A6
	MOVE.L	D6,D0
	MULU	D7,D6
	SWAP	D0
	MULU	D7,D0
	SWAP	D6
	ADD.W	D0,D6
	MOVE.W	A6,D0
	SWAP	D7
	MULU	D7,D0
	ADD.W	D0,D6
	SWAP	D6
	RTS

;----------------------------------------------------------------------
;DIVIDE ROUTINES:
;
;D2:= D2 /D3
; Registers D0, D3, and A6 are destroyed.
DIV2	EXG	D2,D1		;Get numerator and save D1
	EXG	D3,D2		;Get denominator and save D2
	BSR.S	DIV1		;D1:= D1 /D2
	MOVE.L	D3,D2		;Restore D2
	EXG	D1,D2		;Get quotient and restore D1
	RTS

;D3:= D3 /D4
; Registers D0, D4, and A6 are destroyed.
DIV3	EXG	D3,D1
	EXG	D4,D2
	BSR.S	DIV1
	MOVE.L	D4,D2
	EXG	D1,D3
	RTS

;D4:= D4 /D5
; Registers D0, D5, and A6 are destroyed.
DIV4	EXG	D4,D1
	EXG	D5,D2
	BSR.S	DIV1
	MOVE.L	D5,D2
	EXG	D1,D4
	RTS

;D5:= D5 /D6
; Registers D0, D6, and A6 are destroyed.
DIV5	EXG	D5,D1
	EXG	D6,D2
	BSR.S	DIV1
	MOVE.L	D6,D2
	EXG	D1,D5
	RTS

;D6:= D6 /D7
; Registers D0, D7, and A6 are destroyed.
DIV6	EXG	D6,D1
	EXG	D7,D2
	BSR.S	DIV1
	MOVE.L	D7,D2
	EXG	D1,D6
	RTS

;----------------------------------------------------------------------
;Routine to do a signed, 32-bit divide.
; D1:= D1 /D2	remainder is in REMAIN
; (32 bits):= (32 bits) / (32 bits), remainder (32 bits)
; Registers D0, D2, and A6 are destroyed.
;
DIV1	MOVE.L	D2,D0		;(4) Get a copy of the denominator
	BGT.S	DIV20		;(10) Branch if it is greater than one
	BEQ.S	DIV10		;Branch if divide by zero
	NEG.L	D2		;Else, make denominator positive
	BSR.S	DIV20		;Do divide
	NEG.L	D1		;Reverse sign of quotient
	RTS


DIV10	JSR	VERROR
	ASCII	'100 - DIVIDE BY 0'
	DC.B	0

	MOVEQ	#$FFFFFFFF,D1	;Return the best answer:
	LSR.L	#1,D1		;D1:= $7FFFFFFF
	MOVE.L	D2,REMAIN	; quotient = maximum, remainder = 0
	RTS


DIV20	TST.L	D1		;(4) Is the numerator positive?
	BPL.S	DIV30		;(10) Branch if so
	NEG.L	D1		;Otherwise make it positive
	BSR.S	DIV30		;Do divide
	NEG.L	D1		;Make quotient negative
	NEG.L	REMAIN		;Make remainder negative
	RTS


;D1:= D1 / D2
;Positive, 31-bit values.
DIV30	SWAP	D0		;Is denominator more than 16 bits?
	TST.W	D0
	BNE.S	DIV50		;(8) Branch if so

	DIVU	D2,D1		;(140) Attempt a simple divide
	BVS.S	DIV40		;(8) Branch if it didn't work

	MOVEQ	#0,D2		;(4) Clear high word for the remainder
	SWAP	D1		;(4) Get the remainder into D2
	MOVE.W	D1,D2		;(4)
	MOVE.L	D2,REMAIN	;(16)
	CLR.W	D1		;(4) Clear high word of quotient
	SWAP	D1		;(4)
	RTS
	

; D1:= D1 /D2
; (32 bits):= (32 bits) / (16 bits)
;
;	 N       NH *2^16 + NL       NH		  REM *2^16 + NL
;	---  =  ---------------  =  ---- *2^16 + ----------------
;	 D	       D	     D			D
;
; Where:
;	N = The 32-bit numerator
;	D = The 16-bit denominator
;	NH = The high word of the numerator
;	NL = The low word of the numerator
;	REM = The 16-bit remainder from NH/D
;
; Note: (REM *2^16 + NL) / D does not overflow because
;  (REM *2^16 + NL) < (D *2^16).
;
DIV40	MOVE.W	D1,D0		;Save the low word, NL
	CLR.W	D1
	SWAP	D1		;Get the high word, NH
	DIVU	D2,D1		; /D

	MOVEA.W	D1,A6		;Save the high quotient, QH, in A6
	MOVE.W	D0,D1		;QL = [REM *2^16 + NL] /D
	DIVU	D2,D1

	SWAP	D1		;Quotient = QH *2^16 + QL
	MOVEQ	#0,D2
	MOVE.W	D1,D2		;Save remainder
	MOVE.L	D2,REMAIN	;(16)
	MOVE.W	A6,D1		;Combine QH with QL
	SWAP	D1
	RTS


;Check for some trivial cases
; D1:= D1 /D2
DIV50	CMP.L	D1,D2		;Compare denominator to numerator
	BLT.S	DIV70
	BEQ.S	DIV60

	MOVE.L	D1,REMAIN	;Remainder = numerator
	MOVEQ	#0,D1		;Quotient = 0
	RTS


DIV60	MOVEQ	#1,D1		;Quotient = 1
	MOVEQ	#0,D2
	MOVE.L	D2,REMAIN	;Remainder = 0
	RTS


;Handle the non-trivial case: LONG / LONG.
; D1:= D1 /D2,  $10000 <= D2 < D1
;The basic idea here is to shift D2 and D1 right until D2 < $10000. This
; allows the DIVU instruction to be used, which provides a quotient that
; is very nearly correct -- worst case it is only one count too large.
;
DIV70	MOVE.L	D1,-(SP)	;Save numerator
	MOVEA.L	D2,A6		;Save denominator

	MOVEQ	#15,D0		;Scan for the most significant set bit
	SWAP	D2		; in the denominator
	CMPI.W	#$100,D2
	BGE.S	DIV80
	MOVEQ	#7,D0
DIV80
DIV85	BTST	D0,D2
	DBNE	D0,DIV85

	SWAP	D2		;Restore D2
	ADDQ.B	#1,D0
	LSR.L	D0,D2		;Shift numerator and denominator right
	LSR.L	D0,D1		; until the denominator fits in a word

	DIVU	D2,D1		;Divide the truncated values
	EXT.L	D1		;Zero the high word of the quotient

;Test numerator = Original denominator * truncated quotient
; (32) * (16) => (32)
	MOVE.L	A6,D2		;Get original denominator
	MULU	D1,D2		;Times tructated quotient
	MOVE.L	A6,D0		;Multiply the high word of denominator
	SWAP	D0
	MULU	D1,D0
	SWAP	D2		;Add partial products
	ADD.W	D0,D2
	SWAP	D2

;Remainder = original numerator - test numerator
	NEG.L	D2		;Subtract test numerator
	ADD.L	(SP)+,D2	;Add the original numerator
	BGE.S	DIV90		;Branch if cool
	SUBQ.W	#1,D1		;Adjust quotient
	ADD.L	A6,D2		;Adjust remainder (add orig denominator)
DIV90
	MOVE.L	D2,REMAIN	;(16)
	RTS

;----------------------------------------------------------------------
;Illegal intrinsic handler. (Note: this would be improved a tremendous
; amount if it said where it came from.)
;
BADINT	JSR	VERROR
	ASCII	'105 - ILLEGAL INTRINSIC'
	DC.B	0
	RTS

;-----------------------------------------------------------------------
;0
;Return the absolute value of the argument in D0.
; I:= ABS(J)
;
ABS	MOVE.L	(A5),D0
	BPL.S	ABS10
	NEG.L	D0
ABS10	RTS

;-----------------------------------------------------------------------
;1
;Return a random number, between 0 and the argument-1, in D0.
; If the argument = 0, then the seeds are reinitialized (for a
; repeatable sequence). If the argument < 0 then randomize and
; return a positive value between 0 and -(argument-1).
; I:= RAN(10)
; *** THIS IS CURRENTLY A 16-BIT OPERATION ***
;
RAN	TST.L	(A5)		;Is the argument = 0
	BNE.S	RANF10		;Branch if not
	BSR.S	RANINI		;Initialize seeds
	MOVEQ	#0,D0		;Return 0
	BRA.S	RANF90

RANF10	BPL.S	RANF20		;Branch if the argument is positive
	MOVE.L	HASH,RANM	;Randomize with keyboard spinner
	NEG.L	(A5)		;Return a positive random number

RANF20	BSR.S	RANDOM		;Get a random number
	DIVS	2(A5),D0	;D0:= REM(D0 / 2(A5))
	CLR.W	D0		;Clear quotient
	SWAP	D0		;Get remainder into low word
RANF90	RTS

;
;Initialize the random number seeds
;
RANINI	MOVE.L	#2537,RANK	;Reinitialize the seeds
	MOVE.L	#5149,RANL
	MOVE.L	#7026,RANM
	RTS

;
;Return a random number, between 0 and 10860, in D0.
;*** should be increased to 32 bit values ***	????
;
MODK	EQU	10909		;Modulo values (prime numbers)
MODL	EQU	10891
MODM	EQU	10861

RANDOM	MOVE.L	RANK,D0		;RANK:=2*RANK modulo MODK
	ADD.L	D0,D0
	CMP.L	#MODK,D0
	BLT.S	RAN10
	SUB.L	#MODK,D0
RAN10	MOVE.L	D0,RANK

	MOVE.L	RANL,D0		;RANL:=2*RANL modulo MODL
	ADD.L	D0,D0
	CMP.L	#MODL,D0
	BLT.S	RAN20
	SUB.L	#MODL,D0
RAN20	MOVE.L	D0,RANL

	ADD.L	RANK,D0		;RANM:= (RANK+RANL+RANM) modulo MODM
	ADD.L	RANM,D0
RAN30	CMP.L	#MODM,D0
	BLT.S	RAN99
	SUB.L	#MODM,D0
	BRA.S	RAN30

RAN99	MOVE.L	D0,RANM
	RTS

;-----------------------------------------------------------------------
;2
;Return the remainder of the last integer divide in D0.
; The sign of the remainder is always the same as the dividend unless
; the dividend is equal to zero.
; I:= REM(5/3)
;
REM	MOVE.L	REMAIN,D0	;Get the remainder
	RTS

;-----------------------------------------------------------------------
;3
;Reserve heap space for an array (A5:= A5 + <ARG>).
; ADDR:= RESERVE(BYTES)
; The starting (low) address of the reserved space in returned in D0.
;WARNING: This assumes that the heap and the stack are arranged so that
; they grow toward each other.
;
RESERV	MOVE.L	A5,D0		;Return the base address in D0
	BTST	#0,3(A5)	;Make sure he is reserving an even
	BEQ.S	RES10		; number of bytes, branch if so
	ADDQ.B	#1,3(A5)	;Add one more byte to make it even
RES10
	ADDA.L	(A5),A5		;Add the argument number of bytes
				; to the heap pointer (A5)
	CMPA.L	SP,A5		;Check for memory overflow
	BLO.S	RES90
	JSR	VERROR
	ASCII	'102 - MEMORY OVERFLOW'
	DC.B	0
RES90	RTS

;-----------------------------------------------------------------------
;4
;Swap bytes in a word.
; The swapped bytes of the argument are returned in D0.
; I:= SWAP($3412)
;
SWAP	MOVE.L	(A5),D0
	ROL.W	#8,D0
	RTS

;-----------------------------------------------------------------------
;5
;Extend the sign bit of a byte to 32 bits (a long word).
; The sign-extended argument is returned in D0.
; I:= EXTEND($80)
;
EXTEND	MOVE.B	3(A5),D0
	EXT.W	D0
	EXT.L	D0
	RTS

;-----------------------------------------------------------------------
;6
;Restart the current (XPL) program.
; RESTART
;
RESTAR	ST	RERUNF		;Set the RERUN flag
	CLR.L	ERRLOC		;Indicate no errors
	MOVEA.L	STACK,SP	;Set the stack pointer
	MOVEA.L	HEAP,A5		;Set the heap pointer
	JSR	VRSTRT		;Call the current program
	JSR	VSHOERR		;Display any errors
	JMP	VEXIT		;Take the program's exit vector

;-----------------------------------------------------------------------
;7
;Return a byte from input device DEV in D0.
; BYTE:= CHIN(DEV);
;
CHIN	MOVE.B	3(A5),DEVICE	;Get the device number
	BRA	BYTEIN		;(PBRA) returns with byte in D0

;-----------------------------------------------------------------------
;8
;Send a byte to device DEV.
; CHOUT(DEV,BYTE);
; A6 and D0 are destroyed.
;
CHOUT	MOVE.B	3(A5),DEVICE	;Get the device number
	MOVE.B	7(A5),D0	;Get the character
	MOVEA.W	#12,A6		;Set the function code = CHOUT
	JMP	VDEVHAN		;(PJMP) output D0

;-----------------------------------------------------------------------
;9
;Send a "new line" command to DEV
; CRLF(DEV)
; A6 and D0 are destroyed.
;
CRLF	MOVE.B	3(A5),DEVICE	;Get the device number
	MOVEQ	#CR,D0		;CR = new line (LF is not used)
	MOVEA.W	#12,A6		;Set the function code = CHOUT
	JMP	VDEVHAN		;(PJMP) do I/O

;-----------------------------------------------------------------------
;10
;Get a signed, decimal ASCII string from device DEV, convert it to a
; binary long word, and return it in D0.
; I:= INTIN(DEV)
;
INTIN	MOVE.B	3(A5),DEVICE	;Get the device number
	BRA	INTI		;(PBRA) return the integer in D0

;-----------------------------------------------------------------------
;11
;Convert a 32-bit integer to a signed, decimal ASCII string and send it
; out to device DEV.
; INTOUT(DEV,I)
; D0 is destroyed.
;
INTOUT	MOVE.B	3(A5),DEVICE	;Get the device number
	MOVE.L	4(A5),D0	;Get the integer
	BRA	INTO		;(PBRA) output the integer

;-----------------------------------------------------------------------
;12
;Output the ASCII string at address ADDR to I/O device DEV.
; TEXT(DEV,ADDR)
; A6 is destroyed.
;
TEXT	MOVE.B	3(A5),DEVICE	;Get the device number
	MOVEA.L	4(A5),A6	;Get the address
	BRA	TEXTO		;(PBRA) output the string

;-----------------------------------------------------------------------
;13
;Open (initialize) a device for input.
; OPENI(DEV)
; A6 is destroyed.
;
OPENI	MOVE.B	3(A5),DEVICE	;Get the device number
	MOVEA.W	#0,A6		;Set the function code = OPENI
	JMP	VDEVHAN		;(PJMP) do I/O

;-----------------------------------------------------------------------
;14
;Open (initialize) a device for output.
; OPENO(DEV)
; A6 is destroyed.
;
OPENO	MOVE.B	3(A5),DEVICE	;Get the device number
	MOVEA.W	#4,A6		;Set the function code = OPENO
	JMP	VDEVHAN		;(PJMP) do I/O

;-----------------------------------------------------------------------
;15
;Close an output device (flushes buffers, etc.)
; CLOSE(DEV)
; A6 is destroyed.
;
CLOSE	MOVE.B	3(A5),DEVICE	;Get the device number
	MOVEA.W	#16,A6		;Set the function code = CLOSE
	JMP	VDEVHAN		;(PJMP) do I/O

;-----------------------------------------------------------------------
;16
;Abort the XPL program (same as a CTRL-P exit)
; ABORT
;
ABORT	JMP	VABORT

;-----------------------------------------------------------------------
;17
;Turn system error trapping on or off as indicated.
; TRAP('FALSE')
;
TRAP	MOVE.B	#FALSE,ERRTRAP	;Assume it is false (=0)
	TST.L	(A5)
	BEQ.S	TR90
	ST	ERRTRAP		;Set it true if any bit was set
TR90	RTS

;-----------------------------------------------------------------------
;18
;Return the amount of free space left in the heap and the stack.
; WARNING: It is assumed here that the stack and the heap are set up
; such that they grow toward each other.
; I := FREE
;
FREE	MOVE.L	SP,D0		;RETURN (SP - A5)
	SUB.L	A5,D0
	RTS

;-----------------------------------------------------------------------
;19
;Return the rerun flag
; FLAG := RERUN
;
RERUN	MOVE.B	RERUNF,D0
	EXT.W	D0
	EXT.L	D0
	RTS

;-----------------------------------------------------------------------
;20
;Return the heap pointer
; ADDR := GETHP
;
GETHP	MOVE.L	A5,D0
	RTS

;-----------------------------------------------------------------------
;21
;Set the heap pointer.
; SETHP($2000)
; (The user had better have a good idea of the functioning of XPL before
; dinging with the heap pointer or he will surely bomb himself!)
; A6 is destroyed.
;
SETHP	MOVEA.L	(A5),A5
	RTS

;-----------------------------------------------------------------------
;22
;Return 'TRUE' if an error has been detected. (Traps must be turned off
; using intrinsic 17 for this to occur.)
; I:= GETERR;
;
GETERR	MOVEQ	#FALSE,D0	;Assume no error
	TST.L	ERRLOC		;ERRLOC = 0 if no error is detected
	BEQ.S	GE10
	MOVEQ	#TRUE,D0
GE10	CLR.L	ERRLOC		;Clear any possible error
	RTS

;-----------------------------------------------------------------------
;23
;Move cursor of device 0 to column X, line Y. Upper left corner is
;  X,Y = 0,0.
; CURSOR(X,Y)
; A6 is destroyed.
;
CURSOR	MOVE.B	#0,DEVICE	;Set to device number 0

	MOVE.B	3(A5),D0	;Get X position
	ROL.W	#8,D0		;Put it into high byte of D0
	MOVE.B	7(A5),D0	;Get Y position into low byte

	MOVEA.W	#28,A6		;Set function code = "position cursor"
	JMP	VDEVHAN		;(PJMP) do I/O

;-----------------------------------------------------------------------
;24
;Scan the directory for a file name and return its start and end blocks
; SCAN(UNIT, INFO, NAME)
;	UNIT - unit number (0-7)
;	INFO - the address of a 2-integer array where the starting and
;		ending blocks are returned
;	NAME - the address of a 12-byte file name
;		(note: the 11th byte cannot have its MSB set)
;
SCAN	MOVE.B	3(A5),UNIT	;Get the unit argument
	MOVEA.L	8(A5),A6	;Point A6 to the file name
	JSR	VFSCAN		;Scan for the name (heap is not used)

	MOVEA.L	4(A5),A6	;Get the address of the info array
	MOVE.L	BLKNO,(A6)	;Put the start and end blocks into it
	MOVE.L	ENDBLK,4(A6)
	RTS

;-----------------------------------------------------------------------
;25
;Set the RERUN flag
; SETRUN('TRUE')
;
SETRUN	MOVE.B	#FALSE,RERUNF	;Assume it is false (=0)
	TST.L	(A5)
	BEQ.S	SR90
	ST	RERUNF		;Set it true if any bit was set
SR90	RTS

;-----------------------------------------------------------------------
;26
;Get a hex ASCII string from device DEV, convert it to a binary word,
; and return it in D0.
; I:= HEXIN(DEV)
;
HEXIN	MOVE.B	3(A5),DEVICE	;Get the device number
	BRA	HEXI		;(PBRA) get the hex integer in D0

;-----------------------------------------------------------------------
;27
;Convert a 32-bit integer to an unsigned, hex ASCII string and send it
; out to device DEV.
; HEXOUT(DEV,I)
;
HEXOUT	MOVE.B	3(A5),DEVICE	;Get the device number
	MOVE.L	4(A5),D0	;Get the integer
	BRA	HEXO		;(PBRA) output the hex integer

;-----------------------------------------------------------------------
;28
;Run a .SAV file
; CHAIN(UNIT, BLKNO)
;
CHAIN	MOVE.B	3(A5),UNIT	;Get the arguments
	MOVE.L	4(A5),BLKNO
	JMP	VFRUN		;Go run it (never returns)

;-----------------------------------------------------------------------
;29
;Open a disk file for input
; OPENF(UNIT, INFO);
;	UNIT - unit number (0-7)
;	INFO - the address of a 2-integer array containing the starting
;		and ending blocks (usually gotten from SCAN)
;
OPENF	MOVE.B	3(A5),INUNT	;Set the input unit

	MOVEA.L	4(A5),A6	;Get the address of the array
	MOVE.L	(A6),INLBLK	;Set the starting block number
	MOVE.L	4(A6),INHBLK	;Set the ending block number
	MOVE.B	#1,INFLG	;1 = SETUP

	MOVE.B	#3,DEVICE	;Open the disk file for input
	MOVEA.W	#0,A6		;Set the function code = OPENI
	JMP	VDEVHAN		;(PJMP) do I/O

;-----------------------------------------------------------------------
;30
;Write the memory at BUFFER to UNIT for SIZE many BLOCKS
; WRITE(UNIT, BLOCK, BUFFER, SIZE)
;
WRITE	MOVE.B	3(A5),UNIT	;Get the arguments
	MOVE.L	4(A5),BLKNO
	MOVE.L	8(A5),FADDR
	MOVE.L	12(A5),NBLKS
	MOVEA.W	#12,A6		;Set "write" function code
	JMP	VUNTHAN		;(PJMP) perform the unit function code

;-----------------------------------------------------------------------
;31
;Read into the memory at BUFFER FROM UNIT for SIZE many BLOCKS
; READ(UNIT, BLOCK, BUFFER, SIZE)
;
READ	MOVE.B	3(A5),UNIT	;Get the arguments
	MOVE.L	4(A5),BLKNO
	MOVE.L	8(A5),FADDR
	MOVE.L	12(A5),NBLKS
	MOVEA.W	#8,A6		;Set "read" function code
	JMP	VUNTHAN		;(PJMP) perform the unit function code

;-----------------------------------------------------------------------
;32
;COLOR:=TESTPT(X, Y)
TESTPT	RTS

;-----------------------------------------------------------------------
;33
;Load a memory image and enter the monitor
; FGET(UNIT,BLKNO)
;
FGET	MOVE.B	3(A5),UNIT	;Get arguments
	MOVE.L	4(A5),BLKNO
	JMP	VFGET		;(Never returns)

;-----------------------------------------------------------------------
;35
;Write a memory image for a .SAV file
; FSAVE(UNIT,BLKNO)
;
FSAVE	MOVE.B	3(A5),UNIT	;Get arguments
	MOVE.L	4(A5),BLKNO
	JMP	VFSAVE		;(Never returns)

;-----------------------------------------------------------------------
;36
;Routine to quickly move a block of memory.
; Move SIZE many bytes from FROM to TO
; BLIT(FROM, TO, SIZE)
; (Don't use the blitter because it only works with chip memory.)
;
BLIT	MOVEM.L	D1/A0,-(SP)	;Save register(s)
				;Get arguments:
	MOVEA.L	(A5),A0		; FROM
	MOVEA.L	4(A5),A6	; TO
	MOVE.L	8(A5),D0	; SIZE
	MOVE.L	D0,D1		;Put the high 16 bits of SIZE into
	SWAP	D1		; a second counter, D1

	CMPA.L	A0,A6		;If TO > FROM (i.e: moving forward in
	BEQ.S	BLIT90		; memory) then don't branch
	BLO.S	BLIT20		;Enter loop checking for SIZE = 0

	ADDA.L	D0,A6		;Move starting at the end of the block
	ADDA.L	D0,A0		;Add SIZE to TO and FROM
	BRA.S	BLIT40		;Enter loop checking for SIZE = 0

BLIT10	MOVE.B	(A0)+,(A6)+	;Move block backward, pointers forward
BLIT20	DBF	D0,BLIT10	;Loop until D0 = -1
	DBF	D1,BLIT10	; and also D1 = -1
	BRA.S	BLIT90		;Exit

BLIT30	MOVE.B	-(A0),-(A6)	;Move block forward, pointers backward
BLIT40	DBF	D0,BLIT30	;Loop until D0 = -1
	DBF	D1,BLIT30	; and also D1 = -1

BLIT90	MOVEM.L	(SP)+,D1/A0	;Restore register(s)
	RTS

;----------------------------------------------------------------------
;37
;Return "true" if specified mouse button is pressed
; BOOLEAN:=BUTTON(NUMBER)
;
CIAA	EQU	$BFE001

BUTTON	MOVE.W	2(A5),D0	;0 = Port 1, left button
	BNE.S	BUT10
	BTST	#6,CIAA.L
	BEQ.S	BTRUE
	BRA.S	BFALSE
BUT10
	CMPI.W	#1,D0		;1 = Port 1, right button
	BNE.S	BUT20
	NOP			;NOT IMPLEMENTED
	BRA.S	BFALSE
BUT20
	CMPI.W	#2,D0		;2 = Port 2, left button
	BNE.S	BUT30
	BTST	#7,CIAA.L
	BEQ.S	BTRUE
	BRA.S	BFALSE
BUT30
	CMPI.W	#3,D0		;3 = Port 2, right button
	BNE.S	BFALSE
	NOP			;NOT IMPLEMENTED

BFALSE	MOVEQ	#FALSE,D0	;Return "false"
	RTS

BTRUE	MOVEQ	#TRUE,D0	;Return "true"
	RTS

;----------------------------------------------------------------------
;38
;Returns "true" if specified joystick direction (DIR) is pressed
; if JOYSTICK(DIR) then ...
;
;	    LEFT PORT		   RIGHT PORT
;
;		2			6
;		|			|
;	   3 ---+--- 1		   7 ---+--- 5
;		|			|
;		0			4
;
JOY0DAT	EQU	$DFF00A		;Chip register addresses
JOY1DAT	EQU	$DFF00C

JOYSTICK
	MOVEM.W	D1/D2,-(SP)	;Save registers

	MOVE.W	2(A5),D0	;Get specified direction, DIR
	MOVE.W	JOY1DAT.L,D1	;Assume right port
	BTST	#2,D0
	BNE.S	JOY05
	MOVE.W	JOY0DAT.L,D1	;Use left port
JOY05
	BTST	#0,D0		;if DIR & 1 then...
	BEQ.S	JOY20

	BTST	#1,D0		;if DIR & 2 then
	BEQ.S	JOY10
	BTST	#9,D1		; return (DATA & $0200) # 0       \3 <--
	BRA.S	JOY90
JOY10
	BTST	#1,D1		; else return (DATA & $0002) # 0   \1 -->
	BRA.S	JOY90
JOY20
	MOVE.W	D1,D2		;DATA:= DATA>>1 | DATA;
	LSR.W	#1,D2
	EOR.W	D2,D1

	BTST	#1,D0		;if DIR & 2 then
	BEQ.S	JOY30
	BTST	#8,D1		; return (DATA & $0100) # 0   \2 Forward
	BRA.S	JOY90
JOY30
	BTST	#0,D1		; else return (DATA & $0001) # 0 \0 Back

JOY90	MOVEM.W	(SP)+,D1/D2	;Restore regs without changing status
	BNE.S	JTRUE
	MOVEQ	#FALSE,D0	;Return "false"
	RTS

JTRUE	MOVEQ	#TRUE,D0	;Return "true"
	RTS

;-----------------------------------------------------------------------
;39
;SOUND(VOLUME, CYCLES, PERIOD);
SOUND	RTS

;-----------------------------------------------------------------------
;40
;Clear the current graphics bit map.
;
CLEAR	BRA	DOCLEAR		;(PBRA)

;-----------------------------------------------------------------------
;41
;Plot a point at X,Y on the current bit map. "COLOR" selects a color
; register. It also specifys complement and "fast" modes.
; POINT(X, Y, COLOR)
;
POINT	MOVE.L	(A5),D0
	BSR	REMAPX
	MOVE.L	D0,X0

	MOVE.L	4(A5),D0
	BSR	REMAPY
	MOVE.L	D0,Y0

	MOVE.L	8(A5),COLOR
	BRA	DOPOINT		;(PBRA) Plot a point at X0,Y0

;-----------------------------------------------------------------------
;42
;Draw a straight line from X0,Y0 to X,Y on the current bit map. "COLOR"
; selects a color register, modes, and 16 bits of texture. The texture
; is complemented, for example, 16 zero bits gives a solid line.
; LINE(X, Y, COLOR)
;
LINE	MOVE.L	(A5),D0
	BSR	REMAPX
	MOVE.L	D0,X1

	MOVE.L	4(A5),D0
	BSR	REMAPY
	MOVE.L	D0,Y1

	MOVE.L	8(A5),COLOR
	BSR	DOLINE		;Draw line from X0,Y0 to X1,Y1

	MOVE.L	X1,X0		;Resume where we left off
	MOVE.L	Y1,Y0
	RTS

;-----------------------------------------------------------------------
;43
;Move to the start of a line.
; MOVE(X, Y)
;
MOVE	MOVE.L	(A5),D0
	BSR	REMAPX
	MOVE.L	D0,X0

	MOVE.L	4(A5),D0
	BSR	REMAPY
	MOVE.L	D0,Y0
	RTS

;======================================================================
;FLOATING POINT ROUTINES:
;-----------------------------------------------------------------------
;46
;Reserve heap space for a real array
; A5:= A5 + ARG *RLSIZE
; ADDR:= RLRES(REALS)
; The starting (low) address of the reserved space in returned in FP0.
;WARNING: This assumes that the heap and the stack are arranged so that
; they grow toward each other. This also assumes 8 bytes in a real.
;
RLRES	MOVE.L	A5,D0		;Return the base address in FP0
	DC.W	$F200, $4000	;FMOVE.L D0,FP0   (FLOAT)
	MOVE.L	(A5),D0		;Get the number of reals to reserve
	LSL.L	#3,D0		;Times 8 to get the number of bytes
	ADDA.L	D0,A5		;Add the argument number of bytes
				; to the heap pointer (A5)
	CMPA.L	SP,A5		;Check for memory overflow
	BLO.S	RRES90
	JSR	VERROR
	ASCII	'103 - MEMORY OVERFLOW'
	DC.B	0
RRES90	RTS

;-----------------------------------------------------------------------
;47
; X:= RLIN(DEV);
;
RLIN	BRA	BADINT

;-----------------------------------------------------------------------
;48
; RLOUT(DEV,X);
;
RLOUT	BRA	BADINT

;-----------------------------------------------------------------------
;49
;X:= FLOAT(I);
;(FMOVE.L -8(SP),FP0 is not implemented in FPP.68K)
;
FLOAT	MOVE.L	(A5),D0
	DC.W	$F200, $4000	;FMOVE.L D0,FP0
	RTS

;-----------------------------------------------------------------------
;50
;I:= FIX(X);
;
FIX	DC.W	$F215, $5400	;FMOVE.D (A5),FP0
	DC.W	$F200, $6000	;FMOVE.L FP0,D0
	RTS

;-----------------------------------------------------------------------
;51
;X:= RLABS(X);
;
RLABS	DC.W	$F215, $5400	;FMOVE.D (A5),FP0
	DC.W	$F200, $0018	;FABS.X FP0
	RTS

;-----------------------------------------------------------------------
;52
;FORMAT(M,N);
;
FORMAT	BRA	BADINT

;-----------------------------------------------------------------------
;53
;X:= SQRT(X);
;(FSQRT.D (A5),FP0 et cetra are not implemented in FPP.68K)
;
SQRT	DC.W	$F215, $5400	;FMOVE.D (A5),FP0
	DC.W	$F200, $0004	;FSQRT.X FP0
	RTS

;-----------------------------------------------------------------------
;54
;X:= LN(X);
;
LN	DC.W	$F215, $5400	;FMOVE.D (A5),FP0
	DC.W	$F200, $0014	;FLOGN.X FP0
	RTS

;-----------------------------------------------------------------------
;55
;X:= EXP(X);
;
EXP	DC.W	$F215, $5400	;FMOVE.D (A5),FP0
	DC.W	$F200, $0010	;FETOX.X FP0
	RTS

;-----------------------------------------------------------------------
;56
;X:= SIN(X);
;
SIN	DC.W	$F215, $5400	;FMOVE.D (A5),FP0
	DC.W	$F200, $000E	;FSIN.X FP0
	RTS

;-----------------------------------------------------------------------
;57
;X:= ATAN2(Y,X);
;
ATAN2	BRA	BADINT

;-----------------------------------------------------------------------
;58
;X:= MOD(A,B);
;
MOD	BRA	BADINT

;-----------------------------------------------------------------------
;59
;X:= LOG(X);
;
LOG	DC.W	$F215, $5400	;FMOVE.D (A5),FP0
	DC.W	$F200, $0015	;FLOG10.X FP0
	RTS

;-----------------------------------------------------------------------
;60
;X:= COS(X);
;
COS	DC.W	$F215, $5400	;FMOVE.D (A5),FP0
	DC.W	$F200, $001D	;FCOS.X FP0
	RTS

;-----------------------------------------------------------------------
;61
;X:= TAN(X);
;
TAN	DC.W	$F215, $5400	;FMOVE.D (A5),FP0
	DC.W	$F200, $000F	;FTAN.X FP0
	RTS

;-----------------------------------------------------------------------
;62
;X:= ASIN(X);
;
ASIN	DC.W	$F215, $5400	;FMOVE.D (A5),FP0
	DC.W	$F200, $000C	;FACOS.X FP0
	RTS

;-----------------------------------------------------------------------
;63
;X:= ACOS(X);
;
ACOS	DC.W	$F215, $5400	;FMOVE.D (A5),FP0
	DC.W	$F200, $001C	;FACOS.X FP0
	RTS

;-----------------------------------------------------------------------
;64
;Set the backup flag, so the next CHIN will reread the same byte.
; BACKUP
;
BACKUP	ST	BACKFL		;Set on condition true, i.e. always
	RTS

;======================================================================
;65
; HICHAR(X, Y, MODE, ROT, CHAR)
;
HICHAR	RTS

;-----------------------------------------------------------------------
;66
;Return the value of the byte in the Apple at the given address
; BYTE:=PEEK(ADDRESS)
;
PEEK	RTS

;-----------------------------------------------------------------------
;67
;Store the byte at the given address.
; POKE(ADDR,BYTE)
;
POKE	RTS

;----------------------------------------------------------------------
;108
;Define the bit map location and dimensions for POINT, LINE and CLEAR.
; (Note that this bit map might not be displayed immediately.)
; BITMAP(ADDR, WIDTH, HEIGHT, DEPTH)
;   ADDR is the memory location of bit map.
;     Use: RESERVE(WIDTH /8 *HEIGHT *DEPTH)
;   WIDTH should be either 320, 640, or a larger value up to 1024. It
;     must always be evenly divisible by 16, because of CLEAR.
;   HEIGHT should be in the range 200 through 1024.
;   DEPTH should be in the range 1 through 6.
; WIDTH and HEIGHT should always be equal to or greater than the
; displayed view.
;
BITMAP	MOVE.L	(A5),RASTER
	MOVE.L	4(A5),WIDTH
	MOVE.L	8(A5),HEIGHT
	MOVE.L	12(A5),DEPTH

;	ANDI.W	#$03FF,D0	; after shifting right 4 bits
;	BEQ.S	CLR10		;Branch if ok
;	JSR	VERROR
;	ASCII	"106 - BAD RASTER DIMENSIONS"
;	DC.B	0
;	BRA.S	CLR60		;Give it our best shot
;CLR10

	RTS

;----------------------------------------------------------------------
;109
;Define the scale factors and offsets for coordinates used by POINT,
; LINE and CLEAR.
; BITMAP2(MAGX, MAGY, OFFSETX, OFFSETY, INVERTX, INVERTY)
;
BITMAP2	MOVE.L	(A5),MAGX
	MOVE.L	4(A5),MAGY
	MOVE.L	8(A5),OFFSETX
	MOVE.L	12(A5),OFFSETY
	MOVE.L	16(A5),INVERTX
	MOVE.L	20(A5),INVERTY
	RTS

;----------------------------------------------------------------------
;110
; VIEW(ADDR, BPLCON0)
VIEW	BRA	DOVIEW		;(PBRA)

;----------------------------------------------------------------------
;111
; PALETTE(N, VAL)
PALETTE	BRA	DOPALET		;(PBRA)

;----------------------------------------------------------------------
;112
;Return the value of the extend (X) flag. This flag, effectively the
; carry flag, is used for extended-precision arithmetic.
; VAL:= CARRY(0)
;
CARRY	MOVEQ	#0,D0		;Clear high bytes
	ADDX.B	D0,D0		;Add the extend (carry) value (0 or 1)
	RTS

;----------------------------------------------------------------------
;113
;Return the value of the word at the given address.
; WORD:= PEEK_W(ADDR)
;
PEEK_W	MOVEA.L	(A5),A6		;Get the address
	MOVEQ	#0,D0		;Clear high word
	MOVE.W	(A6),D0		;Return the word in D0
	RTS

;----------------------------------------------------------------------
;114
;Store the word at the given address.
; POKE_W(ADDR,WORD)
;
POKE_W	MOVEA.L	(A5),A6		;Get the address
	MOVE.W	6(A5),(A6)	;Store the word
	RTS

;----------------------------------------------------------------------
;115
;Return the value of the long at the given address.
; LONG:= PEEK_L(ADDR)
;
PEEK_L	MOVEA.L	(A5),A6		;Get the address
	MOVE.L	(A6),D0		;Return the long in D0
	RTS

;----------------------------------------------------------------------
;116
;Store the long word at the given address.
; POKE_L(ADDR,LONG)
;
POKE_L	MOVEA.L	(A5),A6		;Get the address
	MOVE.L	4(A5),(A6)	;Store the long
	RTS

;----------------------------------------------------------------------
;117
;Swap the high and low words in the value and return it.
; VAL:= SWAP_W(VAL)
;
SWAP_W	MOVE.L	(A5),D0		;Get the value
	SWAP	D0
	RTS

;----------------------------------------------------------------------
;118
;Sign-extend the 16-bit value and return it.
; VAL:= EXT_L(VAL)
;
EXT_L	MOVE.W	2(A5),D0
	EXT.L	D0
	RTS

;----------------------------------------------------------------------
;119
;Move cursor on the second terminal (device #1) to column X, line Y.
; Upper left corner is X,Y = 0,0.
; CURSOR1(X,Y)
; A6 is destroyed.
;
CURSOR1	MOVE.B	#1,DEVICE	;Set to device number 1

	MOVE.B	3(A5),D0	;Get X position
	ROL.W	#8,D0		;Put it into high byte of D0
	MOVE.B	7(A5),D0	;Get Y position into low byte

	MOVEA.W	#28,A6		;Set function code = "position cursor"
	JMP	VDEVHAN		;(PJMP) do I/O

;-----------------------------------------------------------------------
;120
;Set the display attributes for the second terminal (device #1)
; BUTES1($1);
;The bits in the argument set the attributes as follows:
;	0 - bold (not dim)
;	1 - underline
;	2 - inverse video
;	3 - flashing
;
;WARNING: The Wyse terminal is severely brain-damaged, and it insists on
; inserting a space character whenever attributes are changed.
;
BUTES1	MOVE.L	(A5),D0		;Get argument
	MOVE.B	#1,DEVICE	;Set to device # 1
	MOVEA.W	#48,A6		;Set function code for "butes"
	JMP	VDEVHAN		;(PJMP) go do it

;-----------------------------------------------------------------------
;121
;Turn the cursor indicator on or off for the second terminal (device #1)
; SHOCUR1('TRUE');
;
SHOCUR1	MOVE.L	(A5),D0		;Get boolean argument
	MOVE.B	#1,DEVICE	;Set to device # 1
	MOVEA.W	#44,A6		;Set function code for cursor control
	JMP	VDEVHAN		;(PJMP) go do it

;-----------------------------------------------------------------------
;122
;Return the address of the information array for a device
; ADDR:= DEVINFO(DEV)
;
DEVINFO	MOVE.B	3(A5),DEVICE	;Get the device number
	MOVEA.W	#20,A6		;Set function code for "getinfo"
	JMP	VDEVHAN		;(PJMP) go do it

;-----------------------------------------------------------------------
;123
;Return the address of the information array for a unit
; ADDR:= UNTINFO(UNIT)
;
UNTINFO	MOVE.B	3(A5),UNIT	;Get the unit number
	MOVEA.W	#20,A6		;Set function code for "getinfo"
	JMP	VUNTHAN		;(PJMP) go do it

;-----------------------------------------------------------------------
;124
;Set the display attributes for device 0
; BUTES($1);
;The bits in the argument set the attributes as follows:
;	0 - bold (not dim)
;	1 - underline
;	2 - inverse video
;	3 - flashing
;
;WARNING: The Wyse terminal is severely brain-damaged, and it insists on
; inserting a space character whenever attributes are changed.
;
BUTES	MOVE.L	(A5),D0		;Get argument
	MOVE.B	#0,DEVICE	;Set to device # 0
	MOVEA.W	#48,A6		;Set function code for "butes"
	JMP	VDEVHAN		;(PJMP) go do it

;-----------------------------------------------------------------------
;125
;Wait for and then return the value of a key struck on
; the keyboard
; I:= GETKEY;
;
GETKEY	MOVE.B	#1,DEVICE	;Set to device # 1
	MOVEA.W	#36,A6		;Set function code for "getkey"
	JMP	VDEVHAN		;(PJMP) return with value in D0

;-----------------------------------------------------------------------
;126
;Determine if a key (on the keyboard) has been struck
; I:= KEYHIT;
;
KEYHIT	MOVE.B	#1,DEVICE	;Set to device # 1
	MOVEA.W	#40,A6		;Set function code
	JMP	VDEVHAN		;(PJMP) return with boolean in D0

;-----------------------------------------------------------------------
;127
;Turn the cursor indicator on or off for device 0
; SHOCUR('TRUE');
;
SHOCUR	MOVE.L	(A5),D0		;Get boolean argument
	MOVE.B	#0,DEVICE	;Set to device # 0
	MOVEA.W	#44,A6		;Set function code for cursor control
	JMP	VDEVHAN		;(PJMP) go do it

;=======================================================================
;SUBROUTINES:
;-----------------------------------------------------------------------
;Input ASCII digits and convert them to a signed, decimal, 32-bit value
; which is returned in D0.
;	D0 = I/O
;	D1 = Working register (contains number to be converted)
;	D2 = Flag: a numeric character has been entered
;	D3 = 10 multiplier
;	D4 = Flag: a minus sign was entered, i.e. the number is negative
;
INTI	MOVEM.L	D1-D4,-(SP)	;Save registers

II00	MOVEQ	#0,D1		;NUM:=0;
	CLR.B	D2		;NUMFLG:=false
	CLR.B	D4		;SIGN:=false
	MOVEQ	#10,D3

	BSR	BYTEIN		;Get byte
	CMPI.B	#'-',D0		;if D0 = ^- then SIGN := true
	BNE.S	II30
	MOVEQ	#TRUE,D4
;				;loop begin
II20	BSR	BYTEIN		;Get byte
II30	CMPI.B	#'0',D0		;  if D0<^0 ! D0>^9 then quit
	BLO.S	II50
	CMPI.B	#'9',D0
	BHI.S	II50
	MOVEQ	#TRUE,D2	;  NUMFLG:=true

	MOVE.L	D1,D3		;  NUM:= NUM*10 + (D0-^0)
	LSL.L	#2,D1		;    *4
	ADD.L	D3,D1		;    +1
	LSL.L	#1,D1		;    *2
	SUBI.B	#'0',D0
	ADD.L	D0,D1
	BRA.S	II20		;  end

II50	TST.B	D2		;if NUMFLG then quit
	BEQ.S	II00
	TST.B	D4		;if SIGN then NUM:= -NUM
	BEQ.S	II60
	NEG.L	D1
II60	MOVE.L	D1,D0		;return NUM

	MOVEM.L	(SP)+,D1-D4	;Restore registers
	RTS

;-----------------------------------------------------------------------
;Convert the signed, 32-bit value in D0 to decimal ASCII and output the
; characters to DEVICE.
;	D0 = I/O and subtract counter
;	D1 = Working register (contains number to be converted)
;	D2 = Flag used to suppress leading zeros (suppress if false)
;	D3 = Power-of-ten (loop) counter
;	D4 = Power of ten
;	A0 = Pointer to power-of-ten table
;
INTO	MOVEM.L	D0-D4/A0/A6,-(SP)	;Save registers
	MOVEA.W	#12,A6		;Set the function code = CHOUT

	MOVE.L	D0,D1		;Put number into the working register
	BPL.S	INTO10		;Branch if it is positive
	NEG.L	D1		;Otherwise make it positive
	MOVEQ	#'-',D0		;Output the minus sign
	JSR	VDEVHAN		;Output D0

				;Initialize:
INTO10	MOVEQ	#FALSE,D2	; flag used to suppress leading zeros
	MOVEQ	#8,D3		; loop counter (8 down through 0)
	LEA	TENTBL-@-2(PC),A0 ; pointer to power-of-ten table

INTO20	MOVE.L	(A0)+,D4	;Get a power of ten
	MOVEQ	#9,D0		;Init loop counter (9-0)
INTO30	SUB.L	D4,D1		;Repeatedly subtract a power of ten
	DBMI	D0,INTO30	; until it goes negative
	ADD.L	D4,D1		;Restore to positive value

	NEG.B	D0		;This digit = 9 - D0
	ADD.B	#9,D0
	BNE.S	INTO40		;Branch if digit is not zero
	TST.B	D2		;Are we suppressing leading zeros?
	BEQ.S	INTO50		;Branch if we are (i.e. flag = false)
INTO40	MOVEQ	#TRUE,D2	;Turn leading zero suppression off
	ADD.B	#'0',D0		;Convert digit to ASCII
	JSR	VDEVHAN		;Output it
INTO50	DBF	D3,INTO20	;Repeat for powers 1,000,000,000 down
				; thru 10;
	MOVE.B	D1,D0		;Output the one's digit regardless of
	ADD.B	#'0',D0		; the leading zero suppression flag
	JSR	VDEVHAN

	MOVEM.L	(SP)+,D0-D4/A0/A6	;Restore registers
	RTS

;Power-of-ten table:
TENTBL	DC.L	1000000000	;1G
	DC.L	100000000
	DC.L	10000000
	DC.L	1000000		;1M
	DC.L	100000
	DC.L	10000
	DC.L	1000		;1K
	DC.L	100
	DC.L	10

;-----------------------------------------------------------------------
;Output a text string pointed to by A6.
; The string is terminated with a binary zero.
;
TEXTO	MOVEM.L	A0/A6,-(SP)	;Save registers
	MOVEA.L	A6,A0		;Get string address

	MOVEA.W	#12,A6		;Set the function code to CHOUT
	BRA.S	TXT20		;Enter loop

TXT10	JSR	VDEVHAN		;Output D0
TXT20	MOVE.B	(A0)+,D0	;Get char from string
	BNE.S	TXT10		;Loop until zero byte

	MOVEM.L	(SP)+,A0/A6	;Restore registers
	RTS

;-----------------------------------------------------------------------
;Input hex ASCII digits from DEVICE and convert them to a 32-bit value
; which is returned in D0.
;	D0 = Digit
;	D1 = Accumulated value
;	D2 = Digit counter
;
HEXI	MOVEM.L	D1-D2,-(SP)	;Save registers
	MOVEQ	#0,D1		;Clear result register
	MOVEQ	#7,D2		;Init digit counter (7 down through 0)

HEXI00	BSR	BYTEIN		;Get byte
	CMPI.B	#'0',D0		;Is character in range 0 thru 9?
	BLO.S	HEXI40		;Branch if not
	CMPI.B	#'9',D0
	BHI.S	HEXI20		;(May be A-F)
	SUBI.B	#'0',D0		;Convert ASCII to binary value
	BRA.S	HEXI30		;Go combine with other digits

HEXI20	ANDI.B	#$DF,D0		;Force to uppercase
	CMPI.B	#'A',D0		;Is character in range A thru F?
	BLO.S	HEXI40		;Branch if not
	CMPI.B	#'F',D0
	BHI.S	HEXI40
	SUBI.B	#'A'-10,D0	;Convert ASCII to binary value

HEXI30	ASL.L	#4,D1		;Multiply current value by 16
	ADD.B	D0,D1		;Add new digit
	DBF	D2,HEXI00	;Exit if we have 8 digits

HEXI40	CMPI.B	#7,D2		;Did we find a valid hex digit?
	BEQ.S	HEXI00		;Branch if not -- keep trying

	MOVE.L	D1,D0		;Return the hex value in D0
	MOVEM.L	(SP)+,D1-D2	;Restore registers
	RTS

;-----------------------------------------------------------------------
;Output D0 in ASCII hex (8 digits)
;
HEXO	SWAP	D0		;Get high word
	BSR.S	WRDOUT		;Output it
	SWAP	D0		;(PFALL) get low word back

;-----------------------------------------------------------------------
;Output D0 in ASCII hex (4 digits)
;
WRDOUT	ROR.W	#8,D0		;Move high byte down (and save low byte)
	BSR.S	BYTOUT		;Output it
	ROR.W	#8,D0		;(PFALL) get low byte

;-----------------------------------------------------------------------
;Output D0 in ASCII hex (2 digits)
;
BYTOUT	ROR.B	#4,D0		;Move high nybble down (save low nybble)
	BSR.S	NYBOUT		;Output it
	ROR.B	#4,D0		;(PFALL) get low nybble

;-----------------------------------------------------------------------
;Output D0 in ASCII hex (1 digit)
;
NYBOUT	MOVEM.L	D0/A6,-(SP)	;Save registers
	ANDI.B	#$0F,D0		;Work with low nybble only
	CMPI.B	#10,D0
	BLO.S	NO10
	ADDQ.B	#7,D0
NO10	ADDI.B	#'0',D0		;Convert to ASCII
	MOVEA.W	#12,A6		;Set the function code = CHOUT
	JSR	VDEVHAN		;Output D0
	MOVEM.L	(SP)+,D0/A6	;Restore registers
	RTS

;-----------------------------------------------------------------------
;Input a byte from DEVICE and return it in D0.
;
BYTEIN	TST.B	BACKFL		;Re-read the last character?
	BEQ.S	BYIN20		;Branch if not
	CLR.B	BACKFL		;Clear backup flag
	MOVEQ	#0,D0
	MOVE.B	LASTCH,D0	;Return the last character
	RTS

BYIN20	MOVE.L	A6,-(SP)	;Save A6
	MOVEA.W	#8,A6		;Set the function code = CHIN
	JSR	VDEVHAN		;Do I/O
	MOVE.B	D0,LASTCH	;Save in case we need to re-read it
	MOVEA.L	(SP)+,A6	;Restore A6
	RTS

;======================================================================
;GRAPHICS ROUTINES
;
CHIPREG	EQU	$DFF000		;Base address of chip registers
;Offsets to chip registers:
DMACONR	EQU	$02		;DMA control (and blitter status) read
VPOSR	EQU	$04		;Read vert. MSB and frame flop LOF
INTREQR	EQU	$1E		;Interrupt request bits read
BLTCON0	EQU	$40		;Blitter control register 0
BLTCON1	EQU	$42		;Blitter control register 1
BLTAFWM	EQU	$44		;Blitter first word mask for source A
BLTCPTH	EQU	$48		;Blitter ptr to source C (high 3 bits)
BLTAPTH	EQU	$50		;Blitter ptr to source A (high 3 bits)
BLTAPTL	EQU	$52		;Blitter ptr to source A (low 15 bits)
BLTDPTH	EQU	$54		;Blitter ptr to destn. D (high 3 bits)
BLTSIZE	EQU	$58		;Blitter start and size (width, height)
BLTCMOD	EQU	$60		;Blitter modulo for source C
BLTBMOD	EQU	$62		;Blitter modulo for source B
BLTAMOD	EQU	$64		;Blitter modulo for source A
BLTDMOD	EQU	$66		;Blitter modulo for destn. D
BLTBDAT	EQU	$72		;Blitter source B data register
BLTADAT	EQU	$74		;Blitter source A data register
COP1LCH	EQU	$80		;Copper 1st location reg (high 3 bits)
COP1LCL	EQU	$82		;Copper 1st location reg (low 15 bits)
DIWSTRT	EQU	$8E		;Display window start
DIWSTOP	EQU	$90		;Display window stop
DDFSTRT	EQU	$92		;Display bit plane data fetch start
DDFSTOP	EQU	$94		;Display bit plane data fetch stop
DMACON	EQU	$96		;DMA control write (clear or set)
INTENA	EQU	$9A		;Interrupt enable bits (clear or set)
INTREQ	EQU	$9C		;Interrupt request bits (clear or set)
BPL1PTH	EQU	$E0		;Bit plane 1 pointer (high 3 bits)
BPLCON0	EQU	$100		;Bit plane control register 0
BPLCON1	EQU	$102		;Bit plane control register 1
BPLCON2	EQU	$104		;Bit plane control register 2
BPL1MOD	EQU	$108		;Bit plane modulo (odd planes)
BPL2MOD	EQU	$10A		;Bit plane modulo (even planes)
COLOR00	EQU	$180		;Color register 00
COLOR01	EQU	$182		;Color register 01

;----------------------------------------------------------------------
;107
;Wait for vertical blank on the video screen
;
WAITVB	MOVE.W	#$0020,INTREQ+CHIPREG.L
WVB10	MOVE.W	INTREQR+CHIPREG.L,D0
	BTST	#5,D0
	BEQ.S	WVB10
	RTS

;----------------------------------------------------------------------
;Remap the X coordinate in D0.
;
REMAPX	MOVE.W	D1,-(SP)	;Save D1

	MOVE.W	MAGX+2,D1	;Get the magnification factor
	BEQ.S	RMX20		;Branch if no magnification
	BGE.S	RMX10		;Branch if it's increasing in size
	NEG.W	D1		;It's decreasing in size
	ASR.L	D1,D0
	BRA.S	RMX20
RMX10	ASL.L	D1,D0
RMX20
	ADD.L	OFFSETX,D0	;Add offset

	TST.L	INVERTX		;Is X increasing to the left?
	BEQ.S	RMX30		;Branch if not
	NEG.L	D0		;D0:= WIDTH - D0
	ADD.L	WIDTH,D0
RMX30
	MOVE.W	(SP)+,D1	;Restore D1
	RTS			;Return with remapped value in D0

;----------------------------------------------------------------------
;Remap the Y coordinate in D0.
;
REMAPY	MOVE.W	D1,-(SP)	;Save D1

	MOVE.W	MAGY+2,D1	;Get the magnification factor
	BEQ.S	RMY20		;Branch if no magnification
	BGE.S	RMY10		;Branch if it's increasing in size
	NEG.W	D1		;It's decreasing in size
	ASR.L	D1,D0
	BRA.S	RMY20
RMY10	ASL.L	D1,D0
RMY20
	ADD.L	OFFSETY,D0	;Add offset

	TST.L	INVERTY		;Is Y increasing upward?
	BEQ.S	RMY30		;Branch if not
	NEG.L	D0		;D0:= HEIGHT - D0
	ADD.L	HEIGHT,D0
RMY30
	MOVE.W	(SP)+,D1	;Restore D1
	RTS			;Return with remapped value in D0

;----------------------------------------------------------------------
;This sets up a copper list to display the bit map whos upper-left
; corner is at ADDR. It sets the bit plane control register, BPLCON0,
; directly, and from this the display's width, height, and depth are
; determined. The bit map's WIDTH and HEIGHT are assumed to have been
; set. (These are used to determine modulo and size when DEPTH is
; greater than one.) ADDR should be an even address (RESERVE will
; automatically do this.)
;This routine handles the common displays, however it does not handle
; dual playfields, or horizontal scrolling. These may be accomplished
; by setting the chip registers directly.
;
;   VIEW(ADDR, BPLCON0)
;   BPLCON0 bits:
;	15 HIRES	11 HAM		07 --		03 LPEN
;	14 BPU2		10 DBLPF	06 --		02 LACE
;	13 BPU1		09 COLOR	05 --		01 ERSYNC
;	12 BPU0		08 GAUD		04 --		00 --
;
; Register usage:
;	D0 = BPLCON0 and scratch
;	D1 = Size of each bit plane in bytes
;	D2 = Modulo and depth of bit planes
;	D3 = Display data fetch (DDF) and bit plane pointers (BPLxPT)
;	D4 = View address (ADDR)
;	A0 = Base address of chip registers (CHIPREG)
;	A1 = Copper list pointer
;	A2 = Start of even copper list
;	A3 = Start of odd copper list (if interlaced display)
;
;
DOVIEW	MOVEM.L	D0-D4/A0-A3,-(SP)	;Save registers
	LEA	CHIPREG.L,A0	;Point A0 to base of chip registers

	MOVE.L	(A5),D4		;Get view address (ADDR)
	MOVE.W	6(A5),D0	;Get BPLCON0
	MOVE.W	D0,BPLCON0(A0)	; and set it

	MOVE.W	WIDTH+2,D2	;Set the modulo...
	LSR.W	#3,D2		;Divide by 8 to convert bits to bytes
	MOVE.W	D2,D1		;Save width in bytes for later

	SUB.W	#40,D2		;Anticipate LOWRES mode
	MOVE.L	#$00D00038,D3	;Set LOWRES DDF stop and start positions
	BTST	#15,D0		;Is it HIRES mode?
	BEQ.S	VIEW10		;Branch if not
	SUB.W	#40,D2		;Account for another 40 bytes of width
	MOVE.L	#$00D4003C,D3	;HIRES DDF stop and start positions
VIEW10
	BTST	#2,D0		;Is interlace requested?
	BEQ.S	VIEW20		;Branch if not
	ADD.W	D1,D2		;Skip every other line of bit plane
VIEW20
	MOVE.W	D2,BPL1MOD(A0)	;Set modulo
	MOVE.W	D2,BPL2MOD(A0)	;Set unused modulo to known state

	MOVE.W	D3,DDFSTRT(A0)	;Set display data fetch horz start posn
	SWAP	D3		;Get stop position
	MOVE.W	D3,DDFSTOP(A0)	; and set it

	MOVE.W	#$1781,DIWSTRT(A0) ;Set display window start and stop
	MOVE.W	#$07C1,DIWSTOP(A0) ; horizontal and vertical positions

	MOVEQ	#0,D2		;(Warning: CLR.W does a read cycle)
	MOVE.W	D2,BPLCON1(A0)	;Initialize these unused registers to
	MOVE.W	D2,BPLCON2(A0)	; a known state

	MOVE.W	#$8380,DMACON(A0) ;Make sure bit plane and copper DMA
				; are on
;Set up the copper list:
	MULU	HEIGHT+2,D1	;D1 = size of each bit plane, in bytes

	MOVE.W	D0,D2		;D2 = number of bit planes used (depth)
	ROL.W	#4,D2		;Get BPU bits from BPLCON0
	AND.W	#0007,D2

	LEA	COPLST1,A1	;Point A1 to first copper list area
	BTST	#0,COPFLAG	;Is this list busy?
	BEQ.S	VIEW30		;Branch if not
	LEA	COPLST2,A1	;Point A1 to second copper list area
VIEW30	ADDQ.B	#1,COPFLAG	;Flip busy flag
	MOVEA.L	A1,A2		;Save (even) copper list address
	BSR.S	VIEW100		;Set up copper list

	BTST	#2,D0		;Is display interlaced?
	BEQ.S	VIEW80		;Branch if not

	MOVE.W	#COP1LCL,D0	;Set up call for odd copper list
	SWAP	D0
	MOVE.W	A1,D0		;Get odd copper list address
	ADDQ.W	#8,D0		;Past this and next instructions
	MOVE.L	D0,(A1)+

	MOVEQ	#$FFFFFFFE,D0	;Terminate even copper list with
	MOVE.L	D0,(A1)+	; wait-forever command
	MOVEA.L	A1,A3		;Save address of odd copper list

	MOVE.L	WIDTH,D0	;Point to second (odd) display line
	LSR.L	#3,D0		;Divide by 8 to convert bits to bytes
	ADD.L	D0,D4

	BSR.S	VIEW100		;Set up odd copper list

	MOVE.W	#COP1LCL,D0	;Set up call to even copper list
	SWAP	D0
	MOVE.W	A2,D0		;Get even copper list address
	MOVE.L	D0,(A1)+

	MOVEQ	#$FFFFFFFE,D0	;Terminate with wait-forever command
	MOVE.L	D0,(A1)+

	MOVE.W	VPOSR(A0),D0	;Is current frame long (even)?
	BPL.S	VIEW50		;Branch if not -- branch if odd frame
	EXG	A2,A3		;Current frame is even, next will be odd
VIEW50	MOVE.L	A2,COP1LCH(A0)

	MOVE.W	VPOSR(A0),D1	;Did vertical blank occur during last
	EOR.W	D1,D0		; few instructions (LOF change)?
	BPL.S	VIEW90		;Branch if not
	MOVE.L	A3,COP1LCH(A0)	;Current frame is odd, next will be even
	BRA.S	VIEW90

;Here if non-interlaced display
VIEW80	MOVEQ	#$FFFFFFFE,D0	;Terminate with wait-forever command
	MOVE.L	D0,(A1)+

;This new copper list will be used at the next vertical sync. All copper
; lists must be in the same 64K "page" to prevent a possible big glitch.
	MOVE.L	A2,COP1LCH(A0)

VIEW90	MOVEM.L	(SP)+,D0-D4/A0-A3	;Restore registers
	RTS

;----------------------------------------------------------------------
;Routine to set up a copper list.
;Inputs:
;	D1 = Bit plane size (bytes)
;	D2 = Number of bit planes (depth)
;	D4 = View address (ADDR)
;	A1 = Copper list address pointer
;
;
VIEW100	MOVEM.L	D2/D4,-(SP)	;Save some registers

	MOVE.W	#BPL1PTH,D3	;Set to first bit-plane pointer register
	BRA.S	VIEW130		;Enter loop checking for zero (be safe)

VIEW120	MOVE.W	D3,(A1)+	;Put pointer register into copper list
	ADDQ.W	#2,D3		;Next pointer register
	SWAP	D4		;Get the high word of view address
	MOVE.W	D4,(A1)+	;Put it into copper list
	SWAP	D4

	MOVE.W	D3,(A1)+	;Put pointer register into copper list
	ADDQ.W	#2,D3		;Next pointer register
	MOVE.W	D4,(A1)+	;Put low word of view address into list

	ADD.L	D1,D4		;Add bit-plane size to view address

VIEW130	DBF	D2,VIEW120	;Loop for all bit planes

	MOVEM.L	(SP)+,D2/D4	;Restore some registers
	RTS

;----------------------------------------------------------------------
;Set color register N to value VAL.
; PALETTE(N, VAL)
;
DOPALET	MOVEQ	#0,D0		;Get the color register number
	MOVE.B	3(A5),D0	; (limit to 256 color regs for safety)
	ADD.W	D0,D0		;Double for word entries
	ADD.W	#COLOR00,D0	;Add base address of color registers
	LEA	CHIPREG.L,A6
	MOVE.W	6(A5),0(A6,D0.W) ;Set color register's value
	RTS

;----------------------------------------------------------------------
;Routine to clear the current bit map by setting it to the color
; defined by color register 0. It also moves X0,Y0 to 0,0.
; The blitter uses every other even memory cycle to clear memory. This
; allows the 68000 to run simultaneously. Maximum efficiency is achieved
; if the 68000 doesn't immediately call LINE or POINT since these
; operations will require waiting for the blitter. This will clear a
; 640x480x1 bitmap in approximately 1/75th of a second.
;
;This simply clears the number of words equal to WIDTH/16 *HEIGHT *DEPTH
; The blitter can clear a maximum of 128K bytes per pass.
;
DOCLEAR	MOVEM.L	D0/D1/A0,-(SP)	;Save registers

	LEA	CHIPREG.L,A0	;Set register base (it's efficient)
	MOVE.W	#$8640,DMACON(A0) ;Enable blitter DMA and be nasty

	MOVE.W	WIDTH+2,D1	;No. of words = WIDTH/16 *DEPTH *HEIGHT
	MULU	DEPTH+2,D1	;(This product must not exceed 65535)
	MULU	HEIGHT+2,D1
	LSR.L	#4,D1		;Divide by 16 to get number of words

	BSR	WAITBLT		;Wait for blitter not busy

	MOVE.L	RASTER,BLTDPTH(A0)	;Point to location to be cleared
	MOVEQ	#0,D0			;(Warning: CLR.W does a read)
	MOVE.W	D0,BLTDMOD(A0)		;Modulo = 0
	MOVE.W	#$0100,BLTCON0(A0)	;Use destination D only
	MOVE.W	D0,BLTCON1(A0)

	MOVE.W	D1,D0		;Is there a small chunk <$1000 to clear?
	BEQ.S	CLR25		;Branch if not
	ANDI.W	#$003F,D0	;Is there a chunk <64 words to clear?
	BEQ.S	CLR22		;Branch if not
	ORI.W	#$0040,D0	;Clear chunk with height =1 & width =D0
	MOVE.W	D0,BLTSIZE(A0)
CLR22
	ANDI.W	#$FFC0,D1	;Is $40 <= chunk <$10000?
	BEQ.S	CLR25		;Branch if not
	BSR	WAITBLT
	MOVE.W	D1,BLTSIZE(A0)	;Clear chunk: hight=D1/64, width=64 words
CLR25
	SWAP	D1		;D1.W:= number of $10000 chunks to clear
	BRA.S	CLR50		;Enter loop checking for zero chunks
CLR30
	BSR	WAITBLT		;Wait for blitter not busy
	MOVE.W	#0,BLTSIZE(A0)	;Clear 128K bytes, and advance BLTDPTH
				; (128K bytes = $10000 words)
CLR50	DBF	D1,CLR30	;Loop for next $10000 chunk

CLR60	MOVEQ	#0,D0		;MOVE(0,0)
	MOVE.L	D0,X0
	MOVE.L	D0,Y0

	MOVEM.L	(SP)+,D0/D1/A0	;Restore registers
	RTS

;----------------------------------------------------------------------
;Routine to plot a point at X0,Y0 of the given COLOR.
; The upper-left corner is coordinate 0,0, and the positive Y direction
; is down (this might have been remapped by BITMAP2).
;
DOPOINT	MOVEM.L	D0-D3/A6,-(SP)	;Save registers

	MOVE.L	X0,D1		;Clip points outside bit map
	BMI.S	DOPT90
	CMP.L	WIDTH,D1
	BGE.S	DOPT90

	MOVE.L	Y0,D0		;BYTE = (X0 + Y0*WIDTH) /8 + RASTER
	BMI.S	DOPT90		;D0 =
	CMP.L	HEIGHT,D0
	BGE.S	DOPT90

	MULU	WIDTH+2,D0	; * Y0
	ADD.L	D1,D0		; + X0
	LSR.L	#3,D0		; / 8

	MOVEQ	#7,D1		;BIT = 7 - REM(X0/8)
	SUB.B	X0+3,D1

	MOVE.W	WIDTH+2,D3	;D3 = SIZE = WIDTH *HEIGHT
	MULU	HEIGHT+2,D3
	LSR.L	#3,D3		;Divide by 8 to get size in bytes

	LEA	CHIPREG.L,A6	;Set register base (it's efficient)
DOPT05	MOVE.W	DMACONR(A6),D2	;Wait for blitter not busy, because it
	BTST	#14,D2		; might be doing a CLEAR
	BNE.S	DOPT05

	MOVEA.L	RASTER,A6

	MOVEQ	#0,D2
DOPT10	BTST	#0,MODES
	BNE.S	DOPT40		;Branch if complement mode

	BTST	D2,COLOR+3	;Plot the point in the current screen
	BEQ.S	DOPT20		; if the corresponding COLOR bit is set
	BSET	D1,0(A6,D0.L)	;(D1 is modulo 8)
	BRA.S	DOPT30
DOPT20	BTST	#1,MODES
	BNE.S	DOPT50		;Branch if fast mode
	BCLR	D1,0(A6,D0.L)	;(D1 is modulo 8)
DOPT30	BRA.S	DOPT50

DOPT40	BCHG	D1,0(A6,D0.L)	;(D1 is modulo 8)

DOPT50	ADDA.L	D3,A6		;Next bit plane -- add SIZE to ADDR
	ADDQ.W	#1,D2		;(DBF will not work)
	CMP.W	DEPTH+2,D2
	BLT.S	DOPT10

DOPT90	MOVEM.L	(SP)+,D0-D3/A6	;Restore registers
	RTS

;----------------------------------------------------------------------
;Routine to draw a line from X0,Y0 to X1,Y1.
; This routine first checks to see if the line falls outside the RASTER
; dimensions. If it does, the line is clipped and only the portion
; within the RASTER is drawn. The blitter in line-drawing mode, which
; plots a point every 2.24 microseconds.
; The upper-left corner is coordinate 0,0, and the positive Y direction
; is down (this might have been remapped by BITMAP2).
;
; Register usage (for clip, and for line):
;	D0 = Scratch	Scratch
;	D1 = Scratch	BLTSIZE
;	D2 = Code 0	Bit plane
;	D3 = Code 1	BLTCON0
;	D4 = X0		RASTER size in bytes
;	D5 = Y0		BLTCPTH & BLTDPTH, address of start of line
;	D6 = X1		BLTAPTL
;	D7 = Y1		BLTCON1
;
;
DOLINE	MOVEM.L	D0-D7/A0,-(SP)	;Save registers

;Clip lines to the RASTER dimensions:
	MOVE.L	X0,D4		;Load registers with line end points
	MOVE.L	Y0,D5
	MOVE.L	Y1,D7

	MOVEQ	#0,D3		;Initialize flag bits
	MOVE.L	X1,D6
	SMI	D3		;Code 1 (X1LO, X1HI, Y1LO, Y1HI)
	ADD.W	D3,D3		;D3 Bits:  10    9     8     7-0
	CMP.L	WIDTH,D6
	SGE	D3
	ADD.W	D3,D3		;Shift left
	TST.L	D7
	SMI	D3
	ADD.W	D3,D3
	CMP.L	HEIGHT,D7
	SGE	D3

	MOVEQ	#0,D2		;Initialize flag bits
	TST.L	D4		;Code 0 (X0LO, X0HI, Y0LO, Y0HI)
	SMI	D2		;D2 Bits:  10    9     8     7-0
	ADD.W	D2,D2
	CMP.L	WIDTH,D4
	SGE	D2
	ADD.W	D2,D2
	TST.L	D5
	SMI	D2
	ADD.W	D2,D2
	CMP.L	HEIGHT,D5
	SGE	D2

	MOVE.W	D2,D0		;Is the line completely inside of the
	OR.W	D3,D0		; RASTER area?
	BEQ	LINE00		;Branch if it is -- draw it

	MOVE.W	D2,D0		;Is the line completely outside of the
	AND.W	D3,D0		; RASTER area?
	BNE	LINE90		;Branch if it is -- forget it

;Handle points outside 16-bit arithmetic range by dividing both X and Y
; by 2 until they are within range.
	MOVE.L	D4,D1		;Get X0 into D1
	BPL.S	CLIP010		;Work with positive value
	NEG.L	D1
CLIP010
	MOVE.L	D5,D2		;Get Y0 into D2
	BPL.S	CLIP020		;Work with positive value
	NEG.L	D2
CLIP020
	MOVE.L	#$4000,D0	;Are X0 and Y0 within 16 bit range?
	CMP.L	D0,D1
	BHS.S	CLIP030		;Branch if not (beware of $80000000)
	CMP.L	D0,D2
	BLO.S	CLIP060		;Branch if they are
CLIP030
	MOVEQ	#31,D0		;Scan for most significant bit
CLIP040	BTST	D0,D1		;(Some bit from 14 up to 31 is set)
	BNE.S	CLIP050		;Exit loop when found
	BTST	D0,D2
	DBNE	D0,CLIP040
CLIP050
	SUB.B	#13,D0		;Bits 0-13 are within range
	ASR.L	D0,D4		;Divide X0 and Y0 by 2 until they are
	ASR.L	D0,D5		; within 16-bit arithmetic range
CLIP060
	MOVE.L	D6,D1		;Repeat for X1, Y1...
	BPL.S	CLIP110
	NEG.L	D1
CLIP110
	MOVE.L	D7,D2
	BPL.S	CLIP120
	NEG.L	D2
CLIP120
	MOVE.L	#$4000,D0
	CMP.L	D0,D1
	BHS.S	CLIP130
	CMP.L	D0,D2
	BLO.S	CLIP160
CLIP130
	MOVEQ	#31,D0
CLIP140	BTST	D0,D1
	BNE.S	CLIP150
	BTST	D0,D2
	DBNE	D0,CLIP140
CLIP150
	SUB.B	#13,D0
	ASR.L	D0,D6
	ASR.L	D0,D7
CLIP160
;At this point all points are within 16-bit arithmetic range.
	MOVEQ	#0,D3		;Initialize flag bits
	TST.W	D6		;Code 0 (X0LO, X0HI, Y0LO, Y0HI)
	SMI	D3		;D3 Bits:  10    9     8     7-0
	ADD.W	D3,D3
	CMP.W	WIDTH+2,D6
	SGE	D3
	ADD.W	D3,D3
	TST.W	D7
	SMI	D3
	ADD.W	D3,D3
	CMP.W	HEIGHT+2,D7
	SGE	D3

CLIP200	MOVEQ	#0,D2		;Initialize flag bits
	TST.W	D4		;Code 0 (X0LO, X0HI, Y0LO, Y0HI)
	SMI	D2		;D2 Bits:  10    9     8     7-0
	ADD.W	D2,D2
	CMP.W	WIDTH+2,D4
	SGE	D2
	ADD.W	D2,D2
	TST.W	D5
	SMI	D2
	ADD.W	D2,D2
	CMP.W	HEIGHT+2,D5
	SGE	D2

	MOVE.W	D2,D0		;Is the line completely inside of the
	OR.W	D3,D0		; RASTER area?
	BEQ	LINE00		;Branch if it is -- draw it

	MOVE.W	D2,D0		;Is the line completely outside of the
	AND.W	D3,D0		; RASTER area?
	BNE	LINE90		;Branch if it is -- forget it

	TST.W	D2		;Make sure that point X0,Y0 is outside
	BNE.S	CLIP210		; the RASTER area
	EXG	D4,D6		;Swap points
	EXG	D5,D7
	EXG	D2,D3		;Swap codes
CLIP210
	TST.B	D2		;Is point X0,Y0 beyond the bottom?
	BEQ.S	CLIP220		;Branch if it is not
	SUB.W	D6,D4		;Clip line at bottom edge of RASTER
	MOVE.W	HEIGHT+2,D1	;X0:= X1 + (X0 - X1) * (HEIGHT-1 - Y1) /
	SUBQ.W	#1,D1		;	(Y0 - Y1)
	MOVE.W	D1,D2		;D4:= D6 + (D4 - D6) * (HEIGHT-1 - D7) /
	SUB.W	D7,D1		;	(D5 - D7)
	MULS	D1,D4
	SUB.W	D7,D5
	DIVS	D5,D4
	ADD.W	D6,D4
	MOVE.W	D2,D5		;Y0:= HEIGHT -1
	BRA.S	CLIP200
CLIP220
	BTST	#8,D2		;Is point X0,Y0 above the top?
	BEQ.S	CLIP230		;Branch if it is not
	SUB.W	D6,D4		;Clip line at top edge of RASTER
	MULS	D7,D4		;X0:= X1 + (X0 - X1) * Y1 / (Y1 - Y0)
	MOVE.W	D7,D1		;D4:= D6 + (D4 - D6) * D7 / (D7 - D5)
	SUB.W	D5,D1
	DIVS	D1,D4
	ADD.W	D6,D4
	CLR.W	D5		;Y0:= 0
	BRA.S	CLIP200
CLIP230
	BTST	#9,D2		;Is point X0,Y0 beyond the right edge?
	BEQ.S	CLIP240		;Branch if it is not
	SUB.W	D7,D5		;Clip line at right edge of RASTER
	MOVE.W	WIDTH+2,D1	;Y0:= Y1 + (Y0 - Y1) * (WIDTH-1 - X1) /
	SUBQ.W	#1,D1		;	(X0 - X1)
	MOVE.W	D1,D2		;D5:= D7 + (D5 - D7) * (WIDTH-1 - D6) /
	SUB.W	D6,D1		;	(D4 - D6)
	MULS	D1,D5
	SUB.W	D6,D4
	DIVS	D4,D5
	ADD.W	D7,D5
	MOVE.W	D2,D4		;X0:= WIDTH -1
	BRA	CLIP200
CLIP240				;Pt. X0,Y0 must be left of the left edge
	SUB.W	D7,D5		;Clip line at left edge of RASTER
	MULS	D6,D5		;Y0:= Y1 + (Y0 - Y1) * X1 / (X1 - X0)
	MOVE.W	D6,D1		;D5:= D7 + (D5 - D7) * D6 / (D6 - D4)
	SUB.W	D4,D1
	DIVS	D1,D5
	ADD.W	D7,D5
	CLR.W	D4		;X0:= 0
	BRA	CLIP200		;Loop a maximum of four times

;Draw the line:
LINE00	LEA	CHIPREG.L,A0	;Set register base (it's efficient)
	MOVE.W	#$8640,DMACON(A0) ;Enable blitter DMA and be nasty
	BSR	WAITBLT		;Wait for blitter not busy

	MOVEQ	#0,D0		;Initialize octant value
	MOVE.W	D6,D1		;Calculate delta X
	SUB.W	D4,D1
	BPL.S	LINE10		;Branch if positive
	NEG.W	D1		;Make it positive
	BSET	#0,D0		;Indicate negative X octants
LINE10
	MOVE.W	D7,D2		;Calculate delta Y
	SUB.W	D5,D2
	BPL.S	LINE20		;Branch if positive
	NEG.W	D2		;Make it positive
	BSET	#1,D0		;Indicate negative Y octants
LINE20
	CMP.W	D1,D2		;Is delta Y <= delta X
	BLS.S	LINE30		;Branch if so
	EXG	D1,D2		;Exchange X and Y, so Y is smaller
	BSET	#2,D0		;Indicate reversed octants
LINE30
	MOVE.B	LINETBL-@-2(PC,D0.W),D0 ;Get octant control code
	MOVE.W	D0,D7		;Save it in D7 (high byte must also
	BRA.S	LINE35		; be clear)

;Table to convert our octant code to Amiga's octant command.
; Also sets LINE mode and SIGN flag.
LINETBL	DC.B	$51		;0
	DC.B	$55		;1
	DC.B	$59		;2
	DC.B	$5D		;3
	DC.B	$41		;4
	DC.B	$49		;5
	DC.B	$45		;6
	DC.B	$4D		;7
LINE35
	MOVE.W	D2,D6		;2Y - X
	ADD.W	D6,D6
	SUB.W	D1,D6		;Save result in D6 for BLTAPTL

	MOVE.W	D2,D0		;4Y
	ASL.W	#2,D0
	MOVE.W	D0,BLTBMOD(A0)

	MOVE.W	D2,D0		;4Y - 4X = (Y - X) *4
	SUB.W	D1,D0
	ASL.W	#2,D0
	MOVE.W	D0,BLTAMOD(A0)

	ADDQ.W	#1,D1		;Adjust length to include end point
	LSL.W	#6,D1		;Get line length (X) for the height
	ADD.W	#2,D1		;Set width to 2, save in D1 for BLTSIZE

	MOVE.W	WIDTH+2,D0	;Set no. of bytes per horizontal line
	LSR.W	#3,D0
	MOVE.W	D0,BLTCMOD(A0)
	MOVE.W	D0,BLTDMOD(A0)

	MOVE.W	TEXTURE,D0	;Set texture mask
	NOT.W	D0		;(A zero gives a solid line)
	MOVE.W	D0,BLTBDAT(A0)

	MULU	WIDTH+2,D5	;Calculate address at start of line
	EXT.L	D4		;ADDR = (X0 + Y0 *WIDTH) /8 + RASTER
	ADD.L	D4,D5
	ASR.L	#3,D5
	ADD.L	RASTER,D5

	MOVE.W	D4,D3		;Get the bit shift count: REM(X0 /16)
	SWAP	D3		; and put it into bits 12-15 of D3
	MOVE.W	#$B000,D3	;Set up for BLTCON0 (line draw)
	LSR.L	#4,D3

	MOVE.W	WIDTH+2,D4	;D4 = size = WIDTH *HEIGHT
	MULU	HEIGHT+2,D4
	LSR.L	#3,D4		;Divide by 8 to get size in bytes

	MOVEQ	#0,D2		;Depth counter, point to first bit plane
LINE40	BTST	#0,MODES	;Is it complement mode?
	BEQ.S	LINE50		;Branch if not
	MOVE.B	#$4A,D3		;Set complement mode
	BRA.S	LINE60
LINE50
	BTST	D2,COLOR+3	;Is the bit to be set in this bit plane?
	BEQ.S	LINE55		;Branch if not
	MOVE.B	#$EA,D3		;Set normal mode
	BRA.S	LINE60
LINE55
	BTST	#1,MODES	;Is this fast mode?
	BNE.S	LINE80		;Branch if so (assume zeros are drawn)
	MOVE.B	#$2A,D3		;Erase mode (draw zeros)
LINE60
	BSR	WAITBLT		;Wait for blitter not busy
	MOVE.W	D3,BLTCON0(A0)	;Set line draw mode (line function)
	MOVE.W	D7,BLTCON1(A0)
	MOVE.W	#$8000,BLTADAT(A0)	;Set dot mask
	MOVE.W	D6,BLTAPTL(A0)	;2Y - X
	MOVE.L	D5,BLTCPTH(A0)	;Point to address at the beginning
	MOVE.L	D5,BLTDPTH(A0)	; of the line
	MOVE.W	D1,BLTSIZE(A0)	;Start the blitter

LINE80	ADD.L	D4,D5		;Next bit plane -- add size to addr

	ADDQ.W	#1,D2		;(DBF will not work)
	CMP.W	DEPTH+2,D2
	BLT.S	LINE40

LINE90	MOVEM.L	(SP)+,D0-D7/A0	;Restore registers
	RTS

;----------------------------------------------------------------------
;Routine to wait until the blitter is not busy.
; Inputs A0 = CHIPREG
; Destroys D0
;
WAITBLT	MOVE.W	DMACONR(A0),D0	;Wait for blitter not busy
	BTST	#14,D0		;(Don't change the blitter's registers
	BNE.S	WAITBLT		; while it's doing something)
	RTS


	IF	@ > MEMTOP - $3000 -$200
	ERROR -- TOO BIG
	ENDIF
	END
sters