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    ))