1 /* -*-comment-start: "//";comment-end:""-*-
2 * Mes --- Maxwell Equations of Software
3 * Copyright © 2016,2017 Jan Nieuwenhuizen <janneke@gnu.org>
5 * This file is part of Mes.
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.
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.
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/>.
30 #define NYACC_CAR nyacc_car
31 #define NYACC_CDR nyacc_cdr
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);
50 : // no outputs "=" (r)
58 getenv (char const* p)
64 read (int fd, void* buf, size_t n)
67 //syscall (SYS_write, fd, s, n));
76 : "" (fd), "" (buf), "" (n)
77 : "eax", "ebx", "ecx", "edx"
83 open (char const *s, int mode)
86 //syscall (SYS_open, mode));
104 int r = read (g_stdin, &c, 1);
105 if (r < 1) return -1;
110 write (int fd, char const* s, int n)
113 //syscall (SYS_write, fd, s, n));
119 "mov $0x4, %%eax\n\t"
121 : // no outputs "=" (r)
122 : "" (fd), "" (s), "" (n)
123 : "eax", "ebx", "ecx", "edx"
130 //write (STDOUT, s, strlen (s));
131 //int i = write (STDOUT, s, strlen (s));
132 write (1, (char*)&c, 1);
140 int len = size + sizeof (size);
141 //n = mmap (0, len, PROT_READ | PROT_WRITE, MAP_PRIVATE | MAP_ANONYMOUS, 0, 0 );
150 //munmap ((void*)p, *n);
159 strlen (char const* s)
167 strcmp (char const* a, char const* b)
169 while (*a && *b && *a == *b) {a++;b++;}
176 //write (STDOUT, s, strlen (s));
177 //int i = write (STDOUT, s, strlen (s));
184 eputs (char const* s)
186 //write (STDERR, s, strlen (s));
187 //int i = write (STDERR, s, strlen (s));
206 *p-- = '0' + (x % 10);
219 assert_fail (char* s)
221 eputs ("assert fail:");
232 #define assert(x) ((x) ? (void)0 : assert_fail ("boo:" #x))
234 //#define assert(x) ((x) ? (void)0 : assert_fail ("boo:" #x))
235 #define assert(x) ((x) ? (void)0 : assert_fail (0))
249 SCM r1 = 0; // param 1
250 SCM r2 = 0; // save 2+load/dump
251 SCM r3 = 0; // continuation
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};
256 enum type_t {CHAR, CLOSURE, CONTINUATION, FUNCTION, KEYWORD, MACRO, NUMBER, PAIR, REF, SPECIAL, STRING, SYMBOL, VALUES, VECTOR, BROKEN_HEART};
267 struct scm *g_cells = (struct scm*)arena;
269 struct scm g_cells[200];
276 #define TYPE(x) (g_cells[x].type)
278 #define CAR(x) g_cells[x].car
280 #define CDR(x) g_cells[x].cdr
281 //#define VALUE(x) g_cells[x].value
282 #define VALUE(x) g_cells[x].cdr
291 if (TYPE (x) != PAIR) error (cell_symbol_not_a_pair, cons (x, cell_symbol_car));
303 if (TYPE (x) != PAIR) error (cell_symbol_not_a_pair, cons (x, cell_symbol_cdr));
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));}
315 SCM frame = car (g_stack);
318 r3 = car (cddr (frame));
319 r0 = cadr (cddr (frame));
323 //
\f Environment setup
340 TYPE (0) = 0x6c6c6168;
341 CAR (0) = 0x6a746f6f;
342 CDR (0) = 0x00002165;
345 CAR (1) = 0x2d2d2d2d;
346 CDR (1) = 0x3e3e3e3e;
348 TYPE (9) = 0x2d2d2d2d;
349 CAR (9) = 0x2d2d2d2d;
350 CDR (9) = 0x3e3e3e3e;
358 CAR (11) = 0x58585858;
366 CAR (11) = 0x58585858;
369 TYPE (14) = 0x58585858;
370 CAR (14) = 0x58585858;
371 CDR (14) = 0x58585858;
373 TYPE (14) = 0x58585858;
374 CAR (14) = 0x58585858;
375 CDR (14) = 0x58585858;
382 TYPE (11) = FUNCTION;
383 CAR (11) = 0x58585858;
393 CAR (13) =0x58585858;
401 CAR (15) = 0x58585858;
405 TYPE (16) = 0x3c3c3c3c;
406 CAR (16) = 0x2d2d2d2d;
407 CDR (16) = 0x2d2d2d2d;
414 //puts ("<display>\n");
426 //puts ("<function>\n");
439 //puts ("<number>\n");
441 putchar (48 + VALUE (x));
453 //if (cont != cell_f) puts "(");
455 if (x && x != cell_nil) display_ (CAR (x));
456 if (CDR (x) && CDR (x) != cell_nil)
459 if (TYPE (CDR (x)) != PAIR)
470 //if (cont != cell_f) puts (")");
476 //puts ("<default>\n");
485 bload_env (SCM a) ///((internal))
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;}
492 char *p = (char*)g_cells;
493 char *q = (char*)g_cells;
501 puts (itoa (g_stdin));
506 assert (getchar () == 'M');
507 assert (getchar () == 'E');
508 assert (getchar () == 'S');
510 g_stack = getchar () << 8;
511 g_stack += getchar ();
513 puts (itoa (g_stack));
518 if (c != 'M') exit (10);
521 if (c != 'E') exit (11);
524 if (c != 'S') exit (12);
543 g_free = (p-(char*)g_cells) / sizeof (struct scm);
547 r0 = mes_builtins (r0);
549 puts ("cells read: ");
550 puts (itoa (g_free));
554 puts (itoa (g_symbols));
556 display_ (g_symbols);
578 main (int argc, char *argv[])
580 puts ("filled sexp:\n");
586 g_debug = (int)getenv ("MES_DEBUG");
588 //if (getenv ("MES_ARENA")) ARENA_SIZE = atoi (getenv ("MES_ARENA"));
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");};
593 if (argc > 1 && !strcmp (argv[1], "--help")) return eputs ("Usage: mes [--dump|--load] < FILE\n");
598 r0 = mes_environment ();
602 puts ("Hello tiny-mes!\n");
603 SCM program = bload_env (r0);
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 ();
610 push_cc (r2, cell_unspecified, r0, cell_unspecified);
621 eputs ("\nstats: [");
622 eputs (itoa (g_free));
635 "mov %%ebp,%%eax\n\t"
639 "mov %%ebp,%%eax\n\t"
641 "movzbl (%%eax),%%eax\n\t"
647 : //no inputs "" (&main)