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