;INT.68K	MAR-20-87
;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, Fixed remainder.
;
;Notes:
;These intrinsics may destroy the contents of registers D0 and A6;
; however, subroutines should not destroy the contents of registers. 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	BADINT.L	;TRAP.L		;17
	JMP	FREE.L		;18
	JMP	RERUN.L		;19
	JMP	GETHP.L		;20
	JMP	SETHP.L		;21
	JMP	BADINT.L	;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

;Special intrinsics for Apex:
	JMP	FGET.L		;33
	JMP	BADINT.L	;FASAVE.L	;34
	JMP	FSAVE.L		;35
	JMP	BLIT.L		;36

;	JMP	BADINT.L	;SETTXT.L	;33
;	JMP	BADINT.L	;SETHI.L	;34
;	JMP	BADINT.L	;SETMIX.L	;35
;	JMP	BADINT.L	;SETLO.L	;36

	JMP	BADINT.L	;BUTTON.L	;37
	JMP	BADINT.L	;PADDLE.L	;38
	JMP	BADINT.L	;SOUND.L	;39
	JMP	BADINT.L	;CLEAR.L	;40
	JMP	BADINT.L	;POINT.L	;41
	JMP	BADINT.L	;LINE.L		;42
	JMP	BADINT.L	;MOVE.L		;43
	JMP	BADINT.L	;SCREEN.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	BADINT.L	;107
	JMP	BADINT.L	;108
	JMP	BADINT.L	;109
	JMP	BADINT.L	;110
	JMP	BADINT.L	;111
	JMP	BADINT.L	;112
	JMP	BADINT.L	;113
	JMP	BADINT.L	;114
	JMP	BADINT.L	;115
	JMP	BADINT.L	;116
	JMP	BADINT.L	;117
	JMP	BADINT.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

;-----------------------------------------------------------------------
;All INT.68K variables are stored here. The compiler must know the
; location of REMAIN. The rest are grouped here for convenience when
; they are saved and restored by the multitasking exec.
;
REMAIN	DS.L	1		;Remainder of most recent divide

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

;-----------------------------------------------------------------------
;
	ORG	MEMTOP -$3800
;
;Illegal intrinsic handler. (Note: this would be improved a tremendous
; amount if it said where it came from.)
;
BADINT	JSR	VERROR
	ASCII	'105 - ILLEGAL INTRINSI'
	DC.B	'C'+$80
	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
; remainder is equal to zero.
; I:= REM(5/3)
;
REM	MOVE.W	REMAIN,D0	;Get high word (the actual 16-bit
	EXT.L	D0		; remainder). Extend to 32-bits
	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 OVERFLO'
	DC.B	'W'+$80
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 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
TRAP	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
; I:= GETERR;
GETERR
	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
;MODE:=TESTPT(X, Y)
TESTPT	RTS

;======================================================================
;Special intrinsics for Apex
;-----------------------------------------------------------------------
;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)

;-----------------------------------------------------------------------
;34
;Write APEX.XPL to SYSTEM.SYS
; FASAVE(UNIT,BLKNO)
;
;FASAVE	MOVE.B	3(A5),UNIT	;Get arguments
;	MOVE.L	4(A5),BLKNO
;	JMP	VFASAVE		;(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 LEN many bytes from FROM to TO
; BLIT(TO, FROM, LEN)
;
BLIT	MOVEM.L	D1/A0,-(SP)	;Save register(s)
				;Get arguments:
	MOVEA.L	(A5),A6		; TO
	MOVEA.L	4(A5),A0	; FROM
	MOVE.L	8(A5),D0	; LEN
	MOVE.L	D0,D1		;Put the high 16 bits of LEN 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 LEN = 0

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

BLIT10	MOVE.B	(A0)+,(A6)+	;Move block backward, pointers forward
BLIT20	DBF	D0,BLIT10	;Loop unitl 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 unitl D0 = -1
	DBF	D1,BLIT30	; and also D1 = -1

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

;;======================================================================
;;33
;SETTXT	RTS
;;
;;34
;SETHI	RTS
;;
;;35
;SETMIX	RTS
;;
;;36
;SETLO	RTS

;-----------------------------------------------------------------------
;37
;BOOLEAN:=BUTTON(NUMBER)
BUTTON	RTS
;

;38
;VARIALBE:=PADDLE(NUMBER)
PADDLE	RTS

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

;40
CLEAR	RTS

;41
;POINT(X, Y, MODE)
POINT	RTS

;42
;LINE(X, Y, MODE)
LINE	RTS

;43
;MOVE(X, Y)
MOVE	RTS

;44
;VARIABLE:=SCREEN(X, Y)
SCREEN	RTS

;45
;BLOCK(X, Y, COLOR)
BLOCK	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 OVERFLO'
	DC.B	'W'+$80
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.L	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.L	BADINT

;-----------------------------------------------------------------------
;58
;X:= MOD(A,B);
;
MOD	BRA.L	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 in the Apple at the given address
;POKE(ADDR,BYTE)
;
POKE	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.L,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 character having its MSB set.
;
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
	BPL.S	TXT10		;Loop unitl the last character

	ANDI.B	#$7F,D0		;Clear MSB
	JSR	VDEVHAN		;Output D0

	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

	IF	@ > MEMTOP - $3000
	ERROR -- TOO BIG
	ENDIF
	END
in case we need to re-read it
	MOVEA