diff --git a/.gitignore b/.gitignore index dcfc2d4..565d599 100644 --- a/.gitignore +++ b/.gitignore @@ -20,3 +20,4 @@ test/size-of retropikzel/pffi/*/*.c retropikzel/pffi/*/*.o* retropikzel/pffi/*/*.so +tmp diff --git a/Makefile b/Makefile index f637b85..ff4b93e 100644 --- a/Makefile +++ b/Makefile @@ -7,18 +7,12 @@ RACKET=racket -I r7rs --make -S $(shell pwd) --script STKLOS=STKLOS_FRAMES=200 stklos -A . --compiler-flags='+line-info,+time-display,unroll-iterations=3' -f KAWA=java --add-exports java.base/jdk.internal.foreign.abi=ALL-UNNAMED --add-exports java.base/jdk.internal.foreign.layout=ALL-UNNAMED --add-exports java.base/jdk.internal.foreign=ALL-UNNAMED --enable-native-access=ALL-UNNAMED --enable-preview -jar kawa.jar --r7rs --full-tailcalls -Dkawa.import.path=".." CYCLONE=cyclone -t -A . -GAMBIT=gsc -:r7rs,search=$(shell pwd) -GAMBIT_I=gsi -:r7rs,search=$(shell pwd) CHICKEN=csc -X r7rs -R r7rs CHICKEN_I=csi -R r7rs GERBIL=gxc -prelude :scheme/r7rs -exe GERBIL_I=gxi --lang r7rs -build: build-main-scm build-main-chicken build-main-gambit build-main-gerbil - -build-rkt: - #echo "#lang r7rs" > retropikzel/pffi/${VERSION}/main.rkt - #cat retropikzel/pffi/${VERSION}/main.sld >> retropikzel/pffi/${VERSION}/main.rkt +build: build-main-scm build-main-scm: cp retropikzel/pffi/${VERSION}/main.sld retropikzel/pffi/${VERSION}/main.scm @@ -31,17 +25,6 @@ build-main-chicken: ${CHICKEN} -sJ retropikzel.pffi.${VERSION}.chicken.scm ${CHICKEN} -sJ retropikzel.pffi.${VERSION}.main.scm -build-main-gambit: - ${GAMBIT} -obj retropikzel/pffi/${VERSION}/gambit.scm - ${GAMBIT} -obj retropikzel/pffi/${VERSION}/main.sld - #cp retropikzel/pffi/${VERSION}/*.o* test/ - -build-main-gerbil: - #${GAMBIT} -obj retropikzel/pffi/${VERSION}/gambit.scm - #${GAMBIT} -obj retropikzel/pffi/${VERSION}/main.sld - #cp retropikzel/pffi/${VERSION}/*.o* test/ - - update-documentation: schubert document mkdir -p docutmp @@ -54,6 +37,10 @@ documentation: schubert document VERSION=${VERSION} bash doc/generate.sh > documentation.md +test-sagittarius: + ${SASH} ./test/import.scm + ${SASH} ./test/ + test/import.scm: clean build ${SASH} $@ ${GUILE} $@ @@ -65,19 +52,15 @@ test/import.scm: clean build ${CHICKEN} $@ && ./test/import #${GERBIL} $@ -test/import.scm: clean build - ${RACKET} $@ - #${GAMBIT} -exe $@ && ./test/import - test/pffi-define.scm: clean build ${SASH} $@ ${GUILE} $@ + ${RACKET} $@ ${KAWA} $@ ${CHICKEN} -L -lcurl $@ && ./test/pffi-define test/pffi-define.scm: clean build - ${RACKET} $@ - #${CYCLONE} -CLNK -lcurl $@ && test/pffi-define + ${GAMBIT} -ld-options -lcurl -exe $@ && ./test/pffi-define test/size-of.scm: ${SASH} $@ @@ -106,6 +89,9 @@ test/sdl2.scm: #${STKLOS} $@ ${KAWA} $@ +tmp: + mkdir -p tmp + clean: rm -rf docutmp rm -rf retropikzel/pffi/${VERSION}/*.c @@ -125,3 +111,4 @@ clean: rm -rf *.o rm -rf *.so rm -rf *.a + rm -rf tmp diff --git a/README.md b/README.md index fc71771..08a67f2 100644 --- a/README.md +++ b/README.md @@ -19,6 +19,8 @@ For bugs you can use the - [Racket](https://racket-lang.org/) - [STKlos](https://stklos.net/) +- [Cyclone](https://justinethier.github.io/cyclone/) +- [Chicken](https://www.call-cc.org/) ## Support is waiting for the implementation diff --git a/retropikzel/pffi/v0-1-0/gambit.scm b/retropikzel/pffi/v0-1-0/gambit.scm index 4940418..ea54ae1 100644 --- a/retropikzel/pffi/v0-1-0/gambit.scm +++ b/retropikzel/pffi/v0-1-0/gambit.scm @@ -28,16 +28,9 @@ (lambda (object) (error "Not defined"))) - (define-syntax pffi-define - (syntax-rules () - ((pffi-define scheme-name shared-object c-name return-type argument-types) - (c-define scheme-name - (pffi-type->native-type return-type) - (symbol->string c-name) - string - ) - ))) - + (define pffi-define + (lambda (scheme-name shared-object c-name return-type argument-types) + (error "Not defined"))) (define pffi-size-of (lambda (type) @@ -63,14 +56,10 @@ (lambda (pointer size) (error "Not defined"))) - (define-syntax pffi-shared-object-load - (syntax-rules () - ((header path) - (c-declare (string-append "#include <" header ">"))) - ;(error "Not defined") - - )) + (define pffi-shared-object-load + (lambda (headers) + (error "Not defined"))) (define pffi-pointer-free (lambda (pointer) diff --git a/retropikzel/pffi/v0-1-0/main.scm b/retropikzel/pffi/v0-1-0/main.scm index 311295a..bf45eef 100644 --- a/retropikzel/pffi/v0-1-0/main.scm +++ b/retropikzel/pffi/v0-1-0/main.scm @@ -200,8 +200,9 @@ (syntax-rules () ((pffi-shared-object-auto-load headers object-name additional-paths) (cond-expand - (cyclone (pffi-shared-object-load headers object-path)) - (chicken (pffi-shared-object-load headers object-path)) + (cyclone (pffi-shared-object-load headers)) + (chicken (pffi-shared-object-load headers)) + (gambit (pffi-shared-object-load headers)) (else (let* ((paths (append auto-load-paths additional-paths)) (shared-object #f)) diff --git a/retropikzel/pffi/v0-1-0/main.sld b/retropikzel/pffi/v0-1-0/main.sld index 311295a..bf45eef 100644 --- a/retropikzel/pffi/v0-1-0/main.sld +++ b/retropikzel/pffi/v0-1-0/main.sld @@ -200,8 +200,9 @@ (syntax-rules () ((pffi-shared-object-auto-load headers object-name additional-paths) (cond-expand - (cyclone (pffi-shared-object-load headers object-path)) - (chicken (pffi-shared-object-load headers object-path)) + (cyclone (pffi-shared-object-load headers)) + (chicken (pffi-shared-object-load headers)) + (gambit (pffi-shared-object-load headers)) (else (let* ((paths (append auto-load-paths additional-paths)) (shared-object #f)) diff --git a/test-gambit.sh b/test-gambit.sh new file mode 100644 index 0000000..81f4eac --- /dev/null +++ b/test-gambit.sh @@ -0,0 +1,18 @@ +#!/usr/bin/env bash +set -eu + +make clean +make tmp + +VERSION=v0-1-0 + + +GAMBIT="gsc -:r7rs,search=." +GAMBIT_I="gsi -:r7rs,search=." + + +${GAMBIT} -obj retropikzel/pffi/${VERSION}/gambit.scm +${GAMBIT} -obj retropikzel/pffi/${VERSION}/main.sld +${GAMBIT_I} ./test/import.scm +${GAMBIT} -o ./tmp/import ./test/import.scm +./tmp/import diff --git a/test.scm b/test.scm index 6912400..840d542 100644 --- a/test.scm +++ b/test.scm @@ -1,17 +1,17 @@ (import (scheme base) (scheme write) (scheme file) - (scheme eval) - (scheme process-context) - (cyclone foreign)) + (scheme process-context)) + +(define t "hello") (define-syntax pffi-shared-object-load - (er-macro-transformer - (lambda (expr rename compare) - (let* ((headers (cdr (car (cdr expr))))) - `(begin - ,@ (map - (lambda (header) - `(include-c-header ,(string-append "<" header ">"))) - headers)))))) + (syntax-rules () + ((pffi-shared-object-load headers path) + (begin (display "hello") + + )) + ) + + ) diff --git a/test/SDL2.dll b/test/SDL2.dll deleted file mode 100755 index e26bcb1..0000000 Binary files a/test/SDL2.dll and /dev/null differ diff --git a/test/SDL2_image.dll b/test/SDL2_image.dll deleted file mode 100755 index 7d383e3..0000000 Binary files a/test/SDL2_image.dll and /dev/null differ diff --git a/test/SDL2_mixer.dll b/test/SDL2_mixer.dll deleted file mode 100755 index cf736ef..0000000 Binary files a/test/SDL2_mixer.dll and /dev/null differ diff --git a/test/SDL2_ttf.dll b/test/SDL2_ttf.dll deleted file mode 100755 index a1891a6..0000000 Binary files a/test/SDL2_ttf.dll and /dev/null differ diff --git a/test/import.scm b/test/import.scm index acfa504..d83f103 100644 --- a/test/import.scm +++ b/test/import.scm @@ -1,9 +1,10 @@ (import (scheme base) (scheme write) - (retropikzel pffi v0-1-0 main)) + ;(retropikzel pffi v0-1-0 main) + + ) (display "Hello") (newline) -(flush-output-port) diff --git a/test/pffi-define.scm b/test/pffi-define.scm index 7b6f62e..8cca090 100644 --- a/test/pffi-define.scm +++ b/test/pffi-define.scm @@ -4,17 +4,24 @@ (scheme eval) (retropikzel pffi v0-1-0 main)) -(define libcurl (pffi-shared-object-auto-load (list "curl/curl.h") "curl" (list))) +;(define libcurl (pffi-shared-object-auto-load (list "curl/curl.h") "curl" (list))) -(display libcurl) -(newline) +(c-declare "#include ") +;(display libcurl) +;(newline) -(pffi-define curl-version libcurl 'curl_version 'string (list)) +(define curl-version + (c-lambda () + char-string + "curl_version")) + +;(pffi-define curl-version libcurl 'curl_version 'string (list)) (display "=================") (newline) -(display (pffi-pointer->string (curl-version))) +(display (curl-version)) +;(display (pffi-pointer->string (curl-version))) (newline) (display "=================")