d0282686129683a693b28dfc02f66b3d78137dcc
[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 (strcpy)
218   (format (current-error-port) "parsing: strcpy\n")
219   (with-input-from-string
220                "
221 char *
222 strcpy (char *dest, char const *src)
223 {
224   char *p = dest;
225   while (*src) *p++ = *src++;
226   *p = 0;
227   return dest;
228 }
229 " parse-c99))
230
231 (define (itoa)
232   (format (current-error-port) "parsing: itoa\n")
233   (with-input-from-string
234                "
235 char itoa_buf[10];
236
237 char const*
238 itoa (int x)
239 {
240   //static char itoa_buf[10];
241   //char *p = buf+9;
242   char *p = itoa_buf;
243   p += 9;
244   *p-- = 0;
245
246   //int sign = x < 0; // FIXME
247   int sign = 0;
248   if (x < 0) sign = 1;
249   if (sign)
250     x = -x;
251
252   do
253      {
254        *p-- = '0' + (x % 10);
255        x = x / 10;
256      } while (x);
257
258   if (sign && *(p + 1) != '0')
259     *p-- = '-';
260
261   return p+1;
262 }
263 " parse-c99))
264
265 (define (isdigit)
266   (format (current-error-port) "parsing: isdigit\n")
267   (with-input-from-string
268                "
269 int
270 isdigit (char c)
271 {
272   //return (c>='0') && (c<='9');
273   if (c>='0' && c<='9') return 1;
274   return 0;
275 }
276 " parse-c99))
277
278 (define (atoi)
279   (format (current-error-port) "parsing: atoi\n")
280   (with-input-from-string
281                "
282 int
283 atoi (char const *s)
284 {
285   int i = 0;
286   int sign = 1;
287   if (*s && *s == '-')
288     {
289       sign = -1;
290       s++;
291     }
292   while (isdigit (*s))
293     {
294       i *= 10;
295       i += (*s - '0');
296       s++;
297     }
298   return i * sign;
299 }
300 " parse-c99))
301
302 (define (malloc)
303   (format (current-error-port) "parsing: malloc\n")
304   (with-input-from-string
305                "
306 //void *g_malloc_base = 0;
307 char *g_malloc_base = 0;
308
309 //void *
310 int *
311 malloc (int size)
312 {
313   //void *p = brk (0);
314   char *p = 0;
315   p = brk (0);
316   if (!g_malloc_base) g_malloc_base = p;
317   brk (p+size);
318   return p;
319 }
320 " parse-c99))
321
322 (define (realloc)
323   (format (current-error-port) "parsing: realloc\n")
324   (with-input-from-string
325                "
326 //void *
327 int *
328 //realloc (void *p, int size)
329 realloc (int *p, int size)
330 {
331   brk (g_malloc_base + size);
332   return g_malloc_base;
333 }
334 " parse-c99))
335
336 (define (strncmp)
337   (format (current-error-port) "parsing: strncmp\n")
338   (with-input-from-string
339                "
340 int
341 strncmp (char const* a, char const* b, int length)
342 {
343   while (*a && *b && *a == *b && --length) {a++;b++;}
344   return *a - *b;
345 }
346 " parse-c99))
347
348 (define (c:getenv)
349   (format (current-error-port) "parsing: getenv\n")
350   (with-input-from-string
351                   "
352 char **g_environment;
353 char const*
354 getenv (char const* s)
355 {
356   char **p = g_environment;
357   p = *g_environment;
358   int length = strlen (s);
359   while (*p)
360     {
361       if (!strncmp (s, *p, length) && *(*p + length) == '=') return (*p + length + 1);
362       p++;
363     }
364   return 0;
365 }
366 " parse-c99))
367
368 (define (printf)
369   (format (current-error-port) "parsing: printf\n")
370   (let ((va-arg (i386:va-arg)))
371       (with-input-from-string
372                (string-append "
373 int
374 printf (char const* format, int va_args)
375 {
376   int va_arg = 0;
377   int va;
378   char *p = format;
379   while (*p)
380     if (*p != '%')
381       putchar (*p++);
382     else
383       {
384         p++;
385         char c = *p;
386         switch (c)
387           {
388             case '%': {putchar (*p); break;}
389             case 'c': {asm (\"" va-arg "\"); putchar ((char)va); va_arg++; break;}
390             case 'd': {asm (\"" va-arg "\"); puts (itoa (va)); va_arg++; break;}
391             case 's': {asm (\"" va-arg "\"); puts ((char*)va); va_arg++; break;}
392             default: putchar (*p);
393           }
394         p++;
395       }
396   return 0;
397 }
398 ") parse-c99)))
399
400 (define libc
401   (list
402    strlen
403    getchar
404    assert_fail
405    ungetc
406    putchar
407    fputc
408    eputs
409    fputs
410    puts
411    strcmp
412    strcpy
413    itoa
414    isdigit
415    atoi
416    malloc
417    realloc
418    strncmp
419    c:getenv
420    printf
421    ))