--- gforth/libcc.fs 2008/07/15 09:30:12 1.48 +++ gforth/libcc.fs 2008/07/27 10:34:06 1.51 @@ -1,6 +1,6 @@ \ libcc.fs foreign function interface implemented using a C compiler -\ Copyright (C) 2006,2007 Free Software Foundation, Inc. +\ Copyright (C) 2006,2007,2008 Free Software Foundation, Inc. \ This file is part of Gforth. @@ -136,8 +136,6 @@ require struct.fs - \ counted-string - \ c-function-ft word body: struct cell% field cff-cfr \ xt of c-function-rt word @@ -161,7 +159,8 @@ variable lib-handle-addr \ points to the 2variable libcc-named-dir-v \ directory for named libcc wrapper libraries 0 value libcc-path \ pointer to path of library directories -: delete-file 2drop 0 ; +defer replace-rpath ( c-addr1 u1 -- c-addr2 u2 ) +' noop is replace-rpath : .nb ( n -- ) 0 .r ; @@ -285,6 +284,7 @@ const+ d \ double const+ r \ float const+ func \ C function pointer const+ void +const+ file \ C file pointer drop set-current @@ -301,7 +301,7 @@ set-current parse-libcc-type dup 0< -32 and throw swap c! ; : type-letter ( n -- c ) - chars s" nadrfv" drop + c@ ; + chars s" nadrfvF" drop + c@ ; \ count-stacks @@ -330,6 +330,7 @@ create count-stacks-types ' count-stacks-r , ' count-stacks-func , ' count-stacks-void , +' count-stacks-a , : count-stacks ( pars -- fp-change sp-change ) \ pars is an addr u pair @@ -357,6 +358,9 @@ create count-stacks-types : gen-par-void ( fp-depth1 sp-depth1 -- fp-depth2 sp-depth2 ) -32 throw ; +: gen-par-file ( fp-depth1 sp-depth1 -- fp-depth2 sp-depth2 ) + ." (FILE *)(" gen-par-n ." )" ; + create gen-par-types ' gen-par-n , ' gen-par-a , @@ -364,6 +368,7 @@ create gen-par-types ' gen-par-r , ' gen-par-func , ' gen-par-void , +' gen-par-file , : gen-par ( fp-depth1 sp-depth1 partype -- fp-depth2 sp-depth2 ) cells gen-par-types + @ execute ; @@ -408,6 +413,7 @@ create gen-wrapped-types ' gen-wrapped-r , ' gen-wrapped-func , ' gen-wrapped-void , +' gen-wrapped-a , : gen-wrapped-stmt ( pars c-name fp-change1 sp-change1 ret -- fp-change sp-change ) cells gen-wrapped-types + @ execute ; @@ -563,7 +569,7 @@ DEFER compile-wrapper-function ( -- ) 2dup system drop free throw $? abort" libtool compile failed" [ libtool-command s" --silent --mode=link --tag=CC " s+ libtool-cc append s" -module -rpath " s+ ] sliteral - lib-filename 2@ dirname s+ s" " append + lib-filename 2@ dirname replace-rpath s+ s" " append lib-filename 2@ append s" .lo -o " append lib-filename 2@ append s" .la" append ( c-addr u ) c-libs @ ['] append-l list-map