--- gforth/fflib.fs 2008/02/12 20:28:51 1.19 +++ gforth/fflib.fs 2009/12/31 15:32:35 1.29 @@ -1,6 +1,6 @@ \ lib.fs shared library support package 16aug03py -\ Copyright (C) 1995,1996,1997,1998,2000,2003,2005,2006,2007 Free Software Foundation, Inc. +\ Copyright (C) 1995,1996,1997,1998,2000,2003,2005,2006,2007,2008,2009 Free Software Foundation, Inc. \ This file is part of Gforth. @@ -18,42 +18,49 @@ \ along with this program. If not, see http://www.gnu.org/licenses/. \ replacements for former primitives -require libcc.fs +c-library fflib +s" avcall" add-lib +s" callback" add-lib \c #include \c #include \c static av_alist alist; \c static va_alist gforth_clist; +\c #ifndef HAS_BACKLINK +\c static void **saved_gforth_pointers; +\c #endif \c static float frv; \c static int irv; \c static double drv; \c static long long llrv; \c static void * prv; -\c static Cell *gforth_RP; -\c static char *gforth_LP; \c typedef void *Label; \c typedef Label *Xt; -\c Label *gforth_engine(Xt *ip, Cell *sp, Cell *rp0, Float *fp, char *lp); \c \c void gforth_callback_ffcall(Xt* fcall, void * alist) \c { -\c /* save global valiables */ -\c Cell *rp = gforth_RP; -\c Cell *sp = gforth_SP; -\c Float *fp = gforth_FP; -\c char *lp = gforth_LP; -\c va_alist clist = gforth_clist; +\c #ifndef HAS_BACKLINK +\c void **gforth_pointers = saved_gforth_pointers; +\c #endif +\c { +\c /* save global variables */ +\c Cell *rp = gforth_RP; +\c Cell *sp = gforth_SP; +\c Float *fp = gforth_FP; +\c char *lp = gforth_LP; +\c va_alist clist = gforth_clist; \c -\c gforth_clist = (va_alist)alist; +\c gforth_clist = (va_alist)alist; \c -\c gforth_engine(fcall, sp, rp, fp, lp); +\c gforth_engine(fcall, sp, rp, fp, lp, gforth_UP); \c -\c /* restore global variables */ -\c gforth_RP = rp; -\c gforth_SP = sp; -\c gforth_FP = fp; -\c gforth_LP = lp; -\c gforth_clist = clist; +\c /* restore global variables */ +\c gforth_RP = rp; +\c gforth_SP = sp; +\c gforth_FP = fp; +\c gforth_LP = lp; +\c gforth_clist = clist; +\c } \c } \c #define av_start_void1(c_addr) av_start_void(alist, c_addr) @@ -126,6 +133,7 @@ c-function va-return-longlong1 va_return c-function va-return-float1 va_return_float1 r -- void \c #define va_return_double1(r) va_return_double(gforth_clist,r) c-function va-return-double1 va_return_double1 r -- void +end-c-library : av-int-r 2r> >r av-int ; : av-float-r f@local0 lp+ av-float ; @@ -250,6 +258,10 @@ DOES> ( -- ) dup thislib ! proc: ; DOES> decl, ind-call @ 0= IF symbol, THEN previous revarg off ind-call off ; +: func@ >body cell+ @ ; +: func' ' func@ ; +: [func'] postpone ['] postpone func@ ; immediate restrict + also c-decl definitions : revarg on ;