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 26114707 : {
52 26114707 : struct node *r = new_node();
53 :
54 26114707 : r->typ = APPLICATION;
55 26114707 : r->name = NULL;
56 26114707 : r->cn = COMB_NONE;
57 26114707 : r->right = right_child;
58 26114707 : r->left = left_child;
59 :
60 26114707 : if (r->right)
61 26114361 : ++r->right->refcnt;
62 26114707 : if (r->left)
63 26114707 : ++r->left->refcnt;
64 :
65 26114707 : 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 7018 : {
76 7018 : struct node *r = new_node();
77 :
78 7018 : r->typ = COMBINATOR;
79 7018 : r->cn = cn;
80 7018 : switch (r->cn)
81 : {
82 2548 : case COMB_S: r->name = "S"; break;
83 2420 : case COMB_K: r->name = "K"; break;
84 322 : case COMB_I: r->name = "I"; break;
85 1405 : case COMB_B: r->name = "B"; break;
86 284 : case COMB_C: r->name = "C"; break;
87 16 : case COMB_W: r->name = "W"; break;
88 9 : case COMB_T: r->name = "T"; break;
89 14 : case COMB_M: r->name = "M"; break;
90 : case COMB_NONE:
91 0 : default: r->name = "none"; break;
92 : }
93 :
94 7018 : return r;
95 : }
96 :
97 : struct node *
98 : new_term(const char *name)
99 702 : {
100 702 : struct node *r = new_node();
101 :
102 702 : r->typ = COMBINATOR;
103 702 : r->cn = COMB_NONE;
104 702 : r->name = name;
105 :
106 702 : return r;
107 : }
108 :
109 : void
110 : print_tree(struct node *node, int reduction_node_sn, int current_node_sn)
111 1400867 : {
112 1400867 : switch (node->typ)
113 : {
114 : case APPLICATION:
115 :
116 700167 : if (node != node->left)
117 700167 : 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 700167 : if (elaborate_output)
123 : {
124 165 : printf(" {%d}", node->sn);
125 165 : if (node->sn == current_node_sn)
126 21 : printf("+ ");
127 : else
128 144 : putc(' ', stdout);
129 : } else {
130 700002 : if (node->sn == current_node_sn)
131 21 : printf(" + ");
132 : else
133 699981 : putc(' ', stdout);
134 : }
135 :
136 700167 : if (node != node->right)
137 : {
138 700167 : if (node->right)
139 : {
140 700069 : int print_right_paren = 0;
141 700069 : if (APPLICATION == node->right->typ)
142 : {
143 619916 : putc('(', stdout);
144 619916 : print_right_paren = 1;
145 : }
146 700069 : print_tree(node->right, reduction_node_sn, current_node_sn);
147 700069 : if (print_right_paren)
148 619916 : putc(')', stdout);
149 98 : } else if (elaborate_output)
150 49 : printf(" {%d}", node->sn);
151 : } else
152 0 : printf("Right application loop: {%d}->{%d}\n",
153 : node->sn, node->right->sn);
154 :
155 700167 : break;
156 : case COMBINATOR:
157 700700 : if (elaborate_output)
158 177 : printf("%s{%d}", node->name, node->sn);
159 : else
160 700523 : printf(
161 : (node->sn != reduction_node_sn)? "%s": "%s*",
162 : node->name
163 : );
164 700700 : if (node->sn == current_node_sn)
165 44 : putc('+', stdout);
166 700700 : 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 1400867 : }
175 :
176 : struct node *
177 : new_node(void)
178 28155159 : {
179 28155159 : struct node *r = NULL;
180 :
181 28155159 : ++new_node_cnt;
182 :
183 28155159 : if (node_free_list)
184 : {
185 26165632 : r = node_free_list;
186 26165632 : node_free_list = node_free_list->right;
187 26165632 : ++reused_node_count;
188 : } else {
189 1989527 : r = arena_alloc(arena, sizeof(*r));
190 1989527 : ++sn_counter;
191 1989527 : ++allocated_node_count;
192 1989527 : r->sn = sn_counter;
193 : }
194 :
195 : /* r->sn stays unchanged throughout */
196 28155159 : r->right = r->left = NULL;
197 28155159 : r->typ = UNTYPED;
198 28155159 : r->cn = COMB_NONE;
199 28155159 : r->name = NULL;
200 28155159 : r->examined = 0;
201 28155159 : r->updateable = NULL;
202 28155159 : r->branch_marker = 0;
203 28155159 : r->refcnt = 0;
204 :
205 28155159 : return r;
206 : }
207 :
208 : void
209 : free_all_nodes(int memory_info_flag)
210 56 : {
211 :
212 56 : if (memory_info_flag)
213 : {
214 0 : fprintf(stderr, "Gave out %d nodes of %d bytes each in toto.\n",
215 : new_node_cnt, sizeof(struct node));
216 0 : fprintf(stderr, "%d nodes allocated from arena, %d from free list\n",
217 : sn_counter, reused_node_count);
218 :
219 : }
220 56 : deallocate_arena(arena, memory_info_flag);
221 56 : }
222 :
223 : void
224 : init_node_allocation(int memory_info_flag)
225 56 : {
226 56 : arena = new_arena(memory_info_flag);
227 56 : }
228 :
229 : void
230 : reset_node_allocation(void)
231 720 : {
232 720 : if (!reduction_interrupted)
233 : {
234 719 : int free_list_cnt = 0;
235 719 : struct node *p = node_free_list;
236 :
237 1990957 : while (p)
238 : {
239 1989519 : ++free_list_cnt;
240 1989519 : if (debug_reduction)
241 90 : fprintf(stderr, "Node %d, ref cnt %d on free list\n",
242 : p->sn, p->refcnt);
243 1989519 : p = p->right;
244 1989519 : if (free_list_cnt > allocated_node_count) break;
245 : }
246 :
247 719 : if (free_list_cnt != allocated_node_count)
248 1 : 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 720 : node_free_list = 0;
255 720 : allocated_node_count = 0;
256 :
257 720 : free_arena_contents(arena);
258 720 : }
259 :
260 : struct node *
261 : arena_copy_graph(struct node *p)
262 2032732 : {
263 2032732 : struct node *r = NULL;
264 :
265 2032732 : if (!p)
266 0 : return r;
267 :
268 2032732 : r = new_node();
269 :
270 2032732 : r->typ = p->typ;
271 :
272 2032732 : switch (p->typ)
273 : {
274 : case APPLICATION:
275 1014531 : r->left = arena_copy_graph(p->left);
276 1014531 : ++r->left->refcnt;
277 1014531 : r->right = arena_copy_graph(p->right);
278 1014531 : ++r->right->refcnt;
279 1014531 : break;
280 : case COMBINATOR:
281 1018201 : r->name = p->name;
282 1018201 : r->cn = p->cn;
283 1018201 : 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 2032732 : return r;
296 : }
297 :
298 : void
299 : free_node(struct node *node)
300 80388432 : {
301 80388432 : if (NULL == node) return; /* dummy root nodes have NULL right field */
302 :
303 80388007 : if (debug_reduction)
304 118 : fprintf(stderr, "Freeing node %d, ref cnt %d\n",
305 : node->sn, node->refcnt);
306 :
307 80388007 : --node->refcnt;
308 :
309 80388007 : if (node->refcnt == 0)
310 : {
311 28155158 : if (APPLICATION == node->typ)
312 : {
313 27129238 : free_node(node->left);
314 27129238 : free_node(node->right);
315 : }
316 28155158 : node->right = node_free_list;
317 28155158 : node_free_list = node;
318 52232849 : } else if (0 > node->refcnt)
319 0 : fprintf(stderr, "Freeing node %d, negative ref cnt %d\n",
320 : node->sn, node->refcnt);
321 : }
|
