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

Use compile-r7rs for testing. Create entries for all implementations in makefile.

This commit is contained in:
retropikzel 2025-04-18 05:55:31 +03:00
parent 21027259f7
commit 7ab8b1ab2b
14 changed files with 356 additions and 184 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitignore vendored
View File

@ -40,3 +40,4 @@ dockerfiles/build
core
testfile.test
tests/compliance
tests/retropikzel

12
Dockerfile Normal file
View File

@ -0,0 +1,12 @@
ARG COMPILE_R7RS=chibi
FROM debian:bookworm AS build
RUN apt-get update && apt-get install -y build-essential wget make cmake libgc-dev zlib1g-dev libffi-dev libssl-dev
RUN wget https://bitbucket.org/ktakashi/sagittarius-scheme/downloads/sagittarius-0.9.12.tar.gz && tar -xf sagittarius-0.9.12.tar.gz
RUN cd sagittarius-0.9.12 && mkdir build && cd build && cmake -DCMAKE_INSTALL_PREFIX=/usr/local-other .. && make && make install
FROM schemers/${COMPILE_R7RS}
RUN apt-get update && apt-get install -y \
git make libffi8 libgc1 libssl3 libuv1 build-essential libffi-dev
COPY --from=build /usr/local-other/ /usr/local-other/
ENV PATH=${PATH}:/usr/local-other/bin
RUN git clone https://git.sr.ht/~retropikzel/compile-r7rs && cd compile-r7rs && make && make install

15
Jenkinsfile vendored
View File

