58bbbd9ba9279785bb5cf3dcc67b42896d83abef
[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   eputs (s);
223   eputs ("\n");
224   *((int*)0) = 0;
225 }
226
227 #if __GNUC__
228 #define assert(x) ((x) ? (void)0 : assert_fail ("boo:" #x))
229 #else
230 //#define assert(x) ((x) ? (void)0 : assert_fail ("boo:" #x))
231 #define assert(x) ((x) ? (void)0 : assert_fail (0))
232 #endif
233
234 typedef int SCM;
235
236 #if __GNUC__
237 int g_debug = 0;
238 #endif
239
240 int g_free = 0;
241
242 SCM g_symbols = 0;
243 SCM g_stack = 0;
244 SCM r0 = 0; // a/env
245 SCM r1 = 0; // param 1
246 SCM r2 = 0; // save 2+load/dump
247 SCM r3 = 0; // continuation
248
249 typedef int SCM;
250 #if __NYACC__ || FIXME_NYACC
251 enum type_t {CHAR, CLOSURE, CONTINUATION, FUNCTION, KEYWORD, MACRO, NUMBER, PAIR, REF, SPECIAL, TSTRING, SYMBOL, VALUES, TVECTOR, BROKEN_HEART};
252 #else
253 enum type_t {CHAR, CLOSURE, CONTINUATION, FUNCTION, KEYWORD, MACRO, NUMBER, PAIR, REF, SPECIAL, STRING, SYMBOL, VALUES, VECTOR, BROKEN_HEART};
254 #endif
255 typedef SCM (*function0_t) (void);
256 typedef SCM (*function1_t) (SCM);
257 typedef SCM (*function2_t) (SCM, SCM);
258 typedef SCM (*function3_t) (SCM, SCM, SCM);
259 typedef SCM (*functionn_t) (SCM);
260 typedef struct function_struct {
261   union {
262     function0_t function0;
263     function1_t function1;
264     function2_t function2;
265     function3_t function3;
266     functionn_t functionn;
267   } data;
268   int arity;
269 } function_t;
270 struct scm;
271
272 typedef struct scm_struct {
273   enum type_t type;
274   union {
275     char const *name;
276     SCM string;
277     SCM car;
278     SCM ref;
279     int length;
280   } NYACC_CAR;
281   union {
282     int value;
283     int function;
284     SCM cdr;
285     SCM closure;
286     SCM continuation;
287     SCM macro;
288     SCM vector;
289     int hits;
290   } NYACC_CDR;
291 } scm;
292
293 char arena[200000];
294 scm *g_cells = (scm*)arena;
295
296 #define CAR(x) g_cells[x].car
297
298 #define CDR(x) g_cells[x].cdr
299
300 SCM
301 car (SCM x)
302 {
303 #if MES_MINI
304   //Nyacc
305   //assert ("!car");
306 #else
307   if (TYPE (x) != PAIR) error (cell_symbol_not_a_pair, cons (x, cell_symbol_car));
308 #endif
309   return CAR (x);
310 }
311
312 SCM
313 cdr (SCM x)
314 {
315 #if MES_MINI
316   //Nyacc
317   //assert ("!cdr");
318 #else
319   if (TYPE (x) != PAIR) error (cell_symbol_not_a_pair, cons (x, cell_symbol_cdr));
320 #endif
321   return CDR(x);
322 }
323 SCM caar (SCM x) {return car (car (x));}
324 SCM cadr (SCM x) {return car (cdr (x));}
325 SCM cdar (SCM x) {return cdr (car (x));}
326 SCM cddr (SCM x) {return cdr (cdr (x));}
327
328 SCM
329 gc_peek_frame ()
330 {
331   SCM frame = car (g_stack);
332   r1 = car (frame);
333   r2 = cadr (frame);
334   r3 = car (cddr (frame));
335   r0 = cadr (cddr (frame));
336   return frame;
337 }
338
339 //\f Environment setup
340
341 SCM
342 mes_environment ()
343 {
344   return 0;
345 }
346
347 SCM
348 mes_builtins (SCM a)
349 {
350   return a;
351 }
352
353 SCM
354 bload_env (SCM a) ///((internal))
355 {
356   puts ("bload_env\n");
357   g_stdin = open ("module/mes/read-0.mo", 0);
358   if (g_stdin < 0) {eputs ("no such file: module/mes/read-0.mo\n");return 1;} 
359 #if __GNUC__
360   puts ("fd: ");
361   puts (itoa (g_stdin));
362   puts ("\n");
363   //g_stdin = g_stdin ? g_stdin : fopen (PREFIX "module/mes/read-0.mo", "r");
364 #endif
365   char *p = (char*)g_cells;
366
367   // int x;
368   // x = getchar ();
369   // if (x == 'M') puts ("M");
370   // x = getchar ();
371   // if (x == 'E') puts ("E");
372   // x = getchar ();
373   // if (x == 'S') puts ("S");
374   
375   assert (getchar () == 'M');
376   assert (getchar () == 'E');
377   assert (getchar () == 'S');
378   puts ("GOT MES\n");
379   g_stack = getchar () << 8;
380   g_stack += getchar ();
381   int c = getchar ();
382   while (c != -1)
383     {
384       *p++ = c;
385       c = getchar ();
386     }
387   g_free = (p-(char*)g_cells) / sizeof (scm);
388   gc_peek_frame ();
389   g_symbols = r1;
390   g_stdin = STDIN;
391   r0 = mes_builtins (r0);
392
393 #if __GNUC__
394   puts ("cells read: ");
395   puts (itoa (g_free));
396   puts ("\n");
397 #endif
398   return r2;
399 }
400
401 int
402 main (int argc, char *argv[])
403 {
404 #if __GNUC__
405   g_debug = (int)getenv ("MES_DEBUG");
406 #endif
407   //if (getenv ("MES_ARENA")) ARENA_SIZE = atoi (getenv ("MES_ARENA"));
408
409   if (argc > 1 && !strcmp (argv[1], "--help")) return eputs ("Usage: mes [--dump|--load] < FILE\n");
410   if (argc > 1 && !strcmp (argv[1], "--version")) {eputs ("Mes ");eputs (VERSION);return eputs ("\n");};
411
412   if (argc > 1 && !strcmp (argv[1], "--help")) return eputs ("Usage: mes [--dump|--load] < FILE\n");
413
414
415 #if __GNUC__
416   g_stdin = STDIN;
417   r0 = mes_environment ();
418 #endif
419
420 #if MES_MINI
421   puts ("Hello tiny-mes!\n");
422   SCM program = bload_env (r0);
423 #else
424   SCM program = (argc > 1 && !strcmp (argv[1], "--load"))
425     ? bload_env (r0) : load_env (r0);
426   if (argc > 1 && !strcmp (argv[1], "--dump")) return dump ();
427
428   push_cc (r2, cell_unspecified, r0, cell_unspecified);
429   r3 = cell_vm_begin;
430   r1 = eval_apply ();
431   stderr_ (r1);
432
433   eputs ("\n");
434   gc (g_stack);
435 #endif
436 #if __GNUC__
437   if (g_debug)
438     {
439       eputs ("\nstats: [");
440       eputs (itoa (g_free));
441       eputs ("]\n");
442     }
443 #endif
444   return 0;
445 }
446
447 #if __GNUC__
448 void
449 _start ()
450 {
451   int r;
452   asm (
453        "mov %%ebp,%%eax\n\t"
454        "addl $8,%%eax\n\t"
455        "push %%eax\n\t"
456
457        "mov %%ebp,%%eax\n\t"
458        "addl $4,%%eax\n\t"
459        "movzbl (%%eax),%%eax\n\t"
460        "push %%eax\n\t"
461
462        "call main\n\t"
463        "movl %%eax,%0\n\t"
464        : "=r" (r)
465        : //no inputs "" (&main)
466        );
467   exit (r);
468 }
469 #endif