From f037d22c400a3d3753c7639ba2d7d4319718a0f0 Mon Sep 17 00:00:00 2001 From: retropikzel Date: Fri, 20 Jun 2025 09:37:51 +0300 Subject: [PATCH] Moving towards snow-fort packaging --- .gitignore | 3 + Makefile | 73 +--- documentation/foreign-c.html | 800 ----------------------------------- foreign/c.sld | 2 +- foreign/c/Makefile | 13 +- tests/hello.scm | 32 ++ 6 files changed, 68 insertions(+), 855 deletions(-) create mode 100644 tests/hello.scm diff --git a/.gitignore b/.gitignore index bc23064..136cac5 100644 --- a/.gitignore +++ b/.gitignore @@ -47,3 +47,6 @@ snow foreign/c/lib !foreign/c/primitives/gauche/*.c !foreign/c/primitives/include/*.h +README.html +*.tgz +*.tar.gz diff --git a/Makefile b/Makefile index b33ab30..df63ae1 100644 --- a/Makefile +++ b/Makefile @@ -2,10 +2,30 @@ CC=gcc 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];}') +VERSION=$(shell awk '/version:/{ print $$2 }' README.md ) TESTNAME=primitives -all: chibi chicken cyclone gambit gauche gerbil guile kawa larceny mosh racket sagittarius skint stklos tr7 ypsilon +chibi: foreign/c/primitives/chibi/foreign-c.stub + chibi-ffi foreign/c/primitives/chibi/foreign-c.stub + ${CC} \ + -g3 \ + -o foreign/c/primitives/chibi/foreign-c.so \ + foreign/c/primitives/chibi/foreign-c.c \ + -fPIC \ + -lffi \ + -shared + +package: + markdown README.md > README.html + snow-chibi package \ + --version=${VERSION} \ + --authors="Retropikzel" \ + --doc=README.html \ + --description="Portable foreign function interface for R7RS Schemes" \ + foreign/c.sld + +clean-package: + rm -rf *.tgz test-compile-r7rs: tmp/test/libtest.o tmp/test/libtest.so tmp/test/libtest.a make ${COMPILE_R7RS} @@ -46,6 +66,7 @@ tmp/test/libtest.so: tests/c-src/libtest.c tmp/test/libtest.a: tmp/test/libtest.o tests/c-src/libtest.c ar rcs tmp/test/libtest.a tmp/test/libtest.o +documentation/foreign-c.html: # apt-get install pandoc weasyprint docs: @@ -59,54 +80,6 @@ docs: -o documentation/foreign-c.pdf \ README.md -chibi: - make -C foreign/c chibi - -chicken: - make -C foreign/c chicken - -cyclone: - make -C foreign/c cyclone - -gambit: - make -C foreign/c gambit - -gauche: - make -C foreign/c gauche - -gerbil: - make -C foreign/c gerbil - -guile: - make -C foreign/c guile - -kawa: - make -C foreign/c kawa - -larceny: - make -C foreign/c larceny - -mosh: - make -C foreign/c mosh - -racket: - make -C foreign/c racket - -sagittarius: - make -C foreign/c sagittarius - -skint: - make -C foreign/c skint - -stklos: - make -C foreign/c stklos - -tr7: - make -C foreign/c tr7 - -ypsilon: - make -C foreign/c tr7 - clean: find . -name "*.meta" -delete find . -name "*.link" -delete diff --git a/documentation/foreign-c.html b/documentation/foreign-c.html index b37ec65..e69de29 100644 --- a/documentation/foreign-c.html +++ b/documentation/foreign-c.html @@ -1,800 +0,0 @@ - - - - - foreign-c a portable foreign function interface for R7RS -Schemes - 0.10.0 - - - -

foreign-c

-

foreign-c is a C foreign function interface (FFI) library for - R7RS Schemes. It is portable in the sense that it supports - multiple implementations, as opposed to being portable by - conforming to some specification.

-

Issue - tracker

-

Maling - lists

-

Jenkins

- -

Implementation support - tables

-

Primitives 1 table

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
c-type-sizec-bytevector-u8-set!c-bytevector-u8-refdefine-c-libraryc-bytevector?define-c-procedure
ChibiXXXXXX
ChickenXXXXXX
GaucheXXXXXX
GuileXXXXXX
KawaXXXXXX
MoshXXXXXX
RacketXXXXXX
SaggittariusXXXXXX
StklosXXXXXX
YpsilonXXXXXX
-

Primitives 2 table

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
define-c-callback
Chibi
ChickenX
Gauche
GuileX
Kawa
MoshX
RacketX
SaggittariusX
Stklos
YpsilonX
-

Test files pass

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
primitives.scmaddressof.scmcallback.scm
ChibiXX
ChickenXXX
GaucheXX
GuileXXX
KawaXX
MoshXX
RacketX
SaggittariusXXX
StklosXX
YpsilonXX
-

Installation

-

Eithe 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.

-

Example assuming libraries in directory snow:

- 
git clone https://git.sr.ht/~retropikzel/foreign-c --branch LATEST_VERSION
-mkdir -p snow
-cp -r foreign-c/foreign snow/
-make -C snow/foreign/c SCHEME_IMPLEMENTATION_NAME
-

With most implementations the make command does not compile - anything. When that is the case it will say “Nothing to build on - SCHEME_IMPLEMENTATION_NAME.”

-

Documentation

-

Types

-

Types are given as symbols, for example ’int8 or - ’pointer.

- -

Primitives 1

-

(c-type-size type)

-

Returns the size of given C type.

-

(define-c-library scheme-name - headers object-name options)

-

Takes a scheme-name to bind the library to, list of C headers - as strings, shared-object name and options.

-

The C header strings should not contain “<” or “>”, - they are added automatically.

-

The name of the shared object should not contain suffix like - .so or .dll. Nor should it contain any prefix like “lib”.

-

Options:

- -

Example:

- 
(cond-expand
-  (windows (define-c-library libc-stdlib
-                                '("stdlib.h")
-                                "ucrtbase"
-                                '((additional-versions ("0" "6"))
-                                  (additiona-paths (".")))))
-  (else (define-c-library libc-stdlib
-                             (list "stdlib.h")
-                             "c"
-                             '((additional-versions ("0" "6"))
-                               (additiona-paths ("."))))))
-

Notes

- -

(define-c-procedure scheme-name - shared-object c-name return-type - argument-type)

-

Takes a scheme-name to bind the C procedure to, shared-object - where the function is looked from, c-name of the function as - symbol, return-type and argument-types.

-

Defines a new foreign function to be used from Scheme - code.

-

Example:

- 
(cond-expand
-    (windows (define-c-library libc-stdlib '("stdlib.h") "ucrtbase" '()))
-    (else (define-c-library libc-stdlib '("stdlib.h")  "c" '("6"))))
-(define-c-procedure c-puts libc-stdlib 'puts 'int '(pointer))
-(c-puts "Message brought to you by foreign-c!")
-

Notes

- -

(c-bytevector? obj)

-

Returns #t if obj is c-bytevector, - otherwise returns #f.

-

(c-bytevector-u8-set! c-bytevector - k byte)

-

If K is not a valid index of c-bytevector the behaviour is - undefined.

-

Stores the byte in element k of c-bytevector.

-

(c-bytevector-u8-ref c-bytevector - k)

-

If K is not a valid index of c-bytevector the behaviour is - undefined.

-

Returns the byte at index k of c-bytevector.

-

(c-bytevector-pointer-set! - c-bytevector k pointer)

-

If K is not a valid index of c-bytevector the behaviour is - undefined.

-

Stores the pointer(which is also c-bytevector) in element k - of c-bytevector.

-

(c-bytevector-pointer-ref - c-bytevector k pointer)

-

If K is not a valid index of c-bytevector the behaviour is - undefined.

-

Returns the pointer(which is also c-bytevector) at index k of - c-bytevector.

-

Primitives 2

-

(define-c-callback scheme-name - return-type argument-types - procedure)

-

Takes scheme-name to bind the Scheme procedure to, - return-type, argument-types and procedure as in place - lambda.

-

Defines a new Sceme function to be used as callback to C - code.

-

Example:

- 
; Load the shared library
-(cond-expand
-    (windows (define-c-library libc-stdlib '("stdlib.h") "ucrtbase" '()))
-    (else (define-c-library '("stdlib.h") "c" '("" "6"))))
-
-; Define C function that takes a callback
-(define-c-procedure qsort libc-stdlib 'qsort 'void '(pointer int int callback))
-
-; Define our callback
-(define-c-callback compare
-                      'int
-                      '(pointer pointer)
-                      (lambda (pointer-a pointer-b)
-                        (let ((a (c-bytevector-sint-get pointer-a (native-endianness) 0))
-                              (b (c-bytevector-sint-get pointer-b (native-endianness) 0)))
-                          (cond ((> a b) 1)
-                                ((= a b) 0)
-                                ((< a b) -1)))))
-
-; Create new array of ints to be sorted
-(define array (make-c-bytevector (* (c-type-size 'int) 3)))
-(c-bytevector-s32-native-set! array (* (c-type-size 'int) 0) 3)
-(c-bytevector-s32-native-set! array (* (c-type-size 'int) 1) 2)
-(c-bytevector-s32-native-set! array (* (c-type-size 'int) 2) 1)
-
-(display array)
-(newline)
-;> (3 2 1)
-
-; Sort the array
-(qsort array 3 (c-type-size 'int) compare)
-
-(display array)
-(newline)
-;> (1 2 3)
-

c-bytevector

-

Foreign-c c-bytevector interface is copied from R6RS - bytevectors, with some added functionality for C null pointers - and manual memory management.

-

(make-c-null)

-

Returns a null C pointer.

-

(c-null? obj)

-

Returns #t if obj is a null C - pointer, otherwise returns #f.

-

(c-free c-bytevector)

-

Frees c-bytevector from memory.

-

(call-with-address-of c-bytevector - thunk)

-

Calls thunk with address pointer of - c-bytevector.

-

Since the support for calling C functions taking pointer - address arguments, ones prefixrd with & in C, varies, some - additional ceremony is needed on the Scheme side.

-

Example:

-

Calling from C:

- 
//void func(int** i);
-func(&i);
-

Calling from Scheme:

- 
(define cbv (make-bytevector (c-type-size 'int)))
-(call-with-address-of
- cbv
- (lambda (address)
-  (func address)))
-; Use cbv here
-

The passed c-bytevector, in example named cbv, should only be - used after call to call-with-addres-of - ends.

-

(bytevector->c-bytevector - bytevector)

-

Returns a newly allocated c-bytevector of the bytes of - bytevector.

-

(c-bytevector->bytevector)

-

Returns a newly allocated bytevector of the bytes of - c-bytevector.

-

(native-endianness)

-

Returns the endianness symbol associated implementation’s - preferred endianness (usually that of the underlying machine - architecture). This may be any <endianness symbol>, - including a symbol other than big and little.

-

(make-c-bytevector k)
- (make-c-bytevector k - fill)

-

Returns a newly allocated c-bytevector of k - bytes.

-

If the fill argument is missing, the initial - contents of the returned c-bytevector are unspecified.

-

If the fill argument is present, it’s value must - confine to C uint8_t values , it specifies the initial value for - the bytes of the c-bytevector

-

(c-bytevector-s8-set! c-bytevector - k byte)

-

If k is not a valid index of c-bytevector the - behaviour is undefined.

-

Stores the byte in element k of - c-bytevector.

-

(c-bytevector-s8-ref c-bytevector - k)

-

If k is not a valid index of c-bytevector the - behaviour is undefined.

-

Returns the byte at index k of - c-bytevector.

-

(c-bytevector-char-set! - c-bytevector k char)

-

If k is not a valid index of c-bytevector the - behaviour is undefined.

-

Stores the char in element k of - c-bytevector.

-

(c-bytevector-char-ref c-bytevector - k)

-

If k is not a valid index of c-bytevector the - behaviour is undefined.

-

Returns the char at index k of - c-bytevector.

-

(c-bytevector-uchar-set! - c-bytevector k char)

-

If k is not a valid index of c-bytevector the - behaviour is undefined.

-

Stores the unsigned char in element k of - c-bytevector.

-

(c-bytevector-uchar-ref - c-bytevector k)

-

If k is not a valid index of c-bytevector the - behaviour is undefined.

-

Returns the unsigned char at index k of - c-bytevector.

-

(c-bytevector-uint-ref c-bytevector - k endianness size)
- (c-bytevector-sint-ref c-bytevector - k endianness size)
- (c-bytevector-uint-set! c-bytevector - k n endianness size)
- (c-bytevector-sint-set! c-bytevector - k n endianness size)

-

Size must be a positive exact integer object. If - k,…,k + size − 1 is not valid indices - of c-bytevector the behavior is unspecified.

-

The c-bytevector-uint-ref procedure retrieves the exact - integer object corresponding to the unsigned representation of - size size and specified by endianness at - indices k,…,k + size − 1.

-

The c-bytevector-sint-ref procedure retrieves the exact - integer object corresponding to the two’s-complement - representation of size size and specified by - endianness at indices k,…,k + - size − 1. For c-bytevector-uint-set!, n must - be an exact integer object in the interval - {0,…,256^size − 1}.

-

The c-bytevector-uint-set! procedure stores the unsigned - representation of size size and specified by - endianness into c-bytevector at indices - k,…,k + size − 1.

-

The . . . -set! procedures return unspecified values.

-

Examples:

- 
(define cbv (make-c-bytevector (c-type-size 'int)))
-(c-bytevector-sint-set! cbv 0 100 (native-endianness) (c-type-size 'int))
-(c-bytevector-sint-ref cbv 0 (native-endianness) (c-type-size 'int))
-> 100
-

(c-bytevector-u16-ref c-bytevector - k endianness)
- (c-bytevector-s16-ref c-bytevector - k endianness)
- (c-bytevector-u16-native-ref - c-bytevector k)
- (c-bytevector-s16-native-ref - c-bytevector k)
- (c-bytevector-u16-set! c-bytevector - k n endianness)
- (c-bytevector-s16-set! c-bytevector - k n endianness)
- (c-bytevector-u16-native-set! - c-bytevector k n)
- (c-bytevector-s16-native-set! - c-bytevector k n)

-

K must be a valid index of c-bytevector ; - so must k + 1. For c-bytevector-u16-set! and - c-bytevector-u16-native-set!, n must be an exact - integer object in the interval {0,…,216 − 1}. For - c-bytevector-s16-set! and c-bytevector-s16-native-set!, - n must be an exact integer object in the interval - {−215,…,215 − 1}.

-

These retrieve and set two-byte representations of numbers at - indices k and k + 1, according to the - endianness specified by endianness. The procedures with - u16 in their names deal with the unsigned representation; those - with s16 in their names deal with the two’s-complement - representation.

-

The procedures with native in their names employ the native - endianness, and work only at aligned indices: k must be - a multiple of 2.

-

The …-set! procedures return unspecified values.

-

(c-bytevector-u32-ref c-bytevector - k endianness)
- (c-bytevector-s32-ref c-bytevector - k endianness)
- (c-bytevector-u32-native-ref - c-bytevector k)
- (c-bytevector-s32-native-ref - c-bytevector k)
- (c-bytevector-u32-set! c-bytevector - k n endianness)
- (c-bytevector-s32-set! c-bytevector - k n endianness)
- (c-bytevector-u32-native-set! - c-bytevector k n)
- (c-bytevector-s32-native-set! - c-bytevector k n)

-

K,…,k + 3 must be valid indices of - bytevector. For c-bytevector-u32-set! and - bytevector-u32-native-set!, n must be an exact integer - object in the interval {0,…,232 − 1}. For bytevector-s32-set! - and bytevector-s32-native-set!, n must be an exact - integer object in the interval {−231,…,232 − 1}.

-

These retrieve and set four-byte representations of numbers - at indices k,…,k + 3, according to the - endianness specified by endianness. The procedures with - u32 in their names deal with the unsigned representation; those - with s32 with the two’s-complement representation.

-

The procedures with native in their names employ the native - endianness, and work only at aligned indices: k must be - a multiple of 4.

-

The …-set! procedures return unspecified values.

-

(c-bytevector-u64-ref c-bytevector - k endianness)
- (c-bytevector-s64-ref c-bytevector - k endianness)
- (c-bytevector-u64-native-ref - c-bytevector k)
- (c-bytevector-s64-native-ref - c-bytevector k)
- (c-bytevector-u64-set! c-bytevector - k n endianness)
- (c-bytevector-s64-set! c-bytevector - k n endianness)
- (c-bytevector-u64-native-set! - c-bytevector k n)
- (c-bytevector-s64-native-set! - c-bytevector k n)

-

K,…,k + 7 must be valid indices of - c-bytevector. For c-bytevector-u64-set! and - c-bytevector-u64-native-set!, n must be an exact - integer object in the interval {0,…,264 − 1}. For - c-bytevector-s64-set! and c-bytevector-s64-native-set!, - n must be an exact integer object in the interval - {−263,…,264 − 1}.

-

These retrieve and set eight-byte representations of numbers - at indices k,…,k + 7, according to the - endianness specified by endianness. The procedures with - u64 in their names deal with the unsigned representation; those - with s64 with the two’s-complement representation.

-

The procedures with native in their names employ the native - endianness, and work only at aligned indices: k must be - a multiple of 8.

-

The …-set! procedures return unspecified values.

-

(c-bytevector-ieee-single-native-ref)
- (c-bytevector-ieee-single-ref)

-

K,…,k + 3 must be valid indices of - c-bytevector. For c-bytevector-ieee-single-native-ref, - k must be a multiple of 4.

-

These procedures return the inexact real number object that - best represents the IEEE-754 single-precision number represented - by the four bytes beginning at index k.

-

(c-bytevector-ieee-double-native-ref)
- (c-bytevector-ieee-double-ref)

-

K,…,k + 7 must be valid indices of - c-bytevector. For c-bytevector-ieee-double-native-ref, - k must be a multiple of 8.

-

These procedures return the inexact real number object that - best represents the IEEE-754 double-precision number represented - by the eight bytes beginning at index k.

-

(c-bytevector-ieee-single-native-set!)
- (c-bytevector-ieee-single-set!)

-

K,…,k + 3 must be valid indices of - c-bytevector. For c-bytevector-ieee-single-native-set!, - k must be a multiple of 4.

-

These procedures store an IEEE-754 single-precision - representation of x into elements k through k - + 3 of bytevector, and return unspecified values.

-

(c-bytevector-ieee-double-native-set!)
- (c-bytevector-ieee-double-set!)

-

K,…,k + 7 must be valid indices of - bytevector. For c-bytevector-ieee-double-native-set!, k - must be a multiple of 8.

-

These procedures store an IEEE-754 double-precision - representation of x into elements k through k - + 7 of bytevector, andreturn unspecified values.

-

(string->c-utf8 string)

-

Returns a newly allocated (unless empty) c-bytevector that - contains the UTF-8 encoding of the given string.

-

(c-utf8->string - c-bytevector)

-

Returns a newly allocated (unless empty) string whose - character sequence is encoded by the given c-bytevector.

-

Environment variables

-

Setting environment variables like this on Windows works for - this library:

- 
set "FOREIGN_C_LOAD_PATH=C:\Program Files (x86)/foo/bar"
-

FOREIGN_C__LOAD_PATH

-

To add more paths to where foreign c looks for libraries set - FOREIGN_C_LOAD_PATH to paths separated by ; on windows, and : on - other operating systems.

- - diff --git a/foreign/c.sld b/foreign/c.sld index 7fba2be..70941aa 100644 --- a/foreign/c.sld +++ b/foreign/c.sld @@ -10,7 +10,7 @@ (chibi ast) (scheme inexact) (chibi)) - (include-shared "c/lib/chibi")) + (include-shared "c/primitives/chibi/foreign-c")) (chicken (import (scheme base) (scheme write) diff --git a/foreign/c/Makefile b/foreign/c/Makefile index 3837c23..3d4d0e2 100644 --- a/foreign/c/Makefile +++ b/foreign/c/Makefile @@ -1,9 +1,14 @@ CC=gcc -chibi: primitives/chibi/foreign-c.stub - chibi-ffi primitives/chibi/foreign-c.stub - mkdir -p lib - ${CC} -g3 -o lib/chibi.so primitives/chibi/foreign-c.c -fPIC -lffi -shared +chibi: foreign/c/primitives/chibi/foreign-c.stub + chibi-ffi foreign/c/primitives/chibi/foreign-c.stub + ${CC} \ + -g3 \ + -o foreign/c/primitives/chibi/foreign-c.so \ + foreign/c/primitives/chibi/foreign-c.c \ + -fPIC \ + -lffi \ + -shared chicken: @echo "Nothing to build for Chicken" diff --git a/tests/hello.scm b/tests/hello.scm new file mode 100644 index 0000000..02d72be --- /dev/null +++ b/tests/hello.scm @@ -0,0 +1,32 @@ +(import (scheme base) + (scheme write) + (foreign c)) + + +(cond-expand + (windows (define-c-library c-stdlib + '("stdlib.h") + "ucrtbase" + '())) + (else (define-c-library c-stdlib + '("stdlib.h") + "c" + '((additional-versions ("6")))))) + +(define-c-procedure c-system c-stdlib 'system 'int '(pointer)) + +(define (anything->string item) + (parameterize + ((current-output-port (open-output-string))) + (display item) + (get-output-string (current-output-port)))) + +(define (system command) + (c-system (string->c-utf8 + (apply string-append + (map (lambda (item) + (string-append (anything->string item) " ")) + command))))) + +(system '(ls)) +