From 08fe087e11a0ef62ec02eb1461d9781f1ce5daae Mon Sep 17 00:00:00 2001 From: hyung-hwan Date: Wed, 25 Oct 2006 13:42:31 +0000 Subject: [PATCH] *** empty log message *** --- ase/lsp/env.c | 18 +- ase/lsp/err.c | 4 +- ase/lsp/eval.c | 29 ++-- ase/lsp/lsp.h | 31 +++- ase/lsp/mem.c | 288 +++++++++++--------------------- ase/lsp/mem.h | 47 ++---- ase/lsp/obj.h | 34 ++-- ase/lsp/prim.c | 39 +++-- ase/lsp/prim.h | 4 +- ase/lsp/prim_compar.c | 372 ++++++++++++++++++++++++++---------------- ase/lsp/prim_let.c | 6 +- ase/lsp/prim_math.c | 55 ++++--- ase/lsp/print.c | 20 +-- ase/lsp/read.c | 164 +++++++++++-------- ase/lsp/token.h | 6 +- ase/lsp/types.h | 14 -- 16 files changed, 589 insertions(+), 542 deletions(-) delete mode 100644 ase/lsp/types.h diff --git a/ase/lsp/env.c b/ase/lsp/env.c index ac76fdae..6b316b8b 100644 --- a/ase/lsp/env.c +++ b/ase/lsp/env.c @@ -1,10 +1,8 @@ /* - * $Id: env.c,v 1.10 2006-10-24 04:22:39 bacon Exp $ + * $Id: env.c,v 1.11 2006-10-25 13:42:30 bacon Exp $ */ -#include -#include -#include +#include // TODO: make the frame hash accessible.... @@ -48,7 +46,8 @@ void ase_lsp_frame_free (ase_lsp_frame_t* frame) // destroy the associations assoc = frame->assoc; - while (assoc != ASE_NULL) { + while (assoc != ASE_NULL) + { link = assoc->link; ase_lsp_assoc_free (assoc); assoc = link; @@ -61,10 +60,11 @@ ase_lsp_assoc_t* ase_lsp_frame_lookup (ase_lsp_frame_t* frame, ase_lsp_obj_t* na { ase_lsp_assoc_t* assoc; - ase_assert (ASE_LSP_TYPE(name) == ASE_LSP_OBJ_SYMBOL); + ase_assert (ASE_LSP_TYPE(name) == ASE_LSP_OBJ_SYM); assoc = frame->assoc; - while (assoc != ASE_NULL) { + while (assoc != ASE_NULL) + { if (name == assoc->name) return assoc; assoc = assoc->link; } @@ -76,7 +76,7 @@ ase_lsp_assoc_t* ase_lsp_frame_insert_value ( { ase_lsp_assoc_t* assoc; - ase_assert (ASE_LSP_TYPE(name) == ASE_LSP_OBJ_SYMBOL); + ase_assert (ASE_LSP_TYPE(name) == ASE_LSP_OBJ_SYM); assoc = ase_lsp_assoc_new (name, value, ASE_NULL); if (assoc == ASE_NULL) return ASE_NULL; @@ -90,7 +90,7 @@ ase_lsp_assoc_t* ase_lsp_frame_insert_func ( { ase_lsp_assoc_t* assoc; - ase_assert (ASE_LSP_TYPE(name) == ASE_LSP_OBJ_SYMBOL); + ase_assert (ASE_LSP_TYPE(name) == ASE_LSP_OBJ_SYM); assoc = ase_lsp_assoc_new (name, ASE_NULL, func); if (assoc == ASE_NULL) return ASE_NULL; diff --git a/ase/lsp/err.c b/ase/lsp/err.c index 218b19fe..a642dacb 100644 --- a/ase/lsp/err.c +++ b/ase/lsp/err.c @@ -1,8 +1,8 @@ /* - * $Id: err.c,v 1.3 2006-10-24 04:22:39 bacon Exp $ + * $Id: err.c,v 1.4 2006-10-25 13:42:31 bacon Exp $ */ -#include +#include static const ase_char_t* __errstr[] = { diff --git a/ase/lsp/eval.c b/ase/lsp/eval.c index 4ef6d1e4..739e6c05 100644 --- a/ase/lsp/eval.c +++ b/ase/lsp/eval.c @@ -1,5 +1,5 @@ /* - * $Id: eval.c,v 1.15 2006-10-24 04:22:39 bacon Exp $ + * $Id: eval.c,v 1.16 2006-10-25 13:42:31 bacon Exp $ */ #include @@ -20,7 +20,7 @@ ase_lsp_obj_t* ase_lsp_eval (ase_lsp_t* lsp, ase_lsp_obj_t* obj) if (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_CONS) return eval_cons (lsp, obj); - else if (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_SYMBOL) { + else if (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_SYM) { ase_lsp_assoc_t* assoc; /* @@ -80,8 +80,8 @@ static ase_lsp_obj_t* make_func (ase_lsp_t* lsp, ase_lsp_obj_t* cdr, int is_macr } func = (is_macro)? - ase_lsp_make_macro (lsp->mem, formal, body): - ase_lsp_make_func (lsp->mem, formal, body); + ase_lsp_makemacro (lsp->mem, formal, body): + ase_lsp_makefunc (lsp->mem, formal, body); if (func == ASE_NULL) { lsp->errnum = ASE_LSP_ERR_MEMORY; return ASE_NULL; @@ -99,16 +99,20 @@ static ase_lsp_obj_t* eval_cons (ase_lsp_t* lsp, ase_lsp_obj_t* cons) car = ASE_LSP_CAR(cons); cdr = ASE_LSP_CDR(cons); - if (car == lsp->mem->lambda) { + if (car == lsp->mem->lambda) + { return make_func (lsp, cdr, 0); } - else if (car == lsp->mem->macro) { + else if (car == lsp->mem->macro) + { return make_func (lsp, cdr, 1); } - else if (ASE_LSP_TYPE(car) == ASE_LSP_OBJ_SYMBOL) { + else if (ASE_LSP_TYPE(car) == ASE_LSP_OBJ_SYM) + { ase_lsp_assoc_t* assoc; - if ((assoc = ase_lsp_lookup(lsp->mem, car)) != ASE_NULL) { + if ((assoc = ase_lsp_lookup(lsp->mem, car)) != ASE_NULL) + { //ase_lsp_obj_t* func = assoc->value; ase_lsp_obj_t* func = assoc->func; if (func == ASE_NULL) { @@ -118,14 +122,17 @@ static ase_lsp_obj_t* eval_cons (ase_lsp_t* lsp, ase_lsp_obj_t* cons) } if (ASE_LSP_TYPE(func) == ASE_LSP_OBJ_FUNC || - ASE_LSP_TYPE(func) == ASE_LSP_OBJ_MACRO) { + ASE_LSP_TYPE(func) == ASE_LSP_OBJ_MACRO) + { return apply (lsp, func, cdr); } - else if (ASE_LSP_TYPE(func) == ASE_LSP_OBJ_PRIM) { + else if (ASE_LSP_TYPE(func) == ASE_LSP_OBJ_PRIM) + { /* primitive function */ return ASE_LSP_PRIM(func) (lsp, cdr); } - else { + else + { //TODO: emit the name for debugging lsp->errnum = ASE_LSP_ERR_UNDEF_FUNC; return ASE_NULL; diff --git a/ase/lsp/lsp.h b/ase/lsp/lsp.h index a036b611..ddea625a 100644 --- a/ase/lsp/lsp.h +++ b/ase/lsp/lsp.h @@ -1,11 +1,12 @@ /* - * $Id: lsp.h,v 1.25 2006-10-24 04:22:39 bacon Exp $ + * $Id: lsp.h,v 1.26 2006-10-25 13:42:31 bacon Exp $ */ #ifndef _ASE_LSP_LSP_H_ #define _ASE_LSP_LSP_H_ -#include +#include +#include typedef struct ase_lsp_t ase_lsp_t; typedef struct ase_lsp_obj_t ase_lsp_obj_t; @@ -117,6 +118,32 @@ int ase_lsp_print (ase_lsp_t* lsp, const ase_lsp_obj_t* obj); int ase_lsp_add_prim (ase_lsp_t* lsp, const ase_char_t* name, ase_lsp_prim_t prim); int ase_lsp_remove_prim (ase_lsp_t* lsp, const ase_char_t* name); +/* string functions exported by lsp.h */ +ase_char_t* ase_lsp_strdup (ase_lsp_t* lsp, const ase_char_t* str); +ase_char_t* ase_lsp_strxdup ( + ase_lsp_t* lsp, const ase_char_t* str, ase_size_t len); +ase_char_t* ase_lsp_strxdup2 ( + ase_lsp_t* lsp, + const ase_char_t* str1, ase_size_t len1, + const ase_char_t* str2, ase_size_t len2); + +ase_size_t ase_lsp_strlen (const ase_char_t* str); +ase_size_t ase_lsp_strcpy (ase_char_t* buf, const ase_char_t* str); +ase_size_t ase_lsp_strncpy (ase_char_t* buf, const ase_char_t* str, ase_size_t len); +int ase_lsp_strcmp (const ase_char_t* s1, const ase_char_t* s2); + +int ase_lsp_strxncmp ( + const ase_char_t* s1, ase_size_t len1, + const ase_char_t* s2, ase_size_t len2); + +int ase_lsp_strxncasecmp ( + ase_lsp_t* lsp, + const ase_char_t* s1, ase_size_t len1, + const ase_char_t* s2, ase_size_t len2); + +ase_char_t* ase_lsp_strxnstr ( + const ase_char_t* str, ase_size_t strsz, + const ase_char_t* sub, ase_size_t subsz); const ase_char_t* ase_lsp_geterrstr (int errnum); diff --git a/ase/lsp/mem.c b/ase/lsp/mem.c index b58052e5..8ea1349e 100644 --- a/ase/lsp/mem.c +++ b/ase/lsp/mem.c @@ -1,5 +1,5 @@ /* - * $Id: mem.c,v 1.13 2006-10-24 15:31:35 bacon Exp $ + * $Id: mem.c,v 1.14 2006-10-25 13:42:31 bacon Exp $ */ #include @@ -56,11 +56,11 @@ ase_lsp_mem_t* ase_lsp_openmem ( mem->macro = ASE_NULL; /* initialize common object pointers */ - mem->nil = ase_lsp_make_nil (mem); - mem->t = ase_lsp_make_true (mem); - mem->quote = ase_lsp_make_symbol (mem, ASE_T("quote")); - mem->lambda = ase_lsp_make_symbol (mem, ASE_T("lambda")); - mem->macro = ase_lsp_make_symbol (mem, ASE_T("macro")); + mem->nil = ase_lsp_makenil (mem); + mem->t = ase_lsp_maketrue (mem); + mem->quote = ase_lsp_makesymobj (mem, ASE_T("quote"), 5); + mem->lambda = ase_lsp_makesymobj (mem, ASE_T("lambda"), 6); + mem->macro = ase_lsp_makesymobj (mem, ASE_T("macro"), 5); if (mem->nil == ASE_NULL || mem->t == ASE_NULL || @@ -98,17 +98,17 @@ static int __add_prim (ase_lsp_mem_t* mem, { ase_lsp_obj_t* n, * p; - n = ase_lsp_make_symbolx (mem, name, len); + n = ase_lsp_makesymobj (mem, name, len); if (n == ASE_NULL) return -1; - ase_lsp_lock (n); + ase_lsp_lockobj (mem->lsp, n); - p = ase_lsp_make_prim (mem, prim); + p = ase_lsp_makeprim (mem, prim); if (p == ASE_NULL) return -1; - ase_lsp_unlock (n); + ase_lsp_unlockobj (mem->lsp, n); - if (ase_lsp_set_func(mem, n, p) == ASE_NULL) return -1; + if (ase_lsp_setfunc(mem, n, p) == ASE_NULL) return -1; return 0; } @@ -161,11 +161,12 @@ ase_lsp_obj_t* ase_lsp_alloc (ase_lsp_mem_t* mem, int type, ase_size_t size) if (mem->count >= mem->ubound) return ASE_NULL; } - obj = (ase_lsp_obj_t*) ase_malloc (size); - if (obj == ASE_NULL) { + obj = (ase_lsp_obj_t*) ASE_LSP_MALLOC (mem->lsp, size); + if (obj == ASE_NULL) + { ase_lsp_collectgarbage (mem); - obj = (ase_lsp_obj_t*) ase_malloc (size); + obj = (ase_lsp_obj_t*) ASE_LSP_MALLOC (mem->lsp, size); if (obj == ASE_NULL) return ASE_NULL; } @@ -225,9 +226,9 @@ void ase_lsp_dispose_all (ase_lsp_mem_t* mem) } } -static void __mark_obj (ase_lsp_obj_t* obj) +static void __mark_obj (ase_lsp_t* lsp, ase_lsp_obj_t* obj) { - ase_assert (obj != ASE_NULL); + ase_lsp_assert (lsp, obj != ASE_NULL); // TODO:.... // can it be recursive? @@ -237,57 +238,57 @@ static void __mark_obj (ase_lsp_obj_t* obj) if (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_CONS) { - __mark_obj (ASE_LSP_CAR(obj)); - __mark_obj (ASE_LSP_CDR(obj)); + __mark_obj (lsp, ASE_LSP_CAR(obj)); + __mark_obj (lsp, ASE_LSP_CDR(obj)); } else if (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_FUNC) { - __mark_obj (ASE_LSP_FFORMAL(obj)); - __mark_obj (ASE_LSP_FBODY(obj)); + __mark_obj (lsp, ASE_LSP_FFORMAL(obj)); + __mark_obj (lsp, ASE_LSP_FBODY(obj)); } else if (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_MACRO) { - __mark_obj (ASE_LSP_MFORMAL(obj)); - __mark_obj (ASE_LSP_MBODY(obj)); + __mark_obj (lsp, ASE_LSP_MFORMAL(obj)); + __mark_obj (lsp, ASE_LSP_MBODY(obj)); } } /* - * ase_lsp_lock and ase_lsp_unlockallobjs are just called by ase_lsp_read. + * ase_lsp_lockobj and ase_lsp_unlockallobjs are just called by ase_lsp_read. */ -void ase_lsp_lockobj (ase_lsp_obj_t* obj) +void ase_lsp_lockobj (ase_lsp_t* lsp, ase_lsp_obj_t* obj) { - ase_assert (obj != ASE_NULL); + ase_lsp_assert (lsp, obj != ASE_NULL); ASE_LSP_LOCK(obj) = 1; //ASE_LSP_MARK(obj) = 1; } -void ase_lsp_unlockobj (ase_lsp_obj_t* obj) +void ase_lsp_unlockobj (ase_lsp_t* lsp, ase_lsp_obj_t* obj) { - ase_assert (obj != ASE_NULL); + ase_lsp_assert (lsp, obj != ASE_NULL); ASE_LSP_LOCK(obj) = 0; } -void ase_lsp_unlockallobjs (ase_lsp_obj_t* obj) +void ase_lsp_unlockallobjs (ase_lsp_t* lsp, ase_lsp_obj_t* obj) { - ase_assert (obj != ASE_NULL); + ase_lsp_assert (lsp, obj != ASE_NULL); ASE_LSP_LOCK(obj) = 0; if (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_CONS) { - ase_lsp_unlockallobjs (ASE_LSP_CAR(obj)); - ase_lsp_unlockallobjs (ASE_LSP_CDR(obj)); + ase_lsp_unlockallobjs (lsp, ASE_LSP_CAR(obj)); + ase_lsp_unlockallobjs (lsp, ASE_LSP_CDR(obj)); } else if (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_FUNC) { - ase_lsp_unlockallobjs (ASE_LSP_FFORMAL(obj)); - ase_lsp_unlockallobjs (ASE_LSP_FBODY(obj)); + ase_lsp_unlockallobjs (lsp, ASE_LSP_FFORMAL(obj)); + ase_lsp_unlockallobjs (lsp, ASE_LSP_FBODY(obj)); } else if (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_MACRO) { - ase_lsp_unlockallobjs (ASE_LSP_MFORMAL(obj)); - ase_lsp_unlockallobjs (ASE_LSP_MBODY(obj)); + ase_lsp_unlockallobjs (lsp, ASE_LSP_MFORMAL(obj)); + ase_lsp_unlockallobjs (lsp, ASE_LSP_MBODY(obj)); } } @@ -308,12 +309,12 @@ static void ase_lsp_markobjsinuse (ase_lsp_mem_t* mem) assoc = frame->assoc; while (assoc != ASE_NULL) { - __mark_obj (assoc->name); + __mark_obj (mem->lsp, assoc->name); if (assoc->value != ASE_NULL) - __mark_obj (assoc->value); + __mark_obj (mem->lsp, assoc->value); if (assoc->func != ASE_NULL) - __mark_obj (assoc->func); + __mark_obj (mem->lsp, assoc->func); assoc = assoc->link; } @@ -331,12 +332,12 @@ static void ase_lsp_markobjsinuse (ase_lsp_mem_t* mem) assoc = frame->assoc; while (assoc != ASE_NULL) { - __mark_obj (assoc->name); + __mark_obj (mem->lsp, assoc->name); if (assoc->value != ASE_NULL) - __mark_obj (assoc->value); + __mark_obj (mem->lsp, assoc->value); if (assoc->func != ASE_NULL) - __mark_obj (assoc->func); + __mark_obj (mem->lsp, assoc->func); assoc = assoc->link; } @@ -346,26 +347,27 @@ static void ase_lsp_markobjsinuse (ase_lsp_mem_t* mem) /* ase_dprint0 (ASE_T("marking the locked object\n")); - if (mem->locked != ASE_NULL) __mark_obj (mem->locked); + if (mem->locked != ASE_NULL) __mark_obj (mem->lsp, mem->locked); */ #if 0 ase_dprint0 (ASE_T("marking termporary objects\n")); #endif array = mem->temp_array; - for (i = 0; i < array->size; i++) { - __mark_obj (array->buffer[i]); + for (i = 0; i < array->size; i++) + { + __mark_obj (mem->lsp, array->buffer[i]); } #if 0 ase_dprint0 (ASE_T("marking builtin objects\n")); #endif // mark common objects - if (mem->t != ASE_NULL) __mark_obj (mem->t); - if (mem->nil != ASE_NULL) __mark_obj (mem->nil); - if (mem->quote != ASE_NULL) __mark_obj (mem->quote); - if (mem->lambda != ASE_NULL) __mark_obj (mem->lambda); - if (mem->macro != ASE_NULL) __mark_obj (mem->macro); + if (mem->t != ASE_NULL) __mark_obj (mem->lsp, mem->t); + if (mem->nil != ASE_NULL) __mark_obj (mem->lsp, mem->nil); + if (mem->quote != ASE_NULL) __mark_obj (mem->lsp, mem->quote); + if (mem->lambda != ASE_NULL) __mark_obj (mem->lsp, mem->lambda); + if (mem->macro != ASE_NULL) __mark_obj (mem->lsp, mem->macro); } static void ase_lsp_sweepunmarkedobjs (ase_lsp_mem_t* mem) @@ -408,21 +410,23 @@ void ase_lsp_collectgarbage (ase_lsp_mem_t* mem) ase_lsp_sweepunmarkedobjs (mem); } -ase_lsp_obj_t* ase_lsp_make_nil (ase_lsp_mem_t* mem) +ase_lsp_obj_t* ase_lsp_makenil (ase_lsp_mem_t* mem) { if (mem->nil != ASE_NULL) return mem->nil; - mem->nil = ase_lsp_alloc (mem, ASE_LSP_OBJ_NIL, ase_sizeof(ase_lsp_obj_nil_t)); + mem->nil = ase_lsp_alloc ( + mem, ASE_LSP_OBJ_NIL, ase_sizeof(ase_lsp_obj_nil_t)); return mem->nil; } -ase_lsp_obj_t* ase_lsp_make_true (ase_lsp_mem_t* mem) +ase_lsp_obj_t* ase_lsp_maketrue (ase_lsp_mem_t* mem) { if (mem->t != ASE_NULL) return mem->t; - mem->t = ase_lsp_alloc (mem, ASE_LSP_OBJ_TRUE, ase_sizeof(ase_lsp_obj_true_t)); + mem->t = ase_lsp_alloc ( + mem, ASE_LSP_OBJ_TRUE, ase_sizeof(ase_lsp_obj_true_t)); return mem->t; } -ase_lsp_obj_t* ase_lsp_make_int (ase_lsp_mem_t* mem, ase_lsp_int_t value) +ase_lsp_obj_t* ase_lsp_makeintobj (ase_lsp_mem_t* mem, ase_long_t value) { ase_lsp_obj_t* obj; @@ -435,7 +439,7 @@ ase_lsp_obj_t* ase_lsp_make_int (ase_lsp_mem_t* mem, ase_lsp_int_t value) return obj; } -ase_lsp_obj_t* ase_lsp_make_real (ase_lsp_mem_t* mem, ase_lsp_real_t value) +ase_lsp_obj_t* ase_lsp_makerealobj (ase_lsp_mem_t* mem, ase_real_t value) { ase_lsp_obj_t* obj; @@ -448,57 +452,50 @@ ase_lsp_obj_t* ase_lsp_make_real (ase_lsp_mem_t* mem, ase_lsp_real_t value) return obj; } -ase_lsp_obj_t* ase_lsp_make_symbol (ase_lsp_mem_t* mem, const ase_char_t* str) -{ - return ase_lsp_make_symbolx (mem, str, ase_strlen(str)); -} - -ase_lsp_obj_t* ase_lsp_make_symbolx ( +ase_lsp_obj_t* ase_lsp_makesymobj ( ase_lsp_mem_t* mem, const ase_char_t* str, ase_size_t len) { ase_lsp_obj_t* obj; // look for a sysmbol with the given name - obj = mem->used[ASE_LSP_OBJ_SYMBOL]; - while (obj != ASE_NULL) { + obj = mem->used[ASE_LSP_OBJ_SYM]; + while (obj != ASE_NULL) + { // if there is a symbol with the same name, it is just used. - if (ase_lsp_comp_symbol2 (obj, str, len) == 0) return obj; + if (ase_lsp_strxncmp ( + ASE_LSP_SYMVALUE(obj), + ASE_LSP_SYMLEN(obj), str, len) == 0) return obj; obj = ASE_LSP_LINK(obj); } // no such symbol found. create a new one - obj = ase_lsp_alloc (mem, ASE_LSP_OBJ_SYMBOL, - ase_sizeof(ase_lsp_obj_symbol_t) + (len + 1) * ase_sizeof(ase_char_t)); + obj = ase_lsp_alloc (mem, ASE_LSP_OBJ_SYM, + ase_sizeof(ase_lsp_obj_sym_t)+(len + 1)*ase_sizeof(ase_char_t)); if (obj == ASE_NULL) return ASE_NULL; // fill in the symbol buffer - ase_lsp_copy_string2 (ASE_LSP_SYMVALUE(obj), str, len); + ase_lsp_strncpy (ASE_LSP_SYMVALUE(obj), str, len); return obj; } -ase_lsp_obj_t* ase_lsp_make_string (ase_lsp_mem_t* mem, const ase_char_t* str) -{ - return ase_lsp_make_stringx (mem, str, ase_strlen(str)); -} - -ase_lsp_obj_t* ase_lsp_make_stringx ( +ase_lsp_obj_t* ase_lsp_makestrobj ( ase_lsp_mem_t* mem, const ase_char_t* str, ase_size_t len) { ase_lsp_obj_t* obj; // allocate memory for the string - obj = ase_lsp_alloc (mem, ASE_LSP_OBJ_STRING, - ase_sizeof(ase_lsp_obj_string_t) + (len + 1) * ase_sizeof(ase_char_t)); + obj = ase_lsp_alloc (mem, ASE_LSP_OBJ_STR, + ase_sizeof(ase_lsp_obj_str_t)+(len + 1)*ase_sizeof(ase_char_t)); if (obj == ASE_NULL) return ASE_NULL; // fill in the string buffer - ase_lsp_copy_string2 (ASE_LSP_STRVALUE(obj), str, len); + ase_lsp_strncpy (ASE_LSP_STRVALUE(obj), str, len); return obj; } -ase_lsp_obj_t* ase_lsp_make_cons ( +ase_lsp_obj_t* ase_lsp_makecons ( ase_lsp_mem_t* mem, ase_lsp_obj_t* car, ase_lsp_obj_t* cdr) { ase_lsp_obj_t* obj; @@ -512,7 +509,7 @@ ase_lsp_obj_t* ase_lsp_make_cons ( return obj; } -ase_lsp_obj_t* ase_lsp_make_func ( +ase_lsp_obj_t* ase_lsp_makefunc ( ase_lsp_mem_t* mem, ase_lsp_obj_t* formal, ase_lsp_obj_t* body) { ase_lsp_obj_t* obj; @@ -526,7 +523,7 @@ ase_lsp_obj_t* ase_lsp_make_func ( return obj; } -ase_lsp_obj_t* ase_lsp_make_macro ( +ase_lsp_obj_t* ase_lsp_makemacro ( ase_lsp_mem_t* mem, ase_lsp_obj_t* formal, ase_lsp_obj_t* body) { ase_lsp_obj_t* obj; @@ -540,15 +537,16 @@ ase_lsp_obj_t* ase_lsp_make_macro ( return obj; } -ase_lsp_obj_t* ase_lsp_make_prim (ase_lsp_mem_t* mem, void* impl) +ase_lsp_obj_t* ase_lsp_makeprim (ase_lsp_mem_t* mem, void* impl) { ase_lsp_obj_t* obj; - obj = ase_lsp_alloc (mem, ASE_LSP_OBJ_PRIM, ase_sizeof(ase_lsp_obj_prim_t)); + obj = ase_lsp_alloc ( + mem, ASE_LSP_OBJ_PRIM, ase_sizeof(ase_lsp_obj_prim_t)); if (obj == ASE_NULL) return ASE_NULL; - ASE_LSP_PRIM(obj) = impl; - + /*ASE_LSP_PRIM(obj) = (ase_lsp_prim_t)impl;*/ + ((ase_lsp_obj_prim_t*)obj)->impl = impl; return obj; } @@ -557,11 +555,12 @@ ase_lsp_assoc_t* ase_lsp_lookup (ase_lsp_mem_t* mem, ase_lsp_obj_t* name) ase_lsp_frame_t* frame; ase_lsp_assoc_t* assoc; - ase_assert (ASE_LSP_TYPE(name) == ASE_LSP_OBJ_SYMBOL); + ase_lsp_assert (mem->lsp, ASE_LSP_TYPE(name) == ASE_LSP_OBJ_SYM); frame = mem->frame; - while (frame != ASE_NULL) { + while (frame != ASE_NULL) + { assoc = ase_lsp_frame_lookup (frame, name); if (assoc != ASE_NULL) return assoc; frame = frame->link; @@ -570,13 +569,14 @@ ase_lsp_assoc_t* ase_lsp_lookup (ase_lsp_mem_t* mem, ase_lsp_obj_t* name) return ASE_NULL; } -ase_lsp_assoc_t* ase_lsp_set_value ( +ase_lsp_assoc_t* ase_lsp_setvalue ( ase_lsp_mem_t* mem, ase_lsp_obj_t* name, ase_lsp_obj_t* value) { ase_lsp_assoc_t* assoc; assoc = ase_lsp_lookup (mem, name); - if (assoc == ASE_NULL) { + if (assoc == ASE_NULL) + { assoc = ase_lsp_frame_insert_value ( mem->root_frame, name, value); if (assoc == ASE_NULL) return ASE_NULL; @@ -586,13 +586,14 @@ ase_lsp_assoc_t* ase_lsp_set_value ( return assoc; } -ase_lsp_assoc_t* ase_lsp_set_func ( +ase_lsp_assoc_t* ase_lsp_setfunc ( ase_lsp_mem_t* mem, ase_lsp_obj_t* name, ase_lsp_obj_t* func) { ase_lsp_assoc_t* assoc; assoc = ase_lsp_lookup (mem, name); - if (assoc == ASE_NULL) { + if (assoc == ASE_NULL) + { assoc = ase_lsp_frame_insert_func (mem->root_frame, name, func); if (assoc == ASE_NULL) return ASE_NULL; } @@ -605,11 +606,13 @@ ase_size_t ase_lsp_cons_len (ase_lsp_mem_t* mem, ase_lsp_obj_t* obj) { ase_size_t count; - ase_assert (obj == mem->nil || ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_CONS); + ase_lsp_assert (mem->lsp, + obj == mem->nil || ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_CONS); count = 0; //while (obj != mem->nil) { - while (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_CONS) { + while (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_CONS) + { count++; obj = ASE_LSP_CDR(obj); } @@ -617,11 +620,12 @@ ase_size_t ase_lsp_cons_len (ase_lsp_mem_t* mem, ase_lsp_obj_t* obj) return count; } -int ase_lsp_probe_args (ase_lsp_mem_t* mem, ase_lsp_obj_t* obj, ase_size_t* len) +int ase_lsp_probeargs (ase_lsp_mem_t* mem, ase_lsp_obj_t* obj, ase_size_t* len) { ase_size_t count = 0; - while (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_CONS) { + while (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_CONS) + { count++; obj = ASE_LSP_CDR(obj); } @@ -632,102 +636,4 @@ int ase_lsp_probe_args (ase_lsp_mem_t* mem, ase_lsp_obj_t* obj, ase_size_t* len) return 0; } -int ase_lsp_comp_symbol (ase_lsp_obj_t* obj, const ase_char_t* str) -{ - ase_char_t* p; - ase_size_t index, length; - - ase_assert (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_SYMBOL); - - index = 0; - length = ASE_LSP_SYMLEN(obj); - - p = ASE_LSP_SYMVALUE(obj); - while (index < length) { - if (*p > *str) return 1; - if (*p < *str) return -1; - index++; p++; str++; - } - - return (*str == ASE_T('\0'))? 0: -1; -} - -int ase_lsp_comp_symbol2 (ase_lsp_obj_t* obj, const ase_char_t* str, ase_size_t len) -{ - ase_char_t* p; - ase_size_t index, length; - - ase_assert (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_SYMBOL); - - index = 0; - length = ASE_LSP_SYMLEN(obj); - p = ASE_LSP_SYMVALUE(obj); - - while (index < length && index < len) { - if (*p > *str) return 1; - if (*p < *str) return -1; - index++; p++; str++; - } - - return (length < len)? -1: - (length > len)? 1: 0; -} - -int ase_lsp_comp_string (ase_lsp_obj_t* obj, const ase_char_t* str) -{ - ase_char_t* p; - ase_size_t index, length; - - ase_assert (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_STRING); - - index = 0; - length = ASE_LSP_STRLEN(obj); - - p = ASE_LSP_STRVALUE(obj); - while (index < length) { - if (*p > *str) return 1; - if (*p < *str) return -1; - index++; p++; str++; - } - - return (*str == ASE_T('\0'))? 0: -1; -} - -int ase_lsp_comp_string2 (ase_lsp_obj_t* obj, const ase_char_t* str, ase_size_t len) -{ - ase_char_t* p; - ase_size_t index, length; - - ase_assert (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_STRING); - - index = 0; - length = ASE_LSP_STRLEN(obj); - p = ASE_LSP_STRVALUE(obj); - - while (index < length && index < len) { - if (*p > *str) return 1; - if (*p < *str) return -1; - index++; p++; str++; - } - - return (length < len)? -1: - (length > len)? 1: 0; -} - -void ase_lsp_copy_string (ase_char_t* dst, const ase_char_t* str) -{ - // the buffer pointed by dst should be big enough to hold str - while (*str != ASE_T('\0')) *dst++ = *str++; - *dst = ASE_T('\0'); -} - -void ase_lsp_copy_string2 (ase_char_t* dst, const ase_char_t* str, ase_size_t len) -{ - // the buffer pointed by dst should be big enough to hold str - while (len > 0) { - *dst++ = *str++; - len--; - } - *dst = ASE_T('\0'); -} diff --git a/ase/lsp/mem.h b/ase/lsp/mem.h index 92bea735..df64e6f7 100644 --- a/ase/lsp/mem.h +++ b/ase/lsp/mem.h @@ -1,5 +1,5 @@ /* - * $Id: mem.h,v 1.10 2006-10-24 15:31:35 bacon Exp $ + * $Id: mem.h,v 1.11 2006-10-25 13:42:31 bacon Exp $ */ #ifndef _ASE_LSP_MEM_H_ @@ -65,51 +65,40 @@ void ase_lsp_dispose (ase_lsp_mem_t* mem, ase_lsp_obj_t* prev, ase_lsp_obj_t* o void ase_lsp_dispose_all (ase_lsp_mem_t* mem); void ase_lsp_collectgarbage (ase_lsp_mem_t* mem); -void ase_lsp_lockobj (ase_lsp_obj_t* obj); -void ase_lsp_unlockobj (ase_lsp_obj_t* obj); -void ase_lsp_unlockallobjs (ase_lsp_obj_t* obj); +void ase_lsp_lockobj (ase_lsp_t* lsp, ase_lsp_obj_t* obj); +void ase_lsp_unlockobj (ase_lsp_t* lsp, ase_lsp_obj_t* obj); +void ase_lsp_unlockallobjs (ase_lsp_t* lsp, ase_lsp_obj_t* obj); // object creation of standard types -ase_lsp_obj_t* ase_lsp_make_nil (ase_lsp_mem_t* mem); -ase_lsp_obj_t* ase_lsp_make_true (ase_lsp_mem_t* mem); -ase_lsp_obj_t* ase_lsp_make_int (ase_lsp_mem_t* mem, ase_lsp_int_t value); -ase_lsp_obj_t* ase_lsp_make_real (ase_lsp_mem_t* mem, ase_lsp_real_t value); +ase_lsp_obj_t* ase_lsp_makenil (ase_lsp_mem_t* mem); +ase_lsp_obj_t* ase_lsp_maketrue (ase_lsp_mem_t* mem); +ase_lsp_obj_t* ase_lsp_makeintobj (ase_lsp_mem_t* mem, ase_long_t value); +ase_lsp_obj_t* ase_lsp_makerealobj (ase_lsp_mem_t* mem, ase_real_t value); -ase_lsp_obj_t* ase_lsp_make_symbol ( - ase_lsp_mem_t* mem, const ase_char_t* str); -ase_lsp_obj_t* ase_lsp_make_symbolx ( +ase_lsp_obj_t* ase_lsp_makesymobj ( ase_lsp_mem_t* mem, const ase_char_t* str, ase_size_t len); -ase_lsp_obj_t* ase_lsp_make_string ( - ase_lsp_mem_t* mem, const ase_char_t* str); -ase_lsp_obj_t* ase_lsp_make_stringx ( +ase_lsp_obj_t* ase_lsp_makestrobj ( ase_lsp_mem_t* mem, const ase_char_t* str, ase_size_t len); -ase_lsp_obj_t* ase_lsp_make_cons ( + +ase_lsp_obj_t* ase_lsp_makecons ( ase_lsp_mem_t* mem, ase_lsp_obj_t* car, ase_lsp_obj_t* cdr); -ase_lsp_obj_t* ase_lsp_make_func ( +ase_lsp_obj_t* ase_lsp_makefunc ( ase_lsp_mem_t* mem, ase_lsp_obj_t* formal, ase_lsp_obj_t* body); -ase_lsp_obj_t* ase_lsp_make_macro ( +ase_lsp_obj_t* ase_lsp_makemacro ( ase_lsp_mem_t* mem, ase_lsp_obj_t* formal, ase_lsp_obj_t* body); -ase_lsp_obj_t* ase_lsp_make_prim (ase_lsp_mem_t* mem, void* impl); +ase_lsp_obj_t* ase_lsp_makeprim (ase_lsp_mem_t* mem, void* impl); // frame lookup ase_lsp_assoc_t* ase_lsp_lookup (ase_lsp_mem_t* mem, ase_lsp_obj_t* name); -ase_lsp_assoc_t* ase_lsp_set_value ( +ase_lsp_assoc_t* ase_lsp_setvalue ( ase_lsp_mem_t* mem, ase_lsp_obj_t* name, ase_lsp_obj_t* value); -ase_lsp_assoc_t* ase_lsp_set_func ( +ase_lsp_assoc_t* ase_lsp_setfunc ( ase_lsp_mem_t* mem, ase_lsp_obj_t* name, ase_lsp_obj_t* func); // cons operations ase_size_t ase_lsp_cons_len (ase_lsp_mem_t* mem, ase_lsp_obj_t* obj); -int ase_lsp_probe_args (ase_lsp_mem_t* mem, ase_lsp_obj_t* obj, ase_size_t* len); - -// symbol and string operations -int ase_lsp_comp_symbol (ase_lsp_obj_t* obj, const ase_char_t* str); -int ase_lsp_comp_symbol2 (ase_lsp_obj_t* obj, const ase_char_t* str, ase_size_t len); -int ase_lsp_comp_string (ase_lsp_obj_t* obj, const ase_char_t* str); -int ase_lsp_comp_string2 (ase_lsp_obj_t* obj, const ase_char_t* str, ase_size_t len); -void ase_lsp_copy_string (ase_char_t* dst, const ase_char_t* str); -void ase_lsp_copy_string2 (ase_char_t* dst, const ase_char_t* str, ase_size_t len); +int ase_lsp_probeargs (ase_lsp_mem_t* mem, ase_lsp_obj_t* obj, ase_size_t* len); #ifdef __cplusplus } diff --git a/ase/lsp/obj.h b/ase/lsp/obj.h index e9f241e0..a9553d91 100644 --- a/ase/lsp/obj.h +++ b/ase/lsp/obj.h @@ -1,5 +1,5 @@ /* - * $Id: obj.h,v 1.7 2006-10-24 04:22:39 bacon Exp $ + * $Id: obj.h,v 1.8 2006-10-25 13:42:31 bacon Exp $ */ #ifndef _ASE_LSP_OBJ_H_ @@ -14,8 +14,8 @@ enum ASE_LSP_OBJ_TRUE, ASE_LSP_OBJ_INT, ASE_LSP_OBJ_REAL, - ASE_LSP_OBJ_SYMBOL, - ASE_LSP_OBJ_STRING, + ASE_LSP_OBJ_SYM, + ASE_LSP_OBJ_STR, ASE_LSP_OBJ_CONS, ASE_LSP_OBJ_FUNC, ASE_LSP_OBJ_MACRO, @@ -30,8 +30,8 @@ typedef struct ase_lsp_obj_nil_t ase_lsp_obj_nil_t; typedef struct ase_lsp_obj_true_t ase_lsp_obj_true_t; typedef struct ase_lsp_obj_int_t ase_lsp_obj_int_t; typedef struct ase_lsp_obj_real_t ase_lsp_obj_real_t; -typedef struct ase_lsp_obj_symbol_t ase_lsp_obj_symbol_t; -typedef struct ase_lsp_obj_string_t ase_lsp_obj_string_t; +typedef struct ase_lsp_obj_sym_t ase_lsp_obj_sym_t; +typedef struct ase_lsp_obj_str_t ase_lsp_obj_str_t; typedef struct ase_lsp_obj_cons_t ase_lsp_obj_cons_t; typedef struct ase_lsp_obj_func_t ase_lsp_obj_func_t; typedef struct ase_lsp_obj_macro_t ase_lsp_obj_macro_t; @@ -64,16 +64,16 @@ struct ase_lsp_obj_true_t struct ase_lsp_obj_int_t { ase_lsp_objhdr_t hdr; - ase_lsp_int_t value; + ase_long_t value; }; struct ase_lsp_obj_real_t { ase_lsp_objhdr_t hdr; - ase_lsp_real_t value; + ase_real_t value; }; -struct ase_lsp_obj_symbol_t +struct ase_lsp_obj_sym_t { ase_lsp_objhdr_t hdr; #if defined(__BORLANDC__) || defined(_MSC_VER) @@ -82,7 +82,7 @@ struct ase_lsp_obj_symbol_t #endif }; -struct ase_lsp_obj_string_t +struct ase_lsp_obj_str_t { ase_lsp_objhdr_t hdr; #if defined(__BORLANDC__) || defined(_MSC_VER) @@ -129,19 +129,19 @@ struct ase_lsp_obj_prim_t #define ASE_LSP_IVALUE(x) (((ase_lsp_obj_int_t*)x)->value) #define ASE_LSP_RVALUE(x) (((ase_lsp_obj_real_t*)x)->value) -#ifdef __BORLANDC__ -#define ASE_LSP_SYMVALUE(x) ((ase_char_t*)(((ase_lsp_obj_symbol_t*)x) + 1)) +#if defined(__BORLANDC__) || defined(_MSC_VER) +#define ASE_LSP_SYMVALUE(x) ((ase_char_t*)(((ase_lsp_obj_sym_t*)x) + 1)) #else -#define ASE_LSP_SYMVALUE(x) (((ase_lsp_obj_symbol_t*)x)->buffer) +#define ASE_LSP_SYMVALUE(x) (((ase_lsp_obj_sym_t*)x)->buffer) #endif -#define ASE_LSP_SYMLEN(x) ((((ase_lsp_obj_symbol_t*)x)->hdr.size - sizeof(ase_lsp_obj_t)) / sizeof(ase_char_t) - 1) +#define ASE_LSP_SYMLEN(x) ((((ase_lsp_obj_sym_t*)x)->hdr.size - sizeof(ase_lsp_obj_t)) / sizeof(ase_char_t) - 1) -#ifdef __BORLANDC__ -#define ASE_LSP_STRVALUE(x) ((ase_char_t*)(((ase_lsp_obj_string_t*)x) + 1)) +#if defined(__BORLANDC__) || defined(_MSC_VER) +#define ASE_LSP_STRVALUE(x) ((ase_char_t*)(((ase_lsp_obj_str_t*)x) + 1)) #else -#define ASE_LSP_STRVALUE(x) (((ase_lsp_obj_string_t*)x)->buffer) +#define ASE_LSP_STRVALUE(x) (((ase_lsp_obj_str_t*)x)->buffer) #endif -#define ASE_LSP_STRLEN(x) ((((ase_lsp_obj_string_t*)x)->hdr.size - sizeof(ase_lsp_obj_t)) / sizeof(ase_char_t) - 1) +#define ASE_LSP_STRLEN(x) ((((ase_lsp_obj_str_t*)x)->hdr.size - sizeof(ase_lsp_obj_t)) / sizeof(ase_char_t) - 1) #define ASE_LSP_CAR(x) (((ase_lsp_obj_cons_t*)x)->car) #define ASE_LSP_CDR(x) (((ase_lsp_obj_cons_t*)x)->cdr) diff --git a/ase/lsp/prim.c b/ase/lsp/prim.c index 4fd2f358..2390c5cc 100644 --- a/ase/lsp/prim.c +++ b/ase/lsp/prim.c @@ -1,5 +1,5 @@ /* - * $Id: prim.c,v 1.10 2006-10-24 04:22:39 bacon Exp $ + * $Id: prim.c,v 1.11 2006-10-25 13:42:31 bacon Exp $ */ #include @@ -29,17 +29,17 @@ static int __add_prim (ase_lsp_mem_t* mem, { ase_lsp_obj_t* n, * p; - n = ase_lsp_make_symbolx (mem, name, len); + n = ase_lsp_makesymobj (mem, name, len); if (n == ASE_NULL) return -1; ase_lsp_lock (n); - p = ase_lsp_make_prim (mem, prim); + p = ase_lsp_makeprim (mem, prim); if (p == ASE_NULL) return -1; ase_lsp_unlock (n); - if (ase_lsp_set_func(mem, n, p) == ASE_NULL) return -1; + if (ase_lsp_setfunc(mem, n, p) == ASE_NULL) return -1; return 0; } @@ -249,9 +249,10 @@ ase_lsp_obj_t* ase_lsp_prim_cons (ase_lsp_t* lsp, ase_lsp_obj_t* args) cdr = ase_lsp_eval (lsp, ASE_LSP_CAR(ASE_LSP_CDR(args))); if (cdr == ASE_NULL) return ASE_NULL; - cons = ase_lsp_make_cons (lsp->mem, car, cdr); - if (cons == ASE_NULL) { - lsp->errnum = ASE_LSP_ERR_MEMORY; + cons = ase_lsp_makecons (lsp->mem, car, cdr); + if (cons == ASE_NULL) + { + lsp->errnum = ASE_LSP_ENOMEM; return ASE_NULL; } @@ -274,7 +275,7 @@ ase_lsp_obj_t* ase_lsp_prim_set (ase_lsp_t* lsp, ase_lsp_obj_t* args) p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args)); if (p1 == ASE_NULL) return ASE_NULL; - if (ASE_LSP_TYPE(p1) != ASE_LSP_OBJ_SYMBOL) { + if (ASE_LSP_TYPE(p1) != ASE_LSP_OBJ_SYM) { lsp->errnum = ASE_LSP_ERR_BAD_ARG; return ASE_NULL; } @@ -282,7 +283,7 @@ ase_lsp_obj_t* ase_lsp_prim_set (ase_lsp_t* lsp, ase_lsp_obj_t* args) p2 = ase_lsp_eval (lsp, ASE_LSP_CAR(ASE_LSP_CDR(args))); if (p2 == ASE_NULL) return ASE_NULL; - if (ase_lsp_set_value (lsp->mem, p1, p2) == ASE_NULL) { + if (ase_lsp_setvalue (lsp->mem, p1, p2) == ASE_NULL) { lsp->errnum = ASE_LSP_ERR_MEMORY; return ASE_NULL; } @@ -303,7 +304,7 @@ ase_lsp_obj_t* ase_lsp_prim_setq (ase_lsp_t* lsp, ase_lsp_obj_t* args) ase_assert (ASE_LSP_TYPE(p) == ASE_LSP_OBJ_CONS); p1 = ASE_LSP_CAR(p); - if (ASE_LSP_TYPE(p1) != ASE_LSP_OBJ_SYMBOL) { + if (ASE_LSP_TYPE(p1) != ASE_LSP_OBJ_SYM) { lsp->errnum = ASE_LSP_ERR_BAD_ARG; return ASE_NULL; } @@ -316,7 +317,7 @@ ase_lsp_obj_t* ase_lsp_prim_setq (ase_lsp_t* lsp, ase_lsp_obj_t* args) p2 = ase_lsp_eval (lsp, ASE_LSP_CAR(ASE_LSP_CDR(p))); if (p2 == ASE_NULL) return ASE_NULL; - if (ase_lsp_set_value (lsp->mem, p1, p2) == ASE_NULL) { + if (ase_lsp_setvalue (lsp->mem, p1, p2) == ASE_NULL) { lsp->errnum = ASE_LSP_ERR_MEMORY; return ASE_NULL; } @@ -354,16 +355,18 @@ ase_lsp_obj_t* ase_lsp_prim_defun (ase_lsp_t* lsp, ase_lsp_obj_t* args) ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 3, ASE_LSP_PRIM_MAX_ARG_COUNT); name = ASE_LSP_CAR(args); - if (ASE_LSP_TYPE(name) != ASE_LSP_OBJ_SYMBOL) { + if (ASE_LSP_TYPE(name) != ASE_LSP_OBJ_SYM) + { lsp->errnum = ASE_LSP_ERR_BAD_ARG; return ASE_NULL; } - fun = ase_lsp_make_func (lsp->mem, + fun = ase_lsp_makefunc (lsp->mem, ASE_LSP_CAR(ASE_LSP_CDR(args)), ASE_LSP_CDR(ASE_LSP_CDR(args))); if (fun == ASE_NULL) return ASE_NULL; - if (ase_lsp_set_func (lsp->mem, ASE_LSP_CAR(args), fun) == ASE_NULL) { + if (ase_lsp_setfunc (lsp->mem, ASE_LSP_CAR(args), fun) == ASE_NULL) + { lsp->errnum = ASE_LSP_ERR_MEMORY; return ASE_NULL; } @@ -382,16 +385,18 @@ ase_lsp_obj_t* ase_lsp_prim_demac (ase_lsp_t* lsp, ase_lsp_obj_t* args) ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 3, ASE_LSP_PRIM_MAX_ARG_COUNT); name = ASE_LSP_CAR(args); - if (ASE_LSP_TYPE(name) != ASE_LSP_OBJ_SYMBOL) { + if (ASE_LSP_TYPE(name) != ASE_LSP_OBJ_SYM) + { lsp->errnum = ASE_LSP_ERR_BAD_ARG; return ASE_NULL; } - mac = ase_lsp_make_macro (lsp->mem, + mac = ase_lsp_makemacro (lsp->mem, ASE_LSP_CAR(ASE_LSP_CDR(args)), ASE_LSP_CDR(ASE_LSP_CDR(args))); if (mac == ASE_NULL) return ASE_NULL; - if (ase_lsp_set_func (lsp->mem, ASE_LSP_CAR(args), mac) == ASE_NULL) { + if (ase_lsp_setfunc (lsp->mem, ASE_LSP_CAR(args), mac) == ASE_NULL) + { lsp->errnum = ASE_LSP_ERR_MEMORY; return ASE_NULL; } diff --git a/ase/lsp/prim.h b/ase/lsp/prim.h index 0a285ea0..76d35872 100644 --- a/ase/lsp/prim.h +++ b/ase/lsp/prim.h @@ -1,5 +1,5 @@ /* - * $Id: prim.h,v 1.8 2006-10-24 04:22:39 bacon Exp $ + * $Id: prim.h,v 1.9 2006-10-25 13:42:31 bacon Exp $ */ #ifndef _ASE_LSP_PRIM_H_ @@ -57,7 +57,7 @@ ase_lsp_obj_t* ase_lsp_prim_modulus (ase_lsp_t* lsp, ase_lsp_obj_t* args); #define ASE_LSP_PRIM_CHECK_ARG_COUNT(lsp,args,min,max) \ { \ ase_size_t count; \ - if (ase_lsp_probe_args(lsp->mem, args, &count) == -1) { \ + if (ase_lsp_probeargs(lsp->mem, args, &count) == -1) { \ lsp->errnum = ASE_LSP_ERR_BAD_ARG; \ return ASE_NULL; \ } \ diff --git a/ase/lsp/prim_compar.c b/ase/lsp/prim_compar.c index eee24100..377752a1 100644 --- a/ase/lsp/prim_compar.c +++ b/ase/lsp/prim_compar.c @@ -1,5 +1,5 @@ /* - * $Id: prim_compar.c,v 1.4 2006-10-24 04:22:39 bacon Exp $ + * $Id: prim_compar.c,v 1.5 2006-10-25 13:42:31 bacon Exp $ */ #include @@ -11,7 +11,7 @@ ase_lsp_obj_t* ase_lsp_prim_eq (ase_lsp_t* lsp, ase_lsp_obj_t* args) int res; ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2); - ase_assert (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); + ase_lsp_assert (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args)); if (p1 == ASE_NULL) return ASE_NULL; @@ -20,51 +20,67 @@ ase_lsp_obj_t* ase_lsp_prim_eq (ase_lsp_t* lsp, ase_lsp_obj_t* args) p2 = ase_lsp_eval (lsp, ASE_LSP_CAR(ASE_LSP_CDR(args))); if (p2 == ASE_NULL) return ASE_NULL; - if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_INT) { - if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) { + if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_INT) + { + if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) + { res = ASE_LSP_IVALUE(p1) == ASE_LSP_IVALUE(p2); } - else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL) { + else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL) + { res = ASE_LSP_IVALUE(p1) == ASE_LSP_RVALUE(p2); } - else { + else + { lsp->errnum = ASE_LSP_ERR_BAD_VALUE; return ASE_NULL; } } - else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_REAL) { - if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) { + else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_REAL) + { + if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) + { res = ASE_LSP_RVALUE(p1) == ASE_LSP_IVALUE(p2); } - else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL) { + else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL) + { res = ASE_LSP_RVALUE(p1) == ASE_LSP_RVALUE(p2); } - else { + else + { lsp->errnum = ASE_LSP_ERR_BAD_VALUE; return ASE_NULL; } } - else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_SYMBOL) { - if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYMBOL) { - res = ase_lsp_comp_symbol2 ( - p1, ASE_LSP_SYMVALUE(p2), ASE_LSP_SYMLEN(p2)) == 0; + else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_SYM) + { + if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYM) + { + res = ase_lsp_strxncmp ( + ASE_LSP_SYMVALUE(p1), ASE_LSP_SYMLEN(p1), + ASE_LSP_SYMVALUE(p2), ASE_LSP_SYMLEN(p2)) == 0; + } + else + { + lsp->errnum = ASE_LSP_ERR_BAD_VALUE; + return ASE_NULL; + } + } + else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_STR) + { + if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_STR) + { + res = ase_lsp_strxncmp ( + ASE_LSP_STRVALUE(p1), ASE_LSP_STRLEN(p1), + ASE_LSP_STRVALUE(p2), ASE_LSP_STRLEN(p2)) == 0; } else { lsp->errnum = ASE_LSP_ERR_BAD_VALUE; return ASE_NULL; } } - else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_STRING) { - if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_STRING) { - res = ase_lsp_comp_string2 ( - p1, ASE_LSP_STRVALUE(p2), ASE_LSP_STRLEN(p2)) == 0; - } - else { - lsp->errnum = ASE_LSP_ERR_BAD_VALUE; - return ASE_NULL; - } - } - else { + else + { lsp->errnum = ASE_LSP_ERR_BAD_VALUE; return ASE_NULL; } @@ -78,7 +94,7 @@ ase_lsp_obj_t* ase_lsp_prim_ne (ase_lsp_t* lsp, ase_lsp_obj_t* args) int res; ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2); - ase_assert (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); + ase_lsp_assert (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args)); if (p1 == ASE_NULL) return ASE_NULL; @@ -87,51 +103,68 @@ ase_lsp_obj_t* ase_lsp_prim_ne (ase_lsp_t* lsp, ase_lsp_obj_t* args) p2 = ase_lsp_eval (lsp, ASE_LSP_CAR(ASE_LSP_CDR(args))); if (p2 == ASE_NULL) return ASE_NULL; - if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_INT) { - if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) { + if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_INT) + { + if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) + { res = ASE_LSP_IVALUE(p1) != ASE_LSP_IVALUE(p2); } - else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL) { + else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL) + { res = ASE_LSP_IVALUE(p1) != ASE_LSP_RVALUE(p2); } - else { + else + { lsp->errnum = ASE_LSP_ERR_BAD_VALUE; return ASE_NULL; } } - else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_REAL) { - if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) { + else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_REAL) + { + if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) + { res = ASE_LSP_RVALUE(p1) != ASE_LSP_IVALUE(p2); } - else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL) { + else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL) + { res = ASE_LSP_RVALUE(p1) != ASE_LSP_RVALUE(p2); } - else { + else + { lsp->errnum = ASE_LSP_ERR_BAD_VALUE; return ASE_NULL; } } - else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_SYMBOL) { - if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYMBOL) { - res = ase_lsp_comp_symbol2 ( - p1, ASE_LSP_SYMVALUE(p2), ASE_LSP_SYMLEN(p2)) != 0; + else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_SYM) + { + if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYM) + { + res = ase_lsp_strxncmp ( + ASE_LSP_SYMVALUE(p1), ASE_LSP_SYMLEN(p1), + ASE_LSP_SYMVALUE(p2), ASE_LSP_SYMLEN(p2)) != 0; } - else { + else + { lsp->errnum = ASE_LSP_ERR_BAD_VALUE; return ASE_NULL; } } - else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_STRING) { - if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_STRING) { - res = ase_lsp_comp_string2 ( - p1, ASE_LSP_STRVALUE(p2), ASE_LSP_STRLEN(p2)) != 0; + else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_STR) + { + if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_STR) + { + res = ase_lsp_strxncmp ( + ASE_LSP_STRVALUE(p1), ASE_LSP_STRLEN(p1), + ASE_LSP_STRVALUE(p2), ASE_LSP_STRLEN(p2)) != 0; } - else { + else + { lsp->errnum = ASE_LSP_ERR_BAD_VALUE; return ASE_NULL; } } - else { + else + { lsp->errnum = ASE_LSP_ERR_BAD_VALUE; return ASE_NULL; } @@ -145,7 +178,7 @@ ase_lsp_obj_t* ase_lsp_prim_gt (ase_lsp_t* lsp, ase_lsp_obj_t* args) int res; ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2); - ase_assert (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); + ase_lsp_assert (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args)); if (p1 == ASE_NULL) return ASE_NULL; @@ -154,51 +187,68 @@ ase_lsp_obj_t* ase_lsp_prim_gt (ase_lsp_t* lsp, ase_lsp_obj_t* args) p2 = ase_lsp_eval (lsp, ASE_LSP_CAR(ASE_LSP_CDR(args))); if (p2 == ASE_NULL) return ASE_NULL; - if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_INT) { - if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) { + if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_INT) + { + if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) + { res = ASE_LSP_IVALUE(p1) > ASE_LSP_IVALUE(p2); } - else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL) { + else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL) + { res = ASE_LSP_IVALUE(p1) > ASE_LSP_RVALUE(p2); } - else { + else + { lsp->errnum = ASE_LSP_ERR_BAD_VALUE; return ASE_NULL; } } - else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_REAL) { - if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) { + else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_REAL) + { + if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) + { res = ASE_LSP_RVALUE(p1) > ASE_LSP_IVALUE(p2); } - else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL) { + else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL) + { res = ASE_LSP_RVALUE(p1) > ASE_LSP_RVALUE(p2); } - else { + else + { lsp->errnum = ASE_LSP_ERR_BAD_VALUE; return ASE_NULL; } } - else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_SYMBOL) { - if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYMBOL) { - res = ase_lsp_comp_symbol2 ( - p1, ASE_LSP_SYMVALUE(p2), ASE_LSP_SYMLEN(p2)) > 0; + else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_SYM) + { + if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYM) + { + res = ase_lsp_strxncmp ( + ASE_LSP_SYMVALUE(p1), ASE_LSP_SYMLEN(p1), + ASE_LSP_SYMVALUE(p2), ASE_LSP_SYMLEN(p2)) > 0; } - else { + else + { lsp->errnum = ASE_LSP_ERR_BAD_VALUE; return ASE_NULL; } } - else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_STRING) { - if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_STRING) { - res = ase_lsp_comp_string2 ( - p1, ASE_LSP_STRVALUE(p2), ASE_LSP_STRLEN(p2)) > 0; + else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_STR) + { + if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_STR) + { + res = ase_lsp_strxncmp ( + ASE_LSP_STRVALUE(p1), ASE_LSP_STRLEN(p1), + ASE_LSP_STRVALUE(p2), ASE_LSP_STRLEN(p2)) > 0; } - else { + else + { lsp->errnum = ASE_LSP_ERR_BAD_VALUE; return ASE_NULL; } } - else { + else + { lsp->errnum = ASE_LSP_ERR_BAD_VALUE; return ASE_NULL; } @@ -212,7 +262,7 @@ ase_lsp_obj_t* ase_lsp_prim_lt (ase_lsp_t* lsp, ase_lsp_obj_t* args) int res; ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2); - ase_assert (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); + ase_lsp_assert (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args)); if (p1 == ASE_NULL) return ASE_NULL; @@ -221,51 +271,67 @@ ase_lsp_obj_t* ase_lsp_prim_lt (ase_lsp_t* lsp, ase_lsp_obj_t* args) p2 = ase_lsp_eval (lsp, ASE_LSP_CAR(ASE_LSP_CDR(args))); if (p2 == ASE_NULL) return ASE_NULL; - if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_INT) { - if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) { + if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_INT) + { + if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) + { res = ASE_LSP_IVALUE(p1) < ASE_LSP_IVALUE(p2); } - else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL) { + else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL) + { res = ASE_LSP_IVALUE(p1) < ASE_LSP_RVALUE(p2); } - else { + else + { lsp->errnum = ASE_LSP_ERR_BAD_VALUE; return ASE_NULL; } } - else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_REAL) { - if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) { + else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_REAL) + { + if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) + { res = ASE_LSP_RVALUE(p1) < ASE_LSP_IVALUE(p2); } - else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL) { + else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL) + { res = ASE_LSP_RVALUE(p1) < ASE_LSP_RVALUE(p2); } - else { + else + { lsp->errnum = ASE_LSP_ERR_BAD_VALUE; return ASE_NULL; } } - else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_SYMBOL) { - if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYMBOL) { - res = ase_lsp_comp_symbol2 ( - p1, ASE_LSP_SYMVALUE(p2), ASE_LSP_SYMLEN(p2)) < 0; + else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_SYM) + { + if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYM) + { + res = ase_lsp_strxncmp ( + ASE_LSP_SYMVALUE(p1), ASE_LSP_SYMLEN(p1), + ASE_LSP_SYMVALUE(p2), ASE_LSP_SYMLEN(p2)) < 0; + } + else + { + lsp->errnum = ASE_LSP_ERR_BAD_VALUE; + return ASE_NULL; + } + } + else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_STR) + { + if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_STR) + { + res = ase_lsp_strxncmp ( + ASE_LSP_STRVALUE(p1), ASE_LSP_STRLEN(p1), + ASE_LSP_STRVALUE(p2), ASE_LSP_STRLEN(p2)) < 0; } else { lsp->errnum = ASE_LSP_ERR_BAD_VALUE; return ASE_NULL; } } - else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_STRING) { - if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_STRING) { - res = ase_lsp_comp_string2 ( - p1, ASE_LSP_STRVALUE(p2), ASE_LSP_STRLEN(p2)) < 0; - } - else { - lsp->errnum = ASE_LSP_ERR_BAD_VALUE; - return ASE_NULL; - } - } - else { + else + { lsp->errnum = ASE_LSP_ERR_BAD_VALUE; return ASE_NULL; } @@ -279,7 +345,7 @@ ase_lsp_obj_t* ase_lsp_prim_ge (ase_lsp_t* lsp, ase_lsp_obj_t* args) int res; ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2); - ase_assert (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); + ase_lsp_assert (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args)); if (p1 == ASE_NULL) return ASE_NULL; @@ -288,51 +354,67 @@ ase_lsp_obj_t* ase_lsp_prim_ge (ase_lsp_t* lsp, ase_lsp_obj_t* args) p2 = ase_lsp_eval (lsp, ASE_LSP_CAR(ASE_LSP_CDR(args))); if (p2 == ASE_NULL) return ASE_NULL; - if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_INT) { - if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) { + if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_INT) + { + if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) + { res = ASE_LSP_IVALUE(p1) >= ASE_LSP_IVALUE(p2); } - else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL) { + else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL) + { res = ASE_LSP_IVALUE(p1) >= ASE_LSP_RVALUE(p2); } - else { + else + { lsp->errnum = ASE_LSP_ERR_BAD_VALUE; return ASE_NULL; } } - else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_REAL) { - if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) { + else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_REAL) + { + if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) + { res = ASE_LSP_RVALUE(p1) >= ASE_LSP_IVALUE(p2); } - else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL) { + else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL) + { res = ASE_LSP_RVALUE(p1) >= ASE_LSP_RVALUE(p2); } - else { + else + { lsp->errnum = ASE_LSP_ERR_BAD_VALUE; return ASE_NULL; } } - else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_SYMBOL) { - if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYMBOL) { - res = ase_lsp_comp_symbol2 ( - p1, ASE_LSP_SYMVALUE(p2), ASE_LSP_SYMLEN(p2)) >= 0; + else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_SYM) + { + if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYM) + { + res = ase_lsp_strxncmp ( + ASE_LSP_SYMVALUE(p1), ASE_LSP_SYMLEN(p1), + ASE_LSP_SYMVALUE(p2), ASE_LSP_SYMLEN(p2)) >= 0; + } + else + { + lsp->errnum = ASE_LSP_ERR_BAD_VALUE; + return ASE_NULL; + } + } + else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_STR) + { + if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_STR) + { + res = ase_lsp_strxncmp ( + ASE_LSP_STRVALUE(p1), ASE_LSP_STRLEN(p1), + ASE_LSP_STRVALUE(p2), ASE_LSP_STRLEN(p2)) >= 0; } else { lsp->errnum = ASE_LSP_ERR_BAD_VALUE; return ASE_NULL; } } - else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_STRING) { - if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_STRING) { - res = ase_lsp_comp_string2 ( - p1, ASE_LSP_STRVALUE(p2), ASE_LSP_STRLEN(p2)) >= 0; - } - else { - lsp->errnum = ASE_LSP_ERR_BAD_VALUE; - return ASE_NULL; - } - } - else { + else + { lsp->errnum = ASE_LSP_ERR_BAD_VALUE; return ASE_NULL; } @@ -346,7 +428,7 @@ ase_lsp_obj_t* ase_lsp_prim_le (ase_lsp_t* lsp, ase_lsp_obj_t* args) int res; ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2); - ase_assert (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); + ase_lsp_assert (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args)); if (p1 == ASE_NULL) return ASE_NULL; @@ -355,51 +437,67 @@ ase_lsp_obj_t* ase_lsp_prim_le (ase_lsp_t* lsp, ase_lsp_obj_t* args) p2 = ase_lsp_eval (lsp, ASE_LSP_CAR(ASE_LSP_CDR(args))); if (p2 == ASE_NULL) return ASE_NULL; - if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_INT) { - if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) { + if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_INT) + { + if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) + { res = ASE_LSP_IVALUE(p1) <= ASE_LSP_IVALUE(p2); } - else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL) { + else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL) + { res = ASE_LSP_IVALUE(p1) <= ASE_LSP_RVALUE(p2); } - else { + else + { lsp->errnum = ASE_LSP_ERR_BAD_VALUE; return ASE_NULL; } } - else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_REAL) { - if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) { + else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_REAL) + { + if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) + { res = ASE_LSP_RVALUE(p1) <= ASE_LSP_IVALUE(p2); } - else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL) { + else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL) + { res = ASE_LSP_RVALUE(p1) <= ASE_LSP_RVALUE(p2); } - else { + else + { lsp->errnum = ASE_LSP_ERR_BAD_VALUE; return ASE_NULL; } } - else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_SYMBOL) { - if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYMBOL) { - res = ase_lsp_comp_symbol2 ( - p1, ASE_LSP_SYMVALUE(p2), ASE_LSP_SYMLEN(p2)) <= 0; + else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_SYM) + { + if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYM) + { + res = ase_lsp_strxncmp ( + ASE_LSP_SYMVALUE(p1), ASE_LSP_SYMLEN(p1), + ASE_LSP_SYMVALUE(p2), ASE_LSP_SYMLEN(p2)) <= 0; + } + else + { + lsp->errnum = ASE_LSP_ERR_BAD_VALUE; + return ASE_NULL; + } + } + else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_STR) + { + if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_STR) + { + res = ase_lsp_strxncmp ( + ASE_LSP_STRVALUE(p1), ASE_LSP_STRLEN(p1), + ASE_LSP_STRVALUE(p2), ASE_LSP_STRLEN(p2)) <= 0; } else { lsp->errnum = ASE_LSP_ERR_BAD_VALUE; return ASE_NULL; } } - else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_STRING) { - if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_STRING) { - res = ase_lsp_comp_string2 ( - p1, ASE_LSP_STRVALUE(p2), ASE_LSP_STRLEN(p2)) <= 0; - } - else { - lsp->errnum = ASE_LSP_ERR_BAD_VALUE; - return ASE_NULL; - } - } - else { + else + { lsp->errnum = ASE_LSP_ERR_BAD_VALUE; return ASE_NULL; } diff --git a/ase/lsp/prim_let.c b/ase/lsp/prim_let.c index 7e2e9cfb..59866b7a 100644 --- a/ase/lsp/prim_let.c +++ b/ase/lsp/prim_let.c @@ -1,5 +1,5 @@ /* - * $Id: prim_let.c,v 1.5 2006-10-24 04:22:39 bacon Exp $ + * $Id: prim_let.c,v 1.6 2006-10-25 13:42:31 bacon Exp $ */ #include @@ -40,7 +40,7 @@ static ase_lsp_obj_t* __prim_let ( ase_lsp_obj_t* n = ASE_LSP_CAR(ass); ase_lsp_obj_t* v = ASE_LSP_CDR(ass); - if (ASE_LSP_TYPE(n) != ASE_LSP_OBJ_SYMBOL) { + if (ASE_LSP_TYPE(n) != ASE_LSP_OBJ_SYM) { lsp->errnum = ASE_LSP_ERR_BAD_ARG; // must be a symbol if (sequential) lsp->mem->frame = frame->link; else lsp->mem->brooding_frame = frame->link; @@ -79,7 +79,7 @@ static ase_lsp_obj_t* __prim_let ( return ASE_NULL; } } - else if (ASE_LSP_TYPE(ass) == ASE_LSP_OBJ_SYMBOL) { + else if (ASE_LSP_TYPE(ass) == ASE_LSP_OBJ_SYM) { if (ase_lsp_frame_lookup(frame, ass) != ASE_NULL) { lsp->errnum = ASE_LSP_ERR_DUP_FORMAL; if (sequential) lsp->mem->frame = frame->link; diff --git a/ase/lsp/prim_math.c b/ase/lsp/prim_math.c index 6b92e8ad..9a95cde6 100644 --- a/ase/lsp/prim_math.c +++ b/ase/lsp/prim_math.c @@ -1,5 +1,5 @@ /* - * $Id: prim_math.c,v 1.8 2006-10-24 04:22:39 bacon Exp $ + * $Id: prim_math.c,v 1.9 2006-10-25 13:42:31 bacon Exp $ */ #include @@ -8,8 +8,8 @@ ase_lsp_obj_t* ase_lsp_prim_plus (ase_lsp_t* lsp, ase_lsp_obj_t* args) { ase_lsp_obj_t* body, * tmp; - ase_lsp_int_t ivalue = 0; - ase_lsp_real_t rvalue = .0; + ase_long_t ivalue = 0; + ase_real_t rvalue = .0; ase_bool_t realnum = ase_false; ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT); @@ -45,7 +45,7 @@ ase_lsp_obj_t* ase_lsp_prim_plus (ase_lsp_t* lsp, ase_lsp_obj_t* args) else { if (!realnum) { realnum = ase_true; - rvalue = (ase_lsp_real_t)ivalue; + rvalue = (ase_real_t)ivalue; } rvalue = rvalue + ASE_LSP_RVALUE(tmp); } @@ -62,8 +62,8 @@ ase_lsp_obj_t* ase_lsp_prim_plus (ase_lsp_t* lsp, ase_lsp_obj_t* args) ase_assert (body == lsp->mem->nil); tmp = (realnum)? - ase_lsp_make_real (lsp->mem, rvalue): - ase_lsp_make_int (lsp->mem, ivalue); + ase_lsp_makerealobj (lsp->mem, rvalue): + ase_lsp_makeintobj (lsp->mem, ivalue); if (tmp == ASE_NULL) { lsp->errnum = ASE_LSP_ERR_MEMORY; return ASE_NULL; @@ -75,8 +75,8 @@ ase_lsp_obj_t* ase_lsp_prim_plus (ase_lsp_t* lsp, ase_lsp_obj_t* args) ase_lsp_obj_t* ase_lsp_prim_minus (ase_lsp_t* lsp, ase_lsp_obj_t* args) { ase_lsp_obj_t* body, * tmp; - ase_lsp_int_t ivalue = 0; - ase_lsp_real_t rvalue = .0; + ase_long_t ivalue = 0; + ase_real_t rvalue = .0; ase_bool_t realnum = ase_false; ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT); @@ -110,7 +110,7 @@ ase_lsp_obj_t* ase_lsp_prim_minus (ase_lsp_t* lsp, ase_lsp_obj_t* args) else { if (!realnum) { realnum = ase_true; - rvalue = (ase_lsp_real_t)ivalue; + rvalue = (ase_real_t)ivalue; } rvalue = rvalue - ASE_LSP_RVALUE(tmp); } @@ -127,8 +127,8 @@ ase_lsp_obj_t* ase_lsp_prim_minus (ase_lsp_t* lsp, ase_lsp_obj_t* args) ase_assert (body == lsp->mem->nil); tmp = (realnum)? - ase_lsp_make_real (lsp->mem, rvalue): - ase_lsp_make_int (lsp->mem, ivalue); + ase_lsp_makerealobj (lsp->mem, rvalue): + ase_lsp_makeintobj (lsp->mem, ivalue); if (tmp == ASE_NULL) { lsp->errnum = ASE_LSP_ERR_MEMORY; return ASE_NULL; @@ -140,8 +140,8 @@ ase_lsp_obj_t* ase_lsp_prim_minus (ase_lsp_t* lsp, ase_lsp_obj_t* args) ase_lsp_obj_t* ase_lsp_prim_multiply (ase_lsp_t* lsp, ase_lsp_obj_t* args) { ase_lsp_obj_t* body, * tmp; - ase_lsp_int_t ivalue = 0; - ase_lsp_real_t rvalue = .0; + ase_long_t ivalue = 0; + ase_real_t rvalue = .0; ase_bool_t realnum = ase_false; ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT); @@ -175,7 +175,7 @@ ase_lsp_obj_t* ase_lsp_prim_multiply (ase_lsp_t* lsp, ase_lsp_obj_t* args) else { if (!realnum) { realnum = ase_true; - rvalue = (ase_lsp_real_t)ivalue; + rvalue = (ase_real_t)ivalue; } rvalue = rvalue * ASE_LSP_RVALUE(tmp); } @@ -192,8 +192,8 @@ ase_lsp_obj_t* ase_lsp_prim_multiply (ase_lsp_t* lsp, ase_lsp_obj_t* args) ase_assert (body == lsp->mem->nil); tmp = (realnum)? - ase_lsp_make_real (lsp->mem, rvalue): - ase_lsp_make_int (lsp->mem, ivalue); + ase_lsp_makerealobj (lsp->mem, rvalue): + ase_lsp_makeintobj (lsp->mem, ivalue); if (tmp == ASE_NULL) { lsp->errnum = ASE_LSP_ERR_MEMORY; return ASE_NULL; @@ -205,8 +205,8 @@ ase_lsp_obj_t* ase_lsp_prim_multiply (ase_lsp_t* lsp, ase_lsp_obj_t* args) ase_lsp_obj_t* ase_lsp_prim_divide (ase_lsp_t* lsp, ase_lsp_obj_t* args) { ase_lsp_obj_t* body, * tmp; - ase_lsp_int_t ivalue = 0; - ase_lsp_real_t rvalue = .0; + ase_long_t ivalue = 0; + ase_real_t rvalue = .0; ase_bool_t realnum = ase_false; ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT); @@ -245,7 +245,7 @@ ase_lsp_obj_t* ase_lsp_prim_divide (ase_lsp_t* lsp, ase_lsp_obj_t* args) else { if (!realnum) { realnum = ase_true; - rvalue = (ase_lsp_real_t)ivalue; + rvalue = (ase_real_t)ivalue; } rvalue = rvalue / ASE_LSP_RVALUE(tmp); } @@ -262,8 +262,8 @@ ase_lsp_obj_t* ase_lsp_prim_divide (ase_lsp_t* lsp, ase_lsp_obj_t* args) ase_assert (body == lsp->mem->nil); tmp = (realnum)? - ase_lsp_make_real (lsp->mem, rvalue): - ase_lsp_make_int (lsp->mem, ivalue); + ase_lsp_makerealobj (lsp->mem, rvalue): + ase_lsp_makeintobj (lsp->mem, ivalue); if (tmp == ASE_NULL) { lsp->errnum = ASE_LSP_ERR_MEMORY; return ASE_NULL; @@ -275,7 +275,7 @@ ase_lsp_obj_t* ase_lsp_prim_divide (ase_lsp_t* lsp, ase_lsp_obj_t* args) ase_lsp_obj_t* ase_lsp_prim_modulus (ase_lsp_t* lsp, ase_lsp_obj_t* args) { ase_lsp_obj_t* body, * tmp; - ase_lsp_int_t ivalue = 0; + ase_long_t ivalue = 0; ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT); ase_assert (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); @@ -300,10 +300,10 @@ ase_lsp_obj_t* ase_lsp_prim_modulus (ase_lsp_t* lsp, ase_lsp_obj_t* args) } else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL) { if (body == args) { - ivalue = (ase_lsp_int_t)ASE_LSP_RVALUE(tmp); + ivalue = (ase_long_t)ASE_LSP_RVALUE(tmp); } else { - ase_lsp_int_t tmpi = (ase_lsp_int_t)ASE_LSP_RVALUE(tmp); + ase_long_t tmpi = (ase_long_t)ASE_LSP_RVALUE(tmp); if (tmpi == 0) { lsp->errnum = ASE_LSP_ERR_DIVIDE_BY_ZERO; return ASE_NULL; @@ -322,9 +322,10 @@ ase_lsp_obj_t* ase_lsp_prim_modulus (ase_lsp_t* lsp, ase_lsp_obj_t* args) ase_assert (body == lsp->mem->nil); - tmp = ase_lsp_make_int (lsp->mem, ivalue); - if (tmp == ASE_NULL) { - lsp->errnum = ASE_LSP_ERR_MEMORY; + tmp = ase_lsp_makeintobj (lsp->mem, ivalue); + if (tmp == ASE_NULL) + { + lsp->errnum = ASE_LSP_ENOMEM; return ASE_NULL; } diff --git a/ase/lsp/print.c b/ase/lsp/print.c index 1baf8de1..5420a7a1 100644 --- a/ase/lsp/print.c +++ b/ase/lsp/print.c @@ -1,5 +1,5 @@ /* - * $Id: print.c,v 1.14 2006-10-24 04:22:39 bacon Exp $ + * $Id: print.c,v 1.15 2006-10-25 13:42:31 bacon Exp $ */ #include @@ -21,10 +21,10 @@ void ase_lsp_print_debug (ase_lsp_obj_t* obj) case ASE_LSP_OBJ_REAL: ase_printf (ASE_TEXT("%f"), ASE_LSP_RVALUE(obj)); break; - case ASE_LSP_OBJ_SYMBOL: + case ASE_LSP_OBJ_SYM: ase_printf (ASE_TEXT("%s"), ASE_LSP_SYMVALUE(obj)); break; - case ASE_LSP_OBJ_STRING: + case ASE_LSP_OBJ_STR: ase_printf (ASE_TEXT("%s"), ASE_LSP_STRVALUE(obj)); break; case ASE_LSP_OBJ_CONS: @@ -92,34 +92,34 @@ static int __print (ase_lsp_t* lsp, const ase_lsp_obj_t* obj, ase_bool_t prt_con OUTPUT_STR (lsp, ASE_TEXT("t")); break; case ASE_LSP_OBJ_INT: - if (ase_sizeof(ase_lsp_int_t) == ase_sizeof(int)) { + if (ase_sizeof(ase_long_t) == ase_sizeof(int)) { ase_sprintf (buf, ase_countof(buf), ASE_TEXT("%d"), ASE_LSP_IVALUE(obj)); } - else if (ase_sizeof(ase_lsp_int_t) == ase_sizeof(long)) { + else if (ase_sizeof(ase_long_t) == ase_sizeof(long)) { ase_sprintf (buf, ase_countof(buf), ASE_TEXT("%ld"), ASE_LSP_IVALUE(obj)); } - else if (ase_sizeof(ase_lsp_int_t) == ase_sizeof(long long)) { + else if (ase_sizeof(ase_long_t) == ase_sizeof(long long)) { ase_sprintf (buf, ase_countof(buf), ASE_TEXT("%lld"), ASE_LSP_IVALUE(obj)); } OUTPUT_STR (lsp, buf); break; case ASE_LSP_OBJ_REAL: - if (ase_sizeof(ase_lsp_real_t) == ase_sizeof(double)) { + if (ase_sizeof(ase_real_t) == ase_sizeof(double)) { ase_sprintf (buf, ase_countof(buf), ASE_TEXT("%f"), (double)ASE_LSP_RVALUE(obj)); } - else if (ase_sizeof(ase_lsp_real_t) == ase_sizeof(long double)) { + else if (ase_sizeof(ase_real_t) == ase_sizeof(long double)) { ase_sprintf (buf, ase_countof(buf), ASE_TEXT("%Lf"), (long double)ASE_LSP_RVALUE(obj)); } OUTPUT_STR (lsp, buf); break; - case ASE_LSP_OBJ_SYMBOL: + case ASE_LSP_OBJ_SYM: OUTPUT_STR (lsp, ASE_LSP_SYMVALUE(obj)); break; - case ASE_LSP_OBJ_STRING: + case ASE_LSP_OBJ_STR: OUTPUT_STR (lsp, ASE_LSP_STRVALUE(obj)); break; case ASE_LSP_OBJ_CONS: diff --git a/ase/lsp/read.c b/ase/lsp/read.c index cbd4d7bd..668f584e 100644 --- a/ase/lsp/read.c +++ b/ase/lsp/read.c @@ -1,11 +1,8 @@ /* - * $Id: read.c,v 1.21 2006-10-24 15:31:35 bacon Exp $ + * $Id: read.c,v 1.22 2006-10-25 13:42:31 bacon Exp $ */ -#include -#include -#include -#include +#include #define IS_SPACE(x) ase_isspace(x) #define IS_DIGIT(x) ase_isdigit(x) @@ -29,7 +26,7 @@ #define TOKEN_ADD_CHAR(lsp,ch) do { \ if (ase_lsp_token_addc(&(lsp)->token, ch) == -1) { \ - lsp->errnum = ASE_LSP_ERR_MEMORY; \ + lsp->errnum = ASE_LSP_ENOMEM; \ return -1; \ } \ } while (0) @@ -66,14 +63,15 @@ static int read_string (ase_lsp_t* lsp); ase_lsp_obj_t* ase_lsp_read (ase_lsp_t* lsp) { - if (lsp->curc == ASE_T_EOF && + if (lsp->curc == ASE_CHAR_EOF && read_char(lsp) == -1) return ASE_NULL; - lsp->errnum = ASE_LSP_ERR_NONE; + lsp->errnum = ASE_LSP_ENOERR; NEXT_TOKEN (lsp); - if (lsp->mem->locked != ASE_NULL) { - ase_lsp_unlockallobjs (lsp->mem->locked); + if (lsp->mem->locked != ASE_NULL) + { + ase_lsp_unlockallobjs (lsp, lsp->mem->locked); lsp->mem->locked = ASE_NULL; } lsp->mem->locked = read_obj (lsp); @@ -95,30 +93,31 @@ static ase_lsp_obj_t* read_obj (ase_lsp_t* lsp) NEXT_TOKEN (lsp); return read_quote (lsp); case TOKEN_INT: - obj = ase_lsp_make_int (lsp->mem, TOKEN_IVALUE(lsp)); - if (obj == ASE_NULL) lsp->errnum = ASE_LSP_ERR_MEMORY; - ase_lsp_lockobj (obj); + obj = ase_lsp_makeintobj (lsp->mem, TOKEN_IVALUE(lsp)); + if (obj == ASE_NULL) lsp->errnum = ASE_LSP_ENOMEM; + ase_lsp_lockobj (lsp, obj); return obj; case TOKEN_REAL: - obj = ase_lsp_make_real (lsp->mem, TOKEN_RVALUE(lsp)); - if (obj == ASE_NULL) lsp->errnum = ASE_LSP_ERR_MEMORY; - ase_lsp_lockobj (obj); + obj = ase_lsp_makerealobj (lsp->mem, TOKEN_RVALUE(lsp)); + if (obj == ASE_NULL) lsp->errnum = ASE_LSP_ENOMEM; + ase_lsp_lockobj (lsp, obj); return obj; case TOKEN_STRING: - obj = ase_lsp_make_stringx ( + obj = ase_lsp_makestrobj ( lsp->mem, TOKEN_SVALUE(lsp), TOKEN_SLENGTH(lsp)); - if (obj == ASE_NULL) lsp->errnum = ASE_LSP_ERR_MEMORY; - ase_lsp_lockobj (obj); + if (obj == ASE_NULL) lsp->errnum = ASE_LSP_ENOMEM; + ase_lsp_lockobj (lsp, obj); return obj; case TOKEN_IDENT: ase_assert (lsp->mem->nil != ASE_NULL && lsp->mem->t != ASE_NULL); if (TOKEN_COMPARE(lsp,ASE_T("nil")) == 0) obj = lsp->mem->nil; else if (TOKEN_COMPARE(lsp,ASE_T("t")) == 0) obj = lsp->mem->t; - else { - obj = ase_lsp_make_symbolx ( + else + { + obj = ase_lsp_makesymobj ( lsp->mem, TOKEN_SVALUE(lsp), TOKEN_SLENGTH(lsp)); - if (obj == ASE_NULL) lsp->errnum = ASE_LSP_ERR_MEMORY; - ase_lsp_lockobj (obj); + if (obj == ASE_NULL) lsp->errnum = ASE_LSP_ENOMEM; + ase_lsp_lockobj (lsp, obj); } return obj; } @@ -165,21 +164,24 @@ static ase_lsp_obj_t* read_list (ase_lsp_t* lsp) } obj = read_obj (lsp); - if (obj == ASE_NULL) { - if (lsp->errnum == ASE_LSP_ERR_END) { + if (obj == ASE_NULL) + { + if (lsp->errnum == ASE_LSP_ERR_END) + { // unexpected end of input lsp->errnum = ASE_LSP_ERR_SYNTAX; } return ASE_NULL; } - p = (ase_lsp_obj_cons_t*)ase_lsp_make_cons ( + p = (ase_lsp_obj_cons_t*)ase_lsp_makecons ( lsp->mem, lsp->mem->nil, lsp->mem->nil); - if (p == ASE_NULL) { - lsp->errnum = ASE_LSP_ERR_MEMORY; + if (p == ASE_NULL) + { + lsp->errnum = ASE_LSP_ENOMEM; return ASE_NULL; } - ase_lsp_lockobj ((ase_lsp_obj_t*)p); + ase_lsp_lockobj (lsp, (ase_lsp_obj_t*)p); if (first == ASE_NULL) first = p; if (prev != ASE_NULL) prev->cdr = (ase_lsp_obj_t*)p; @@ -198,27 +200,31 @@ static ase_lsp_obj_t* read_quote (ase_lsp_t* lsp) ase_lsp_obj_t* cons, * tmp; tmp = read_obj (lsp); - if (tmp == ASE_NULL) { - if (lsp->errnum == ASE_LSP_ERR_END) { + if (tmp == ASE_NULL) + { + if (lsp->errnum == ASE_LSP_ERR_END) + { // unexpected end of input lsp->errnum = ASE_LSP_ERR_SYNTAX; } return ASE_NULL; } - cons = ase_lsp_make_cons (lsp->mem, tmp, lsp->mem->nil); - if (cons == ASE_NULL) { - lsp->errnum = ASE_LSP_ERR_MEMORY; + cons = ase_lsp_makecons (lsp->mem, tmp, lsp->mem->nil); + if (cons == ASE_NULL) + { + lsp->errnum = ASE_LSP_ENOMEM; return ASE_NULL; } - ase_lsp_lockobj (cons); + ase_lsp_lockobj (lsp, cons); - cons = ase_lsp_make_cons (lsp->mem, lsp->mem->quote, cons); - if (cons == ASE_NULL) { - lsp->errnum = ASE_LSP_ERR_MEMORY; + cons = ase_lsp_makecons (lsp->mem, lsp->mem->quote, cons); + if (cons == ASE_NULL) + { + lsp->errnum = ASE_LSP_ENOMEM; return ASE_NULL; } - ase_lsp_lockobj (cons); + ase_lsp_lockobj (lsp, cons); return cons; } @@ -227,18 +233,20 @@ static int read_char (ase_lsp_t* lsp) { ase_ssize_t n; - if (lsp->input_func == ASE_NULL) { + if (lsp->input_func == ASE_NULL) + { lsp->errnum = ASE_LSP_ERR_INPUT_NOT_ATTACHED; return -1; } n = lsp->input_func(ASE_LSP_IO_DATA, lsp->input_arg, &lsp->curc, 1); - if (n == -1) { + if (n == -1) + { lsp->errnum = ASE_LSP_ERR_INPUT; return -1; } - if (n == 0) lsp->curc = ASE_T_EOF; + if (n == 0) lsp->curc = ASE_CHAR_EOF; return 0; } @@ -248,68 +256,84 @@ static int read_token (ase_lsp_t* lsp) TOKEN_CLEAR (lsp); - for (;;) { + while (1) + { // skip white spaces while (IS_SPACE(lsp->curc)) NEXT_CHAR (lsp); // skip the comments here - if (lsp->curc == ASE_T(';')) { - do { + if (lsp->curc == ASE_T(';')) + { + do + { NEXT_CHAR (lsp); - } while (lsp->curc != ASE_T('\n') && lsp->curc != ASE_T_EOF); + } + while (lsp->curc != ASE_T('\n') && lsp->curc != ASE_CHAR_EOF); } else break; } - if (lsp->curc == ASE_T_EOF) { + if (lsp->curc == ASE_CHAR_EOF) + { TOKEN_TYPE(lsp) = TOKEN_END; return 0; } - else if (lsp->curc == ASE_T('(')) { + else if (lsp->curc == ASE_T('(')) + { TOKEN_ADD_CHAR (lsp, lsp->curc); TOKEN_TYPE(lsp) = TOKEN_LPAREN; NEXT_CHAR (lsp); return 0; } - else if (lsp->curc == ASE_T(')')) { + else if (lsp->curc == ASE_T(')')) + { TOKEN_ADD_CHAR (lsp, lsp->curc); TOKEN_TYPE(lsp) = TOKEN_RPAREN; NEXT_CHAR (lsp); return 0; } - else if (lsp->curc == ASE_T('\'')) { + else if (lsp->curc == ASE_T('\'')) + { TOKEN_ADD_CHAR (lsp, lsp->curc); TOKEN_TYPE(lsp) = TOKEN_QUOTE; NEXT_CHAR (lsp); return 0; } - else if (lsp->curc == ASE_T('.')) { + else if (lsp->curc == ASE_T('.')) + { TOKEN_ADD_CHAR (lsp, lsp->curc); TOKEN_TYPE(lsp) = TOKEN_DOT; NEXT_CHAR (lsp); return 0; } - else if (lsp->curc == ASE_T('-')) { + else if (lsp->curc == ASE_T('-')) + { TOKEN_ADD_CHAR (lsp, lsp->curc); NEXT_CHAR (lsp); - if (IS_DIGIT(lsp->curc)) { + if (IS_DIGIT(lsp->curc)) + { return read_number (lsp, 1); } - else if (IS_IDENT(lsp->curc)) { + else if (IS_IDENT(lsp->curc)) + { return read_ident (lsp); } - else { + else + { TOKEN_TYPE(lsp) = TOKEN_IDENT; return 0; } } - else if (IS_DIGIT(lsp->curc)) { + else if (IS_DIGIT(lsp->curc)) + { return read_number (lsp, 0); } - else if (IS_ALPHA(lsp->curc) || IS_IDENT(lsp->curc)) { + else if (IS_ALPHA(lsp->curc) || IS_IDENT(lsp->curc)) + { return read_ident (lsp); } - else if (lsp->curc == ASE_T('\"')) { + else if (lsp->curc == ASE_T('\"')) + { NEXT_CHAR (lsp); return read_string (lsp); } @@ -321,24 +345,28 @@ static int read_token (ase_lsp_t* lsp) static int read_number (ase_lsp_t* lsp, int negative) { - ase_lsp_int_t ivalue = 0; - ase_lsp_real_t rvalue = 0.; + ase_long_t ivalue = 0; + ase_real_t rvalue = 0.; - do { + do + { ivalue = ivalue * 10 + (lsp->curc - ASE_T('0')); TOKEN_ADD_CHAR (lsp, lsp->curc); NEXT_CHAR (lsp); - } while (IS_DIGIT(lsp->curc)); + } + while (IS_DIGIT(lsp->curc)); /* TODO: extend parsing floating point number */ - if (lsp->curc == ASE_T('.')) { - ase_lsp_real_t fraction = 0.1; + if (lsp->curc == ASE_T('.')) + { + ase_real_t fraction = 0.1; NEXT_CHAR (lsp); - rvalue = (ase_lsp_real_t)ivalue; + rvalue = (ase_real_t)ivalue; - while (IS_DIGIT(lsp->curc)) { - rvalue += (ase_lsp_real_t)(lsp->curc - ASE_T('0')) * fraction; + while (IS_DIGIT(lsp->curc)) + { + rvalue += (ase_real_t)(lsp->curc - ASE_T('0')) * fraction; fraction *= 0.1; NEXT_CHAR (lsp); } @@ -372,7 +400,7 @@ static int read_string (ase_lsp_t* lsp) ase_cint_t code = 0; do { - if (lsp->curc == ASE_T_EOF) { + if (lsp->curc == ASE_CHAR_EOF) { TOKEN_TYPE(lsp) = TOKEN_UNTERM_STRING; return 0; } diff --git a/ase/lsp/token.h b/ase/lsp/token.h index 434632bb..8ac2d9b7 100644 --- a/ase/lsp/token.h +++ b/ase/lsp/token.h @@ -1,5 +1,5 @@ /* - * $Id: token.h,v 1.13 2006-10-24 04:22:40 bacon Exp $ + * $Id: token.h,v 1.14 2006-10-25 13:42:31 bacon Exp $ */ #ifndef _ASE_LSP_TOKEN_H_ @@ -17,8 +17,8 @@ struct ase_lsp_token_t { int type; - ase_lsp_int_t ivalue; - ase_lsp_real_t rvalue; + ase_long_t ivalue; + ase_real_t rvalue; ase_lsp_name_t name; ase_bool_t __dynamic; diff --git a/ase/lsp/types.h b/ase/lsp/types.h deleted file mode 100644 index 6d85747a..00000000 --- a/ase/lsp/types.h +++ /dev/null @@ -1,14 +0,0 @@ -/* - * $Id: types.h,v 1.9 2006-10-24 04:22:40 bacon Exp $ - */ - -#ifndef _ASE_LSP_TYPES_H_ -#define _ASE_LSP_TYPES_H_ - -#include -#include - -typedef ase_long_t ase_lsp_int_t; -typedef ase_real_t ase_lsp_real_t; - -#endif