--- gforth/libcc.fs	2009/12/27 01:00:52	1.62
+++ gforth/libcc.fs	2012/12/31 15:25:18	1.78
@@ -1,6 +1,6 @@
 \ libcc.fs	foreign function interface implemented using a C compiler
 
-\ Copyright (C) 2006,2007,2008 Free Software Foundation, Inc.
+\ Copyright (C) 2006,2007,2008,2009,2010,2011,2012 Free Software Foundation, Inc.
 
 \ This file is part of Gforth.
 
@@ -64,8 +64,8 @@
 \ wrapper again.  This is all done by loading the index file(s?),
 \ which define words for the wrappers in a separate wordlist.
 
-\ The files are built in .../lib/gforth/$VERSION/libcc/ or
-\ ~/.gforth/libcc/$HOST/.
+\ The files are built in .../lib/gforth$ARCH/$VERSION/libcc/ or
+\ ~/.gforth$ARCH/libcc/$HOST/.
 
 \ Todo: conversion between function pointers and xts (both directions)
 
@@ -154,7 +154,7 @@ variable lib-handle-addr \ points to the
 2variable lib-filename   \ filename without extension
 2variable lib-modulename \ basename of the file without extension
 2variable libcc-named-dir-v \ directory for named libcc wrapper libraries
-0 value libcc-path       \ pointer to path of library directories
+Variable libcc-path      \ pointer to path of library directories
 
 defer replace-rpath ( c-addr1 u1 -- c-addr2 u2 )
 ' noop is replace-rpath
@@ -217,6 +217,8 @@ end-struct list%
 
 2variable c-libs \ library names in a string (without "lib")
 
+: lib-prefix ( -- addr u )  s" libgf" ;
+
 : add-lib ( c-addr u -- ) \ gforth
 \G Add library lib@i{string} to the list of libraries, where
     \G @i{string} is represented by @i{c-addr u}.
@@ -266,7 +268,7 @@ defer save-c-prefix-line ( c-addr u -- )
     \G One line of C declarations for the C interface
     -1 parse save-c-prefix-line ;
 
-s" #include <gforth/" version-string s+ s" /libcc.h>" append ( c-addr u )
+s" #include <gforth" arch-modifier s+ s" /" append version-string append s" /libcc.h>" append ( c-addr u )
   2dup save-c-prefix-line drop free throw
 
 \ Types (for parsing)
@@ -318,8 +320,12 @@ drop
     c,  0 c, ;
 
 : parse-variable-type ( -- addr )
-	c-var c, here
-	s" a" libcc-type c,  0 c, ;
+    c-var c, here
+    s" a" libcc-type c,  0 c, ;
+
+0 Value is-funptr?
+: parse-funptr-types ( "{libcc-type}" "--" "libcc-type" -- addr )
+    true to is-funptr?  parse-function-types ;
 
 : type-letter ( n -- c )
     chars s" nadrfv" drop + c@ ;
@@ -447,6 +453,15 @@ create gen-wrapped-types
 : gen-wrapped-stmt ( pars c-name fp-change1 sp-change1 ret -- fp-change sp-change )
     cells gen-wrapped-types + @ execute ;
 
+: sanitize ( addr u -- )
+    bounds ?DO
+	I c@
+	dup 'a' 'z' 1+ within
+	over 'A' 'Z' 1+ within or
+	over '0' '9' 1+ within or
+	swap '_' = or 0= IF  '_' I c!  THEN
+    LOOP ;
+
 : wrapper-function-name ( addr -- c-addr u )
     \ addr points to the return type index of a c-function descriptor
     count { r-type } count { d: pars }
@@ -460,15 +475,18 @@ create gen-wrapped-types
 	i c@ type-letter front-char
     loop
     '_ front-char r-type type-letter front-char assert( dup 0= )
-    2drop c-addr u ;
+    2drop c-addr u 2dup sanitize ;
 
 : gen-wrapper-function ( addr -- )
     \ addr points to the return type index of a c-function descriptor
     dup { descriptor }
     count { ret } count 2dup { d: pars } chars + count { d: c-name }
-    ." void " lib-modulename 2@ type ." _LTX_" descriptor wrapper-function-name 2dup type drop free throw
+    ." void "
+    [ lib-suffix s" .la" str= [IF] ] lib-prefix type lib-modulename 2@ type ." _LTX_" [ [THEN] ]
+    descriptor wrapper-function-name 2dup type drop free throw
     .\" (GFORTH_ARGS)\n"
     .\" {\n  Cell MAYBE_UNUSED *sp = gforth_SP;\n  Float MAYBE_UNUSED *fp = gforth_FP;\n  "
