#include "inc/priv.h"#include "inc/cvalues.h"#include "inc/print.h"#include "inc/types.h"#include "libtcc.h" static sl_v ccsym, vtbtypesym[VT_BTYPE+1];static sl_v vtunsignedsym, vtsignedsym, vtarraysym, vtbitfieldsym, vtconstantsym;static sl_v vtvolatilesym, vtvlasym, vtlongsym, vtunionsym, vtenumsym;static sl_v vtexternsym, vtstaticsym, vttypedefsym, vtinlinesym;static const sl_type *cctype; typedef struct sl_cc sl_cc; struct sl_cc {	TCCState *s;	sl_v filename;	sl_v error_func;	sl_v decl_func;	sl_v define_func;	sl_htable *types;}; sl_nonnull(2)static sl_vmk_vt_mod(int t, CType *ctype){	sl_v m[8], v;	int n = 0; 	if(t & VT_DEFSIGN)		m[n++] = (t & VT_UNSIGNED) ? vtunsignedsym : vtsignedsym;	if(t & VT_ARRAY){		m[n++] = vtarraysym;		m[n++] = size_wrap(tcc_ctype_array_size(ctype));	}	if(t & VT_BITFIELD)		m[n++] = vtbitfieldsym;	if(t & VT_CONSTANT)		m[n++] = vtconstantsym;	if(t & VT_VOLATILE)		m[n++] = vtvolatilesym;	if(t & VT_VLA)		m[n++] = vtvlasym;	if(t & VT_LONG)		m[n++] = vtlongsym; 	if(n == 0)		return sl_nil;	v = alloc_vec(n, false);	for(int i = 0; i < n; i++)		vec_elt(v, i) = m[i];	return v;} static sl_vmk_storage(int t){	sl_v v, s[4];	int n = 0; 	if(t & VT_EXTERN)		s[n++] = vtexternsym;	if(t & VT_STATIC)		s[n++] = vtstaticsym;	if(t & VT_TYPEDEF)		s[n++] = vttypedefsym;	if(t & VT_INLINE)		s[n++] = vtinlinesym; 	if(n == 0)		return sl_nil;	v = alloc_vec(n, false);	for(int i = 0; i < n; i++)		vec_elt(v, i) = s[i];	return v;} static booliscc(sl_v v){	return iscvalue(v) && cvalue_class(v) == cctype;} sl_nonnull(1, 2)static voiderror_func(void *aux, const char *msg){	sl_v v = (sl_v)aux;	sl_cc *c = value2c(sl_cc*, v); 	if(c->error_func != sl_nil){		sl_gc_handle(&v);		sl_applyn(1, c->error_func, str_from_cstr(msg));		sl_free_gc_handles(1);	}} static sl_vmk_vt(int t){	if(IS_ENUM(t))		return vtenumsym;	if(IS_UNION(t))		return vtunionsym;	return vtbtypesym[t & VT_BTYPE];} sl_nonnull(1, 3)static sl_vmk_csymbol(sl_htable *types, int val, CType *ctype){	int t = ctype->t;	const char *cname = (val & ~SYM_FIELD) != 0 ? tcc_token_to_str(val) : nil;	sl_v v = cname != nil ? str_from_cstr(cname) : sl_nil; 	if((t & ~VT_BTYPE) == 0 && t != VT_PTR && t != VT_STRUCT && t != VT_FUNC) {		// nameless and basic type - return the type itself		sl_v vt = mk_vt(t);		if(v == sl_nil)			return vt;		// with a name return (type . name)		PUSH_SAFE(v);		sl_v c = alloc_cons();		car_(c) = vt;		cdr_(c) = POP();		return c;	} 	if(ctype->ref != nil){		sl_v ref = (sl_v)ptrhash_get(types, ctype->ref);		if(ref != (sl_v)HT_NOTFOUND){			// if the type was known before - use (type . name)			PUSH_SAFE(ref);			sl_v c = alloc_cons();			car_(c) = POP();			cdr_(c) = v;			return c;		}	}	PUSH_SAFE(v); 	int n = 0;	for(Sym *sym = ctype->ref; sym != nil; sym = tcc_sym_next(sym))		n++;	v = alloc_vec(4+n, true);	if(ctype->ref != nil)		ptrhash_put(types, ctype->ref, (void*)v);	int i = 0;	vec_elt(v, i++) = sl.sp[-1];	sl.sp[-1] = v;	v = mk_storage(t);	vec_elt(sl.sp[-1], i++) = v;	v = mk_vt_mod(t, ctype);	vec_elt(sl.sp[-1], i++) = v;	v = mk_vt(t);	vec_elt(sl.sp[-1], i++) = v; 	for(Sym *sym = ctype->ref; sym != nil; sym = tcc_sym_next(sym)){		if(!IS_ENUM(t) || sym == ctype->ref)			v = mk_csymbol(types, tcc_sym_token(sym), tcc_sym_type(sym));		else{ // for enums use (value . identifier)			v = alloc_cons();			car_(v) = sl_nil;			cdr_(v) = sl_nil;			PUSH_SAFE(v);			v = return_from_s64(tcc_sym_enum_val(sym));			car_(sl.sp[-1]) = v;			v = str_from_cstr(tcc_token_to_str(tcc_sym_token(sym)));			cdr_(sl.sp[-1]) = v;			v = POP();		}		vec_elt(sl.sp[-1], i++) = v;	}	return POP();} sl_nonnull(1, 2, 6)static voiddecl_func(void *aux, const char *cfilename, int line, int val, int l, CType *ctype){	if(l != VT_CONST)		return; 	sl_v v = (sl_v)aux;	sl_cc *c = value2c(sl_cc*, v);	sl_htable *types = c->types; 	if(c->decl_func != sl_nil){		sl_gc_handle(&v);		if(c->filename == sl_nil || strcmp(tostr(c->filename), cfilename) != 0)			c->filename = str_from_cstr(cfilename);		sl_v sym = mk_csymbol(types, val, ctype);		c = value2c(sl_cc*, v);		sl_applyn(			3, c->decl_func,			c->filename,			fixnum(line),			sym		);		// FIXME(sigrid): this won't get called if the callback throws		sl_free_gc_handles(1);	}} static voiddefine_func(void *aux, const char *cfilename, int line, int val, int macro_type, int *str){	sl_v v = (sl_v)aux;	sl_cc *c = value2c(sl_cc*, v); 	if(c->define_func != sl_nil && macro_type == MACRO_OBJ){		sl_gc_handle(&v);		if(c->filename == sl_nil || strcmp(tostr(c->filename), cfilename) != 0)			c->filename = str_from_cstr(cfilename);		const char *cname = tcc_token_to_str(val);		sl_v name = str_from_cstr(cname);		sl_v value = sl_nil;		char *cstr = tcc_macro_to_str(str);		int len;		if(cstr != nil && (len = strlen(cstr)) > 0){			sl_gc_handle(&name);			value = cvalue_str(len);			memcpy(cvalue_data(value), cstr, len);		}		c = value2c(sl_cc*, v);		sl_applyn(4, c->define_func, c->filename, fixnum(line), name, value);		// FIXME(sigrid): this won't get called if the callback throws		sl_free_gc_handles(1 + (value != sl_nil));	}} BUILTIN("make-cc", make_cc){	argcount_most(1);	sl_v errfn = sl_nil;	if(nargs > 0){		errfn = args[0];		if(errfn != sl_nil && sl_unlikely(!isfn(errfn)))			bthrow(type_error(nil, "(or fn NIL)", errfn));	}	TCCState *s = tcc_new();	sl_htable *types = MEM_ALLOC(sizeof(*types));	if(sl_unlikely(s == nil || types == nil)){		if(s != nil)			tcc_delete(s);		else			MEM_FREE(types);		bthrow(error(sl_errmem, "could not allocate C code object"));	}	sl_v v = cvalue(cctype, sizeof(sl_cc));	sl_cc *c = value2c(sl_cc*, v);	c->s = s;	c->filename = sl_nil;	c->error_func = errfn;	c->decl_func = sl_nil;	c->define_func = sl_nil;	c->types = types;	htable_new(c->types, HT_N_INLINE);	tcc_set_output_type(s, TCC_OUTPUT_MEMORY);	tcc_set_error_func(s, (void*)v, error_func);	tcc_set_decl_func(s, (void*)v, decl_func);	tcc_set_define_func(s, (void*)v, define_func);	return v;} BUILTIN("cc?", ccp){	argcount(1);	return iscc(args[0]) ? sl_t : sl_nil;} BUILTIN("cc-compile", cc_compile){	argcount(4);	sl_v v = args[0];	if(sl_unlikely(!iscc(v)))		bthrow(type_error(nil, "cc", v));	sl_v d = args[1];	if(sl_unlikely(!isstr(d)))		bthrow(type_error(nil, "(or str io)", d));	sl_v decl_func = args[2];	if(decl_func != sl_nil && sl_unlikely(!isfn(decl_func)))		bthrow(type_error(nil, "fn", decl_func));	sl_v define_func = args[3];	if(define_func != sl_nil && sl_unlikely(!isfn(define_func)))		bthrow(type_error(nil, "fn", define_func)); 	sl_cc *c = value2c(sl_cc*, v);	htable_reset(c->types, c->types->size);	u64int tmp;	usize sz, esz;	char *data = (char*)to_sized_ptr(d, &sz, &esz, &tmp);	c->decl_func = decl_func;	c->define_func = define_func;	return tcc_compile_string(c->s, data) < 0 ? sl_nil : sl_t;} BUILTIN("cc-relocate", cc_relocate){	argcount(1);	sl_v v = args[0];	if(sl_unlikely(!iscc(v)))		bthrow(type_error(nil, "cc", v));	sl_cc *c = value2c(sl_cc*, v);	return tcc_relocate(c->s) < 0 ? sl_nil : sl_t;} BUILTIN("cc-set-options", cc_set_options){	argcount(2);	sl_v v = args[0];	if(sl_unlikely(!iscc(v)))		bthrow(type_error(nil, "cc", v));	// FIXME(sigrid): use a list instead; multiple space-separated arguments would be TCC-specific	char *opts = tostr(args[1]);	sl_cc *c = value2c(sl_cc*, v);	tcc_set_options(c->s, opts);	return sl_void;} BUILTIN("cc-add-include-path", cc_add_include_path){	argcount(2);	sl_v v = args[0];	if(sl_unlikely(!iscc(v)))		bthrow(type_error(nil, "cc", v));	char *p = tostr(args[1]);	sl_cc *c = value2c(sl_cc*, v);	tcc_add_include_path(c->s, p);	return sl_void;} BUILTIN("cc-add-sysinclude-path", cc_add_sysinclude_path){	argcount(2);	sl_v v = args[0];	if(sl_unlikely(!iscc(v)))		bthrow(type_error(nil, "cc", v));	char *p = tostr(args[1]);	sl_cc *c = value2c(sl_cc*, v);	tcc_add_sysinclude_path(c->s, p);	return sl_void;} BUILTIN("cc-add-library-path", cc_add_library_path){	argcount(2);	sl_v v = args[0];	if(sl_unlikely(!iscc(v)))		bthrow(type_error(nil, "cc", v));	char *p = tostr(args[1]);	sl_cc *c = value2c(sl_cc*, v);	tcc_add_library_path(c->s, p);	return sl_void;} BUILTIN("cc-add-file", cc_add_file){	argcount(2);	sl_v v = args[0];	if(sl_unlikely(!iscc(v)))		bthrow(type_error(nil, "cc", v));	char *p = tostr(args[1]);	sl_cc *c = value2c(sl_cc*, v);	if(tcc_add_file(c->s, p) < 0)		return sl_nil;	return sl_t;} BUILTIN("cc-define", cc_define){	argcount_least(2);	argcount_most(3);	sl_v v = args[0];	if(sl_unlikely(!iscc(v)))		bthrow(type_error(nil, "cc", v));	char *s = tostr(args[1]);	char *val = nargs < 3 ? nil : tostr(args[2]);	sl_cc *c = value2c(sl_cc*, v);	tcc_define_symbol(c->s, s, val);	return sl_void;} BUILTIN("cc-undefine", cc_undefine){	argcount(2);	sl_v v = args[0];	if(sl_unlikely(!iscc(v)))		bthrow(type_error(nil, "cc", v));	char *s = tostr(args[1]);	sl_cc *c = value2c(sl_cc*, v);	tcc_undefine_symbol(c->s, s);	return sl_void;} static voidprint_cc(sl_v v){	USED(v);	sl_print_str("#<cc>", true);} static voidrelocate_cc(sl_v oldv, sl_v newv){	USED(oldv);	sl_cc *c = value2c(sl_cc*, newv);	c->filename = sl_relocate(c->filename);	c->error_func = sl_relocate(c->error_func);	c->decl_func = sl_relocate(c->decl_func);	c->define_func = sl_relocate(c->define_func);	tcc_set_error_func(c->s, (void*)newv, error_func);	tcc_set_decl_func(c->s, (void*)newv, decl_func);	tcc_set_define_func(c->s, (void*)newv, define_func);	sl_htable *h = c->types;	for(usize i = 0, k = 0; k < h->live && i < h->size; i += 2){		if(h->table[i+1] == HT_NOTFOUND)			continue;		k++;		h->table[i+1] = (void*)sl_relocate((sl_v)h->table[i+1]);	}} static voidfree_cc(sl_v self){	sl_cc *c = value2c(sl_cc*, self);	if(c->s != nil){		tcc_delete(c->s);		c->s = nil;		htable_free(c->types);		MEM_FREE(c->types);	}} static sl_cvtable cc_vtable = {	print_cc,	relocate_cc,	free_cc,	nil,	nil,}; voidbcc_init(void){	ccsym = mk_sym("cc", false);	cctype = define_opaque_type(ccsym, sizeof(sl_cc), &cc_vtable, nil); 	vtbtypesym[VT_VOID] = mk_sym("void", false);	vtbtypesym[VT_BYTE] = mk_sym("byte", false);	vtbtypesym[VT_SHORT] = mk_sym("short", false);	vtbtypesym[VT_INT] = mk_sym("int", false);	vtbtypesym[VT_LLONG] = mk_sym("llong", false);	vtbtypesym[VT_PTR] = mk_sym("ptr", false);	vtbtypesym[VT_FUNC] = mk_sym("func", false);	vtbtypesym[VT_STRUCT] = mk_sym("struct", false);	vtbtypesym[VT_FLOAT] = mk_sym("float", false);	vtbtypesym[VT_DOUBLE] = mk_sym("double", false);	vtbtypesym[VT_BOOL] = mk_sym("bool", false);	vtbtypesym[VT_QLONG] = mk_sym("qlong", false);	vtbtypesym[VT_QFLOAT] = mk_sym("qfloat", false); 	vtunsignedsym = mk_sym("unsigned", false);	vtsignedsym = mk_sym("signed", false);	vtarraysym = mk_sym("array", false);	vtbitfieldsym = mk_sym("bitfield", false);	vtconstantsym = mk_sym("constant", false);	vtvolatilesym = mk_sym("volatile", false);	vtvlasym = mk_sym("vla", false);	vtlongsym = mk_sym("long", false); 	vtunionsym = mk_sym("union", false);	vtenumsym = mk_sym("enum", false); 	vtexternsym = mk_sym("extern", false);	vtstaticsym = mk_sym("static", false);	vttypedefsym = mk_sym("typedef", false);	vtinlinesym = mk_sym("inline", false);}