diff --git NEWS NEWS index a0b1854..75e4587 100644 --- NEWS +++ NEWS @@ -1,3 +1,7 @@ +User-visible changes between 0.7.2 and 0.7.3: +Bug fixes + Backported protection against glibc math functions clobbering TOS + User-visible changes between 0.7.1 and 0.7.2: Bug fixes Fixed installdirs diff --git arch/386/machine.h arch/386/machine.h index 1b626a3..f582c4d 100644 --- arch/386/machine.h +++ 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 arch/amd64/machine.h arch/amd64/machine.h index 500cd20..17d61cf 100644 --- arch/amd64/machine.h +++ 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 arch/generic/machine.h arch/generic/machine.h index dd75c34..b75cc1b 100644 --- arch/generic/machine.h +++ 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 configure.in configure.in index 9b2c926..c3602a7 100644 --- configure.in +++ configure.in @@ -20,12 +20,12 @@ dnl Process this file with autoconf to produce a configure script. dnl We use some automake macros here, dnl but don't use automake for creating Makefile.in -AC_INIT([gforth],[0.7.2],[https://savannah.gnu.org/bugs/?func=addbug&group=gforth]) +AC_INIT([gforth],[0.7.3],[https://savannah.gnu.org/bugs/?func=addbug&group=gforth]) AC_PREREQ(2.54) #snapshots have numbers major.minor.release-YYYYMMDD #note that lexicographic ordering must be heeded. #I.e., 0.4.1-YYYYMMDD must not exist before 0.4.1! -UPDATED="February 24, 2013" +UPDATED="June 14, 2014" AC_SUBST(UPDATED) AC_CONFIG_HEADERS(engine/config.h) diff --git cross.fs cross.fs index 59d12f3..670995a 100644 --- cross.fs +++ 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 engine/engine.c engine/engine.c index e4ed239..cec5815 100644 --- engine/engine.c +++ 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 extend.fs extend.fs index 6229812..f599496 100644 --- extend.fs +++ 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 \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 gforth.el gforth.el index d2b2661..48a9b3c 100644 --- gforth.el +++ 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 libcc.fs libcc.fs index 2ceab19..aba5df5 100644 --- libcc.fs +++ libcc.fs @@ -238,6 +238,10 @@ variable c-libs \ linked list of library names (without "lib") \ append " -l" to string1 >r s" -l" append r> c-lib-string 2@ append ; +: add-libpath ( c-addr1 u1 node -- c-addr2 u2 ) + \ append " -l" 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 prim prim index 9c0e77b..bc38d4e 100644 --- prim +++ 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 (r1f 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 script.fs script.fs index e5ce514..2fab0d4 100644 --- script.fs +++ script.fs @@ -17,13 +17,14 @@ \ scripting extensions -: sh-eval ( addr u -- ) +: sh-eval ( addr u -- xt ) \G evaluate string + rest of command line - 2dup 2>r >in @ >r negate - source >in @ 1- /string + c@ bl <> + >in +! drop sh - $? IF r> >in ! 2r> defers interpreter-notfound - ELSE rdrop 2rdrop THEN ; -' sh-eval IS interpreter-notfound + 2dup 2>r >in @ >r + drop source drop - >in ! source >in @ /string dup >in +! + system + $? IF r> >in ! 2r> defers interpreter-notfound1 + ELSE rdrop 2rdrop ['] noop THEN ; +' sh-eval IS interpreter-notfound1 2Variable sh$ 0. sh$ 2! : sh-get ( addr u -- addr' u' ) diff --git test/float.fs test/float.fs index 68bdb15..45cd231 100644 --- test/float.fs +++ 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 } +