version 1.26, 2008/08/05 07:52:44
|
version 1.31, 2009/02/24 22:34:35
|
Line 24
|
Line 24
|
c-library libffi |
c-library libffi |
s" ffi" add-lib |
s" ffi" add-lib |
|
|
s" os-type" environment? [IF] s" darwin" string-prefix? |
\ The ffi.h of XCode needs the following line, and it should not hurt elsewhere |
[IF] |
\c #define MACOSX |
\c #define MACOSX |
include-ffi.h-string save-c-prefix-line \ #include <ffi.h> |
\c #include <ffi/ffi.h> |
\c #include <stdio.h> |
[ELSE] |
|
\c #include <ffi.h> |
|
[THEN] |
|
[ELSE] |
|
\c #include <ffi.h> |
|
[THEN] |
|
\c extern Cell *gforth_RP; |
|
\c extern unsigned char *gforth_LP; |
|
\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; |
|
\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 Cell *rp1 = gforth_RP; |
\c #ifndef HAS_BACKLINK |
\c Cell *sp = gforth_SP; |
\c void **gforth_pointers = saved_gforth_pointers; |
\c Float *fp = gforth_FP; |
\c #endif |
\c unsigned char *lp = gforth_LP; |
\c { |
\c void ** clist = gforth_clist; |
\c Cell *rp1 = gforth_RP; |
\c void * ritem = gforth_ritem; |
\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, gforth_UP); |
\c |
\c |
\c gforth_clist = args; |
\c /* restore global variables */ |
\c gforth_ritem = resp; |
\c gforth_RP = rp1; |
\c |
\c gforth_SP = sp; |
\c gforth_engine((Xt *)ip, sp, rp1, fp, lp); |
\c gforth_FP = fp; |
\c |
\c gforth_LP = lp; |
\c /* restore global variables */ |
\c gforth_clist = clist; |
\c gforth_RP = rp1; |
\c gforth_ritem = ritem; |
\c gforth_SP = sp; |
\c } |
\c gforth_FP = fp; |
|
\c gforth_LP = lp; |
|
\c gforth_clist = clist; |
|
\c gforth_ritem = ritem; |
|
\c } |
\c } |
|
|
\c static void* ffi_types[] = |
\c static void* ffi_types[] = |
Line 84 c-function ffi-size ffi_size n -- n
|
Line 83 c-function ffi-size ffi_size n -- n
|
\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 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 #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 ffi_call((ffi_cif *)a_cif, (void(*)())a_ip, \ |
\c (void *)a_rvalue, (void **)a_avalues) |
\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 225 DOES> ( -- ) dup thislib ! proc: ;
|
Line 231 DOES> ( -- ) dup thislib ! proc: ;
|
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 344 also c-decl definitions
|
Line 354 also c-decl definitions
|
' >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) |