Optimize CAD*R for &MORE args.
[sbcl.git] / src / runtime / vars.c
1 /*
2  * This software is part of the SBCL system. See the README file for
3  * more information.
4  *
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.
10  */
11
12 #include <stdio.h>
13 #include <string.h>
14 #include <sys/types.h>
15 #include <stdlib.h>
16
17 #include "sbcl.h"
18 #include "runtime.h"
19 #include "vars.h"
20 #include "os.h"
21
22 #define NAME_BUCKETS 31
23 #define OBJ_BUCKETS 31
24
25 static struct var *NameHash[NAME_BUCKETS], *ObjHash[OBJ_BUCKETS];
26 static int tempcntr = 1;
27
28 struct var {
29     lispobj obj;
30     lispobj (*update_fn)(struct var *var);
31     char *name;
32     sword_t clock;
33     boolean map_back, permanent;
34
35     struct var *nnext; /* Next in name list */
36     struct var *onext; /* Next in object list */
37 };
38
39 static int hash_name(char *name)
40 {
41     uword_t value = 0;
42
43     while (*name != '\0') {
44         value = (value << 1) ^ *(unsigned char *)(name++);
45         value = (value & (1-(1<<24))) ^ (value >> 24);
46     }
47
48     return value % NAME_BUCKETS;
49 }
50
51 static int hash_obj(lispobj obj)
52 {
53     return (uword_t)obj % OBJ_BUCKETS;
54 }
55
56 void flush_vars()
57 {
58     int index;
59     struct var *var, *next, *perm = NULL;
60
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. */
64
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;
71             }
72             else {
73                 free(var->name);
74                 free(var);
75             }
76         }
77     memset(NameHash, 0, sizeof(NameHash));
78     memset(ObjHash, 0, sizeof(ObjHash));
79     tempcntr = 1;
80
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;
90         }
91     }
92 }
93
94 struct var *lookup_by_name(name)
95 char *name;
96 {
97     struct var *var;
98
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;
103 }
104
105 struct var *lookup_by_obj(obj)
106 lispobj obj;
107 {
108     struct var *var;
109
110     for (var = ObjHash[hash_obj(obj)]; var != NULL; var = var->onext)
111         if (var->obj == obj)
112             return var;
113     return NULL;
114 }
115
116 static struct var *make_var(char *name, boolean perm)
117 {
118     struct var *var = (struct var *)malloc(sizeof(struct var));
119     char buffer[256];
120     int index;
121
122     if (name == NULL) {
123         sprintf(buffer, "%d", tempcntr++);
124         name = buffer;
125     }
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;
131
132     index = hash_name(name);
133     var->nnext = NameHash[index];
134     NameHash[index] = var;
135
136     return var;
137 }
138
139 struct var *define_var(char *name, lispobj obj, boolean perm)
140 {
141     struct var *var = make_var(name, perm);
142     int index;
143
144     var->obj = obj;
145     var->update_fn = NULL;
146
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;
152     }
153
154     return var;
155 }
156
157 struct var *define_dynamic_var(char *name, lispobj updatefn(struct var *),
158                                boolean perm)
159 {
160     struct var *var = make_var(name, perm);
161
162     var->update_fn = updatefn;
163
164     return var;
165 }
166
167 char *var_name(struct var *var)
168 {
169     return var->name;
170 }
171
172 lispobj var_value(struct var *var)
173 {
174     if (var->update_fn != NULL)
175         var->obj = (*var->update_fn)(var);
176     return var->obj;
177 }
178
179 sword_t var_clock(struct var *var)
180 {
181     return var->clock;
182 }
183
184 void var_setclock(struct var *var, sword_t val)
185 {
186     var->clock = val;
187 }