core: Prepaere for M2-Planet.

* src/gc.c (M2_CELL_SIZE): Hack for missing pointer arithmetic in
M2-Planet.
(gc_init, alloc, make_cell, gc_up_arena, gc_copy, gc_loop, gc_): Use it.
This commit is contained in:
Jan Nieuwenhuizen 2019-10-24 21:56:49 +02:00
parent 65ac20a171
commit 6adc5f20bb
No known key found for this signature in database
GPG Key ID: F3C1A0D9C1D65273
1 changed files with 16 additions and 13 deletions

View File

@ -36,6 +36,9 @@
void init_symbols_ (); void init_symbols_ ();
// CONSTANT M2_CELL_SIZE 12
#define M2_CELL_SIZE 1
#if POINTER_CELLS #if POINTER_CELLS
long g_stack; long g_stack;
#else #else
@ -119,7 +122,7 @@ gc_init () /*:((internal)) */
TYPE (cell_arena) = TVECTOR; TYPE (cell_arena) = TVECTOR;
LENGTH (cell_arena) = 1000; LENGTH (cell_arena) = 1000;
VECTOR (cell_arena) = 0; VECTOR (cell_arena) = 0;
g_cells = g_cells + 1; g_cells = g_cells + M2_CELL_SIZE;
TYPE (cell_arena) = TCHAR; TYPE (cell_arena) = TCHAR;
VALUE (cell_arena) = 'c'; VALUE (cell_arena) = 'c';
@ -157,7 +160,7 @@ SCM
alloc (long n) alloc (long n)
{ {
SCM x = g_free; SCM x = g_free;
g_free = g_free + n; g_free = g_free + n * M2_CELL_SIZE;
#if POINTER_CELLS #if POINTER_CELLS
long i = g_free - g_cells; long i = g_free - g_cells;
#else #else
@ -172,7 +175,7 @@ SCM
make_cell (long type, SCM car, SCM cdr) make_cell (long type, SCM car, SCM cdr)
{ {
SCM x = g_free; SCM x = g_free;
g_free = g_free + 1; g_free = g_free + M2_CELL_SIZE;
#if POINTER_CELLS #if POINTER_CELLS
long i = g_free - g_cells; long i = g_free - g_cells;
#else #else
@ -211,7 +214,7 @@ copy_stack (long index, SCM from)
SCM SCM
cell_ref (SCM cell, long index) cell_ref (SCM cell, long index)
{ {
return cell + index; return cell + index * M2_CELL_SIZE;
} }
SCM SCM
@ -330,7 +333,7 @@ gc_up_arena () /*:((internal)) */
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 - M2_CELL_SIZE, arena_bytes + STACK_SIZE * sizeof (SCM));
if (p == 0) if (p == 0)
{ {
eputs ("realloc failed, g_free="); eputs ("realloc failed, g_free=");
@ -348,7 +351,7 @@ gc_up_arena () /*:((internal)) */
} }
g_cells = 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 + 1; g_cells = g_cells + M2_CELL_SIZE;
return 0; return 0;
} }
@ -378,7 +381,7 @@ gc_copy (SCM old) /*:((internal)) */
if (TYPE (old) == TBROKEN_HEART) if (TYPE (old) == TBROKEN_HEART)
return CAR (old); return CAR (old);
SCM new = g_free; SCM new = g_free;
g_free = g_free + 1; g_free = g_free + M2_CELL_SIZE;
copy_news (new, old); copy_news (new, old);
if (NTYPE (new) == TSTRUCT || NTYPE (new) == TVECTOR) if (NTYPE (new) == TSTRUCT || NTYPE (new) == TVECTOR)
{ {
@ -387,7 +390,7 @@ gc_copy (SCM old) /*:((internal)) */
for (i = 0; i < LENGTH (old); i = i + 1) for (i = 0; i < LENGTH (old); i = i + 1)
{ {
copy_news (g_free, cell_ref (VECTOR (old), i)); copy_news (g_free, cell_ref (VECTOR (old), i));
g_free = g_free + 1; g_free = g_free + M2_CELL_SIZE;
} }
} }
else if (NTYPE (new) == TBYTES) else if (NTYPE (new) == TBYTES)
@ -400,7 +403,7 @@ gc_copy (SCM old) /*:((internal)) */
size_t length = NLENGTH (new); size_t length = NLENGTH (new);
#endif #endif
memcpy (dest, src, length + 1); memcpy (dest, src, length + 1);
g_free = g_free + bytes_cells (length) - 1; g_free = g_free + (bytes_cells (length) - 1) * M2_CELL_SIZE;
if (g_debug > 4) if (g_debug > 4)
{ {
@ -460,8 +463,8 @@ gc_loop (SCM scan) /*:((internal)) */
gc_relocate_cdr (scan, cdr); gc_relocate_cdr (scan, cdr);
} }
if (NTYPE (scan) == TBYTES) if (NTYPE (scan) == TBYTES)
scan = scan + bytes_cells (NLENGTH (scan)) - 1; scan = scan + (bytes_cells (NLENGTH (scan)) - 1) * M2_CELL_SIZE;
scan = scan + 1; scan = scan + M2_CELL_SIZE;
} }
gc_flip (); gc_flip ();
} }
@ -521,14 +524,14 @@ gc_ () /*:((internal)) */
} }
SCM s; SCM s;
for (s = cell_nil; s < g_symbol_max; s = s + 1) for (s = cell_nil; s < g_symbol_max; s = s + M2_CELL_SIZE)
gc_copy (s); gc_copy (s);
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);
long i; long i;
for (i = g_stack; i < STACK_SIZE; i = i + 1) for (i = g_stack; i < STACK_SIZE; i = i + M2_CELL_SIZE)
copy_stack (i, gc_copy (g_stack_array[i])); copy_stack (i, gc_copy (g_stack_array[i]));
#if POINTER_CELLS #if POINTER_CELLS
long save_gfree = g_free; long save_gfree = g_free;