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