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