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

Progress with Gauche

This commit is contained in:
retropikzel 2025-04-27 20:35:16 +03:00
parent 8ccfc69395
commit 872ce5d897
1 changed files with 11 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
foreign/c/primitives/gauche.scm
View File

@ -195,14 +195,24 @@
(let ((c-function (dlsym shared-object c-name)) (let ((c-function (dlsym shared-object c-name))
(maybe-dlerror (dlerror))) (maybe-dlerror (dlerror)))
(lambda arguments (lambda arguments
(display "Calling: ")
(write c-name)
(newline)
(let ((return-pointer (internal-ffi-call (length argument-types) (let ((return-pointer (internal-ffi-call (length argument-types)
(type->libffi-type-number return-type) (type->libffi-type-number return-type)
(map type->libffi-type-number argument-types) (map type->libffi-type-number argument-types)
c-function c-function
(size-of-type return-type) (size-of-type return-type)
arguments))) arguments)))
(cond #;((equal? return-type 'pointer) return-pointer) (cond ((equal? return-type 'pointer)
(display "SCM return value: ")
(write return-pointer)
(newline)
return-pointer)
((not (equal? return-type 'void)) ((not (equal? return-type 'void))
(display "SCM return value: ")
(write (pointer-get return-pointer return-type 0))
(newline)
(pointer-get return-pointer return-type 0)))))))) (pointer-get return-pointer return-type 0))))))))
(define-syntax define-c-procedure (define-syntax define-c-procedure