core: Add boot-module.
[mes.git] / src / mes.c
1 /* -*-comment-start: "//";comment-end:""-*-
2  * GNU Mes --- Maxwell Equations of Software
3  * Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
4  *
5  * This file is part of GNU Mes.
6  *
7  * GNU Mes is free software; you can redistribute it and/or modify it
8  * under the terms of the GNU General Public License as published by
9  * the Free Software Foundation; either version 3 of the License, or (at
10  * your option) any later version.
11  *
12  * GNU Mes is distributed in the hope that it will be useful, but
13  * WITHOUT ANY WARRANTY; without even the implied warranty of
14  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15  * GNU General Public License for more details.
16  *
17  * You should have received a copy of the GNU General Public License
18  * along with GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
19  */
20
21 #include <stdio.h>
22 #include <assert.h>
23 #include <stdlib.h>
24 #include <string.h>
25 #include <libmes.h>
26
27 //#define MES_MINI 1
28 #if POSIX
29 long ARENA_SIZE = 100000000; // 64b: 4GiB
30 #else
31 long ARENA_SIZE = 200000; // 32b: 2MiB, 64b: 4 MiB
32 #endif
33 long MAX_ARENA_SIZE = 100000000;
34
35 long JAM_SIZE = 20000;
36 long GC_SAFETY = 2000;
37
38 char *g_arena = 0;
39 typedef long SCM;
40
41 int g_debug = 0;
42 long g_free = 0;
43
44 SCM g_continuations = 0;
45 SCM g_symbols = 0;
46 SCM g_stack = 0;
47 // a/env
48 SCM r0 = 0;
49 // param 1
50 SCM r1 = 0;
51 // save 2+load/dump
52 SCM r2 = 0;
53 // continuation
54 SCM r3 = 0;
55 // current-module
56 SCM m0 = 0;
57 // macro
58 SCM g_macros = 1;
59 SCM g_ports = 1;
60
61 #if __M2_PLANET__
62 CONSTANT TCHAR          0
63 CONSTANT TCLOSURE       1
64 CONSTANT TCONTINUATION  2
65 CONSTANT TFUNCTION      3
66 CONSTANT TKEYWORD       4
67 CONSTANT TMACRO         5
68 CONSTANT TNUMBER        6
69 CONSTANT TPAIR          7
70 CONSTANT TPORT          8
71 CONSTANT TREF           9
72 CONSTANT TSPECIAL      10
73 CONSTANT TSTRING       11
74 CONSTANT TSTRUCT       12
75 CONSTANT TSYMBOL       13
76 CONSTANT TVALUES       14
77 CONSTANT TVARIABLE     15
78 CONSTANT TVECTOR       16
79 CONSTANT TBROKEN_HEART 17
80 #else // !__M2_PLANET__
81 enum type_t {TCHAR, TCLOSURE, TCONTINUATION, TFUNCTION, TKEYWORD, TMACRO, TNUMBER, TPAIR, TPORT, TREF, TSPECIAL, TSTRING, TSTRUCT, TSYMBOL, TVALUES, TVARIABLE, TVECTOR, TBROKEN_HEART};
82 #endif // !__M2_PLANET__
83
84 typedef SCM (*function0_t) (void);
85 typedef SCM (*function1_t) (SCM);
86 typedef SCM (*function2_t) (SCM, SCM);
87 typedef SCM (*function3_t) (SCM, SCM, SCM);
88 typedef SCM (*functionn_t) (SCM);
89 #if !POSIX
90 struct scm {
91   enum type_t type;
92   SCM car;
93   SCM cdr;
94 };
95 struct function {
96 #if __M2_PLANET__
97   FUNCTION function;
98 #else // !__M2_PLANET__
99   SCM (*function) (SCM);
100 #endif // !__M2_PLANET__
101   long arity;
102   char *name;
103 };
104 #else
105 struct function {
106   union {
107     function0_t function0;
108     function1_t function1;
109     function2_t function2;
110     function3_t function3;
111     functionn_t functionn;
112   };
113   long arity;
114   char const *name;
115 };
116 struct scm {
117   enum type_t type;
118   union {
119     char const* name;
120     SCM car;
121     SCM ref;
122     SCM string;
123     SCM variable;
124     long length;
125   };
126   union {
127     long value;
128     long function;
129     long port;
130     SCM cdr;
131     SCM closure;
132     SCM continuation;
133     SCM macro;
134     SCM vector;
135   };
136 };
137 #endif
138
139 #if __MESC__
140 //FIXME
141 char *foobar = 0;
142 struct scm *g_cells = foobar;
143 struct scm *g_news = foobar;
144 #else
145 struct scm *g_cells = 0;
146 struct scm *g_news = 0;
147 #endif
148
149 struct scm scm_nil = {TSPECIAL, "()",0};
150 struct scm scm_f = {TSPECIAL, "#f",0};
151 struct scm scm_t = {TSPECIAL, "#t",0};
152 struct scm scm_dot = {TSPECIAL, ".",0};
153 struct scm scm_arrow = {TSPECIAL, "=>",0};
154 struct scm scm_undefined = {TSPECIAL, "*undefined*",0};
155 struct scm scm_unspecified = {TSPECIAL, "*unspecified*",0};
156 struct scm scm_closure = {TSPECIAL, "*closure*",0};
157 struct scm scm_circular = {TSPECIAL, "*circular*",0};
158 struct scm scm_begin = {TSPECIAL, "*begin*",0};
159
160 struct scm scm_symbol_dot = {TSYMBOL, "*dot*",0};
161 struct scm scm_symbol_lambda = {TSYMBOL, "lambda",0};
162 struct scm scm_symbol_begin = {TSYMBOL, "begin",0};
163 struct scm scm_symbol_if = {TSYMBOL, "if",0};
164 struct scm scm_symbol_quote = {TSYMBOL, "quote",0};
165 struct scm scm_symbol_define = {TSYMBOL, "define",0};
166 struct scm scm_symbol_define_macro = {TSYMBOL, "define-macro",0};
167
168 struct scm scm_symbol_quasiquote = {TSYMBOL, "quasiquote", 0};
169 struct scm scm_symbol_unquote = {TSYMBOL, "unquote", 0};
170 struct scm scm_symbol_unquote_splicing = {TSYMBOL, "unquote-splicing", 0};
171 struct scm scm_symbol_syntax = {TSYMBOL, "syntax",0};
172 struct scm scm_symbol_quasisyntax = {TSYMBOL, "quasisyntax", 0};
173 struct scm scm_symbol_unsyntax = {TSYMBOL, "unsyntax", 0};
174 struct scm scm_symbol_unsyntax_splicing = {TSYMBOL, "unsyntax-splicing", 0};
175
176 struct scm scm_symbol_set_x = {TSYMBOL, "set!",0};
177
178 struct scm scm_symbol_sc_expand = {TSYMBOL, "sc-expand",0};
179 struct scm scm_symbol_macro_expand = {TSYMBOL, "macro-expand",0};
180 struct scm scm_symbol_portable_macro_expand = {TSYMBOL, "portable-macro-expand",0};
181 struct scm scm_symbol_sc_expander_alist = {TSYMBOL, "*sc-expander-alist*",0};
182
183 struct scm scm_symbol_call_with_values = {TSYMBOL, "call-with-values",0};
184 struct scm scm_call_with_current_continuation = {TSPECIAL, "*call/cc*",0};
185 struct scm scm_symbol_call_with_current_continuation = {TSYMBOL, "call-with-current-continuation",0};
186 struct scm scm_symbol_boot_module = {TSYMBOL, "boot-module",0};
187 struct scm scm_symbol_current_module = {TSYMBOL, "current-module",0};
188 struct scm scm_symbol_primitive_load = {TSYMBOL, "primitive-load",0};
189 struct scm scm_symbol_read_input_file = {TSYMBOL, "read-input-file",0};
190 struct scm scm_symbol_write = {TSYMBOL, "write",0};
191 struct scm scm_symbol_display = {TSYMBOL, "display",0};
192
193 struct scm scm_symbol_throw = {TSYMBOL, "throw",0};
194 struct scm scm_symbol_not_a_number = {TSYMBOL, "not-a-number",0};
195 struct scm scm_symbol_not_a_pair = {TSYMBOL, "not-a-pair",0};
196 struct scm scm_symbol_system_error = {TSYMBOL, "system-error",0};
197 struct scm scm_symbol_wrong_number_of_args = {TSYMBOL, "wrong-number-of-args",0};
198 struct scm scm_symbol_wrong_type_arg = {TSYMBOL, "wrong-type-arg",0};
199 struct scm scm_symbol_unbound_variable = {TSYMBOL, "unbound-variable",0};
200
201 struct scm scm_symbol_argv = {TSYMBOL, "%argv",0};
202 struct scm scm_symbol_mes_prefix = {TSYMBOL, "%prefix",0};
203 struct scm scm_symbol_mes_version = {TSYMBOL, "%version",0};
204
205 struct scm scm_symbol_car = {TSYMBOL, "car",0};
206 struct scm scm_symbol_cdr = {TSYMBOL, "cdr",0};
207 struct scm scm_symbol_pmatch_car = {TSYMBOL, "pmatch-car",0};
208 struct scm scm_symbol_pmatch_cdr = {TSYMBOL, "pmatch-cdr",0};
209
210 struct scm scm_vm_evlis = {TSPECIAL, "*vm-evlis*",0};
211 struct scm scm_vm_evlis2 = {TSPECIAL, "*vm-evlis2*",0};
212 struct scm scm_vm_evlis3 = {TSPECIAL, "*vm-evlis3*",0};
213 struct scm scm_vm_apply = {TSPECIAL, "core:apply",0};
214 struct scm scm_vm_apply2 = {TSPECIAL, "*vm-apply2*",0};
215 struct scm scm_vm_eval = {TSPECIAL, "core:eval-expanded",0};
216
217 struct scm scm_vm_eval_pmatch_car = {TSPECIAL, "*vm-eval-pmatch-car*",0};
218 struct scm scm_vm_eval_pmatch_cdr = {TSPECIAL, "*vm-eval-pmatch-cdr*",0};
219 struct scm scm_vm_eval_define = {TSPECIAL, "*vm-eval-define*",0};
220
221 struct scm scm_vm_eval_set_x = {TSPECIAL, "*vm-eval-set!*",0};
222 struct scm scm_vm_eval_macro_expand_eval = {TSPECIAL, "*vm:eval-macro-expand-eval*",0};
223 struct scm scm_vm_eval_macro_expand_expand = {TSPECIAL, "*vm:eval-macro-expand-expand*",0};
224 struct scm scm_vm_eval_check_func = {TSPECIAL, "*vm-eval-check-func*",0};
225 struct scm scm_vm_eval2 = {TSPECIAL, "*vm-eval2*",0};
226 struct scm scm_vm_macro_expand = {TSPECIAL, "core:macro-expand",0};
227 struct scm scm_vm_macro_expand_define = {TSPECIAL, "*vm:core:macro-expand-define*",0};
228 struct scm scm_vm_macro_expand_define_macro = {TSPECIAL, "*vm:core:macro-expand-define-macro*",0};
229 struct scm scm_vm_macro_expand_lambda = {TSPECIAL, "*vm:core:macro-expand-lambda*",0};
230 struct scm scm_vm_macro_expand_set_x = {TSPECIAL, "*vm:core:macro-expand-set!*",0};
231 struct scm scm_vm_begin_expand_primitive_load = {TSPECIAL, "*vm:core:begin-expand-primitive-load*",0};
232 struct scm scm_vm_begin_primitive_load = {TSPECIAL, "*vm:core:begin-primitive-load*",0};
233 struct scm scm_vm_macro_expand_car = {TSPECIAL, "*vm:core:macro-expand-car*",0};
234 struct scm scm_vm_macro_expand_cdr = {TSPECIAL, "*vm:macro-expand-cdr*",0};
235 struct scm scm_vm_begin_expand = {TSPECIAL, "core:eval",0};
236 struct scm scm_vm_begin_expand_eval = {TSPECIAL, "*vm:begin-expand-eval*",0};
237 struct scm scm_vm_begin_expand_macro = {TSPECIAL, "*vm:begin-expand-macro*",0};
238 struct scm scm_vm_begin = {TSPECIAL, "*vm-begin*",0};
239 struct scm scm_vm_begin_read_input_file = {TSPECIAL, "*vm-begin-read-input-file*",0};
240 struct scm scm_vm_begin_eval = {TSPECIAL, "*vm:begin-eval*",0};
241 struct scm scm_vm_if = {TSPECIAL, "*vm-if*",0};
242 struct scm scm_vm_if_expr = {TSPECIAL, "*vm-if-expr*",0};
243 struct scm scm_vm_call_with_values2 = {TSPECIAL, "*vm-call-with-values2*",0};
244 struct scm scm_vm_call_with_current_continuation2 = {TSPECIAL, "*vm-call-with-current-continuation2*",0};
245 struct scm scm_vm_return = {TSPECIAL, "*vm-return*",0};
246
247 struct scm scm_type_char = {TSYMBOL, "<cell:char>",0};
248 struct scm scm_type_closure = {TSYMBOL, "<cell:closure>",0};
249 struct scm scm_type_continuation = {TSYMBOL, "<cell:continuation>",0};
250 struct scm scm_type_function = {TSYMBOL, "<cell:function>",0};
251 struct scm scm_type_keyword = {TSYMBOL, "<cell:keyword>",0};
252 struct scm scm_type_macro = {TSYMBOL, "<cell:macro>",0};
253 struct scm scm_type_number = {TSYMBOL, "<cell:number>",0};
254 struct scm scm_type_pair = {TSYMBOL, "<cell:pair>",0};
255 struct scm scm_type_port = {TSYMBOL, "<cell:port>",0};
256 struct scm scm_type_ref = {TSYMBOL, "<cell:ref>",0};
257 struct scm scm_type_special = {TSYMBOL, "<cell:special>",0};
258 struct scm scm_type_string = {TSYMBOL, "<cell:string>",0};
259 struct scm scm_type_struct = {TSYMBOL, "<cell:struct>",0};
260 struct scm scm_type_symbol = {TSYMBOL, "<cell:symbol>",0};
261 struct scm scm_type_values = {TSYMBOL, "<cell:values>",0};
262 struct scm scm_type_variable = {TSYMBOL, "<cell:variable>",0};
263 struct scm scm_type_vector = {TSYMBOL, "<cell:vector>",0};
264 struct scm scm_type_broken_heart = {TSYMBOL, "<cell:broken-heart>",0};
265
266 struct scm scm_symbol_compiler = {TSYMBOL, "%compiler",0};
267 struct scm scm_symbol_arch = {TSYMBOL, "%arch",0};
268
269 struct scm scm_test = {TSYMBOL, "%%test",0};
270
271 #if !_POSIX_SOURCE
272 #include "mes.mes.symbols.h"
273 #else
274 #include "mes.symbols.h"
275 #endif
276
277 struct function g_functions[200];
278 int g_function = 0;
279
280 #if !__GNUC__ || !_POSIX_SOURCE
281 #include "gc.mes.h"
282 #include "lib.mes.h"
283 #include "math.mes.h"
284 #include "mes.mes.h"
285 #include "module.mes.h"
286 #include "posix.mes.h"
287 #include "reader.mes.h"
288 #include "struct.mes.h"
289 #include "vector.mes.h"
290 #else
291 #include "gc.h"
292 #include "lib.h"
293 #include "math.h"
294 #include "mes.h"
295 #include "module.h"
296 #include "posix.h"
297 #include "reader.h"
298 #include "struct.h"
299 #include "vector.h"
300 #endif
301
302 #define TYPE(x) g_cells[x].type
303 #define CAR(x) g_cells[x].car
304 #define CDR(x) g_cells[x].cdr
305
306 #define NTYPE(x) g_news[x].type
307 #define NCAR(x) g_news[x].car
308 #define NCDR(x) g_news[x].cdr
309
310 #if !_POSIX_SOURCE
311 #define LENGTH(x) g_cells[x].car
312 #define REF(x) g_cells[x].car
313 #define STRING(x) g_cells[x].car
314 #define VARIABLE(x) g_cells[x].car
315
316 #define CLOSURE(x) g_cells[x].cdr
317 #define CONTINUATION(x) g_cells[x].cdr
318
319 #define FUNCTION(x) g_functions[g_cells[x].cdr]
320 #define FUNCTION0(x) g_functions[g_cells[x].cdr].function
321 #define MACRO(x) g_cells[x].cdr
322 #define PORT(x) g_cells[x].cdr
323 #define STRUCT(x) g_cells[x].cdr
324 #define VALUE(x) g_cells[x].cdr
325 #define VECTOR(x) g_cells[x].cdr
326
327 #define NLENGTH(x) g_news[x].car
328
329 #define NVALUE(x) g_news[x].cdr
330 #define NVECTOR(x) g_news[x].cdr
331
332 #else
333 #define CONTINUATION(x) g_cells[x].cdr
334 #define HITS(x) g_cells[x].hits
335 #define LENGTH(x) g_cells[x].length
336 #define NAME(x) g_cells[x].name
337 #define STRING(x) g_cells[x].string
338 #define VARIABLE(x) g_cells[x].variable
339
340 #define CLOSURE(x) g_cells[x].closure
341 #define MACRO(x) g_cells[x].macro
342 #define PORT(x) g_cells[x].port
343 #define REF(x) g_cells[x].ref
344 #define STRUCT(x) g_cells[x].vector
345 #define VALUE(x) g_cells[x].value
346 #define VECTOR(x) g_cells[x].vector
347 #define FUNCTION(x) g_functions[g_cells[x].function]
348 #define FUNCTION0(x) g_functions[g_cells[x].function].function0
349
350 #define NLENGTH(x) g_news[x].length
351
352 #define NVALUE(x) g_news[x].value
353 #define NVECTOR(x) g_news[x].vector
354 #endif
355
356 #define MAKE_CHAR(n) make_cell__ (TCHAR, 0, n)
357 #define MAKE_CONTINUATION(n) make_cell__ (TCONTINUATION, n, g_stack)
358 #define MAKE_NUMBER(n) make_cell__ (TNUMBER, 0, n)
359 #define MAKE_REF(n) make_cell__ (TREF, n, 0)
360 #define MAKE_STRING(x) make_cell__ (TSTRING, x, 0)
361 #define MAKE_KEYWORD(x) make_cell__ (TKEYWORD, x, 0)
362 #define MAKE_STRING_PORT(x) make_cell__ (TPORT, x, -length__ (g_ports) - 2)
363 #define MAKE_MACRO(name, x) make_cell__ (TMACRO, STRING (name), x)
364
365 #define CAAR(x) CAR (CAR (x))
366 #define CADR(x) CAR (CDR (x))
367 #define CDAR(x) CDR (CAR (x))
368 #define CDDR(x) CDR (CDR (x))
369 #define CADAR(x) CAR (CDR (CAR (x)))
370 #define CADDR(x) CAR (CDR (CDR (x)))
371 #define CDADAR(x) CAR (CDR (CAR (CDR (x))))
372
373 SCM
374 alloc (long n)
375 {
376   SCM x = g_free;
377   g_free += n;
378   return x;
379 }
380
381 SCM
382 make_cell__ (long type, SCM car, SCM cdr)
383 {
384   SCM x = alloc (1);
385   TYPE (x) = type;
386   CAR (x) = car;
387   CDR (x) = cdr;
388   return x;
389 }
390
391 SCM
392 make_cell_ (SCM type, SCM car, SCM cdr)
393 {
394   assert (TYPE (type) == TNUMBER);
395   long t = VALUE (type);
396   if (t == TCHAR || t == TNUMBER)
397     return make_cell__ (t, car ? CAR (car) : 0, cdr ? CDR (cdr) : 0);
398   return make_cell__ (t, car, cdr);
399 }
400
401 SCM
402 make_symbol_ (SCM s) ///((internal))
403 {
404   SCM x = make_cell__ (TSYMBOL, s, 0);
405   g_symbols = cons (x, g_symbols);
406   return x;
407 }
408
409 SCM
410 list_of_char_equal_p (SCM a, SCM b) ///((internal))
411 {
412   while (a != cell_nil && b != cell_nil && VALUE (CAR (a)) == VALUE (CAR (b)))
413     {
414       assert (TYPE (CAR (a)) == TCHAR);
415       assert (TYPE (CAR (b)) == TCHAR);
416       a = CDR (a);
417       b = CDR (b);
418     }
419   return (a == cell_nil && b == cell_nil) ? cell_t : cell_f;
420 }
421
422 SCM
423 list_to_symbol (SCM s)
424 {
425   SCM x = g_symbols;
426   while (x)
427     {
428       if (list_of_char_equal_p (STRING (CAR (x)), s) == cell_t)
429         break;
430       x = CDR (x);
431     }
432   if (x)
433     x = CAR (x);
434   if (!x)
435     x = make_symbol_ (s);
436   return x;
437 }
438
439 SCM
440 type_ (SCM x)
441 {
442   return MAKE_NUMBER (TYPE (x));
443 }
444
445 SCM
446 car_ (SCM x)
447 {
448   return (TYPE (x) != TCONTINUATION
449           && (TYPE (CAR (x)) == TPAIR // FIXME: this is weird
450               || TYPE (CAR (x)) == TREF
451               || TYPE (CAR (x)) == TSPECIAL
452               || TYPE (CAR (x)) == TSYMBOL
453               || TYPE (CAR (x)) == TSTRING)) ? CAR (x) : MAKE_NUMBER (CAR (x));
454 }
455
456 SCM
457 cdr_ (SCM x)
458 {
459   return (TYPE (x) != TCHAR
460           && TYPE (x) != TNUMBER
461           && TYPE (x) != TPORT
462           && (TYPE (CDR (x)) == TPAIR
463               || TYPE (CDR (x)) == TREF
464               || TYPE (CDR (x)) == TSPECIAL
465               || TYPE (CDR (x)) == TSYMBOL
466               || TYPE (CDR (x)) == TSTRING)) ? CDR (x) : MAKE_NUMBER (CDR (x));
467 }
468
469 SCM
470 arity_ (SCM x)
471 {
472   assert (TYPE (x) == TFUNCTION);
473   return MAKE_NUMBER (FUNCTION (x).arity);
474 }
475
476 SCM
477 cons (SCM x, SCM y)
478 {
479   return make_cell__ (TPAIR, x, y);
480 }
481
482 SCM
483 car (SCM x)
484 {
485 #if !__MESC_MES__
486   if (TYPE (x) != TPAIR)
487     error (cell_symbol_not_a_pair, cons (x, cell_symbol_car));
488 #endif
489   return CAR (x);
490 }
491
492 SCM
493 cdr (SCM x)
494 {
495 #if !__MESC_MES__
496   if (TYPE (x) != TPAIR)
497     error (cell_symbol_not_a_pair, cons (x, cell_symbol_cdr));
498 #endif
499   return CDR (x);
500 }
501
502 SCM
503 list (SCM x) ///((arity . n))
504 {
505   return x;
506 }
507
508 SCM
509 null_p (SCM x)
510 {
511   return x == cell_nil ? cell_t : cell_f;
512 }
513
514 SCM
515 eq_p (SCM x, SCM y)
516 {
517   return (x == y
518           || ((TYPE (x) == TKEYWORD && TYPE (y) == TKEYWORD
519                && STRING (x) == STRING (y)))
520           || (TYPE (x) == TCHAR && TYPE (y) == TCHAR
521               && VALUE (x) == VALUE (y))
522           || (TYPE (x) == TNUMBER && TYPE (y) == TNUMBER
523               && VALUE (x) == VALUE (y)))
524     ? cell_t : cell_f;
525 }
526
527 SCM
528 values (SCM x) ///((arity . n))
529 {
530   SCM v = cons (0, x);
531   TYPE (v) = TVALUES;
532   return v;
533 }
534
535 SCM
536 acons (SCM key, SCM value, SCM alist)
537 {
538   return cons (cons (key, value), alist);
539 }
540
541 long
542 length__ (SCM x) ///((internal))
543 {
544   long n = 0;
545   while (x != cell_nil)
546     {
547       n++;
548       if (TYPE (x) != TPAIR)
549         return -1;
550       x = CDR (x);
551     }
552   return n;
553 }
554
555 SCM
556 length (SCM x)
557 {
558   return MAKE_NUMBER (length__ (x));
559 }
560
561 SCM apply (SCM, SCM, SCM);
562
563 SCM
564 error (SCM key, SCM x)
565 {
566 #if !__MESC_MES__
567   SCM throw;
568   if ((throw = module_ref (r0, cell_symbol_throw)) != cell_undefined)
569     return apply (throw, cons (key, cons (x, cell_nil)), r0);
570 #endif
571   display_error_ (key);
572   eputs (": ");
573   write_error_ (x);
574   eputs ("\n");
575   exit (1);
576 }
577
578 SCM
579 string_to_list (char const* s, long i)
580 {
581   SCM p = cell_nil;
582   while (i--)
583     p = cons (MAKE_CHAR (s[i]), p);
584   return p;
585 }
586
587 SCM
588 cstring_to_list (char const* s)
589 {
590   return string_to_list (s, strlen (s));
591 }
592
593 SCM
594 cstring_to_symbol (char const *s)
595 {
596   return list_to_symbol (cstring_to_list (s));
597 }
598
599 // \f extra lib
600 SCM
601 assert_defined (SCM x, SCM e) ///((internal))
602 {
603   if (e == cell_undefined)
604     return error (cell_symbol_unbound_variable, x);
605   return e;
606 }
607
608 SCM
609 check_formals (SCM f, SCM formals, SCM args) ///((internal))
610 {
611   long flen = (TYPE (formals) == TNUMBER) ? VALUE (formals) : length__ (formals);
612   long alen = length__ (args);
613   if (alen != flen && alen != -1 && flen != -1)
614     {
615       char *s = "apply: wrong number of arguments; expected: ";
616       eputs (s);
617       eputs (itoa (flen));
618       eputs (", got: ");
619       eputs (itoa (alen));
620       eputs ("\n");
621       write_error_ (f);
622       SCM e = MAKE_STRING (cstring_to_list (s));
623       return error (cell_symbol_wrong_number_of_args, cons (e, f));
624     }
625   return cell_unspecified;
626 }
627
628 SCM
629 check_apply (SCM f, SCM e) ///((internal))
630 {
631   char* type = 0;
632   if (f == cell_f || f == cell_t)
633     type = "bool";
634   if (f == cell_nil)
635     type = "nil";
636   if (f == cell_unspecified)
637     type = "*unspecified*";
638   if (f == cell_undefined)
639     type = "*undefined*";
640   if (TYPE (f) == TCHAR)
641     type = "char";
642   if (TYPE (f) == TNUMBER)
643     type = "number";
644   if (TYPE (f) == TSTRING)
645     type = "string";
646   if (TYPE (f) == TSTRUCT)
647     type = "#<...>";
648   if (TYPE (f) == TBROKEN_HEART)
649     type = "<3";
650
651   if (type)
652     {
653       char *s = "cannot apply: ";
654       eputs (s);
655       eputs (type);
656       eputs ("[");
657       write_error_ (e);
658       eputs ("]\n");
659       SCM e = MAKE_STRING (cstring_to_list (s));
660       return error (cell_symbol_wrong_type_arg, cons (e, f));
661     }
662   return cell_unspecified;
663 }
664
665 SCM
666 gc_push_frame () ///((internal))
667 {
668   SCM frame = cons (r1, cons (r2, cons (r3, cons (r0, cons (m0, cell_nil)))));
669   g_stack = cons (frame, g_stack);
670   return g_stack;
671 }
672
673 SCM
674 append2 (SCM x, SCM y)
675 {
676   if (x == cell_nil)
677     return y;
678   if (TYPE (x) != TPAIR)
679     error (cell_symbol_not_a_pair, cons (x, cell_append2));
680   SCM r = cell_nil;
681   while (x != cell_nil)
682     {
683       r = cons (CAR (x), r);
684       x = CDR (x);
685     }
686   return reverse_x_ (r, y);
687 }
688
689 SCM
690 append_reverse (SCM x, SCM y)
691 {
692   if (x == cell_nil)
693     return y;
694   if (TYPE (x) != TPAIR)
695     error (cell_symbol_not_a_pair, cons (x, cell_append_reverse));
696   while (x != cell_nil)
697     {
698       y = cons (CAR (x), y);
699       x = CDR (x);
700     }
701   return y;
702 }
703
704 SCM
705 reverse_x_ (SCM x, SCM t)
706 {
707   if (x != cell_nil && TYPE (x) != TPAIR)
708     error (cell_symbol_not_a_pair, cons (x, cell_reverse_x_));
709   SCM r = t;
710   while (x != cell_nil)
711     {
712       t = CDR (x);
713       CDR (x) = r;
714       r = x;
715       x = t;
716     }
717   return r;
718 }
719
720 SCM
721 pairlis (SCM x, SCM y, SCM a)
722 {
723   if (x == cell_nil)
724     return a;
725   if (TYPE (x) != TPAIR)
726     return cons (cons (x, y), a);
727   return cons (cons (car (x), car (y)),
728                pairlis (cdr (x), cdr (y), a));
729 }
730
731 SCM
732 call (SCM fn, SCM x)
733 {
734 #if __M2_PLANET__
735   struct function *f = FUNCTION (fn);
736 #else
737   struct function *f = &FUNCTION (fn);
738 #endif
739   int arity = f->arity;
740   if ((arity > 0 || arity == -1)
741       && x != cell_nil && TYPE (CAR (x)) == TVALUES)
742     x = cons (CADAR (x), CDR (x));
743   if ((arity > 1 || arity == -1)
744       && x != cell_nil && TYPE (CDR (x)) == TPAIR && TYPE (CADR (x)) == TVALUES)
745     x = cons (CAR (x), cons (CDADAR (x), CDR (x)));
746
747 #if __M2_PLANET__
748   FUNCTION fp = f->function;
749   if (arity == 0)
750     return fp ();
751   else if (arity == 1)
752     return fp (CAR (x));
753   else if (arity == 2)
754     return fp (CAR (x), CADR (x));
755   else if (arity == 3)
756     return fp (CAR (x), CADR (x), CAR (CDDR (x)));
757   else if (arity == -1)
758     return fp (x);
759 #elif !POSIX
760   if (arity == 0)
761     {
762       //function0_t fp = f->function;
763       SCM (*fp) (void) = f->function;
764       return fp ();
765     }
766   else if (arity == 1)
767     {
768       //function1_t fp = f->function;
769       SCM (*fp) (SCM) = f->function;
770       return fp (CAR (x));
771     }
772   else if (arity == 2)
773     {
774       //function2_t fp = f->function;
775       SCM (*fp) (SCM, SCM) = f->function;
776       return fp (CAR (x), CADR (x));
777     }
778   else if (arity == 3)
779     {
780       //function3_t fp = f->function;
781       SCM (*fp) (SCM, SCM, SCM) = f->function;
782       return fp (CAR (x), CADR (x), CAR (CDDR (x)));
783     }
784   else if (arity == -1)
785     {
786       //functionn_t fp = f->function;
787       SCM (*fp) (SCM) = f->function;
788       return fp (x);
789     }
790 #else
791   if (arity == 0)
792     return FUNCTION (fn).function0 ();
793   else if (arity == 1)
794     return FUNCTION (fn).function1 (CAR (x));
795   else if (arity == 2)
796     return FUNCTION (fn).function2 (CAR (x), CADR (x));
797   else if (arity == 3)
798     return FUNCTION (fn).function3 (CAR (x), CADR (x), CAR (CDDR (x)));
799   else if (arity == -1)
800     return FUNCTION (fn).functionn (x);
801 #endif //! (__M2_PLANET__ || !POSIX)
802   return cell_unspecified;
803 }
804
805 SCM
806 assq (SCM x, SCM a)
807 {
808   if (TYPE (a) != TPAIR)
809     return cell_f;
810   int t = TYPE (x);
811   if (t == TCHAR
812       || t == TNUMBER)
813       {
814         SCM v = VALUE (x);
815         while (a != cell_nil && v != VALUE (CAAR (a)))
816           a = CDR (a);
817       }
818     else if (t == TKEYWORD)
819       {
820         SCM v = STRING (x);
821         while (a != cell_nil && v != STRING (CAAR (a)))
822           a = CDR (a);
823       }
824   // else if (t == TSYMBOL)
825   // else if (t == TSPECIAL)
826   else
827     while (a != cell_nil && x != CAAR (a))
828       a = CDR (a);
829   return a != cell_nil ? CAR (a) : cell_f;
830 }
831
832 SCM
833 set_car_x (SCM x, SCM e)
834 {
835   if (TYPE (x) != TPAIR)
836     error (cell_symbol_not_a_pair, cons (x, cell_set_car_x));
837   CAR (x) = e;
838   return cell_unspecified;
839 }
840
841 SCM
842 set_cdr_x (SCM x, SCM e)
843 {
844   if (TYPE (x) != TPAIR)
845     error (cell_symbol_not_a_pair, cons (x, cell_set_cdr_x));
846   CDR (x) = e;
847   return cell_unspecified;
848 }
849
850 SCM
851 set_env_x (SCM x, SCM e, SCM a)
852 {
853   SCM p;
854   if (TYPE (x) == TVARIABLE)
855     p = VARIABLE (x);
856   else
857     p = assert_defined (x, module_variable (a, x));
858   if (TYPE (p) != TPAIR)
859     error (cell_symbol_not_a_pair, cons (p, x));
860   return set_cdr_x (p, e);
861 }
862
863 SCM
864 call_lambda (SCM e, SCM x, SCM aa, SCM a) ///((internal))
865 {
866   SCM cl = cons (cons (cell_closure, x), x);
867   r1 = e;
868   r0 = cl;
869   return cell_unspecified;
870 }
871
872 SCM
873 make_closure_ (SCM args, SCM body, SCM a) ///((internal))
874 {
875   return make_cell__ (TCLOSURE, 0, cons (cons (cell_circular, a), cons (args, body)));
876 }
877
878 SCM
879 make_variable_ (SCM var) ///((internal))
880 {
881   return make_cell__ (TVARIABLE, var, 0);
882 }
883
884 SCM
885 lookup_macro_ (SCM x, SCM a) ///((internal))
886 {
887   if (TYPE (x) != TSYMBOL)
888     return cell_f;
889   SCM m = assq (x, a);
890   if (m != cell_f)
891     return MACRO (CDR (m));
892   return cell_f;
893 }
894
895 SCM
896 push_cc (SCM p1, SCM p2, SCM a, SCM c) ///((internal))
897 {
898   SCM x = r3;
899   r3 = c;
900   r2 = p2;
901   gc_push_frame ();
902   r1 = p1;
903   // if (TYPE (a) == TPAIR)
904   //   r0 = module_clone_locals (r0, a);
905   // else
906     r0 = a;
907   r3 = x;
908   return cell_unspecified;
909 }
910
911 SCM
912 gc_peek_frame () ///((internal))
913 {
914   SCM frame = CAR (g_stack);
915   r1 = CAR (frame);
916   r2 = CADR (frame);
917   r3 = CAR (CDDR (frame));
918   r0 = CADR (CDDR (frame));
919   m0 = CAR (CDDR (CDDR (frame)));
920   return frame;
921 }
922
923 SCM
924 gc_pop_frame () ///((internal))
925 {
926   SCM frame = gc_peek_frame (g_stack);
927   g_stack = CDR (g_stack);
928   return frame;
929 }
930
931 char const* string_to_cstring (SCM s);
932
933 SCM
934 add_formals (SCM formals, SCM x)
935 {
936   while (TYPE (x) == TPAIR)
937     {
938       formals = cons (CAR (x), formals);
939       x = CDR (x);
940     }
941   if (TYPE (x) == TSYMBOL)
942     formals = cons (x, formals);
943   return formals;
944 }
945
946 int
947 formal_p (SCM x, SCM formals) /// ((internal))
948 {
949   if (TYPE (formals) == TSYMBOL)
950     {
951       if (x == formals)
952         return x;
953       else return cell_f;
954     }
955   while (TYPE (formals) == TPAIR && CAR (formals) != x)
956     formals = CDR (formals);
957   if (TYPE (formals) == TSYMBOL)
958     return formals == x;
959   return TYPE (formals) == TPAIR;
960 }
961
962 SCM
963 expand_variable_ (SCM x, SCM formals, int top_p) ///((internal))
964 {
965   while (TYPE (x) == TPAIR)
966     {
967       if (TYPE (CAR (x)) == TPAIR)
968         {
969           if (CAAR (x) == cell_symbol_lambda)
970             {
971               SCM f = CAR (CDAR (x));
972               formals = add_formals (formals, f);
973             }
974           else if (CAAR (x) == cell_symbol_define
975                    || CAAR (x) == cell_symbol_define_macro)
976             {
977               SCM f = CAR (CDAR (x));
978               formals = add_formals (formals, f);
979             }
980           if (CAAR (x) != cell_symbol_quote)
981             expand_variable_ (CAR (x), formals, 0);
982         }
983       else
984         {
985           if (CAR (x) == cell_symbol_lambda)
986             {
987               SCM f = CADR (x);
988               formals = add_formals (formals, f);
989               x = CDR (x);
990             }
991           else if (CAR (x) == cell_symbol_define
992                    || CAR (x) == cell_symbol_define_macro)
993             {
994               SCM f = CADR (x);
995               if (top_p && TYPE (f) == TPAIR)
996                 f = CDR (f);
997               formals = add_formals (formals, f);
998               x = CDR (x);
999             }
1000           else if (CAR (x) == cell_symbol_quote)
1001             return cell_unspecified;
1002           else if (TYPE (CAR (x)) == TSYMBOL
1003                    && CAR (x) != cell_begin
1004                    && CAR (x) != cell_symbol_begin
1005                    && CAR (x) != cell_symbol_boot_module
1006                    && CAR (x) != cell_symbol_current_module
1007                    && CAR (x) != cell_symbol_primitive_load
1008                    && CAR (x) != cell_symbol_if // HMM
1009                    && !formal_p (CAR (x), formals))
1010             {
1011               SCM v = module_variable (r0, CAR (x));
1012               if (v != cell_f)
1013                 CAR (x) = make_variable_ (v);
1014             }
1015         }
1016       x = CDR (x);
1017       top_p = 0;
1018     }
1019   return cell_unspecified;
1020 }
1021
1022 SCM
1023 expand_variable (SCM x, SCM formals) ///((internal))
1024 {
1025   return expand_variable_ (x, formals, 1);
1026 }
1027
1028 SCM struct_ref_ (SCM x, long i);
1029 SCM vector_ref_ (SCM x, long i);
1030
1031 SCM
1032 eval_apply ()
1033 {
1034   SCM aa;
1035   SCM args;
1036   SCM body;
1037   SCM cl;
1038   SCM entry;
1039   SCM expanders;
1040   SCM formals;
1041   SCM input;
1042   SCM name;
1043   SCM macro;
1044   SCM p;
1045   SCM program;
1046   SCM sc_expand;
1047   SCM x;
1048   int global_p;
1049   int macro_p;
1050   int t;
1051   long c;
1052
1053  eval_apply:
1054   if (r3 == cell_vm_evlis) goto evlis;
1055   else if (r3 == cell_vm_evlis2) goto evlis2;
1056   else if (r3 == cell_vm_evlis3) goto evlis3;
1057   else if (r3 == cell_vm_apply) goto apply;
1058   else if (r3 == cell_vm_apply2) goto apply2;
1059   else if (r3 == cell_vm_eval) goto eval;
1060   else if (r3 == cell_vm_eval_pmatch_car) goto eval_pmatch_car;
1061   else if (r3 == cell_vm_eval_pmatch_cdr) goto eval_pmatch_cdr;
1062   else if (r3 == cell_vm_eval_define) goto eval_define;
1063   else if (r3 == cell_vm_eval_set_x) goto eval_set_x;
1064   else if (r3 == cell_vm_eval_macro_expand_eval) goto eval_macro_expand_eval;
1065   else if (r3 == cell_vm_eval_macro_expand_expand) goto eval_macro_expand_expand;
1066   else if (r3 == cell_vm_eval_check_func) goto eval_check_func;
1067   else if (r3 == cell_vm_eval2) goto eval2;
1068   else if (r3 == cell_vm_macro_expand) goto macro_expand;
1069   else if (r3 == cell_vm_macro_expand_define) goto macro_expand_define;
1070   else if (r3 == cell_vm_macro_expand_define_macro) goto macro_expand_define_macro;
1071   else if (r3 == cell_vm_macro_expand_lambda) goto macro_expand_lambda;
1072   else if (r3 == cell_vm_macro_expand_set_x) goto macro_expand_set_x;
1073   else if (r3 == cell_vm_macro_expand_car) goto macro_expand_car;
1074   else if (r3 == cell_vm_macro_expand_cdr) goto macro_expand_cdr;
1075   else if (r3 == cell_vm_begin) goto begin;
1076   else if (r3 == cell_vm_begin_eval) goto begin_eval;
1077   else if (r3 == cell_vm_begin_primitive_load) goto begin_primitive_load;
1078   else if (r3 == cell_vm_begin_expand) goto begin_expand;
1079   else if (r3 == cell_vm_begin_expand_eval) goto begin_expand_eval;
1080   else if (r3 == cell_vm_begin_expand_macro) goto begin_expand_macro;
1081   else if (r3 == cell_vm_begin_expand_primitive_load) goto begin_expand_primitive_load;
1082   else if (r3 == cell_vm_if) goto vm_if;
1083   else if (r3 == cell_vm_if_expr) goto if_expr;
1084   else if (r3 == cell_vm_call_with_current_continuation2) goto call_with_current_continuation2;
1085   else if (r3 == cell_vm_call_with_values2) goto call_with_values2;
1086   else if (r3 == cell_vm_return) goto vm_return;
1087   else if (r3 == cell_unspecified) return r1;
1088   else
1089     error (cell_symbol_system_error,
1090            MAKE_STRING (cstring_to_list ("eval/apply unknown continuation")));
1091
1092  evlis:
1093   if (r1 == cell_nil)
1094     goto vm_return;
1095   if (TYPE (r1) != TPAIR)
1096     goto eval;
1097   push_cc (CAR (r1), r1, r0, cell_vm_evlis2);
1098   goto eval;
1099  evlis2:
1100   push_cc (CDR (r2), r1, r0, cell_vm_evlis3);
1101   goto evlis;
1102  evlis3:
1103   r1 = cons (r2, r1);
1104   goto vm_return;
1105
1106  apply:
1107   t = TYPE (CAR (r1));
1108   if (t == TFUNCTION)
1109     {
1110       check_formals (CAR (r1), MAKE_NUMBER (FUNCTION (CAR (r1)).arity), CDR (r1));
1111       r1 = call (CAR (r1), CDR (r1)); /// FIXME: move into eval_apply
1112       goto vm_return;
1113     }
1114   else if (t == TCLOSURE)
1115     {
1116       cl = CLOSURE (CAR (r1));
1117       body = CDDR (cl);
1118       formals = CADR (cl);
1119       args = CDR (r1);
1120       aa = CDAR (cl);
1121       aa = CDR (aa);
1122       check_formals (CAR (r1), formals, CDR (r1));
1123       p = pairlis (formals, args, aa);
1124       call_lambda (body, p, aa, r0);
1125       goto begin;
1126     }
1127   else if (t == TCONTINUATION)
1128     {
1129       x = r1;
1130       g_stack = CONTINUATION (CAR (r1));
1131       gc_pop_frame ();
1132       r1 = CADR (x);
1133       goto eval_apply;
1134     }
1135   else if (t == TSPECIAL)
1136     {
1137       c = CAR (r1);
1138       if (c == cell_vm_apply)
1139         {
1140           push_cc (cons (CADR (r1), CADDR (r1)), r1, r0, cell_vm_return);
1141           goto apply;
1142         }
1143       else if (c ==  cell_vm_eval)
1144         {
1145           push_cc (CADR (r1), r1, CADDR (r1), cell_vm_return);
1146           goto eval;
1147         }
1148       else if (c ==  cell_vm_begin_expand)
1149         {
1150           push_cc (cons (CADR (r1), cell_nil), r1, CADDR (r1), cell_vm_return);
1151           goto begin_expand;
1152         }
1153       else if (c ==  cell_call_with_current_continuation)
1154         {
1155           r1 = CDR (r1);
1156           goto call_with_current_continuation;
1157         }
1158       else
1159         check_apply (cell_f, CAR (r1));
1160     }
1161   else if (t == TSYMBOL)
1162     {
1163       if (CAR (r1) == cell_symbol_call_with_values)
1164         {
1165           r1 = CDR (r1);
1166           goto call_with_values;
1167         }
1168       if (CAR (r1) == cell_symbol_current_module)
1169         {
1170           r1 = r0;
1171           goto vm_return;
1172         }
1173       if (CAR (r1) == cell_symbol_boot_module)
1174         {
1175           r1 = m0;
1176           goto vm_return;
1177         }
1178     }
1179   else if (t == TPAIR)
1180     {
1181       if (CAAR (r1) == cell_symbol_lambda)
1182         {
1183           formals = CADR (CAR (r1));
1184           args = CDR (r1);
1185           body = CDDR (CAR (r1));
1186           p = pairlis (formals, CDR (r1), r0);
1187           check_formals (r1, formals, args);
1188           call_lambda (body, p, p, r0);
1189           goto begin;
1190         }
1191     }
1192   push_cc (CAR (r1), r1, r0, cell_vm_apply2);
1193   goto eval;
1194  apply2:
1195   check_apply (r1, CAR (r2));
1196   r1 = cons (r1, CDR (r2));
1197   goto apply;
1198
1199  eval:
1200   t = TYPE (r1);
1201   if (t == TPAIR)
1202     {
1203       c = CAR (r1);
1204       if (c ==  cell_symbol_pmatch_car)
1205         {
1206           push_cc (CADR (r1), r1, r0, cell_vm_eval_pmatch_car);
1207           goto eval;
1208         eval_pmatch_car:
1209           x = r1;
1210           gc_pop_frame ();
1211           r1 = CAR (x);
1212           goto eval_apply;
1213         }
1214       else if (c ==  cell_symbol_pmatch_cdr)
1215         {
1216           push_cc (CADR (r1), r1, r0, cell_vm_eval_pmatch_cdr);
1217           goto eval;
1218         eval_pmatch_cdr:
1219           x = r1;
1220           gc_pop_frame ();
1221           r1 = CDR (x);
1222           goto eval_apply;
1223         }
1224       else if (c ==  cell_symbol_quote)
1225         {
1226           x = r1;
1227           gc_pop_frame ();
1228           r1 = CADR (x);
1229           goto eval_apply;
1230         }
1231       else if (c ==  cell_symbol_begin)
1232         goto begin;
1233       else if (c ==  cell_symbol_lambda)
1234         {
1235           r1 = make_closure_ (CADR (r1), CDDR (r1), r0);
1236           goto vm_return;
1237         }
1238       else if (c ==  cell_symbol_if)
1239         {
1240           r1=CDR (r1);
1241           goto vm_if;
1242         }
1243       else if (c ==  cell_symbol_set_x)
1244         {
1245           push_cc (CAR (CDDR (r1)), r1, r0, cell_vm_eval_set_x);
1246           goto eval;
1247         eval_set_x:
1248           r1 = set_env_x (CADR (r2), r1, r0);
1249           goto vm_return;
1250         }
1251       else if (c == cell_vm_macro_expand)
1252         {
1253           push_cc (CADR (r1), r1, r0, cell_vm_eval_macro_expand_eval);
1254           goto eval;
1255         eval_macro_expand_eval:
1256           push_cc (r1, r2, r0, cell_vm_eval_macro_expand_expand);
1257           goto macro_expand;
1258         eval_macro_expand_expand:
1259           goto vm_return;
1260         }
1261       else
1262         {
1263           if (TYPE (r1) == TPAIR
1264               && (CAR (r1) == cell_symbol_define
1265                   || CAR (r1) == cell_symbol_define_macro))
1266             {
1267               global_p = CAAR (r0) != cell_closure;
1268               macro_p = CAR (r1) == cell_symbol_define_macro;
1269               if (global_p)
1270                 {
1271                   name = CADR (r1);
1272                   if (TYPE (CADR (r1)) == TPAIR)
1273                     name = CAR (name);
1274                   if (macro_p)
1275                     {
1276                       entry = assq (name, g_macros);
1277                       if (entry == cell_f)
1278                         {
1279                           entry = cons (name, cell_f);
1280                           g_macros = cons (entry, g_macros);
1281                         }
1282                     }
1283                   else
1284                     {
1285                       entry = module_variable (r0, name);
1286                       if (entry == cell_f)
1287                         module_define_x (m0, name, cell_f);
1288                     }
1289                 }
1290               r2 = r1;
1291               if (TYPE (CADR (r1)) != TPAIR)
1292                 {
1293                   push_cc (CAR (CDDR (r1)), r2, cons (cons (CADR (r1), CADR (r1)), r0), cell_vm_eval_define);
1294                   goto eval;
1295                 }
1296               else
1297                 {
1298                   p = pairlis (CADR (r1), CADR (r1), r0);
1299                   formals = CDR (CADR (r1));
1300                   body = CDDR (r1);
1301
1302                   if (macro_p || global_p)
1303                     expand_variable (body, formals);
1304                   r1 = cons (cell_symbol_lambda, cons (formals, body));
1305                   push_cc (r1, r2, p, cell_vm_eval_define);
1306                   goto eval;
1307                 }
1308             eval_define:;
1309               name = CADR (r2);
1310               if (TYPE (CADR (r2)) == TPAIR)
1311                 name = CAR (name);
1312               if (macro_p)
1313                 {
1314                   entry = assq (name, g_macros);
1315                   r1 = MAKE_MACRO (name, r1);
1316                   set_cdr_x (entry, r1);
1317                 }
1318               else if (global_p)
1319                 {
1320                   entry = module_variable (r0, name);
1321                   set_cdr_x (entry, r1);
1322                 }
1323               else
1324                 {
1325                   entry = cons (name, r1);
1326                   aa = cons (entry, cell_nil);
1327                   set_cdr_x (aa, cdr (r0));
1328                   set_cdr_x (r0, aa);
1329                   cl = module_variable (r0, cell_closure);
1330                   set_cdr_x (cl, aa);
1331                 }
1332               r1 = cell_unspecified;
1333               goto vm_return;
1334             }
1335           push_cc (CAR (r1), r1, r0, cell_vm_eval_check_func);
1336           gc_check ();
1337           goto eval;
1338         eval_check_func:
1339           push_cc (CDR (r2), r2, r0, cell_vm_eval2);
1340           goto evlis;
1341         eval2:
1342           r1 = cons (CAR (r2), r1);
1343           goto apply;
1344         }
1345     }
1346   else if (t == TSYMBOL)
1347     {
1348       if (r1 == cell_symbol_boot_module)
1349         goto vm_return;
1350       if (r1 == cell_symbol_current_module)
1351         goto vm_return;
1352       if (r1 == cell_symbol_begin) // FIXME
1353         {
1354           r1 = cell_begin;
1355           goto vm_return;
1356         }
1357       r1 = assert_defined (r1, module_ref (r0, r1));
1358       goto vm_return;
1359     }
1360   else if (t == TVARIABLE)
1361     {
1362       r1 = CDR (VARIABLE (r1));
1363       goto vm_return;
1364     }
1365   else if (t == TBROKEN_HEART)
1366     error (cell_symbol_system_error,  r1);
1367   else
1368     goto vm_return;
1369
1370  macro_expand:
1371   {
1372     macro;
1373     expanders;
1374
1375     if (TYPE (r1) != TPAIR || CAR (r1) == cell_symbol_quote)
1376       goto vm_return;
1377
1378     if (CAR (r1) == cell_symbol_lambda)
1379       {
1380         push_cc (CDDR (r1), r1, r0, cell_vm_macro_expand_lambda);
1381         goto macro_expand;
1382       macro_expand_lambda:
1383         CDDR (r2) = r1;
1384         r1 = r2;
1385         goto vm_return;
1386       }
1387
1388     if (TYPE (r1) == TPAIR
1389         && (macro = lookup_macro_ (CAR (r1), g_macros)) != cell_f)
1390       {
1391         r1 = cons (macro, CDR (r1));
1392         push_cc (r1, cell_nil, r0, cell_vm_macro_expand);
1393         goto apply;
1394       }
1395
1396     if (CAR (r1) == cell_symbol_define
1397         || CAR (r1) == cell_symbol_define_macro)
1398       {
1399         push_cc (CDDR (r1), r1, r0, cell_vm_macro_expand_define);
1400         goto macro_expand;
1401       macro_expand_define:
1402         CDDR (r2) = r1;
1403         r1 = r2;
1404         if (CAR (r1) == cell_symbol_define_macro)
1405           {
1406             push_cc (r1, r1, r0, cell_vm_macro_expand_define_macro);
1407             goto eval;
1408           macro_expand_define_macro:
1409             r1 = r2;
1410           }
1411         goto vm_return;
1412       }
1413
1414     if (CAR (r1) == cell_symbol_set_x)
1415       {
1416         push_cc (CDDR (r1), r1, r0, cell_vm_macro_expand_set_x);
1417         goto macro_expand;
1418       macro_expand_set_x:
1419         CDDR (r2) = r1;
1420         r1 = r2;
1421         goto vm_return;
1422       }
1423
1424     if (TYPE (r1) == TPAIR
1425         && TYPE (CAR (r1)) == TSYMBOL
1426         && CAR (r1) != cell_symbol_begin
1427         && ((macro = assq (cell_symbol_portable_macro_expand, g_macros)) != cell_f)
1428         && ((expanders = module_ref (r0, cell_symbol_sc_expander_alist)) != cell_undefined)
1429         && ((macro = assq (CAR (r1), expanders)) != cell_f))
1430       {
1431         sc_expand = module_ref (r0, cell_symbol_macro_expand);
1432         r2 = r1;
1433         if (sc_expand != cell_undefined && sc_expand != cell_f)
1434           {
1435             r1 = cons (sc_expand, cons (r1, cell_nil));
1436             goto apply;
1437           }
1438       }
1439
1440     push_cc (CAR (r1), r1, r0, cell_vm_macro_expand_car);
1441     goto macro_expand;
1442
1443   macro_expand_car:
1444     CAR (r2) = r1;
1445     r1 = r2;
1446     if (CDR (r1) == cell_nil)
1447       goto vm_return;
1448
1449     push_cc (CDR (r1), r1, r0, cell_vm_macro_expand_cdr);
1450     goto macro_expand;
1451
1452   macro_expand_cdr:
1453     CDR (r2) = r1;
1454     r1 = r2;
1455
1456     goto vm_return;
1457   }
1458
1459  begin:
1460   x = cell_unspecified;
1461   while (r1 != cell_nil)
1462     {
1463       gc_check ();
1464       if (TYPE (r1) == TPAIR)
1465         {
1466           if (CAAR (r1) == cell_symbol_primitive_load)
1467             {
1468               program = cons (CAR (r1), cell_nil);
1469               push_cc (program, r1, r0, cell_vm_begin_primitive_load);
1470               goto begin_expand;
1471             begin_primitive_load:
1472               CAR (r2) = r1;
1473               r1 = r2;
1474             }
1475         }
1476
1477       if (TYPE (r1) == TPAIR && TYPE (CAR (r1)) == TPAIR)
1478         {
1479           if (CAAR (r1) == cell_symbol_begin)
1480             r1 = append2 (CDAR (r1), CDR (r1));
1481         }
1482       if (CDR (r1) == cell_nil)
1483         {
1484           r1 = CAR (r1);
1485           goto eval;
1486         }
1487       push_cc (CAR (r1), r1, r0, cell_vm_begin_eval);
1488       goto eval;
1489     begin_eval:
1490       x = r1;
1491       r1 = CDR (r2);
1492     }
1493   r1 = x;
1494   goto vm_return;
1495
1496
1497  begin_expand:
1498   x = cell_unspecified;
1499   while (r1 != cell_nil)
1500     {
1501       gc_check ();
1502
1503       if (TYPE (r1) == TPAIR)
1504         {
1505           if (TYPE (CAR (r1)) == TPAIR && CAAR (r1) == cell_symbol_begin)
1506             r1 = append2 (CDAR (r1), CDR (r1));
1507           if (CAAR (r1) == cell_symbol_primitive_load)
1508             {
1509               push_cc (CADR (CAR (r1)), r1, r0, cell_vm_begin_expand_primitive_load);
1510               goto eval; // FIXME: expand too?!
1511             begin_expand_primitive_load:
1512               if (TYPE (r1) == TNUMBER && VALUE (r1) == 0)
1513                 ;
1514               else if (TYPE (r1) == TSTRING)
1515                 input = set_current_input_port (open_input_file (r1));
1516               else if (TYPE (r1) == TPORT)
1517                 input = set_current_input_port (r1);
1518               else
1519                 assert (0);
1520
1521               push_cc (input, r2, r0, cell_vm_return);
1522               x = read_input_file_env (r0);
1523               if (g_debug > 3)
1524                 module_printer (m0);
1525               gc_pop_frame ();
1526               input = r1;
1527               r1 = x;
1528               set_current_input_port (input);
1529               r1 = cons (cell_symbol_begin, r1);
1530               CAR (r2) = r1;
1531               r1 = r2;
1532               continue;
1533             }
1534         }
1535
1536       push_cc (CAR (r1), r1, r0, cell_vm_begin_expand_macro);
1537       goto macro_expand;
1538     begin_expand_macro:
1539       if (r1 != CAR (r2))
1540         {
1541           CAR (r2) = r1;
1542           r1 = r2;
1543           continue;
1544         }
1545       r1 = r2;
1546       expand_variable (CAR (r1), cell_nil);
1547       push_cc (CAR (r1), r1, r0, cell_vm_begin_expand_eval);
1548       goto eval;
1549     begin_expand_eval:
1550       x = r1;
1551       r1 = CDR (r2);
1552     }
1553   r1 = x;
1554   goto vm_return;
1555
1556  vm_if:
1557   push_cc (CAR (r1), r1, r0, cell_vm_if_expr);
1558   goto eval;
1559  if_expr:
1560   x = r1;
1561   r1 = r2;
1562   if (x != cell_f)
1563     {
1564       r1 = CADR (r1);
1565       goto eval;
1566     }
1567   if (CDDR (r1) != cell_nil)
1568     {
1569       r1 = CAR (CDDR (r1));
1570       goto eval;
1571     }
1572   r1 = cell_unspecified;
1573   goto vm_return;
1574
1575  call_with_current_continuation:
1576   gc_push_frame ();
1577   x = MAKE_CONTINUATION (g_continuations++);
1578   gc_pop_frame ();
1579   push_cc (cons (CAR (r1), cons (x, cell_nil)), x, r0, cell_vm_call_with_current_continuation2);
1580   goto apply;
1581  call_with_current_continuation2:
1582   CONTINUATION (r2) = g_stack;
1583   goto vm_return;
1584
1585  call_with_values:
1586   push_cc (cons (CAR (r1), cell_nil), r1, r0, cell_vm_call_with_values2);
1587   goto apply;
1588  call_with_values2:
1589   if (TYPE (r1) == TVALUES)
1590     r1 = CDR (r1);
1591   r1 = cons (CADR (r2), r1);
1592   goto apply;
1593
1594  vm_return:
1595   x = r1;
1596   gc_pop_frame ();
1597   r1 = x;
1598   goto eval_apply;
1599 }
1600
1601 SCM
1602 apply (SCM f, SCM x, SCM a) ///((internal))
1603 {
1604   push_cc (cons (f, x), cell_unspecified, r0, cell_unspecified);
1605   r3 = cell_vm_apply;
1606   return eval_apply ();
1607 }
1608
1609 SCM
1610 mes_g_stack (SCM a) ///((internal))
1611 {
1612   //r0 = a;
1613   r1 = MAKE_CHAR (0);
1614   r2 = MAKE_CHAR (0);
1615   r3 = MAKE_CHAR (0);
1616   g_stack = cons (cell_nil, cell_nil);
1617   return a;
1618 }
1619
1620 //\f Environment setup
1621
1622 #include "module.c"
1623 #include "posix.c"
1624 #include "math.c"
1625 #include "lib.c"
1626
1627 //\f Jam Collector
1628 SCM g_symbol_max;
1629
1630 SCM
1631 gc_init_cells () ///((internal))
1632 {
1633   g_cells = (struct scm *)malloc ((ARENA_SIZE+JAM_SIZE)*sizeof (struct scm));
1634   TYPE (0) = TVECTOR;
1635   LENGTH (0) = 1000;
1636   VECTOR (0) = 0;
1637   g_cells++;
1638   TYPE (0) = TCHAR;
1639   VALUE (0) = 'c';
1640   return 0;
1641 }
1642
1643 SCM
1644 mes_symbols () ///((internal))
1645 {
1646   gc_init_cells ();
1647
1648 #if MES_MINI
1649
1650 g_free++;
1651 g_cells[cell_nil] = scm_nil;
1652
1653 g_free++;
1654 g_cells[cell_f] = scm_f;
1655
1656 g_free++;
1657 g_cells[cell_t] = scm_t;
1658
1659 g_free++;
1660 g_cells[cell_dot] = scm_dot;
1661
1662 g_free++;
1663 g_cells[cell_arrow] = scm_arrow;
1664
1665 g_free++;
1666 g_cells[cell_undefined] = scm_undefined;
1667
1668 g_free++;
1669 g_cells[cell_unspecified] = scm_unspecified;
1670
1671 g_free++;
1672 g_cells[cell_closure] = scm_closure;
1673
1674 g_free++;
1675 g_cells[cell_circular] = scm_circular;
1676
1677 g_free++;
1678 g_cells[cell_begin] = scm_begin;
1679
1680 g_free++;
1681 g_cells[cell_symbol_dot] = scm_symbol_dot;
1682
1683 g_free++;
1684 g_cells[cell_symbol_lambda] = scm_symbol_lambda;
1685
1686 g_free++;
1687 g_cells[cell_symbol_begin] = scm_symbol_begin;
1688
1689 g_free++;
1690 g_cells[cell_symbol_if] = scm_symbol_if;
1691
1692 g_free++;
1693 g_cells[cell_symbol_quote] = scm_symbol_quote;
1694
1695 g_free++;
1696 g_cells[cell_symbol_define] = scm_symbol_define;
1697
1698 g_free++;
1699 g_cells[cell_symbol_define_macro] = scm_symbol_define_macro;
1700
1701 g_free++;
1702 g_cells[cell_symbol_quasiquote] = scm_symbol_quasiquote;
1703
1704 g_free++;
1705 g_cells[cell_symbol_unquote] = scm_symbol_unquote;
1706
1707 g_free++;
1708 g_cells[cell_symbol_unquote_splicing] = scm_symbol_unquote_splicing;
1709
1710
1711 ////// for GC
1712 g_free++;
1713 g_cells[cell_symbol_syntax] = scm_symbol_syntax;
1714
1715 g_free++;
1716 g_cells[cell_symbol_quasisyntax] = scm_symbol_quasisyntax;
1717
1718 g_free++;
1719 g_cells[cell_symbol_unsyntax] = scm_symbol_unsyntax;
1720
1721 g_free++;
1722 g_cells[cell_symbol_unsyntax_splicing] = scm_symbol_unsyntax_splicing;
1723
1724 g_free++;
1725 g_cells[cell_symbol_set_x] = scm_symbol_set_x;
1726
1727 g_free++;
1728 g_cells[cell_symbol_sc_expand] = scm_symbol_sc_expand;
1729
1730 g_free++;
1731 g_cells[cell_symbol_macro_expand] = scm_symbol_macro_expand;
1732
1733 g_free++;
1734 g_cells[cell_symbol_portable_macro_expand] = scm_symbol_portable_macro_expand;
1735
1736 g_free++;
1737 g_cells[cell_symbol_sc_expander_alist] = scm_symbol_sc_expander_alist;
1738
1739 g_free++;
1740 g_cells[cell_symbol_call_with_values] = scm_symbol_call_with_values;
1741
1742 g_free++;
1743 g_cells[cell_call_with_current_continuation] = scm_call_with_current_continuation;
1744
1745 g_free++;
1746 g_cells[cell_symbol_call_with_current_continuation] = scm_symbol_call_with_current_continuation;
1747
1748 g_free++;
1749 g_cells[cell_symbol_boot_module] = scm_symbol_boot_module;
1750
1751 g_free++;
1752 g_cells[cell_symbol_current_module] = scm_symbol_current_module;
1753
1754 g_free++;
1755 g_cells[cell_symbol_primitive_load] = scm_symbol_primitive_load;
1756
1757 g_free++;
1758 g_cells[cell_symbol_read_input_file] = scm_symbol_read_input_file;
1759
1760 g_free++;
1761 g_cells[cell_symbol_write] = scm_symbol_write;
1762
1763 g_free++;
1764 g_cells[cell_symbol_display] = scm_symbol_display;
1765
1766 g_free++;
1767 g_cells[cell_symbol_throw] = scm_symbol_throw;
1768
1769 g_free++;
1770 g_cells[cell_symbol_not_a_number] = scm_symbol_not_a_number;
1771
1772 g_free++;
1773 g_cells[cell_symbol_not_a_pair] = scm_symbol_not_a_pair;
1774
1775 g_free++;
1776 g_cells[cell_symbol_system_error] = scm_symbol_system_error;
1777
1778 g_free++;
1779 g_cells[cell_symbol_wrong_number_of_args] = scm_symbol_wrong_number_of_args;
1780
1781 g_free++;
1782 g_cells[cell_symbol_wrong_type_arg] = scm_symbol_wrong_type_arg;
1783
1784 g_free++;
1785 g_cells[cell_symbol_unbound_variable] = scm_symbol_unbound_variable;
1786
1787 g_free++;
1788 g_cells[cell_symbol_argv] = scm_symbol_argv;
1789
1790 g_free++;
1791 g_cells[cell_symbol_mes_prefix] = scm_symbol_mes_prefix;
1792
1793 g_free++;
1794 g_cells[cell_symbol_mes_version] = scm_symbol_mes_version;
1795
1796 g_free++;
1797 g_cells[cell_symbol_car] = scm_symbol_car;
1798
1799 g_free++;
1800 g_cells[cell_symbol_cdr] = scm_symbol_cdr;
1801
1802 g_free++;
1803 g_cells[cell_symbol_pmatch_car] = scm_symbol_pmatch_car;
1804
1805 g_free++;
1806 g_cells[cell_symbol_pmatch_cdr] = scm_symbol_pmatch_cdr;
1807
1808 g_free++;
1809 g_cells[cell_vm_evlis] = scm_vm_evlis;
1810
1811 g_free++;
1812 g_cells[cell_vm_evlis2] = scm_vm_evlis2;
1813
1814 g_free++;
1815 g_cells[cell_vm_evlis3] = scm_vm_evlis3;
1816
1817 g_free++;
1818 g_cells[cell_vm_apply] = scm_vm_apply;
1819
1820 g_free++;
1821 g_cells[cell_vm_apply2] = scm_vm_apply2;
1822
1823 g_free++;
1824 g_cells[cell_vm_eval] = scm_vm_eval;
1825
1826 g_free++;
1827 g_cells[cell_vm_eval_pmatch_car] = scm_vm_eval_pmatch_car;
1828
1829 g_free++;
1830 g_cells[cell_vm_eval_pmatch_cdr] = scm_vm_eval_pmatch_cdr;
1831
1832 g_free++;
1833 g_cells[cell_vm_eval_define] = scm_vm_eval_define;
1834
1835 g_free++;
1836 g_cells[cell_vm_eval_set_x] = scm_vm_eval_set_x;
1837
1838 g_free++;
1839 g_cells[cell_vm_eval_macro_expand_eval] = scm_vm_eval_macro_expand_eval;
1840
1841 g_free++;
1842 g_cells[cell_vm_eval_macro_expand_expand] = scm_vm_eval_macro_expand_expand;
1843
1844 g_free++;
1845 g_cells[cell_vm_eval_check_func] = scm_vm_eval_check_func;
1846
1847 g_free++;
1848 g_cells[cell_vm_eval2] = scm_vm_eval2;
1849
1850 g_free++;
1851 g_cells[cell_vm_macro_expand] = scm_vm_macro_expand;
1852
1853 g_free++;
1854 g_cells[cell_vm_macro_expand_define] = scm_vm_macro_expand_define;
1855
1856 g_free++;
1857 g_cells[cell_vm_macro_expand_define_macro] = scm_vm_macro_expand_define_macro;
1858
1859 g_free++;
1860 g_cells[cell_vm_macro_expand_lambda] = scm_vm_macro_expand_lambda;
1861
1862 g_free++;
1863 g_cells[cell_vm_macro_expand_set_x] = scm_vm_macro_expand_set_x;
1864
1865 g_free++;
1866 g_cells[cell_vm_begin_expand_primitive_load] = scm_vm_begin_expand_primitive_load;
1867
1868 g_free++;
1869 g_cells[cell_vm_begin_primitive_load] = scm_vm_begin_primitive_load;
1870
1871 g_free++;
1872 g_cells[cell_vm_macro_expand_car] = scm_vm_macro_expand_car;
1873
1874 g_free++;
1875 g_cells[cell_vm_macro_expand_cdr] = scm_vm_macro_expand_cdr;
1876
1877 g_free++;
1878 g_cells[cell_vm_begin_expand] = scm_vm_begin_expand;
1879
1880 g_free++;
1881 g_cells[cell_vm_begin_expand_eval] = scm_vm_begin_expand_eval;
1882
1883 g_free++;
1884 g_cells[cell_vm_begin_expand_macro] = scm_vm_begin_expand_macro;
1885
1886 g_free++;
1887 g_cells[cell_vm_begin] = scm_vm_begin;
1888
1889 g_free++;
1890 g_cells[cell_vm_begin_read_input_file] = scm_vm_begin_read_input_file;
1891
1892 g_free++;
1893 g_cells[cell_vm_begin_eval] = scm_vm_begin_eval;
1894
1895 g_free++;
1896 g_cells[cell_vm_if] = scm_vm_if;
1897
1898 g_free++;
1899 g_cells[cell_vm_if_expr] = scm_vm_if_expr;
1900
1901 g_free++;
1902 g_cells[cell_vm_call_with_values2] = scm_vm_call_with_values2;
1903
1904 g_free++;
1905 g_cells[cell_vm_call_with_current_continuation2] = scm_vm_call_with_current_continuation2;
1906
1907 g_free++;
1908 g_cells[cell_vm_return] = scm_vm_return;
1909
1910 g_free++;
1911 g_cells[cell_symbol_compiler] = scm_symbol_compiler;
1912
1913 g_free++;
1914 g_cells[cell_symbol_arch] = scm_symbol_arch;
1915
1916 g_free++;
1917 g_cells[cell_test] = scm_test;
1918
1919 #elif !_POSIX_SOURCE
1920 #include "mes.mes.symbols.i"
1921 #else
1922 #include "mes.symbols.i"
1923 #endif
1924
1925
1926   g_symbol_max = g_free++;
1927   g_symbols = 0;
1928   for (int i=1; i<g_symbol_max; i++)
1929     g_symbols = cons (i, g_symbols);
1930
1931   SCM a = cell_nil;
1932
1933 #if MES_MINI
1934
1935 g_cells[cell_nil].car = cstring_to_list (scm_nil.car);
1936 g_cells[cell_f].car = cstring_to_list (scm_f.car);
1937 g_cells[cell_t].car = cstring_to_list (scm_t.car);
1938 g_cells[cell_dot].car = cstring_to_list (scm_dot.car);
1939 g_cells[cell_arrow].car = cstring_to_list (scm_arrow.car);
1940 g_cells[cell_undefined].car = cstring_to_list (scm_undefined.car);
1941 g_cells[cell_unspecified].car = cstring_to_list (scm_unspecified.car);
1942 g_cells[cell_closure].car = cstring_to_list (scm_closure.car);
1943 g_cells[cell_circular].car = cstring_to_list (scm_circular.car);
1944 g_cells[cell_begin].car = cstring_to_list (scm_begin.car);
1945 g_cells[cell_symbol_dot].car = cstring_to_list (scm_symbol_dot.car);
1946 g_cells[cell_symbol_lambda].car = cstring_to_list (scm_symbol_lambda.car);
1947 g_cells[cell_symbol_begin].car = cstring_to_list (scm_symbol_begin.car);
1948 g_cells[cell_symbol_if].car = cstring_to_list (scm_symbol_if.car);
1949 g_cells[cell_symbol_quote].car = cstring_to_list (scm_symbol_quote.car);
1950 g_cells[cell_symbol_define].car = cstring_to_list (scm_symbol_define.car);
1951 g_cells[cell_symbol_define_macro].car = cstring_to_list (scm_symbol_define_macro.car);
1952 g_cells[cell_symbol_quasiquote].car = cstring_to_list (scm_symbol_quasiquote.car);
1953 g_cells[cell_symbol_unquote].car = cstring_to_list (scm_symbol_unquote.car);
1954 g_cells[cell_symbol_unquote_splicing].car = cstring_to_list (scm_symbol_unquote_splicing.car);
1955
1956 //// FOR GCC
1957 #if !POSIX
1958  #define name car
1959 #endif
1960 g_cells[cell_symbol_syntax].car = cstring_to_list (scm_symbol_syntax.name);
1961 g_cells[cell_symbol_quasisyntax].car = cstring_to_list (scm_symbol_quasisyntax.name);
1962 g_cells[cell_symbol_unsyntax].car = cstring_to_list (scm_symbol_unsyntax.name);
1963 g_cells[cell_symbol_unsyntax_splicing].car = cstring_to_list (scm_symbol_unsyntax_splicing.name);
1964 g_cells[cell_symbol_set_x].car = cstring_to_list (scm_symbol_set_x.name);
1965 g_cells[cell_symbol_sc_expand].car = cstring_to_list (scm_symbol_sc_expand.name);
1966 g_cells[cell_symbol_macro_expand].car = cstring_to_list (scm_symbol_macro_expand.name);
1967 g_cells[cell_symbol_portable_macro_expand].car = cstring_to_list (scm_symbol_portable_macro_expand.name);
1968 g_cells[cell_symbol_sc_expander_alist].car = cstring_to_list (scm_symbol_sc_expander_alist.name);
1969 g_cells[cell_symbol_call_with_values].car = cstring_to_list (scm_symbol_call_with_values.name);
1970 g_cells[cell_call_with_current_continuation].car = cstring_to_list (scm_call_with_current_continuation.name);
1971 g_cells[cell_symbol_call_with_current_continuation].car = cstring_to_list (scm_symbol_call_with_current_continuation.name);
1972 g_cells[cell_symbol_boot_module].car = cstring_to_list (scm_symbol_boot_module.name);
1973 g_cells[cell_symbol_current_module].car = cstring_to_list (scm_symbol_current_module.name);
1974 g_cells[cell_symbol_primitive_load].car = cstring_to_list (scm_symbol_primitive_load.name);
1975 g_cells[cell_symbol_read_input_file].car = cstring_to_list (scm_symbol_read_input_file.name);
1976 g_cells[cell_symbol_write].car = cstring_to_list (scm_symbol_write.name);
1977 g_cells[cell_symbol_display].car = cstring_to_list (scm_symbol_display.name);
1978 g_cells[cell_symbol_throw].car = cstring_to_list (scm_symbol_throw.name);
1979 g_cells[cell_symbol_not_a_number].car = cstring_to_list (scm_symbol_not_a_number.name);
1980 g_cells[cell_symbol_not_a_pair].car = cstring_to_list (scm_symbol_not_a_pair.name);
1981 g_cells[cell_symbol_system_error].car = cstring_to_list (scm_symbol_system_error.name);
1982 g_cells[cell_symbol_wrong_number_of_args].car = cstring_to_list (scm_symbol_wrong_number_of_args.name);
1983 g_cells[cell_symbol_wrong_type_arg].car = cstring_to_list (scm_symbol_wrong_type_arg.name);
1984 g_cells[cell_symbol_unbound_variable].car = cstring_to_list (scm_symbol_unbound_variable.name);
1985 g_cells[cell_symbol_argv].car = cstring_to_list (scm_symbol_argv.name);
1986 g_cells[cell_symbol_mes_prefix].car = cstring_to_list (scm_symbol_mes_prefix.name);
1987 g_cells[cell_symbol_mes_version].car = cstring_to_list (scm_symbol_mes_version.name);
1988 g_cells[cell_symbol_car].car = cstring_to_list (scm_symbol_car.name);
1989 g_cells[cell_symbol_cdr].car = cstring_to_list (scm_symbol_cdr.name);
1990 g_cells[cell_symbol_pmatch_car].car = cstring_to_list (scm_symbol_pmatch_car.name);
1991 g_cells[cell_symbol_pmatch_cdr].car = cstring_to_list (scm_symbol_pmatch_cdr.name);
1992
1993 #if !POSIX
1994  #undef name
1995 #endif
1996
1997 g_cells[cell_vm_evlis].car = cstring_to_list (scm_vm_evlis.car);
1998 g_cells[cell_vm_evlis2].car = cstring_to_list (scm_vm_evlis2.car);
1999 g_cells[cell_vm_evlis3].car = cstring_to_list (scm_vm_evlis3.car);
2000 g_cells[cell_vm_apply].car = cstring_to_list (scm_vm_apply.car);
2001 g_cells[cell_vm_apply2].car = cstring_to_list (scm_vm_apply2.car);
2002 g_cells[cell_vm_eval].car = cstring_to_list (scm_vm_eval.car);
2003 g_cells[cell_vm_eval_pmatch_car].car = cstring_to_list (scm_vm_eval_pmatch_car.car);
2004 g_cells[cell_vm_eval_pmatch_cdr].car = cstring_to_list (scm_vm_eval_pmatch_cdr.car);
2005 g_cells[cell_vm_eval_define].car = cstring_to_list (scm_vm_eval_define.car);
2006 g_cells[cell_vm_eval_set_x].car = cstring_to_list (scm_vm_eval_set_x.car);
2007 g_cells[cell_vm_eval_macro_expand_eval].car = cstring_to_list (scm_vm_eval_macro_expand_eval.car);
2008 g_cells[cell_vm_eval_macro_expand_expand].car = cstring_to_list (scm_vm_eval_macro_expand_expand.car);
2009 g_cells[cell_vm_eval_check_func].car = cstring_to_list (scm_vm_eval_check_func.car);
2010 g_cells[cell_vm_eval2].car = cstring_to_list (scm_vm_eval2.car);
2011 g_cells[cell_vm_macro_expand].car = cstring_to_list (scm_vm_macro_expand.car);
2012 g_cells[cell_vm_macro_expand_define].car = cstring_to_list (scm_vm_macro_expand_define.car);
2013 g_cells[cell_vm_macro_expand_define_macro].car = cstring_to_list (scm_vm_macro_expand_define_macro.car);
2014 g_cells[cell_vm_macro_expand_lambda].car = cstring_to_list (scm_vm_macro_expand_lambda.car);
2015 g_cells[cell_vm_macro_expand_set_x].car = cstring_to_list (scm_vm_macro_expand_set_x.car);
2016 g_cells[cell_vm_begin_expand_primitive_load].car = cstring_to_list (scm_vm_begin_expand_primitive_load.car);
2017 g_cells[cell_vm_begin_primitive_load].car = cstring_to_list (scm_vm_begin_primitive_load.car);
2018 g_cells[cell_vm_macro_expand_car].car = cstring_to_list (scm_vm_macro_expand_car.car);
2019 g_cells[cell_vm_macro_expand_cdr].car = cstring_to_list (scm_vm_macro_expand_cdr.car);
2020 g_cells[cell_vm_begin_expand].car = cstring_to_list (scm_vm_begin_expand.car);
2021 g_cells[cell_vm_begin_expand_eval].car = cstring_to_list (scm_vm_begin_expand_eval.car);
2022 g_cells[cell_vm_begin_expand_macro].car = cstring_to_list (scm_vm_begin_expand_macro.car);
2023 g_cells[cell_vm_begin].car = cstring_to_list (scm_vm_begin.car);
2024 g_cells[cell_vm_begin_read_input_file].car = cstring_to_list (scm_vm_begin_read_input_file.car);
2025 g_cells[cell_vm_begin_eval].car = cstring_to_list (scm_vm_begin_eval.car);
2026 g_cells[cell_vm_if].car = cstring_to_list (scm_vm_if.car);
2027 g_cells[cell_vm_if_expr].car = cstring_to_list (scm_vm_if_expr.car);
2028 g_cells[cell_vm_call_with_values2].car = cstring_to_list (scm_vm_call_with_values2.car);
2029 g_cells[cell_vm_call_with_current_continuation2].car = cstring_to_list (scm_vm_call_with_current_continuation2.car);
2030 g_cells[cell_vm_return].car = cstring_to_list (scm_vm_return.car);
2031
2032 ////////////////// gc
2033
2034 #elif !_POSIX_SOURCE
2035 #include "mes.mes.symbol-names.i"
2036 #else
2037 #include "mes.symbol-names.i"
2038 #endif
2039
2040   a = acons (cell_symbol_call_with_values, cell_symbol_call_with_values, a);
2041   a = acons (cell_symbol_boot_module, cell_symbol_boot_module, a);
2042   a = acons (cell_symbol_current_module, cell_symbol_current_module, a);
2043   a = acons (cell_symbol_call_with_current_continuation, cell_call_with_current_continuation, a);
2044
2045   a = acons (cell_symbol_mes_version, MAKE_STRING (cstring_to_list (VERSION)), a);
2046   a = acons (cell_symbol_mes_prefix, MAKE_STRING (cstring_to_list (PREFIX)), a);
2047
2048   a = acons (cell_type_char, MAKE_NUMBER (TCHAR), a);
2049   a = acons (cell_type_closure, MAKE_NUMBER (TCLOSURE), a);
2050   a = acons (cell_type_continuation, MAKE_NUMBER (TCONTINUATION), a);
2051   a = acons (cell_type_function, MAKE_NUMBER (TFUNCTION), a);
2052   a = acons (cell_type_keyword, MAKE_NUMBER (TKEYWORD), a);
2053   a = acons (cell_type_macro, MAKE_NUMBER (TMACRO), a);
2054   a = acons (cell_type_number, MAKE_NUMBER (TNUMBER), a);
2055   a = acons (cell_type_pair, MAKE_NUMBER (TPAIR), a);
2056   a = acons (cell_type_port, MAKE_NUMBER (TPORT), a);
2057   a = acons (cell_type_ref, MAKE_NUMBER (TREF), a);
2058   a = acons (cell_type_special, MAKE_NUMBER (TSPECIAL), a);
2059   a = acons (cell_type_string, MAKE_NUMBER (TSTRING), a);
2060   a = acons (cell_type_struct, MAKE_NUMBER (TSTRUCT), a);
2061   a = acons (cell_type_symbol, MAKE_NUMBER (TSYMBOL), a);
2062   a = acons (cell_type_values, MAKE_NUMBER (TVALUES), a);
2063   a = acons (cell_type_variable, MAKE_NUMBER (TVARIABLE), a);
2064   a = acons (cell_type_vector, MAKE_NUMBER (TVECTOR), a);
2065   a = acons (cell_type_broken_heart, MAKE_NUMBER (TBROKEN_HEART), a);
2066
2067   a = acons (cell_closure, a, a);
2068
2069   return a;
2070 }
2071
2072 SCM
2073 mes_environment (int argc, char *argv[])
2074 {
2075   SCM a = mes_symbols ();
2076
2077   char *compiler = "gnuc";
2078 #if __MESC__
2079   compiler = "mesc";
2080 #elif __TINYC__
2081   compiler = "tcc";
2082 #endif
2083   a = acons (cell_symbol_compiler, MAKE_STRING (cstring_to_list (compiler)), a);
2084
2085   char *arch = "x86";
2086 #if __x86_64__
2087   arch = "x86_64";
2088 #endif
2089   a = acons (cell_symbol_arch, MAKE_STRING (cstring_to_list (arch)), a);
2090
2091 #if !MES_MINI
2092   SCM lst = cell_nil;
2093   for (int i=argc-1; i>=0; i--)
2094     lst = cons (MAKE_STRING (cstring_to_list (argv[i])), lst);
2095   a = acons (cell_symbol_argv, lst, a);
2096 #endif
2097
2098   return mes_g_stack (a);
2099 }
2100
2101 SCM
2102 mes_builtins (SCM a) ///((internal))
2103 {
2104 #if MES_MINI
2105
2106 #if !POSIX
2107  #define function cdr
2108  #define name car
2109  #define string car
2110 #endif
2111
2112 //mes
2113 scm_cons.function = g_function;
2114 g_functions[g_function++] = fun_cons;
2115 cell_cons = g_free++;
2116 g_cells[cell_cons] = scm_cons;
2117
2118 scm_car.function = g_function;
2119 g_functions[g_function++] = fun_car;
2120 cell_car = g_free++;
2121 g_cells[cell_car] = scm_car;
2122
2123 scm_cdr.function = g_function;
2124 g_functions[g_function++] = fun_cdr;
2125 cell_cdr = g_free++;
2126 g_cells[cell_cdr] = scm_cdr;
2127
2128 scm_list.function = g_function;
2129 g_functions[g_function++] = fun_list;
2130 cell_list = g_free++;
2131 g_cells[cell_list] = scm_list;
2132
2133 scm_null_p.function = g_function;
2134 g_functions[g_function++] = fun_null_p;
2135 cell_null_p = g_free++;
2136 g_cells[cell_null_p] = scm_null_p;
2137
2138 scm_eq_p.function = g_function;
2139 g_functions[g_function++] = fun_eq_p;
2140 cell_eq_p = g_free++;
2141 g_cells[cell_eq_p] = scm_eq_p;
2142
2143 //math
2144 scm_minus.function = g_function;
2145 g_functions[g_function++] = fun_minus;
2146 cell_minus = g_free++;
2147 g_cells[cell_minus] = scm_minus;
2148
2149 scm_plus.function = g_function;
2150 g_functions[g_function++] = fun_plus;
2151 cell_plus = g_free++;
2152 g_cells[cell_plus] = scm_plus;
2153
2154 //lib
2155 scm_display_.function = g_function;
2156 g_functions[g_function++] = fun_display_;
2157 cell_display_ = g_free++;
2158 g_cells[cell_display_] = scm_display_;
2159
2160 scm_display_error_.function = g_function;
2161 g_functions[g_function++] = fun_display_error_;
2162 cell_display_error_ = g_free++;
2163 g_cells[cell_display_error_] = scm_display_error_;
2164
2165 //posix
2166 scm_getenv_.function = g_function;
2167 g_functions[g_function++] = fun_getenv_;
2168 cell_getenv_ = g_free++;
2169 g_cells[cell_getenv_] = scm_getenv_;
2170
2171 #if !POSIX
2172  #undef name
2173 #endif
2174
2175 //mes.environment
2176 scm_cons.string = cstring_to_list (fun_cons.name);
2177 g_cells[cell_cons].string = MAKE_STRING (scm_cons.string);
2178 a = acons (list_to_symbol (scm_cons.string), cell_cons, a);
2179
2180 scm_car.string = cstring_to_list (fun_car.name);
2181 g_cells[cell_car].string = MAKE_STRING (scm_car.string);
2182 a = acons (list_to_symbol (scm_car.string), cell_car, a);
2183
2184 scm_cdr.string = cstring_to_list (fun_cdr.name);
2185 g_cells[cell_cdr].string = MAKE_STRING (scm_cdr.string);
2186 a = acons (list_to_symbol (scm_cdr.string), cell_cdr, a);
2187
2188 scm_list.string = cstring_to_list (fun_list.name);
2189 g_cells[cell_list].string = MAKE_STRING (scm_list.string);
2190 a = acons (list_to_symbol (scm_list.string), cell_list, a);
2191
2192 scm_null_p.string = cstring_to_list (fun_null_p.name);
2193 g_cells[cell_null_p].string = MAKE_STRING (scm_null_p.string);
2194 a = acons (list_to_symbol (scm_null_p.string), cell_null_p, a);
2195
2196 scm_eq_p.string = cstring_to_list (fun_eq_p.name);
2197 g_cells[cell_eq_p].string = MAKE_STRING (scm_eq_p.string);
2198 a = acons (list_to_symbol (scm_eq_p.string), cell_eq_p, a);
2199
2200 //math.environment
2201  scm_minus.string = cstring_to_list (fun_minus.name);
2202 g_cells[cell_minus].string = MAKE_STRING (scm_minus.string);
2203 a = acons (list_to_symbol (scm_minus.string), cell_minus, a);
2204
2205 scm_plus.string = cstring_to_list (fun_plus.name);
2206 g_cells[cell_plus].string = MAKE_STRING (scm_plus.string);
2207 a = acons (list_to_symbol (scm_plus.string), cell_plus, a);
2208
2209 //lib.environment
2210 scm_display_.string = cstring_to_list (fun_display_.name);
2211 g_cells[cell_display_].string = MAKE_STRING (scm_display_.string);
2212 a = acons (list_to_symbol (scm_display_.string), cell_display_, a);
2213
2214 scm_display_error_.string = cstring_to_list (fun_display_error_.name);
2215 g_cells[cell_display_error_].string = MAKE_STRING (scm_display_error_.string);
2216 a = acons (list_to_symbol (scm_display_error_.string), cell_display_error_, a);
2217
2218 //posix.environment
2219 scm_getenv_.string = cstring_to_list (fun_getenv_.name);
2220 g_cells[cell_getenv_].string = MAKE_STRING (scm_getenv_.string);
2221 a = acons (list_to_symbol (scm_getenv_.string), cell_getenv_, a);
2222
2223 #if !POSIX
2224  #undef function
2225  #undef string
2226 #endif
2227
2228 #elif !__GNUC__ || !_POSIX_SOURCE
2229 #include "mes.mes.i"
2230
2231   // Do not sort: Order of these includes define builtins
2232 #include "module.mes.i"
2233 #include "posix.mes.i"
2234 #include "math.mes.i"
2235 #include "lib.mes.i"
2236 #include "vector.mes.i"
2237 #include "struct.mes.i"
2238 #include "gc.mes.i"
2239 #include "reader.mes.i"
2240
2241 #include "gc.mes.environment.i"
2242 #include "lib.mes.environment.i"
2243 #include "math.mes.environment.i"
2244 #include "mes.mes.environment.i"
2245 #include "module.mes.environment.i"
2246 #include "posix.mes.environment.i"
2247 #include "reader.mes.environment.i"
2248 #include "struct.mes.environment.i"
2249 #include "vector.mes.environment.i"
2250 #else
2251 #include "mes.i"
2252
2253   // Do not sort: Order of these includes define builtins
2254 #include "module.i"
2255 #include "posix.i"
2256 #include "math.i"
2257 #include "lib.i"
2258 #include "vector.i"
2259 #include "struct.i"
2260 #include "gc.i"
2261 #include "reader.i"
2262
2263 #include "gc.environment.i"
2264 #include "lib.environment.i"
2265 #include "math.environment.i"
2266 #include "mes.environment.i"
2267 #include "module.environment.i"
2268 #include "posix.environment.i"
2269 #include "reader.environment.i"
2270 #include "struct.environment.i"
2271 #include "vector.environment.i"
2272 #endif
2273
2274   if (g_debug > 3)
2275     {
2276       fdputs ("functions: ", STDERR);
2277       fdputs (itoa (g_function), STDERR);
2278       fdputs ("\n", STDERR);
2279       for (int i = 0; i < g_function; i++)
2280         {
2281           fdputs ("[", STDERR);
2282           fdputs (itoa (i), STDERR);
2283           fdputs ("]: ", STDERR);
2284           fdputs (g_functions[i].name, STDERR);
2285           fdputs ("\n", STDERR);
2286         }
2287       fdputs ("\n", STDERR);
2288     }
2289
2290   return a;
2291 }
2292
2293 SCM read_input_file_env (SCM);
2294
2295 int
2296 load_boot (char *prefix, char const *boot, char const *location)
2297 {
2298   strcpy (prefix + strlen (prefix), boot);
2299   if (g_debug > 1)
2300     {
2301       eputs ("mes: reading boot-0 [");
2302       eputs (location);
2303       eputs ("]: ");
2304       eputs (prefix);
2305       eputs ("\n");
2306     }
2307   int fd = open (prefix, O_RDONLY);
2308   if (g_debug && fd > 0)
2309     {
2310       eputs ("mes: read boot-0: ");
2311       eputs (prefix);
2312       eputs ("\n");
2313     }
2314   return fd;
2315 }
2316
2317 SCM
2318 load_env () ///((internal))
2319 {
2320   g_stdin = -1;
2321   char prefix[1024];
2322   char boot[1024];
2323   if (getenv ("MES_BOOT"))
2324     strcpy (boot, getenv ("MES_BOOT"));
2325   else
2326     strcpy (boot, "boot-0.scm");
2327   if (getenv ("MES_PREFIX"))
2328     {
2329       strcpy (prefix, getenv ("MES_PREFIX"));
2330       strcpy (prefix + strlen (prefix), "/module");
2331       strcpy (prefix + strlen (prefix), "/mes/");
2332       g_stdin = load_boot (prefix, boot, "MES_PREFIX");
2333     }
2334   if (g_stdin < 0)
2335     {
2336       char const *p = MODULEDIR "/mes/";
2337       strcpy (prefix, p);
2338       g_stdin = load_boot (prefix, boot, "MODULEDIR");
2339     }
2340   if (g_stdin < 0)
2341     {
2342       strcpy (prefix, "mes/module/mes/");
2343       g_stdin = load_boot (prefix, boot, ".");
2344     }
2345   if (g_stdin < 0)
2346     {
2347       prefix[0] = 0;
2348       g_stdin = load_boot (prefix, boot, "<boot>");
2349     }
2350   if (g_stdin < 0)
2351     {
2352       eputs ("mes: boot failed: no such file: ");
2353       eputs (boot);
2354       eputs ("\n");
2355       exit (1);
2356     }
2357
2358   r2 = read_input_file_env (r0);
2359   g_stdin = STDIN;
2360   return r2;
2361 }
2362
2363 SCM
2364 bload_env () ///((internal))
2365 {
2366 #if !_POSIX_SOURCE
2367   char *mo = "mes/boot-0.32-mo";
2368   g_stdin = open ("module/mes/boot-0.32-mo", O_RDONLY);
2369   char *read0 = MODULEDIR "/mes/boot-0.32-mo";
2370   g_stdin = g_stdin >= 0 ? g_stdin : open (read0, O_RDONLY);
2371 #else
2372   char *mo ="mes/boot-0.mo";
2373   g_stdin = open ("module/mes/boot-0.mo", O_RDONLY);
2374   g_stdin = g_stdin >= 0 ? g_stdin : open (MODULEDIR "/mes/boot-0.mo", O_RDONLY);
2375 #endif
2376
2377   if (g_stdin < 0)
2378     {
2379       eputs ("no such file: ");
2380       eputs (mo);
2381       eputs ("\n");
2382       return 1;
2383     }
2384   assert (getchar () == 'M');
2385   assert (getchar () == 'E');
2386   assert (getchar () == 'S');
2387
2388   if (g_debug)
2389     eputs ("*GOT MES*\n");
2390   g_stack = getchar () << 8;
2391   g_stack += getchar ();
2392
2393   char *p = (char*)g_cells;
2394   int c = getchar ();
2395   while (c != EOF)
2396     {
2397       *p++ = c;
2398       c = getchar ();
2399     }
2400   g_free = (p-(char*)g_cells) / sizeof (struct scm);
2401   gc_peek_frame ();
2402   g_symbols = r1;
2403   g_stdin = STDIN;
2404   // SCM a = struct_ref (r0, 3);
2405   // a = mes_builtins (a);
2406   // struct_set_x (r0, 3, a);
2407   r0 = mes_builtins (r0);
2408
2409   if (g_debug > 3)
2410     {
2411       eputs ("symbols: ");
2412       SCM s = g_symbols;
2413       while (s && s != cell_nil)
2414         {
2415           display_error_ (CAR (s));
2416           eputs (" ");
2417           s = CDR (s);
2418         }
2419       eputs ("\n");
2420       eputs ("functions: ");
2421       eputs (itoa (g_function));
2422       eputs ("\n");
2423       for (int i = 0; i < g_function; i++)
2424         {
2425           eputs ("[");
2426           eputs (itoa (i));
2427           eputs ("]: ");
2428           eputs (g_functions[i].name);
2429           eputs ("\n");
2430         }
2431     }
2432   return r2;
2433 }
2434
2435 #include "vector.c"
2436 #include "struct.c"
2437 #include "gc.c"
2438 #include "reader.c"
2439
2440 int
2441 main (int argc, char *argv[])
2442 {
2443   char *p;
2444   if (p = getenv ("MES_DEBUG"))
2445     g_debug = atoi (p);
2446   if (g_debug > 1)
2447     {
2448       eputs (";;; MODULEDIR=");
2449       eputs (MODULEDIR);
2450       eputs ("\n");
2451     }
2452   if (p = getenv ("MES_MAX_ARENA"))
2453     MAX_ARENA_SIZE = atoi (p);
2454   if (p = getenv ("MES_ARENA"))
2455     ARENA_SIZE = atoi (p);
2456   JAM_SIZE = ARENA_SIZE / 10;
2457   if (p = getenv ("MES_JAM"))
2458     JAM_SIZE = atoi (p);
2459   GC_SAFETY = ARENA_SIZE / 100;
2460   if (p = getenv ("MES_SAFETY"))
2461     GC_SAFETY = atoi (p);
2462   g_stdin = STDIN;
2463   g_stdout = STDOUT;
2464
2465   SCM a = mes_environment (argc, argv);
2466   a = mes_builtins (a);
2467   m0 = make_initial_module (a);
2468
2469   if (g_debug > 3)
2470     module_printer (m0);
2471
2472   SCM program = (argc > 1 && !strcmp (argv[1], "--load"))
2473     ? bload_env () : load_env ();
2474   g_tiny = argc > 2 && !strcmp (argv[2], "--tiny");
2475   if (argc > 1 && !strcmp (argv[1], "--dump"))
2476     return dump ();
2477
2478   push_cc (r2, cell_unspecified, r0, cell_unspecified);
2479
2480   if (g_debug > 2)
2481     {
2482       eputs ("\ngc stats: [");
2483       eputs (itoa (g_free));
2484       eputs ("]\n");
2485     }
2486   if (g_debug > 3)
2487     {
2488       eputs ("program: ");
2489       write_error_ (r1);
2490       eputs ("\n");
2491     }
2492   if (g_debug > 3)
2493     {
2494       eputs ("symbols: ");
2495       write_error_ (g_symbols);
2496       eputs ("\n");
2497     }
2498   r3 = cell_vm_begin_expand;
2499   r1 = eval_apply ();
2500   if (g_debug)
2501     {
2502       write_error_ (r1);
2503       eputs ("\n");
2504     }
2505   if (g_debug)
2506     {
2507       eputs ("\ngc stats: [");
2508       eputs (itoa (g_free));
2509       MAX_ARENA_SIZE = 0;
2510       gc (g_stack);
2511       eputs (" => ");
2512       eputs (itoa (g_free));
2513       eputs ("]\n");
2514     }
2515   return 0;
2516 }