#include "inc/priv.h"#include "inc/operators.h"#include "inc/cvalues.h"#include "inc/types.h"#include "inc/io.h"#include "inc/equal.h" enum { MAX_INL_SIZE = 384, CVALUE_NWORDS_STR = sizeof(sl_cv)/sizeof(sl_v), CVALUE_NWORDS = sl_offsetof(sl_cv, _space)/sizeof(sl_v), CV_OWNED = 1<<0,}; #define owned(cv) ((uintptr)(cv)->type & CV_OWNED) const sl_type *unboxedtypes[T_UNBOXED_NUM];sl_v unboxedtypesyms[T_UNBOXED_NUM];static const sl_type notype;static sl_v specialsym, unboxedsym, cvaluesym; voidadd_finalizer(sl_cv *cv){ if(sl_unlikely(slvm.nfinalizers == slvm.maxfinalizers)){ sl_cv **nf = MEM_REALLOC(slvm.finalizers, 2*slvm.maxfinalizers*sizeof(slvm.finalizers)); if(sl_unlikely(nf == nil)) cthrow(error(sl_errmem, "no memory for a finalizer"), cv); slvm.finalizers = nf; slvm.maxfinalizers *= 2; } slvm.finalizers[slvm.nfinalizers++] = cv;} voidsweep_cv(sl_cv *cv){ const sl_type *t = cv_class(cv); if(t->vtable != nil) t->vtable->finalize(tagptr(cv, TAG_CVALUE)); if(!isinlined(cv) && owned(cv)) MEM_FREE(cv_data(cv)); cv->type = ¬ype;} // remove dead objects from finalization list in-placevoidsweep_finalizers(void){ sl_cv **lst = slvm.finalizers; usize n = 0, ndel = 0, l = slvm.nfinalizers; sl_cv *tmp;#define SWAP_sf(a, b) (tmp = a, a = b, b = tmp, 1) if(sl_unlikely(l == 0)) return; do{ tmp = lst[n]; if(isforwarded((sl_v)tmp)){ // object is alive lst[n] = ptr(sl_cv, forwardloc((sl_v)tmp)); n++; }else{ sweep_cv(tmp); ndel++; } }while((n < l-ndel) && SWAP_sf(lst[n], lst[n+ndel])); slvm.nfinalizers -= ndel; slvm.malloc_pressure = 0;} // compute the size of the metadata object for a cvaluesl_nonnull(1)static usizecv_nwords(sl_cv *cv){ if(!isinlined(cv)) return cv_isstr(cv) ? CVALUE_NWORDS_STR : CVALUE_NWORDS; usize n = cv_len(cv); if(cv_isstr(cv)) n++; return CVALUE_NWORDS + NWORDS(n);} sl_nonnull(1)voidcv_autorelease(sl_cv *cv){ cv->type = (const sl_type*)(((uintptr)cv->type) | CV_OWNED); add_finalizer(cv);} voidcvalue_cutdown(sl_v cv, usize nb){ sl_cv *pcv = ptr(sl_cv, cv); bool isstr = cv_isstr(pcv); assert(nb <= pcv->len); if(!isinlined(pcv)){ void *data = MEM_REALLOC(pcv->data, nb+(isstr ? 1 : 0)); if(data != nil) // oh well, that's alright pcv->data = data; } pcv->len = nb; if(isstr) ((char*)pcv->data)[nb] = 0;} sl_vcvalue_(const sl_type *type, usize sz, bool nofinalize){ assert(type != nil); bool str = false; if(type->eltype == sl_utf8type){ if(sz == 0) return sl_emptystr; sz++; str = true; } sl_cv *pcv; if(sz <= MAX_INL_SIZE){ usize nw = CVALUE_NWORDS + NWORDS(sz); pcv = alloc_words(nw); pcv->type = type; pcv->data = cv_space(pcv); if(!nofinalize && type->vtable != nil) add_finalizer(pcv); }else{ if(slvm.malloc_pressure > ALLOC_LIMIT_TRIGGER) sl_gc(false); void *data = MEM_ALLOC(sz); if(sl_unlikely(data == nil)) cthrow(error(sl_errmem, "no memory for a cv"), type); slvm.malloc_pressure += sz; pcv = alloc_words(str ? CVALUE_NWORDS_STR : CVALUE_NWORDS); pcv->type = type; pcv->data = data; cv_autorelease(pcv); } if(str){ ((char*)pcv->data)[--sz] = '\0'; if(!isinlined(pcv)){ pcv->startbytes = 0; pcv->startrune = 0; } } pcv->len = sz; return tagptr(pcv, TAG_CVALUE);} // this effectively dereferences a pointer// just like *p in C, it only removes a level of indirection from the type,// it doesn't copy any data.// this method of creating a cvalue only allocates metadata.// ptr is user-managed; we don't autorelease it unless the// user explicitly calls (autorelease ) on the result of this function.// 'parent' is an optional cvalue that this pointer is known to point// into; NIL if none.sl_vcvalue_from_ref(const sl_type *type, void *ptr, usize sz){ sl_cv *pcv; assert(type != nil); assert(ptr != nil); pcv = alloc_words(type == sl_strtype ? CVALUE_NWORDS_STR : CVALUE_NWORDS); pcv->data = ptr; pcv->len = sz; pcv->type = type; pcv->startbytes = 0; pcv->startrune = 0; return tagptr(pcv, TAG_CVALUE);} sl_vcvalue_str(usize sz){ if(sz == 0) return sl_emptystr; return cvalue(sl_strtype, sz);} sl_vcvalue_static_cstr(const char *str){ if(sl_unlikely(*str == 0)) return sl_emptystr; return cvalue_from_ref(sl_strtype, (char*)str, strlen(str));} sl_vstr_from_cstr(const char *str){ usize n = strlen(str); sl_v v = cvalue_str(n); memcpy(cvalue_data(v), str, n); return v;} boolisstr(sl_v v){ return iscvalue(v) && cv_isstr(ptr(sl_cv, v));} // convert to malloc representation (fixed address)voidcv_pin(sl_cv *cv){ if(!isinlined(cv)) return; usize sz = cv_len(cv); if(cv_isstr(cv)) sz++; void *data = MEM_ALLOC(sz); if(sl_unlikely(data == nil)) cthrow(error(sl_errmem, "no memory to pin a cv"), cv); slvm.malloc_pressure += sz; memcpy(data, cv_data(cv), sz); cv->data = data; cv_autorelease(cv);} sl_nonnull(1, 3)static voidcvalue_rune_init(const sl_type *type, sl_v a, void *dest){ Rune r; USED(type); if(isfixnum(a)) r = numval(a); else if(sl_isrune(a)) r = torune(a); else if(iscvalue(a)) r = conv_to_u32(a, cvalue_data(a), cvalue_numtype(a)); else if(isubnum(a)){ sl_fx v = ubnumval(a); sl_numtype nt = ubnumtype(a);#if !defined(BITS64) if(nt > T_P32) nt -= T_P64-T_P32;#endif r = conv_to_u32(a, ubnumptr(v, nt), nt); }else cthrow(type_error(nil, "num", a), type); if(sl_unlikely(r >= 0xd800 && r <= 0xdfff)) cthrow(error(sl_errarg, "invalid rune: utf-16 surrogate pair: #x%"PRIx32, (u32int)r), type); if(sl_unlikely(r > Runemax)) cthrow(error(sl_errarg, "invalid rune: outside of valid range: #x%"PRIx32, (u32int)r), type); *((Rune*)dest) = r;} #define num_init(ctype, cnvt, tag) \ sl_nonnull(1, 3) \ static void \ cvalue_##ctype##_init(const sl_type *type, sl_v a, void *dest) \ { \ ctype n; \ USED(type); \ if(isfixnum(a)){ \ n = (ctype)numval(a); \ }else if(isubnum(a)){ \ sl_fx v = ubnumval(a); \ sl_numtype nt = ubnumtype(a); \ if(sizeof(sl_fx) < sizeof(u64int) && nt > T_P32) \ nt -= T_P64-T_P32; \ n = (ctype)conv_to_##cnvt(a, ubnumptr(v, nt), nt); \ }else if(iscvalue(a)){ \ n = (ctype)conv_to_##cnvt(a, cvalue_data(a), cvalue_numtype(a)); \ }else \ cthrow(type_error(nil, "num", a), type); \ *((ctype*)dest) = n; \ } typedef u32int u32ptr;typedef u64int u64ptr;typedef float f32;typedef double f64; num_init(s8int, s32, T_S8)num_init(u8int, u32, T_U8)num_init(s16int, s32, T_S16)num_init(u16int, u32, T_U16)num_init(s32int, s32, T_S32)num_init(u32int, u32, T_U32)num_init(s64int, s64, T_S64)num_init(u64int, u64, T_U64)num_init(u32ptr, p32, T_P32)num_init(u64ptr, p64, T_P64)num_init(f32, double, T_F32)num_init(f64, double, T_F64) BUILTIN("rune", rune){ argcount_most(1); if(nargs == 0){ PUSH(fixnum(Runeerror)); args = sl.sp-1; } Rune r; cvalue_rune_init(sl_runetype, args[0], &r); return mk_rune(r);} #define num_ctor_init(typenam, ctype, tag) \ static \ BUILTIN(#typenam, typenam) \ { \ argcount_most(1); \ if(sl_unlikely(nargs == 0)){ \ PUSH(fixnum(0)); \ args = sl.sp-1; \ } \ sl_v v = cvalue(sl_##typenam##type, sizeof(ctype)); \ cvalue_##ctype##_init(sl_##typenam##type, args[0], cvalue_data(v)); \ return v; \ } #define num_ctor_init_unboxed(typenam, ctype, tag, issigned) \ static \ BUILTIN(#typenam, typenam) \ { \ argcount_most(1); \ if(sl_unlikely(nargs == 0)){ \ PUSH(fixnum(0)); \ args = sl.sp-1; \ } \ sl_v v; \ ctype n; \ cvalue_##ctype##_init(sl_##typenam##type, args[0], &n); \ if(tag < T_UNBOXED_NUM && \ (sizeof(n) < sizeof(sl_fx) || fits_bits(n, UNBOXED_BITS-issigned))){ \ v = (sl_v)n<<TAG_EXT_BITS | tag<<TAG_UBNUM_SHIFT | TAG_UNBOXED; \ }else{ \ v = cvalue(sl_##typenam##type, sizeof(n)); \ *(ctype*)cvalue_data(v) = n; \ } \ return v; \ } #define num_ctor_ctor(typenam, ctype, tag) \ sl_v \ mk_##typenam(ctype n) \ { \ sl_v v = cvalue(sl_##typenam##type, sizeof(n)); \ *(ctype*)cvalue_data(v) = n; \ return v; \ } #define num_ctor_ctor_unboxed(typenam, ctype, tag, issigned) \ sl_v \ mk_##typenam(ctype n) \ { \ sl_v v; \ if(tag < T_UNBOXED_NUM && \ (sizeof(n) < sizeof(sl_fx) || fits_bits(n, UNBOXED_BITS-issigned))){ \ v = (sl_v)n<<TAG_EXT_BITS | tag<<TAG_UBNUM_SHIFT | TAG_UNBOXED; \ }else{ \ v = cvalue(sl_##typenam##type, sizeof(n)); \ *(ctype*)cvalue_data(v) = n; \ } \ return v; \ } #define num_ctor(typenam, ctype, tag) \ num_ctor_ctor(typenam, ctype, tag) \ num_ctor_init(typenam, ctype, tag) \ #define num_ctor_unboxed(typenam, ctype, tag, issigned) \ num_ctor_ctor_unboxed(typenam, ctype, tag, issigned) \ num_ctor_init_unboxed(typenam, ctype, tag, issigned) \ #if defined(BITS64)#define sl_constfn64 sl_constfn#else#define sl_constfn64#endif sl_constfn num_ctor_unboxed(s8, s8int, T_S8, 1)sl_constfn num_ctor_unboxed(u8, u8int, T_U8, 0)sl_constfn num_ctor_unboxed(s16, s16int, T_S16, 1)sl_constfn num_ctor_unboxed(u16, u16int, T_U16, 0)sl_constfn64 num_ctor_unboxed(s32, s32int, T_S32, 1)sl_constfn64 num_ctor_unboxed(u32, u32int, T_U32, 0)sl_constfn64 num_ctor_unboxed(p32, u32ptr, T_P32, 0)num_ctor_unboxed(s64, s64int, T_S64, 1)num_ctor_unboxed(u64, u64int, T_U64, 0)num_ctor_unboxed(p64, u64ptr, T_P64, 0)num_ctor(f32, f32, T_F32)num_ctor(f64, f64, T_F64) sl_nonnull(1, 3)static voidcvalue_bignum_init(const sl_type *type, sl_v a, void *dest){ mpint *n; USED(type); if(isfixnum(a)) n = vtomp(numval(a), nil); else if(isubnum(a)){ sl_fx v = ubnumval(a); sl_numtype nt = ubnumtype(a);#if !defined(BITS64) if(nt > T_P32) nt -= T_P64-T_P32;#endif n = conv_to_bignum(a, ubnumptr(v, nt), nt); }else if(iscvalue(a)){ sl_cv *cv = ptr(sl_cv, a); void *p = cv_data(cv); n = conv_to_bignum(a, p, cv_numtype(cv)); }else cthrow(type_error(nil, "num", a), type); *((mpint**)dest) = n;} BUILTIN("bignum", bignum){ argcount_most(1); if(nargs == 0){ PUSH(fixnum(0)); args = sl.sp-1; } mpint *m; cvalue_bignum_init(sl_bignumtype, args[0], &m); sl_v cv = cvalue(sl_bignumtype, sizeof(mpint*)); *((mpint**)cvalue_data(cv)) = m; return cv;} sl_vmk_bignum(mpint *n){ sl_v cv = cvalue(sl_bignumtype, sizeof(mpint*)); *(mpint**)cvalue_data(cv) = n; return cv;} static voidfree_bignum(sl_v self){ mpint **s = value2c(mpint**, self); if(*s != mpzero && *s != mpone && *s != mptwo) mpfree(*s);} static sl_cvtable bignum_vtable = { nil, nil, free_bignum, nil, nil }; sl_constfnsl_vsize_wrap(usize sz){ if(sizeof(usize) == 8) return fits_fixnum(sz) ? fixnum(sz): mk_u64(sz); return fits_fixnum(sz) ? fixnum(sz): mk_u32(sz);} u32inttou32(sl_v n){ if(iscvalue(n)){ sl_cv *cv = ptr(sl_cv, n); return conv_to_u32(n, cv_data(cv), cv_numtype(cv)); } if(isfixnum(n)) return numval(n); if(isubnum(n)) return ubnumval(n); cthrow(type_error(nil, "num", n), n);} u64inttou64(sl_v n){ if(iscvalue(n)){ sl_cv *cv = ptr(sl_cv, n); return conv_to_u64(n, cv_data(cv), cv_numtype(cv)); } if(isfixnum(n)) return numval(n); if(isubnum(n)) return ubnumval(n); cthrow(type_error(nil, "num", n), n);} usizetosize(sl_v n){ if(sl_unlikely(iscvalue(n))){ if(sl_likely(numeric_compare(n, fixnum(0), true) >= 0)){ sl_cv *cv = ptr(sl_cv, n); if(sizeof(usize) > 4) return conv_to_u64(n, cv_data(cv), cv_numtype(cv)); return conv_to_u32(n, cv_data(cv), cv_numtype(cv)); } }else{ sl_fx x; if(sl_likely(isfixnum(n)))Lines 1–500 of 1605. Load more
#include "inc/priv.h" #include "inc/operators.h" #include "inc/cvalues.h" #include "inc/types.h" #include "inc/io.h" #include "inc/equal.h" enum { MAX_INL_SIZE = 384, CVALUE_NWORDS_STR = sizeof(sl_cv)/sizeof(sl_v), CVALUE_NWORDS = sl_offsetof(sl_cv, _space)/sizeof(sl_v), CV_OWNED = 1<<0, }; #define owned(cv) ((uintptr)(cv)->type & CV_OWNED) const sl_type *unboxedtypes[T_UNBOXED_NUM]; sl_v unboxedtypesyms[T_UNBOXED_NUM]; static const sl_type notype; static sl_v specialsym, unboxedsym, cvaluesym; void add_finalizer(sl_cv *cv) { if(sl_unlikely(slvm.nfinalizers == slvm.maxfinalizers)){ sl_cv **nf = MEM_REALLOC(slvm.finalizers, 2*slvm.maxfinalizers*sizeof(slvm.finalizers)); if(sl_unlikely(nf == nil)) cthrow(error(sl_errmem, "no memory for a finalizer"), cv); slvm.finalizers = nf; slvm.maxfinalizers *= 2; } slvm.finalizers[slvm.nfinalizers++] = cv; } void sweep_cv(sl_cv *cv) { const sl_type *t = cv_class(cv); if(t->vtable != nil) t->vtable->finalize(tagptr(cv, TAG_CVALUE)); if(!isinlined(cv) && owned(cv)) MEM_FREE(cv_data(cv)); cv->type = ¬ype; } // remove dead objects from finalization list in-place void sweep_finalizers(void) { sl_cv **lst = slvm.finalizers; usize n = 0, ndel = 0, l = slvm.nfinalizers; sl_cv *tmp; #define SWAP_sf(a, b) (tmp = a, a = b, b = tmp, 1) if(sl_unlikely(l == 0)) return; do{ tmp = lst[n]; if(isforwarded((sl_v)tmp)){ // object is alive lst[n] = ptr(sl_cv, forwardloc((sl_v)tmp)); n++; }else{ sweep_cv(tmp); ndel++; } }while((n < l-ndel) && SWAP_sf(lst[n], lst[n+ndel])); slvm.nfinalizers -= ndel; slvm.malloc_pressure = 0; } // compute the size of the metadata object for a cvalue sl_nonnull(1) static usize cv_nwords(sl_cv *cv) { if(!isinlined(cv)) return cv_isstr(cv) ? CVALUE_NWORDS_STR : CVALUE_NWORDS; usize n = cv_len(cv); if(cv_isstr(cv)) n++; return CVALUE_NWORDS + NWORDS(n); } sl_nonnull(1) void cv_autorelease(sl_cv *cv) { cv->type = (const sl_type*)(((uintptr)cv->type) | CV_OWNED); add_finalizer(cv); } void cvalue_cutdown(sl_v cv, usize nb) { sl_cv *pcv = ptr(sl_cv, cv); bool isstr = cv_isstr(pcv); assert(nb <= pcv->len); if(!isinlined(pcv)){ void *data = MEM_REALLOC(pcv->data, nb+(isstr ? 1 : 0)); if(data != nil) // oh well, that's alright pcv->data = data; } pcv->len = nb; if(isstr) ((char*)pcv->data)[nb] = 0; } sl_v cvalue_(const sl_type *type, usize sz, bool nofinalize) { assert(type != nil); bool str = false; if(type->eltype == sl_utf8type){ if(sz == 0) return sl_emptystr; sz++; str = true; } sl_cv *pcv; if(sz <= MAX_INL_SIZE){ usize nw = CVALUE_NWORDS + NWORDS(sz); pcv = alloc_words(nw); pcv->type = type; pcv->data = cv_space(pcv); if(!nofinalize && type->vtable != nil) add_finalizer(pcv); }else{ if(slvm.malloc_pressure > ALLOC_LIMIT_TRIGGER) sl_gc(false); void *data = MEM_ALLOC(sz); if(sl_unlikely(data == nil)) cthrow(error(sl_errmem, "no memory for a cv"), type); slvm.malloc_pressure += sz; pcv = alloc_words(str ? CVALUE_NWORDS_STR : CVALUE_NWORDS); pcv->type = type; pcv->data = data; cv_autorelease(pcv); } if(str){ ((char*)pcv->data)[--sz] = '\0'; if(!isinlined(pcv)){ pcv->startbytes = 0; pcv->startrune = 0; } } pcv->len = sz; return tagptr(pcv, TAG_CVALUE); } // this effectively dereferences a pointer // just like *p in C, it only removes a level of indirection from the type, // it doesn't copy any data. // this method of creating a cvalue only allocates metadata. // ptr is user-managed; we don't autorelease it unless the // user explicitly calls (autorelease ) on the result of this function. // 'parent' is an optional cvalue that this pointer is known to point // into; NIL if none. sl_v cvalue_from_ref(const sl_type *type, void *ptr, usize sz) { sl_cv *pcv; assert(type != nil); assert(ptr != nil); pcv = alloc_words(type == sl_strtype ? CVALUE_NWORDS_STR : CVALUE_NWORDS); pcv->data = ptr; pcv->len = sz; pcv->type = type; pcv->startbytes = 0; pcv->startrune = 0; return tagptr(pcv, TAG_CVALUE); } sl_v cvalue_str(usize sz) { if(sz == 0) return sl_emptystr; return cvalue(sl_strtype, sz); } sl_v cvalue_static_cstr(const char *str) { if(sl_unlikely(*str == 0)) return sl_emptystr; return cvalue_from_ref(sl_strtype, (char*)str, strlen(str)); } sl_v str_from_cstr(const char *str) { usize n = strlen(str); sl_v v = cvalue_str(n); memcpy(cvalue_data(v), str, n); return v; } bool isstr(sl_v v) { return iscvalue(v) && cv_isstr(ptr(sl_cv, v)); } // convert to malloc representation (fixed address) void cv_pin(sl_cv *cv) { if(!isinlined(cv)) return; usize sz = cv_len(cv); if(cv_isstr(cv)) sz++; void *data = MEM_ALLOC(sz); if(sl_unlikely(data == nil)) cthrow(error(sl_errmem, "no memory to pin a cv"), cv); slvm.malloc_pressure += sz; memcpy(data, cv_data(cv), sz); cv->data = data; cv_autorelease(cv); } sl_nonnull(1, 3) static void cvalue_rune_init(const sl_type *type, sl_v a, void *dest) { Rune r; USED(type); if(isfixnum(a)) r = numval(a); else if(sl_isrune(a)) r = torune(a); else if(iscvalue(a)) r = conv_to_u32(a, cvalue_data(a), cvalue_numtype(a)); else if(isubnum(a)){ sl_fx v = ubnumval(a); sl_numtype nt = ubnumtype(a); #if !defined(BITS64) if(nt > T_P32) nt -= T_P64-T_P32; #endif r = conv_to_u32(a, ubnumptr(v, nt), nt); }else cthrow(type_error(nil, "num", a), type); if(sl_unlikely(r >= 0xd800 && r <= 0xdfff)) cthrow(error(sl_errarg, "invalid rune: utf-16 surrogate pair: #x%"PRIx32, (u32int)r), type); if(sl_unlikely(r > Runemax)) cthrow(error(sl_errarg, "invalid rune: outside of valid range: #x%"PRIx32, (u32int)r), type); *((Rune*)dest) = r; } #define num_init(ctype, cnvt, tag) \ sl_nonnull(1, 3) \ static void \ cvalue_##ctype##_init(const sl_type *type, sl_v a, void *dest) \ { \ ctype n; \ USED(type); \ if(isfixnum(a)){ \ n = (ctype)numval(a); \ }else if(isubnum(a)){ \ sl_fx v = ubnumval(a); \ sl_numtype nt = ubnumtype(a); \ if(sizeof(sl_fx) < sizeof(u64int) && nt > T_P32) \ nt -= T_P64-T_P32; \ n = (ctype)conv_to_##cnvt(a, ubnumptr(v, nt), nt); \ }else if(iscvalue(a)){ \ n = (ctype)conv_to_##cnvt(a, cvalue_data(a), cvalue_numtype(a)); \ }else \ cthrow(type_error(nil, "num", a), type); \ *((ctype*)dest) = n; \ } typedef u32int u32ptr; typedef u64int u64ptr; typedef float f32; typedef double f64; num_init(s8int, s32, T_S8) num_init(u8int, u32, T_U8) num_init(s16int, s32, T_S16) num_init(u16int, u32, T_U16) num_init(s32int, s32, T_S32) num_init(u32int, u32, T_U32) num_init(s64int, s64, T_S64) num_init(u64int, u64, T_U64) num_init(u32ptr, p32, T_P32) num_init(u64ptr, p64, T_P64) num_init(f32, double, T_F32) num_init(f64, double, T_F64) BUILTIN("rune", rune) { argcount_most(1); if(nargs == 0){ PUSH(fixnum(Runeerror)); args = sl.sp-1; } Rune r; cvalue_rune_init(sl_runetype, args[0], &r); return mk_rune(r); } #define num_ctor_init(typenam, ctype, tag) \ static \ BUILTIN(#typenam, typenam) \ { \ argcount_most(1); \ if(sl_unlikely(nargs == 0)){ \ PUSH(fixnum(0)); \ args = sl.sp-1; \ } \ sl_v v = cvalue(sl_##typenam##type, sizeof(ctype)); \ cvalue_##ctype##_init(sl_##typenam##type, args[0], cvalue_data(v)); \ return v; \ } #define num_ctor_init_unboxed(typenam, ctype, tag, issigned) \ static \ BUILTIN(#typenam, typenam) \ { \ argcount_most(1); \ if(sl_unlikely(nargs == 0)){ \ PUSH(fixnum(0)); \ args = sl.sp-1; \ } \ sl_v v; \ ctype n; \ cvalue_##ctype##_init(sl_##typenam##type, args[0], &n); \ if(tag < T_UNBOXED_NUM && \ (sizeof(n) < sizeof(sl_fx) || fits_bits(n, UNBOXED_BITS-issigned))){ \ v = (sl_v)n<<TAG_EXT_BITS | tag<<TAG_UBNUM_SHIFT | TAG_UNBOXED; \ }else{ \ v = cvalue(sl_##typenam##type, sizeof(n)); \ *(ctype*)cvalue_data(v) = n; \ } \ return v; \ } #define num_ctor_ctor(typenam, ctype, tag) \ sl_v \ mk_##typenam(ctype n) \ { \ sl_v v = cvalue(sl_##typenam##type, sizeof(n)); \ *(ctype*)cvalue_data(v) = n; \ return v; \ } #define num_ctor_ctor_unboxed(typenam, ctype, tag, issigned) \ sl_v \ mk_##typenam(ctype n) \ { \ sl_v v; \ if(tag < T_UNBOXED_NUM && \ (sizeof(n) < sizeof(sl_fx) || fits_bits(n, UNBOXED_BITS-issigned))){ \ v = (sl_v)n<<TAG_EXT_BITS | tag<<TAG_UBNUM_SHIFT | TAG_UNBOXED; \ }else{ \ v = cvalue(sl_##typenam##type, sizeof(n)); \ *(ctype*)cvalue_data(v) = n; \ } \ return v; \ } #define num_ctor(typenam, ctype, tag) \ num_ctor_ctor(typenam, ctype, tag) \ num_ctor_init(typenam, ctype, tag) \ #define num_ctor_unboxed(typenam, ctype, tag, issigned) \ num_ctor_ctor_unboxed(typenam, ctype, tag, issigned) \ num_ctor_init_unboxed(typenam, ctype, tag, issigned) \ #if defined(BITS64) #define sl_constfn64 sl_constfn #else #define sl_constfn64 #endif sl_constfn num_ctor_unboxed(s8, s8int, T_S8, 1) sl_constfn num_ctor_unboxed(u8, u8int, T_U8, 0) sl_constfn num_ctor_unboxed(s16, s16int, T_S16, 1) sl_constfn num_ctor_unboxed(u16, u16int, T_U16, 0) sl_constfn64 num_ctor_unboxed(s32, s32int, T_S32, 1) sl_constfn64 num_ctor_unboxed(u32, u32int, T_U32, 0) sl_constfn64 num_ctor_unboxed(p32, u32ptr, T_P32, 0) num_ctor_unboxed(s64, s64int, T_S64, 1) num_ctor_unboxed(u64, u64int, T_U64, 0) num_ctor_unboxed(p64, u64ptr, T_P64, 0) num_ctor(f32, f32, T_F32) num_ctor(f64, f64, T_F64) sl_nonnull(1, 3) static void cvalue_bignum_init(const sl_type *type, sl_v a, void *dest) { mpint *n; USED(type); if(isfixnum(a)) n = vtomp(numval(a), nil); else if(isubnum(a)){ sl_fx v = ubnumval(a); sl_numtype nt = ubnumtype(a); #if !defined(BITS64) if(nt > T_P32) nt -= T_P64-T_P32; #endif n = conv_to_bignum(a, ubnumptr(v, nt), nt); }else if(iscvalue(a)){ sl_cv *cv = ptr(sl_cv, a); void *p = cv_data(cv); n = conv_to_bignum(a, p, cv_numtype(cv)); }else cthrow(type_error(nil, "num", a), type); *((mpint**)dest) = n; } BUILTIN("bignum", bignum) { argcount_most(1); if(nargs == 0){ PUSH(fixnum(0)); args = sl.sp-1; } mpint *m; cvalue_bignum_init(sl_bignumtype, args[0], &m); sl_v cv = cvalue(sl_bignumtype, sizeof(mpint*)); *((mpint**)cvalue_data(cv)) = m; return cv; } sl_v mk_bignum(mpint *n) { sl_v cv = cvalue(sl_bignumtype, sizeof(mpint*)); *(mpint**)cvalue_data(cv) = n; return cv; } static void free_bignum(sl_v self) { mpint **s = value2c(mpint**, self); if(*s != mpzero && *s != mpone && *s != mptwo) mpfree(*s); } static sl_cvtable bignum_vtable = { nil, nil, free_bignum, nil, nil }; sl_constfn sl_v size_wrap(usize sz) { if(sizeof(usize) == 8) return fits_fixnum(sz) ? fixnum(sz): mk_u64(sz); return fits_fixnum(sz) ? fixnum(sz): mk_u32(sz); } u32int tou32(sl_v n) { if(iscvalue(n)){ sl_cv *cv = ptr(sl_cv, n); return conv_to_u32(n, cv_data(cv), cv_numtype(cv)); } if(isfixnum(n)) return numval(n); if(isubnum(n)) return ubnumval(n); cthrow(type_error(nil, "num", n), n); } u64int tou64(sl_v n) { if(iscvalue(n)){ sl_cv *cv = ptr(sl_cv, n); return conv_to_u64(n, cv_data(cv), cv_numtype(cv)); } if(isfixnum(n)) return numval(n); if(isubnum(n)) return ubnumval(n); cthrow(type_error(nil, "num", n), n); } usize tosize(sl_v n) { if(sl_unlikely(iscvalue(n))){ if(sl_likely(numeric_compare(n, fixnum(0), true) >= 0)){ sl_cv *cv = ptr(sl_cv, n); if(sizeof(usize) > 4) return conv_to_u64(n, cv_data(cv), cv_numtype(cv)); return conv_to_u32(n, cv_data(cv), cv_numtype(cv)); } }else{ sl_fx x; if(sl_likely(isfixnum(n)))