artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

core: Prepare for M2-Planet: gc.c.

Browse source 
* src/gc.c: Rewrite C constructs not supported by M2-Planet.
This commit is contained in:
Jan (janneke) Nieuwenhuizen 2020-04-19 13:23:47 +02:00
parent 3b347433e6
commit 948c6ef91d
No known key found for this signature in database
GPG key ID: F3C1A0D9C1D65273
1 changed files with 59 additions and 68 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

127
src/gc.c
View file

@ -1,6 +1,6 @@
/* -*-comment-start: "//";comment-end:""-*- /* -*-comment-start: "//";comment-end:""-*-
* GNU Mes --- Maxwell Equations of Software * GNU Mes --- Maxwell Equations of Software
* Copyright © 2016,2017 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> * Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
* *
* This file is part of GNU Mes. * This file is part of GNU Mes.
* *
@ -26,26 +26,13 @@
#include <string.h> #include <string.h>
#include <stdlib.h> #include <stdlib.h>
long ARENA_SIZE;
long MAX_ARENA_SIZE;
long STACK_SIZE;
long JAM_SIZE;
long GC_SAFETY;
long MAX_STRING;
char *g_arena;
long g_free;
SCM g_stack;
SCM *g_stack_array;
struct scm *g_cells;
struct scm *g_news;
SCM SCM
gc_init () ///((internal)) gc_init () /*:((internal)) */
{ {
#if SYSTEM_LIBC #if SYSTEM_LIBC
ARENA_SIZE = 100000000; // 2.3GiB ARENA_SIZE = 100000000; /* 2.3GiB */
#else #else
ARENA_SIZE = 300000; // 32b: 3MiB, 64b: 6 MiB ARENA_SIZE = 300000; /* 32b: 3MiB, 64b: 6 MiB */
#endif #endif
MAX_ARENA_SIZE = 100000000; MAX_ARENA_SIZE = 100000000;
STACK_SIZE = 20000; STACK_SIZE = 20000;
@ -72,50 +59,50 @@ gc_init () ///((internal))
long arena_bytes = (ARENA_SIZE + JAM_SIZE) * sizeof (struct scm); long arena_bytes = (ARENA_SIZE + JAM_SIZE) * sizeof (struct scm);
void *a = malloc (arena_bytes + STACK_SIZE * sizeof (SCM)); void *a = malloc (arena_bytes + STACK_SIZE * sizeof (SCM));
g_cells = (struct scm *) a; g_cells = a;
g_stack_array = (SCM *) (a + arena_bytes); g_stack_array = a + arena_bytes;
TYPE (0) = TVECTOR; TYPE (0) = TVECTOR;
LENGTH (0) = 1000; LENGTH (0) = 1000;
VECTOR (0) = 0; VECTOR (0) = 0;
g_cells++; g_cells = g_cells + 1;
TYPE (0) = TCHAR; TYPE (0) = TCHAR;
VALUE (0) = 'c'; VALUE (0) = 'c';
// FIXME: remove MES_MAX_STRING, grow dynamically /* FIXME: remove MES_MAX_STRING, grow dynamically */
g_buf = (char *) malloc (MAX_STRING); g_buf = malloc (MAX_STRING);
return 0; return 0;
} }
SCM SCM
gc_init_news () ///((internal)) gc_init_news () /*:((internal)) */
{ {
g_news = g_cells + g_free; g_news = g_cells + g_free;
NTYPE (0) = TVECTOR; NTYPE (0) = TVECTOR;
NLENGTH (0) = 1000; NLENGTH (0) = 1000;
NVECTOR (0) = 0; NVECTOR (0) = 0;
g_news++; g_news = g_news + 1;
NTYPE (0) = TCHAR; NTYPE (0) = TCHAR;
NVALUE (0) = 'n'; NVALUE (0) = 'n';
return 0; return 0;
} }
SCM SCM
gc_up_arena () ///((internal)) gc_up_arena () /*:((internal)) */
{ {
long old_arena_bytes = (ARENA_SIZE + JAM_SIZE) * sizeof (struct scm); long old_arena_bytes = (ARENA_SIZE + JAM_SIZE) * sizeof (struct scm);
if (ARENA_SIZE >> 1 < MAX_ARENA_SIZE >> 2) if (ARENA_SIZE >> 1 < MAX_ARENA_SIZE >> 2)
{ {
ARENA_SIZE <<= 1; ARENA_SIZE = ARENA_SIZE << 1;
JAM_SIZE <<= 1; JAM_SIZE = JAM_SIZE << 1;
GC_SAFETY <<= 1; GC_SAFETY = GC_SAFETY << 1;
} }
else else
ARENA_SIZE = MAX_ARENA_SIZE - JAM_SIZE; ARENA_SIZE = MAX_ARENA_SIZE - JAM_SIZE;
long arena_bytes = (ARENA_SIZE + JAM_SIZE) * sizeof (struct scm); long arena_bytes = (ARENA_SIZE + JAM_SIZE) * sizeof (struct scm);
void *p = realloc (g_cells - 1, arena_bytes + STACK_SIZE * sizeof (SCM)); void *p = realloc (g_cells - 1, arena_bytes + STACK_SIZE * sizeof (SCM));
if (!p) if (p == 0)
{ {
eputs ("realloc failed, g_free="); eputs ("realloc failed, g_free=");
eputs (itoa (g_free)); eputs (itoa (g_free));
@ -125,15 +112,15 @@ gc_up_arena () ///((internal))
assert (0); assert (0);
exit (1); exit (1);
} }
g_cells = (struct scm *) p; g_cells = p;
memcpy (p + arena_bytes, p + old_arena_bytes, STACK_SIZE * sizeof (SCM)); memcpy (p + arena_bytes, p + old_arena_bytes, STACK_SIZE * sizeof (SCM));
g_cells++; g_cells = g_cells + 1;
return 0; return 0;
} }
void void
gc_flip () ///((internal)) gc_flip () /*:((internal)) */
{ {
if (g_debug > 2) if (g_debug > 2)
{ {
@ -147,17 +134,22 @@ gc_flip () ///((internal))
} }
SCM SCM
gc_copy (SCM old) ///((internal)) gc_copy (SCM old) /*:((internal)) */
{ {
if (TYPE (old) == TBROKEN_HEART) if (TYPE (old) == TBROKEN_HEART)
return g_cells[old].car; return CAR (old);
SCM new = g_free++; SCM new = g_free;
g_free = g_free + 1;
g_news[new] = g_cells[old]; g_news[new] = g_cells[old];
if (NTYPE (new) == TSTRUCT || NTYPE (new) == TVECTOR) if (NTYPE (new) == TSTRUCT || NTYPE (new) == TVECTOR)
{ {
NVECTOR (new) = g_free; NVECTOR (new) = g_free;
for (long i = 0; i < LENGTH (old); i++) long i;
g_news[g_free++] = g_cells[VECTOR (old) + i]; for (i = 0; i < LENGTH (old); i = i + 1)
{
g_news[g_free] = g_cells[VECTOR (old) + i];
g_free = g_free + 1;
}
} }
else if (NTYPE (new) == TBYTES) else if (NTYPE (new) == TBYTES)
{ {
@ -165,7 +157,7 @@ gc_copy (SCM old) ///((internal))
char *dest = NCBYTES (new); char *dest = NCBYTES (new);
size_t length = NLENGTH (new); size_t length = NLENGTH (new);
memcpy (dest, src, length + 1); memcpy (dest, src, length + 1);
g_free += bytes_cells (length) - 1; g_free = g_free + bytes_cells (length) - 1;
if (g_debug > 4) if (g_debug > 4)
{ {
@ -189,21 +181,21 @@ gc_copy (SCM old) ///((internal))
} }
SCM SCM
gc_relocate_car (SCM new, SCM car) ///((internal)) gc_relocate_car (SCM new, SCM car) /*:((internal)) */
{ {
g_news[new].car = car; NCAR (new) = car;
return cell_unspecified; return cell_unspecified;
} }
SCM SCM
gc_relocate_cdr (SCM new, SCM cdr) ///((internal)) gc_relocate_cdr (SCM new, SCM cdr) /*:((internal)) */
{ {
g_news[new].cdr = cdr; NCDR (new) = cdr;
return cell_unspecified; return cell_unspecified;
} }
void void
gc_loop (SCM scan) ///((internal)) gc_loop (SCM scan) /*:((internal)) */
{ {
SCM car; SCM car;
SCM cdr; SCM cdr;
@ -211,21 +203,22 @@ gc_loop (SCM scan) ///((internal))
{ {
if (NTYPE (scan) == TBROKEN_HEART) if (NTYPE (scan) == TBROKEN_HEART)
error (cell_symbol_system_error, cstring_to_symbol ("gc")); error (cell_symbol_system_error, cstring_to_symbol ("gc"));
if (NTYPE (scan) == TMACRO || NTYPE (scan) == TPAIR || NTYPE (scan) == TREF || scan == 1 // null if (NTYPE (scan) == TMACRO || NTYPE (scan) == TPAIR || NTYPE (scan) == TREF || scan == 1 /* null */
|| NTYPE (scan) == TVARIABLE) || NTYPE (scan) == TVARIABLE)
{ {
car = gc_copy (g_news[scan].car); car = gc_copy (NCAR (scan));
gc_relocate_car (scan, car); gc_relocate_car (scan, car);
} }
if ((NTYPE (scan) == TCLOSURE || NTYPE (scan) == TCONTINUATION || NTYPE (scan) == TKEYWORD || NTYPE (scan) == TMACRO || NTYPE (scan) == TPAIR || NTYPE (scan) == TPORT || NTYPE (scan) == TSPECIAL || NTYPE (scan) == TSTRING || NTYPE (scan) == TSYMBOL || scan == 1 // null if ((NTYPE (scan) == TCLOSURE || NTYPE (scan) == TCONTINUATION || NTYPE (scan) == TKEYWORD || NTYPE (scan) == TMACRO || NTYPE (scan) == TPAIR || NTYPE (scan) == TPORT || NTYPE (scan) == TSPECIAL || NTYPE (scan) == TSTRING || NTYPE (scan) == TSYMBOL || scan == 1 /* null */
|| NTYPE (scan) == TVALUES) && g_news[scan].cdr) // allow for 0 terminated list of symbols || NTYPE (scan) == TVALUES)
&& NCDR (scan)) /* allow for 0 terminated list of symbols */
{ {
cdr = gc_copy (g_news[scan].cdr); cdr = gc_copy (NCDR (scan));
gc_relocate_cdr (scan, cdr); gc_relocate_cdr (scan, cdr);
} }
if (NTYPE (scan) == TBYTES) if (NTYPE (scan) == TBYTES)
scan += bytes_cells (NLENGTH (scan)) - 1; scan = scan + bytes_cells (NLENGTH (scan)) - 1;
scan++; scan = scan + 1;
} }
gc_flip (); gc_flip ();
} }
@ -239,7 +232,7 @@ gc_check ()
} }
SCM SCM
gc_ () ///((internal)) gc_ () /*:((internal)) */
{ {
gc_init_news (); gc_init_news ();
if (g_debug == 2) if (g_debug == 2)
@ -254,20 +247,16 @@ gc_ () ///((internal))
} }
g_free = 1; g_free = 1;
#if __MESC__
if (ARENA_SIZE < MAX_ARENA_SIZE && (long) g_news > 0)
#else
if (ARENA_SIZE < MAX_ARENA_SIZE && g_news > 0) if (ARENA_SIZE < MAX_ARENA_SIZE && g_news > 0)
#endif
{ {
if (g_debug == 2) if (g_debug == 2)
eputs ("+"); eputs ("+");
if (g_debug > 2) if (g_debug > 2)
{ {
eputs (" up["); eputs (" up[");
eputs (itoa ((unsigned long) g_cells)); eputs (itoa (g_cells));
eputs (","); eputs (",");
eputs (itoa ((unsigned long) g_news)); eputs (itoa (g_news));
eputs (":"); eputs (":");
eputs (itoa (ARENA_SIZE)); eputs (itoa (ARENA_SIZE));
eputs (","); eputs (",");
@ -277,13 +266,14 @@ gc_ () ///((internal))
gc_up_arena (); gc_up_arena ();
} }
for (long i = g_free; i < g_symbol_max; i++) long i;
for (i = g_free; i < g_symbol_max; i = i + 1)
gc_copy (i); gc_copy (i);
g_symbols = gc_copy (g_symbols); g_symbols = gc_copy (g_symbols);
g_macros = gc_copy (g_macros); g_macros = gc_copy (g_macros);
g_ports = gc_copy (g_ports); g_ports = gc_copy (g_ports);
m0 = gc_copy (m0); m0 = gc_copy (m0);
for (long i = g_stack; i < STACK_SIZE; i++) for (i = g_stack; i < STACK_SIZE; i = i + 1)
g_stack_array[i] = gc_copy (g_stack_array[i]); g_stack_array[i] = gc_copy (g_stack_array[i]);
gc_loop (1); gc_loop (1);
} }
@ -315,20 +305,21 @@ gc ()
} }
SCM SCM
gc_push_frame () ///((internal)) gc_push_frame () /*:((internal)) */
{ {
if (g_stack < 5) if (g_stack < 5)
assert (!"STACK FULL"); assert (!"STACK FULL");
g_stack_array[--g_stack] = cell_f; g_stack_array[g_stack - 1] = cell_f;
g_stack_array[--g_stack] = r0; g_stack_array[g_stack - 2] = r0;
g_stack_array[--g_stack] = r1; g_stack_array[g_stack - 3] = r1;
g_stack_array[--g_stack] = r2; g_stack_array[g_stack - 4] = r2;
g_stack_array[--g_stack] = r3; g_stack_array[g_stack - 5] = r3;
g_stack = g_stack - 5;
return g_stack; return g_stack;
} }
SCM SCM
gc_peek_frame () ///((internal)) gc_peek_frame () /*:((internal)) */
{ {
r3 = g_stack_array[g_stack]; r3 = g_stack_array[g_stack];
r2 = g_stack_array[g_stack + 1]; r2 = g_stack_array[g_stack + 1];
@ -338,9 +329,9 @@ gc_peek_frame () ///((internal))
} }
SCM SCM
gc_pop_frame () ///((internal)) gc_pop_frame () /*:((internal)) */
{ {
SCM x = gc_peek_frame (); SCM x = gc_peek_frame ();
g_stack += 5; g_stack = g_stack + 5;
return x; return x;
} }