Apple-2gs-SW/gno
1
0
Fork 0
mirror of https://github.com/GnoConsortium/gno.git synced 2024-12-21 07:30:05 +00:00
Code Issues Projects Releases Wiki Activity

- initial checkin, as submitted by Soenke Behrens

Browse Source
This commit is contained in:
gdr 1997-09-17 16:36:41 +00:00
parent 39e6f0d5ee
commit c1a44d4166
10 changed files with 3069 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
lib/lsaneglue/Makefile Normal file
View File

@ -0,0 +1,46 @@
# Makefile for SANE glue code
# 1997 Soenke Behrens
# All paths assume a GNO/ME setup as described in Devin Reade's
# GNO/ME FAQ. For installation under ORCA/Shell, see the README
# file
LIBDIR = 13
# Change INCDIR to 13/orcacdefs if you are using the "old-style"
# path naming convention
# Or set to /lang/orca/include if you wish to completely replace
# ORCA/C's sane.h.
INCDIR = /usr/include
# You should not have to modify anything beyond this point
all: sanetest findfpe lsaneglue
sanetest: sanetest.o saneglue.o
$(RM) saneglue.root
occ -o sanetest sanetest.o saneglue.o
findfpe: findfpe.o findfpcp.o
$(RM) findfpcp.root
occ -o findfpe findfpe.o findfpcp.o
saneglue.o:: saneglue.mac
saneglue.mac: saneglue.asm saneglue.macro
macgen saneglue.asm saneglue.mac saneglue.mac saneglue.macro \
13:ainclude:m16.sane 13:orcainclude:m16.orca
findfpcp.o:: findfpcp.mac
findfpcp.mac: findfpcp.asm
macgen findfpcp.asm findfpcp.mac findfpcp.mac \
13:orcainclude:m16.orca
lsaneglue: saneglue.o findfpcp.o
$(RM) lsaneglue
makelib lsaneglue +saneglue.o +findfpcp.o
copyfork lsaneglue.r lsaneglue
install:
cp -f sane.h $(INCDIR)
cp -f lsaneglue $(LIBDIR)

245
lib/lsaneglue/README Normal file
View File

