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

Add c-type-align

This commit is contained in:
retropikzel 2025-08-06 10:59:41 +03:00
parent f8bc94e86f
commit bc4befe2d1
18 changed files with 315 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Makefile
View File

@ -1,7 +1,7 @@
.PHONY: libtest.o tests/libtest.so libtest.a documentation README.html foreign-c.pdf
PDFENGINE=weasyprint
CC=gcc
VERSION=0.10.2
VERSION=0.10.3
TEST=primitives
SCHEME=chibi
TMPDIR=tmp/${SCHEME}

1
foreign/c.sld
View File

@ -180,6 +180,7 @@
bytevector-c-uint8-ref))))
(export ;;;; Primitives 1
c-type-size
c-type-align
define-c-library
define-c-procedure
c-bytevector?

4
foreign/c/main.scm
View File

@ -2,6 +2,10 @@
(lambda (type)
(size-of-type type)))
(define c-type-align
(lambda (type)
(align-of-type type)))
(define foreign-c:string-split
(lambda (str mark)
(let* ((str-l (string->list str))

26
foreign/c/primitives/chibi.scm
View File

@ -24,6 +24,32 @@
((eq? type 'void) 0)
(else #f))))
(define align-of-type
(lambda (type)
(cond ((eq? type 'int8) (align-of-int8_t))
((eq? type 'uint8) (align-of-uint8_t))
((eq? type 'int16) (align-of-int16_t))
((eq? type 'uint16) (align-of-uint16_t))
((eq? type 'int32) (align-of-int32_t))
((eq? type 'uint32) (align-of-uint32_t))
((eq? type 'int64) (align-of-int64_t))
((eq? type 'uint64) (align-of-uint64_t))
((eq? type 'char) (align-of-char))
((eq? type 'unsigned-char) (align-of-char))
((eq? type 'short) (align-of-short))
((eq? type 'unsigned-short) (align-of-unsigned-short))
((eq? type 'int) (align-of-int))
((eq? type 'unsigned-int) (align-of-unsigned-int))
((eq? type 'long) (align-of-long))
((eq? type 'unsigned-long) (align-of-unsigned-long))
((eq? type 'float) (align-of-float))
((eq? type 'double) (align-of-double))
((eq? type 'pointer) (align-of-pointer))
((eq? type 'pointer-address) (align-of-pointer))
((eq? type 'callback) (align-of-pointer))
((eq? type 'void) 0)
(else #f))))
(define shared-object-load
(lambda (path options)
(let ((shared-object (dlopen path RTLD-NOW))

43
foreign/c/primitives/chibi/foreign-c.stub
View File

@ -57,6 +57,49 @@
(define-c int (size-of-double size_of_double) ())
(define-c int (size-of-pointer size_of_pointer) ())
;; c-type-align
(c-declare "
int align_of_int8_t() { return _Alignof(int8_t); }
int align_of_uint8_t() { return _Alignof(uint8_t); }
int align_of_int16_t() { return _Alignof(int16_t); }
int align_of_uint16_t() { return _Alignof(uint16_t); }
int align_of_int32_t() { return _Alignof(int32_t); }
int align_of_uint32_t() { return _Alignof(uint32_t); }
int align_of_int64_t() { return _Alignof(int64_t); }
int align_of_uint64_t() { return _Alignof(uint64_t); }
int align_of_char() { return _Alignof(char); }
int align_of_unsigned_char() { return _Alignof(unsigned char); }
int align_of_short() { return _Alignof(short); }
int align_of_unsigned_short() { return _Alignof(unsigned short); }
int align_of_int() { return _Alignof(int); }
int align_of_unsigned_int() { return _Alignof(unsigned int); }
int align_of_long() { return _Alignof(long); }
int align_of_unsigned_long() { return _Alignof(unsigned long); }
int align_of_float() { return _Alignof(float); }
int align_of_double() { return _Alignof(double); }
int align_of_pointer() { return _Alignof(void*); }
")
(define-c int (align-of-int8_t align_of_int8_t) ())
(define-c int (align-of-uint8_t align_of_uint8_t) ())
(define-c int (align-of-int16_t align_of_int16_t) ())
(define-c int (align-of-uint16_t align_of_uint16_t) ())
(define-c int (align-of-int32_t align_of_int32_t) ())
(define-c int (align-of-uint32_t align_of_uint32_t) ())
(define-c int (align-of-int64_t align_of_int64_t) ())
(define-c int (align-of-uint64_t align_of_uint64_t) ())
(define-c int (align-of-char align_of_char) ())
(define-c int (align-of-unsigned-char align_of_unsigned_char) ())
(define-c int (align-of-short align_of_short) ())
(define-c int (align-of-unsigned-short align_of_unsigned_short) ())
(define-c int (align-of-int align_of_int) ())
(define-c int (align-of-unsigned-int align_of_unsigned_int) ())
(define-c int (align-of-long align_of_long) ())
(define-c int (align-of-unsigned-long align_of_unsigned_long) ())
(define-c int (align-of-float align_of_float) ())
(define-c int (align-of-double align_of_double) ())
(define-c int (align-of-pointer align_of_pointer) ())
;; shared-object-load
(define-c-const int (RTLD-NOW "RTLD_NOW"))
(define-c (maybe-null pointer void*) dlopen (string int))

24
foreign/c/primitives/chicken.scm
View File

@ -136,6 +136,30 @@
((equal? type 'string) (foreign-value "sizeof(void*)" int))
((equal? type 'callback) (foreign-value "sizeof(void*)" int)))))
(define align-of-type
(lambda (type)
(cond ((equal? type 'int8) (foreign-value "_Alignof(int8_t)" int))
((equal? type 'uint8) (foreign-value "_Alignof(uint8_t)" int))
((equal? type 'int16) (foreign-value "_Alignof(int16_t)" int))
((equal? type 'uint16) (foreign-value "_Alignof(uint16_t)" int))
((equal? type 'int32) (foreign-value "_Alignof(int32_t)" int))
((equal? type 'uint32) (foreign-value "_Alignof(uint32_t)" int))
((equal? type 'int64) (foreign-value "_Alignof(int64_t)" int))
((equal? type 'uint64) (foreign-value "_Alignof(uint64_t)" int))
((equal? type 'char) (foreign-value "_Alignof(char)" int))
((equal? type 'unsigned-char) (foreign-value "_Alignof(unsigned char)" int))
((equal? type 'short) (foreign-value "_Alignof(short)" int))
((equal? type 'unsigned-short) (foreign-value "_Alignof(unsigned short)" int))
((equal? type 'int) (foreign-value "_Alignof(int)" int))
((equal? type 'unsigned-int) (foreign-value "_Alignof(unsigned int)" int))
((equal? type 'long) (foreign-value "_Alignof(long)" int))
((equal? type 'unsigned-long) (foreign-value "_Alignof(unsigned long)" int))
((equal? type 'float) (foreign-value "_Alignof(float)" int))
((equal? type 'double) (foreign-value "_Alignof(double)" int))
((equal? type 'pointer) (foreign-value "_Alignof(void*)" int))
((equal? type 'string) (foreign-value "_Alignof(void*)" int))
((equal? type 'callback) (foreign-value "_Alignof(void*)" int)))))
(define make-c-null
(lambda ()
(address->pointer 0)))

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

@ -24,8 +24,7 @@
(define size-of-type
(lambda (type)
(cond
((equal? type 'int8) (size-of-int8))
(cond ((equal? type 'int8) (size-of-int8))
((equal? type 'uint8) (size-of-uint8))
((equal? type 'int16) (size-of-int16))
((equal? type 'uint16) (size-of-uint16))
@ -47,6 +46,30 @@
((equal? type 'pointer) (size-of-pointer))
((equal? type 'void) (size-of-void)))))
(define align-of-type
(lambda (type)
(cond ((equal? type 'int8) (align-of-int8))
((equal? type 'uint8) (align-of-uint8))
((equal? type 'int16) (align-of-int16))
((equal? type 'uint16) (align-of-uint16))
((equal? type 'int32) (align-of-int32))
((equal? type 'uint32) (align-of-uint32))
((equal? type 'int64) (align-of-int64))
((equal? type 'uint64) (align-of-uint64))
((equal? type 'char) (align-of-char))
((equal? type 'unsigned-char) (align-of-unsigned-char))
((equal? type 'short) (align-of-short))
((equal? type 'unsigned-short) (align-of-unsigned-short))
((equal? type 'int) (align-of-int))
((equal? type 'unsigned-int) (align-of-unsigned-int))
((equal? type 'long) (align-of-long))
((equal? type 'unsigned-long) (align-of-unsigned-long))
((equal? type 'float) (align-of-float))
((equal? type 'double) (align-of-double))
((equal? type 'string) (align-of-string))
((equal? type 'pointer) (align-of-pointer))
((equal? type 'void) (align-of-void)))))
#;(define shared-object-load
(lambda (path options)
(shared-object-load path)))

22
foreign/c/primitives/gauche/foreign-c-primitives-gauche.c
View File

@ -41,6 +41,28 @@ ScmObj size_of_string() { return Scm_MakeInteger(sizeof(char*)); }
ScmObj size_of_pointer() { return Scm_MakeInteger(sizeof(void*)); }
ScmObj size_of_void() { return Scm_MakeInteger(sizeof(void)); }
ScmObj align_of_int8() { return Scm_MakeInteger(_Alignof(int8_t)); }
ScmObj align_of_uint8() { return Scm_MakeInteger(_Alignof(uint8_t)); }
ScmObj align_of_int16() { return Scm_MakeInteger(_Alignof(int16_t)); }
ScmObj align_of_uint16() { return Scm_MakeInteger(_Alignof(uint16_t)); }
ScmObj align_of_int32() { return Scm_MakeInteger(_Alignof(int32_t)); }
ScmObj align_of_uint32() { return Scm_MakeInteger(_Alignof(uint32_t)); }
ScmObj align_of_int64() { return Scm_MakeInteger(_Alignof(int64_t)); }
ScmObj align_of_uint64() { return Scm_MakeInteger(_Alignof(uint64_t)); }
ScmObj align_of_char() { return Scm_MakeInteger(_Alignof(char)); }
ScmObj align_of_unsigned_char() { return Scm_MakeInteger(_Alignof(unsigned char)); }
ScmObj align_of_short() { return Scm_MakeInteger(_Alignof(short)); }
ScmObj align_of_unsigned_short() { return Scm_MakeInteger(_Alignof(unsigned short)); }
ScmObj align_of_int() { return Scm_MakeInteger(_Alignof(int)); }
ScmObj align_of_unsigned_int() { return Scm_MakeInteger(_Alignof(unsigned int)); }
ScmObj align_of_long() { return Scm_MakeInteger(_Alignof(long)); }
ScmObj align_of_unsigned_long() { return Scm_MakeInteger(_Alignof(unsigned long)); }
ScmObj align_of_float() { return Scm_MakeInteger(_Alignof(float)); }
ScmObj align_of_double() { return Scm_MakeInteger(_Alignof(double)); }
ScmObj align_of_string() { return Scm_MakeInteger(_Alignof(char*)); }
ScmObj align_of_pointer() { return Scm_MakeInteger(_Alignof(void*)); }
ScmObj align_of_void() { return Scm_MakeInteger(_Alignof(void)); }
ScmModule* module = NULL;
ScmObj shared_object_load(ScmString* path, ScmObj options) {

23
foreign/c/primitives/gauche/foreign-c-primitives-gauche.h
View File

@ -19,6 +19,29 @@ extern ScmObj size_of_double();
extern ScmObj size_of_string();
extern ScmObj size_of_pointer();
extern ScmObj size_of_void();
extern ScmObj align_of_int8();
extern ScmObj align_of_uint8();
extern ScmObj align_of_int16();
extern ScmObj align_of_uint16();
extern ScmObj align_of_int32();
extern ScmObj align_of_uint32();
extern ScmObj align_of_int64();
extern ScmObj align_of_uint64();
extern ScmObj align_of_char();
extern ScmObj align_of_unsigned_char();
extern ScmObj align_of_short();
extern ScmObj align_of_unsigned_short();
extern ScmObj align_of_int();
extern ScmObj align_of_unsigned_int();
extern ScmObj align_of_long();
extern ScmObj align_of_unsigned_long();
extern ScmObj align_of_float();
extern ScmObj align_of_double();
extern ScmObj align_of_string();
extern ScmObj align_of_pointer();
extern ScmObj align_of_void();
extern ScmObj shared_object_load(ScmString* path, ScmObj options);
//extern ScmObj pointer_null();
extern ScmObj is_pointer_null();

24
foreign/c/primitives/gauche/gauchelib.scm
View File

@ -2,6 +2,7 @@
(inline-stub
(.include "foreign-c-primitives-gauche.h")
(define-cproc size-of-int8 () size_of_int8)
(define-cproc size-of-uint8 () size_of_uint8)
(define-cproc size-of-int16 () size_of_int16)
@ -23,6 +24,29 @@
(define-cproc size-of-string () size_of_string)
(define-cproc size-of-pointer () size_of_pointer)
(define-cproc size-of-void () size_of_void)
(define-cproc align-of-int8 () align_of_int8)
(define-cproc align-of-uint8 () align_of_uint8)
(define-cproc align-of-int16 () align_of_int16)
(define-cproc align-of-uint16 () align_of_int16)
(define-cproc align-of-int32 () align_of_int32)
(define-cproc align-of-uint32 () align_of_int32)
(define-cproc align-of-int64 () align_of_int64)
(define-cproc align-of-uint64 () align_of_int64)
(define-cproc align-of-char () align_of_char)
(define-cproc align-of-unsigned-char () align_of_unsigned_char)
(define-cproc align-of-short () align_of_short)
(define-cproc align-of-unsigned-short () align_of_unsigned_short)
(define-cproc align-of-int () align_of_int)
(define-cproc align-of-unsigned-int () align_of_unsigned_int)
(define-cproc align-of-long () align_of_long)
(define-cproc align-of-unsigned-long () align_of_unsigned_long)
(define-cproc align-of-float () align_of_float)
(define-cproc align-of-double () align_of_double)
(define-cproc align-of-string () align_of_string)
(define-cproc align-of-pointer () align_of_pointer)
(define-cproc align-of-void () align_of_void)
(define-cproc shared-object-load (path::<string> options) shared_object_load)
;(define-cproc pointer-null () pointer_null)
(define-cproc pointer-null? (pointer) is_pointer_null)

8
foreign/c/primitives/guile.scm
View File

@ -21,7 +21,6 @@
((equal? type 'pointer) '*)
((equal? type 'void) void)
((equal? type 'callback) '*)
((equal? type 'struct) '*)
(else #f))))
(define c-bytevector?
@ -52,6 +51,13 @@
(native-type (sizeof native-type))
(else #f)))))
(define align-of-type
(lambda (type)
(let ((native-type (type->native-type type)))
(cond ((equal? native-type void) 0)
(native-type (alignof native-type))
(else #f)))))
(define shared-object-load
(lambda (path options)
(load-foreign-library path)))

7
foreign/c/primitives/kawa.scm
View File

@ -132,6 +132,13 @@
(invoke native-type 'byteAlignment)
#f))))
(define align-of-type
(lambda (type)
(let ((native-type (type->native-type type)))
(if native-type
(invoke native-type 'byteAlignment)
#f))))
(define make-c-null
(lambda ()
(static-field java.lang.foreign.MemorySegment 'NULL)))

25
foreign/c/primitives/mosh.scm
View File

@ -23,6 +23,31 @@
((eq? type 'void) 0)
(else #f))))
(define align-of-type
(lambda (type)
(cond ((eq? type 'int8) 1)
((eq? type 'uint8) 1)
((eq? type 'int16) 2)
((eq? type 'uint16) 2)
((eq? type 'int32) 4)
((eq? type 'uint32) 4)
((eq? type 'int64) 8)
((eq? type 'uint64) 8)
((eq? type 'char) 1)
((eq? type 'unsigned-char) 1)
((eq? type 'short) align-of-short)
((eq? type 'unsigned-short) align-of-short)
((eq? type 'int) align-of-int)
((eq? type 'unsigned-int) align-of-int)
((eq? type 'long) align-of-long)
((eq? type 'unsigned-long) align-of-unsigned-long)
((eq? type 'float) align-of-float)
((eq? type 'double) align-of-double)
((eq? type 'pointer) align-of-void*)
((eq? type 'callback) align-of-void*)
((eq? type 'void) 0)
(else #f))))
(define shared-object-load
(lambda (path options)
(open-shared-library path)))

5
foreign/c/primitives/racket.scm
View File

@ -48,6 +48,11 @@
(lambda (type)
(ctype-sizeof (type->native-type type))))
;; FIXME
(define align-of-type
(lambda (type)
(ctype-sizeof (type->native-type type))))
(define shared-object-load
(lambda (path options)
(if (and (not (null? options))

25
foreign/c/primitives/sagittarius.scm
View File

@ -23,6 +23,31 @@
((eq? type 'callback) size-of-void*)
(else #f))))
(define align-of-type
(lambda (type)
(cond ((eq? type 'int8) align-of-int8_t)
((eq? type 'uint8) align-of-uint8_t)
((eq? type 'int16) align-of-int16_t)
((eq? type 'uint16) align-of-uint16_t)
((eq? type 'int32) align-of-int32_t)
((eq? type 'uint32) align-of-uint32_t)
((eq? type 'int64) align-of-int64_t)
((eq? type 'uint64) align-of-uint64_t)
((eq? type 'char) align-of-char)
((eq? type 'unsigned-char) align-of-char)
((eq? type 'short) align-of-short)
((eq? type 'unsigned-short) align-of-unsigned-short)
((eq? type 'int) align-of-int)
((eq? type 'unsigned-int) align-of-unsigned-int)
((eq? type 'long) align-of-long)
((eq? type 'unsigned-long) align-of-unsigned-long)
((eq? type 'float) align-of-float)
((eq? type 'double) align-of-double)
((eq? type 'pointer) align-of-void*)
((eq? type 'void) 0)
((eq? type 'callback) align-of-void*)
(else #f))))
(define shared-object-load
(lambda (path options)
(open-shared-library path)))

5
foreign/c/primitives/stklos.scm
View File

@ -93,6 +93,11 @@
((equal? type 'double) (c-size-of :double))
((equal? type 'pointer) (c-size-of :pointer)))))
;; FIXME
(define align-of-type
(lambda (type)
(size-of-type type)))
(define c-bytevector-u8-set!
(lambda (pointer offset value)
(cpointer-set! pointer :uint8 value offset)))

26
foreign/c/primitives/ypsilon.scm
View File

@ -24,6 +24,32 @@
((eq? type 'void) 0)
(else #f))))
(define align-of-type
(lambda (type)
(cond ((eq? type 'int8) (alignof:int8_t))
((eq? type 'uint8) (alignof:int8_t))
((eq? type 'int16) (alignof:int16_t))
((eq? type 'uint16) (alignof:int16_t))
((eq? type 'int32) (alignof:int32_t))
((eq? type 'uint32) (alignof:int32_t))
((eq? type 'int64) (alignof:int64_t))
((eq? type 'uint64) (alignof:int64_t))
((eq? type 'char) (alignof:int8_t))
((eq? type 'unsigned-char) (alignof:int8_t))
((eq? type 'short) (alignof:short))
((eq? type 'unsigned-short) (alignof:short))
((eq? type 'int) (alignof:int))
((eq? type 'unsigned-int) (alignof:int))
((eq? type 'long) (alignof:long))
((eq? type 'unsigned-long) (alignof:long))
((eq? type 'float) (alignof:float))
((eq? type 'double) (alignof:double))
((eq? type 'pointer) (alignof:void*))
((eq? type 'struct) (alignof:void*))
((eq? type 'callback) (alignof:void*))
((eq? type 'void) 0)
(else #f))))
(define c-bytevector?
(lambda (object)
(number? object)))

22
tests/primitives.scm
View File

@ -6,6 +6,28 @@
(scheme process-context)
(foreign c))
(define foreign-types '(int8
uint8
int16
uint16
int32
uint32
int64
uint64
char
unsigned-char
short
unsigned-short
int
unsigned-int
long
unsigned-long
float
double
pointer
pointer-address
callback
void))
(display "libc-name: ")
(display libc-name)