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