scaffold/tiny-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 #define MES_MINI 1
  22
  23 #if __GNUC__
  24 #define FIXME_NYACC 1
  25 #define  __NYACC__ 0
  26 #define NYACC_CAR
  27 #define NYACC_CDR
  28 #else
  29 #define  __NYACC__ 1
  30 #define NYACC_CAR nyacc_car
  31 #define NYACC_CDR nyacc_cdr
  32 #endif
  33
  34 int g_stdin = 0;
  35
  36 #if __GNUC__
  37 typedef long size_t;
  38 void *malloc (size_t i);
  39 int open (char const *s, int mode);
  40 int read (int fd, void* buf, size_t n);
  41 void write (int fd, char const* s, int n);
  42
  43 void
  44 exit (int code)
  45 {
  46   asm (
  47        "movl %0,%%ebx\n\t"
  48        "movl $1,%%eax\n\t"
  49        "int  $0x80"
  50        : // no outputs "=" (r)
  51        : "" (code)
  52        );
  53   // not reached
  54   exit (0);
  55 }
  56
  57 char const*
  58 getenv (char const* p)
  59 {
  60   return 0;
  61 }
  62
  63 int
  64 read (int fd, void* buf, size_t n)
  65 {
  66   int r;
  67   //syscall (SYS_write, fd, s, n));
  68   asm (
  69        "movl %1,%%ebx\n\t"
  70        "movl %2,%%ecx\n\t"
  71        "movl %3,%%edx\n\t"
  72        "movl $0x3,%%eax\n\t"
  73        "int  $0x80\n\t"
  74        "mov %%eax,%0\n\t"
  75        : "=r" (r)
  76        : "" (fd), "" (buf), "" (n)
  77        : "eax", "ebx", "ecx", "edx"
  78        );
  79   return r;
  80 }
  81
  82 int
  83 open (char const *s, int mode)
  84 {
  85   int r;
  86   //syscall (SYS_open, mode));
  87   asm (
  88        "mov %1,%%ebx\n\t"
  89        "mov %2,%%ecx\n\t"
  90        "mov $0x5,%%eax\n\t"
  91        "int $0x80\n\t"
  92        "mov %%eax,%0\n\t"
  93        : "=r" (r)
  94        : "" (s), "" (mode)
  95        : "eax", "ebx", "ecx"
  96        );
  97   return r;
  98 }
  99
 100 int
 101 getchar ()
 102 {
 103   char c;
 104   int r = read (g_stdin, &c, 1);
 105   if (r < 1) return -1;
 106   return c;
 107 }
 108
 109 void
 110 write (int fd, char const* s, int n)
 111 {
 112   int r;
 113   //syscall (SYS_write, fd, s, n));
 114   asm (
 115        "mov %0,%%ebx\n\t"
 116        "mov %1,%%ecx\n\t"
 117        "mov %2,%%edx\n\t"
 118
 119        "mov $0x4, %%eax\n\t"
 120        "int $0x80\n\t"
 121        : // no outputs "=" (r)
 122        : "" (fd), "" (s), "" (n)
 123        : "eax", "ebx", "ecx", "edx"
 124        );
 125 }
 126
 127 int
 128 putchar (int c)
 129 {
 130   //write (STDOUT, s, strlen (s));
 131   //int i = write (STDOUT, s, strlen (s));
 132   write (1, (char*)&c, 1);
 133   return 0;
 134 }
 135
 136 void *
 137 malloc (size_t size)
 138 {
 139   int *n;
 140   int len = size + sizeof (size);
 141   //n = mmap (0, len, PROT_READ | PROT_WRITE, MAP_PRIVATE | MAP_ANONYMOUS, 0, 0 );
 142   *n = len;
 143   return (void*)(n+1);
 144 }
 145
 146 void
 147 free (void *p)
 148 {
 149   int *n = (int*)p-1;
 150   //munmap ((void*)p, *n);
 151 }
 152
 153 #define EOF -1
 154 #define STDIN 0
 155 #define STDOUT 1
 156 #define STDERR 2
 157
 158 size_t
 159 strlen (char const* s)
 160 {
 161   int i = 0;
 162   while (s[i]) i++;
 163   return i;
 164 }
 165
 166 int
 167 strcmp (char const* a, char const* b)
 168 {
 169   while (*a && *b && *a == *b) {a++;b++;}
 170   return *a - *b;
 171 }
 172
 173 int
 174 puts (char const* s)
 175 {
 176   //write (STDOUT, s, strlen (s));
 177   //int i = write (STDOUT, s, strlen (s));
 178   int i = strlen (s);
 179   write (1, s, i);
 180   return 0;
 181 }
 182
 183 int
 184 eputs (char const* s)
 185 {
 186   //write (STDERR, s, strlen (s));
 187   //int i = write (STDERR, s, strlen (s));
 188   int i = strlen (s);
 189   write (2, s, i);
 190   return 0;
 191 }
 192
 193 char const*
 194 itoa (int x)
 195 {
 196   static char buf[10];
 197   char *p = buf+9;
 198   *p-- = 0;
 199
 200   int sign = x < 0;
 201   if (sign)
 202     x = -x;
 203
 204   do
 205     {
 206       *p-- = '0' + (x % 10);
 207       x = x / 10;
 208     } while (x);
 209
 210   if (sign)
 211     *p-- = '-';
 212
 213   return p+1;
 214 }
 215
 216 #endif
 217
 218 void
 219 assert_fail (char* s)
 220 {
 221   eputs ("assert fail:");
 222 #if __GNUC__
 223   eputs (s);
 224 #endif
 225   eputs ("\n");
 226 #if __GNUC__
 227   *((int*)0) = 0;
 228 #endif
 229 }
 230
 231 #if __GNUC__
 232 #define assert(x) ((x) ? (void)0 : assert_fail ("boo:" #x))
 233 #else
 234 //#define assert(x) ((x) ? (void)0 : assert_fail ("boo:" #x))
 235 #define assert(x) ((x) ? (void)0 : assert_fail (0))
 236 #endif
 237
 238 typedef int SCM;
 239
 240 #if __GNUC__
 241 int g_debug = 0;
 242 #endif
 243
 244 int g_free = 0;
 245
 246 SCM g_symbols = 0;
 247 SCM g_stack = 0;
 248 SCM r0 = 0; // a/env
 249 SCM r1 = 0; // param 1
 250 SCM r2 = 0; // save 2+load/dump
 251 SCM r3 = 0; // continuation
 252
 253 #if __NYACC__ || FIXME_NYACC
 254 enum type_t {CHAR, CLOSURE, CONTINUATION, FUNCTION, KEYWORD, MACRO, NUMBER, PAIR, REF, SPECIAL, TSTRING, SYMBOL, VALUES, TVECTOR, BROKEN_HEART};
 255 #else
 256 enum type_t {CHAR, CLOSURE, CONTINUATION, FUNCTION, KEYWORD, MACRO, NUMBER, PAIR, REF, SPECIAL, STRING, SYMBOL, VALUES, VECTOR, BROKEN_HEART};
 257 #endif
 258
 259 struct scm {
 260   enum type_t type;
 261   SCM car;
 262   SCM cdr;
 263 };
 264
 265 #if 0
 266 char arena[200];
 267 struct scm *g_cells = (struct scm*)arena;
 268 #else
 269 struct scm g_cells[200];
 270 #endif
 271
 272 #define cell_nil 1
 273 #define cell_f 2
 274 #define cell_t 3
 275
 276 #define TYPE(x) (g_cells[x].type)
 277
 278 #define CAR(x) g_cells[x].car
 279
 280 #define CDR(x) g_cells[x].cdr
 281 //#define VALUE(x) g_cells[x].value
 282 #define VALUE(x) g_cells[x].cdr
 283
 284 SCM
 285 car (SCM x)
 286 {
 287 #if MES_MINI
 288   //Nyacc
 289   //assert ("!car");
 290 #else
 291   if (TYPE (x) != PAIR) error (cell_symbol_not_a_pair, cons (x, cell_symbol_car));
 292 #endif
 293   return CAR (x);
 294 }
 295
 296 SCM
 297 cdr (SCM x)
 298 {
 299 #if MES_MINI
 300   //Nyacc
 301   //assert ("!cdr");
 302 #else
 303   if (TYPE (x) != PAIR) error (cell_symbol_not_a_pair, cons (x, cell_symbol_cdr));
 304 #endif
 305   return CDR(x);
 306 }
 307 SCM caar (SCM x) {return car (car (x));}
 308 SCM cadr (SCM x) {return car (cdr (x));}
 309 SCM cdar (SCM x) {return cdr (car (x));}
 310 SCM cddr (SCM x) {return cdr (cdr (x));}
 311
 312 SCM
 313 gc_peek_frame ()
 314 {
 315   SCM frame = car (g_stack);
 316   r1 = car (frame);
 317   r2 = cadr (frame);
 318   r3 = car (cddr (frame));
 319   r0 = cadr (cddr (frame));
 320   return frame;
 321 }
 322
 323 //\f Environment setup
 324
 325 SCM
 326 mes_environment ()
 327 {
 328   return 0;
 329 }
 330
 331 SCM
 332 mes_builtins (SCM a)
 333 {
 334   return a;
 335 }
 336
 337 SCM
 338 fill ()
 339 {
 340   TYPE (0) = 0x6c6c6168;
 341   CAR (0) = 0x6a746f6f;
 342   CDR (0) = 0x00002165;
 343
 344   TYPE (1) = SYMBOL;
 345   CAR (1) = 0x2d2d2d2d;
 346   CDR (1) = 0x3e3e3e3e;
 347
 348   TYPE (9) = 0x2d2d2d2d;
 349   CAR (9) = 0x2d2d2d2d;
 350   CDR (9) = 0x3e3e3e3e;
 351 #if 0
 352   // (A(B))
 353   TYPE (10) = PAIR;
 354   CAR (10) = 11;
 355   CDR (10) = 12;
 356
 357   TYPE (11) = CHAR;
 358   CAR (11) = 0x58585858;
 359   CDR (11) = 89;
 360
 361   TYPE (12) = PAIR;
 362   CAR (12) = 13;
 363   CDR (12) = 1;
 364
 365   TYPE (13) = CHAR;
 366   CAR (11) = 0x58585858;
 367   CDR (13) = 90;
 368
 369   TYPE (14) = 0x58585858;
 370   CAR (14) = 0x58585858;
 371   CDR (14) = 0x58585858;
 372
 373   TYPE (14) = 0x58585858;
 374   CAR (14) = 0x58585858;
 375   CDR (14) = 0x58585858;
 376 #else
 377   // (cons 0 1)
 378   TYPE (10) = PAIR;
 379   CAR (10) = 11;
 380   CDR (10) = 12;
 381
 382   TYPE (11) = FUNCTION;
 383   CAR (11) = 0x58585858;
 384   // 0 = make_cell
 385   // 1 = cons
 386   CDR (11) = 1;
 387
 388   TYPE (12) = PAIR;
 389   CAR (12) = 13;
 390   CDR (12) = 14;
 391
 392   TYPE (13) = NUMBER;
 393   CAR (13) =0x58585858;
 394   CDR (13) = 0;
 395
 396   TYPE (14) = PAIR;
 397   CAR (14) = 15;
 398   CDR (14) = 1;
 399
 400   TYPE (15) = NUMBER;
 401   CAR (15) = 0x58585858;
 402   CDR (15) = 1;
 403
 404 #endif
 405   TYPE (16) = 0x3c3c3c3c;
 406   CAR (16) = 0x2d2d2d2d;
 407   CDR (16) = 0x2d2d2d2d;
 408   return 0;
 409 }
 410
 411 SCM
 412 display_ (SCM x)
 413 {
 414   //puts ("<display>\n");
 415   switch (TYPE (x))
 416     {
 417     case CHAR:
 418       {
 419         //puts ("<char>\n");
 420         puts ("#\\");
 421         putchar (VALUE (x));
 422         break;
 423       }
 424     case FUNCTION:
 425       {
 426         //puts ("<function>\n");
 427         if (VALUE (x) == 0)
 428           puts ("make-cell");
 429         if (VALUE (x) == 1)
 430           puts ("cons");
 431         if (VALUE (x) == 2)
 432           puts ("car");
 433         if (VALUE (x) == 3)
 434           puts ("cdr");
 435         break;
 436       }
 437     case NUMBER:
 438       {
 439         //puts ("<number>\n");
 440 #if __GNUC__
 441         putchar (48 + VALUE (x));
 442 #else
 443         int i;
 444         i = VALUE (x);
 445         i = i + 48;
 446         putchar (i);
 447 #endif
 448         break;
 449       }
 450     case PAIR:
 451       {
 452         //puts ("<pair>\n");
 453         //if (cont != cell_f) puts "(");
 454         puts ("(");
 455         if (x && x != cell_nil) display_ (CAR (x));
 456         if (CDR (x) && CDR (x) != cell_nil)
 457           {
 458 #if __GNUC__
 459             if (TYPE (CDR (x)) != PAIR)
 460               puts (" . ");
 461 #else
 462             int c;
 463             c = CDR (x);
 464             c = TYPE (c);
 465             if (c != PAIR)
 466               puts (" . ");
 467 #endif
 468             display_ (CDR (x));
 469           }
 470         //if (cont != cell_f) puts (")");
 471         puts (")");
 472         break;
 473       }
 474     default:
 475       {
 476         //puts ("<default>\n");
 477         puts ("_");
 478         break;
 479       }
 480     }
 481   return 0;
 482 }
 483
 484 SCM
 485 bload_env (SCM a) ///((internal))
 486 {
 487   //g_stdin = open ("module/mes/read-0-32.mo", 0);
 488   g_stdin = open ("module/mes/hack-32.mo", 0);
 489   if (g_stdin < 0) {eputs ("no such file: module/mes/read-0-32.mo\n");return 1;}
 490
 491   int c;
 492   char *p = (char*)g_cells;
 493   char *q = (char*)g_cells;
 494
 495   puts ("q: ");
 496   puts (q);
 497   puts ("\n");
 498
 499 #if __GNUC__
 500   puts ("fd: ");
 501   puts (itoa (g_stdin));
 502   puts ("\n");
 503 #endif
 504
 505 #if __GNUC__
 506   assert (getchar () == 'M');
 507   assert (getchar () == 'E');
 508   assert (getchar () == 'S');
 509   puts ("GOT MES!\n");
 510   g_stack = getchar () << 8;
 511   g_stack += getchar ();
 512   puts ("stack: ");
 513   puts (itoa (g_stack));
 514   puts ("\n");
 515 #else
 516   c = getchar ();
 517   putchar (c);
 518   if (c != 'M') exit (10);
 519   c = getchar ();
 520   putchar (c);
 521   if (c != 'E') exit (11);
 522   c = getchar ();
 523   putchar (c);
 524   if (c != 'S') exit (12);
 525   puts ("\n");
 526   puts ("GOT MES!\n");
 527   getchar ();
 528   getchar ();
 529 #endif
 530
 531   c = getchar ();
 532   while (c != -1)
 533     {
 534       *p++ = c;
 535       c = getchar ();
 536     }
 537
 538   puts ("q: ");
 539   puts (q);
 540   puts ("\n");
 541 #if 0
 542   //__GNUC__
 543   g_free = (p-(char*)g_cells) / sizeof (struct scm);
 544   gc_peek_frame ();
 545   g_symbols = r1;
 546   g_stdin = STDIN;
 547   r0 = mes_builtins (r0);
 548
 549   puts ("cells read: ");
 550   puts (itoa (g_free));
 551   puts ("\n");
 552
 553   puts ("symbols: ");
 554   puts (itoa (g_symbols));
 555   puts ("\n");
 556   display_ (g_symbols);
 557   puts ("\n");
 558
 559   r2 = 10;
 560   puts ("\n");
 561   puts ("program: ");
 562   puts (itoa (r2));
 563   puts ("\n");
 564   display_ (r2);
 565   puts ("\n");
 566 #else
 567   display_ (10);
 568   puts ("\n");
 569   puts ("\n");
 570   fill ();
 571   display_ (10);
 572 #endif
 573   puts ("\n");
 574   return r2;
 575 }
 576
 577 int
 578 main (int argc, char *argv[])
 579 {
 580   puts ("filled sexp:\n");
 581   fill ();
 582   display_ (10);
 583   puts ("\n");
 584
 585 #if __GNUC__
 586   g_debug = (int)getenv ("MES_DEBUG");
 587 #endif
 588   //if (getenv ("MES_ARENA")) ARENA_SIZE = atoi (getenv ("MES_ARENA"));
 589
 590   if (argc > 1 && !strcmp (argv[1], "--help")) return eputs ("Usage: mes [--dump|--load] < FILE\n");
 591   if (argc > 1 && !strcmp (argv[1], "--version")) {eputs ("Mes ");eputs (VERSION);return eputs ("\n");};
 592
 593   if (argc > 1 && !strcmp (argv[1], "--help")) return eputs ("Usage: mes [--dump|--load] < FILE\n");
 594
 595
 596 #if __GNUC__
 597   g_stdin = STDIN;
 598   r0 = mes_environment ();
 599 #endif
 600
 601 #if MES_MINI
 602   puts ("Hello tiny-mes!\n");
 603   SCM program = bload_env (r0);
 604
 605 #else
 606   SCM program = (argc > 1 && !strcmp (argv[1], "--load"))
 607     ? bload_env (r0) : load_env (r0);
 608   if (argc > 1 && !strcmp (argv[1], "--dump")) return dump ();
 609
 610   push_cc (r2, cell_unspecified, r0, cell_unspecified);
 611   r3 = cell_vm_begin;
 612   r1 = eval_apply ();
 613   stderr_ (r1);
 614
 615   eputs ("\n");
 616   gc (g_stack);
 617 #endif
 618 #if __GNUC__
 619   if (g_debug)
 620     {
 621       eputs ("\nstats: [");
 622       eputs (itoa (g_free));
 623       eputs ("]\n");
 624     }
 625 #endif
 626   return 0;
 627 }
 628
 629 #if __GNUC__
 630 void
 631 _start ()
 632 {
 633   int r;
 634   asm (
 635        "mov %%ebp,%%eax\n\t"
 636        "addl $8,%%eax\n\t"
 637        "push %%eax\n\t"
 638
 639        "mov %%ebp,%%eax\n\t"
 640        "addl $4,%%eax\n\t"
 641        "movzbl (%%eax),%%eax\n\t"
 642        "push %%eax\n\t"
 643
 644        "call main\n\t"
 645        "movl %%eax,%0\n\t"
 646        : "=r" (r)
 647        : //no inputs "" (&main)
 648        );
 649   exit (r);
 650 }
 651 #endif
 652