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