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