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

Made good progress with the struct interface

This commit is contained in:
retropikzel 2025-01-14 20:43:54 +02:00
parent 0a5883eade
commit ebba1db3f7
2 changed files with 65 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -17,20 +17,35 @@
to-round to-round
(round-to-next-modulo-of (+ to-round 1) roundee))) (round-to-next-modulo-of (+ to-round 1) roundee)))
(define (calculate-struct-size types) (define (calculate-struct-size-and-offsets members)
(cond-expand (let* ((size 0)
(guile (sizeof (map pffi-type->native-type types))) (largest-member-size 0)
(else (offsets (map (lambda (member)
(let ((size 0)) (let* ((name (cdr member))
(for-each (type (car member))
(lambda (type) (type-alignment (pffi-align-of type)))
(let ((type-alignment (pffi-align-of type))) (when (> (pffi-size-of type) largest-member-size)
(if (or (= size 0) (set! largest-member-size (pffi-size-of type)))
(= (floor-remainder size type-alignment) 0)) (if (or (= size 0)
(set! size (+ size type-alignment)) (= (floor-remainder size type-alignment) 0))
(set! size (+ (round-to-next-modulo-of size type-alignment) type-alignment))))) (begin
types) (set! size (+ size type-alignment))
size)))) (list name type (- size type-alignment)))
(begin
(set! size (+ (round-to-next-modulo-of size type-alignment)
type-alignment))
(list name
type
(round-to-next-modulo-of size type-alignment))))))
members)))
(list (cons 'size
(cond-expand
(guile (sizeof (map pffi-type->native-type (map car members))))
(else
(if (= (modulo size largest-member-size) 0)
size
(round-to-next-modulo-of size largest-member-size)))))
(cons 'offsets offsets))))
(define pffi-word-size (define pffi-word-size
(cond-expand (cond-expand
@ -38,6 +53,10 @@
(else 8))) ; 64-bit system (else 8))) ; 64-bit system
(define (pffi-struct-allocate name members) (define (pffi-struct-allocate name members)
(let* ((size (calculate-struct-size (map car members))) (let* ((size-and-offsets (calculate-struct-size-and-offsets members))
(size (cdr (assoc 'size size-and-offsets)))
(offsets (cdr (assoc 'offsets size-and-offsets)))
(pointer (pffi-pointer-allocate size))) (pointer (pffi-pointer-allocate size)))
(write size-and-offsets)
(newline)
(pffi-struct-make name size pointer members))) (pffi-struct-make name size pointer members)))

31
test.scm
View File

@ -433,6 +433,8 @@
; pffi-struct-allocate ; pffi-struct-allocate
(print-header "pffi-struct")
(define struct1 (pffi-struct-allocate 'test '((int . r) (int . g) (int . b)))) (define struct1 (pffi-struct-allocate 'test '((int . r) (int . g) (int . b))))
(debug struct1) (debug struct1)
(debug (pffi-struct-size struct1)) (debug (pffi-struct-size struct1))
@ -448,6 +450,35 @@
(debug (pffi-struct-size struct3)) (debug (pffi-struct-size struct3))
(assert = (pffi-struct-size struct3) 8) (assert = (pffi-struct-size struct3) 8)
(define struct4 (pffi-struct-allocate 'test '((int8 . r) (pointer . a) (int8 . g) (int . b))))
(debug struct4)
(debug (pffi-struct-size struct4))
(assert = (pffi-struct-size struct4) 24)
(define struct5 (pffi-struct-allocate 'test '((int8 . r) (char . b) (pointer . a) (int8 . g) (int . b))))
(debug struct5)
(debug (pffi-struct-size struct5))
(assert = (pffi-struct-size struct5) 24)
(define struct6 (pffi-struct-allocate 'test '((int8 . r)
(char . b)
(double . c)
(char bb)
(pointer . a)
(float . d)
(pointer . aa)
(int8 . g)
(pointer . aaa)
(int . bbb)
(int . bbbb)
(int . bbbb)
(double . c)
(float . d)
)))
(debug struct6)
(debug (pffi-struct-size struct6))
(assert = (pffi-struct-size struct6) 96)
#| #|
;; pffi-string->pointer ;; pffi-string->pointer