mirror of
https://github.com/ctm/executor.git
synced 2024-09-29 18:58:01 +00:00
1245 lines
34 KiB
C
1245 lines
34 KiB
C
|
/* 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)
|
||
|
#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)
|
||
|
#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));
|
||
|
|
||
|
}
|