- Better error messages

- Improve sagittarius pffi-pointer-null
This commit is contained in:
retropikzel 2024-06-01 09:39:39 +03:00
parent c4a537448c
commit 8ee8b8fc78
2 changed files with 25 additions and 4 deletions

View File

@ -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
@ -181,6 +190,8 @@
(let* ((paths (append auto-load-paths additional-paths)) (let* ((paths (append auto-load-paths additional-paths))
(versions (append auto-load-versions additional-versions)) (versions (append auto-load-versions additional-versions))
(shared-object #f)) (shared-object #f))
(write paths)
(newline)
(for-each (for-each
(lambda (path) (lambda (path)
(for-each (for-each
@ -191,12 +202,22 @@
object-name object-name
platform-file-extension platform-file-extension
version))) version)))
(write library-path)
(if (file-exists? library-path) (if (file-exists? library-path)
(set! shared-object library-path)))) (begin
(write " exists!")
(set! shared-object library-path)))
(newline)
))
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

@ -87,7 +87,7 @@
(define pffi-pointer-null (define pffi-pointer-null
(lambda () (lambda ()
(integer->pointer 0))) (empty-pointer)))
(define pffi-string->pointer (define pffi-string->pointer
(lambda (string-content) (lambda (string-content)