new function: is_lisp_immediate()
[sbcl/pkhuong.git] / src / runtime / vars.c
blob03b8ec256f11805515bda14b4ffc753d1405c3e7
1 /*
2 * This software is part of the SBCL system. See the README file for
3 * more information.
5 * This software is derived from the CMU CL system, which was
6 * written at Carnegie Mellon University and released into the
7 * public domain. The software is in the public domain and is
8 * provided with absolutely no warranty. See the COPYING and CREDITS
9 * files for more information.
12 #include <stdio.h>
13 #include <string.h>
14 #include <sys/types.h>
15 #include <stdlib.h>
17 #include "sbcl.h"
18 #include "runtime.h"
19 #include "vars.h"
20 #include "os.h"
22 #define NAME_BUCKETS 31
23 #define OBJ_BUCKETS 31
25 static struct var *NameHash[NAME_BUCKETS], *ObjHash[OBJ_BUCKETS];
26 static int tempcntr = 1;
28 struct var {
29 lispobj obj;
30 lispobj (*update_fn)(struct var *var);
31 char *name;
32 long clock;
33 boolean map_back, permanent;
35 struct var *nnext; /* Next in name list */
36 struct var *onext; /* Next in object list */
39 static int hash_name(char *name)
41 unsigned long value = 0;
43 while (*name != '\0') {
44 value = (value << 1) ^ *(unsigned char *)(name++);
45 value = (value & (1-(1<<24))) ^ (value >> 24);
48 return value % NAME_BUCKETS;
51 static int hash_obj(lispobj obj)
53 return (unsigned long)obj % OBJ_BUCKETS;
56 void flush_vars()
58 int index;
59 struct var *var, *next, *perm = NULL;
61 /* Note: all vars in the object hash table also appear in the name hash
62 * table, so if we free everything in the name hash table, we free
63 * everything in the object hash table. */
65 for (index = 0; index < NAME_BUCKETS; index++)
66 for (var = NameHash[index]; var != NULL; var = next) {
67 next = var->nnext;
68 if (var->permanent) {
69 var->nnext = perm;
70 perm = var;
72 else {
73 free(var->name);
74 free(var);
77 memset(NameHash, 0, sizeof(NameHash));
78 memset(ObjHash, 0, sizeof(ObjHash));
79 tempcntr = 1;
81 for (var = perm; var != NULL; var = next) {
82 next = var->nnext;
83 index = hash_name(var->name);
84 var->nnext = NameHash[index];
85 NameHash[index] = var;
86 if (var->map_back) {
87 index = hash_obj(var->obj);
88 var->onext = ObjHash[index];
89 ObjHash[index] = var;
94 struct var *lookup_by_name(name)
95 char *name;
97 struct var *var;
99 for (var = NameHash[hash_name(name)]; var != NULL; var = var->nnext)
100 if (strcmp(var->name, name) == 0)
101 return var;
102 return NULL;
105 struct var *lookup_by_obj(obj)
106 lispobj obj;
108 struct var *var;
110 for (var = ObjHash[hash_obj(obj)]; var != NULL; var = var->onext)
111 if (var->obj == obj)
112 return var;
113 return NULL;
116 static struct var *make_var(char *name, boolean perm)
118 struct var *var = (struct var *)malloc(sizeof(struct var));
119 char buffer[256];
120 int index;
122 if (name == NULL) {
123 sprintf(buffer, "%d", tempcntr++);
124 name = buffer;
126 var->name = (char *)malloc(strlen(name)+1);
127 strcpy(var->name, name);
128 var->clock = 0;
129 var->permanent = perm;
130 var->map_back = 0;
132 index = hash_name(name);
133 var->nnext = NameHash[index];
134 NameHash[index] = var;
136 return var;
139 struct var *define_var(char *name, lispobj obj, boolean perm)
141 struct var *var = make_var(name, perm);
142 int index;
144 var->obj = obj;
145 var->update_fn = NULL;
147 if (lookup_by_obj(obj) == NULL) {
148 var->map_back = 1;
149 index = hash_obj(obj);
150 var->onext = ObjHash[index];
151 ObjHash[index] = var;
154 return var;
157 struct var *define_dynamic_var(char *name, lispobj updatefn(struct var *),
158 boolean perm)
160 struct var *var = make_var(name, perm);
162 var->update_fn = updatefn;
164 return var;
167 char *var_name(struct var *var)
169 return var->name;
172 lispobj var_value(struct var *var)
174 if (var->update_fn != NULL)
175 var->obj = (*var->update_fn)(var);
176 return var->obj;
179 long var_clock(struct var *var)
181 return var->clock;
184 void var_setclock(struct var *var, long val)
186 var->clock = val;