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