core: GC fixes. non...Pointer-based? WIP

* src/gc.c (gc_init): ...
This commit is contained in:
Jan Nieuwenhuizen 2019-10-28 17:00:15 +01:00
parent 55bf150d70
commit ca58bec16f
No known key found for this signature in database
GPG Key ID: F3C1A0D9C1D65273
2 changed files with 33 additions and 16 deletions

View File

@ -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"

View File

@ -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