mescc: Support regular C99 compile, headers + mlibc.
[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 #if POSIX
22 #error "POSIX not supported"
23 #endif
24
25 #include <mlibc.h>
26
27 char arena[300];
28
29 typedef int SCM;
30
31 SCM g_stack = 0;
32 SCM r0 = 0; // a/env
33 SCM r1 = 0; // param 1
34 SCM r2 = 0; // save 2+load/dump
35 SCM r3 = 0; // continuation
36
37 enum type_t {TCHAR, TCLOSURE, TCONTINUATION, TFUNCTION, TKEYWORD, TMACRO, TNUMBER, TPAIR, TREF, TSPECIAL, TSTRING, TSYMBOL, TVALUES, TVECTOR, TBROKEN_HEART};
38
39 struct scm {
40   enum type_t type;
41   SCM car;
42   SCM cdr;
43 };
44
45 #if __MESC__
46 struct scm *g_cells = arena;
47 #else
48 struct scm *g_cells = (struct scm*)arena;
49 #endif
50
51 #define cell_nil 1
52 #define cell_f 2
53 #define cell_t 3
54
55 #define TYPE(x) (g_cells[x].type)
56
57 #define CAR(x) g_cells[x].car
58
59 #define CDR(x) g_cells[x].cdr
60 #define VALUE(x) g_cells[x].cdr
61
62 SCM
63 car (SCM x)
64 {
65   return CAR (x);
66 }
67
68 SCM
69 cdr (SCM x)
70 {
71   return CDR (x);
72 }
73
74 SCM caar (SCM x) {return car (car (x));}
75 SCM cadr (SCM x) {return car (cdr (x));}
76 SCM cdar (SCM x) {return cdr (car (x));}
77 SCM cddr (SCM x) {return cdr (cdr (x));}
78
79 SCM
80 gc_peek_frame ()
81 {
82   SCM frame = car (g_stack);
83   r1 = car (frame);
84   r2 = cadr (frame);
85   r3 = car (cddr (frame));
86   r0 = cadr (cddr (frame));
87   return frame;
88 }
89
90 //\f Environment setup
91
92 SCM
93 mes_environment ()
94 {
95   return 0;
96 }
97
98 SCM
99 mes_builtins (SCM a)
100 {
101   return a;
102 }
103
104 SCM
105 fill ()
106 {
107   TYPE (0) = 0x6c6c6168;
108   CAR (0) = 0x6a746f6f;
109   CDR (0) = 0x00002165;
110
111   TYPE (1) = TSYMBOL;
112   CAR (1) = 0x2d2d2d2d;
113   CDR (1) = 0x3e3e3e3e;
114
115   TYPE (9) = 0x2d2d2d2d;
116   CAR (9) = 0x2d2d2d2d;
117   CDR (9) = 0x3e3e3e3e;
118
119   // (A(B))
120   TYPE (10) = TPAIR;
121   CAR (10) = 11;
122   CDR (10) = 12;
123
124   TYPE (11) = TCHAR;
125   CAR (11) = 0x58585858;
126   CDR (11) = 89;
127
128   TYPE (12) = TPAIR;
129   CAR (12) = 13;
130   CDR (12) = 1;
131
132   TYPE (13) = TCHAR;
133   CAR (11) = 0x58585858;
134   CDR (13) = 90;
135
136   TYPE (14) = 0x58585858;
137   CAR (14) = 0x58585858;
138   CDR (14) = 0x58585858;
139
140   TYPE (14) = 0x58585858;
141   CAR (14) = 0x58585858;
142   CDR (14) = 0x58585858;
143
144   TYPE (16) = 0x3c3c3c3c;
145   CAR (16) = 0x2d2d2d2d;
146   CDR (16) = 0x2d2d2d2d;
147   return 0;
148 }
149
150 SCM
151 display_ (SCM x)
152 {
153   //puts ("<display>\n");
154   switch (TYPE (x))
155     {
156     case TCHAR:
157       {
158         //puts ("<char>\n");
159         puts ("#\\");
160         putchar (VALUE (x));
161         break;
162       }
163     case TFUNCTION:
164       {
165         //puts ("<function>\n");
166         if (VALUE (x) == 0)
167           puts ("core:make-cell");
168         if (VALUE (x) == 1)
169           puts ("cons");
170         if (VALUE (x) == 2)
171           puts ("car");
172         if (VALUE (x) == 3)
173           puts ("cdr");
174         break;
175       }
176     case TNUMBER:
177       {
178         //puts ("<number>\n");
179 #if __GNUC__
180         puts (itoa (VALUE (x)));
181 #else
182         int i;
183         i = VALUE (x);
184         i = i + 48;
185         putchar (i);
186 #endif
187         break;
188       }
189     case TPAIR:
190       {
191         //puts ("<pair>\n");
192         //if (cont != cell_f) puts "(");
193         puts ("(");
194         if (x && x != cell_nil) display_ (CAR (x));
195         if (CDR (x) && CDR (x) != cell_nil)
196           {
197 #if __GNUC__
198             if (TYPE (CDR (x)) != TPAIR)
199               puts (" . ");
200 #else
201             int c;
202             c = CDR (x);
203             c = TYPE (c);
204             if (c != TPAIR)
205               puts (" . ");
206 #endif
207             display_ (CDR (x));
208           }
209         //if (cont != cell_f) puts (")");
210         puts (")");
211         break;
212       }
213     case TSPECIAL:
214       {
215         switch (x)
216           {
217           case 1: {puts ("()"); break;}
218           case 2: {puts ("#f"); break;}
219           case 3: {puts ("#t"); break;}
220           default:
221             {
222 #if __GNUC__
223         puts ("<x:");
224         puts (itoa (x));
225         puts (">");
226 #else
227         puts ("<x>");
228 #endif
229             }
230           }
231         break;
232       }
233     case TSYMBOL:
234       {
235         switch (x)
236           {
237           case 11: {puts (" . "); break;}
238           case 12: {puts ("lambda"); break;}
239           case 13: {puts ("begin"); break;}
240           case 14: {puts ("if"); break;}
241           case 15: {puts ("quote"); break;}
242           case 37: {puts ("car"); break;}
243           case 38: {puts ("cdr"); break;}
244           case 39: {puts ("null?"); break;}
245           case 40: {puts ("eq?"); break;}
246           case 41: {puts ("cons"); break;}
247           default:
248             {
249 #if __GNUC__
250         puts ("<s:");
251         puts (itoa (x));
252         puts (">");
253 #else
254         puts ("<s>");
255 #endif
256             }
257           }
258         break;
259       }
260     default:
261       {
262         //puts ("<default>\n");
263 #if __GNUC__
264         puts ("<");
265         puts (itoa (TYPE (x)));
266         puts (":");
267         puts (itoa (x));
268         puts (">");
269 #else
270         puts ("_");
271 #endif
272         break;
273       }
274     }
275   return 0;
276 }
277
278 SCM
279 bload_env (SCM a) ///((internal))
280 {
281   puts ("reading: ");
282   char *mo = "module/mes/tiny-0-32.mo";
283   puts (mo);
284   puts ("\n");
285   g_stdin = open (mo, 0);
286   if (g_stdin < 0) {eputs ("no such file: module/mes/tiny-0-32.mo\n");return 1;}
287
288   // BOOM
289   //char *p = arena;
290   char *p = (char*)g_cells;
291   int c;
292
293   c = getchar ();
294   putchar (c);
295   if (c != 'M') exit (10);
296   c = getchar ();
297   putchar (c);
298   if (c != 'E') exit (11);
299   c = getchar ();
300   putchar (c);
301   if (c != 'S') exit (12);
302   puts (" *GOT MES*\n");
303
304   // skip stack
305   getchar ();
306   getchar ();
307
308   int i = 0;
309   c = getchar ();
310   while (c != -1)
311     {
312       i++;
313       eputs (itoa (i));
314       eputs (": ");
315       eputs (itoa (c));
316       eputs ("\n");
317       *p++ = c;
318       c = getchar ();
319     }
320
321   puts ("read done\n");
322   display_ (10);
323
324   puts ("\n");
325   return r2;
326 }
327
328 int
329 main (int argc, char *argv[])
330 {
331   fill ();
332   char *p = arena;
333   puts (p);
334   puts ("\n");
335   display_ (10);
336   puts ("\n");
337   SCM program = bload_env (r0);
338
339   return 0;
340 }