src/gc.c

   1 /* -*-comment-start: "//";comment-end:""-*-
   2  * Mes --- Maxwell Equations of Software
   3  * Copyright © 2016,2017 Jan (janneke) 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 #include <errno.h>
  22
  23 SCM
  24 gc_up_arena () ///((internal))
  25 {
  26   ARENA_SIZE *= 2;
  27   void *p = realloc (g_cells-1, 2*ARENA_SIZE*sizeof(struct scm));
  28   if (!p)
  29     {
  30       eputs ("realloc failed, g_free=");
  31       eputs (itoa (g_free));
  32       eputs (":");
  33       eputs (itoa (ARENA_SIZE - g_free));
  34       eputs ("\n");
  35       assert (0);
  36       exit (1);
  37     }
  38   g_cells = (struct scm*)p;
  39   g_cells++;
  40   gc_init_news ();
  41
  42   return 0;
  43 }
  44
  45 SCM
  46 gc_flip () ///((internal))
  47 {
  48   struct scm *cells = g_cells;
  49   g_cells = g_news;
  50   g_news = cells;
  51   if (g_debug > 2)
  52     {
  53       eputs (";;;   => jam[");
  54       eputs (itoa (g_free));
  55       eputs ("]\n");
  56     }
  57   return g_stack;
  58 }
  59
  60 SCM
  61 gc_copy (SCM old) ///((internal))
  62 {
  63   if (TYPE (old) == TBROKEN_HEART)
  64     return g_cells[old].car;
  65   SCM new = g_free++;
  66   g_news[new] = g_cells[old];
  67   if (NTYPE (new) == TVECTOR)
  68     {
  69       NVECTOR (new) = g_free;
  70       for (int i=0; i<LENGTH (old); i++)
  71         g_news[g_free++] = g_cells[VECTOR (old)+i];
  72     }
  73   TYPE (old) = TBROKEN_HEART;
  74   CAR (old) = new;
  75   return new;
  76 }
  77
  78 SCM
  79 gc_relocate_car (SCM new, SCM car) ///((internal))
  80 {
  81   g_news[new].car = car;
  82   return cell_unspecified;
  83 }
  84
  85 SCM
  86 gc_relocate_cdr (SCM new, SCM cdr) ///((internal))
  87 {
  88   g_news[new].cdr = cdr;
  89   return cell_unspecified;
  90 }
  91
  92 SCM
  93 gc_loop (SCM scan) ///((internal))
  94 {
  95   SCM car;
  96   SCM cdr;
  97   while (scan < g_free)
  98     {
  99       if (NTYPE (scan) == TCLOSURE
 100           || NTYPE (scan) == TCONTINUATION
 101           || NTYPE (scan) == TFUNCTION
 102           || NTYPE (scan) == TKEYWORD
 103           || NTYPE (scan) == TMACRO
 104           || NTYPE (scan) == TPAIR
 105           || NTYPE (scan) == TREF
 106           || scan == 1 // null
 107           || NTYPE (scan) == TSPECIAL
 108           || NTYPE (scan) == TSTRING
 109           || NTYPE (scan) == TSYMBOL
 110           || NTYPE (scan) == TVARIABLE)
 111         {
 112           car = gc_copy (g_news[scan].car);
 113           gc_relocate_car (scan, car);
 114         }
 115       if ((NTYPE (scan) == TCLOSURE
 116            || NTYPE (scan) == TCONTINUATION
 117            || NTYPE (scan) == TMACRO
 118            || NTYPE (scan) == TPAIR
 119            || NTYPE (scan) == TVALUES)
 120           && g_news[scan].cdr) // allow for 0 terminated list of symbols
 121         {
 122           cdr = gc_copy (g_news[scan].cdr);
 123           gc_relocate_cdr (scan, cdr);
 124         }
 125       scan++;
 126     }
 127   return gc_flip ();
 128 }
 129
 130 SCM
 131 gc_check ()
 132 {
 133   if (g_free + GC_SAFETY > ARENA_SIZE)
 134     gc ();
 135   return cell_unspecified;
 136 }
 137
 138 SCM
 139 gc_ () ///((internal))
 140 {
 141   if (g_debug == 2)
 142     eputs (".");
 143   if (g_debug > 2)
 144     {
 145       eputs (";;; gc[");
 146       eputs (itoa (g_free));
 147       eputs (":");
 148       eputs (itoa (ARENA_SIZE - g_free));
 149       eputs ("]...");
 150     }
 151   g_free = 1;
 152
 153   if (g_cells < g_news
 154       //&& g_free > ARENA_SIZE >> 2
 155       && ARENA_SIZE < MAX_ARENA_SIZE)
 156     {
 157       if (g_debug == 2)
 158         eputs ("+");
 159       if (g_debug > 2)
 160         {
 161           eputs (" up[");
 162           eputs (itoa (g_cells));
 163           eputs (",");
 164           eputs (itoa (g_news));
 165           eputs (":");
 166           eputs (itoa (ARENA_SIZE));
 167           eputs (",");
 168           eputs (itoa (MAX_ARENA_SIZE));
 169           eputs ("]...");
 170         }
 171       gc_up_arena ();
 172     }
 173
 174   for (int i=g_free; i<g_symbol_max; i++)
 175     gc_copy (i);
 176   g_symbols = gc_copy (g_symbols);
 177   g_macros = gc_copy (g_macros);
 178   SCM new = gc_copy (g_stack);
 179   if (g_debug > 3)
 180     {
 181       eputs ("new=");
 182       eputs (itoa (new));
 183       eputs ("\n");
 184     }
 185   g_stack = new;
 186   gc_loop (1);
 187 }
 188
 189 SCM
 190 gc ()
 191 {
 192   if (g_debug > 4)
 193     {
 194       eputs ("symbols: ");
 195       write_error_ (g_symbols);
 196       eputs ("\n");
 197       eputs ("R0: ");
 198       write_error_ (r0);
 199       eputs ("\n");
 200     }
 201   gc_push_frame ();
 202   gc_ ();
 203   gc_pop_frame ();
 204   if (g_debug > 4)
 205     {
 206       eputs ("symbols: ");
 207       write_error_ (g_symbols);
 208       eputs ("\n");
 209       eputs ("R0: ");
 210       write_error_ (r0);
 211       eputs ("\n");
 212     }
 213 }