abs.a68
; Copyright (C) 1987 by Manx Software Systems, Inc.
; :ts=8

	public	.Pabs
	public	_abs
_abs
	movem.l	4(sp),d0/d1
	jmp	.Pabs

acos.a68
; Copyright (C) 1987 by Manx Software Systems, Inc.
; :ts=8

	include	"io68881.i"

	public	_acos
_acos
	jsr	.getbase#
	move.w	#facos+fp0,(a2)
1$	cmp.w	#$8900,resp(a0)
	beq	1$
	move.l	16(sp),(a1)
	move.l	20(sp),(a1)

	move.w	#fmvfrfp+fp0,(a2)
3$	cmp.w	#$8900,resp(a0)
	beq	3$
	move.l	(a1),d0
	move.l	(a1),d1
	movem.l	(sp)+,a0-a2
	rts

asin.a68
; Copyright (C) 1987 by Manx Software Systems, Inc.
; :ts=8

	include	"io68881.i"

	public	_asin
_asin
	jsr	.getbase#
	move.w	#fasin+fp0,(a2)
1$	cmp.w	#$8900,resp(a0)
	beq	1$
	move.l	16(sp),(a1)
	move.l	20(sp),(a1)

	move.w	#fmvfrfp+fp0,(a2)
3$	cmp.w	#$8900,resp(a0)
	beq	3$
	move.l	(a1),d0
	move.l	(a1),d1
	movem.l	(sp)+,a0-a2
	rts

atan.a68
; Copyright (C) 1987 by Manx Software Systems, Inc.
; :ts=8

	include	"io68881.i"

	public	_atan
_atan
	jsr	.getbase#
	move.w	#fatan+fp0,(a2)
1$	cmp.w	#$8900,resp(a0)
	beq	1$
	move.l	16(sp),(a1)
	move.l	20(sp),(a1)

	move.w	#fmvfrfp+fp0,(a2)
3$	cmp.w	#$8900,resp(a0)
	beq	3$
	move.l	(a1),d0
	move.l	(a1),d1
	movem.l	(sp)+,a0-a2
	rts

atan2.c
#include "errno.h"

#define MAXEXP	1024
#define MINEXP	-1023

#define PI		3.14159265358979323846
#define PIov2	1.57079632679489661923

double atan2(v,u)
double u,v;
{
	double f, frexp(), fabs(), atan();
	int vexp, uexp;
	extern int flterr;
	extern int errno;

	if (u == 0.0) {
		if (v == 0.0) {
			errno = EDOM;
			return 0.0;
		} else if (v > 0.0 )
			return PIov2;
		return -PIov2;
	}

	frexp(v, &vexp);
	frexp(u, &uexp);
	if (vexp-uexp > MAXEXP-3)	/* overflow */
		f = PIov2;
	else {
		if (vexp-uexp < MINEXP+3)	/* underflow */
			f = 0.0;
		else
			f = atan(fabs(v/u));
		if (u < 0.0)
			f = PI - f;
	}
	if (v < 0.0)
		f = -f;
	return f;
}

atanh.a68
; Copyright (C) 1987 by Manx Software Systems, Inc.
; :ts=8

	include	"io68881.i"

	public	_atanh
_atanh
	jsr	.getbase#
	move.w	#fatanh+fp0,(a2)
1$	cmp.w	#$8900,resp(a0)
	beq	1$
	move.l	16(sp),(a1)
	move.l	20(sp),(a1)

	move.w	#fmvfrfp+fp0,(a2)
3$	cmp.w	#$8900,resp(a0)
	beq	3$
	move.l	(a1),d0
	move.l	(a1),d1
	movem.l	(sp)+,a0-a2
	rts

atof.c
/* Copyright (C) 1983 by Manx Software Systems */
#include	<ctype.h>

double
atof(cp)
register char *cp;
{
	double acc, zero = 0.0, ten = 10.0;
	int msign, esign, dpflg;
	int i, dexp;

	while (*cp == ' ' || *cp == '\t')
		++cp;
	if (*cp == '-') {
		++cp;
		msign = 1;
	} else {
		msign = 0;
		if (*cp == '+')
			++cp;
	}
	dpflg = dexp = 0;
	for (acc = zero ; ; ++cp) {
		if (isdigit(*cp)) {
			acc *= ten;
			acc += *cp - '0';
			if (dpflg)
				--dexp;
		} else if (*cp == '.') {
			if (dpflg)
				break;
			dpflg = 1;
		} else
			break;
	}
	if (*cp == 'e' || *cp == 'E') {
		++cp;
		if (*cp == '-') {
			++cp;
			esign = 1;
		} else {
			esign = 0;
			if (*cp == '+')
				++cp;
		}
		for ( i = 0 ; isdigit(*cp) ; i = i*10 + *cp++ - '0' )
			;
		if (esign)
			i = -i;
		dexp += i;
	}
	if (dexp < 0) {
		while (dexp++)
			acc /= ten;
	} else if (dexp > 0) {
		while (dexp--)
			acc *= ten;
	}
	if (msign)
		acc = -acc;
	return acc;
}

