shithub: femtolisp

ref: b71e694a565be65d648cd3b70d938b4417622782
dir: /cvalues.c/

View raw version
#include "llt.h"
#include "flisp.h"
#include "operators.h"
#include "cvalues.h"
#include "types.h"
#include "overflows.h"

// trigger unconditional GC after this many bytes are allocated
#define ALLOC_LIMIT_TRIGGER 67108864

value_t int8sym, uint8sym, int16sym, uint16sym, int32sym, uint32sym;
value_t int64sym, uint64sym, bignumsym;
value_t longsym, ulongsym, bytesym, wcharsym;
value_t floatsym, doublesym;
value_t gftypesym, stringtypesym, wcstringtypesym;
value_t emptystringsym;

value_t structsym, arraysym, enumsym, cfunctionsym, voidsym, pointersym;
value_t unionsym;

htable_t TypeTable;
htable_t reverse_dlsym_lookup_table;
fltype_t *mpinttype;
static fltype_t *int8type, *uint8type;
static fltype_t *int16type, *uint16type;
static fltype_t *int32type, *uint32type;
static fltype_t *int64type, *uint64type;
static fltype_t *longtype, *ulongtype;
static fltype_t *floattype, *doubletype;
fltype_t *bytetype, *wchartype;
fltype_t *stringtype, *wcstringtype;
fltype_t *builtintype;

static size_t malloc_pressure = 0;
static cvalue_t **Finalizers = nil;
static size_t nfinalizers = 0;
static size_t maxfinalizers = 0;

static void cvalue_init(fltype_t *type, value_t v, void *dest);

void
add_finalizer(cvalue_t *cv)
{
	if(nfinalizers == maxfinalizers){
		size_t nn = maxfinalizers == 0 ? 256 : maxfinalizers*2;
		cvalue_t **temp = realloc(Finalizers, nn*sizeof(cvalue_t*));
		if(temp == nil)
			lerrorf(MemoryError, "out of memory");
		Finalizers = temp;
		maxfinalizers = nn;
	}
	Finalizers[nfinalizers++] = cv;
}

// remove dead objects from finalization list in-place
void
sweep_finalizers(void)
{
	cvalue_t **lst = Finalizers;
	size_t n = 0, ndel = 0, l = nfinalizers;
	cvalue_t *tmp;
#define SWAP_sf(a, b) (tmp = a, a = b, b = tmp, 1)
	if(l == 0)
		return;
	do{
		tmp = lst[n];
		if(isforwarded((value_t)tmp)){
			// object is alive
			lst[n] = ptr(forwardloc((value_t)tmp));
			n++;
		}else{
			fltype_t *t = cv_class(tmp);
			if(t->vtable != nil && t->vtable->finalize != nil)
				t->vtable->finalize(tagptr(tmp, TAG_CVALUE));
			if(!isinlined(tmp) && owned(tmp)){
				memset(cv_data(tmp), 0xbb, cv_len(tmp));
				free(cv_data(tmp));
			}
			ndel++;
		}
	}while((n < l-ndel) && SWAP_sf(lst[n], lst[n+ndel]));

	nfinalizers -= ndel;
#ifdef VERBOSEGC
	if(ndel > 0)
		printf("GC: finalized %d objects\n", ndel);
#endif

	malloc_pressure = 0;
}

// compute the size of the metadata object for a cvalue
static size_t
cv_nwords(cvalue_t *cv)
{
	if(isinlined(cv)){
		size_t n = cv_len(cv);
		if(n == 0 || cv_isstr(cv))
			n++;
		return CVALUE_NWORDS - 1 + NWORDS(n);
	}
	return CVALUE_NWORDS;
}

static void
autorelease(cvalue_t *cv)
{
	cv->type = (fltype_t*)(((uintptr_t)cv->type) | CV_OWNED_BIT);
	add_finalizer(cv);
}

void
cv_autorelease(cvalue_t *cv)
{
	autorelease(cv);
}

static value_t
cprim(fltype_t *type, size_t sz)
{
	assert(!ismanaged((uintptr_t)type));
	assert(sz == type->size);
	cprim_t *pcp = alloc_words(CPRIM_NWORDS-1+NWORDS(sz));
	pcp->type = type;
	return tagptr(pcp, TAG_CPRIM);
}

value_t
cvalue(fltype_t *type, size_t sz)
{
	cvalue_t *pcv;
	int str = 0;

	if(valid_numtype(type->numtype) && type->numtype != T_MPINT)
		return cprim(type, sz);

	if(type->eltype == bytetype){
		if(sz == 0)
			return symbol_value(emptystringsym);
		sz++;
		str = 1;
	}
	if(sz <= MAX_INL_SIZE){
		size_t nw = CVALUE_NWORDS - 1 + NWORDS(sz) + (sz == 0 ? 1 : 0);
		pcv = alloc_words(nw);
		pcv->type = type;
		pcv->data = &pcv->_space[0];
		if(type->vtable != nil && type->vtable->finalize != nil)
			add_finalizer(pcv);
	}else{
		if(malloc_pressure > ALLOC_LIMIT_TRIGGER)
			gc(0);
		pcv = alloc_words(CVALUE_NWORDS);
		pcv->type = type;
		pcv->data = malloc(sz);
		autorelease(pcv);
		malloc_pressure += sz;
	}
	if(str)
		((char*)pcv->data)[--sz] = '\0';
	pcv->len = sz;
	return tagptr(pcv, TAG_CVALUE);
}

value_t
cvalue_from_data(fltype_t *type, void *data, size_t sz)
{
	value_t cv;
	cv = cvalue(type, sz);
	memmove(cptr(cv), data, sz);
	return cv;
}

// 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.
value_t
cvalue_from_ref(fltype_t *type, void *ptr, size_t sz, value_t parent)
{
	cvalue_t *pcv;
	value_t cv;

	pcv = alloc_words(CVALUE_NWORDS);
	pcv->data = ptr;
	pcv->len = sz;
	pcv->type = type;
	if(parent != NIL){
		pcv->type = (fltype_t*)(((uintptr_t)pcv->type) | CV_PARENT_BIT);
		pcv->parent = parent;
	}
	cv = tagptr(pcv, TAG_CVALUE);
	return cv;
}

value_t
cvalue_string(size_t sz)
{
	return cvalue(stringtype, sz);
}

value_t
cvalue_static_cstring(const char *str)
{
	return cvalue_from_ref(stringtype, (char*)str, strlen(str), NIL);
}

value_t
string_from_cstrn(char *str, size_t n)
{
	value_t v = cvalue_string(n);
	memmove(cvalue_data(v), str, n);
	return v;
}

value_t
string_from_cstr(char *str)
{
	return string_from_cstrn(str, strlen(str));
}

int
fl_isstring(value_t v)
{
	return iscvalue(v) && cv_isstr((cvalue_t*)ptr(v));
}

