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

Contents of /src/lisp/vars.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2.14.1 - (show annotations)
Wed Sep 3 11:32:05 2003 UTC (10 years, 7 months ago) by gerd
Branch: lisp-executable
Changes since 1.2: +2 -1 lines
File MIME type: text/plain
Fred Gilham's Lisp executable support for CMUCL.
1 /* $Header: /tiger/var/lib/cvsroots/cmucl/src/lisp/vars.c,v 1.2.14.1 2003/09/03 11:32:05 gerd 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 hash_name(char *name)
29 {
30 unsigned long value = 0;
31
32 while (*name != '\0') {
33 value = (value << 1) ^ *(unsigned char *)(name++);
34 value = (value & (1-(1<<24))) ^ (value >> 24);
35 }
36
37 return value % NAME_BUCKETS;
38 }
39
40 static int hash_obj(lispobj obj)
41 {
42 return (unsigned long)obj % OBJ_BUCKETS;
43 }
44
45
46 void flush_vars()
47 {
48 int index;
49 struct var *var, *next, *perm = NULL;
50
51 /* 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. */
52
53 for (index = 0; index < NAME_BUCKETS; index++)
54 for (var = NameHash[index]; var != NULL; var = next) {
55 next = var->nnext;
56 if (var->permanent) {
57 var->nnext = perm;
58 perm = var;
59 }
60 else {
61 free(var->name);
62 free(var);
63 }
64 }
65 bzero(NameHash, sizeof(NameHash));
66 bzero(ObjHash, sizeof(ObjHash));
67 tempcntr = 1;
68
69 for (var = perm; var != NULL; var = next) {
70 next = var->nnext;
71 index = hash_name(var->name);
72 var->nnext = NameHash[index];
73 NameHash[index] = var;
74 if (var->map_back) {
75 index = hash_obj(var->obj);
76 var->onext = ObjHash[index];
77 ObjHash[index] = var;
78 }
79 }
80 }
81
82 struct var *lookup_by_name(name)
83 char *name;
84 {
85 struct var *var;
86
87 for (var = NameHash[hash_name(name)]; var != NULL; var = var->nnext)
88 if (strcmp(var->name, name) == 0)
89 return var;
90 return NULL;
91 }
92
93 struct var *lookup_by_obj(obj)
94 lispobj obj;
95 {
96 struct var *var;
97
98 for (var = ObjHash[hash_obj(obj)]; var != NULL; var = var->onext)
99 if (var->obj == obj)
100 return var;
101 return NULL;
102 }
103
104 static struct var *make_var(char *name, boolean perm)
105 {
106 struct var *var = (struct var *)malloc(sizeof(struct var));
107 char buffer[256];
108 int index;
109
110 if (name == NULL) {
111 sprintf(buffer, "%d", tempcntr++);
112 name = buffer;
113 }
114 var->name = (char *)malloc(strlen(name)+1);
115 strcpy(var->name, name);
116 var->clock = 0;
117 var->permanent = perm;
118 var->map_back = FALSE;
119
120 index = hash_name(name);
121 var->nnext = NameHash[index];
122 NameHash[index] = var;
123
124 return var;
125 }
126
127 struct var *define_var(char *name, lispobj obj, boolean perm)
128 {
129 struct var *var = make_var(name, perm);
130 int index;
131
132 var->obj = obj;
133 var->update_fn = NULL;
134
135 if (lookup_by_obj(obj) == NULL) {
136 var->map_back = TRUE;
137 index = hash_obj(obj);
138 var->onext = ObjHash[index];
139 ObjHash[index] = var;
140 }
141
142 return var;
143 }
144
145 struct var *define_dynamic_var(char *name, lispobj updatefn(struct var *),
146 boolean perm)
147 {
148 struct var *var = make_var(name, perm);
149
150 var->update_fn = updatefn;
151
152 return var;
153 }
154
155 char *var_name(struct var *var)
156 {
157 return var->name;
158 }
159
160 lispobj var_value(struct var *var)
161 {
162 if (var->update_fn != NULL)
163 var->obj = (*var->update_fn)(var);
164 return var->obj;
165 }
166
167 long var_clock(struct var *var)
168 {
169 return var->clock;
170 }
171
172 void var_setclock(struct var *var, long val)
173 {
174 var->clock = val;
175 }

  ViewVC Help
Powered by ViewVC 1.1.5