X-Git-Url: https://git.gag.com/?a=blobdiff_plain;f=src%2Flisp%2Fao_lisp.h;h=fa3632b157afaeb8c38c8c7a9c7810efe5395434;hb=129e07ccc9b8a33491a905a91ca6c5b0509aba9c;hp=98e99acbaec768d4467521f946f19f9741a0be3e;hpb=11cb03b1d336ee90c422be27588f57be573a9546;p=fw%2Faltos diff --git a/src/lisp/ao_lisp.h b/src/lisp/ao_lisp.h index 98e99acb..fa3632b1 100644 --- a/src/lisp/ao_lisp.h +++ b/src/lisp/ao_lisp.h @@ -15,29 +15,76 @@ #ifndef _AO_LISP_H_ #define _AO_LISP_H_ -#include - -#if !defined(AO_LISP_TEST) && !defined(AO_LISP_MAKE_CONST) -#include -#define AO_LISP_ALTOS 1 -#define abort() ao_panic(1) -#endif +#define DBG_MEM 0 +#define DBG_EVAL 0 #include #include -#include +#include + +typedef uint16_t ao_poly; +typedef int16_t ao_signed_poly; + +#ifdef AO_LISP_SAVE + +struct ao_lisp_os_save { + ao_poly atoms; + ao_poly globals; + uint16_t const_checksum; + uint16_t const_checksum_inv; +}; + +#define AO_LISP_POOL_EXTRA (sizeof(struct ao_lisp_os_save)) +#define AO_LISP_POOL ((int) (AO_LISP_POOL_TOTAL - AO_LISP_POOL_EXTRA)) + +int +ao_lisp_os_save(void); + +int +ao_lisp_os_restore_save(struct ao_lisp_os_save *save, int offset); + +int +ao_lisp_os_restore(void); + +#endif #ifdef AO_LISP_MAKE_CONST #define AO_LISP_POOL_CONST 16384 extern uint8_t ao_lisp_const[AO_LISP_POOL_CONST]; #define ao_lisp_pool ao_lisp_const #define AO_LISP_POOL AO_LISP_POOL_CONST -#define _ao_lisp_atom_quote ao_lisp_atom_poly(ao_lisp_atom_intern("quote")) -#define _ao_lisp_atom_set ao_lisp_atom_poly(ao_lisp_atom_intern("set")) + +#define _atom(n) ao_lisp_atom_poly(ao_lisp_atom_intern(n)) + +#define _ao_lisp_atom_quote _atom("quote") +#define _ao_lisp_atom_set _atom("set") +#define _ao_lisp_atom_setq _atom("setq") +#define _ao_lisp_atom_t _atom("t") +#define _ao_lisp_atom_car _atom("car") +#define _ao_lisp_atom_cdr _atom("cdr") +#define _ao_lisp_atom_cons _atom("cons") +#define _ao_lisp_atom_last _atom("last") +#define _ao_lisp_atom_length _atom("length") +#define _ao_lisp_atom_cond _atom("cond") +#define _ao_lisp_atom_lambda _atom("lambda") +#define _ao_lisp_atom_led _atom("led") +#define _ao_lisp_atom_delay _atom("delay") +#define _ao_lisp_atom_pack _atom("pack") +#define _ao_lisp_atom_unpack _atom("unpack") +#define _ao_lisp_atom_flush _atom("flush") +#define _ao_lisp_atom_eval _atom("eval") +#define _ao_lisp_atom_read _atom("read") +#define _ao_lisp_atom_eof _atom("eof") +#define _ao_lisp_atom_save _atom("save") +#define _ao_lisp_atom_restore _atom("restore") +#define _ao_lisp_atom_call2fcc _atom("call/cc") +#define _ao_lisp_atom_collect _atom("collect") #else #include "ao_lisp_const.h" -#define AO_LISP_POOL 1024 -extern uint8_t ao_lisp_pool[AO_LISP_POOL]; +#ifndef AO_LISP_POOL +#define AO_LISP_POOL 3072 +#endif +extern uint8_t ao_lisp_pool[AO_LISP_POOL + AO_LISP_POOL_EXTRA]; #endif /* Primitive types */ @@ -55,7 +102,12 @@ extern uint8_t ao_lisp_pool[AO_LISP_POOL]; #define AO_LISP_ATOM 4 #define AO_LISP_BUILTIN 5 #define AO_LISP_FRAME 6 -#define AO_LISP_NUM_TYPE 7 +#define AO_LISP_LAMBDA 7 +#define AO_LISP_STACK 8 +#define AO_LISP_NUM_TYPE 9 + +/* Leave two bits for types to use as they please */ +#define AO_LISP_OTHER_TYPE_MASK 0x3f #define AO_LISP_NIL 0 @@ -64,45 +116,31 @@ extern uint16_t ao_lisp_top; #define AO_LISP_OOM 0x01 #define AO_LISP_DIVIDE_BY_ZERO 0x02 #define AO_LISP_INVALID 0x04 +#define AO_LISP_UNDEFINED 0x08 +#define AO_LISP_EOF 0x10 extern uint8_t ao_lisp_exception; -typedef uint16_t ao_poly; - static inline int ao_lisp_is_const(ao_poly poly) { return poly & AO_LISP_CONST; } -#define AO_LISP_POOL_BASE (ao_lisp_pool - 4) -#define AO_LISP_CONST_BASE (ao_lisp_const - 4) - #define AO_LISP_IS_CONST(a) (ao_lisp_const <= ((uint8_t *) (a)) && ((uint8_t *) (a)) < ao_lisp_const + AO_LISP_POOL_CONST) #define AO_LISP_IS_POOL(a) (ao_lisp_pool <= ((uint8_t *) (a)) && ((uint8_t *) (a)) < ao_lisp_pool + AO_LISP_POOL) +#define AO_LISP_IS_INT(p) (ao_lisp_base_type(p) == AO_LISP_INT); -static inline void * -ao_lisp_ref(ao_poly poly) { - if (poly == AO_LISP_NIL) - return NULL; - if (poly & AO_LISP_CONST) - return (void *) (AO_LISP_CONST_BASE + (poly & AO_LISP_REF_MASK)); - return (void *) (AO_LISP_POOL_BASE + (poly & AO_LISP_REF_MASK)); -} +void * +ao_lisp_ref(ao_poly poly); -static inline ao_poly -ao_lisp_poly(const void *addr, ao_poly type) { - const uint8_t *a = addr; - if (a == NULL) - return AO_LISP_NIL; - if (AO_LISP_IS_CONST(a)) - return AO_LISP_CONST | (a - AO_LISP_CONST_BASE) | type; - return (a - AO_LISP_POOL_BASE) | type; -} +ao_poly +ao_lisp_poly(const void *addr, ao_poly type); struct ao_lisp_type { - void (*mark)(void *addr); int (*size)(void *addr); + void (*mark)(void *addr); void (*move)(void *addr); + char name[]; }; struct ao_lisp_cons { @@ -123,12 +161,20 @@ struct ao_lisp_val { }; struct ao_lisp_frame { + uint8_t type; uint8_t num; - uint8_t readonly; - ao_poly next; + ao_poly prev; struct ao_lisp_val vals[]; }; +/* Set on type when the frame escapes the lambda */ +#define AO_LISP_FRAME_MARK 0x80 +#define AO_LISP_FRAME_PRINT 0x40 + +static inline int ao_lisp_frame_marked(struct ao_lisp_frame *f) { + return f->type & AO_LISP_FRAME_MARK; +} + static inline struct ao_lisp_frame * ao_lisp_poly_frame(ao_poly poly) { return ao_lisp_ref(poly); @@ -139,10 +185,67 @@ ao_lisp_frame_poly(struct ao_lisp_frame *frame) { return ao_lisp_poly(frame, AO_LISP_OTHER); } -#define AO_LISP_LAMBDA 0 -#define AO_LISP_NLAMBDA 1 -#define AO_LISP_MACRO 2 -#define AO_LISP_LEXPR 3 +enum eval_state { + eval_sexpr, /* Evaluate an sexpr */ + eval_val, /* Value computed */ + eval_formal, /* Formal computed */ + eval_exec, /* Start a lambda evaluation */ + eval_cond, /* Start next cond clause */ + eval_cond_test, /* Check cond condition */ + eval_progn, /* Start next progn entry */ + eval_while, /* Start while condition */ + eval_while_test, /* Check while condition */ + eval_macro, /* Finished with macro generation */ +}; + +struct ao_lisp_stack { + uint8_t type; /* AO_LISP_STACK */ + uint8_t state; /* enum eval_state */ + ao_poly prev; /* previous stack frame */ + ao_poly sexprs; /* expressions to evaluate */ + ao_poly values; /* values computed */ + ao_poly values_tail; /* end of the values list for easy appending */ + ao_poly frame; /* current lookup frame */ + ao_poly list; /* most recent function call */ +}; + +#define AO_LISP_STACK_MARK 0x80 /* set on type when a reference has been taken */ +#define AO_LISP_STACK_PRINT 0x40 /* stack is being printed */ + +static inline int ao_lisp_stack_marked(struct ao_lisp_stack *s) { + return s->type & AO_LISP_STACK_MARK; +} + +static inline void ao_lisp_stack_mark(struct ao_lisp_stack *s) { + s->type |= AO_LISP_STACK_MARK; +} + +static inline struct ao_lisp_stack * +ao_lisp_poly_stack(ao_poly p) +{ + return ao_lisp_ref(p); +} + +static inline ao_poly +ao_lisp_stack_poly(struct ao_lisp_stack *stack) +{ + return ao_lisp_poly(stack, AO_LISP_OTHER); +} + +extern ao_poly ao_lisp_v; + +#define AO_LISP_FUNC_LAMBDA 0 +#define AO_LISP_FUNC_NLAMBDA 1 +#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; @@ -151,24 +254,50 @@ struct ao_lisp_builtin { }; enum ao_lisp_builtin_id { + builtin_eval, + builtin_read, + builtin_lambda, + builtin_lexpr, + builtin_nlambda, + builtin_macro, builtin_car, builtin_cdr, builtin_cons, + builtin_last, + builtin_length, builtin_quote, builtin_set, builtin_setq, + builtin_cond, + builtin_progn, + builtin_while, builtin_print, + builtin_patom, builtin_plus, builtin_minus, builtin_times, builtin_divide, builtin_mod, - builtin_last + builtin_equal, + builtin_less, + builtin_greater, + builtin_less_equal, + builtin_greater_equal, + builtin_pack, + builtin_unpack, + builtin_flush, + builtin_delay, + builtin_led, + builtin_save, + builtin_restore, + builtin_call_cc, + builtin_collect, + _builtin_last }; typedef ao_poly (*ao_lisp_func_t)(struct ao_lisp_cons *cons); -extern ao_lisp_func_t ao_lisp_builtins[]; +extern const ao_lisp_func_t ao_lisp_builtins[]; static inline ao_lisp_func_t ao_lisp_func(struct ao_lisp_builtin *b) @@ -176,6 +305,25 @@ ao_lisp_func(struct ao_lisp_builtin *b) return ao_lisp_builtins[b->func]; } +struct ao_lisp_lambda { + uint8_t type; + uint8_t args; + ao_poly code; + ao_poly frame; +}; + +static inline struct ao_lisp_lambda * +ao_lisp_poly_lambda(ao_poly poly) +{ + return ao_lisp_ref(poly); +} + +static inline ao_poly +ao_lisp_lambda_poly(struct ao_lisp_lambda *lambda) +{ + return ao_lisp_poly(lambda, AO_LISP_OTHER); +} + static inline void * ao_lisp_poly_other(ao_poly poly) { return ao_lisp_ref(poly); @@ -183,7 +331,11 @@ ao_lisp_poly_other(ao_poly poly) { static inline uint8_t ao_lisp_other_type(void *other) { - return *((uint8_t *) other); +#if DBG_MEM + if ((*((uint8_t *) other) & AO_LISP_OTHER_TYPE_MASK) >= AO_LISP_NUM_TYPE) + ao_lisp_abort(); +#endif + return *((uint8_t *) other) & AO_LISP_OTHER_TYPE_MASK; } static inline ao_poly @@ -193,13 +345,23 @@ ao_lisp_other_poly(const void *other) } static inline int -ao_lisp_mem_round(int size) +ao_lisp_size_round(int size) { return (size + 3) & ~3; } +static inline int +ao_lisp_size(const struct ao_lisp_type *type, void *addr) +{ + return ao_lisp_size_round(type->size(addr)); +} + #define AO_LISP_OTHER_POLY(other) ((ao_poly)(other) + AO_LISP_OTHER) +static inline int ao_lisp_poly_base_type(ao_poly poly) { + return poly & AO_LISP_TYPE_MASK; +} + static inline int ao_lisp_poly_type(ao_poly poly) { int type = poly & AO_LISP_TYPE_MASK; if (type == AO_LISP_OTHER) @@ -222,13 +384,13 @@ ao_lisp_cons_poly(struct ao_lisp_cons *cons) static inline int ao_lisp_poly_int(ao_poly poly) { - return (int) poly >> AO_LISP_TYPE_SHIFT; + return (int) ((ao_signed_poly) poly >> AO_LISP_TYPE_SHIFT); } static inline ao_poly ao_lisp_int_poly(int i) { - return ((ao_poly) i << 2) + AO_LISP_INT; + return ((ao_poly) i << 2) | AO_LISP_INT; } static inline char * @@ -268,34 +430,66 @@ ao_lisp_builtin_poly(struct ao_lisp_builtin *b) } /* memory functions */ -void + +extern int ao_lisp_collects[2]; +extern int ao_lisp_freed[2]; +extern int ao_lisp_loops[2]; + +/* returns 1 if the object was already marked */ +int ao_lisp_mark(const struct ao_lisp_type *type, void *addr); /* returns 1 if the object was already marked */ int -ao_lisp_mark_memory(void *addr, int size); +ao_lisp_mark_memory(const struct ao_lisp_type *type, void *addr); void * ao_lisp_move_map(void *addr); -void * -ao_lisp_move(const struct ao_lisp_type *type, void *addr); +/* returns 1 if the object was already moved */ +int +ao_lisp_move(const struct ao_lisp_type *type, void **ref); -/* returns NULL if the object was already moved */ -void * -ao_lisp_move_memory(void *addr, int size); +/* returns 1 if the object was already moved */ +int +ao_lisp_move_memory(const struct ao_lisp_type *type, void **ref); void * ao_lisp_alloc(int size); -void -ao_lisp_collect(void); +#define AO_LISP_COLLECT_FULL 1 +#define AO_LISP_COLLECT_INCREMENTAL 0 int -ao_lisp_root_add(const struct ao_lisp_type *type, void *addr); +ao_lisp_collect(uint8_t style); void -ao_lisp_root_clear(void *addr); +ao_lisp_cons_stash(int id, struct ao_lisp_cons *cons); + +struct ao_lisp_cons * +ao_lisp_cons_fetch(int id); + +void +ao_lisp_poly_stash(int id, ao_poly poly); + +ao_poly +ao_lisp_poly_fetch(int id); + +void +ao_lisp_string_stash(int id, char *string); + +char * +ao_lisp_string_fetch(int id); + +static inline void +ao_lisp_stack_stash(int id, struct ao_lisp_stack *stack) { + ao_lisp_poly_stash(id, ao_lisp_stack_poly(stack)); +} + +static inline struct ao_lisp_stack * +ao_lisp_stack_fetch(int id) { + return ao_lisp_poly_stack(ao_lisp_poly_fetch(id)); +} /* cons */ extern const struct ao_lisp_type ao_lisp_cons_type; @@ -303,31 +497,47 @@ extern const struct ao_lisp_type ao_lisp_cons_type; 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); +void +ao_lisp_cons_patom(ao_poly); + +int +ao_lisp_cons_length(struct ao_lisp_cons *cons); + /* string */ extern const struct ao_lisp_type ao_lisp_string_type; -char * -ao_lisp_string_new(int len); - char * ao_lisp_string_copy(char *a); char * ao_lisp_string_cat(char *a, char *b); +ao_poly +ao_lisp_string_pack(struct ao_lisp_cons *cons); + +ao_poly +ao_lisp_string_unpack(char *a); + void ao_lisp_string_print(ao_poly s); +void +ao_lisp_string_patom(ao_poly s); + /* atom */ extern const struct ao_lisp_type ao_lisp_atom_type; -extern struct ao_lisp_atom *ao_lisp_atoms; - -void -ao_lisp_atom_init(void); +extern struct ao_lisp_atom *ao_lisp_atoms; +extern struct ao_lisp_frame *ao_lisp_frame_global; +extern struct ao_lisp_frame *ao_lisp_frame_current; void ao_lisp_atom_print(ao_poly a); @@ -335,6 +545,9 @@ ao_lisp_atom_print(ao_poly a); struct ao_lisp_atom * ao_lisp_atom_intern(char *name); +ao_poly * +ao_lisp_atom_ref(struct ao_lisp_frame *frame, ao_poly atom); + ao_poly ao_lisp_atom_get(ao_poly atom); @@ -346,26 +559,59 @@ void ao_lisp_int_print(ao_poly i); /* prim */ -ao_poly +void ao_lisp_poly_print(ao_poly p); void -ao_lisp_poly_mark(ao_poly p); +ao_lisp_poly_patom(ao_poly p); -ao_poly -ao_lisp_poly_move(ao_poly p); +int +ao_lisp_poly_mark(ao_poly p, uint8_t note_cons); + +/* returns 1 if the object has already been moved */ +int +ao_lisp_poly_move(ao_poly *p, uint8_t note_cons); /* eval */ + +void +ao_lisp_eval_clear_globals(void); + +int +ao_lisp_eval_restart(void); + ao_poly ao_lisp_eval(ao_poly p); +ao_poly +ao_lisp_set_cond(struct ao_lisp_cons *cons); + /* builtin */ void ao_lisp_builtin_print(ao_poly b); extern const struct ao_lisp_type ao_lisp_builtin_type; +/* Check argument count */ +ao_poly +ao_lisp_check_argc(ao_poly name, struct ao_lisp_cons *cons, int min, int max); + +/* Check argument type */ +ao_poly +ao_lisp_check_argt(ao_poly name, struct ao_lisp_cons *cons, int argc, int type, int nil_ok); + +/* Fetch an arg (nil if off the end) */ +ao_poly +ao_lisp_arg(struct ao_lisp_cons *cons, int argc); + +char * +ao_lisp_args_name(uint8_t args); + /* read */ +extern struct ao_lisp_cons *ao_lisp_read_cons; +extern struct ao_lisp_cons *ao_lisp_read_cons_tail; +extern struct ao_lisp_cons *ao_lisp_read_stack; + ao_poly ao_lisp_read(void); @@ -376,16 +622,168 @@ ao_lisp_read_eval_print(void); /* frame */ extern const struct ao_lisp_type ao_lisp_frame_type; -int -ao_lisp_frame_set(struct ao_lisp_frame *frame, ao_poly atom, ao_poly val); +#define AO_LISP_FRAME_FREE 6 + +extern struct ao_lisp_frame *ao_lisp_frame_free_list[AO_LISP_FRAME_FREE]; ao_poly -ao_lisp_frame_get(struct ao_lisp_frame *frame, ao_poly atom); +ao_lisp_frame_mark(struct ao_lisp_frame *frame); -struct ao_lisp_frame * -ao_lisp_frame_new(int num, int readonly); +ao_poly * +ao_lisp_frame_ref(struct ao_lisp_frame *frame, ao_poly atom); struct ao_lisp_frame * -ao_lisp_frame_add(struct ao_lisp_frame *frame, ao_poly atom, ao_poly val); +ao_lisp_frame_new(int num); + +void +ao_lisp_frame_free(struct ao_lisp_frame *frame); + +void +ao_lisp_frame_bind(struct ao_lisp_frame *frame, int num, ao_poly atom, ao_poly val); + +int +ao_lisp_frame_add(struct ao_lisp_frame **frame, ao_poly atom, ao_poly val); + +void +ao_lisp_frame_print(ao_poly p); + +/* lambda */ +extern const struct ao_lisp_type ao_lisp_lambda_type; + +extern const char *ao_lisp_state_names[]; + +struct ao_lisp_lambda * +ao_lisp_lambda_new(ao_poly cons); + +void +ao_lisp_lambda_print(ao_poly lambda); + +ao_poly +ao_lisp_lambda(struct ao_lisp_cons *cons); + +ao_poly +ao_lisp_lexpr(struct ao_lisp_cons *cons); + +ao_poly +ao_lisp_nlambda(struct ao_lisp_cons *cons); + +ao_poly +ao_lisp_macro(struct ao_lisp_cons *cons); + +ao_poly +ao_lisp_lambda_eval(void); + +/* save */ + +ao_poly +ao_lisp_save(struct ao_lisp_cons *cons); + +ao_poly +ao_lisp_restore(struct ao_lisp_cons *cons); + +/* stack */ + +extern const struct ao_lisp_type ao_lisp_stack_type; +extern struct ao_lisp_stack *ao_lisp_stack; +extern struct ao_lisp_stack *ao_lisp_stack_free_list; + +void +ao_lisp_stack_reset(struct ao_lisp_stack *stack); + +int +ao_lisp_stack_push(void); + +void +ao_lisp_stack_pop(void); + +void +ao_lisp_stack_clear(void); + +void +ao_lisp_stack_print(ao_poly stack); + +ao_poly +ao_lisp_stack_eval(void); + +ao_poly +ao_lisp_call_cc(struct ao_lisp_cons *cons); + +/* error */ + +void +ao_lisp_error_poly(char *name, ao_poly poly, ao_poly last); + +void +ao_lisp_error_frame(int indent, char *name, struct ao_lisp_frame *frame); + +ao_poly +ao_lisp_error(int error, char *format, ...); + +/* debugging macros */ + +#if DBG_EVAL +#define DBG_CODE 1 +int ao_lisp_stack_depth; +#define DBG_DO(a) a +#define DBG_INDENT() do { int _s; for(_s = 0; _s < ao_lisp_stack_depth; _s++) printf(" "); } while(0) +#define DBG_IN() (++ao_lisp_stack_depth) +#define DBG_OUT() (--ao_lisp_stack_depth) +#define DBG_RESET() (ao_lisp_stack_depth = 0) +#define DBG(...) printf(__VA_ARGS__) +#define DBGI(...) do { DBG("%4d: ", __LINE__); DBG_INDENT(); DBG(__VA_ARGS__); } while (0) +#define DBG_CONS(a) ao_lisp_cons_print(ao_lisp_cons_poly(a)) +#define DBG_POLY(a) ao_lisp_poly_print(a) +#define OFFSET(a) ((a) ? (int) ((uint8_t *) a - ao_lisp_pool) : -1) +#define DBG_STACK() ao_lisp_stack_print(ao_lisp_stack_poly(ao_lisp_stack)) +static inline void +ao_lisp_frames_dump(void) +{ + struct ao_lisp_stack *s; + DBGI(".. current frame: "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n"); + for (s = ao_lisp_stack; s; s = ao_lisp_poly_stack(s->prev)) { + DBGI(".. stack frame: "); DBG_POLY(s->frame); DBG("\n"); + } +} +#define DBG_FRAMES() ao_lisp_frames_dump() +#else +#define DBG_DO(a) +#define DBG_INDENT() +#define DBG_IN() +#define DBG_OUT() +#define DBG(...) +#define DBGI(...) +#define DBG_CONS(a) +#define DBG_POLY(a) +#define DBG_RESET() +#define DBG_STACK() +#define DBG_FRAMES() +#endif + +#define DBG_MEM_START 1 + +#if DBG_MEM + +#include +extern int dbg_move_depth; +#define MDBG_DUMP 1 +#define MDBG_OFFSET(a) ((int) ((uint8_t *) (a) - ao_lisp_pool)) + +extern int dbg_mem; + +#define MDBG_DO(a) a +#define MDBG_MOVE(...) do { if (dbg_mem) { int d; for (d = 0; d < dbg_move_depth; d++) printf (" "); printf(__VA_ARGS__); } } while (0) +#define MDBG_MORE(...) do { if (dbg_mem) printf(__VA_ARGS__); } while (0) +#define MDBG_MOVE_IN() (dbg_move_depth++) +#define MDBG_MOVE_OUT() (assert(--dbg_move_depth >= 0)) + +#else + +#define MDBG_DO(a) +#define MDBG_MOVE(...) +#define MDBG_MORE(...) +#define MDBG_MOVE_IN() +#define MDBG_MOVE_OUT() + +#endif #endif /* _AO_LISP_H_ */