Chibi fixes

This commit is contained in:
retropikzel 2025-06-26 20:16:54 +03:00
parent 9380b007ae
commit 936d250b3c
10 changed files with 80 additions and 36 deletions

View File

@ -47,12 +47,9 @@ test-compile-r7rs-wine:
LD_LIBRARY_PATH=. \
wine ./${TESTNAME}.bat
test-compile-r7rs-docker-old:
docker build --build-arg COMPILE_R7RS=${COMPILE_R7RS} --tag=r7rs-pffi-test-${COMPILE_R7RS} -f Dockerfile.test .
docker run -v "${PWD}:/workdir" -w /workdir -t r7rs-pffi-test-${COMPILE_R7RS} sh -c "make COMPILE_R7RS=${COMPILE_R7RS} TESTNAME=${TESTNAME} test-compile-r7rs"
test-compile-r7rs-docker:
docker run -v "${PWD}:/workdir" -w /workdir retropikzel1/compile-r7rs:${COMPILE_R7RS} sh -c "make test-compile-r7rs COMPILE_R7RS=${COMPILE_R7RS} TESTNAME=${TESTNAME}"
docker build --build-arg COMPILE_R7RS=${COMPILE_R7RS} --tag=r7rs-pffi-test-${COMPILE_R7RS} -f dockerfiles/Dockerfile.test .
docker run -it -v "${PWD}:/workdir" -w /workdir -t r7rs-pffi-test-${COMPILE_R7RS} sh -c "make COMPILE_R7RS=${COMPILE_R7RS} TESTNAME=${TESTNAME} test-compile-r7rs"
tmp/test/libtest.o: tests/c-src/libtest.c
mkdir -p tmp/test

View File