chiptst.c
#define	BASE	0xe90180

#define	response	(*(unsigned short *)(BASE+0))
#define	control	(*(unsigned short *)(BASE+2))
#define	command	(*(unsigned short *)(BASE+10))
#define	restore	(*(unsigned short *)(BASE+6))
#define	operand	(*(unsigned long *)(BASE+16))

main()
{
	char buf[40];
	register unsigned long atoh(), l;

	for (;;) {
		printf("cmd?");
		gets(buf);
		switch(*buf) {
		case 'R':
			l = 0;
			restore = l;
			printf("restore = %04x\n", restore);
			resp();
			break;
		case 'q':
			exit(1);
		case 'a':
			l = 1;
			control = l;
			resp();
			break;
		case 'r':
			resp();
			break;
		case 'c':
			l = atoh(buf+1);
			command = l;
			resp();
			break;
		case 'g':
			l = operand;
			printf("operand=%08lx\n", l);
			resp();
			break;
		case 'p':
			l = atoh(buf+1);
			operand = l;
			resp();
			break;
		}
	}
}

resp()
{
	register short l;

	l = response;
	printf("resp = %04x\n", l);
}

char hx[] = "0123456789ABCDEF";

unsigned long
atoh(s)
register char *s;
{
	register long val = 0;
	register char *cp, *strchr();

	while (*s == ' ')
		s++;
	while (*s && (cp = strchr(hx, toupper(*s++)))) {
		val <<= 4;
		val += cp - hx;
	}
	return(val);
}

cos.a68
; Copyright (C) 1987 by Manx Software Systems, Inc.
; :ts=8

	include	"io68881.i"

	public	_cos
_cos
	jsr	.getbase#
	move.w	#fcos+fp0,(a2)
1$	cmp.w	#$8900,resp(a0)
	beq	1$
	move.l	16(sp),(a1)
	move.l	20(sp),(a1)

	move.w	#fmvfrfp+fp0,(a2)
3$	cmp.w	#$8900,resp(a0)
	beq	3$
	move.l	(a1),d0
	move.l	(a1),d1
	movem.l	(sp)+,a0-a2
	rts

cosh.a68
; Copyright (C) 1987 by Manx Software Systems, Inc.
; :ts=8

	include	"io68881.i"

	public	_cosh
_cosh
	jsr	.getbase#
	move.w	#fcosh+fp0,(a2)
1$	cmp.w	#$8900,resp(a0)
	beq	1$
	move.l	16(sp),(a1)
	move.l	20(sp),(a1)

	move.w	#fmvfrfp+fp0,(a2)
3$	cmp.w	#$8900,resp(a0)
	beq	3$
	move.l	(a1),d0
	move.l	(a1),d1
	movem.l	(sp)+,a0-a2
	rts

cotan.a68
; Copyright (C) 1987 by Manx Software Systems, Inc.
; :ts=8

	include	"io68881.i"

	public	_cotan
_cotan
	jsr	.getbase#
	move.w	#fgtlong+fp0,(a2)
1$	cmp.w	#$8900,resp(a0)
	beq	1$
	move.l	#1,d0
	move.l	d0,(a1)

	move.w	#ftan+fp1,(a2)
2$	cmp.w	#$8900,resp(a0)
	beq	2$
	move.l	16(sp),(a1)
	move.l	20(sp),(a1)

	move.w	#$420,(a2)		;fdiv.x	fp1,fp0
3$	cmp.w	#$8900,resp(a0)
	beq	3$

	move.w	#fmvfrfp+fp0,(a2)
4$	cmp.w	#$8900,resp(a0)
	beq	4$
	move.l	(a1),d0
	move.l	(a1),d1
	movem.l	(sp)+,a0-a2
	rts

dtof.a68
; Copyright (C) 1987 by Manx Software Systems, Inc.
; :ts=8

	include	"io68881.i"

fptflt	equ	$6400

	public	.dtof
.dtof
	jsr	.getbase#
	move.w	#fmvtofp+fp0,(a2)
