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