diff --git a/Makefile b/Makefile
index afd9c80..7f4fd0f 100644
--- a/Makefile
+++ b/Makefile
@@ -1,16 +1,15 @@
-.PHONY: snow
PREFIX=/usr/local
build:
printf "#!/bin/sh\nsash --disable-cache -r7 -L ${PREFIX}/lib/compile-r7rs/snow ${PREFIX}/lib/compile-r7rs/main.scm \"\$$@\"\n" > compile-r7rs
snow:
- rm -rf snow
mkdir -p snow
cp -r ../r7rs-pffi/retropikzel snow/
cp -r ../pffi-srfi-170/srfi snow/
-install:
+# Does uninstall because without that the changes do not seem to update
+install: uninstall
mkdir -p ${PREFIX}/lib/compile-r7rs/snow
cp -r snow/* ${PREFIX}/lib/compile-r7rs/snow
cp -r libs ${PREFIX}/lib/compile-r7rs/snow/libs
@@ -63,6 +62,12 @@ test-r7rs-docker:
docker build --build-arg COMPILE_R7RS=${COMPILE_R7RS} --tag=compile-r7rs-test-${COMPILE_R7RS} .
docker run -v "${PWD}":/workdir -w /workdir -t compile-r7rs-test-${COMPILE_R7RS} sh -c "make && make install && make clean-test COMPILE_R7RS=${COMPILE_R7RS} test-r7rs"
+clean-snow:
+ rm -rf snow
+
+clean-test:
+ rm -rf test
+
clean:
find . -name "*.so" -delete
find . -name "*.o*" -delete
@@ -74,5 +79,4 @@ clean:
rm -rf dist
rm -rf test
-clean-test:
- rm -rf test
+
diff --git a/README.md b/README.md
index 4e43dc5..a5b0b5b 100644
--- a/README.md
+++ b/README.md
@@ -98,6 +98,11 @@ as compiler.
- interpreter
- R6RS
- R7RS
+- racket
+ - interpreter
+ - Has compiling capabilities but I havent got them to work yet
+ - r6rs
+ - r7rs
- sagittarius
- interpreter
- R6RS
@@ -132,12 +137,6 @@ as compiler.
https://github.com/yamacir-kit/meevax/issues/494, might not be
implemented yet
- r7rs
- - racket
- - Wants the library paths to be full paths so I need to implement
- realpath into [pffi-srfi-170](https://git.sr.ht/~retropikzel/pffi-srfi-170)
- to get them
- - r6rs
- - r7rs
- picrin
- Might not be possible, seems to not have (include...) that works like
others
@@ -435,12 +434,3 @@ libs/util.sld.
If the transformer has to go trough hoops, that is is little or much unusual
then it is a good idea to explain how it works in this readmes how it works
section.
-
-### Misc notes
-<a name="#development-misc-notes"></a>
-
-When developing and testing, run:
-
- make && sudo make uninstall install
-
-without the uninstall the changes to libraries dont seem to update.
diff --git a/libs/data.sld b/libs/data.sld
index 29aa7c0..4a007c3 100644
--- a/libs/data.sld
+++ b/libs/data.sld
@@ -391,13 +391,26 @@
" "
,input-file)))))
(racket
- (type . compiler)
+ (type . interpreter)
+ (library-command . ,(lambda (library-file prepend-directories append-directories r6rs?)
+ (let ((library-rkt-file (change-file-suffix library-file ".rkt")))
+ (apply string-append
+ `("printf"
+ " "
+ "'#lang r7rs\\n(import (scheme base))\\n(include \""
+ ,(path->filename library-file)
+ "\")\\n"
+ "'"
+ " "
+ ">"
+ " "
+ ,library-rkt-file)))))
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?)
(let ((rkt-input-file (if (string=? input-file "")
""
(change-file-suffix input-file ".rkt"))))
(when (not (string=? rkt-input-file ""))
- (if (file-exists? rkt-input-file)
+ (when (file-exists? rkt-input-file)
(delete-file rkt-input-file))
(with-output-to-file
rkt-input-file
@@ -410,38 +423,23 @@
(display (path->filename input-file))
(display "\")")
(newline))))
- (for-each
- (lambda (file)
- (let ((library-rkt-file (change-file-suffix file ".rkt")))
- (if (file-exists? library-rkt-file)
- (delete-file library-rkt-file))
- (with-output-to-file
- library-rkt-file
- (lambda ()
- (display "#lang r7rs")
- (newline)
- (display "(import (scheme base))")
- (newline)
- (display "(include \"")
- (display (path->filename file))
- (display "\")")
- (newline)))))
- library-files)
(apply string-append
- ;; TODO run realpath to each directory
- ;; as Racket expects static paths
- `("PLTCOLLECTS="
- ,(string-join prepend-directories ":")
- ,(string-join append-directories ":")
- " "
- "raco exe"
+ `("racket"
" "
,(util-getenv "COMPILE_R7RS_RACKET")
" "
- "--orig-exe ++lang r7rs -o "
- ,output-file
+ "-I"
" "
- ,rkt-input-file))))))
+ ,(if r6rs? "r6rs" "r7rs")
+ " "
+ ,@(map (lambda (item)
+ (string-append "-S " item " "))
+ prepend-directories)
+ ,@(map (lambda (item)
+ (string-append "-S " item " "))
+ append-directories)
+ " "
+ ,(if r6rs? input-file rkt-input-file)))))))
(sagittarius
(type . interpreter)
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?)
diff --git a/snow/retropikzel/pffi/Makefile b/snow/retropikzel/pffi/Makefile
index 1cb9662..c9f6bde 100644
--- a/snow/retropikzel/pffi/Makefile
+++ b/snow/retropikzel/pffi/Makefile
@@ -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"
diff --git a/snow/retropikzel/pffi/chibi/pffi.stub b/snow/retropikzel/pffi/chibi-src/pffi.stub
similarity index 100%
rename from snow/retropikzel/pffi/chibi/pffi.stub
rename to snow/retropikzel/pffi/chibi-src/pffi.stub
diff --git a/snow/retropikzel/pffi/chibi/pffi.c b/snow/retropikzel/pffi/chibi/pffi.c
deleted file mode 100644
index e909d9c..0000000
--- a/snow/retropikzel/pffi/chibi/pffi.c
+++ /dev/null
@@ -1,1421 +0,0 @@
-/* Automatically generated by chibi-ffi; version: 0.5 */
-
-#include <chibi/eval.h>
-
-#include <stdint.h>
-
-#include <dlfcn.h>
-
-#include <ffi.h>
-
- int size_of_int8_t() { return sizeof(int8_t); }
- int size_of_uint8_t() { return sizeof(uint8_t); }
- int size_of_int16_t() { return sizeof(int16_t); }
- int size_of_uint16_t() { return sizeof(uint16_t); }
- int size_of_int32_t() { return sizeof(int32_t); }
- int size_of_uint32_t() { return sizeof(uint32_t); }
- int size_of_int64_t() { return sizeof(int64_t); }
- int size_of_uint64_t() { return sizeof(uint64_t); }
- int size_of_char() { return sizeof(char); }
- int size_of_unsigned_char() { return sizeof(unsigned char); }
- int size_of_short() { return sizeof(short); }
- int size_of_unsigned_short() { return sizeof(unsigned short); }
- int size_of_int() { return sizeof(int); }
- int size_of_unsigned_int() { return sizeof(unsigned int); }
- int size_of_long() { return sizeof(long); }
- int size_of_unsigned_long() { return sizeof(unsigned long); }
- int size_of_float() { return sizeof(float); }
- int size_of_double() { return sizeof(double); }
- int size_of_pointer() { return sizeof(void*); }
-
-void* pointer_null() { return NULL; }
-int is_pointer_null(void* pointer) { if(pointer == NULL) { return 1; } else { return 0; }; }
-void* pointer_allocate(int size) { return malloc(size); }
-sexp is_pointer(struct sexp_struct* object) {
- if(sexp_cpointerp(object)) {
- return SEXP_TRUE;
- } else {
- return SEXP_FALSE;
- }
- }
-intptr_t pointer_address(struct sexp_struct* pointer) {
- return (intptr_t)&sexp_cpointer_value(pointer);
- }
-void pointer_free(void* pointer) { free(pointer); }
-void pointer_set_c_int8_t(void* pointer, int offset, int8_t value) { *(int8_t*)((char*)pointer + offset) = value; }
-void pointer_set_c_uint8_t(void* pointer, int offset, uint8_t value) { *(uint8_t*)((char*)pointer + offset) = value; }
-void pointer_set_c_int16_t(void* pointer, int offset, int16_t value) { *(int16_t*)((char*)pointer + offset) = value; }
-void pointer_set_c_uint16_t(void* pointer, int offset, uint16_t value) { *(uint16_t*)((char*)pointer + offset) = value; }
-void pointer_set_c_int32_t(void* pointer, int offset, int32_t value) { *(int32_t*)((char*)pointer + offset) = value; }
-void pointer_set_c_uint32_t(void* pointer, int offset, uint32_t value) { *(uint32_t*)((char*)pointer + offset) = value; }
-void pointer_set_c_int64_t(void* pointer, int offset, int64_t value) { *(int64_t*)((char*)pointer + offset) = value; }
-void pointer_set_c_uint64_t(void* pointer, int offset, uint64_t value) { *(uint64_t*)((char*)pointer + offset) = value; }
-void pointer_set_c_char(void* pointer, int offset, char value) { *((char*)pointer + offset) = value; }
-void pointer_set_c_unsigned_char(void* pointer, int offset, unsigned char value) { *(unsigned char*)((char*)pointer + offset) = value; }
-void pointer_set_c_short(void* pointer, int offset, short value) { *(short*)((char*)pointer + offset) = value; }
-void pointer_set_c_unsigned_short(void* pointer, int offset, unsigned short value) { *(unsigned short*)((char*)pointer + offset) = value; }
-void pointer_set_c_int(void* pointer, int offset, int value) { *(int*)((char*)pointer + offset) = value; }
-void pointer_set_c_unsigned_int(void* pointer, int offset, unsigned int value) { *(unsigned int*)((char*)pointer + offset) = value; }
-void pointer_set_c_long(void* pointer, int offset, long value) { *(long*)((char*)pointer + offset) = value; }
-void pointer_set_c_unsigned_long(void* pointer, int offset, unsigned long value) { *(unsigned long*)((char*)pointer + offset) = value; }
-void pointer_set_c_float(void* pointer, int offset, float value) { *(float*)((char*)pointer + offset) = value; }
-void pointer_set_c_double(void* pointer, int offset, double value) { *(double*)((char*)pointer + offset) = value; }
-void pointer_set_c_pointer(void* pointer, int offset, void* value) { char* p = (char*)pointer + offset; *(char**)p = value; }
-int8_t pointer_ref_c_int8_t(void* pointer, int offset) { return *(int8_t*)((char*)pointer + offset); }
-uint8_t pointer_ref_c_uint8_t(void* pointer, int offset) { return *(uint8_t*)((char*)pointer + offset); }
-int16_t pointer_ref_c_int16_t(void* pointer, int offset) { return *(int16_t*)((char*)pointer + offset); }
-uint16_t pointer_ref_c_uint16_t(void* pointer, int offset) { return *(uint16_t*)((char*)pointer + offset); }
-int32_t pointer_ref_c_int32_t(void* pointer, int offset) { return *(int32_t*)((char*)pointer + offset); }
-uint32_t pointer_ref_c_uint32_t(void* pointer, int offset) { return *(uint32_t*)((char*)pointer + offset); }
-int64_t pointer_ref_c_int64_t(void* pointer, int offset) { return *(int64_t*)((char*)pointer + offset); }
-uint64_t pointer_ref_c_uint64_t(void* pointer, int offset) { return *(uint64_t*)((char*)pointer + offset); }
-char pointer_ref_c_char(void* pointer, int offset) { return *(char*)((char*)pointer + offset); }
-unsigned char pointer_ref_c_unsigned_char(void* pointer, int offset) { return *(unsigned char*)((char*)pointer + offset); }
-short pointer_ref_c_short(void* pointer, int offset) { return *(short*)((char*)pointer + offset); }
-unsigned short pointer_ref_c_unsigned_short(void* pointer, int offset) { return *(unsigned short*)((char*)pointer + offset); }
-int pointer_ref_c_int(void* pointer, int offset) { return *(int*)((char*)pointer + offset); }
-unsigned int pointer_ref_c_unsigned_int(void* pointer, int offset) { return *(unsigned int*)((char*)pointer + offset); }
-long pointer_ref_c_long(void* pointer, int offset) { return *(long*)((char*)pointer + offset); }
-unsigned long pointer_ref_c_unsigned_long(void* pointer, int offset) { return *(unsigned long*)((char*)pointer + offset); }
-float pointer_ref_c_float(void* pointer, int offset) { return *(float*)((char*)pointer + offset); }
-double pointer_ref_c_double(void* pointer, int offset) { return *(double*)((char*)pointer + offset); }
-void* pointer_ref_c_pointer(void* pointer, int offset) { char* p = (char*)pointer + offset; return *(char**)p; }
-ffi_cif cif;
-void* get_ffi_type_int8() { return &ffi_type_sint8; }
-void* get_ffi_type_uint8() { return &ffi_type_uint8; }
-void* get_ffi_type_int16() { return &ffi_type_sint16; }
-void* get_ffi_type_uint16() { return &ffi_type_uint16; }
-void* get_ffi_type_int32() { return &ffi_type_sint32; }
-void* get_ffi_type_uint32() { return &ffi_type_uint32; }
-void* get_ffi_type_int64() { return &ffi_type_sint64; }
-void* get_ffi_type_uint64() { return &ffi_type_uint64; }
-void* get_ffi_type_char() { return &ffi_type_schar; }
-void* get_ffi_type_uchar() { return &ffi_type_uchar; }
-void* get_ffi_type_short() { return &ffi_type_sshort; }
-void* get_ffi_type_ushort() { return &ffi_type_ushort; }
-void* get_ffi_type_int() { return &ffi_type_sint; }
-void* get_ffi_type_uint() { return &ffi_type_uint; }
-void* get_ffi_type_long() { return &ffi_type_slong; }
-void* get_ffi_type_ulong() { return &ffi_type_ulong; }
-void* get_ffi_type_float() { return &ffi_type_float; }
-void* get_ffi_type_double() { return &ffi_type_double; }
-void* get_ffi_type_void() { return &ffi_type_void; }
-void* get_ffi_type_pointer() { return &ffi_type_pointer; }
-int internal_ffi_prep_cif(unsigned int nargs, void* rtype, void* atypes[]) {
- printf("A1: %u, A2: %u, nargs: %u\n", &ffi_type_pointer, atypes[0], nargs);
- return ffi_prep_cif(&cif, FFI_DEFAULT_ABI, nargs, (ffi_type*)rtype, (ffi_type**)atypes);
- }
-void internal_ffi_call(unsigned int nargs, void* rtype, void** atypes, void* fn, void* rvalue, struct sexp_struct* avalues[]) {
- ffi_prep_cif(&cif, FFI_DEFAULT_ABI, nargs, (ffi_type*)rtype, (ffi_type**)atypes);
- void* c_avalues[nargs];
- for(int i = 0; i < nargs; i++) {
- c_avalues[i] = sexp_cpointer_value(avalues[i]);
- }
- ffi_call(&cif, FFI_FN(fn), rvalue, c_avalues);
- }
-void* scheme_procedure_to_pointer(sexp proc) {
- if(sexp_procedurep(proc) == 1) {
- return 0; //&sexp_unbox_fixnum(proc);
- } else {
- printf("NOT A FUNCTION\n");
- }
- return (void*)proc;
- }
-/*
-types: ()
-enums: ()
-*/
-
-sexp sexp_scheme_procedure_to_pointer_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0) {
- sexp res;
- res = sexp_make_cpointer(ctx, SEXP_CPOINTER, scheme_procedure_to_pointer(arg0), SEXP_FALSE, 0);
- return res;
-}
-
-sexp sexp_internal_ffi_call_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1, sexp arg2, sexp arg3, sexp arg4, sexp arg5) {
- int i = 0;
- void* *tmp2;
- sexp *tmp5;
- sexp res;
- if (! sexp_exact_integerp(arg0))
- return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg0);
- if (! (sexp_pointerp(arg1) && (sexp_pointer_tag(arg1) == SEXP_CPOINTER)))
- return sexp_type_exception(ctx, self, SEXP_CPOINTER, arg1);
- for (res=arg2; sexp_pairp(res); res=sexp_cdr(res))
- if (! (sexp_pointerp(sexp_car(res)) && (sexp_pointer_tag(sexp_car(res)) == SEXP_CPOINTER)))
- return sexp_xtype_exception(ctx, self, "not a list of void*s", arg2);
- if (! sexp_nullp(res))
- return sexp_xtype_exception(ctx, self, "not a list of void*s", arg2);
- if (! (sexp_pointerp(arg3) && (sexp_pointer_tag(arg3) == SEXP_CPOINTER)))
- return sexp_type_exception(ctx, self, SEXP_CPOINTER, arg3);
- if (! (sexp_pointerp(arg4) && (sexp_pointer_tag(arg4) == SEXP_CPOINTER)))
- return sexp_type_exception(ctx, self, SEXP_CPOINTER, arg4);
- for (res=arg5; sexp_pairp(res); res=sexp_cdr(res))
- if (! 1)
- return sexp_xtype_exception(ctx, self, "not a list of sexps", arg5);
- if (! sexp_nullp(res))
- return sexp_xtype_exception(ctx, self, "not a list of sexps", arg5);
- tmp2 = (void**) calloc((sexp_unbox_fixnum(sexp_length(ctx, arg2))+1), sizeof(tmp2[0]));
- for (i=0, res=arg2; sexp_pairp(res); res=sexp_cdr(res), i++) {
- tmp2[i] = (void*)sexp_cpointer_value(sexp_car(res));
- }
- tmp2[i] = 0;
- tmp5 = (sexp*) calloc((sexp_unbox_fixnum(sexp_length(ctx, arg5))+1), sizeof(tmp5[0]));
- for (i=0, res=arg5; sexp_pairp(res); res=sexp_cdr(res), i++) {
- tmp5[i] = sexp_car(res);
- }
- tmp5[i] = 0;
- res = ((internal_ffi_call(sexp_uint_value(arg0), (void**)sexp_cpointer_value(arg1), tmp2, (void**)sexp_cpointer_value(arg3), (void**)sexp_cpointer_value(arg4), tmp5)), SEXP_VOID);
- free(tmp2);
- free(tmp5);
- return res;
-}
-
-sexp sexp_internal_ffi_prep_cif_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1, sexp arg2) {
- int i = 0;
- void* *tmp2;
- sexp res;
- if (! sexp_exact_integerp(arg0))
- return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg0);
- if (! (sexp_pointerp(arg1) && (sexp_pointer_tag(arg1) == SEXP_CPOINTER)))
- return sexp_type_exception(ctx, self, SEXP_CPOINTER, arg1);
- for (res=arg2; sexp_pairp(res); res=sexp_cdr(res))
- if (! (sexp_pointerp(sexp_car(res)) && (sexp_pointer_tag(sexp_car(res)) == SEXP_CPOINTER)))
- return sexp_xtype_exception(ctx, self, "not a list of void*s", arg2);
- if (! sexp_nullp(res))
- return sexp_xtype_exception(ctx, self, "not a list of void*s", arg2);
- tmp2 = (void**) calloc((sexp_unbox_fixnum(sexp_length(ctx, arg2))+1), sizeof(tmp2[0]));
- for (i=0, res=arg2; sexp_pairp(res); res=sexp_cdr(res), i++) {
- tmp2[i] = (void*)sexp_cpointer_value(sexp_car(res));
- }
- tmp2[i] = 0;
- res = sexp_make_integer(ctx, internal_ffi_prep_cif(sexp_uint_value(arg0), (void**)sexp_cpointer_value(arg1), tmp2));
- free(tmp2);
- return res;
-}
-
-sexp sexp_get_ffi_type_pointer_stub (sexp ctx, sexp self, sexp_sint_t n) {
- void* *tmp;
- sexp res;
- res = sexp_make_cpointer(ctx, SEXP_CPOINTER, get_ffi_type_pointer(), SEXP_FALSE, 0);
- return res;
-}
-
-sexp sexp_get_ffi_type_void_stub (sexp ctx, sexp self, sexp_sint_t n) {
- void* *tmp;
- sexp res;
- res = sexp_make_cpointer(ctx, SEXP_CPOINTER, get_ffi_type_void(), SEXP_FALSE, 0);
- return res;
-}
-
-sexp sexp_get_ffi_type_double_stub (sexp ctx, sexp self, sexp_sint_t n) {
- void* *tmp;
- sexp res;
- res = sexp_make_cpointer(ctx, SEXP_CPOINTER, get_ffi_type_double(), SEXP_FALSE, 0);
- return res;
-}
-
-sexp sexp_get_ffi_type_float_stub (sexp ctx, sexp self, sexp_sint_t n) {
- void* *tmp;
- sexp res;
- res = sexp_make_cpointer(ctx, SEXP_CPOINTER, get_ffi_type_float(), SEXP_FALSE, 0);
- return res;
-}
-
-sexp sexp_get_ffi_type_ulong_stub (sexp ctx, sexp self, sexp_sint_t n) {
- void* *tmp;
- sexp res;
- res = sexp_make_cpointer(ctx, SEXP_CPOINTER, get_ffi_type_ulong(), SEXP_FALSE, 0);
- return res;
-}
-
-sexp sexp_get_ffi_type_long_stub (sexp ctx, sexp self, sexp_sint_t n) {
- void* *tmp;
- sexp res;
- res = sexp_make_cpointer(ctx, SEXP_CPOINTER, get_ffi_type_long(), SEXP_FALSE, 0);
- return res;
-}
-
-sexp sexp_get_ffi_type_uint_stub (sexp ctx, sexp self, sexp_sint_t n) {
- void* *tmp;
- sexp res;
- res = sexp_make_cpointer(ctx, SEXP_CPOINTER, get_ffi_type_uint(), SEXP_FALSE, 0);
- return res;
-}
-
-sexp sexp_get_ffi_type_int_stub (sexp ctx, sexp self, sexp_sint_t n) {
- void* *tmp;
- sexp res;
- res = sexp_make_cpointer(ctx, SEXP_CPOINTER, get_ffi_type_int(), SEXP_FALSE, 0);
- return res;
-}
-
-sexp sexp_get_ffi_type_ushort_stub (sexp ctx, sexp self, sexp_sint_t n) {
- void* *tmp;
- sexp res;
- res = sexp_make_cpointer(ctx, SEXP_CPOINTER, get_ffi_type_ushort(), SEXP_FALSE, 0);
- return res;
-}
-
-sexp sexp_get_ffi_type_short_stub (sexp ctx, sexp self, sexp_sint_t n) {
- void* *tmp;
- sexp res;
- res = sexp_make_cpointer(ctx, SEXP_CPOINTER, get_ffi_type_short(), SEXP_FALSE, 0);
- return res;
-}
-
-sexp sexp_get_ffi_type_uchar_stub (sexp ctx, sexp self, sexp_sint_t n) {
- void* *tmp;
- sexp res;
- res = sexp_make_cpointer(ctx, SEXP_CPOINTER, get_ffi_type_uchar(), SEXP_FALSE, 0);
- return res;
-}
-
-sexp sexp_get_ffi_type_char_stub (sexp ctx, sexp self, sexp_sint_t n) {
- void* *tmp;
- sexp res;
- res = sexp_make_cpointer(ctx, SEXP_CPOINTER, get_ffi_type_char(), SEXP_FALSE, 0);
- return res;
-}
-
-sexp sexp_get_ffi_type_uint64_stub (sexp ctx, sexp self, sexp_sint_t n) {
- void* *tmp;
- sexp res;
- res = sexp_make_cpointer(ctx, SEXP_CPOINTER, get_ffi_type_uint64(), SEXP_FALSE, 0);
- return res;
-}
-
-sexp sexp_get_ffi_type_int64_stub (sexp ctx, sexp self, sexp_sint_t n) {
- void* *tmp;
- sexp res;
- res = sexp_make_cpointer(ctx, SEXP_CPOINTER, get_ffi_type_int64(), SEXP_FALSE, 0);
- return res;
-}
-
-sexp sexp_get_ffi_type_uint32_stub (sexp ctx, sexp self, sexp_sint_t n) {
- void* *tmp;
- sexp res;
- res = sexp_make_cpointer(ctx, SEXP_CPOINTER, get_ffi_type_uint32(), SEXP_FALSE, 0);
- return res;
-}
-
-sexp sexp_get_ffi_type_int32_stub (sexp ctx, sexp self, sexp_sint_t n) {
- void* *tmp;
- sexp res;
- res = sexp_make_cpointer(ctx, SEXP_CPOINTER, get_ffi_type_int32(), SEXP_FALSE, 0);
- return res;
-}
-
-sexp sexp_get_ffi_type_uint16_stub (sexp ctx, sexp self, sexp_sint_t n) {
- void* *tmp;
- sexp res;
- res = sexp_make_cpointer(ctx, SEXP_CPOINTER, get_ffi_type_uint16(), SEXP_FALSE, 0);
- return res;
-}
-
-sexp sexp_get_ffi_type_int16_stub (sexp ctx, sexp self, sexp_sint_t n) {
- void* *tmp;
- sexp res;
- res = sexp_make_cpointer(ctx, SEXP_CPOINTER, get_ffi_type_int16(), SEXP_FALSE, 0);
- return res;
-}
-
-sexp sexp_get_ffi_type_uint8_stub (sexp ctx, sexp self, sexp_sint_t n) {
- void* *tmp;
- sexp res;
- res = sexp_make_cpointer(ctx, SEXP_CPOINTER, get_ffi_type_uint8(), SEXP_FALSE, 0);
- return res;
-}
-
-sexp sexp_get_ffi_type_int8_stub (sexp ctx, sexp self, sexp_sint_t n) {
- void* *tmp;
- sexp res;
- res = sexp_make_cpointer(ctx, SEXP_CPOINTER, get_ffi_type_int8(), SEXP_FALSE, 0);
- return res;
-}
-
-sexp sexp_dlsym_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1) {
- void* *tmp;
- sexp res;
- if (! ((sexp_pointerp(arg0) && (sexp_pointer_tag(arg0) == SEXP_CPOINTER)) || sexp_not(arg0)))
- return sexp_type_exception(ctx, self, SEXP_CPOINTER, arg0);
- if (! sexp_stringp(arg1))
- return sexp_type_exception(ctx, self, SEXP_STRING, arg1);
- res = sexp_make_cpointer(ctx, SEXP_CPOINTER, dlsym((void**)sexp_cpointer_maybe_null_value(arg0), sexp_string_data(arg1)), SEXP_FALSE, 0);
- return res;
-}
-
-sexp sexp_pointer_ref_c_pointer_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1) {
- void* *tmp;
- sexp res;
- if (! (sexp_pointerp(arg0) && (sexp_pointer_tag(arg0) == SEXP_CPOINTER)))
- return sexp_type_exception(ctx, self, SEXP_CPOINTER, arg0);
- if (! sexp_exact_integerp(arg1))
- return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg1);
- res = sexp_make_cpointer(ctx, SEXP_CPOINTER, pointer_ref_c_pointer((void**)sexp_cpointer_value(arg0), sexp_sint_value(arg1)), SEXP_FALSE, 0);
- return res;
-}
-
-sexp sexp_pointer_ref_c_double_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1) {
- sexp res;
- if (! (sexp_pointerp(arg0) && (sexp_pointer_tag(arg0) == SEXP_CPOINTER)))
- return sexp_type_exception(ctx, self, SEXP_CPOINTER, arg0);
- if (! sexp_exact_integerp(arg1))
- return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg1);
- res = sexp_make_flonum(ctx, pointer_ref_c_double((void**)sexp_cpointer_value(arg0), sexp_sint_value(arg1)));
- return res;
-}
-
-sexp sexp_pointer_ref_c_float_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1) {
- sexp res;
- if (! (sexp_pointerp(arg0) && (sexp_pointer_tag(arg0) == SEXP_CPOINTER)))
- return sexp_type_exception(ctx, self, SEXP_CPOINTER, arg0);
- if (! sexp_exact_integerp(arg1))
- return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg1);
- res = sexp_make_flonum(ctx, pointer_ref_c_float((void**)sexp_cpointer_value(arg0), sexp_sint_value(arg1)));
- return res;
-}
-
-sexp sexp_pointer_ref_c_unsigned_long_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1) {
- sexp res;
- if (! (sexp_pointerp(arg0) && (sexp_pointer_tag(arg0) == SEXP_CPOINTER)))
- return sexp_type_exception(ctx, self, SEXP_CPOINTER, arg0);
- if (! sexp_exact_integerp(arg1))
- return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg1);
- res = sexp_make_unsigned_integer(ctx, pointer_ref_c_unsigned_long((void**)sexp_cpointer_value(arg0), sexp_sint_value(arg1)));
- return res;
-}
-
-sexp sexp_pointer_ref_c_long_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1) {
- sexp res;
- if (! (sexp_pointerp(arg0) && (sexp_pointer_tag(arg0) == SEXP_CPOINTER)))
- return sexp_type_exception(ctx, self, SEXP_CPOINTER, arg0);
- if (! sexp_exact_integerp(arg1))
- return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg1);
- res = sexp_make_integer(ctx, pointer_ref_c_long((void**)sexp_cpointer_value(arg0), sexp_sint_value(arg1)));
- return res;
-}
-
-sexp sexp_pointer_ref_c_unsigned_int_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1) {
- sexp res;
- if (! (sexp_pointerp(arg0) && (sexp_pointer_tag(arg0) == SEXP_CPOINTER)))
- return sexp_type_exception(ctx, self, SEXP_CPOINTER, arg0);
- if (! sexp_exact_integerp(arg1))
- return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg1);
- res = sexp_make_unsigned_integer(ctx, pointer_ref_c_unsigned_int((void**)sexp_cpointer_value(arg0), sexp_sint_value(arg1)));
- return res;
-}
-
-sexp sexp_pointer_ref_c_int_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1) {
- sexp res;
- if (! (sexp_pointerp(arg0) && (sexp_pointer_tag(arg0) == SEXP_CPOINTER)))
- return sexp_type_exception(ctx, self, SEXP_CPOINTER, arg0);
- if (! sexp_exact_integerp(arg1))
- return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg1);
- res = sexp_make_integer(ctx, pointer_ref_c_int((void**)sexp_cpointer_value(arg0), sexp_sint_value(arg1)));
- return res;
-}
-
-sexp sexp_pointer_ref_c_unsigned_short_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1) {
- sexp res;
- if (! (sexp_pointerp(arg0) && (sexp_pointer_tag(arg0) == SEXP_CPOINTER)))
- return sexp_type_exception(ctx, self, SEXP_CPOINTER, arg0);
- if (! sexp_exact_integerp(arg1))
- return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg1);
- res = sexp_make_unsigned_integer(ctx, pointer_ref_c_unsigned_short((void**)sexp_cpointer_value(arg0), sexp_sint_value(arg1)));
- return res;
-}
-
-sexp sexp_pointer_ref_c_short_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1) {
- sexp res;
- if (! (sexp_pointerp(arg0) && (sexp_pointer_tag(arg0) == SEXP_CPOINTER)))
- return sexp_type_exception(ctx, self, SEXP_CPOINTER, arg0);
- if (! sexp_exact_integerp(arg1))
- return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg1);
- res = sexp_make_integer(ctx, pointer_ref_c_short((void**)sexp_cpointer_value(arg0), sexp_sint_value(arg1)));
- return res;
-}
-
-sexp sexp_pointer_ref_c_unsigned_char_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1) {
- sexp res;
- if (! (sexp_pointerp(arg0) && (sexp_pointer_tag(arg0) == SEXP_CPOINTER)))
- return sexp_type_exception(ctx, self, SEXP_CPOINTER, arg0);
- if (! sexp_exact_integerp(arg1))
- return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg1);
- res = sexp_make_unsigned_integer(ctx, pointer_ref_c_unsigned_char((void**)sexp_cpointer_value(arg0), sexp_sint_value(arg1)));
- return res;
-}
-
-sexp sexp_pointer_ref_c_char_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1) {
- sexp res;
- if (! (sexp_pointerp(arg0) && (sexp_pointer_tag(arg0) == SEXP_CPOINTER)))
- return sexp_type_exception(ctx, self, SEXP_CPOINTER, arg0);
- if (! sexp_exact_integerp(arg1))
- return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg1);
- res = sexp_make_character(pointer_ref_c_char((void**)sexp_cpointer_value(arg0), sexp_sint_value(arg1)));
- return res;
-}
-
-sexp sexp_pointer_ref_c_uint64_t_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1) {
- sexp res;
- if (! (sexp_pointerp(arg0) && (sexp_pointer_tag(arg0) == SEXP_CPOINTER)))
- return sexp_type_exception(ctx, self, SEXP_CPOINTER, arg0);
- if (! sexp_exact_integerp(arg1))
- return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg1);
- res = sexp_make_unsigned_integer(ctx, pointer_ref_c_uint64_t((void**)sexp_cpointer_value(arg0), sexp_sint_value(arg1)));
- return res;
-}
-
-sexp sexp_pointer_ref_c_int64_t_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1) {
- sexp res;
- if (! (sexp_pointerp(arg0) && (sexp_pointer_tag(arg0) == SEXP_CPOINTER)))
- return sexp_type_exception(ctx, self, SEXP_CPOINTER, arg0);
- if (! sexp_exact_integerp(arg1))
- return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg1);
- res = sexp_make_integer(ctx, pointer_ref_c_int64_t((void**)sexp_cpointer_value(arg0), sexp_sint_value(arg1)));
- return res;
-}
-
-sexp sexp_pointer_ref_c_uint32_t_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1) {
- sexp res;
- if (! (sexp_pointerp(arg0) && (sexp_pointer_tag(arg0) == SEXP_CPOINTER)))
- return sexp_type_exception(ctx, self, SEXP_CPOINTER, arg0);
- if (! sexp_exact_integerp(arg1))
- return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg1);
- res = sexp_make_unsigned_integer(ctx, pointer_ref_c_uint32_t((void**)sexp_cpointer_value(arg0), sexp_sint_value(arg1)));
- return res;
-}
-
-sexp sexp_pointer_ref_c_int32_t_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1) {
- sexp res;
- if (! (sexp_pointerp(arg0) && (sexp_pointer_tag(arg0) == SEXP_CPOINTER)))
- return sexp_type_exception(ctx, self, SEXP_CPOINTER, arg0);
- if (! sexp_exact_integerp(arg1))
- return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg1);
- res = sexp_make_integer(ctx, pointer_ref_c_int32_t((void**)sexp_cpointer_value(arg0), sexp_sint_value(arg1)));
- return res;
-}
-
-sexp sexp_pointer_ref_c_uint16_t_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1) {
- sexp res;
- if (! (sexp_pointerp(arg0) && (sexp_pointer_tag(arg0) == SEXP_CPOINTER)))
- return sexp_type_exception(ctx, self, SEXP_CPOINTER, arg0);
- if (! sexp_exact_integerp(arg1))
- return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg1);
- res = sexp_make_unsigned_integer(ctx, pointer_ref_c_uint16_t((void**)sexp_cpointer_value(arg0), sexp_sint_value(arg1)));
- return res;
-}
-
-sexp sexp_pointer_ref_c_int16_t_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1) {
- sexp res;
- if (! (sexp_pointerp(arg0) && (sexp_pointer_tag(arg0) == SEXP_CPOINTER)))
- return sexp_type_exception(ctx, self, SEXP_CPOINTER, arg0);
- if (! sexp_exact_integerp(arg1))
- return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg1);
- res = sexp_make_integer(ctx, pointer_ref_c_int16_t((void**)sexp_cpointer_value(arg0), sexp_sint_value(arg1)));
- return res;
-}
-
-sexp sexp_pointer_ref_c_uint8_t_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1) {
- sexp res;
- if (! (sexp_pointerp(arg0) && (sexp_pointer_tag(arg0) == SEXP_CPOINTER)))
- return sexp_type_exception(ctx, self, SEXP_CPOINTER, arg0);
- if (! sexp_exact_integerp(arg1))
- return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg1);
- res = sexp_make_unsigned_integer(ctx, pointer_ref_c_uint8_t((void**)sexp_cpointer_value(arg0), sexp_sint_value(arg1)));
- return res;
-}
-
-sexp sexp_pointer_ref_c_int8_t_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1) {
- sexp res;
- if (! (sexp_pointerp(arg0) && (sexp_pointer_tag(arg0) == SEXP_CPOINTER)))
- return sexp_type_exception(ctx, self, SEXP_CPOINTER, arg0);
- if (! sexp_exact_integerp(arg1))
- return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg1);
- res = sexp_make_integer(ctx, pointer_ref_c_int8_t((void**)sexp_cpointer_value(arg0), sexp_sint_value(arg1)));
- return res;
-}
-
-sexp sexp_pointer_set_c_pointer_x_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1, sexp arg2) {
- sexp res;
- if (! (sexp_pointerp(arg0) && (sexp_pointer_tag(arg0) == SEXP_CPOINTER)))
- return sexp_type_exception(ctx, self, SEXP_CPOINTER, arg0);
- if (! sexp_exact_integerp(arg1))
- return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg1);
- if (! ((sexp_pointerp(arg2) && (sexp_pointer_tag(arg2) == SEXP_CPOINTER)) || sexp_not(arg2)))
- return sexp_type_exception(ctx, self, SEXP_CPOINTER, arg2);
- res = ((pointer_set_c_pointer((void**)sexp_cpointer_value(arg0), sexp_sint_value(arg1), (void**)sexp_cpointer_maybe_null_value(arg2))), SEXP_VOID);
- return res;
-}
-
-sexp sexp_pointer_set_c_double_x_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1, sexp arg2) {
- sexp res;
- if (! (sexp_pointerp(arg0) && (sexp_pointer_tag(arg0) == SEXP_CPOINTER)))
- return sexp_type_exception(ctx, self, SEXP_CPOINTER, arg0);
- if (! sexp_exact_integerp(arg1))
- return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg1);
- if (! sexp_flonump(arg2))
- return sexp_type_exception(ctx, self, SEXP_FLONUM, arg2);
- res = ((pointer_set_c_double((void**)sexp_cpointer_value(arg0), sexp_sint_value(arg1), sexp_flonum_value(arg2))), SEXP_VOID);
- return res;
-}
-
-sexp sexp_pointer_set_c_float_x_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1, sexp arg2) {
- sexp res;
- if (! (sexp_pointerp(arg0) && (sexp_pointer_tag(arg0) == SEXP_CPOINTER)))
- return sexp_type_exception(ctx, self, SEXP_CPOINTER, arg0);
- if (! sexp_exact_integerp(arg1))
- return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg1);
- if (! sexp_flonump(arg2))
- return sexp_type_exception(ctx, self, SEXP_FLONUM, arg2);
- res = ((pointer_set_c_float((void**)sexp_cpointer_value(arg0), sexp_sint_value(arg1), sexp_flonum_value(arg2))), SEXP_VOID);
- return res;
-}
-
-sexp sexp_pointer_set_c_unsigned_long_x_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1, sexp arg2) {
- sexp res;
- if (! (sexp_pointerp(arg0) && (sexp_pointer_tag(arg0) == SEXP_CPOINTER)))
- return sexp_type_exception(ctx, self, SEXP_CPOINTER, arg0);
- if (! sexp_exact_integerp(arg1))
- return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg1);
- if (! sexp_exact_integerp(arg2))
- return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg2);
- res = ((pointer_set_c_unsigned_long((void**)sexp_cpointer_value(arg0), sexp_sint_value(arg1), sexp_uint_value(arg2))), SEXP_VOID);
- return res;
-}
-
-sexp sexp_pointer_set_c_long_x_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1, sexp arg2) {
- sexp res;
- if (! (sexp_pointerp(arg0) && (sexp_pointer_tag(arg0) == SEXP_CPOINTER)))
- return sexp_type_exception(ctx, self, SEXP_CPOINTER, arg0);
- if (! sexp_exact_integerp(arg1))
- return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg1);
- if (! sexp_exact_integerp(arg2))
- return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg2);
- res = ((pointer_set_c_long((void**)sexp_cpointer_value(arg0), sexp_sint_value(arg1), sexp_sint_value(arg2))), SEXP_VOID);
- return res;
-}
-
-sexp sexp_pointer_set_c_unsigned_int_x_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1, sexp arg2) {
- sexp res;
- if (! (sexp_pointerp(arg0) && (sexp_pointer_tag(arg0) == SEXP_CPOINTER)))
- return sexp_type_exception(ctx, self, SEXP_CPOINTER, arg0);
- if (! sexp_exact_integerp(arg1))
- return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg1);
- if (! sexp_exact_integerp(arg2))
- return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg2);
- res = ((pointer_set_c_unsigned_int((void**)sexp_cpointer_value(arg0), sexp_sint_value(arg1), sexp_uint_value(arg2))), SEXP_VOID);
- return res;
-}
-
-sexp sexp_pointer_set_c_int_x_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1, sexp arg2) {
- sexp res;
- if (! (sexp_pointerp(arg0) && (sexp_pointer_tag(arg0) == SEXP_CPOINTER)))
- return sexp_type_exception(ctx, self, SEXP_CPOINTER, arg0);
- if (! sexp_exact_integerp(arg1))
- return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg1);
- if (! sexp_exact_integerp(arg2))
- return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg2);
- res = ((pointer_set_c_int((void**)sexp_cpointer_value(arg0), sexp_sint_value(arg1), sexp_sint_value(arg2))), SEXP_VOID);
- return res;
-}
-
-sexp sexp_pointer_set_c_unsigned_short_x_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1, sexp arg2) {
- sexp res;
- if (! (sexp_pointerp(arg0) && (sexp_pointer_tag(arg0) == SEXP_CPOINTER)))
- return sexp_type_exception(ctx, self, SEXP_CPOINTER, arg0);
- if (! sexp_exact_integerp(arg1))
- return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg1);
- if (! sexp_exact_integerp(arg2))
- return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg2);
- res = ((pointer_set_c_unsigned_short((void**)sexp_cpointer_value(arg0), sexp_sint_value(arg1), sexp_uint_value(arg2))), SEXP_VOID);
- return res;
-}
-
-sexp sexp_pointer_set_c_short_x_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1, sexp arg2) {
- sexp res;
- if (! (sexp_pointerp(arg0) && (sexp_pointer_tag(arg0) == SEXP_CPOINTER)))
- return sexp_type_exception(ctx, self, SEXP_CPOINTER, arg0);
- if (! sexp_exact_integerp(arg1))
- return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg1);
- if (! sexp_exact_integerp(arg2))
- return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg2);
- res = ((pointer_set_c_short((void**)sexp_cpointer_value(arg0), sexp_sint_value(arg1), sexp_sint_value(arg2))), SEXP_VOID);
- return res;
-}
-
-sexp sexp_pointer_set_c_unsigned_char_x_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1, sexp arg2) {
- sexp res;
- if (! (sexp_pointerp(arg0) && (sexp_pointer_tag(arg0) == SEXP_CPOINTER)))
- return sexp_type_exception(ctx, self, SEXP_CPOINTER, arg0);
- if (! sexp_exact_integerp(arg1))
- return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg1);
- if (! sexp_exact_integerp(arg2))
- return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg2);
- res = ((pointer_set_c_unsigned_char((void**)sexp_cpointer_value(arg0), sexp_sint_value(arg1), sexp_uint_value(arg2))), SEXP_VOID);
- return res;
-}
-
-sexp sexp_pointer_set_c_char_x_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1, sexp arg2) {
- sexp res;
- if (! (sexp_pointerp(arg0) && (sexp_pointer_tag(arg0) == SEXP_CPOINTER)))
- return sexp_type_exception(ctx, self, SEXP_CPOINTER, arg0);
- if (! sexp_exact_integerp(arg1))
- return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg1);
- if (! sexp_charp(arg2))
- return sexp_type_exception(ctx, self, SEXP_CHAR, arg2);
- res = ((pointer_set_c_char((void**)sexp_cpointer_value(arg0), sexp_sint_value(arg1), sexp_unbox_character(arg2))), SEXP_VOID);
- return res;
-}
-
-sexp sexp_pointer_set_c_uint64_t_x_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1, sexp arg2) {
- sexp res;
- if (! (sexp_pointerp(arg0) && (sexp_pointer_tag(arg0) == SEXP_CPOINTER)))
- return sexp_type_exception(ctx, self, SEXP_CPOINTER, arg0);
- if (! sexp_exact_integerp(arg1))
- return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg1);
- if (! sexp_exact_integerp(arg2))
- return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg2);
- res = ((pointer_set_c_uint64_t((void**)sexp_cpointer_value(arg0), sexp_sint_value(arg1), sexp_uint_value(arg2))), SEXP_VOID);
- return res;
-}
-
-sexp sexp_pointer_set_c_int64_t_x_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1, sexp arg2) {
- sexp res;
- if (! (sexp_pointerp(arg0) && (sexp_pointer_tag(arg0) == SEXP_CPOINTER)))
- return sexp_type_exception(ctx, self, SEXP_CPOINTER, arg0);
- if (! sexp_exact_integerp(arg1))
- return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg1);
- if (! sexp_exact_integerp(arg2))
- return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg2);
- res = ((pointer_set_c_int64_t((void**)sexp_cpointer_value(arg0), sexp_sint_value(arg1), sexp_sint_value(arg2))), SEXP_VOID);
- return res;
-}
-
-sexp sexp_pointer_set_c_uint32_t_x_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1, sexp arg2) {
- sexp res;
- if (! (sexp_pointerp(arg0) && (sexp_pointer_tag(arg0) == SEXP_CPOINTER)))
- return sexp_type_exception(ctx, self, SEXP_CPOINTER, arg0);
- if (! sexp_exact_integerp(arg1))
- return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg1);
- if (! sexp_exact_integerp(arg2))
- return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg2);
- res = ((pointer_set_c_uint32_t((void**)sexp_cpointer_value(arg0), sexp_sint_value(arg1), sexp_uint_value(arg2))), SEXP_VOID);
- return res;
-}
-
-sexp sexp_pointer_set_c_int32_t_x_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1, sexp arg2) {
- sexp res;
- if (! (sexp_pointerp(arg0) && (sexp_pointer_tag(arg0) == SEXP_CPOINTER)))
- return sexp_type_exception(ctx, self, SEXP_CPOINTER, arg0);
- if (! sexp_exact_integerp(arg1))
- return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg1);
- if (! sexp_exact_integerp(arg2))
- return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg2);
- res = ((pointer_set_c_int32_t((void**)sexp_cpointer_value(arg0), sexp_sint_value(arg1), sexp_sint_value(arg2))), SEXP_VOID);
- return res;
-}
-
-sexp sexp_pointer_set_c_uint16_t_x_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1, sexp arg2) {
- sexp res;
- if (! (sexp_pointerp(arg0) && (sexp_pointer_tag(arg0) == SEXP_CPOINTER)))
- return sexp_type_exception(ctx, self, SEXP_CPOINTER, arg0);
- if (! sexp_exact_integerp(arg1))
- return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg1);
- if (! sexp_exact_integerp(arg2))
- return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg2);
- res = ((pointer_set_c_uint16_t((void**)sexp_cpointer_value(arg0), sexp_sint_value(arg1), sexp_uint_value(arg2))), SEXP_VOID);
- return res;
-}
-
-sexp sexp_pointer_set_c_int16_t_x_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1, sexp arg2) {
- sexp res;
- if (! (sexp_pointerp(arg0) && (sexp_pointer_tag(arg0) == SEXP_CPOINTER)))
- return sexp_type_exception(ctx, self, SEXP_CPOINTER, arg0);
- if (! sexp_exact_integerp(arg1))
- return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg1);
- if (! sexp_exact_integerp(arg2))
- return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg2);
- res = ((pointer_set_c_int16_t((void**)sexp_cpointer_value(arg0), sexp_sint_value(arg1), sexp_sint_value(arg2))), SEXP_VOID);
- return res;
-}
-
-sexp sexp_pointer_set_c_uint8_t_x_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1, sexp arg2) {
- sexp res;
- if (! (sexp_pointerp(arg0) && (sexp_pointer_tag(arg0) == SEXP_CPOINTER)))
- return sexp_type_exception(ctx, self, SEXP_CPOINTER, arg0);
- if (! sexp_exact_integerp(arg1))
- return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg1);
- if (! sexp_exact_integerp(arg2))
- return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg2);
- res = ((pointer_set_c_uint8_t((void**)sexp_cpointer_value(arg0), sexp_sint_value(arg1), sexp_uint_value(arg2))), SEXP_VOID);
- return res;
-}
-
-sexp sexp_pointer_set_c_int8_t_x_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1, sexp arg2) {
- sexp res;
- if (! (sexp_pointerp(arg0) && (sexp_pointer_tag(arg0) == SEXP_CPOINTER)))
- return sexp_type_exception(ctx, self, SEXP_CPOINTER, arg0);
- if (! sexp_exact_integerp(arg1))
- return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg1);
- if (! sexp_exact_integerp(arg2))
- return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg2);
- res = ((pointer_set_c_int8_t((void**)sexp_cpointer_value(arg0), sexp_sint_value(arg1), sexp_sint_value(arg2))), SEXP_VOID);
- return res;
-}
-
-sexp sexp_pointer_free_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0) {
- sexp res;
- if (! ((sexp_pointerp(arg0) && (sexp_pointer_tag(arg0) == SEXP_CPOINTER)) || sexp_not(arg0)))
- return sexp_type_exception(ctx, self, SEXP_CPOINTER, arg0);
- res = ((pointer_free((void**)sexp_cpointer_maybe_null_value(arg0))), SEXP_VOID);
- return res;
-}
-
-sexp sexp_pointer_address_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0) {
- sexp res;
- res = sexp_make_unsigned_integer(ctx, pointer_address(arg0));
- return res;
-}
-
-sexp sexp_pointer_p_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0) {
- sexp res;
- res = is_pointer(arg0);
- return res;
-}
-
-sexp sexp_pointer_allocate_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0) {
- void* *tmp;
- sexp res;
- if (! sexp_exact_integerp(arg0))
- return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg0);
- res = sexp_make_cpointer(ctx, SEXP_CPOINTER, pointer_allocate(sexp_sint_value(arg0)), SEXP_FALSE, 0);
- return res;
-}
-
-sexp sexp_is_pointer_null_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0) {
- sexp res;
- if (! ((sexp_pointerp(arg0) && (sexp_pointer_tag(arg0) == SEXP_CPOINTER)) || sexp_not(arg0)))
- return sexp_type_exception(ctx, self, SEXP_CPOINTER, arg0);
- res = sexp_make_boolean(is_pointer_null((void**)sexp_cpointer_maybe_null_value(arg0)));
- return res;
-}
-
-sexp sexp_pointer_null_stub (sexp ctx, sexp self, sexp_sint_t n) {
- void* *tmp;
- sexp res;
- res = sexp_make_cpointer(ctx, SEXP_CPOINTER, pointer_null(), SEXP_FALSE, 0);
- return res;
-}
-
-sexp sexp_dlerror_stub (sexp ctx, sexp self, sexp_sint_t n) {
- void* *tmp;
- sexp res;
- res = sexp_make_cpointer(ctx, SEXP_CPOINTER, dlerror(), SEXP_FALSE, 0);
- return res;
-}
-
-sexp sexp_dlopen_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1) {
- void* *tmp;
- sexp res;
- if (! sexp_stringp(arg0))
- return sexp_type_exception(ctx, self, SEXP_STRING, arg0);
- if (! sexp_exact_integerp(arg1))
- return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg1);
- res = sexp_make_cpointer(ctx, SEXP_CPOINTER, dlopen(sexp_string_data(arg0), sexp_sint_value(arg1)), SEXP_FALSE, 0);
- return res;
-}
-
-sexp sexp_size_of_pointer_stub (sexp ctx, sexp self, sexp_sint_t n) {
- sexp res;
- res = sexp_make_integer(ctx, size_of_pointer());
- return res;
-}
-
-sexp sexp_size_of_double_stub (sexp ctx, sexp self, sexp_sint_t n) {
- sexp res;
- res = sexp_make_integer(ctx, size_of_double());
- return res;
-}
-
-sexp sexp_size_of_float_stub (sexp ctx, sexp self, sexp_sint_t n) {
- sexp res;
- res = sexp_make_integer(ctx, size_of_float());
- return res;
-}
-
-sexp sexp_size_of_unsigned_long_stub (sexp ctx, sexp self, sexp_sint_t n) {
- sexp res;
- res = sexp_make_integer(ctx, size_of_unsigned_long());
- return res;
-}
-
-sexp sexp_size_of_long_stub (sexp ctx, sexp self, sexp_sint_t n) {
- sexp res;
- res = sexp_make_integer(ctx, size_of_long());
- return res;
-}
-
-sexp sexp_size_of_unsigned_int_stub (sexp ctx, sexp self, sexp_sint_t n) {
- sexp res;
- res = sexp_make_integer(ctx, size_of_unsigned_int());
- return res;
-}
-
-sexp sexp_size_of_int_stub (sexp ctx, sexp self, sexp_sint_t n) {
- sexp res;
- res = sexp_make_integer(ctx, size_of_int());
- return res;
-}
-
-sexp sexp_size_of_unsigned_short_stub (sexp ctx, sexp self, sexp_sint_t n) {
- sexp res;
- res = sexp_make_integer(ctx, size_of_unsigned_short());
- return res;
-}
-
-sexp sexp_size_of_short_stub (sexp ctx, sexp self, sexp_sint_t n) {
- sexp res;
- res = sexp_make_integer(ctx, size_of_short());
- return res;
-}
-
-sexp sexp_size_of_unsigned_char_stub (sexp ctx, sexp self, sexp_sint_t n) {
- sexp res;
- res = sexp_make_integer(ctx, size_of_unsigned_char());
- return res;
-}
-
-sexp sexp_size_of_char_stub (sexp ctx, sexp self, sexp_sint_t n) {
- sexp res;
- res = sexp_make_integer(ctx, size_of_char());
- return res;
-}
-
-sexp sexp_size_of_uint64_t_stub (sexp ctx, sexp self, sexp_sint_t n) {
- sexp res;
- res = sexp_make_integer(ctx, size_of_uint64_t());
- return res;
-}
-
-sexp sexp_size_of_int64_t_stub (sexp ctx, sexp self, sexp_sint_t n) {
- sexp res;
- res = sexp_make_integer(ctx, size_of_int64_t());
- return res;
-}
-
-sexp sexp_size_of_uint32_t_stub (sexp ctx, sexp self, sexp_sint_t n) {
- sexp res;
- res = sexp_make_integer(ctx, size_of_uint32_t());
- return res;
-}
-
-sexp sexp_size_of_int32_t_stub (sexp ctx, sexp self, sexp_sint_t n) {
- sexp res;
- res = sexp_make_integer(ctx, size_of_int32_t());
- return res;
-}
-
-sexp sexp_size_of_uint16_t_stub (sexp ctx, sexp self, sexp_sint_t n) {
- sexp res;
- res = sexp_make_integer(ctx, size_of_uint16_t());
- return res;
-}
-
-sexp sexp_size_of_int16_t_stub (sexp ctx, sexp self, sexp_sint_t n) {
- sexp res;
- res = sexp_make_integer(ctx, size_of_int16_t());
- return res;
-}
-
-sexp sexp_size_of_uint8_t_stub (sexp ctx, sexp self, sexp_sint_t n) {
- sexp res;
- res = sexp_make_integer(ctx, size_of_uint8_t());
- return res;
-}
-
-sexp sexp_size_of_int8_t_stub (sexp ctx, sexp self, sexp_sint_t n) {
- sexp res;
- res = sexp_make_integer(ctx, size_of_int8_t());
- return res;
-}
-
-
-sexp sexp_init_library (sexp ctx, sexp self, sexp_sint_t n, sexp env, const char* version, const sexp_abi_identifier_t abi) {
- sexp_gc_var3(name, tmp, op);
- if (!(sexp_version_compatible(ctx, version, sexp_version)
- && sexp_abi_compatible(ctx, abi, SEXP_ABI_IDENTIFIER)))
- return SEXP_ABI_ERROR;
- sexp_gc_preserve3(ctx, name, tmp, op);
- name = sexp_intern(ctx, "FFI-OK", 6);
- sexp_env_define(ctx, env, name, tmp=sexp_make_integer(ctx, FFI_OK));
- name = sexp_intern(ctx, "RTLD-NOW", 8);
- sexp_env_define(ctx, env, name, tmp=sexp_make_integer(ctx, RTLD_NOW));
- op = sexp_define_foreign(ctx, env, "scheme-procedure-to-pointer", 1, sexp_scheme_procedure_to_pointer_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- }
- op = sexp_define_foreign(ctx, env, "internal-ffi-call", 6, sexp_internal_ffi_call_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = SEXP_VOID;
- sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- sexp_opcode_arg3_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- sexp_opcode_argn_type(op) = sexp_make_vector(ctx, SEXP_THREE, sexp_make_fixnum(SEXP_OBJECT));
- sexp_vector_set(sexp_opcode_argn_type(op), SEXP_ZERO, sexp_make_fixnum(SEXP_CPOINTER));
- sexp_vector_set(sexp_opcode_argn_type(op), SEXP_ONE, sexp_make_fixnum(SEXP_CPOINTER));
- }
- op = sexp_define_foreign(ctx, env, "internal-ffi-prep-cif", 3, sexp_internal_ffi_prep_cif_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- sexp_opcode_arg3_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- }
- op = sexp_define_foreign(ctx, env, "get-ffi-type-pointer", 0, sexp_get_ffi_type_pointer_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- }
- op = sexp_define_foreign(ctx, env, "get-ffi-type-void", 0, sexp_get_ffi_type_void_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- }
- op = sexp_define_foreign(ctx, env, "get-ffi-type-double", 0, sexp_get_ffi_type_double_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- }
- op = sexp_define_foreign(ctx, env, "get-ffi-type-float", 0, sexp_get_ffi_type_float_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- }
- op = sexp_define_foreign(ctx, env, "get-ffi-type-ulong", 0, sexp_get_ffi_type_ulong_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- }
- op = sexp_define_foreign(ctx, env, "get-ffi-type-long", 0, sexp_get_ffi_type_long_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- }
- op = sexp_define_foreign(ctx, env, "get-ffi-type-uint", 0, sexp_get_ffi_type_uint_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- }
- op = sexp_define_foreign(ctx, env, "get-ffi-type-int", 0, sexp_get_ffi_type_int_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- }
- op = sexp_define_foreign(ctx, env, "get-ffi-type-ushort", 0, sexp_get_ffi_type_ushort_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- }
- op = sexp_define_foreign(ctx, env, "get-ffi-type-short", 0, sexp_get_ffi_type_short_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- }
- op = sexp_define_foreign(ctx, env, "get-ffi-type-uchar", 0, sexp_get_ffi_type_uchar_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- }
- op = sexp_define_foreign(ctx, env, "get-ffi-type-char", 0, sexp_get_ffi_type_char_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- }
- op = sexp_define_foreign(ctx, env, "get-ffi-type-uint64", 0, sexp_get_ffi_type_uint64_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- }
- op = sexp_define_foreign(ctx, env, "get-ffi-type-int64", 0, sexp_get_ffi_type_int64_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- }
- op = sexp_define_foreign(ctx, env, "get-ffi-type-uint32", 0, sexp_get_ffi_type_uint32_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- }
- op = sexp_define_foreign(ctx, env, "get-ffi-type-int32", 0, sexp_get_ffi_type_int32_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- }
- op = sexp_define_foreign(ctx, env, "get-ffi-type-uint16", 0, sexp_get_ffi_type_uint16_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- }
- op = sexp_define_foreign(ctx, env, "get-ffi-type-int16", 0, sexp_get_ffi_type_int16_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- }
- op = sexp_define_foreign(ctx, env, "get-ffi-type-uint8", 0, sexp_get_ffi_type_uint8_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- }
- op = sexp_define_foreign(ctx, env, "get-ffi-type-int8", 0, sexp_get_ffi_type_int8_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- }
- op = sexp_define_foreign(ctx, env, "dlsym", 2, sexp_dlsym_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_STRING);
- }
- op = sexp_define_foreign(ctx, env, "pointer-ref-c-pointer", 2, sexp_pointer_ref_c_pointer_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- }
- op = sexp_define_foreign(ctx, env, "pointer-ref-c-double", 2, sexp_pointer_ref_c_double_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FLONUM);
- sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- }
- op = sexp_define_foreign(ctx, env, "pointer-ref-c-float", 2, sexp_pointer_ref_c_float_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FLONUM);
- sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- }
- op = sexp_define_foreign(ctx, env, "pointer-ref-c-unsigned-long", 2, sexp_pointer_ref_c_unsigned_long_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- }
- op = sexp_define_foreign(ctx, env, "pointer-ref-c-long", 2, sexp_pointer_ref_c_long_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- }
- op = sexp_define_foreign(ctx, env, "pointer-ref-c-unsigned-int", 2, sexp_pointer_ref_c_unsigned_int_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- }
- op = sexp_define_foreign(ctx, env, "pointer-ref-c-int", 2, sexp_pointer_ref_c_int_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- }
- op = sexp_define_foreign(ctx, env, "pointer-ref-c-unsigned-short", 2, sexp_pointer_ref_c_unsigned_short_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- }
- op = sexp_define_foreign(ctx, env, "pointer-ref-c-short", 2, sexp_pointer_ref_c_short_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- }
- op = sexp_define_foreign(ctx, env, "pointer-ref-c-unsigned-char", 2, sexp_pointer_ref_c_unsigned_char_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- }
- op = sexp_define_foreign(ctx, env, "pointer-ref-c-char", 2, sexp_pointer_ref_c_char_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_CHAR);
- sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- }
- op = sexp_define_foreign(ctx, env, "pointer-ref-c-uint64_t", 2, sexp_pointer_ref_c_uint64_t_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- }
- op = sexp_define_foreign(ctx, env, "pointer-ref-c-int64_t", 2, sexp_pointer_ref_c_int64_t_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- }
- op = sexp_define_foreign(ctx, env, "pointer-ref-c-uint32_t", 2, sexp_pointer_ref_c_uint32_t_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- }
- op = sexp_define_foreign(ctx, env, "pointer-ref-c-int32_t", 2, sexp_pointer_ref_c_int32_t_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- }
- op = sexp_define_foreign(ctx, env, "pointer-ref-c-uint16_t", 2, sexp_pointer_ref_c_uint16_t_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- }
- op = sexp_define_foreign(ctx, env, "pointer-ref-c-int16_t", 2, sexp_pointer_ref_c_int16_t_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- }
- op = sexp_define_foreign(ctx, env, "pointer-ref-c-uint8_t", 2, sexp_pointer_ref_c_uint8_t_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- }
- op = sexp_define_foreign(ctx, env, "pointer-ref-c-int8_t", 2, sexp_pointer_ref_c_int8_t_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- }
- op = sexp_define_foreign(ctx, env, "pointer-set-c-pointer!", 3, sexp_pointer_set_c_pointer_x_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = SEXP_VOID;
- sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- sexp_opcode_arg3_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- }
- op = sexp_define_foreign(ctx, env, "pointer-set-c-double!", 3, sexp_pointer_set_c_double_x_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = SEXP_VOID;
- sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- sexp_opcode_arg3_type(op) = sexp_make_fixnum(SEXP_FLONUM);
- }
- op = sexp_define_foreign(ctx, env, "pointer-set-c-float!", 3, sexp_pointer_set_c_float_x_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = SEXP_VOID;
- sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- sexp_opcode_arg3_type(op) = sexp_make_fixnum(SEXP_FLONUM);
- }
- op = sexp_define_foreign(ctx, env, "pointer-set-c-unsigned-long!", 3, sexp_pointer_set_c_unsigned_long_x_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = SEXP_VOID;
- sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- sexp_opcode_arg3_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- }
- op = sexp_define_foreign(ctx, env, "pointer-set-c-long!", 3, sexp_pointer_set_c_long_x_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = SEXP_VOID;
- sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- sexp_opcode_arg3_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- }
- op = sexp_define_foreign(ctx, env, "pointer-set-c-unsigned-int!", 3, sexp_pointer_set_c_unsigned_int_x_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = SEXP_VOID;
- sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- sexp_opcode_arg3_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- }
- op = sexp_define_foreign(ctx, env, "pointer-set-c-int!", 3, sexp_pointer_set_c_int_x_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = SEXP_VOID;
- sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- sexp_opcode_arg3_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- }
- op = sexp_define_foreign(ctx, env, "pointer-set-c-unsigned-short!", 3, sexp_pointer_set_c_unsigned_short_x_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = SEXP_VOID;
- sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- sexp_opcode_arg3_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- }
- op = sexp_define_foreign(ctx, env, "pointer-set-c-short!", 3, sexp_pointer_set_c_short_x_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = SEXP_VOID;
- sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- sexp_opcode_arg3_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- }
- op = sexp_define_foreign(ctx, env, "pointer-set-c-unsigned-char!", 3, sexp_pointer_set_c_unsigned_char_x_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = SEXP_VOID;
- sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- sexp_opcode_arg3_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- }
- op = sexp_define_foreign(ctx, env, "pointer-set-c-char!", 3, sexp_pointer_set_c_char_x_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = SEXP_VOID;
- sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- sexp_opcode_arg3_type(op) = sexp_make_fixnum(SEXP_CHAR);
- }
- op = sexp_define_foreign(ctx, env, "pointer-set-c-uint64_t!", 3, sexp_pointer_set_c_uint64_t_x_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = SEXP_VOID;
- sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- sexp_opcode_arg3_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- }
- op = sexp_define_foreign(ctx, env, "pointer-set-c-int64_t!", 3, sexp_pointer_set_c_int64_t_x_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = SEXP_VOID;
- sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- sexp_opcode_arg3_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- }
- op = sexp_define_foreign(ctx, env, "pointer-set-c-uint32_t!", 3, sexp_pointer_set_c_uint32_t_x_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = SEXP_VOID;
- sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- sexp_opcode_arg3_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- }
- op = sexp_define_foreign(ctx, env, "pointer-set-c-int32_t!", 3, sexp_pointer_set_c_int32_t_x_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = SEXP_VOID;
- sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- sexp_opcode_arg3_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- }
- op = sexp_define_foreign(ctx, env, "pointer-set-c-uint16_t!", 3, sexp_pointer_set_c_uint16_t_x_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = SEXP_VOID;
- sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- sexp_opcode_arg3_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- }
- op = sexp_define_foreign(ctx, env, "pointer-set-c-int16_t!", 3, sexp_pointer_set_c_int16_t_x_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = SEXP_VOID;
- sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- sexp_opcode_arg3_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- }
- op = sexp_define_foreign(ctx, env, "pointer-set-c-uint8_t!", 3, sexp_pointer_set_c_uint8_t_x_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = SEXP_VOID;
- sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- sexp_opcode_arg3_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- }
- op = sexp_define_foreign(ctx, env, "pointer-set-c-int8_t!", 3, sexp_pointer_set_c_int8_t_x_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = SEXP_VOID;
- sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- sexp_opcode_arg3_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- }
- op = sexp_define_foreign(ctx, env, "pointer-free", 1, sexp_pointer_free_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = SEXP_VOID;
- sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- }
- op = sexp_define_foreign(ctx, env, "pointer-address", 1, sexp_pointer_address_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- }
- op = sexp_define_foreign(ctx, env, "pointer?", 1, sexp_pointer_p_stub);
- op = sexp_define_foreign(ctx, env, "pointer-allocate", 1, sexp_pointer_allocate_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- }
- op = sexp_define_foreign(ctx, env, "is-pointer-null", 1, sexp_is_pointer_null_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_BOOLEAN);
- sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- }
- op = sexp_define_foreign(ctx, env, "pointer-null", 0, sexp_pointer_null_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- }
- op = sexp_define_foreign(ctx, env, "dlerror", 0, sexp_dlerror_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- }
- op = sexp_define_foreign(ctx, env, "dlopen", 2, sexp_dlopen_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
- sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_STRING);
- sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- }
- op = sexp_define_foreign(ctx, env, "size-of-pointer", 0, sexp_size_of_pointer_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- }
- op = sexp_define_foreign(ctx, env, "size-of-double", 0, sexp_size_of_double_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- }
- op = sexp_define_foreign(ctx, env, "size-of-float", 0, sexp_size_of_float_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- }
- op = sexp_define_foreign(ctx, env, "size-of-unsigned-long", 0, sexp_size_of_unsigned_long_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- }
- op = sexp_define_foreign(ctx, env, "size-of-long", 0, sexp_size_of_long_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- }
- op = sexp_define_foreign(ctx, env, "size-of-unsigned-int", 0, sexp_size_of_unsigned_int_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- }
- op = sexp_define_foreign(ctx, env, "size-of-int", 0, sexp_size_of_int_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- }
- op = sexp_define_foreign(ctx, env, "size-of-unsigned-short", 0, sexp_size_of_unsigned_short_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- }
- op = sexp_define_foreign(ctx, env, "size-of-short", 0, sexp_size_of_short_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- }
- op = sexp_define_foreign(ctx, env, "size-of-unsigned-char", 0, sexp_size_of_unsigned_char_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- }
- op = sexp_define_foreign(ctx, env, "size-of-char", 0, sexp_size_of_char_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- }
- op = sexp_define_foreign(ctx, env, "size-of-uint64_t", 0, sexp_size_of_uint64_t_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- }
- op = sexp_define_foreign(ctx, env, "size-of-int64_t", 0, sexp_size_of_int64_t_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- }
- op = sexp_define_foreign(ctx, env, "size-of-uint32_t", 0, sexp_size_of_uint32_t_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- }
- op = sexp_define_foreign(ctx, env, "size-of-int32_t", 0, sexp_size_of_int32_t_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- }
- op = sexp_define_foreign(ctx, env, "size-of-uint16_t", 0, sexp_size_of_uint16_t_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- }
- op = sexp_define_foreign(ctx, env, "size-of-int16_t", 0, sexp_size_of_int16_t_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- }
- op = sexp_define_foreign(ctx, env, "size-of-uint8_t", 0, sexp_size_of_uint8_t_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- }
- op = sexp_define_foreign(ctx, env, "size-of-int8_t", 0, sexp_size_of_int8_t_stub);
- if (sexp_opcodep(op)) {
- sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
- }
- sexp_gc_release3(ctx);
- return SEXP_VOID;
-}
-
diff --git a/snow/retropikzel/pffi/gauche/gauchelib.scm b/snow/retropikzel/pffi/gauche-src/gauchelib.scm
similarity index 100%
rename from snow/retropikzel/pffi/gauche/gauchelib.scm
rename to snow/retropikzel/pffi/gauche-src/gauchelib.scm
diff --git a/snow/retropikzel/pffi/gauche/gauche-pffi.c b/snow/retropikzel/pffi/gauche/gauche-pffi.c
deleted file mode 100644
index e3875dd..0000000
--- a/snow/retropikzel/pffi/gauche/gauche-pffi.c
+++ /dev/null
@@ -1,692 +0,0 @@
-#include <math.h>
-#include <stdint.h>
-#include <gauche.h>
-#include <gauche/extend.h>
-#include <gauche/module.h>
-#include <gauche/load.h>
-#include <gauche/number.h>
-#include <gauche/string.h>
-#include <gauche-pffi.h>
-#include <ffi.h>
-#include <dlfcn.h>
-
-void print_pointer(ScmObj obj, ScmPort* sink, ScmWriteContext* G1788 SCM_UNUSED) {
- void* p = SCM_FOREIGN_POINTER_REF(void*, obj);
- if(p == NULL) {
- Scm_Printf(sink, "<pffi-pointer: (null)>\n");
- } else {
- Scm_Printf(sink, "<pffi-pointer: %i>\n", &p);
- }
-}
-
-void dprint_pointer(ScmObj obj, ScmPort* sink, ScmWriteContext* G1788 SCM_UNUSED) {
- void* p = SCM_FOREIGN_POINTER_REF(void*, obj);
- if(p == NULL) {
- Scm_Printf(sink, "<DEBUG pffi-pointer: (null)>\n");
- } else {
- Scm_Printf(sink, "<DEBUG pffi-pointer: %i>\n", &p);
- }
-}
-
-ScmObj size_of_int8() { return Scm_MakeInteger(sizeof(int8_t)); }
-ScmObj size_of_uint8() { return Scm_MakeInteger(sizeof(uint8_t)); }
-ScmObj size_of_int16() { return Scm_MakeInteger(sizeof(int16_t)); }
-ScmObj size_of_uint16() { return Scm_MakeInteger(sizeof(uint16_t)); }
-ScmObj size_of_int32() { return Scm_MakeInteger(sizeof(int32_t)); }
-ScmObj size_of_uint32() { return Scm_MakeInteger(sizeof(uint32_t)); }
-ScmObj size_of_int64() { return Scm_MakeInteger(sizeof(int64_t)); }
-ScmObj size_of_uint64() { return Scm_MakeInteger(sizeof(uint64_t)); }
-ScmObj size_of_char() { return Scm_MakeInteger(sizeof(char)); }
-ScmObj size_of_unsigned_char() { return Scm_MakeInteger(sizeof(unsigned char)); }
-ScmObj size_of_short() { return Scm_MakeInteger(sizeof(short)); }
-ScmObj size_of_unsigned_short() { return Scm_MakeInteger(sizeof(unsigned short)); }
-ScmObj size_of_int() { return Scm_MakeInteger(sizeof(int)); }
-ScmObj size_of_unsigned_int() { return Scm_MakeInteger(sizeof(unsigned int)); }
-ScmObj size_of_long() { return Scm_MakeInteger(sizeof(long)); }
-ScmObj size_of_unsigned_long() { return Scm_MakeInteger(sizeof(unsigned long)); }
-ScmObj size_of_float() { return Scm_MakeInteger(sizeof(float)); }
-ScmObj size_of_double() { return Scm_MakeInteger(sizeof(double)); }
-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)); }
-
-ScmModule* module = NULL;
-
-ScmObj shared_object_load(ScmString* path) {
- const ScmStringBody* body = SCM_STRING_BODY(path);
- const char* c_path = SCM_STRING_BODY_START(body);
- void* shared_object = dlopen(c_path, RTLD_NOW);
- ScmClass* shared_object_class = Scm_MakeForeignPointerClass(module, "pffi-shared-object", print_pointer, NULL, 0);
- ScmObj scm_shared_object = Scm_MakeForeignPointer(shared_object_class, shared_object);
- return scm_shared_object;
-}
-
-ScmObj pointer_null() {
- ScmClass* pointer_class = Scm_MakeForeignPointerClass(module, "pffi-pointer", print_pointer, NULL, 0);
- ScmObj pointer = Scm_MakeForeignPointer(pointer_class, NULL);
- return pointer;
-}
-
-ScmObj is_pointer_null(ScmObj pointer) {
- if(!Scm_TypeP(pointer, SCM_CLASS_FOREIGN_POINTER)) {
- return SCM_FALSE;
- }
- if(SCM_FOREIGN_POINTER_REF(void*, pointer) == NULL) {
- return SCM_TRUE;
- } else {
- return SCM_FALSE;
- }
-}
-
-ScmObj pointer_allocate(int size) {
- ScmClass* pointer_class = Scm_MakeForeignPointerClass(module, "pffi-pointer", print_pointer, NULL, 0);
- void* p = malloc(size);
- ScmObj pointer = Scm_MakeForeignPointer(pointer_class, p);
- return pointer;
-}
-
-ScmObj pointer_address(ScmObj object) {
- if(!Scm_TypeP(object, SCM_CLASS_FOREIGN_POINTER)) {
- Scm_Error("Can only get pointer address of a pointer");
- return SCM_UNDEFINED;
- }
- void* p = SCM_FOREIGN_POINTER_REF(void*, object);
- return SCM_MAKE_INT(&p);
-}
-
-ScmObj is_pointer(ScmObj pointer) {
- if(Scm_TypeP(pointer, SCM_CLASS_FOREIGN_POINTER)) {
- return SCM_TRUE;
- } else {
- return SCM_FALSE;
- }
-}
-
-ScmObj pointer_free(ScmObj pointer) {
- if(SCM_FOREIGN_POINTER_P(pointer)) {
- free(SCM_FOREIGN_POINTER_REF(void*, pointer));
- }
- return SCM_UNDEFINED;
-}
-
-ScmObj pointer_set_int8(ScmObj pointer, int offset, int8_t value) {
- if(SCM_FOREIGN_POINTER_P(pointer)) {
- void* p = SCM_FOREIGN_POINTER_REF(void*, pointer);
- *(int8_t*)((char*)p + offset) = value;
- } else {
- Scm_Error("Not a pointer: %S", pointer);
- }
- return SCM_UNDEFINED;
-}
-
-ScmObj pointer_set_uint8(ScmObj pointer, int offset, uint8_t value) {
- if(SCM_FOREIGN_POINTER_P(pointer)) {
- void* p = SCM_FOREIGN_POINTER_REF(void*, pointer);
- *(uint8_t*)((char*)p + offset) = value;
- } else {
- Scm_Error("Not a pointer: %S", pointer);
- }
- return SCM_UNDEFINED;
-}
-
-ScmObj pointer_set_int16(ScmObj pointer, int offset, int16_t value) {
- if(SCM_FOREIGN_POINTER_P(pointer)) {
- void* p = SCM_FOREIGN_POINTER_REF(void*, pointer);
- *(int16_t*)((char*)p + offset) = value;
- } else {
- Scm_Error("Not a pointer: %S", pointer);
- }
- return SCM_UNDEFINED;
-}
-
-ScmObj pointer_set_uint16(ScmObj pointer, int offset, uint16_t value) {
- if(SCM_FOREIGN_POINTER_P(pointer)) {
- void* p = SCM_FOREIGN_POINTER_REF(void*, pointer);
- *(uint16_t*)((char*)p + offset) = value;
- } else {
- Scm_Error("Not a pointer: %S", pointer);
- }
- return SCM_UNDEFINED;
-}
-
-ScmObj pointer_set_int32(ScmObj pointer, int offset, int32_t value) {
- if(SCM_FOREIGN_POINTER_P(pointer)) {
- void* p = SCM_FOREIGN_POINTER_REF(void*, pointer);
- *(int32_t*)((char*)p + offset) = value;
- } else {
- Scm_Error("Not a pointer: %S", pointer);
- }
- return SCM_UNDEFINED;
-}
-
-ScmObj pointer_set_uint32(ScmObj pointer, int offset, uint32_t value) {
- if(SCM_FOREIGN_POINTER_P(pointer)) {
- void* p = SCM_FOREIGN_POINTER_REF(void*, pointer);
- *(uint32_t*)((char*)p + offset) = value;
- } else {
- Scm_Error("Not a pointer: %S", pointer);
- }
- return SCM_UNDEFINED;
-}
-
-ScmObj pointer_set_int64(ScmObj pointer, int offset, int64_t value) {
- if(SCM_FOREIGN_POINTER_P(pointer)) {
- void* p = SCM_FOREIGN_POINTER_REF(void*, pointer);
- *(int64_t*)((char*)p + offset) = value;
- } else {
- Scm_Error("Not a pointer: %S", pointer);
- }
- return SCM_UNDEFINED;
-}
-
-ScmObj pointer_set_uint64(ScmObj pointer, int offset, uint64_t value) {
- if(SCM_FOREIGN_POINTER_P(pointer)) {
- void* p = SCM_FOREIGN_POINTER_REF(void*, pointer);
- *(uint64_t*)((char*)p + offset) = value;
- } else {
- Scm_Error("Not a pointer: %S", pointer);
- }
- return SCM_UNDEFINED;
-}
-
-ScmObj pointer_set_char(ScmObj pointer, int offset, char value) {
- if(SCM_FOREIGN_POINTER_P(pointer)) {
- void* p = SCM_FOREIGN_POINTER_REF(void*, pointer);
- *(char*)((char*)p + offset) = value;
- } else {
- Scm_Error("Not a pointer: %S", pointer);
- }
- return SCM_UNDEFINED;
-}
-
-ScmObj pointer_set_unsigned_char(ScmObj pointer, int offset, unsigned char value) {
- if(SCM_FOREIGN_POINTER_P(pointer)) {
- void* p = SCM_FOREIGN_POINTER_REF(void*, pointer);
- *(unsigned char*)((char*)p + offset) = value;
- } else {
- Scm_Error("Not a pointer: %S", pointer);
- }
- return SCM_UNDEFINED;
-}
-
-ScmObj pointer_set_short(ScmObj pointer, int offset, short value) {
- if(SCM_FOREIGN_POINTER_P(pointer)) {
- void* p = SCM_FOREIGN_POINTER_REF(void*, pointer);
- *(short*)((char*)p + offset) = value;
- } else {
- Scm_Error("Not a pointer: %S", pointer);
- }
- return SCM_UNDEFINED;
-}
-
-ScmObj pointer_set_unsigned_short(ScmObj pointer, int offset, unsigned short value) {
- if(SCM_FOREIGN_POINTER_P(pointer)) {
- void* p = SCM_FOREIGN_POINTER_REF(void*, pointer);
- *(unsigned short*)((char*)p + offset) = value;
- } else {
- Scm_Error("Not a pointer: %S", pointer);
- }
- return SCM_UNDEFINED;
-}
-
-ScmObj pointer_set_int(ScmObj pointer, int offset, int value) {
- if(SCM_FOREIGN_POINTER_P(pointer)) {
- void* p = SCM_FOREIGN_POINTER_REF(void*, pointer);
- *(int*)((char*)p + offset) = value;
- } else {
- Scm_Error("Not a pointer: %S", pointer);
- }
- return SCM_UNDEFINED;
-}
-
-ScmObj pointer_set_unsigned_int(ScmObj pointer, int offset, unsigned int value) {
- if(SCM_FOREIGN_POINTER_P(pointer)) {
- void* p = SCM_FOREIGN_POINTER_REF(void*, pointer);
- *(unsigned int*)((char*)p + offset) = value;
- } else {
- Scm_Error("Not a pointer: %S", pointer);
- }
- return SCM_UNDEFINED;
-}
-
-ScmObj pointer_set_long(ScmObj pointer, int offset, long value) {
- if(SCM_FOREIGN_POINTER_P(pointer)) {
- void* p = SCM_FOREIGN_POINTER_REF(void*, pointer);
- *(long*)((char*)p + offset) = value;
- } else {
- Scm_Error("Not a pointer: %S", pointer);
- }
- return SCM_UNDEFINED;
-}
-
-ScmObj pointer_set_unsigned_long(ScmObj pointer, int offset, unsigned long value) {
- if(SCM_FOREIGN_POINTER_P(pointer)) {
- void* p = SCM_FOREIGN_POINTER_REF(void*, pointer);
- *(unsigned long*)((char*)p + offset) = value;
- } else {
- Scm_Error("Not a pointer: %S", pointer);
- }
- return SCM_UNDEFINED;
-}
-
-ScmObj pointer_set_float(ScmObj pointer, int offset, float value) {
- if(SCM_FOREIGN_POINTER_P(pointer)) {
- void* p = SCM_FOREIGN_POINTER_REF(void*, pointer);
- *(float*)((char*)p + offset) = value;
- } else {
- Scm_Error("Not a pointer: %S", pointer);
- }
- return SCM_UNDEFINED;
-}
-
-ScmObj pointer_set_double(ScmObj pointer, int offset, double value) {
- if(SCM_FOREIGN_POINTER_P(pointer)) {
- void* p = SCM_FOREIGN_POINTER_REF(void*, pointer);
- *(double*)((char*)p + offset) = value;
- } else {
- Scm_Error("Not a pointer: %S", pointer);
- }
- return SCM_UNDEFINED;
-}
-
-ScmObj pointer_set_pointer(ScmObj pointer, int offset, ScmObj value) {
- if(SCM_FOREIGN_POINTER_P(pointer)) {
- void* v = SCM_FOREIGN_POINTER_REF(void*, value);
- void* p = SCM_FOREIGN_POINTER_REF(void*, pointer);
- char* p1 = (char*)p + offset;
- *(char**)p1 = v;
- } else {
- Scm_Error("Not a pointer: %S", pointer);
- }
- return SCM_UNDEFINED;
-}
-
-ScmObj pointer_get_int8(ScmObj pointer, int offset) {
- if(SCM_FOREIGN_POINTER_P(pointer)) {
- void* p = SCM_FOREIGN_POINTER_REF(void*, pointer);
- return SCM_MAKE_INT(*(int8_t*)((char*)p + offset));
- } else {
- Scm_Error("Not a pointer: %S", pointer);
- }
- return SCM_UNDEFINED;
-}
-
-ScmObj pointer_get_uint8(ScmObj pointer, int offset) {
- if(SCM_FOREIGN_POINTER_P(pointer)) {
- void* p = SCM_FOREIGN_POINTER_REF(void*, pointer);
- return SCM_MAKE_INT(*(uint8_t*)((char*)p + offset));
- } else {
- Scm_Error("Not a pointer: %S", pointer);
- }
- return SCM_UNDEFINED;
-}
-
-ScmObj pointer_get_int16(ScmObj pointer, int offset) {
- if(SCM_FOREIGN_POINTER_P(pointer)) {
- void* p = SCM_FOREIGN_POINTER_REF(void*, pointer);
- return SCM_MAKE_INT(*(int16_t*)((char*)p + offset));
- } else {
- Scm_Error("Not a pointer: %S", pointer);
- }
- return SCM_UNDEFINED;
-}
-
-ScmObj pointer_get_uint16(ScmObj pointer, int offset) {
- if(SCM_FOREIGN_POINTER_P(pointer)) {
- void* p = SCM_FOREIGN_POINTER_REF(void*, pointer);
- return SCM_MAKE_INT(*(uint16_t*)((char*)p + offset));
- } else {
- Scm_Error("Not a pointer: %S", pointer);
- }
- return SCM_UNDEFINED;
-}
-
-ScmObj pointer_get_int32(ScmObj pointer, int offset) {
- if(SCM_FOREIGN_POINTER_P(pointer)) {
- void* p = SCM_FOREIGN_POINTER_REF(void*, pointer);
- return SCM_MAKE_INT(*(int32_t*)((char*)p + offset));
- } else {
- Scm_Error("Not a pointer: %S", pointer);
- }
- return SCM_UNDEFINED;
-}
-
-ScmObj pointer_get_uint32(ScmObj pointer, int offset) {
- if(SCM_FOREIGN_POINTER_P(pointer)) {
- void* p = SCM_FOREIGN_POINTER_REF(void*, pointer);
- return SCM_MAKE_INT(*(uint32_t*)((char*)p + offset));
- } else {
- Scm_Error("Not a pointer: %S", pointer);
- }
- return SCM_UNDEFINED;
-}
-
-ScmObj pointer_get_int64(ScmObj pointer, int offset) {
- if(SCM_FOREIGN_POINTER_P(pointer)) {
- void* p = SCM_FOREIGN_POINTER_REF(void*, pointer);
- return SCM_MAKE_INT(*(int64_t*)((char*)p + offset));
- } else {
- Scm_Error("Not a pointer: %S", pointer);
- }
- return SCM_UNDEFINED;
-}
-
-ScmObj pointer_get_uint64(ScmObj pointer, int offset) {
- if(SCM_FOREIGN_POINTER_P(pointer)) {
- void* p = SCM_FOREIGN_POINTER_REF(void*, pointer);
- return SCM_MAKE_INT(*(uint64_t*)((char*)p + offset));
- } else {
- Scm_Error("Not a pointer: %S", pointer);
- }
- return SCM_UNDEFINED;
-}
-
-ScmObj pointer_get_char(ScmObj pointer, int offset) {
- if(SCM_FOREIGN_POINTER_P(pointer)) {
- void* p = SCM_FOREIGN_POINTER_REF(void*, pointer);
- return SCM_MAKE_INT(*(char*)((char*)p + offset));
- } else {
- Scm_Error("Not a pointer: %S", pointer);
- }
- return SCM_UNDEFINED;
-}
-
-ScmObj pointer_get_unsigned_char(ScmObj pointer, int offset) {
- if(SCM_FOREIGN_POINTER_P(pointer)) {
- void* p = SCM_FOREIGN_POINTER_REF(void*, pointer);
- return SCM_MAKE_INT(*(unsigned char*)((char*)p + offset));
- } else {
- Scm_Error("Not a pointer: %S", pointer);
- }
- return SCM_UNDEFINED;
-}
-
-ScmObj pointer_get_short(ScmObj pointer, int offset) {
- if(SCM_FOREIGN_POINTER_P(pointer)) {
- void* p = SCM_FOREIGN_POINTER_REF(void*, pointer);
- return SCM_MAKE_INT(*(short*)((char*)p + offset));
- } else {
- Scm_Error("Not a pointer: %S", pointer);
- }
- return SCM_UNDEFINED;
-}
-
-ScmObj pointer_get_unsigned_short(ScmObj pointer, int offset) {
- if(SCM_FOREIGN_POINTER_P(pointer)) {
- void* p = SCM_FOREIGN_POINTER_REF(void*, pointer);
- return SCM_MAKE_INT(*(unsigned short*)((char*)p + offset));
- } else {
- Scm_Error("Not a pointer: %S", pointer);
- }
- return SCM_UNDEFINED;
-}
-
-ScmObj pointer_get_int(ScmObj pointer, int offset) {
- if(SCM_FOREIGN_POINTER_P(pointer)) {
- void* p = SCM_FOREIGN_POINTER_REF(void*, pointer);
- return SCM_MAKE_INT(*(int*)((char*)p + offset));
- } else {
- Scm_Error("Not a pointer: %S", pointer);
- }
- return SCM_UNDEFINED;
-}
-
-ScmObj pointer_get_unsigned_int(ScmObj pointer, int offset) {
- if(SCM_FOREIGN_POINTER_P(pointer)) {
- void* p = SCM_FOREIGN_POINTER_REF(void*, pointer);
- return SCM_MAKE_INT(*(unsigned int*)((char*)p + offset));
- } else {
- Scm_Error("Not a pointer: %S", pointer);
- }
- return SCM_UNDEFINED;
-}
-
-ScmObj pointer_get_long(ScmObj pointer, int offset) {
- if(SCM_FOREIGN_POINTER_P(pointer)) {
- void* p = SCM_FOREIGN_POINTER_REF(void*, pointer);
- return SCM_MAKE_INT(*(long*)((char*)p + offset));
- } else {
- Scm_Error("Not a pointer: %S", pointer);
- }
- return SCM_UNDEFINED;
-}
-
-ScmObj pointer_get_unsigned_long(ScmObj pointer, int offset) {
- if(SCM_FOREIGN_POINTER_P(pointer)) {
- void* p = SCM_FOREIGN_POINTER_REF(void*, pointer);
- return SCM_MAKE_INT(*(unsigned long*)((char*)p + offset));
- } else {
- Scm_Error("Not a pointer: %S", pointer);
- }
- return SCM_UNDEFINED;
-}
-
-ScmObj pointer_get_float(ScmObj pointer, int offset) {
- if(SCM_FOREIGN_POINTER_P(pointer)) {
- void* p = SCM_FOREIGN_POINTER_REF(void*, pointer);
- return Scm_MakeFlonum(*(float*)((char*)p + offset));
- } else {
- Scm_Error("Not a pointer: %S", pointer);
- }
- return SCM_UNDEFINED;
-}
-
-ScmObj pointer_get_double(ScmObj pointer, int offset) {
- if(SCM_FOREIGN_POINTER_P(pointer)) {
- void* p = SCM_FOREIGN_POINTER_REF(void*, pointer);
- return Scm_MakeFlonum(*(double*)((char*)p + offset));
- } else {
- Scm_Error("Not a pointer: %S", pointer);
- }
- return SCM_UNDEFINED;
-}
-
-ScmObj pointer_get_pointer(ScmObj pointer, int offset) {
- if(SCM_FOREIGN_POINTER_P(pointer)) {
- void* p = SCM_FOREIGN_POINTER_REF(void*, pointer);
- char* p1 = (char*)p + offset;
- ScmClass* pointer_class = Scm_MakeForeignPointerClass(module, "pffi-pointer", dprint_pointer, NULL, 0);
- return Scm_MakeForeignPointer(pointer_class, (void*)*(char**)p1);
- } else {
- Scm_Error("Not a pointer: %S", pointer);
- }
- return SCM_UNDEFINED;
-}
-
-ScmObj string_to_pointer(ScmObj string) {
- if(SCM_STRINGP(string)) {
- ScmClass* pointer_class = Scm_MakeForeignPointerClass(module, "pffi-pointer", print_pointer, NULL, 0);
- return Scm_MakeForeignPointer(pointer_class, Scm_GetString(SCM_STRING(string)));
- } else {
- Scm_Error("Not a string: %S", string);
- }
- return SCM_UNDEFINED;
-}
-
-ScmObj pointer_to_string(ScmObj pointer) {
- if(SCM_FOREIGN_POINTER_P(pointer)) {
- void* p = SCM_FOREIGN_POINTER_REF(void*, pointer);
- void* string = (char*)p;
- return Scm_MakeString(string, -1, -1, 0);
- } else {
- Scm_Error("Not a pointer: %S", pointer);
- }
- return SCM_UNDEFINED;
-}
-
-ScmObj pffi_dlerror() {
- ScmClass* pointer_class = Scm_MakeForeignPointerClass(module, "pffi-pointer", print_pointer, NULL, 0);
- void* msg = dlerror();
- if(msg == NULL) {
- return Scm_MakeForeignPointer(pointer_class, NULL);
- } else {
- return Scm_MakeForeignPointer(pointer_class, msg);
- }
-}
-
-ScmObj pffi_dlsym(ScmObj shared_object, ScmObj c_name) {
-
- if(!SCM_FOREIGN_POINTER_P(shared_object)) {
- Scm_Error("Not a shared object: %S", shared_object);
- return SCM_UNDEFINED;
- }
-
- if(!SCM_STRINGP(c_name)) {
- Scm_Error("Not a string: %S", c_name);
- return SCM_UNDEFINED;
- }
-
- void* handle = SCM_FOREIGN_POINTER_REF(void*, shared_object);
- const ScmStringBody* body = SCM_STRING_BODY(c_name);
- const char* name = SCM_STRING_BODY_START(body);
- void* symbol = dlsym(handle, name);
-
- if(symbol == NULL) {
- Scm_Error("Could not find function %S", c_name);
- return SCM_UNDEFINED;
- }
-
- ScmClass* pointer_class = Scm_MakeForeignPointerClass(module, "pffi-pointer", print_pointer, NULL, 0);
- return Scm_MakeForeignPointer(pointer_class, symbol);
-}
-
-ScmObj get_ffi_type_int8() {
- ScmClass* pointer_class = Scm_MakeForeignPointerClass(module, "pffi-pointer", print_pointer, NULL, 0);
- return Scm_MakeForeignPointer(pointer_class, &ffi_type_sint8);
-}
-
-ScmObj get_ffi_type_uint8() {
- ScmClass* pointer_class = Scm_MakeForeignPointerClass(module, "pffi-pointer", print_pointer, NULL, 0);
- return Scm_MakeForeignPointer(pointer_class, &ffi_type_uint8);
-}
-
-ScmObj get_ffi_type_int16() {
- ScmClass* pointer_class = Scm_MakeForeignPointerClass(module, "pffi-pointer", print_pointer, NULL, 0);
- return Scm_MakeForeignPointer(pointer_class, &ffi_type_sint16);
-}
-
-ScmObj get_ffi_type_uint16() {
- ScmClass* pointer_class = Scm_MakeForeignPointerClass(module, "pffi-pointer", print_pointer, NULL, 0);
- return Scm_MakeForeignPointer(pointer_class, &ffi_type_uint16);
-}
-
-ScmObj get_ffi_type_int32() {
- ScmClass* pointer_class = Scm_MakeForeignPointerClass(module, "pffi-pointer", print_pointer, NULL, 0);
- return Scm_MakeForeignPointer(pointer_class, &ffi_type_sint32);
-}
-
-ScmObj get_ffi_type_uint32() {
- ScmClass* pointer_class = Scm_MakeForeignPointerClass(module, "pffi-pointer", print_pointer, NULL, 0);
- return Scm_MakeForeignPointer(pointer_class, &ffi_type_uint32);
-}
-
-ScmObj get_ffi_type_int64() {
- ScmClass* pointer_class = Scm_MakeForeignPointerClass(module, "pffi-pointer", print_pointer, NULL, 0);
- return Scm_MakeForeignPointer(pointer_class, &ffi_type_sint64);
-}
-
-ScmObj get_ffi_type_uint64() {
- ScmClass* pointer_class = Scm_MakeForeignPointerClass(module, "pffi-pointer", print_pointer, NULL, 0);
- return Scm_MakeForeignPointer(pointer_class, &ffi_type_uint64);
-}
-
-ScmObj get_ffi_type_char() {
- ScmClass* pointer_class = Scm_MakeForeignPointerClass(module, "pffi-pointer", print_pointer, NULL, 0);
- return Scm_MakeForeignPointer(pointer_class, &ffi_type_schar);
-}
-
-ScmObj get_ffi_type_unsigned_char() {
- ScmClass* pointer_class = Scm_MakeForeignPointerClass(module, "pffi-pointer", print_pointer, NULL, 0);
- return Scm_MakeForeignPointer(pointer_class, &ffi_type_uchar);
-}
-
-ScmObj get_ffi_type_short() {
- ScmClass* pointer_class = Scm_MakeForeignPointerClass(module, "pffi-pointer", print_pointer, NULL, 0);
- return Scm_MakeForeignPointer(pointer_class, &ffi_type_sshort);
-}
-
-ScmObj get_ffi_type_unsigned_short() {
- ScmClass* pointer_class = Scm_MakeForeignPointerClass(module, "pffi-pointer", print_pointer, NULL, 0);
- return Scm_MakeForeignPointer(pointer_class, &ffi_type_ushort);
-}
-
-ScmObj get_ffi_type_int() {
- ScmClass* pointer_class = Scm_MakeForeignPointerClass(module, "pffi-pointer", print_pointer, NULL, 0);
- return Scm_MakeForeignPointer(pointer_class, &ffi_type_sint);
-}
-
-ScmObj get_ffi_type_unsigned_int() {
- ScmClass* pointer_class = Scm_MakeForeignPointerClass(module, "pffi-pointer", print_pointer, NULL, 0);
- return Scm_MakeForeignPointer(pointer_class, &ffi_type_uint);
-}
-
-ScmObj get_ffi_type_long() {
- ScmClass* pointer_class = Scm_MakeForeignPointerClass(module, "pffi-pointer", print_pointer, NULL, 0);
- return Scm_MakeForeignPointer(pointer_class, &ffi_type_slong);
-}
-
-ScmObj get_ffi_type_unsigned_long() {
- ScmClass* pointer_class = Scm_MakeForeignPointerClass(module, "pffi-pointer", print_pointer, NULL, 0);
- return Scm_MakeForeignPointer(pointer_class, &ffi_type_ulong);
-}
-
-ScmObj get_ffi_type_float() {
- ScmClass* pointer_class = Scm_MakeForeignPointerClass(module, "pffi-pointer", print_pointer, NULL, 0);
- return Scm_MakeForeignPointer(pointer_class, &ffi_type_float);
-}
-
-ScmObj get_ffi_type_double() {
- ScmClass* pointer_class = Scm_MakeForeignPointerClass(module, "pffi-pointer", print_pointer, NULL, 0);
- return Scm_MakeForeignPointer(pointer_class, &ffi_type_double);
-}
-
-ScmObj get_ffi_type_void() {
- ScmClass* pointer_class = Scm_MakeForeignPointerClass(module, "pffi-pointer", print_pointer, NULL, 0);
- return Scm_MakeForeignPointer(pointer_class, &ffi_type_void);
-}
-
-ScmObj get_ffi_type_pointer() {
- ScmClass* pointer_class = Scm_MakeForeignPointerClass(module, "pffi-pointer", print_pointer, NULL, 0);
- return Scm_MakeForeignPointer(pointer_class, &ffi_type_pointer);
-}
-
-ScmObj internal_ffi_call(ScmObj nargs, ScmObj rtype, ScmObj atypes, ScmObj fn, ScmObj rvalue, ScmObj avalues) {
-
- ffi_cif cif;
-
- unsigned int c_nargs = SCM_INT_VALUE(nargs);
- ffi_type* c_rtype = SCM_FOREIGN_POINTER_REF(ffi_type*, rtype);
- int atypes_length = (int)Scm_Length(atypes);
- ffi_type* c_atypes[atypes_length];
- for(int i = 0; i < atypes_length; i++) {
- c_atypes[i] = SCM_FOREIGN_POINTER_REF(ffi_type*, Scm_ListRef(atypes, i, SCM_UNDEFINED));
- }
- int prep_status = ffi_prep_cif(&cif, FFI_DEFAULT_ABI, c_nargs, c_rtype, c_atypes);
-
- void* c_fn = SCM_FOREIGN_POINTER_REF(void*, fn);
- void* c_rvalue = SCM_FOREIGN_POINTER_REF(void*, rvalue);
- int avalues_length = (int)Scm_Length(avalues);
- void* c_avalues[avalues_length];
- for(int i = 0; i < avalues_length; i++) {
- ScmObj item = Scm_ListRef(avalues, i, SCM_UNDEFINED);
- void* pp = SCM_FOREIGN_POINTER_REF(void*, item);
- char* list_p = (char*)c_avalues + (sizeof(void) * i);
- c_avalues[i] = pp;
- }
- ffi_call(&cif, FFI_FN(c_fn), c_rvalue, c_avalues);
-
- return SCM_UNDEFINED;
-}
-
-/*
-ScmObj procedure_to_pointer(ScmObj procedure) {
-
- return SCM_UNDEFINED;
-}*/
-
-void Scm_Init_gauche_pffi(void)
-{
- SCM_INIT_EXTENSION(retropikzel.pffi.gauche);
- module = SCM_MODULE(SCM_FIND_MODULE("retropikzel.pffi.gauche", TRUE));
- Scm_Init_gauchelib();
-}
diff --git a/snow/retropikzel/pffi/shared/struct.scm b/snow/retropikzel/pffi/shared/struct.scm
index 01938a5..2de0ebd 100644
--- a/snow/retropikzel/pffi/shared/struct.scm
+++ b/snow/retropikzel/pffi/shared/struct.scm
@@ -30,9 +30,6 @@
(let* ((member-type (cadr struct-member))
(member-name (car struct-member))
(member-size (pffi-size-of member-type)))
- (display "HERE: ")
- (write member-size)
- (newline)
(pffi-pointer-set! pointer
member-type
offset
@@ -114,10 +111,6 @@
(error "Struct has no such member" (list struct member-name)))
(let ((type (car (cdr (assoc member-name (pffi-struct-members struct)))))
(offset (car (cdr (cdr (assoc member-name (pffi-struct-members struct)))))))
- (map display (list "type: " type
- ", offset: " offset
- ", value: " (pffi-pointer-get (pffi-struct-pointer struct) type offset)
- #\newline))
(pffi-pointer-get (pffi-struct-pointer struct) type offset)))
(define (pffi-struct-set! struct member-name value)
diff --git a/snow/srfi/170.scm b/snow/srfi/170.scm
index af93f85..c03e23e 100644
--- a/snow/srfi/170.scm
+++ b/snow/srfi/170.scm
@@ -36,14 +36,55 @@
(pffi-define uv-fs-scandir libuv 'uv_fs_scandir 'int '(pointer pointer pointer int pointer))
(pffi-define uv-fs-scandir-next libuv 'uv_fs_scandir_next 'int '(pointer pointer))
(pffi-define uv-fs-get-ptr libuv 'uv_fs_get_ptr 'pointer '(pointer))
+(pffi-define uv-fs-realpath libuv 'uv_fs_realpath 'int '(pointer pointer pointer pointer))
+(pffi-define uv-fs-cleanup libuv 'uv_fs_req_cleanup 'void '(pointer))
;(pffi-define uv-fs-scandir libuv 'uv_fs_scandir 'int '(pointer pointer pointer int pointer))
;(pffi-define c-printf libc 'printf 'int '(string))
;(pffi-define c-cos libc 'cos 'double '(double))
(define UV-FS 6)
-(define uv-fs-t-make
+(pffi-define-struct uv-fs-t-make
+ 'uv_fs_t
+ '((pointer . data)
+ (int . type)
+ (pointer . reserved1)
+ (pointer . reserved2)
+ (pointer . reserved3)
+ (pointer . reserved4)
+ (pointer . reserved5)
+ (pointer . reserved6)
+ (pointer . fs_type)
+ (pointer . loop)
+ (pointer . cb)
+ (int . result)
+ (pointer . ptr)
+ (pointer . path)
+ (int . statbuf)
+ (pointer . new_path)
+ (int . file)
+ (int . flags)
+ (int . mode)
+ (pointer . bufs)
+ (int . off)
+ (int . uid)
+ (int . gid)
+ (double . atime)
+ (double . mtime)
+ (pointer . work_req)
+ (pointer . bufsml1)
+ (pointer . bufsml2)
+ (pointer . bufsml3)
+ (pointer . bufsml4)))
+
+(define req-type (uv-fs-t-make))
+
+;(pffi-struct-set! struct 'fs_type UV-FS)
+#;(define uv-fs-t-make
(lambda ()
- (let ((p (pffi-pointer-allocate (+ (pffi-size-of 'pointer) ; .loop
+ (let ((struct (uv-fs-t)))
+ (pffi-struct-set! struct 'fs_type UV-FS)
+ struct
+ #;(let ((p (pffi-pointer-allocate (+ (pffi-size-of 'pointer) ; .loop
(pffi-size-of 'int) ; .uv_fs_type
(pffi-size-of 'pointer) ; .path
(pffi-size-of 'int) ; .result
@@ -52,7 +93,11 @@
512 ; Temporary fix
))))
(pffi-pointer-set! p 'int (pffi-size-of 'pointer) UV-FS)
- p)))
+ p))))
+
+(pffi-define-struct uv-dirent-make
+ 'uv_dirent_t
+ '((pointer . name) (int . uv_dirent_type)))
(define handle-errors
(lambda (return-code . irritants)
@@ -85,115 +130,105 @@
; FIX make the "follow?" argument work
(define file-info
(lambda (fname/port follow?)
- (let* ((req-type (uv-fs-t-make)))
- (handle-errors (uv-fs-stat (uv-default-loop)
- req-type
- (pffi-string->pointer fname/port)
- (pffi-pointer-null)))
- (let ((stat-pointer (uv-fs-get-ptr req-type)))
- (file-info-record-make (pffi-pointer-get stat-pointer 'uint64 (* (pffi-size-of 'uint64) 0))
- (pffi-pointer-get stat-pointer 'uint64 (* (pffi-size-of 'uint64) 1))
- (pffi-pointer-get stat-pointer 'uint64 (* (pffi-size-of 'uint64) 2))
- (pffi-pointer-get stat-pointer 'uint64 (* (pffi-size-of 'uint64) 3))
- (pffi-pointer-get stat-pointer 'uint64 (* (pffi-size-of 'uint64) 4))
- (pffi-pointer-get stat-pointer 'uint64 (* (pffi-size-of 'uint64) 5))
- (pffi-pointer-get stat-pointer 'uint64 (* (pffi-size-of 'uint64) 6))
- (pffi-pointer-get stat-pointer 'uint64 (* (pffi-size-of 'uint64) 7))
- (pffi-pointer-get stat-pointer 'uint64 (* (pffi-size-of 'uint64) 8))
- (pffi-pointer-get stat-pointer 'uint64 (* (pffi-size-of 'uint64) 9))
- (pffi-pointer-get stat-pointer 'uint64 (* (pffi-size-of 'uint64) 10))
- (pffi-pointer-get stat-pointer 'uint64 (* (pffi-size-of 'uint64) 11))
- (pffi-pointer-get stat-pointer 'uint64 (* (pffi-size-of 'uint64) 12))
- fname/port
- follow?)))))
+ (handle-errors (uv-fs-stat (uv-default-loop)
+ (pffi-struct-pointer req-type)
+ (pffi-string->pointer fname/port)
+ (pffi-pointer-null)))
+ (let* ((stat-pointer (uv-fs-get-ptr (pffi-struct-pointer req-type)))
+ (result (file-info-record-make (pffi-pointer-get stat-pointer 'uint64 (* (pffi-size-of 'uint64) 0))
+ (pffi-pointer-get stat-pointer 'uint64 (* (pffi-size-of 'uint64) 1))
+ (pffi-pointer-get stat-pointer 'uint64 (* (pffi-size-of 'uint64) 2))
+ (pffi-pointer-get stat-pointer 'uint64 (* (pffi-size-of 'uint64) 3))
+ (pffi-pointer-get stat-pointer 'uint64 (* (pffi-size-of 'uint64) 4))
+ (pffi-pointer-get stat-pointer 'uint64 (* (pffi-size-of 'uint64) 5))
+ (pffi-pointer-get stat-pointer 'uint64 (* (pffi-size-of 'uint64) 6))
+ (pffi-pointer-get stat-pointer 'uint64 (* (pffi-size-of 'uint64) 7))
+ (pffi-pointer-get stat-pointer 'uint64 (* (pffi-size-of 'uint64) 8))
+ (pffi-pointer-get stat-pointer 'uint64 (* (pffi-size-of 'uint64) 9))
+ (pffi-pointer-get stat-pointer 'uint64 (* (pffi-size-of 'uint64) 10))
+ (pffi-pointer-get stat-pointer 'uint64 (* (pffi-size-of 'uint64) 11))
+ (pffi-pointer-get stat-pointer 'uint64 (* (pffi-size-of 'uint64) 12))
+ fname/port
+ follow?)))
+ (uv-fs-cleanup (pffi-struct-pointer req-type))
+ result)))
(define file-info-directory?
(lambda (file-info)
; Try to open the file-info path as directory, if it fails say it's not a directory
- (let ((req-type (uv-fs-t-make)))
- (let* ((file-path (file-info:fname/port file-info))
- (result (uv-fs-opendir (uv-default-loop)
- req-type
- (pffi-string->pointer file-path)
- (pffi-pointer-null))))
- (cond ((not (file-exists? file-path)) #f)
- ((not (= result -20)) #t)
- ; If it is a dir then it's open and needs to be closed
- (else (uv-fs-closedir (uv-default-loop)
- req-type
- (uv-fs-get-ptr req-type)
- (pffi-pointer-null))
- #f))))))
+ (let* ((file-path (file-info:fname/port file-info))
+ (uv-result (uv-fs-opendir (uv-default-loop)
+ (pffi-struct-pointer req-type)
+ (pffi-string->pointer file-path)
+ (pffi-pointer-null))))
+ (cond ((not (file-exists? file-path))
+ (uv-fs-cleanup (pffi-struct-pointer req-type))
+ #f)
+ ((not (= uv-result -20))
+ (uv-fs-cleanup (pffi-struct-pointer req-type))
+ #t)
+ ; If it is a dir then it's open and needs to be closed
+ (else (uv-fs-closedir (uv-default-loop)
+ (pffi-struct-pointer req-type)
+ (uv-fs-get-ptr (pffi-struct-pointer req-type))
+ (pffi-pointer-null))
+ (uv-fs-cleanup (pffi-struct-pointer req-type))
+ #f)))))
(define create-directory
(lambda (fname . permission-bits)
- (let ((req-type (uv-fs-t-make))
- (mode (if (null? permission-bits) #o775 (car permission-bits))))
+ (let ((mode (if (null? permission-bits) #o775 (car permission-bits))))
(handle-errors (uv-fs-mkdir (uv-default-loop)
- req-type
+ (pffi-struct-pointer req-type)
(pffi-string->pointer fname)
mode
(pffi-pointer-null))
+ (uv-fs-cleanup (pffi-struct-pointer req-type))
fname))))
(define delete-directory
(lambda (fname)
- (let ((req-type (uv-fs-t-make)))
- (handle-errors
- (uv-fs-rmdir (uv-default-loop)
- req-type
- (pffi-string->pointer fname)
- (pffi-pointer-null))
- fname))))
+ (handle-errors
+ (uv-fs-rmdir (uv-default-loop)
+ (pffi-struct-pointer req-type)
+ (pffi-string->pointer fname)
+ (pffi-pointer-null))
+ (uv-fs-cleanup (pffi-struct-pointer req-type))
+ fname)))
(define directory-files
(lambda (dir . args)
(letrec* ((dotfiles? (if (null? args) #f (car args)))
- (req-type (uv-fs-t-make))
(result (handle-errors (uv-fs-scandir (uv-default-loop)
- req-type
+ (pffi-struct-pointer req-type)
(pffi-string->pointer dir)
0
(pffi-pointer-null))
dir))
- (uv-dirent-t (pffi-pointer-allocate (+ (pffi-size-of 'pointer)
- (pffi-size-of 'int)
- 512)))
+ (uv-dirent-t (uv-dirent-make))
(files (list))
(looper
(lambda ()
- (let ((next-file (uv-fs-scandir-next req-type uv-dirent-t)))
+ (let ((next-file (uv-fs-scandir-next (pffi-struct-pointer req-type)
+ (pffi-struct-pointer uv-dirent-t))))
(when (= next-file 0) ; End of file
- (let ((file-name (string-copy (pffi-pointer->string (pffi-pointer-get uv-dirent-t 'pointer 0)))))
+ (let ((file-name (pffi-pointer->string (pffi-struct-get uv-dirent-t 'name))))
(if (and (> (string-length file-name) 0)
(char=? (string-ref file-name 0) #\.))
(if dotfiles? (set! files (append files (list file-name))))
- (set! files (append files (list file-name)))
- )
+ (set! files (append files (list file-name))))
(looper)))))))
(looper)
- files
- ;(write result)
- ;(newline)
- ;(write (uv-fs-scandir-next req-type uv-dirent-t))
- ;(newline)
- ;(write (pffi-pointer->string (pffi-pointer-get uv-dirent-t 'pointer 0)))
- ;(newline)
+ (uv-fs-cleanup (pffi-struct-pointer req-type))
+ files)))
+(define real-path
+ (lambda (path)
+ (let* ((result (uv-fs-realpath (uv-default-loop)
+ (pffi-struct-pointer req-type)
+ (pffi-string->pointer path)
+ (pffi-pointer-null)))
+ (realpath (pffi-pointer->string (uv-fs-get-ptr (pffi-struct-pointer req-type)))))
+ (uv-fs-cleanup (pffi-struct-pointer req-type))
+ realpath)))
-
-
-
-
- ;(write (uv-default-loop))
- ;(newline)
- ;(write (uv-fs-scandir (uv-default-loop) (pffi-string->pointer ".") 0 (pffi-pointer-null)))
- ;(newline)
- ;(write (c-opendir (pffi-string->pointer ".")))
- ;(newline)
- ;(c-puts (pffi-string->pointer "Hello world"))
- ;(c-printf (pffi-string->pointer "Hello world\n"))
- ;(newline)
- ;(c-cos 5.5)
- ;#t
- )))
diff --git a/snow/srfi/170.sld b/snow/srfi/170.sld
index 6db5bcf..5f39945 100644
--- a/snow/srfi/170.sld
+++ b/snow/srfi/170.sld
@@ -3,7 +3,9 @@
(import (scheme base)
(scheme write)
(scheme file)
- (retropikzel pffi))
+ (retropikzel pffi)
+ (scheme process-context)
+ )
(export ;posix-error?
;posix-error-name
;posix-error-message
@@ -46,7 +48,7 @@
;open-directory
;read-directory
;close-directory
- ;real-path
+ real-path
;file-space
;temp-file-prefix
;create-temp-file