Macintosh-Tools
/
executor
mirror of https://github.com/ctm/executor.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity
executor/src/float4.c

1245 lines
34 KiB
C
Raw Permalink Blame History

/* Copyright 1990, 1995 by Abacus Research and
* Development, Inc. All rights reserved.
*/
#if !defined (OMIT_RCSID_STRINGS)
char ROMlib_rcsid_float4[] =
"$Id: float4.c 88 2005-05-25 03:59:37Z ctm $";
#endif
/* Forward declarations in SANE.h (DO NOT DELETE THIS LINE) */
/*
* TODO:figure out what the two highest bits of sel do.
* they are mentioned in think C's <sane.h>, and have come
* up in FreeHand 1.0
*/
#include "rsys/common.h"
#if defined (NEXT)
#define INLINE_MATH
#endif
#include <math.h>
#include <string.h>
#include <stdlib.h>
#include <float.h>
#include "SANE.h"
#include "rsys/float.h"
#include "rsys/floatconv.h"
#include "rsys/float_fcw.h"
#if !defined (CYGWIN32)
#define IEEE_T_FORMAT "%.20Lf"
#define IEEE_T_PRINT_CAST ieee_t
#else
#define IEEE_T_FORMAT "%.20f"
#define IEEE_T_PRINT_CAST double
#endif
#if defined (mc68000)
/* This table maps bits in the 68881 FPCR to bits in the SANE environment
* word. This bit number of the fpcr bit is the index into the table.
*/
static unsigned short m68k_fpcr_envword_table[16] = {
0, 0, 0, 0, /* These bits are unused. */
(1 << 13), (1 << 14), /* Rounding mode; map wrong, fixed below. */
(1 << 6 ), (1 << 5 ), /* Rounding precision. */
(1 << 4 ), (1 << 4 ), /* Inexact exceptions enabled. */
(1 << 3 ), /* Divide by zero exceptions enabled. */
(1 << 1 ), /* Underflow exceptions enabled. */
(1 << 2 ), /* Overflow excpetions enabled. */
(1 << 0 ), (1 << 0), (1 << 0) /* Invalid exceptions enabled (inexact map!)*/
};
/* This table maps bits in the 68881 FPSR to bits in the SANE environment
* word. This bit number of the fpsr bit is the index into the table.
* Only the low 8 bits of the FPSR map to anything in the SANE word.
*/
static unsigned short m68k_fpsr_envword_table[8] = {
0, 0, 0, /* These bits are unused. */
(1 << 12), /* Inexact exception raised. */
(1 << 11), /* Divide by zero exception raised. */
(1 << 9 ), /* Underflow exception raised. */
(1 << 10), /* Overflow exception raised. */
(1 << 8 ) /* Invalid operation exception raised. */
};
/* Bits we affect. Preserve all of the other ones. */
#define FPCR_BITS_WE_USE 0x0000FFF0
#define FPSR_BITS_WE_USE 0x000000F8
/* We need these to compensate for differing bit patterns for the four
* rounding modes.
*/
#define ROUNDING_MODE_HIGH_BIT (1 << 14)
#define ROUNDING_MODE_LOW_BIT (1 << 13)
#elif defined (i386)
static unsigned short i387_fcw_envword_table[] = {
(1 << 0), /* Invalid operation MASKED (backwards from SANE). */
0, /* Denormal exception masked; no analog in SANE. */
(1 << 3), /* Division by zero exception MASKED. */
(1 << 2), /* Overflow exception MASKED. */
(1 << 1), /* Underflow exception MASKED. */
(1 << 4), /* Precision -> inexact MASKED. */
0, 0, /* Not used. */
(1 << 5 ), (1 << 6 ), /* Precision control; mapping wrong! Fixed below. */
(1 << 14), (1 << 13) /* Rounding control. */
};
static unsigned short i387_fsw_envword_table[] = {
(1 << 8 ), /* Invalid operation exception signaled. */
0, /* Denormal exception signaled; no SANE analog. */
(1 << 11), /* Division by zero exception signaled. */
(1 << 10), /* Overflow exception signaled. */
(1 << 9 ), /* Underflow exception signaled. */
(1 << 12) /* Inexact operation exception signaled. */
};
/* Bits we affect. Preserve all of the other ones. */
#define FCW_BITS_WE_USE 0x0F3D
#define FSW_BITS_WE_USE 0x003D
/* We need these to compensate for differing bit patterns for the four
* precision modes.
*/
#define PRECISION_MODE_HIGH_BIT (1 << 6)
#define PRECISION_MODE_LOW_BIT (1 << 5)
#if !defined (PACKED)
# define PACKED __attribute__ ((packed))
#endif
typedef struct {
unsigned short fcw PACKED;
unsigned short unused1 PACKED;
unsigned short fsw PACKED;
unsigned short unused2 PACKED;
unsigned short tag_word PACKED;
unsigned short unused3 PACKED;
ULONGINT fip PACKED;
unsigned short fcs PACKED;
unsigned short opcode PACKED;
ULONGINT foo PACKED;
unsigned short fos PACKED;
unsigned short unused4 PACKED;
} i387_env_t;
PUBLIC uint32
ROMlib_get_fcw_fsw (void)
{
i387_env_t i387_env;
asm ("fnstenv %0 ; fwait" : "=m" (i387_env));
return (i387_env.fcw << 16) | i387_env.fsw;
}
PUBLIC void
ROMlib_set_fcw_fsw (uint32 fcwfsw)
{
i387_env_t i387_env;
asm ("fnstenv %0 ; fwait" : "=m" (i387_env));
i387_env.fcw = fcwfsw >> 16;
i387_env.fsw = fcwfsw;
asm ("fldenv %0" : : "m" (i387_env));
}
PUBLIC void
ROMlib_compare_fcw_fsw (uint32 fcwfsw, const char *func, int line)
{
uint16 old_fcw;
uint16 old_fsw;
i387_env_t i387_env;
old_fcw = fcwfsw >> 16;
old_fsw = fcwfsw;
asm ("fnstenv %0 ; fwait" : "=m" (i387_env));
if (old_fcw != i387_env.fcw)
fprintf (stderr, "%s(%d) old fcw = %x, new fcw = %x\n", func, line,
old_fcw, i387_env.fcw);
if (old_fsw != i387_env.fsw)
fprintf (stderr, "%s(%d) old fsw = %x, new fsw = %x\n", func, line,
old_fsw, i387_env.fsw);
}
#endif /* defined (i386) */
/* We keep track of SANE's idea of what halts are enabled separately
* from what halts are actually enabled in hardware (e.g. 80387).
* This way Fgetenv will return the same information as Fsetenv,
* without forcing us to be able to generate a real floating point
* exception. Eventually this needs to be changed so we *do* get
* a real exception, and signal appropriately.
*/
static uint8 halts_enabled;
P_SAVED0D1A0A1_2 (PUBLIC pascal trap, void, ROMlib_Fsetenv, INTEGER *,
dp, INTEGER, sel)
{
unsigned short env;
int i;
/* Note which halts are enabled, but don't enable them in hardware.
* This is a hack so we don't get real floating point exceptions
* and should go away when we properly handle SANE exception
* handling.
*/
env = CW (*dp);
halts_enabled = env & 0x1F;
env &= ~0x1F;
#if defined (mc68000)
{
ULONGINT fpcr, fpsr;
/* Rearrange rounding mode bits into 68881 format. */
if (env & ROUNDING_MODE_LOW_BIT)
env ^= ROUNDING_MODE_HIGH_BIT;
/* Grab the fpcr + fpsr and zero out the bits we might set. We'll
* preserve all of the bits we never affect.
*/
asm ("fmovel fpcr, %0 ; fmovel fpsr, %0" : "=g" (fpcr), "=g" (fpsr));
fpcr &= ~FPCR_BITS_WE_USE;
fpsr &= ~FPSR_BITS_WE_USE;
/* Compute bits for the fpcr. */
for (i = NELEM (m68k_fpcr_envword_table) - 1; i >= 0; i--)
if (env & m68k_fpcr_envword_table[i])
fpcr |= (1 << i);
/* Compute bits for the fpsr. */
for (i = NELEM (m68k_fpsr_envword_table) - 1; i >= 0; i--)
if (env & m68k_fpsr_envword_table[i])
fpsr |= (1 << i);
/* Save the computed fpcr and fpsr. */
asm ("fmovel %0, fpcr ; fmovel %1, fpsr" : : "g" (fpcr), "g" (fpsr));
}
#elif defined (i386)
#if !defined (__CHECKER__)
{
unsigned short fcw, fsw;
i387_env_t i387_env;
/* Grab the fcw + fsw and zero out the bits we might set. We'll
* preserve all of the bits we never affect. We use fnstenv so we
* can save the fsw at the end.
*/
asm ("fnstenv %0 ; fwait" : "=m" (i387_env));
fcw = i387_env.fcw;
fsw = i387_env.fsw;
/* Mask out bit we are going to set up. */
fcw &= ~FCW_BITS_WE_USE;
fsw &= ~FSW_BITS_WE_USE;
#if 0
/* No longer necessary, since we prevent them from enabling
* *any* halts as far as the 80387 is concerned.
*/
/* 80387 semantics are that exceptions are "sticky" and stay around
* until explicitly cleared. If that exception becomes unmasked,
* and is still pending, we'll get an exception then. Panorama 3
* does an intentional division by zero with division-by-zero
* exceptions masked. Then later it reenables division-by-zero
* faults. On the 80387, this causes the pending division by zero
* exception to be triggered by the next floating point opcode!
* As a workaround, we see which exceptions we're about to unmask
* and make sure none of them are pending. Otherwise, we'll
* end up getting an exception. A better approach would be
* to keep track of this information separately elsewhere,
* so it doesn't trip up the 80387 but the information isn't
* lost. Oh well; this SANE implementation would fail a rigorous
* SANE test suite in many other ways, and this should be good
* enough for almost all programs.
*/
if (env & ((env & 0x1F) << 8))
{
warning_unimplemented ("About to clear pending SANE exception "
"information to avoid an 80387 exception. "
"Technically we should not be discarding "
"this information, and should allow "
"unmasked exceptions to be set here.");
env &= ~((env & 0x1F) << 8);
}
#endif
/* Compensate for different bit patterns for precision control.
* [SANE -> 80387]: 00 -> 11, 01 -> 10, 10 -> 00, 11 -> 01. */
if (!(env & PRECISION_MODE_HIGH_BIT))
env ^= (PRECISION_MODE_HIGH_BIT | PRECISION_MODE_LOW_BIT);
else
env &= ~PRECISION_MODE_HIGH_BIT;
/* Compute bits for the fcw. */
fcw |= 0x3D;/* Start out with exceptions masked, so ^ 1 turns them "on". */
for (i = NELEM (i387_fcw_envword_table) - 1; i >= 0; i--)
if (env & i387_fcw_envword_table[i])
fcw ^= (1 << i);
/* Compute bits for the fsw. */
for (i = NELEM (i387_fsw_envword_table) - 1; i >= 0; i--)
if (env & i387_fsw_envword_table[i])
fsw |= (1 << i);
/* Save the computed fcw and fsw. */
i387_env.fcw = fcw;
i387_env.fsw = fsw;
asm ("fldenv %0" : : "m" (i387_env));
}
#endif
#elif defined(__alpha) || defined (powerpc) || defined (__ppc__)
#warning ROMlib_Fsetenv not implemented!
signal(SIGFPE, SIG_IGN);
#else
#warning ROMlib_Fsetenv not implemented!
gui_abort ();
#endif
warning_floating_point ("setenv(0x%04X)", (unsigned) (uint16) CW (*dp));
}
P_SAVED0D1A0A1_2 (PUBLIC pascal trap, void, ROMlib_Fgetenv, INTEGER *,
dp, INTEGER, sel)
{
unsigned short env;
int i;
#if defined (mc68000)
ULONGINT fpcr, fpsr;
/* Default to all zero bits. */
env = 0;
/* Grab FP status and control registers. */
asm ("fmovel fpcr,%0 ; fmovel fpsr,%1" : "=g" (fpcr), "=g" (fpsr));
/* Grab bits from the fpcr. */
for (i = NELEM (m68k_fpcr_envword_table) - 1; i >= 0; i--)
if (fpcr & (1 << i))
env |= m68k_fpcr_envword_table[i];
/* Grab bits from the fpsr. */
for (i = NELEM (m68k_fpsr_envword_table) - 1; i >= 0; i--)
if (fpsr & (1 << i))
env |= m68k_fpsr_envword_table[i];
/* Correct for different 2 bit patterns for rounding modes between
* SANE and the 68881.
*/
if (env & ROUNDING_MODE_LOW_BIT)
env ^= ROUNDING_MODE_HIGH_BIT;
#elif defined (i386)
/* Volatile because targets of fnstcw and fnstsw have to be in memory. */
volatile unsigned short mem_fcw, mem_fsw;
unsigned short fcw, fsw;
/* Default to all zero bits but with all exceptions enabled. We do it this
* way because the meanings of the 387 exception enable bits are reversed
* from those of SANE. By using XOR and starting these bits out as 1,
* we set these back to zero when exceptions are "masked", which is what
* SANE expects.
*/
env = 0x1F; /* Low 5 bits set. */
/* Fetch the floating control word and the floating status word. */
asm ("fnstcw %0 ; fnstsw %1 ; fwait" : "=m" (mem_fcw), "=m" (mem_fsw));
fcw = mem_fcw;
fsw = mem_fsw;
/* Grab bits from the fcw. */
for (i = NELEM (i387_fcw_envword_table) - 1; i >= 0; i--)
if (fcw & (1 << i))
env ^= i387_fcw_envword_table[i];
/* Grab bits from the fsw. */
for (i = NELEM (i387_fsw_envword_table) - 1; i >= 0; i--)
if (fsw & (1 << i))
env ^= i387_fsw_envword_table[i];
/* Compensate for different bit patterns for precision control.
* [80387 -> SANE]: 00 -> 10, 01 -> 11, 10 -> 01, 11 -> 00.
*/
if (env & PRECISION_MODE_HIGH_BIT)
env ^= (PRECISION_MODE_HIGH_BIT | PRECISION_MODE_LOW_BIT);
else
env |= PRECISION_MODE_HIGH_BIT;
#elif defined(__alpha) || defined(powerpc) || defined (__ppc__)
#warning ROMlib_Fgetenv not properly implemented!
env = 0;
#else
#warning ROMlib_Fgetenv not implemented!
gui_abort ();
#endif
/* We now ignore what exceptions the hardware thinks is enabled,
* and just faithfully report whatever the program set up in the
* last setenv.
*/
env = (env & ~0x1F) | halts_enabled;
/* Return the computed environment word. */
*(unsigned short *) dp = CW(env);
warning_floating_point ("Returning 0x%04X", (unsigned) env);
}
P_SAVED0D1A0A1_2 (PUBLIC pascal trap, void, ROMlib_Fprocentry, INTEGER *,
dp, INTEGER, sel)
{
static INTEGER default_environment = 0; /* Always == 0. */
warning_floating_point (NULL_STRING);
/* Save the old environment. */
C_ROMlib_Fgetenv (dp, 0);
/* Set up the default environment. */
C_ROMlib_Fsetenv (&default_environment, 0);
}
P_SAVED0D1A0A1_2 (PUBLIC pascal trap, void, ROMlib_Fprocexit, INTEGER *, dp,
INTEGER, sel)
{
INTEGER swapped_old_env;
INTEGER swapped_new_env;
/* FIXME - the behavior of this function is not likely to be correct for
* the cases where exceptions are lurking, waiting to be signaled.
*/
warning_floating_point (NULL_STRING);
#define EXCEPTION_BITS_MASK 0x1F00
/* Get the old environment. */
C_ROMlib_Fgetenv (&swapped_old_env, 0);
/* Compute the new environment (which is swapped). */
swapped_new_env = ((*dp & ~CWC (EXCEPTION_BITS_MASK))
| (swapped_old_env & CWC (EXCEPTION_BITS_MASK)));
/* Set up the new environment. */
C_ROMlib_Fsetenv (&swapped_new_env, 0);
}
P_SAVED0D1A0A1_2 (PUBLIC pascal trap, void, ROMlib_Ftestxcp, INTEGER *,
dp, INTEGER, sel)
{
INTEGER env;
warning_floating_point (NULL_STRING);
/* Fetch the current environment. */
C_ROMlib_Fgetenv (&env, 0);
env = CW (env);
/* Clear dp's high byte. */
*dp &= CWC (0x00FF);
/* See if any of the specified exception bits are set. */
if ((env >> 8) & ((unsigned char *)dp)[1])
*dp |= CWC (0x100); /* Return 1 in the high byte. */
}
P_SAVED0D1A0A1_2 (PUBLIC pascal trap, void, ROMlib_FsqrtX, x80_t *,
dp, unsigned short, sel)
{
DECLAREINOUT();
/* FIXME - may lose precision! */
ieee_to_x80 (out = sqrt (in = x80_to_ieee (dp)), dp);
warning_floating_point ("sqrt(" IEEE_T_FORMAT ") == " IEEE_T_FORMAT "",
(IEEE_T_PRINT_CAST) in, (IEEE_T_PRINT_CAST) out);
}
P_SAVED0D1A0A1_3 (PUBLIC pascal trap, void, ROMlib_FscalbX, INTEGER *,
sp, x80_t *, dp, unsigned short, sel)
{
int scale;
DECLAREINOUT();
/* FIXME - may lose precision! */
scale = CW(*(short *)sp);
ieee_to_x80 (out = scalb (in = x80_to_ieee (dp), scale), dp);
warning_floating_point ("scalb(" IEEE_T_FORMAT ", %d) == " IEEE_T_FORMAT "",
(IEEE_T_PRINT_CAST) in, scale, (IEEE_T_PRINT_CAST) out);
}
P_SAVED0D1A0A1_2 (PUBLIC pascal trap, void, ROMlib_FlogbX, x80_t *,
dp, unsigned short, sel)
{
DECLAREINOUT();
/* FIXME - may lose precision! */
ieee_to_x80 (out = logb (in = x80_to_ieee (dp)), dp);
warning_floating_point ("logb(" IEEE_T_FORMAT ") == " IEEE_T_FORMAT "", (IEEE_T_PRINT_CAST) in, (IEEE_T_PRINT_CAST) out);
}
P_SAVED0D1A0A1_2 (PUBLIC pascal trap, void, ROMlib_FabsX, x80_t *,
dp, unsigned short, sel)
{
warning_floating_point (NULL_STRING);
SET_X80_SGN (dp, 0);
}
P_SAVED0D1A0A1_2(PUBLIC pascal trap, void, ROMlib_FnegX, x80_t *,
dp, unsigned short, sel)
{
#if ERROR_SUPPORTED_P (ERROR_FLOATING_POINT)
ieee_t before;
before = x80_to_ieee (dp);
#endif
SET_X80_SGN (dp, !(GET_X80_SGN (dp)));
warning_floating_point ("neg(" IEEE_T_FORMAT ") == " IEEE_T_FORMAT "",
(IEEE_T_PRINT_CAST) before, (IEEE_T_PRINT_CAST) x80_to_ieee (dp));
}
P_SAVED0D1A0A1_3 (PUBLIC pascal trap, void, ROMlib_Fcpysgnx, x80_t *,
sp, x80_t *, dp, unsigned short, sel)
{
warning_floating_point (NULL_STRING);
/* This looks strange because we are copying dst's sign to src, but
* that is what the Apple Numerics Manual specifies (p. 150), and is
* what the old float4.c used to do.
*/
SET_X80_SGN (sp, GET_X80_SGN (dp));
}
P_SAVED0D1A0A1_2 (PUBLIC pascal trap, void, ROMlib_FrintX, x80_t *,
dp, unsigned short, sel)
{
DECLAREINOUT();
/* FIXME - may lose precision! */
ieee_to_x80 (out = rint (in = x80_to_ieee (dp)), dp);
warning_floating_point ("rint(" IEEE_T_FORMAT ") == " IEEE_T_FORMAT "", (IEEE_T_PRINT_CAST) in, (IEEE_T_PRINT_CAST) out);
}
P_SAVED0D1A0A1_2 (PUBLIC pascal trap, void, ROMlib_FtintX, x80_t *,
dp, unsigned short, sel)
{
DECLAREINOUT();
register ieee_t n = x80_to_ieee (dp);
in = n;
/* FIXME - may lose precision! */
if (n >= 0)
ieee_to_x80 (out = floor (n), dp);
else
ieee_to_x80 (out = -floor (-n), dp);
warning_floating_point ("tint(" IEEE_T_FORMAT ") == " IEEE_T_FORMAT "", (IEEE_T_PRINT_CAST) in, (IEEE_T_PRINT_CAST) out);
}
/* The SIMPLE_OP macro extracts the commonality from several functions. */
#define NOT_BINARY_OP 0
#define IS_BINARY_OP 1
#define SIMPLE_OP(name, op, is_binary_op) \
do { \
DECLAREIN2OUT(); \
register ieee_t dest; \
\
if (is_binary_op) { \
dest = x80_to_ieee (dp); \
in2 = dest; \
} else \
in2 = 0.0; \
/* Add the appropriate value. */ \
switch (sel & OPCODE_MASK) { \
case FX_OPERAND: \
dest op ( in1 = x80_to_ieee ((const x80_t *) sp)); \
break; \
case FD_OPERAND: \
dest op ( in1 = f64_to_ieee ((const f64_t *) sp)); \
break; \
case FS_OPERAND: \
dest op ( in1 = f32_to_ieee ((const f32_t *) sp)); \
break; \
case FI_OPERAND: \
dest op (in1 = CW (*(short *) sp)); \
break; \
case FL_OPERAND: \
dest op (in1 = CL (*(long *)(sp))); \
break; \
case FC_OPERAND: \
dest op (in1 = comp_to_ieee ((const comp_t *) sp)); \
break; \
default: \
dest = 0.0; /* Here to avoid compiler warnings. */ \
gui_abort(); \
} \
\
/* Write out the value. */ \
ieee_to_x80 (dest, dp); \
out = dest; \
if (is_binary_op) \
warning_floating_point (name "(" IEEE_T_FORMAT ", " IEEE_T_FORMAT ") == " IEEE_T_FORMAT "", \
(IEEE_T_PRINT_CAST) in2, (IEEE_T_PRINT_CAST) in1, (IEEE_T_PRINT_CAST) out); \
else \
warning_floating_point (name "(" IEEE_T_FORMAT ") == " IEEE_T_FORMAT "", \
(IEEE_T_PRINT_CAST) in1, (IEEE_T_PRINT_CAST) out); \
} while (0)
P_SAVED0D1A0A1_3 (PUBLIC pascal trap, void, ROMlib_Faddx, void *, sp,
x80_t *, dp, unsigned short, sel)
{
SIMPLE_OP ("add", +=, IS_BINARY_OP);
}
P_SAVED0D1A0A1_3 (PUBLIC pascal trap, void, ROMlib_Fsubx, void *, sp,
x80_t *, dp, unsigned short, sel)
{
SIMPLE_OP ("sub", -=, IS_BINARY_OP);
}
P_SAVED0D1A0A1_3 (PUBLIC pascal trap, void, ROMlib_Fmulx, void *, sp,
x80_t *, dp, unsigned short, sel)
{
SIMPLE_OP ("mul", *=, IS_BINARY_OP);
}
PRIVATE LONGINT halt_vec;
P_SAVED0D1A0A1_2 (PUBLIC pascal trap, void, ROMlib_Fsethv, LONGINT *, hvp,
unsigned short, sel)
{
halt_vec = *hvp;
}
P_SAVED0D1A0A1_2 (PUBLIC pascal trap, void, ROMlib_Fgethv, LONGINT *, hvp,
unsigned short, sel)
{
*hvp = halt_vec;
}
P_SAVED0D1A0A1_3 (PUBLIC pascal trap, void, ROMlib_Fdivx, void *, sp,
x80_t *, dp, unsigned short, sel)
{
SIMPLE_OP ("div", /=, IS_BINARY_OP);
}
P_SAVED0D1A0A1_3 (PUBLIC pascal trap, void, ROMlib_Fx2X, void *, sp,
x80_t *, dp, unsigned short, sel)
{
/* NOTE: this is way slower than it needs to be for the case where we are
* assigning one x80 to another.
*/
SIMPLE_OP ("assign", =, NOT_BINARY_OP);
}
P_SAVED0D1A0A1_3 (PUBLIC pascal trap, void, ROMlib_FX2x, x80_t *,
sp, void *, dp, unsigned short, sel)
{
DECLAREIN();
register ieee_t val = x80_to_ieee (sp);
/* FIXME - should trigger exceptions if val cannot be accurately
* represented in the new type.
*/
in = val;
warning_floating_point ("X2x(" IEEE_T_FORMAT ")", (IEEE_T_PRINT_CAST) in);
switch (sel & OPCODE_MASK) {
case FX_OPERAND:
#if defined (QUADALIGN)
memmove (dp, sp, sizeof *sp); /* struct assign may assume alignment. */
#else
*(x80_t *)dp = *sp;
#endif
break;
case FD_OPERAND:
ieee_to_f64 (val, (f64_t *) dp);
break;
case FS_OPERAND:
ieee_to_f32 (val, (f32_t *) dp);
break;
case FI_OPERAND:
*(short *)dp = CW( (signed short) rint (val));
break;
case FL_OPERAND:
*(long *)dp = CL( (LONGINT) rint (val));
break;
case FC_OPERAND:
ieee_to_comp (val, (comp_t *) dp);
break;
default:
gui_abort();
}
}
P_SAVED1A0A1_3 (PUBLIC pascal trap, void, ROMlib_Fremx, void *, sp,
x80_t *, dp, unsigned short, sel)
{
DECLAREIN2OUT();
register ieee_t n1, n2, ratio;
int n;
/* Fetch first argument. */
n1 = x80_to_ieee (dp);
in1 = n1;
/* Fetch second argument. */
switch (sel & OPCODE_MASK) {
case FX_OPERAND:
n2 = x80_to_ieee ((const x80_t *) sp);
break;
case FD_OPERAND:
n2 = f64_to_ieee ((const f64_t *) sp);
break;
case FS_OPERAND:
n2 = f32_to_ieee ((const f32_t *) sp);
break;
case FI_OPERAND:
n2 = CW(*(short *)sp);
break;
case FL_OPERAND:
n2 = CL(*(long *)sp);
break;
case FC_OPERAND:
n2 = comp_to_ieee ((const comp_t *) sp);
break;
default:
n2 = 0.0; /* Here to avoid compiler warnings. */
gui_abort();
}
in2 = n2;
/* m68k specific stuff commented out so we can test one consistent version. */
#if 0 && defined (mc68000)
asm ("fremx %3,%0 ; fmovel fpsr, %1" : "=f" (n1), "=g" (n)
: "0" (n1), "f" (n2));
n = (n >> 16);
#else /* Not mc68000 */
/* FIXME - may lose precision! */
n = ratio = rint (n1 / n2);
if (n < 0)
n = -n;
n1 = /* drem (n1, n2); */ n1 - ratio * n2; /* djgpp has no drem. */
#endif /* Not mc68000 */
/* Save the frem value. */
ieee_to_x80 (out = n1, dp);
warning_floating_point ("remx(" IEEE_T_FORMAT ", " IEEE_T_FORMAT ") == " IEEE_T_FORMAT "",
(IEEE_T_PRINT_CAST) in1, (IEEE_T_PRINT_CAST) in2, (IEEE_T_PRINT_CAST) out);
/* Put the low-order 7 bits of n into d0.w. */
cpu_state.regs[0].uw.n = (n & 0x7F);
}
#define CCC cpu_state.ccc
#define CCV cpu_state.ccv
#define CCN cpu_state.ccn
#define CCX cpu_state.ccx
#define CCNZ cpu_state.ccnz
P_SAVED0D1A0A1_3 (PUBLIC pascal trap, FCMP_RETURN_TYPE, ROMlib_Fcmpx,
void *, sp, x80_t *, dp, unsigned short, sel)
{
DECLAREIN2();
register ieee_t n1, n2;
/* Fetch first value to compare. */
n1 = x80_to_ieee (dp);
/* Fetch other value to compare. */
switch (sel & OPCODE_MASK) {
case FX_OPERAND:
n2 = x80_to_ieee ((const x80_t *) sp);
break;
case FD_OPERAND:
n2 = f64_to_ieee ((const f64_t *) sp);
break;
case FS_OPERAND:
n2 = f32_to_ieee ((const f32_t *) sp);
break;
case FI_OPERAND:
n2 = CW(*(short *)sp);
break;
case FL_OPERAND:
n2 = CL (* (long *)sp);
break;
case FC_OPERAND:
n2 = comp_to_ieee ((const comp_t *) sp);
break;
default:
n2 = 0.0; /* Here to avoid compiler warnings. */
gui_abort();
}
in1 = n1;
in2 = n2;
/* Compare the two values & set CC bits accordingly. */
#define SET_CCS(x, n, z, v, c) \
do { CCC = (c); CCN = (n); CCV = (v); CCX = (x); CCNZ = !(z); } while (0)
/* Set up the CC bits appropriately. */
if (n1 <= n2)
{
if (n1 == n2)
SET_CCS (0, 0, 1, 0, 0);
else /* n1 < n2 */
SET_CCS (1, 1, 0, 0, 1);
}
else if (n1 > n2)
SET_CCS (0, 0, 0, 0, 0);
else /* Unordered - FIXME; will it actually get here? */
SET_CCS (0, 0, 0, 1, 0);
warning_floating_point ("cmp(" IEEE_T_FORMAT ", " IEEE_T_FORMAT ") == (cnvxz=%d%d%d%d%d)",
(IEEE_T_PRINT_CAST) in1, (IEEE_T_PRINT_CAST) in2,
CCC, CCN, CCV, CCX, !CCNZ);
}
P_SAVED0D1A0A1_3 (PUBLIC pascal trap, FCMP_RETURN_TYPE, ROMlib_FcpXx,
void *, sp, x80_t *, dp, unsigned short, sel)
{
warning_floating_point (NULL_STRING);
/* FIXME - this should signal; calling Fcmpx is only a stopgap hack
* so we can keep testing stuff.
*/
C_ROMlib_Fcmpx (sp, dp, sel);
}
/* Rounds an ASCII string of digits to a string of `desired_digits'
* length, and returns the order-of-magnitude difference between
* this string and the original.
*/
static int
round_string (const char *in, char *out, boolean_t negative_p,
int desired_digits)
{
int in_len, out_len, exponent_change, len_diff;
in_len = strlen (in);
/* First check for the easy case of no rounding. */
if (desired_digits >= in_len)
{
strcpy (out, in);
exponent_change = 0;
}
else
{
char temp[256], *dot;
double d;
/* We'll convert the number to a double, and then round it
* with rint. This should use the rounding mode we
* set in Fsetenv.
*/
sprintf (temp, "%s%.*s.%s", negative_p ? "-" : "", desired_digits, in,
in + desired_digits);
d = atof (temp);
sprintf (out, "%f", rint (d));
/* Axe any floating point residual that may have appeared. */
dot = strchr (out, '.');
if (dot)
*dot = '\0';
/* Strip any leading zeros or minus signs that may have crept in. */
while (out[0] == '0' || out[0] == '-')
memmove (out, out + 1, strlen (out));
exponent_change = in_len - desired_digits;
}
out_len = strlen (out);
len_diff = desired_digits - out_len;
if (len_diff > 0)
memset (out + out_len, '0', len_diff);
out[desired_digits] = '\0';
exponent_change -= len_diff;
return exponent_change;
}
P_SAVED0D1A0A1_4 (PUBLIC pascal trap, void, ROMlib_Fx2dec, DecForm *,
sp2, void *, sp, Decimal *, dp, unsigned short, sel)
{
DECLAREIN();
register ieee_t n;
int digits;
char c_string[256] = "?"; /* Big enough to be safe. */
switch (sel & OPCODE_MASK) {
case FX_OPERAND:
n = x80_to_ieee ((const x80_t *) sp);
break;
case FD_OPERAND:
n = f64_to_ieee ((const f64_t *) sp);
break;
case FS_OPERAND:
n = f32_to_ieee ((const f32_t *) sp);
break;
case FI_OPERAND:
n = CW (*(short *)sp);
break;
case FL_OPERAND:
n = CL (*(long *)sp);
break;
case FC_OPERAND:
n = comp_to_ieee ((const comp_t *) sp);
break;
default:
n = 0.0; /* Here to avoid compiler warnings. */
gui_abort();
}
in = n;
/* Fetch the number of digits they are interested in. */
digits = CW (*(short *) (&sp2->digits));
/* Compute sign. */
if (n < 0)
{
dp->sgn = CB (1);
n = -n;
}
else
dp->sgn = CB (0);
/* Default to 0 exp, in case of infinity, etc, just to be consistent. */
dp->exp = CWC (0);
if (n == 0)
strcpy (c_string, "0");
else if (n != n) /* Check for NaN */
strcpy (c_string, "N"); /* FIXME - more digits? See SANE p. 28 */
else if (n * 2 == n) /* Check for +-Inf (0 handled above). */
strcpy (c_string, "I");
else /* Normal number. */
{
char *digit_string, *dot;
int exponent, digits_to_keep;
/* Convert the number to ASCII. */
digit_string = alloca (SIGDIGLEN + 256); /* tons of extra space */
#if !defined (CYGWIN32)
sprintf (digit_string, "%.80Lf", n);
#else
#warning MAY LOSE PRECISION HERE
sprintf (digit_string, "%.80f", (double) n);
#endif
dot = strchr (digit_string, '.');
if (dot == NULL)
exponent = 0;
else
{
exponent = dot - &digit_string[strlen (digit_string) - 1];
memmove (dot, dot + 1, strlen (dot)); /* nuke the decimal point. */
}
/* Nuke any leading zeros. */
while (*digit_string == '0')
digit_string++;
/* Check which format they want and act accordingly. */
if ((sp2->style & CWC (DECIMALTYPEMASK)) == CWC (FloatDecimal))
{
/* Floating style. */
digits_to_keep = digits;
}
else
{
/* Fixed style. */
digits_to_keep = strlen (digit_string) + exponent + digits;
}
/* Round the value appropriately. */
if (digits_to_keep <= 0)
c_string[0] = '\0'; /* zero */
else
exponent += round_string (digit_string, c_string,
CB (dp->sgn), digits_to_keep);
/* Make sure the string is short enough. */
if ((int) strlen (c_string) > digits_to_keep)
c_string[digits_to_keep] = '\0';
/* Replace the empty string with "0". */
if (c_string[0] == '\0')
strcpy (c_string, "0");
dp->exp = CW (exponent);
}
/* See if the generated string is too LONGINT. */
if (strlen (c_string) >= SIGDIGLEN)
#if 0
strcpy (c_string, "?"); /* SANE specs say this is OK. */
#else
{
int old_len, new_len;
old_len = strlen (c_string);
c_string[SIGDIGLEN] = 0;
new_len = SIGDIGLEN;
dp->exp = CW (CW (dp->exp) + old_len - new_len);
}
#endif
/* Copy the generated string out to their Decimal record. */
dp->sig[0] = strlen (c_string);
strncpy ((char *) dp->sig + 1,
c_string, strlen (c_string)); /* Don't copy '\0' */
warning_floating_point ("Fx2dec(" IEEE_T_FORMAT ", digits=%d) == %s%s * 10**%d",
(IEEE_T_PRINT_CAST) in, digits, dp->sgn ? "-" : "",
c_string, CW (dp->exp));
}
#if defined (CYGWIN32)
#define pow(a, b) my_pow10 (b)
PRIVATE double
my_pow10(int i)
{
double retval;
retval = 1;
while (i-- > 0)
retval *= 10;
return retval;
}
#endif
P_SAVED0D1A0A1_3 (PUBLIC pascal trap, void, ROMlib_Fdec2x, Decimal *,
sp, void *, dp, unsigned short, sel)
{
DECLAREIN();
long double n;
INTEGER exp;
#if 0
char c_str[SIGDIGLEN + 1];
#endif
char *p, *last_char;
/* Parse the value. */
switch (sp->sig[1]) {
case '0':
n = 0.0;
break;
case 'N':
/* #warning "Expect an invalid operation error here; we're just making a NaN" */
n = (0.0 / 0.0); /* NaN */
/* FIXME - grab subsequent bytes of sig and stick them in significand;
* see SANE book p.28.
*/
break;
case 'I':
/* #warning "Expect an invalid operation error here; we're just making a +Inf" */
n = (1.0 / 0.0); /* Infinity. */
break;
default:
/* Parse the digits (a potentially large integer) into an ieee_t.
* May lose precision in the boundary cases.
*/
last_char = (char *) sp->sig + sp->sig[0];
for (p = (char *) sp->sig + 1, n = 0; p <= last_char; p++)
n = (n * 10) + (*p - '0');
exp = SWAPSW_IFLE (sp->exp);
if (exp > 0)
n *= pow (10.0, exp);
else
n /= pow (10.0, -exp);
if (sp->sgn)
n = -n;
break;
}
in = n;
/* Write out the value. */
switch (sel & OPCODE_MASK) {
case FX_OPERAND:
ieee_to_x80 (n, (x80_t *) dp);
break;
case FD_OPERAND:
ieee_to_f64 (n, (f64_t *) dp);
break;
case FS_OPERAND:
ieee_to_f32 (n, (f32_t *) dp);
break;
case FI_OPERAND:
*(short *) dp = CW( (signed short) rint (n));
break;
case FL_OPERAND:
*(long *) dp = CL( (LONGINT) rint (n));
break;
case FC_OPERAND:
ieee_to_comp (n, (comp_t *) dp);
break;
default:
gui_abort();
}
warning_floating_point ("Fdec2x(%s%.*s * 10**%d) == " IEEE_T_FORMAT "",
sp->sgn ? "-" : "",
(uint8) sp->sig[0], &sp->sig[1],
CW (sp->exp), (IEEE_T_PRINT_CAST) in);
}
P_SAVED0D1A0A1_3 (PUBLIC pascal trap, void, ROMlib_Fclassx, void *,
sp, INTEGER *, dp, unsigned short, sel)
{
static const unsigned char eight_zeros[] = { 0, 0, 0, 0, 0, 0, 0, 0 };
unsigned short first_word = CW (*(unsigned short *)sp);
warning_floating_point (NULL_STRING);
/* Default to normal number. */
*dp = CWC (NormalNum);
warning_floating_point (NULL_STRING);
switch (sel & OPCODE_MASK) {
case FX_OPERAND:
#define X_INF_OR_NAN ((unsigned short) 0x7FFF)
#define X_NORMNUM_MASK ((unsigned short) 0x8000)
#define X_QNAN_MASK ((unsigned short) 0x4000)
if ((first_word & X_INF_OR_NAN) == X_INF_OR_NAN)
{
if ((((unsigned char *)sp)[2] & 0x7F) == 0
&& !memcmp (((unsigned char *)sp) + 3, eight_zeros, 7))
*dp = CWC (Infinite);
else if (((unsigned short *)sp)[1] & CWC (X_QNAN_MASK))
*dp = CWC (QNaN);
else
*dp = CWC (SNaN);
}
else if ((((unsigned short *)sp)[1] & CWC (X_NORMNUM_MASK)) == 0)
{
if (!memcmp (((char *)sp) + 2, eight_zeros, 8))
*dp = CWC (ZeroNum);
else
*dp = CWC (DenormalNum);
}
break;
case FD_OPERAND:
#define D_SIGN_MASK ((unsigned short) 0x8000)
#define D_INF_OR_NAN ((unsigned short) 0x7FF0)
#define D_NORMNUM_MASK ((unsigned short) 0x7FF0)
#define D_QNAN_MASK ((unsigned short) 0x0008)
if ((first_word & D_INF_OR_NAN) == D_INF_OR_NAN)
{
if ((first_word & 0xF) == 0
&& !memcmp (((char *)sp) + 2, eight_zeros, 6))
*dp = CWC (Infinite);
else if (first_word & D_QNAN_MASK)
*dp = CWC (QNaN);
else
*dp = CWC (SNaN);
}
else if ((first_word & D_NORMNUM_MASK) == 0)
{
if ((first_word & 0xF) == 0
&& !memcmp (((char *)sp) + 2, eight_zeros, 6))
*dp = CWC (ZeroNum);
else
*dp = CWC (DenormalNum);
}
break;
case FS_OPERAND:
{
#define S_INF_OR_NAN 0x78000000
#define S_NORMNUM_MASK 0x78000000
#define S_FRAC_MASK 0x07FFFFFF
#define S_QNAN_MASK 0x04000000
ULONGINT v = CL (*(uint32 *)sp);
if ((v & S_INF_OR_NAN) == S_INF_OR_NAN)
{
if ((v & S_FRAC_MASK) == 0)
*dp = CWC (Infinite);
else if (v & S_QNAN_MASK)
*dp = CWC (QNaN);
else
*dp = CWC (SNaN);
}
else if ((v & S_NORMNUM_MASK) == 0)
{
if ((v & S_FRAC_MASK) == 0)
*dp = CWC (ZeroNum);
else
*dp = CWC (DenormalNum);
}
}
break;
case FC_OPERAND:
{
static const unsigned char comp_nan[] = { 0x80, 0, 0, 0, 0, 0, 0, 0 };
if (!memcmp (sp, eight_zeros, sizeof (comp_t)))
*dp = CWC (ZeroNum);
else if (!memcmp (sp, comp_nan, sizeof comp_nan))
*dp = CWC (SNaN); /* FIXME - should this be signaling? Bill sez so */
/* FIXME - should we let the SNaN get negated, below? */
}
break;
default:
gui_abort ();
break;
}
/* Negate *dp if *sp is negative. Since all types share the same
* sign bit, we only need to check the first byte of the type.
*/
if (*(signed char *)sp < 0)
*dp = CW (0 - CW (*dp));
}
Reference in New Issue View Git Blame Copy Permalink