1 : /*
2 : Copyright (C) 2007, Bruce Ediger
3 :
4 : This file is part of cl.
5 :
6 : cl is free software; you can redistribute it and/or modify
7 : it under the terms of the GNU General Public License as published by
8 : the Free Software Foundation; either version 2 of the License, or
9 : (at your option) any later version.
10 :
11 : cl is distributed in the hope that it will be useful,
12 : but WITHOUT ANY WARRANTY; without even the implied warranty of
13 : MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 : GNU General Public License for more details.
15 :
16 : You should have received a copy of the GNU General Public License
17 : along with cl; if not, write to the Free Software
18 : Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
19 :
20 : */
21 : #include <stdio.h>
22 : #include <stdlib.h>
23 : #include <string.h>
24 : #include <stdlib.h>
25 :
26 : #include <node.h>
27 : #include <arena.h>
28 :
29 : extern int elaborate_output;
30 : extern int debug_reduction;
31 :
32 : static struct memory_arena *arena = NULL;
33 :
34 : /* sn_counter - give a serial number (sn field) to
35 : * all nodes, so as to distinguish them in elaborate output.
36 : * Note that 0 constitutes a special value. */
37 : static int sn_counter = 0;
38 : static int reused_node_count = 0;
39 : static int allocated_node_count = 0; /* Not total. In a particular arena. */
40 : static int new_node_cnt;
41 :
42 : extern int interpreter_interrupted;
43 : extern int reduction_interrupted;
44 :
45 : static struct node *node_free_list = NULL;
46 :
47 : struct node *new_node(void);
48 :
49 : struct node *
50 : new_application(struct node *left_child, struct node *right_child)
51 75131315 : {
52 75131315 : struct node *r = new_node();
53 :
54 75131315 : r->typ = APPLICATION;
55 75131315 : r->name = NULL;
56 75131315 : r->cn = COMB_NONE;
57 75131315 : r->right = right_child;
58 75131315 : r->left = left_child;
59 :
60 75131315 : if (r->right)
61 75130930 : ++r->right->refcnt;
62 75131315 : if (r->left)
63 75131315 : ++r->left->refcnt;
64 :
65 75131315 : return r;
66 : }
67 :
68 : /* Why doesn't this use Atoms to do combinator names?
69 : * It potentially complicates comparing (for example)
70 : * the name of an "S" combinator from the Atom table,
71 : * and the name of an "S" combintor allocated here.
72 : */
73 : struct node *
74 : new_combinator(enum combinatorName cn)
75 86991 : {
76 86991 : struct node *r = new_node();
77 :
78 86991 : r->typ = COMBINATOR;
79 86991 : r->cn = cn;
80 86991 : switch (r->cn)
81 : {
82 19140 : case COMB_S: r->name = "S"; break;
83 18459 : case COMB_K: r->name = "K"; break;
84 16110 : case COMB_I: r->name = "I"; break;
85 17274 : case COMB_B: r->name = "B"; break;
86 15928 : case COMB_C: r->name = "C"; break;
87 25 : case COMB_W: r->name = "W"; break;
88 18 : case COMB_T: r->name = "T"; break;
89 37 : case COMB_M: r->name = "M"; break;
90 : case COMB_NONE:
91 0 : default: r->name = "none"; break;
92 : }
93 :
94 86991 : return r;
95 : }
96 :
97 : struct node *
98 : new_term(const char *name)
99 780 : {
100 780 : struct node *r = new_node();
101 :
102 780 : r->typ = COMBINATOR;
103 780 : r->cn = COMB_NONE;
104 780 : r->name = name;
105 :
106 780 : return r;
107 : }
108 :
109 : void
110 : print_tree(struct node *node, int reduction_node_sn, int current_node_sn)
111 1401749 : {
112 1401749 : switch (node->typ)
113 : {
114 : case APPLICATION:
115 :
116 700573 : if (node != node->left)
117 700573 : print_tree(node->left, reduction_node_sn, current_node_sn);
118 : else
119 0 : printf("Left application loop: {%d}->{%d}\n",
120 : node->sn, node->left->sn);
121 :
122 700573 : if (elaborate_output)
123 : {
124 167 : printf(" {%d}", node->sn);
125 167 : if (node->sn == current_node_sn)
126 22 : printf("+ ");
127 : else
128 145 : putc(' ', stdout);
129 : } else {
130 700406 : if (node->sn == current_node_sn)
131 21 : printf(" + ");
132 : else
133 700385 : putc(' ', stdout);
134 : }
135 :
136 700573 : if (node != node->right)
137 : {
138 700573 : if (node->right)
139 : {
140 700473 : int print_right_paren = 0;
141 700473 : if (APPLICATION == node->right->typ)
142 : {
143 620099 : putc('(', stdout);
144 620099 : print_right_paren = 1;
145 : }
146 700473 : print_tree(node->right, reduction_node_sn, current_node_sn);
147 700473 : if (print_right_paren)
148 620099 : putc(')', stdout);
149 100 : } else if (elaborate_output)
150 51 : printf(" {%d}", node->sn);
151 : } else
152 0 : printf("Right application loop: {%d}->{%d}\n",
153 : node->sn, node->right->sn);
154 :
155 700573 : break;
156 : case COMBINATOR:
157 701176 : if (elaborate_output)
158 181 : printf("%s{%d}", node->name, node->sn);
159 : else
160 700995 : printf(
161 : (node->sn != reduction_node_sn)? "%s": "%s*",
162 : node->name
163 : );
164 701176 : if (node->sn == current_node_sn)
165 45 : putc('+', stdout);
166 701176 : break;
167 : case UNTYPED:
168 0 : printf("UNTYPED {%d}", node->sn);
169 0 : break;
170 : default:
171 0 : printf("Unknown %d {%d}", node->typ, node->sn);
172 : break;
173 : }
174 1401749 : }
175 :
176 : struct node *
177 : new_node(void)
178 77252405 : {
179 77252405 : struct node *r = NULL;
180 :
181 77252405 : ++new_node_cnt;
182 :
183 77252405 : if (node_free_list)
184 : {
185 75107155 : r = node_free_list;
186 75107155 : node_free_list = node_free_list->right;
187 75107155 : ++reused_node_count;
188 : } else {
189 2145250 : r = arena_alloc(arena, sizeof(*r));
190 2145250 : ++sn_counter;
191 2145250 : ++allocated_node_count;
192 2145250 : r->sn = sn_counter;
193 : }
194 :
195 : /* r->sn stays unchanged throughout */
196 77252405 : r->right = r->left = NULL;
197 77252405 : r->typ = UNTYPED;
198 77252405 : r->cn = COMB_NONE;
199 77252405 : r->name = NULL;
200 77252405 : r->examined = 0;
201 77252405 : r->updateable = NULL;
202 77252405 : r->branch_marker = 0;
203 77252405 : r->refcnt = 0;
204 :
205 77252405 : return r;
206 : }
207 :
208 : void
209 : free_all_nodes(int memory_info_flag)
210 69 : {
211 :
212 69 : if (memory_info_flag)
213 : {
214 2 : fprintf(stderr, "Gave out %d nodes of %d bytes each in toto.\n",
215 : new_node_cnt, sizeof(struct node));
216 2 : fprintf(stderr, "%d nodes allocated from arena, %d from free list\n",
217 : sn_counter, reused_node_count);
218 :
219 : }
220 69 : deallocate_arena(arena, memory_info_flag);
221 69 : }
222 :
223 : void
224 : init_node_allocation(int memory_info_flag)
225 70 : {
226 70 : arena = new_arena(memory_info_flag);
227 70 : }
228 :
229 : void
230 : reset_node_allocation(void)
231 5818 : {
232 5818 : if (!reduction_interrupted)
233 : {
234 5810 : int free_list_cnt = 0;
235 5810 : struct node *p = node_free_list;
236 :
237 2156808 : while (p)
238 : {
239 2145188 : ++free_list_cnt;
240 2145188 : if (debug_reduction)
241 92 : fprintf(stderr, "Node %d, ref cnt %d on free list\n",
242 : p->sn, p->refcnt);
243 2145188 : p = p->right;
244 2145188 : if (free_list_cnt > allocated_node_count) break;
245 : }
246 :
247 5810 : if (free_list_cnt != allocated_node_count)
248 5 : fprintf(stderr, "Allocated %d nodes, but found %s %d on free list\n",
249 : allocated_node_count,
250 : free_list_cnt >allocated_node_count? "at least": "only",
251 : free_list_cnt);
252 : }
253 :
254 5818 : node_free_list = 0;
255 5818 : allocated_node_count = 0;
256 :
257 5818 : free_arena_contents(arena);
258 5818 : }
259 :
260 : struct node *
261 : arena_copy_graph(struct node *p)
262 2033319 : {
263 2033319 : struct node *r = NULL;
264 :
265 2033319 : if (!p)
266 0 : return r;
267 :
268 2033319 : r = new_node();
269 :
270 2033319 : r->typ = p->typ;
271 :
272 2033319 : switch (p->typ)
273 : {
274 : case APPLICATION:
275 1014783 : r->left = arena_copy_graph(p->left);
276 1014783 : ++r->left->refcnt;
277 1014783 : r->right = arena_copy_graph(p->right);
278 1014783 : ++r->right->refcnt;
279 1014783 : break;
280 : case COMBINATOR:
281 1018536 : r->name = p->name;
282 1018536 : r->cn = p->cn;
283 1018536 : break;
284 : case UNTYPED:
285 0 : printf("Copying an UNTYPED node\n");
286 0 : break;
287 : default:
288 0 : printf("Copying n node of unknown (%d) type\n", p->typ);
289 0 : r->left = arena_copy_graph(p->left);
290 0 : ++r->left->refcnt;
291 0 : r->right = arena_copy_graph(p->right);
292 0 : ++r->right->refcnt;
293 : break;
294 : }
295 2033319 : return r;
296 : }
297 :
298 : void
299 : free_node(struct node *node)
300 227368911 : {
301 227368911 : if (NULL == node) return; /* dummy root nodes have NULL right field */
302 :
303 227368448 : if (debug_reduction)
304 120 : fprintf(stderr, "Freeing node %d, ref cnt %d\n",
305 : node->sn, node->refcnt);
306 :
307 227368448 : --node->refcnt;
308 :
309 227368448 : if (node->refcnt == 0)
310 : {
311 77252387 : if (APPLICATION == node->typ)
312 : {
313 76146091 : free_node(node->left);
314 76146091 : free_node(node->right);
315 : }
316 77252387 : node->right = node_free_list;
317 77252387 : node_free_list = node;
318 150116061 : } else if (0 > node->refcnt)
319 0 : fprintf(stderr, "Freeing node %d, negative ref cnt %d\n",
320 : node->sn, node->refcnt);
321 : }
|
