version 1.23, 2008/07/15 16:11:49
|
version 1.29, 2009/12/31 15:32:35
|
Line 1
|
Line 1
|
\ lib.fs shared library support package 16aug03py |
\ lib.fs shared library support package 16aug03py |
|
|
\ Copyright (C) 1995,1996,1997,1998,2000,2003,2005,2006,2007,2008 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. |
\ This file is part of Gforth. |
|
|
Line 26 s" callback" add-lib
|
Line 26 s" callback" add-lib
|
\c #include <callback.h> |
\c #include <callback.h> |
\c static av_alist alist; |
\c static av_alist alist; |
\c static va_alist gforth_clist; |
\c static va_alist gforth_clist; |
|
\c #ifndef HAS_BACKLINK |
|
\c static void **saved_gforth_pointers; |
|
\c #endif |
\c static float frv; |
\c static float frv; |
\c static int irv; |
\c static int irv; |
\c static double drv; |
\c static double drv; |
\c static long long llrv; |
\c static long long llrv; |
\c static void * prv; |
\c static void * prv; |
\c static Cell *gforth_RP; |
|
\c static char *gforth_LP; |
|
\c typedef void *Label; |
\c typedef void *Label; |
\c typedef Label *Xt; |
\c typedef Label *Xt; |
\c Label *gforth_engine(Xt *ip, Cell *sp, Cell *rp0, Float *fp, char *lp); |
|
\c |
\c |
\c void gforth_callback_ffcall(Xt* fcall, void * alist) |
\c void gforth_callback_ffcall(Xt* fcall, void * alist) |
\c { |
\c { |
\c /* save global valiables */ |
\c #ifndef HAS_BACKLINK |
\c Cell *rp = gforth_RP; |
\c void **gforth_pointers = saved_gforth_pointers; |
\c Cell *sp = gforth_SP; |
\c #endif |
\c Float *fp = gforth_FP; |
\c { |
\c char *lp = gforth_LP; |
\c /* save global variables */ |
\c va_alist clist = gforth_clist; |
\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 |
\c gforth_clist = (va_alist)alist; |
\c gforth_clist = (va_alist)alist; |
\c |
\c |
\c gforth_engine(fcall, sp, rp, fp, lp); |
\c gforth_engine(fcall, sp, rp, fp, lp, gforth_UP); |
\c |
\c |
\c /* restore global variables */ |
\c /* restore global variables */ |
\c gforth_RP = rp; |
\c gforth_RP = rp; |
\c gforth_SP = sp; |
\c gforth_SP = sp; |
\c gforth_FP = fp; |
\c gforth_FP = fp; |
\c gforth_LP = lp; |
\c gforth_LP = lp; |
\c gforth_clist = clist; |
\c gforth_clist = clist; |
|
\c } |
\c } |
\c } |
|
|
\c #define av_start_void1(c_addr) av_start_void(alist, c_addr) |
\c #define av_start_void1(c_addr) av_start_void(alist, c_addr) |
Line 253 DOES> ( -- ) dup thislib ! proc: ;
|
Line 258 DOES> ( -- ) dup thislib ! proc: ;
|
DOES> decl, ind-call @ 0= IF symbol, THEN |
DOES> decl, ind-call @ 0= IF symbol, THEN |
previous revarg off ind-call off ; |
previous revarg off ind-call off ; |
|
|
|
: func@ >body cell+ @ ; |
|
: func' ' func@ ; |
|
: [func'] postpone ['] postpone func@ ; immediate restrict |
|
|
also c-decl definitions |
also c-decl definitions |
|
|
: <rev> revarg on ; |
: <rev> revarg on ; |