Symbol *objc_getMsgSend(Type *ret, bool hasHiddenArg) { if (hasHiddenArg) { if (!objc_smsgSend_stret) objc_smsgSend_stret = symbol_name("_objc_msgSend_stret", SCglobal, type_fake(TYhfunc)); return objc_smsgSend_stret; } // not sure if DMD can handle this else if (ret->ty == Tcomplex80) { if (!objc_smsgSend_fp2ret) objc_smsgSend_fp2ret = symbol_name("_objc_msgSend_fp2ret", SCglobal, type_fake(TYnfunc)); return objc_smsgSend_fp2ret; } else if (ret->ty == Tfloat80) { if (!objc_smsgSend_fpret) objc_smsgSend_fpret = symbol_name("_objc_msgSend_fpret", SCglobal, type_fake(TYnfunc)); return objc_smsgSend_fpret; } else { if (!objc_smsgSend) objc_smsgSend = symbol_name("_objc_msgSend", SCglobal, type_fake(TYnfunc)); return objc_smsgSend; } assert(0); return NULL; }
void nteh_declarvars(Blockx *bx) { symbol *s; //printf("nteh_declarvars()\n"); #if MARS if (!(bx->funcsym->Sfunc->Fflags3 & Fnteh)) // if haven't already done it { bx->funcsym->Sfunc->Fflags3 |= Fnteh; s = symbol_name(s_name_context,SCbprel,tsint); s->Soffset = -5 * 4; // -6 * 4 for C __try, __except, __finally s->Sflags |= SFLfree | SFLnodebug; type_setty(&s->Stype,mTYvolatile | TYint); symbol_add(s); bx->context = s; } #else if (!(funcsym_p->Sfunc->Fflags3 & Fnteh)) // if haven't already done it { funcsym_p->Sfunc->Fflags3 |= Fnteh; if (!s_context) s_context = scope_search(s_name_context_tag,CPP ? SCTglobal : SCTglobaltag); symbol_debug(s_context); s = symbol_name(s_name_context,SCbprel,s_context->Stype); s->Soffset = -6 * 4; // -5 * 4 for C++ s->Sflags |= SFLfree; symbol_add(s); type_setty(&s->Stype,mTYvolatile | TYstruct); s = symbol_name(s_name_ecode,SCauto,type_alloc(mTYvolatile | TYint)); s->Sflags |= SFLfree; symbol_add(s); } #endif }
static environment_t* rename(environment_t* e, cons_t* ids) { assert_type(PAIR, ids); // build a new environment and return it environment_t *r = null_environment(); // TODO: Below code runs in slow O(n^2) time for ( dict_t::const_iterator i = e->symbols.begin(); i != e->symbols.end(); ++i ) { std::string name = (*i).first; // find new name for ( cons_t *id = ids; !nullp(id); id = cdr(id) ) { assert_type(PAIR, car(id)); assert_type(SYMBOL, caar(id)); assert_type(SYMBOL, cadar(id)); if ( symbol_name(caar(id)) == name ) { name = symbol_name(cadar(id)); break; } } r->symbols[name] = (*i).second; } return r; }
type *TypeAArray::toCtype() { type *t; if (ctype) return ctype; if (0 && global.params.symdebug) { /* An associative array is represented by: * struct AArray { size_t length; void* ptr; } */ static Symbol *s; if (!s) { s = symbol_calloc("_AArray"); s->Sclass = SCstruct; s->Sstruct = struct_calloc(); s->Sstruct->Sflags |= 0; s->Sstruct->Salignsize = alignsize(); s->Sstruct->Sstructalign = global.structalign; s->Sstruct->Sstructsize = size(0); slist_add(s); Symbol *s1 = symbol_name("length", SCmember, Type::tsize_t->toCtype()); list_append(&s->Sstruct->Sfldlst, s1); Symbol *s2 = symbol_name("data", SCmember, Type::tvoidptr->toCtype()); s2->Smemoff = Type::tsize_t->size(); list_append(&s->Sstruct->Sfldlst, s2); } t = type_alloc(TYstruct); t->Ttag = (Classsym *)s; // structure tag name t->Tcount++; s->Stype = t; } else { if (global.params.symdebug == 1) { /* Generate D symbolic debug info, rather than C * Tnext: element type * Tkey: key type */ t = type_allocn(TYaarray, next->toCtype()); t->Tkey = index->toCtype(); t->Tkey->Tcount++; } else t = type_fake(TYaarray); } t->Tcount++; ctype = t; return t; }
type *TypeDelegate::toCtype() { type *t; if (ctype) return ctype; if (0 && global.params.symdebug) { /* A delegate consists of: * _Delegate { void* frameptr; Function *funcptr; } */ static Symbol *s; if (!s) { s = symbol_calloc("_Delegate"); s->Sclass = SCstruct; s->Sstruct = struct_calloc(); s->Sstruct->Sflags |= 0; s->Sstruct->Salignsize = alignsize(); s->Sstruct->Sstructalign = global.structalign; s->Sstruct->Sstructsize = size(0); slist_add(s); Symbol *s1 = symbol_name("frameptr", SCmember, Type::tvoidptr->toCtype()); list_append(&s->Sstruct->Sfldlst, s1); Symbol *s2 = symbol_name("funcptr", SCmember, Type::tvoidptr->toCtype()); s2->Smemoff = Type::tvoidptr->size(); list_append(&s->Sstruct->Sfldlst, s2); } t = type_alloc(TYstruct); t->Ttag = (Classsym *)s; // structure tag name t->Tcount++; s->Stype = t; } else { if (global.params.symdebug == 1) { // Generate D symbolic debug info, rather than C t = type_allocn(TYdelegate, next->toCtype()); } else t = type_fake(TYdelegate); } t->Tcount++; ctype = t; return t; }
type *TypeDArray::toCtype() { type *t; if (ctype) return ctype; if (0 && global.params.symdebug) { /* Create a C type out of: * struct _Array_T { size_t length; T* data; } */ Symbol *s; char *id; assert(next->deco); id = (char *) alloca(7 + strlen(next->deco) + 1); sprintf(id, "_Array_%s", next->deco); s = symbol_calloc(id); s->Sclass = SCstruct; s->Sstruct = struct_calloc(); s->Sstruct->Sflags |= 0; s->Sstruct->Salignsize = alignsize(); s->Sstruct->Sstructalign = global.structalign; s->Sstruct->Sstructsize = size(0); slist_add(s); Symbol *s1 = symbol_name("length", SCmember, Type::tsize_t->toCtype()); list_append(&s->Sstruct->Sfldlst, s1); Symbol *s2 = symbol_name("data", SCmember, next->pointerTo()->toCtype()); s2->Smemoff = Type::tsize_t->size(); list_append(&s->Sstruct->Sfldlst, s2); t = type_alloc(TYstruct); t->Ttag = (Classsym *)s; // structure tag name t->Tcount++; s->Stype = t; } else { if (global.params.symdebug == 1) { // Generate D symbolic debug info, rather than C t = type_allocn(TYdarray, next->toCtype()); } else t = type_fake(TYdarray); } t->Tcount++; ctype = t; return t; }
cons_t* proc_env_assign(cons_t* p, environment_t*) { assert_length(p, 3); assert_type(ENVIRONMENT, car(p)); assert_type(SYMBOL, cadr(p)); const std::string name = symbol_name(cadr(p)); environment_t *e = car(p)->environment; cons_t *value = caddr(p); if ( value == NULL ) raise(runtime_exception( "Symbol is not bound in any environment: " + name)); environment_t *i = e; // search for definition and set if found for ( ; i != NULL; i = i->outer ) { if ( i->symbols.find(name) != i->symbols.end() ) { i->symbols[name] = value; return nil(); } } // only set if NOT found if ( i == NULL ) e->define(name, value); return nil(); }
/* * (set-video-mode <width> <height> <bits per pixel>?) or * (set-video-mode <width> <height> <bits per pixel> <mode flags>+) * * where <symbols> are: * swsurface * hwsurface * asyncblit * anyformat * hwpalette * doublebuf * fullscreen * opengl * openglblit * resizable * noframe * */ cons_t* set_video_mode(cons_t* p, environment_t*) { assert_length_min(p, 2); assert_type(INTEGER, car(p)); assert_type(INTEGER, cadr(p)); // dimension int x = car(p)->integer; int y = cadr(p)->integer; // default values int bits = 32; uint32_t mode = 0; /////////////////// raise(runtime_exception("Testing")); /////////////////// // bits per pixel if ( integerp(caddr(p)) ) bits = caddr(p)->integer; // options cons_t *opts = symbolp(caddr(p))? cddr(p) : symbolp(cadddr(p))? cdddr(p) : nil();; for ( cons_t *s = opts; !nullp(s); s = cdr(s) ) { assert_type(SYMBOL, car(s)); std::string sym = symbol_name(s); int size = sizeof(sdl_flags) / sizeof(key_value_t<std::string, uint32_t>); for ( int n=0; n < size; ++n ) if ( sym == sdl_flags[n].key ) { /////////////////// printf("flag %s\n", sym.c_str()); printf("value %d and %d\n", sdl_flags[n].value, SDL_HWSURFACE); /////////////////// mode |= sdl_flags[n].value; goto NEXT_FLAG; } raise(runtime_exception("Unknown SDL video mode flag: " + sym)); NEXT_FLAG: continue; } mode = SDL_HWSURFACE; /////////////////// printf("video mode\n"); fflush(stdout); /////////////////// SDL_Surface *screen = SDL_SetVideoMode(x, y, bits, mode); if ( screen == NULL ) raise(runtime_exception(SDL_GetError())); return pointer(new pointer_t("sdl-surface", (void*)screen)); }
symbol *except_gentables() { //printf("except_gentables()\n"); if (OUREH) { // BUG: alloca() changes the stack size, which is not reflected // in the fixed eh tables. assert(!usedalloca); char name[13+5+1]; static int tmpnum; sprintf(name,"_HandlerTable%d",tmpnum++); symbol *s = symbol_name(name,SCstatic,tsint); symbol_keep(s); symbol_debug(s); except_fillInEHTable(s); outdata(s); // output the scope table objmod->ehtables(funcsym_p,funcsym_p->Ssize,s); } return NULL; }
Symbol *objc_getMethVarRef(const char *s, size_t len) { objc_hasSymbols = true; StringValue *sv = objc_smethVarRefTable->update(s, len); Symbol *refsymbol = (Symbol *) sv->ptrvalue; if (refsymbol == NULL) { // create data dt_t *dt = NULL; Symbol *sselname = objc_getMethVarName(s, len); dtxoff(&dt, sselname, 0, TYnptr); // find segment int seg = objc_getSegment(SEGselrefs); // create symbol static size_t selcount = 0; char namestr[42]; sprintf(namestr, "L_OBJC_SELECTOR_REFERENCES_%lu", selcount); refsymbol = symbol_name(namestr, SCstatic, type_fake(TYnptr)); refsymbol->Sdt = dt; refsymbol->Sseg = seg; outdata(refsymbol); sv->ptrvalue = refsymbol; ++selcount; } return refsymbol; }
void put_symbol(Symbol symbol, hash_table_t table) { char *name; name = symbol_name(symbol); add_key_value(name, symbol, table); }
static environment_t* import_set(cons_t* p) { std::string s = symbol_name(car(p)); /* * Each import set can be either of: */ // (rename <import set> (<identifier1> <identifier2>) ...) if ( s == "rename" ) return rename(import_set(cadr(p)), cddr(p)); // (prefix <import set> <identifier>) else if ( s == "prefix" ) return prefix(import_set(cadr(p)), caddr(p)); // (only <import set> <identifier> ...) else if ( s == "only" ) return only(import_set(cadr(p)), cddr(p)); // (except <import set> <identifier> ...) else if ( s == "except" ) return except(import_set(cadr(p)), cddr(p)); // <library name> else if ( !s.empty() ) return import_library(sprint(p)); raise(runtime_exception("Unknown import set: " + sprint(p))); return NULL; }
static environment_t* except(environment_t* e, cons_t* ids) { assert_type(PAIR, ids); // build a new environment and return it environment_t *r = null_environment(); for ( dict_t::const_iterator i = e->symbols.begin(); i != e->symbols.end(); ++i ) { std::string name = (*i).first; // do not import specified name // TODO: Fix slow O(n^2) algo below for ( cons_t *id = ids; !nullp(id); id = cdr(id) ) { assert_type(SYMBOL, car(id)); if ( symbol_name(car(id)) == name ) goto DO_NOT_IMPORT; } r->symbols[name] = (*i).second; DO_NOT_IMPORT: continue; } return r; }
Symbol *Dsymbol::toSymbolX(const char *prefix, int sclass, type *t, const char *suffix) { //printf("Dsymbol::toSymbolX('%s')\n", prefix); const char *n = mangle(); assert(n); size_t nlen = strlen(n); size_t prefixlen = strlen(prefix); size_t idlen = 2 + nlen + sizeof(size_t) * 3 + prefixlen + strlen(suffix) + 1; char idbuf[20]; char *id = idbuf; if (idlen > sizeof(idbuf)) { id = (char *)malloc(idlen); assert(id); } int nwritten = sprintf(id,"_D%s%llu%s%s", n, (unsigned long long)prefixlen, prefix, suffix); assert((unsigned)nwritten < idlen); // nwritten does not include the terminating 0 char Symbol *s = symbol_name(id, sclass, t); if (id != idbuf) free(id); //printf("-Dsymbol::toSymbolX() %s\n", id); return s; }
value_t fl_defined_julia_global(value_t *args, uint32_t nargs) { argcount("defined-julia-global", nargs, 1); (void)tosymbol(args[0], "defined-julia-global"); char *name = symbol_name(args[0]); return jl_boundp(jl_current_module, jl_symbol(name)) ? FL_T : FL_F; }
static void ase_metric_prnt(Lisp_Object obj, Lisp_Object pcf, int unused) { EMOD_ASE_DEBUG_METR("m:0x%08x@0x%08x (rc:%d)\n", (unsigned int)(XASE_METRIC(obj)), (unsigned int)obj, 1); write_c_string("#<", pcf); print_internal(XDYNACAT_TYPE(obj), pcf, unused); { if (NILP(XASE_METRIC_LDIST(obj))) { write_hex_ptr(XASE_METRIC_DIST(obj),pcf); } else { Lisp_Object ldist = XASE_METRIC_LDIST(obj); if (SYMBOLP(ldist)) { Lisp_String *name = symbol_name(XSYMBOL(ldist)); write_fmt_string(pcf, " #'%s", string_data(name)); } else if (SUBRP(ldist)) { const char *name = subr_name(XSUBR(ldist)); write_fmt_string(pcf, " #'%s", name); } else { write_c_string(" #'(lambda ...)", pcf); } } } write_c_string(">", pcf); return; }
symbol *except_gentables() { //printf("except_gentables()\n"); if (config.ehmethod == EH_DM) { // BUG: alloca() changes the stack size, which is not reflected // in the fixed eh tables. if (Alloca.size) error(NULL, 0, 0, "cannot mix core.std.stdlib.alloca() and exception handling in %s()", funcsym_p->Sident); char name[13+5+1]; static int tmpnum; sprintf(name,"_HandlerTable%d",tmpnum++); symbol *s = symbol_name(name,SCstatic,tsint); symbol_keep(s); symbol_debug(s); except_fillInEHTable(s); outdata(s); // output the scope table objmod->ehtables(funcsym_p,funcsym_p->Ssize,s); } return NULL; }
void tape_print(FILE *out) { extern tape_block *head; extern tape_block *leftmost; tape_block *b; b = leftmost; while(b != NULL) { if(b == leftmost) fprintf(out, "|"); if(b == head) fprintf(out, "_%s_|", symbol_name(b->sym)); else fprintf(out, " %s |", symbol_name(b->sym)); b = b->next; } }
Symbol *Dsymbol::toSymbolX(const char *prefix, int sclass, type *t, const char *suffix) { Symbol *s; char *id; const char *n; size_t nlen; //printf("Dsymbol::toSymbolX('%s')\n", prefix); n = mangle(); assert(n); nlen = strlen(n); #if 0 if (nlen > 2 && n[0] == '_' && n[1] == 'D') { nlen -= 2; n += 2; } #endif id = (char *) alloca(2 + nlen + sizeof(size_t) * 3 + strlen(prefix) + strlen(suffix) + 1); sprintf(id,"_D%s%zu%s%s", n, strlen(prefix), prefix, suffix); #if 0 if (global.params.isWindows && (type_mangle(t) == mTYman_c || type_mangle(t) == mTYman_std)) id++; // Windows C mangling will put the '_' back in #endif s = symbol_name(id, sclass, t); //printf("-Dsymbol::toSymbolX() %s\n", id); return s; }
LISPTR lisp_print(LISPTR x, FILE* out) { if (consp(x)) { fputwc('(', out); while (true) { lisp_print(car(x), out); x = cdr(x); if (!consp(x)) { if (x != NIL) { fputws(L" . ", out); lisp_print(x, out); } break; } fputwc(' ', out); } fputwc(')', out); } else if (symbolp(x)) { fputws(string_text(symbol_name(x)), out); } else if (numberp(x)) { fwprintf(out, L"%g", number_value(x)); } else if (stringp(x)) { fputwc('"', out); fputws(string_text(x), out); fputwc('"', out); } else { fputws(L"*UNKOBJ*", out); } return x; }
static int lengthestimate(value_t v) { // get the width of an expression if we can do so cheaply if (issymbol(v)) return u8_strwidth(symbol_name(v)); return -1; }
/* * Query sizes of basic C data types. * */ extern "C" cons_t* proc_sizeof(cons_t* p, environment_t*) { static struct { const char* name; size_t size; } sizes[] = { {"char", sizeof(char)}, {"int", sizeof(int)}, {"long", sizeof(long)}, {"longlong", sizeof(long long)}, {"pointer", sizeof(void*)}, // shorthand {"short", sizeof(short)}, {"void*", sizeof(void*)}, {NULL, 0} }; assert_length(p, 1); assert_type(SYMBOL, car(p)); std::string s = symbol_name(car(p)); for ( size_t n=0; sizes[n].name != NULL; ++n ) if ( s == sizes[n].name ) return integer(sizes[n].size); // not found return boolean(false); }
void win64_pdata(Symbol *sf) { // return; // doesn't work yet //printf("win64_pdata()\n"); assert(config.exe == EX_WIN64); // Generate the pdata name, which is $pdata$funcname size_t sflen = strlen(sf->Sident); char *pdata_name = (char *)alloca(7 + sflen + 1); assert(pdata_name); memcpy(pdata_name, "$pdata$", 7); memcpy(pdata_name + 7, sf->Sident, sflen + 1); // include terminating 0 symbol *spdata = symbol_name(pdata_name,SCstatic,tsint); symbol_keep(spdata); symbol_debug(spdata); symbol *sunwind = win64_unwind(sf); /* 3 pointers are emitted: * 1. pointer to start of function sf * 2. pointer past end of function sf * 3. pointer to unwind data */ dt_t **pdt = &spdata->Sdt; pdt = dtxoff(pdt,sf,0,TYint); // Note the TYint, these are 32 bit fixups pdt = dtxoff(pdt,sf,retoffset + retsize,TYint); pdt = dtxoff(pdt,sunwind,0,TYint); spdata->Sseg = symbol_iscomdat(sf) ? MsCoffObj::seg_pdata_comdat(sf) : MsCoffObj::seg_pdata(); spdata->Salignment = 4; outdata(spdata); }
static const wchar_t *block_name(C_procedure_t *block, obj_t *env) { if (block == b_eval) return L"b_eval"; if (block == b_accum_operator) return L"b_accum_operator"; if (block == b_accum_arg) return L"b_accum_arg"; if (block == b_eval_sequence) return L"b_eval_sequence"; if (block == NULL) return L"NULL"; /* XXX Move this code into env.c. */ if (!env) env = library_env(r6rs_library()); if (is_pair(env)) { obj_t *frame = pair_car(env); while (frame) { obj_t *binding = pair_car(frame); obj_t *value = binding_value(binding); if (is_procedure(value) && procedure_is_C(value)) { C_procedure_t *body; body = (C_procedure_t *)procedure_body(value); if (body == block) { obj_t *name = symbol_name(binding_name(binding)); return string_value(name); } } frame = pair_cdr(frame); } } return L"<some-proc>"; }
static environment_t* only(environment_t* e, cons_t* ids) { assert_type(PAIR, ids); // build a new environment and return it environment_t *r = null_environment(); for ( dict_t::const_iterator i = e->symbols.begin(); i != e->symbols.end(); ++i ) { std::string name = (*i).first; // only import specified names // TODO: Fix slow O(n^2) algo below for ( cons_t *id = ids; !nullp(id); id = cdr(id) ) { assert_type(SYMBOL, car(id)); if ( symbol_name(car(id)) == name ) { r->symbols[name] = (*i).second; break; } } } return r; }
obj_t *env_lookup(env_t *env, obj_t *var) { /* * for frame in env: * for binding in frame: * if binding.name == var: * return binding * assert False, 'unbound variable' */ assert(is_symbol(var)); #if ENV_TRACE printf_unchecked("lookup(%ls, %O)\n", string_value(symbol_name(var)), env); #endif while (!is_null(env)) { obj_t *frame = pair_car(env); #if ENV_TRACE if (pair_cdr(env)) { printf(" FRAME"); obj_t *p = frame; while (!is_null(p)) { printf_unchecked(" %O: %O", binding_name(pair_car(p)), binding_value(pair_car(p))); p = pair_cdr(p); } printf("\n"); } else { printf(" FRAME [builtins]\n"); } #endif while (!is_null(frame)) { obj_t *binding = pair_car(frame); assert(is_binding(binding)); if (binding_name(binding) == var) { #if ENV_TRACE printf(" found\n\n"); #endif return binding; } frame = pair_cdr(frame); } env = pair_cdr(env); } fprintf(stderr, "unbound variable \"%ls\"\n", string_value(symbol_name(var))); assert(false && "unbound variable"); }
int calc_parser::emitstr (int n, char* str) { int sti; int i, x; char string[1000]; char *symb, *s, *p; // Get symbol from node. sti = node[n].sti; if (sti < 0) symb = term_symb[-sti]; else symb = symbol_name(sti); // Scan string for &-codes ... p = str; s = string; while (1) { *s = *p; if (*s == 0) { fprintf (outputdesc, string, symb); return (0); } if (*s == '&') // &-code ? { if (numeric[*++p]) // number ? { x = *p - '0'; while (numeric[*++p]) x = 10*x + *p - '0'; i = stacki - x; if (i < 0) *s++ = '?'; // Error. else { switch (*p) { case 'c': s += sprintf (s, "%d", stack[i].counter); // Get counter. p++; break; // case 'n': // s += sprintf (s, "%s", node_name[stack[i].id]); // Get node name. // p++; // break; default: s += sprintf (s, "%d", stack[i].counter); // Get counter. break; } } } else s++; } else { s++; p++; } } return (0); }
static inline int tinyp(value_t v) { if (issymbol(v)) return (u8_strwidth(symbol_name(v)) < SMALL_STR_LEN); if (fl_isstring(v)) return (cv_len((cvalue_t*)ptr(v)) < SMALL_STR_LEN); return (isfixnum(v) || isbuiltin(v) || v==FL_F || v==FL_T || v==FL_NIL || v == FL_EOF); }
string asset::to_string()const { string result = fc::to_string(amount.value / precision()); if( decimals() ) { auto fract = amount.value % precision(); result += "." + fc::to_string(precision() + fract).erase(0,1); } return result + " " + symbol_name(); }
static inline int tinyp(fl_context_t *fl_ctx, value_t v) { if (issymbol(v)) return (u8_strwidth(symbol_name(fl_ctx, v)) < SMALL_STR_LEN); if (fl_isstring(fl_ctx, v)) return (cv_len((cvalue_t*)ptr(v)) < SMALL_STR_LEN); return (isfixnum(v) || isbuiltin(v) || v==fl_ctx->F || v==fl_ctx->T || v==fl_ctx->NIL || v == fl_ctx->FL_EOF); }