+    is-funptr? IF  .\" Cell ptr = *sp++;\n  "  0 to is-funptr?  THEN
     pars c-name 2over count-stacks ret gen-wrapped-stmt .\" ;\n"
     ?dup-if
 	."   gforth_SP = sp+" .nb .\" ;\n"
@@ -504,13 +522,14 @@ create gen-wrapped-types
     libcc-named-dir-v 2@ ;
 
 : libcc-tmp-dir ( -- c-addr u )
-    s" ~/.gforth/libcc-tmp/" ;
+    s" ~/.gforth" arch-modifier s+ s" /libcc-tmp/" s+ ;
 
 : prepend-dirname ( c-addr1 u1 c-addr2 u2 -- c-addr3 u3 )
     2over s+ 2swap drop free throw ;
 
 : open-wrappers ( -- addr|0 )
-    lib-filename 2@ s" .la" s+
+    lib-filename 2@ dirname lib-prefix s+
+    lib-filename 2@ basename append lib-suffix append
     2dup libcc-named-dir string-prefix? if ( c-addr u )
 	\ see if we can open it in the path
 	libcc-named-dir nip /string
@@ -594,18 +613,19 @@ DEFER compile-wrapper-function ( -- )
     lib-handle 0= if
 	c-source-file close-file throw
 	0 c-source-file-id !
-	[ libtool-command s"  --silent --mode=compile " s+
+	[ libtool-command s"  --silent --tag=CC --mode=compile " s+
 	  libtool-cc append s"  -I '" append
 	  s" includedir" getenv append  s" '" append ] sliteral
 	s"  -O -c " s+ lib-filename 2@ append s" .c -o " append
 	lib-filename 2@ append s" .lo" append ( c-addr u )
 	\    2dup type cr
 	2dup system drop free throw $? abort" libtool compile failed"
-	[ libtool-command s"  --silent --mode=link " s+
+	[ libtool-command s"  --silent --tag=CC --mode=link " s+
 	  libtool-cc append libtool-flags append s"  -module -rpath " s+ ] sliteral
 	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 )
+	lib-filename 2@ dirname append lib-prefix append
+	lib-filename 2@ basename append s" .la" append ( c-addr u )
 	c-libs 2@ append
 	\    2dup type cr
 	2dup system drop free throw $? abort" libtool link failed"
@@ -659,7 +679,7 @@ DEFER compile-wrapper-function ( -- )
     \G specified stack effect and calls the C function @code{c-name}.
     ['] parse-function-types (c-function) ;
 
-: c-value ( "forth-name" "c-name" "[---]" "type" -- ) \ gforth
+: c-value ( "forth-name" "c-name" "---" "type" -- ) \ gforth
     \G Define a Forth word @i{forth-name}.  @i{Forth-name} has the
     \G specified stack effect and gives the C value of @code{c-name}.
     ['] parse-value-type (c-function) ;
@@ -669,6 +689,12 @@ DEFER compile-wrapper-function ( -- )
     \G address of @code{c-name}.
     ['] parse-variable-type (c-function) ;
 
+: c-funptr ( "forth-name" "c-typecast" "@{type@}" "---" "type" -- ) \ gforth
+    \G Define a Forth word @i{forth-name}.  @i{Forth-name} has the
+    \G specified stack effect and calls the C function pointer
+    \G ptr using the typecast or struct access @code{c-typecast}.
+    ['] parse-funptr-types (c-function) ;
+
 : clear-libs ( -- ) \ gforth
 \G Clear the list of libs
     c-source-file-id @ if
@@ -697,9 +723,9 @@ clear-libs
     compile-wrapper-function1 ;
 
 : init-libcc ( -- )
-    s" ~/.gforth/libcc-named/" libcc-named-dir-v 2!
-[IFDEF] make-path
-    make-path to libcc-path
+    s" ~/.gforth" arch-modifier s+ s" /libcc-named/" s+ libcc-named-dir-v 2!
+[IFDEF] $init
+    libcc-path $init
     libcc-named-dir libcc-path also-path
     [ s" libccdir" getenv ] sliteral libcc-path also-path
 [THEN]