From d851bb15bb5461f5985167ca35e8644c6ea0e078 Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Tue, 22 Oct 2019 15:57:49 +0200 Subject: [PATCH] core: Prepare for pointer-based 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. --- include/mes/cc.h | 4 + include/mes/m2.h | 10 ++ include/mes/macros.h | 43 ++++++++ include/mes/mes.h | 41 +++++++ include/mes/symbols.h | 7 ++ src/eval-apply.c | 2 +- src/gc.c | 243 +++++++++++++++++++++++++++++++++--------- src/hash.c | 2 +- src/lib.c | 2 +- src/mes.c | 25 ++--- src/struct.c | 19 +--- src/symbol.c | 70 +++++++++--- src/vector.c | 12 +-- 13 files changed, 373 insertions(+), 107 deletions(-) diff --git a/include/mes/cc.h b/include/mes/cc.h index 19949c7c..1fe513a6 100644 --- a/include/mes/cc.h +++ b/include/mes/cc.h @@ -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; diff --git a/include/mes/m2.h b/include/mes/m2.h index e645c8e9..23bb91a4 100644 --- a/include/mes/m2.h +++ b/include/mes/m2.h @@ -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 */ diff --git a/include/mes/macros.h b/include/mes/macros.h index 94b63f7f..304b0d45 100644 --- a/include/mes/macros.h +++ b/include/mes/macros.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)) diff --git a/include/mes/mes.h b/include/mes/mes.h index a6b555e7..371483c0 100644 --- a/include/mes/mes.h +++ b/include/mes/mes.h @@ -21,15 +21,45 @@ #ifndef __MES_MES_H #define __MES_MES_H +#define POINTER_CELLS 0 + #include #include "mes/cc.h" +#if POINTER_CELLS +struct scm +{ + long type; + 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; + }; +}; +#else struct scm { long type; SCM car; SCM cdr; }; +#endif /* mes */ char *g_datadir; @@ -61,8 +91,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 +118,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 gc_init (); SCM gc_peek_frame (); @@ -118,6 +157,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 copy_cell (SCM to, SCM from); +void gc_stats_ (char const* where); #include "mes/builtins.h" #include "mes/constants.h" diff --git a/include/mes/symbols.h b/include/mes/symbols.h index c0c59b50..4df57801 100644 --- a/include/mes/symbols.h +++ b/include/mes/symbols.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 */ diff --git a/src/eval-apply.c b/src/eval-apply.c index 655fe4e8..5f137e4e 100644 --- a/src/eval-apply.c +++ b/src/eval-apply.c @@ -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) diff --git a/src/gc.c b/src/gc.c index a3b964f0..80bdc881 100644 --- a/src/gc.c +++ b/src/gc.c @@ -25,23 +25,53 @@ #include #include -long ARENA_SIZE; -long MAX_ARENA_SIZE; -long STACK_SIZE; -long JAM_SIZE; -long GC_SAFETY; -long MAX_STRING; -char *g_arena; -long g_free; +// long ARENA_SIZE; +// long MAX_ARENA_SIZE; +// long STACK_SIZE; +// long JAM_SIZE; +// long GC_SAFETY; +// long MAX_STRING; +// char *g_arena; +// long g_free; + +void init_symbols_ (); + +#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 +long g_stack; +#else SCM g_stack; +#endif + +#if POINTER_CELLS +SCM g_symbol; +#else +long g_symbol; +#endif + SCM *g_stack_array; + struct scm *g_cells; struct scm *g_news; 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 * @@ -61,7 +91,11 @@ gc_init () /*:((internal)) */ MAX_ARENA_SIZE = 100000000; STACK_SIZE = 20000; +#if POINTER_CELLS + JAM_SIZE = 1000; +#else JAM_SIZE = 20000; +#endif GC_SAFETY = 2000; MAX_STRING = 524288; @@ -82,16 +116,27 @@ gc_init () /*:((internal)) */ 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'; // FIXME: remove MES_MAX_STRING, grow dynamically g_buf = malloc (MAX_STRING); @@ -99,17 +144,28 @@ gc_init () /*:((internal)) */ return 0; } -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 (itoa (i)); + eputs ("]\n"); } SCM @@ -117,7 +173,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; } @@ -127,7 +188,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; @@ -135,6 +201,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) { @@ -154,12 +248,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 @@ -221,6 +310,23 @@ make_string_port (SCM x) /*:((internal)) */ return make_cell (TPORT, -length__ (g_ports) - 2, x); } +SCM +gc_init_news () /*:((internal)) */ +{ +#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 + return 0; +} + SCM gc_up_arena () /*:((internal)) */ { @@ -240,7 +346,12 @@ gc_up_arena () /*:((internal)) */ 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); @@ -253,17 +364,22 @@ gc_up_arena () /*:((internal)) */ } void -gc_flip () /*:((internal)) */ +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 @@ -273,14 +389,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; } } @@ -288,7 +404,11 @@ gc_copy (SCM old) /*:((internal)) */ { char const *src = cell_bytes (old); char *dest = news_bytes (new); +#if POINTER_CELLS + size_t length = LENGTH (old); +#else size_t length = NLENGTH (new); +#endif memcpy (dest, src, length + 1); g_free = g_free + bytes_cells (length) - 1; @@ -336,13 +456,13 @@ gc_loop (SCM scan) /*:((internal)) */ { 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 + if (NTYPE (scan) == TMACRO || NTYPE (scan) == TPAIR || NTYPE (scan) == TREF /* || scan == 1 //cell_nil */ || NTYPE (scan) == 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 + 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 //cell_nil */ || NTYPE (scan) == TVALUES) && NCDR (scan)) // allow for 0 terminated list of symbols { @@ -359,7 +479,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; } @@ -372,13 +496,20 @@ gc_ () /*:((internal)) */ 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) { @@ -399,16 +530,28 @@ gc_ () /*:((internal)) */ 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 diff --git a/src/hash.c b/src/hash.c index 47d3c01f..15066887 100644 --- a/src/hash.c +++ b/src/hash.c @@ -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; } diff --git a/src/lib.c b/src/lib.c index 7b56919e..34f12448 100644 --- a/src/lib.c +++ b/src/lib.c @@ -125,7 +125,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); } diff --git a/src/mes.c b/src/mes.c index 280712e7..42b47f8b 100644 --- a/src/mes.c +++ b/src/mes.c @@ -32,7 +32,6 @@ int g_debug; char *g_buf; SCM g_continuations; SCM g_symbols; -SCM g_symbol_max; SCM assoc_string (SCM x, SCM a) /*:((internal)) */ @@ -229,7 +228,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); } @@ -418,7 +417,6 @@ init (char **envp) g_debug = atoi (p); open_boot (); gc_init (); - g_ports = 1; } int @@ -439,11 +437,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: "); @@ -462,25 +456,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; } diff --git a/src/struct.c b/src/struct.c index 741d6d7e..36390c4d 100644 --- a/src/struct.c +++ b/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; } diff --git a/src/symbol.c b/src/symbol.c index bb9026af..24d89f69 100644 --- a/src/symbol.c +++ b/src/symbol.c @@ -23,32 +23,42 @@ #include +#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_type_broken_heart = init_symbol (g_symbol, TSYMBOL, ""); 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); diff --git a/src/vector.c b/src/vector.c index 9f06e3b2..432e8008 100644 --- a/src/vector.c +++ b/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);