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