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