version 1.218, 2007/09/16 16:26:11
|
version 1.225, 2008/04/19 19:15:14
|
Line 1
|
Line 1
|
\ Gforth primitives |
\ 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. |
\ This file is part of Gforth. |
|
|
\ Gforth is free software; you can redistribute it and/or |
\ Gforth is free software; you can redistribute it and/or |
\ modify it under the terms of the GNU General Public License |
\ 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. |
\ of the License, or (at your option) any later version. |
|
|
\ This program is distributed in the hope that it will be useful, |
\ This program is distributed in the hope that it will be useful, |
Line 15
|
Line 15
|
\ GNU General Public License for more details. |
\ GNU General Public License for more details. |
|
|
\ You should have received a copy of the GNU General Public License |
\ You should have received a copy of the GNU General Public License |
\ along with this program; if not, write to the Free Software |
\ along with this program. If not, see http://www.gnu.org/licenses/. |
\ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA. |
|
|
|
|
|
\ WARNING: This file is processed by m4. Make sure your identifiers |
\ WARNING: This file is processed by m4. Make sure your identifiers |
Line 203 INST_TAIL;
|
Line 202 INST_TAIL;
|
goto *next_code; |
goto *next_code; |
#endif /* defined(NO_IP) */ |
#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 |
(dodoes) ( -- a_body R:a_retaddr ) gforth-internal paren_dodoes |
""run-time routine for @code{does>}-defined words"" |
""run-time routine for @code{does>}-defined words"" |
#ifdef NO_IP |
#ifdef NO_IP |
Line 695 c2 = toupper(c1);
|
Line 702 c2 = toupper(c1);
|
: |
: |
dup [char] a - [ char z char a - 1 + ] Literal u< bl and - ; |
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 |
""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} |
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 |
is 1. Currently this is based on the machine's character |
Line 2386 r = fp[u];
|
Line 2393 r = fp[u];
|
\g syslib |
\g syslib |
|
|
open-lib ( c_addr1 u1 -- u2 ) gforth open_lib |
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 |
#ifndef RTLD_GLOBAL |
#define RTLD_GLOBAL 0 |
#define RTLD_GLOBAL 0 |
#endif |
#endif |
Line 2401 u2 = 0;
|
Line 2410 u2 = 0;
|
#endif |
#endif |
|
|
lib-sym ( c_addr1 u1 u2 -- u3 ) gforth lib_sym |
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)); |
u3 = (UCell) dlsym((void*)u2,cstr(c_addr1, u1, 1)); |
#else |
#else |
# ifdef _WIN32 |
# ifdef _WIN32 |
Line 2771 uploop(i, 0, 7, `fcall(i)')
|
Line 2782 uploop(i, 0, 7, `fcall(i)')
|
fcall(20) |
fcall(20) |
|
|
\+ |
\+ |
\+ |
|
|
|
|
lib-error ( -- c_addr u ) gforth lib_error |
|
c_addr = lt_dlerror(); |
|
u = (c_addr == NULL) ? 0 : strlen(c_addr); |
|
|
|
\+ |
\g peephole |
\g peephole |
|
|
\+peephole |
\+peephole |