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