@ -1,21 +1,16 @@
pipeline {
agent {
dockerfile {
filename 'dockerfiles/jenkins'
dir '.'
args '--user=root --privileged -v /var/run/docker.sock:/var/run/docker.sock'
}
}
agent any
options {
buildDiscarder(logRotator(numToKeepStr: '10', artifactNumToKeepStr: '10'))
disableConcurrentBuilds()
buildDiscarder(logRotator(numToKeepStr: '10', artifactNumToKeepStr: '10'))
}
stages {
stage('Build test libraries') {
stage('Chibi') {
steps {
catchError(buildResult: 'SUCCESS', stageResult: 'FAILURE') {
sh 'make libtest.so libtest.a'
sh 'make COMPILE_R7RS=chibi test-compile-r7rs-docker'
}
}
}

134
Makefile
View File

@ -4,8 +4,6 @@ DOCKER=docker run -it -v ${PWD}:/workdir
DOCKER_INIT=cd /workdir && make clean &&
VERSION=$(shell grep "version:" README.md | awk '{split\($0,a\); print a[2];}')
all: chibi gauche tests/libtest.so libtest.o libtest.a
# apt-get install pandoc weasyprint
docs:
mkdir -p documentation
@ -19,44 +17,120 @@ docs:
README.md
chibi:
make -C retropikzel/pffi chibi-pffi.so
make -C retropikzel/pffi chibi
chicken:
make -C retropikzel/pffi chicken
cyclone:
make -C retropikzel/pffi cyclone
gambit:
make -C retropikzel/pffi gambit
gauche:
make -C retropikzel/pffi gauche-pffi.so
make -C retropikzel/pffi gauche
jenkinsfile:
gosh -r7 -I ./snow build.scm
gerbil:
make -C retropikzel/pffi gerbil
libtest.o: src/libtest.c
${CC} -o libtest.o -fPIC -c src/libtest.c -I./include
guile:
make -C retropikzel/pffi guile
tests/libtest.so: src/libtest.c
${CC} -o tests/libtest.so -shared -fPIC src/libtest.c -I./include
kawa:
make -C retropikzel/pffi kawa
libtest.a: libtest.o src/libtest.c
ar rcs libtest.a libtest.o
larceny:
make -C retropikzel/pffi larceny
test-interpreter-compliance: tests/libtest.so
SCHEME=${SCHEME} script-r7rs -I . -I .. tests/compliance.scm
mosh:
make -C retropikzel/pffi mosh
test-interpreter-compliance-docker:
docker build -f dockerfiles/test . --build-arg SCHEME=${SCHEME} --tag=pffi-${SCHEME}
docker run -v ${PWD}:/workdir pffi-${SCHEME} bash -c "cd /workdir && SCHEME=${SCHEME} script-r7rs -I . -I .. tests/compliance.scm"
racket:
make -C retropikzel/pffi racket
test-compile-library: tests/libtest.so libtest.a libtest.o
SCHEME=${SCHEME} compile-r7rs-library retropikzel/pffi.sld
sagittarius:
make -C retropikzel/pffi sagittarius
test-compiler-compliance-compile: test-compile-library
SCHEME=${SCHEME} CFLAGS="-I./include -L." LDFLAGS="-ltest -L." compile-r7rs -I . tests/compliance.scm
./tests/compliance
skint:
make -C retropikzel/pffi skint
test-compiler-compliance: test-compiler-compliance-compile
./tests/compliance
stklos:
make -C retropikzel/pffi stklos
test-compiler-compliance-docker: tests/libtest.so libtest.a
docker build -f dockerfiles/test . --build-arg SCHEME=${SCHEME} --tag=pffi-${SCHEME}
docker run -v ${PWD}:/workdir pffi-${SCHEME} bash -c "cd /workdir && SCHEME=${SCHEME} compile-r7rs-library retropikzel/pffi.sld"
docker run -v ${PWD}:/workdir pffi-${SCHEME} bash -c "cd /workdir && SCHEME=${SCHEME} compile-r7rs -I . compliance.scm && ./test"
tr7:
make -C retropikzel/pffi tr7
ypsilon:
make -C retropikzel/pffi tr7
test-compile-r7rs: tmp/test/libtest.o tmp/test/libtest.so
make ${COMPILE_R7RS}
cp -r retropikzel tmp/test/
cp tests/compliance.scm tmp/test/
cp include/libtest.h tmp/test/
cd tmp/test && COMPILE_R7RS_CHICKEN="-L -ltest -I. -L." compile-r7rs -I . -o compliance compliance.scm
cd tmp/test && LD_LIBRARY_PATH=. ./compliance
test-compile-r7rs-docker:
docker build --build-arg COMPILE_R7RS=${COMPILE_R7RS} --tag=r7rs-pffi-test-${COMPILE_R7RS} .
docker run -v "${PWD}":/workdir -w /workdir -t r7rs-pffi-test-${COMPILE_R7RS} sh -c "make COMPILE_R7RS=${COMPILE_R7RS} test-compile-r7rs"
#chicken-objects:
#cd chicken/src && gcc -Os -fomit-frame-pointer -DHAVE_CHICKEN_CONFIG_H -c *.c -I../include
#test-chicken-c: libtest.o
#csc -R r7rs -X r7rs -t -J -I ./retropikzel retropikzel/pffi.sld -o retropikzel.pffi.c
#csc -R r7rs -X r7rs -t tests/compliance.scm -o tests/compliance.c
#gcc -Os -fomit-frame-pointer -DHAVE_CHICKEN_CONFIG_H -o tests/compliance chicken/src/*.o tests/compliance.c -ltest -L. -I./include -I./chicken/include
#test-chicken: libtest.o
#csc -R r7rs -X r7rs -c -J -I ./retropikzel retropikzel/pffi.sld -o retropikzel.pffi.o
#csc -v -R r7rs -X r7rs -static tests/compliance.scm -o tests/compliance -C -ltest -I./include
#csc -R r7rs -X r7rs -J -t -I ./retropikzel retropikzel/pffi.sld
#csc -R r7rs -X r7rs -uses retropikzel.pffi -static tests/compliance.scm -L -ltest -L. -I./include -L./retropikzel
#csc -R r7rs -X r7rs -t -I ./retropikzel retropikzel/pffi.sld -o retropikzel/pffi.c
#cp retropikzel/pffi.sld retropikzel.pffi.scm
#csc -J -t -I ./retropikzel retropikzel/pffi.sld -o retropikzel/pffi.c
#csc -R r7rs -X r7rs -t -I retropikzel retropikzel/pffi.sld tests/compliance.scm -optimize-level 3 -o tests/compliance.c
#csc -t tests/compliance.scm -o tests/compliance.c #-L -ltest -I./include -L. -L./tests
#./tests/compliance
#jenkinsfile:
#gosh -r7 -I ./snow build.scm
tmp/test/libtest.o: src/libtest.c
mkdir -p tmp/test
${CC} -o tmp/test/libtest.o -fPIC -c src/libtest.c -I./include
tmp/test/libtest.so: src/libtest.c
mkdir -p tmp/test
${CC} -o tmp/test/libtest.so -shared -fPIC src/libtest.c -I./include
tmp/test/libtest.a: tmp/test/libtest.o src/libtest.c
ar rcs tmp/test/libtest.a tmp/test/libtest.o
#test-interpreter-compliance: tests/libtest.so
#SCHEME=${SCHEME} script-r7rs -I . -I .. tests/compliance.scm
#test-interpreter-compliance-docker:
#docker build -f dockerfiles/test . --build-arg SCHEME=${SCHEME} --tag=pffi-${SCHEME}
#docker run -v ${PWD}:/workdir pffi-${SCHEME} bash -c "cd /workdir && SCHEME=${SCHEME} script-r7rs -I . -I .. tests/compliance.scm"
#test-compile-library: tests/libtest.so libtest.a libtest.o
#SCHEME=${SCHEME} compile-r7rs-library retropikzel/pffi.sld
#test-compiler-compliance-compile: test-compile-library
#SCHEME=${SCHEME} CFLAGS="-I./include -L." LDFLAGS="-ltest -L." compile-r7rs -I . tests/compliance.scm
#./tests/compliance
#test-compiler-compliance: test-compiler-compliance-compile
#./tests/compliance
#test-compiler-compliance-docker: tests/libtest.so libtest.a
#docker build -f dockerfiles/test . --build-arg SCHEME=${SCHEME} --tag=pffi-${SCHEME}
#docker run -v ${PWD}:/workdir pffi-${SCHEME} bash -c "cd /workdir && SCHEME=${SCHEME} compile-r7rs-library retropikzel/pffi.sld"
#docker run -v ${PWD}:/workdir pffi-${SCHEME} bash -c "cd /workdir && SCHEME=${SCHEME} compile-r7rs -I . compliance.scm && ./test"
clean:
@rm -rf retropikzel/pffi/*.o*
@ -79,7 +153,9 @@ clean:
find . -name "core.1" -delete
find . -name "*@gambit*" -delete
rm -rf retropikzel/pffi.c
rm -rf tests/compliance.c
rm -rf tests/compliance.c*
rm -rf tests/compliance.o
rm -rf tests/compliance.so
rm -rf tests/compliance
rm -rf tests/retropikzel.*.import.scm
rm -rf tmp

92
README.md
View File

@ -30,17 +30,21 @@ conforming to some specification.
- [Primitives](#feature-implementation-table-primitives)
- [Built upon](#feature-implementation-table-built-upon)
- [Documentation](#documentation)
- [Installation](#installation)
- [Compiling the library](#compiling-the-library)
- [Chibi](#compiling-the-library-chibi)
- [Gauche](#compiling-the-library-gauche)
- [Dependencies](#dependencies)
- [Chibi](#dependencies-chibi)
- [Chicken](#dependencies-chicken)
- [Gauche](#dependencies-gauche)
- [Racket](#dependencies-racket)
- [Kawa](#dependencies-kawa)
- [Installation](#installation)
- [Project local](#installation-project-local)
- [Linux](#installation-project-local-linux)
- [Windows](#installation-project-local-windows)
- [System global](#installation-system-global)
- [Reference](#reference)
- [Types](#types)
- [Environment variables](#environment-variables)
- [PFFI\_LOAD\_PATH](#environment-variables-pffi-load-path)
- [Procedures and macros](#procedures-and-macros)
- [pffi-init](#pffi-init)
- [pffi-size-of](#pffi-size-of)
@ -194,31 +198,7 @@ and work, they should work too.
## Documentation
<a name="documentation"></a>
### Installation
<a name="installation"></a>
Download the latest release from
[https://git.sr.ht/~retropikzel/r7rs-pffi/refs](https://git.sr.ht/~retropikzel/r7rs-pffi/refs).
Unpack it somewhere and copy the directory called "retropikzel" to your projects
library directory. For the rest of this documentation it is assumed to be ./snow.
#### Compiling the libary
<a name="compiling-the-library"></a>
Some implementations need extra step of compiling the library. Change directory
to ./snow/retropikzel/pffi and run command corresponding to your implementation.
##### Chibi
<a name="compiling-the-library-chibi"></a>
make -C ./snow/retropikzel/pffi chibi-pffi.so
##### Gauche
<a name="compiling-the-library-gauche"></a>
make -C ./snow/retropikzel/pffi gauche-pffi.so
#### Dependencies
### Dependencies
<a name="dependencies"></a>
Some implementations have extra dependencies/requirements beyond just the
@ -233,6 +213,13 @@ Debian/Ubuntu/Mint install with:
apt install libffi-dev
#### Chicken
<a name="dependencies-chicken"></a>
Chicken needs r7rs egg installed. Install it with:
chicken-install r7rs
#### Gauche
<a name="dependencies-gauche"></a>
@ -259,6 +246,37 @@ Kawa Needs at least Java version 22 and jvm flags:
- \--add-exports java.base/jdk.internal.foreign=ALL-UNNAMED
- \--enable-native-access=ALL-UNNAMED
### Installation
<a name="installation"></a>
Since the project is under active development is best to clone it from git,
### Project local
<a name="installation-project-local"></a>
#### Linux
<a name="installation-project-local-linux"></a>
Assuming you have a project and your libraries live in directory called snow
in it:
git clone https://git.sr.ht/~retropikzel/r7rs-pffi
mkdir -p snow
cp -r r7rs-pffi/retropikzel snow/
cd snow/retropikzel/pffi
make <SCHEME>
#### Windows
<a name="installation-project-local-windows"></a>
There is no build scripts yet for Windows, that said many implementations work
without compiling anything. If you run this and it says "There is notching to
build for SCHEME" then you should be good to go.
### System global
<a name="installation-system-global"></a>
Still work in progress.
## Reference
<a name="reference"></a>
@ -289,6 +307,22 @@ Types are given as symbols, for example 'int8 or 'pointer.
- callback
- Callback function
### Types
<a name="types"></a>
### Environment variables
<a name="environment-variables"></a>
Setting environment variables like this on Windows works for this library:
set "PFFI_LOAD_PATH=C:\Program Files (x86)/foo/bar"
#### PFFI\_LOAD\_PATH
<a name="environment-variables-pffi-load-path"></a>
To add more paths to where pffi looks for libraries set PFFI\_LOAD\_PATH to
paths separated by ; on windows, and : on other operating systems.
### Procedures and macros
<a name="procedures-and-macros"></a>

22
retropikzel/pffi.sld
View File

@ -59,7 +59,8 @@
(scheme process-context)
(rnrs bytevectors)
(system foreign)
(system foreign-library)))
(system foreign-library)
(only (guile) include-from-path)))
(kawa
(import (scheme base)
(scheme write)
@ -133,8 +134,7 @@
(scheme process-context)
(ypsilon c-ffi)
(ypsilon c-types)
(only (core) define-macro syntax-case)))
(else (error "Unsupported implementation")))
(only (core) define-macro syntax-case))))
(export pffi-init
pffi-size-of
pffi-type?
@ -167,7 +167,8 @@
pffi-define-callback)
(cond-expand
(chibi (include "pffi/chibi.scm"))
(chicken (include-relative "pffi/chicken.scm"))
(chicken-5 (include "pffi/chicken.scm"))
(chicken-6 (include-relative "pffi/chicken.scm"))
(cyclone (include "pffi/cyclone.scm"))
(gambit (include "pffi/gambit.scm"))
(gauche (include "pffi/gauche.scm"))
@ -183,7 +184,12 @@
(tr7 (include "pffi/tr7.scm"))
(ypsilon (include "pffi/ypsilon.scm")))
;(include "pffi/shared/union.scm")
(include "pffi/shared/main.scm")
(include "pffi/shared/pointer.scm")
(include "pffi/shared/array.scm")
(include "pffi/shared/struct.scm"))
(cond-expand
(chicken-6 (include-relative "pffi/shared/main.scm")
(include-relative "pffi/shared/pointer.scm")
(include-relative "pffi/shared/array.scm")
(include-relative "pffi/shared/struct.scm"))
(else (include "pffi/shared/main.scm")
(include "pffi/shared/pointer.scm")
(include "pffi/shared/array.scm")
(include "pffi/shared/struct.scm"))))

52
retropikzel/pffi/Makefile
View File

@ -1,13 +1,55 @@
CC=gcc
chibi-pffi.so: chibi/pffi.stub
chibi-ffi chibi/pffi.stub
${CC} -g3 -o chibi-pffi.so chibi/pffi.c -fPIC -lffi -shared
chibi: chibi-src/pffi.stub
chibi-ffi chibi-src/pffi.stub
${CC} -g3 -o chibi-pffi.so chibi-src/pffi.c -fPIC -lffi -shared
gauche-pffi.so:
chicken:
@echo "Nothing to build for Chicken"
cyclone:
@echo "Nothing to build for Cyclone"
gambit:
@echo "Nothing to build for Gambit"
gauche: gauche-src/gauche-pffi.c gauche-src/gauchelib.scm
gauche-package compile \
--srcdir=gauche \
--srcdir=gauche-src \
--cc=${CC} \
--cflags="-I./include" \
--libs=-lffi \
gauche-pffi gauche-pffi.c gauchelib.scm
gerbil:
@echo "Nothing to build for Gerbil"
guile:
@echo "Nothing to build for Guile"
kawa:
@echo "Nothing to build for Kawa"
larceny:
@echo "Nothing to build for Larceny"
mosh:
@echo "Nothing to build for Mosh"
racket:
@echo "Nothing to build for Racket"
sagittarius:
@echo "Nothing to build for Sagittarius"
skint:
@echo "Nothing to build for Skint"
stklos:
@echo "Nothing to build for Stklos"
tr7:
@echo "Nothing to build for tr7"
ypsilon:
@echo "Nothing to build for Ypsilon"

0
retropikzel/pffi/chibi/pffi.stub → retropikzel/pffi/chibi-src/pffi.stub
View File

0
retropikzel/pffi/gauche/gauchelib.scm → retropikzel/pffi/gauche-src/gauchelib.scm
View File

8
retropikzel/pffi/guile.scm
View File

@ -53,7 +53,7 @@
(native-type (sizeof native-type))
(else #f)))))
(define pffi-pointer-allocate
#;(define pffi-pointer-allocate
(lambda (size)
(bytevector->pointer (make-bytevector size 0))))
@ -74,10 +74,10 @@
(pointer->string pointer)))
(define pffi-shared-object-load
(lambda (header path . options)
(lambda (path options)
(load-foreign-library path)))
(define pffi-pointer-free
#;(define pffi-pointer-free
(lambda (pointer)
#t))
@ -132,6 +132,6 @@
((equal? type 'pointer) (make-pointer (bytevector-sint-ref p offset (native-endianness) (size-of-type type))))
((equal? type 'string) (pffi-pointer->string (make-pointer (bytevector-sint-ref p offset (native-endianness) (size-of-type type)))))))))
(define pffi-struct-dereference
#;(define pffi-struct-dereference
(lambda (struct)
(dereference-pointer (pffi-struct-pointer struct))))

114
retropikzel/pffi/shared/main.scm
View File

@ -121,61 +121,67 @@
(list)))
(slash (cond-expand (windows (string #\\)) (else "/")))
(auto-load-paths
(cond-expand
(windows
(append
(if (get-environment-variable "SYSTEM")
(list (get-environment-variable "SYSTEM"))
(list))
(if (get-environment-variable "WINDIR")
(list (get-environment-variable "WINDIR"))
(list))
(if (get-environment-variable "WINEDLLDIR0")
(list (get-environment-variable "WINEDLLDIR0"))
(list))
(if (get-environment-variable "SystemRoot")
(list (string-append
(get-environment-variable "SystemRoot")
slash
"system32"))
(list))
(list ".")
(if (get-environment-variable "PATH")
(string-split (get-environment-variable "PATH") #\;)
(list))
(if (get-environment-variable "PWD")
(list (get-environment-variable "PWD"))
(list))))
(else
(append
; Guix
(list (if (get-environment-variable "GUIX_ENVIRONMENT")
(string-append (get-environment-variable "GUIX_ENVIRONMENT") slash "lib")
"")
"/run/current-system/profile/lib")
; Debian
(if (get-environment-variable "LD_LIBRARY_PATH")
(string-split (get-environment-variable "LD_LIBRARY_PATH") #\:)
(list))
(list
;;; x86-64
(cond-expand
(windows
(append
(if (get-environment-variable "PFFI_LOAD_PATH")
(string-split (get-environment-variable "PFFI_LOAD_PATH") #\;)
(list))
(if (get-environment-variable "SYSTEM")
(list (get-environment-variable "SYSTEM"))
(list))
(if (get-environment-variable "WINDIR")
(list (get-environment-variable "WINDIR"))
(list))
(if (get-environment-variable "WINEDLLDIR0")
(list (get-environment-variable "WINEDLLDIR0"))
(list))
(if (get-environment-variable "SystemRoot")
(list (string-append
(get-environment-variable "SystemRoot")
slash
"system32"))
(list))
(list ".")
(if (get-environment-variable "PATH")
(string-split (get-environment-variable "PATH") #\;)
(list))
(if (get-environment-variable "PWD")
(list (get-environment-variable "PWD"))
(list))))
(else
(append
(if (get-environment-variable "PFFI_LOAD_PATH")
(string-split (get-environment-variable "PFFI_LOAD_PATH") #\:)
(list))
; Guix
(list (if (get-environment-variable "GUIX_ENVIRONMENT")
(string-append (get-environment-variable "GUIX_ENVIRONMENT") slash "lib")
"")
"/run/current-system/profile/lib")
; Debian
"/lib/x86_64-linux-gnu"
"/usr/lib/x86_64-linux-gnu"
"/usr/local/lib"
; Fedora/Alpine
"/usr/lib"
"/usr/lib64"
;;; aarch64
; Debian
"/lib/aarch64-linux-gnu"
"/usr/lib/aarch64-linux-gnu"
"/usr/local/lib"
; Fedora/Alpine
"/usr/lib"
"/usr/lib64"
; NetBSD
"/usr/pkg/lib")))))
(if (get-environment-variable "LD_LIBRARY_PATH")
(string-split (get-environment-variable "LD_LIBRARY_PATH") #\:)
(list))
(list
;;; x86-64
; Debian
"/lib/x86_64-linux-gnu"
"/usr/lib/x86_64-linux-gnu"
"/usr/local/lib"
; Fedora/Alpine
"/usr/lib"
"/usr/lib64"
;;; aarch64
; Debian
"/lib/aarch64-linux-gnu"
"/usr/lib/aarch64-linux-gnu"
"/usr/local/lib"
; Fedora/Alpine
"/usr/lib"
"/usr/lib64"
; NetBSD
"/usr/pkg/lib")))))
(auto-load-versions (list ""))
(paths (append auto-load-paths additional-paths))
(versions (append additional-versions auto-load-versions))

2
retropikzel/pffi/shared/pointer.scm
View File

@ -12,7 +12,7 @@
(chibi #t) ; FIXME
(else (pffi-define pffi-pointer-allocate pffi-libc-stdlib 'malloc 'pointer '(int))))
(pffi-define pffi-pointer-allocate-aligned pffi-libc-stdlib 'aligned_alloc 'pointer '(int int))
;(pffi-define pffi-pointer-allocate-aligned pffi-libc-stdlib 'aligned_alloc 'pointer '(int int))
(pffi-define pffi-pointer-allocate-calloc pffi-libc-stdlib 'calloc 'pointer '(int int))
(cond-expand

4
retropikzel/pffi/shared/struct.scm
View File

@ -52,7 +52,7 @@
(define round-to-next-modulo-of
(lambda (to-round roundee)
(if (= (floor-remainder to-round roundee) 0)
(if (= (modulo to-round roundee) 0)
to-round
(round-to-next-modulo-of (+ to-round 1) roundee))))
@ -67,7 +67,7 @@
(when (> (size-of-type type) largest-member-size)
(set! largest-member-size (size-of-type type)))
(if (or (= size 0)
(= (floor-remainder size type-alignment) 0))
(= (modulo size type-alignment) 0))
(begin
(set! size (+ size type-alignment))
(list name type (- size type-alignment)))

84
tests/compliance.scm
View File

@ -922,25 +922,25 @@
;; pffi-struct-dereference 1
(print-header "pffi-struct-dereference 1")
(pffi-define c-color-check-by-value c-testlib 'color_check_by_value 'int '((struct . color)))
(pffi-define-struct make-struct-color 'color '((int8 . r)
;(print-header "pffi-struct-dereference 1")
;(pffi-define c-color-check-by-value c-testlib 'color_check_by_value 'int '((struct . color)))
#;(pffi-define-struct make-struct-color 'color '((int8 . r)
(int8 . g)
(int8 . b)
(int8 . a)))
(define struct-color (make-struct-color))
(debug (pffi-struct-set! struct-color 'r 100))
(debug (pffi-struct-set! struct-color 'g 101))
(debug (pffi-struct-set! struct-color 'b 102))
(debug (pffi-struct-set! struct-color 'a 103))
(assert = (c-color-check-by-value (pffi-struct-dereference struct-color)) 0)
;(define struct-color (make-struct-color))
;(debug (pffi-struct-set! struct-color 'r 100))
;(debug (pffi-struct-set! struct-color 'g 101))
;(debug (pffi-struct-set! struct-color 'b 102))
;(debug (pffi-struct-set! struct-color 'a 103))
;(assert = (c-color-check-by-value (pffi-struct-dereference struct-color)) 0)
(exit 0)
(print-header "pffi-struct-dereference 2")
;(print-header "pffi-struct-dereference 2")
(pffi-define c-test-check-by-value c-testlib 'test_check_by_value 'int '((struct . test)))
(pffi-define-struct make-struct-test-dereference2
;(pffi-define c-test-check-by-value c-testlib 'test_check_by_value 'int '((struct . test)))
#;(pffi-define-struct make-struct-test-dereference2
'test
'((int8 . a)
(char . b)
@ -956,36 +956,36 @@
(int . l)
(double . m)
(float . n)))
(define struct-test3 (make-struct-test-dereference2))
(debug (pffi-struct-set! struct-test3 'a 1))
(debug (pffi-struct-set! struct-test3 'b #\b))
(debug (pffi-struct-set! struct-test3 'c 3.0))
(debug (pffi-struct-set! struct-test3 'd #\d))
(debug (pffi-struct-set! struct-test3 'e (pffi-pointer-null)))
(debug (pffi-struct-set! struct-test3 'f 6.0))
(debug (pffi-struct-set! struct-test3 'g (pffi-string->pointer "foo")))
(debug (pffi-struct-set! struct-test3 'h 8))
(debug (pffi-struct-set! struct-test3 'i (pffi-pointer-null)))
(debug (pffi-struct-set! struct-test3 'j 10))
(debug (pffi-struct-set! struct-test3 'k 11))
(debug (pffi-struct-set! struct-test3 'l 12))
(debug (pffi-struct-set! struct-test3 'm 13.0))
(debug (pffi-struct-set! struct-test3 'n 14.0))
(debug (pffi-struct-get struct-test3 'a))
(debug (pffi-struct-get struct-test3 'b))
(debug (pffi-struct-get struct-test3 'c))
(debug (pffi-struct-get struct-test3 'd))
(debug (pffi-struct-get struct-test3 'e))
(debug (pffi-struct-get struct-test3 'f))
(debug (pffi-struct-get struct-test3 'g))
(debug (pffi-struct-get struct-test3 'h))
(debug (pffi-struct-get struct-test3 'i))
(debug (pffi-struct-get struct-test3 'j))
(debug (pffi-struct-get struct-test3 'k))
(debug (pffi-struct-get struct-test3 'l))
(debug (pffi-struct-get struct-test3 'm))
(debug (pffi-struct-get struct-test3 'n))
(c-test-check-by-value (pffi-struct-dereference struct-test3))
;(define struct-test3 (make-struct-test-dereference2))
;(debug (pffi-struct-set! struct-test3 'a 1))
;(debug (pffi-struct-set! struct-test3 'b #\b))
;(debug (pffi-struct-set! struct-test3 'c 3.0))
;(debug (pffi-struct-set! struct-test3 'd #\d))
;(debug (pffi-struct-set! struct-test3 'e (pffi-pointer-null)))
;(debug (pffi-struct-set! struct-test3 'f 6.0))
;(debug (pffi-struct-set! struct-test3 'g (pffi-string->pointer "foo")))
;(debug (pffi-struct-set! struct-test3 'h 8))
;(debug (pffi-struct-set! struct-test3 'i (pffi-pointer-null)))
;(debug (pffi-struct-set! struct-test3 'j 10))
;(debug (pffi-struct-set! struct-test3 'k 11))
;(debug (pffi-struct-set! struct-test3 'l 12))
;(debug (pffi-struct-set! struct-test3 'm 13.0))
;(debug (pffi-struct-set! struct-test3 'n 14.0))
;(debug (pffi-struct-get struct-test3 'a))
;(debug (pffi-struct-get struct-test3 'b))
;(debug (pffi-struct-get struct-test3 'c))
;(debug (pffi-struct-get struct-test3 'd))
;(debug (pffi-struct-get struct-test3 'e))
;(debug (pffi-struct-get struct-test3 'f))
;(debug (pffi-struct-get struct-test3 'g))
;(debug (pffi-struct-get struct-test3 'h))
;(debug (pffi-struct-get struct-test3 'i))
;(debug (pffi-struct-get struct-test3 'j))
;(debug (pffi-struct-get struct-test3 'k))
;(debug (pffi-struct-get struct-test3 'l))
;(debug (pffi-struct-get struct-test3 'm))
;(debug (pffi-struct-get struct-test3 'n))
;(c-test-check-by-value (pffi-struct-dereference struct-test3))
;; pffi-define-callback