This commit is contained in:
retropikzel 2024-06-06 14:40:27 +03:00
parent e5b121416c
commit 08efcd520c
23 changed files with 62 additions and 46 deletions

View File

@ -2,8 +2,12 @@
VERSION=$(shell cat VERSION) VERSION=$(shell cat VERSION)
build: build-main-scm build: build-main-scm
install: build
schubert install
build-main-scm: build-main-scm:
cp retropikzel/pffi/${VERSION}/main.sld retropikzel/pffi/${VERSION}/main.scm cp retropikzel/pffi/${VERSION}/main.sld retropikzel/pffi/${VERSION}/main.scm
@ -22,7 +26,7 @@ documentation:
tmp: tmp:
mkdir -p tmp mkdir -p tmp
test: test: build
bash test-all.sh bash test-all.sh
clean: clean:

View File

@ -1 +1 @@
v0-2-1 v0-2-2

View File

@ -1,5 +1,5 @@
(define-library (define-library
(retropikzel pffi v0-2-1 chicken) (retropikzel pffi v0-2-2 chicken)
(import (scheme base) (import (scheme base)
(scheme write) (scheme write)
(scheme file) (scheme file)

View File

@ -1,5 +1,5 @@
(define-library (define-library
(retropikzel pffi v0-2-1 cyclone) (retropikzel pffi v0-2-2 cyclone)
(import (scheme base) (import (scheme base)
(scheme write) (scheme write)
(scheme file) (scheme file)

View File

@ -1,5 +1,5 @@
(define-library (define-library
(retropikzel pffi v0-2-1 empty) (retropikzel pffi v0-2-2 empty)
(import (scheme base) (import (scheme base)
(scheme write) (scheme write)
(scheme file) (scheme file)

View File

@ -1,5 +1,5 @@
(define-library (define-library
(retropikzel pffi v0-2-1 gambit) (retropikzel pffi v0-2-2 gambit)
(import (scheme base) (import (scheme base)
(scheme write) (scheme write)
(scheme file) (scheme file)

View File

@ -1,5 +1,5 @@
(define-library (define-library
(retropikzel pffi v0-2-1 gerbil) (retropikzel pffi v0-2-2 gerbil)
(import (scheme base) (import (scheme base)
(scheme write) (scheme write)
(scheme file) (scheme file)

View File

@ -1,5 +1,5 @@
(define-library (define-library
(retropikzel pffi v0-2-1 guile) (retropikzel pffi v0-2-2 guile)
(import (scheme base) (import (scheme base)
(scheme write) (scheme write)
(scheme file) (scheme file)

View File

@ -1,32 +1,32 @@
(define-library (define-library
(retropikzel pffi v0-2-1 main) (retropikzel pffi v0-2-2 main)
(cond-expand (cond-expand
(sagittarius (sagittarius
(import (scheme base) (import (scheme base)
(scheme write) (scheme write)
(scheme file) (scheme file)
(scheme process-context) (scheme process-context)
(retropikzel pffi v0-2-1 sagittarius))) (retropikzel pffi v0-2-2 sagittarius)))
(guile (guile
(import (scheme base) (import (scheme base)
(scheme write) (scheme write)
(scheme file) (scheme file)
(scheme process-context) (scheme process-context)
(retropikzel pffi v0-2-1 guile))) (retropikzel pffi v0-2-2 guile)))
(racket (racket
(import (scheme base) (import (scheme base)
(scheme write) (scheme write)
(scheme file) (scheme file)
(scheme process-context) (scheme process-context)
(only (racket base) system-type) (only (racket base) system-type)
(retropikzel pffi v0-2-1 racket))) (retropikzel pffi v0-2-2 racket)))
(stklos (stklos
(import (scheme base) (import (scheme base)
(scheme write) (scheme write)
(scheme file) (scheme file)
(scheme process-context) (scheme process-context)
(stklos) (stklos)
(retropikzel pffi v0-2-1 stklos))) (retropikzel pffi v0-2-2 stklos)))
(kawa (kawa
(import (scheme base) (import (scheme base)
(scheme write) (scheme write)
@ -37,31 +37,31 @@
(scheme write) (scheme write)
(scheme file) (scheme file)
(scheme process-context) (scheme process-context)
(retropikzel pffi v0-2-1 cyclone))) (retropikzel pffi v0-2-2 cyclone)))
(gambit (gambit
(import (scheme base) (import (scheme base)
(scheme write) (scheme write)
(scheme file) (scheme file)
(scheme process-context) (scheme process-context)
(retropikzel pffi v0-2-1 gambit))) (retropikzel pffi v0-2-2 gambit)))
(chicken (chicken
(import (scheme base) (import (scheme base)
(scheme write) (scheme write)
(scheme file) (scheme file)
(scheme process-context) (scheme process-context)
(retropikzel pffi v0-2-1 chicken))) (retropikzel pffi v0-2-2 chicken)))
(chibi (chibi
(import (scheme base) (import (scheme base)
(scheme write) (scheme write)
(scheme file) (scheme file)
(scheme process-context) (scheme process-context)
(retropikzel pffi v0-2-1 chibi))) (retropikzel pffi v0-2-2 chibi)))
(mit-scheme (mit-scheme
(import (scheme base) (import (scheme base)
(scheme write) (scheme write)
(scheme file) (scheme file)
(scheme process-context) (scheme process-context)
(retropikzel pffi v0-2-1 mit-scheme)))) (retropikzel pffi v0-2-2 mit-scheme))))
(export pffi-shared-object-auto-load (export pffi-shared-object-auto-load
pffi-shared-object-load pffi-shared-object-load
pffi-define pffi-define
@ -83,7 +83,7 @@
(define library-version "v0-2-1") (define library-version "v0-2-2")
(define slash (cond-expand (windows (string #\\)) (else "/"))) (define slash (cond-expand (windows (string #\\)) (else "/")))
(define platform-file-extension (define platform-file-extension
@ -149,7 +149,16 @@
(if (get-environment-variable "WINDIR") (if (get-environment-variable "WINDIR")
(list (get-environment-variable "WINDIR")) (list (get-environment-variable "WINDIR"))
(list)) (list))
(list ".") (if (get-environment-variable "WINEDLLDIR0")
(list (get-environment-variable "WINEDLLDIR0"))
(list))
(if (get-environment-variable "SystemRoot")
(list (string-append
(get-environment-variable "SystemRoot")
"system32"))
(list))
(list "."
)
(string-split (get-environment-variable "PATH") #\;))) (string-split (get-environment-variable "PATH") #\;)))
(else (else
(append (append
@ -166,7 +175,6 @@
"/usr/lib/x86_64-linux-gnu" "/usr/lib/x86_64-linux-gnu"
"/usr/local/lib" "/usr/local/lib"
"/usr/lib" "/usr/lib"
"/usr/lib32"
"/usr/lib64")))))) "/usr/lib64"))))))
(define auto-load-versions (list "")) (define auto-load-versions (list ""))
@ -192,14 +200,16 @@
object-name object-name
platform-file-extension platform-file-extension
version))) version)))
(write library-path)
(newline)
(if (file-exists? library-path) (if (file-exists? library-path)
(set! shared-object library-path)))) (set! shared-object library-path))))
versions)) versions))
paths) paths)
(if (not shared-object) (if (not shared-object)
(error "Could not load shared object" object-name) (error "Could not load shared object"
(list (cons 'object object-name)
(cons 'paths paths)
(cons 'platform-file-extension platform-file-extension)
(cons 'versions versions)))
(pffi-shared-object-load headers shared-object)))))))) (pffi-shared-object-load headers shared-object))))))))
(cond-expand (cond-expand

View File

@ -6,27 +6,27 @@
(scheme write) (scheme write)
(scheme file) (scheme file)
(scheme process-context) (scheme process-context)
(retropikzel pffi v0-2-1 sagittarius))) (retropikzel pffi v0-2-2 sagittarius)))
(guile (guile
(import (scheme base) (import (scheme base)
(scheme write) (scheme write)
(scheme file) (scheme file)
(scheme process-context) (scheme process-context)
(retropikzel pffi v0-2-1 guile))) (retropikzel pffi v0-2-2 guile)))
(racket (racket
(import (scheme base) (import (scheme base)
(scheme write) (scheme write)
(scheme file) (scheme file)
(scheme process-context) (scheme process-context)
(only (racket base) system-type) (only (racket base) system-type)
(retropikzel pffi v0-2-1 racket))) (retropikzel pffi v0-2-2 racket)))
(stklos (stklos
(import (scheme base) (import (scheme base)
(scheme write) (scheme write)
(scheme file) (scheme file)
(scheme process-context) (scheme process-context)
(stklos) (stklos)
(retropikzel pffi v0-2-1 stklos))) (retropikzel pffi v0-2-2 stklos)))
(kawa (kawa
(import (scheme base) (import (scheme base)
(scheme write) (scheme write)
@ -37,31 +37,31 @@
(scheme write) (scheme write)
(scheme file) (scheme file)
(scheme process-context) (scheme process-context)
(retropikzel pffi v0-2-1 cyclone))) (retropikzel pffi v0-2-2 cyclone)))
(gambit (gambit
(import (scheme base) (import (scheme base)
(scheme write) (scheme write)
(scheme file) (scheme file)
(scheme process-context) (scheme process-context)
(retropikzel pffi v0-2-1 gambit))) (retropikzel pffi v0-2-2 gambit)))
(chicken (chicken
(import (scheme base) (import (scheme base)
(scheme write) (scheme write)
(scheme file) (scheme file)
(scheme process-context) (scheme process-context)
(retropikzel pffi v0-2-1 chicken))) (retropikzel pffi v0-2-2 chicken)))
(chibi (chibi
(import (scheme base) (import (scheme base)
(scheme write) (scheme write)
(scheme file) (scheme file)
(scheme process-context) (scheme process-context)
(retropikzel pffi v0-2-1 chibi))) (retropikzel pffi v0-2-2 chibi)))
(mit-scheme (mit-scheme
(import (scheme base) (import (scheme base)
(scheme write) (scheme write)
(scheme file) (scheme file)
(scheme process-context) (scheme process-context)
(retropikzel pffi v0-2-1 mit-scheme)))) (retropikzel pffi v0-2-2 mit-scheme))))
(export pffi-shared-object-auto-load (export pffi-shared-object-auto-load
pffi-shared-object-load pffi-shared-object-load
pffi-define pffi-define
@ -83,7 +83,7 @@
(define library-version "v0-2-1") (define library-version "v0-2-2")
(define slash (cond-expand (windows (string #\\)) (else "/"))) (define slash (cond-expand (windows (string #\\)) (else "/")))
(define platform-file-extension (define platform-file-extension

View File

@ -1,7 +1,7 @@
#lang r7rs #lang r7rs
(define-library (define-library
(retropikzel pffi v0-2-1 racket) (retropikzel pffi v0-2-2 racket)
(import (scheme base) (import (scheme base)
(scheme write) (scheme write)
(scheme file) (scheme file)

View File

@ -1,5 +1,5 @@
(define-library (define-library
(retropikzel pffi v0-2-1 sagittarius) (retropikzel pffi v0-2-2 sagittarius)
(import (scheme base) (import (scheme base)
(scheme write) (scheme write)
(scheme file) (scheme file)

View File

@ -1,5 +1,5 @@
(define-library (define-library
(retropikzel pffi v0-2-1 stklos) (retropikzel pffi v0-2-2 stklos)
(import (scheme base) (import (scheme base)
(scheme write) (scheme write)
(scheme file) (scheme file)

View File

@ -3,6 +3,8 @@
set -eu set -eu
set -o pipefail set -o pipefail
VERSION=$(cat VERSION)
for testfile in ./test-*.sh for testfile in ./test-*.sh
do do
if [[ ! "${testfile}" = "./test-all.sh" ]]; if [[ ! "${testfile}" = "./test-all.sh" ]];

View File

@ -1,6 +1,6 @@
(import (scheme base) (import (scheme base)
(scheme write) (scheme write)
(retropikzel pffi v0-2-1 main)) (retropikzel pffi v0-2-2 main))
(display "Hello from import.scm") (display "Hello from import.scm")
(newline) (newline)

View File

@ -1,6 +1,6 @@
(import (scheme base) (import (scheme base)
(scheme write) (scheme write)
(retropikzel pffi v0-2-1 main)) (retropikzel pffi v0-2-2 main))
(display 'int8) (display 'int8)
(display " ") (display " ")

View File

@ -1,6 +1,6 @@
(import (scheme base) (import (scheme base)
(scheme write) (scheme write)
(retropikzel pffi v0-2-1 main)) (retropikzel pffi v0-2-2 main))
(define p (pffi-pointer-allocate (+ (* (pffi-size-of 'uint32) 3) (define p (pffi-pointer-allocate (+ (* (pffi-size-of 'uint32) 3)
(* (pffi-size-of 'uint8) 4) (* (pffi-size-of 'uint8) 4)

View File

@ -1,6 +1,6 @@
(import (scheme base) (import (scheme base)
(scheme write) (scheme write)
(retropikzel pffi v0-2-1 main)) (retropikzel pffi v0-2-2 main))
(define p (pffi-pointer-allocate (+ (* (pffi-size-of 'uint32) 3) (define p (pffi-pointer-allocate (+ (* (pffi-size-of 'uint32) 3)
(* (pffi-size-of 'uint8) 4) (* (pffi-size-of 'uint8) 4)

View File

@ -1,6 +1,6 @@
(import (scheme base) (import (scheme base)
(scheme write) (scheme write)
(retropikzel pffi v0-2-1 main)) (retropikzel pffi v0-2-2 main))
(define p (pffi-pointer-allocate (+ (* (pffi-size-of 'uint32) 3) (define p (pffi-pointer-allocate (+ (* (pffi-size-of 'uint32) 3)
(* (pffi-size-of 'uint8) 4) (* (pffi-size-of 'uint8) 4)

View File

@ -1,6 +1,6 @@
(import (scheme base) (import (scheme base)
(scheme write) (scheme write)
(retropikzel pffi v0-2-1 main)) (retropikzel pffi v0-2-2 main))
(define p (pffi-pointer-allocate (+ (* (pffi-size-of 'uint32) 3) (define p (pffi-pointer-allocate (+ (* (pffi-size-of 'uint32) 3)
(* (pffi-size-of 'uint8) 4) (* (pffi-size-of 'uint8) 4)

View File

@ -1,6 +1,6 @@
(import (scheme base) (import (scheme base)
(scheme write) (scheme write)
(retropikzel pffi v0-2-1 main)) (retropikzel pffi v0-2-2 main))
(define original "Hello world") (define original "Hello world")

View File

@ -2,7 +2,7 @@
(scheme write) (scheme write)
(scheme process-context) (scheme process-context)
(scheme eval) (scheme eval)
(retropikzel pffi v0-2-1 main)) (retropikzel pffi v0-2-2 main))
(define libcurl (pffi-shared-object-auto-load (list "curl/curl.h") (define libcurl (pffi-shared-object-auto-load (list "curl/curl.h")
(list) (list)

View File

@ -2,7 +2,7 @@
(scheme write) (scheme write)
(scheme process-context) (scheme process-context)
(scheme eval) (scheme eval)
(retropikzel pffi v0-2-1 main)) (retropikzel pffi v0-2-2 main))
(define libc (pffi-shared-object-auto-load (list "curl/curl.h") (define libc (pffi-shared-object-auto-load (list "curl/curl.h")
(list) (list)