scaffold/t.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 __GNUC__
  22 void
  23 exit (int code)
  24 {
  25   asm (
  26        "movl %0,%%ebx\n\t"
  27        "movl $1,%%eax\n\t"
  28        "int  $0x80"
  29        : // no outputs "=" (r)
  30        : "" (code)
  31        );
  32   // not reached
  33   exit (0);
  34 }
  35
  36 void
  37 write (int fd, char const* s, int n)
  38 {
  39   int r;
  40   //syscall (SYS_write, fd, s, n));
  41   asm (
  42        "mov %0,%%ebx\n\t"
  43        "mov %1,%%ecx\n\t"
  44        "mov %2,%%edx\n\t"
  45
  46        "mov $0x4,%%eax\n\t"
  47        "int $0x80\n\t"
  48        : // no outputs "=" (r)
  49        : "" (fd), "" (s), "" (n)
  50        : "eax", "ebx", "ecx", "edx"
  51        );
  52 }
  53
  54 #define STDOUT 1
  55
  56 typedef long size_t;
  57 size_t
  58 strlen (char const* s)
  59 {
  60   int i = 0;
  61   while (s[i]) i++;
  62   return i;
  63 }
  64
  65 int
  66 puts (char const* s)
  67 {
  68   //write (STDOUT, s, strlen (s));
  69   //int i = write (STDOUT, s, strlen (s));
  70   int i = strlen (s);
  71   write (1, s, i);
  72   return 0;
  73 }
  74
  75 int
  76 putchar (int c)
  77 {
  78   //write (STDOUT, s, strlen (s));
  79   //int i = write (STDOUT, s, strlen (s));
  80   write (1, (char*)&c, 1);
  81   return 0;
  82 }
  83
  84 int
  85 strcmp (char const* a, char const* b)
  86 {
  87   while (*a && *b && *a == *b) {a++;b++;}
  88   return *a - *b;
  89 }
  90 #endif
  91
  92 struct scm {
  93   int type;
  94   int car;
  95   int cdr;
  96 };
  97
  98 char arena[200];
  99 struct scm *g_cells = arena;
 100 char *g_chars = arena;
 101 char buf[200];
 102
 103 int foo () {puts ("t: foo\n"); return 0;};
 104 int bar (int i) {puts ("t: bar\n"); return 0;};
 105 struct function {
 106   int (*function) (void);
 107   int arity;
 108 };
 109 struct function g_fun = {&exit, 1};
 110 struct function g_foo = {&foo, 0};
 111 struct function g_bar = {&bar, 1};
 112
 113 //void *functions[2];
 114 int functions[2];
 115
 116 struct function g_functions[2];
 117 int g_function = 0;
 118
 119 enum type_t {CHAR, CLOSURE, CONTINUATION, TFUNCTION, KEYWORD, MACRO, NUMBER, PAIR, REF, SPECIAL, TSTRING, SYMBOL, VALUES, TVECTOR, BROKEN_HEART};
 120
 121 typedef int SCM;
 122 int g_free = 3;
 123 SCM tmp;
 124 SCM tmp_num;
 125
 126 int ARENA_SIZE = 200;
 127 #define TYPE(x) (g_cells[x].type)
 128 #define CAR(x) g_cells[x].car
 129 #define CDR(x) g_cells[x].cdr
 130 #define VALUE(x) g_cells[x].cdr
 131
 132 struct scm scm_fun = {TFUNCTION,0,0};
 133 SCM cell_fun;
 134
 135 #if 1
 136
 137 int
 138 add (int a, int b)
 139 {
 140   return a + b;
 141 }
 142
 143 int
 144 inc (int i)
 145 {
 146   return i + 1;
 147 }
 148
 149 int
 150 label (int c)
 151 {
 152  label:
 153   if (c == 0) return c;
 154   c--;
 155   goto label;
 156   return 1;
 157 }
 158
 159 int
 160 swits (int c)
 161 {
 162   int x = -1;
 163
 164   switch (c)
 165     {
 166     case CHAR: {goto next;}
 167     case 1: {goto next;}
 168     case 2: {goto next;}
 169     default: {goto next;}
 170     }
 171
 172   return 1;
 173  next:
 174   switch (c)
 175     {
 176       case 0:
 177         {
 178           x = 0;
 179           c = 34;
 180           break;
 181         }
 182       case 1:
 183         {
 184           x = 1;
 185           break;
 186         }
 187       default:
 188         {
 189           x = 2;
 190           break;
 191         }
 192     }
 193   return x;
 194 }
 195
 196 int g = 48;
 197 int
 198 get ()
 199 {
 200   int i = g;
 201   g++;
 202   return i;
 203 }
 204
 205 int
 206 read_test ()
 207 {
 208   puts ("read test\n");
 209   char *p = (char*)g_chars;
 210   int i = 0;
 211   puts ("t: read 0123456789\n");
 212   int c = get ();
 213   while (i < 10) {
 214     *p++ = c;
 215     putchar (c);
 216     c = get ();
 217     i++;
 218   }
 219   puts ("\n");
 220   if (strcmp (g_chars, "0123456789")) return 1;
 221   return 0;
 222 }
 223
 224 int
 225 math_test ()
 226 {
 227   int i;
 228   puts ("t: 4/2=");
 229   i = 4 / 2;
 230   if (i!=2) return 1;
 231   i += 48;
 232   putchar (i);
 233   puts ("\n");
 234   return read_test ();
 235 }
 236
 237 SCM
 238 alloc (int n)
 239 {
 240   SCM x = g_free;
 241   g_free += n;
 242   return x;
 243 }
 244
 245 SCM
 246 make_cell (SCM type, SCM car, SCM cdr)
 247 {
 248   SCM x = alloc (1);
 249   TYPE (x) = VALUE (type);
 250   if (VALUE (type) == CHAR || VALUE (type) == NUMBER) {
 251     if (car) CAR (x) = CAR (car);
 252     if (cdr) CDR(x) = CDR(cdr);
 253   }
 254   else if (VALUE (type) == TFUNCTION) {
 255     if (car) CAR (x) = car;
 256     if (cdr) CDR(x) = CDR(cdr);
 257   }
 258   else {
 259     CAR (x) = car;
 260     CDR(x) = cdr;
 261   }
 262   return x;
 263 }
 264
 265 SCM
 266 make_cell_test ()
 267 {
 268   VALUE (tmp_num) = PAIR;
 269   make_cell (tmp_num, 0, 1);
 270   return math_test ();
 271 }
 272
 273 SCM
 274 make_tmps_test (struct scm* cells)
 275 {
 276   puts ("t: tmp = g_free++\n");
 277   tmp = g_free++;
 278   puts ("t: cells[tmp].type = CHAR\n");
 279   cells[tmp].type = CHAR;
 280   tmp_num = g_free++;
 281   cells[tmp_num].type = NUMBER;
 282
 283   return make_cell_test();
 284 }
 285
 286 int
 287 struct_test ()
 288 {
 289   g_cells[3].type = 0x64;
 290   if (g_cells[3].type != 0x64)
 291     return g_cells[3].type;
 292
 293   TYPE (4) = 4;
 294   if (TYPE (4) != 4)
 295     return 4;
 296
 297   CDR (3) = 0x22;
 298   CDR (4) = 0x23;
 299   if (CDR (3) != 0x22)
 300     return CDR (3);
 301
 302   puts ("t: struct fun = {&exit, 1};\n");
 303   struct function fun = {&exit, 1};
 304
 305   puts ("t: g_fun.arity != 1;\n");
 306   if (g_fun.arity != 1) return 1;
 307
 308   puts ("t: g_fun.function != exit;\n");
 309   if (g_fun.function != &exit) return 1;
 310
 311   puts ("t: fun.arity != 1;\n");
 312   if (fun.arity != 1) return 1;
 313
 314   puts ("t: fun.function != exit;\n");
 315   if (fun.function != &exit) return 1;
 316
 317   puts ("t: g_functions[g_function++] = g_foo;\n");
 318   g_functions[g_function++] = g_foo;
 319
 320   int fn = 0;
 321   puts ("t: g_functions[g_cells[fn].cdr].arity\n");
 322 #if __GNUC__
 323   //FIXME
 324   if (g_functions[g_cells[fn].cdr].arity) return 1;
 325 #endif
 326   if (g_functions[g_cells[fn].cdr].arity != 0) return 1;
 327
 328   int (*functionx) (void) = 0;
 329   functionx = g_functions[0].function;
 330   puts ("t: *functionx == foo\n");
 331   if (functionx != foo) return 11;
 332
 333   puts ("t: (*functionx) () == foo\n");
 334   if ((functionx) () != 0) return 12;
 335
 336   puts ("t: g_functions[<foo>].arity\n");
 337   if (g_functions[0].arity != 0) return 17;
 338
 339   fn++;
 340   g_functions[fn] = g_bar;
 341   g_cells[fn].cdr = fn;
 342   if (g_cells[fn].cdr != fn) return 13;
 343
 344   puts ("t: g_functions[g_cells[fn].cdr].function\n");
 345   functionx = g_functions[g_cells[fn].cdr].function;
 346
 347   puts ("t: functionx == bar\n");
 348   if (functionx != bar) return 15;
 349
 350   puts ("t: (*functiony) (1) == bar\n");
 351 #if __GNUC__
 352   //FIXME
 353   int (*functiony) (int) = 0;
 354   functiony = g_functions[g_cells[fn].cdr].function;
 355   if ((functiony) (1) != 0) return 16;
 356 #endif
 357 #if !__GNUC__
 358   functionx = g_functions[g_cells[fn].cdr].function;
 359   if ((functionx) (1) != 0) return 16;
 360 #endif
 361
 362   puts ("t: g_functions[<bar>].arity;");
 363   if (g_functions[fn].arity != 1) return 18;
 364
 365   scm_fun.cdr = g_function;
 366   g_functions[g_function++] = g_fun;
 367   cell_fun = g_free++;
 368   g_cells[cell_fun] = scm_fun;
 369
 370   return make_tmps_test  (g_cells);
 371 }
 372
 373 int
 374 test (char *p)
 375 {
 376   int f = 0;
 377   int t = 1;
 378   int one = 1;
 379   char c = 'C';
 380   int i=0;
 381
 382   char *x = arena;
 383   char *y = g_chars;
 384
 385   puts ("t: if (0)\n");
 386   if (0) return 1;
 387
 388   if (i)
 389     return 1;
 390   else
 391     puts ("t: else 1\n");
 392
 393   if (i)
 394     puts ("0");
 395   else if (i == 1)
 396     puts ("1");
 397   else
 398     puts ("t: else if 2\n");
 399
 400   puts ("t: if (f)\n");
 401   if (f) return 1;
 402
 403   puts ("t: if (one > 1)\n");
 404   if (one > 1) return 1;
 405
 406   puts ("t: if (one < 0)\n");
 407   if (one < 0) return 1;
 408
 409   puts ("t: if (strlen (\"\"))\n");
 410   if (strlen ("")) return 1;
 411
 412   puts ("t: if (strlen (p) != 4)\n");
 413   if (strlen (p) != 4) return 1;
 414
 415   puts ("t: if (!strlen (\".\"))\n");
 416   if (!strlen (".")) return 1;
 417
 418   puts ("t: if (strcmp (p, \"foo\"))\n");
 419   if (!strcmp (p, "foo")) return 1;
 420
 421   puts ("t: if (strcmp (p, \"t.c\\n\"))\n");
 422   if (strcmp (p, "t.c\n")) return 1;
 423
 424   puts ("t: if (!1)\n");
 425   if (!1) return 1;
 426
 427   puts ("t: if (one == 0)\n");
 428   if (one == 0) return 1;
 429
 430   puts ("t: if (f != 0)\n");
 431   if (one != 1) return 1;
 432
 433   puts ("t: if (1 && 0)\n");
 434   if (1 && 0) return 1;
 435
 436   puts ("t: if (!t && f)\n");
 437   if (!t && f) return 1;
 438
 439   puts ("t: if (t && !one)\n");
 440   if (t && !one) return 1;
 441
 442   puts ("t: if (f || !t)\n");
 443   if (f || !t) return 1;
 444
 445   puts ("t: if (i++)\n");
 446   if (i++) return 1;
 447
 448   puts ("t: if (--i)\n");
 449   if (--i) return 1;
 450
 451   puts ("t: i += 2\n");
 452   i += 2;
 453   if (i != 2) return 1;
 454
 455   puts ("t: i -= 2\n");
 456   i -= 2;
 457   if (i != 0) return 1;
 458
 459   puts ("t: (one == 1) ?\n");
 460   (one == 1) ? 1 : exit (1);
 461
 462   puts ("t: (f) ?\n");
 463   (f) ? exit (1) : 1;
 464
 465   puts ("t: *g_chars != 'A'\n");
 466   arena[0] = 'A';
 467   if (*g_chars != 'A') return 1;
 468
 469   puts ("t: *x != 'A'\n");
 470   if (*x != 'A') return 1;
 471
 472   puts ("t: *y != 'A'\n");
 473   if (*y != 'A') return 1;
 474
 475   puts ("t: *x != 'Q'\n");
 476   g_chars[0] = 'Q';
 477   if (*x != 'Q') return 1;
 478
 479   puts ("t: *x++ != 'C'\n");
 480   *x++ = c;
 481   if (*g_chars != 'C') return 1;
 482
 483   puts ("t: 1 + 2\n");
 484   if (1 + 2 != 3) return 1;
 485
 486   puts ("t: 2 - 1\n");
 487   if (2 - 1 != 1) return 1;
 488
 489   puts ("t: 1 << 3\n");
 490   if (1 << 3 != 8) return 1;
 491
 492   puts ("t: 8 / 4\n");
 493   if (8 / 4 != 2) return 1;
 494
 495   puts ("t: inc (0)\n");
 496   if (inc (0) != 1) return 1;
 497
 498   puts ("t: inc (inc (0))\n");
 499   if (inc (inc (0)) != 2) return 1;
 500
 501   puts ("t: inc (inc (inc (0)))\n");
 502   if (inc (inc (inc (0))) != 3) return 1;
 503
 504   puts ("t: add (1, 2)\n");
 505   if (add (1, 2) != 3) return 1;
 506
 507   puts ("t: add (inc (0), inc (1))\n");
 508   if (add (inc (0), inc (1)) != 3) return 1;
 509
 510   puts ("t: add (inc (inc (0)), inc (inc (1)))\n");
 511   if (add (inc (inc (0)), inc (inc (1))) != 5) return 1;
 512
 513   puts ("t: goto label\n");
 514   if (label (1) != 0) return 1;
 515
 516   puts ("t: switch 0\n");
 517   if (swits (0) != 0) return swits (0);
 518
 519   puts ("t: switch 1\n");
 520   if (swits (1) != 1) return 1;
 521
 522   puts ("t: switch -1\n");
 523   if (swits (-1) != 2) return 1;
 524
 525   puts ("t: if (1)\n");
 526   if (1) goto ok0;
 527   return 1;
 528  ok0:
 529
 530   puts ("t: if (0); return 1; else;\n");
 531   if (0) return 1; else goto ok01;
 532  ok01:
 533
 534   puts ("t: if (t)\n");
 535   if (t) goto ok1;
 536   return 1;
 537  ok1:
 538
 539   puts ("t: if (one > 0)\n");
 540   if (one > 0) goto ok2;
 541   return 1;
 542  ok2:
 543
 544   puts ("t: if (one < 2)\n");
 545   //if (one < 2) goto ok3;
 546   if (one < 0x44) goto ok3;
 547   return 1;
 548  ok3:
 549
 550   puts ("t: if (strlen (\".\"))\n");
 551   if (strlen (".")) goto ok4;
 552   return 1;
 553  ok4:
 554
 555   puts ("t: if (strlen (p) == 4)\n");
 556   if (strlen (p) == 4) goto ok40;
 557  ok40:
 558
 559   puts ("t: if (!strcmp (p, \"t.c\\n\"))\n");
 560   if (!strcmp (p, "t.c\n")) goto ok41;
 561   return 1;
 562  ok41:
 563
 564   puts ("t: if (strcmp (p, \"foo\"))\n");
 565   if (strcmp (p, "foo")) goto ok42;
 566   return 1;
 567  ok42:
 568
 569   puts ("t: if (!0)\n");
 570   if (!0) goto ok5;
 571   return 1;
 572  ok5:
 573
 574   puts ("t: if (one == 1)\n");
 575   if (one == 1) goto ok6;
 576   return 1;
 577  ok6:
 578
 579   puts ("t: if (one != 0)\n");
 580   if (one != 0) goto ok7;
 581   return 1;
 582  ok7:
 583
 584   puts ("t: if (1 && !0)\n");
 585   if (1 && !0) goto ok8;
 586   return 1;
 587  ok8:
 588
 589   puts ("t: if (f || t)\n");
 590   if (f || t) goto ok80;
 591   return 1;
 592  ok80:
 593
 594   puts ("t: if (++i)\n");
 595   if (++i) goto ok9;
 596   return 1;
 597  ok9:
 598
 599   puts ("t: if (i--)\n");
 600   if (i--) goto ok10;
 601   return 1;
 602  ok10:
 603
 604   puts ("t: *g_chars == 'B'\n");
 605   arena[0] = 'B';
 606   if (*g_chars == 'B') goto ok11;
 607   return 1;
 608   ok11:
 609
 610   puts ("t: *x == 'B'\n");
 611   x = arena;
 612   if (*x == 'B') goto ok12;
 613   return 1;
 614  ok12:
 615
 616   puts ("t: *y == 'B'\n");
 617   y = g_chars;
 618   if (*y == 'B') goto ok13;
 619   return 1;
 620  ok13:
 621
 622   puts ("t: *x == 'R'\n");
 623   g_chars[0] = 'R';
 624   if (*x == 'R') goto ok14;
 625   return 1;
 626  ok14:
 627
 628   puts ("t: *x++ == 'C'\n");
 629   *x++ = c;
 630   if (*g_chars == 'C') goto ok15;
 631   return 1;
 632  ok15:
 633
 634   puts ("t: for (i=1; i<5; ++i)\n");
 635   for (i=1; i<5; ++i);
 636   if (i != 5) return i;
 637
 638   return struct_test ();
 639 }
 640 #endif
 641
 642 int
 643 main (int argc, char *argv[])
 644 {
 645   // int fn = 0;
 646   // g_functions[fn] = g_bar;
 647   // if (g_functions[fn].arity != 1) return 1;
 648   char *p = "t.c\n";
 649   puts ("t.c\n");
 650
 651   if (argc > 1 && !strcmp (argv[1], "--help")) return 1;
 652   puts ("t: if (argc > 1 && !strcmp (argv[1], \"--help\")\n");
 653
 654   // FIXME mescc?!
 655   if (argc > 1) if (!strcmp (argv[1], "--help")) return 1;
 656
 657   return test (p);
 658
 659   return 22;
 660 }
 661
 662 #if __GNUC__
 663 void
 664 _start ()
 665 {
 666   // int r=main ();
 667   // exit (r);
 668   int r;
 669   asm (
 670        "mov %%ebp,%%eax\n\t"
 671        "addl $8,%%eax\n\t"
 672        "push %%eax\n\t"
 673
 674        "mov %%ebp,%%eax\n\t"
 675        "addl $4,%%eax\n\t"
 676        "movzbl (%%eax),%%eax\n\t"
 677        "push %%eax\n\t"
 678
 679        "call main\n\t"
 680
 681        "movl %%eax,%0\n\t"
 682        : "=r" (r)
 683        : //no inputs "" (&main)
 684        );
 685   exit (r);
 686 }
 687 #endif