core: Prepare for pointer cells.
* include/mes/cc.h: Prepare for pointer-based cells. * include/mes/macros.h[POINTER_CELLS]: Alternative set of macros. * include/mes/mes.h (struct scm)[POINTER_CELLS]: Alternative definition. * src/gc.c (copy_cell, copy_news): New function. * include/mes/mes.h: Declare them.
This commit is contained in:
Jan (janneke) Nieuwenhuizen
parent
52c57da02f
commit
f9a372de13
|
|
@ -21,7 +21,11 @@
|
|||
#ifndef __MES_CC_H
|
||||
#define __MES_CC_H
|
||||
|
||||
#if POINTER_CELLS
|
||||
typedef struct scm* SCM;
|
||||
#else
|
||||
typedef long SCM;
|
||||
#endif
|
||||
|
||||
#if __MESC__
|
||||
typedef long FUNCTION;
|
||||
|
|
|
|||
|
|
@ -53,7 +53,15 @@ struct timeval
|
|||
*/
|
||||
|
||||
#define struct_size 12
|
||||
|
||||
#if POINTER_CELLS
|
||||
|
||||
#define CELL(x) (x)
|
||||
|
||||
#else
|
||||
|
||||
#define CELL(x) ((x*struct_size)+g_cells)
|
||||
|
||||
#define TYPE(x) ((x*struct_size)+g_cells)->type
|
||||
#define CAR(x) ((x*struct_size)+g_cells)->car
|
||||
#define CDR(x) ((x*struct_size)+g_cells)->cdr
|
||||
|
|
@ -95,4 +103,6 @@ struct timeval
|
|||
#define CADDR(x) CAR (CDR (CDR (x)))
|
||||
#define CDADAR(x) CAR (CDR (CAR (CDR (x))))
|
||||
|
||||
#endif
|
||||
|
||||
#endif /* __MES_M2_H */
|
||||
|
|
|
|||
|
|
@ -21,6 +21,43 @@
|
|||
#ifndef __MES_MACROS_H
|
||||
#define __MES_MACROS_H
|
||||
|
||||
#if POINTER_CELLS
|
||||
|
||||
#define TYPE(x) g_cells[x - g_cells].type
|
||||
#define CAR(x) g_cells[x - g_cells].car
|
||||
#define CDR(x) g_cells[x - g_cells].cdr
|
||||
|
||||
#define NTYPE(x) g_news[x - g_news].type
|
||||
#define NCAR(x) g_news[x - g_news].car
|
||||
#define NCDR(x) g_news[x - g_news].cdr
|
||||
|
||||
#define STYPE(x) TYPE (g_stack_array[x])
|
||||
#define SCAR(x) CAR (g_stack_array[x])
|
||||
#define SCDR(x) CDR (g_stack_arraynews[x])
|
||||
|
||||
#define BYTES(x) g_cells[x - g_cells].bytes
|
||||
#define LENGTH(x) g_cells[x - g_cells].length
|
||||
#define MACRO(x) g_cells[x - g_cells].macro
|
||||
#define PORT(x) g_cells[x - g_cells].port
|
||||
#define REF(x) g_cells[x - g_cells].ref
|
||||
#define VARIABLE(x) g_cells[x - g_cells].variable
|
||||
|
||||
#define CLOSURE(x) g_cells[x - g_cells].closure
|
||||
#define CONTINUATION(x) g_cells[x - g_cells].continuation
|
||||
|
||||
#define NAME(x) g_cells[x - g_cells].name
|
||||
#define STRING(x) g_cells[x - g_cells].string
|
||||
#define STRUCT(x) g_cells[x - g_cells].structure
|
||||
#define VALUE(x) g_cells[x - g_cells].value
|
||||
#define VECTOR(x) g_cells[x - g_cells].vector
|
||||
|
||||
#define NLENGTH(x) g_news[x - g_news].length
|
||||
#define NVALUE(x) g_news[x - g_news].value
|
||||
#define NSTRING(x) g_news[x - g_news].string
|
||||
#define NVECTOR(x) g_news[x - g_news].vector
|
||||
|
||||
#else
|
||||
|
||||
#define TYPE(x) g_cells[x].type
|
||||
#define CAR(x) g_cells[x].car
|
||||
#define CDR(x) g_cells[x].cdr
|
||||
|
|
@ -29,6 +66,10 @@
|
|||
#define NCAR(x) g_news[x].car
|
||||
#define NCDR(x) g_news[x].cdr
|
||||
|
||||
#define STYPE(x) TYPE (g_stack_array[x])
|
||||
#define SCAR(x) CAR (g_stack_array[x])
|
||||
#define SCDR(x) CDR (g_stack_array[x])
|
||||
|
||||
#define BYTES(x) g_cells[x].car
|
||||
#define LENGTH(x) g_cells[x].car
|
||||
#define REF(x) g_cells[x].car
|
||||
|
|
@ -50,6 +91,8 @@
|
|||
#define NSTRING(x) g_news[x].cdr
|
||||
#define NVECTOR(x) g_news[x].cdr
|
||||
|
||||
#endif
|
||||
|
||||
#define CAAR(x) CAR (CAR (x))
|
||||
#define CADR(x) CAR (CDR (x))
|
||||
#define CDAR(x) CDR (CAR (x))
|
||||
|
|
|
|||
|
|
@ -21,14 +21,35 @@
|
|||
#ifndef __MES_MES_H
|
||||
#define __MES_MES_H
|
||||
|
||||
#define POINTER_CELLS 0
|
||||
|
||||
#include <sys/types.h>
|
||||
#include "mes/cc.h"
|
||||
|
||||
struct scm
|
||||
{
|
||||
long type;
|
||||
SCM car;
|
||||
SCM cdr;
|
||||
union
|
||||
{
|
||||
SCM car;
|
||||
char *bytes;
|
||||
long length;
|
||||
SCM ref;
|
||||
SCM variable;
|
||||
SCM macro;
|
||||
long port;
|
||||
};
|
||||
union
|
||||
{
|
||||
SCM cdr;
|
||||
SCM closure;
|
||||
SCM continuation;
|
||||
char *name;
|
||||
SCM string;
|
||||
SCM structure;
|
||||
long value;
|
||||
SCM vector;
|
||||
};
|
||||
};
|
||||
|
||||
/* mes */
|
||||
|
|
@ -61,8 +82,16 @@ long JAM_SIZE;
|
|||
long GC_SAFETY;
|
||||
long MAX_STRING;
|
||||
char *g_arena;
|
||||
SCM cell_arena;
|
||||
|
||||
#if POINTER_CELLS
|
||||
SCM g_free;
|
||||
long g_stack;
|
||||
#else
|
||||
long g_free;
|
||||
SCM g_stack;
|
||||
#endif
|
||||
|
||||
SCM *g_stack_array;
|
||||
struct scm *g_cells;
|
||||
struct scm *g_news;
|
||||
|
|
@ -80,6 +109,7 @@ SCM apply_builtin (SCM fn, SCM x);
|
|||
SCM builtin_name (SCM builtin);
|
||||
SCM cstring_to_list (char const *s);
|
||||
SCM cstring_to_symbol (char const *s);
|
||||
SCM cell_ref (SCM cell, long index);
|
||||
SCM fdisplay_ (SCM, int, int);
|
||||
SCM init_symbols ();
|
||||
SCM init_time (SCM a);
|
||||
|
|
@ -114,11 +144,14 @@ 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 copy_cell (SCM to, SCM from);
|
||||
void gc_ ();
|
||||
void gc_init ();
|
||||
void gc_peek_frame ();
|
||||
void gc_pop_frame ();
|
||||
void gc_push_frame ();
|
||||
void gc_stats_ (char const* where);
|
||||
void init_symbols_ ();
|
||||
|
||||
#include "mes/builtins.h"
|
||||
#include "mes/constants.h"
|
||||
|
|
|
|||
|
|
@ -143,4 +143,11 @@ SCM cell_symbol_test;
|
|||
// CONSTANT SYMBOL_MAX 119
|
||||
#define SYMBOL_MAX 119
|
||||
|
||||
// CONSTANT CELL_UNSPECIFIED 7
|
||||
#define CELL_UNSPECIFIED 7
|
||||
|
||||
// CONSTANT CELL_SYMBOL_RECORD_TYPE 88
|
||||
#define CELL_SYMBOL_RECORD_TYPE 88
|
||||
|
||||
|
||||
#endif /* __MES_SYMBOLS_H */
|
||||
|
|
|
|||
|
|
@ -352,7 +352,7 @@ eval_apply ()
|
|||
int global_p;
|
||||
int macro_p;
|
||||
int t;
|
||||
long c;
|
||||
SCM c;
|
||||
|
||||
eval_apply:
|
||||
if (R3 == cell_vm_evlis2)
|
||||
|
|
|
|||
215
src/gc.c
215
src/gc.c
|
|
@ -25,10 +25,25 @@
|
|||
#include <string.h>
|
||||
#include <stdlib.h>
|
||||
|
||||
#if __M2_PLANET__
|
||||
#define M2_CELL_SIZE 12
|
||||
// CONSTANT M2_CELL_SIZE 12
|
||||
#else
|
||||
#define M2_CELL_SIZE 1
|
||||
// CONSTANT M2_CELL_SIZE 12
|
||||
#endif
|
||||
|
||||
char *
|
||||
cell_bytes (SCM x)
|
||||
{
|
||||
#if POINTER_CELLS
|
||||
char *p = x;
|
||||
return p + (2 * sizeof (long));
|
||||
#elif __M2_PLANET__
|
||||
CELL (x) + 8;
|
||||
#else
|
||||
return &CDR (x);
|
||||
#endif
|
||||
}
|
||||
|
||||
char *
|
||||
|
|
@ -48,7 +63,11 @@ gc_init ()
|
|||
MAX_ARENA_SIZE = 100000000;
|
||||
STACK_SIZE = 20000;
|
||||
|
||||
#if POINTER_CELLS
|
||||
JAM_SIZE = 1000;
|
||||
#else
|
||||
JAM_SIZE = 20000;
|
||||
#endif
|
||||
GC_SAFETY = 2000;
|
||||
MAX_STRING = 524288;
|
||||
|
||||
|
|
@ -69,32 +88,60 @@ gc_init ()
|
|||
MAX_STRING = atoi (p);
|
||||
|
||||
long arena_bytes = (ARENA_SIZE + JAM_SIZE) * sizeof (struct scm);
|
||||
#if POINTER_CELLS
|
||||
void *a = malloc (arena_bytes + STACK_SIZE * sizeof (SCM) * 2);
|
||||
#else
|
||||
void *a = malloc (arena_bytes + STACK_SIZE * sizeof (SCM));
|
||||
#endif
|
||||
g_cells = a;
|
||||
g_stack_array = a + arena_bytes;
|
||||
|
||||
TYPE (0) = TVECTOR;
|
||||
LENGTH (0) = 1000;
|
||||
VECTOR (0) = 0;
|
||||
#if POINTER_CELLS
|
||||
/* The vector that holds the arenea. */
|
||||
cell_arena = g_cells;
|
||||
#else
|
||||
/* The vector that holds the arenea. */
|
||||
cell_arena = 0;
|
||||
#endif
|
||||
TYPE (cell_arena) = TVECTOR;
|
||||
LENGTH (cell_arena) = 1000;
|
||||
VECTOR (cell_arena) = 0;
|
||||
g_cells = g_cells + 1;
|
||||
TYPE (0) = TCHAR;
|
||||
VALUE (0) = 'c';
|
||||
TYPE (cell_arena) = TCHAR;
|
||||
VALUE (cell_arena) = 'c';
|
||||
|
||||
#if !POINTER_CELLS
|
||||
g_free = 1;
|
||||
#else
|
||||
g_free = g_cells + M2_CELL_SIZE;
|
||||
#endif
|
||||
|
||||
/* FIXME: remove MES_MAX_STRING, grow dynamically */
|
||||
g_buf = malloc (MAX_STRING);
|
||||
}
|
||||
|
||||
SCM
|
||||
gc_init_news () /*:((internal)) */
|
||||
long
|
||||
gc_free ()
|
||||
{
|
||||
g_news = g_cells + g_free;
|
||||
NTYPE (0) = TVECTOR;
|
||||
NLENGTH (0) = 1000;
|
||||
NVECTOR (0) = 0;
|
||||
g_news = g_news + 1;
|
||||
NTYPE (0) = TCHAR;
|
||||
NVALUE (0) = 'n';
|
||||
return 0;
|
||||
#if POINTER_CELLS
|
||||
return g_free - g_cells;
|
||||
#else
|
||||
return g_free;
|
||||
#endif
|
||||
}
|
||||
|
||||
void
|
||||
gc_stats_ (char const* where)
|
||||
{
|
||||
#if POINTER_CELLS
|
||||
long i = g_free - g_cells;
|
||||
#else
|
||||
long i = g_free;
|
||||
#endif
|
||||
eputs (where);
|
||||
eputs (": [");
|
||||
eputs (ntoab (i, 10, 0));
|
||||
eputs ("]\n");
|
||||
}
|
||||
|
||||
SCM
|
||||
|
|
@ -102,7 +149,12 @@ alloc (long n)
|
|||
{
|
||||
SCM x = g_free;
|
||||
g_free = g_free + n;
|
||||
if (g_free > ARENA_SIZE)
|
||||
#if POINTER_CELLS
|
||||
long i = g_free - g_cells;
|
||||
#else
|
||||
long i = g_free;
|
||||
#endif
|
||||
if (i > ARENA_SIZE)
|
||||
assert_msg (0, "alloc: out of memory");
|
||||
return x;
|
||||
}
|
||||
|
|
@ -112,7 +164,12 @@ make_cell (long type, SCM car, SCM cdr)
|
|||
{
|
||||
SCM x = g_free;
|
||||
g_free = g_free + 1;
|
||||
if (g_free > ARENA_SIZE)
|
||||
#if POINTER_CELLS
|
||||
long i = g_free - g_cells;
|
||||
#else
|
||||
long i = g_free;
|
||||
#endif
|
||||
if (i > ARENA_SIZE)
|
||||
assert_msg (0, "alloc: out of memory");
|
||||
TYPE (x) = type;
|
||||
CAR (x) = car;
|
||||
|
|
@ -120,6 +177,34 @@ make_cell (long type, SCM car, SCM cdr)
|
|||
return x;
|
||||
}
|
||||
|
||||
void
|
||||
copy_cell (SCM to, SCM from)
|
||||
{
|
||||
TYPE (to) = TYPE (from);
|
||||
CAR (to) = CAR (from);
|
||||
CDR (to) = CDR (from);
|
||||
}
|
||||
|
||||
void
|
||||
copy_news (SCM to, SCM from)
|
||||
{
|
||||
NTYPE (to) = TYPE (from);
|
||||
NCAR (to) = CAR (from);
|
||||
NCDR (to) = CDR (from);
|
||||
}
|
||||
|
||||
void
|
||||
copy_stack (long index, SCM from)
|
||||
{
|
||||
g_stack_array[index] = from;
|
||||
}
|
||||
|
||||
SCM
|
||||
cell_ref (SCM cell, long index)
|
||||
{
|
||||
return cell + index;
|
||||
}
|
||||
|
||||
SCM
|
||||
cons (SCM x, SCM y)
|
||||
{
|
||||
|
|
@ -139,12 +224,7 @@ make_bytes (char const *s, size_t length)
|
|||
SCM x = alloc (size);
|
||||
TYPE (x) = TBYTES;
|
||||
LENGTH (x) = length;
|
||||
#if __M2_PLANET__
|
||||
char *p = &g_cells[x];
|
||||
p = p + 2 * sizeof (SCM);
|
||||
#else
|
||||
char *p = &CDR (x);
|
||||
#endif
|
||||
char *p = cell_bytes (x);
|
||||
if (length == 0)
|
||||
p[0] = 0;
|
||||
else
|
||||
|
|
@ -206,6 +286,22 @@ make_string_port (SCM x) /*:((internal)) */
|
|||
return make_cell (TPORT, -length__ (g_ports) - 2, x);
|
||||
}
|
||||
|
||||
void
|
||||
gc_init_news ()
|
||||
{
|
||||
#if POINTER_CELLS
|
||||
g_news = g_free;
|
||||
#else
|
||||
g_news = g_cells + g_free;
|
||||
NTYPE (cell_arena) = TVECTOR;
|
||||
NLENGTH (cell_arena) = 1000;
|
||||
NVECTOR (cell_arena) = 0;
|
||||
g_news = g_news + 1;
|
||||
NTYPE (cell_arena) = TCHAR;
|
||||
NVALUE (cell_arena) = 'n';
|
||||
#endif
|
||||
}
|
||||
|
||||
void
|
||||
gc_up_arena ()
|
||||
{
|
||||
|
|
@ -225,7 +321,12 @@ gc_up_arena ()
|
|||
eputs ("realloc failed, g_free=");
|
||||
eputs (itoa (g_free));
|
||||
eputs (":");
|
||||
eputs (itoa (ARENA_SIZE - g_free));
|
||||
#if POINTER_CELLS
|
||||
long i = g_free - g_cells;
|
||||
#else
|
||||
long i = g_free;
|
||||
#endif
|
||||
eputs (itoa (ARENA_SIZE - i));
|
||||
eputs ("\n");
|
||||
assert_msg (0, "0");
|
||||
exit (1);
|
||||
|
|
@ -238,15 +339,20 @@ gc_up_arena ()
|
|||
void
|
||||
gc_flip ()
|
||||
{
|
||||
#if POINTER_CELLS
|
||||
//with pointers, nevva gonna wok
|
||||
//memcpy (g_cells - 1, g_news - 1, (g_free - g_cells + 2) * sizeof (struct scm));
|
||||
g_cells = g_news;
|
||||
#endif
|
||||
if (g_debug > 2)
|
||||
{
|
||||
eputs (";;; => jam[");
|
||||
eputs (itoa (g_free));
|
||||
eputs ("]\n");
|
||||
}
|
||||
gc_stats_ (";;; => jam");
|
||||
#if POINTER_CELLS
|
||||
// nothing
|
||||
#else
|
||||
if (g_free > JAM_SIZE)
|
||||
JAM_SIZE = g_free + g_free / 2;
|
||||
memcpy (g_cells - 1, g_news - 1, (g_free + 2) * sizeof (struct scm));
|
||||
#endif
|
||||
}
|
||||
|
||||
SCM
|
||||
|
|
@ -256,14 +362,14 @@ gc_copy (SCM old) /*:((internal)) */
|
|||
return CAR (old);
|
||||
SCM new = g_free;
|
||||
g_free = g_free + 1;
|
||||
g_news[new] = g_cells[old];
|
||||
copy_news (new, old);
|
||||
if (NTYPE (new) == TSTRUCT || NTYPE (new) == TVECTOR)
|
||||
{
|
||||
NVECTOR (new) = g_free;
|
||||
long i;
|
||||
for (i = 0; i < LENGTH (old); i = i + 1)
|
||||
{
|
||||
g_news[g_free] = g_cells[VECTOR (old) + i];
|
||||
copy_news (g_free, cell_ref (VECTOR (old), i));
|
||||
g_free = g_free + 1;
|
||||
}
|
||||
}
|
||||
|
|
@ -271,7 +377,7 @@ gc_copy (SCM old) /*:((internal)) */
|
|||
{
|
||||
char const *src = cell_bytes (old);
|
||||
char *dest = news_bytes (new);
|
||||
size_t length = NLENGTH (new);
|
||||
size_t length = NLENGTH (old);
|
||||
memcpy (dest, src, length);
|
||||
g_free = g_free + bytes_cells (length) - 1;
|
||||
|
||||
|
|
@ -311,7 +417,7 @@ gc_relocate_cdr (SCM new, SCM cdr) /*:((internal)) */
|
|||
}
|
||||
|
||||
void
|
||||
gc_loop (SCM scan) /*:((internal)) */
|
||||
gc_loop (SCM scan)
|
||||
{
|
||||
SCM car;
|
||||
SCM cdr;
|
||||
|
|
@ -351,9 +457,9 @@ gc_loop (SCM scan) /*:((internal)) */
|
|||
gc_relocate_cdr (scan, cdr);
|
||||
}
|
||||
if (t == TBYTES)
|
||||
scan = scan + bytes_cells (NLENGTH (scan));
|
||||
scan = scan + (bytes_cells (NLENGTH (scan)) * M2_CELL_SIZE);
|
||||
else
|
||||
scan = scan + 1;
|
||||
scan = scan + M2_CELL_SIZE;
|
||||
}
|
||||
gc_flip ();
|
||||
}
|
||||
|
|
@ -361,7 +467,11 @@ gc_loop (SCM scan) /*:((internal)) */
|
|||
SCM
|
||||
gc_check ()
|
||||
{
|
||||
#if POINTER_CELLS
|
||||
if ((g_free - g_cells) + GC_SAFETY > ARENA_SIZE)
|
||||
#else
|
||||
if (g_free + GC_SAFETY > ARENA_SIZE)
|
||||
#endif
|
||||
gc ();
|
||||
return cell_unspecified;
|
||||
}
|
||||
|
|
@ -374,13 +484,20 @@ gc_ ()
|
|||
eputs (".");
|
||||
if (g_debug > 2)
|
||||
{
|
||||
eputs (";;; gc[");
|
||||
eputs (itoa (g_free));
|
||||
eputs (":");
|
||||
gc_stats_ (";;; gc");
|
||||
eputs (";;; free: [");
|
||||
#if POINTER_CELLS
|
||||
eputs (itoa (ARENA_SIZE - (g_free - g_cells)));
|
||||
#else
|
||||
eputs (itoa (ARENA_SIZE - g_free));
|
||||
#endif
|
||||
eputs ("]...");
|
||||
}
|
||||
#if POINTER_CELLS
|
||||
g_free = g_news;
|
||||
#else
|
||||
g_free = 1;
|
||||
#endif
|
||||
|
||||
if (ARENA_SIZE < MAX_ARENA_SIZE && g_news > 0)
|
||||
{
|
||||
|
|
@ -401,16 +518,28 @@ gc_ ()
|
|||
gc_up_arena ();
|
||||
}
|
||||
|
||||
long i;
|
||||
for (i = g_free; i < g_symbol_max; i = i + 1)
|
||||
gc_copy (i);
|
||||
SCM s;
|
||||
for (s = cell_nil; s < g_symbol_max; s = s + 1)
|
||||
gc_copy (s);
|
||||
g_symbols = gc_copy (g_symbols);
|
||||
g_macros = gc_copy (g_macros);
|
||||
g_ports = gc_copy (g_ports);
|
||||
M0 = gc_copy (M0);
|
||||
long i;
|
||||
for (i = g_stack; i < STACK_SIZE; i = i + 1)
|
||||
g_stack_array[i] = gc_copy (g_stack_array[i]);
|
||||
gc_loop (1);
|
||||
copy_stack (i, gc_copy (g_stack_array[i]));
|
||||
#if POINTER_CELLS
|
||||
long save_gfree = g_free;
|
||||
long save_gsymbols =g_symbols;
|
||||
g_symbols = 0;
|
||||
///g_free = g_news + 1;
|
||||
cell_nil = g_news; // hmm?
|
||||
init_symbols_ ();
|
||||
g_symbol_max = g_symbol;
|
||||
g_free = save_gfree;
|
||||
g_symbols = save_gsymbols;
|
||||
#endif
|
||||
gc_loop (cell_nil);
|
||||
}
|
||||
|
||||
SCM
|
||||
|
|
|
|||
|
|
@ -29,7 +29,7 @@ hash_cstring (char const *s, long size)
|
|||
int hash = s[0] * 37;
|
||||
if (s[0] != 0 && s[1] != 0)
|
||||
hash = hash + s[1] * 43;
|
||||
assert_msg (size, "size");
|
||||
assert_msg (size != 0, "size");
|
||||
hash = hash % size;
|
||||
return hash;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -131,7 +131,7 @@ memq (SCM x, SCM a)
|
|||
int t = TYPE (x);
|
||||
if (t == TCHAR || t == TNUMBER)
|
||||
{
|
||||
SCM v = VALUE (x);
|
||||
long v = VALUE (x);
|
||||
while (a != cell_nil && v != VALUE (CAR (a)))
|
||||
a = CDR (a);
|
||||
}
|
||||
|
|
|
|||
24
src/mes.c
24
src/mes.c
|
|
@ -224,7 +224,7 @@ assq (SCM x, SCM a)
|
|||
a = CDR (a);
|
||||
else if (t == TCHAR || t == TNUMBER)
|
||||
{
|
||||
SCM v = VALUE (x);
|
||||
long v = VALUE (x);
|
||||
while (a != cell_nil && v != VALUE (CAAR (a)))
|
||||
a = CDR (a);
|
||||
}
|
||||
|
|
@ -399,7 +399,6 @@ init (char **envp)
|
|||
g_debug = atoi (p);
|
||||
open_boot ();
|
||||
gc_init ();
|
||||
g_ports = 1;
|
||||
}
|
||||
|
||||
int
|
||||
|
|
@ -420,11 +419,7 @@ main (int argc, char **argv, char **envp)
|
|||
push_cc (R2, cell_unspecified, R0, cell_unspecified);
|
||||
|
||||
if (g_debug > 2)
|
||||
{
|
||||
eputs ("\ngc stats: [");
|
||||
eputs (itoa (g_free));
|
||||
eputs ("]\n");
|
||||
}
|
||||
gc_stats_ ("\n gc boot");
|
||||
if (g_debug > 3)
|
||||
{
|
||||
eputs ("program: ");
|
||||
|
|
@ -443,25 +438,22 @@ main (int argc, char **argv, char **envp)
|
|||
if (g_debug > 5)
|
||||
module_printer (M0);
|
||||
|
||||
eputs ("\ngc stats: [");
|
||||
eputs (itoa (g_free));
|
||||
if (g_debug < 3)
|
||||
gc_stats_ ("\ngc run");
|
||||
MAX_ARENA_SIZE = 0;
|
||||
|
||||
gc (g_stack);
|
||||
eputs (" => ");
|
||||
eputs (itoa (g_free));
|
||||
eputs ("]\n");
|
||||
eputs ("\n");
|
||||
if (g_debug < 3)
|
||||
gc_stats_ (" => ");
|
||||
|
||||
if (g_debug > 5)
|
||||
{
|
||||
eputs ("ports:");
|
||||
eputs ("\nports:");
|
||||
write_error_ (g_ports);
|
||||
eputs ("\n");
|
||||
}
|
||||
eputs ("\n");
|
||||
|
||||
|
||||
}
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
|
|
|||
19
src/struct.c
19
src/struct.c
|
|
@ -27,14 +27,8 @@ make_struct (SCM type, SCM fields, SCM printer)
|
|||
long size = 2 + length__ (fields);
|
||||
SCM v = alloc (size);
|
||||
SCM x = make_cell (TSTRUCT, size, v);
|
||||
SCM vt = vector_entry (type);
|
||||
TYPE (v) = TYPE (vt);
|
||||
CAR (v) = CAR (vt);
|
||||
CDR (v) = CDR (vt);
|
||||
SCM vp = vector_entry (printer);
|
||||
TYPE (v + 1) = TYPE (vp);
|
||||
CAR (v + 1) = CAR (vp);
|
||||
CDR (v + 1) = CDR (vp);
|
||||
copy_cell (v, vector_entry (type));
|
||||
copy_cell (cell_ref (v, 1), vector_entry (printer));
|
||||
long i;
|
||||
for (i = 2; i < size; i = i + 1)
|
||||
{
|
||||
|
|
@ -44,10 +38,7 @@ make_struct (SCM type, SCM fields, SCM printer)
|
|||
e = CAR (fields);
|
||||
fields = CDR (fields);
|
||||
}
|
||||
SCM ve = vector_entry (e);
|
||||
TYPE (v + i) = TYPE (ve);
|
||||
CAR (v + i) = CAR (ve);
|
||||
CDR (v + i) = CDR (ve);
|
||||
copy_cell (cell_ref (v, i), vector_entry (e));
|
||||
}
|
||||
return x;
|
||||
}
|
||||
|
|
@ -64,7 +55,7 @@ struct_ref_ (SCM x, long i)
|
|||
{
|
||||
assert_msg (TYPE (x) == TSTRUCT, "TYPE (x) == TSTRUCT");
|
||||
assert_msg (i < LENGTH (x), "i < LENGTH (x)");
|
||||
SCM e = STRUCT (x) + i;
|
||||
SCM e = cell_ref (STRUCT (x), i);
|
||||
if (TYPE (e) == TREF)
|
||||
e = REF (e);
|
||||
if (TYPE (e) == TCHAR)
|
||||
|
|
@ -79,7 +70,7 @@ struct_set_x_ (SCM x, long i, SCM e)
|
|||
{
|
||||
assert_msg (TYPE (x) == TSTRUCT, "TYPE (x) == TSTRUCT");
|
||||
assert_msg (i < LENGTH (x), "i < LENGTH (x)");
|
||||
g_cells[STRUCT (x) + i] = g_cells[vector_entry (e)];
|
||||
copy_cell (cell_ref (STRUCT (x), i), vector_entry (e));
|
||||
return cell_unspecified;
|
||||
}
|
||||
|
||||
|
|
|
|||
70
src/symbol.c
70
src/symbol.c
|
|
@ -23,32 +23,42 @@
|
|||
|
||||
#include <string.h>
|
||||
|
||||
#if __M2_PLANET__
|
||||
#define M2_CELL_SIZE 12
|
||||
// CONSTANT M2_CELL_SIZE 12
|
||||
#else
|
||||
#define M2_CELL_SIZE 1
|
||||
// CONSTANT M2_CELL_SIZE 12
|
||||
#endif
|
||||
|
||||
#if POINTER_CELLS
|
||||
SCM g_symbol;
|
||||
#else
|
||||
long g_symbol;
|
||||
#endif
|
||||
|
||||
SCM
|
||||
init_symbol (SCM x, long type, char const *name)
|
||||
{
|
||||
TYPE (x) = type;
|
||||
int length = strlen (name);
|
||||
SCM string = make_string (name, length);
|
||||
CAR (x) = length;
|
||||
CDR (x) = STRING (string);
|
||||
hash_set_x (g_symbols, string, x);
|
||||
g_symbol = g_symbol + 1;
|
||||
if (!g_symbols)
|
||||
g_free = g_free + M2_CELL_SIZE;
|
||||
else
|
||||
{
|
||||
int length = strlen (name);
|
||||
SCM string = make_string (name, length);
|
||||
CAR (x) = length;
|
||||
CDR (x) = STRING (string);
|
||||
hash_set_x (g_symbols, string, x);
|
||||
}
|
||||
g_symbol = g_symbol + M2_CELL_SIZE;
|
||||
return x;
|
||||
}
|
||||
|
||||
SCM
|
||||
init_symbols () /*:((internal)) */
|
||||
void
|
||||
init_symbols_ () /*:((internal)) */
|
||||
{
|
||||
g_free = SYMBOL_MAX + 1;
|
||||
g_symbol_max = g_free;
|
||||
g_symbols = make_hash_table_ (500);
|
||||
|
||||
int size = VALUE (struct_ref_ (g_symbols, 3));
|
||||
|
||||
g_symbol = 1;
|
||||
cell_nil = 1;
|
||||
g_symbol = cell_nil;
|
||||
cell_nil = init_symbol (g_symbol, TSPECIAL, "()");
|
||||
cell_f = init_symbol (g_symbol, TSPECIAL, "#f");
|
||||
cell_t = init_symbol (g_symbol, TSPECIAL, "#t");
|
||||
|
|
@ -167,8 +177,34 @@ init_symbols () /*:((internal)) */
|
|||
cell_type_vector = init_symbol (g_symbol, TSYMBOL, "<cell:vector>");
|
||||
cell_type_broken_heart = init_symbol (g_symbol, TSYMBOL, "<cell:broken-heart>");
|
||||
cell_symbol_test = init_symbol (g_symbol, TSYMBOL, "%%test");
|
||||
}
|
||||
|
||||
assert_msg (g_symbol == SYMBOL_MAX, "i == SYMBOL_MAX");
|
||||
SCM
|
||||
init_symbols () /*:((internal)) */
|
||||
{
|
||||
#if POINTER_CELLS
|
||||
g_free = g_cells + M2_CELL_SIZE;
|
||||
#else
|
||||
g_free = 1;
|
||||
#endif
|
||||
|
||||
g_symbols = 0;
|
||||
cell_nil = g_free;
|
||||
init_symbols_ ();
|
||||
|
||||
#if POINTER_CELLS
|
||||
assert_msg ("UNSPEC", cell_unspecified - g_cells == CELL_UNSPECIFIED);
|
||||
assert_msg ("RECORD-TYPE", cell_symbol_record_type - g_cells == CELL_SYMBOL_RECORD_TYPE);
|
||||
g_symbol_max = g_symbol;
|
||||
#else
|
||||
assert_msg ("UNSPEC", cell_unspecified == CELL_UNSPECIFIED);
|
||||
assert_msg ("RECORD-TYPE", cell_symbol_record_type == CELL_SYMBOL_RECORD_TYPE);
|
||||
g_symbol_max = g_symbol;
|
||||
#endif
|
||||
|
||||
g_symbols = make_hash_table_ (500);
|
||||
init_symbols_ ();
|
||||
g_ports = cell_nil;
|
||||
|
||||
SCM a = cell_nil;
|
||||
a = acons (cell_symbol_call_with_values, cell_symbol_call_with_values, a);
|
||||
|
|
|
|||
12
src/vector.c
12
src/vector.c
|
|
@ -28,7 +28,8 @@ make_vector__ (long k)
|
|||
SCM x = make_cell (TVECTOR, k, v);
|
||||
long i;
|
||||
for (i = 0; i < k; i = i + 1)
|
||||
g_cells[v + i] = g_cells[vector_entry (cell_unspecified)];
|
||||
copy_cell (cell_ref (v, i), vector_entry (cell_unspecified));
|
||||
|
||||
return x;
|
||||
}
|
||||
|
||||
|
|
@ -50,7 +51,7 @@ vector_ref_ (SCM x, long i)
|
|||
{
|
||||
assert_msg (TYPE (x) == TVECTOR, "TYPE (x) == TVECTOR");
|
||||
assert_msg (i < LENGTH (x), "i < LENGTH (x)");
|
||||
SCM e = VECTOR (x) + i;
|
||||
SCM e = cell_ref (VECTOR (x), i);
|
||||
if (TYPE (e) == TREF)
|
||||
e = REF (e);
|
||||
if (TYPE (e) == TCHAR)
|
||||
|
|
@ -79,7 +80,7 @@ vector_set_x_ (SCM x, long i, SCM e)
|
|||
{
|
||||
assert_msg (TYPE (x) == TVECTOR, "TYPE (x) == TVECTOR");
|
||||
assert_msg (i < LENGTH (x), "i < LENGTH (x)");
|
||||
g_cells[VECTOR (x) + i] = g_cells[vector_entry (e)];
|
||||
copy_cell (cell_ref (VECTOR (x), i), vector_entry (e));
|
||||
return cell_unspecified;
|
||||
}
|
||||
|
||||
|
|
@ -92,12 +93,11 @@ vector_set_x (SCM x, SCM i, SCM e)
|
|||
SCM
|
||||
list_to_vector (SCM x)
|
||||
{
|
||||
|
||||
SCM v = make_vector__ (length__ (x));
|
||||
SCM p = VECTOR (v);
|
||||
while (x != cell_nil)
|
||||
{
|
||||
g_cells[p] = g_cells[vector_entry (car (x))];
|
||||
copy_cell (p, vector_entry (car (x)));
|
||||
p = p + 1;
|
||||
x = cdr (x);
|
||||
}
|
||||
|
|
@ -111,7 +111,7 @@ vector_to_list (SCM v)
|
|||
long i;
|
||||
for (i = LENGTH (v); i; i = i - 1)
|
||||
{
|
||||
SCM e = VECTOR (v) + i - 1;
|
||||
SCM e = cell_ref (VECTOR (v), i - 1);
|
||||
if (TYPE (e) == TREF)
|
||||
e = REF (e);
|
||||
x = cons (e, x);
|
||||
|
|
|
|||
Loading…
Reference in New Issue