scaffold/tiny-mes.c

   1 /* -*-comment-start: "//";comment-end:""-*-
   2  * Mes --- Maxwell Equations of Software
   3  * Copyright © 2016,2017 Jan Nieuwenhuizen <janneke@gnu.org>
   4  *
   5  * This file is part of Mes.
   6  *
   7  * Mes is free software; you can redistribute it and/or modify it
   8  * under the terms of the GNU General Public License as published by
   9  * the Free Software Foundation; either version 3 of the License, or (at
  10  * your option) any later version.
  11  *
  12  * Mes is distributed in the hope that it will be useful, but
  13  * WITHOUT ANY WARRANTY; without even the implied warranty of
  14  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15  * GNU General Public License for more details.
  16  *
  17  * You should have received a copy of the GNU General Public License
  18  * along with Mes.  If not, see <http://www.gnu.org/licenses/>.
  19  */
  20
  21 #if POSIX
  22 #error "POSIX not supported"
  23 #endif
  24
  25 #include <mlibc.h>
  26
  27 char arena[300];
  28
  29 typedef int SCM;
  30
  31 SCM g_stack = 0;
  32 SCM r0 = 0; // a/env
  33 SCM r1 = 0; // param 1
  34 SCM r2 = 0; // save 2+load/dump
  35 SCM r3 = 0; // continuation
  36
  37 enum type_t {TCHAR, TCLOSURE, TCONTINUATION, TFUNCTION, TKEYWORD, TMACRO, TNUMBER, TPAIR, TREF, TSPECIAL, TSTRING, TSYMBOL, TVALUES, TVECTOR, TBROKEN_HEART};
  38
  39 struct scm {
  40   enum type_t type;
  41   SCM car;
  42   SCM cdr;
  43 };
  44
  45 #if __MESC__
  46 struct scm *g_cells = arena;
  47 #else
  48 struct scm *g_cells = (struct scm*)arena;
  49 #endif
  50
  51 #define cell_nil 1
  52 #define cell_f 2
  53 #define cell_t 3
  54
  55 #define TYPE(x) (g_cells[x].type)
  56
  57 #define CAR(x) g_cells[x].car
  58
  59 #define CDR(x) g_cells[x].cdr
  60 #define VALUE(x) g_cells[x].cdr
  61
  62 SCM
  63 car (SCM x)
  64 {
  65   return CAR (x);
  66 }
  67
  68 SCM
  69 cdr (SCM x)
  70 {
  71   return CDR (x);
  72 }
  73
  74 SCM caar (SCM x) {return car (car (x));}
  75 SCM cadr (SCM x) {return car (cdr (x));}
  76 SCM cdar (SCM x) {return cdr (car (x));}
  77 SCM cddr (SCM x) {return cdr (cdr (x));}
  78
  79 SCM
  80 gc_peek_frame ()
  81 {
  82   SCM frame = car (g_stack);
  83   r1 = car (frame);
  84   r2 = cadr (frame);
  85   r3 = car (cddr (frame));
  86   r0 = cadr (cddr (frame));
  87   return frame;
  88 }
  89
  90 //\f Environment setup
  91
  92 SCM
  93 mes_environment ()
  94 {
  95   return 0;
  96 }
  97
  98 SCM
  99 mes_builtins (SCM a)
 100 {
 101   return a;
 102 }
 103
 104 SCM
 105 fill ()
 106 {
 107   TYPE (0) = 0x6c6c6168;
 108   CAR (0) = 0x6a746f6f;
 109   CDR (0) = 0x00002165;
 110
 111   TYPE (1) = TSYMBOL;
 112   CAR (1) = 0x2d2d2d2d;
 113   CDR (1) = 0x3e3e3e3e;
 114
 115   TYPE (9) = 0x2d2d2d2d;
 116   CAR (9) = 0x2d2d2d2d;
 117   CDR (9) = 0x3e3e3e3e;
 118
 119   // (A(B))
 120   TYPE (10) = TPAIR;
 121   CAR (10) = 11;
 122   CDR (10) = 12;
 123
 124   TYPE (11) = TCHAR;
 125   CAR (11) = 0x58585858;
 126   CDR (11) = 89;
 127
 128   TYPE (12) = TPAIR;
 129   CAR (12) = 13;
 130   CDR (12) = 1;
 131
 132   TYPE (13) = TCHAR;
 133   CAR (11) = 0x58585858;
 134   CDR (13) = 90;
 135
 136   TYPE (14) = 0x58585858;
 137   CAR (14) = 0x58585858;
 138   CDR (14) = 0x58585858;
 139
 140   TYPE (14) = 0x58585858;
 141   CAR (14) = 0x58585858;
 142   CDR (14) = 0x58585858;
 143
 144   TYPE (16) = 0x3c3c3c3c;
 145   CAR (16) = 0x2d2d2d2d;
 146   CDR (16) = 0x2d2d2d2d;
 147   return 0;
 148 }
 149
 150 SCM
 151 display_ (SCM x)
 152 {
 153   //puts ("<display>\n");
 154   switch (TYPE (x))
 155     {
 156     case TCHAR:
 157       {
 158         //puts ("<char>\n");
 159         puts ("#\\");
 160         putchar (VALUE (x));
 161         break;
 162       }
 163     case TFUNCTION:
 164       {
 165         //puts ("<function>\n");
 166         if (VALUE (x) == 0)
 167           puts ("core:make-cell");
 168         if (VALUE (x) == 1)
 169           puts ("cons");
 170         if (VALUE (x) == 2)
 171           puts ("car");
 172         if (VALUE (x) == 3)
 173           puts ("cdr");
 174         break;
 175       }
 176     case TNUMBER:
 177       {
 178         //puts ("<number>\n");
 179 #if __GNUC__
 180         puts (itoa (VALUE (x)));
 181 #else
 182         int i;
 183         i = VALUE (x);
 184         i = i + 48;
 185         putchar (i);
 186 #endif
 187         break;
 188       }
 189     case TPAIR:
 190       {
 191         //puts ("<pair>\n");
 192         //if (cont != cell_f) puts "(");
 193         puts ("(");
 194         if (x && x != cell_nil) display_ (CAR (x));
 195         if (CDR (x) && CDR (x) != cell_nil)
 196           {
 197 #if __GNUC__
 198             if (TYPE (CDR (x)) != TPAIR)
 199               puts (" . ");
 200 #else
 201             int c;
 202             c = CDR (x);
 203             c = TYPE (c);
 204             if (c != TPAIR)
 205               puts (" . ");
 206 #endif
 207             display_ (CDR (x));
 208           }
 209         //if (cont != cell_f) puts (")");
 210         puts (")");
 211         break;
 212       }
 213     case TSPECIAL:
 214       {
 215         switch (x)
 216           {
 217           case 1: {puts ("()"); break;}
 218           case 2: {puts ("#f"); break;}
 219           case 3: {puts ("#t"); break;}
 220           default:
 221             {
 222 #if __GNUC__
 223         puts ("<x:");
 224         puts (itoa (x));
 225         puts (">");
 226 #else
 227         puts ("<x>");
 228 #endif
 229             }
 230           }
 231         break;
 232       }
 233     case TSYMBOL:
 234       {
 235         switch (x)
 236           {
 237           case 11: {puts (" . "); break;}
 238           case 12: {puts ("lambda"); break;}
 239           case 13: {puts ("begin"); break;}
 240           case 14: {puts ("if"); break;}
 241           case 15: {puts ("quote"); break;}
 242           case 37: {puts ("car"); break;}
 243           case 38: {puts ("cdr"); break;}
 244           case 39: {puts ("null?"); break;}
 245           case 40: {puts ("eq?"); break;}
 246           case 41: {puts ("cons"); break;}
 247           default:
 248             {
 249 #if __GNUC__
 250         puts ("<s:");
 251         puts (itoa (x));
 252         puts (">");
 253 #else
 254         puts ("<s>");
 255 #endif
 256             }
 257           }
 258         break;
 259       }
 260     default:
 261       {
 262         //puts ("<default>\n");
 263 #if __GNUC__
 264         puts ("<");
 265         puts (itoa (TYPE (x)));
 266         puts (":");
 267         puts (itoa (x));
 268         puts (">");
 269 #else
 270         puts ("_");
 271 #endif
 272         break;
 273       }
 274     }
 275   return 0;
 276 }
 277
 278 SCM
 279 bload_env (SCM a) ///((internal))
 280 {
 281   puts ("reading: ");
 282   char *mo = "module/mes/tiny-0-32.mo";
 283   puts (mo);
 284   puts ("\n");
 285   g_stdin = open (mo, 0);
 286   if (g_stdin < 0) {eputs ("no such file: module/mes/tiny-0-32.mo\n");return 1;}
 287
 288   // BOOM
 289   //char *p = arena;
 290   char *p = (char*)g_cells;
 291   int c;
 292
 293   c = getchar ();
 294   putchar (c);
 295   if (c != 'M') exit (10);
 296   c = getchar ();
 297   putchar (c);
 298   if (c != 'E') exit (11);
 299   c = getchar ();
 300   putchar (c);
 301   if (c != 'S') exit (12);
 302   puts (" *GOT MES*\n");
 303
 304   // skip stack
 305   getchar ();
 306   getchar ();
 307
 308   int i = 0;
 309   c = getchar ();
 310   while (c != -1)
 311     {
 312       i++;
 313       eputs (itoa (i));
 314       eputs (": ");
 315       eputs (itoa (c));
 316       eputs ("\n");
 317       *p++ = c;
 318       c = getchar ();
 319     }
 320
 321   puts ("read done\n");
 322   display_ (10);
 323
 324   puts ("\n");
 325   return r2;
 326 }
 327
 328 int
 329 main (int argc, char *argv[])
 330 {
 331   fill ();
 332   char *p = arena;
 333   puts (p);
 334   puts ("\n");
 335   display_ (10);
 336   puts ("\n");
 337   SCM program = bload_env (r0);
 338
 339   return 0;
 340 }