Retropikzel
/
foreign-c
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Auto load fixes

This commit is contained in:
retropikzel 2025-02-08 12:07:19 +02:00
parent 7b43422811
commit 7fca3f383a
1 changed files with 21 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
retropikzel/r7rs-pffi/main.scm
View File

@ -146,7 +146,8 @@
;(racket (if (equal? (system-type 'os) 'windows) ".dll" ".so")) ;(racket (if (equal? (system-type 'os) 'windows) ".dll" ".so"))
(windows ".dll") (windows ".dll")
(else ".so"))) (else ".so")))
(shared-object #f)) (shared-object #f)
(searched-paths (list)))
(for-each (for-each
(lambda (path) (lambda (path)
(for-each (for-each
@ -156,17 +157,23 @@
slash slash
platform-lib-prefix platform-lib-prefix
object-name object-name
platform-file-extension (cond-expand
(windows "")
(else platform-file-extension))
(if (string=? version "") (if (string=? version "")
"" ""
(string-append (string-append
(cond-expand (windows "-") (cond-expand (windows "-")
(else ".")) (else "."))
version)))) version))
(cond-expand
(windows platform-file-extension)
(else ""))))
(library-path-without-suffixes (string-append path (library-path-without-suffixes (string-append path
slash slash
platform-lib-prefix platform-lib-prefix
object-name))) object-name)))
(set! searched-paths (append searched-paths (list library-path)))
(when (and (not shared-object) (when (and (not shared-object)
(file-exists? library-path)) (file-exists? library-path))
(set! shared-object (set! shared-object
@ -175,11 +182,17 @@
versions)) versions))
paths) paths)
(if (not shared-object) (if (not shared-object)
(error "Could not load shared object" (begin
(list (cons 'object object-name) (display "Could not load shared object: ")
(cons 'paths paths) (write (list (cons 'object object-name)
(cons 'platform-file-extension platform-file-extension) (cons 'paths paths)
(cons 'versions versions))) (cons 'platform-file-extension platform-file-extension)
(cons 'versions versions)))
(newline)
(display "Searched paths: ")
(write searched-paths)
(newline)
(exit 1))
(pffi-shared-object-load headers (pffi-shared-object-load headers
shared-object shared-object
`((additional-versions ,versions)))))))))))) `((additional-versions ,versions))))))))))))