}
extern struct ao_lisp_stack *ao_lisp_stack;
+extern struct ao_lisp_stack *ao_lisp_stack_free_list;
extern ao_poly ao_lisp_v;
#define AO_LISP_FUNC_LAMBDA 0
#define AO_LISP_FUNC_MACRO 2
#define AO_LISP_FUNC_LEXPR 3
+#define AO_LISP_FUNC_FREE_ARGS 0x80
+#define AO_LISP_FUNC_MASK 0x7f
+
+#define AO_LISP_FUNC_F_LAMBDA (AO_LISP_FUNC_FREE_ARGS | AO_LISP_FUNC_LAMBDA)
+#define AO_LISP_FUNC_F_NLAMBDA (AO_LISP_FUNC_FREE_ARGS | AO_LISP_FUNC_NLAMBDA)
+#define AO_LISP_FUNC_F_MACRO (AO_LISP_FUNC_FREE_ARGS | AO_LISP_FUNC_MACRO)
+#define AO_LISP_FUNC_F_LEXPR (AO_LISP_FUNC_FREE_ARGS | AO_LISP_FUNC_LEXPR)
+
struct ao_lisp_builtin {
uint8_t type;
uint8_t args;
}
/* memory functions */
+
+extern int ao_lisp_collects;
+
/* returns 1 if the object was already marked */
int
ao_lisp_mark(const struct ao_lisp_type *type, void *addr);
struct ao_lisp_cons *
ao_lisp_cons_cons(ao_poly car, struct ao_lisp_cons *cdr);
+extern struct ao_lisp_cons *ao_lisp_cons_free_list;
+
+void
+ao_lisp_cons_free(struct ao_lisp_cons *cons);
+
void
ao_lisp_cons_print(ao_poly);
.name = "cons",
};
+struct ao_lisp_cons *ao_lisp_cons_free_list;
+
struct ao_lisp_cons *
ao_lisp_cons_cons(ao_poly car, struct ao_lisp_cons *cdr)
{
struct ao_lisp_cons *cons;
- ao_lisp_poly_stash(0, car);
- ao_lisp_cons_stash(0, cdr);
- cons = ao_lisp_alloc(sizeof (struct ao_lisp_cons));
- car = ao_lisp_poly_fetch(0);
- cdr = ao_lisp_cons_fetch(0);
- if (!cons)
- return NULL;
+ if (ao_lisp_cons_free_list) {
+ cons = ao_lisp_cons_free_list;
+ ao_lisp_cons_free_list = ao_lisp_poly_cons(cons->cdr);
+ } else {
+ ao_lisp_poly_stash(0, car);
+ ao_lisp_cons_stash(0, cdr);
+ cons = ao_lisp_alloc(sizeof (struct ao_lisp_cons));
+ car = ao_lisp_poly_fetch(0);
+ cdr = ao_lisp_cons_fetch(0);
+ if (!cons)
+ return NULL;
+ }
cons->car = car;
cons->cdr = ao_lisp_cons_poly(cdr);
return cons;
}
+void
+ao_lisp_cons_free(struct ao_lisp_cons *cons)
+{
+ while (cons) {
+ ao_poly cdr = cons->cdr;
+ cons->cdr = ao_lisp_cons_poly(ao_lisp_cons_free_list);
+ ao_lisp_cons_free_list = cons;
+ cons = ao_lisp_poly_cons(cdr);
+ }
+}
+
void
ao_lisp_cons_print(ao_poly c)
{
struct ao_lisp_stack *ao_lisp_stack;
ao_poly ao_lisp_v;
+struct ao_lisp_stack *ao_lisp_stack_free_list;
+
ao_poly
ao_lisp_set_cond(struct ao_lisp_cons *c)
{
static int
ao_lisp_stack_push(void)
{
- struct ao_lisp_stack *stack = ao_lisp_alloc(sizeof (struct ao_lisp_stack));
- if (!stack)
- return 0;
+ struct ao_lisp_stack *stack;
+ if (ao_lisp_stack_free_list) {
+ stack = ao_lisp_stack_free_list;
+ ao_lisp_stack_free_list = ao_lisp_poly_stack(stack->prev);
+ } else {
+ stack = ao_lisp_alloc(sizeof (struct ao_lisp_stack));
+ if (!stack)
+ return 0;
+ }
stack->prev = ao_lisp_stack_poly(ao_lisp_stack);
stack->frame = ao_lisp_frame_poly(ao_lisp_frame_current);
stack->list = AO_LISP_NIL;
static void
ao_lisp_stack_pop(void)
{
+ ao_poly prev;
+
if (!ao_lisp_stack)
return;
- ao_lisp_stack = ao_lisp_poly_stack(ao_lisp_stack->prev);
+ prev = ao_lisp_stack->prev;
+ ao_lisp_stack->prev = ao_lisp_stack_poly(ao_lisp_stack_free_list);
+ ao_lisp_stack_free_list = ao_lisp_stack;
+
+ ao_lisp_stack = ao_lisp_poly_stack(prev);
if (ao_lisp_stack)
ao_lisp_frame_current = ao_lisp_poly_frame(ao_lisp_stack->frame);
else
return ao_lisp_error(AO_LISP_INVALID, "func is nil");
switch (ao_lisp_poly_type(func)) {
case AO_LISP_BUILTIN:
- return ao_lisp_poly_builtin(func)->args;
+ return ao_lisp_poly_builtin(func)->args & AO_LISP_FUNC_MASK;
case AO_LISP_LAMBDA:
return ao_lisp_poly_lambda(func)->args;
default:
ao_lisp_eval_exec(void)
{
ao_poly v;
+ struct ao_lisp_builtin *builtin;
+
DBGI("exec: "); DBG_POLY(ao_lisp_v); DBG(" values "); DBG_POLY(ao_lisp_stack->values); DBG ("\n");
ao_lisp_stack->sexprs = AO_LISP_NIL;
switch (ao_lisp_poly_type(ao_lisp_v)) {
case AO_LISP_BUILTIN:
ao_lisp_stack->state = eval_val;
- v = ao_lisp_func(ao_lisp_poly_builtin(ao_lisp_v)) (
+ builtin = ao_lisp_poly_builtin(ao_lisp_v);
+ v = ao_lisp_func(builtin) (
ao_lisp_poly_cons(ao_lisp_poly_cons(ao_lisp_stack->values)->cdr));
DBG_DO(if (!ao_lisp_exception && ao_lisp_poly_builtin(ao_lisp_v)->func == builtin_set) {
struct ao_lisp_cons *cons = ao_lisp_poly_cons(ao_lisp_stack->values);
ao_poly val = ao_lisp_arg(cons, 2);
DBGI("set "); DBG_POLY(atom); DBG(" = "); DBG_POLY(val); DBG("\n");
});
+ builtin = ao_lisp_poly_builtin(ao_lisp_v);
+ if (builtin->args & AO_LISP_FUNC_FREE_ARGS)
+ ao_lisp_cons_free(ao_lisp_poly_cons(ao_lisp_stack->values));
+
ao_lisp_v = v;
DBGI(".. result "); DBG_POLY(ao_lisp_v); DBG ("\n");
DBGI(".. frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");
args = ao_lisp_poly_cons(args->cdr);
vals = ao_lisp_poly_cons(vals->cdr);
}
+ ao_lisp_cons_free(cons);
break;
}
case AO_LISP_FUNC_LEXPR:
};
struct builtin_func funcs[] = {
- "eval", AO_LISP_FUNC_LAMBDA, builtin_eval,
- "read", AO_LISP_FUNC_LAMBDA, builtin_read,
+ "eval", AO_LISP_FUNC_F_LAMBDA, builtin_eval,
+ "read", AO_LISP_FUNC_F_LAMBDA, builtin_read,
"lambda", AO_LISP_FUNC_NLAMBDA, builtin_lambda,
"lexpr", AO_LISP_FUNC_NLAMBDA, builtin_lexpr,
"nlambda", AO_LISP_FUNC_NLAMBDA, builtin_nlambda,
"macro", AO_LISP_FUNC_NLAMBDA, builtin_macro,
- "car", AO_LISP_FUNC_LAMBDA, builtin_car,
- "cdr", AO_LISP_FUNC_LAMBDA, builtin_cdr,
- "cons", AO_LISP_FUNC_LAMBDA, builtin_cons,
- "last", AO_LISP_FUNC_LAMBDA, builtin_last,
- "length", AO_LISP_FUNC_LAMBDA, builtin_length,
+ "car", AO_LISP_FUNC_F_LAMBDA, builtin_car,
+ "cdr", AO_LISP_FUNC_F_LAMBDA, builtin_cdr,
+ "cons", AO_LISP_FUNC_F_LAMBDA, builtin_cons,
+ "last", AO_LISP_FUNC_F_LAMBDA, builtin_last,
+ "length", AO_LISP_FUNC_F_LAMBDA, builtin_length,
"quote", AO_LISP_FUNC_NLAMBDA, builtin_quote,
- "set", AO_LISP_FUNC_LAMBDA, builtin_set,
+ "set", AO_LISP_FUNC_F_LAMBDA, builtin_set,
"setq", AO_LISP_FUNC_MACRO, builtin_setq,
"cond", AO_LISP_FUNC_NLAMBDA, builtin_cond,
"progn", AO_LISP_FUNC_NLAMBDA, builtin_progn,
"while", AO_LISP_FUNC_NLAMBDA, builtin_while,
- "print", AO_LISP_FUNC_LEXPR, builtin_print,
- "patom", AO_LISP_FUNC_LEXPR, builtin_patom,
- "+", AO_LISP_FUNC_LEXPR, builtin_plus,
- "-", AO_LISP_FUNC_LEXPR, builtin_minus,
- "*", AO_LISP_FUNC_LEXPR, builtin_times,
- "/", AO_LISP_FUNC_LEXPR, builtin_divide,
- "%", AO_LISP_FUNC_LEXPR, builtin_mod,
- "=", AO_LISP_FUNC_LEXPR, builtin_equal,
- "<", AO_LISP_FUNC_LEXPR, builtin_less,
- ">", AO_LISP_FUNC_LEXPR, builtin_greater,
- "<=", AO_LISP_FUNC_LEXPR, builtin_less_equal,
- ">=", AO_LISP_FUNC_LEXPR, builtin_greater_equal,
- "pack", AO_LISP_FUNC_LAMBDA, builtin_pack,
- "unpack", AO_LISP_FUNC_LAMBDA, builtin_unpack,
- "flush", AO_LISP_FUNC_LAMBDA, builtin_flush,
- "delay", AO_LISP_FUNC_LAMBDA, builtin_delay,
- "led", AO_LISP_FUNC_LEXPR, builtin_led,
- "save", AO_LISP_FUNC_LAMBDA, builtin_save,
- "restore", AO_LISP_FUNC_LAMBDA, builtin_restore,
+ "print", AO_LISP_FUNC_F_LEXPR, builtin_print,
+ "patom", AO_LISP_FUNC_F_LEXPR, builtin_patom,
+ "+", AO_LISP_FUNC_F_LEXPR, builtin_plus,
+ "-", AO_LISP_FUNC_F_LEXPR, builtin_minus,
+ "*", AO_LISP_FUNC_F_LEXPR, builtin_times,
+ "/", AO_LISP_FUNC_F_LEXPR, builtin_divide,
+ "%", AO_LISP_FUNC_F_LEXPR, builtin_mod,
+ "=", AO_LISP_FUNC_F_LEXPR, builtin_equal,
+ "<", AO_LISP_FUNC_F_LEXPR, builtin_less,
+ ">", AO_LISP_FUNC_F_LEXPR, builtin_greater,
+ "<=", AO_LISP_FUNC_F_LEXPR, builtin_less_equal,
+ ">=", AO_LISP_FUNC_F_LEXPR, builtin_greater_equal,
+ "pack", AO_LISP_FUNC_F_LAMBDA, builtin_pack,
+ "unpack", AO_LISP_FUNC_F_LAMBDA, builtin_unpack,
+ "flush", AO_LISP_FUNC_F_LAMBDA, builtin_flush,
+ "delay", AO_LISP_FUNC_F_LAMBDA, builtin_delay,
+ "led", AO_LISP_FUNC_F_LEXPR, builtin_led,
+ "save", AO_LISP_FUNC_F_LAMBDA, builtin_save,
+ "restore", AO_LISP_FUNC_F_LAMBDA, builtin_restore,
};
#define N_FUNC (sizeof funcs / sizeof funcs[0])
#if DBG_MEM
int dbg_move_depth;
int dbg_mem = DBG_MEM_START;
-int dbg_collects = 0;
int dbg_validate = 0;
struct ao_lisp_record {
#define AO_LISP_ROOT (sizeof (ao_lisp_root) / sizeof (ao_lisp_root[0]))
+static const void ** const ao_lisp_cache[] = {
+ (const void **) &ao_lisp_cons_free_list,
+ (const void **) &ao_lisp_stack_free_list,
+};
+
+#define AO_LISP_CACHE (sizeof (ao_lisp_cache) / sizeof (ao_lisp_cache[0]))
+
#define AO_LISP_BUSY_SIZE ((AO_LISP_POOL + 31) / 32)
static uint8_t ao_lisp_busy[AO_LISP_BUSY_SIZE];
};
};
-#define AO_LISP_NCHUNK 32
+#define AO_LISP_NCHUNK 64
static struct ao_lisp_chunk ao_lisp_chunk[AO_LISP_NCHUNK];
/* Offset of an address within the pool. */
static inline uint16_t pool_offset(void *addr) {
+#if DBG_MEM
if (!AO_LISP_IS_POOL(addr))
ao_lisp_abort();
+#endif
return ((uint8_t *) addr) - ao_lisp_pool;
}
* These are used in the chunk code.
*/
static inline ao_poly pool_poly(void *addr) {
+#if DBG_MEM
if (!AO_LISP_IS_POOL(addr))
ao_lisp_abort();
+#endif
return ((uint8_t *) addr) - AO_LISP_POOL_BASE;
}
for (i = 0; i < AO_LISP_NCHUNK; i++) {
if (ao_lisp_chunk[i].size && ao_lisp_chunk[i].old_addr == addr) {
+#if DBG_MEM
if (ao_lisp_chunk[i].size != size)
ao_lisp_abort();
+#endif
return;
}
if (ao_lisp_chunk[i].old_addr > addr) {
memset(ao_lisp_busy, '\0', sizeof (ao_lisp_busy));
memset(ao_lisp_cons_note, '\0', sizeof (ao_lisp_cons_note));
ao_lisp_cons_noted = 0;
- for (i = 0; i < AO_LISP_ROOT; i++) {
+ for (i = 0; i < (int) AO_LISP_ROOT; i++) {
if (ao_lisp_root[i].type) {
void **a = ao_lisp_root[i].addr, *v;
if (a && (v = *a)) {
return ao_lisp_poly_mark(*p, do_note_cons);
}
+int ao_lisp_collects;
+
void
ao_lisp_collect(void)
{
int moved;
struct ao_lisp_record *mark_record = NULL, *move_record = NULL;
- ++dbg_collects;
- MDBG_MOVE("collect %d\n", dbg_collects);
+ MDBG_MOVE("collect %d\n", ao_lisp_collects);
marked = moved = 0;
#endif
+
+ ++ao_lisp_collects;
+
+ /* Clear references to all caches */
+ for (i = 0; i < (int) AO_LISP_CACHE; i++)
+ *ao_lisp_cache[i] = NULL;
chunk_low = 0;
top = 0;
for (;;) {
if (ao_lisp_chunk[i].old_addr > top)
break;
+#if DBG_MEM
if (ao_lisp_chunk[i].old_addr != top)
ao_lisp_abort();
+#endif
top += size;
MDBG_MOVE("chunk %d %d not moving\n",
if (type == AO_LISP_OTHER) {
type = ao_lisp_other_type(ao_lisp_poly_other(p));
+#if DBG_MEM
if (type <= AO_LISP_OTHER || AO_LISP_NUM_TYPE <= type)
ao_lisp_abort();
+#endif
}
lisp_type = ao_lisp_types[ao_lisp_poly_type(p)];
if (!AO_LISP_IS_POOL(addr))
return 1;
+ (void) type;
+
MDBG_MOVE("move memory %d\n", MDBG_OFFSET(addr));
addr = move_map(addr);
if (addr != *ref) {
if (type == AO_LISP_OTHER) {
type = ao_lisp_other_type(move_map(ao_lisp_poly_other(p)));
+#if DBG_MEM
if (type <= AO_LISP_OTHER || AO_LISP_NUM_TYPE <= type)
ao_lisp_abort();
+#endif
}
lisp_type = ao_lisp_types[type];
void
ao_lisp_cons_stash(int id, struct ao_lisp_cons *cons)
{
- if (save_cons[id] != NULL)
- ao_lisp_abort();
save_cons[id] = cons;
}
void
ao_lisp_string_stash(int id, char *string)
{
- if (save_cons[id] != NULL)
- ao_lisp_abort();
save_string[id] = string;
}
os->atoms = ao_lisp_atom_poly(ao_lisp_atoms);
os->globals = ao_lisp_frame_poly(ao_lisp_frame_global);
os->const_checksum = ao_lisp_const_checksum;
- os->const_checksum_inv = ~ao_lisp_const_checksum;
+ os->const_checksum_inv = (uint16_t) ~ao_lisp_const_checksum;
if (ao_lisp_os_save())
return _ao_lisp_atom_t;