version 1.20, 2008/04/28 08:42:59
|
version 1.27, 2008/08/05 09:17:06
|
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 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 |
|
s" ffi" add-lib |
|
|
clear-libs s" ffi" add-lib |
s" os-type" environment? [IF] s" darwin" string-prefix? |
|
[IF] |
\c #include <ffi.h> |
\c #define MACOSX |
\c static Cell *gforth_RP; |
\c #include <ffi/ffi.h> |
\c static char *gforth_LP; |
[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 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 Cell *rp1 = gforth_RP; |
\c Cell *sp = gforth_SP; |
\c Cell *sp = gforth_SP; |
\c Float *fp = gforth_FP; |
\c Float *fp = gforth_FP; |
\c char *lp = gforth_LP; |
\c unsigned char *lp = gforth_LP; |
\c void ** clist = gforth_clist; |
\c void ** clist = gforth_clist; |
\c void * ritem = gforth_ritem; |
\c void * ritem = gforth_ritem; |
\c |
\c |
Line 82 c-function ffi-call ffi_call1 a a a a --
|
Line 91 c-function ffi-call ffi_call1 a a a a --
|
|
|
\c #define ffi_prep_closure1(a_ip, a_cif, a_closure) \ |
\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 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? |
\ !! use ud? |
\c #define ffi_2fetch(a_addr) (*(long long *)a_addr) |
\c #define ffi_2fetch(a_addr) (*(long long *)a_addr) |
Line 141 c-function ffi-ret-float1 ffi_ret_float1
|
Line 150 c-function ffi-ret-float1 ffi_ret_float1
|
\c #define ffi_ret_double1(r) (*(double *)(gforth_ritem) = r) |
\c #define ffi_ret_double1(r) (*(double *)(gforth_ritem) = r) |
c-function ffi-ret-double1 ffi_ret_double1 r -- void |
c-function ffi-ret-double1 ffi_ret_double1 r -- void |
: ffi-ret-double ( r -- ) ffi-ret-double1 ffi-ret-void ; |
: ffi-ret-double ( r -- ) ffi-ret-double1 ffi-ret-void ; |
|
end-c-library |
|
|
\ common stuff, same as fflib.fs |
\ common stuff, same as fflib.fs |
|
|
Line 334 also c-decl definitions
|
Line 344 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) |
Line 421 also cb-decl definitions
|
Line 432 also cb-decl definitions
|
' 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) |