@ -85,7 +85,15 @@ to being portable by conforming to some specification.
Required versions:
- Gambit >= 4.9.5
- Guile >= 3
- Kawa >= 3.11 and Java >= 22
- Needs arguments
- -J--add-exports=java.base/jdk.internal.foreign.abi=ALL-UNNAMED
- -J--add-exports=java.base/jdk.internal.foreign.layout=ALL-UNNAMED
- -J--add-exports=java.base/jdk.internal.foreign=ALL-UNNAMED
- -J--enable-native-access=ALL-UNNAMED
- -J--enable-preview
- STklos > 2.10
### Primitives 1 table
@ -94,12 +102,13 @@ Required versions:
|------------------|:------------:|:--------------------:|:------------------:|:-------------------:|:-------------:|:-------------------:|
| **Chibi** | X | X |X | X | X | X |
| **Chicken** | X | X |X | X | X | X |
| Gambit | X | X |X | X | X | X |
| **Gauche** | X | X |X | X | X | X |
| **Guile** | X | X |X | X | X | X |
| **Kawa** | X | X |X | X | X | X |
| **Mosh** | X | X |X | X | X | X |
| **Racket** | X | X |X | X | X | X |
| **Saggittarius** | X | X |X | X | X | X |
| **Sagittarius** | X | X |X | X | X | X |
| **STklos** | X | X |X | X | X | X |
| **Ypsilon** | X | X |X | X | X | X |
@ -135,7 +144,7 @@ Required versions:
## Installation
Eithe download the latest release from
Either download the latest release from
[https://git.sr.ht/~retropikzel/foreign-c/refs](https://git.sr.ht/~retropikzel/foreign-c/refs)
or git clone, preferably with a tag, and copy the _foreign_ directory to your
library directory.

View File

@ -102,7 +102,19 @@ Schemes - 0.10.0</title>
tables</h2>
<p>Required versions:</p>
<ul>
<li>Gambit &gt;= 4.9.5</li>
<li>Guile &gt;= 3</li>
<li>Kawa &gt;= 3.11 and Java &gt;= 22
<ul>
<li>Needs arguments
<ul>
<li>-Jadd-exports=java.base/jdk.internal.foreign.abi=ALL-UNNAMED</li>
<li>-Jadd-exports=java.base/jdk.internal.foreign.layout=ALL-UNNAMED</li>
<li>-Jadd-exports=java.base/jdk.internal.foreign=ALL-UNNAMED</li>
<li>-Jenable-native-access=ALL-UNNAMED</li>
<li>-Jenable-preview</li>
</ul></li>
</ul></li>
<li>STklos &gt; 2.10</li>
</ul>
<h3 id="primitives-1-table">Primitives 1 table</h3>
@ -147,6 +159,15 @@ Schemes - 0.10.0</title>
<td style="text-align: center;">X</td>
</tr>
<tr class="odd">
<td>Gambit</td>
<td style="text-align: center;">X</td>
<td style="text-align: center;">X</td>
<td style="text-align: center;">X</td>
<td style="text-align: center;">X</td>
<td style="text-align: center;">X</td>
<td style="text-align: center;">X</td>
</tr>
<tr class="even">
<td><strong>Gauche</strong></td>
<td style="text-align: center;">X</td>
<td style="text-align: center;">X</td>
@ -155,7 +176,7 @@ Schemes - 0.10.0</title>
<td style="text-align: center;">X</td>
<td style="text-align: center;">X</td>
</tr>
<tr class="even">
<tr class="odd">
<td><strong>Guile</strong></td>
<td style="text-align: center;">X</td>
<td style="text-align: center;">X</td>
@ -164,7 +185,7 @@ Schemes - 0.10.0</title>
<td style="text-align: center;">X</td>
<td style="text-align: center;">X</td>
</tr>
<tr class="odd">
<tr class="even">
<td><strong>Kawa</strong></td>
<td style="text-align: center;">X</td>
<td style="text-align: center;">X</td>
@ -173,7 +194,7 @@ Schemes - 0.10.0</title>
<td style="text-align: center;">X</td>
<td style="text-align: center;">X</td>
</tr>
<tr class="even">
<tr class="odd">
<td><strong>Mosh</strong></td>
<td style="text-align: center;">X</td>
<td style="text-align: center;">X</td>
@ -182,7 +203,7 @@ Schemes - 0.10.0</title>
<td style="text-align: center;">X</td>
<td style="text-align: center;">X</td>
</tr>
<tr class="odd">
<tr class="even">
<td><strong>Racket</strong></td>
<td style="text-align: center;">X</td>
<td style="text-align: center;">X</td>
@ -191,8 +212,8 @@ Schemes - 0.10.0</title>
<td style="text-align: center;">X</td>
<td style="text-align: center;">X</td>
</tr>
<tr class="even">
<td><strong>Saggittarius</strong></td>
<tr class="odd">
<td><strong>Sagittarius</strong></td>
<td style="text-align: center;">X</td>
<td style="text-align: center;">X</td>
<td style="text-align: center;">X</td>
@ -200,7 +221,7 @@ Schemes - 0.10.0</title>
<td style="text-align: center;">X</td>
<td style="text-align: center;">X</td>
</tr>
<tr class="odd">
<tr class="even">
<td><strong>STklos</strong></td>
<td style="text-align: center;">X</td>
<td style="text-align: center;">X</td>
@ -209,7 +230,7 @@ Schemes - 0.10.0</title>
<td style="text-align: center;">X</td>
<td style="text-align: center;">X</td>
</tr>
<tr class="even">
<tr class="odd">
<td><strong>Ypsilon</strong></td>
<td style="text-align: center;">X</td>
<td style="text-align: center;">X</td>
@ -345,7 +366,7 @@ Schemes - 0.10.0</title>
</tbody>
</table>
<h2 id="installation">Installation</h2>
<p>Eithe download the latest release from <a
<p>Either download the latest release from <a
href="https://git.sr.ht/~retropikzel/foreign-c/refs">https://git.sr.ht/~retropikzel/foreign-c/refs</a>
or git clone, preferably with a tag, and copy the
<em>foreign</em> directory to your library directory.</p>

Binary file not shown.

View File

@ -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"))

View File

@ -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")

View File

@ -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))))

View File

@ -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 "

View File

@ -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;"))

View File