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:
parent
65ac20a171
commit
6adc5f20bb
29
src/gc.c
29
src/gc.c
|
@ -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;
|
||||||
|
|
Loading…
Reference in New Issue