--- gforth/libffi.fs	2008/07/15 16:11:49	1.25
+++ gforth/libffi.fs	2012/03/17 22:18:59	1.35
@@ -1,6 +1,6 @@
 \ libffi.fs	shared library support package 		14aug05py
 
-\ 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.
 
@@ -24,44 +24,43 @@
 c-library libffi
 s" ffi" add-lib
 
-s" os-type" environment? [IF] s" darwin" string-prefix?
-[IF]
-    \c #define MACOSX
-    \c #include <ffi/ffi.h>
-[ELSE]
-    \c #include <ffi.h>
-[THEN]
-[ELSE]
-    \c #include <ffi.h>
-[THEN]
-\c extern Cell *gforth_RP;
-\c extern unsigned char *gforth_LP;
+\ The ffi.h of XCode needs the following line, and it should not hurt elsewhere
+\c #define MACOSX
+include-ffi.h-string save-c-prefix-line \ #include <ffi.h>
+\c #include <stdio.h>
 \c static void **gforth_clist;
 \c static void *gforth_ritem;
+\c #ifndef HAS_BACKLINK
+\c static void *(*saved_gforth_pointers)(Cell);
+\c #endif
 \c typedef void *Label;
 \c typedef Label *Xt;
-\c Label *gforth_engine(Xt *ip, Cell *sp, Cell *rp0, Float *fp, unsigned char *lp);
 \c static void gforth_callback_ffi(ffi_cif * cif, void * resp, void ** args, void * ip)
 \c {
-\c   Cell *rp1 = gforth_RP;
-\c   Cell *sp = gforth_SP;
-\c   Float *fp = gforth_FP;
-\c   unsigned char *lp = gforth_LP;
-\c   void ** clist = gforth_clist;
-\c   void * ritem = gforth_ritem;
+\c #ifndef HAS_BACKLINK
+\c   void *(*gforth_pointers)(Cell) = saved_gforth_pointers;
+\c #endif
+\c   {
+\c     Cell *rp1 = gforth_RP;
+\c     Cell *sp = gforth_SP;
+\c     Float *fp = gforth_FP;
+\c     unsigned char *lp = gforth_LP;
+\c     void ** clist = gforth_clist;
+\c     void * ritem = gforth_ritem;
+\c
+\c     gforth_clist = args;
+\c     gforth_ritem = resp;
+\c
+\c     gforth_engine((Xt *)ip, sp, rp1, fp, lp);
 \c 
-\c   gforth_clist = args;
-\c   gforth_ritem = resp;
-\c 
-\c   gforth_engine((Xt *)ip, sp, rp1, fp, lp);
-\c 
-\c   /* restore global variables */
-\c   gforth_RP = rp1;
-\c   gforth_SP = sp;
-\c   gforth_FP = fp;
-\c   gforth_LP = lp;
-\c   gforth_clist = clist;
-\c   gforth_ritem = ritem;
+\c     /* restore global variables */
+\c     gforth_RP = rp1;
+\c     gforth_SP = sp;
+\c     gforth_FP = fp;
+\c     gforth_LP = lp;
+\c     gforth_clist = clist;
+\c     gforth_ritem = ritem;
+\c   }
 \c }
 
 \c static void* ffi_types[] =
@@ -84,9 +83,16 @@ c-function ffi-size ffi_size n -- n
 \c                        (ffi_type *)rtype, (ffi_type **)atypes)
 c-function ffi-prep-cif ffi_prep_cif1 a n a a -- n
 
+\c #ifdef HAS_BACKLINK
+\c #define ffi_call1(a_avalues, a_rvalue ,a_ip ,a_cif) \
+\c             ffi_call((ffi_cif *)a_cif, (void(*)())a_ip, \
+\c                      (void *)a_rvalue, (void **)a_avalues)
+\c #else
 \c #define ffi_call1(a_avalues, a_rvalue ,a_ip ,a_cif) \
+\c             (saved_gforth_pointers = gforth_pointers), \
 \c             ffi_call((ffi_cif *)a_cif, (void(*)())a_ip, \
 \c                      (void *)a_rvalue, (void **)a_avalues)
+\c #endif
 c-function ffi-call ffi_call1 a a a a -- void
 
 \c #define ffi_prep_closure1(a_ip, a_cif, a_closure) \
@@ -225,6 +231,10 @@ DOES> ( -- )  dup thislib ! proc: ;
     here thisproc @ 2 cells + ! parse-name s,
     thislib @ thisproc @ @proc ;
 
+: func@ >body cell+ @ ;
+: func' ' func@ ;
+: [func'] postpone ['] postpone func@ ; immediate restrict
+
 \ stuff for libffi
 
 \ libffi uses a parameter array for the input
@@ -264,7 +274,7 @@ Create argptr maxargs 0 [DO]  argbuf [I]
 : sf>x  ( -- r )  retbuf sf@ ;
 : df>x  ( -- r )  retbuf df@ ;
 
-wordlist constant cifs
+table constant cifs
 
 Variable cifbuf $40 allot \ maximum: 64 parameters
 : cifreset  cifbuf cell+ cifbuf ! ;
@@ -344,6 +354,7 @@ also c-decl definitions
 ' >dl+ ' >dl-   6 argtype dlong
 ' >sf+ ' >sf-   9 argtype sf
 ' >df+ ' >df- &10 argtype df
+: ints 0 ?DO int LOOP ;
 
 ' noop   0 rettype (void)
 ' is>x   6 rettype (int)
@@ -431,6 +442,7 @@ also cb-decl definitions
 ' ffi-arg-longlong   8 argtype' llong
 ' ffi-arg-dlong      6 argtype' dlong
 ' ffi-arg-ptr      &12 argtype' ptr
+: ints ( n -- ) 0 ?DO postpone int LOOP ; immediate
 
 ' ffi-ret-void       0 rettype' (void)
 ' ffi-ret-int        6 rettype' (int)