@ -0,0 +1,245 @@
SANE Glue Code for ORCA/C 2.1 or later
Written in 1997 by Soenke Behrens
Legal Stuff
===========
This library and the accompanying source code are hereby placed
into the Public Domain. There is no warranty, express or implied,
on the performance of the library or source code. The author is not
liable for any damage that may occur as a direct or indirect result
of using the library or source code.
Installation
============
In GNO/ME, run "dmake install".
This will copy a changed sane.h to /lang/orca/include and the library
lsaneglue to 13.
If, on your system, includes are kept in a different directory (say
13/orcacdefs), either copy the files manually or edit the file
"makefile" to use a different path.
In ORCA/Shell, copy the changed include file and the library
manually.
Afterwards, use a directory ordering utility such as ProSel-16
to make sure lsaneglue comes _before_ ORCALIB.
Documentation, Use
==================
lsaneglue is a library that contains code to let you call
SANE functions directly from ORCA/C. To avoid namespace
conflicts with math.h, it was necessary to change sane.h.
Thus, all SANE functions are now prefixed with "s_" (e.g.
"annuity" became "s_annuity", and "sin" became "s_sin").
This lets you choose easily between the SANE and ISO/C
implementations of the same function.
Below you will find a brief overview over the functions in
lsaneglue. This overview does not replace, however, proper
documentation. To fully understand SANE, you will need the
"Apple Numerics Manual, 2nd Edition" by Apple Computer, Inc.,
ISBN 0-201-17738-2, published by Addison-Wesley Publishing
Company, Inc.
SANE is also introduced in the "Apple IIgs Toolbox Reference,
Volume 2", Chapter 18.
I find the functions to control the SANE environment (rounding
direction, halts &c.), the functions to spot NaNs (classification
functions) as well as the functions that give you a good pi, NaN
and INF particularly useful.
Brief SANE function overview
============================
There is one function in lsaneglue that has nothing to do with
SANE:
int findfpcp(void);
This function will find an FPE or NC card and return the slot number
(or -1 if card not found). You can use the output of this function
for the ORCA/C setfpeslot(), which is used when having ORCA/C
create code for the FPE/NC directly (#pragma float 1 1).
Now for the SANE interface functions.
I will give the prototype of the function, and a one-line description
on the following line. Page numbers refer to Apple Numerics Manual.
NB: Use the file "sane.h" itself as reference for constants used
to set/test exceptions, rounding direction, rounding precision,
number classes, ordering relations, formatting styles and NAN codes.
void s_num2dec(DecForm *f, extended x, Decimal *d);
Convert x to SANE decimal record. Pg 28
extended s_dec2num(Decimal *d);
Convert SANE decimal record to extended. Pg 28f
void s_str2dec(char *s, short *ix, Decimal *d, short *vp);
Convert string s to SANE decimal record. Pg 30f
void s_dec2str(DecForm *f, Decimal *d, char *s);
Convert SANE decimal record d to string. Pg 31ff
extended s_fabs(extended x);
Get the absolute of x (make sign positive). Pg 49
extended s_fneg(extended x);
Reverse sign of x. Pg 49
extended s_remainder(extended x, extended y, short *quo);
Get the remainder of x and y. Pg 46f
extended s_sqrt(extended x);
Compute square root of x. Pg 46
extended s_rint(extended x);
Round x to integer in current rounding direction. Pg 47
extended s_scalb(short n, extended x);
Return (x times 2^n). Pg 50
extended s_logb(extended x);
Compute binary exponent of normalized x. Pg 50
extended s_copysign(extended x, extended y);
Return y with sign of x. Pg 49
extended s_nextfloat(extended x, extended y);
Return next float number after x in direction of y. Pg 50
extended s_nextdouble(extended x, extended y);
Return next double number after x in direction of y. Pg 50
extended s_nextextended(extended x, extended y);
Return next extended number after x in direction of y. Pg 50
extended s_log2(extended x);
Return base-2 logarithm of x. Pg 62
extended s_log(extended x);
Return base-e (natural) logarithm of x. Pg 62
extended s_log1(extended x);
Return base-e (natural) logarithm of (x+1). Pg 62
extended s_exp2(extended x);
Return base-2 exponantial of x (2^x). Pg 63f
extended s_exp(extended x);
Return base-e (natural) exponantial of x (x^e). Pg 63f
extended s_exp1(extended x);
Return base-e (natural) exponantial of x, minus 1 (x^e - 1). Pg 63f
extended s_power(extended x, extended y);
Return x^y. Pg 63f
extended s_ipower(extended x, short i);
Return x^i. Pg 63f
extended s_compound(extended r, extended n);
Compute compound (1+r)^n. Pg 64f
extended s_annuity(extended r, extended n);
Compute annuity (1-(1+r)^n)/r. Pg 65
extended s_tan(extended x);
Return tangent of x. Pg 67f
extended s_sin(extended x);
Return sine of x. Pg 67
extended s_cos(extended x);
Return cosine of x. Pg 67
extended s_atan(extended x);
Return arctangent of x. Pg 67f
extended s_randomx(extended *x);
Return pseudorandom integer value with seed x. Pg 67
numclass s_classfloat(extended x);
Return classification of float x. Pg 44
numclass s_classdouble(extended x);
Return classification of double x. Pg 44
numclass s_classcomp(extended x);
Return classification of comp x. Pg 44
numclass s_classextended(extended);
Return classification of extended x. Pg 44
int s_signnum(extended x);
Return sign of x: 0 if positive, 1 if negative. Pg 44
void s_setexception(exception e, long b);
Clear or set SANE exceptions. Pg 54ff
long s_testexception(exception e);
Check whether SANE exception is currently set. Pg 54ff
void s_sethalt(exception e, long b);
Clear or set SANE exception halts. Pg 54ff
long s_testhalt(exception e);
Check whether SANE exception halt is currently set. Pg 54ff
void s_setround(rounddir r);
Set SANE rounding direction. Pg 52f
rounddir s_getround(void);
Get SANE rounding direction. Pg 52f
void s_setprecision(roundpre p);
Set SANE rounding precision. Pg 53
roundpre s_getprecision(void);
Get SANE rounding precision. Pg 53
void s_setenvironment(environment e);
Set SANE environment word. Pg 57
void s_getenvironment(environment *e);
Get SANE environment word. Pg 57
void s_procentry(environment *e);
Save SANE environment word, then default it. Pg 57
void s_procexit(environment e);
Restore SANE environment word, then signal exceptions. Pg 57
haltvector s_gethaltvector(void);
Get SANE halt vector. Pg 54
void s_sethaltvector(haltvector v);
Set SANE halt vector. Pg 54
relop s_relation(extended x, extended y);
Return relation of x to y. Pg 49
extended s_nan(unsigned char c);
Return NaN(c).
extended s_inf(void);
Return +INF (Infinity).
extended s_pi(void);
Return pi constant (3.141592653589793238512808959)
Errors in SANE toolkit
======================
The fclass functions should return the sign of the passed number
in n-bit and Y. They do not report the sign at all, though, which
has to be considered a bug. s_signnum() has been rewritten to not
rely on fclassx any more.
Soenke Behrens
September 1997
sbehrens@bigfoot.com

106
lib/lsaneglue/findfpcp.asm Normal file
View File

@ -0,0 +1,106 @@
case on
mcopy findfpcp.mac
*
* Find the slot the FPE or NumberCruncher card is in
*
* Returns the slot number or -1 if FPCP card cannot be found.
*
* For slots 1-5 and 7, findfpcp() can find the card
* regardless of the Slot setting in the Control Panel.
* For slot 6, the Control Panel must be set to "Your Card"
* for the function to be able to find the card.
*
* Written in 1997 by Soenke Behrens, from Merlin code by
* Albert Chin-A-Young
* This code is hereby place into the Public Domain
*
*
* Dummy function to take care of findfpcp.root, which
* can then be discarded.
*
dummy start
end
****************************************************************
*
* int findfpcp (void);
*
* Find slot FPCP card is in
*
* See also: Floating-Point Coprocessor Manual by Albert
* Chin-A-Young
*
****************************************************************
*
findfpcp start
SETINTC3ROM equ $e1c00a ; enable internal slot 3 ROM
SETSLOTC3ROM equ $e1c00b ; enable external slot 3 ROM
RDC3ROM equ $e1c017 ; bit 7 = 1 if slot c3 space enabled
SLTROMSEL equ $e1c02d ; slot ROM select
csub
sei Disable interrupts
short m 8-bit accumulator
lda #0 enable slot 3 ROM as FPCP
sta SETSLOTC3ROM might be in slot 3
lab1 lda RDC3ROM wait for external slot 3
bpl lab1 space to be enabled
lda SLTROMSEL store previous value in Y
tay
ora #%10110110 enable slot 1, 2, 4, 5, 7 ROM
sta SLTROMSEL
long m 16-bit accumulator
ldx #$c100 Start with slot 1
search lda $e00004,x read slot at address $04,
cmp id_bytes $06 and $0b. If no match
bne next_slot is found, exit, else set up
lda $e00006,x base address
cmp id_bytes+2
bne next_slot
lda $e0000b,x
cmp id_bytes+4
beq found
next_slot txa try next slot
clc
adc #$100
tax
cmp #$c000 last slot + $100
bne search
lda #$FFFF
sta slot_num store -1 to
bra end indicate FPCP not found
found txa slot number of FPCP
xba
and #$0f strip slot number
sta slot_num save slot number
end short m
lda #0 re-enable internal slot 3 ROM
sta SETINTC3ROM
lab2 lda RDC3ROM wait for internal slot 3
bmi lab2 space to be enabled
tya re-enable other internal
sta SLTROMSEL slot ROM
long m
cli re-enable interrupts
ret 2:slot_num
id_bytes anop
dc h'3838'
dc h'1818'
dc h'01af'
slot_num ds 2
end

13
lib/lsaneglue/findfpe.c Normal file
View File

@ -0,0 +1,13 @@
#include <stdio.h>
int main(void)
{
int s = findfpcp();
if (s == -1)
printf("FPE not found\n");
else
printf("FPE found in slot %d\n", s);
return (0);
}

31
lib/lsaneglue/fpnumtest.c Normal file
View File

@ -0,0 +1,31 @@
/*
* Test the _isnan and _isinf functions.
* Requires lsaneglue to link and compile
*/
#include <stdio.h>
#include <sane.h> /* Modified sane.h from lsaneglue */
int _isnan (extended);
int _isinf (extended);
int main (void)
{
int i;
if (_isinf(s_inf()) && _isinf(-s_inf()))
printf("_isinf() test successful.\n");
else
printf("_isinf() test failed.\n");
for (i = 0; i < 256; ++i)
{
if (_isnan(s_nan(i)) != 1)
{
printf("_isnan() test failed.\n");
return 1;
}
}
printf("_isnan() test successful.\n");
return 0;
}

104
lib/lsaneglue/fpspecnum.asm Normal file
View File

@ -0,0 +1,104 @@
case on
mcopy fpspecnum.mac
*
* Test an extended to see whether it is NaN or INF
*
*
* Dummy function to take care of fpspecnum.root, which
* can then be discarded.
*
dummy start
copy 13:ainclude:e16.sane ; Apple-supplied SANE EQUs
end
****************************************************************
*
* int _isnan (extended x);
*
* Check whether x is NaN, if so, return 1, otherwise, return 0.
*
****************************************************************
*
_isnan start
result equ 1
space equ result+2
csub (10:ext_x),space
short m clear the specific NaN code
stz ext_x+6
long m
lda ext_x and do the compare
cmp nan_x
bne diff
lda ext_x+2
cmp nan_x+2
bne diff
lda ext_x+4
cmp nan_x+4
bne diff
lda ext_x+6
cmp nan_x+6
bne diff
lda ext_x+8
cmp nan_x+8
bne diff
lda #1
sta result
bra bye
diff stz result
bye ret (2:result)
nan_x dc h'0000000000000040FF7F' ; Hex encoding of a NaN
end
****************************************************************
*
* int _isinf (extended x);
*
* Check whether x is INF, if so, return 1, otherwise, return 0.
*
****************************************************************
*
_isinf start
result equ 1
space equ result+2
csub (10:ext_x),space
short m
lda ext_x+9 get rid of sign bit
and #%01111111
sta ext_x+9
long m
lda ext_x and do the compare
cmp inf_x
bne diff
lda ext_x+2
cmp inf_x+2
bne diff
lda ext_x+4
cmp inf_x+4
bne diff
lda ext_x+6
cmp inf_x+6
bne diff
lda ext_x+8
cmp inf_x+8
bne diff
lda #1
sta result
bra bye
diff stz result
bye ret (2:result)
inf_x dc h'0000000000000000FF7F' ; Hex encoding of +INF
end

183
lib/lsaneglue/sane.h Normal file
View File

@ -0,0 +1,183 @@
/*
* File: SANE.h
*
* Declarations, macros and prototypes for
* the SANE glue functions in library
* lsaneglue.
*
* Written in 1997 by Soenke Behrens.
* This code is hereby placed into the Public Domain.
*/
#ifndef __SANE__
#define __SANE__
#ifndef __TYPES__
#include <types.h>
#endif
/* Decimal representation constants */
#define SIGDIGLEN 0x001C
#define DECSTROUTLEN 0x0050
/* IEEE default environment constant */
#define IEEEDEFAULTENV 0x0000
typedef short environment;
/* Decimal formatting styles */
#define FLOATDECIMAL 0x0000
#define FIXEDDECIMAL 0x0001
/* Exceptions */
#define INVALID 0x0001
#define UNDERFLOW 0x0002
#define OVERFLOW 0x0004
#define DIVBYZERO 0x0008
#define INEXACT 0x0010
typedef short exception;
/* Ordering relations */
#define GREATERTHAN 0
#define LESSTHAN 1
#define EQUALTO 2
#define UNORDERED 3
typedef short relop;
/* Inquiry classes */
#define SNAN 0
#define QNAN 1
#define INFINITE 2
#define ZERONUM 3
#define NORMALNUM 4
#define DENORMALNUM 5
typedef short numclass;
/* Environmental control */
/* Rounding directions */
#define TONEAREST 0
#define UPWARD 1
#define DOWNWARD 2
#define TOWARDZERO 3
typedef short rounddir;
/* Rounding precisions */
#define EXTPRECISION 0
#define DBLPRECISION 1
#define FLOATPRECISION 2
typedef short roundpre;
/* NAN codes */
#define NANSQRT 1 /* Invalid square root such as sqrt(-1) */
#define NANADD 2 /* Invalid addition such as +INF - +INF */
#define NANDIV 4 /* Invalid division such as 0/0 */
#define NANMUL 8 /* Invalid multiply such as 0 * INF */
#define NANREM 9 /* Invalid rem or mod such as x REM 0 */
#define NANASCBIN 17 /* Conversion of invalid ASCII string */
#define NANCOMP 20 /* Comp NaN converted to floating */
#define NANZERO 21 /* Attempt to create a NaN with zero code */
#define NANTRIG 33 /* Invalid argument to trig routine */
#define NANINVTRIG 34 /* Invalid arg to inverse trig routine */
#define NANLOG 36 /* Invalid argument to log routine */
#define NANPOWER 37 /* Invalid argument to x^i or x^y routine */
#define NANFINAN 38 /* Invalid argument to financial function */
typedef struct decimal
{
short sgn; /* sign 0 for +, 1 for - */
short exp; /* decimal exponent */
struct
{
unsigned char length, text[SIGDIGLEN], unused;
}sig; /* significant digits */
} decimal, Decimal;
typedef struct decform
{
short style; /* FLOATDECIMAL or FIXEDDECIMAL */
short digits;
} decform, DecForm;
typedef void (*haltvector)(void);
/* SANE types are:
* float -- IEEE single precision
* double -- IEEE double precision
* extended -- IEEE extended precision
* comp -- SANE comp type
* Decimal -- SANE decimal string
* DecForm -- Controls formatting of decimal strings
*/
/* Function declarations */
void s_num2dec(DecForm *, extended, Decimal *);
extended s_dec2num(Decimal *);
void s_str2dec(char *, short *, Decimal *, short *);
void s_dec2str(DecForm *, Decimal *, char *);
extended s_fabs(extended);
extended s_fneg(extended);
extended s_remainder(extended, extended, short *);
extended s_sqrt(extended);
extended s_rint(extended);
extended s_scalb(short, extended);
extended s_logb(extended);
extended s_copysign(extended, extended);
extended s_nextfloat(extended, extended);
extended s_nextdouble(extended, extended);
extended s_nextextended(extended, extended);
extended s_log2(extended);
extended s_log(extended);
extended s_log1(extended);
extended s_exp2(extended);
extended s_exp(extended);
extended s_exp1(extended);
extended s_power(extended, extended);
extended s_ipower(extended, short);
extended s_compound(extended, extended);
extended s_annuity(extended, extended);
extended s_tan(extended);
extended s_sin(extended);
extended s_cos(extended);
extended s_atan(extended);
extended s_randomx(extended *);
numclass s_classfloat(extended);
numclass s_classdouble(extended);
numclass s_classcomp(extended);
numclass s_classextended(extended);
long s_signnum(extended);
void s_setexception(exception, long);
long s_testexception(exception);
void s_sethalt(exception, long);
long s_testhalt(exception);
void s_setround(rounddir);
rounddir s_getround(void);
void s_setprecision(roundpre);
roundpre s_getprecision(void);
void s_setenvironment(environment);
void s_getenvironment(environment *);
void s_procentry(environment *);
void s_procexit(environment);
haltvector s_gethaltvector(void);
void s_sethaltvector(haltvector);
relop s_relation(extended, extended);
extended s_nan(unsigned char);
extended s_inf(void);
extended s_pi(void);
/* SANE tool calls */
extern pascal void SANEBootInit(void) inline(0x010A,dispatcher);
extern pascal void SANEStartUp(Word) inline(0x020A,dispatcher);
extern pascal void SANEShutDown(void) inline(0x030A,dispatcher);
extern pascal Word SANEVersion(void) inline(0x040A,dispatcher);
extern pascal void SANEReset(void) inline(0x050A,dispatcher);
extern pascal Boolean SANEStatus(void) inline(0x060A,dispatcher);
extern pascal void SANEFP816(Word, ...) inline(0x090A,dispatcher);
extern pascal void SANEDecStr816(Word, ...) inline(0x0A0A,dispatcher);
extern pascal void SANEElems816(Word, ...) inline(0x0B0A,dispatcher);
/* FPCP find routine, not part of SANE tool set, found in lsaneglue */
int findfpcp(void); /* Returns slot number of FPCP card or -1 if not found */
#endif

1689
lib/lsaneglue/saneglue.asm Normal file
View File

File diff suppressed because it is too large Load Diff

55
lib/lsaneglue/saneglue.macro Normal file
View File

@ -0,0 +1,55 @@
*
* Macros for SANE glue code in saneglue.asm
*
* Written in 1997 by Soenke Behrens.
* This code is hereby placed into the Public Domain.
*
*
* phptr - push a pointer to a variable on the DP
* of a function as DP+offset: Pointer is valid
* even if DP is changed.
*
macro
&lab phptr &n1
&lab pea $0
tdc
clc
adc #&n1
pha
mend
*
* copyx - copy an 'extended' variable to another
*
macro
&lab copyx &n1,&n2
&lab lda &n1
sta &n2
lda &n1+2
sta &n2+2
lda &n1+4
sta &n2+4
lda &n1+6
sta &n2+6
lda &n1+8
sta &n2+8
mend
*
* sterr - store returned error code in _toolErr
* Must be used _immediately_ after tool call because
* it relies on carry flag being set and A containing
* the error code (if any).
*
macro
&lab sterr
&lab bcs ~&SYSCNT
lda #0
~&SYSCNT sta _toolErr
mend
* End Of File

597
lib/lsaneglue/sanetest.c Normal file
View File

@ -0,0 +1,597 @@
/*
* Test SANE glue code from saneglue.asm
* NB: The purpose of this code is _not_ to perform rigorous
* testing of the numerical correctness of SANE. That is
* taken for a given. The sole purpose is to test the SANE
* glue code (and, by extension, SANE patches such as fpcp).
*
* Does not test gethaltvector/sethaltvector (yet).
*
* Written in 1997 by Soenke Behrens.
* This code is hereby placed into the Public Domain.
*/
#include <math.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#pragma lint -1
#include "sane.h"
#pragma optimize 0x0048 /* Catch errors in parameter passing */
void a_function(void);
int main (void)
{
short i,j;
DecForm convert;
Decimal d;
extended x,y,z;
static char s[258];
rounddir r;
roundpre rp;
environment e1, e2, e3;
haltvector hv1, hv2;
/*
* Test whether we start with IEEE default environment set
*/
s_getenvironment(&e2);
if (e2 != IEEEDEFAULTENV)
printf("SANE environment does not match default environment: %#.4x.\n",e2);
/*
* Test fabs
*/
x = s_fabs(-3.275);
if (x != 3.275)
printf("s_fabs() test failed.\n");
else
printf("s_fabs() test successful.\n");
/*
* Test fneg
*/
x = s_fneg(3.275);
if (x != -3.275)
printf("s_fneg() test failed.\n");
else
printf("s_fneg() test successful.\n");
/*
* Test num2dec and dec2num
*/
convert.style = FLOATDECIMAL;
convert.digits = 8;
s_num2dec(&convert,3.1415926,&d);
if (d.sgn != 0 || d.exp != -7 ||
strncmp(d.sig.text,"31415926",d.sig.length) != 0)
printf("s_num2dec() test failed.\n");
else
printf("s_num2dec() test successful.\n");
x = s_dec2num(&d);
if (fabs(x - 3.1415926) < 1E-15)
printf("s_dec2num() test successful.\n");
else
printf("s_dec2num() test failed.\n");
/*
* Test dec2str and str2dec
*/
convert.style = FLOATDECIMAL;
convert.digits = 8;
s_num2dec(&convert,2.7182818,&d);
s_dec2str(&convert,&d,s);
if (strcmp(s," 2.7182818e+0") != 0)
printf("s_dec2str() test failed.\n");
else
printf("s_dec2str() test successful.\n");
i = 1;
s_str2dec(s,&i,&d,&j);
if (j != 1)
{
fprintf (stderr,"s_str2dec() rejected input string.\n");
exit (EXIT_FAILURE);
}
x = s_dec2num (&d);
if (fabs(x - 2.7182818) < 1E-15)
printf("s_str2dec() test successful.\n");
else
printf("s_str2dec() test failed.\n");
/*
* Test remainder
*/
z = s_remainder (3.1415926,2.7182818,&i);
if (fabs(z - 0.4233108) < 1E-15)
printf("s_remainder() test successful.\n");
else
printf("s_remainder() test failed.\n");
/*
* Test sqrt
*/
z = s_sqrt (2.0);
if (fabs(z - 1.414213562373095048763788073) < 1E-15)
printf("s_sqrt() test successful.\n");
else
printf("s_sqrt() test failed.\n");
/*
* Test rint
*/
z = s_rint (3.1415926);
if (z == 3.0)
printf("s_rint() test successful.\n");
else
printf("s_rint() test failed.\n");
/*
* Test scalb
*/
z = s_scalb (2,1.4142136);
if (fabs(z - 5.6568544) < 1E-15)
printf("s_scalb() test successful.\n");
else
printf("s_scalb() test failed.\n");
/*
* Test logb
*/
z = s_logb (1.234e308);
if (z == 1023.0)
printf("s_logb() test successful.\n");
else
printf("s_logb() test failed.\n");
/*
* Test copysign
*/
z = s_copysign(1.234,-5.678);
if (z == 5.678)
printf("s_copysign() test successful.\n");
else
printf("s_copysign() test failed.\n");
/*
* Test nextfloat
*/
z = s_nextfloat(1.0,1.1);
if (z == 1.00000011920928955078125)
printf("s_nextfloat() test successful.\n");
else
printf("s_nextfloat() test failed.\n");
/*
* Test nextdouble
*/
z = s_nextdouble(1.0,1.1);
if (z == 1.000000000000000222044604925)
printf("s_nextdouble() test successful.\n");
else
printf("s_nextdouble() test failed.\n");
/*
* Test nextextended
*/
z = s_nextextended(1.0,1.1);
/* I only have double constants, so testing this is a bit tricky */
if (fabs(z - 1.000000000000000000108420217) < 1E-15)
printf("s_nextextended() test successful.\n");
else
printf("s_nextextended() test failed.\n");
/*
* Test log2
*/
z = s_log2(1.1);
if (fabs(z - 0.1375035237499350248218483658) < 1E-15)
printf("s_log2() test successful.\n");
else
printf("s_log2() test failed.\n");
/*
* Test log
*/
z = s_log(1.1);
if (fabs(z - 0.09531017980432494078943525193) < 1E-15)
printf("s_log() test successful.\n");
else
printf("s_log() test failed.\n");
/*
* Test log1
*/
z = s_log1(1.1);
if (fabs(z - 0.7419373447293773548238092486) < 1E-15)
printf("s_log1() test successful.\n");
else
printf("s_log1() test failed.\n");
/*
* Test exp2
*/
z = s_exp2(1.1);
if (fabs(z - 2.143546925072586460409712616) < 1E-15)
printf("s_exp2() test successful.\n");
else
printf("s_exp2() test failed.\n");
/*
* Test exp
*/
z = s_exp(1.1);
if (fabs(z - 3.004166023946433378968498551) < 1E-15)
printf("s_exp() test successful.\n");
else
printf("s_exp() test failed.\n");
/*
* Test exp1
*/
z = s_exp1(1.1);
if (fabs(z - 2.004166023946433378968498551) < 1E-15)
printf("s_exp1() test successful.\n");
else
printf("s_exp1() test failed.\n");
/*
* Test power
*/
z = s_power(1.1,2.2);
if (fabs(z - 1.233286300554662750887657818) < 1E-15)
printf("s_power() test successful.\n");
else
printf("s_power() test failed.\n");
/*
* Test ipower
*/
z = s_ipower(1.12345,2);
if (fabs(z - 1.26213990250000013411922628) < 1E-15)
printf("s_ipower() test successful.\n");
else
printf("s_ipower() test failed.\n");
/*
* Test compound
*/
z = s_compound(0.12,2.3);
if (fabs(z - 1.297781121042242946086661681) < 1E-15)
printf("s_compound() test successful.\n");
else
printf("s_compound() test failed.\n");
/*
* Test annuity
*/
z = s_annuity(0.12,2.3);
if (fabs(z - 1.91211699860898026910333708) < 1E-15)
printf("s_annuity() test successful.\n");
else
printf("s_annuity() test failed.\n");
/*
* Test tan
*/
z = s_tan(1.1);
if (fabs(z - 1.96475965724865238239311982) < 1E-15)
printf("s_tan() test successful.\n");
else
printf("s_tan() test failed.\n");
/*
* Test sin
*/
z = s_sin(1.1);
if (fabs(z - 0.8912073600614353802488142031) < 1E-15)
printf("s_sin() test successful.\n");
else
printf("s_sin() test failed.\n");
/*
* Test cos
*/
z = s_cos(1.1);
if (fabs(z - 0.4535961214255773086276909284) < 1E-15)
printf("s_cos() test successful.\n");
else
printf("s_cos() test failed.\n");
/*
* Test atan
*/
z = s_atan(1.1);
if (fabs(z - 0.8329812666744317456186258442) < 1E-15)
printf("s_atan() test successful.\n");
else
printf("s_atan() test failed.\n");
/*
* Test randomx
*/
x = 1.0;
z = s_randomx(&x);
if (z == 16807.0)
printf("s_randomx() test successful.\n");
else
printf("s_randomx() test failed.\n");
/*
* Test classfloat
*/
i = s_classfloat(-0.0);
if (i == 0x03)
printf("s_classfloat() test successful.\n");
else
printf("s_classfloat() test failed.\n");
/*
* Test classdouble
*/
i = s_classdouble(-0.0);
if (i == 0x03)
printf("s_classdouble() test successful.\n");
else
printf("s_classdouble() test failed.\n");
/*
* Test classcomp
*/
i = s_classcomp(-0.0);
if (i == 0x03)
printf("s_classcomp() test successful.\n");
else
printf("s_classcomp() test failed.\n");
/*
* Test classextended
*/
i = s_classextended(-0.0);
if (i == 0x03)
printf("s_classextended() test successful.\n");
else
printf("s_classextended() test failed.\n");
/*
* Test signnum
*/
if (s_signnum(-123.45) == 1 && s_signnum(123.45) == 0)
printf("s_signnum() test successful.\n");
else
printf("s_signnum() test failed.\n");
/*
* Test relation
*/
i = s_relation(1.23,s_nan(2));
if (i == UNORDERED)
printf("s_relation() test successful.\n");
else
printf("s_relation() test failed.\n");
/*
* For the following tests, clear all exceptions the previous
* tests might have generated.
*/
s_setenvironment(IEEEDEFAULTENV);
/*
* Test setexception and testexception
*/
s_setexception(OVERFLOW | INEXACT, 1);
if (s_testexception(INEXACT) && s_testexception(OVERFLOW))
printf("s_setexception() and s_testexception() tests successful.\n");
else
printf("s_setexception() and s_testexception() tests failed.\n");
/* Clear exceptions again */
s_setexception(OVERFLOW | INEXACT, 0);
/*
* Test sethalt and testhalt
*/
s_sethalt(OVERFLOW | INEXACT, 1);
if (s_testhalt(INEXACT) && s_testhalt(OVERFLOW))
printf("s_sethalt() and s_testhalt() tests successful.\n");
else
printf("s_sethalt() and s_testhalt() tests failed.\n");
/* Clear halts again */
s_sethalt(OVERFLOW | INEXACT, 0);
/*
* Test setround and getround
*/
if ((r = s_getround()) != TONEAREST)
{
printf("Rounding direction is not default TONEAREST as required by SANE:\n");
switch (r)
{
case TONEAREST:
printf("Program error, please investigate.\n");
break;
case UPWARD:
printf("Rounding direction is UPWARD.\n");
break;
case DOWNWARD:
printf("Rounding direction is DOWNWARD.\n");
break;
case TOWARDZERO:
printf("Rounding direction is TOWARDZERO.\n");
break;
default:
printf("Undefined rounding direction: %d\n",r);
break;
}
}
s_setround(TOWARDZERO);
if (s_getround() == TOWARDZERO)
printf("s_setround() and s_getround() tests successful.\n");
else
printf("s_setround() and s_getround() tests failed.\n");
/* Set back to earlier value */
s_setround(r);
/*
* Test setprecision and getprecision
*/
if ((rp = s_getprecision()) != EXTPRECISION)
{
printf("Rounding precision is not default \"extended\" as required by SANE:\n");
switch (rp)
{
case EXTPRECISION:
printf("Program error, please investigate.\n");
break;
case DBLPRECISION:
printf("Rounding precision is \"double\".\n");
break;
case FLOATPRECISION:
printf("Rounding precision is \"single\".\n");
break;
default:
printf("Undefined rounding precision: %d\n",r);
break;
}
}
s_setprecision(FLOATPRECISION);
if (s_getprecision() == FLOATPRECISION)
printf("s_setprecision() and s_getprecision() tests successful.\n");
else
printf("s_setprecision() and s_getprecision() tests failed.\n");
/* Set back to earlier value */
s_setprecision(rp);
/*
* Test setenvironment and getenvironment
*/
s_getenvironment(&e2);
if (e2 != IEEEDEFAULTENV)
printf("SANE environment does not match default environment: %#.4x.\n",e2);
s_setenvironment(0x0A0A); /* nonsense value */
s_getenvironment(&e1);
if (e1 == 0x0A0A)
printf("s_setenvironment() and s_getenvironment() tests successful.\n");
else
printf("s_setenvironment() and s_getenvironment() tests failed.\n");
/* Now restore the original environment word */
s_setenvironment(e2);
/*
* Test procentry and procexit
*/
s_getenvironment(&e3);
s_setenvironment(0x0A0A); /* nonsense value */
s_procentry(&e2);
s_getenvironment(&e1);
if (e1 == IEEEDEFAULTENV)
printf("s_procentry() test successful.\n");
else
printf("s_procentry test failed.\n");
s_procexit(e2);
s_getenvironment(&e1);
if (e1 == 0x0A0A)
printf("s_procexit() test successful.\n");
else
printf("s_procexit() test failed.\n");
/* Set environment back to what it was */
s_setenvironment(e3);
/*
* Test sethaltvector and gethaltvector
*/
hv1 = s_gethaltvector();
s_sethaltvector(a_function);
hv2 = s_gethaltvector();
if (hv2 == a_function)
printf("s_sethaltvector() and s_gethaltvector() tests successful.\n");
else
printf("s_sethaltvector() and s_gethaltvector() tests failed.\n");
/* Now restore original vector */
s_sethaltvector(hv1);
/*
* Test pi
*/
z = s_pi();
if (fabs(z - 3.141592653589793238512808959) < 1E-15)
printf("s_pi() test successful.\n");
else
printf("s_pi() test failed.\n");
/*
* Test nan
*/
z = s_nan(5);
sprintf(s,"%f",z);
if (strcmp(s,"NAN(005)") == 0)
printf("s_nan() test successful.\n");
else
printf("s_nan() test failed.\n");
/*
* Test inf
*/
z = s_inf();
sprintf(s,"%f",z);
if (strcmp(s,"INF") == 0)
printf("s_inf() test successful.\n");
else
printf("s_inf() test failed.\n");
return (0);
}
void a_function(void)
{
printf("Halt occured.\n");
return;
}
/* End Of File */