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

uvector fixes

Browse source
This commit is contained in:
Alex Shinn 2019-02-25 23:01:35 +08:00
parent 7b3413ec1a
commit a94a2c7902
4 changed files with 30 additions and 44 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
include/chibi/sexp.h
View file

@ -432,9 +432,8 @@ struct sexp_struct {
} bytes;
struct {
unsigned char element_type;
sexp_uint_t length;
sexp_sint_t length;
sexp bytes;
unsigned char* data;
} uvector;
struct {
#if SEXP_USE_PACKED_STRINGS
@ -1118,7 +1117,7 @@ enum sexp_uniform_vector_type {
#define sexp_uvector_length(x) (sexp_field(x, uvector, SEXP_UNIFORM_VECTOR, length))
#define sexp_uvector_type(x) (sexp_field(x, uvector, SEXP_UNIFORM_VECTOR, element_type))
#define sexp_uvector_data(x) (sexp_field(x, uvector, SEXP_UNIFORM_VECTOR, data))
#define sexp_uvector_data(x) sexp_bytes_data(sexp_uvector_bytes(x))
#define sexp_uvector_maybe_null_data(x) (sexp_not(x) ? NULL : sexp_uvector_data(x))
#define sexp_uvector_bytes(x) (sexp_field(x, uvector, SEXP_UNIFORM_VECTOR, bytes))

24
lib/srfi/160/base.sld
View file

@ -119,19 +119,19 @@
(define (f64vector . ls) (list->f64vector ls))
(define (c64vector . ls) (list->c64vector ls))
(define (c128vector . ls) (list->c128vector ls))
(define (make-u1vector len) (make-u1vector SEXP_U1 len))
(define (make-u1vector len) (make-uvector SEXP_U1 len))
(define make-u8vector make-bytevector)
(define (make-s8vector len) (make-s8vector SEXP_S8 len))
(define (make-u16vector len) (make-u16vector SEXP_U16 len))
(define (make-s16vector len) (make-s16vector SEXP_S16 len))
(define (make-u32vector len) (make-u32vector SEXP_U32 len))
(define (make-s32vector len) (make-s32vector SEXP_S32 len))
(define (make-u64vector len) (make-u64vector SEXP_U64 len))
(define (make-s64vector len) (make-s64vector SEXP_S64 len))
(define (make-f32vector len) (make-f32vector SEXP_F32 len))
(define (make-f64vector len) (make-f64vector SEXP_F64 len))
(define (make-c64vector len) (make-c64vector SEXP_C64 len))
(define (make-c128vector len) (make-c128vector SEXP_C128 len))
(define (make-s8vector len) (make-uvector SEXP_S8 len))
(define (make-u16vector len) (make-uvector SEXP_U16 len))
(define (make-s16vector len) (make-uvector SEXP_S16 len))
(define (make-u32vector len) (make-uvector SEXP_U32 len))
(define (make-s32vector len) (make-uvector SEXP_S32 len))
(define (make-u64vector len) (make-uvector SEXP_U64 len))
(define (make-s64vector len) (make-uvector SEXP_S64 len))
(define (make-f32vector len) (make-uvector SEXP_F32 len))
(define (make-f64vector len) (make-uvector SEXP_F64 len))
(define (make-c64vector len) (make-uvector SEXP_C64 len))
(define (make-c128vector len) (make-uvector SEXP_C128 len))
(define-syntax define-uvector->list
(syntax-rules ()
((define-uvector->list uv->list len ref)

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

@ -118,20 +118,20 @@ void c128vector_set(double* uv, int i, sexp v) {
}
")
(define-c int (uvector-length "sexp_uvector_length") (uvector))
(define-c long (uvector-length "sexp_uvector_length") (sexp))
(define-c int (u1vector? "uvector_of") (uvector (value SEXP_U1 int)))
(define-c int (s8vector? "uvector_of") (uvector (value SEXP_S8 int)))
(define-c int (u16vector? "uvector_of") (uvector (value SEXP_U16 int)))
(define-c int (s16vector? "uvector_of") (uvector (value SEXP_S16 int)))
(define-c int (u32vector? "uvector_of") (uvector (value SEXP_U32 int)))
(define-c int (s32vector? "uvector_of") (uvector (value SEXP_S32 int)))
(define-c int (u64vector? "uvector_of") (uvector (value SEXP_U64 int)))
(define-c int (s64vector? "uvector_of") (uvector (value SEXP_S64 int)))
(define-c int (f32vector? "uvector_of") (uvector (value SEXP_F32 int)))
(define-c int (f64vector? "uvector_of") (uvector (value SEXP_F64 int)))
(define-c int (c64vector? "uvector_of") (uvector (value SEXP_C64 int)))
(define-c int (c128vector? "uvector_of") (uvector (value SEXP_C128 int)))
(define-c boolean (u1vector? "uvector_of") (sexp (value SEXP_U1 int)))
(define-c boolean (s8vector? "uvector_of") (sexp (value SEXP_S8 int)))
(define-c boolean (u16vector? "uvector_of") (sexp (value SEXP_U16 int)))
(define-c boolean (s16vector? "uvector_of") (sexp (value SEXP_S16 int)))
(define-c boolean (u32vector? "uvector_of") (sexp (value SEXP_U32 int)))
(define-c boolean (s32vector? "uvector_of") (sexp (value SEXP_S32 int)))
(define-c boolean (u64vector? "uvector_of") (sexp (value SEXP_U64 int)))
(define-c boolean (s64vector? "uvector_of") (sexp (value SEXP_S64 int)))
(define-c boolean (f32vector? "uvector_of") (sexp (value SEXP_F32 int)))
(define-c boolean (f64vector? "uvector_of") (sexp (value SEXP_F64 int)))
(define-c boolean (c64vector? "uvector_of") (sexp (value SEXP_C64 int)))
(define-c boolean (c128vector? "uvector_of") (sexp (value SEXP_C128 int)))
(define-c int u1vector-ref (sexp int))
(define-c void (u1vector-set! "u1vector_set") (sexp int int))

19
sexp.c
View file

@ -1108,10 +1108,10 @@ sexp sexp_make_bytes_op (sexp ctx, sexp self, sexp_sint_t n, sexp len, sexp i) {
#if SEXP_USE_UNIFORM_VECTOR_LITERALS
sexp sexp_make_uvector_op(sexp ctx, sexp self, sexp_sint_t n, sexp elt_type, sexp len) {
sexp_uint_t etype = sexp_unbox_fixnum(elt_type), elen = sexp_unbox_fixnum(len), clen;
sexp_sint_t etype = sexp_unbox_fixnum(elt_type), elen = sexp_unbox_fixnum(len), clen;
sexp_gc_var1(res);
if (etype == SEXP_U8)
return sexp_make_bytes(ctx, len, SEXP_VOID);
return sexp_make_bytes(ctx, len, SEXP_ZERO);
sexp_assert_type(ctx, sexp_fixnump, SEXP_FIXNUM, elt_type);
sexp_assert_type(ctx, sexp_fixnump, SEXP_FIXNUM, len);
if (etype < SEXP_U1 || etype > SEXP_C128)
@ -1124,26 +1124,13 @@ sexp sexp_make_uvector_op(sexp ctx, sexp self, sexp_sint_t n, sexp elt_type, sex
clen = ((elen * sexp_uvector_element_size(etype)) + 7) / 8;
sexp_uvector_type(res) = etype;
sexp_uvector_length(res) = elen;
sexp_uvector_bytes(res) = sexp_make_bytes(ctx, sexp_make_fixnum(clen), SEXP_VOID);
sexp_uvector_bytes(res) = sexp_make_bytes(ctx, sexp_make_fixnum(clen), SEXP_ZERO);
if (sexp_exceptionp(sexp_uvector_bytes(res)))
res = sexp_uvector_bytes(res);
else
sexp_uvector_data(res) = (unsigned char*) sexp_bytes_data(sexp_uvector_bytes(res));
}
sexp_gc_release1(ctx);
return res;
}
sexp sexp_make_cuvector(sexp ctx, sexp_uint_t etype, void* cptr, int freep) {
sexp res = sexp_alloc_type(ctx, uvector, SEXP_UNIFORM_VECTOR);
if (!sexp_exceptionp(res)) {
sexp_uvector_type(res) = etype;
sexp_uvector_length(res) = -1;
sexp_uvector_data(res) = cptr;
sexp_uvector_freep(res) = freep;
}
return res;
}
#endif
#if SEXP_USE_UTF8_STRINGS