--- gforth/libffi.fs 2008/03/25 10:41:30 1.17 +++ gforth/libffi.fs 2008/08/05 09:17:06 1.27 @@ -1,6 +1,6 @@ \ 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 Free Software Foundation, Inc. \ This file is part of Gforth. @@ -21,21 +21,32 @@ \ note that the API functions have their arguments reversed and other \ deviations. -require libcc.fs +c-library libffi +s" ffi" add-lib -\c #include -\c static Cell *gforth_RP; -\c static char *gforth_LP; +s" os-type" environment? [IF] s" darwin" string-prefix? +[IF] + \c #define MACOSX + \c #include +[ELSE] + \c #include +[THEN] +[ELSE] + \c #include +[THEN] +\c extern Cell *gforth_RP; +\c extern unsigned char *gforth_LP; \c static void **gforth_clist; \c static void *gforth_ritem; \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 char *lp = gforth_LP; +\c unsigned char *lp = gforth_LP; \c void ** clist = gforth_clist; \c void * ritem = gforth_ritem; \c @@ -80,7 +91,7 @@ c-function ffi-call ffi_call1 a a a a -- \c #define ffi_prep_closure1(a_ip, a_cif, a_closure) \ \c ffi_prep_closure((ffi_closure *)a_closure, (ffi_cif *)a_cif, gforth_callback_ffi, (void *)a_ip) -c-function ffi-prep-closure a a a -- n +c-function ffi-prep-closure ffi_prep_closure1 a a a -- n \ !! use ud? \c #define ffi_2fetch(a_addr) (*(long long *)a_addr) @@ -139,6 +150,7 @@ c-function ffi-ret-float1 ffi_ret_float1 \c #define ffi_ret_double1(r) (*(double *)(gforth_ritem) = r) c-function ffi-ret-double1 ffi_ret_double1 r -- void : ffi-ret-double ( r -- ) ffi-ret-double1 ffi-ret-void ; +end-c-library \ common stuff, same as fflib.fs @@ -332,6 +344,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) @@ -419,6 +432,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)