1$	cmp.w	#$8900,resp(a0)
	beq	1$
	move.l	d0,(a1)
	move.l	d1,(a1)

	move.w	#fptflt+fp0,(a2)
3$	cmp.w	#$8900,resp(a0)
	beq	3$
	move.l	(a1),d0
	movem.l	(sp)+,a0-a2
	rts

exp.a68
; Copyright (C) 1987 by Manx Software Systems, Inc.
; :ts=8

	include	"io68881.i"

	public	_exp
_exp
	jsr	.getbase#
	move.w	#fexp+fp0,(a2)
1$	cmp.w	#$8900,resp(a0)
	beq	1$
	move.l	16(sp),(a1)
	move.l	20(sp),(a1)

	move.w	#fmvfrfp+fp0,(a2)
3$	cmp.w	#$8900,resp(a0)
	beq	3$
	move.l	(a1),d0
	move.l	(a1),d1
	movem.l	(sp)+,a0-a2
	rts

fabs.a68
; Copyright (C) 1987 by Manx Software Systems, Inc.
; :ts=8

	public	.Pabs
	public	_fabs
_fabs
	movem.l	4(sp),d0/d1
	jmp	.Pabs

floor.c
#include "math.h"

double floor(d)
double d;
{
	if (d < 0.0)
		return -ceil(-d);
	modf(d, &d);
	return d;
}

double ceil(d)
double d;
{
	if (d < 0.0)
		return -floor(-d);
	if (modf(d, &d) > 0.0)
		++d;
	return d;
}
frexp.a68
; Copyright (C) 1987 by Manx Software Systems, Inc.
;
;	FLOATING POINT ERROR VALUES
;
UNDER_FLOW	equ	1
OVER_FLOW	equ	2
DIV_BY_ZERO	equ	3
;
;	frexp(d, &i)
;
;	returns 1/2 <= |x| < 1
;	such that d = x *2^i
;
		public	_frexp
_frexp:
		move.l	12(sp),a0		;get address for int
		move.l	4(sp),d0		; get double value
		move.l	d0,d1
		swap	d1
		and.w	#$7ff0,d1
		bne		notzero
		move.l	#0,d1
		beq		done
notzero:
		and.l	#$800fffff,d0	;get rid of old exponent
		lsr.w	#4,d1
		sub.w	#1022,d1
		or.l	#$3fe00000,d0	;change exponent to -1
done:
		if INT32
		ext.l	d1
		move.l	d1,(a0)
		else
		move.w	d1,(a0)
		endc
		move.l	8(sp),d1		;get low word into d1 for return
		rts

ftoa.c
/* Copyright (C) 1984 by Manx Software Systems, Inc. */

static double round[] = { 10, 1,
	5e-1, 5e-2, 5e-3, 5e-4, 5e-5, 5e-6, 5e-7, 5e-8, 5e-9, 5e-10,
	5e-11, 5e-12, 5e-13, 5e-14, 5e-15, 5e-16 };

ftoa(number, buffer, maxwidth, flag)
double number; register char *buffer;
{
	register int i;
	register int exp, digit, decpos, ndig;

	if ((*(short *)&number&0x7ff0) == 0x7ff0) {
		strcpy(buffer, "NAN");
		return;
	}
	ndig = maxwidth+1;
	exp = 0;
	if (number < 0.0) {
		number = -number;
		*buffer++ = '-';
	}
	if (number > 0.0) {
		while (number < round[1]) {
			number *= round[0];
			--exp;
		}
		while (number >= round[0]) {
			number /= round[0];
			++exp;
		}
	}

	if (flag == 2) {		/* 'g' format */
		ndig = maxwidth;
		if (exp < -4 || exp > maxwidth)
			flag = 0;		/* switch to 'e' format */
	} else if (flag == 1)	/* 'f' format */
		ndig += exp;

	if (ndig >= 0) {
		if ((number += round[(ndig>16?16:ndig)+1]) >= round[0]) {
			number = round[1];
			++exp;
			if (flag)
				++ndig;
		}
	}

	if (flag) {
		if (exp < 0) {
			*buffer++ = '0';
			*buffer++ = '.';
			i = -exp - 1;
			if (ndig <= 0)
				i = maxwidth;
			while (i--)
				*buffer++ = '0';
			decpos = 0;
		} else {
			decpos = exp+1;
		}
	} else {
		decpos = 1;
	}

	if (ndig > 0) {
		for (i = 0 ; ; ++i) {
			if (i < 16) {
				digit = (int)number;
				*buffer++ = digit+'0';
				number = (number - digit) * round[0];
			} else
				*buffer++ = '0';
			if (--ndig == 0)
				break;
			if (decpos && --decpos == 0)
				*buffer++ = '.';
		}
	}

	if (!flag) {
		*buffer++ = 'e';
		if (exp < 0) {
			exp = -exp;
			*buffer++ = '-';
		} else
			*buffer++ = '+';
		if (exp >= 100) {
			*buffer++ = exp/100 + '0';
			exp %= 100;
		}
		*buffer++ = exp/10 + '0';
		*buffer++ = exp%10 + '0';
	}
	*buffer = 0;
}

