src/gc.c

   1 /* -*-comment-start: "//";comment-end:""-*-
   2  * Mes --- Maxwell Equations of Software
   3  * Copyright © 2016 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 SCM
  22 gc_up_arena () ///((internal))
  23 {
  24   ARENA_SIZE *= 2;
  25   GC_SAFETY *= 2;
  26 #if _POSIX_SOURCE
  27   void *p = realloc (g_cells-1, 2*ARENA_SIZE*sizeof(struct scm));
  28 #else
  29   char *p = g_cells;
  30   p = realloc (p-sizeof (struct scm), 2*ARENA_SIZE*sizeof(struct scm));
  31 #endif
  32
  33 #if _POSIX_SOURCE
  34   if (!p) error (cell_symbol_system_error, cons (MAKE_STRING (cstring_to_list (strerror (errno))), MAKE_NUMBER (g_free)));
  35   g_cells = (struct scm*)p;
  36   g_cells++;
  37 #endif
  38   gc_init_news ();
  39   return 0;
  40 }
  41
  42 SCM
  43 gc_flip () ///((internal))
  44 {
  45   struct scm *cells = g_cells;
  46   g_cells = g_news;
  47   g_news = cells;
  48   if (g_debug)
  49     {
  50       eputs (";;;   => jam[");
  51       eputs (itoa (g_free));
  52       eputs ("]\n");
  53     }
  54   return g_stack;
  55 }
  56
  57 SCM
  58 gc_copy (SCM old) ///((internal))
  59 {
  60   if (TYPE (old) == TBROKEN_HEART) return g_cells[old].car;
  61   SCM new = g_free++;
  62   g_news[new] = g_cells[old];
  63   if (NTYPE (new) == TVECTOR)
  64     {
  65       NVECTOR (new) = g_free;
  66       for (int i=0; i<LENGTH (old); i++)
  67         g_news[g_free++] = g_cells[VECTOR (old)+i];
  68     }
  69   TYPE (old) = TBROKEN_HEART;
  70   CAR (old) = new;
  71   return new;
  72 }
  73
  74 SCM
  75 gc_relocate_car (SCM new, SCM car) ///((internal))
  76 {
  77   g_news[new].car = car;
  78   return cell_unspecified;
  79 }
  80
  81 SCM
  82 gc_relocate_cdr (SCM new, SCM cdr) ///((internal))
  83 {
  84   g_news[new].cdr = cdr;
  85   return cell_unspecified;
  86 }
  87
  88 SCM
  89 gc_loop (SCM scan) ///((internal))
  90 {
  91   while (scan < g_free)
  92     {
  93       if (NTYPE (scan) == TCLOSURE
  94           || NTYPE (scan) == TCONTINUATION
  95           || NTYPE (scan) == TFUNCTION
  96           || NTYPE (scan) == TKEYWORD
  97           || NTYPE (scan) == TMACRO
  98           || NTYPE (scan) == TPAIR
  99           || NTYPE (scan) == TREF
 100           || scan == 1 // null
 101           || NTYPE (scan) == TSPECIAL
 102           || NTYPE (scan) == TSTRING
 103           || NTYPE (scan) == TSYMBOL)
 104         {
 105           SCM car = gc_copy (g_news[scan].car);
 106           gc_relocate_car (scan, car);
 107         }
 108       if ((NTYPE (scan) == TCLOSURE
 109            || NTYPE (scan) == TCONTINUATION
 110            || NTYPE (scan) == TMACRO
 111            || NTYPE (scan) == TPAIR
 112            || NTYPE (scan) == TVALUES)
 113           && g_news[scan].cdr) // allow for 0 terminated list of symbols
 114         {
 115           SCM cdr = gc_copy (g_news[scan].cdr);
 116           gc_relocate_cdr (scan, cdr);
 117         }
 118       scan++;
 119     }
 120   return gc_flip ();
 121 }
 122
 123 SCM
 124 gc_check ()
 125 {
 126   if (g_free + GC_SAFETY > ARENA_SIZE)
 127     gc_pop_frame (gc (gc_push_frame ()));
 128   return cell_unspecified;
 129 }
 130
 131 SCM
 132 gc ()
 133 {
 134   if (g_debug)
 135     {
 136       eputs (";;; gc[");
 137       eputs (itoa (g_free));
 138       eputs (":");
 139       eputs (itoa (ARENA_SIZE - g_free));
 140       eputs ("]...");
 141     }
 142   g_free = 1;
 143   if (g_cells < g_news && ARENA_SIZE < MAX_ARENA_SIZE) gc_up_arena ();
 144   for (int i=g_free; i<g_symbol_max; i++)
 145     gc_copy (i);
 146   make_tmps (g_news);
 147   g_symbols = gc_copy (g_symbols);
 148   SCM new = gc_copy (g_stack);
 149   if (g_debug)
 150     {
 151       eputs ("new=");
 152       eputs (itoa (new));
 153       eputs ("\n");
 154     }
 155   g_stack = new;
 156   return gc_loop (1);
 157 }