mescc: Parse mlibc early, show progress.
[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     (format (current-error-port) "parsing: _start\n")
37     (with-input-from-string
38         (string-append "
39 char **g_environment;
40 char **
41 _env (char **e)
42 {
43   return e;
44 }
45
46 int
47 _start ()
48 {
49   asm(\"" argc-argv "\");
50   g_environment = _env ();
51   asm (\".byte 0x58\");
52   int r = main ();
53   exit (r);
54 }
55 ") parse-c99)))
56
57 (define (strlen)
58   (format (current-error-port) "parsing: strlen\n")
59   (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 "  parse-c99))
69
70 (define (getchar)
71   (format (current-error-port) "parsing: getchar\n")
72   (with-input-from-string
73       "
74 int g_stdin = 0;
75 int ungetc_char = -1;
76 char ungetc_buf[2];
77 int
78 getchar ()
79 {
80   char c;
81   int i;
82   if (ungetc_char == -1)
83     {
84       int r = read (g_stdin, &c, 1);
85       if (r < 1) return -1;
86       i = c;
87    }
88   else
89     {
90        //FIXME
91        //i = ungetc_buf[ungetc_char--];
92        i = ungetc_buf[ungetc_char];
93        //ungetc_char--;
94        ungetc_char = ungetc_char - 1;
95      }
96   if (i < 0) i += 256;
97
98   return i;
99 }
100 " parse-c99))
101
102 (define (assert_fail)
103   (format (current-error-port) "parsing: assert_fail\n")
104   (with-input-from-string
105                "
106 void
107 assert_fail (char* s)
108 {
109   eputs (\"assert fail: \");
110   eputs (s);
111   eputs (\"\n\");
112   //*((int*)0) = 0;
113   char *fail = s;
114   fail = 0;
115   *fail = 0;
116 }
117 " parse-c99))
118
119 (define (ungetc)
120   (format (current-error-port) "parsing: ungetc\n")
121   (with-input-from-string
122                 "
123 //#define assert(x) ((x) ? (void)0 : assert_fail (#x))
124 int
125 ungetc (int c, int fd)
126 {
127   //FIXME
128   //assert (ungetc_char < 2);
129   //assert (ungetc_char == -1 || ungetc_char < 2);
130   //FIXME
131   //ungetc_buf[++ungetc_char] = c;
132   ungetc_char++;
133   ungetc_buf[ungetc_char] = c;
134   return c;
135  }
136 " parse-c99))
137
138 (define (putchar)
139   (format (current-error-port) "parsing: putchar\n")
140   (with-input-from-string
141                "
142 int
143 putchar (int c)
144 {
145   write (1, (char*)&c, 1);
146   return 0;
147 }
148 " parse-c99))
149
150 (define (fputc)
151   (format (current-error-port) "parsing: fputc\n")
152   (with-input-from-string
153                "
154 int
155 fputc (int c, int fd)
156 {
157   write (fd, (char*)&c, 1);
158   return 0;
159 }
160 " parse-c99))
161
162 (define (eputs)
163   (format (current-error-port) "parsing: eputs\n")
164   (with-input-from-string
165                "
166 int
167 eputs (char const* s)
168 {
169   int i = strlen (s);
170   write (2, s, i);
171   return 0;
172 }
173 " parse-c99))
174
175
176 (define (fputs)
177   (format (current-error-port) "parsing: fputs\n")
178   (with-input-from-string
179                "
180 int
181 fputs (char const* s, int fd)
182 {
183   int i = strlen (s);
184   write (fd, s, i);
185   return 0;
186 }
187 " parse-c99))
188
189 (define (puts)
190   (format (current-error-port) "parsing: puts\n")
191   (with-input-from-string
192                "
193 int
194 puts (char const* s)
195 {
196   int i = strlen (s);
197   write (1, s, i);
198   return 0;
199 }
200 " parse-c99))
201
202 (define (strcmp)
203   (format (current-error-port) "parsing: strcmp\n")
204   (with-input-from-string
205                "
206 int
207 strcmp (char const* a, char const* b)
208 {
209   while (*a && *b && *a == *b)
210     {
211       a++;b++;
212     }
213   return *a - *b;
214 }
215 " parse-c99))
216
217 (define (itoa)
218   (format (current-error-port) "parsing: itoa\n")
219   (with-input-from-string
220                "
221 char itoa_buf[10];
222
223 char const*
224 itoa (int x)
225 {
226   //static char itoa_buf[10];
227   //char *p = buf+9;
228   char *p = itoa_buf;
229   p += 9;
230   *p-- = 0;
231
232   //int sign = x < 0;
233   int sign;
234   sign = x < 0;
235   if (sign)
236     x = -x;
237   
238   do
239      {
240        *p-- = '0' + (x % 10);
241        x = x / 10;
242      } while (x);
243
244   if (sign)
245     *p-- = '-';
246
247   return p+1;
248 }
249 " parse-c99))
250
251 (define (isdigit)
252   (format (current-error-port) "parsing: isdigit\n")
253   (with-input-from-string
254                "
255 int
256 isdigit (char c)
257 {
258   //return (c>='0') && (c<='9');
259   if (c>='0' && c<='9') return 1;
260   return 0;
261 }
262 " parse-c99))
263
264 (define (atoi)
265   (format (current-error-port) "parsing: atoi\n")
266   (with-input-from-string
267                "
268 int
269 atoi (char const *s)
270 {
271   int i = 0;
272   int sign = 1;
273   if (*s && *s == '-')
274     {
275       sign = -1;
276       s++;
277     }
278   while (isdigit (*s))
279     {
280       i *= 10;
281       i += (*s - '0');
282       s++;
283     }
284   return i * sign;
285 }
286 " parse-c99))
287
288 (define (malloc)
289   (format (current-error-port) "parsing: malloc\n")
290   (with-input-from-string
291                "
292 //void *g_malloc_base = 0;
293 char *g_malloc_base = 0;
294
295 //void *
296 int *
297 malloc (int size)
298 {
299   //void *p = brk (0);
300   char *p = 0;
301   p = brk (0);
302   if (!g_malloc_base) g_malloc_base = p;
303   brk (p+size);
304   return p;
305 }
306 " parse-c99))
307
308 (define (realloc)
309   (format (current-error-port) "parsing: realloc\n")
310   (with-input-from-string
311                "
312 //void *
313 int *
314 //realloc (void *p, int size)
315 realloc (int *p, int size)
316 {
317   brk (g_malloc_base + size);
318   return g_malloc_base;
319 }
320 " parse-c99))
321
322 (define (strncmp)
323   (format (current-error-port) "parsing: strncmp\n")
324   (with-input-from-string
325                "
326 int
327 strncmp (char const* a, char const* b, int length)
328 {
329   while (*a && *b && *a == *b && --length) {a++;b++;}
330   return *a - *b;
331 }
332 " parse-c99))
333
334 (define (c:getenv)
335   (format (current-error-port) "parsing: getenv\n")
336   (with-input-from-string
337                   "
338 char **g_environment;
339 char const*
340 getenv (char const* s)
341 {
342   char **p = g_environment;
343   p = *g_environment;
344   int length = strlen (s);
345   while (*p)
346     {
347       if (!strncmp (s, *p, length) && *(*p + length) == '=') return (*p + length + 1);
348       p++;
349     }
350   return 0;
351 }
352 " parse-c99))
353
354 (define libc
355   (list
356    strlen
357    getchar
358    assert_fail
359    ungetc
360    putchar
361    fputc
362    eputs
363    fputs
364    puts
365    strcmp
366    itoa
367    isdigit
368    atoi
369    malloc
370    realloc
371    strncmp
372    c:getenv
373    ))