X-Git-Url: https://git.gag.com/?a=blobdiff_plain;f=src%2Flisp%2Fao_lisp.h;h=7a165cd8b47ef1bcf94004eec2aeb0813426fb52;hb=d46ca67f93e9ecbc4d8c051c3fbdead85490b690;hp=6a35d8ce3f0493104e4dd683a2762bb3f7dd654e;hpb=794718abc62f4610495fe2bd535a2b67bc46573c;p=fw%2Faltos diff --git a/src/lisp/ao_lisp.h b/src/lisp/ao_lisp.h index 6a35d8ce..7a165cd8 100644 --- a/src/lisp/ao_lisp.h +++ b/src/lisp/ao_lisp.h @@ -15,17 +15,10 @@ #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 #ifdef AO_LISP_MAKE_CONST #define AO_LISP_POOL_CONST 16384 @@ -43,8 +36,17 @@ 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") #else #include "ao_lisp_const.h" #ifndef AO_LISP_POOL @@ -78,6 +80,8 @@ 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; @@ -95,26 +99,11 @@ 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); @@ -156,26 +145,26 @@ ao_lisp_frame_poly(struct ao_lisp_frame *frame) { return ao_lisp_poly(frame, AO_LISP_OTHER); } -struct ao_lisp_stack { - ao_poly prev; - uint8_t state; - uint8_t macro; - ao_poly sexprs; - ao_poly values; - ao_poly values_tail; - ao_poly frame; - ao_poly macro_frame; - ao_poly list; -}; - enum eval_state { - eval_sexpr, + eval_sexpr, /* Evaluate an sexpr */ eval_val, eval_formal, eval_exec, - eval_lambda_done, eval_cond, - eval_cond_test + eval_cond_test, + eval_progn, + eval_while, + eval_while_test, +}; + +struct 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 */ }; static inline struct ao_lisp_stack * @@ -205,6 +194,8 @@ struct ao_lisp_builtin { }; enum ao_lisp_builtin_id { + builtin_eval, + builtin_read, builtin_lambda, builtin_lexpr, builtin_nlambda, @@ -213,10 +204,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, @@ -229,12 +223,17 @@ enum ao_lisp_builtin_id { builtin_greater, builtin_less_equal, builtin_greater_equal, + builtin_pack, + builtin_unpack, + builtin_flush, + builtin_delay, + builtin_led, _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) @@ -403,6 +402,9 @@ 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; @@ -415,6 +417,12 @@ 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); @@ -504,8 +512,8 @@ 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); +int +ao_lisp_frame_add(struct ao_lisp_frame **frame, ao_poly atom, ao_poly val); void ao_lisp_frame_print(ao_poly p); @@ -532,8 +540,7 @@ 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); /* error */ @@ -559,6 +566,16 @@ int ao_lisp_stack_depth; #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() +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() @@ -570,6 +587,7 @@ int ao_lisp_stack_depth; #define DBG_POLY(a) #define DBG_RESET() #define DBG_STACK() +#define DBG_FRAMES() #endif #endif /* _AO_LISP_H_ */