build: Resurrect --with-cheating.
[mes.git] / scaffold / cons-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 #if SYSTEM_LIBC
22 #error "SYSTEM_LIBC not supported"
23 #endif
24
25 #include <stdio.h>
26 #include <assert.h>
27 #include <stdlib.h>
28 #include <string.h>
29 #include <mes/lib.h>
30
31 char arena[2000];
32
33 typedef int SCM;
34
35 int g_debug = 0;
36 int g_free = 0;
37
38 SCM g_continuations = 0;
39 SCM g_symbols = 0;
40 SCM g_stack = 0;
41 SCM r0 = 0;                     // a/env
42 SCM r1 = 0;                     // param 1
43 SCM r2 = 0;                     // save 2+load/dump
44 SCM r3 = 0;                     // continuation
45
46 enum type_t
47 { TCHAR, TCLOSURE, TCONTINUATION, TFUNCTION, TKEYWORD, TMACRO, TNUMBER, TPAIR, TREF, TSPECIAL, TSTRING,
48     TSYMBOL, TVALUES, TVECTOR, TBROKEN_HEART };
49
50 struct scm
51 {
52   enum type_t type;
53   SCM car;
54   SCM cdr;
55 };
56
57 struct function
58 {
59   int (*function) (void);
60   int arity;
61   char *name;
62 };
63
64 #if __MESC__
65 struct scm *g_cells = arena;
66 #else
67 struct scm *g_cells = (struct scm *) arena;
68 #endif
69
70 #define cell_nil 1
71 #define cell_f 2
72 #define cell_t 3
73 #define cell_dot 4
74 // #define cell_arrow 5
75 #define cell_undefined 6
76 #define cell_unspecified 7
77 #define cell_closure 8
78 #define cell_circular 9
79 #define cell_begin 10
80 #define cell_symbol_dot 11
81 #define cell_symbol_lambda 12
82 #define cell_symbol_begin 13
83 #define cell_symbol_if 14
84 #define cell_symbol_quote 15
85 #define cell_symbol_set_x 16
86
87 #define cell_vm_apply 45
88 #define cell_vm_apply2 46
89
90 #define cell_vm_eval 47
91
92 #define cell_vm_begin 56
93 //#define cell_vm_begin_read_input_file 57
94 #define cell_vm_begin2 58
95
96 #define cell_vm_return 63
97
98 SCM tmp;
99 SCM tmp_num;
100 SCM tmp_num2;
101
102 int ARENA_SIZE = 200;
103 struct function g_functions[5];
104 int g_function = 0;
105
106
107 SCM make_cell_ (SCM type, SCM car, SCM cdr);
108 struct function fun_make_cell_ = { &make_cell_, 3, "core:make-cell" };
109 struct scm scm_make_cell_ = { TFUNCTION, 0, 0 };
110
111    //, "core:make-cell", 0};
112 SCM cell_make_cell_;
113
114 SCM cons (SCM x, SCM y);
115 struct function fun_cons = { &cons, 2, "cons" };
116 struct scm scm_cons = { TFUNCTION, 0, 0 };
117
118   // "cons", 0};
119 SCM cell_cons;
120
121 SCM car (SCM x);
122 struct function fun_car = { &car, 1, "car" };
123 struct scm scm_car = { TFUNCTION, 0, 0 };
124
125   // "car", 0};
126 SCM cell_car;
127
128 SCM cdr (SCM x);
129 struct function fun_cdr = { &cdr, 1, "cdr" };
130 struct scm scm_cdr = { TFUNCTION, 0, 0 };
131
132 // "cdr", 0};
133 SCM cell_cdr;
134
135 // SCM eq_p (SCM x, SCM y);
136 // struct function fun_eq_p = {&eq_p,2,"eq?"};
137 // scm scm_eq_p = {TFUNCTION,0,0};
138 // SCM cell_eq_p;
139
140 #define TYPE(x) (g_cells[x].type)
141
142 #define CAR(x) g_cells[x].car
143 #define LENGTH(x) g_cells[x].car
144 #define STRING(x) g_cells[x].car
145
146 #define CDR(x) g_cells[x].cdr
147 #define CONTINUATION(x) g_cells[x].cdr
148
149 #define FUNCTION(x) g_functions[g_cells[x].cdr]
150 #define VALUE(x) g_cells[x].cdr
151 #define VECTOR(x) g_cells[x].cdr
152
153 #define MAKE_CHAR(n) make_cell_ (tmp_num_ (TCHAR), 0, tmp_num2_ (n))
154 #define MAKE_NUMBER(n) make_cell_ (tmp_num_ (TNUMBER), 0, tmp_num2_ (n))
155
156 #define CAAR(x) CAR (CAR (x))
157 #define CADAR(x) CAR (CDR (CAR (x)))
158 #define CDADAR(x) CAR (CDR (CAR (CDR (x))))
159 #define CADR(x) CAR (CDR (x))
160
161 #define MAKE_STRING(x) make_cell_ (tmp_num_ (TSTRING), x, 0)
162
163 SCM
164 alloc (int n)
165 {
166   assert (g_free + n < ARENA_SIZE);
167   SCM x = g_free;
168   g_free += n;
169   return x;
170 }
171
172 SCM
173 make_cell_ (SCM type, SCM car, SCM cdr)
174 {
175   SCM x = alloc (1);
176   assert (TYPE (type) == TNUMBER);
177   TYPE (x) = VALUE (type);
178   if (VALUE (type) == TCHAR || VALUE (type) == TNUMBER)
179     {
180       if (car)
181         CAR (x) = CAR (car);
182       if (cdr)
183         CDR (x) = CDR (cdr);
184     }
185   else if (VALUE (type) == TFUNCTION)
186     {
187       if (car)
188         CAR (x) = car;
189       if (cdr)
190         CDR (x) = CDR (cdr);
191     }
192   else
193     {
194       CAR (x) = car;
195       CDR (x) = cdr;
196     }
197   return x;
198 }
199
200 SCM
201 tmp_num_ (int x)
202 {
203   VALUE (tmp_num) = x;
204   return tmp_num;
205 }
206
207 SCM
208 tmp_num2_ (int x)
209 {
210   VALUE (tmp_num2) = x;
211   return tmp_num2;
212 }
213
214 SCM
215 cons (SCM x, SCM y)
216 {
217   VALUE (tmp_num) = TPAIR;
218   return make_cell_ (tmp_num, x, y);
219 }
220
221 SCM
222 car (SCM x)
223 {
224   return CAR (x);
225 }
226
227 SCM
228 cdr (SCM x)
229 {
230   return CDR (x);
231 }
232
233 SCM
234 gc_push_frame ()
235 {
236   SCM frame = cons (r1, cons (r2, cons (r3, cons (r0, cell_nil))));
237   g_stack = cons (frame, g_stack);
238   return g_stack;
239 }
240
241 SCM
242 append2 (SCM x, SCM y)
243 {
244   if (x == cell_nil)
245     return y;
246   assert (TYPE (x) == TPAIR);
247   return cons (car (x), append2 (cdr (x), y));
248 }
249
250 SCM
251 pairlis (SCM x, SCM y, SCM a)
252 {
253   if (x == cell_nil)
254     return a;
255   if (TYPE (x) != TPAIR)
256     return cons (cons (x, y), a);
257   return cons (cons (car (x), car (y)), pairlis (cdr (x), cdr (y), a));
258 }
259
260 SCM
261 assq (SCM x, SCM a)
262 {
263   while (a != cell_nil && x == CAAR (a))
264     a = CDR (a);
265   return a != cell_nil ? car (a) : cell_f;
266 }
267
268 SCM
269 push_cc (SCM p1, SCM p2, SCM a, SCM c)  ///((internal))
270 {
271   puts ("push cc\n");
272   SCM x = r3;
273   r3 = c;
274   r2 = p2;
275   gc_push_frame ();
276   r1 = p1;
277   r0 = a;
278   r3 = x;
279   return cell_unspecified;
280 }
281
282 SCM
283 caar (SCM x)
284 {
285   return car (car (x));
286 }
287
288 SCM
289 cadr (SCM x)
290 {
291   return car (cdr (x));
292 }
293
294 SCM
295 cdar (SCM x)
296 {
297   return cdr (car (x));
298 }
299
300 SCM
301 cddr (SCM x)
302 {
303   return cdr (cdr (x));
304 }
305
306 #if __GNUC__
307 //FIXME
308 SCM call (SCM, SCM);
309 SCM gc_pop_frame ();
310 #endif
311
312 SCM
313 eval_apply ()
314 {
315 eval_apply:
316   switch (r3)
317     {
318     case cell_vm_apply:
319       {
320         goto apply;
321       }
322     case cell_unspecified:
323       {
324         return r1;
325       }
326     }
327
328   SCM x = cell_nil;
329   SCM y = cell_nil;
330
331 apply:
332   switch (TYPE (car (r1)))
333     {
334     case TFUNCTION:
335       {
336         puts ("apply.function\n");
337         r1 = call (car (r1), cdr (r1));
338         goto vm_return;
339       }
340     }
341 vm_return:
342   x = r1;
343   gc_pop_frame ();
344   r1 = x;
345   goto eval_apply;
346 }
347
348 SCM
349 call (SCM fn, SCM x)
350 {
351   puts ("call\n");
352   if ((FUNCTION (fn).arity > 0 || FUNCTION (fn).arity == -1) && x != cell_nil && TYPE (CAR (x)) == TVALUES)
353     x = cons (CADAR (x), CDR (x));
354   if ((FUNCTION (fn).arity > 1 || FUNCTION (fn).arity == -1)
355       && x != cell_nil && TYPE (CDR (x)) == TPAIR && TYPE (CADR (x)) == TVALUES)
356     x = cons (CAR (x), cons (CDADAR (x), CDR (x)));
357   switch (FUNCTION (fn).arity)
358     {
359     case 0:
360       {
361         return (FUNCTION (fn).function) ();
362       }
363     case 1:
364       {
365         return ((SCM (*)(SCM)) (FUNCTION (fn).function)) (car (x));
366       }
367     case 2:
368       {
369         return ((SCM (*)(SCM, SCM)) (FUNCTION (fn).function)) (car (x), cadr (x));
370       }
371     case 3:
372       {
373         return ((SCM (*)(SCM, SCM, SCM)) (FUNCTION (fn).function)) (car (x), cadr (x), car (cddr (x)));
374       }
375     case -1:
376       {
377         return ((SCM (*)(SCM)) (FUNCTION (fn).function)) (x);
378       }
379     }
380   return cell_unspecified;
381 }
382
383 SCM
384 gc_peek_frame ()
385 {
386   SCM frame = car (g_stack);
387   r1 = car (frame);
388   r2 = cadr (frame);
389   r3 = car (cddr (frame));
390   r0 = cadr (cddr (frame));
391   return frame;
392 }
393
394 SCM
395 gc_pop_frame ()
396 {
397   SCM frame = gc_peek_frame (g_stack);
398   g_stack = cdr (g_stack);
399   return frame;
400 }
401
402 SCM
403 mes_g_stack (SCM a)             ///((internal))
404 {
405   r0 = a;
406   r1 = MAKE_CHAR (0);
407   r2 = MAKE_CHAR (0);
408   r3 = MAKE_CHAR (0);
409   g_stack = cons (cell_nil, cell_nil);
410   return r0;
411 }
412
413 //\f Environment setup
414 SCM
415 make_tmps (struct scm * cells)
416 {
417   tmp = g_free++;
418   cells[tmp].type = TCHAR;
419   tmp_num = g_free++;
420   cells[tmp_num].type = TNUMBER;
421   tmp_num2 = g_free++;
422   cells[tmp_num2].type = TNUMBER;
423   return 0;
424 }
425
426 SCM
427 make_symbol_ (SCM s)
428 {
429   VALUE (tmp_num) = TSYMBOL;
430   SCM x = make_cell_ (tmp_num, s, 0);
431   g_symbols = cons (x, g_symbols);
432   return x;
433 }
434
435 SCM
436 make_symbol (SCM s)
437 {
438   SCM x = 0;
439   return x ? x : make_symbol_ (s);
440 }
441
442 SCM
443 acons (SCM key, SCM value, SCM alist)
444 {
445   return cons (cons (key, value), alist);
446 }
447
448 //\f Jam Collector
449 SCM g_symbol_max;
450
451 SCM
452 gc_init_cells ()
453 {
454   return 0;
455 }
456
457 // INIT NEWS
458
459 SCM
460 mes_symbols ()                  ///((internal))
461 {
462   gc_init_cells ();
463   //  gc_init_news ();
464
465 #if __GNUC__ && 0
466   //#include "mes.symbols.i"
467 #else
468   g_free++;
469 // g_cells[cell_nil] = scm_nil;
470
471   g_free++;
472 // g_cells[cell_f] = scm_f;
473
474   g_free++;
475 // g_cells[cell_t] = scm_t;
476
477   g_free++;
478 // g_cells[cell_dot] = scm_dot;
479
480   g_free++;
481 // g_cells[cell_arrow] = scm_arrow;
482
483   g_free++;
484 // g_cells[cell_undefined] = scm_undefined;
485
486   g_free++;
487 // g_cells[cell_unspecified] = scm_unspecified;
488
489   g_free++;
490 // g_cells[cell_closure] = scm_closure;
491
492   g_free++;
493 // g_cells[cell_circular] = scm_circular;
494
495   g_free++;
496 // g_cells[cell_begin] = scm_begin;
497
498 ///
499   g_free = 44;
500   g_free++;
501 // g_cells[cell_vm_apply] = scm_vm_apply;
502
503   g_free++;
504 // g_cells[cell_vm_apply2] = scm_vm_apply2;
505
506   g_free++;
507 // g_cells[cell_vm_eval] = scm_vm_eval;
508
509 ///
510   g_free = 55;
511   g_free++;
512 // g_cells[cell_vm_begin] = scm_vm_begin;
513
514   g_free++;
515 // g_cells[cell_vm_begin_read_input_file] = scm_vm_begin_read_input_file;
516
517   g_free++;
518 // g_cells[cell_vm_begin2] = scm_vm_begin2;
519
520 ///
521   g_free = 62;
522   g_free++;
523 // g_cells[cell_vm_return] = scm_vm_return;
524
525 #endif
526
527   g_symbol_max = g_free;
528   make_tmps (g_cells);
529
530   g_symbols = 0;
531   for (int i = 1; i < g_symbol_max; i++)
532     g_symbols = cons (i, g_symbols);
533
534   SCM a = cell_nil;
535
536   a = acons (cell_symbol_dot, cell_dot, a);
537   a = acons (cell_symbol_begin, cell_begin, a);
538   a = acons (cell_closure, a, a);
539
540   return a;
541 }
542
543 SCM
544 make_closure (SCM args, SCM body, SCM a)
545 {
546   return make_cell_ (tmp_num_ (TCLOSURE), cell_f, cons (cons (cell_circular, a), cons (args, body)));
547 }
548
549 SCM
550 mes_environment ()              ///((internal))
551 {
552   SCM a = 0;
553   a = mes_symbols ();
554   a = mes_g_stack (a);
555   return a;
556 }
557
558 SCM
559 mes_builtins (SCM a)
560 {
561 #if 0
562   //__GNUC__
563 //#include "mes.i"
564
565 // #include "lib.i"
566 // #include "math.i"
567 // #include "posix.i"
568 // #include "reader.i"
569
570 // #include "lib.environment.i"
571 // #include "math.environment.i"
572 // #include "mes.environment.i"
573 // #include "posix.environment.i"
574 // #include "reader.environment.i"
575 #else
576   scm_make_cell_.cdr = g_function;
577   g_functions[g_function++] = fun_make_cell_;
578   cell_make_cell_ = g_free++;
579   g_cells[cell_make_cell_] = scm_make_cell_;
580
581   scm_cons.cdr = g_function;
582   g_functions[g_function++] = fun_cons;
583   cell_cons = g_free++;
584   g_cells[cell_cons] = scm_cons;
585
586   scm_car.cdr = g_function;
587   g_functions[g_function++] = fun_car;
588   cell_car = g_free++;
589   g_cells[cell_car] = scm_car;
590
591   scm_cdr.cdr = g_function;
592   g_functions[g_function++] = fun_cdr;
593   cell_cdr = g_free++;
594   g_cells[cell_cdr] = scm_cdr;
595 #endif
596   return a;
597 }
598
599 SCM
600 bload_env (SCM a)               ///((internal))
601 {
602   __stdin = open ("module/mes/read-0.mo", 0);
603   char *p = (char *) g_cells;
604   assert (getchar () == 'M');
605   assert (getchar () == 'E');
606   assert (getchar () == 'S');
607   g_stack = getchar () << 8;
608   g_stack += getchar ();
609   int c = getchar ();
610   while (c != EOF)
611     {
612       *p++ = c;
613       c = getchar ();
614     }
615   g_free = (p - (char *) g_cells) / sizeof (struct scm);
616   gc_peek_frame ();
617   g_symbols = r1;
618   __stdin = STDIN;
619   r0 = mes_builtins (r0);
620   return r2;
621 }
622
623 SCM
624 fill ()
625 {
626   TYPE (0) = 0x6c6c6168;
627   CAR (0) = 0x6a746f6f;
628   CDR (0) = 0x00002165;
629
630   TYPE (1) = TSYMBOL;
631   CAR (1) = 0x2d2d2d2d;
632   CDR (1) = 0x3e3e3e3e;
633
634   TYPE (9) = 0x2d2d2d2d;
635   CAR (9) = 0x2d2d2d2d;
636   CDR (9) = 0x3e3e3e3e;
637
638   // (cons 0 1)
639   TYPE (10) = TPAIR;
640   CAR (10) = 11;
641   CDR (10) = 12;
642
643   TYPE (11) = TFUNCTION;
644   CAR (11) = 0x58585858;
645   // 0 = make_cell_
646   // 1 = cons
647   // 2 = car
648   CDR (11) = 1;
649
650   TYPE (12) = TPAIR;
651   CAR (12) = 13;
652   //CDR (12) = 1;
653   CDR (12) = 14;
654
655   TYPE (13) = TNUMBER;
656   CAR (13) = 0x58585858;
657   CDR (13) = 0;
658
659   TYPE (14) = TPAIR;
660   CAR (14) = 15;
661   CDR (14) = 1;
662
663   TYPE (15) = TNUMBER;
664   CAR (15) = 0x58585858;
665   CDR (15) = 1;
666
667   return 0;
668 }
669
670 SCM
671 display_ (SCM x)
672 {
673   //puts ("<display>\n");
674   switch (TYPE (x))
675     {
676     case TCHAR:
677       {
678         //puts ("<char>\n");
679         puts ("#\\");
680         putchar (VALUE (x));
681         break;
682       }
683     case TFUNCTION:
684       {
685         //puts ("<function>\n");
686         if (VALUE (x) == 0)
687           puts ("core:make-cell");
688         if (VALUE (x) == 1)
689           puts ("cons");
690         if (VALUE (x) == 2)
691           puts ("car");
692         if (VALUE (x) == 3)
693           puts ("cdr");
694         break;
695       }
696     case TNUMBER:
697       {
698         //puts ("<number>\n");
699 #if __GNUC__
700         puts (itoa (VALUE (x)));
701 #else
702         int i;
703         i = VALUE (x);
704         i = i + 48;
705         putchar (i);
706 #endif
707         break;
708       }
709     case TPAIR:
710       {
711         //puts ("<pair>\n");
712         //if (cont != cell_f) puts "(");
713         puts ("(");
714         if (x && x != cell_nil)
715           display_ (CAR (x));
716         if (CDR (x) && CDR (x) != cell_nil)
717           {
718 #if __GNUC__
719             if (TYPE (CDR (x)) != TPAIR)
720               puts (" . ");
721 #else
722             int c;
723             c = CDR (x);
724             c = TYPE (c);
725             if (c != TPAIR)
726               puts (" . ");
727 #endif
728             display_ (CDR (x));
729           }
730         //if (cont != cell_f) puts (")");
731         puts (")");
732         break;
733       }
734     case TSPECIAL:
735       {
736         switch (x)
737           {
738           case 1:
739             {
740               puts ("()");
741               break;
742             }
743           case 2:
744             {
745               puts ("#f");
746               break;
747             }
748           case 3:
749             {
750               puts ("#t");
751               break;
752             }
753           default:
754             {
755 #if __GNUC__
756               puts ("<x:");
757               puts (itoa (x));
758               puts (">");
759 #else
760               puts ("<x>");
761 #endif
762             }
763           }
764         break;
765       }
766     case TSYMBOL:
767       {
768         switch (x)
769           {
770           case 11:
771             {
772               puts (" . ");
773               break;
774             }
775           case 12:
776             {
777               puts ("lambda");
778               break;
779             }
780           case 13:
781             {
782               puts ("begin");
783               break;
784             }
785           case 14:
786             {
787               puts ("if");
788               break;
789             }
790           case 15:
791             {
792               puts ("quote");
793               break;
794             }
795           case 37:
796             {
797               puts ("car");
798               break;
799             }
800           case 38:
801             {
802               puts ("cdr");
803               break;
804             }
805           case 39:
806             {
807               puts ("null?");
808               break;
809             }
810           case 40:
811             {
812               puts ("eq?");
813               break;
814             }
815           case 41:
816             {
817               puts ("cons");
818               break;
819             }
820           default:
821             {
822 #if __GNUC__
823               puts ("<s:");
824               puts (itoa (x));
825               puts (">");
826 #else
827               puts ("<s>");
828 #endif
829             }
830           }
831         break;
832       }
833     default:
834       {
835         //puts ("<default>\n");
836 #if __GNUC__
837         puts ("<");
838         puts (itoa (TYPE (x)));
839         puts (":");
840         puts (itoa (x));
841         puts (">");
842 #else
843         puts ("_");
844 #endif
845         break;
846       }
847     }
848   return 0;
849 }
850
851 SCM
852 simple_bload_env (SCM a)        ///((internal))
853 {
854   puts ("reading: ");
855   char *mo = "module/mes/tiny-0-32.mo";
856   puts (mo);
857   puts ("\n");
858   __stdin = open (mo, 0);
859   if (__stdin < 0)
860     {
861       eputs ("no such file: module/mes/tiny-0-32.mo\n");
862       return 1;
863     }
864
865   char *p = (char *) g_cells;
866   int c;
867
868   assert (getchar () == 'M');
869   assert (getchar () == 'E');
870   assert (getchar () == 'S');
871   puts (" *GOT MES*\n");
872
873   g_stack = getchar () << 8;
874   g_stack += getchar ();
875
876   puts ("stack: ");
877   puts (itoa (g_stack));
878   puts ("\n");
879
880   c = getchar ();
881   while (c != -1)
882     {
883       *p++ = c;
884       c = getchar ();
885     }
886
887   puts ("read done\n");
888
889   g_free = (p - (char *) g_cells) / sizeof (struct scm);
890
891   if (g_free != 15)
892     exit (33);
893
894   g_symbols = 1;
895
896   __stdin = STDIN;
897   r0 = mes_builtins (r0);
898
899   if (g_free != 19)
900     exit (34);
901
902   puts ("cells read: ");
903   puts (itoa (g_free));
904   puts ("\n");
905
906   puts ("symbols: ");
907   puts (itoa (g_symbols));
908   puts ("\n");
909   // display_ (g_symbols);
910   // puts ("\n");
911
912   display_ (10);
913   puts ("\n");
914
915   fill ();
916   r2 = 10;
917
918   if (TYPE (12) != TPAIR)
919     exit (33);
920
921   puts ("program[");
922   puts (itoa (r2));
923   puts ("]: ");
924
925   display_ (r2);
926   //display_ (14);
927   puts ("\n");
928
929   r0 = 1;
930   //r2 = 10;
931   return r2;
932 }
933
934 int
935 main (int argc, char *argv[])
936 {
937   puts ("Hello cons-mes!\n");
938   if (argc > 1 && !strcmp (argv[1], "--help"))
939     return eputs ("Usage: mes [--dump|--load] < FILE");
940 #if __GNUC__
941   if (argc > 1 && !strcmp (argv[1], "--version"))
942     {
943       eputs ("Mes ");
944       return eputs (VERSION);
945     };
946 #else
947   if (argc > 1 && !strcmp (argv[1], "--version"))
948     {
949       eputs ("Mes ");
950       return eputs ("0.4");
951     };
952 #endif
953   __stdin = STDIN;
954
955   r0 = mes_environment ();
956
957   SCM program = simple_bload_env (r0);
958
959   puts ("g_free=");
960   puts (itoa (g_free));
961   puts ("\n");
962
963   push_cc (r2, cell_unspecified, r0, cell_unspecified);
964
965   puts ("g_free=");
966   puts (itoa (g_free));
967   puts ("\n");
968
969   puts ("g_stack=");
970   puts (itoa (g_stack));
971   puts ("\n");
972
973   puts ("r0=");
974   puts (itoa (r0));
975   puts ("\n");
976
977   puts ("r1=");
978   puts (itoa (r1));
979   puts ("\n");
980
981   puts ("r2=");
982   puts (itoa (r2));
983   puts ("\n");
984
985   puts ("r3=");
986   puts (itoa (r3));
987   puts ("\n");
988
989   r3 = cell_vm_apply;
990   r1 = eval_apply ();
991   display_ (r1);
992
993   eputs ("\n");
994   return 0;
995 }