mescc: Add brk, naive malloc.
[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 int g_stdin;
60 int ungetc_char = -1;
61
62 #if 0
63 int
64 getchar ()
65 {
66   char c;
67   int r = read (g_stdin, &c, 1);
68   //int r = read (0, &c, 1);
69   if (r < 1) return -1;
70   return c;
71 }
72 #endif
73
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       i = ungetc_char;
88       ungetc_char = -1;
89     }
90   if (i < 0) i += 256;
91   return i;
92 }
93 "
94 ;;paredit:"
95                 parse-c99)))
96     ast))
97
98 (define assert_fail
99   (let* ((ast (with-input-from-string
100                   "
101 void
102 assert_fail (char* s)
103 {
104   eputs (\"assert fail: \");
105   eputs (s);
106   eputs (\"\n\");
107   //*((int*)0) = 0;
108   char *fail = s;
109   fail = 0;
110   *fail = 0;
111 }
112 "
113 ;;paredit:"
114                 parse-c99)))
115     ast))
116
117 (define ungetc
118   (let* ((ast (with-input-from-string
119 "
120 #define assert(x) ((x) ? (void)0 : assert_fail (#x))
121 int
122 ungetc (int c, int fd)
123 {
124   assert (ungetc_char == -1);
125   ungetc_char = c;
126   return c;
127 }
128 "
129 ;;paredit:"
130                 parse-c99)))
131     ast))
132
133 (define putchar
134   (let* ((ast (with-input-from-string
135                   "
136 int
137 putchar (int c)
138 {
139   //write (STDOUT, s, strlen (s));
140   //int i = write (STDOUT, s, strlen (s));
141   write (1, (char*)&c, 1);
142   return 0;
143 }
144 "
145 ;;paredit:"
146                 parse-c99)))
147     ast))
148
149 (define eputs
150   (let* ((ast (with-input-from-string
151                   "
152 int
153 eputs (char const* s)
154 {
155   //write (STDERR, s, strlen (s));
156   //write (2, s, strlen (s));
157   int i = strlen (s);
158   write (2, s, i);
159   return 0;
160 }
161 "
162 ;;paredit:"
163                 parse-c99)))
164     ast))
165
166 (define fputs
167   (let* ((ast (with-input-from-string
168                   "
169 int
170 fputs (char const* s, int fd)
171 {
172   int i = strlen (s);
173   write (fd, s, i);
174   return 0;
175 }
176 "
177 ;;paredit:"
178                 parse-c99)))
179     ast))
180
181 (define puts
182   (let* ((ast (with-input-from-string
183                   "
184 int
185 puts (char const* s)
186 {
187   //write (STDOUT, s, strlen (s));
188   //int i = write (STDOUT, s, strlen (s));
189   int i = strlen (s);
190   write (1, s, i);
191   return 0;
192 }
193 "
194 ;;paredit:"
195                 parse-c99)))
196     ast))
197
198 (define strcmp
199   (let* ((ast (with-input-from-string
200                   "
201 int
202 strcmp (char const* a, char const* b)
203 {
204   while (*a && *b && *a == *b) 
205     {
206       a++;b++;
207     }
208   return *a - *b;
209 }
210 "
211 ;;paredit:"
212                 parse-c99)))
213     ast))
214
215 (define itoa
216   (let* ((ast (with-input-from-string
217                   "
218 char itoa_buf[10];
219
220 char const*
221 itoa (int x)
222 {
223   //static char itoa_buf[10];
224   //char *p = buf+9;
225   char *p = itoa_buf;
226   p += 9;
227   *p-- = 0;
228
229   //int sign = x < 0;
230   int sign;
231   sign = x < 0;
232   if (sign)
233     x = -x;
234   
235   do
236     {
237       *p-- = '0' + (x % 10);
238       x = x / 10;
239     } while (x);
240
241   if (sign)
242     *p-- = '-';
243
244   return p+1;
245 }
246 "
247 ;;paredit:"
248                 parse-c99)))
249     ast))
250
251 (define isdigit
252   (let* ((ast (with-input-from-string
253                   "
254 int
255 isdigit (char c)
256 {
257   //return (c>='0') && (c<='9');
258   if (c>='0' && c<='9') return 1;
259   return 0;
260 }
261 "
262 ;;paredit:"
263                 parse-c99)))
264     ast))
265
266 (define malloc
267   (let* ((ast (with-input-from-string
268                   "
269 //void *g_malloc_base = 0;
270 char *g_malloc_base = 0;
271
272 //void *
273 int *
274 malloc (int size)
275 {
276   //void *p = brk (0);
277   char *p = 0;
278   if (!g_malloc_base) g_malloc_base = p;
279   p = brk (0);
280   brk (p+size);
281   return p;
282 }
283 "
284 ;;paredit:"
285                 parse-c99)))
286     ast))
287
288 (define realloc
289   (let* ((ast (with-input-from-string
290                   "
291 //void *
292 int *
293 //realloc (void *p, int size)
294 realloc (int *p, int size)
295 {
296   brk (g_malloc_base + size);
297   return g_malloc_base;
298 }
299 "
300 ;;paredit:"
301                 parse-c99)))
302     ast))
303
304 (define libc
305   (list
306    strlen
307    getchar
308    assert_fail
309    ungetc
310    putchar
311    eputs
312    fputs
313    puts
314    strcmp
315    itoa
316    isdigit
317    malloc
318    realloc))