X-Git-Url: https://git.gag.com/?a=blobdiff_plain;f=src%2Flisp%2Fao_lisp.h;h=858212dd5012fc9659fce01dea1a8ba384a0f4f5;hb=00bf2ca86b60e6501880011897cea073865c5a03;hp=980514ccb826afe15d74f6f350a6295e9c4b19f8;hpb=bc076747f6cc00508aef909a3a5bd3edf8c9bd66;p=fw%2Faltos diff --git a/src/lisp/ao_lisp.h b/src/lisp/ao_lisp.h index 980514cc..858212dd 100644 --- a/src/lisp/ao_lisp.h +++ b/src/lisp/ao_lisp.h @@ -21,6 +21,9 @@ #include #include #include +#ifndef __BYTE_ORDER +#include +#endif typedef uint16_t ao_poly; typedef int16_t ao_signed_poly; @@ -55,34 +58,17 @@ extern uint8_t ao_lisp_const[AO_LISP_POOL_CONST] __attribute__((aligned(4))); #define AO_LISP_POOL AO_LISP_POOL_CONST #define _atom(n) ao_lisp_atom_poly(ao_lisp_atom_intern(n)) +#define _bool(v) ao_lisp_bool_poly(ao_lisp_bool_get(v)) + +#define _ao_lisp_bool_true _bool(1) +#define _ao_lisp_bool_false _bool(0) -#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") -#define _ao_lisp_atom_symbolp _atom("symbol?") -#define _ao_lisp_atom_builtin _atom("builtin?") -#define _ao_lisp_atom_symbolp _atom("symbol?") -#define _ao_lisp_atom_symbolp _atom("symbol?") +#define _ao_lisp_atom_else _atom("else") + +#define AO_LISP_BUILTIN_ATOMS +#include "ao_lisp_builtin.h" + #else #include "ao_lisp_const.h" #ifndef AO_LISP_POOL @@ -108,7 +94,10 @@ extern uint8_t ao_lisp_pool[AO_LISP_POOL + AO_LISP_POOL_EXTRA] __attribute__((a #define AO_LISP_FRAME 6 #define AO_LISP_LAMBDA 7 #define AO_LISP_STACK 8 -#define AO_LISP_NUM_TYPE 9 +#define AO_LISP_BOOL 9 +#define AO_LISP_BIGINT 10 +#define AO_LISP_FLOAT 11 +#define AO_LISP_NUM_TYPE 12 /* Leave two bits for types to use as they please */ #define AO_LISP_OTHER_TYPE_MASK 0x3f @@ -122,6 +111,7 @@ extern uint16_t ao_lisp_top; #define AO_LISP_INVALID 0x04 #define AO_LISP_UNDEFINED 0x08 #define AO_LISP_EOF 0x10 +#define AO_LISP_EXIT 0x20 extern uint8_t ao_lisp_exception; @@ -132,7 +122,7 @@ 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) -#define AO_LISP_IS_INT(p) (ao_lisp_base_type(p) == AO_LISP_INT); +#define AO_LISP_IS_INT(p) (ao_lisp_poly_base_type(p) == AO_LISP_INT) void * ao_lisp_ref(ao_poly poly); @@ -171,6 +161,48 @@ struct ao_lisp_frame { struct ao_lisp_val vals[]; }; +struct ao_lisp_bool { + uint8_t type; + uint8_t value; + uint16_t pad; +}; + +struct ao_lisp_bigint { + uint32_t value; +}; + +struct ao_lisp_float { + uint8_t type; + uint8_t pad1; + uint16_t pad2; + float value; +}; + +#if __BYTE_ORDER == __LITTLE_ENDIAN +static inline uint32_t +ao_lisp_int_bigint(int32_t i) { + return AO_LISP_BIGINT | (i << 8); +} +static inline int32_t +ao_lisp_bigint_int(uint32_t bi) { + return (int32_t) bi >> 8; +} +#else +static inline uint32_t +ao_lisp_int_bigint(int32_t i) { + return (uint32_t) (i & 0xffffff) | (AO_LISP_BIGINT << 24); +} +static inlint int32_t +ao_lisp_bigint_int(uint32_t bi) { + return (int32_t) (bi << 8) >> 8; +} +#endif + +#define AO_LISP_MIN_INT (-(1 << (15 - AO_LISP_TYPE_SHIFT))) +#define AO_LISP_MAX_INT ((1 << (15 - AO_LISP_TYPE_SHIFT)) - 1) + +#define AO_LISP_NOT_INTEGER 0x7fffffff + /* Set on type when the frame escapes the lambda */ #define AO_LISP_FRAME_MARK 0x80 #define AO_LISP_FRAME_PRINT 0x40 @@ -194,9 +226,10 @@ enum eval_state { eval_val, /* Value computed */ eval_formal, /* Formal computed */ eval_exec, /* Start a lambda evaluation */ + eval_apply, /* Execute apply */ eval_cond, /* Start next cond clause */ eval_cond_test, /* Check cond condition */ - eval_progn, /* Start next progn entry */ + eval_begin, /* Start next begin entry */ eval_while, /* Start while condition */ eval_while_test, /* Check while condition */ eval_macro, /* Finished with macro generation */ @@ -257,47 +290,8 @@ struct ao_lisp_builtin { uint16_t func; }; -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_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 -}; +#define AO_LISP_BUILTIN_ID +#include "ao_lisp_builtin.h" typedef ao_poly (*ao_lisp_func_t)(struct ao_lisp_cons *cons); @@ -385,18 +379,30 @@ ao_lisp_cons_poly(struct ao_lisp_cons *cons) return ao_lisp_poly(cons, AO_LISP_CONS); } -static inline int +static inline int32_t ao_lisp_poly_int(ao_poly poly) { - return (int) ((ao_signed_poly) poly >> AO_LISP_TYPE_SHIFT); + return (int32_t) ((ao_signed_poly) poly >> AO_LISP_TYPE_SHIFT); } static inline ao_poly -ao_lisp_int_poly(int i) +ao_lisp_int_poly(int32_t i) { return ((ao_poly) i << 2) | AO_LISP_INT; } +static inline struct ao_lisp_bigint * +ao_lisp_poly_bigint(ao_poly poly) +{ + return ao_lisp_ref(poly); +} + +static inline ao_poly +ao_lisp_bigint_poly(struct ao_lisp_bigint *bi) +{ + return ao_lisp_poly(bi, AO_LISP_OTHER); +} + static inline char * ao_lisp_poly_string(ao_poly poly) { @@ -433,6 +439,33 @@ ao_lisp_builtin_poly(struct ao_lisp_builtin *b) return ao_lisp_poly(b, AO_LISP_OTHER); } +static inline ao_poly +ao_lisp_bool_poly(struct ao_lisp_bool *b) +{ + return ao_lisp_poly(b, AO_LISP_OTHER); +} + +static inline struct ao_lisp_bool * +ao_lisp_poly_bool(ao_poly poly) +{ + return ao_lisp_ref(poly); +} + +static inline ao_poly +ao_lisp_float_poly(struct ao_lisp_float *f) +{ + return ao_lisp_poly(f, AO_LISP_OTHER); +} + +static inline struct ao_lisp_float * +ao_lisp_poly_float(ao_poly poly) +{ + return ao_lisp_ref(poly); +} + +float +ao_lisp_poly_number(ao_poly p); + /* memory functions */ extern int ao_lisp_collects[2]; @@ -495,11 +528,32 @@ ao_lisp_stack_fetch(int id) { return ao_lisp_poly_stack(ao_lisp_poly_fetch(id)); } +/* bool */ + +extern const struct ao_lisp_type ao_lisp_bool_type; + +void +ao_lisp_bool_write(ao_poly v); + +#ifdef AO_LISP_MAKE_CONST +struct ao_lisp_bool *ao_lisp_true, *ao_lisp_false; + +struct ao_lisp_bool * +ao_lisp_bool_get(uint8_t value); +#endif + /* cons */ 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); +ao_lisp_cons_cons(ao_poly car, ao_poly cdr); + +/* Return a cons or NULL for a proper list, else error */ +struct ao_lisp_cons * +ao_lisp_cons_cdr(struct ao_lisp_cons *cons); + +ao_poly +ao_lisp__cons(ao_poly car, ao_poly cdr); extern struct ao_lisp_cons *ao_lisp_cons_free_list; @@ -507,10 +561,10 @@ void ao_lisp_cons_free(struct ao_lisp_cons *cons); void -ao_lisp_cons_print(ao_poly); +ao_lisp_cons_write(ao_poly); void -ao_lisp_cons_patom(ao_poly); +ao_lisp_cons_display(ao_poly); int ao_lisp_cons_length(struct ao_lisp_cons *cons); @@ -531,10 +585,10 @@ ao_poly ao_lisp_string_unpack(char *a); void -ao_lisp_string_print(ao_poly s); +ao_lisp_string_write(ao_poly s); void -ao_lisp_string_patom(ao_poly s); +ao_lisp_string_display(ao_poly s); /* atom */ extern const struct ao_lisp_type ao_lisp_atom_type; @@ -544,7 +598,7 @@ 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); +ao_lisp_atom_write(ao_poly a); struct ao_lisp_atom * ao_lisp_atom_intern(char *name); @@ -560,14 +614,30 @@ ao_lisp_atom_set(ao_poly atom, ao_poly val); /* int */ void -ao_lisp_int_print(ao_poly i); +ao_lisp_int_write(ao_poly i); +int32_t +ao_lisp_poly_integer(ao_poly p); + +ao_poly +ao_lisp_integer_poly(int32_t i); + +static inline int +ao_lisp_integer_typep(uint8_t t) +{ + return (t == AO_LISP_INT) || (t == AO_LISP_BIGINT); +} + +void +ao_lisp_bigint_write(ao_poly i); + +extern const struct ao_lisp_type ao_lisp_bigint_type; /* prim */ void -ao_lisp_poly_print(ao_poly p); +ao_lisp_poly_write(ao_poly p); void -ao_lisp_poly_patom(ao_poly p); +ao_lisp_poly_display(ao_poly p); int ao_lisp_poly_mark(ao_poly p, uint8_t note_cons); @@ -590,9 +660,27 @@ ao_lisp_eval(ao_poly p); ao_poly ao_lisp_set_cond(struct ao_lisp_cons *cons); +/* float */ +extern const struct ao_lisp_type ao_lisp_float_type; + +void +ao_lisp_float_write(ao_poly p); + +ao_poly +ao_lisp_float_get(float value); + +static inline uint8_t +ao_lisp_number_typep(uint8_t t) +{ + return ao_lisp_integer_typep(t) || (t == AO_LISP_FLOAT); +} + +float +ao_lisp_poly_number(ao_poly p); + /* builtin */ void -ao_lisp_builtin_print(ao_poly b); +ao_lisp_builtin_write(ao_poly b); extern const struct ao_lisp_type ao_lisp_builtin_type; @@ -649,7 +737,7 @@ int ao_lisp_frame_add(struct ao_lisp_frame **frame, ao_poly atom, ao_poly val); void -ao_lisp_frame_print(ao_poly p); +ao_lisp_frame_write(ao_poly p); /* lambda */ extern const struct ao_lisp_type ao_lisp_lambda_type; @@ -660,31 +748,11 @@ 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_lisp_lambda_write(ao_poly lambda); 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; @@ -704,14 +772,11 @@ void ao_lisp_stack_clear(void); void -ao_lisp_stack_print(ao_poly stack); +ao_lisp_stack_write(ao_poly stack); ao_poly ao_lisp_stack_eval(void); -ao_poly -ao_lisp_call_cc(struct ao_lisp_cons *cons); - /* error */ void @@ -723,6 +788,11 @@ ao_lisp_error_frame(int indent, char *name, struct ao_lisp_frame *frame); ao_poly ao_lisp_error(int error, char *format, ...); +/* builtins */ + +#define AO_LISP_BUILTIN_DECLS +#include "ao_lisp_builtin.h" + /* debugging macros */ #if DBG_EVAL @@ -735,10 +805,10 @@ int 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 DBG_CONS(a) ao_lisp_cons_write(ao_lisp_cons_poly(a)) +#define DBG_POLY(a) ao_lisp_poly_write(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)) +#define DBG_STACK() ao_lisp_stack_write(ao_lisp_stack_poly(ao_lisp_stack)) static inline void ao_lisp_frames_dump(void) {