core: GC fixes. non...Pointer-based? WIP
* src/gc.c (gc_init): ...
This commit is contained in:
parent
55bf150d70
commit
ca58bec16f
|
@ -118,6 +118,7 @@ long length__ (SCM x);
|
|||
size_t bytes_cells (size_t length);
|
||||
void assert_max_string (size_t i, char const *msg, char *string);
|
||||
void assert_msg (int check, char *msg);
|
||||
void gc_ ();
|
||||
|
||||
#include "mes/builtins.h"
|
||||
#include "mes/constants.h"
|
||||
|
|
48
src/gc.c
48
src/gc.c
|
@ -144,7 +144,7 @@ cons (SCM x, SCM y)
|
|||
size_t
|
||||
bytes_cells (size_t length)
|
||||
{
|
||||
return (1 + sizeof (long) + sizeof (long) + length + sizeof (SCM)) / sizeof (SCM);
|
||||
return (sizeof (long) + sizeof (long) + length - 1 + sizeof (SCM)) / sizeof (SCM);
|
||||
}
|
||||
|
||||
SCM
|
||||
|
@ -163,7 +163,7 @@ make_bytes (char const *s, size_t length)
|
|||
if (length == 0)
|
||||
p[0] = 0;
|
||||
else
|
||||
memcpy (p, s, length + 1);
|
||||
memcpy (p, s, length);
|
||||
|
||||
return x;
|
||||
}
|
||||
|
@ -204,7 +204,7 @@ make_string (char const *s, size_t length)
|
|||
if (length > MAX_STRING)
|
||||
assert_max_string (length, "make_string", s);
|
||||
SCM x = make_cell (TSTRING, length, 0);
|
||||
SCM v = make_bytes (s, length);
|
||||
SCM v = make_bytes (s, length + 1);
|
||||
CDR (x) = v;
|
||||
return x;
|
||||
}
|
||||
|
@ -289,7 +289,7 @@ gc_copy (SCM old) /*:((internal)) */
|
|||
char const *src = cell_bytes (old);
|
||||
char *dest = news_bytes (new);
|
||||
size_t length = NLENGTH (new);
|
||||
memcpy (dest, src, length + 1);
|
||||
memcpy (dest, src, length);
|
||||
g_free = g_free + bytes_cells (length) - 1;
|
||||
|
||||
if (g_debug > 4)
|
||||
|
@ -334,24 +334,39 @@ gc_loop (SCM scan) /*:((internal)) */
|
|||
SCM cdr;
|
||||
while (scan < g_free)
|
||||
{
|
||||
if (NTYPE (scan) == TBROKEN_HEART)
|
||||
error (cell_symbol_system_error, cstring_to_symbol ("gc"));
|
||||
if (NTYPE (scan) == TMACRO || NTYPE (scan) == TPAIR || NTYPE (scan) == TREF || scan == 1 /* null */
|
||||
|| NTYPE (scan) == TVARIABLE)
|
||||
long t = NTYPE (scan);
|
||||
if (t == TBROKEN_HEART)
|
||||
assert_msg (0, "broken heart");
|
||||
if (t == TMACRO
|
||||
|| t == TPAIR
|
||||
|| t == TREF
|
||||
|| t == TVARIABLE)
|
||||
{
|
||||
car = gc_copy (NCAR (scan));
|
||||
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 */
|
||||
|| NTYPE (scan) == TVALUES)
|
||||
&& NCDR (scan)) /* allow for 0 terminated list of symbols */
|
||||
if ((t == TCLOSURE
|
||||
|| t == TCONTINUATION
|
||||
|| t == TKEYWORD
|
||||
|| t == TMACRO
|
||||
|| t == TPAIR
|
||||
|| t == TPORT
|
||||
|| t == TSPECIAL
|
||||
|| t == TSTRING
|
||||
/*|| t == TSTRUCT handled by gc_copy */
|
||||
|| t == TSYMBOL
|
||||
|| t == TVALUES
|
||||
/*|| t == TVECTOR handled by gc_copy */
|
||||
)
|
||||
&& NCDR (scan)) /* Allow for 0 terminated list of symbols. */
|
||||
{
|
||||
cdr = gc_copy (NCDR (scan));
|
||||
gc_relocate_cdr (scan, cdr);
|
||||
}
|
||||
if (NTYPE (scan) == TBYTES)
|
||||
scan = scan + bytes_cells (NLENGTH (scan)) - 1;
|
||||
scan = scan + 1;
|
||||
if (t == TBYTES)
|
||||
scan = scan + bytes_cells (NLENGTH (scan));
|
||||
else
|
||||
scan = scan + 1;
|
||||
}
|
||||
gc_flip ();
|
||||
}
|
||||
|
@ -364,8 +379,8 @@ gc_check ()
|
|||
return cell_unspecified;
|
||||
}
|
||||
|
||||
SCM
|
||||
gc_ () /*:((internal)) */
|
||||
void
|
||||
gc_ ()
|
||||
{
|
||||
gc_init_news ();
|
||||
if (g_debug == 2)
|
||||
|
@ -435,6 +450,7 @@ gc ()
|
|||
write_error_ (R0);
|
||||
eputs ("\n");
|
||||
}
|
||||
return cell_unspecified;
|
||||
}
|
||||
|
||||
SCM
|
||||
|
|
Loading…
Reference in New Issue