// convert to malloc representation (fixed address)
void
cv_pin(cvalue_t *cv)
{
	if(!isinlined(cv))
		return;
	size_t sz = cv_len(cv);
	if(cv_isstr(cv))
		sz++;
	void *data = malloc(sz);
	memmove(data, cv_data(cv), sz);
	cv->data = data;
	autorelease(cv);
}

#define num_init(ctype, cnvt, tag) \
	static int \
	cvalue_##ctype##_init(fltype_t *type, value_t arg, void *dest) \
	{ \
		ctype n; \
		USED(type); \
		if(isfixnum(arg)) \
			n = numval(arg); \
		else if(iscprim(arg)){ \
			cprim_t *cp = (cprim_t*)ptr(arg); \
			void *p = cp_data(cp); \
			n = (ctype)conv_to_##cnvt(p, cp_numtype(cp)); \
		}else \
			return 1; \
		*((ctype*)dest) = n; \
		return 0; \
	}

num_init(int8_t, int32, T_INT8)
num_init(uint8_t, uint32, T_UINT8)
num_init(int16_t, int32, T_INT16)
num_init(uint16_t, uint32, T_UINT16)
num_init(int32_t, int32, T_INT32)
num_init(uint32_t, uint32, T_UINT32)
num_init(int64_t, int64, T_INT64)
num_init(uint64_t, uint64, T_UINT64)
num_init(float, double, T_FLOAT)
num_init(double, double, T_DOUBLE)

