From ac39c74c0f5ebef6a9e9f6f4edeaa720c1a2ad5b Mon Sep 17 00:00:00 2001 From: hyung-hwan Date: Thu, 26 Oct 2006 08:17:38 +0000 Subject: [PATCH] *** empty log message *** --- ase/awk/awk_i.h | 6 +- ase/lsp/array.c | 101 ----------------------------- ase/lsp/array.h | 35 ---------- ase/lsp/env.c | 49 +++++++------- ase/lsp/env.h | 41 ++++++------ ase/lsp/eval.c | 100 +++++++++++++++------------- ase/lsp/lsp.c | 19 +++--- ase/lsp/lsp.dsp | 16 ----- ase/lsp/lsp_i.h | 15 +++-- ase/lsp/makefile.bcc | 3 +- ase/lsp/makefile.cl | 2 +- ase/lsp/makefile.in | 3 +- ase/lsp/mem.c | 51 ++++++++------- ase/lsp/mem.h | 10 +-- ase/lsp/name.c | 147 +++++++++++++++++++++++------------------- ase/lsp/name.h | 15 +++-- ase/lsp/obj.h | 38 +++++------ ase/lsp/prim.c | 43 ++++++------ ase/lsp/prim_compar.c | 53 ++++++++------- ase/lsp/prim_let.c | 79 ++++++++++++++--------- ase/lsp/prim_math.c | 58 ++++++++--------- ase/lsp/prim_prog.c | 8 +-- ase/lsp/print.c | 121 ++++++++++++++++++++-------------- ase/lsp/read.c | 91 +++++++++++++++----------- ase/lsp/token.c | 77 ---------------------- ase/lsp/token.h | 46 ------------- 26 files changed, 521 insertions(+), 706 deletions(-) delete mode 100644 ase/lsp/array.c delete mode 100644 ase/lsp/array.h delete mode 100644 ase/lsp/token.c delete mode 100644 ase/lsp/token.h diff --git a/ase/awk/awk_i.h b/ase/awk/awk_i.h index 760f6ad9..ee20c36f 100644 --- a/ase/awk/awk_i.h +++ b/ase/awk/awk_i.h @@ -1,5 +1,5 @@ /* - * $Id: awk_i.h,v 1.73 2006-10-24 04:48:52 bacon Exp $ + * $Id: awk_i.h,v 1.74 2006-10-26 08:17:37 bacon Exp $ */ #ifndef _ASE_AWK_AWKI_H_ @@ -145,8 +145,8 @@ struct ase_awk_t /* token */ struct { - int prev; - int type; + int prev; + int type; ase_awk_str_t name; ase_size_t line; ase_size_t column; diff --git a/ase/lsp/array.c b/ase/lsp/array.c deleted file mode 100644 index 6258f8ab..00000000 --- a/ase/lsp/array.c +++ /dev/null @@ -1,101 +0,0 @@ -/* - * $Id: array.c,v 1.11 2006-10-24 04:22:39 bacon Exp $ - */ - -#include - -ase_lsp_array_t* ase_lsp_array_new (ase_size_t capacity) -{ - ase_lsp_array_t* array; - - ase_assert (capacity > 0); - array = (ase_lsp_array_t*) ase_malloc (sizeof(ase_lsp_array_t)); - if (array == ASE_NULL) return ASE_NULL; - - array->buffer = (void**) ase_malloc (capacity + 1); - if (array->buffer == ASE_NULL) { - free (array); - return ASE_NULL; - } - - array->size = 0; - array->capacity = capacity; - array->buffer[0] = ASE_NULL; - return array; -} - -void ase_lsp_array_free (ase_lsp_array_t* array) -{ - while (array->size > 0) - free (array->buffer[--array->size]); - ase_assert (array->size == 0); - - free (array->buffer); - free (array); -} - -int ase_lsp_array_add_item (ase_lsp_array_t* array, void* item) -{ - if (array->size >= array->capacity) { - void* new_buffer = (void**)realloc ( - array->buffer, array->capacity * 2 + 1); - if (new_buffer == ASE_NULL) return -1; - array->buffer = new_buffer; - array->capacity = array->capacity * 2; - } - - array->buffer[array->size++] = item; - array->buffer[array->size] = ASE_NULL; - return 0; -} - -int ase_lsp_array_insert (ase_lsp_array_t* array, ase_size_t index, void* value) -{ - ase_size_t i; - - if (index >= array->capacity) { - void* new_buffer = (void**)realloc ( - array->buffer, array->capacity * 2 + 1); - if (new_buffer == ASE_NULL) return -1; - array->buffer = new_buffer; - array->capacity = array->capacity * 2; - } - - for (i = array->size; i > index; i--) { - array->buffer[i] = array->buffer[i - 1]; - } - array->buffer[index] = value; - array->size = (index > array->size)? index + 1: array->size + 1; - - return 0; -} - -void ase_lsp_array_delete (ase_lsp_array_t* array, ase_size_t index) -{ - ase_assert (index < array->size); - -} - -void ase_lsp_array_clear (ase_lsp_array_t* array) -{ - while (array->size > 0) - free (array->buffer[--array->size]); - ase_assert (array->size == 0); - array->buffer[0] = ASE_NULL; -} - -void** ase_lsp_array_yield (ase_lsp_array_t* array, ase_size_t capacity) -{ - void** old_buffer, ** new_buffer; - - new_buffer = (void**) ase_malloc (capacity + 1); - if (new_buffer == ASE_NULL) return ASE_NULL; - - old_buffer = array->buffer; - array->buffer = new_buffer; - array->size = 0; - array->capacity = capacity; - array->buffer[0] = ASE_NULL; - - return old_buffer; -} diff --git a/ase/lsp/array.h b/ase/lsp/array.h deleted file mode 100644 index 3466d810..00000000 --- a/ase/lsp/array.h +++ /dev/null @@ -1,35 +0,0 @@ -/* - * $Id: array.h,v 1.7 2006-10-24 04:22:39 bacon Exp $ - */ - -#ifndef _ASE_LSP_ARRAY_H_ -#define _ASE_LSP_ARRAY_H_ - -#include - -struct ase_lsp_array_t -{ - void** buffer; - ase_size_t size; - ase_size_t capacity; -}; - -typedef struct ase_lsp_array_t ase_lsp_array_t; - -#ifdef __cplusplus -extern "C" { -#endif - -ase_lsp_array_t* ase_lsp_array_new (ase_size_t capacity); -void ase_lsp_array_free (ase_lsp_array_t* array); -int ase_lsp_array_add_item (ase_lsp_array_t* array, void* item); -int ase_lsp_array_insert (ase_lsp_array_t* array, ase_size_t index, void* value); -void ase_lsp_array_delete (ase_lsp_array_t* array, ase_size_t index); -void ase_lsp_array_clear (ase_lsp_array_t* array); -void** ase_lsp_array_yield (ase_lsp_array_t* array, ase_size_t capacity); - -#ifdef __cplusplus -} -#endif - -#endif diff --git a/ase/lsp/env.c b/ase/lsp/env.c index 6b316b8b..6b3985d3 100644 --- a/ase/lsp/env.c +++ b/ase/lsp/env.c @@ -1,17 +1,19 @@ /* - * $Id: env.c,v 1.11 2006-10-25 13:42:30 bacon Exp $ + * $Id: env.c,v 1.12 2006-10-26 08:17:37 bacon Exp $ */ #include // TODO: make the frame hash accessible.... -ase_lsp_assoc_t* ase_lsp_assoc_new ( - ase_lsp_obj_t* name, ase_lsp_obj_t* value, ase_lsp_obj_t* func) +static ase_lsp_assoc_t* __new_assoc ( + ase_lsp_t* lsp, ase_lsp_obj_t* name, + ase_lsp_obj_t* value, ase_lsp_obj_t* func) { ase_lsp_assoc_t* assoc; - assoc = (ase_lsp_assoc_t*) ase_malloc (sizeof(ase_lsp_assoc_t)); + assoc = (ase_lsp_assoc_t*) + ASE_LSP_MALLOC (lsp, sizeof(ase_lsp_assoc_t)); if (assoc == ASE_NULL) return ASE_NULL; assoc->name = name; @@ -22,16 +24,12 @@ ase_lsp_assoc_t* ase_lsp_assoc_new ( return assoc; } -void ase_lsp_assoc_free (ase_lsp_assoc_t* assoc) -{ - ase_free (assoc); -} - -ase_lsp_frame_t* ase_lsp_frame_new (void) +ase_lsp_frame_t* ase_lsp_newframe (ase_lsp_t* lsp) { ase_lsp_frame_t* frame; - frame = (ase_lsp_frame_t*) ase_malloc (sizeof(ase_lsp_frame_t)); + frame = (ase_lsp_frame_t*) + ASE_LSP_MALLOC (lsp, sizeof(ase_lsp_frame_t)); if (frame == ASE_NULL) return ASE_NULL; frame->assoc = ASE_NULL; @@ -40,7 +38,7 @@ ase_lsp_frame_t* ase_lsp_frame_new (void) return frame; } -void ase_lsp_frame_free (ase_lsp_frame_t* frame) +void ase_lsp_freeframe (ase_lsp_t* lsp, ase_lsp_frame_t* frame) { ase_lsp_assoc_t* assoc, * link; @@ -49,18 +47,19 @@ void ase_lsp_frame_free (ase_lsp_frame_t* frame) while (assoc != ASE_NULL) { link = assoc->link; - ase_lsp_assoc_free (assoc); + ASE_LSP_FREE (lsp, assoc); assoc = link; } - ase_free (frame); + ASE_LSP_FREE (lsp, frame); } -ase_lsp_assoc_t* ase_lsp_frame_lookup (ase_lsp_frame_t* frame, ase_lsp_obj_t* name) +ase_lsp_assoc_t* ase_lsp_lookupinframe ( + ase_lsp_t* lsp, ase_lsp_frame_t* frame, ase_lsp_obj_t* name) { ase_lsp_assoc_t* assoc; - ase_assert (ASE_LSP_TYPE(name) == ASE_LSP_OBJ_SYM); + ase_lsp_assert (lsp, ASE_LSP_TYPE(name) == ASE_LSP_OBJ_SYM); assoc = frame->assoc; while (assoc != ASE_NULL) @@ -71,28 +70,30 @@ ase_lsp_assoc_t* ase_lsp_frame_lookup (ase_lsp_frame_t* frame, ase_lsp_obj_t* na return ASE_NULL; } -ase_lsp_assoc_t* ase_lsp_frame_insert_value ( - ase_lsp_frame_t* frame, ase_lsp_obj_t* name, ase_lsp_obj_t* value) +ase_lsp_assoc_t* ase_lsp_insertvalueintoframe ( + ase_lsp_t* lsp, ase_lsp_frame_t* frame, + ase_lsp_obj_t* name, ase_lsp_obj_t* value) { ase_lsp_assoc_t* assoc; - ase_assert (ASE_LSP_TYPE(name) == ASE_LSP_OBJ_SYM); + ase_lsp_assert (lsp, ASE_LSP_TYPE(name) == ASE_LSP_OBJ_SYM); - assoc = ase_lsp_assoc_new (name, value, ASE_NULL); + assoc = __new_assoc (lsp, name, value, ASE_NULL); if (assoc == ASE_NULL) return ASE_NULL; assoc->link = frame->assoc; frame->assoc = assoc; return assoc; } -ase_lsp_assoc_t* ase_lsp_frame_insert_func ( - ase_lsp_frame_t* frame, ase_lsp_obj_t* name, ase_lsp_obj_t* func) +ase_lsp_assoc_t* ase_lsp_insertfuncintoframe ( + ase_lsp_t* lsp, ase_lsp_frame_t* frame, + ase_lsp_obj_t* name, ase_lsp_obj_t* func) { ase_lsp_assoc_t* assoc; - ase_assert (ASE_LSP_TYPE(name) == ASE_LSP_OBJ_SYM); + ase_lsp_assert (lsp, ASE_LSP_TYPE(name) == ASE_LSP_OBJ_SYM); - assoc = ase_lsp_assoc_new (name, ASE_NULL, func); + assoc = __new_assoc (lsp, name, ASE_NULL, func); if (assoc == ASE_NULL) return ASE_NULL; assoc->link = frame->assoc; frame->assoc = assoc; diff --git a/ase/lsp/env.h b/ase/lsp/env.h index 836533a6..44ce232b 100644 --- a/ase/lsp/env.h +++ b/ase/lsp/env.h @@ -1,46 +1,49 @@ /* - * $Id: env.h,v 1.9 2006-10-24 04:22:39 bacon Exp $ + * $Id: env.h,v 1.10 2006-10-26 08:17:37 bacon Exp $ */ #ifndef _ASE_LSP_ENV_H_ #define _ASE_LSP_ENV_H_ -#include +#ifndef _ASE_LSP_LSP_H_ +#error Never include this file directly. Include instead +#endif + +typedef struct ase_lsp_assoc_t ase_lsp_assoc_t; +typedef struct ase_lsp_frame_t ase_lsp_frame_t; struct ase_lsp_assoc_t { - ase_lsp_obj_t* name; // ase_lsp_obj_symbol_t + ase_lsp_obj_t* name; /* ase_lsp_obj_symbol_t */ /*ase_lsp_obj_t* value;*/ ase_lsp_obj_t* value; /* value as a variable */ ase_lsp_obj_t* func; /* function definition */ - struct ase_lsp_assoc_t* link; + + ase_lsp_assoc_t* link; }; struct ase_lsp_frame_t { - struct ase_lsp_assoc_t* assoc; - struct ase_lsp_frame_t* link; + ase_lsp_assoc_t* assoc; + ase_lsp_frame_t* link; }; -typedef struct ase_lsp_assoc_t ase_lsp_assoc_t; -typedef struct ase_lsp_frame_t ase_lsp_frame_t; - #ifdef __cplusplus extern "C" { #endif -ase_lsp_assoc_t* ase_lsp_assoc_new ( - ase_lsp_obj_t* name, ase_lsp_obj_t* value, ase_lsp_obj_t* func); -void ase_lsp_assoc_free (ase_lsp_assoc_t* assoc); +ase_lsp_frame_t* ase_lsp_newframe (ase_lsp_t* lsp); +void ase_lsp_freeframe (ase_lsp_t* lsp, ase_lsp_frame_t* frame); -ase_lsp_frame_t* ase_lsp_frame_new (void); -void ase_lsp_frame_free (ase_lsp_frame_t* frame); -ase_lsp_assoc_t* ase_lsp_frame_lookup (ase_lsp_frame_t* frame, ase_lsp_obj_t* name); +ase_lsp_assoc_t* ase_lsp_lookupinframe ( + ase_lsp_t* lsp, ase_lsp_frame_t* frame, ase_lsp_obj_t* name); -ase_lsp_assoc_t* ase_lsp_frame_insert_value ( - ase_lsp_frame_t* frame, ase_lsp_obj_t* name, ase_lsp_obj_t* value); -ase_lsp_assoc_t* ase_lsp_frame_insert_func ( - ase_lsp_frame_t* frame, ase_lsp_obj_t* name, ase_lsp_obj_t* func); +ase_lsp_assoc_t* ase_lsp_insertvalueintoframe ( + ase_lsp_t* lsp, ase_lsp_frame_t* frame, + ase_lsp_obj_t* name, ase_lsp_obj_t* value); +ase_lsp_assoc_t* ase_lsp_insertfuncintoframe ( + ase_lsp_t* lsp, ase_lsp_frame_t* frame, + ase_lsp_obj_t* name, ase_lsp_obj_t* func); #ifdef __cplusplus } diff --git a/ase/lsp/eval.c b/ase/lsp/eval.c index 739e6c05..77345eee 100644 --- a/ase/lsp/eval.c +++ b/ase/lsp/eval.c @@ -1,11 +1,8 @@ /* - * $Id: eval.c,v 1.16 2006-10-25 13:42:31 bacon Exp $ + * $Id: eval.c,v 1.17 2006-10-26 08:17:37 bacon Exp $ */ -#include -#include -#include -#include +#include static ase_lsp_obj_t* make_func ( ase_lsp_t* lsp, ase_lsp_obj_t* cdr, int is_macro); @@ -16,7 +13,7 @@ static ase_lsp_obj_t* apply ( ase_lsp_obj_t* ase_lsp_eval (ase_lsp_t* lsp, ase_lsp_obj_t* obj) { - lsp->errnum = ASE_LSP_ERR_NONE; + lsp->errnum = ASE_LSP_ENOERR; if (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_CONS) return eval_cons (lsp, obj); @@ -83,7 +80,7 @@ static ase_lsp_obj_t* make_func (ase_lsp_t* lsp, ase_lsp_obj_t* cdr, int is_macr ase_lsp_makemacro (lsp->mem, formal, body): ase_lsp_makefunc (lsp->mem, formal, body); if (func == ASE_NULL) { - lsp->errnum = ASE_LSP_ERR_MEMORY; + lsp->errnum = ASE_LSP_ENOMEM; return ASE_NULL; } @@ -94,7 +91,7 @@ static ase_lsp_obj_t* eval_cons (ase_lsp_t* lsp, ase_lsp_obj_t* cons) { ase_lsp_obj_t* car, * cdr; - ase_assert (ASE_LSP_TYPE(cons) == ASE_LSP_OBJ_CONS); + ase_lsp_assert (lsp, ASE_LSP_TYPE(cons) == ASE_LSP_OBJ_CONS); car = ASE_LSP_CAR(cons); cdr = ASE_LSP_CDR(cons); @@ -176,70 +173,78 @@ static ase_lsp_obj_t* apply ( ase_lsp_obj_t* value; ase_lsp_mem_t* mem; - ase_assert ( + ase_lsp_assert (lsp, ASE_LSP_TYPE(func) == ASE_LSP_OBJ_FUNC || ASE_LSP_TYPE(func) == ASE_LSP_OBJ_MACRO); - ase_assert (ASE_LSP_TYPE(ASE_LSP_CDR(func)) == ASE_LSP_OBJ_CONS); + ase_lsp_assert (lsp, + ASE_LSP_TYPE(ASE_LSP_CDR(func)) == ASE_LSP_OBJ_CONS); mem = lsp->mem; - if (ASE_LSP_TYPE(func) == ASE_LSP_OBJ_MACRO) { + if (ASE_LSP_TYPE(func) == ASE_LSP_OBJ_MACRO) + { formal = ASE_LSP_MFORMAL (func); body = ASE_LSP_MBODY (func); } - else { + else + { formal = ASE_LSP_FFORMAL (func); body = ASE_LSP_FBODY (func); } - // make a new frame. - frame = ase_lsp_frame_new (); - if (frame == ASE_NULL) { - lsp->errnum = ASE_LSP_ERR_MEMORY; + /* make a new frame. */ + frame = ase_lsp_newframe (lsp); + if (frame == ASE_NULL) + { + lsp->errnum = ASE_LSP_ENOMEM; return ASE_NULL; } - // attach it to the brooding frame list to - // make them not to be garbage collected. + /* attach it to the brooding frame list to + * make them not to be garbage collected. */ frame->link = mem->brooding_frame; mem->brooding_frame = frame; - // evaluate arguments and push them into the frame. - while (formal != mem->nil) { - if (actual == mem->nil) { + /* evaluate arguments and push them into the frame. */ + while (formal != mem->nil) + { + if (actual == mem->nil) + { lsp->errnum = ASE_LSP_ERR_TOO_FEW_ARGS; mem->brooding_frame = frame->link; - ase_lsp_frame_free (frame); + ase_lsp_freeframe (lsp, frame); return ASE_NULL; } value = ASE_LSP_CAR(actual); - if (ASE_LSP_TYPE(func) != ASE_LSP_OBJ_MACRO) { + if (ASE_LSP_TYPE(func) != ASE_LSP_OBJ_MACRO) + { // macro doesn't evaluate actual arguments. value = ase_lsp_eval (lsp, value); - if (value == ASE_NULL) { + if (value == ASE_NULL) + { mem->brooding_frame = frame->link; - ase_lsp_frame_free (frame); + ase_lsp_freeframe (lsp, frame); return ASE_NULL; } } - if (ase_lsp_frame_lookup ( - frame, ASE_LSP_CAR(formal)) != ASE_NULL) { - + if (ase_lsp_lookupinframe ( + lsp, frame, ASE_LSP_CAR(formal)) != ASE_NULL) + { lsp->errnum = ASE_LSP_ERR_DUP_FORMAL; mem->brooding_frame = frame->link; - ase_lsp_frame_free (frame); + ase_lsp_freeframe (lsp, frame); return ASE_NULL; } - if (ase_lsp_frame_insert_value ( - frame, ASE_LSP_CAR(formal), value) == ASE_NULL) { - - lsp->errnum = ASE_LSP_ERR_MEMORY; + if (ase_lsp_insertvalueintoframe ( + lsp, frame, ASE_LSP_CAR(formal), value) == ASE_NULL) + { + lsp->errnum = ASE_LSP_ENOMEM; mem->brooding_frame = frame->link; - ase_lsp_frame_free (frame); + ase_lsp_freeframe (lsp, frame); return ASE_NULL; } @@ -247,16 +252,18 @@ static ase_lsp_obj_t* apply ( formal = ASE_LSP_CDR(formal); } - if (ASE_LSP_TYPE(actual) == ASE_LSP_OBJ_CONS) { + if (ASE_LSP_TYPE(actual) == ASE_LSP_OBJ_CONS) + { lsp->errnum = ASE_LSP_ERR_TOO_MANY_ARGS; mem->brooding_frame = frame->link; - ase_lsp_frame_free (frame); + ase_lsp_freeframe (lsp, frame); return ASE_NULL; } - else if (actual != mem->nil) { + else if (actual != mem->nil) + { lsp->errnum = ASE_LSP_ERR_BAD_ARG; mem->brooding_frame = frame->link; - ase_lsp_frame_free (frame); + ase_lsp_freeframe (lsp, frame); return ASE_NULL; } @@ -267,24 +274,27 @@ static ase_lsp_obj_t* apply ( // do the evaluation of the body value = mem->nil; - while (body != mem->nil) { + while (body != mem->nil) + { value = ase_lsp_eval(lsp, ASE_LSP_CAR(body)); - if (value == ASE_NULL) { + if (value == ASE_NULL) + { mem->frame = frame->link; - ase_lsp_frame_free (frame); + ase_lsp_freeframe (lsp, frame); return ASE_NULL; } body = ASE_LSP_CDR(body); } - // pop the frame. + /* pop the frame. */ mem->frame = frame->link; - // destroy the frame. - ase_lsp_frame_free (frame); + /* destroy the frame. */ + ase_lsp_freeframe (lsp, frame); //if (ASE_LSP_CAR(func) == mem->macro) { - if (ASE_LSP_TYPE(func) == ASE_LSP_OBJ_MACRO) { + if (ASE_LSP_TYPE(func) == ASE_LSP_OBJ_MACRO) + { value = ase_lsp_eval(lsp, value); if (value == ASE_NULL) return ASE_NULL; } diff --git a/ase/lsp/lsp.c b/ase/lsp/lsp.c index f707f5d4..58a54b60 100644 --- a/ase/lsp/lsp.c +++ b/ase/lsp/lsp.c @@ -1,5 +1,5 @@ /* - * $Id: lsp.c,v 1.8 2006-10-24 15:31:35 bacon Exp $ + * $Id: lsp.c,v 1.9 2006-10-26 08:17:37 bacon Exp $ */ #if defined(__BORLANDC__) @@ -20,6 +20,7 @@ ase_lsp_t* ase_lsp_open ( if (syscas == ASE_NULL) return ASE_NULL; if (syscas->malloc == ASE_NULL || + syscas->realloc == ASE_NULL || syscas->free == ASE_NULL) return ASE_NULL; if (syscas->is_upper == ASE_NULL || @@ -60,9 +61,9 @@ ase_lsp_t* ase_lsp_open ( else syscas->memcpy (&lsp->syscas, syscas, ase_sizeof(lsp->syscas)); if (syscas->memset == ASE_NULL) lsp->syscas.memset = ase_lsp_memset; - if (ase_lsp_token_open(&lsp->token, 0) == ASE_NULL) + if (ase_lsp_name_open(&lsp->token.name, 0, lsp) == ASE_NULL) { - if (lsp->__dynamic) ASE_LSP_FREE (lsp, lsp); + ASE_LSP_FREE (lsp, lsp); return ASE_NULL; } @@ -79,16 +80,16 @@ ase_lsp_t* ase_lsp_open ( lsp->mem = ase_lsp_openmem (lsp, mem_ubound, mem_ubound_inc); if (lsp->mem == ASE_NULL) { - ase_lsp_token_close (&lsp->token); - if (lsp->__dynamic) ASE_LSP_FREE (lsp, lsp); + ase_lsp_name_close (&lsp->token.name); + ASE_LSP_FREE (lsp, lsp); return ASE_NULL; } if (__add_builtin_prims(lsp) == -1) { ase_lsp_closemem (lsp->mem); - ase_lsp_token_close (&lsp->token); - if (lsp->__dynamic) ASE_LSP_FREE (lsp, lsp); + ase_lsp_name_close (&lsp->token.name); + ASE_LSP_FREE (lsp, lsp); return ASE_NULL; } @@ -101,8 +102,8 @@ ase_lsp_t* ase_lsp_open ( void ase_lsp_close (ase_lsp_t* lsp) { ase_lsp_closemem (lsp->mem); - ase_lsp_token_close (&lsp->token); - if (lsp->__dynamic) ASE_LSP_FREE (lsp, lsp); + ase_lsp_name_close (&lsp->token.name); + ASE_LSP_FREE (lsp, lsp); } int ase_lsp_attach_input (ase_lsp_t* lsp, ase_lsp_io_t input, void* arg) diff --git a/ase/lsp/lsp.dsp b/ase/lsp/lsp.dsp index f8a2fea6..0aa36625 100644 --- a/ase/lsp/lsp.dsp +++ b/ase/lsp/lsp.dsp @@ -87,10 +87,6 @@ LIB32=link.exe -lib # PROP Default_Filter "cpp;c;cxx;rc;def;r;odl;idl;hpj;bat" # Begin Source File -SOURCE=.\array.c -# End Source File -# Begin Source File - SOURCE=.\env.c # End Source File # Begin Source File @@ -145,20 +141,12 @@ SOURCE=.\print.c SOURCE=.\read.c # End Source File -# Begin Source File - -SOURCE=.\token.c -# End Source File # End Group # Begin Group "Header Files" # PROP Default_Filter "h;hpp;hxx;hm;inl" # Begin Source File -SOURCE=.\array.h -# End Source File -# Begin Source File - SOURCE=.\env.h # End Source File # Begin Source File @@ -187,10 +175,6 @@ SOURCE=.\prim.h # End Source File # Begin Source File -SOURCE=.\token.h -# End Source File -# Begin Source File - SOURCE=.\types.h # End Source File # End Group diff --git a/ase/lsp/lsp_i.h b/ase/lsp/lsp_i.h index 03cbc91f..b9786589 100644 --- a/ase/lsp/lsp_i.h +++ b/ase/lsp/lsp_i.h @@ -1,15 +1,17 @@ /* - * $Id: lsp_i.h,v 1.1 2006-10-24 15:10:25 bacon Exp $ + * $Id: lsp_i.h,v 1.2 2006-10-26 08:17:37 bacon Exp $ */ #ifndef _ASE_LSP_LSPI_H_ #define _ASE_LSP_LSPI_H_ #include -#include +#include +#include #include #include #include +#include #ifdef NDEBUG #define ase_lsp_assert(lsp,expr) ((void)0) @@ -65,7 +67,13 @@ struct ase_lsp_t /* for read */ ase_cint_t curc; - ase_lsp_token_t token; + struct + { + int type; + ase_long_t ivalue; + ase_real_t rvalue; + ase_lsp_name_t name; + } token; /* io functions */ ase_lsp_io_t input_func; @@ -79,7 +87,6 @@ struct ase_lsp_t /* memory manager */ ase_lsp_mem_t* mem; - ase_bool_t __dynamic; }; #endif diff --git a/ase/lsp/makefile.bcc b/ase/lsp/makefile.bcc index 77131d43..4e2cdc00 100644 --- a/ase/lsp/makefile.bcc +++ b/ase/lsp/makefile.bcc @@ -1,5 +1,4 @@ -SRCS = lsp.c name.c token.c array.c mem.c env.c err.c \ - read.c eval.c print.c \ +SRCS = lsp.c name.c mem.c env.c err.c read.c eval.c print.c \ prim.c prim_prog.c prim_let.c prim_compar.c prim_math.c OBJS = $(SRCS:.c=.obj) OUT = aselsp.lib diff --git a/ase/lsp/makefile.cl b/ase/lsp/makefile.cl index 8f0a98a6..8debc984 100644 --- a/ase/lsp/makefile.cl +++ b/ase/lsp/makefile.cl @@ -1,6 +1,6 @@ OUT = aselsp -SRCS = lsp.c name.c token.c array.c mem.c env.c err.c read.c eval.c print.c \ +SRCS = lsp.c name.c mem.c env.c err.c read.c eval.c print.c \ prim.c prim_prog.c prim_let.c prim_compar.c prim_math.c OBJS = $(SRCS:.c=.obj) diff --git a/ase/lsp/makefile.in b/ase/lsp/makefile.in index 02683aab..042d43fc 100644 --- a/ase/lsp/makefile.in +++ b/ase/lsp/makefile.in @@ -1,5 +1,4 @@ -SRCS = name.c token.c array.c mem.c env.c error.c \ - init.c read.c eval.c print.c \ +SRCS = lsp.c name.c mem.c env.c err.c read.c eval.c print.c \ prim.c prim_prog.c prim_let.c prim_compar.c prim_math.c OBJS = $(SRCS:.c=.o) OUT = libaselsp.a diff --git a/ase/lsp/mem.c b/ase/lsp/mem.c index 8ea1349e..efc170f7 100644 --- a/ase/lsp/mem.c +++ b/ase/lsp/mem.c @@ -1,5 +1,5 @@ /* - * $Id: mem.c,v 1.14 2006-10-25 13:42:31 bacon Exp $ + * $Id: mem.c,v 1.15 2006-10-26 08:17:37 bacon Exp $ */ #include @@ -18,7 +18,7 @@ ase_lsp_mem_t* ase_lsp_openmem ( mem->lsp = lsp; /* create a new root environment frame */ - mem->frame = ase_lsp_frame_new (); + mem->frame = ase_lsp_newframe (lsp); if (mem->frame == ASE_NULL) { ASE_LSP_FREE (lsp, mem); @@ -28,13 +28,15 @@ ase_lsp_mem_t* ase_lsp_openmem ( mem->brooding_frame = ASE_NULL; /* create an array to hold temporary objects */ - mem->temp_array = ase_lsp_array_new (512); - if (mem->temp_array == ASE_NULL) + /* + mem->temp_arr = ase_lsp_arr_new (512); + if (mem->temp_arr == ASE_NULL) { - ase_lsp_frame_free (mem->frame); + ase_lsp_freeframe (lsp, mem->frame); ASE_LSP_FREE (lsp, mem); return ASE_NULL; } + */ /* initialize object allocation list */ mem->ubound = ubound; @@ -69,8 +71,8 @@ ase_lsp_mem_t* ase_lsp_openmem ( mem->macro == ASE_NULL) { ase_lsp_dispose_all (mem); - ase_lsp_array_free (mem->temp_array); - ase_lsp_frame_free (mem->frame); + /*ase_lsp_arr_free (mem->temp_arr);*/ + ase_lsp_freeframe (lsp, mem->frame); ASE_LSP_FREE (lsp, mem); return ASE_NULL; } @@ -83,11 +85,11 @@ void ase_lsp_closemem (ase_lsp_mem_t* mem) /* dispose of the allocated objects */ ase_lsp_dispose_all (mem); - /* dispose of the temporary object arrays */ - ase_lsp_array_free (mem->temp_array); + /* dispose of the temporary object arrs */ + /*ase_lsp_arr_free (mem->temp_arr);*/ /* dispose of environment frames */ - ase_lsp_frame_free (mem->frame); + ase_lsp_freeframe (mem->lsp, mem->frame); /* free the memory */ ASE_LSP_FREE (mem->lsp, mem); @@ -175,7 +177,7 @@ ase_lsp_obj_t* ase_lsp_alloc (ase_lsp_mem_t* mem, int type, ase_size_t size) ASE_LSP_MARK(obj) = 0; ASE_LSP_LOCK(obj) = 0; - // insert the object at the head of the used list + /* insert the object at the head of the used list */ ASE_LSP_LINK(obj) = mem->used[type]; mem->used[type] = obj; mem->count++; @@ -296,8 +298,8 @@ static void ase_lsp_markobjsinuse (ase_lsp_mem_t* mem) { ase_lsp_frame_t* frame; ase_lsp_assoc_t* assoc; - ase_lsp_array_t* array; - ase_size_t i; + /*ase_lsp_arr_t* arr;*/ + /*ase_size_t i;*/ #if 0 ase_dprint0 (ASE_T("marking environment frames\n")); @@ -353,11 +355,13 @@ static void ase_lsp_markobjsinuse (ase_lsp_mem_t* mem) #if 0 ase_dprint0 (ASE_T("marking termporary objects\n")); #endif - array = mem->temp_array; - for (i = 0; i < array->size; i++) + /* + arr = mem->temp_arr; + for (i = 0; i < arr->size; i++) { - __mark_obj (mem->lsp, array->buffer[i]); + __mark_obj (mem->lsp, arr->buffer[i]); } + */ #if 0 ase_dprint0 (ASE_T("marking builtin objects\n")); @@ -463,7 +467,7 @@ ase_lsp_obj_t* ase_lsp_makesymobj ( { // if there is a symbol with the same name, it is just used. if (ase_lsp_strxncmp ( - ASE_LSP_SYMVALUE(obj), + ASE_LSP_SYMPTR(obj), ASE_LSP_SYMLEN(obj), str, len) == 0) return obj; obj = ASE_LSP_LINK(obj); } @@ -474,7 +478,7 @@ ase_lsp_obj_t* ase_lsp_makesymobj ( if (obj == ASE_NULL) return ASE_NULL; // fill in the symbol buffer - ase_lsp_strncpy (ASE_LSP_SYMVALUE(obj), str, len); + ase_lsp_strncpy (ASE_LSP_SYMPTR(obj), str, len); return obj; } @@ -490,7 +494,7 @@ ase_lsp_obj_t* ase_lsp_makestrobj ( if (obj == ASE_NULL) return ASE_NULL; // fill in the string buffer - ase_lsp_strncpy (ASE_LSP_STRVALUE(obj), str, len); + ase_lsp_strncpy (ASE_LSP_STRPTR(obj), str, len); return obj; } @@ -561,7 +565,7 @@ ase_lsp_assoc_t* ase_lsp_lookup (ase_lsp_mem_t* mem, ase_lsp_obj_t* name) while (frame != ASE_NULL) { - assoc = ase_lsp_frame_lookup (frame, name); + assoc = ase_lsp_lookupinframe (mem->lsp, frame, name); if (assoc != ASE_NULL) return assoc; frame = frame->link; } @@ -577,8 +581,8 @@ ase_lsp_assoc_t* ase_lsp_setvalue ( assoc = ase_lsp_lookup (mem, name); if (assoc == ASE_NULL) { - assoc = ase_lsp_frame_insert_value ( - mem->root_frame, name, value); + assoc = ase_lsp_insertvalueintoframe ( + mem->lsp, mem->root_frame, name, value); if (assoc == ASE_NULL) return ASE_NULL; } else assoc->value = value; @@ -594,7 +598,8 @@ ase_lsp_assoc_t* ase_lsp_setfunc ( assoc = ase_lsp_lookup (mem, name); if (assoc == ASE_NULL) { - assoc = ase_lsp_frame_insert_func (mem->root_frame, name, func); + assoc = ase_lsp_insertfuncintoframe ( + mem->lsp, mem->root_frame, name, func); if (assoc == ASE_NULL) return ASE_NULL; } else assoc->func = func; diff --git a/ase/lsp/mem.h b/ase/lsp/mem.h index df64e6f7..5c825876 100644 --- a/ase/lsp/mem.h +++ b/ase/lsp/mem.h @@ -1,13 +1,13 @@ /* - * $Id: mem.h,v 1.11 2006-10-25 13:42:31 bacon Exp $ + * $Id: mem.h,v 1.12 2006-10-26 08:17:37 bacon Exp $ */ #ifndef _ASE_LSP_MEM_H_ #define _ASE_LSP_MEM_H_ -#include -#include -#include +#ifndef _ASE_LSP_LSP_H_ +#error Never include this file directly. Include instead +#endif typedef struct ase_lsp_mem_t ase_lsp_mem_t; @@ -46,7 +46,7 @@ struct ase_lsp_mem_t /* * temporary objects */ - ase_lsp_array_t* temp_array; + /*ase_lsp_arr_t* temp_arr;*/ }; diff --git a/ase/lsp/name.c b/ase/lsp/name.c index f7f49c98..2b69e213 100644 --- a/ase/lsp/name.c +++ b/ase/lsp/name.c @@ -1,89 +1,101 @@ /* - * $Id: name.c,v 1.7 2006-10-25 14:42:40 bacon Exp $ + * $Id: name.c,v 1.8 2006-10-26 08:17:37 bacon Exp $ */ -#include +#include ase_lsp_name_t* ase_lsp_name_open ( - ase_lsp_name_t* name, ase_size_t capacity) + ase_lsp_name_t* name, ase_size_t capa, ase_lsp_t* lsp) { - if (capacity == 0) - capacity = ase_countof(name->static_buffer) - 1; + if (capa == 0) + capa = ase_countof(name->static_buf) - 1; - if (name == ASE_NULL) { + if (name == ASE_NULL) + { name = (ase_lsp_name_t*) - ase_malloc (ase_sizeof(ase_lsp_name_t)); + ASE_LSP_MALLOC (lsp, ase_sizeof(ase_lsp_name_t)); if (name == ASE_NULL) return ASE_NULL; name->__dynamic = ase_true; } else name->__dynamic = ase_false; - if (capacity < ase_countof(name->static_buffer)) { - name->buffer = name->static_buffer; + if (capa < ase_countof(name->static_buf)) + { + name->buf = name->static_buf; } - else { - name->buffer = (ase_char_t*) - ase_malloc ((capacity + 1) * ase_sizeof(ase_char_t)); - if (name->buffer == ASE_NULL) { - if (name->__dynamic) ase_free (name); + else + { + name->buf = (ase_char_t*) + ASE_LSP_MALLOC (lsp, (capa+1)*ase_sizeof(ase_char_t)); + if (name->buf == ASE_NULL) + { + if (name->__dynamic) ASE_LSP_FREE (lsp, name); return ASE_NULL; } } - name->size = 0; - name->capacity = capacity; - name->buffer[0] = ASE_CHAR('\0'); + name->size = 0; + name->capa = capa; + name->buf[0] = ASE_CHAR('\0'); + name->lsp = lsp; return name; } void ase_lsp_name_close (ase_lsp_name_t* name) { - if (name->capacity >= ase_countof(name->static_buffer)) { - ase_assert (name->buffer != name->static_buffer); - ase_free (name->buffer); + if (name->capa >= ase_countof(name->static_buf)) + { + ase_lsp_assert (name->lsp, name->buf != name->static_buf); + ASE_LSP_FREE (name->lsp, name->buf); } - if (name->__dynamic) ase_free (name); + if (name->__dynamic) ASE_LSP_FREE (name->lsp, name); } int ase_lsp_name_addc (ase_lsp_name_t* name, ase_cint_t c) { - if (name->size >= name->capacity) { - /* double the capacity. */ - ase_size_t new_capacity = name->capacity * 2; + if (name->size >= name->capa) + { + /* double the capa. */ + ase_size_t new_capa = name->capa * 2; - if (new_capacity >= ase_countof(name->static_buffer)) { + if (new_capa >= ase_countof(name->static_buf)) + { ase_char_t* space; - if (name->capacity < ase_countof(name->static_buffer)) { - space = (ase_char_t*)ase_malloc ( - (new_capacity + 1) * ase_sizeof(ase_char_t)); + if (name->capa < ase_countof(name->static_buf)) + { + space = (ase_char_t*) ASE_LSP_MALLOC ( + name->lsp, (new_capa+1)*ase_sizeof(ase_char_t)); if (space == ASE_NULL) return -1; /* don't need to copy up to the terminating null */ - ase_memcpy (space, name->buffer, - name->capacity * ase_sizeof(ase_char_t)); + ASE_LSP_MEMCPY (name->lsp, space, name->buf, + name->capa*ase_sizeof(ase_char_t)); } - else { - space = (ase_char_t*)ase_realloc (name->buffer, - (new_capacity + 1) * ase_sizeof(ase_char_t)); + else + { + space = (ase_char_t*) ASE_LSP_REALLOC ( + name->lsp, name->buf, + (new_capa+1)*ase_sizeof(ase_char_t)); if (space == ASE_NULL) return -1; } - name->buffer = space; + name->buf = space; } - name->capacity = new_capacity; + name->capa = new_capa; } - name->buffer[name->size++] = c; - name->buffer[name->size] = ASE_CHAR('\0'); + name->buf[name->size++] = c; + name->buf[name->size] = ASE_CHAR('\0'); return 0; } int ase_lsp_name_adds (ase_lsp_name_t* name, const ase_char_t* s) { - while (*s != ASE_CHAR('\0')) { + while (*s != ASE_CHAR('\0')) + { if (ase_lsp_name_addc(name, *s) == -1) return -1; s++; } @@ -93,49 +105,54 @@ int ase_lsp_name_adds (ase_lsp_name_t* name, const ase_char_t* s) void ase_lsp_name_clear (ase_lsp_name_t* name) { - name->size = 0; - name->buffer[0] = ASE_CHAR('\0'); + name->size = 0; + name->buf[0] = ASE_CHAR('\0'); } -ase_char_t* ase_lsp_name_yield (ase_lsp_name_t* name, ase_size_t capacity) +ase_char_t* ase_lsp_name_yield (ase_lsp_name_t* name, ase_size_t capa) { - ase_char_t* old_buffer, * new_buffer; + ase_char_t* old_buf, * new_buf; - if (capacity == 0) - capacity = ase_countof(name->static_buffer) - 1; + if (capa == 0) capa = ase_countof(name->static_buf) - 1; - if (name->capacity < ase_countof(name->static_buffer)) { - old_buffer = (ase_char_t*) - ase_malloc((name->capacity + 1) * ase_sizeof(ase_char_t)); - if (old_buffer == ASE_NULL) return ASE_NULL; - ase_memcpy (old_buffer, name->buffer, - (name->capacity + 1) * ase_sizeof(ase_char_t)); - } - else old_buffer = name->buffer; + if (name->capa < ase_countof(name->static_buf)) + { + old_buf = (ase_char_t*) ASE_LSP_MALLOC ( + name->lsp, (name->capa+1)*ase_sizeof(ase_char_t)); + if (old_buf == ASE_NULL) return ASE_NULL; - if (capacity < ase_countof(name->static_buffer)) { - new_buffer = name->static_buffer; + ASE_LSP_MEMCPY ( + name->lsp, old_buf, name->buf, + (name->capa+1)*ase_sizeof(ase_char_t)); } - else { - new_buffer = (ase_char_t*) - ase_malloc((capacity + 1) * ase_sizeof(ase_char_t)); - if (new_buffer == ASE_NULL) return ASE_NULL; + else old_buf = name->buf; + + if (capa < ase_countof(name->static_buf)) + { + new_buf = name->static_buf; + } + else + { + new_buf = (ase_char_t*) ASE_LSP_MALLOC ( + name->lsp, (capa+1)*ase_sizeof(ase_char_t)); + if (new_buf == ASE_NULL) return ASE_NULL; } - name->buffer = new_buffer; - name->size = 0; - name->capacity = capacity; - name->buffer[0] = ASE_CHAR('\0'); + name->buf = new_buf; + name->size = 0; + name->capa = capa; + name->buf[0] = ASE_CHAR('\0'); - return old_buffer; + return old_buf; } int ase_lsp_name_compare (ase_lsp_name_t* name, const ase_char_t* str) { - ase_char_t* p = name->buffer; + ase_char_t* p = name->buf; ase_size_t index = 0; - while (index < name->size) { + while (index < name->size) + { if (*p > *str) return 1; if (*p < *str) return -1; index++; p++; str++; diff --git a/ase/lsp/name.h b/ase/lsp/name.h index 6002ef6c..3ea83af0 100644 --- a/ase/lsp/name.h +++ b/ase/lsp/name.h @@ -1,5 +1,5 @@ /* - * $Id: name.h,v 1.6 2006-10-25 14:42:40 bacon Exp $ + * $Id: name.h,v 1.7 2006-10-26 08:17:37 bacon Exp $ */ #ifndef _ASE_LSP_NAME_H_ @@ -10,10 +10,11 @@ struct ase_lsp_name_t { - ase_size_t capacity; - ase_size_t size; - ase_char_t* buffer; - ase_char_t static_buffer[128]; + ase_size_t capa; + ase_size_t size; + ase_char_t* buf; + ase_char_t static_buf[128]; + ase_lsp_t* lsp; ase_bool_t __dynamic; }; @@ -24,13 +25,13 @@ extern "C" { #endif ase_lsp_name_t* ase_lsp_name_open ( - ase_lsp_name_t* name, ase_size_t capacity); + ase_lsp_name_t* name, ase_size_t capa, ase_lsp_t* lsp); void ase_lsp_name_close (ase_lsp_name_t* name); int ase_lsp_name_addc (ase_lsp_name_t* name, ase_cint_t c); int ase_lsp_name_adds (ase_lsp_name_t* name, const ase_char_t* s); void ase_lsp_name_clear (ase_lsp_name_t* name); -ase_char_t* ase_lsp_name_yield (ase_lsp_name_t* name, ase_size_t capacity); +ase_char_t* ase_lsp_name_yield (ase_lsp_name_t* name, ase_size_t capa); int ase_lsp_name_compare (ase_lsp_name_t* name, const ase_char_t* str); #ifdef __cplusplus diff --git a/ase/lsp/obj.h b/ase/lsp/obj.h index a9553d91..3d8b100c 100644 --- a/ase/lsp/obj.h +++ b/ase/lsp/obj.h @@ -1,11 +1,13 @@ /* - * $Id: obj.h,v 1.8 2006-10-25 13:42:31 bacon Exp $ + * $Id: obj.h,v 1.9 2006-10-26 08:17:37 bacon Exp $ */ #ifndef _ASE_LSP_OBJ_H_ #define _ASE_LSP_OBJ_H_ -#include +#ifndef _ASE_LSP_LSP_H_ +#error Never include this file directly. Include instead +#endif /* object types */ enum @@ -24,18 +26,18 @@ enum ASE_LSP_TYPE_COUNT // the number of lsp object types }; -typedef struct ase_lsp_objhdr_t ase_lsp_objhdr_t; -typedef struct ase_lsp_obj_t ase_lsp_obj_t; -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_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; -typedef struct ase_lsp_obj_prim_t ase_lsp_obj_prim_t; +typedef struct ase_lsp_objhdr_t ase_lsp_objhdr_t; +typedef struct ase_lsp_obj_t ase_lsp_obj_t; +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_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; +typedef struct ase_lsp_obj_prim_t ase_lsp_obj_prim_t; struct ase_lsp_objhdr_t { @@ -130,16 +132,16 @@ struct ase_lsp_obj_prim_t #define ASE_LSP_RVALUE(x) (((ase_lsp_obj_real_t*)x)->value) #if defined(__BORLANDC__) || defined(_MSC_VER) -#define ASE_LSP_SYMVALUE(x) ((ase_char_t*)(((ase_lsp_obj_sym_t*)x) + 1)) +#define ASE_LSP_SYMPTR(x) ((ase_char_t*)(((ase_lsp_obj_sym_t*)x) + 1)) #else -#define ASE_LSP_SYMVALUE(x) (((ase_lsp_obj_sym_t*)x)->buffer) +#define ASE_LSP_SYMPTR(x) (((ase_lsp_obj_sym_t*)x)->buffer) #endif #define ASE_LSP_SYMLEN(x) ((((ase_lsp_obj_sym_t*)x)->hdr.size - sizeof(ase_lsp_obj_t)) / sizeof(ase_char_t) - 1) #if defined(__BORLANDC__) || defined(_MSC_VER) -#define ASE_LSP_STRVALUE(x) ((ase_char_t*)(((ase_lsp_obj_str_t*)x) + 1)) +#define ASE_LSP_STRPTR(x) ((ase_char_t*)(((ase_lsp_obj_str_t*)x) + 1)) #else -#define ASE_LSP_STRVALUE(x) (((ase_lsp_obj_str_t*)x)->buffer) +#define ASE_LSP_STRPTR(x) (((ase_lsp_obj_str_t*)x)->buffer) #endif #define ASE_LSP_STRLEN(x) ((((ase_lsp_obj_str_t*)x)->hdr.size - sizeof(ase_lsp_obj_t)) / sizeof(ase_char_t) - 1) diff --git a/ase/lsp/prim.c b/ase/lsp/prim.c index 2390c5cc..83cf1a5d 100644 --- a/ase/lsp/prim.c +++ b/ase/lsp/prim.c @@ -1,13 +1,8 @@ /* - * $Id: prim.c,v 1.11 2006-10-25 13:42:31 bacon Exp $ + * $Id: prim.c,v 1.12 2006-10-26 08:17:37 bacon Exp $ */ -#include -#include -#include - -#include -#include +#include static int __add_prim (ase_lsp_mem_t* mem, const ase_char_t* name, ase_size_t len, ase_lsp_prim_t prim); @@ -15,7 +10,7 @@ static int __add_prim (ase_lsp_mem_t* mem, int ase_lsp_add_prim ( ase_lsp_t* lsp, const ase_char_t* name, ase_lsp_prim_t prim) { - return __add_prim (lsp->mem, name, ase_strlen(name), prim); + return __add_prim (lsp->mem, name, ase_lsp_strlen(name), prim); } int ase_lsp_remove_prim (ase_lsp_t* lsp, const ase_char_t* name) @@ -32,12 +27,12 @@ static int __add_prim (ase_lsp_mem_t* mem, 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_makeprim (mem, prim); if (p == ASE_NULL) return -1; - ase_lsp_unlock (n); + ase_lsp_unlockobj (mem->lsp, n); if (ase_lsp_setfunc(mem, n, p) == ASE_NULL) return -1; @@ -56,7 +51,7 @@ ase_lsp_obj_t* ase_lsp_prim_eval (ase_lsp_t* lsp, ase_lsp_obj_t* args) ase_lsp_obj_t* tmp; ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1); - ase_assert (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); + ase_lsp_assert (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(args)); if (tmp == ASE_NULL) return ASE_NULL; @@ -70,7 +65,7 @@ ase_lsp_obj_t* ase_lsp_prim_eval (ase_lsp_t* lsp, ase_lsp_obj_t* args) ase_lsp_obj_t* ase_lsp_prim_gc (ase_lsp_t* lsp, ase_lsp_obj_t* args) { ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 0, 0); - ase_lsp_garbage_collect (lsp->mem); + ase_lsp_collectgarbage (lsp->mem); return lsp->mem->nil; } @@ -123,7 +118,7 @@ ase_lsp_obj_t* ase_lsp_prim_if (ase_lsp_t* lsp, ase_lsp_obj_t* args) ase_lsp_obj_t* tmp; ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, ASE_LSP_PRIM_MAX_ARG_COUNT); - ase_assert (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); + ase_lsp_assert (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(args)); if (tmp == ASE_NULL) return ASE_NULL; @@ -162,7 +157,7 @@ ase_lsp_obj_t* ase_lsp_prim_while (ase_lsp_t* lsp, ase_lsp_obj_t* args) ase_lsp_obj_t* tmp; 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); + ase_lsp_assert (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); for (;;) { tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(args)); @@ -194,7 +189,7 @@ ase_lsp_obj_t* ase_lsp_prim_car (ase_lsp_t* lsp, ase_lsp_obj_t* args) ase_lsp_obj_t* tmp; ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1); - ase_assert (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); + ase_lsp_assert (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(args)); if (tmp == ASE_NULL) return ASE_NULL; @@ -217,7 +212,7 @@ ase_lsp_obj_t* ase_lsp_prim_cdr (ase_lsp_t* lsp, ase_lsp_obj_t* args) ase_lsp_obj_t* tmp; ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1); - ase_assert (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); + ase_lsp_assert (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(args)); if (tmp == ASE_NULL) return ASE_NULL; @@ -241,7 +236,7 @@ ase_lsp_obj_t* ase_lsp_prim_cons (ase_lsp_t* lsp, ase_lsp_obj_t* args) ase_lsp_obj_t* car, * cdr, * cons; 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); car = ase_lsp_eval (lsp, ASE_LSP_CAR(args)); if (car == ASE_NULL) return ASE_NULL; @@ -270,7 +265,7 @@ ase_lsp_obj_t* ase_lsp_prim_set (ase_lsp_t* lsp, ase_lsp_obj_t* args) ase_lsp_obj_t* p1, * p2; 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; @@ -284,7 +279,7 @@ ase_lsp_obj_t* ase_lsp_prim_set (ase_lsp_t* lsp, ase_lsp_obj_t* args) if (p2 == ASE_NULL) return ASE_NULL; if (ase_lsp_setvalue (lsp->mem, p1, p2) == ASE_NULL) { - lsp->errnum = ASE_LSP_ERR_MEMORY; + lsp->errnum = ASE_LSP_ENOMEM; return ASE_NULL; } @@ -301,7 +296,7 @@ ase_lsp_obj_t* ase_lsp_prim_setq (ase_lsp_t* lsp, ase_lsp_obj_t* args) ase_lsp_obj_t* p = args, * p1, * p2 = lsp->mem->nil; while (p != lsp->mem->nil) { - ase_assert (ASE_LSP_TYPE(p) == ASE_LSP_OBJ_CONS); + ase_lsp_assert (lsp, ASE_LSP_TYPE(p) == ASE_LSP_OBJ_CONS); p1 = ASE_LSP_CAR(p); if (ASE_LSP_TYPE(p1) != ASE_LSP_OBJ_SYM) { @@ -318,7 +313,7 @@ ase_lsp_obj_t* ase_lsp_prim_setq (ase_lsp_t* lsp, ase_lsp_obj_t* args) if (p2 == ASE_NULL) return ASE_NULL; if (ase_lsp_setvalue (lsp->mem, p1, p2) == ASE_NULL) { - lsp->errnum = ASE_LSP_ERR_MEMORY; + lsp->errnum = ASE_LSP_ENOMEM; return ASE_NULL; } @@ -335,7 +330,7 @@ ase_lsp_obj_t* ase_lsp_prim_quote (ase_lsp_t* lsp, ase_lsp_obj_t* args) */ ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1); - ase_assert (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); + ase_lsp_assert (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); return ASE_LSP_CAR(args); } @@ -367,7 +362,7 @@ ase_lsp_obj_t* ase_lsp_prim_defun (ase_lsp_t* lsp, ase_lsp_obj_t* args) if (ase_lsp_setfunc (lsp->mem, ASE_LSP_CAR(args), fun) == ASE_NULL) { - lsp->errnum = ASE_LSP_ERR_MEMORY; + lsp->errnum = ASE_LSP_ENOMEM; return ASE_NULL; } return fun; @@ -397,7 +392,7 @@ ase_lsp_obj_t* ase_lsp_prim_demac (ase_lsp_t* lsp, ase_lsp_obj_t* args) if (ase_lsp_setfunc (lsp->mem, ASE_LSP_CAR(args), mac) == ASE_NULL) { - lsp->errnum = ASE_LSP_ERR_MEMORY; + lsp->errnum = ASE_LSP_ENOMEM; return ASE_NULL; } return mac; diff --git a/ase/lsp/prim_compar.c b/ase/lsp/prim_compar.c index 377752a1..1117aeb5 100644 --- a/ase/lsp/prim_compar.c +++ b/ase/lsp/prim_compar.c @@ -1,9 +1,8 @@ /* - * $Id: prim_compar.c,v 1.5 2006-10-25 13:42:31 bacon Exp $ + * $Id: prim_compar.c,v 1.6 2006-10-26 08:17:37 bacon Exp $ */ -#include -#include +#include ase_lsp_obj_t* ase_lsp_prim_eq (ase_lsp_t* lsp, ase_lsp_obj_t* args) { @@ -57,8 +56,8 @@ ase_lsp_obj_t* ase_lsp_prim_eq (ase_lsp_t* lsp, ase_lsp_obj_t* args) 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; + ASE_LSP_SYMPTR(p1), ASE_LSP_SYMLEN(p1), + ASE_LSP_SYMPTR(p2), ASE_LSP_SYMLEN(p2)) == 0; } else { @@ -71,8 +70,8 @@ ase_lsp_obj_t* ase_lsp_prim_eq (ase_lsp_t* lsp, ase_lsp_obj_t* args) 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; + ASE_LSP_STRPTR(p1), ASE_LSP_STRLEN(p1), + ASE_LSP_STRPTR(p2), ASE_LSP_STRLEN(p2)) == 0; } else { lsp->errnum = ASE_LSP_ERR_BAD_VALUE; @@ -140,8 +139,8 @@ ase_lsp_obj_t* ase_lsp_prim_ne (ase_lsp_t* lsp, ase_lsp_obj_t* args) 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; + ASE_LSP_SYMPTR(p1), ASE_LSP_SYMLEN(p1), + ASE_LSP_SYMPTR(p2), ASE_LSP_SYMLEN(p2)) != 0; } else { @@ -154,8 +153,8 @@ ase_lsp_obj_t* ase_lsp_prim_ne (ase_lsp_t* lsp, ase_lsp_obj_t* args) 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; + ASE_LSP_STRPTR(p1), ASE_LSP_STRLEN(p1), + ASE_LSP_STRPTR(p2), ASE_LSP_STRLEN(p2)) != 0; } else { @@ -224,8 +223,8 @@ ase_lsp_obj_t* ase_lsp_prim_gt (ase_lsp_t* lsp, ase_lsp_obj_t* args) 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; + ASE_LSP_SYMPTR(p1), ASE_LSP_SYMLEN(p1), + ASE_LSP_SYMPTR(p2), ASE_LSP_SYMLEN(p2)) > 0; } else { @@ -238,8 +237,8 @@ ase_lsp_obj_t* ase_lsp_prim_gt (ase_lsp_t* lsp, ase_lsp_obj_t* args) 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; + ASE_LSP_STRPTR(p1), ASE_LSP_STRLEN(p1), + ASE_LSP_STRPTR(p2), ASE_LSP_STRLEN(p2)) > 0; } else { @@ -308,8 +307,8 @@ ase_lsp_obj_t* ase_lsp_prim_lt (ase_lsp_t* lsp, ase_lsp_obj_t* args) 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; + ASE_LSP_SYMPTR(p1), ASE_LSP_SYMLEN(p1), + ASE_LSP_SYMPTR(p2), ASE_LSP_SYMLEN(p2)) < 0; } else { @@ -322,8 +321,8 @@ ase_lsp_obj_t* ase_lsp_prim_lt (ase_lsp_t* lsp, ase_lsp_obj_t* args) 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; + ASE_LSP_STRPTR(p1), ASE_LSP_STRLEN(p1), + ASE_LSP_STRPTR(p2), ASE_LSP_STRLEN(p2)) < 0; } else { lsp->errnum = ASE_LSP_ERR_BAD_VALUE; @@ -391,8 +390,8 @@ ase_lsp_obj_t* ase_lsp_prim_ge (ase_lsp_t* lsp, ase_lsp_obj_t* args) 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; + ASE_LSP_SYMPTR(p1), ASE_LSP_SYMLEN(p1), + ASE_LSP_SYMPTR(p2), ASE_LSP_SYMLEN(p2)) >= 0; } else { @@ -405,8 +404,8 @@ ase_lsp_obj_t* ase_lsp_prim_ge (ase_lsp_t* lsp, ase_lsp_obj_t* args) 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; + ASE_LSP_STRPTR(p1), ASE_LSP_STRLEN(p1), + ASE_LSP_STRPTR(p2), ASE_LSP_STRLEN(p2)) >= 0; } else { lsp->errnum = ASE_LSP_ERR_BAD_VALUE; @@ -474,8 +473,8 @@ ase_lsp_obj_t* ase_lsp_prim_le (ase_lsp_t* lsp, ase_lsp_obj_t* args) 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; + ASE_LSP_SYMPTR(p1), ASE_LSP_SYMLEN(p1), + ASE_LSP_SYMPTR(p2), ASE_LSP_SYMLEN(p2)) <= 0; } else { @@ -488,8 +487,8 @@ ase_lsp_obj_t* ase_lsp_prim_le (ase_lsp_t* lsp, ase_lsp_obj_t* args) 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; + ASE_LSP_STRPTR(p1), ASE_LSP_STRLEN(p1), + ASE_LSP_STRPTR(p2), ASE_LSP_STRLEN(p2)) <= 0; } else { lsp->errnum = ASE_LSP_ERR_BAD_VALUE; diff --git a/ase/lsp/prim_let.c b/ase/lsp/prim_let.c index 59866b7a..e230fe5c 100644 --- a/ase/lsp/prim_let.c +++ b/ase/lsp/prim_let.c @@ -1,8 +1,8 @@ /* - * $Id: prim_let.c,v 1.6 2006-10-25 13:42:31 bacon Exp $ + * $Id: prim_let.c,v 1.7 2006-10-26 08:17:37 bacon Exp $ */ -#include +#include static ase_lsp_obj_t* __prim_let ( ase_lsp_t* lsp, ase_lsp_obj_t* args, int sequential) @@ -15,18 +15,21 @@ static ase_lsp_obj_t* __prim_let ( ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT); // create a new frame - frame = ase_lsp_frame_new (); - if (frame == ASE_NULL) { - lsp->errnum = ASE_LSP_ERR_MEMORY; + frame = ase_lsp_newframe (lsp); + if (frame == ASE_NULL) + { + lsp->errnum = ASE_LSP_ENOMEM; return ASE_NULL; } //frame->link = lsp->mem->frame; - if (sequential) { + if (sequential) + { frame->link = lsp->mem->frame; lsp->mem->frame = frame; } - else { + else + { frame->link = lsp->mem->brooding_frame; lsp->mem->brooding_frame = frame; } @@ -34,72 +37,84 @@ static ase_lsp_obj_t* __prim_let ( assoc = ASE_LSP_CAR(args); //while (assoc != lsp->mem->nil) { - while (ASE_LSP_TYPE(assoc) == ASE_LSP_OBJ_CONS) { + while (ASE_LSP_TYPE(assoc) == ASE_LSP_OBJ_CONS) + { ase_lsp_obj_t* ass = ASE_LSP_CAR(assoc); - if (ASE_LSP_TYPE(ass) == ASE_LSP_OBJ_CONS) { + if (ASE_LSP_TYPE(ass) == ASE_LSP_OBJ_CONS) + { 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_SYM) { + 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; - ase_lsp_frame_free (frame); + ase_lsp_freeframe (lsp, frame); return ASE_NULL; } - if (v != lsp->mem->nil) { - if (ASE_LSP_CDR(v) != lsp->mem->nil) { + if (v != lsp->mem->nil) + { + if (ASE_LSP_CDR(v) != lsp->mem->nil) + { lsp->errnum = ASE_LSP_ERR_TOO_MANY_ARGS; // must be a symbol if (sequential) lsp->mem->frame = frame->link; else lsp->mem->brooding_frame = frame->link; - ase_lsp_frame_free (frame); + ase_lsp_freeframe (lsp, frame); return ASE_NULL; } - if ((v = ase_lsp_eval(lsp, ASE_LSP_CAR(v))) == ASE_NULL) { + if ((v = ase_lsp_eval(lsp, ASE_LSP_CAR(v))) == ASE_NULL) + { if (sequential) lsp->mem->frame = frame->link; else lsp->mem->brooding_frame = frame->link; - ase_lsp_frame_free (frame); + ase_lsp_freeframe (lsp, frame); return ASE_NULL; } } - if (ase_lsp_frame_lookup (frame, n) != ASE_NULL) { + if (ase_lsp_lookupinframe (lsp, frame, n) != ASE_NULL) + { lsp->errnum = ASE_LSP_ERR_DUP_FORMAL; if (sequential) lsp->mem->frame = frame->link; else lsp->mem->brooding_frame = frame->link; - ase_lsp_frame_free (frame); + ase_lsp_freeframe (lsp, frame); return ASE_NULL; } - if (ase_lsp_frame_insert_value(frame, n, v) == ASE_NULL) { - lsp->errnum = ASE_LSP_ERR_MEMORY; + if (ase_lsp_insertvalueintoframe (lsp, frame, n, v) == ASE_NULL) + { + lsp->errnum = ASE_LSP_ENOMEM; if (sequential) lsp->mem->frame = frame->link; else lsp->mem->brooding_frame = frame->link; - ase_lsp_frame_free (frame); + ase_lsp_freeframe (lsp, frame); return ASE_NULL; } } - else if (ASE_LSP_TYPE(ass) == ASE_LSP_OBJ_SYM) { - if (ase_lsp_frame_lookup(frame, ass) != ASE_NULL) { + else if (ASE_LSP_TYPE(ass) == ASE_LSP_OBJ_SYM) + { + if (ase_lsp_lookupinframe (lsp, frame, ass) != ASE_NULL) + { lsp->errnum = ASE_LSP_ERR_DUP_FORMAL; if (sequential) lsp->mem->frame = frame->link; else lsp->mem->brooding_frame = frame->link; - ase_lsp_frame_free (frame); + ase_lsp_freeframe (lsp, frame); return ASE_NULL; } - if (ase_lsp_frame_insert_value(frame, ass, lsp->mem->nil) == ASE_NULL) { - lsp->errnum = ASE_LSP_ERR_MEMORY; + if (ase_lsp_insertvalueintoframe (lsp, frame, ass, lsp->mem->nil) == ASE_NULL) + { + lsp->errnum = ASE_LSP_ENOMEM; if (sequential) lsp->mem->frame = frame->link; else lsp->mem->brooding_frame = frame->link; - ase_lsp_frame_free (frame); + ase_lsp_freeframe (lsp, frame); return ASE_NULL; } } - else { + else + { lsp->errnum = ASE_LSP_ERR_BAD_ARG; if (sequential) lsp->mem->frame = frame->link; else lsp->mem->brooding_frame = frame->link; - ase_lsp_frame_free (frame); + ase_lsp_freeframe (lsp, frame); return ASE_NULL; } @@ -110,7 +125,7 @@ static ase_lsp_obj_t* __prim_let ( lsp->errnum = ASE_LSP_ERR_BAD_ARG; if (sequential) lsp->mem->frame = frame->link; else lsp->mem->brooding_frame = frame->link; - ase_lsp_frame_free (frame); + ase_lsp_freeframe (lsp, frame); return ASE_NULL; } @@ -128,7 +143,7 @@ static ase_lsp_obj_t* __prim_let ( value = ase_lsp_eval (lsp, ASE_LSP_CAR(body)); if (value == ASE_NULL) { lsp->mem->frame = frame->link; - ase_lsp_frame_free (frame); + ase_lsp_freeframe (lsp, frame); return ASE_NULL; } body = ASE_LSP_CDR(body); @@ -138,7 +153,7 @@ static ase_lsp_obj_t* __prim_let ( lsp->mem->frame = frame->link; // destroy the frame - ase_lsp_frame_free (frame); + ase_lsp_freeframe (lsp, frame); return value; } diff --git a/ase/lsp/prim_math.c b/ase/lsp/prim_math.c index 9a95cde6..8ad54247 100644 --- a/ase/lsp/prim_math.c +++ b/ase/lsp/prim_math.c @@ -1,9 +1,8 @@ /* - * $Id: prim_math.c,v 1.9 2006-10-25 13:42:31 bacon Exp $ + * $Id: prim_math.c,v 1.10 2006-10-26 08:17:38 bacon Exp $ */ -#include -#include +#include ase_lsp_obj_t* ase_lsp_prim_plus (ase_lsp_t* lsp, ase_lsp_obj_t* args) { @@ -13,7 +12,7 @@ ase_lsp_obj_t* ase_lsp_prim_plus (ase_lsp_t* lsp, ase_lsp_obj_t* args) ase_bool_t realnum = ase_false; 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); + ase_lsp_assert (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); body = args; //while (body != lsp->mem->nil) { @@ -26,7 +25,7 @@ ase_lsp_obj_t* ase_lsp_prim_plus (ase_lsp_t* lsp, ase_lsp_obj_t* args) if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT) { if (body == args) { - ase_assert (realnum == ase_false); + ase_lsp_assert (lsp, realnum == ase_false); ivalue = ASE_LSP_IVALUE(tmp); } else { @@ -38,7 +37,7 @@ ase_lsp_obj_t* ase_lsp_prim_plus (ase_lsp_t* lsp, ase_lsp_obj_t* args) } else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL) { if (body == args) { - ase_assert (realnum == ase_false); + ase_lsp_assert (lsp, realnum == ase_false); realnum = ase_true; rvalue = ASE_LSP_RVALUE(tmp); } @@ -59,13 +58,13 @@ ase_lsp_obj_t* ase_lsp_prim_plus (ase_lsp_t* lsp, ase_lsp_obj_t* args) body = ASE_LSP_CDR(body); } - ase_assert (body == lsp->mem->nil); + ase_lsp_assert (lsp, body == lsp->mem->nil); tmp = (realnum)? ase_lsp_makerealobj (lsp->mem, rvalue): ase_lsp_makeintobj (lsp->mem, ivalue); if (tmp == ASE_NULL) { - lsp->errnum = ASE_LSP_ERR_MEMORY; + lsp->errnum = ASE_LSP_ENOMEM; return ASE_NULL; } @@ -80,7 +79,7 @@ ase_lsp_obj_t* ase_lsp_prim_minus (ase_lsp_t* lsp, ase_lsp_obj_t* args) ase_bool_t realnum = ase_false; 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); + ase_lsp_assert (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); body = args; //while (body != lsp->mem->nil) { @@ -91,7 +90,7 @@ ase_lsp_obj_t* ase_lsp_prim_minus (ase_lsp_t* lsp, ase_lsp_obj_t* args) if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT) { if (body == args) { - ase_assert (realnum == ase_false); + ase_lsp_assert (lsp, realnum == ase_false); ivalue = ASE_LSP_IVALUE(tmp); } else { @@ -103,7 +102,7 @@ ase_lsp_obj_t* ase_lsp_prim_minus (ase_lsp_t* lsp, ase_lsp_obj_t* args) } else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL) { if (body == args) { - ase_assert (realnum == ase_false); + ase_lsp_assert (lsp, realnum == ase_false); realnum = ase_true; rvalue = ASE_LSP_RVALUE(tmp); } @@ -124,13 +123,13 @@ ase_lsp_obj_t* ase_lsp_prim_minus (ase_lsp_t* lsp, ase_lsp_obj_t* args) body = ASE_LSP_CDR(body); } - ase_assert (body == lsp->mem->nil); + ase_lsp_assert (lsp, body == lsp->mem->nil); tmp = (realnum)? ase_lsp_makerealobj (lsp->mem, rvalue): ase_lsp_makeintobj (lsp->mem, ivalue); if (tmp == ASE_NULL) { - lsp->errnum = ASE_LSP_ERR_MEMORY; + lsp->errnum = ASE_LSP_ENOMEM; return ASE_NULL; } @@ -145,7 +144,7 @@ ase_lsp_obj_t* ase_lsp_prim_multiply (ase_lsp_t* lsp, ase_lsp_obj_t* args) ase_bool_t realnum = ase_false; 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); + ase_lsp_assert (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); body = args; //while (body != lsp->mem->nil) { @@ -156,7 +155,7 @@ ase_lsp_obj_t* ase_lsp_prim_multiply (ase_lsp_t* lsp, ase_lsp_obj_t* args) if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT) { if (body == args) { - ase_assert (realnum == ase_false); + ase_lsp_assert (lsp, realnum == ase_false); ivalue = ASE_LSP_IVALUE(tmp); } else { @@ -168,7 +167,7 @@ ase_lsp_obj_t* ase_lsp_prim_multiply (ase_lsp_t* lsp, ase_lsp_obj_t* args) } else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL) { if (body == args) { - ase_assert (realnum == ase_false); + ase_lsp_assert (lsp, realnum == ase_false); realnum = ase_true; rvalue = ASE_LSP_RVALUE(tmp); } @@ -189,13 +188,13 @@ ase_lsp_obj_t* ase_lsp_prim_multiply (ase_lsp_t* lsp, ase_lsp_obj_t* args) body = ASE_LSP_CDR(body); } - ase_assert (body == lsp->mem->nil); + ase_lsp_assert (lsp, body == lsp->mem->nil); tmp = (realnum)? ase_lsp_makerealobj (lsp->mem, rvalue): ase_lsp_makeintobj (lsp->mem, ivalue); if (tmp == ASE_NULL) { - lsp->errnum = ASE_LSP_ERR_MEMORY; + lsp->errnum = ASE_LSP_ENOMEM; return ASE_NULL; } @@ -210,7 +209,7 @@ ase_lsp_obj_t* ase_lsp_prim_divide (ase_lsp_t* lsp, ase_lsp_obj_t* args) ase_bool_t realnum = ase_false; 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); + ase_lsp_assert (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); body = args; //while (body != lsp->mem->nil) { @@ -221,13 +220,13 @@ ase_lsp_obj_t* ase_lsp_prim_divide (ase_lsp_t* lsp, ase_lsp_obj_t* args) if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT) { if (body == args) { - ase_assert (realnum == ase_false); + ase_lsp_assert (lsp, realnum == ase_false); ivalue = ASE_LSP_IVALUE(tmp); } else { if (!realnum) { if (ASE_LSP_IVALUE(tmp) == 0) { - lsp->errnum = ASE_LSP_ERR_DIVIDE_BY_ZERO; + lsp->errnum = ASE_LSP_EDIVBYZERO; return ASE_NULL; } ivalue = ivalue / ASE_LSP_IVALUE(tmp); @@ -238,7 +237,7 @@ ase_lsp_obj_t* ase_lsp_prim_divide (ase_lsp_t* lsp, ase_lsp_obj_t* args) } else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL) { if (body == args) { - ase_assert (realnum == ase_false); + ase_lsp_assert (lsp, realnum == ase_false); realnum = ase_true; rvalue = ASE_LSP_RVALUE(tmp); } @@ -259,13 +258,14 @@ ase_lsp_obj_t* ase_lsp_prim_divide (ase_lsp_t* lsp, ase_lsp_obj_t* args) body = ASE_LSP_CDR(body); } - ase_assert (body == lsp->mem->nil); + ase_lsp_assert (lsp, body == lsp->mem->nil); tmp = (realnum)? ase_lsp_makerealobj (lsp->mem, rvalue): ase_lsp_makeintobj (lsp->mem, ivalue); - if (tmp == ASE_NULL) { - lsp->errnum = ASE_LSP_ERR_MEMORY; + if (tmp == ASE_NULL) + { + lsp->errnum = ASE_LSP_ENOMEM; return ASE_NULL; } @@ -278,7 +278,7 @@ ase_lsp_obj_t* ase_lsp_prim_modulus (ase_lsp_t* lsp, ase_lsp_obj_t* args) 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); + ase_lsp_assert (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); body = args; //while (body != lsp->mem->nil) { @@ -292,7 +292,7 @@ ase_lsp_obj_t* ase_lsp_prim_modulus (ase_lsp_t* lsp, ase_lsp_obj_t* args) } else { if (ASE_LSP_IVALUE(tmp) == 0) { - lsp->errnum = ASE_LSP_ERR_DIVIDE_BY_ZERO; + lsp->errnum = ASE_LSP_EDIVBYZERO; return ASE_NULL; } ivalue = ivalue % ASE_LSP_IVALUE(tmp); @@ -305,7 +305,7 @@ ase_lsp_obj_t* ase_lsp_prim_modulus (ase_lsp_t* lsp, ase_lsp_obj_t* args) else { ase_long_t tmpi = (ase_long_t)ASE_LSP_RVALUE(tmp); if (tmpi == 0) { - lsp->errnum = ASE_LSP_ERR_DIVIDE_BY_ZERO; + lsp->errnum = ASE_LSP_EDIVBYZERO; return ASE_NULL; } ivalue = ivalue % tmpi; @@ -320,7 +320,7 @@ ase_lsp_obj_t* ase_lsp_prim_modulus (ase_lsp_t* lsp, ase_lsp_obj_t* args) body = ASE_LSP_CDR(body); } - ase_assert (body == lsp->mem->nil); + ase_lsp_assert (lsp, body == lsp->mem->nil); tmp = ase_lsp_makeintobj (lsp->mem, ivalue); if (tmp == ASE_NULL) diff --git a/ase/lsp/prim_prog.c b/ase/lsp/prim_prog.c index 9961fe71..1b8f442e 100644 --- a/ase/lsp/prim_prog.c +++ b/ase/lsp/prim_prog.c @@ -1,8 +1,8 @@ /* - * $Id: prim_prog.c,v 1.3 2006-10-24 04:22:39 bacon Exp $ + * $Id: prim_prog.c,v 1.4 2006-10-26 08:17:38 bacon Exp $ */ -#include +#include ase_lsp_obj_t* ase_lsp_prim_prog1 (ase_lsp_t* lsp, ase_lsp_obj_t* args) { @@ -18,8 +18,8 @@ ase_lsp_obj_t* ase_lsp_prim_prog1 (ase_lsp_t* lsp, ase_lsp_obj_t* args) if (res == ASE_NULL) { /* - ase_lsp_array_t* ta = lsp->mem->temp_array; - ase_lsp_array_insert (ta, ta->size, tmp); + ase_lsp_arr_t* ta = lsp->mem->temp_arr; + ase_lsp_arr_insert (ta, ta->size, tmp); */ res = tmp; } diff --git a/ase/lsp/print.c b/ase/lsp/print.c index 5420a7a1..dcffe88f 100644 --- a/ase/lsp/print.c +++ b/ase/lsp/print.c @@ -1,67 +1,67 @@ /* - * $Id: print.c,v 1.15 2006-10-25 13:42:31 bacon Exp $ + * $Id: print.c,v 1.16 2006-10-26 08:17:38 bacon Exp $ */ -#include -#include -#include +#include +#if 0 void ase_lsp_print_debug (ase_lsp_obj_t* obj) { switch (ASE_LSP_TYPE(obj)) { case ASE_LSP_OBJ_NIL: - ase_printf (ASE_TEXT("nil")); + ase_printf (ASE_T("nil")); break; case ASE_LSP_OBJ_TRUE: - ase_printf (ASE_TEXT("t")); + ase_printf (ASE_T("t")); break; case ASE_LSP_OBJ_INT: - ase_printf (ASE_TEXT("%d"), ASE_LSP_IVALUE(obj)); + ase_printf (ASE_T("%d"), ASE_LSP_IVALUE(obj)); break; case ASE_LSP_OBJ_REAL: - ase_printf (ASE_TEXT("%f"), ASE_LSP_RVALUE(obj)); + ase_printf (ASE_T("%f"), ASE_LSP_RVALUE(obj)); break; case ASE_LSP_OBJ_SYM: - ase_printf (ASE_TEXT("%s"), ASE_LSP_SYMVALUE(obj)); + ase_printf (ASE_T("%s"), ASE_LSP_SYMPTR(obj)); break; case ASE_LSP_OBJ_STR: - ase_printf (ASE_TEXT("%s"), ASE_LSP_STRVALUE(obj)); + ase_printf (ASE_T("%s"), ASE_LSP_STRPTR(obj)); break; case ASE_LSP_OBJ_CONS: { ase_lsp_obj_t* p = obj; - ase_printf (ASE_TEXT("(")); + ase_printf (ASE_T("(")); do { ase_lsp_print_debug (ASE_LSP_CAR(p)); p = ASE_LSP_CDR(p); if (ASE_LSP_TYPE(p) != ASE_LSP_OBJ_NIL) { - ase_printf (ASE_TEXT(" ")); + ase_printf (ASE_T(" ")); if (ASE_LSP_TYPE(p) != ASE_LSP_OBJ_CONS) { - ase_printf (ASE_TEXT(". ")); + ase_printf (ASE_T(". ")); ase_lsp_print_debug (p); } } } while (ASE_LSP_TYPE(p) != ASE_LSP_OBJ_NIL && ASE_LSP_TYPE(p) == ASE_LSP_OBJ_CONS); - ase_printf (ASE_TEXT(")")); + ase_printf (ASE_T(")")); } break; case ASE_LSP_OBJ_FUNC: - ase_printf (ASE_TEXT("func")); + ase_printf (ASE_T("func")); break; case ASE_LSP_OBJ_MACRO: - ase_printf (ASE_TEXT("macro")); + ase_printf (ASE_T("macro")); break; case ASE_LSP_OBJ_PRIM: - ase_printf (ASE_TEXT("prim")); + ase_printf (ASE_T("prim")); break; default: - ase_printf (ASE_TEXT("unknown object type: %d"), ASE_LSP_TYPE(obj)); + ase_printf (ASE_T("unknown object type: %d"), ASE_LSP_TYPE(obj)); } } +#endif #define OUTPUT_STR(lsp,str) \ do { \ - if (lsp->output_func(ASE_LSP_IO_DATA, lsp->output_arg, (ase_char_t*)str, ase_strlen(str)) == -1) { \ + if (lsp->output_func(ASE_LSP_IO_WRITE, lsp->output_arg, (ase_char_t*)str, ase_lsp_strlen(str)) == -1) { \ lsp->errnum = ASE_LSP_ERR_OUTPUT; \ return -1; \ } \ @@ -69,7 +69,7 @@ void ase_lsp_print_debug (ase_lsp_obj_t* obj) #define OUTPUT_STRX(lsp,str,len) \ do { \ - if (lsp->output_func(ASE_LSP_IO_DATA, lsp->output_arg, (ase_char_t*)str, len) == -1) { \ + if (lsp->output_func(ASE_LSP_IO_WRITE, lsp->output_arg, (ase_char_t*)str, len) == -1) { \ lsp->errnum = ASE_LSP_ERR_OUTPUT; \ return -1; \ } \ @@ -86,82 +86,103 @@ static int __print (ase_lsp_t* lsp, const ase_lsp_obj_t* obj, ase_bool_t prt_con switch (ASE_LSP_TYPE(obj)) { case ASE_LSP_OBJ_NIL: - OUTPUT_STR (lsp, ASE_TEXT("nil")); + OUTPUT_STR (lsp, ASE_T("nil")); break; case ASE_LSP_OBJ_TRUE: - OUTPUT_STR (lsp, ASE_TEXT("t")); + OUTPUT_STR (lsp, ASE_T("t")); break; case ASE_LSP_OBJ_INT: if (ase_sizeof(ase_long_t) == ase_sizeof(int)) { - ase_sprintf (buf, ase_countof(buf), ASE_TEXT("%d"), ASE_LSP_IVALUE(obj)); + lsp->syscas.sprintf ( + buf, ase_countof(buf), + ASE_T("%d"), ASE_LSP_IVALUE(obj)); } - 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_long_t) == ase_sizeof(long)) + { + lsp->syscas.sprintf ( + buf, ase_countof(buf), + ASE_T("%ld"), ASE_LSP_IVALUE(obj)); } - else if (ase_sizeof(ase_long_t) == ase_sizeof(long long)) { - ase_sprintf (buf, ase_countof(buf), ASE_TEXT("%lld"), ASE_LSP_IVALUE(obj)); +#if defined(__BORLANDC__) || defined(_MSC_VER) + else if (ase_sizeof(ase_long_t) == ase_sizeof(__int64)) + { + lsp->syscas.sprintf ( + buf, ase_countof(buf), + ASE_T("%I64d"), ASE_LSP_IVALUE(obj)); } +#else + else if (ase_sizeof(ase_long_t) == ase_sizeof(long long)) + { + lsp->syscas.sprintf ( + buf, ase_countof(buf), + ASE_T("%lld"), ASE_LSP_IVALUE(obj)); + } +#endif OUTPUT_STR (lsp, buf); break; case ASE_LSP_OBJ_REAL: if (ase_sizeof(ase_real_t) == ase_sizeof(double)) { - ase_sprintf (buf, ase_countof(buf), ASE_TEXT("%f"), + lsp->syscas.sprintf (buf, ase_countof(buf), ASE_T("%f"), (double)ASE_LSP_RVALUE(obj)); } else if (ase_sizeof(ase_real_t) == ase_sizeof(long double)) { - ase_sprintf (buf, ase_countof(buf), ASE_TEXT("%Lf"), + lsp->syscas.sprintf (buf, ase_countof(buf), ASE_T("%Lf"), (long double)ASE_LSP_RVALUE(obj)); } OUTPUT_STR (lsp, buf); break; case ASE_LSP_OBJ_SYM: - OUTPUT_STR (lsp, ASE_LSP_SYMVALUE(obj)); + OUTPUT_STR (lsp, ASE_LSP_SYMPTR(obj)); break; case ASE_LSP_OBJ_STR: - OUTPUT_STR (lsp, ASE_LSP_STRVALUE(obj)); + OUTPUT_STR (lsp, ASE_LSP_STRPTR(obj)); break; case ASE_LSP_OBJ_CONS: { const ase_lsp_obj_t* p = obj; - if (prt_cons_par) OUTPUT_STR (lsp, ASE_TEXT("(")); - do { + if (prt_cons_par) OUTPUT_STR (lsp, ASE_T("(")); + do + { ase_lsp_print (lsp, ASE_LSP_CAR(p)); p = ASE_LSP_CDR(p); - if (p != lsp->mem->nil) { - OUTPUT_STR (lsp, ASE_TEXT(" ")); - if (ASE_LSP_TYPE(p) != ASE_LSP_OBJ_CONS) { - OUTPUT_STR (lsp, ASE_TEXT(". ")); + if (p != lsp->mem->nil) + { + OUTPUT_STR (lsp, ASE_T(" ")); + if (ASE_LSP_TYPE(p) != ASE_LSP_OBJ_CONS) + { + OUTPUT_STR (lsp, ASE_T(". ")); ase_lsp_print (lsp, p); } } - } while (p != lsp->mem->nil && ASE_LSP_TYPE(p) == ASE_LSP_OBJ_CONS); - if (prt_cons_par) OUTPUT_STR (lsp, ASE_TEXT(")")); + } + while (p != lsp->mem->nil && ASE_LSP_TYPE(p) == ASE_LSP_OBJ_CONS); + if (prt_cons_par) OUTPUT_STR (lsp, ASE_T(")")); } break; case ASE_LSP_OBJ_FUNC: - /*OUTPUT_STR (lsp, ASE_TEXT("func"));*/ - OUTPUT_STR (lsp, ASE_TEXT("(lambda ")); + /*OUTPUT_STR (lsp, ASE_T("func"));*/ + OUTPUT_STR (lsp, ASE_T("(lambda ")); if (__print (lsp, ASE_LSP_FFORMAL(obj), ase_true) == -1) return -1; - OUTPUT_STR (lsp, ASE_TEXT(" ")); + OUTPUT_STR (lsp, ASE_T(" ")); if (__print (lsp, ASE_LSP_FBODY(obj), ase_false) == -1) return -1; - OUTPUT_STR (lsp, ASE_TEXT(")")); + OUTPUT_STR (lsp, ASE_T(")")); break; case ASE_LSP_OBJ_MACRO: - /*OUTPUT_STR (lsp, ASE_TEXT("macro"));*/ - OUTPUT_STR (lsp, ASE_TEXT("(macro ")); + /*OUTPUT_STR (lsp, ASE_T("macro"));*/ + OUTPUT_STR (lsp, ASE_T("(macro ")); if (__print (lsp, ASE_LSP_FFORMAL(obj), ase_true) == -1) return -1; - OUTPUT_STR (lsp, ASE_TEXT(" ")); + OUTPUT_STR (lsp, ASE_T(" ")); if (__print (lsp, ASE_LSP_FBODY(obj), ase_false) == -1) return -1; - OUTPUT_STR (lsp, ASE_TEXT(")")); + OUTPUT_STR (lsp, ASE_T(")")); break; case ASE_LSP_OBJ_PRIM: - OUTPUT_STR (lsp, ASE_TEXT("prim")); + OUTPUT_STR (lsp, ASE_T("prim")); break; default: - ase_sprintf (buf, ase_countof(buf), - ASE_TEXT("unknown object type: %d"), ASE_LSP_TYPE(obj)); + lsp->syscas.sprintf (buf, ase_countof(buf), + ASE_T("unknown object type: %d"), ASE_LSP_TYPE(obj)); OUTPUT_STR (lsp, buf); } diff --git a/ase/lsp/read.c b/ase/lsp/read.c index 668f584e..9013e0b6 100644 --- a/ase/lsp/read.c +++ b/ase/lsp/read.c @@ -1,14 +1,9 @@ /* - * $Id: read.c,v 1.22 2006-10-25 13:42:31 bacon Exp $ + * $Id: read.c,v 1.23 2006-10-26 08:17:38 bacon Exp $ */ #include -#define IS_SPACE(x) ase_isspace(x) -#define IS_DIGIT(x) ase_isdigit(x) -#define IS_ALPHA(x) ase_isalpha(x) -#define IS_ALNUM(x) ase_isalnum(x) - #define IS_IDENT(c) \ ((c) == ASE_T('+') || (c) == ASE_T('-') || \ (c) == ASE_T('*') || (c) == ASE_T('/') || \ @@ -17,21 +12,21 @@ (c) == ASE_T('=') || (c) == ASE_T('_') || \ (c) == ASE_T('?')) -#define TOKEN_CLEAR(lsp) ase_lsp_token_clear (&(lsp)->token) +#define TOKEN_CLEAR(lsp) ase_lsp_name_clear (&(lsp)->token.name) #define TOKEN_TYPE(lsp) (lsp)->token.type #define TOKEN_IVALUE(lsp) (lsp)->token.ivalue #define TOKEN_RVALUE(lsp) (lsp)->token.rvalue -#define TOKEN_SVALUE(lsp) (lsp)->token.name.buffer +#define TOKEN_SVALUE(lsp) (lsp)->token.name.buf #define TOKEN_SLENGTH(lsp) (lsp)->token.name.size #define TOKEN_ADD_CHAR(lsp,ch) do { \ - if (ase_lsp_token_addc(&(lsp)->token, ch) == -1) { \ + if (ase_lsp_name_addc(&(lsp)->token.name, ch) == -1) { \ lsp->errnum = ASE_LSP_ENOMEM; \ return -1; \ } \ } while (0) -#define TOKEN_COMPARE(lsp,str) ase_lsp_token_compare_name (&(lsp)->token, str) +#define TOKEN_COMPARE(lsp,str) ase_lsp_name_compare (&(lsp)->token.name, str) #define TOKEN_END 0 #define TOKEN_INT 1 @@ -82,7 +77,8 @@ static ase_lsp_obj_t* read_obj (ase_lsp_t* lsp) { ase_lsp_obj_t* obj; - switch (TOKEN_TYPE(lsp)) { + switch (TOKEN_TYPE(lsp)) + { case TOKEN_END: lsp->errnum = ASE_LSP_ERR_END; return ASE_NULL; @@ -109,7 +105,8 @@ static ase_lsp_obj_t* read_obj (ase_lsp_t* lsp) ase_lsp_lockobj (lsp, obj); return obj; case TOKEN_IDENT: - ase_assert (lsp->mem->nil != ASE_NULL && lsp->mem->t != ASE_NULL); + ase_lsp_assert (lsp, + 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 @@ -131,13 +128,16 @@ static ase_lsp_obj_t* read_list (ase_lsp_t* lsp) ase_lsp_obj_t* obj; ase_lsp_obj_cons_t* p, * first = ASE_NULL, * prev = ASE_NULL; - while (TOKEN_TYPE(lsp) != TOKEN_RPAREN) { - if (TOKEN_TYPE(lsp) == TOKEN_END) { + while (TOKEN_TYPE(lsp) != TOKEN_RPAREN) + { + if (TOKEN_TYPE(lsp) == TOKEN_END) + { lsp->errnum = ASE_LSP_ERR_SYNTAX; // unexpected end of input return ASE_NULL; } - if (TOKEN_TYPE(lsp) == TOKEN_DOT) { + if (TOKEN_TYPE(lsp) == TOKEN_DOT) + { if (prev == ASE_NULL) { lsp->errnum = ASE_LSP_ERR_SYNTAX; // unexpected . return ASE_NULL; @@ -145,8 +145,10 @@ static ase_lsp_obj_t* read_list (ase_lsp_t* lsp) NEXT_TOKEN (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; } @@ -155,7 +157,8 @@ static ase_lsp_obj_t* read_list (ase_lsp_t* lsp) prev->cdr = obj; NEXT_TOKEN (lsp); - if (TOKEN_TYPE(lsp) != TOKEN_RPAREN) { + if (TOKEN_TYPE(lsp) != TOKEN_RPAREN) + { lsp->errnum = ASE_LSP_ERR_SYNTAX; // ) expected return ASE_NULL; } @@ -239,7 +242,7 @@ static int read_char (ase_lsp_t* lsp) return -1; } - n = lsp->input_func(ASE_LSP_IO_DATA, lsp->input_arg, &lsp->curc, 1); + n = lsp->input_func(ASE_LSP_IO_READ, lsp->input_arg, &lsp->curc, 1); if (n == -1) { lsp->errnum = ASE_LSP_ERR_INPUT; @@ -252,14 +255,14 @@ static int read_char (ase_lsp_t* lsp) static int read_token (ase_lsp_t* lsp) { - ase_assert (lsp->input_func != ASE_NULL); + ase_lsp_assert (lsp, lsp->input_func != ASE_NULL); TOKEN_CLEAR (lsp); while (1) { // skip white spaces - while (IS_SPACE(lsp->curc)) NEXT_CHAR (lsp); + while (ASE_LSP_ISSPACE(lsp, lsp->curc)) NEXT_CHAR (lsp); // skip the comments here if (lsp->curc == ASE_T(';')) @@ -268,7 +271,8 @@ static int read_token (ase_lsp_t* lsp) { NEXT_CHAR (lsp); } - while (lsp->curc != ASE_T('\n') && lsp->curc != ASE_CHAR_EOF); + while (lsp->curc != ASE_T('\n') && + lsp->curc != ASE_CHAR_EOF); } else break; } @@ -310,7 +314,7 @@ static int read_token (ase_lsp_t* lsp) { TOKEN_ADD_CHAR (lsp, lsp->curc); NEXT_CHAR (lsp); - if (IS_DIGIT(lsp->curc)) + if (ASE_LSP_ISDIGIT(lsp,lsp->curc)) { return read_number (lsp, 1); } @@ -324,11 +328,11 @@ static int read_token (ase_lsp_t* lsp) return 0; } } - else if (IS_DIGIT(lsp->curc)) + else if (ASE_LSP_ISDIGIT(lsp,lsp->curc)) { return read_number (lsp, 0); } - else if (IS_ALPHA(lsp->curc) || IS_IDENT(lsp->curc)) + else if (ASE_LSP_ISALPHA(lsp,lsp->curc) || IS_IDENT(lsp->curc)) { return read_ident (lsp); } @@ -354,7 +358,7 @@ static int read_number (ase_lsp_t* lsp, int negative) TOKEN_ADD_CHAR (lsp, lsp->curc); NEXT_CHAR (lsp); } - while (IS_DIGIT(lsp->curc)); + while (ASE_LSP_ISDIGIT(lsp,lsp->curc)); /* TODO: extend parsing floating point number */ if (lsp->curc == ASE_T('.')) @@ -364,7 +368,7 @@ static int read_number (ase_lsp_t* lsp, int negative) NEXT_CHAR (lsp); rvalue = (ase_real_t)ivalue; - while (IS_DIGIT(lsp->curc)) + while (ASE_LSP_ISDIGIT(lsp, lsp->curc)) { rvalue += (ase_real_t)(lsp->curc - ASE_T('0')) * fraction; fraction *= 0.1; @@ -386,10 +390,12 @@ static int read_number (ase_lsp_t* lsp, int negative) static int read_ident (ase_lsp_t* lsp) { - do { + do + { TOKEN_ADD_CHAR (lsp, lsp->curc); NEXT_CHAR (lsp); - } while (IS_ALNUM(lsp->curc) || IS_IDENT(lsp->curc)); + } + while (ASE_LSP_ISALNUM(lsp,lsp->curc) || IS_IDENT(lsp->curc)); TOKEN_TYPE(lsp) = TOKEN_IDENT; return 0; } @@ -399,20 +405,25 @@ static int read_string (ase_lsp_t* lsp) int escaped = 0; ase_cint_t code = 0; - do { - if (lsp->curc == ASE_CHAR_EOF) { + do + { + if (lsp->curc == ASE_CHAR_EOF) + { TOKEN_TYPE(lsp) = TOKEN_UNTERM_STRING; return 0; } // TODO: - if (escaped == 3) { + if (escaped == 3) + { /* \xNN */ } - else if (escaped == 2) { + else if (escaped == 2) + { /* \000 */ } - else if (escaped == 1) { + else if (escaped == 1) + { /* backslash + character */ if (lsp->curc == ASE_T('a')) lsp->curc = ASE_T('\a'); @@ -428,20 +439,23 @@ static int read_string (ase_lsp_t* lsp) lsp->curc = ASE_T('\t'); else if (lsp->curc == ASE_T('v')) lsp->curc = ASE_T('\v'); - else if (lsp->curc == ASE_T('0')) { + else if (lsp->curc == ASE_T('0')) + { escaped = 2; code = 0; NEXT_CHAR (lsp); continue; } - else if (lsp->curc == ASE_T('x')) { + else if (lsp->curc == ASE_T('x')) + { escaped = 3; code = 0; NEXT_CHAR (lsp); continue; } } - else if (lsp->curc == ASE_T('\\')) { + else if (lsp->curc == ASE_T('\\')) + { escaped = 1; NEXT_CHAR (lsp); continue; @@ -449,7 +463,8 @@ static int read_string (ase_lsp_t* lsp) TOKEN_ADD_CHAR (lsp, lsp->curc); NEXT_CHAR (lsp); - } while (lsp->curc != ASE_T('\"')); + } + while (lsp->curc != ASE_T('\"')); TOKEN_TYPE(lsp) = TOKEN_STRING; NEXT_CHAR (lsp); diff --git a/ase/lsp/token.c b/ase/lsp/token.c deleted file mode 100644 index 3b7a9c53..00000000 --- a/ase/lsp/token.c +++ /dev/null @@ -1,77 +0,0 @@ -/* - * $Id: token.c,v 1.16 2006-10-25 14:42:40 bacon Exp $ - */ - -#include - -ase_lsp_token_t* ase_lsp_token_open ( - ase_lsp_token_t* token, ase_size_t capacity) -{ - if (token == ASE_NULL) - { - token = (ase_lsp_token_t*) - ase_malloc (ase_sizeof(ase_lsp_token_t)); - if (token == ASE_NULL) return ASE_NULL; - token->__dynamic = ase_true; - } - else token->__dynamic = ase_false; - - if (ase_lsp_name_open(&token->name, capacity) == ASE_NULL) { - if (token->__dynamic) ase_free (token); - return ASE_NULL; - } - - /* - token->ivalue = 0; - token->fvalue = .0; - */ - token->type = ASE_LSP_TOKEN_END; - return token; -} - -void ase_lsp_token_close (ase_lsp_token_t* token) -{ - ase_lsp_name_close (&token->name); - if (token->__dynamic) ase_free (token); -} - -int ase_lsp_token_addc (ase_lsp_token_t* token, ase_cint_t c) -{ - return ase_lsp_name_addc (&token->name, c); -} - -int ase_lsp_token_adds (ase_lsp_token_t* token, const ase_char_t* s) -{ - return ase_lsp_name_adds (&token->name, s); -} - -void ase_lsp_token_clear (ase_lsp_token_t* token) -{ - /* - token->ivalue = 0; - token->fvalue = .0; - */ - - token->type = ASE_LSP_TOKEN_END; - ase_lsp_name_clear (&token->name); -} - -ase_char_t* ase_lsp_token_yield (ase_lsp_token_t* token, ase_size_t capacity) -{ - ase_char_t* p; - - p = ase_lsp_name_yield (&token->name, capacity); - if (p == ASE_NULL) return ASE_NULL; - - /* - token->ivalue = 0; - token->fvalue = .0; - */ - token->type = ASE_LSP_TOKEN_END; - return p; -} - -int ase_lsp_token_compare_name (ase_lsp_token_t* token, const ase_char_t* str) -{ - return ase_lsp_name_compare (&token->name, str); -} diff --git a/ase/lsp/token.h b/ase/lsp/token.h deleted file mode 100644 index 80156140..00000000 --- a/ase/lsp/token.h +++ /dev/null @@ -1,46 +0,0 @@ -/* - * $Id: token.h,v 1.15 2006-10-25 14:42:40 bacon Exp $ - */ - -#ifndef _ASE_LSP_TOKEN_H_ -#define _ASE_LSP_TOKEN_H_ - -#include - -enum -{ - ASE_LSP_TOKEN_END -}; - -struct ase_lsp_token_t -{ - int type; - - ase_long_t ivalue; - ase_real_t rvalue; - - ase_lsp_name_t name; - ase_bool_t __dynamic; -}; - -typedef struct ase_lsp_token_t ase_lsp_token_t; - -#ifdef __cplusplus -extern "C" { -#endif - -ase_lsp_token_t* ase_lsp_token_open ( - ase_lsp_token_t* token, ase_size_t capacity); -void ase_lsp_token_close (ase_lsp_token_t* token); - -int ase_lsp_token_addc (ase_lsp_token_t* token, ase_cint_t c); -int ase_lsp_token_adds (ase_lsp_token_t* token, const ase_char_t* s); -void ase_lsp_token_clear (ase_lsp_token_t* token); -ase_char_t* ase_lsp_token_yield (ase_lsp_token_t* token, ase_size_t capacity); -int ase_lsp_token_compare_name (ase_lsp_token_t* token, const ase_char_t* str); - -#ifdef __cplusplus -} -#endif - -#endif