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

Small guile fixes

This commit is contained in:
retropikzel 2024-07-19 20:54:30 +03:00
parent c6e4691a99
commit 2a911690da
3 changed files with 12 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
Jenkinsfile vendored
View File

@ -1,20 +0,0 @@
pipeline {
agent any
stages {
stage('Test amd64') {
steps {
sh 'make test-amd64-wine'
}
}
stage('Test amd64 wine') {
steps {
sh 'make test-amd64-wine'
}
}
stage('Test arm64') {
steps {
sh 'make test-arm64'
}
}
}
}

2
composition.scm
View File

@ -1,6 +1,6 @@
((packager . "retropikzel") ((packager . "retropikzel")
(name . "r7rs-pffi") (name . "r7rs-pffi")
(version . "v0-4-1") (version . "v0-4-2")
(type . "library") (type . "library")
(description . "Portable Foreign Function Interface for R7RS schemes") (description . "Portable Foreign Function Interface for R7RS schemes")
(license . "LGPL") (license . "LGPL")

22
retropikzel/r7rs-pffi/version/guile.scm
View File

@ -108,8 +108,8 @@
(lambda (pointer type offset value) (lambda (pointer type offset value)
(let ((p (pointer->bytevector pointer (+ offset 100))) (let ((p (pointer->bytevector pointer (+ offset 100)))
(native-type (pffi-type->native-type type))) (native-type (pffi-type->native-type type)))
(cond ((equal? native-type int8) (bytevector-s8-set! p offset value)) (cond ((equal? native-type int8) (bytevector-s8-set! p offset value (native-endianness)))
((equal? native-type uint8) (bytevector-u8-set! p offset value)) ((equal? native-type uint8) (bytevector-u8-set! p offset value (native-endianness)))
((equal? native-type int16) (bytevector-s16-set! p offset value (native-endianness))) ((equal? native-type int16) (bytevector-s16-set! p offset value (native-endianness)))
((equal? native-type uint16) (bytevector-u16-set! p offset value (native-endianness))) ((equal? native-type uint16) (bytevector-u16-set! p offset value (native-endianness)))
((equal? native-type int32) (bytevector-s32-set! p offset value (native-endianness))) ((equal? native-type int32) (bytevector-s32-set! p offset value (native-endianness)))
@ -117,13 +117,13 @@
((equal? native-type int64) (bytevector-s64-set! p offset value (native-endianness))) ((equal? native-type int64) (bytevector-s64-set! p offset value (native-endianness)))
((equal? native-type uint64) (bytevector-u64-set! p offset value (native-endianness))) ((equal? native-type uint64) (bytevector-u64-set! p offset value (native-endianness)))
((equal? native-type short) (bytevector-s8-set! p offset value (native-endianness))) ((equal? native-type short) (bytevector-s8-set! p offset value (native-endianness)))
((equal? native-type unsigned-short) (bytevector-u8-set! p offset value)) ((equal? native-type unsigned-short) (bytevector-u8-set! p offset value (native-endianness)))
((equal? native-type int) (bytevector-sint-set! p offset value (native-endianness) (pffi-size-of type))) ((equal? native-type int) (bytevector-sint-set! p offset value (native-endianness) (pffi-size-of type)))
((equal? native-type unsigned-int) (bytevector-uint-set! p offset value (native-endianness) (pffi-size-of type))) ((equal? native-type unsigned-int) (bytevector-uint-set! p offset value (native-endianness) (pffi-size-of type)))
((equal? native-type long) (bytevector-s64-set! p offset value (native-endianness))) ((equal? native-type long) (bytevector-s64-set! p offset value (native-endianness)))
((equal? native-type unsigned-long) (bytevector-u64-set! p offset value (native-endianness))) ((equal? native-type unsigned-long) (bytevector-u64-set! p offset value (native-endianness)))
((equal? native-type float) (bytevector-u64-set! p offset value (native-endianness))) ((equal? native-type float) (bytevector-ieee-single-set! p offset value (native-endianness)))
((equal? native-type double) (bytevector-u64-set! p offset value (native-endianness))) ((equal? native-type double) (bytevector-ieee-double-set! p offset value (native-endianness)))
((equal? native-type '*) (bytevector-sint-set! p offset (pointer-address value) (native-endianness) (pffi-size-of type)))) ((equal? native-type '*) (bytevector-sint-set! p offset (pointer-address value) (native-endianness) (pffi-size-of type))))
))) )))
@ -131,22 +131,22 @@
(lambda (pointer type offset) (lambda (pointer type offset)
(let ((p (pointer->bytevector pointer (+ offset 100))) (let ((p (pointer->bytevector pointer (+ offset 100)))
(native-type (pffi-type->native-type type))) (native-type (pffi-type->native-type type)))
(cond ((equal? native-type int8) (bytevector-s8-ref p offset)) (cond ((equal? native-type int8) (bytevector-s8-ref p offset (native-endianness)))
((equal? native-type uint8) (bytevector-u8-ref p offset)) ((equal? native-type uint8) (bytevector-u8-ref p offset (native-endianness)))
((equal? native-type int16) (bytevector-s16-ref p offset (native-endianness))) ((equal? native-type int16) (bytevector-s16-ref p offset (native-endianness)))
((equal? native-type uint16) (bytevector-u16-ref p offset (native-endianness))) ((equal? native-type uint16) (bytevector-u16-ref p offset (native-endianness)))
((equal? native-type int32) (bytevector-s32-ref p offset (native-endianness))) ((equal? native-type int32) (bytevector-s32-ref p offset (native-endianness)))
((equal? native-type uint32) (bytevector-u32-ref p offset (native-endianness))) ((equal? native-type uint32) (bytevector-u32-ref p offset (native-endianness)))
((equal? native-type int64) (bytevector-s64-ref p offset (native-endianness))) ((equal? native-type int64) (bytevector-s64-ref p offset (native-endianness)))
((equal? native-type uint64) (bytevector-u64-ref p offset (native-endianness))) ((equal? native-type uint64) (bytevector-u64-ref p offset (native-endianness)))
((equal? native-type short) (bytevector-s8-ref p offset)) ((equal? native-type short) (bytevector-s8-ref p offset (native-endianness)))
((equal? native-type unsigned-short) (bytevector-u8-ref p offset)) ((equal? native-type unsigned-short) (bytevector-u8-ref p offset (native-endianness)))
((equal? native-type int) (bytevector-sint-ref p offset (native-endianness) (pffi-size-of type))) ((equal? native-type int) (bytevector-sint-ref p offset (native-endianness) (pffi-size-of type)))
((equal? native-type unsigned-int) (bytevector-uint-ref p offset (native-endianness) (pffi-size-of type))) ((equal? native-type unsigned-int) (bytevector-uint-ref p offset (native-endianness) (pffi-size-of type)))
((equal? native-type long) (bytevector-s64-ref p offset (native-endianness))) ((equal? native-type long) (bytevector-s64-ref p offset (native-endianness)))
((equal? native-type unsigned-long) (bytevector-u64-ref p offset (native-endianness))) ((equal? native-type unsigned-long) (bytevector-u64-ref p offset (native-endianness)))
((equal? native-type float) (bytevector-u64-ref p offset (native-endianness))) ((equal? native-type float) (bytevector-ieee-single-ref p offset (native-endianness)))
((equal? native-type double) (bytevector-u64-ref p offset (native-endianness))) ((equal? native-type double) (bytevector-ieee-double-ref p offset (native-endianness)))
((equal? native-type '*) (make-pointer (bytevector-sint-ref p offset (native-endianness) (pffi-size-of type)))))))) ((equal? native-type '*) (make-pointer (bytevector-sint-ref p offset (native-endianness) (pffi-size-of type))))))))
(define pffi-pointer-deref (define pffi-pointer-deref