kkeyword.c (3878B)
1 /* 2 ** kkeywrod.c 3 ** Kernel Keywords 4 ** See Copyright Notice in klisp.h 5 */ 6 7 #include <string.h> 8 9 #include "kkeyword.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 static uint32_t get_keyword_hash(const char *buf, uint32_t size) 18 { 19 uint32_t h = size; /* seed */ 20 size_t step = (size>>5)+1; /* if string is too long, don't hash all 21 its chars */ 22 size_t size1; 23 for (size1 = size; size1 >= step; size1 -= step) /* compute hash */ 24 h = h ^ ((h<<5)+(h>>2)+ ((unsigned char) buf[size1-1])); 25 26 h ^= (uint32_t) 0x55555555; 27 /* keyword hash should be different from string & symbol hash 28 otherwise keywords and their respective immutable string 29 would always fall in the same bucket */ 30 return h; 31 } 32 33 /* Looks for a keyword in the stringtable and returns a pointer 34 to it if found or NULL otherwise. */ 35 static Keyword *search_in_keyword_table(klisp_State *K, const char *buf, 36 uint32_t size, uint32_t h) 37 { 38 for (GCObject *o = G(K)->strt.hash[lmod(h, G(K)->strt.size)]; o != NULL; 39 o = o->gch.next) { 40 klisp_assert(o->gch.tt == K_TKEYWORD || o->gch.tt == K_TSYMBOL || 41 o->gch.tt == K_TSTRING || o->gch.tt == K_TBYTEVECTOR); 42 43 if (o->gch.tt != K_TKEYWORD) continue; 44 45 String *ts = tv2str(((Keyword *) o)->str); 46 if (ts->size == size && (memcmp(buf, ts->b, size) == 0)) { 47 /* keyword and/or string may be dead */ 48 if (isdead(G(K), o)) changewhite(o); 49 if (isdead(G(K), (GCObject *) ts)) changewhite((GCObject *) ts); 50 return (Keyword *) o; 51 } 52 } 53 /* If it exits the loop, it means it wasn't found */ 54 return NULL; 55 } 56 57 /* No case folding is performed by these constructors */ 58 TValue kkeyword_new_bs(klisp_State *K, const char *buf, uint32_t size) 59 { 60 /* First calculate the hash */ 61 uint32_t h = get_keyword_hash(buf, size); 62 63 /* look for it in the table */ 64 Keyword *new_keyw = search_in_keyword_table(K, buf, size, h); 65 66 if (new_keyw != NULL) { 67 return gc2keyw(new_keyw); 68 } 69 /* Didn't find it, alloc new immutable string and save in keyword table, 70 note that the hash value remained in h */ 71 TValue new_str = kstring_new_bs_imm(K, buf, size); 72 krooted_tvs_push(K, new_str); 73 new_keyw = klispM_new(K, Keyword); 74 TValue ret_tv = gc2keyw(new_keyw); 75 krooted_tvs_pop(K); 76 77 /* header + gc_fields */ 78 /* can't use klispC_link, because strings use the next pointer 79 differently */ 80 new_keyw->gct = klispC_white(G(K)); 81 new_keyw->tt = K_TKEYWORD; 82 new_keyw->kflags = 0; 83 new_keyw->si = NULL; 84 85 /* keyword specific fields */ 86 new_keyw->str = new_str; 87 new_keyw->hash = h; 88 89 /* add to the string/keyword table (and link it) */ 90 stringtable *tb; 91 tb = &G(K)->strt; 92 h = lmod(h, tb->size); 93 new_keyw->next = tb->hash[h]; /* chain new entry */ 94 tb->hash[h] = (GCObject *)(new_keyw); 95 tb->nuse++; 96 if (tb->nuse > ((uint32_t) tb->size) && tb->size <= INT32_MAX / 2) { 97 krooted_tvs_push(K, ret_tv); /* save in case of gc */ 98 klispS_resize(K, tb->size*2); /* too crowded */ 99 krooted_tvs_pop(K); 100 } 101 return ret_tv; 102 } 103 104 /* for c strings with unknown size */ 105 TValue kkeyword_new_b(klisp_State *K, const char *buf) 106 { 107 int32_t size = (int32_t) strlen(buf); 108 return kkeyword_new_bs(K, buf, size); 109 } 110 111 /* for string->keyword & symbol->keyword */ 112 /* GC: assumes str is rooted */ 113 TValue kkeyword_new_str(klisp_State *K, TValue str) 114 { 115 return kkeyword_new_bs(K, kstring_buf(str), kstring_size(str)); 116 } 117 118 bool kkeywordp(TValue obj) { return ttiskeyword(obj); } 119 120 int32_t kkeyword_cstr_cmp(TValue keyw, const char *buf) 121 { 122 return kstring_cstr_cmp(kkeyword_str(keyw), buf); 123 }