From cd87578e038639d79604f126c38c4424823fa1c1 Mon Sep 17 00:00:00 2001 From: retropikzel Date: Wed, 23 Jul 2025 14:26:34 +0300 Subject: [PATCH] Racket uint8-ref/set! fixes --- foreign/c/primitives/racket.scm | 18 +++++-- tests/c-bytevector.scm | 83 +++++++++++++++++++++++++++++++++ 2 files changed, 97 insertions(+), 4 deletions(-) create mode 100644 tests/c-bytevector.scm diff --git a/foreign/c/primitives/racket.scm b/foreign/c/primitives/racket.scm index 849d17b..abe7eca 100644 --- a/foreign/c/primitives/racket.scm +++ b/foreign/c/primitives/racket.scm @@ -1,7 +1,7 @@ (define type->native-type (lambda (type) - (cond ((equal? type 'int8) _int8) - ((equal? type 'uint8) _uint8) + (cond ((equal? type 'int8) _byte) + ((equal? type 'uint8) _ubyte) ((equal? type 'int16) _int16) ((equal? type 'uint16) _uint16) ((equal? type 'int32) _int32) @@ -59,11 +59,21 @@ (define c-bytevector-u8-set! (lambda (c-bytevector k byte) - (ptr-set! c-bytevector _byte 'abs k byte))) + (ptr-set! c-bytevector _ubyte 'abs k byte))) (define c-bytevector-u8-ref (lambda (c-bytevector k) - (ptr-ref c-bytevector _ubyte 'abs k))) + (let ((result (ptr-ref c-bytevector _ubyte 'abs k))) + (display "c-bytevector: ") + (display c-bytevector) + (newline) + (display "k: ") + (display k) + (newline) + (display "Result: ") + (display result) + (newline) + result))) (define c-bytevector-pointer-set! (lambda (c-bytevector k pointer) diff --git a/tests/c-bytevector.scm b/tests/c-bytevector.scm new file mode 100644 index 0000000..e23a74f --- /dev/null +++ b/tests/c-bytevector.scm @@ -0,0 +1,83 @@ +(import (scheme base) + (scheme write) + (scheme read) + (scheme char) + (scheme file) + (scheme process-context) + (foreign c)) + +;; util +(define header-count 1) + +(define print-header + (lambda (title) + (set-tag title) + (display "=========================================") + (newline) + (display header-count) + (display " ") + (display title) + (newline) + (display "=========================================") + (newline) + (set! header-count (+ header-count 1)))) + +(define count 0) +(define assert-tag 'none) + +(define set-tag + (lambda (tag) + (set! assert-tag tag) + (set! count 0))) + +(cond-expand + (gambit + (define assert + (lambda (check value-a value-b) + (let ((result (apply check (list value-a value-b)))) + (set! count (+ count 1)) + (if (not result) (display "FAIL ") (display "PASS ")) + (display "[") + (display assert-tag) + (display " - ") + (display count) + (display "]") + (display ": ") + (write (list 'check 'value-a 'value-b)) + (newline) + (when (not result) (exit 1)))))) + (else + (define-syntax assert + (syntax-rules () + ((_ check value-a value-b) + (let ((result (apply check (list value-a value-b)))) + (set! count (+ count 1)) + (if (not result) (display "FAIL ") (display "PASS ")) + (display "[") + (display assert-tag) + (display " - ") + (display count) + (display "]") + (display ": ") + (write (list 'check 'value-a 'value-b)) + (newline) + (when (not result) (exit 1)))))))) + +(define-syntax debug + (syntax-rules () + ((_ value) + (begin + (display 'value) + (display ": ") + (write value) + (newline))))) + +(let* ((pointer-size (c-type-size 'long)) + (pointer (make-c-bytevector (c-type-size 'long)))) + (c-bytevector-sint-set! pointer 0 42 (native-endianness) pointer-size) + (let ((value (c-bytevector-sint-ref pointer 0 (native-endianness) pointer-size))) + (c-free pointer) + (display "Code: ") + (display value) + (newline) + (assert = value 42)))