mescc: Read and display sexp dumped by mes.
[mes.git] / 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