Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-19 05:39:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

fixing 64-bit uvectors

Browse source
This commit is contained in:
Alex Shinn 2020-07-27 16:08:24 +09:00
parent 99a863c723
commit edcddd7299
6 changed files with 133 additions and 125 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

24
include/chibi/sexp.h
View file

@ -269,6 +269,9 @@ typedef int32_t sexp_int32_t;
# include <ape/limits.h> # include <ape/limits.h>
# else # else
# include <limits.h> # include <limits.h>
# if SEXP_USE_UNIFORM_VECTOR_LITERALS
# include <stdint.h>
# endif
# endif # endif
# if UCHAR_MAX == 255 # if UCHAR_MAX == 255
# define SEXP_UINT8_DEFINED 1 # define SEXP_UINT8_DEFINED 1
@ -287,7 +290,7 @@ typedef long sexp_int32_t;
typedef unsigned short sexp_uint32_t; typedef unsigned short sexp_uint32_t;
typedef short sexp_int32_t; typedef short sexp_int32_t;
# endif # endif
#endif #endif /* SEXP_USE_INTTYPES */
#if defined(__APPLE__) || defined(_WIN64) || (defined(__CYGWIN__) && __SIZEOF_POINTER__ == 8) #if defined(__APPLE__) || defined(_WIN64) || (defined(__CYGWIN__) && __SIZEOF_POINTER__ == 8)
#define SEXP_PRIdOFF "lld" #define SEXP_PRIdOFF "lld"
@ -398,6 +401,9 @@ struct sexp_mark_stack_ptr_t {
struct sexp_mark_stack_ptr_t *prev; /* TODO: remove for allocations on stack */ struct sexp_mark_stack_ptr_t *prev; /* TODO: remove for allocations on stack */
}; };
/* Note this must be kept in sync with the type registry in sexp.c. */
/* sexp fields must be placed first if you use slot-ref/set!, as is */
/* done by write. */
struct sexp_struct { struct sexp_struct {
sexp_tag_t tag; sexp_tag_t tag;
char markedp; char markedp;
@ -430,9 +436,9 @@ struct sexp_struct {
char data SEXP_FLEXIBLE_ARRAY; char data SEXP_FLEXIBLE_ARRAY;
} bytes; } bytes;
struct { struct {
sexp bytes;
unsigned char element_type; unsigned char element_type;
sexp_sint_t length; sexp_sint_t length;
sexp bytes;
} uvector; } uvector;
struct { struct {
#if SEXP_USE_PACKED_STRINGS #if SEXP_USE_PACKED_STRINGS
@ -451,15 +457,15 @@ struct sexp_struct {
char data SEXP_FLEXIBLE_ARRAY; char data SEXP_FLEXIBLE_ARRAY;
} symbol; } symbol;
struct { struct {
sexp name;
sexp cookie;
sexp fd;
FILE *stream; FILE *stream;
char *buf; char *buf;
char openp, bidirp, binaryp, shutdownp, no_closep, sourcep, char openp, bidirp, binaryp, shutdownp, no_closep, sourcep,
blockedp, fold_casep; blockedp, fold_casep;
sexp_uint_t offset, line, flags; sexp_uint_t offset, line, flags;
size_t size; size_t size;
sexp name;
sexp cookie;
sexp fd;
} port; } port;
struct { struct {
char openp, no_closep; char openp, no_closep;
@ -480,9 +486,9 @@ struct sexp_struct {
sexp real, imag; sexp real, imag;
} complex; } complex;
struct { struct {
sexp parent;
sexp_uint_t length; sexp_uint_t length;
void *value; void *value;
sexp parent;
char body SEXP_FLEXIBLE_ARRAY; char body SEXP_FLEXIBLE_ARRAY;
} cpointer; } cpointer;
/* runtime types */ /* runtime types */
@ -493,14 +499,14 @@ struct sexp_struct {
#endif #endif
} env; } env;
struct { struct {
sexp_uint_t length, max_depth;
sexp name, literals, source; sexp name, literals, source;
sexp_uint_t length, max_depth;
unsigned char data SEXP_FLEXIBLE_ARRAY; unsigned char data SEXP_FLEXIBLE_ARRAY;
} bytecode; } bytecode;
struct { struct {
sexp bc, vars;
char flags; char flags;
sexp_proc_num_args_t num_args; sexp_proc_num_args_t num_args;
sexp bc, vars;
} procedure; } procedure;
struct { struct {
sexp proc, env, source, aux; sexp proc, env, source, aux;
@ -572,8 +578,8 @@ struct sexp_struct {
} context; } context;
#if SEXP_USE_STABLE_ABI || SEXP_USE_AUTO_FORCE #if SEXP_USE_STABLE_ABI || SEXP_USE_AUTO_FORCE
struct { struct {
int donep;
sexp value; sexp value;
int donep;
} promise; } promise;
#endif #endif
#if SEXP_USE_STABLE_ABI || SEXP_USE_WEAK_REFERENCES #if SEXP_USE_STABLE_ABI || SEXP_USE_WEAK_REFERENCES

6
lib/srfi/160/test.sld
View file

@ -1,5 +1,7 @@
(define-library (srfi 160 test) (define-library (srfi 160 test)
(import (scheme base) (srfi 160 u32) (chibi test)) (import (scheme base)
(srfi 160 u32) (srfi 160 u64) (srfi 160 s64)
(chibi test))
(export run-tests) (export run-tests)
(begin (begin
(define (run-tests) (define (run-tests)
@ -19,6 +21,8 @@
(test '#u32(1 2 3 4) (u32vector-reverse-copy '#u32(5 4 3 2 1 0) 1 5)) (test '#u32(1 2 3 4) (u32vector-reverse-copy '#u32(5 4 3 2 1 0) 1 5))
(test '#u32(0 1) (u32vector-append '#u32(0) '#u32(1))) (test '#u32(0 1) (u32vector-append '#u32(0) '#u32(1)))
(test '#u32(0 1 2 3) (u32vector-append '#u32(0) '#u32(1 2 3))) (test '#u32(0 1 2 3) (u32vector-append '#u32(0) '#u32(1 2 3)))
(test '#u64(0 1 2 3) (u64vector-append '#u64(0) '#u64(1 2 3)))
(test '#s64(0 -1 2 -3) (s64vector-append '#s64(0) '#s64(-1 2 -3)))
(test '#u32(0 1 2 3) (u32vector-concatenate '(#u32(0 1) #u32(2 3)))) (test '#u32(0 1 2 3) (u32vector-concatenate '(#u32(0 1) #u32(2 3))))
(test '#u32(0 1 6 7) (test '#u32(0 1 6 7)
(u32vector-append-subvectors '#u32(0 1 2 3 4) 0 2 '#u32(4 5 6 7 8) 2 4)) (u32vector-append-subvectors '#u32(0 1 2 3 4) 0 2 '#u32(4 5 6 7 8) 2 4))

122
lib/srfi/160/u64.sld
View file

@ -1,70 +1,70 @@
(define-library (srfi 160 s64) (define-library (srfi 160 u64)
(export (export
make-s64vector make-u64vector
s64? u64?
s64vector? u64vector?
s64vector-ref u64vector-ref
s64vector-set! u64vector-set!
s64vector-length u64vector-length
(rename vector s64vector) (rename vector u64vector)
(rename uvector-unfold s64vector-unfold) (rename uvector-unfold u64vector-unfold)
(rename uvector-unfold-right s64vector-unfold-right) (rename uvector-unfold-right u64vector-unfold-right)
(rename vector-copy s64vector-copy) (rename vector-copy u64vector-copy)
(rename vector-reverse-copy s64vector-reverse-copy) (rename vector-reverse-copy u64vector-reverse-copy)
(rename vector-append s64vector-append) (rename vector-append u64vector-append)
(rename vector-concatenate s64vector-concatenate) (rename vector-concatenate u64vector-concatenate)
(rename vector-append-subvectors s64vector-append-subvectors) (rename vector-append-subvectors u64vector-append-subvectors)
(rename vector-empty? s64vector-empty?) (rename vector-empty? u64vector-empty?)
(rename vector= s64vector=) (rename vector= u64vector=)
(rename vector-take s64vector-take) (rename vector-take u64vector-take)
(rename vector-take-right s64vector-take-right) (rename vector-take-right u64vector-take-right)
(rename vector-drop s64vector-drop) (rename vector-drop u64vector-drop)
(rename vector-drop-right s64vector-drop-right) (rename vector-drop-right u64vector-drop-right)
(rename vector-segment s64vector-segment) (rename vector-segment u64vector-segment)
(rename vector-fold s64vector-fold) (rename vector-fold u64vector-fold)
(rename vector-fold-right s64vector-fold-right) (rename vector-fold-right u64vector-fold-right)
(rename vector-map s64vector-map) (rename vector-map u64vector-map)
(rename vector-map! s64vector-map!) (rename vector-map! u64vector-map!)
(rename vector-for-each s64vector-for-each) (rename vector-for-each u64vector-for-each)
(rename vector-count s64vector-count) (rename vector-count u64vector-count)
(rename vector-cumulate s64vector-cumulate) (rename vector-cumulate u64vector-cumulate)
(rename vector-take-while s64vector-take-while) (rename vector-take-while u64vector-take-while)
(rename vector-take-while-right s64vector-take-while-right) (rename vector-take-while-right u64vector-take-while-right)
(rename vector-drop-while s64vector-drop-while) (rename vector-drop-while u64vector-drop-while)
(rename vector-drop-while-right s64vector-drop-while-right) (rename vector-drop-while-right u64vector-drop-while-right)
(rename vector-index s64vector-index) (rename vector-index u64vector-index)
(rename vector-index-right s64vector-index-right) (rename vector-index-right u64vector-index-right)
(rename vector-skip s64vector-skip) (rename vector-skip u64vector-skip)
(rename vector-skip-right s64vector-skip-right) (rename vector-skip-right u64vector-skip-right)
(rename vector-binary-search s64vector-binary-search) (rename vector-binary-search u64vector-binary-search)
(rename vector-any s64vector-any) (rename vector-any u64vector-any)
(rename vector-every s64vector-every) (rename vector-every u64vector-every)
(rename vector-partition s64vector-partition) (rename vector-partition u64vector-partition)
(rename vector-filter s64vector-filter) (rename vector-filter u64vector-filter)
(rename vector-remove s64vector-remove) (rename vector-remove u64vector-remove)
(rename vector-swap! s64vector-swap!) (rename vector-swap! u64vector-swap!)
(rename vector-fill! s64vector-fill!) (rename vector-fill! u64vector-fill!)
(rename vector-reverse! s64vector-reverse!) (rename vector-reverse! u64vector-reverse!)
(rename vector-copy! s64vector-copy!) (rename vector-copy! u64vector-copy!)
(rename vector-reverse-copy! s64vector-reverse-copy!) (rename vector-reverse-copy! u64vector-reverse-copy!)
(rename uvector->list s64vector->list) (rename uvector->list u64vector->list)
(rename reverse-vector->list reverse-s64vector->list) (rename reverse-vector->list reverse-u64vector->list)
(rename list->uvector list->s64vector) (rename list->uvector list->u64vector)
(rename reverse-list->vector reverse-list->s64vector) (rename reverse-list->vector reverse-list->u64vector)
(rename uvector->vector s64vector->vector) (rename uvector->vector u64vector->vector)
(rename vector->uvector vector->s64vector) (rename vector->uvector vector->u64vector)
(rename make-vector-generator make-s64vector-generator) (rename make-vector-generator make-u64vector-generator)
(rename write-vector write-s64vector)) (rename write-vector write-u64vector))
(import (except (scheme base) (import (except (scheme base)
vector-append vector-copy vector-copy! vector-append vector-copy vector-copy!
vector-map vector-for-each) vector-map vector-for-each)
(scheme write) (scheme write)
(srfi 160 base)) (srfi 160 base))
(begin (begin
(define uvector? s64vector?) (define uvector? u64vector?)
(define make-uvector make-s64vector) (define make-uvector make-u64vector)
(define uvector-length s64vector-length) (define uvector-length u64vector-length)
(define uvector-ref s64vector-ref) (define uvector-ref u64vector-ref)
(define uvector-set! s64vector-set!)) (define uvector-set! u64vector-set!))
(include "uvector.scm")) (include "uvector.scm"))

30
lib/srfi/160/uvprims.stub
View file

@ -1,4 +1,6 @@
(c-system-include "stdint.h")
(define-c-const int (define-c-const int
SEXP_U1 SEXP_U1
SEXP_S8 SEXP_S8
@ -47,31 +49,31 @@ void s16vector_set(short* uv, int i, short v) {
uv[i] = v; uv[i] = v;
} }
unsigned int u32vector_ref(unsigned int* uv, int i) { uint32_t u32vector_ref(uint32_t* uv, int i) {
return uv[i]; return uv[i];
} }
void u32vector_set(unsigned int* uv, int i, unsigned int v) { void u32vector_set(uint32_t* uv, int i, uint32_t v) {
uv[i] = v; uv[i] = v;
} }
int s32vector_ref(int* uv, int i) { int32_t s32vector_ref(int32_t* uv, int i) {
return uv[i]; return uv[i];
} }
void s32vector_set(int* uv, int i, int v) { void s32vector_set(int32_t* uv, int i, int32_t v) {
uv[i] = v; uv[i] = v;
} }
unsigned long u64vector_ref(unsigned long* uv, int i) { uint64_t u64vector_ref(uint64_t* uv, int i) {
return uv[i]; return uv[i];
} }
void u64vector_set(unsigned long* uv, int i, unsigned long v) { void u64vector_set(uint64_t* uv, int i, uint64_t v) {
uv[i] = v; uv[i] = v;
} }
long s64vector_ref(long* uv, int i) { int64_t s64vector_ref(int64_t* uv, int i) {
return uv[i]; return uv[i];
} }
void s64vector_set(long* uv, int i, long v) { void s64vector_set(int64_t* uv, int i, int64_t v) {
uv[i] = v; uv[i] = v;
} }
@ -148,14 +150,14 @@ void c128vector_set(sexp ctx, double* uv, int i, sexp v) {
(define-c unsigned-int u32vector-ref (u32vector int)) (define-c unsigned-int u32vector-ref (u32vector int))
(define-c void (u32vector-set! "u32vector_set") (u32vector int unsigned-int)) (define-c void (u32vector-set! "u32vector_set") (u32vector int unsigned-int))
(define-c int s32vector-ref (s32vector int)) (define-c int32_t s32vector-ref (s32vector int))
(define-c void (s32vector-set! "s32vector_set") (s32vector int int)) (define-c void (s32vector-set! "s32vector_set") (s32vector int int32_t))
(define-c unsigned-long u64vector-ref (u64vector int)) (define-c uint64_t u64vector-ref (u64vector int))
(define-c void (u64vector-set! "u64vector_set") (u64vector int unsigned-long)) (define-c void (u64vector-set! "u64vector_set") (u64vector int uint64_t))
(define-c long s64vector-ref (s64vector int)) (define-c int64_t s64vector-ref (s64vector int))
(define-c void (s64vector-set! "s64vector_set") (s64vector int long)) (define-c void (s64vector-set! "s64vector_set") (s64vector int int64_t))
(define-c float f32vector-ref (f32vector int)) (define-c float f32vector-ref (f32vector int))
(define-c void (f32vector-set! "f32vector_set") (f32vector int float)) (define-c void (f32vector-set! "f32vector_set") (f32vector int float))

64
sexp.c
View file

@ -153,10 +153,10 @@ sexp sexp_write_uvector(sexp ctx, sexp self, sexp_sint_t n, sexp obj, sexp write
case SEXP_S8: sexp_write(ctx, sexp_make_fixnum(((signed char*)str)[i]), out); break; case SEXP_S8: sexp_write(ctx, sexp_make_fixnum(((signed char*)str)[i]), out); break;
case SEXP_S16: sexp_write(ctx, sexp_make_fixnum(((signed short*)str)[i]), out); break; case SEXP_S16: sexp_write(ctx, sexp_make_fixnum(((signed short*)str)[i]), out); break;
case SEXP_U16: sexp_write(ctx, sexp_make_fixnum(((unsigned short*)str)[i]), out); break; case SEXP_U16: sexp_write(ctx, sexp_make_fixnum(((unsigned short*)str)[i]), out); break;
case SEXP_S32: sexp_write(ctx, tmp=sexp_make_integer(ctx, ((signed int*)str)[i]), out); break; case SEXP_S32: sexp_write(ctx, tmp=sexp_make_integer(ctx, ((int32_t*)str)[i]), out); break;
case SEXP_U32: sexp_write(ctx, tmp=sexp_make_unsigned_integer(ctx, ((unsigned int*)str)[i]), out); break; case SEXP_U32: sexp_write(ctx, tmp=sexp_make_unsigned_integer(ctx, ((uint32_t*)str)[i]), out); break;
case SEXP_S64: sexp_write(ctx, tmp=sexp_make_integer(ctx, ((signed int*)str)[i]), out); break; case SEXP_S64: sexp_write(ctx, tmp=sexp_make_integer(ctx, ((int64_t*)str)[i]), out); break;
case SEXP_U64: sexp_write(ctx, tmp=sexp_make_unsigned_integer(ctx, ((unsigned int*)str)[i]), out); break; case SEXP_U64: sexp_write(ctx, tmp=sexp_make_unsigned_integer(ctx, ((uint64_t*)str)[i]), out); break;
#if SEXP_USE_FLONUMS #if SEXP_USE_FLONUMS
case SEXP_F32: sexp_flonum_value_set(f, ((float*)str)[i]); sexp_write(ctx, f, out); break; case SEXP_F32: sexp_flonum_value_set(f, ((float*)str)[i]); sexp_write(ctx, f, out); break;
case SEXP_F64: sexp_flonum_value_set(f, ((double*)str)[i]); sexp_write(ctx, f, out); break; case SEXP_F64: sexp_flonum_value_set(f, ((double*)str)[i]); sexp_write(ctx, f, out); break;
@ -243,8 +243,8 @@ sexp sexp_finalize_dl (sexp ctx, sexp self, sexp_sint_t n, sexp dl) {
#if SEXP_USE_UNIFORM_VECTOR_LITERALS #if SEXP_USE_UNIFORM_VECTOR_LITERALS
sexp sexp_finalize_uvector (sexp ctx, sexp self, sexp_sint_t n, sexp obj) { sexp sexp_finalize_uvector (sexp ctx, sexp self, sexp_sint_t n, sexp obj) {
if (sexp_uvector_freep(obj)) /* if (sexp_uvector_freep(obj)) */
free(sexp_uvector_data(obj)); /* free(sexp_uvector_data(obj)); */
return SEXP_VOID; return SEXP_VOID;
} }
#endif #endif
@ -2998,8 +2998,9 @@ static int sexp_resolve_uniform_type(int c, sexp len) {
#endif #endif
sexp sexp_list_to_uvector_op(sexp ctx, sexp self, sexp_sint_t n, sexp etype, sexp ls) { sexp sexp_list_to_uvector_op(sexp ctx, sexp self, sexp_sint_t n, sexp etype, sexp ls) {
long et, i, min; long et, i;
unsigned long max; long long min;
unsigned long long max;
sexp ls2, tmp; sexp ls2, tmp;
sexp_assert_type(ctx, sexp_fixnump, SEXP_FIXNUM, etype); sexp_assert_type(ctx, sexp_fixnump, SEXP_FIXNUM, etype);
sexp_gc_var1(res); sexp_gc_var1(res);
@ -3010,12 +3011,13 @@ sexp sexp_list_to_uvector_op(sexp ctx, sexp self, sexp_sint_t n, sexp etype, sex
sexp_gc_preserve1(ctx, res); sexp_gc_preserve1(ctx, res);
et = sexp_unbox_fixnum(etype); et = sexp_unbox_fixnum(etype);
res = et == SEXP_U8 ? sexp_make_bytes(ctx, sexp_length(ctx, ls), SEXP_VOID) : sexp_make_uvector(ctx, etype, sexp_length(ctx, ls)); res = et == SEXP_U8 ? sexp_make_bytes(ctx, sexp_length(ctx, ls), SEXP_VOID) : sexp_make_uvector(ctx, etype, sexp_length(ctx, ls));
min = 0;
max = sexp_uvector_element_size(et) == 64 ? -1 :
(1uLL << sexp_uvector_element_size(et)) - 1;
if (sexp_uvector_prefix(et) == 's') { if (sexp_uvector_prefix(et) == 's') {
min = -(max/2) - 1; min = (-1LL << (sexp_uvector_element_size(et)-1));
max = (max/2); max = (1LL << (sexp_uvector_element_size(et)-1)) - 1LL;
} else {
min = 0;
max = sexp_uvector_element_size(et) == 64 ? -1 :
(1uLL << sexp_uvector_element_size(et)) - 1LL;
} }
for (ls2=ls; sexp_pairp(ls2); ls2=sexp_cdr(ls2)) { for (ls2=ls; sexp_pairp(ls2); ls2=sexp_cdr(ls2)) {
tmp = sexp_car(ls2); tmp = sexp_car(ls2);
@ -3023,14 +3025,18 @@ sexp sexp_list_to_uvector_op(sexp ctx, sexp self, sexp_sint_t n, sexp etype, sex
#if SEXP_USE_UNIFORM_VECTOR_LITERALS #if SEXP_USE_UNIFORM_VECTOR_LITERALS
((sexp_uvector_prefix(et) == 'u') || (sexp_uvector_prefix(et) == 's')) ? ((sexp_uvector_prefix(et) == 'u') || (sexp_uvector_prefix(et) == 's')) ?
#endif #endif
!(sexp_fixnump(tmp) && sexp_unbox_fixnum(tmp) >= min !(sexp_exact_integerp(tmp) && sexp_sint_value(tmp) >= min
&& sexp_unbox_fixnum(tmp) <= max) && (sexp_sint_value(tmp) < 0 || sexp_uint_value(tmp) <= max))
#if SEXP_USE_UNIFORM_VECTOR_LITERALS #if SEXP_USE_UNIFORM_VECTOR_LITERALS
: (sexp_uvector_prefix(et) == 'c') ? !sexp_numberp(tmp) : : ((sexp_uvector_prefix(et) == 'c') ? !sexp_numberp(tmp) :
!(sexp_exact_integerp(tmp) || sexp_realp(tmp)) !(sexp_exact_integerp(tmp) || sexp_realp(tmp)))
#endif #endif
) { ) {
res = sexp_xtype_exception(ctx, self, "invalid uniform vector value", tmp); res = sexp_cons(ctx, SEXP_FALSE, SEXP_FALSE);
sexp_car(res) = sexp_make_integer(ctx, min);
sexp_cdr(res) = sexp_make_integer(ctx, max);
res = sexp_list2(ctx, res, tmp);
res = sexp_xtype_exception(ctx, self, "invalid uniform vector value", res);
break; break;
} }
} }
@ -3052,25 +3058,13 @@ sexp sexp_list_to_uvector_op(sexp ctx, sexp self, sexp_sint_t n, sexp etype, sex
case SEXP_U16: case SEXP_U16:
((unsigned short*)sexp_uvector_data(res))[i] = sexp_unbox_fixnum(sexp_car(ls)); break; ((unsigned short*)sexp_uvector_data(res))[i] = sexp_unbox_fixnum(sexp_car(ls)); break;
case SEXP_S32: case SEXP_S32:
((signed int*)sexp_uvector_data(res))[i] = sexp_unbox_fixnum(sexp_car(ls)); break; ((signed int*)sexp_uvector_data(res))[i] = sexp_sint_value(sexp_car(ls)); break;
case SEXP_U32: case SEXP_U32:
((unsigned int*)sexp_uvector_data(res))[i] = sexp_unbox_fixnum(sexp_car(ls)); break; ((unsigned int*)sexp_uvector_data(res))[i] = sexp_uint_value(sexp_car(ls)); break;
case SEXP_S64: case SEXP_S64:
#if SEXP_USE_BIGNUMS ((sexp_sint_t*)sexp_uvector_data(res))[i] = sexp_sint_value(sexp_car(ls)); break;
if (sexp_bignump(sexp_car(ls)))
((sexp_sint_t*)sexp_uvector_data(res))[i] = sexp_bignum_data(sexp_car(ls))[0] * sexp_bignum_sign(sexp_car(ls));
else
#endif
((sexp_sint_t*)sexp_uvector_data(res))[i] = sexp_unbox_fixnum(sexp_car(ls));
break;
case SEXP_U64: case SEXP_U64:
#if SEXP_USE_BIGNUMS ((sexp_uint_t*)sexp_uvector_data(res))[i] = sexp_uint_value(sexp_car(ls)); break;
if (sexp_bignump(sexp_car(ls)))
((sexp_uint_t*)sexp_uvector_data(res))[i] = sexp_bignum_data(sexp_car(ls))[0];
else
#endif
((sexp_uint_t*)sexp_uvector_data(res))[i] = sexp_unbox_fixnum(sexp_car(ls));
break;
#if SEXP_USE_FLONUMS #if SEXP_USE_FLONUMS
case SEXP_F32: case SEXP_F32:
((float*)sexp_uvector_data(res))[i] = sexp_to_double(ctx, sexp_car(ls)); break; ((float*)sexp_uvector_data(res))[i] = sexp_to_double(ctx, sexp_car(ls)); break;
@ -3095,8 +3089,8 @@ sexp sexp_list_to_uvector_op(sexp ctx, sexp self, sexp_sint_t n, sexp etype, sex
#endif /* SEXP_USE_UNIFORM_VECTOR_LITERALS */ #endif /* SEXP_USE_UNIFORM_VECTOR_LITERALS */
} }
} }
sexp_gc_release1(ctx);
} }
sexp_gc_release1(ctx);
return res; return res;
} }

12
tools/chibi-ffi
View file

@ -214,13 +214,15 @@
(assq type *c-enum-types*)) (assq type *c-enum-types*))
(define (signed-int-type? type) (define (signed-int-type? type)
(or (memq type '(signed-char short int long s8 s16 s32 s64)) (or (memq type '(signed-char short int long s8 s16 s32 s64
int8_t int16_t int32_t int64_t))
(memq type *c-int-types*) (memq type *c-int-types*)
(enum-type? type))) (enum-type? type)))
(define (unsigned-int-type? type) (define (unsigned-int-type? type)
(memq type '(unsigned-char unsigned-short unsigned unsigned-int unsigned-long (memq type '(unsigned-char unsigned-short unsigned unsigned-int unsigned-long
size_t off_t time_t clock_t dev_t ino_t mode_t nlink_t size_t off_t time_t clock_t dev_t ino_t mode_t nlink_t
uint8_t uint16_t uint32_t uint64_t
uid_t gid_t pid_t blksize_t blkcnt_t sigval_t uid_t gid_t pid_t blksize_t blkcnt_t sigval_t
u1 u8 u16 u32 u64))) u1 u8 u16 u32 u64)))
@ -290,10 +292,10 @@
((s8vector) "signed char*") ((s8vector) "signed char*")
((u16vector) "unsigned short*") ((u16vector) "unsigned short*")
((s16vector) "signed short*") ((s16vector) "signed short*")
((u32vector) "unsigned int*") ((u32vector) "uint32_t*")
((s32vector) "signed int*") ((s32vector) "int32_t*")
((u64vector) "sexp_uint_t*") ((u64vector) "uint64_t*")
((s64vector) "sexp_sint_t*") ((s64vector) "int64_t*")
((f32vector) "float*") ((f32vector) "float*")
((f64vector) "double*") ((f64vector) "double*")
((c64vector) "float*") ((c64vector) "float*")