Clean up RCS ids
[projects/cmucl/cmucl.git] / src / lisp / vars.c
1 /*
2
3  This code was written as part of the CMU Common Lisp project at
4  Carnegie Mellon University, and has been placed in the public domain.
5
6 */
7
8 #include <stdio.h>
9 #include <sys/types.h>
10 #include <stdlib.h>
11 #include <string.h>
12
13 #include "lisp.h"
14 #include "vars.h"
15 #include "os.h"
16
17 #define NAME_BUCKETS 31
18 #define OBJ_BUCKETS 31
19
20 static struct var *NameHash[NAME_BUCKETS], *ObjHash[OBJ_BUCKETS];
21 static int tempcntr = 1;
22
23 struct var {
24     lispobj obj;
25       lispobj(*update_fn) (struct var * var);
26     char *name;
27     long clock;
28     boolean map_back, permanent;
29
30     struct var *nnext;          /* Next in name list */
31     struct var *onext;          /* Next in object list */
32 };
33
34 static int
35 hash_name(char *name)
36 {
37     unsigned long value = 0;
38
39     while (*name != '\0') {
40         value = (value << 1) ^ *(unsigned char *) (name++);
41         value = (value & (1 - (1 << 24))) ^ (value >> 24);
42     }
43
44     return value % NAME_BUCKETS;
45 }
46
47 static int
48 hash_obj(lispobj obj)
49 {
50     return (unsigned long) obj % OBJ_BUCKETS;
51 }
52
53
54 void
55 flush_vars(void)
56 {
57     int index;
58     struct var *var, *next, *perm = NULL;
59
60     /* Note: all vars in the object hash table also appear in the name hash table, so if we free everything in the name hash table, we free everything in the object hash table. */
61
62     for (index = 0; index < NAME_BUCKETS; index++)
63         for (var = NameHash[index]; var != NULL; var = next) {
64             next = var->nnext;
65             if (var->permanent) {
66                 var->nnext = perm;
67                 perm = var;
68             } else {
69                 free(var->name);
70                 free(var);
71             }
72         }
73     memset(NameHash, 0, sizeof(NameHash));
74     memset(ObjHash, 0, sizeof(ObjHash));
75     tempcntr = 1;
76
77     for (var = perm; var != NULL; var = next) {
78         next = var->nnext;
79         index = hash_name(var->name);
80         var->nnext = NameHash[index];
81         NameHash[index] = var;
82         if (var->map_back) {
83             index = hash_obj(var->obj);
84             var->onext = ObjHash[index];
85             ObjHash[index] = var;
86         }
87     }
88 }
89
90 struct var *
91 lookup_by_name(char *name)
92 {
93     struct var *var;
94
95     for (var = NameHash[hash_name(name)]; var != NULL; var = var->nnext)
96         if (strcmp(var->name, name) == 0)
97             return var;
98     return NULL;
99 }
100
101 struct var *
102 lookup_by_obj(lispobj obj)
103 {
104     struct var *var;
105
106     for (var = ObjHash[hash_obj(obj)]; var != NULL; var = var->onext)
107         if (var->obj == obj)
108             return var;
109     return NULL;
110 }
111
112 static struct var *
113 make_var(char *name, boolean perm)
114 {
115     struct var *var;
116     char buffer[256];
117     int index;
118
119     var = (struct var *) malloc(sizeof(struct var));
120
121     if (var == NULL) {
122         perror("malloc");
123         exit(1);
124     }
125
126     if (name == NULL) {
127         sprintf(buffer, "%d", tempcntr++);
128         name = buffer;
129     }
130     var->name = (char *) malloc(strlen(name) + 1);
131     strcpy(var->name, name);
132     var->clock = 0;
133     var->permanent = perm;
134     var->map_back = FALSE;
135
136     index = hash_name(name);
137     var->nnext = NameHash[index];
138     NameHash[index] = var;
139
140     return var;
141 }
142
143 struct var *
144 define_var(char *name, lispobj obj, boolean perm)
145 {
146     struct var *var = make_var(name, perm);
147     int index;
148
149     var->obj = obj;
150     var->update_fn = NULL;
151
152     if (lookup_by_obj(obj) == NULL) {
153         var->map_back = TRUE;
154         index = hash_obj(obj);
155         var->onext = ObjHash[index];
156         ObjHash[index] = var;
157     }
158
159     return var;
160 }
161
162 struct var *
163 define_dynamic_var(char *name, lispobj updatefn(struct var *), boolean perm)
164 {
165     struct var *var = make_var(name, perm);
166
167     var->update_fn = updatefn;
168
169     return var;
170 }
171
172 char *
173 var_name(struct var *var)
174 {
175     return var->name;
176 }
177
178 lispobj
179 var_value(struct var * var)
180 {
181     if (var->update_fn != NULL)
182         var->obj = (*var->update_fn) (var);
183     return var->obj;
184 }
185
186 long
187 var_clock(struct var *var)
188 {
189     return var->clock;
190 }
191
192 void
193 var_setclock(struct var *var, long val)
194 {
195     var->clock = val;
196 }