Started working on a gauche implementation

Makefile

@@ -14,8 +14,8 @@ chibi:
 		-shared
 
 gauche:
-	#${CC} -Werror -g3 -o retropikzel/pffi/pffi-gauche.so \ src/pffi-gauche.c \ -fPIC \ -lffi \ -shared \ -I./include
-	gauche-package
+	CFLAGS="-I./include" gauche-package compile \
+		--verbose --srcdir=src retropikzel-pffi-gauche gauche.c gauchelib.scm
 
 jenkinsfile:
 	gosh -r7 -I ./snow build.scm
@@ -48,26 +48,22 @@ test-compile-docker: libtest.so libtest.a
 	docker run -v ${PWD}:/workdir pffi-${SCHEME} bash -c "cd /workdir && SCHEME=${SCHEME} compile-r7rs -I . test.scm && ./test"
 
 clean:
-	@rm -rf docutmp
-	@rm -rf retropikzel/r7rs-pffi/*.o*
-	@rm -rf retropikzel/r7rs-pffi/*.so
-	@rm -rf retropikzel/r7rs-pffi/*.meta
-	@rm -rf retropikzel/r7rs-pffi/retropikzel.*
-	@rm -rf retropikzel/r7rs-pffi/compiled
+	@rm -rf retropikzel/pffi/*.o*
+	@rm -rf retropikzel/pffi/*.so
+	@rm -rf retropikzel/pffi/*.meta
+	@rm -rf retropikzel/pffi/retropikzel.*
+	@rm -rf retropikzel/pffi/compiled
 	@rm -rf retropikzel.*
 	find . -name "*.meta" -delete
 	@rm -rf test/pffi-define
 	@rm -rf test/*gambit*
 	find . -name "*.link" -delete
-	find . -name "*.c" -not -name "libtest.c" -and -not -name "pffi-gauche.c" -delete
+	#find . -name "*.c" -not -name "libtest.c" -and -not -name "pffi-gauche.c" -delete
 	find . -name "*.o" -delete
 	find . -name "*.o[1-9]" -delete
 	find . -name "*.so" -delete
 	find . -name "*.a" -delete
 	find . -name "*.class" -delete
 	@rm -rf test
-	@rm -rf tmp
 	find . -name "core.1" -delete
 	find . -name "*@gambit*" -delete
-	rm -rf retropikzel/r7rs-pffi/r7rs-pffi-chibi.so
-	rm -rf retropikzel/r7rs-pffi/r7rs-pffi-chibi.c

retropikzel/pffi.sld

@@ -170,9 +170,11 @@
               (scheme char)
               (scheme file)
               (scheme process-context)
-              (gauche base))
+              (gauche base)
+              (retropikzel pffi gauche))
       (export pffi-init
               ;pffi-size-of
+              spigot-calculate-pi
               pffi-type?
               pffi-align-of
               ;pffi-shared-object-auto-load
@@ -549,8 +551,7 @@
     (skint (include "pffi/skint.scm"))
     (stklos (include "pffi/stklos.scm"))
     (tr7 (include "pffi/tr7.scm"))
-    (ypsilon (include "pffi/ypsilon.scm"))
-    (else #t))
+    (ypsilon (include "pffi/ypsilon.scm")))
   (include "pffi/shared/struct.scm")
   (include "pffi/shared/union.scm")
   (include "pffi/shared/main.scm"))

retropikzel/pffi/gauche.scm

@@ -1,7 +1,16 @@
-(dynamic-load "retropikzel/pffi/pffi-gauche" :init-function "Scm__Init_pffi_gauche")
+(define-module retropikzel.pffi.gauche
+               (export spigot-calculate-pi
+                       spigot-calculate-e))
+(select-module retropikzel.pffi.gauche)
 
-(foo 10)
+(dynamic-load "retropikzel-pffi-gauche")
+;(define-module retropikzel.pffi.gauche (export pffi-foo))
 
-(define size-of-type
+;(dynamic-load "retropikzel/pffi/pffi-gauche" :init-function "Scm__Init_pffi_2dgauche")
+;(select-module pffi-gauche)
+
+;(pffi-foo 10)
+
+#;(define size-of-type
   (lambda (type)
     (cond ((equal? type 'int8) 1))))

src/gauche.scm

@@ -1,27 +0,0 @@
-(use gauche.cgen)
-
-(define unit (make <cgen-unit> :name "pffi-gauche"))
-(cgen-current-unit unit)
-
-
-(cgen-decl "#include <ffi.h>")
-(cgen-decl "#include <stdio.h>")
-
-(cgen-init "printf(\"initialization function\\n\");")
-
-(cgen-body "void foo(int n) { printf(\"got %u\\n\", n); }")
-
-(cgen-extern "void foo(int n);")
-
-;(cgen-extern "void foo(int n);")
-
-#;(parameterize ([cgen-current-unit *unit*])
-  (cgen-decl "#include <ffi.h>")
-  (cgen-decl "#include <stdio.h>")
-  (cgen-body "void foo(int n) { printf(\"got %u\\n\", n); }")
-  (cgen-extern "void foo(int n);")
-  (cgen-init "printf(\"initialization function\\n\");")
-  )
-
-(cgen-emit-c unit)
-(cgen-emit-h unit)

src/gauchelib.scm

@@ -0,0 +1,20 @@
+;;;
+;;; spigot - 'spigot' extension module example
+;;;
+;;;  Written by Shiro Kawai (shiro@acm.org)
+;;;  I put this program in public domain.  Use it as you like.
+;;;
+
+(in-module retropikzel.pffi.gauche)
+
+;;
+;; The 'define-cproc' forms exposes C functions to Scheme world.
+;;
+
+(inline-stub
+ (.include "pffi-gauche.h")
+ (define-cproc spigot-calculate-pi (digits::<int>) Spigot_calculate_pi)
+ (define-cproc spigot-calculate-e (digits::<int>) Spigot_calculate_e)
+ )
+
+;; You can define Scheme functions here if you want.

src/pffi-gauche.scm

@@ -1,6 +0,0 @@
-(in-module pffi)
-
-(inline-stub
-  (.include "pffi-gauche.h")
-  (define-cproc foo (x::<int>) foo))
-

test.scm

@@ -57,6 +57,8 @@
 (print-header 'pffi-init)
 
 (pffi-init)
+(write (spigot-calculate-pi 10))
+(newline)
 
 (exit 0)
 ;; pffi-type?