[gforth] / gforth / libffi.fs  

gforth: gforth/libffi.fs

Diff for /gforth/libffi.fs between version 1.22 and 1.35

version 1.22, Tue Jun 17 20:18:11 2008 UTC version 1.35, Sat Mar 17 22:18:59 2012 UTC
Line 1 
Line 1 
 \ libffi.fs     shared library support package          14aug05py  \ libffi.fs     shared library support package          14aug05py
   
 \ 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.  \ This file is part of Gforth.
   
Line 21 
Line 21 
 \ note that the API functions have their arguments reversed and other  \ note that the API functions have their arguments reversed and other
 \ deviations.  \ deviations.
   
 require libcc.fs  
   
 c-library libffi  c-library libffi
 s" ffi" add-lib  s" ffi" add-lib
   
 \c #include <ffi.h>  \ The ffi.h of XCode needs the following line, and it should not hurt elsewhere
 \c static Cell *gforth_RP;  \c #define MACOSX
 \c static unsigned char *gforth_LP;  include-ffi.h-string save-c-prefix-line \ #include <ffi.h>
   \c #include <stdio.h>
 \c static void **gforth_clist;  \c static void **gforth_clist;
 \c static void *gforth_ritem;  \c static void *gforth_ritem;
   \c #ifndef HAS_BACKLINK
   \c static void *(*saved_gforth_pointers)(Cell);
   \c #endif
 \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, unsigned char *lp);  
 \c static void gforth_callback_ffi(ffi_cif * cif, void * resp, void ** args, void * ip)  \c static void gforth_callback_ffi(ffi_cif * cif, void * resp, void ** args, void * ip)
 \c {  \c {
   \c #ifndef HAS_BACKLINK
   \c   void *(*gforth_pointers)(Cell) = saved_gforth_pointers;
   \c #endif
   \c   {
 \c   Cell *rp1 = gforth_RP;  \c   Cell *rp1 = gforth_RP;
 \c   Cell *sp = gforth_SP;  \c   Cell *sp = gforth_SP;
 \c   Float *fp = gforth_FP;  \c   Float *fp = gforth_FP;
Line 56 
Line 61 
 \c   gforth_clist = clist;  \c   gforth_clist = clist;
 \c   gforth_ritem = ritem;  \c   gforth_ritem = ritem;
 \c }  \c }
   \c }
   
 \c static void* ffi_types[] =  \c static void* ffi_types[] =
 \c     { &ffi_type_void,  \c     { &ffi_type_void,
Line 77 
Line 83 
 \c                        (ffi_type *)rtype, (ffi_type **)atypes)  \c                        (ffi_type *)rtype, (ffi_type **)atypes)
 c-function ffi-prep-cif ffi_prep_cif1 a n a a -- n  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 #define ffi_call1(a_avalues, a_rvalue ,a_ip ,a_cif) \
 \c             ffi_call((ffi_cif *)a_cif, (void(*)())a_ip, \  \c             ffi_call((ffi_cif *)a_cif, (void(*)())a_ip, \
 \c                      (void *)a_rvalue, (void **)a_avalues)  \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-function ffi-call ffi_call1 a a a a -- void
   
 \c #define ffi_prep_closure1(a_ip, a_cif, a_closure) \  \c #define ffi_prep_closure1(a_ip, a_cif, a_closure) \
Line 218 
Line 231 
     here thisproc @ 2 cells + ! parse-name s,      here thisproc @ 2 cells + ! parse-name s,
     thislib @ thisproc @ @proc ;      thislib @ thisproc @ @proc ;
   
   : func@ >body cell+ @ ;
   : func' ' func@ ;
   : [func'] postpone ['] postpone func@ ; immediate restrict
   
 \ stuff for libffi  \ stuff for libffi
   
 \ libffi uses a parameter array for the input  \ libffi uses a parameter array for the input
Line 257 
Line 274 
 : sf>x  ( -- r )  retbuf sf@ ;  : sf>x  ( -- r )  retbuf sf@ ;
 : df>x  ( -- r )  retbuf df@ ;  : df>x  ( -- r )  retbuf df@ ;
   
 wordlist constant cifs  table constant cifs
   
 Variable cifbuf $40 allot \ maximum: 64 parameters  Variable cifbuf $40 allot \ maximum: 64 parameters
 : cifreset  cifbuf cell+ cifbuf ! ;  : cifreset  cifbuf cell+ cifbuf ! ;
Line 337 
Line 354 
 ' >dl+ ' >dl-   6 argtype dlong  ' >dl+ ' >dl-   6 argtype dlong
 ' >sf+ ' >sf-   9 argtype sf  ' >sf+ ' >sf-   9 argtype sf
 ' >df+ ' >df- &10 argtype df  ' >df+ ' >df- &10 argtype df
   : ints 0 ?DO int LOOP ;
   
 ' noop   0 rettype (void)  ' noop   0 rettype (void)
 ' is>x   6 rettype (int)  ' is>x   6 rettype (int)
Line 424 
Line 442 
 ' ffi-arg-longlong   8 argtype' llong  ' ffi-arg-longlong   8 argtype' llong
 ' ffi-arg-dlong      6 argtype' dlong  ' ffi-arg-dlong      6 argtype' dlong
 ' ffi-arg-ptr      &12 argtype' ptr  ' ffi-arg-ptr      &12 argtype' ptr
   : ints ( n -- ) 0 ?DO postpone int LOOP ; immediate
   
 ' ffi-ret-void       0 rettype' (void)  ' ffi-ret-void       0 rettype' (void)
 ' ffi-ret-int        6 rettype' (int)  ' ffi-ret-int        6 rettype' (int)

Generate output suitable for use with a patch program
Legend:
Removed from v.1.22  
changed lines
  Added in v.1.35
CVS Admin

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help