diff --git a/arch/386/machine.h b/arch/386/machine.h
index 1b626a3..f582c4d 100644
--- a/arch/386/machine.h
+++ b/arch/386/machine.h
@@ -1,7 +1,7 @@
/*
This is the machine-specific part for Intel 386 compatible processors
- Copyright (C) 1995,1996,1997,1998,2000,2003,2004,2005,2006,2007,2008 Free Software Foundation, Inc.
+ Copyright (C) 1995,1996,1997,1998,2000,2003,2004,2005,2006,2007,2008,2012,2013 Free Software Foundation, Inc.
This file is part of Gforth.
@@ -45,8 +45,6 @@
#define ASM_UM_SLASH_MOD(d1lo, d1hi, n1, n2, n3) \
asm("divl %4": "=a"(n3),"=d"(n2) : "a"(d1lo),"d"(d1hi),"g"(n1):"cc");
-#include "../generic/machine.h"
-
/* 386 and below have no cache, 486 has a shared cache, and the
Pentium and later employ hardware cache consistency, so
flush-icache is a noop */
@@ -102,15 +100,30 @@
/* ecx works only for TOS, and eax, edx don't work for anything (gcc-3.0) */
# else /* !(gcc-2.95 or gcc-3.x) */
# if (__GNUC__==4 && defined(__GNUC_MINOR__) && __GNUC_MINOR__>=2)
-# ifndef __APPLE__
-# define IPREG asm("%ebx")
+# if defined(PIC) || defined(__ANDROID__)
# define SPREG asm("%esi")
-# define RPREG asm("%edi")
-# define TOSREG asm("%edx")
-# else
# define IPREG asm("%edi")
-# define SPREG asm("%esi")
-# define TOSREG asm("%edx")
+# else
+# ifndef __APPLE__
+# define IPREG asm("%ebx")
+# define SPREG asm("%esi")
+# define RPREG asm("%edi")
+# if(__GNUC_MINOR__>=6)
+# define TOSREG asm("%ebp")
+# else
+# define TOSREG asm("%ecx")
+# define TOS_CLOBBERED
+# endif
+# else
+# define IPREG asm("%edi")
+# define SPREG asm("%esi")
+# if(__GNUC_MINOR__>=6)
+# define TOSREG asm("%ebp")
+# else
+# define TOSREG asm("%ecx")
+# define TOS_CLOBBERED
+# endif
+# endif
# endif
# endif /* (gcc-4.2 or later) */
# endif /* !(gcc-2.95 or later) */
@@ -131,3 +144,10 @@
#endif /* defined(FORCE_REG) && !defined(DOUBLY_INDIRECT) && !defined(VM_PROFILING) */
/* #define ALIGNMENT_CHECK 1 */
+
+#if defined(USE_TOS) && defined(TOS_CLOBBERED)
+#define CLOBBER_TOS_WORKAROUND_START sp[0]=spTOS; __asm__ __volatile__ ("" ::: "memory");
+#define CLOBBER_TOS_WORKAROUND_END __asm__ __volatile__ ("" ::: "memory"); spTOS=sp[0];
+#endif
+
+#include "../generic/machine.h"
diff --git a/arch/amd64/machine.h b/arch/amd64/machine.h
index 500cd20..17d61cf 100644
--- a/arch/amd64/machine.h
+++ b/arch/amd64/machine.h
@@ -89,12 +89,18 @@ explicit register allocation and efforts to stop coalescing.
#define RPREG asm("%r13")
#define FPREG asm("%r12")
#define TOSREG asm("%r14")
-#define SPREG asm("%r15")
-#define IPREG asm("%rbx")
-#if 0
-#define LPREG asm("%rbp") /* doesn't work now */
+#if (__GNUC__==4 && defined(__GNUC_MINOR__) && __GNUC_MINOR__!=6)
+# define SPREG asm("%r15")
+# define IPREG asm("%rbx")
#endif
+#if (__GNUC__==4 && defined(__GNUC_MINOR__) && __GNUC_MINOR__>=7)
+#define LPREG asm("%rbp") /* works with GCC 4.7.x */
+#endif
+#if (__GNUC__==4 && defined(__GNUC_MINOR__) && __GNUC_MINOR__>=8)
+#define FTOSREG asm("%xmm7")
+#else
#define FTOSREG asm("%xmm8")
#endif
+#endif
#define GOTO_ALIGN asm(".p2align 4,,7");
diff --git a/arch/generic/machine.h b/arch/generic/machine.h
index dd75c34..b75cc1b 100644
--- a/arch/generic/machine.h
+++ b/arch/generic/machine.h
@@ -47,6 +47,11 @@
#endif
#endif
+#ifndef CLOBBER_TOS_WORKAROUND_START
+#define CLOBBER_TOS_WORKAROUND_START
+#define CLOBBER_TOS_WORKAROUND_END
+#endif
+
#ifndef INDIRECT_THREADED
#ifndef DIRECT_THREADED
#define DIRECT_THREADED
diff --git a/cross.fs b/cross.fs
index 59d12f3..670995a 100644
--- a/cross.fs
+++ b/cross.fs
@@ -691,7 +691,7 @@ Variable comp-state
['] pi-undefined , \ target plugin action
8765 , \ plugin magic
[IFDEF] value!
- ['] value! !to
+ ['] value! set-to
[THEN]
DOES> perform ;
diff --git a/engine/engine.c b/engine/engine.c
index e4ed239..cec5815 100644
--- a/engine/engine.c
+++ b/engine/engine.c
@@ -445,7 +445,7 @@ Label *gforth_engine(Xt *ip0, Cell *sp0, Cell *rp0, Float *fp0, Address lp0 sr_p
#else
SET_IP(ip);
SUPER_END; /* count the first block, too */
- FIRST_NEXT;
+ NEXT;
#endif
#ifdef CPU_DEP3
@@ -453,7 +453,7 @@ Label *gforth_engine(Xt *ip0, Cell *sp0, Cell *rp0, Float *fp0, Address lp0 sr_p
#endif
#include PRIM_I
- after_last: return (Label *)0;
+ after_last: FIRST_NEXT;
/*needed only to get the length of the last primitive */
return (Label *)0;
diff --git a/extend.fs b/extend.fs
index 6229812..f599496 100644
--- a/extend.fs
+++ b/extend.fs
@@ -199,7 +199,7 @@ variable span ( -- c-addr ) \ core-ext-obsolescent
\G editing capabilites are available. The length of the string is
\G stored in @code{span}; it does not include the <return>
\G character. OBSOLESCENT: superceeded by @code{accept}.
- 0 rot over
+ everyline 0 rot over
BEGIN ( maxlen span c-addr pos1 )
key decode ( maxlen span c-addr pos2 flag )
>r 2over = r> or
diff --git a/gforth.el b/gforth.el
index d2b2661..48a9b3c 100644
--- a/gforth.el
+++ b/gforth.el
@@ -510,9 +510,7 @@ End:\" construct).")
sub
))
mapped)))
- (let ((result (cons regexp sub-list)))
- (byte-compile 'result)
- result)))
+ (cons regexp sub-list)))
(defun forth-compile-words ()
"Compile the the words from `forth-words' and `forth-indent-words' into
@@ -726,12 +724,11 @@ End:\" construct).")
(get-text-property from 'fontified))
(forth-update-properties from to)))))
-(eval-when-compile
- (byte-compile 'forth-set-word-properties)
- (byte-compile 'forth-next-known-forth-word)
- (byte-compile 'forth-update-properties)
- (byte-compile 'forth-delete-properties)
- (byte-compile 'forth-get-regexp-branch))
+(byte-compile 'forth-set-word-properties)
+(byte-compile 'forth-next-known-forth-word)
+(byte-compile 'forth-update-properties)
+(byte-compile 'forth-delete-properties)
+(byte-compile 'forth-get-regexp-branch)
;;; imenu support
;;;
diff --git a/libcc.fs b/libcc.fs
index 2ceab19..aba5df5 100644
--- a/libcc.fs
+++ b/libcc.fs
@@ -238,6 +238,10 @@ variable c-libs \ linked list of library names (without "lib")
\ append " -l<nodelib>" to string1
>r s" -l" append r> c-lib-string 2@ append ;
+: add-libpath ( c-addr1 u1 node -- c-addr2 u2 )
+ \ append " -l<nodelib>" to string1
+ >r s" -L" append r> c-lib-string 2@ append ;
+
\ C prefix lines
\ linked list of longcstrings: [ link | count-cell | characters ]
diff --git a/prim b/prim
index 9c0e77b..bc38d4e 100644
--- a/prim
+++ b/prim
@@ -2082,7 +2082,9 @@ r3 = r1/r2;
f** ( r1 r2 -- r3 ) float-ext f_star_star
""@i{r3} is @i{r1} raised to the @i{r2}th power.""
+CLOBBER_TOS_WORKAROUND_START;
r3 = pow(r1,r2);
+CLOBBER_TOS_WORKAROUND_END;
fm* ( r1 n -- r2 ) gforth fm_star
r2 = r1*n;
@@ -2124,11 +2126,15 @@ n2 = n1*sizeof(Float);
floor ( r1 -- r2 ) float
""Round towards the next smaller integral value, i.e., round toward negative infinity.""
/* !! unclear wording */
+CLOBBER_TOS_WORKAROUND_START;
r2 = floor(r1);
+CLOBBER_TOS_WORKAROUND_END;
fround ( r1 -- r2 ) float f_round
""Round to the nearest integral value.""
+CLOBBER_TOS_WORKAROUND_START;
r2 = rint(r1);
+CLOBBER_TOS_WORKAROUND_END;
fmax ( r1 r2 -- r3 ) float f_max
if (r1<r2)
@@ -2178,27 +2184,40 @@ fabs ( r1 -- r2 ) float-ext f_abs
r2 = fabs(r1);
facos ( r1 -- r2 ) float-ext f_a_cos
+CLOBBER_TOS_WORKAROUND_START;
r2 = acos(r1);
+CLOBBER_TOS_WORKAROUND_END;
fasin ( r1 -- r2 ) float-ext f_a_sine
+CLOBBER_TOS_WORKAROUND_START;
r2 = asin(r1);
+CLOBBER_TOS_WORKAROUND_END;
fatan ( r1 -- r2 ) float-ext f_a_tan
+CLOBBER_TOS_WORKAROUND_START;
r2 = atan(r1);
+CLOBBER_TOS_WORKAROUND_END;
fatan2 ( r1 r2 -- r3 ) float-ext f_a_tan_two
""@i{r1/r2}=tan(@i{r3}). ANS Forth does not require, but probably
intends this to be the inverse of @code{fsincos}. In gforth it is.""
+CLOBBER_TOS_WORKAROUND_START;
r3 = atan2(r1,r2);
+CLOBBER_TOS_WORKAROUND_END;
fcos ( r1 -- r2 ) float-ext f_cos
+CLOBBER_TOS_WORKAROUND_START;
r2 = cos(r1);
+CLOBBER_TOS_WORKAROUND_END;
fexp ( r1 -- r2 ) float-ext f_e_x_p
+CLOBBER_TOS_WORKAROUND_START;
r2 = exp(r1);
+CLOBBER_TOS_WORKAROUND_END;
fexpm1 ( r1 -- r2 ) float-ext f_e_x_p_m_one
""@i{r2}=@i{e}**@i{r1}@minus{}1""
+CLOBBER_TOS_WORKAROUND_START;
#ifdef HAVE_EXPM1
extern double
#ifdef NeXT
@@ -2209,12 +2228,16 @@ r2 = expm1(r1);
#else
r2 = exp(r1)-1.;
#endif
+CLOBBER_TOS_WORKAROUND_END;
fln ( r1 -- r2 ) float-ext f_l_n
+CLOBBER_TOS_WORKAROUND_START;
r2 = log(r1);
+CLOBBER_TOS_WORKAROUND_END;
flnp1 ( r1 -- r2 ) float-ext f_l_n_p_one
""@i{r2}=ln(@i{r1}+1)""
+CLOBBER_TOS_WORKAROUND_START;
#ifdef HAVE_LOG1P
extern double
#ifdef NeXT
@@ -2225,59 +2248,83 @@ r2 = log1p(r1);
#else
r2 = log(r1+1.);
#endif
+CLOBBER_TOS_WORKAROUND_END;
flog ( r1 -- r2 ) float-ext f_log
""The decimal logarithm.""
+CLOBBER_TOS_WORKAROUND_START;
r2 = log10(r1);
+CLOBBER_TOS_WORKAROUND_END;
falog ( r1 -- r2 ) float-ext f_a_log
""@i{r2}=10**@i{r1}""
extern double pow10(double);
+CLOBBER_TOS_WORKAROUND_START;
r2 = pow10(r1);
+CLOBBER_TOS_WORKAROUND_END;
fsin ( r1 -- r2 ) float-ext f_sine
+CLOBBER_TOS_WORKAROUND_START;
r2 = sin(r1);
fsincos ( r1 -- r2 r3 ) float-ext f_sine_cos
""@i{r2}=sin(@i{r1}), @i{r3}=cos(@i{r1})""
+CLOBBER_TOS_WORKAROUND_START;
r2 = sin(r1);
r3 = cos(r1);
+CLOBBER_TOS_WORKAROUND_END;
fsqrt ( r1 -- r2 ) float-ext f_square_root
+CLOBBER_TOS_WORKAROUND_START;
r2 = sqrt(r1);
+CLOBBER_TOS_WORKAROUND_END;
ftan ( r1 -- r2 ) float-ext f_tan
+CLOBBER_TOS_WORKAROUND_START;
r2 = tan(r1);
+CLOBBER_TOS_WORKAROUND_END;
:
fsincos f/ ;
fsinh ( r1 -- r2 ) float-ext f_cinch
+CLOBBER_TOS_WORKAROUND_START;
r2 = sinh(r1);
+CLOBBER_TOS_WORKAROUND_END;
:
fexpm1 fdup fdup 1. d>f f+ f/ f+ f2/ ;
fcosh ( r1 -- r2 ) float-ext f_cosh
+CLOBBER_TOS_WORKAROUND_START;
r2 = cosh(r1);
+CLOBBER_TOS_WORKAROUND_END;
:
fexp fdup 1/f f+ f2/ ;
ftanh ( r1 -- r2 ) float-ext f_tan_h
+CLOBBER_TOS_WORKAROUND_START;
r2 = tanh(r1);
+CLOBBER_TOS_WORKAROUND_END;
:
f2* fexpm1 fdup 2. d>f f+ f/ ;
fasinh ( r1 -- r2 ) float-ext f_a_cinch
+CLOBBER_TOS_WORKAROUND_START;
r2 = asinh(r1);
+CLOBBER_TOS_WORKAROUND_END;
:
fdup fdup f* 1. d>f f+ fsqrt f/ fatanh ;
facosh ( r1 -- r2 ) float-ext f_a_cosh
+CLOBBER_TOS_WORKAROUND_START;
r2 = acosh(r1);
+CLOBBER_TOS_WORKAROUND_END;
:
fdup fdup f* 1. d>f f- fsqrt f+ fln ;
fatanh ( r1 -- r2 ) float-ext f_a_tan_h
+CLOBBER_TOS_WORKAROUND_START;
r2 = atanh(r1);
+CLOBBER_TOS_WORKAROUND_END;
:
fdup f0< >r fabs 1. d>f fover f- f/ f2* flnp1 f2/
r> IF fnegate THEN ;
diff --git a/test/float.fs b/test/float.fs
index 68bdb15..45cd231 100644
--- a/test/float.fs
+++ b/test/float.fs
@@ -49,3 +49,32 @@ decimal
{ s" " >float 0e f= -> true true }
{ s" 2e+3e" >float -> false }
{ s" 2+3" >float -> 2000e true }
+
+set-near
+\ transcendenal and other functions, mainly test effect on TOS (not FTOS)
+{ 12345 2e 3e f** -> 12345 8e }
+{ 12345 1.8e floor -> 12345 1e }
+{ 12345 1.8e fround -> 12345 2e }
+{ 12345 -1.8e fabs -> 12345 1.8e }
+{ 12345 1e facos -> 12345 0e }
+{ 12345 1e fasin -> 12345 pi 2e f/ }
+{ 12345 0e fatan -> 12345 0e }
+{ 12345 1e 0e fatan2 -> 12345 pi 2e f/ }
+{ 12345 pi fcos -> 12345 -1e }
+{ 12345 0e fexp -> 12345 1e }
+{ 12345 0e fexpm1 -> 12345 0e }
+{ 12345 1e fln -> 12345 0e }
+{ 12345 0e flnp1 -> 12345 0e }
+{ 12345 1e flog -> 12345 0e }
+{ 12345 0e falog -> 12345 1e }
+{ 12345 pi f2/ fsin -> 12345 1e }
+{ 12345 0e fsincos -> 12345 0e 1e }
+{ 12345 4e fsqrt -> 12345 2e }
+{ 12345 pi 4e f/ ftan -> 12345 1e }
+{ 12345 0e fsinh -> 12345 0e }
+{ 12345 0e fcosh -> 12345 1e }
+{ 12345 0e ftanh -> 12345 0e }
+{ 12345 0e fasinh -> 12345 0e }
+{ 12345 1e facosh -> 12345 0e }
+{ 12345 0e fatanh -> 12345 0e }
+