404
+Page not found
+diff --git a/.gitignore b/.gitignore index f713a5c..37cfaf7 100644 --- a/.gitignore +++ b/.gitignore @@ -29,10 +29,4 @@ retropikzel/pffi/*/compiled tmp dockerfiles/build .scheme_testrunner -retropikzel/pffi/version/main.sld -retropikzel/pffi/version/main.rkt -*.sld -*.rkt -site -test snow diff --git a/retropikzel/r7rs-pffi.rkt b/retropikzel/r7rs-pffi.rkt new file mode 100644 index 0000000..da0f2d3 --- /dev/null +++ b/retropikzel/r7rs-pffi.rkt @@ -0,0 +1,3 @@ +#lang r7rs +(import (scheme base)) +(include "r7rs-pffi.sld") diff --git a/retropikzel/r7rs-pffi.sld b/retropikzel/r7rs-pffi.sld new file mode 100644 index 0000000..936097b --- /dev/null +++ b/retropikzel/r7rs-pffi.sld @@ -0,0 +1,91 @@ +(define-library + (retropikzel r7rs-pffi) + (cond-expand + (chicken + (import (scheme base) + (scheme write) + (scheme file) + (scheme process-context) + (chicken foreign) + (chicken locative) + (chicken syntax) + (chicken memory) + (chicken random))) + (cyclone + (import (scheme base) + (scheme write) + (scheme file) + (scheme process-context) + (cyclone foreign) + (scheme cyclone primitives))) + (gambit + (import (scheme base) + (scheme write) + (scheme file) + (scheme process-context))) + (guile + (import (scheme base) + (scheme write) + (scheme file) + (scheme process-context) + (rnrs bytevectors) + (system foreign) + (system foreign-library))) + (kawa + (import (scheme base) + (scheme write) + (scheme file) + (scheme process-context))) + (racket + (import (scheme base) + (scheme write) + (scheme file) + (scheme process-context) + (only (racket base) system-type) + (ffi winapi) + (compatibility mlist) + (ffi unsafe) + (ffi vector))) + (sagittarius + (import (scheme base) + (scheme write) + (scheme file) + (scheme process-context) + (sagittarius ffi) + (sagittarius))) + (stklos + (import (scheme base) + (scheme write) + (scheme file) + (scheme process-context) + (stklos))) + (else (error "Unsupported implementation"))) + (export pffi-init + pffi-shared-object-auto-load + pffi-shared-object-load + pffi-define + pffi-define-callback + pffi-size-of + pffi-pointer-allocate + pffi-pointer-null + pffi-string->pointer + pffi-pointer->string + pffi-pointer-free + pffi-pointer? + pffi-pointer-null? + pffi-pointer-set! + pffi-pointer-get + pffi-pointer-deref + pffi-os-name) + (begin + (include "r7rs-pffi/main.scm") + (cond-expand + (chicken (include "r7rs-pffi/chicken.scm")) + (cyclone (include "r7rs-pffi/cyclone.scm")) + (gambit (include "r7rs-pffi/gambit.scm")) + (guile (include "r7rs-pffi/guile.scm")) + (kawa (include "r7rs-pffi/kawa.scm")) + (racket (include "r7rs-pffi/racket.scm")) + (sagittarius (include "r7rs-pffi/sagittarius.scm")) + (stklos (include "r7rs-pffi/stklos.scm")) + (else #t)))) diff --git a/retropikzel/r7rs-pffi/kawa.scm b/retropikzel/r7rs-pffi/kawa.scm index e1ea803..47f3944 100644 --- a/retropikzel/r7rs-pffi/kawa.scm +++ b/retropikzel/r7rs-pffi/kawa.scm @@ -87,7 +87,9 @@ (syntax-rules () ((_ scheme-name return-type argument-types procedure) (define scheme-name - (let* ((helper-object (object () (callback procedure))) + (let* ((helper-procedure + (lambda (a b) + (apply procedure (list a b)))) (function-descriptor (let ((function-descriptor (if (equal? return-type 'void) @@ -98,39 +100,26 @@ (map pffi-type->native-type argument-types))))) (write function-descriptor) (newline) + (write (invoke function-descriptor 'toMethodType)) + (newline) function-descriptor)) (method-type - (let ((method-type (invoke-static java.lang.invoke.MethodType - 'methodType - (invoke int 'getClass) - (invoke java.lang.foreign.MemorySegment 'getClass) - (invoke java.lang.foreign.MemorySegment 'getClass) - ))) + (let ((method-type (invoke function-descriptor 'toMethodType))) (write method-type) (newline) method-type)) (method-handle - (let ((method-handle - (invoke method-handle-lookup - 'unreflect - ((invoke (invoke helper-object 'getClass) 'getMethods) 0)))) - (invoke method-handle-lookup 'revealDirect method-handle) + (let ( + ;(method-handle (invoke procedure 'getApplyMethod)) + ) + ;(invoke method-handle-lookup 'revealDirect method-handle) + (write method-handle) + (newline) (set! method-handle (invoke method-handle 'asType method-type)) (write method-handle) (newline) method-handle))) - (invoke native-linker - 'upcallStub - method-handle - function-descriptor - arena)))))) - -(define-syntax pffi-define-callback-old - (syntax-rules () - ((_ scheme-name return-type argument-types procedure) - (define scheme-name - (invoke-static java.lang.invoke.MethodType 'genericMethodType (length argument-types)) - )))) + (invoke native-linker 'upcallStub method-handle function-descriptor arena)))))) (define pffi-size-of (lambda (type) diff --git a/site/404.html b/site/404.html new file mode 100644 index 0000000..2c1f13c --- /dev/null +++ b/site/404.html @@ -0,0 +1,145 @@ + + +
+ + + + + + + +Page not found
+Foreign function interface that is supported on multiple R7RS Sceheme implementations.
+Note that this software is in alpha stage. That said the interface should not be changing anymore.
+Any help in form of constructive advice and bug reports are appreciated.
+Documentation or run mkdocs serve or see docs/.
+ + +For documentation see retropikzel.neocities.org/r7rs-pffi +or run mkdocs serve or see or docs/ directory.
+These implementations do not have callback support on their FFI. If I'm wrong please let me know!
+ +Support waiting for the implementation.
+Support needs to be investigated.
+ +Support maybe possible/dreaming about.
+Not supported currently, and may never be.
+