Beispiel #1
0
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;
}
Beispiel #2
0
Datei: nteh.c Projekt: 9rnsr/dmd
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
}
Beispiel #3
0
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;
}
Beispiel #4
0
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;
}
Beispiel #5
0
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;
}
Beispiel #6
0
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));
}
Beispiel #9
0
Datei: eh.c Projekt: Govelius/dmd
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;
}
Beispiel #10
0
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;
}
Beispiel #11
0
void put_symbol(Symbol symbol, hash_table_t table)
{
    char *name;

    name = symbol_name(symbol);
    add_key_value(name, symbol, table);
}
Beispiel #12
0
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;
}
Beispiel #13
0
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;
}
Beispiel #14
0
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;
}
Beispiel #15
0
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;
}
Beispiel #16
0
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;
}
Beispiel #17
0
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;
}
Beispiel #18
0
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;
    }
}
Beispiel #19
0
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;
}
Beispiel #20
0
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;
}
Beispiel #21
0
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);
}
Beispiel #23
0
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);
}
Beispiel #24
0
    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>";
    }
Beispiel #25
0
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;
}
Beispiel #26
0
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");
}
Beispiel #27
0
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);
}
Beispiel #28
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);
}
Beispiel #29
0
 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();
 }
Beispiel #30
0
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);
}