Commit a713facd authored by anton's avatar anton

worked a bit on m68k.h and power.h

moved hyperbolic functions and falog to primitives
parent 15701043
......@@ -10,4 +10,13 @@ if blocks.fb does not exist, 1 block creates the file, but cannot
read-file from it. Only if the file-id has been created with
open-file, not create-file, read-file works. - anton 6aug94
etags.fs crashes one of my applications (gs.fs). anton 12jan95
\ No newline at end of file
etags.fs crashes one of my applications (gs.fs). anton 12jan95
f. suppresses all digits when it prints 0:
0e0 f. . ok
There's also one other problem with f.:
1e-20 f. 0.00000000000000000001000000000000001 ok
-20e0 falog f. 0.00000000000000000001000000000000001 ok
0.00000000000000000001e0 f. 0.00000000000000000001000000000000001 ok
All this happens under Slackware Linux. Maybe the ecvt in the library
is not so good? anton 17jan95
......@@ -23,13 +23,12 @@ DVI2PS = dvips
MAKEINFO = makeinfo
XCFLAGS = @CFLAGS@
XDEFINES = @DEFS@
SWITCHES = $(XCFLAGS) $(XDEFINES) -D_POSIX_VERSION#-DNDEBUG #turn off assertions
SWITCHES = $(XCFLAGS) $(XDEFINES) #-DNDEBUG #turn off assertions
ENGINE_FLAGS = -fforce-mem -fforce-addr -fomit-frame-pointer -fno-defer-pop -fcaller-saves
CFLAGS = -g -O4 -Wall $(SWITCHES)
#-Xlinker -n puts text and data into the same 256M region
#John Wavrik should use -Xlinker -N to get a writable text (executable)
LDFLAGS = -Xlinker -N @LDFLAGS@
LDFLAGS = @LDFLAGS@
LDLIBS = @LIBS@
prefix = @prefix@
......
......@@ -835,7 +835,7 @@ getopt_long="getopt.o getopt1.o"
fi
for ac_func in rint expm1 log1p
for ac_func in rint expm1 log1p pow10
do
echo $ac_n "checking for $ac_func""... $ac_c" 1>&4
if eval "test \"`echo '${'ac_cv_func_$ac_func'+set}'`\" = set"; then
......
......@@ -94,7 +94,7 @@ AC_FUNC_MEMCMP
AC_REPLACE_FUNCS(memmove strtoul)
AC_CHECK_FUNC(getopt_long,getop_long="",getopt_long="getopt.o getopt1.o")
AC_SUBST(getopt_long)
AC_CHECK_FUNCS(rint expm1 log1p)
AC_CHECK_FUNCS(rint expm1 log1p pow10)
AC_REPLACE_FUNCS(ecvt)
dnl No check for select, because our replacement is no good under
dnl anything but DOS
......
......@@ -89,16 +89,19 @@
: f2/ 2e0 f/ ;
: 1/f 1e0 fswap f/ ;
: falog ( f -- 10^f ) [ 10e0 fln ] FLiteral f* fexp ;
: fsinh fexpm1 fdup fdup 1e0 f+ f/ f+ f2/ ;
: fcosh fexp fdup 1/f f+ f2/ ;
: ftanh f2* fexpm1 fdup 2e0 f+ f/ ;
\ We now have primitives for these, so we need not define them
: fatanh fdup f0< >r fabs 1e0 fover f- f/ f2* flnp1 f2/
r> IF fnegate THEN ;
: facosh fdup fdup f* 1e0 f- fsqrt f+ fln ;
: fasinh fdup fdup f* 1e0 f+ fsqrt f/ fatanh ;
\ : falog ( f -- 10^f ) [ 10e0 fln ] FLiteral f* fexp ;
\ : fsinh fexpm1 fdup fdup 1e0 f+ f/ f+ f2/ ;
\ : fcosh fexp fdup 1/f f+ f2/ ;
\ : ftanh f2* fexpm1 fdup 2e0 f+ f/ ;
\ : fatanh fdup f0< >r fabs 1e0 fover f- f/ f2* flnp1 f2/
\ r> IF fnegate THEN ;
\ : facosh fdup fdup f* 1e0 f- fsqrt f+ fln ;
\ : fasinh fdup fdup f* 1e0 f+ fsqrt f/ fatanh ;
: f.s ." <" fdepth 0 .r ." > " fdepth 0 max maxdepth-.s @ min dup 0
?DO dup i - 1- floats fp@ + f@ f. LOOP drop ;
......@@ -428,9 +428,9 @@ unwary (e.g., floating point addition is not associative) and even a few
for the wary. You should not use them unless you know what you are doing
or you don't care that the results you get are totally bogus. If you
want to learn about the problems of floating point numbers (and how to
avoid them), you might start with @cite{Goldberg, What every computer
scientist should know about floating-point numbers, Computing Surveys
?}.
avoid them), you might start with @cite{David (?) Goldberg, What Every
Computer Scientist Should Know About Floating-Point Arithmetic, ACM
Computing Surveys 23(1):5@minus{}48, March 1991}.
doc-f+
doc-f-
......@@ -449,6 +449,7 @@ doc-fexpm1
doc-fln
doc-flnp1
doc-flog
doc-falog
doc-fsin
doc-fcos
doc-fsincos
......
......@@ -7,6 +7,8 @@
Use -D_POSIX_VERSION for POSIX systems.
*/
#include <unistd.h>
#ifdef DOMAINOS
#define _POSIX_VERSION
#endif
......@@ -31,10 +33,6 @@
# endif
#endif
#if defined (HAVE_UNISTD_H)
# include <unistd.h>
#endif
#define NEW_TTY_DRIVER
#define HAVE_BSD_SIGNALS
/*
......
/*
$Id: m68k.h,v 1.1 1994-12-12 17:10:41 anton Exp $
$Id: m68k.h,v 1.2 1995-01-18 18:41:41 anton Exp $
Copyright 1992 by the ANSI figForth Development Group
This is the machine-specific part for the 68000 and family
......@@ -8,6 +8,12 @@
#include "32bit.h"
#ifdef DIRECT_THREADED
#define CACHE_FLUSH(addr,size) cache_$clear()
/* Clearing the whole cache is a bit drastic, but this is the only
cache control available on the apollo.
*/
/* PFA gives the parameter field address corresponding to a cfa */
#define PFA(cfa) (((Cell *)cfa)+2)
/* PFA1 is a special version for use just after a NEXT1 */
......@@ -22,14 +28,16 @@
/* this is the point where the does code starts if label points to the
* jump dodoes */
#define DOES_CODE(label) ((Xt *)(((char *)label)+8))
#define DOES_CODE(label) ((Xt *)(((char *)CODE_ADDRESS(label))+DOES_HANDLER_SIZE))
/* this is a special version of DOES_CODE for use in dodoes */
#define DOES_CODE1(label) DOES_CODE(label)
/* this stores a jump dodoes at ca */
#define MAKE_DOESJUMP(ca) ({short * _ca = (short *)ca; \
_ca[0] = 0x4ef9; /* jmp.l */ \
*(long *)(_ca+1) = (long)&&dodoes;})
/* this stores a call dodoes at addr */
#define MAKE_DOES_HANDLER(addr) MAKE_CF(addr,symbols[DODOES])
#define DOES_HANDLER_SIZE 8
#define MAKE_DOES_CF(addr,doesp) MAKE_CF(addr,((int)(doesp)-8))
#endif
/*
Copyright 1992 by the ANSI figForth Development Group
This is the machine-specific part for the Power (incl. PPC) architecture
*/
#if !defined(USE_TOS) && !defined(USE_NO_TOS)
#define USE_TOS
#endif
#ifndef INDIRECT_THREADED
#ifndef DIRECT_THREADED
/* #define DIRECT_THREADED */
#endif
#endif
#include "32bit.h"
/* cache flush stuff */
#ifdef DIRECT_THREADED
#warning Direct threading for Power has not been tested
#warning If you get assembly errors, here is the reason why
#define CACHE_FLUSH(addr,size) asm("icbi (%0); isync"::"b"(addr))
/* this assumes size=4 */
/* the mnemonics are for the PPC and the syntax is a wild guess; for
Power the mnemonic for the isync instruction is "ics" and I have
not found an equivalent for the icbi instruction in my reference.
*/
/* PFA gives the parameter field address corresponding to a cfa */
#define PFA(cfa) (((Cell *)cfa)+2)
/* PFA1 is a special version for use just after a NEXT1 */
/* the improvement here is that we may destroy cfa before using PFA1 */
#define PFA1(cfa) PFA(cfa)
/* I'll assume the code resides in the lower (or upper) 32M of the
address space and use absolute addressing in the jumps to the
handlers. This makes it possible to use the full address space for
direct threaded Forth (even on 64-bit PowerPCs). However, the
linker has to ensure that this really happens */
#define JUMP_TARGET_BITS 0
/* assuming the code is in the lower 32M; if it is in the upper 32M,
define JUMP_TARGET_BITS as ~0x3ffffff */
#define JUMP_MASK 0x3fffffc
/* CODE_ADDRESS is the address of the code jumped to through the code field */
#define CODE_ADDRESS(cfa) ((Label)(((*(unsigned *)(cfa))&JUMP_MASK)|JUMP_TARGET_BITS))
/* MAKE_CF creates an appropriate code field at the cfa; ca is the
code address. For those familiar with assembly, this is a `ba'
instruction in both Power and PowerPC assembly languages */
#define MAKE_CF(cfa,ca) (*(long *)(cfa) = 0x48000002|(ca))
/* this is the point where the does code for the word with the xt cfa
starts. Since a branch is only a cell on Power, we can use the
second cell of the cfa for storing the does address */
#define DOES_CODE(cfa) ((Xt *)(((long *)(cfa))[1]))
/* this is a special version of DOES_CODE for use in dodoes */
#define DOES_CODE1(label) DOES_CODE(label)
/* the does handler resides between DOES> and the following Forth
code. Since the code-field jumps directly to dodoes, the
does-handler is not needed for the Power architecture */
#define DOES_HANDLER_SIZE 8
#define MAKE_DOES_HANDLER(addr) 0
/* This makes a code field for a does-defined word. doesp is the
address of the does-code. On the PPC, the code field consists of a
jump to dodoes and the address of the does code */
#define MAKE_DOES_CF(cfa,doesp) ({Xt *_cfa = (Xt *)(cfa); \
MAKE_CF(_cfa, symbols[DODOES]); \
_cfa[1] = (doesp); })
#endif
......@@ -1164,11 +1164,11 @@ r2 = exp(r1);
fexpm1 r1 -- r2 float-ext
""@i{r2}=@i{e}**@i{r1}@minus{}1""
r2 =
#ifdef HAVE_EXPM1
expm1(r1);
extern double expm1(double);
r2 = expm1(r1);
#else
exp(r1)-1.;
r2 = exp(r1)-1.;
#endif
fln r1 -- r2 float-ext
......@@ -1176,21 +1176,34 @@ r2 = log(r1);
flnp1 r1 -- r2 float-ext
""@i{r2}=ln(@i{r1}+1)""
r2 =
#ifdef HAVE_LOG1P
log1p(r1);
extern double log1p(double);
r2 = log1p(r1);
#else
log(r1+1.);
r2 = log(r1+1.);
#endif
flog r1 -- r2 float-ext
""the decimal logarithm""
r2 = log10(r1);
falog r1 -- r2 float-ext
""@i{r2}=10**@i{r1}""
#ifdef HAVE_POW10
extern double pow10(double);
r2 = pow10(r1);
#else
#ifndef M_LN10
#define M_LN10 2.30258509299404568402
#endif
r2 = exp(r1*M_LN10);
#endif
fsin r1 -- r2 float-ext
r2 = sin(r1);
fsincos r1 -- r2 r3 float-ext
""@i{r2}=sin(@i{r1}), @i{r3}=cos(@i{r1})""
r2 = sin(r1);
r3 = cos(r1);
......@@ -1200,6 +1213,24 @@ r2 = sqrt(r1);
ftan r1 -- r2 float-ext
r2 = tan(r1);
fsinh r1 -- r2 float-ext
r2 = sinh(r1);
fcosh r1 -- r2 float-ext
r2 = cosh(r1);
ftanh r1 -- r2 float-ext
r2 = tanh(r1);
fasinh r1 -- r2 float-ext
r2 = asinh(r1);
facosh r1 -- r2 float-ext
r2 = acosh(r1);
fatanh r1 -- r2 float-ext
r2 = atanh(r1);
\ The following words access machine/OS/installation-dependent ANSI
\ figForth internals
\ !! how about environmental queries DIRECT-THREADED,
......
/*
$Id: sparc.h,v 1.9 1995-01-10 18:46:05 anton Exp $
$Id: sparc.h,v 1.10 1995-01-18 18:41:44 anton Exp $
Copyright 1992 by the ANSI figForth Development Group
This is the machine-specific part for a SPARC
......@@ -17,14 +17,12 @@
#ifdef DIRECT_THREADED
#ifndef WORDS_BIGENDIAN
#error Direct threading only supported for big-endian machines.
#error Direct threading only supported for big-endian SPARCs.
/* little endian SPARCs still store instructions in big-endian format,
so you would have to reverse the instructions stores in the following
*/
#endif
/* according to the SPARC V9 architecture manual, we have to use flush,
but as V2.20 does not recognize the opcode */
/* assuming size = 8 */
#define CACHE_FLUSH(addr,size) \
asm("iflush %0; iflush %0+4"::"r"(addr))
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment