artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

core: Prepare for pointer cells.

Browse source 
* 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 2020-07-14 15:57:49 +02:00
parent 52c57da02f
commit f9a372de13
No known key found for this signature in database
GPG key ID: F3C1A0D9C1D65273
13 changed files with 346 additions and 101 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
include/mes/cc.h
View file

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

10
include/mes/m2.h
View file

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

43
include/mes/macros.h
View file

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

37
include/mes/mes.h
View file

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

7
include/mes/symbols.h
View file

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

2
src/eval-apply.c
View file

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

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

2
src/hash.c
View file

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

2
src/lib.c
View file

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

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

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

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

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