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

Make pffi-size-of work with structs too

This commit is contained in:
retropikzel 2025-02-17 20:03:55 +02:00
parent a35dc8dbc8
commit 7b12ab40cb
23 changed files with 164 additions and 98 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
README.md
View File

@ -40,7 +40,6 @@ Any help in form of constructive advice and bug reports are appreciated.
- [pffi-string->pointer](#strongpffi-string-gtpointerstrong-string--gt-pointer)
- [pffi-pointer->string](#strongpffi-pointer-gtstringstrong-pointer--gt-string)
- [pffi-struct-make](#strongpffi-struct-makestrong-name-members--pointer--gt-pffi-struct)
- [pffi-struct-size](#strongpffi-struct-sizestrong-pffi-struct--gt-number)
- [pffi-struct-pointer](#strongpffi-struct-pointerstrong-pffi-struct--gt-pointer)
- [pffi-struct-offset-get](#strongpffi-struct-offset-getstrong-member-name--gt-number)
- [pffi-struct-get](#strongpffi-struct-getstrong-pffi-struct-member-name--gt-object)
@ -76,28 +75,28 @@ changing anymore and some implementations are in **beta**.
### Beta
| | pffi-init | pffi-size-of | pffi-shared-object-auto-load | pffi-shared-object-load | pffi-pointer-null | pffi-pointer-null? | pffi-pointer-allocate | pffi-pointer-address | pffi-pointer? | pffi-pointer-free | pffi-pointer-set! | pffi-pointer-get | pffi-string->pointer | pffi-pointer->string | pffi-struct-make | pffi-struct-size | pffi-struct-pointer | pffi-struct-offset-get | pffi-struct-get | pffi-struct-set! | pffi-struct-dereference | pffi-define | pffi-define-callback |
|--------------|-----------|--------------|------------------------------|-------------------------|-------------------|--------------------|-----------------------|----------------------|---------------|-------------------|-------------------|------------------|----------------------|----------------------|------------------|------------------|---------------------|------------------------|-----------------|------------------|-------------------------|-------------|----------------------|
| Guile | X | X | X | X | X | X | X | | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X |
| Racket | X | X | X | X | X | X | X | | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X |
| Saggittarius | X | X | X | X | X | X | X | | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X |
| | pffi-init | pffi-size-of | pffi-shared-object-auto-load | pffi-shared-object-load | pffi-pointer-null | pffi-pointer-null? | pffi-pointer-allocate | pffi-pointer-address | pffi-pointer? | pffi-pointer-free | pffi-pointer-set! | pffi-pointer-get | pffi-string->pointer | pffi-pointer->string | pffi-struct-make | pffi-struct-pointer | pffi-struct-offset-get | pffi-struct-get | pffi-struct-set! | pffi-struct-dereference | pffi-define | pffi-define-callback |
|--------------|-----------|--------------|------------------------------|-------------------------|-------------------|--------------------|-----------------------|----------------------|---------------|-------------------|-------------------|------------------|----------------------|----------------------|------------------|---------------------|------------------------|-----------------|------------------|-------------------------|-------------|----------------------|
| Guile | X | X | X | X | X | X | X | | X | X | X | X | X | X | X | X | X | X | X | X | X | X |
| Racket | X | X | X | X | X | X | X | | X | X | X | X | X | X | X | X | X | X | X | X | X | X |
| Saggittarius | X | X | X | X | X | X | X | | X | X | X | X | X | X | X | X | X | X | X | X | X | X |
### Alpha
| | pffi-init | pffi-size-of | pffi-shared-object-auto-load | pffi-shared-object-load | pffi-pointer-null | pffi-pointer-null? | pffi-pointer-allocate | pffi-pointer-address |pffi-pointer? | pffi-pointer-free | pffi-pointer-set! | pffi-pointer-get | pffi-string->pointer | pffi-pointer->string | pffi-struct-make | pffi-struct-size | pffi-struct-pointer | pffi-struct-offset-get | pffi-struct-get | pffi-struct-set! | pffi-struct-dereference | pffi-define | pffi-define-callback |
|--------------|-----------|--------------|------------------------------|-------------------------|-------------------|--------------------|-----------------------|----------------------|---------------|-------------------|-------------------|------------------|----------------------|----------------------|------------------|------------------|---------------------|------------------------|-----------------|------------------|-------------------------|-------------|----------------------|
| Chibi | X | X | X | X | X | X | X | | X | X | X | X | X | X | X | X | X | X | X | X | | X | |
| Chicken-5 | X | X | X | X | X | X | X | | X | X | X | X | X | X | X | X | X | X | X | X | | X | X |
| Cyclone | X | X | X | X | X | X | X | | X | X | X | X | X | X | X | X | X | X | X | X | | X | |
| Gambit | X | X | | | | | | | | | | | | | X | X | X | X | X | X | | | |
| Gauche | X | | | | | | | | | | | | | | X | X | X | X | X | X | | | |
| Gerbil | X | | | | | | | | | | | | | | X | X | X | X | X | X | | | |
| Larceny | X | | | | | | | | | | | | | | X | X | X | X | X | X | | | |
| Mosh | X | X | X | X | X | X | X | | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X |
| Skint | X | | | | | | | | | | | | | | X | X | X | X | X | X | | | |
| Stklos | X | X | X | X | X | X | X | | X | X | | | | | X | X | X | X | X | X | | | |
| tr7 | | | | | | | | | | | | | | | X | X | X | X | X | X | | | |
| Ypsilon | | | | | | | | | | | | | | | X | X | X | X | X | X | | | |
| | pffi-init | pffi-size-of | pffi-shared-object-auto-load | pffi-shared-object-load | pffi-pointer-null | pffi-pointer-null? | pffi-pointer-allocate | pffi-pointer-address |pffi-pointer? | pffi-pointer-free | pffi-pointer-set! | pffi-pointer-get | pffi-string->pointer | pffi-pointer->string | pffi-struct-make | pffi-struct-pointer | pffi-struct-offset-get | pffi-struct-get | pffi-struct-set! | pffi-struct-dereference | pffi-define | pffi-define-callback |
|--------------|-----------|--------------|------------------------------|-------------------------|-------------------|--------------------|-----------------------|----------------------|---------------|-------------------|-------------------|------------------|----------------------|----------------------|------------------|---------------------|------------------------|-----------------|------------------|-------------------------|-------------|----------------------|
| Chibi | X | X | X | X | X | X | X | | X | X | X | X | X | X | X | X | X | X | X | | X | |
| Chicken-5 | X | X | X | X | X | X | X | | X | X | X | X | X | X | X | X | X | X | X | | X | X |
| Cyclone | X | X | X | X | X | X | X | | X | X | X | X | X | X | X | X | X | X | X | | X | |
| Gambit | X | X | | | | | | | | | | | | | X | X | X | X | X | | | |
| Gauche | X | | | | | | | | | | | | | | X | X | X | X | X | | | |
| Gerbil | X | | | | | | | | | | | | | | X | X | X | X | X | | | |
| Larceny | X | | | | | | | | | | | | | | X | X | X | X | X | | | |
| Mosh | X | X | X | X | X | X | X | | X | X | X | X | X | X | X | X | X | X | X | X | X | X |
| Skint | X | | | | | | | | | | | | | | X | X | X | X | X | | | |
| Stklos | X | X | X | X | X | X | X | | X | X | | | | | X | X | X | X | X | | | |
| tr7 | | | | | | | | | | | | | | | X | X | X | X | X | | | |
| Ypsilon | | | | | | | | | | | | | | | X | X | X | X | X | | | |
### Not started
@ -187,9 +186,9 @@ Some of these are procedures and some macros, it might also change implementatio
Always call this first, on most implementation it does nothing but some implementations might need
initialisation run.
##### **pffi-size-of** type -> number
##### **pffi-size-of** object -> number
Returns the size of the type.
Returns the size of the pffi-struct, pffi-enum or pffi-type.
##### **pffi-align-of** type -> number
@ -294,14 +293,6 @@ names and types. For example:
C-type argument can be symbol or a string.
##### **pffi-struct-size** pffi-struct -> number
Returns the size of a given pffi-struct. For example:
(define s (pffi-struct-make 'test '((int . r) (int . g) (int . b))))
(pffi-struct-size s)
> 12
##### **pffi-struct-pointer** pffi-struct -> pointer
Returns the pointer that holds the struct content. You need to use this when passing a struct as

6
manifest.scm
View File

@ -2,4 +2,8 @@
;; You can store it in a file that you may then pass to any 'guix' command
;; that accepts a '--manifest' (or '-m') option.
(specifications->manifest (list "gcc-toolchain"))
(specifications->manifest (list "gcc-toolchain"
"guile-next"
"racket"
"chicken"
"stklos"))

37
retropikzel/r7rs-pffi.sld
View File

@ -11,6 +11,7 @@
(chibi))
(export pffi-init
pffi-size-of
pffi-type?
pffi-align-of
pffi-shared-object-auto-load
pffi-shared-object-load
@ -24,7 +25,6 @@
pffi-string->pointer
pffi-pointer->string
pffi-struct-make
pffi-struct-size
pffi-struct-pointer
pffi-struct-offset-get
pffi-struct-get
@ -46,6 +46,7 @@
(chicken random))
(export pffi-init
pffi-size-of
pffi-type?
pffi-align-of
pffi-shared-object-auto-load
pffi-shared-object-load
@ -60,7 +61,6 @@
pffi-string->pointer
pffi-pointer->string
pffi-struct-make
pffi-struct-size
pffi-struct-pointer
pffi-struct-offset-get
pffi-struct-get
@ -81,6 +81,7 @@
(chicken random))
(export pffi-init
pffi-size-of
pffi-type?
pffi-align-of
pffi-shared-object-auto-load
pffi-shared-object-load
@ -94,7 +95,6 @@
pffi-string->pointer
pffi-pointer->string
pffi-struct-make
pffi-struct-size
pffi-struct-pointer
pffi-struct-offset-get
pffi-struct-get
@ -111,6 +111,7 @@
(scheme cyclone primitives))
(export pffi-init
pffi-size-of
pffi-type?
pffi-align-of
pffi-shared-object-auto-load
pffi-shared-object-load
@ -124,7 +125,6 @@
pffi-string->pointer
pffi-pointer->string
pffi-struct-make
pffi-struct-size
pffi-struct-pointer
pffi-struct-offset-get
pffi-struct-get
@ -142,6 +142,7 @@
(only (gambit) c-declare c-lambda c-define))
(export pffi-init
pffi-size-of
pffi-type?
pffi-align-of
pffi-shared-object-auto-load
pffi-shared-object-load
@ -155,7 +156,6 @@
;pffi-string->pointer
;pffi-pointer->string
pffi-struct-make
pffi-struct-size
pffi-struct-pointer
pffi-struct-offset-get
pffi-struct-get
@ -171,6 +171,7 @@
(scheme process-context))
(export pffi-init
;pffi-size-of
pffi-type?
pffi-align-of
;pffi-shared-object-auto-load
;pffi-shared-object-load
@ -184,7 +185,6 @@
;pffi-string->pointer
;pffi-pointer->string
pffi-struct-make
pffi-struct-size
pffi-struct-pointer
pffi-struct-offset-get
pffi-struct-get
@ -200,6 +200,7 @@
(scheme process-context))
(export pffi-init
;pffi-size-of
pffi-type?
;pffi-align-of
;pffi-shared-object-auto-load
;pffi-shared-object-load
@ -213,7 +214,6 @@
;pffi-string->pointer
;pffi-pointer->string
pffi-struct-make
pffi-struct-size
pffi-struct-pointer
pffi-struct-offset-get
pffi-struct-get
@ -232,6 +232,7 @@
(system foreign-library))
(export pffi-init
pffi-size-of
pffi-type?
pffi-align-of
pffi-shared-object-auto-load
pffi-shared-object-load
@ -246,7 +247,6 @@
pffi-string->pointer
pffi-pointer->string
pffi-struct-make
pffi-struct-size
pffi-struct-pointer
pffi-struct-offset-get
pffi-struct-get
@ -262,6 +262,7 @@
(scheme process-context))
(export pffi-init
pffi-size-of
pffi-type?
pffi-align-of
pffi-shared-object-auto-load
pffi-shared-object-load
@ -275,7 +276,6 @@
pffi-string->pointer
pffi-pointer->string
pffi-struct-make
pffi-struct-size
pffi-struct-pointer
pffi-struct-offset-get
pffi-struct-get
@ -298,6 +298,7 @@
)
(export pffi-init
;pffi-size-of
pffi-type?
;pffi-align-of
;pffi-shared-object-auto-load
;pffi-shared-object-load
@ -311,7 +312,6 @@
;pffi-string->pointer
;pffi-pointer->string
pffi-struct-make
pffi-struct-size
pffi-struct-pointer
pffi-struct-offset-get
pffi-struct-get
@ -328,6 +328,7 @@
(mosh ffi))
(export pffi-init
pffi-size-of
pffi-type?
pffi-align-of
pffi-shared-object-auto-load
pffi-shared-object-load
@ -341,7 +342,6 @@
pffi-string->pointer
pffi-pointer->string
pffi-struct-make
pffi-struct-size
pffi-struct-pointer
pffi-struct-offset-get
pffi-struct-get
@ -362,6 +362,7 @@
(ffi vector))
(export pffi-init
pffi-size-of
pffi-type?
pffi-align-of
pffi-shared-object-auto-load
pffi-shared-object-load
@ -376,7 +377,6 @@
pffi-string->pointer
pffi-pointer->string
pffi-struct-make
pffi-struct-size
pffi-struct-pointer
pffi-struct-offset-get
pffi-struct-get
@ -394,6 +394,7 @@
(sagittarius))
(export pffi-init
pffi-size-of
pffi-type?
pffi-align-of
pffi-shared-object-auto-load
pffi-shared-object-load
@ -408,7 +409,6 @@
pffi-string->pointer
pffi-pointer->string
pffi-struct-make
pffi-struct-size
pffi-struct-pointer
pffi-struct-offset-get
pffi-struct-get
@ -424,6 +424,7 @@
(scheme process-context))
(export pffi-init
;pffi-size-of
pffi-type?
;pffi-align-of
;pffi-shared-object-auto-load
;pffi-shared-object-load
@ -437,7 +438,6 @@
;pffi-string->pointer
;pffi-pointer->string
pffi-struct-make
pffi-struct-size
pffi-struct-pointer
pffi-struct-offset-get
pffi-struct-get
@ -454,6 +454,7 @@
(stklos))
(export pffi-init
pffi-size-of
pffi-type?
pffi-align-of
pffi-shared-object-auto-load
pffi-shared-object-load
@ -467,7 +468,6 @@
;pffi-string->pointer
;pffi-pointer->string
pffi-struct-make
pffi-struct-size
pffi-struct-pointer
pffi-struct-offset-get
pffi-struct-get
@ -483,6 +483,7 @@
(scheme process-context))
(export pffi-init
;pffi-size-of
pffi-type?
;pffi-align-of
;pffi-shared-object-auto-load
;pffi-shared-object-load
@ -496,7 +497,6 @@
;pffi-string->pointer
;pffi-pointer->string
pffi-struct-make
pffi-struct-size
pffi-struct-pointer
pffi-struct-offset-get
pffi-struct-get
@ -512,6 +512,7 @@
(scheme process-context))
(export ;pffi-init
;pffi-size-of
pffi-type?
;pffi-align-of
;pffi-shared-object-auto-load
;pffi-shared-object-load
@ -525,7 +526,6 @@
;pffi-string->pointer
;pffi-pointer->string
pffi-struct-make
pffi-struct-size
pffi-struct-pointer
pffi-struct-offset-get
pffi-struct-get
@ -556,6 +556,9 @@
(cond-expand
(stklos (include "retropikzel/r7rs-pffi/struct.scm")) ; FIXME temporarily for stklos 2.10
(else (include "r7rs-pffi/struct.scm")))
(cond-expand
(stklos (include "retropikzel/r7rs-pffi/union.scm")) ; FIXME temporarily for stklos 2.10
(else (include "r7rs-pffi/union.scm")))
(cond-expand
(stklos (include "retropikzel/r7rs-pffi/main.scm")) ; FIXME temporarily for stklos 2.10
(else (include "r7rs-pffi/main.scm"))))

8
retropikzel/r7rs-pffi/chibi.scm
View File

@ -1,4 +1,4 @@
(define pffi-size-of
(define size-of-type
(lambda (type)
(cond ((eq? type 'int8) (size-of-int8_t))
((eq? type 'uint8) (size-of-uint8_t))
@ -19,7 +19,7 @@
((eq? type 'float) (size-of-float))
((eq? type 'double) (size-of-double))
((eq? type 'pointer) (size-of-pointer))
(else (error "Can not get size of unknown type" type)))))
((eq? type 'string) (size-of-pointer)))))
(define pffi-shared-object-load
(lambda (headers path . options)
@ -163,7 +163,7 @@
value)
((procedure? value)
(scheme-procedure-to-pointer value))
(else (let ((pointer (pffi-pointer-allocate (pffi-size-of type))))
(else (let ((pointer (pffi-pointer-allocate (size-of-type type))))
(pffi-pointer-set! pointer type 0 value)
pointer)))))
@ -180,7 +180,7 @@
(return-value (pffi-pointer-allocate
(if (equal? return-type 'void)
0
(pffi-size-of return-type)))))
(size-of-type return-type)))))
(when (not (pffi-pointer-null? maybe-dlerror))
(error (pffi-pointer->string maybe-dlerror)))
(lambda arguments

5
retropikzel/r7rs-pffi/chicken5.scm
View File

@ -117,7 +117,7 @@
(begin ,@ procedure-body))
(define ,scheme-name (location external_123456789)))))))
(define pffi-size-of
(define size-of-type
(lambda (type)
(cond ((equal? type 'int8) (foreign-value "sizeof(int8_t)" int))
((equal? type 'uint8) (foreign-value "sizeof(uint8_t)" int))
@ -138,7 +138,8 @@
((equal? type 'float) (foreign-value "sizeof(float)" int))
((equal? type 'double) (foreign-value "sizeof(double)" int))
((equal? type 'pointer) (foreign-value "sizeof(void*)" int))
(else (error "pffi-size-of -- No such pffi type" type)))))
((equal? type 'string) (foreign-value "sizeof(void*)" int))
((equal? type 'callback) (foreign-value "sizeof(void*)" int)))))
(define pffi-pointer-allocate
(lambda (size)

4
retropikzel/r7rs-pffi/chicken6.scm
View File

@ -113,7 +113,7 @@
(begin ,@ procedure-body))
(define ,scheme-name (location external_123456789)))))))
(define pffi-size-of
(define size-of-type
(lambda (type)
(cond ((equal? type 'int8) (foreign-value "sizeof(int8_t)" int))
((equal? type 'uint8) (foreign-value "sizeof(uint8_t)" int))
@ -134,7 +134,7 @@
((equal? type 'float) (foreign-value "sizeof(float)" int))
((equal? type 'double) (foreign-value "sizeof(double)" int))
((equal? type 'pointer) (foreign-value "sizeof(void*)" int))
(else (error "pffi-size-of -- No such pffi type" type)))))
(else #f)))))
(define pffi-pointer-allocate
(lambda (size)

5
retropikzel/r7rs-pffi/cyclone.scm
View File

@ -71,7 +71,7 @@
(lambda (scheme-name return-type argument-types procedure)
(error "pffi-define-callback not yet implemented on Cyclone")))
(define pffi-size-of
(define size-of-type
(lambda (type)
(cond ((equal? type 'int8) (c-value "sizeof(int8_t)" int))
((equal? type 'uint8) (c-value "sizeof(uint8_t)" int))
@ -91,8 +91,7 @@
((equal? type 'unsigned-long) (c-value "sizeof(unsigned long)" int))
((equal? type 'float) (c-value "sizeof(float)" int))
((equal? type 'double) (c-value "sizeof(double)" int))
((equal? type 'pointer) (c-value "sizeof(void*)" int))
(else (error "pffi-size-of -- No such pffi type" type)))))
((equal? type 'pointer) (c-value "sizeof(void*)" int)))))
(define-c pffi-pointer-allocate
"(void *data, int argc, closure _, object k, object size)"

2
retropikzel/r7rs-pffi/gambit.scm
View File

@ -26,7 +26,7 @@
(define size-of-void* (c-lambda () int "___return(sizeof(void*));"))
(define pffi-size-of
(define size-of-type
(lambda (type)
(cond ((eq? type 'int8) (size-of-int8_t))
((eq? type 'uint8) (size-of-uint8_t))

2
retropikzel/r7rs-pffi/gauche.scm
View File

@ -1,3 +1,3 @@
(define pffi-size-of
(define size-of-type
(lambda (type)
(cond ((equal? type 'int8) 1))))

2
retropikzel/r7rs-pffi/gerbil.scm
View File

@ -11,7 +11,7 @@
((pffi-define scheme-name shared-object c-name return-type argument-types)
(error "Not defined"))))
(define pffi-size-of
(define size-of-type
(lambda (type)
(error "Not defined")))

18
retropikzel/r7rs-pffi/guile.scm
View File

@ -45,7 +45,7 @@
procedure
(map pffi-type->native-type argument-types))))))
(define pffi-size-of
(define size-of-type
(lambda (type)
(sizeof (pffi-type->native-type type))))
@ -96,14 +96,14 @@
((equal? type 'char) (bytevector-s8-set! p offset (char->integer value)))
((equal? type 'short) (bytevector-s8-set! p offset value))
((equal? type 'unsigned-short) (bytevector-u8-set! p offset value))
((equal? type 'int) (bytevector-sint-set! p offset value (native-endianness) (pffi-size-of type)))
((equal? type 'unsigned-int) (bytevector-uint-set! p offset value (native-endianness) (pffi-size-of type)))
((equal? type 'int) (bytevector-sint-set! p offset value (native-endianness) (size-of-type type)))
((equal? type 'unsigned-int) (bytevector-uint-set! p offset value (native-endianness) (size-of-type type)))
((equal? type 'long) (bytevector-s64-set! p offset value (native-endianness)))
((equal? type 'unsigned-long) (bytevector-u64-set! p offset value (native-endianness)))
((equal? type 'float) (bytevector-ieee-single-set! p offset value (native-endianness)))
((equal? type 'double) (bytevector-ieee-double-set! p offset value (native-endianness)))
((equal? type 'pointer) (bytevector-sint-set! p offset (pointer-address value) (native-endianness) (pffi-size-of type)))
((equal? type 'string) (bytevector-sint-set! p offset (pointer-address (pffi-string->pointer value)) (native-endianness) (pffi-size-of type)))))))
((equal? type 'pointer) (bytevector-sint-set! p offset (pointer-address value) (native-endianness) (size-of-type type)))
((equal? type 'string) (bytevector-sint-set! p offset (pointer-address (pffi-string->pointer value)) (native-endianness) (size-of-type type)))))))
(define pffi-pointer-get
(lambda (pointer type offset)
@ -119,14 +119,14 @@
((equal? type 'char) (integer->char (bytevector-s8-ref p offset)))
((equal? type 'short) (bytevector-s8-ref p offset))
((equal? type 'unsigned-short) (bytevector-u8-ref p offset))
((equal? type 'int) (bytevector-sint-ref p offset (native-endianness) (pffi-size-of type)))
((equal? type 'unsigned-int) (bytevector-uint-ref p offset (native-endianness) (pffi-size-of type)))
((equal? type 'int) (bytevector-sint-ref p offset (native-endianness) (size-of-type type)))
((equal? type 'unsigned-int) (bytevector-uint-ref p offset (native-endianness) (size-of-type type)))
((equal? type 'long) (bytevector-s64-ref p offset (native-endianness)))
((equal? type 'unsigned-long) (bytevector-u64-ref p offset (native-endianness)))
((equal? type 'float) (bytevector-ieee-single-ref p offset (native-endianness)))
((equal? type 'double) (bytevector-ieee-double-ref p offset (native-endianness)))
((equal? type 'pointer) (make-pointer (bytevector-sint-ref p offset (native-endianness) (pffi-size-of type))))
((equal? type 'string) (pffi-pointer->string (make-pointer (bytevector-sint-ref p offset (native-endianness) (pffi-size-of type)))))))))
((equal? type 'pointer) (make-pointer (bytevector-sint-ref p offset (native-endianness) (size-of-type type))))
((equal? type 'string) (pffi-pointer->string (make-pointer (bytevector-sint-ref p offset (native-endianness) (size-of-type type)))))))))
(define pffi-struct-dereference
(lambda (struct)

2
retropikzel/r7rs-pffi/kawa.scm
View File

@ -123,7 +123,7 @@
method-handle)))
(invoke native-linker 'upcallStub method-handle function-descriptor arena))))))
(define pffi-size-of
(define size-of-type
(lambda (type)
(invoke (pffi-type->native-type type) 'byteAlignment)))

2
retropikzel/r7rs-pffi/larceny.scm
View File

@ -1,7 +1,7 @@
(require 'std-ffi)
;; FIXME
(define pffi-size-of
(define size-of-type
(lambda (type)
(cond ((eq? type 'int8) 1)
((eq? type 'uint8) 1)

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

@ -7,7 +7,15 @@
(chicken memory))))))
(else
(define pffi-init
(lambda () (+ 1 1)))))
(lambda () #t))))
(define (pffi-type? object) (if (equal? (size-of-type object) #f) #f #t))
(define (pffi-size-of object)
(cond ((pffi-struct? object) (pffi-struct-size object))
((pffi-union? object) (pffi-union-size object))
((pffi-type? object) (size-of-type object))
(else (error "Not pffi-struct, pffi-enum of pffi-type" object))))
(define pffi-types
'(int8

6
retropikzel/r7rs-pffi/mosh.scm
View File

@ -1,4 +1,4 @@
(define pffi-size-of
(define size-of-type
(lambda (type)
(cond ((eq? type 'int8) 1)
((eq? type 'uint8) 1)
@ -95,10 +95,10 @@
(index 0))
(string-for-each
(lambda (c)
(pffi-pointer-set! pointer 'char (* index (pffi-size-of 'char)) c)
(pffi-pointer-set! pointer 'char (* index (size-of-type 'char)) c)
(set! index (+ index 1)))
string-content)
(pffi-pointer-set! pointer 'char (* index (pffi-size-of 'char)) #\null)
(pffi-pointer-set! pointer 'char (* index (size-of-type 'char)) #\null)
pointer)))
(define pffi-pointer->string

2
retropikzel/r7rs-pffi/racket.scm
View File

@ -45,7 +45,7 @@
(mlist->list (map pffi-type->native-type argument-types))
(pffi-type->native-type return-type)))))))
(define pffi-size-of
(define size-of-type
(lambda (type)
(ctype-sizeof (pffi-type->native-type type))))

5
retropikzel/r7rs-pffi/sagittarius.scm
View File

@ -47,7 +47,7 @@
(map pffi-type->native-type argument-types)
procedure)))))
(define pffi-size-of
(define size-of-type
(lambda (type)
(cond ((eq? type 'int8) size-of-int8_t)
((eq? type 'uint8) size-of-uint8_t)
@ -68,7 +68,8 @@
((eq? type 'float) size-of-float)
((eq? type 'double) size-of-double)
((eq? type 'pointer) size-of-void*)
(else (error "Can not get size of unknown type" type)))))
((eq? type 'string) size-of-void*)
(else #f))))
(define pffi-pointer-allocate
(lambda (size)

2
retropikzel/r7rs-pffi/skint.scm
View File

@ -1,3 +1,3 @@
(define pffi-size-of
(define size-of-type
(lambda (type)
(cond ((equal? type 'int8) 1))))

2
retropikzel/r7rs-pffi/stklos.scm
View File

@ -43,7 +43,7 @@
(error "Not implemented")))
; If youre reading this, this is just a temp hack. Dont judge me :D
(define pffi-size-of
(define size-of-type
(lambda (type)
(cond
((equal? type 'int8) 1)

6
retropikzel/r7rs-pffi/struct.scm
View File

@ -11,7 +11,7 @@
(lambda (type)
(cond-expand
;(guile (alignof (pffi-type->native-type type)))
(else (pffi-size-of type)))))
(else (size-of-type type)))))
(define (round-to-next-modulo-of to-round roundee)
(if (= (floor-remainder to-round roundee) 0)
@ -25,8 +25,8 @@
(let* ((name (cdr member))
(type (car member))
(type-alignment (pffi-align-of type)))
(when (> (pffi-size-of type) largest-member-size)
(set! largest-member-size (pffi-size-of type)))
(when (> (size-of-type type) largest-member-size)
(set! largest-member-size (size-of-type type)))
(if (or (= size 0)
(= (floor-remainder size type-alignment) 0))
(begin

2
retropikzel/r7rs-pffi/tr7.scm
View File

@ -1,3 +1,3 @@
(define pffi-size-of
(define size-of-type
(lambda (type)
(cond ((equal? type 'int8) 1))))

8
retropikzel/r7rs-pffi/union.scm Normal file
View File

@ -0,0 +1,8 @@
(define-record-type <pffi-union>
(union-make c-type size pointer members)
pffi-union?
(c-type pffi-union-c-type)
(size pffi-union-size)
(pointer pffi-union-pointer)
(members pffi-union-members))

75
test.scm
View File

@ -58,6 +58,57 @@
(pffi-init)
;; pffi-type?
(print-header 'pffi-type?)
(debug (pffi-type? 'int8))
(assert equal? (pffi-type? 'int8) #t)
(debug (pffi-type? 'uint8))
(assert equal? (pffi-type? 'uint8) #t)
(debug (pffi-type? 'int16))
(assert equal? (pffi-type? 'int16) #t)
(debug (pffi-type? 'uint16))
(assert equal? (pffi-type? 'uint16) #t)
(debug (pffi-type? 'int32))
(assert equal? (pffi-type? 'int32) #t)
(debug (pffi-type? 'uint32))
(assert equal? (pffi-type? 'uint32) #t)
(debug (pffi-type? 'int64))
(assert equal? (pffi-type? 'int64) #t)
(debug (pffi-type? 'uint64))
(assert equal? (pffi-type? 'uint64) #t)
(debug (pffi-type? 'char))
(assert equal? (pffi-type? 'char) #t)
(debug (pffi-type? 'unsigned-char))
(assert equal? (pffi-type? 'unsigned-char) #t)
(debug (pffi-type? 'short))
(assert equal? (pffi-type? 'short) #t)
(debug (pffi-type? 'unsigned-short))
(assert equal? (pffi-type? 'unsigned-short) #t)
(debug (pffi-type? 'int))
(assert equal? (pffi-type? 'int) #t)
(debug (pffi-type? 'unsigned-int))
(assert equal? (pffi-type? 'unsigned-int) #t)
(debug (pffi-type? 'long))
(assert equal? (pffi-type? 'long) #t)
(debug (pffi-type? 'unsigned-long))
(assert equal? (pffi-type? 'unsigned-long) #t)
(debug (pffi-type? 'float))
(assert equal? (pffi-type? 'float) #t)
(debug (pffi-type? 'double))
(assert equal? (pffi-type? 'double) #t)
(debug (pffi-type? 'string))
(assert equal? (pffi-type? 'string) #t)
(debug (pffi-type? 'pointer))
(assert equal? (pffi-type? 'pointer) #t)
(debug (pffi-type? 'void))
(assert equal? (pffi-type? 'void) #t)
(debug (pffi-type? 'callback))
(assert equal? (pffi-type? 'callback) #t)
(pffi-init)
;; pffi-size-of
(print-header 'pffi-size-of)
@ -449,28 +500,28 @@
(define struct1 (pffi-struct-make 'test '((int . r) (int . g) (int . b))))
(debug struct1)
(debug (pffi-struct-size struct1))
(assert = (pffi-struct-size struct1) 12)
(debug (pffi-size-of struct1))
(assert = (pffi-size-of struct1) 12)
(define struct2 (pffi-struct-make 'test '((int8 . r) (int8 . g) (int . b))))
(debug struct2)
(debug (pffi-struct-size struct2))
(assert = (pffi-struct-size struct2) 8)
(debug (pffi-size-of struct2))
(assert = (pffi-size-of struct2) 8)
(define struct3 (pffi-struct-make 'test '((int8 . r) (int8 . g) (int . b))))
(debug struct3)
(debug (pffi-struct-size struct3))
(assert = (pffi-struct-size struct3) 8)
(debug (pffi-size-of struct3))
(assert = (pffi-size-of struct3) 8)
(define struct4 (pffi-struct-make 'test '((int8 . r) (pointer . a) (int8 . g) (int . b))))
(debug struct4)
(debug (pffi-struct-size struct4))
(assert = (pffi-struct-size struct4) 24)
(debug (pffi-size-of struct4))
(assert = (pffi-size-of struct4) 24)
(define struct5 (pffi-struct-make 'test '((int8 . r) (char . b) (pointer . a) (int8 . g) (int . b))))
(debug struct5)
(debug (pffi-struct-size struct5))
(assert = (pffi-struct-size struct5) 24)
(debug (pffi-size-of struct5))
(assert = (pffi-size-of struct5) 24)
(define struct6 (pffi-struct-make 'test '((int8 . a)
(char . b)
@ -487,8 +538,8 @@
(double . m)
(float . n))))
(debug struct6)
(debug (pffi-struct-size struct6))
(assert = (pffi-struct-size struct6) 96)
(debug (pffi-size-of struct6))
(assert = (pffi-size-of struct6) 96)
;; pffi-string->pointer