klisp

an open source interpreter for the Kernel Programming Language.
git clone http://git.hanabi.in/repos/klisp.git
Log | Files | Refs | README

ksymbol.c (4611B)

      1 /*
      2 ** ksymbol.c
      3 ** Kernel Symbols
      4 ** See Copyright Notice in klisp.h
      5 */
      6 
      7 #include <string.h>
      8 
      9 #include "ksymbol.h"
     10 #include "kobject.h"
     11 #include "kstate.h"
     12 #include "kmem.h"
     13 #include "kgc.h"
     14 /* for immutable table */
     15 #include "kstring.h" 
     16 
     17 /* NOTE: symbols can have source info, they should be compared with
     18    tv_sym_equal, NOT tv_equal */
     19 
     20 /* No case folding is performed by these constructors */
     21 
     22 /*
     23 ** Interned symbols are only the ones that don't have source info 
     24 ** (like those created with string->symbol) 
     25 */
     26 static uint32_t get_symbol_hash(const char *buf, uint32_t size)
     27 {
     28     uint32_t h = size; /* seed */
     29     size_t step = (size>>5)+1; /* if string is too long, don't hash all 
     30                                   its chars */
     31     size_t size1;
     32     for (size1 = size; size1 >= step; size1 -= step)  /* compute hash */
     33         h = h ^ ((h<<5)+(h>>2)+ ((unsigned char) buf[size1-1]));
     34 
     35     h = ~h; /* symbol hash should be different from string hash
     36                otherwise symbols and their respective immutable string
     37                would always fall in the same bucket */
     38     return h;
     39 }
     40 
     41 /* Looks for a symbol in the stringtable and returns a pointer
     42    to it if found or NULL otherwise.  */
     43 static Symbol *search_in_symbol_table(klisp_State *K, const char *buf, 
     44 				      uint32_t size, uint32_t h)
     45 {
     46     for (GCObject *o = G(K)->strt.hash[lmod(h, G(K)->strt.size)];
     47          o != NULL; o = o->gch.next) {
     48         klisp_assert(o->gch.tt == K_TKEYWORD || o->gch.tt == K_TSYMBOL || 
     49   	  	 o->gch.tt == K_TSTRING || o->gch.tt == K_TBYTEVECTOR);
     50 
     51         if (o->gch.tt != K_TSYMBOL) continue;
     52 
     53 	String *ts = tv2str(((Symbol *) o)->str);
     54 	if (ts->size == size && (memcmp(buf, ts->b, size) == 0)) {
     55 	    /* symbol and/or string may be dead */
     56 	    if (isdead(G(K), o)) changewhite(o);
     57 	    if (isdead(G(K), (GCObject *) ts)) changewhite((GCObject *) ts);
     58 	    return (Symbol *) o;
     59 	}
     60     }
     61 
     62     /* If it exits the loop, it means it wasn't found */
     63     return NULL;
     64 }
     65 
     66 TValue ksymbol_new_bs(klisp_State *K, const char *buf, uint32_t size, TValue si)
     67 {
     68     /* First calculate the hash */
     69     uint32_t h = get_symbol_hash(buf, size);
     70   
     71     /* look for it in the table only if it doesn't have source info */
     72     if (ttisnil(si)) {
     73         Symbol *new_sym = search_in_symbol_table(K, buf, size, h);
     74 	if (new_sym != NULL) {
     75 	    return gc2sym(new_sym);
     76 	}
     77     }
     78 
     79     /* Didn't find it, alloc new immutable string and save in symbol table,
     80        note that the hash value remained in h */
     81     TValue new_str = kstring_new_bs_imm(K, buf, size);
     82     krooted_tvs_push(K, new_str);
     83     Symbol *new_sym = klispM_new(K, Symbol);
     84     TValue ret_tv = gc2sym(new_sym);
     85     krooted_tvs_pop(K); 
     86     
     87     if (ttisnil(si)) {
     88         /* header + gc_fields */
     89         /* can't use klispC_link, because strings use the next pointer
     90            differently */
     91         new_sym->gct = klispC_white(G(K));
     92         new_sym->tt = K_TSYMBOL;
     93         new_sym->kflags = 0;
     94         new_sym->si = NULL;
     95 
     96         /* symbol specific fields */
     97         new_sym->str = new_str;
     98         new_sym->hash = h;
     99 
    100         /* add to the string/symbol table (and link it) */
    101         stringtable *tb;
    102         tb = &G(K)->strt;
    103         h = lmod(h, tb->size);
    104         new_sym->next = tb->hash[h];  /* chain new entry */
    105         tb->hash[h] = (GCObject *)(new_sym);
    106         tb->nuse++;
    107         if (tb->nuse > ((uint32_t) tb->size) && tb->size <= INT32_MAX / 2) {
    108             krooted_tvs_push(K, ret_tv); /* save in case of gc */
    109             klispS_resize(K, tb->size*2);  /* too crowded */
    110             krooted_tvs_pop(K);
    111         }
    112     } else { /* non nil source info */
    113         /* link it with regular objects and save source info */
    114         /* header + gc_fields */
    115         klispC_link(K, (GCObject *) new_sym, K_TSYMBOL, 0);
    116 	
    117         /* symbol specific fields */
    118         new_sym->str = new_str;
    119         new_sym->hash = h;
    120 
    121         krooted_tvs_push(K, ret_tv); /* not needed, but just in case */
    122         kset_source_info(K, ret_tv, si);
    123         krooted_tvs_pop(K); 
    124     }
    125     return ret_tv;
    126 }
    127 
    128 /* for c strings with unknown size */
    129 TValue ksymbol_new_b(klisp_State *K, const char *buf, TValue si)
    130 {
    131     int32_t size = (int32_t) strlen(buf);
    132     return ksymbol_new_bs(K, buf, size, si);
    133 }
    134 
    135 /* for string->symbol */
    136 /* GC: assumes str is rooted */
    137 TValue ksymbol_new_str(klisp_State *K, TValue str, TValue si)
    138 {
    139     return ksymbol_new_bs(K, kstring_buf(str), kstring_size(str), si);
    140 }
    141 
    142 bool ksymbolp(TValue obj) { return ttissymbol(obj); }
    143 
    144 int32_t ksymbol_cstr_cmp(TValue sym, const char *buf)
    145 {
    146     return kstring_cstr_cmp(ksymbol_str(sym), buf);
    147 }