ftod.a68
; Copyright (C) 1987 by Manx Software Systems, Inc.
; :ts=8

	include	"io68881.i"

fgtflt	equ	$4400

	public	.ftod
.ftod
	jsr	.getbase#
	move.w	#fgtflt+fp0,(a2)
1$	cmp.w	#$8900,resp(a0)
	beq	1$
	move.l	d0,(a1)

	move.w	#fmvfrfp+fp0,(a2)
3$	cmp.w	#$8900,resp(a0)
	beq	3$
	move.l	(a1),d0
	move.l	(a1),d1
	movem.l	(sp)+,a0-a2
	rts

getbase.a68
; Copyright (C) 1987 by Manx Software Systems, Inc.
; :ts=8

	nolist
	include	"exec/types.i"
	include "exec/libraries.i"
	include	"io68881.i"
	list

	STRUCTURE IO8Lib,LIB_SIZE
	ULONG	io8_68881

	bss	savebase,4

libname	dc.b	'io68881.library',0

msg	dc.b	'No 68881! Aborting!',$a
	ds	0

	public	.getbase
.getbase
	movem.l	d0/a0/a1,-(sp)
	move.l	12(sp),(sp)
	move.l	a2,12(sp)
	tst.l	savebase
	bne	gotit

	movem.l	d0/d1/a6,-(sp)
	move.l	4,a6
	lea	libname,a1
	move.l	#0,d0
	jsr	_LVOOpenLibrary#(a6)
	tst.l	d0
	beq	1$

	move.l	d0,a1
	move.l	io8_68881(a1),a0
	move.l	a0,savebase
	jsr	_LVOCloseLibrary#(a6)
	move.l	(sp)+,d0
1$
	movem.l	(sp)+,d1/a6
	tst.l	savebase
	bne	first_time

error:
	move.l	#20,-(sp)
	pea	msg
	jsr	__Output#
	move.l	d0,-(sp)
	jsr	__Write#
	jsr	__abort#
	rts

first_time:
	jsr	gotit
	move.w	#0,restore(a0)	; abort current instruction
				; and begin reset of 881 state
	move.w	restore(a0),d0	; get verifification
	and.w	#$FF00,d0
	bne	error		; we expect to '0' return

1$	tst.w	(a0)
	bmi	1$
	move.w	#fmvtocr+fpcr,(a2)
2$	cmp.w	#$8900,resp(a0)
	beq	2$
	move.l	#$00000090,(a1)		;round to 0, chop mode, double prec
3$	tst.w	(a0)
	bmi	3$
	rts

gotit:
	move.l	savebase,a0
	lea	operand(a0),a1
	lea	command(a0),a2
	rts

ldexp.a68
;:ts=8
; Copyright (C) 1987 by Manx Software Systems, Inc.

	include	"io68881.i"

;
;		ldexp(d, i)
;
;		return x = d * 2^i
;

	public	_ldexp
_ldexp:
	jsr	.getbase#
	move.w	#fmvtofp+fp0,(a2)
1$	cmp.w	#$8900,resp(a0)
	beq	1$
	move.l	16(sp),(a1)
	move.l	20(sp),(a1)

	if INT32
	move.l  24(sp),d0
	else
	move.w  24(sp),d0
	ext.l	d0
	endc
	move.w	#fsclong+fp0,(a2)	;scale with a long
2$	cmp.w	#$8900,resp(a0)
	beq	2$
	move.l	d0,(a1)

	move.w	#fmvfrfp+fp0,(a2)
3$	cmp.w	#$8900,resp(a0)
	beq	3$
	move.l	(a1),d0
	move.l	(a1),d1
	movem.l	(sp)+,a0-a2
	rts

log.a68
; Copyright (C) 1987 by Manx Software Systems, Inc.
; :ts=8

	include	"io68881.i"

	public	_log
_log
	jsr	.getbase#
	move.w	#flog+fp0,(a2)
1$	cmp.w	#$8900,resp(a0)
	beq	1$
	move.l	16(sp),(a1)
	move.l	20(sp),(a1)

	move.w	#fmvfrfp+fp0,(a2)
