diff --git a/.gitignore b/.gitignore index d4f52f8..dcfc2d4 100644 --- a/.gitignore +++ b/.gitignore @@ -7,6 +7,8 @@ docuptmp *.o* *.meta *.link +*.dep +*.zo old retropikzel.* import diff --git a/Makefile b/Makefile index c3a8d8b..f637b85 100644 --- a/Makefile +++ b/Makefile @@ -14,11 +14,11 @@ CHICKEN_I=csi -R r7rs GERBIL=gxc -prelude :scheme/r7rs -exe GERBIL_I=gxi --lang r7rs -build: build-rkt build-main-scm build-main-chicken build-main-gambit build-main-gerbil +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 + #echo "#lang r7rs" > retropikzel/pffi/${VERSION}/main.rkt + #cat retropikzel/pffi/${VERSION}/main.sld >> retropikzel/pffi/${VERSION}/main.rkt build-main-scm: cp retropikzel/pffi/${VERSION}/main.sld retropikzel/pffi/${VERSION}/main.scm diff --git a/retropikzel/pffi/v0-1-0/compiled/main_rkt.dep b/retropikzel/pffi/v0-1-0/compiled/main_rkt.dep deleted file mode 100644 index 6e80ffe..0000000 --- a/retropikzel/pffi/v0-1-0/compiled/main_rkt.dep +++ /dev/null @@ -1 +0,0 @@ -("8.12" ta6le ("ef25d0339315600c996485e29d2d36b0be50ef74" . "87ea6db5c29da02402ccf3308ea25984d84f8e9f") (collects #"r7rs" #"base.rkt") (collects #"r7rs" #"file.rkt") (collects #"r7rs" #"lang" #"reader.rkt") (collects #"r7rs" #"main.rkt") (collects #"r7rs" #"process-context.rkt") (collects #"r7rs" #"write.rkt") (collects #"racket" #"base.rkt") (collects #"racket" #"runtime-config.rkt") (collects #"retropikzel" #"pffi" #"v0-1-0" #"racket.rkt")) diff --git a/retropikzel/pffi/v0-1-0/compiled/main_rkt.zo b/retropikzel/pffi/v0-1-0/compiled/main_rkt.zo deleted file mode 100644 index 6546386..0000000 Binary files a/retropikzel/pffi/v0-1-0/compiled/main_rkt.zo and /dev/null differ diff --git a/retropikzel/pffi/v0-1-0/compiled/racket_rkt.dep b/retropikzel/pffi/v0-1-0/compiled/racket_rkt.dep deleted file mode 100644 index b98f16d..0000000 --- a/retropikzel/pffi/v0-1-0/compiled/racket_rkt.dep +++ /dev/null @@ -1 +0,0 @@ -("8.12" ta6le ("213d7907ee3cf2051004e3be2f9a67102c0176ce" . "c6039c9fe52ff5953361b25f7570ae33857df055") (collects #"compatibility" #"mlist.rkt") (collects #"ffi" #"unsafe.rkt") (collects #"r7rs" #"base.rkt") (collects #"r7rs" #"file.rkt") (collects #"r7rs" #"lang" #"reader.rkt") (collects #"r7rs" #"main.rkt") (collects #"r7rs" #"process-context.rkt") (collects #"r7rs" #"write.rkt") (collects #"racket" #"base.rkt") (collects #"racket" #"runtime-config.rkt")) diff --git a/retropikzel/pffi/v0-1-0/compiled/racket_rkt.zo b/retropikzel/pffi/v0-1-0/compiled/racket_rkt.zo deleted file mode 100644 index 4847483..0000000 Binary files a/retropikzel/pffi/v0-1-0/compiled/racket_rkt.zo and /dev/null differ diff --git a/retropikzel/pffi/v0-1-0/main.rkt b/retropikzel/pffi/v0-1-0/main.rkt index 358099a..7ce16a0 100644 --- a/retropikzel/pffi/v0-1-0/main.rkt +++ b/retropikzel/pffi/v0-1-0/main.rkt @@ -1,250 +1,3 @@ #lang r7rs -;> # pffi - -;> ## Procedures -(define-library - (retropikzel pffi v0-1-0 main) - (cond-expand - (sagittarius - (import (scheme base) - (scheme write) - (scheme file) - (scheme process-context) - (retropikzel pffi v0-1-0 sagittarius))) - (guile - (import (scheme base) - (scheme write) - (scheme file) - (scheme process-context) - (retropikzel pffi v0-1-0 guile))) - (racket - (import (scheme base) - (scheme write) - (scheme file) - (scheme process-context) - (only (racket base) system-type) - (retropikzel pffi v0-1-0 racket))) - (stklos - (import (scheme base) - (scheme write) - (scheme file) - (scheme process-context) - (stklos) - (retropikzel pffi v0-1-0 stklos))) - (kawa - (import (scheme base) - (scheme write) - (scheme file) - (scheme process-context))) - (cyclone - (import (scheme base) - (scheme write) - (scheme file) - (scheme process-context) - (retropikzel pffi v0-1-0 cyclone))) - (gambit - (import (scheme base) - (scheme write) - (scheme file) - (scheme process-context) - (retropikzel pffi v0-1-0 gambit))) - (chicken - (import (scheme base) - (scheme write) - (scheme file) - (scheme process-context) - (retropikzel pffi v0-1-0 chicken))) - (chibi - (import (scheme base) - (scheme write) - (scheme file) - (scheme process-context) - (retropikzel pffi v0-1-0 chibi))) - (mit-scheme - (import (scheme base) - (scheme write) - (scheme file) - (scheme process-context) - (retropikzel pffi v0-1-0 mit-scheme)))) - (export pffi-shared-object-auto-load - pffi-shared-object-load - pffi-define - pffi-size-of - pffi-pointer-allocate - pffi-pointer-null - pffi-string->pointer - pffi-pointer->string - pffi-pointer->bytevector - pffi-pointer-free - pffi-pointer? - pffi-pointer-null? - pffi-pointer-set! - pffi-pointer-get - pffi-pointer-deref) - (begin - - - - (define library-version "v0-1-0") - - ;> ## Procedures - - (define platform-file-extension - (cond-expand - (racket (if (equal? (system-type 'os) 'windows) ".dll" ".so")) - (windows ".dll") - (else ".so"))) - - (define platform-version-file-extension - (cond-expand - (racket (if (equal? (system-type 'os) 'windows) ".dll" ".so.0")) - (windows ".dll") - (else ".so.0"))) - - (define platform-lib-prefix - (cond-expand - (racket (if (equal? (system-type 'os) 'windows) "" "lib")) - (windows "") - (else "lib"))) - - (define pffi-types - '(int8 - uint8 - int16 - uint16 - int32 - uint32 - int64 - uint64 - intptr - uintptr - char - unsigned-char - short - unsigned-short - int - unsigned-int - long - unsigned-long - float - double - pointer)) - - (define string-split - (lambda (str mark) - (let* ((str-l (string->list str)) - (res (list)) - (last-index 0) - (index 0) - (splitter (lambda (c) - (cond ((char=? c mark) - (begin - (set! res (append res (list (string-copy str last-index index)))) - (set! last-index (+ index 1)))) - ((equal? (length str-l) (+ index 1)) - (set! res (append res (list (string-copy str last-index (+ index 1))))))) - (set! index (+ index 1))))) - (for-each splitter str-l) - res))) - - (define auto-load-paths - (append - (cond-expand - (windows - (append - (if (get-environment-variable "SYSTEM") - (list (get-environment-variable "SYSTEM")) - (list)) - (if (get-environment-variable "WINDIR") - (list (get-environment-variable "WINDIR")) - (list)) - (list ".") - (string-split (get-environment-variable "PATH") #\;))) - (else - (append - ; Guix - (list (if (get-environment-variable "GUIX_ENVIRONMENT") - (string-append (get-environment-variable "GUIX_ENVIRONMENT") "/lib") - "") - "/run/current-system/profile/lib") - ; Debian - (if (get-environment-variable "LD_LIBRARY_PATH") - (list (string-split (get-environment-variable "LD_LIBRARY_PATH") #\:)) - (list)) - (list "/lib/x86_64-linux-gnu" - "/usr/lib/x86_64-linux-gnu" - "/usr/local/lib")))))) - - ;> ### pffi-shared-object-load - ;> - ;> Arguments: - ;> - path (string) The path to the shared object you want to load, including any "lib" infront and .so/.dll at the end - ;> - ;> Returns: - ;> - - - - - ;> ### pffi-shared-object-auto-load - ;> - ;> Arguments: - ;> - object-name (symbol) - ;> - The name of the dynamic library file you want to load without the "lib" in fron of it or .so/.dll at the end - ;> - addition-paths (list (string)...) - ;> - Any additional paths you want to search for the library - ;> - ;> Returns: - ;> - (object) Shared object, the type depends on the implementation - - (define-syntax pffi-shared-object-auto-load - (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)) - (else - (let* ((paths (append auto-load-paths additional-paths)) - (shared-object #f)) - (for-each - (lambda (path) - (if (not shared-object) - (let ((object-path - (string-append path - "/" - object-name - platform-file-extension)) - (object-version-path - (string-append path - "/" - object-name - platform-version-file-extension)) - (object-lib-path - (string-append path - "/" - platform-lib-prefix - object-name - platform-file-extension)) - (object-version-lib-path - (string-append path - "/" - platform-lib-prefix - object-name - platform-version-file-extension))) - (cond - ((file-exists? object-path) - (set! shared-object (pffi-shared-object-load headers object-path))) - ((file-exists? object-version-path) - (set! shared-object (pffi-shared-object-load headers object-version-path))) - ((file-exists? object-lib-path) - (set! shared-object (pffi-shared-object-load headers object-lib-path))) - ((file-exists? object-version-lib-path) - (set! shared-object (pffi-shared-object-load headers object-version-lib-path))))))) - paths) - (if (not shared-object) - (error "Could not load shared object" object-name) - shared-object))))))) - - (cond-expand - (kawa (include "kawa.scm")) - (else #t)))) +(import (scheme base)) +(include "main.sld") diff --git a/retropikzel/pffi/v0-1-0/racket.rkt b/retropikzel/pffi/v0-1-0/racket.rkt index bf371ed..126f629 100644 --- a/retropikzel/pffi/v0-1-0/racket.rkt +++ b/retropikzel/pffi/v0-1-0/racket.rkt @@ -7,7 +7,8 @@ (scheme file) (scheme process-context) (compatibility mlist) - (ffi unsafe)) + (ffi unsafe) + (ffi vector)) (export pffi-shared-object-load pffi-define pffi-size-of @@ -34,7 +35,6 @@ ((equal? type 'uint32) _uint32) ((equal? type 'int64) _int64) ((equal? type 'uint64) _uint64) - ;((equal? type 'char) _int32) ((equal? type 'char) _int) ((equal? type 'unsigned-char) _int) ((equal? type 'short) _short) @@ -86,10 +86,7 @@ (define pffi-pointer->bytevector (lambda (pointer size) - #f - ;(pointer->bytevector pointer size) - - )) + (cast pointer _pointer _bytes))) (define pffi-shared-object-load (lambda (header path) @@ -106,13 +103,14 @@ (define pffi-pointer-set! (lambda (pointer type offset value) - (ptr-set! pointer type offset 'abs value))) + (ptr-set! pointer (pffi-type->native-type type) offset value))) (define pffi-pointer-get (lambda (pointer type offset) - (ptr-ref pointer type 'abs offset))) + (ptr-ref pointer (pffi-type->native-type type) offset))) (define pffi-pointer-deref (lambda (pointer) - #f ; TODO FIX + pointer + ;#f ; TODO FIX ))))