core: gc: Fixes.
* src/gc.c (gc_init, gc_up_arena, gc_flip): Change to void function. Fixes 0 returns. (make_bytes): Use plain. (make_string): Add 1 to length, for zero-terminated C strings. (gc_copy): Use plain bytes length. (gc_loop): Manually reformat.
This commit is contained in:
parent
4613b070e4
commit
c6670b46c3
|
@ -81,7 +81,6 @@ SCM builtin_name (SCM builtin);
|
|||
SCM cstring_to_list (char const *s);
|
||||
SCM cstring_to_symbol (char const *s);
|
||||
SCM fdisplay_ (SCM, int, int);
|
||||
SCM gc_init ();
|
||||
SCM gc_peek_frame ();
|
||||
SCM gc_pop_frame ();
|
||||
SCM gc_push_frame ();
|
||||
|
@ -118,6 +117,8 @@ 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_ ();
|
||||
void gc_init ();
|
||||
|
||||
#include "mes/builtins.h"
|
||||
#include "mes/constants.h"
|
||||
|
|
66
src/gc.c
66
src/gc.c
|
@ -37,8 +37,8 @@ news_bytes (SCM x)
|
|||
return &NCDR (x);
|
||||
}
|
||||
|
||||
SCM
|
||||
gc_init () /*:((internal)) */
|
||||
void
|
||||
gc_init ()
|
||||
{
|
||||
#if SYSTEM_LIBC
|
||||
ARENA_SIZE = 100000000; /* 2.3GiB */
|
||||
|
@ -82,8 +82,6 @@ gc_init () /*:((internal)) */
|
|||
|
||||
/* FIXME: remove MES_MAX_STRING, grow dynamically */
|
||||
g_buf = malloc (MAX_STRING);
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
SCM
|
||||
|
@ -131,7 +129,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
|
||||
|
@ -150,7 +148,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;
|
||||
}
|
||||
|
@ -191,7 +189,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;
|
||||
}
|
||||
|
@ -208,8 +206,8 @@ make_string_port (SCM x) /*:((internal)) */
|
|||
return make_cell (TPORT, -length__ (g_ports) - 2, x);
|
||||
}
|
||||
|
||||
SCM
|
||||
gc_up_arena () /*:((internal)) */
|
||||
void
|
||||
gc_up_arena ()
|
||||
{
|
||||
long old_arena_bytes = (ARENA_SIZE + JAM_SIZE) * sizeof (struct scm);
|
||||
if (ARENA_SIZE >> 1 < MAX_ARENA_SIZE >> 2)
|
||||
|
@ -235,12 +233,10 @@ gc_up_arena () /*:((internal)) */
|
|||
g_cells = p;
|
||||
memcpy (p + arena_bytes, p + old_arena_bytes, STACK_SIZE * sizeof (SCM));
|
||||
g_cells = g_cells + 1;
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
void
|
||||
gc_flip () /*:((internal)) */
|
||||
gc_flip ()
|
||||
{
|
||||
if (g_debug > 2)
|
||||
{
|
||||
|
@ -276,7 +272,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)
|
||||
|
@ -321,24 +317,43 @@ 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");
|
||||
/* *INDENT-OFF* */
|
||||
if (t == TMACRO
|
||||
|| t == TPAIR
|
||||
|| t == TREF
|
||||
|| t == TVARIABLE)
|
||||
/* *INDENT-ON* */
|
||||
{
|
||||
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 */
|
||||
/* *INDENT-OFF* */
|
||||
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. */
|
||||
/* *INDENT-ON* */
|
||||
{
|
||||
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 ();
|
||||
}
|
||||
|
@ -351,8 +366,8 @@ gc_check ()
|
|||
return cell_unspecified;
|
||||
}
|
||||
|
||||
SCM
|
||||
gc_ () /*:((internal)) */
|
||||
void
|
||||
gc_ ()
|
||||
{
|
||||
gc_init_news ();
|
||||
if (g_debug == 2)
|
||||
|
@ -422,6 +437,7 @@ gc ()
|
|||
write_error_ (R0);
|
||||
eputs ("\n");
|
||||
}
|
||||
return cell_unspecified;
|
||||
}
|
||||
|
||||
SCM
|
||||
|
|
Loading…
Reference in a new issue