Required versions:
Eithe download the latest release from Either download the latest release from https://git.sr.ht/~retropikzel/foreign-c/refs or git clone, preferably with a tag, and copy the foreign directory to your library directory.
diff --git a/documentation/foreign-c.pdf b/documentation/foreign-c.pdf index ace1c8b..b99ec83 100644 Binary files a/documentation/foreign-c.pdf and b/documentation/foreign-c.pdf differ diff --git a/foreign/c.sld b/foreign/c.sld index f70fa19..444c287 100644 --- a/foreign/c.sld +++ b/foreign/c.sld @@ -33,7 +33,7 @@ (scheme process-context) (cyclone foreign) (scheme cyclone primitives))) - #;(gambit + (gambit (import (scheme base) (scheme write) (scheme char) @@ -77,6 +77,13 @@ (scheme file) (scheme inexact) (scheme process-context))) + (mit-scheme + (import (scheme base) + (scheme write) + (scheme char) + (scheme file) + (scheme inexact) + (scheme process-context))) #;(larceny (import (scheme base) (scheme write) @@ -304,11 +311,12 @@ (include "c/primitives/chicken.scm")) (chicken-6 (include-relative "c/primitives/chicken.scm")) ;(cyclone (include "c/primitives/cyclone.scm")) - ;(gambit (include "c/primitives/gambit.scm")) + (gambit (include "c/primitives/gambit.scm")) (gauche (include "c/primitives/gauche/define-c-procedure.scm")) ;(gerbil (include "c/primitives/gerbil.scm")) - (guile (include "./c/primitives/guile.scm")) + (guile (include "c/primitives/guile.scm")) (kawa (include "c/primitives/kawa.scm")) + (mit-scheme (include "c/primitives/mit-scheme.scm")) ;(larceny (include "c/primitives/larceny.scm")) (mosh (include "c/primitives/mosh.scm")) (racket (include "c/primitives/racket.scm")) diff --git a/foreign/c/libc.scm b/foreign/c/libc.scm index 661a5bf..45cc695 100644 --- a/foreign/c/libc.scm +++ b/foreign/c/libc.scm @@ -1,8 +1,9 @@ (cond-expand - (windows (define-c-library libc - '("stdlib.h" "stdio.h" "string.h") - "ucrtbase" - '())) + (windows + (define-c-library libc + '("stdlib.h" "stdio.h" "string.h") + "ucrtbase" + '())) (else (define c-library "c") (when (get-environment-variable "BE_HOST_CPU") diff --git a/foreign/c/pointer.scm b/foreign/c/pointer.scm index 774860f..bbb95cc 100644 --- a/foreign/c/pointer.scm +++ b/foreign/c/pointer.scm @@ -1,11 +1,23 @@ (define-c-procedure c-calloc libc 'calloc 'pointer '(int int)) (cond-expand - (chicken (define c-memset-address->pointer + (gambit + (define c-memset-address->pointer + (c-lambda (unsigned-int64 unsigned-int8 int) + (pointer void) + "___return(memset((void*)___arg1, ___arg2, ___arg3));"))) + (chicken + (define c-memset-address->pointer (lambda (address value offset) (address->pointer address)))) - (else (define-c-procedure c-memset-address->pointer libc 'memset 'pointer '(uint64 uint8 int)))) + (else + (define-c-procedure c-memset-address->pointer libc 'memset 'pointer '(uint64 uint8 int)))) (cond-expand + (gambit + (define c-memset-pointer->address + (c-lambda ((pointer void) unsigned-int8 int) + unsigned-int64 + "___return((uint64_t)memset(___arg1, ___arg2, ___arg3));"))) (chicken (define c-memset-pointer->address (lambda (pointer value offset) (pointer->address pointer)))) diff --git a/foreign/c/primitives/chibi/foreign-c.stub b/foreign/c/primitives/chibi/foreign-c.stub index bde411e..a0fa720 100644 --- a/foreign/c/primitives/chibi/foreign-c.stub +++ b/foreign/c/primitives/chibi/foreign-c.stub @@ -1,11 +1,10 @@ ; vim: ft=scheme -(c-link "ffi") - (c-system-include "stdint.h") (c-system-include "dlfcn.h") (c-system-include "stdio.h") (c-system-include "ffi.h") +(c-link "ffi") ;; c-type-size (c-declare " diff --git a/foreign/c/primitives/gambit.scm b/foreign/c/primitives/gambit.scm index 11d3e4d..49432ad 100644 --- a/foreign/c/primitives/gambit.scm +++ b/foreign/c/primitives/gambit.scm @@ -47,14 +47,11 @@ (else (error "Can not get size of unknown type" type))))) (define-macro - (define-c-library name headers object-name . options) - (begin - (let ((c-code (apply string-append - (map - (lambda (header) - (string-append "#include <" header ">" (string #\newline))) - (car (cdr headers)))))) - `(begin (define ,name #t) (c-declare ,c-code))))) + (define-c-library name headers object-name options) + (append (list `(define ,name #t) + (map (lambda (header) + `(c-declare ,(string-append "#include <" header ">"))) + (car (cdr headers)))))) (define pointer? (c-lambda ((pointer void)) bool "___return(1);")) @@ -66,7 +63,7 @@ (lambda (x) #f) (lambda () (pointer? object))))))) -#;(define c-bytevector-u8-set! (c-lambda ((pointer void) int unsigned-int8) void "*(uint8_t*)((char*)___arg1 + ___arg2) = ___arg3;")) +(define c-bytevector-u8-set! (c-lambda ((pointer void) int unsigned-int8) void "*(uint8_t*)((char*)___arg1 + ___arg2) = ___arg3;")) (define c-bytevector-u8-ref (c-lambda ((pointer void) int) unsigned-int8 "___return(*(uint8_t*)((char*)___arg1 + ___arg2));")) (define pointer-set-c-int8_t! (c-lambda ((pointer void) int int8) void "*(int8_t*)((char*)___arg1 + ___arg2) = ___arg3;")) diff --git a/foreign/c/primitives/mit-scheme.scm b/foreign/c/primitives/mit-scheme.scm new file mode 100644 index 0000000..e69de29