3$	cmp.w	#$8900,resp(a0)
	beq	3$
	move.l	(a1),d0
	move.l	(a1),d1
	movem.l	(sp)+,a0-a2
	rts

log10.a68
; Copyright (C) 1987 by Manx Software Systems, Inc.
; :ts=8

	include	"io68881.i"

	public	_log10
_log10
	jsr	.getbase#
	move.w	#flog10+fp0,(a2)
1$	cmp.w	#$8900,resp(a0)
	beq	1$
	move.l	16(sp),(a1)
	move.l	20(sp),(a1)

	move.w	#fmvfrfp+fp0,(a2)
3$	cmp.w	#$8900,resp(a0)
	beq	3$
	move.l	(a1),d0
	move.l	(a1),d1
	movem.l	(sp)+,a0-a2
	rts

log2.a68
; Copyright (C) 1987 by Manx Software Systems, Inc.
; :ts=8

	include	"io68881.i"

	public	_log2
_log2
	jsr	.getbase#
	move.w	#flog2+fp0,(a2)
1$	cmp.w	#$8900,resp(a0)
	beq	1$
	move.l	16(sp),(a1)
	move.l	20(sp),(a1)

	move.w	#fmvfrfp+fp0,(a2)
3$	cmp.w	#$8900,resp(a0)
	beq	3$
	move.l	(a1),d0
	move.l	(a1),d1
	movem.l	(sp)+,a0-a2
	rts

makefile
.c.o:
	cc +bfi -o $@ $*.c
.c.o32:
	cc +blfi -o $@ $*.c
.c.l:
	cc +bcdfi -o $@ $*.c
.c.l32:
	cc +bpfi -o $@ $*.c

.a68.o:
	as -o $@ $*.a68
.a68.o32:
	as -eINT32 -o $@ $*.a68
.a68.l:
	as -cdo $@ $*.a68
.a68.l32:
	as -eINT32 -cdo $@ $*.a68

C=atof.o atan2.o ftoa.o floor.o pow.o random.o
C32=ftoa.o32 floor.o32
LC=atof.l atan2.l ftoa.l floor.l pow.l random.l
LC32=ftoa.l32 floor.l32
ASM=abs.o acos.o asin.o atan.o atanh.o\
	cos.o cosh.o cotan.o exp.o fabs.o\
	frexp.o getbase.o ldexp.o log.o log10.o\
	log2.o modf.o pabs.o padd.o pdiv.o\
	pfix.o pflt.o pmul.o pneg.o psub.o\
	ptst.o sin.o sinh.o sqrt.o tan.o\
	tanh.o dtof.o ftod.o
ASM32=frexp.o32 ldexp.o32 pow.o32
LASM=abs.l acos.l asin.l atan.l atanh.l\
	cos.l cosh.l cotan.l exp.l fabs.l\
	frexp.l getbase.l ldexp.l log.l log10.l\
	log2.l modf.l pabs.l padd.l pdiv.l\
	pfix.l pflt.l pmul.l pneg.l psub.l\
	ptst.l sin.l sinh.l sqrt.l tan.l\
	tanh.l dtof.l ftod.l
LASM32=frexp.l32 ldexp.l32 pow.l32

all:	16 32 l16 l32

16:	$(ASM) $(C)

32:	$(ASM32) $(C32)

l16:	$(LASM) $(LC)

l32:	$(LASM32) $(LC32)

modf.a68
;:ts=8
; Copyright (C) 1987 by Manx Software Systems, Inc.

	include	"io68881.i"

;
;	modf(d, dptr)
;
;	return fractional part of d and
;	stores integral part in	*dptr
;


	public	_modf
_modf:
	jsr	.getbase#
	move.l	a3,-(sp)
	move.w	#fmvtofp+fp0,(a2)
1$	cmp.w	#$8900,resp(a0)
	beq	1$
	move.l	20(sp),(a1)
	move.l	24(sp),(a1)

	move.w	#fgtext+fp1,(a2)
2$	cmp.w	#$8900,resp(a0)
	beq	2$

	move.w	#fintrz+fp1,(a2)
3$	cmp.w	#$8900,resp(a0)
	beq	3$

	move.l	28(sp),a3	;pick up pointer for storing
	move.w	#fmvfrfp+fp1,(a2)
4$	cmp.w	#$8900,resp(a0)
	beq	4$
	move.l	(a1),(a3)+
	move.l	(a1),(a3)

	move.w	#fsubext,(a2)