#define num_ctor_init(typenam, ctype, tag) \
	BUILTIN(#typenam, typenam) \
	{ \
		if(nargs == 0){ \
			PUSH(fixnum(0)); \
			args = &Stack[SP-1]; \
		} \
		value_t cp = cprim(typenam##type, sizeof(ctype)); \
		if(cvalue_##ctype##_init(typenam##type, args[0], cp_data((cprim_t*)ptr(cp)))) \
			type_error("number", args[0]); \
		return cp; \
	}

#define num_ctor_ctor(typenam, ctype, tag) \
	value_t mk_##typenam(ctype n) \
	{ \
		value_t cp = cprim(typenam##type, sizeof(ctype)); \
		*(ctype*)cp_data((cprim_t*)ptr(cp)) = n; \
		return cp; \
	}

#define num_ctor(typenam, ctype, tag) \
	num_ctor_init(typenam, ctype, tag) \
	num_ctor_ctor(typenam, ctype, tag)

num_ctor(int8, int8_t, T_INT8)
num_ctor(uint8, uint8_t, T_UINT8)
num_ctor(int16, int16_t, T_INT16)
num_ctor(uint16, uint16_t, T_UINT16)
num_ctor(int32, int32_t, T_INT32)
num_ctor(uint32, uint32_t, T_UINT32)
num_ctor(int64, int64_t, T_INT64)
num_ctor(uint64, uint64_t, T_UINT64)
num_ctor(byte,  uint8_t, T_UINT8)
num_ctor(wchar, int32_t, T_INT32)
#if defined(ULONG64)
num_ctor(long, int64_t, T_INT64)
num_ctor(ulong, uint64_t, T_UINT64)
#else
num_ctor(long, int32_t, T_INT32)
num_ctor(ulong, uint32_t, T_UINT32)
#endif
num_ctor(float, float, T_FLOAT)
num_ctor(double, double, T_DOUBLE)

static int
cvalue_mpint_init(fltype_t *type, value_t arg, void *dest)
{
	mpint *n;
	USED(type);
	if(isfixnum(arg)){
		n = vtomp(numval(arg), nil);
	}else if(iscprim(arg)){
		cprim_t *cp = (cprim_t*)ptr(arg);
		void *p = cp_data(cp);
		n = conv_to_mpint(p, cp_numtype(cp));
	}else{
		return 1;
	}
	*((mpint**)dest) = n;
	return 0;
}

BUILTIN("bignum", bignum)
{
	if(nargs == 0){
		PUSH(fixnum(0));
		args = &Stack[SP-1];
	}
	value_t cv = cvalue(mpinttype, sizeof(mpint*));
	if(cvalue_mpint_init(mpinttype, args[0], cv_data((cvalue_t*)ptr(cv))))
		type_error("number", args[0]);
	return cv;
}


value_t
mk_mpint(mpint *n)
{
	value_t cv = cvalue(mpinttype, sizeof(mpint*));
	*(mpint**)cvalue_data(cv) = n;
	return cv;
}

static void
free_mpint(value_t self)
{
	mpint **s = value2c(mpint**, self);
	if(*s != mpzero && *s != mpone && *s != mptwo)
		mpfree(*s);
}

static cvtable_t mpint_vtable = { nil, nil, free_mpint, nil };

value_t
size_wrap(size_t sz)
{
	if(fits_fixnum(sz))
		return fixnum(sz);
	assert(sizeof(void*) == sizeof(size_t));
	return mk_ulong(sz);
}

size_t
toulong(value_t n)
{
	if(isfixnum(n))
		return numval(n);
	if(iscprim(n)){
		cprim_t *cp = (cprim_t*)ptr(n);
		return conv_to_ulong(cp_data(cp), cp_numtype(cp));
	}
	type_error("number", n);
}

off_t
tooffset(value_t n)
{
	if(isfixnum(n))
		return numval(n);
	if(iscprim(n)){
		cprim_t *cp = (cprim_t*)ptr(n);
		return conv_to_int64(cp_data(cp), cp_numtype(cp));
	}
	type_error("number", n);
}

int
cvalue_enum_init(fltype_t *ft, value_t arg, void *dest)
{
	int n;
	value_t syms;
	value_t type = ft->type;

	syms = car(cdr(type));
	if(!isvector(syms))
		type_error("vector", syms);
	if(issymbol(arg)){
		for(n = 0; n < (int)vector_size(syms); n++){
			if(vector_elt(syms, n) == arg){
				*(int*)dest = n;
				return 0;
			}
		}
		lerrorf(ArgError, "invalid enum value");
	}
	if(isfixnum(arg))
		n = (int)numval(arg);
	else if(iscprim(arg)){
		cprim_t *cp = (cprim_t*)ptr(arg);
		n = conv_to_int32(cp_data(cp), cp_numtype(cp));
	}else
		type_error("number", arg);
	if((unsigned)n >= vector_size(syms))
		lerrorf(ArgError, "value out of range");
	*(int*)dest = n;
	return 0;
}

BUILTIN("enum", enum)
{
	argcount(nargs, 2);
	value_t type = fl_list2(enumsym, args[0]);
	fltype_t *ft = get_type(type);
	value_t cv = cvalue(ft, sizeof(int32_t));
	cvalue_enum_init(ft, args[1], cp_data((cprim_t*)ptr(cv)));
	return cv;
}

int
isarray(value_t v)
{
	return iscvalue(v) && cv_class((cvalue_t*)ptr(v))->eltype != nil;
}

static size_t
predict_arraylen(value_t arg)
{
	if(isvector(arg))
		return vector_size(arg);
	if(iscons(arg))
		return llength(arg);
	if(arg == NIL)
		return 0;
	if(isarray(arg))
		return cvalue_arraylen(arg);
	return 1;
}

int
cvalue_array_init(fltype_t *ft, value_t arg, void *dest)
{
	value_t type = ft->type;
	size_t elsize, i, cnt, sz;
	fltype_t *eltype = ft->eltype;

	elsize = ft->elsz;
	cnt = predict_arraylen(arg);

	if(iscons(cdr_(cdr_(type)))){
		size_t tc = toulong(car_(cdr_(cdr_(type))));
		if(tc != cnt)
			lerrorf(ArgError, "size mismatch");
	}

	sz = elsize * cnt;

	if(isvector(arg)){
		assert(cnt <= vector_size(arg));
		for(i = 0; i < cnt; i++){
			cvalue_init(eltype, vector_elt(arg, i), dest);
			dest = (char*)dest + elsize;
		}
		return 0;
	}
	if(iscons(arg) || arg == NIL){
		i = 0;
		while(iscons(arg)){
			if(i == cnt){
				i++;
				break;
			} // trigger error
			cvalue_init(eltype, car_(arg), dest);
			i++;
			dest = (char*)dest + elsize;
			arg = cdr_(arg);
		}
		if(i != cnt)
			lerrorf(ArgError, "size mismatch");
		return 0;
	}
	if(iscvalue(arg)){
		cvalue_t *cv = (cvalue_t*)ptr(arg);
		if(isarray(arg)){
			fltype_t *aet = cv_class(cv)->eltype;
			if(aet == eltype){
				if(cv_len(cv) == sz)
					memmove(dest, cv_data(cv), sz);
				else
					lerrorf(ArgError, "size mismatch");
				return 0;
			}else{
				// TODO: initialize array from different type elements
				lerrorf(ArgError, "element type mismatch");
			}
		}
	}
	if(cnt == 1)
		cvalue_init(eltype, arg, dest);
	type_error("sequence", arg);
}

BUILTIN("array", array)
{
	size_t elsize, cnt, sz;
	value_t arg;
	int i;

	if(nargs < 1)
		argcount(nargs, 1);

	cnt = nargs - 1;
	fltype_t *type = get_array_type(args[0]);
	elsize = type->elsz;
	sz = elsize * cnt;

	value_t cv = cvalue(type, sz);
	char *dest = cv_data(ptr(cv));
	FOR_ARGS(i, 1, arg, args){
		cvalue_init(type->eltype, arg, dest);
		dest += elsize;
	}
	return cv;
}

// NOTE: v must be an array
size_t
cvalue_arraylen(value_t v)
{
	cvalue_t *cv = ptr(v);
	return cv_len(cv)/cv_class(cv)->elsz;
}

static size_t
cvalue_struct_offs(value_t type, value_t field, int computeTotal, int *palign)
{
	value_t fld = car(cdr_(type));
	size_t fsz, ssz = 0;
	int al;
	*palign = 0;

	while(iscons(fld)){
		fsz = ctype_sizeof(car(cdr(car_(fld))), &al);

		ssz = LLT_ALIGN(ssz, al);
		if(al > *palign)
			*palign = al;

		if(!computeTotal && field == car_(car_(fld))) // found target field
			return ssz;

		ssz += fsz;
		fld = cdr_(fld);
	}
	return LLT_ALIGN(ssz, *palign);
}

static size_t
cvalue_union_size(value_t type, int *palign)
{
	value_t fld = car(cdr_(type));
	size_t fsz, usz = 0;
	int al;
	*palign = 0;

	while(iscons(fld)){
		fsz = ctype_sizeof(car(cdr(car_(fld))), &al);
		if(al > *palign)
			*palign = al;
		if(fsz > usz)
			usz = fsz;
		fld = cdr_(fld);
	}
	return LLT_ALIGN(usz, *palign);
}

// *palign is an output argument giving the alignment required by type
size_t
ctype_sizeof(value_t type, int *palign)
{
	symbol_t *s;

	if(issymbol(type) && (s = ptr(type)) != nil && valid_numtype(s->numtype)){
		 *palign = s->align;
		return s->size;
	}

	if(iscons(type)){
		value_t hed = car_(type);
		if(hed == structsym)
			return cvalue_struct_offs(type, NIL, 1, palign);
		if(hed == unionsym)
			return cvalue_union_size(type, palign);
		if(hed == pointersym || hed == cfunctionsym){
			*palign = offsetof(struct{ char a; void *i; }, i);
			return sizeof(void*);
		}
		if(hed == arraysym){
			value_t t = car(cdr_(type));
			if(!iscons(cdr_(cdr_(type))))
				lerrorf(ArgError, "incomplete type");
			value_t n = car_(cdr_(cdr_(type)));
			size_t sz = toulong(n);
			return sz * ctype_sizeof(t, palign);
		}
		if(hed == enumsym){
			*palign = offsetof(struct{ char c; numerictype_t e; }, e);
			return sizeof(numerictype_t);
		}
	}

	lerrorf(ArgError, "invalid c type");
}

extern fltype_t *iostreamtype;

// get pointer and size for any plain-old-data value
void
to_sized_ptr(value_t v, char **pdata, size_t *psz)
{
	if(iscvalue(v)){
		cvalue_t *pcv = ptr(v);
		ios_t *x = value2c(ios_t*, v);
		if(cv_class(pcv) == iostreamtype && x->bm == bm_mem){
			*pdata = x->buf;
			*psz = x->size;
			return;
		}
		if(cv_isPOD(pcv)){
			*pdata = cv_data(pcv);
			*psz = cv_len(pcv);
			return;
		}
	}
	if(iscprim(v)){
		cprim_t *pcp = (cprim_t*)ptr(v);
		*pdata = cp_data(pcp);
		*psz = cp_class(pcp)->size;
		return;
	}
	type_error("plain-old-data", v);
}

BUILTIN("sizeof", sizeof)
{
	argcount(nargs, 1);
	size_t n; char *data;
	int a;
	if(issymbol(args[0]) || iscons(args[0]))
		return size_wrap(ctype_sizeof(args[0], &a));
	to_sized_ptr(args[0], &data, &n);
	return size_wrap(n);
}

BUILTIN("typeof", typeof)
{
	argcount(nargs, 1);
	switch(tag(args[0])){
	case TAG_CONS: return pairsym;
	case TAG_NUM1: case TAG_NUM: return fixnumsym;
	case TAG_SYM: return symbolsym;
	case TAG_VECTOR: return vectorsym;
	case TAG_FUNCTION:
		if(args[0] == FL_T || args[0] == FL_F)
			return booleansym;
		if(args[0] == NIL)
			return nullsym;
		if(args[0] == FL_EOF)
			return symbol("eof-object");
		if(isbuiltin(args[0]))
			return builtinsym;
		return FUNCTION;
	}
	return cv_type(ptr(args[0]));
}

value_t
cvalue_relocate(value_t v)
{
	size_t nw;
	cvalue_t *cv = ptr(v);
	cvalue_t *nv;
	value_t ncv;

	nw = cv_nwords(cv);
	nv = alloc_words(nw);
	memmove(nv, cv, nw*sizeof(value_t));
	if(isinlined(cv))
		nv->data = &nv->_space[0];
	ncv = tagptr(nv, TAG_CVALUE);
	fltype_t *t = cv_class(cv);
	if(t->vtable != nil && t->vtable->relocate != nil)
		t->vtable->relocate(v, ncv);
	forward(v, ncv);
	return ncv;
}

value_t
cvalue_copy(value_t v)
{
	assert(iscvalue(v));
	PUSH(v);
	cvalue_t *cv = ptr(v);
	size_t nw = cv_nwords(cv);
	cvalue_t *ncv = alloc_words(nw);
	v = POP();
	cv = ptr(v);
	memmove(ncv, cv, nw * sizeof(value_t));
	if(!isinlined(cv)){
		size_t len = cv_len(cv);
		if(cv_isstr(cv))
			len++;
		ncv->data = malloc(len);
		memmove(ncv->data, cv_data(cv), len);
		autorelease(ncv);
		if(hasparent(cv)){
			ncv->type = (fltype_t*)(((uintptr_t)ncv->type) & ~CV_PARENT_BIT);
			ncv->parent = NIL;
		}
	}else{
		ncv->data = &ncv->_space[0];
	}

	return tagptr(ncv, TAG_CVALUE);
}

BUILTIN("copy", copy)
{
	argcount(nargs, 1);
	if(iscons(args[0]) || isvector(args[0]))
		lerrorf(ArgError, "argument must be a leaf atom");
	if(!iscvalue(args[0]))
		return args[0];
	if(!cv_isPOD(ptr(args[0])))
		lerrorf(ArgError, "argument must be a plain-old-data type");
	return cvalue_copy(args[0]);
}

BUILTIN("plain-old-data?", plain_old_datap)
{
	argcount(nargs, 1);
	return (iscprim(args[0]) ||
			(iscvalue(args[0]) && cv_isPOD((cvalue_t*)ptr(args[0])))) ?
		FL_T : FL_F;
}

static void
cvalue_init(fltype_t *type, value_t v, void *dest)
{
	cvinitfunc_t f = type->init;
	if(f == nil)
		lerrorf(ArgError, "invalid c type");
	f(type, v, dest);
}

// (new type . args)
// this provides (1) a way to allocate values with a shared type for
// efficiency, (2) a uniform interface for allocating cvalues of any
// type, including user-defined.
BUILTIN("c-value", c_value)
{
	if(nargs < 1 || nargs > 2)
		argcount(nargs, 2);
	value_t type = args[0];
	fltype_t *ft = get_type(type);
	value_t cv;
	if(ft->eltype != nil){
		// special case to handle incomplete array types bla[]
		size_t elsz = ft->elsz;
		size_t cnt;

		if(iscons(cdr_(cdr_(type))))
			cnt = toulong(car_(cdr_(cdr_(type))));
		else if(nargs == 2)
			cnt = predict_arraylen(args[1]);
		else
			cnt = 0;
		cv = cvalue(ft, elsz * cnt);
		if(nargs == 2)
			cvalue_array_init(ft, args[1], cv_data(ptr(cv)));
	}else{
		cv = cvalue(ft, ft->size);
		if(nargs == 2)
			cvalue_init(ft, args[1], cptr(cv));
	}
	return cv;
}

// NOTE: this only compares lexicographically; it ignores numeric formats
value_t
cvalue_compare(value_t a, value_t b)
{
	cvalue_t *ca = ptr(a);
	cvalue_t *cb = ptr(b);
	char *adata = cv_data(ca);
	char *bdata = cv_data(cb);
	size_t asz = cv_len(ca);
	size_t bsz = cv_len(cb);
	size_t minsz = asz < bsz ? asz : bsz;
	int diff = memcmp(adata, bdata, minsz);
	if(diff == 0){
		if(asz > bsz)
			return fixnum(1);
		if(asz < bsz)
			return fixnum(-1);
	}
	return fixnum(diff);
}

static void
check_addr_args(value_t arr, value_t ind, char **data, int *index)
{
	int numel;
	cvalue_t *cv = ptr(arr);
	*data = cv_data(cv);
	numel = cv_len(cv)/cv_class(cv)->elsz;
	*index = toulong(ind);
	if(*index >= numel)
		bounds_error(arr, ind);
}

value_t
cvalue_array_aref(value_t *args)
{
	char *data; int index;
	fltype_t *eltype = cv_class(ptr(args[0]))->eltype;
	value_t el = 0;
	numerictype_t nt = eltype->numtype;
	if(nt >= T_INT32)
		el = cvalue(eltype, eltype->size);
	check_addr_args(args[0], args[1], &data, &index);
	if(nt < T_INT32){
		if(nt == T_INT8)
			return fixnum((int8_t)data[index]);
		if(nt == T_UINT8)
			return fixnum((uint8_t)data[index]);
		if(nt == T_INT16)
			return fixnum(((int16_t*)data)[index]);
		return fixnum(((uint16_t*)data)[index]);
	}
	char *dest = cptr(el);
	size_t sz = eltype->size;
	if(sz == 1)
		*dest = data[index];
	else if(sz == 2)
		*(int16_t*)dest = ((int16_t*)data)[index];
	else if(sz == 4)
		*(int32_t*)dest = ((int32_t*)data)[index];
	else if(sz == 8)
		*(int64_t*)dest = ((int64_t*)data)[index];
	else
		memmove(dest, data + index*sz, sz);
	return el;
}

value_t
cvalue_array_aset(value_t *args)
{
	char *data; int index;
	fltype_t *eltype = cv_class(ptr(args[0]))->eltype;
	check_addr_args(args[0], args[1], &data, &index);
	char *dest = data + index*eltype->size;
	cvalue_init(eltype, args[2], dest);
	return args[2];
}

BUILTIN("builtin", builtin)
{
	argcount(nargs, 1);
	symbol_t *name = tosymbol(args[0]);
	cvalue_t *cv;
	if(ismanaged(args[0]) || (cv = name->dlcache) == nil)
		lerrorf(ArgError, "function %s not found", name->name);
	return tagptr(cv, TAG_CVALUE);
}

value_t
cbuiltin(char *name, builtin_t f)
{
	cvalue_t *cv;
	cv = calloc(CVALUE_NWORDS, sizeof(*cv));
	cv->type = builtintype;
	cv->data = &cv->_space[0];
	cv->len = sizeof(value_t);
	*(void**)cv->data = f;

	value_t sym = symbol(name);
	((symbol_t*)ptr(sym))->dlcache = cv;
	ptrhash_put(&reverse_dlsym_lookup_table, cv, (void*)sym);

	return tagptr(cv, TAG_CVALUE);
}

#define cv_intern(tok) \
	do{ \
		tok##sym = symbol(#tok); \
	}while(0)

#define ctor_cv_intern(tok, nt, ctype) \
	do{ \
		symbol_t *s; \
		cv_intern(tok); \
		set(tok##sym, cbuiltin(#tok, fn_builtin_##tok)); \
		if(valid_numtype(nt)){ \
			s = ptr(tok##sym); \
			s->numtype = nt; \
			s->size = sizeof(ctype); \
			s->align = offsetof(struct{char c; ctype x;}, x); \
		} \
	}while(0)

#define mk_primtype(name, ctype) \
	do{ \
		name##type = get_type(name##sym); \
		name##type->init = cvalue_##ctype##_init; \
	}while(0)

#define RETURN_NUM_AS(var, type) return(mk_##type(var))

value_t
return_from_uint64(uint64_t Uaccum)
{
	if(fits_fixnum(Uaccum))
		return fixnum((fixnum_t)Uaccum);
	if(Uaccum > (uint64_t)INT64_MAX)
		RETURN_NUM_AS(Uaccum, uint64);
	if(Uaccum > (uint64_t)UINT32_MAX)
		RETURN_NUM_AS(Uaccum, int64);
	if(Uaccum > (uint64_t)INT32_MAX)
		RETURN_NUM_AS(Uaccum, uint32);
	RETURN_NUM_AS(Uaccum, int32);
}

value_t
return_from_int64(int64_t Saccum)
{
	if(fits_fixnum(Saccum))
		return fixnum((fixnum_t)Saccum);
	if(Saccum > (int64_t)UINT32_MAX || Saccum < (int64_t)INT32_MIN)
		RETURN_NUM_AS(Saccum, int64);
	if(Saccum > (int64_t)INT32_MAX)
		RETURN_NUM_AS(Saccum, uint32);
	RETURN_NUM_AS(Saccum, int32);
}

value_t
fl_add_any(value_t *args, uint32_t nargs, fixnum_t carryIn)
{
	uint64_t Uaccum = 0;
	uint64_t Uresult;
	int64_t Saccum = carryIn;
	int64_t Sresult;
	double Faccum = 0;
	int32_t inexact = 0;
	uint32_t i;
	int64_t i64;
	value_t arg;
	mpint *Maccum = nil, *x;
	numerictype_t pt;
	fixnum_t pi;
	void *a;

	FOR_ARGS(i, 0, arg, args){
		if(isfixnum(arg)){
			Saccum += numval(arg);
			continue;
		}
		if(num_to_ptr(arg, &pi, &pt, &a)){
			switch(pt){
			case T_INT8:   Saccum += *(int8_t*)a; break;
			case T_UINT8:  Uaccum += *(uint8_t*)a; break;
			case T_INT16:  Saccum += *(int16_t*)a; break;
			case T_UINT16: Uaccum += *(uint16_t*)a; break;
			case T_INT32:  Saccum += *(int32_t*)a; break;
			case T_UINT32: Uaccum += *(uint32_t*)a; break;
			case T_INT64:
				i64 = *(int64_t*)a;
				if(i64 > 0){
					if(addof_uint64(Uresult, Uaccum, (uint64_t)i64)){
						if(Maccum == nil)
							Maccum = mpnew(0);
						x = uvtomp((uint64_t)i64, nil);
						mpadd(Maccum, x, Maccum);
						mpfree(x);
					}else
						Uaccum = Uresult;
				}else{
					if(subof_int64(Sresult, Saccum, i64)){
						if(Maccum == nil)
							Maccum = mpnew(0);
						x = vtomp(i64, nil);
						mpadd(Maccum, x, Maccum);
						mpfree(x);
					}else{
						USED(Sresult);
						Saccum += i64;
					}
				}
				break;
			case T_UINT64:
				if(addof_uint64(Uresult, Uaccum, *(uint64_t*)a)){
					if(Maccum == nil)
						Maccum = mpnew(0);
					x = uvtomp(*(uint64_t*)a, nil);
					mpadd(Maccum, x, Maccum);
					mpfree(x);
				}else
					Uaccum = Uresult;
				break;
			case T_MPINT:
				if(Maccum == nil)
					Maccum = mpnew(0);
				mpadd(Maccum, *(mpint**)a, Maccum);
				break;
			case T_FLOAT:  Faccum += *(float*)a; inexact = 1; break;
			case T_DOUBLE: Faccum += *(double*)a; inexact = 1; break;
			default:
				goto add_type_error;
			}
			continue;
		}

add_type_error:
		mpfree(Maccum);
		type_error("number", arg);
	}
	if(inexact){
		Faccum += Uaccum;
		Faccum += Saccum;
		if(Maccum != nil){
			Faccum += mptod(Maccum);
			mpfree(Maccum);
		}
		return mk_double(Faccum);
	}
	if(Maccum != nil){
		/* FIXME - check if it fits into fixnum first, etc */
		x = vtomp(Saccum, nil);
		mpadd(Maccum, x, Maccum);
		x = uvtomp(Uaccum, x);
		mpadd(Maccum, x, Maccum);
		mpfree(x);
		return mk_mpint(Maccum);
	}
	if(Saccum < 0){
		uint64_t negpart = (uint64_t)(-Saccum);
		if(negpart > Uaccum){
			Saccum += (int64_t)Uaccum;
			// return value in Saccum
			if(Saccum >= INT32_MIN){
				if(fits_fixnum(Saccum)){
					return fixnum((fixnum_t)Saccum);
				}
				RETURN_NUM_AS(Saccum, int32);
			}
			RETURN_NUM_AS(Saccum, int64);
		}
		Uaccum -= negpart;
	}else{
		if(addof_uint64(Uresult, Uaccum, (uint64_t)Saccum)){
			if(Maccum == nil)
				Maccum = mpnew(0);
			x = vtomp(Saccum, nil);
			mpadd(Maccum, x, Maccum);
			x = uvtomp(Uaccum, x);
			mpadd(Maccum, x, Maccum);
			mpfree(x);
			return mk_mpint(Maccum);
		}else
			Uaccum = Uresult;
	}
	return return_from_uint64(Uaccum);
}

value_t
fl_neg(value_t n)
{
	uint32_t ui32;
	int32_t i32;
	int64_t i64;
	mpint *mp;
	numerictype_t pt;
	fixnum_t pi;
	void *a;

	if(isfixnum(n)){
		fixnum_t s = fixnum(-numval(n));
		if(__unlikely((value_t)s == n))
			return mk_xlong(-numval(n));
		return s;
	}

	if(num_to_ptr(n, &pi, &pt, &a)){
		switch(pt){
		case T_INT8:   return fixnum(-(int32_t)*(int8_t*)a);
		case T_UINT8:  return fixnum(-(int32_t)*(uint8_t*)a);
		case T_INT16:  return fixnum(-(int32_t)*(int16_t*)a);
		case T_UINT16: return fixnum(-(int32_t)*(uint16_t*)a);
		case T_INT32:
			i32 = *(int32_t*)a;
			if(i32 == (int32_t)BIT31)
				return mk_uint32((uint32_t)BIT31);
			return mk_int32(-i32);
		case T_UINT32:
			ui32 = *(uint32_t*)a;
			if(ui32 <= ((uint32_t)INT32_MAX)+1)
				return mk_int32(-(int32_t)ui32);
			return mk_int64(-(int64_t)ui32);
		case T_INT64:
			i64 = *(int64_t*)a;
			if(i64 == (int64_t)BIT63)
				return mk_uint64((uint64_t)BIT63);
			return mk_int64(-i64);
		case T_UINT64: return mk_int64(-(int64_t)*(uint64_t*)a);
		case T_MPINT:
			mp = mpcopy(*(mpint**)a);
			mpsub(mpzero, mp, mp);
			return mk_mpint(mp);
		case T_FLOAT:  return mk_float(-*(float*)a);
		case T_DOUBLE: return mk_double(-*(double*)a);
		}
	}

	type_error("number", n);
}

value_t
fl_mul_any(value_t *args, uint32_t nargs, int64_t Saccum)
{
	uint64_t Uaccum = 1;
	double Faccum = 1;
	int32_t inexact = 0;
	int64_t i64;
	uint32_t i;
	value_t arg;
	mpint *Maccum = nil, *x;
	numerictype_t pt;
	fixnum_t pi;
	void *a;

	FOR_ARGS(i, 0, arg, args){
		if(isfixnum(arg)){
			Saccum *= numval(arg);
			continue;
		}
		if(num_to_ptr(arg, &pi, &pt, &a)){
			switch(pt){
			case T_INT8:   Saccum *= *(int8_t*)a; break;
			case T_UINT8:  Uaccum *= *(uint8_t*)a; break;
			case T_INT16:  Saccum *= *(int16_t*)a; break;
			case T_UINT16: Uaccum *= *(uint16_t*)a; break;
			case T_INT32:  Saccum *= *(int32_t*)a; break;
			case T_UINT32: Uaccum *= *(uint32_t*)a; break;
			case T_INT64:
				i64 = *(int64_t*)a;
				if(i64 > 0)
					Uaccum *= (uint64_t)i64;
				else
					Saccum *= i64;
				break;
			case T_UINT64: Uaccum *= *(uint64_t*)a; break;
			case T_MPINT:
				if(Maccum == nil)
					Maccum = mpcopy(mpone);
				mpmul(Maccum, *(mpint**)a, Maccum);
				break;
			case T_FLOAT:  Faccum *= *(float*)a; inexact = 1; break;
			case T_DOUBLE: Faccum *= *(double*)a; inexact = 1; break;
			default:
				goto mul_type_error;
			}
			continue;
		}

mul_type_error:
		type_error("number", arg);
	}
	if(inexact){
		Faccum *= Uaccum;
		Faccum *= Saccum;
		if(Maccum != nil){
			Faccum *= mptod(Maccum);
			mpfree(Maccum);
		}
		return mk_double(Faccum);
	}
	if(Maccum != nil){
		/* FIXME might still fit into a fixnum */
		x = vtomp(Saccum, nil);
		mpmul(Maccum, x, Maccum);
		x = uvtomp(Uaccum, x);
		mpmul(Maccum, x, Maccum);
		mpfree(x);
		return mk_mpint(Maccum);
	}
	if(Saccum < 0){
		Saccum *= (int64_t)Uaccum;
		if(Saccum >= INT32_MIN){
			if(fits_fixnum(Saccum)){
				return fixnum((fixnum_t)Saccum);
			}
			RETURN_NUM_AS(Saccum, int32);
		}
		RETURN_NUM_AS(Saccum, int64);
	}else{
		Uaccum *= (uint64_t)Saccum;
	}
	return return_from_uint64(Uaccum);
}

int
num_to_ptr(value_t a, fixnum_t *pi, numerictype_t *pt, void **pp)
{
	cprim_t *cp;
	cvalue_t *cv;
	if(isfixnum(a)){
		*pi = numval(a);
		*pp = pi;
		*pt = T_FIXNUM;
		return 1;
	}else if(iscprim(a)){
		cp = ptr(a);
		*pp = cp_data(cp);
		*pt = cp_numtype(cp);
		return 1;
	}else if(iscvalue(a)){
		cv = ptr(a);
		*pp = cv_data(cv);
		*pt = cv_class(cv)->numtype;
		return valid_numtype(*pt);
	}
	return 0;
}

/*
  returns -1, 0, or 1 based on ordering of a and b
  eq: consider equality only, returning 0 or nonzero
  eqnans: NaNs considered equal to each other
		  -0.0 not considered equal to 0.0
		  inexact not considered equal to exact
  typeerr: if not 0, throws type errors, else returns 2 for type errors
*/
int
numeric_compare(value_t a, value_t b, int eq, int eqnans, int typeerr)
{
	lltint_t ai, bi;
	numerictype_t ta, tb;
	void *aptr, *bptr;

	if(bothfixnums(a, b)){
		if(a == b)
			return 0;
		if(numval(a) < numval(b))
			return -1;
		return 1;
	}
	if(!num_to_ptr(a, &ai, &ta, &aptr)){
		if(typeerr)
			type_error("number", a);
		return 2;
	}
	if(!num_to_ptr(b, &bi, &tb, &bptr)){
		if(typeerr)
			type_error("number", b);
		return 2;
	}
	if(eq && eqnans && ((ta >= T_FLOAT) != (tb >= T_FLOAT)))
		return 1;
	if(cmp_eq(aptr, ta, bptr, tb, eqnans))
		return 0;
	if(eq)
		return 1;
	if(cmp_lt(aptr, ta, bptr, tb))
		return -1;
	return 1;
}

_Noreturn void
DivideByZeroError(void)
{
	lerrorf(DivideError, "/: division by zero");
}

value_t
fl_div2(value_t a, value_t b)
{
	double da, db;
	lltint_t ai, bi;
	numerictype_t ta, tb;
	void *aptr, *bptr;

	if(!num_to_ptr(a, &ai, &ta, &aptr))
		type_error("number", a);
	if(!num_to_ptr(b, &bi, &tb, &bptr))
		type_error("number", b);

	da = conv_to_double(aptr, ta);
	db = conv_to_double(bptr, tb);

	if(db == 0 && tb < T_FLOAT)  // exact 0
		DivideByZeroError();

	da = da/db;

	if(ta < T_FLOAT && tb < T_FLOAT && (double)(int64_t)da == da)
		return return_from_int64((int64_t)da);
	return mk_double(da);
}

value_t
fl_idiv2(value_t a, value_t b)
{
	lltint_t ai, bi;
	numerictype_t ta, tb;
	void *aptr, *bptr;
	int64_t a64, b64;
	mpint *x;

	if(!num_to_ptr(a, &ai, &ta, &aptr))
		type_error("number", a);
	if(!num_to_ptr(b, &bi, &tb, &bptr))
		type_error("number", b);

	if(ta == T_MPINT){
		if(tb == T_MPINT){
			if(mpsignif(*(mpint**)bptr) == 0)
				goto div_error;
			x = mpnew(0);
			mpdiv(*(mpint**)aptr, *(mpint**)bptr, x, nil);
			return mk_mpint(x);
		}else{
			b64 = conv_to_int64(bptr, tb);
			if(b64 == 0)
				goto div_error;
			x = tb == T_UINT64 ? uvtomp(b64, nil) : vtomp(b64, nil);
			mpdiv(*(mpint**)aptr, x, x, nil);
			return mk_mpint(x);
		}
	}
	if(ta == T_UINT64){
		if(tb == T_UINT64){
			if(*(uint64_t*)bptr == 0)
				goto div_error;
			return return_from_uint64(*(uint64_t*)aptr / *(uint64_t*)bptr);
		}
		b64 = conv_to_int64(bptr, tb);
		if(b64 < 0)
			return return_from_int64(-(int64_t)(*(uint64_t*)aptr / (uint64_t)(-b64)));
		if(b64 == 0)
			goto div_error;
		return return_from_uint64(*(uint64_t*)aptr / (uint64_t)b64);
	}
	if(tb == T_UINT64){
		if(*(uint64_t*)bptr == 0)
			goto div_error;
		a64 = conv_to_int64(aptr, ta);
		if(a64 < 0)
			return return_from_int64(-((int64_t)((uint64_t)(-a64) / *(uint64_t*)bptr)));
		return return_from_uint64((uint64_t)a64 / *(uint64_t*)bptr);
	}

	b64 = conv_to_int64(bptr, tb);
	if(b64 == 0)
		goto div_error;

	return return_from_int64(conv_to_int64(aptr, ta) / b64);
 div_error:
	DivideByZeroError();
}

static value_t
fl_bitwise_op(value_t a, value_t b, int opcode)
{
	lltint_t ai, bi;
	numerictype_t ta, tb, itmp;
	void *aptr = nil, *bptr = nil, *ptmp;
	mpint *bmp = nil, *resmp = nil;
	int64_t b64;

	if(!num_to_ptr(a, &ai, &ta, &aptr) || ta >= T_FLOAT)
		type_error("integer", a);
	if(!num_to_ptr(b, &bi, &tb, &bptr) || tb >= T_FLOAT)
		type_error("integer", b);

	if(ta < tb){
		itmp = ta; ta = tb; tb = itmp;
		ptmp = aptr; aptr = bptr; bptr = ptmp;
	}
	// now a's type is larger than or same as b's
	if(ta == T_MPINT){
		if(tb == T_MPINT){
			bmp = *(mpint**)bptr;
			resmp = mpnew(0);
		}else{
			bmp = conv_to_mpint(bptr, tb);
			resmp = bmp;
		}
		b64 = 0;
	}else
		b64 = conv_to_int64(bptr, tb);
	switch(opcode){
	case 0:
	switch(ta){
	case T_INT8:   return fixnum(   *(int8_t *)aptr  & (int8_t  )b64);
	case T_UINT8:  return fixnum(   *(uint8_t *)aptr & (uint8_t )b64);
	case T_INT16:  return fixnum(   *(int16_t*)aptr  & (int16_t )b64);
	case T_UINT16: return fixnum(   *(uint16_t*)aptr & (uint16_t)b64);
	case T_INT32:  return mk_int32( *(int32_t*)aptr  & (int32_t )b64);
	case T_UINT32: return mk_uint32(*(uint32_t*)aptr & (uint32_t)b64);
	case T_INT64:  return mk_int64( *(int64_t*)aptr  & (int64_t )b64);
	case T_UINT64: return mk_uint64(*(uint64_t*)aptr & (uint64_t)b64);
	case T_MPINT:  mpand(*(mpint**)aptr, bmp, resmp); return mk_mpint(resmp);
	case T_FLOAT:
	case T_DOUBLE: assert(0);
	}
	break;
	case 1:
	switch(ta){
	case T_INT8:   return fixnum(   *(int8_t *)aptr  | (int8_t  )b64);
	case T_UINT8:  return fixnum(   *(uint8_t *)aptr | (uint8_t )b64);
	case T_INT16:  return fixnum(   *(int16_t*)aptr  | (int16_t )b64);
	case T_UINT16: return fixnum(   *(uint16_t*)aptr | (uint16_t)b64);
	case T_INT32:  return mk_int32( *(int32_t*)aptr  | (int32_t )b64);
	case T_UINT32: return mk_uint32(*(uint32_t*)aptr | (uint32_t)b64);
	case T_INT64:  return mk_int64( *(int64_t*)aptr  | (int64_t )b64);
	case T_UINT64: return mk_uint64(*(uint64_t*)aptr | (uint64_t)b64);
	case T_MPINT:  mpor(*(mpint**)aptr, bmp, resmp); return mk_mpint(resmp);
	case T_FLOAT:
	case T_DOUBLE: assert(0);
	}
	break;
	case 2:
	switch(ta){
	case T_INT8:   return fixnum(   *(int8_t *)aptr  ^ (int8_t  )b64);
	case T_UINT8:  return fixnum(   *(uint8_t *)aptr ^ (uint8_t )b64);
	case T_INT16:  return fixnum(   *(int16_t*)aptr  ^ (int16_t )b64);
	case T_UINT16: return fixnum(   *(uint16_t*)aptr ^ (uint16_t)b64);
	case T_INT32:  return mk_int32( *(int32_t*)aptr  ^ (int32_t )b64);
	case T_UINT32: return mk_uint32(*(uint32_t*)aptr ^ (uint32_t)b64);
	case T_INT64:  return mk_int64( *(int64_t*)aptr  ^ (int64_t )b64);
	case T_UINT64: return mk_uint64(*(uint64_t*)aptr ^ (uint64_t)b64);
	case T_MPINT:  mpxor(*(mpint**)aptr, bmp, resmp); return mk_mpint(resmp);
	case T_FLOAT:
	case T_DOUBLE: assert(0);
	}
	}
	assert(0);
	return NIL;
}

BUILTIN("logand", logand)
{
	value_t v, e;
	int i;
	if(nargs == 0)
		return fixnum(-1);
	v = args[0];
	FOR_ARGS(i, 1, e, args){
		if(bothfixnums(v, e))
			v = v & e;
		else
			v = fl_bitwise_op(v, e, 0);
	}
	return v;
}

BUILTIN("logior", logior)
{
	value_t v, e;
	int i;
	if(nargs == 0)
		return fixnum(0);
	v = args[0];
	FOR_ARGS(i, 1, e, args){
		if(bothfixnums(v, e))
			v = v | e;
		else
			v = fl_bitwise_op(v, e, 1);
	}
	return v;
}

BUILTIN("logxor", logxor)
{
	value_t v, e;
	int i;
	if(nargs == 0)
		return fixnum(0);
	v = args[0];
	FOR_ARGS(i, 1, e, args){
		if(bothfixnums(v, e))
			v = fixnum(numval(v) ^ numval(e));
		else
			v = fl_bitwise_op(v, e, 2);
	}
	return v;
}

BUILTIN("lognot", lognot)
{
	argcount(nargs, 1);
	value_t a = args[0];
	cprim_t *cp;
	int ta;
	void *aptr;

	if(isfixnum(a))
		return fixnum(~numval(a));
	if(iscprim(a)){
		cp = ptr(a);
		ta = cp_numtype(cp);
		aptr = cp_data(cp);
		switch(ta){
		case T_INT8:   return fixnum(~*(int8_t *)aptr);
		case T_UINT8:  return fixnum(~*(uint8_t *)aptr & 0xff);
		case T_INT16:  return fixnum(~*(int16_t *)aptr);
		case T_UINT16: return fixnum(~*(uint16_t*)aptr & 0xffff);
		case T_INT32:  return mk_int32(~*(int32_t *)aptr);
		case T_UINT32: return mk_uint32(~*(uint32_t*)aptr);
		case T_INT64:  return mk_int64(~*(int64_t *)aptr);
		case T_UINT64: return mk_uint64(~*(uint64_t*)aptr);
		}
	}
	type_error("integer", a);
}

BUILTIN("ash", ash)
{
	fixnum_t n;
	int64_t accum;
	cprim_t *cp;
	int ta;
	mpint *mp;
	void *aptr;

	argcount(nargs, 2);
	value_t a = args[0];
	n = tofixnum(args[1]);
	if(isfixnum(a)){
		if(n <= 0)
			return fixnum(numval(a)>>(-n));
		accum = ((int64_t)numval(a))<<n;
		return fits_fixnum(accum) ? fixnum(accum) : return_from_int64(accum);
	}
	if(iscprim(a) || iscvalue(a)){
		if(n == 0)
			return a;
		cp = ptr(a);
		ta = cp_numtype(cp);
		aptr = cp_data(cp);
		if(n < 0){
			n = -n;
			switch(ta){
			case T_INT8:   return fixnum((*(int8_t *)aptr) >> n);
			case T_UINT8:  return fixnum((*(uint8_t *)aptr) >> n);
			case T_INT16:  return fixnum((*(int16_t *)aptr) >> n);
			case T_UINT16: return fixnum((*(uint16_t*)aptr) >> n);
			case T_INT32:  return mk_int32((*(int32_t *)aptr) >> n);
			case T_UINT32: return mk_uint32((*(uint32_t*)aptr) >> n);
			case T_INT64:  return mk_int64((*(int64_t *)aptr) >> n);
			case T_UINT64: return mk_uint64((*(uint64_t*)aptr) >> n);
			case T_MPINT:
				aptr = cv_data(cp);
				mp = mpnew(0);
				mpright(*(mpint**)aptr, n, mp);
				return mk_mpint(mp);
			}
		}
		if(ta == T_MPINT){
			aptr = cv_data(cp);
			mp = mpnew(0);
			mpleft(*(mpint**)aptr, n, mp);
			return mk_mpint(mp);
		}
		if(ta == T_UINT64)
			return return_from_uint64((*(uint64_t*)aptr)<<n);
		if(ta < T_FLOAT)
			return return_from_int64(conv_to_int64(aptr, ta)<<n);
	}
	type_error("integer", a);
}

void
cvalues_init(void)
{
	htable_new(&TypeTable, 256);
	htable_new(&reverse_dlsym_lookup_table, 256);

	builtintype = define_opaque_type(builtinsym, sizeof(builtin_t), nil, nil);

	ctor_cv_intern(int8, T_INT8, int8_t);
	ctor_cv_intern(uint8, T_UINT8, uint8_t);
	ctor_cv_intern(int16, T_INT16, int16_t);
	ctor_cv_intern(uint16, T_UINT16, uint16_t);
	ctor_cv_intern(int32, T_INT32, int32_t);
	ctor_cv_intern(uint32, T_UINT32, uint32_t);
	ctor_cv_intern(int64, T_INT64, int64_t);
	ctor_cv_intern(uint64, T_UINT64, uint64_t);
	ctor_cv_intern(byte, T_UINT8, uint8_t);
	ctor_cv_intern(wchar, T_INT32, int32_t);
#if defined(ULONG64)
	ctor_cv_intern(long, T_INT64, int64_t);
	ctor_cv_intern(ulong, T_UINT64, uint64_t);
#else
	ctor_cv_intern(long, T_INT32, int32_t);
	ctor_cv_intern(ulong, T_UINT32, uint32_t);
#endif
	ctor_cv_intern(float, T_FLOAT, float);
	ctor_cv_intern(double, T_DOUBLE, double);

	ctor_cv_intern(array, NONNUMERIC, int);
	ctor_cv_intern(enum, NONNUMERIC, int);
	cv_intern(pointer);
	cv_intern(struct);
	cv_intern(union);
	cv_intern(void);
	cfunctionsym = symbol("c-function");

	stringtypesym = symbol("*string-type*");
	setc(stringtypesym, fl_list2(arraysym, bytesym));

	wcstringtypesym = symbol("*wcstring-type*");
	setc(wcstringtypesym, fl_list2(arraysym, wcharsym));

	mk_primtype(int8, int8_t);
	mk_primtype(uint8, uint8_t);
	mk_primtype(int16, int16_t);
	mk_primtype(uint16, uint16_t);
	mk_primtype(int32, int32_t);
	mk_primtype(uint32, uint32_t);
	mk_primtype(int64, int64_t);
	mk_primtype(uint64, uint64_t);
#if defined(ULONG64)
	mk_primtype(long, int64_t);
	mk_primtype(ulong, uint64_t);
#else
	mk_primtype(long, int32_t);
	mk_primtype(ulong, uint32_t);
#endif
	mk_primtype(byte, uint8_t);
	mk_primtype(wchar, int32_t);
	mk_primtype(float, float);
	mk_primtype(double, double);

	ctor_cv_intern(bignum, T_MPINT, mpint*);
	mpinttype = get_type(bignumsym);
	mpinttype->init = cvalue_mpint_init;
	mpinttype->vtable = &mpint_vtable;

	stringtype = get_type(symbol_value(stringtypesym));
	wcstringtype = get_type(symbol_value(wcstringtypesym));

	emptystringsym = symbol("*empty-string*");
	setc(emptystringsym, cvalue_static_cstring(""));
}