mescc: Mini-mes runs (cons 0 1) dump.
[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 () {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, 1};
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 #if 1
127 int
128 swits (int c)
129 {
130   int x = -1;
131
132   switch (c)
133     {
134     case 0: {goto next;}
135     case 1: {goto next;}
136     case 2: {goto next;}
137     default: {goto next;}
138     }
139
140   return 1;
141  next:
142   switch (c)
143     {
144       case 0:
145         {
146           x = 0;
147           c = 34;
148           break;
149         }
150       case 1:
151         {
152           x = 1;
153           break;
154         }
155       default:
156         {
157           x = 2;
158           break;
159         }
160     }
161   return x;
162 }
163
164 int g = 48;
165 int
166 get ()
167 {
168   int i = g;
169   g++;
170   return i;
171 }
172
173 int
174 read_test ()
175 {
176   puts ("read test\n");
177   char *p = (char*)g_chars;
178   int i = 0;
179   puts ("t: read 0123456789\n");
180   int c = get ();
181   while (i < 10) {
182     *p++ = c;
183     putchar (c);
184     c = get ();
185     i++;
186   }
187   puts ("\n");
188   if (strcmp (g_chars, "0123456789")) return 1;
189   return 0;
190 }
191
192 int
193 math_test ()
194 {
195   int i;
196   puts ("t: 4/2=");
197   i = 4 / 2;
198   if (i!=2) return 1;
199   i += 48;
200   putchar (i);
201   puts ("\n");
202   return read_test ();
203 }
204
205 int ARENA_SIZE = 200;
206 #define TYPE(x) (g_cells[x].type)
207 #define CAR(x) g_cells[x].car
208 #define CDR(x) g_cells[x].cdr
209 #define VALUE(x) g_cells[x].cdr
210
211 struct scm scm_fun = {TFUNCTION,0,0};
212 SCM cell_fun;
213
214 SCM
215 alloc (int n)
216 {
217   SCM x = g_free;
218   g_free += n;
219   return x;
220 }
221
222 SCM
223 make_cell (SCM type, SCM car, SCM cdr)
224 {
225   SCM x = alloc (1);
226   TYPE (x) = VALUE (type);
227   if (VALUE (type) == CHAR || VALUE (type) == NUMBER) {
228     if (car) CAR (x) = CAR (car);
229     if (cdr) CDR(x) = CDR(cdr);
230   }
231   else if (VALUE (type) == TFUNCTION) {
232     if (car) CAR (x) = car;
233     if (cdr) CDR(x) = CDR(cdr);
234   }
235   else {
236     CAR (x) = car;
237     CDR(x) = cdr;
238   }
239   return x;
240 }
241
242 SCM
243 make_cell_test ()
244 {
245   VALUE (tmp_num) = PAIR;
246   make_cell (tmp_num, 0, 1);
247   return math_test ();
248 }
249
250 SCM
251 make_tmps_test (struct scm* cells)
252 {
253   puts ("t: tmp = g_free++\n");
254   tmp = g_free++;
255   puts ("t: cells[tmp].type = CHAR\n");
256   cells[tmp].type = CHAR;
257   tmp_num = g_free++;
258   cells[tmp_num].type = NUMBER;
259
260   return make_cell_test();
261 }
262
263 int
264 struct_test ()
265 {
266   g_cells[3].type = 0x64;
267   if (g_cells[3].type != 0x64)
268     return g_cells[3].type;
269
270   TYPE (4) = 4;
271   if (TYPE (4) != 4)
272     return 4;
273   
274   CDR (3) = 0x22;
275   CDR (4) = 0x23;
276   if (CDR (3) != 0x22)
277     return CDR (3);
278
279   puts ("t: struct fun = {&exit, 1};\n");
280   struct function fun = {&exit, 1};
281
282   puts ("t: g_fun.arity != 1;\n");
283   if (g_fun.arity != 1) return 1;
284
285   puts ("t: g_fun.function != exit;\n");
286   if (g_fun.function != &exit) return 1;
287
288   puts ("t: fun.arity != 1;\n");
289   if (fun.arity != 1) return 1;
290
291   puts ("t: fun.function != exit;\n");
292   if (fun.function != &exit) return 1;
293
294   puts ("t: g_functions[g_function++] = g_foo;\n");
295   g_functions[g_function++] = g_foo;
296
297   int fn = 0;
298   puts ("t: g_functions[g_cells[fn].cdr].arity\n");
299   if (!g_functions[g_cells[fn].cdr].arity) return 1;
300
301   int (*functionx) (void) = 0;
302   functionx = g_functions[0].function;
303   puts ("t: *functionx == foo\n");
304   if (*functionx != foo) return 11;
305
306   puts ("t: (*functionx) () == foo\n");
307   if ((*functionx) () != 0) return 12;
308
309   fn++;
310   g_functions[0] = g_bar;
311   if (g_cells[fn].cdr != 0) return 13;
312   puts ("t: g_functions[g_cells[fn].cdr].function\n");
313   functionx = g_functions[g_cells[fn].cdr].function;
314   puts ("t: *functionx == bar\n");
315   if (*functionx != bar) return 15;
316   puts ("t: (*functionx) () == bar\n");
317   if ((*functionx) () != 0) return 16;
318
319   scm_fun.cdr = g_function;
320   g_functions[g_function++] = g_fun;
321   cell_fun = g_free++;
322   g_cells[cell_fun] = scm_fun;
323
324   return make_tmps_test  (g_cells);
325 }
326
327 int
328 test (char *p)
329 {
330   int f = 0;
331   int t = 1;
332   int one = 1;
333   char c = 'C';
334   int i=0;
335
336   char *x = arena;
337   char *y = g_chars;
338
339   puts ("t: if (0)\n");
340   if (0) return 1;
341
342   if (i)
343     return 1;
344   else
345     puts ("t: else 1\n");
346
347   if (i)
348     puts ("0");
349   else if (i == 1)
350     puts ("1");
351   else
352     puts ("t: else if 2\n");
353
354   puts ("t: if (f)\n");
355   if (f) return 1;
356
357   puts ("t: if (one > 1)\n");
358   if (one > 1) return 1;
359
360   puts ("t: if (one < 0)\n");
361   if (one < 0) return 1;
362
363   puts ("t: if (strlen (\"\"))\n");
364   if (strlen ("")) return 1;
365
366   puts ("t: if (strlen (p) != 4)\n");
367   if (strlen (p) != 4) return 1;
368
369   puts ("t: if (!strlen (\".\"))\n");
370   if (!strlen (".")) return 1;
371
372   puts ("t: if (strcmp (p, \"foo\"))\n");
373   if (!strcmp (p, "foo")) return 1;
374
375   puts ("t: if (strcmp (p, \"t.c\\n\"))\n");
376   if (strcmp (p, "t.c\n")) return 1;
377
378   puts ("t: if (!1)\n");
379   if (!1) return 1;
380
381   puts ("t: if (one == 0)\n");
382   if (one == 0) return 1;
383
384   puts ("t: if (f != 0)\n");
385   if (one != 1) return 1;
386
387   puts ("t: if (1 && 0)\n");
388   if (1 && 0) return 1;
389
390   puts ("t: if (!t && f)\n");
391   if (!t && f) return 1;
392
393   puts ("t: if (t && !one)\n");
394   if (t && !one) return 1;
395
396   puts ("t: if (f || !t)\n");
397   if (f || !t) return 1;
398
399   puts ("t: if (i++)\n");
400   if (i++) return 1;
401
402   puts ("t: if (--i)\n");
403   if (--i) return 1;
404
405   puts ("t: i += 2\n");
406   i += 2;
407   if (i != 2) return 1;
408
409   puts ("t: i -= 2\n");
410   i -= 2;
411   if (i != 0) return 1;
412
413   puts ("t: (one == 1) ?\n");
414   (one == 1) ? 1 : exit (1);
415
416   puts ("t: (f) ?\n");
417   (f) ? exit (1) : 1;
418
419   puts ("t: *g_chars != 'A'\n");
420   arena[0] = 'A';
421   if (*g_chars != 'A') return 1;
422
423   puts ("t: *x != 'A'\n");
424   if (*x != 'A') return 1;
425
426   puts ("t: *y != 'A'\n");
427   if (*y != 'A') return 1;
428
429   puts ("t: *x != 'Q'\n");
430   g_chars[0] = 'Q';
431   if (*x != 'Q') return 1;
432
433   puts ("t: *x++ != 'C'\n");
434   *x++ = c;
435   if (*g_chars != 'C') return 1;
436
437   puts ("t: switch 0\n");
438   if (swits (0) != 0) return swits (0);
439
440   puts ("t: switch 1\n");
441   if (swits (1) != 1) return 1;
442
443   puts ("t: switch -1\n");
444   if (swits (-1) != 2) return 1;
445
446   puts ("t: if (1)\n");
447   if (1) goto ok0;
448   return 1;
449  ok0:
450   
451   puts ("t: if (0); return 1; else;\n");
452   if (0) return 1; else goto ok01;
453  ok01:
454
455   puts ("t: if (t)\n");
456   if (t) goto ok1;
457   return 1;
458  ok1:
459
460   puts ("t: if (one > 0)\n");
461   if (one > 0) goto ok2;
462   return 1;
463  ok2:
464
465   puts ("t: if (one < 2)\n");
466   //if (one < 2) goto ok3;
467   if (one < 0x44) goto ok3;
468   return 1;
469  ok3:
470
471   puts ("t: if (strlen (\".\"))\n");
472   if (strlen (".")) goto ok4;
473   return 1;
474  ok4:
475
476   puts ("t: if (strlen (p) == 4)\n");
477   if (strlen (p) == 4) goto ok40;
478  ok40:
479
480   puts ("t: if (!strcmp (p, \"t.c\\n\"))\n");
481   if (!strcmp (p, "t.c\n")) goto ok41;
482   return 1;
483  ok41:
484
485   puts ("t: if (strcmp (p, \"foo\"))\n");
486   if (strcmp (p, "foo")) goto ok42;
487   return 1;
488  ok42:
489
490   puts ("t: if (!0)\n");
491   if (!0) goto ok5;
492   return 1;
493  ok5:
494
495   puts ("t: if (one == 1)\n");
496   if (one == 1) goto ok6;
497   return 1;
498  ok6:
499
500   puts ("t: if (one != 0)\n");
501   if (one != 0) goto ok7;
502   return 1;
503  ok7:
504
505   puts ("t: if (1 && !0)\n");
506   if (1 && !0) goto ok8;
507   return 1;
508  ok8:
509
510   puts ("t: if (f || t)\n");
511   if (f || t) goto ok80;
512   return 1;
513  ok80:
514
515   puts ("t: if (++i)\n");
516   if (++i) goto ok9;
517   return 1;
518  ok9:
519
520   puts ("t: if (i--)\n");
521   if (i--) goto ok10;
522   return 1;
523  ok10:
524
525   puts ("t: *g_chars == 'B'\n");
526   arena[0] = 'B';
527   if (*g_chars == 'B') goto ok11;
528   return 1;
529   ok11:
530
531   puts ("t: *x == 'B'\n");
532   x = arena;
533   if (*x == 'B') goto ok12;
534   return 1;
535  ok12:
536
537   puts ("t: *y == 'B'\n");
538   y = g_chars;
539   if (*y == 'B') goto ok13;
540   return 1;
541  ok13:
542
543   puts ("t: *x == 'R'\n");
544   g_chars[0] = 'R';
545   if (*x == 'R') goto ok14;
546   return 1;
547  ok14:
548
549   puts ("t: *x++ == 'C'\n");
550   *x++ = c;
551   if (*g_chars == 'C') goto ok15;
552   return 1;
553  ok15:
554
555   puts ("t: for (i=1; i<5; ++i)\n");
556   for (i=1; i<5; ++i);
557   if (i != 5) return i;
558
559   return struct_test ();
560 }
561 #endif
562
563 int
564 main (int argc, char *argv[])
565 {
566   char *p = "t.c\n";
567   puts ("t.c\n");
568
569   if (argc > 1 && !strcmp (argv[1], "--help")) return 1;
570   puts ("t: if (argc > 1 && !strcmp (argv[1], \"--help\")\n");
571
572   // FIXME mescc?!
573   if (argc > 1) if (!strcmp (argv[1], "--help")) return 1;
574
575   return test (p);
576
577   return 22;
578 }
579
580 #if __GNUC__
581 void
582 _start ()
583 {
584   // int r=main ();
585   // exit (r);
586   int r;
587   asm (
588        "mov %%ebp,%%eax\n\t"
589        "addl $8,%%eax\n\t"
590        "push %%eax\n\t"
591
592        "mov %%ebp,%%eax\n\t"
593        "addl $4,%%eax\n\t"
594        "movzbl (%%eax),%%eax\n\t"
595        "push %%eax\n\t"
596
597        "call main\n\t"
598        
599        "movl %%eax,%0\n\t"
600        : "=r" (r)
601        : //no inputs "" (&main)
602        );
603   exit (r);
604 }
605 #endif