mirror of
https://github.com/GnoConsortium/gno.git
synced 2024-10-13 14:23:40 +00:00
- initial checkin, as submitted by Soenke Behrens
This commit is contained in:
parent
39e6f0d5ee
commit
c1a44d4166
46
lib/lsaneglue/Makefile
Normal file
46
lib/lsaneglue/Makefile
Normal 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
245
lib/lsaneglue/README
Normal 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
106
lib/lsaneglue/findfpcp.asm
Normal 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
13
lib/lsaneglue/findfpe.c
Normal 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
31
lib/lsaneglue/fpnumtest.c
Normal 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
104
lib/lsaneglue/fpspecnum.asm
Normal 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
183
lib/lsaneglue/sane.h
Normal 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
1689
lib/lsaneglue/saneglue.asm
Normal file
File diff suppressed because it is too large
Load Diff
55
lib/lsaneglue/saneglue.macro
Normal file
55
lib/lsaneglue/saneglue.macro
Normal 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
597
lib/lsaneglue/sanetest.c
Normal 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 */
|
Loading…
Reference in New Issue
Block a user