5$	cmp.w	#$8900,resp(a0)
	beq	5$

	move.w	#fmvfrfp+fp0,(a2)
6$	cmp.w	#$8900,resp(a0)
	beq	6$
	move.l	(a1),d0
	move.l	(a1),d1
	move.l	(sp)+,a3
	movem.l	(sp)+,a0-a2
	rts

pabs.a68
; Copyright (C) 1987 by Manx Software Systems, Inc.
; :ts=8

	include	"io68881.i"

	public	.Pabs
.Pabs
	jsr	.getbase#
	move.w	#fabs2fp+fp0,(a2)
1$	cmp.w	#$8900,resp(a0)
	beq	1$
	move.l	d0,(a1)
	move.l	d1,(a1)

	move.w	#fmvfrfp+fp0,(a2)
3$	cmp.w	#$8900,resp(a0)
	beq	3$
	move.l	(a1),d0
	move.l	(a1),d1
	movem.l	(sp)+,a0-a2
	rts

padd.a68
; Copyright (C) 1987 by Manx Software Systems, Inc.
; :ts=8

	include	"io68881.i"

	public	.Padd
.Padd
	jsr	.getbase#
	move.w	#fmvtofp+fp0,(a2)
1$	cmp.w	#$8900,resp(a0)
	beq	1$
	move.l	d0,(a1)
	move.l	d1,(a1)

	move.w	#fadd2fp+fp0,(a2)
2$	cmp.w	#$8900,resp(a0)
	beq	2$
	move.l	d2,(a1)
	move.l	d3,(a1)

	move.w	#fmvfrfp+fp0,(a2)
3$	cmp.w	#$8900,resp(a0)
	beq	3$
	move.l	(a1),d0
	move.l	(a1),d1
	movem.l	(sp)+,a0-a2
	rts

pdiv.a68
; Copyright (C) 1987 by Manx Software Systems, Inc.
; :ts=8

	include	"io68881.i"

	public	.Pdiv
.Pdiv
	jsr	.getbase#
	move.w	#fmvtofp+fp0,(a2)
1$	cmp.w	#$8900,resp(a0)
	beq	1$
	move.l	d0,(a1)
	move.l	d1,(a1)

	move.w	#fdiv2fp+fp0,(a2)
2$	cmp.w	#$8900,resp(a0)
	beq	2$
	move.l	d2,(a1)
	move.l	d3,(a1)

	move.w	#fmvfrfp+fp0,(a2)
3$	cmp.w	#$8900,resp(a0)
	beq	3$
	move.l	(a1),d0
	move.l	(a1),d1
	movem.l	(sp)+,a0-a2
	rts

pfix.a68
; Copyright (C) 1987 by Manx Software Systems, Inc.
; :ts=8

	include	"io68881.i"

	public	.Pfix
.Pfix
	jsr	.getbase#
	move.w	#fmvtofp+fp0,(a2)
1$	cmp.w	#$8900,resp(a0)
	beq	1$
	move.l	d0,(a1)
	move.l	d1,(a1)

	move.w	#fintrz+fp0,(a2)
2$	cmp.w	#$8900,resp(a0)
	beq	2$

	move.w	#fptlong+fp0,(a2)
3$	cmp.w	#$8900,resp(a0)
	beq	3$
	move.l	(a1),d0
	movem.l	(sp)+,a0-a2
	rts

pflt.a68
; Copyright (C) 1987 by Manx Software Systems, Inc.
; :ts=8

	include	"io68881.i"

	public	.Pflt
.Pflt
	jsr	.getbase#
	move.w	#fgtlong+fp0,(a2)
1$	cmp.w	#$8900,resp(a0)
	beq	1$
	move.l	d0,(a1)

	move.w	#fmvfrfp+fp0,(a2)
3$	cmp.w	#$8900,resp(a0)
	beq	3$
	move.l	(a1),d0
	move.l	(a1),d1
	movem.l	(sp)+,a0-a2
	rts

pmul.a68
; Copyright (C) 1987 by Manx Software Systems, Inc.
; :ts=8

	include	"io68881.i"

	public	.Pmul
.Pmul
	jsr	.getbase#
	move.w	#fmvtofp+fp0,(a2)
1$	cmp.w	#$8900,resp(a0)
	beq	1$
	move.l	d0,(a1)
	move.l	d1,(a1)

	move.w	#fmul2fp+fp0,(a2)
2$	cmp.w	#$8900,resp(a0)
	beq	2$
	move.l	d2,(a1)
	move.l	d3,(a1)

	move.w	#fmvfrfp+fp0,(a2)
