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 #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 #if __GNUC__
 548   //FIXME GNUC
 549   //g_stdin = g_stdin ? g_stdin : fopen (PREFIX "module/mes/read-0.mo", "r");
 550 #endif
 551   char *p = (char*)g_cells;
 552   assert (getchar () == 'M');
 553   assert (getchar () == 'E');
 554   assert (getchar () == 'S');
 555   g_stack = getchar () << 8;
 556   g_stack += getchar ();
 557   int c = getchar ();
 558   while (c != EOF)
 559     {
 560       *p++ = c;
 561       c = getchar ();
 562     }
 563   g_free = (p-(char*)g_cells) / sizeof (struct scm);
 564   gc_peek_frame ();
 565   g_symbols = r1;
 566   g_stdin = STDIN;
 567   r0 = mes_builtins (r0);
 568   return r2;
 569 }
 570
 571 SCM
 572 fill ()
 573 {
 574   TYPE (0) = 0x6c6c6168;
 575   CAR (0) = 0x6a746f6f;
 576   CDR (0) = 0x00002165;
 577
 578   TYPE (1) = TSYMBOL;
 579   CAR (1) = 0x2d2d2d2d;
 580   CDR (1) = 0x3e3e3e3e;
 581
 582   TYPE (9) = 0x2d2d2d2d;
 583   CAR (9) = 0x2d2d2d2d;
 584   CDR (9) = 0x3e3e3e3e;
 585
 586   // (cons 0 1)
 587   TYPE (10) = TPAIR;
 588   CAR (10) = 11;
 589   CDR (10) = 12;
 590
 591   TYPE (11) = TFUNCTION;
 592   CAR (11) = 0x58585858;
 593   // 0 = make_cell_
 594   // 1 = cons
 595   // 2 = car
 596   CDR (11) = 1;
 597
 598   TYPE (12) = TPAIR;
 599   CAR (12) = 13;
 600   //CDR (12) = 1;
 601   CDR (12) = 14;
 602
 603   TYPE (13) = TNUMBER;
 604   CAR (13) = 0x58585858;
 605   CDR (13) = 0;
 606
 607   TYPE (14) = TPAIR;
 608   CAR (14) = 15;
 609   CDR (14) = 1;
 610
 611   TYPE (15) = TNUMBER;
 612   CAR (15) = 0x58585858;
 613   CDR (15) = 1;
 614
 615   return 0;
 616 }
 617
 618 SCM
 619 display_ (SCM x)
 620 {
 621   //puts ("<display>\n");
 622   switch (TYPE (x))
 623     {
 624     case TCHAR:
 625       {
 626         //puts ("<char>\n");
 627         puts ("#\\");
 628         putchar (VALUE (x));
 629         break;
 630       }
 631     case TFUNCTION:
 632       {
 633         //puts ("<function>\n");
 634         if (VALUE (x) == 0)
 635           puts ("core:make-cell");
 636         if (VALUE (x) == 1)
 637           puts ("cons");
 638         if (VALUE (x) == 2)
 639           puts ("car");
 640         if (VALUE (x) == 3)
 641           puts ("cdr");
 642         break;
 643       }
 644     case TNUMBER:
 645       {
 646         //puts ("<number>\n");
 647 #if __GNUC__
 648         puts (itoa (VALUE (x)));
 649 #else
 650         int i;
 651         i = VALUE (x);
 652         i = i + 48;
 653         putchar (i);
 654 #endif
 655         break;
 656       }
 657     case TPAIR:
 658       {
 659         //puts ("<pair>\n");
 660         //if (cont != cell_f) puts "(");
 661         puts ("(");
 662         if (x && x != cell_nil) display_ (CAR (x));
 663         if (CDR (x) && CDR (x) != cell_nil)
 664           {
 665 #if __GNUC__
 666             if (TYPE (CDR (x)) != TPAIR)
 667               puts (" . ");
 668 #else
 669             int c;
 670             c = CDR (x);
 671             c = TYPE (c);
 672             if (c != TPAIR)
 673               puts (" . ");
 674 #endif
 675             display_ (CDR (x));
 676           }
 677         //if (cont != cell_f) puts (")");
 678         puts (")");
 679         break;
 680       }
 681     case TSPECIAL:
 682       {
 683         switch (x)
 684           {
 685           case 1: {puts ("()"); break;}
 686           case 2: {puts ("#f"); break;}
 687           case 3: {puts ("#t"); break;}
 688           default:
 689             {
 690 #if __GNUC__
 691         puts ("<x:");
 692         puts (itoa (x));
 693         puts (">");
 694 #else
 695         puts ("<x>");
 696 #endif
 697             }
 698           }
 699         break;
 700       }
 701     case TSYMBOL:
 702       {
 703         switch (x)
 704           {
 705           case 11: {puts (" . "); break;}
 706           case 12: {puts ("lambda"); break;}
 707           case 13: {puts ("begin"); break;}
 708           case 14: {puts ("if"); break;}
 709           case 15: {puts ("quote"); break;}
 710           case 37: {puts ("car"); break;}
 711           case 38: {puts ("cdr"); break;}
 712           case 39: {puts ("null?"); break;}
 713           case 40: {puts ("eq?"); break;}
 714           case 41: {puts ("cons"); break;}
 715           default:
 716             {
 717 #if __GNUC__
 718         puts ("<s:");
 719         puts (itoa (x));
 720         puts (">");
 721 #else
 722         puts ("<s>");
 723 #endif
 724             }
 725           }
 726         break;
 727       }
 728     default:
 729       {
 730         //puts ("<default>\n");
 731 #if __GNUC__
 732         puts ("<");
 733         puts (itoa (TYPE (x)));
 734         puts (":");
 735         puts (itoa (x));
 736         puts (">");
 737 #else
 738         puts ("_");
 739 #endif
 740         break;
 741       }
 742     }
 743   return 0;
 744 }
 745
 746 SCM
 747 simple_bload_env (SCM a) ///((internal))
 748 {
 749   puts ("reading: ");
 750   char *mo = "module/mes/tiny-0-32.mo";
 751   puts (mo);
 752   puts ("\n");
 753   g_stdin = open (mo, 0);
 754   if (g_stdin < 0) {eputs ("no such file: module/mes/tiny-0-32.mo\n");return 1;}
 755
 756   char *p = (char*)g_cells;
 757   int c;
 758
 759   assert (getchar () == 'M');
 760   assert (getchar () == 'E');
 761   assert (getchar () == 'S');
 762   puts (" *GOT MES*\n");
 763
 764   g_stack = getchar () << 8;
 765   g_stack += getchar ();
 766
 767   puts ("stack: ");
 768   puts (itoa (g_stack));
 769   puts ("\n");
 770
 771   c = getchar ();
 772   while (c != -1)
 773     {
 774       *p++ = c;
 775       c = getchar ();
 776     }
 777
 778   puts ("read done\n");
 779
 780   g_free = (p-(char*)g_cells) / sizeof (struct scm);
 781
 782   if (g_free != 15) exit (33);
 783
 784   g_symbols = 1;
 785
 786   g_stdin = STDIN;
 787   r0 = mes_builtins (r0);
 788
 789   if (g_free != 19) exit (34);
 790
 791   puts ("cells read: ");
 792   puts (itoa (g_free));
 793   puts ("\n");
 794
 795   puts ("symbols: ");
 796   puts (itoa (g_symbols));
 797   puts ("\n");
 798   // display_ (g_symbols);
 799   // puts ("\n");
 800
 801   display_ (10);
 802   puts ("\n");
 803
 804   fill ();
 805   r2 = 10;
 806
 807   if (TYPE (12) != TPAIR)
 808     exit (33);
 809
 810   puts ("program[");
 811   puts (itoa (r2));
 812   puts ("]: ");
 813
 814   display_ (r2);
 815   //display_ (14);
 816   puts ("\n");
 817
 818   r0 = 1;
 819   //r2 = 10;
 820   return r2;
 821 }
 822
 823 int
 824 main (int argc, char *argv[])
 825 {
 826   puts ("Hello cons-mes!\n");
 827   if (argc > 1 && !strcmp (argv[1], "--help")) return eputs ("Usage: mes [--dump|--load] < FILE");
 828 #if __GNUC__
 829   if (argc > 1 && !strcmp (argv[1], "--version")) {eputs ("Mes ");return eputs (VERSION);};
 830 #else
 831   if (argc > 1 && !strcmp (argv[1], "--version")) {eputs ("Mes ");return eputs ("0.4");};
 832 #endif
 833   g_stdin = STDIN;
 834
 835   r0 = mes_environment ();
 836
 837   SCM program = simple_bload_env (r0);
 838
 839   puts ("g_free=");
 840   puts (itoa(g_free));
 841   puts ("\n");
 842
 843   push_cc (r2, cell_unspecified, r0, cell_unspecified);
 844
 845   puts ("g_free=");
 846   puts (itoa(g_free));
 847   puts ("\n");
 848
 849   puts ("g_stack=");
 850   puts (itoa(g_stack));
 851   puts ("\n");
 852
 853   puts ("r0=");
 854   puts (itoa(r0));
 855   puts ("\n");
 856
 857   puts ("r1=");
 858   puts (itoa(r1));
 859   puts ("\n");
 860
 861   puts ("r2=");
 862   puts (itoa(r2));
 863   puts ("\n");
 864
 865   puts ("r3=");
 866   puts (itoa(r3));
 867   puts ("\n");
 868
 869   r3 = cell_vm_apply;
 870   r1 = eval_apply ();
 871   display_ (r1);
 872
 873   eputs ("\n");
 874   return 0;
 875 }
 876