/[cmucl]/src/lisp/vars.c
ViewVC logotype

Contents of /src/lisp/vars.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.6 - (show annotations)
Thu Sep 15 18:26:53 2005 UTC (8 years, 7 months ago) by rtoy
Branch: MAIN
CVS Tags: double-double-array-base, double-double-init-sparc-2, double-double-base, snapshot-2007-09, snapshot-2007-08, snapshot-2007-05, snapshot-2008-01, snapshot-2008-02, snapshot-2008-03, snapshot-2006-11, snapshot-2006-10, double-double-init-sparc, snapshot-2006-12, snapshot-2007-01, snapshot-2007-02, release-19e, release-19d, double-double-init-ppc, release-19c, release-19c-base, double-double-init-%make-sparc, snapshot-2007-03, snapshot-2007-04, snapshot-2007-07, snapshot-2007-06, double-double-array-checkpoint, double-double-reader-checkpoint-1, release-19d-base, release-19e-pre1, double-double-irrat-end, release-19e-pre2, release-19d-pre2, release-19d-pre1, double-double-init-checkpoint-1, double-double-reader-base, double-double-init-x86, snapshot-2005-11, double-double-sparc-checkpoint-1, snapshot-2005-10, snapshot-2005-12, release-19c-pre1, release-19e-base, double-double-irrat-start, snapshot-2007-12, snapshot-2007-10, snapshot-2007-11, snapshot-2006-02, snapshot-2006-03, snapshot-2006-01, snapshot-2006-06, snapshot-2006-07, snapshot-2006-04, snapshot-2006-05, pre-telent-clx, snapshot-2006-08, snapshot-2006-09
Branch point for: double-double-reader-branch, double-double-array-branch, release-19d-branch, double-double-branch, release-19e-branch, release-19c-branch
Changes since 1.5: +71 -60 lines
File MIME type: text/plain
Indent all source files using GNU indent using the config in
.indent.pro.
1 /* $Header: /tiger/var/lib/cvsroots/cmucl/src/lisp/vars.c,v 1.6 2005/09/15 18:26:53 rtoy Exp $ */
2 #include <stdio.h>
3 #include <sys/types.h>
4 #include <stdlib.h>
5 #include <string.h>
6
7 #include "lisp.h"
8 #include "vars.h"
9 #include "os.h"
10
11 #define NAME_BUCKETS 31
12 #define OBJ_BUCKETS 31
13
14 static struct var *NameHash[NAME_BUCKETS], *ObjHash[OBJ_BUCKETS];
15 static int tempcntr = 1;
16
17 struct var {
18 lispobj obj;
19 lispobj(*update_fn) (struct var * var);
20 char *name;
21 long clock;
22 boolean map_back, permanent;
23
24 struct var *nnext; /* Next in name list */
25 struct var *onext; /* Next in object list */
26 };
27
28 static int
29 hash_name(char *name)
30 {
31 unsigned long value = 0;
32
33 while (*name != '\0') {
34 value = (value << 1) ^ *(unsigned char *) (name++);
35 value = (value & (1 - (1 << 24))) ^ (value >> 24);
36 }
37
38 return value % NAME_BUCKETS;
39 }
40
41 static int
42 hash_obj(lispobj obj)
43 {
44 return (unsigned long) obj % OBJ_BUCKETS;
45 }
46
47
48 void
49 flush_vars()
50 {
51 int index;
52 struct var *var, *next, *perm = NULL;
53
54 /* 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. */
55
56 for (index = 0; index < NAME_BUCKETS; index++)
57 for (var = NameHash[index]; var != NULL; var = next) {
58 next = var->nnext;
59 if (var->permanent) {
60 var->nnext = perm;
61 perm = var;
62 } else {
63 free(var->name);
64 free(var);
65 }
66 }
67 memset(NameHash, 0, sizeof(NameHash));
68 memset(ObjHash, 0, sizeof(ObjHash));
69 tempcntr = 1;
70
71 for (var = perm; var != NULL; var = next) {
72 next = var->nnext;
73 index = hash_name(var->name);
74 var->nnext = NameHash[index];
75 NameHash[index] = var;
76 if (var->map_back) {
77 index = hash_obj(var->obj);
78 var->onext = ObjHash[index];
79 ObjHash[index] = var;
80 }
81 }
82 }
83
84 struct var *
85 lookup_by_name(name)
86 char *name;
87 {
88 struct var *var;
89
90 for (var = NameHash[hash_name(name)]; var != NULL; var = var->nnext)
91 if (strcmp(var->name, name) == 0)
92 return var;
93 return NULL;
94 }
95
96 struct var *
97 lookup_by_obj(obj)
98 lispobj obj;
99 {
100 struct var *var;
101
102 for (var = ObjHash[hash_obj(obj)]; var != NULL; var = var->onext)
103 if (var->obj == obj)
104 return var;
105 return NULL;
106 }
107
108 static struct var *
109 make_var(char *name, boolean perm)
110 {
111 struct var *var;
112 char buffer[256];
113 int index;
114
115 var = (struct var *) malloc(sizeof(struct var));
116
117 if (var == NULL) {
118 perror("malloc");
119 exit(1);
120 }
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 = FALSE;
131
132 index = hash_name(name);
133 var->nnext = NameHash[index];
134 NameHash[index] = var;
135
136 return var;
137 }
138
139 struct var *
140 define_var(char *name, lispobj obj, boolean perm)
141 {
142 struct var *var = make_var(name, perm);
143 int index;
144
145 var->obj = obj;
146 var->update_fn = NULL;
147
148 if (lookup_by_obj(obj) == NULL) {
149 var->map_back = TRUE;
150 index = hash_obj(obj);
151 var->onext = ObjHash[index];
152 ObjHash[index] = var;
153 }
154
155 return var;
156 }
157
158 struct var *
159 define_dynamic_var(char *name, lispobj updatefn(struct var *), boolean perm)
160 {
161 struct var *var = make_var(name, perm);
162
163 var->update_fn = updatefn;
164
165 return var;
166 }
167
168 char *
169 var_name(struct var *var)
170 {
171 return var->name;
172 }
173
174 lispobj
175 var_value(struct var * var)
176 {
177 if (var->update_fn != NULL)
178 var->obj = (*var->update_fn) (var);
179 return var->obj;
180 }
181
182 long
183 var_clock(struct var *var)
184 {
185 return var->clock;
186 }
187
188 void
189 var_setclock(struct var *var, long val)
190 {
191 var->clock = val;
192 }

  ViewVC Help
Powered by ViewVC 1.1.5