3$	cmp.w	#$8900,resp(a0)
	beq	3$
	move.l	(a1),d0
	move.l	(a1),d1
	movem.l	(sp)+,a0-a2
	rts

pneg.a68
; Copyright (C) 1987 by Manx Software Systems, Inc.
; :ts=8

	include	"io68881.i"

	public	.Pneg
.Pneg
	jsr	.getbase#
	move.w	#fneg2fp+fp0,(a2)
1$	cmp.w	#$8900,resp(a0)
	beq	1$
	move.l	d0,(a1)
	move.l	d1,(a1)

	move.w	#fmvfrfp+fp0,(a2)
3$	cmp.w	#$8900,resp(a0)
	beq	3$
	move.l	(a1),d0
	move.l	(a1),d1
	movem.l	(sp)+,a0-a2
	rts

pow.c
#include "math.h"
#include "errno.h"

double pow(a,b)
double a,b;
{
	double answer, tmp;
	extern int errno;
	char sign;
	
	if (b == 0)
		return 1.0;		/* anything raised to 0 is 1 */
	if (a == 0) {
		if (b <= 0)
domain:		errno = EDOM;
		return 0.0;
	}
	sign = 0;
	if (modf(b,&answer) == 0) {
		if (a < 0)
			sign = 1, a = -a;
		if (answer < 0)
			answer = -answer;
		modf(answer/2, &tmp);
		if (tmp*2 == answer)
			sign = 0;		/* number is even so sign is positive */

	} else if (a < 0)
		goto domain;

	answer = exp(log(a)*b);
	return sign ? -answer : answer;
}

psub.a68
; Copyright (C) 1987 by Manx Software Systems, Inc.
; :ts=8

	include	"io68881.i"

	public	.Psub
.Psub
	jsr	.getbase#
	move.w	#fmvtofp+fp0,(a2)
1$	cmp.w	#$8900,resp(a0)
	beq	1$
	move.l	d0,(a1)
	move.l	d1,(a1)

	move.w	#fsub2fp+fp0,(a2)
2$	cmp.w	#$8900,resp(a0)
	beq	2$
	move.l	d2,(a1)
	move.l	d3,(a1)

	move.w	#fmvfrfp+fp0,(a2)
3$	cmp.w	#$8900,resp(a0)
	beq	3$
	move.l	(a1),d0
	move.l	(a1),d1
	movem.l	(sp)+,a0-a2
	rts

ptst.a68
; Copyright (C) 1987 by Manx Software Systems, Inc.
; :ts=8

	include	"io68881.i"

	public	.Ptst
.Ptst
	jsr	.getbase#
	move.w	#fmvtofp+fp0,(a2)
1$	cmp.w	#$8900,resp(a0)
	beq	1$
	move.l	d0,(a1)
	move.l	d1,(a1)

common_tst:
	move.w	#$12,cond(a0)
2$	move.w	resp(a0),d0
	cmp.w	#$8900,d0
	beq	2$
	btst	#0,d0
	beq	3$
	move.l	#1,d0
	bra	6$
3$	move.w	#$14,cond(a0)
4$	move.w	resp(a0),d0
	cmp.w	#$8900,d0
	beq	4$
	btst	#0,d0
	beq	5$
	move.l	#-1,d0
	bra	6$
5$
	move.l	#0,d0
6$
	movem.l	(sp)+,a0-a2
	rts

	public	.Pcmp
.Pcmp
	jsr	.getbase#
	move.w	#fmvtofp+fp0,(a2)
1$	cmp.w	#$8900,resp(a0)
	beq	1$
	move.l	d0,(a1)
	move.l	d1,(a1)

	move.w	#fcmp2fp+fp0,(a2)
2$	cmp.w	#$8900,resp(a0)
	beq	2$
	move.l	d2,(a1)
	move.l	d3,(a1)
	bra	common_tst

random.c
/*
 * Random number generator -
 * adapted from the FORTRAN version 
 * in "Software Manual for the Elementary Functions"
 * by W.J. Cody, Jr and William Waite.
 */
double ran()
{
	static long int iy = 100001;
	
	iy *= 125;
	iy -= (iy/2796203) * 2796203;
	return (double) iy/ 2796203.0;
}

double randl(x)
double x;
{
	double exp();

	return exp(x*ran());
}
sin.a68
; Copyright (C) 1987 by Manx Software Systems, Inc.
; :ts=8

	include	"io68881.i"

	public	_sin
_sin
	jsr	.getbase#
	move.w	#fsin+fp0,(a2)
