X-Git-Url: https://git.gag.com/?a=blobdiff_plain;f=src%2Flisp%2Fao_lisp.h;h=ea8d98b5b57eb9cea7d6bc4bbee02007e972a543;hb=daa06c8dedc6dc1cf21936ee2769d9d25f0567bd;hp=82ba5a20e1ec20f1bad122c31fc408f3b818f413;hpb=0ee44c8e4bf5dabe6a97bf76b366c8b767c387f8;p=fw%2Faltos diff --git a/src/lisp/ao_lisp.h b/src/lisp/ao_lisp.h index 82ba5a20..ea8d98b5 100644 --- a/src/lisp/ao_lisp.h +++ b/src/lisp/ao_lisp.h @@ -15,17 +15,36 @@ #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 - #include #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 @@ -43,14 +62,25 @@ extern uint8_t ao_lisp_const[AO_LISP_POOL_CONST]; #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") #else #include "ao_lisp_const.h" #ifndef AO_LISP_POOL -#define AO_LISP_POOL 16384 +#define AO_LISP_POOL 3072 #endif -extern uint8_t ao_lisp_pool[AO_LISP_POOL]; +extern uint8_t ao_lisp_pool[AO_LISP_POOL + AO_LISP_POOL_EXTRA]; #endif /* Primitive types */ @@ -79,12 +109,10 @@ extern uint16_t ao_lisp_top; #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; -typedef int16_t ao_signed_poly; - static inline int ao_lisp_is_const(ao_poly poly) { return poly & AO_LISP_CONST; @@ -96,31 +124,17 @@ ao_lisp_is_const(ao_poly poly) { #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) -static inline void * -ao_lisp_ref(ao_poly poly) { - if (poly == 0xBEEF) - abort(); - 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 { int (*size)(void *addr); void (*mark)(void *addr); void (*move)(void *addr); + char name[]; }; struct ao_lisp_cons { @@ -142,13 +156,33 @@ struct ao_lisp_val { struct ao_lisp_frame { uint8_t type; - uint8_t num; - ao_poly next; + uint8_t _num; + ao_poly prev; struct ao_lisp_val vals[]; }; +#define AO_LISP_FRAME_NUM_MASK 0x7f + +/* Set when the frame escapes the lambda */ +#define AO_LISP_FRAME_MARK 0x80 + +static inline int ao_lisp_frame_num(struct ao_lisp_frame *f) { + if (f->_num == 0xff) + ao_lisp_abort(); + return f->_num & AO_LISP_FRAME_NUM_MASK; +} + +static inline int ao_lisp_frame_marked(struct ao_lisp_frame *f) { + if (f->_num == 0xff) + ao_lisp_abort(); + return f->_num & AO_LISP_FRAME_MARK; +} + static inline struct ao_lisp_frame * ao_lisp_poly_frame(ao_poly poly) { + struct ao_lisp_frame *frame = ao_lisp_ref(poly); + if (frame && frame->_num == 0xff) + ao_lisp_abort(); return ao_lisp_ref(poly); } @@ -159,11 +193,15 @@ ao_lisp_frame_poly(struct ao_lisp_frame *frame) { enum eval_state { eval_sexpr, /* Evaluate an sexpr */ - eval_val, - eval_formal, - eval_exec, - eval_cond, - eval_cond_test + 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 { @@ -189,6 +227,7 @@ ao_lisp_stack_poly(struct ao_lisp_stack *stack) } 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 @@ -196,6 +235,14 @@ extern ao_poly ao_lisp_v; #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; @@ -203,6 +250,8 @@ struct ao_lisp_builtin { }; enum ao_lisp_builtin_id { + builtin_eval, + builtin_read, builtin_lambda, builtin_lexpr, builtin_nlambda, @@ -211,10 +260,13 @@ enum ao_lisp_builtin_id { 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, @@ -227,12 +279,19 @@ enum ao_lisp_builtin_id { builtin_greater, builtin_less_equal, builtin_greater_equal, + builtin_pack, + builtin_unpack, + builtin_flush, + builtin_delay, + builtin_led, + builtin_save, + builtin_restore, _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) @@ -276,11 +335,17 @@ 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) { @@ -355,13 +420,18 @@ ao_lisp_builtin_poly(struct ao_lisp_builtin *b) } /* memory functions */ + +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); @@ -372,22 +442,34 @@ ao_lisp_move(const struct ao_lisp_type *type, void **ref); /* returns 1 if the object was already moved */ int -ao_lisp_move_memory(void **ref, int size); +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); -int -ao_lisp_root_poly_add(ao_poly *p); +void +ao_lisp_cons_stash(int id, struct ao_lisp_cons *cons); + +struct ao_lisp_cons * +ao_lisp_cons_fetch(int id); + +void +ao_lisp_string_stash(int id, char *string); + +char * +ao_lisp_string_fetch(int id); void -ao_lisp_root_clear(void *addr); +ao_lisp_poly_stash(int id, ao_poly poly); + +ao_poly +ao_lisp_poly_fetch(int id); /* cons */ extern const struct ao_lisp_type ao_lisp_cons_type; @@ -395,24 +477,35 @@ 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); @@ -432,6 +525,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); @@ -458,6 +554,12 @@ 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); @@ -486,6 +588,10 @@ 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); @@ -496,14 +602,24 @@ ao_lisp_read_eval_print(void); /* frame */ extern const struct ao_lisp_type ao_lisp_frame_type; +#define AO_LISP_FRAME_FREE 4 + +extern struct ao_lisp_frame *ao_lisp_frame_free_list[AO_LISP_FRAME_FREE]; + +ao_poly +ao_lisp_frame_mark(struct ao_lisp_frame *frame); + ao_poly * ao_lisp_frame_ref(struct ao_lisp_frame *frame, ao_poly atom); struct ao_lisp_frame * ao_lisp_frame_new(int num); -struct ao_lisp_frame * -ao_lisp_frame_add(struct ao_lisp_frame *frame, ao_poly atom, ao_poly val); +void +ao_lisp_frame_free(struct ao_lisp_frame *frame); + +int +ao_lisp_frame_add(struct ao_lisp_frame **frame, ao_poly atom, ao_poly val); void ao_lisp_frame_print(ao_poly p); @@ -530,11 +646,20 @@ ao_poly ao_lisp_macro(struct ao_lisp_cons *cons); ao_poly -ao_lisp_lambda_eval(struct ao_lisp_lambda *lambda, - struct ao_lisp_cons *cons); +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); /* error */ +extern const struct ao_lisp_type ao_lisp_stack_type; + void ao_lisp_stack_print(void); @@ -581,4 +706,32 @@ ao_lisp_frames_dump(void) #define DBG_FRAMES() #endif +#define DBG_MEM 0 +#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_ */