31607f8e78a4adfba66ac215c414aa484341d7de
[mes.git] / module / mes / libc.mes
1 ;;; -*-scheme-*-
2
3 ;;; Mes --- Maxwell Equations of Software
4 ;;; Copyright © 2016,2017 Jan Nieuwenhuizen <janneke@gnu.org>
5 ;;;
6 ;;; This file is part of Mes.
7 ;;;
8 ;;; Mes is free software; you can redistribute it and/or modify it
9 ;;; under the terms of the GNU General Public License as published by
10 ;;; the Free Software Foundation; either version 3 of the License, or (at
11 ;;; your option) any later version.
12 ;;;
13 ;;; Mes is distributed in the hope that it will be useful, but
14 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
15 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
16 ;;; GNU General Public License for more details.
17 ;;;
18 ;;; You should have received a copy of the GNU General Public License
19 ;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
20
21 ;;; Commentary:
22
23 ;;; libc.mes provides a minimal portable C library for mescc.
24
25 ;;; Code:
26
27 (cond-expand
28  (guile-2)
29  (guile)
30  (mes
31   (mes-use-module (nyacc lang c99 parser))
32   (mes-use-module (mes libc-i386))))
33
34 (define _start
35   (let* ((argc-argv (i386:_start))
36          (ast (with-input-from-string
37                   (string-append "
38 char **g_environment;
39 char **
40 _env (char **e)
41 {
42   return e;
43 }
44
45 int
46 _start ()
47 {
48   asm(\"" argc-argv "\");
49   g_environment = _env ();
50   asm (\".byte 0x58\");
51   int r = main ();
52   exit (r);
53 }
54 ")
55                 parse-c99)))
56     ast))
57
58 (define strlen
59   (let* ((ast (with-input-from-string
60                   "
61 int
62 strlen (char const* s)
63 {
64   int i = 0;
65   while (s[i]) i++;
66   return i;
67 }
68 "
69 ;;paredit:"
70                 parse-c99)))
71     ast))
72
73 (define getchar
74   (let* ((ast (with-input-from-string
75                   "
76 int g_stdin = 0;
77 int ungetc_char = -1;
78 char ungetc_buf[2];
79 int
80 getchar ()
81 {
82   char c;
83   int i;
84   if (ungetc_char == -1)
85     {
86       int r = read (g_stdin, &c, 1);
87       if (r < 1) return -1;
88       i = c;
89     }
90   else
91     {
92      //FIXME
93      //i = ungetc_buf[ungetc_char--];
94      i = ungetc_buf[ungetc_char];
95      //ungetc_char--;
96      ungetc_char = ungetc_char - 1;
97     }
98   if (i < 0) i += 256;
99
100   return i;
101 }
102 "
103 ;;paredit:"
104                 parse-c99)))
105     ast))
106
107 (define assert_fail
108   (let* ((ast (with-input-from-string
109                   "
110 void
111 assert_fail (char* s)
112 {
113   eputs (\"assert fail: \");
114   eputs (s);
115   eputs (\"\n\");
116   //*((int*)0) = 0;
117   char *fail = s;
118   fail = 0;
119   *fail = 0;
120 }
121 "
122 ;;paredit:"
123                 parse-c99)))
124     ast))
125
126 (define ungetc
127   (let* ((ast (with-input-from-string
128 "
129 //#define assert(x) ((x) ? (void)0 : assert_fail (#x))
130 int
131 ungetc (int c, int fd)
132 {
133   //FIXME
134   //assert (ungetc_char < 2);
135   //assert (ungetc_char == -1 || ungetc_char < 2);
136   //FIXME
137   //ungetc_buf[++ungetc_char] = c;
138   ungetc_char++;
139   ungetc_buf[ungetc_char] = c;
140   return c;
141 }
142 "
143 ;;paredit:"
144                 parse-c99)))
145     ast))
146
147 (define putchar
148   (let* ((ast (with-input-from-string
149                   "
150 int
151 putchar (int c)
152 {
153   write (1, (char*)&c, 1);
154   return 0;
155 }
156 "
157 ;;paredit:"
158                 parse-c99)))
159     ast))
160
161 (define fputc
162   (let* ((ast (with-input-from-string
163                   "
164 int
165 fputc (int c, int fd)
166 {
167   write (fd, (char*)&c, 1);
168   return 0;
169 }
170 "
171 ;;paredit:"
172                 parse-c99)))
173     ast))
174
175 (define eputs
176   (let* ((ast (with-input-from-string
177                   "
178 int
179 eputs (char const* s)
180 {
181   int i = strlen (s);
182   write (2, s, i);
183   return 0;
184 }
185 "
186 ;;paredit:"
187                 parse-c99)))
188     ast))
189
190 (define fputs
191   (let* ((ast (with-input-from-string
192                   "
193 int
194 fputs (char const* s, int fd)
195 {
196   int i = strlen (s);
197   write (fd, s, i);
198   return 0;
199 }
200 "
201 ;;paredit:"
202                 parse-c99)))
203     ast))
204
205 (define puts
206   (let* ((ast (with-input-from-string
207                   "
208 int
209 puts (char const* s)
210 {
211   int i = strlen (s);
212   write (1, s, i);
213   return 0;
214 }
215 "
216 ;;paredit:"
217                 parse-c99)))
218     ast))
219
220 (define strcmp
221   (let* ((ast (with-input-from-string
222                   "
223 int
224 strcmp (char const* a, char const* b)
225 {
226   while (*a && *b && *a == *b) 
227     {
228       a++;b++;
229     }
230   return *a - *b;
231 }
232 "
233 ;;paredit:"
234                 parse-c99)))
235     ast))
236
237 (define itoa
238   (let* ((ast (with-input-from-string
239                   "
240 char itoa_buf[10];
241
242 char const*
243 itoa (int x)
244 {
245   //static char itoa_buf[10];
246   //char *p = buf+9;
247   char *p = itoa_buf;
248   p += 9;
249   *p-- = 0;
250
251   //int sign = x < 0;
252   int sign;
253   sign = x < 0;
254   if (sign)
255     x = -x;
256   
257   do
258     {
259       *p-- = '0' + (x % 10);
260       x = x / 10;
261     } while (x);
262
263   if (sign)
264     *p-- = '-';
265
266   return p+1;
267 }
268 "
269 ;;paredit:"
270                 parse-c99)))
271     ast))
272
273 (define isdigit
274   (let* ((ast (with-input-from-string
275                   "
276 int
277 isdigit (char c)
278 {
279   //return (c>='0') && (c<='9');
280   if (c>='0' && c<='9') return 1;
281   return 0;
282 }
283 "
284 ;;paredit:"
285                 parse-c99)))
286     ast))
287
288 (define atoi
289   (let* ((ast (with-input-from-string
290                   "
291 int
292 atoi (char const *s)
293 {
294   int i = 0;
295   int sign = 1;
296   if (*s && *s == '-')
297     {
298       sign = -1;
299       s++;
300     }
301   while (isdigit (*s))
302     {
303       i *= 10;
304       i += (*s - '0');
305       s++;
306     }
307   return i * sign;
308 }
309 "
310 ;;paredit:"
311                 parse-c99)))
312     ast))
313
314 (define malloc
315   (let* ((ast (with-input-from-string
316                   "
317 //void *g_malloc_base = 0;
318 char *g_malloc_base = 0;
319
320 //void *
321 int *
322 malloc (int size)
323 {
324   //void *p = brk (0);
325   char *p = 0;
326   p = brk (0);
327   if (!g_malloc_base) g_malloc_base = p;
328   brk (p+size);
329   return p;
330 }
331 "
332 ;;paredit:"
333                 parse-c99)))
334     ast))
335
336 (define realloc
337   (let* ((ast (with-input-from-string
338                   "
339 //void *
340 int *
341 //realloc (void *p, int size)
342 realloc (int *p, int size)
343 {
344   brk (g_malloc_base + size);
345   return g_malloc_base;
346 }
347 "
348 ;;paredit:"
349                 parse-c99)))
350     ast))
351
352 (define strncmp
353   (let* ((ast (with-input-from-string
354                   "
355 int
356 strncmp (char const* a, char const* b, int length)
357 {
358   while (*a && *b && *a == *b && --length) {a++;b++;}
359   return *a - *b;
360 }
361 "
362 ;;paredit:"
363                 parse-c99)))
364     ast))
365
366 (define c:getenv
367   (let* ((ast (with-input-from-string
368                   "
369 char **g_environment;
370 char const*
371 getenv (char const* s)
372 {
373   char **p = g_environment;
374   p = *g_environment;
375   int length = strlen (s);
376   while (*p)
377     {
378       if (!strncmp (s, *p, length) && *(*p + length) == '=') return (*p + length + 1);
379       p++;
380     }
381   return 0;
382 }
383 "
384 ;;paredit:"
385                 parse-c99)))
386     ast))
387
388
389 (define libc
390   (list
391    strlen
392    getchar
393    assert_fail
394    ungetc
395    putchar
396    fputc
397    eputs
398    fputs
399    puts
400    strcmp
401    itoa
402    isdigit
403    atoi
404    malloc
405    realloc
406    strncmp
407    c:getenv
408    ))