--- gforth/prim 2007/08/21 10:33:52 1.217 +++ gforth/prim 2008/04/19 19:15:14 1.225 @@ -1,12 +1,12 @@ \ Gforth primitives -\ Copyright (C) 1995,1996,1997,1998,2000,2003,2004,2005,2006 Free Software Foundation, Inc. +\ Copyright (C) 1995,1996,1997,1998,2000,2003,2004,2005,2006,2007 Free Software Foundation, Inc. \ This file is part of Gforth. \ Gforth is free software; you can redistribute it and/or \ modify it under the terms of the GNU General Public License -\ as published by the Free Software Foundation; either version 2 +\ as published by the Free Software Foundation, either version 3 \ of the License, or (at your option) any later version. \ This program is distributed in the hope that it will be useful, @@ -15,8 +15,7 @@ \ GNU General Public License for more details. \ You should have received a copy of the GNU General Public License -\ along with this program; if not, write to the Free Software -\ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA. +\ along with this program. If not, see http://www.gnu.org/licenses/. \ WARNING: This file is processed by m4. Make sure your identifiers @@ -109,9 +108,9 @@ \E store-optimization on \E ' noop tail-nextp2 ! \ now INST_TAIL just stores, but does not jump \E -\E include-skipped-insts on \ static superinsts include cells for components -\E \ useful for dynamic programming and -\E \ superinsts across entry points +\E `include-skipped-insts' on \ static superinsts include cells for components +\E \ useful for dynamic programming and +\E \ superinsts across entry points \ \ @@ -203,6 +202,14 @@ INST_TAIL; goto *next_code; #endif /* defined(NO_IP) */ +(dovalue) ( -- w ) gforth-internal paren_doval +""run-time routine for constants"" +w = *(Cell *)PFA(CFA); +#ifdef NO_IP +INST_TAIL; +goto *next_code; +#endif /* defined(NO_IP) */ + (dodoes) ( -- a_body R:a_retaddr ) gforth-internal paren_dodoes ""run-time routine for @code{does>}-defined words"" #ifdef NO_IP @@ -695,7 +702,7 @@ c2 = toupper(c1); : dup [char] a - [ char z char a - 1 + ] Literal u< bl and - ; -capscompare ( c_addr1 u1 c_addr2 u2 -- n ) string +capscompare ( c_addr1 u1 c_addr2 u2 -- n ) gforth ""Compare two strings lexicographically. If they are equal, @i{n} is 0; if the first string is smaller, @i{n} is -1; if the first string is larger, @i{n} is 1. Currently this is based on the machine's character @@ -2386,7 +2393,9 @@ r = fp[u]; \g syslib open-lib ( c_addr1 u1 -- u2 ) gforth open_lib -#if defined(HAVE_LIBDL) || defined(HAVE_DLOPEN) +#if 1 +u2 = (UCell)lt_dlopenadvise(cstr(c_addr1, u1, 1), ltdl_advice); +#elif defined(HAVE_LIBDL) || defined(HAVE_DLOPEN) #ifndef RTLD_GLOBAL #define RTLD_GLOBAL 0 #endif @@ -2401,7 +2410,9 @@ u2 = 0; #endif lib-sym ( c_addr1 u1 u2 -- u3 ) gforth lib_sym -#if defined(HAVE_LIBDL) || defined(HAVE_DLOPEN) +#if 1 +u3 = (UCell) lt_dlsym((lt_dlhandle)u2, cstr(c_addr1, u1, 1)); +#elif defined(HAVE_LIBDL) || defined(HAVE_DLOPEN) u3 = (UCell) dlsym((void*)u2,cstr(c_addr1, u1, 1)); #else # ifdef _WIN32 @@ -2771,8 +2782,12 @@ uploop(i, 0, 7, `fcall(i)') fcall(20) \+ -\+ +lib-error ( -- c_addr u ) gforth lib_error +c_addr = lt_dlerror(); +u = (c_addr == NULL) ? 0 : strlen(c_addr); + +\+ \g peephole \+peephole