1$	cmp.w	#$8900,resp(a0)
	beq	1$
	move.l	16(sp),(a1)
	move.l	20(sp),(a1)

	move.w	#fmvfrfp+fp0,(a2)
3$	cmp.w	#$8900,resp(a0)
	beq	3$
	move.l	(a1),d0
	move.l	(a1),d1
	movem.l	(sp)+,a0-a2
	rts

sinh.a68
; Copyright (C) 1987 by Manx Software Systems, Inc.
; :ts=8

	include	"io68881.i"

	public	_sinh
_sinh
	jsr	.getbase#
	move.w	#fsinh+fp0,(a2)
1$	cmp.w	#$8900,resp(a0)
	beq	1$
	move.l	16(sp),(a1)
	move.l	20(sp),(a1)

	move.w	#fmvfrfp+fp0,(a2)
3$	cmp.w	#$8900,resp(a0)
	beq	3$
	move.l	(a1),d0
	move.l	(a1),d1
	movem.l	(sp)+,a0-a2
	rts

sqrt.a68
; Copyright (C) 1987 by Manx Software Systems, Inc.
; :ts=8

	include	"io68881.i"

	public	_sqrt
_sqrt
	jsr	.getbase#
	move.w	#fsqrt+fp0,(a2)
1$	cmp.w	#$8900,resp(a0)
	beq	1$
	move.l	16(sp),(a1)
	move.l	20(sp),(a1)

	move.w	#fmvfrfp+fp0,(a2)
3$	cmp.w	#$8900,resp(a0)
	beq	3$
	move.l	(a1),d0
	move.l	(a1),d1
	movem.l	(sp)+,a0-a2
	rts

tan.a68
; Copyright (C) 1987 by Manx Software Systems, Inc.
; :ts=8

	include	"io68881.i"

	public	_tan
_tan
	jsr	.getbase#
	move.w	#ftan+fp0,(a2)
1$	cmp.w	#$8900,resp(a0)
	beq	1$
	move.l	16(sp),(a1)
	move.l	20(sp),(a1)

	move.w	#fmvfrfp+fp0,(a2)
3$	cmp.w	#$8900,resp(a0)
	beq	3$
	move.l	(a1),d0
	move.l	(a1),d1
	movem.l	(sp)+,a0-a2
	rts

tanh.a68
; Copyright (C) 1987 by Manx Software Systems, Inc.
; :ts=8

	include	"io68881.i"

	public	_tanh
_tanh
	jsr	.getbase#
	move.w	#ftanh+fp0,(a2)
1$	cmp.w	#$8900,resp(a0)
	beq	1$
	move.l	16(sp),(a1)
	move.l	20(sp),(a1)

	move.w	#fmvfrfp+fp0,(a2)
3$	cmp.w	#$8900,resp(a0)
	beq	3$
	move.l	(a1),d0
	move.l	(a1),d1
	movem.l	(sp)+,a0-a2
	rts

tst.c
main()
{
	double d, e, f;
	long l;

	d = 1;
	e = 2;
	f = d + e;
	printf("%08lx%08lx %08lx%08lx\n", 3.0, f);
	d = f - e;
	printf("%08lx%08lx %08lx%08lx\n", 1.0, d);
	d = e * f;
	printf("%08lx%08lx %08lx%08lx\n", 6.0, d);
	f = d / e;
	printf("%08lx%08lx %08lx%08lx\n", 3.0, f);
	d = 6.567;
	l = d;
	printf("l=%lx\n", l);
	d = l;
	printf("%08lx%08lx %08lx%08lx\n", 6.0, d);
	d = -d;
	printf("%08lx%08lx %08lx%08lx\n", -6.0, d);
	if (d > 0)
		printf("d > 0\n");
	else if (d < 0)
		printf("d < 0\n");
	else
		printf("d == 0\n");
	d = -d;
	if (d > 0)
		printf("d > 0\n");
	else if (d < 0)
		printf("d < 0\n");
	else
		printf("d == 0\n");
	d = 0;
	if (d > 0)
		printf("d > 0\n");
	else if (d < 0)
		printf("d < 0\n");
	else
		printf("d == 0\n");
	d = 3;
	if (d > 10)
		printf("d > 10\n");
	else if (d < 10)
		printf("d < 10\n");
	else
		printf("d == 10\n");
	d = 13;
	if (d > 10)
		printf("d > 10\n");
	else if (d < 10)
		printf("d < 10\n");
	else
		printf("d == 10\n");
	d = 10;
	if (d > 10)
		printf("d > 10\n");
	else if (d < 10)
		printf("d < 10\n");
	else
		printf("d == 10\n");
}