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