From ce62271756bd957f49a40e059b14893f9bb72928 Mon Sep 17 00:00:00 2001 From: hyung-hwan Date: Fri, 4 Feb 2005 16:00:37 +0000 Subject: [PATCH] *** empty log message *** --- ase/lsp/array.c | 16 +- ase/lsp/array.h | 22 +-- ase/lsp/env.c | 8 +- ase/lsp/env.h | 8 +- ase/lsp/eval.c | 122 +++++++-------- ase/lsp/lisp.c | 16 +- ase/lsp/lisp.h | 58 ++++---- ase/lsp/makefile.in | 2 +- ase/lsp/memory.c | 236 ++++++++++++++--------------- ase/lsp/memory.h | 16 +- ase/lsp/object.h | 100 ++++++------- ase/lsp/primitive.c | 352 ++++++++++++++++++++++---------------------- ase/lsp/primitive.h | 20 +-- ase/lsp/print.c | 124 ++++++++-------- ase/lsp/read.c | 132 ++++++++--------- ase/lsp/token.c | 12 +- ase/lsp/token.h | 6 +- 17 files changed, 626 insertions(+), 624 deletions(-) diff --git a/ase/lsp/array.c b/ase/lsp/array.c index 11d97ed7..108924c8 100644 --- a/ase/lsp/array.c +++ b/ase/lsp/array.c @@ -1,16 +1,16 @@ /* - * $Id: array.c,v 1.1 2005-02-04 15:39:11 bacon Exp $ + * $Id: array.c,v 1.2 2005-02-04 16:00:37 bacon Exp $ */ -#include "array.h" -#include -#include +#include +#include +#include xp_lisp_array_t* xp_lisp_array_new (xp_size_t capacity) { xp_lisp_array_t* array; - assert (capacity > 0); + xp_assert (capacity > 0); array = (xp_lisp_array_t*)malloc (sizeof(xp_lisp_array_t)); if (array == XP_NULL) return XP_NULL; @@ -30,7 +30,7 @@ void xp_lisp_array_free (xp_lisp_array_t* array) { while (array->size > 0) free (array->buffer[--array->size]); - assert (array->size == 0); + xp_assert (array->size == 0); free (array->buffer); free (array); @@ -74,7 +74,7 @@ int xp_lisp_array_insert (xp_lisp_array_t* array, xp_size_t index, void* value) void xp_lisp_array_delete (xp_lisp_array_t* array, xp_size_t index) { - assert (index < array->size); + xp_assert (index < array->size); } @@ -82,7 +82,7 @@ void xp_lisp_array_clear (xp_lisp_array_t* array) { while (array->size > 0) free (array->buffer[--array->size]); - assert (array->size == 0); + xp_assert (array->size == 0); array->buffer[0] = XP_NULL; } diff --git a/ase/lsp/array.h b/ase/lsp/array.h index 86066f53..f777b399 100644 --- a/ase/lsp/array.h +++ b/ase/lsp/array.h @@ -1,11 +1,11 @@ /* - * $Id: array.h,v 1.1 2005-02-04 15:39:11 bacon Exp $ + * $Id: array.h,v 1.2 2005-02-04 16:00:37 bacon Exp $ */ -#ifndef _RBL_ARRAY_H_ -#define _RBL_ARRAY_H_ +#ifndef _XP_LISP_ARRAY_H_ +#define _XP_LISP_ARRAY_H_ -#include +#include struct xp_lisp_array_t { void** buffer; @@ -19,13 +19,13 @@ typedef struct xp_lisp_array_t xp_lisp_array_t; extern "C" { #endif -xp_lisp_array_t* xp_lisp_array_new (xp_size_t capacity); -void xp_lisp_array_free (xp_lisp_array_t* array); -int xp_lisp_array_add_item (xp_lisp_array_t* array, void* item); -int xp_lisp_array_insert (xp_lisp_array_t* array, xp_size_t index, void* value); -void xp_lisp_array_delete (xp_lisp_array_t* array, xp_size_t index); -void xp_lisp_array_clear (xp_lisp_array_t* array); -void** xp_lisp_array_transfer (xp_lisp_array_t* array, xp_size_t capacity); +xp_lisp_array_t* xp_lisp_array_new (xp_size_t capacity); +void xp_lisp_array_free (xp_lisp_array_t* array); +int xp_lisp_array_add_item (xp_lisp_array_t* array, void* item); +int xp_lisp_array_insert (xp_lisp_array_t* array, xp_size_t index, void* value); +void xp_lisp_array_delete (xp_lisp_array_t* array, xp_size_t index); +void xp_lisp_array_clear (xp_lisp_array_t* array); +void** xp_lisp_array_transfer (xp_lisp_array_t* array, xp_size_t capacity); #ifdef __cplusplus } diff --git a/ase/lsp/env.c b/ase/lsp/env.c index 733eb539..3285bdaa 100644 --- a/ase/lsp/env.c +++ b/ase/lsp/env.c @@ -1,8 +1,8 @@ /* - * $Id: env.c,v 1.1 2005-02-04 15:39:11 bacon Exp $ + * $Id: env.c,v 1.2 2005-02-04 16:00:37 bacon Exp $ */ -#include "environment.h" +#include #include xp_lisp_assoc_t* xp_lisp_assoc_new (xp_lisp_obj_t* name, xp_lisp_obj_t* value) @@ -56,7 +56,7 @@ xp_lisp_assoc_t* xp_lisp_frame_lookup (xp_lisp_frame_t* frame, xp_lisp_obj_t* na { xp_lisp_assoc_t* assoc; - xp_lisp_assert (RBL_TYPE(name) == RBL_OBJ_SYMBOL); + xp_lisp_assert (XP_LISP_TYPE(name) == XP_LISP_OBJ_SYMBOL); assoc = frame->assoc; while (assoc != XP_NULL) { @@ -71,7 +71,7 @@ xp_lisp_assoc_t* xp_lisp_frame_insert ( { xp_lisp_assoc_t* assoc; - xp_lisp_assert (RBL_TYPE(name) == RBL_OBJ_SYMBOL); + xp_lisp_assert (XP_LISP_TYPE(name) == XP_LISP_OBJ_SYMBOL); assoc = xp_lisp_assoc_new (name, value); if (assoc == XP_NULL) return XP_NULL; diff --git a/ase/lsp/env.h b/ase/lsp/env.h index 6209e076..94bf3552 100644 --- a/ase/lsp/env.h +++ b/ase/lsp/env.h @@ -1,11 +1,11 @@ /* - * $Id: env.h,v 1.1 2005-02-04 15:39:11 bacon Exp $ + * $Id: env.h,v 1.2 2005-02-04 16:00:37 bacon Exp $ */ -#ifndef _RBL_ENV_H_ -#define _RBL_ENV_H_ +#ifndef _XP_LISP_ENV_H_ +#define _XP_LISP_ENV_H_ -#include "object.h" +#include struct xp_lisp_assoc_t { diff --git a/ase/lsp/eval.c b/ase/lsp/eval.c index a1d3dcfb..79b3fe7f 100644 --- a/ase/lsp/eval.c +++ b/ase/lsp/eval.c @@ -1,10 +1,10 @@ /* - * $Id: eval.c,v 1.1 2005-02-04 15:39:11 bacon Exp $ + * $Id: eval.c,v 1.2 2005-02-04 16:00:37 bacon Exp $ */ -#include "lsp.h" -#include "env.h" -#include "prim.h" +#include +#include +#include #ifdef __cplusplus extern "C" { @@ -20,24 +20,24 @@ static xp_lisp_obj_t* apply (xp_lisp_t* lsp, xp_lisp_obj_t* func, xp_lisp_ob xp_lisp_obj_t* xp_lisp_eval (xp_lisp_t* lsp, xp_lisp_obj_t* obj) { - lsp->error = RBL_ERR_NONE; + lsp->error = XP_LISP_ERR_NONE; - if (RBL_TYPE(obj) == RBL_OBJ_CONS) + if (XP_LISP_TYPE(obj) == XP_LISP_OBJ_CONS) return eval_cons (lsp, obj); - else if (RBL_TYPE(obj) == RBL_OBJ_SYMBOL) { + else if (XP_LISP_TYPE(obj) == XP_LISP_OBJ_SYMBOL) { xp_lisp_assoc_t* assoc; /* if (obj == lsp->mem->lambda || obj == lsp->mem->macro) { printf ("lambda or macro can't be used as a normal symbol\n"); - lsp->error = RBL_ERR_BAD_SYMBOL; + lsp->error = XP_LISP_ERR_BAD_SYMBOL; return XP_NULL; } */ if ((assoc = xp_lisp_lookup (lsp->mem, obj)) == XP_NULL) { if (lsp->opt_undef_symbol) { - lsp->error = RBL_ERR_UNDEF_SYMBOL; + lsp->error = XP_LISP_ERR_UNDEF_SYMBOL; return XP_NULL; } return lsp->mem->nil; @@ -57,20 +57,20 @@ static xp_lisp_obj_t* make_func (xp_lisp_t* lsp, xp_lisp_obj_t* cdr, int is_macr printf ("about to create a function or a macro ....\n"); if (cdr == lsp->mem->nil) { - lsp->error = RBL_ERR_TOO_FEW_ARGS; + lsp->error = XP_LISP_ERR_TOO_FEW_ARGS; return XP_NULL; } - if (RBL_TYPE(cdr) != RBL_OBJ_CONS) { - lsp->error = RBL_ERR_BAD_ARG; + if (XP_LISP_TYPE(cdr) != XP_LISP_OBJ_CONS) { + lsp->error = XP_LISP_ERR_BAD_ARG; return XP_NULL; } - formal = RBL_CAR(cdr); - body = RBL_CDR(cdr); + formal = XP_LISP_CAR(cdr); + body = XP_LISP_CDR(cdr); if (body == lsp->mem->nil) { - lsp->error = RBL_ERR_EMPTY_BODY; + lsp->error = XP_LISP_ERR_EMPTY_BODY; return XP_NULL; } @@ -78,7 +78,7 @@ static xp_lisp_obj_t* make_func (xp_lisp_t* lsp, xp_lisp_obj_t* cdr, int is_macr xp_lisp_make_macro (lsp->mem, formal, body): xp_lisp_make_func (lsp->mem, formal, body); if (func == XP_NULL) { - lsp->error = RBL_ERR_MEM; + lsp->error = XP_LISP_ERR_MEM; return XP_NULL; } @@ -89,10 +89,10 @@ static xp_lisp_obj_t* eval_cons (xp_lisp_t* lsp, xp_lisp_obj_t* cons) { xp_lisp_obj_t* car, * cdr; - xp_lisp_assert (RBL_TYPE(cons) == RBL_OBJ_CONS); + xp_lisp_assert (XP_LISP_TYPE(cons) == XP_LISP_OBJ_CONS); - car = RBL_CAR(cons); - cdr = RBL_CDR(cons); + car = XP_LISP_CAR(cons); + cdr = XP_LISP_CDR(cons); if (car == lsp->mem->lambda) { return make_func (lsp, cdr, 0); @@ -100,24 +100,24 @@ static xp_lisp_obj_t* eval_cons (xp_lisp_t* lsp, xp_lisp_obj_t* cons) else if (car == lsp->mem->macro) { return make_func (lsp, cdr, 1); } - else if (RBL_TYPE(car) == RBL_OBJ_SYMBOL) { + else if (XP_LISP_TYPE(car) == XP_LISP_OBJ_SYMBOL) { xp_lisp_assoc_t* assoc; if ((assoc = xp_lisp_lookup (lsp->mem, car)) != XP_NULL) { xp_lisp_obj_t* func = assoc->value; - if (RBL_TYPE(func) == RBL_OBJ_FUNC || - RBL_TYPE(func) == RBL_OBJ_MACRO) { + if (XP_LISP_TYPE(func) == XP_LISP_OBJ_FUNC || + XP_LISP_TYPE(func) == XP_LISP_OBJ_MACRO) { return apply (lsp, func, cdr); } - else if (RBL_TYPE(func) == RBL_OBJ_PRIM) { + else if (XP_LISP_TYPE(func) == XP_LISP_OBJ_PRIM) { // primitive function - return RBL_PIMPL(func) (lsp, cdr); + return XP_LISP_PIMPL(func) (lsp, cdr); } else { printf ("undefined function: "); xp_lisp_print (lsp, car); printf ("\n"); - lsp->error = RBL_ERR_UNDEF_FUNC; + lsp->error = XP_LISP_ERR_UNDEF_FUNC; return XP_NULL; } } @@ -126,31 +126,31 @@ static xp_lisp_obj_t* eval_cons (xp_lisp_t* lsp, xp_lisp_obj_t* cons) printf ("undefined function: "); xp_lisp_print (lsp, car); printf ("\n"); - lsp->error = RBL_ERR_UNDEF_FUNC; + lsp->error = XP_LISP_ERR_UNDEF_FUNC; return XP_NULL; } } - else if (RBL_TYPE(car) == RBL_OBJ_FUNC || - RBL_TYPE(car) == RBL_OBJ_MACRO) { + else if (XP_LISP_TYPE(car) == XP_LISP_OBJ_FUNC || + XP_LISP_TYPE(car) == XP_LISP_OBJ_MACRO) { return apply (lsp, car, cdr); } - else if (RBL_TYPE(car) == RBL_OBJ_CONS) { - if (RBL_CAR(car) == lsp->mem->lambda) { - xp_lisp_obj_t* func = make_func (lsp, RBL_CDR(car), 0); + else if (XP_LISP_TYPE(car) == XP_LISP_OBJ_CONS) { + if (XP_LISP_CAR(car) == lsp->mem->lambda) { + xp_lisp_obj_t* func = make_func (lsp, XP_LISP_CDR(car), 0); if (func == XP_NULL) return XP_NULL; return apply (lsp, func, cdr); } - else if (RBL_CAR(car) == lsp->mem->macro) { - xp_lisp_obj_t* func = make_func (lsp, RBL_CDR(car), 1); + else if (XP_LISP_CAR(car) == lsp->mem->macro) { + xp_lisp_obj_t* func = make_func (lsp, XP_LISP_CDR(car), 1); if (func == XP_NULL) return XP_NULL; return apply (lsp, func, cdr); } } - rb_printf (RBL_TEXT("bad function: ")); + xp_printf (XP_LISP_TEXT("bad function: ")); xp_lisp_print (lsp, car); - rb_printf (RBL_TEXT("\n")); - lsp->error = RBL_ERR_BAD_FUNC; + xp_printf (XP_LISP_TEXT("\n")); + lsp->error = XP_LISP_ERR_BAD_FUNC; return XP_NULL; } @@ -163,26 +163,26 @@ static xp_lisp_obj_t* apply (xp_lisp_t* lsp, xp_lisp_obj_t* func, xp_lisp_obj_t* xp_lisp_mem_t* mem; xp_lisp_assert ( - RBL_TYPE(func) == RBL_OBJ_FUNC || - RBL_TYPE(func) == RBL_OBJ_MACRO); + XP_LISP_TYPE(func) == XP_LISP_OBJ_FUNC || + XP_LISP_TYPE(func) == XP_LISP_OBJ_MACRO); - xp_lisp_assert (RBL_TYPE(RBL_CDR(func)) == RBL_OBJ_CONS); + xp_lisp_assert (XP_LISP_TYPE(XP_LISP_CDR(func)) == XP_LISP_OBJ_CONS); mem = lsp->mem; - if (RBL_TYPE(func) == RBL_OBJ_MACRO) { - formal = RBL_MFORMAL (func); - body = RBL_MBODY (func); + if (XP_LISP_TYPE(func) == XP_LISP_OBJ_MACRO) { + formal = XP_LISP_MFORMAL (func); + body = XP_LISP_MBODY (func); } else { - formal = RBL_FFORMAL (func); - body = RBL_FBODY (func); + formal = XP_LISP_FFORMAL (func); + body = XP_LISP_FBODY (func); } // make a new frame. frame = xp_lisp_frame_new (); if (frame == XP_NULL) { - lsp->error = RBL_ERR_MEM; + lsp->error = XP_LISP_ERR_MEM; return XP_NULL; } @@ -194,14 +194,14 @@ static xp_lisp_obj_t* apply (xp_lisp_t* lsp, xp_lisp_obj_t* func, xp_lisp_obj_t* // evaluate arguments and push them into the frame. while (formal != mem->nil) { if (actual == mem->nil) { - lsp->error = RBL_ERR_TOO_FEW_ARGS; + lsp->error = XP_LISP_ERR_TOO_FEW_ARGS; mem->brooding_frame = frame->link; xp_lisp_frame_free (frame); return XP_NULL; } - value = RBL_CAR(actual); - if (RBL_TYPE(func) != RBL_OBJ_MACRO) { + value = XP_LISP_CAR(actual); + if (XP_LISP_TYPE(func) != XP_LISP_OBJ_MACRO) { // macro doesn't evaluate actual arguments. value = xp_lisp_eval (lsp, value); if (value == XP_NULL) { @@ -211,31 +211,31 @@ static xp_lisp_obj_t* apply (xp_lisp_t* lsp, xp_lisp_obj_t* func, xp_lisp_obj_t* } } - if (xp_lisp_frame_lookup (frame, RBL_CAR(formal)) != XP_NULL) { - lsp->error = RBL_ERR_DUP_FORMAL; + if (xp_lisp_frame_lookup (frame, XP_LISP_CAR(formal)) != XP_NULL) { + lsp->error = XP_LISP_ERR_DUP_FORMAL; mem->brooding_frame = frame->link; xp_lisp_frame_free (frame); return XP_NULL; } - if (xp_lisp_frame_insert (frame, RBL_CAR(formal), value) == XP_NULL) { - lsp->error = RBL_ERR_MEM; + if (xp_lisp_frame_insert (frame, XP_LISP_CAR(formal), value) == XP_NULL) { + lsp->error = XP_LISP_ERR_MEM; mem->brooding_frame = frame->link; xp_lisp_frame_free (frame); return XP_NULL; } - actual = RBL_CDR(actual); - formal = RBL_CDR(formal); + actual = XP_LISP_CDR(actual); + formal = XP_LISP_CDR(formal); } - if (RBL_TYPE(actual) == RBL_OBJ_CONS) { - lsp->error = RBL_ERR_TOO_MANY_ARGS; + if (XP_LISP_TYPE(actual) == XP_LISP_OBJ_CONS) { + lsp->error = XP_LISP_ERR_TOO_MANY_ARGS; mem->brooding_frame = frame->link; xp_lisp_frame_free (frame); return XP_NULL; } else if (actual != mem->nil) { - lsp->error = RBL_ERR_BAD_ARG; + lsp->error = XP_LISP_ERR_BAD_ARG; mem->brooding_frame = frame->link; xp_lisp_frame_free (frame); return XP_NULL; @@ -249,13 +249,13 @@ static xp_lisp_obj_t* apply (xp_lisp_t* lsp, xp_lisp_obj_t* func, xp_lisp_obj_t* // do the evaluation of the body value = mem->nil; while (body != mem->nil) { - value = xp_lisp_eval(lsp, RBL_CAR(body)); + value = xp_lisp_eval(lsp, XP_LISP_CAR(body)); if (value == XP_NULL) { mem->frame = frame->link; xp_lisp_frame_free (frame); return XP_NULL; } - body = RBL_CDR(body); + body = XP_LISP_CDR(body); } // pop the frame. @@ -264,8 +264,8 @@ static xp_lisp_obj_t* apply (xp_lisp_t* lsp, xp_lisp_obj_t* func, xp_lisp_obj_t* // destroy the frame. xp_lisp_frame_free (frame); - //if (RBL_CAR(func) == mem->macro) { - if (RBL_TYPE(func) == RBL_OBJ_MACRO) { + //if (XP_LISP_CAR(func) == mem->macro) { + if (XP_LISP_TYPE(func) == XP_LISP_OBJ_MACRO) { value = xp_lisp_eval(lsp, value); if (value == XP_NULL) return XP_NULL; } diff --git a/ase/lsp/lisp.c b/ase/lsp/lisp.c index a5a0ed0c..fc82a313 100644 --- a/ase/lsp/lisp.c +++ b/ase/lsp/lisp.c @@ -1,32 +1,32 @@ /* - * $Id: lisp.c,v 1.1 2005-02-04 15:39:11 bacon Exp $ + * $Id: lisp.c,v 1.2 2005-02-04 16:00:37 bacon Exp $ */ -#include "lsp.h" -#include +#include +#include xp_lisp_t* xp_lisp_new (xp_size_t mem_ubound, xp_size_t mem_ubound_inc) { xp_lisp_t* lsp; - lsp = (xp_lisp_t*)malloc(sizeof(xp_lisp_t)); + lsp = (xp_lisp_t*)xp_malloc(sizeof(xp_lisp_t)); if (lsp == XP_NULL) return lsp; lsp->token = xp_lisp_token_new (256); if (lsp->token == XP_NULL) { - free (lsp); + xp_free (lsp); return XP_NULL; } - lsp->error = RBL_ERR_NONE; + lsp->error = XP_LISP_ERR_NONE; //lsp->opt_undef_symbol = 1; lsp->opt_undef_symbol = 0; - lsp->curc = RBL_CHAR_END; + lsp->curc = XP_LISP_CHAR_END; lsp->creader = XP_NULL; lsp->creader_extra = XP_NULL; lsp->creader_just_set = 0; - lsp->outstream = stdout; + lsp->outstream = xp_stdout; lsp->mem = xp_lisp_mem_new (mem_ubound, mem_ubound_inc); if (lsp->mem == XP_NULL) { diff --git a/ase/lsp/lisp.h b/ase/lsp/lisp.h index 9d96fe20..0a794132 100644 --- a/ase/lsp/lisp.h +++ b/ase/lsp/lisp.h @@ -1,38 +1,40 @@ /* - * $Id: lisp.h,v 1.1 2005-02-04 15:39:11 bacon Exp $ + * $Id: lisp.h,v 1.2 2005-02-04 16:00:37 bacon Exp $ */ -#ifndef _RBL_LISP_H_ -#define _RBL_LISP_H_ +#ifndef _XP_LISP_LISP_H_ +#define _XP_LISP_LISP_H_ #include #include #include #include +#include // TODO: may have to remove dependency on stdio? + // NOTICE: the function of xp_lisp_creader_t must return -1 on error // and 0 on success. the first argument must be set to -// RBL_END_CHAR at the end of input. +// XP_LISP_END_CHAR at the end of input. typedef int (*xp_lisp_creader_t) (xp_lisp_cint*, void*); -#define RBL_ERR(lsp) ((lsp)->error) -#define RBL_ERR_NONE 0 -#define RBL_ERR_ABORT 1 -#define RBL_ERR_END 2 -#define RBL_ERR_MEM 3 -#define RBL_ERR_READ 4 -#define RBL_ERR_SYNTAX 5 -#define RBL_ERR_BAD_ARG 6 -#define RBL_ERR_WRONG_ARG 7 -#define RBL_ERR_TOO_FEW_ARGS 8 -#define RBL_ERR_TOO_MANY_ARGS 9 -#define RBL_ERR_UNDEF_FUNC 10 -#define RBL_ERR_BAD_FUNC 11 -#define RBL_ERR_DUP_FORMAL 12 -#define RBL_ERR_BAD_SYMBOL 13 -#define RBL_ERR_UNDEF_SYMBOL 14 -#define RBL_ERR_EMPTY_BODY 15 -#define RBL_ERR_BAD_VALUE 16 +#define XP_LISP_ERR(lsp) ((lsp)->error) +#define XP_LISP_ERR_NONE 0 +#define XP_LISP_ERR_ABORT 1 +#define XP_LISP_ERR_END 2 +#define XP_LISP_ERR_MEM 3 +#define XP_LISP_ERR_READ 4 +#define XP_LISP_ERR_SYNTAX 5 +#define XP_LISP_ERR_BAD_ARG 6 +#define XP_LISP_ERR_WRONG_ARG 7 +#define XP_LISP_ERR_TOO_FEW_ARGS 8 +#define XP_LISP_ERR_TOO_MANY_ARGS 9 +#define XP_LISP_ERR_UNDEF_FUNC 10 +#define XP_LISP_ERR_BAD_FUNC 11 +#define XP_LISP_ERR_DUP_FORMAL 12 +#define XP_LISP_ERR_BAD_SYMBOL 13 +#define XP_LISP_ERR_UNDEF_SYMBOL 14 +#define XP_LISP_ERR_EMPTY_BODY 15 +#define XP_LISP_ERR_BAD_VALUE 16 struct xp_lisp_t { @@ -41,10 +43,10 @@ struct xp_lisp_t int opt_undef_symbol; /* for read */ - xp_lisp_cint curc; - xp_lisp_creader_t creader; - void* creader_extra; - int creader_just_set; + xp_lisp_cint curc; + xp_lisp_creader_t creader; + void* creader_extra; + int creader_just_set; xp_lisp_token_t* token; /* for eval */ @@ -52,10 +54,10 @@ struct xp_lisp_t xp_size_t eval_depth; /* for print */ - FILE* outstream; + XP_FILE* outstream; /* memory manager */ - xp_lisp_mem_t* mem; + xp_lisp_mem_t* mem; }; typedef struct xp_lisp_t xp_lisp_t; diff --git a/ase/lsp/makefile.in b/ase/lsp/makefile.in index 87e91a94..5c469a6d 100644 --- a/ase/lsp/makefile.in +++ b/ase/lsp/makefile.in @@ -1,4 +1,4 @@ -SRCS = env.c token.c mem.c lsp.c prim.c read.c eval.c print.c array.c +SRCS = env.c token.c memory.c lisp.c primitive.c read.c eval.c print.c array.c OBJS = $(SRCS:.c=.o) OUT = libxplisp.a diff --git a/ase/lsp/memory.c b/ase/lsp/memory.c index 98146f71..a4e20297 100644 --- a/ase/lsp/memory.c +++ b/ase/lsp/memory.c @@ -1,5 +1,5 @@ /* - * $Id: memory.c,v 1.1 2005-02-04 15:39:11 bacon Exp $ + * $Id: memory.c,v 1.2 2005-02-04 16:00:37 bacon Exp $ */ #include @@ -36,7 +36,7 @@ xp_lisp_mem_t* xp_lisp_mem_new (xp_size_t ubound, xp_size_t ubound_inc) mem->ubound = ubound; mem->ubound_inc = ubound_inc; mem->count = 0; - for (i = 0; i < RBL_TYPE_COUNT; i++) { + for (i = 0; i < XP_LISP_TYPE_COUNT; i++) { mem->used[i] = XP_NULL; mem->free[i] = XP_NULL; } @@ -53,9 +53,9 @@ xp_lisp_mem_t* xp_lisp_mem_new (xp_size_t ubound, xp_size_t ubound_inc) // initialize common object pointers mem->nil = xp_lisp_make_nil (mem); mem->t = xp_lisp_make_true (mem); - mem->quote = xp_lisp_make_symbol (mem, RBL_TEXT("quote"), 5); - mem->lambda = xp_lisp_make_symbol (mem, RBL_TEXT("lambda"), 6); - mem->macro = xp_lisp_make_symbol (mem, RBL_TEXT("macro"), 5); + mem->quote = xp_lisp_make_symbol (mem, XP_LISP_TEXT("quote"), 5); + mem->lambda = xp_lisp_make_symbol (mem, XP_LISP_TEXT("lambda"), 6); + mem->macro = xp_lisp_make_symbol (mem, XP_LISP_TEXT("macro"), 5); if (mem->nil == XP_NULL || mem->t == XP_NULL || @@ -116,30 +116,30 @@ int xp_lisp_add_prims (xp_lisp_mem_t* mem) #define ADD_PRIM(mem,name,len,prim) \ if (xp_lisp_add_prim(mem,name,len,prim) == -1) return -1; - ADD_PRIM (mem, RB_TEXT("abort"), 5, xp_lisp_prim_abort); - ADD_PRIM (mem, RB_TEXT("eval"), 4, xp_lisp_prim_eval); - ADD_PRIM (mem, RB_TEXT("prog1"), 5, xp_lisp_prim_prog1); - ADD_PRIM (mem, RB_TEXT("progn"), 5, xp_lisp_prim_progn); - ADD_PRIM (mem, RB_TEXT("gc"), 2, xp_lisp_prim_gc); + ADD_PRIM (mem, XP_TEXT("abort"), 5, xp_lisp_prim_abort); + ADD_PRIM (mem, XP_TEXT("eval"), 4, xp_lisp_prim_eval); + ADD_PRIM (mem, XP_TEXT("prog1"), 5, xp_lisp_prim_prog1); + ADD_PRIM (mem, XP_TEXT("progn"), 5, xp_lisp_prim_progn); + ADD_PRIM (mem, XP_TEXT("gc"), 2, xp_lisp_prim_gc); - ADD_PRIM (mem, RB_TEXT("cond"), 4, xp_lisp_prim_cond); - ADD_PRIM (mem, RB_TEXT("if"), 2, xp_lisp_prim_if); - ADD_PRIM (mem, RB_TEXT("while"), 5, xp_lisp_prim_while); + ADD_PRIM (mem, XP_TEXT("cond"), 4, xp_lisp_prim_cond); + ADD_PRIM (mem, XP_TEXT("if"), 2, xp_lisp_prim_if); + ADD_PRIM (mem, XP_TEXT("while"), 5, xp_lisp_prim_while); - ADD_PRIM (mem, RB_TEXT("car"), 3, xp_lisp_prim_car); - ADD_PRIM (mem, RB_TEXT("cdr"), 3, xp_lisp_prim_cdr); - ADD_PRIM (mem, RB_TEXT("cons"), 4, xp_lisp_prim_cons); - ADD_PRIM (mem, RB_TEXT("set"), 3, xp_lisp_prim_set); - ADD_PRIM (mem, RB_TEXT("setq"), 4, xp_lisp_prim_setq); - ADD_PRIM (mem, RB_TEXT("quote"), 5, xp_lisp_prim_quote); - ADD_PRIM (mem, RB_TEXT("defun"), 5, xp_lisp_prim_defun); - ADD_PRIM (mem, RB_TEXT("demac"), 5, xp_lisp_prim_demac); - ADD_PRIM (mem, RB_TEXT("let"), 3, xp_lisp_prim_let); - ADD_PRIM (mem, RB_TEXT("let*"), 4, xp_lisp_prim_letx); + ADD_PRIM (mem, XP_TEXT("car"), 3, xp_lisp_prim_car); + ADD_PRIM (mem, XP_TEXT("cdr"), 3, xp_lisp_prim_cdr); + ADD_PRIM (mem, XP_TEXT("cons"), 4, xp_lisp_prim_cons); + ADD_PRIM (mem, XP_TEXT("set"), 3, xp_lisp_prim_set); + ADD_PRIM (mem, XP_TEXT("setq"), 4, xp_lisp_prim_setq); + ADD_PRIM (mem, XP_TEXT("quote"), 5, xp_lisp_prim_quote); + ADD_PRIM (mem, XP_TEXT("defun"), 5, xp_lisp_prim_defun); + ADD_PRIM (mem, XP_TEXT("demac"), 5, xp_lisp_prim_demac); + ADD_PRIM (mem, XP_TEXT("let"), 3, xp_lisp_prim_let); + ADD_PRIM (mem, XP_TEXT("let*"), 4, xp_lisp_prim_letx); - ADD_PRIM (mem, RB_TEXT("+"), 1, xp_lisp_prim_plus); - ADD_PRIM (mem, RB_TEXT(">"), 1, xp_lisp_prim_gt); - ADD_PRIM (mem, RB_TEXT("<"), 1, xp_lisp_prim_lt); + ADD_PRIM (mem, XP_TEXT("+"), 1, xp_lisp_prim_plus); + ADD_PRIM (mem, XP_TEXT(">"), 1, xp_lisp_prim_gt); + ADD_PRIM (mem, XP_TEXT("<"), 1, xp_lisp_prim_lt); return 0; } @@ -163,16 +163,16 @@ xp_lisp_obj_t* xp_lisp_allocate (xp_lisp_mem_t* mem, int type, xp_size_t size) if (obj == XP_NULL) return XP_NULL; } - RBL_TYPE(obj) = type; - RBL_SIZE(obj) = size; - RBL_MARK(obj) = 0; - RBL_LOCK(obj) = 0; + XP_LISP_TYPE(obj) = type; + XP_LISP_SIZE(obj) = size; + XP_LISP_MARK(obj) = 0; + XP_LISP_LOCK(obj) = 0; // insert the object at the head of the used list - RBL_LINK(obj) = mem->used[type]; + XP_LISP_LINK(obj) = mem->used[type]; mem->used[type] = obj; mem->count++; - RB_DEBUG1 (RB_TEXT("mem->count: %u\n"), mem->count); + XP_DEBUG1 (XP_TEXT("mem->count: %u\n"), mem->count); return obj; } @@ -187,11 +187,11 @@ void xp_lisp_dispose (xp_lisp_mem_t* mem, xp_lisp_obj_t* prev, xp_lisp_obj_t* ob // efficient memory management if (prev == XP_NULL) - mem->used[RBL_TYPE(obj)] = RBL_LINK(obj); - else RBL_LINK(prev) = RBL_LINK(obj); + mem->used[XP_LISP_TYPE(obj)] = XP_LISP_LINK(obj); + else XP_LISP_LINK(prev) = XP_LISP_LINK(obj); mem->count--; - RB_DEBUG1 (RB_TEXT("mem->count: %u\n"), mem->count); + XP_DEBUG1 (XP_TEXT("mem->count: %u\n"), mem->count); xp_free (obj); } @@ -201,11 +201,11 @@ void xp_lisp_dispose_all (xp_lisp_mem_t* mem) xp_lisp_obj_t* obj, * next; xp_size_t i; - for (i = 0; i < RBL_TYPE_COUNT; i++) { + for (i = 0; i < XP_LISP_TYPE_COUNT; i++) { obj = mem->used[i]; while (obj != XP_NULL) { - next = RBL_LINK(obj); + next = XP_LISP_LINK(obj); xp_lisp_dispose (mem, XP_NULL, obj); obj = next; } @@ -218,21 +218,21 @@ static void xp_lisp_mark_obj (xp_lisp_obj_t* obj) // TODO:.... // can it be recursive? - if (RBL_MARK(obj) != 0) return; + if (XP_LISP_MARK(obj) != 0) return; - RBL_MARK(obj) = 1; + XP_LISP_MARK(obj) = 1; - if (RBL_TYPE(obj) == RBL_OBJ_CONS) { - xp_lisp_mark_obj (RBL_CAR(obj)); - xp_lisp_mark_obj (RBL_CDR(obj)); + if (XP_LISP_TYPE(obj) == XP_LISP_OBJ_CONS) { + xp_lisp_mark_obj (XP_LISP_CAR(obj)); + xp_lisp_mark_obj (XP_LISP_CDR(obj)); } - else if (RBL_TYPE(obj) == RBL_OBJ_FUNC) { - xp_lisp_mark_obj (RBL_FFORMAL(obj)); - xp_lisp_mark_obj (RBL_FBODY(obj)); + else if (XP_LISP_TYPE(obj) == XP_LISP_OBJ_FUNC) { + xp_lisp_mark_obj (XP_LISP_FFORMAL(obj)); + xp_lisp_mark_obj (XP_LISP_FBODY(obj)); } - else if (RBL_TYPE(obj) == RBL_OBJ_MACRO) { - xp_lisp_mark_obj (RBL_MFORMAL(obj)); - xp_lisp_mark_obj (RBL_MBODY(obj)); + else if (XP_LISP_TYPE(obj) == XP_LISP_OBJ_MACRO) { + xp_lisp_mark_obj (XP_LISP_MFORMAL(obj)); + xp_lisp_mark_obj (XP_LISP_MBODY(obj)); } } @@ -242,33 +242,33 @@ static void xp_lisp_mark_obj (xp_lisp_obj_t* obj) void xp_lisp_lock (xp_lisp_obj_t* obj) { xp_lisp_assert (obj != XP_NULL); - RBL_LOCK(obj) = 1; - //RBL_MARK(obj) = 1; + XP_LISP_LOCK(obj) = 1; + //XP_LISP_MARK(obj) = 1; } void xp_lisp_unlock (xp_lisp_obj_t* obj) { xp_lisp_assert (obj != XP_NULL); - RBL_LOCK(obj) = 0; + XP_LISP_LOCK(obj) = 0; } void xp_lisp_unlock_all (xp_lisp_obj_t* obj) { xp_lisp_assert (obj != XP_NULL); - RBL_LOCK(obj) = 0; + XP_LISP_LOCK(obj) = 0; - if (RBL_TYPE(obj) == RBL_OBJ_CONS) { - xp_lisp_unlock_all (RBL_CAR(obj)); - xp_lisp_unlock_all (RBL_CDR(obj)); + if (XP_LISP_TYPE(obj) == XP_LISP_OBJ_CONS) { + xp_lisp_unlock_all (XP_LISP_CAR(obj)); + xp_lisp_unlock_all (XP_LISP_CDR(obj)); } - else if (RBL_TYPE(obj) == RBL_OBJ_FUNC) { - xp_lisp_unlock_all (RBL_FFORMAL(obj)); - xp_lisp_unlock_all (RBL_FBODY(obj)); + else if (XP_LISP_TYPE(obj) == XP_LISP_OBJ_FUNC) { + xp_lisp_unlock_all (XP_LISP_FFORMAL(obj)); + xp_lisp_unlock_all (XP_LISP_FBODY(obj)); } - else if (RBL_TYPE(obj) == RBL_OBJ_MACRO) { - xp_lisp_unlock_all (RBL_MFORMAL(obj)); - xp_lisp_unlock_all (RBL_MBODY(obj)); + else if (XP_LISP_TYPE(obj) == XP_LISP_OBJ_MACRO) { + xp_lisp_unlock_all (XP_LISP_MFORMAL(obj)); + xp_lisp_unlock_all (XP_LISP_MBODY(obj)); } } @@ -279,7 +279,7 @@ static void xp_lisp_mark (xp_lisp_mem_t* mem) xp_lisp_array_t* array; xp_size_t i; - RB_DEBUG0 (RB_TEXT("marking environment frames\n")); + XP_DEBUG0 (XP_TEXT("marking environment frames\n")); // mark objects in the environment frames frame = mem->frame; while (frame != XP_NULL) { @@ -293,7 +293,7 @@ static void xp_lisp_mark (xp_lisp_mem_t* mem) frame = frame->link; } - RB_DEBUG0 (RB_TEXT("marking interim frames\n")); + XP_DEBUG0 (XP_TEXT("marking interim frames\n")); // mark objects in the interim frames frame = mem->brooding_frame; @@ -310,17 +310,17 @@ static void xp_lisp_mark (xp_lisp_mem_t* mem) } /* - RB_DEBUG0 (RB_TEXT("marking the locked object\n")); + XP_DEBUG0 (XP_TEXT("marking the locked object\n")); if (mem->locked != XP_NULL) xp_lisp_mark_obj (mem->locked); */ - RB_DEBUG0 (RB_TEXT("marking termporary objects\n")); + XP_DEBUG0 (XP_TEXT("marking termporary objects\n")); array = mem->temp_array; for (i = 0; i < array->size; i++) { xp_lisp_mark_obj (array->buffer[i]); } - RB_DEBUG0 (RB_TEXT("marking builtin objects\n")); + XP_DEBUG0 (XP_TEXT("marking builtin objects\n")); // mark common objects if (mem->t != XP_NULL) xp_lisp_mark_obj (mem->t); if (mem->nil != XP_NULL) xp_lisp_mark_obj (mem->nil); @@ -335,24 +335,24 @@ static void xp_lisp_sweep (xp_lisp_mem_t* mem) xp_size_t i; // scan all the allocated objects and get rid of unused objects - for (i = 0; i < RBL_TYPE_COUNT; i++) { - //for (i = RBL_TYPE_COUNT; i > 0; /*i--*/) { + for (i = 0; i < XP_LISP_TYPE_COUNT; i++) { + //for (i = XP_LISP_TYPE_COUNT; i > 0; /*i--*/) { prev = XP_NULL; obj = mem->used[i]; //obj = mem->used[--i]; - RB_DEBUG1 (RB_TEXT("sweeping objects of type: %u\n"), i); + XP_DEBUG1 (XP_TEXT("sweeping objects of type: %u\n"), i); while (obj != XP_NULL) { - next = RBL_LINK(obj); + next = XP_LISP_LINK(obj); - if (RBL_LOCK(obj) == 0 && RBL_MARK(obj) == 0) { + if (XP_LISP_LOCK(obj) == 0 && XP_LISP_MARK(obj) == 0) { // dispose of unused objects xp_lisp_dispose (mem, prev, obj); } else { // unmark the object in use - RBL_MARK(obj) = 0; + XP_LISP_MARK(obj) = 0; prev = obj; } @@ -370,14 +370,14 @@ void xp_lisp_garbage_collect (xp_lisp_mem_t* mem) xp_lisp_obj_t* xp_lisp_make_nil (xp_lisp_mem_t* mem) { if (mem->nil != XP_NULL) return mem->nil; - mem->nil = xp_lisp_allocate (mem, RBL_OBJ_NIL, sizeof(xp_lisp_obj_nil_t)); + mem->nil = xp_lisp_allocate (mem, XP_LISP_OBJ_NIL, sizeof(xp_lisp_obj_nil_t)); return mem->nil; } xp_lisp_obj_t* xp_lisp_make_true (xp_lisp_mem_t* mem) { if (mem->t != XP_NULL) return mem->t; - mem->t = xp_lisp_allocate (mem, RBL_OBJ_TRUE, sizeof(xp_lisp_obj_true_t)); + mem->t = xp_lisp_allocate (mem, XP_LISP_OBJ_TRUE, sizeof(xp_lisp_obj_true_t)); return mem->t; } @@ -385,10 +385,10 @@ xp_lisp_obj_t* xp_lisp_make_int (xp_lisp_mem_t* mem, xp_lisp_int value) { xp_lisp_obj_t* obj; - obj = xp_lisp_allocate (mem, RBL_OBJ_INT, sizeof(xp_lisp_obj_int_t)); + obj = xp_lisp_allocate (mem, XP_LISP_OBJ_INT, sizeof(xp_lisp_obj_int_t)); if (obj == XP_NULL) return XP_NULL; - RBL_IVALUE(obj) = value; + XP_LISP_IVALUE(obj) = value; return obj; } @@ -397,10 +397,10 @@ xp_lisp_obj_t* xp_lisp_make_float (xp_lisp_mem_t* mem, xp_lisp_float value) { xp_lisp_obj_t* obj; - obj = xp_lisp_allocate (mem, RBL_OBJ_FLOAT, sizeof(xp_lisp_obj_float_t)); + obj = xp_lisp_allocate (mem, XP_LISP_OBJ_FLOAT, sizeof(xp_lisp_obj_float_t)); if (obj == XP_NULL) return XP_NULL; - RBL_FVALUE(obj) = value; + XP_LISP_FVALUE(obj) = value; return obj; } @@ -410,20 +410,20 @@ xp_lisp_obj_t* xp_lisp_make_symbol (xp_lisp_mem_t* mem, const xp_lisp_char* str, xp_lisp_obj_t* obj; // look for a sysmbol with the given name - obj = mem->used[RBL_OBJ_SYMBOL]; + obj = mem->used[XP_LISP_OBJ_SYMBOL]; while (obj != XP_NULL) { // if there is a symbol with the same name, it is just used. if (xp_lisp_comp_symbol2 (obj, str, len) == 0) return obj; - obj = RBL_LINK(obj); + obj = XP_LISP_LINK(obj); } // no such symbol found. create a new one - obj = xp_lisp_allocate (mem, RBL_OBJ_SYMBOL, + obj = xp_lisp_allocate (mem, XP_LISP_OBJ_SYMBOL, sizeof(xp_lisp_obj_symbol_t) + (len + 1) * sizeof(xp_lisp_char)); if (obj == XP_NULL) return XP_NULL; // fill in the symbol buffer - xp_lisp_copy_string2 (RBL_SYMVALUE(obj), str, len); + xp_lisp_copy_string2 (XP_LISP_SYMVALUE(obj), str, len); return obj; } @@ -433,12 +433,12 @@ xp_lisp_obj_t* xp_lisp_make_string (xp_lisp_mem_t* mem, const xp_lisp_char* str, xp_lisp_obj_t* obj; // allocate memory for the string - obj = xp_lisp_allocate (mem, RBL_OBJ_STRING, + obj = xp_lisp_allocate (mem, XP_LISP_OBJ_STRING, sizeof(xp_lisp_obj_string_t) + (len + 1) * sizeof(xp_lisp_char)); if (obj == XP_NULL) return XP_NULL; // fill in the string buffer - xp_lisp_copy_string2 (RBL_STRVALUE(obj), str, len); + xp_lisp_copy_string2 (XP_LISP_STRVALUE(obj), str, len); return obj; } @@ -447,11 +447,11 @@ xp_lisp_obj_t* xp_lisp_make_cons (xp_lisp_mem_t* mem, xp_lisp_obj_t* car, xp_lis { xp_lisp_obj_t* obj; - obj = xp_lisp_allocate (mem, RBL_OBJ_CONS, sizeof(xp_lisp_obj_cons_t)); + obj = xp_lisp_allocate (mem, XP_LISP_OBJ_CONS, sizeof(xp_lisp_obj_cons_t)); if (obj == XP_NULL) return XP_NULL; - RBL_CAR(obj) = car; - RBL_CDR(obj) = cdr; + XP_LISP_CAR(obj) = car; + XP_LISP_CDR(obj) = cdr; return obj; } @@ -460,11 +460,11 @@ xp_lisp_obj_t* xp_lisp_make_func (xp_lisp_mem_t* mem, xp_lisp_obj_t* formal, xp_ { xp_lisp_obj_t* obj; - obj = xp_lisp_allocate (mem, RBL_OBJ_FUNC, sizeof(xp_lisp_obj_func_t)); + obj = xp_lisp_allocate (mem, XP_LISP_OBJ_FUNC, sizeof(xp_lisp_obj_func_t)); if (obj == XP_NULL) return XP_NULL; - RBL_FFORMAL(obj) = formal; - RBL_FBODY(obj) = body; + XP_LISP_FFORMAL(obj) = formal; + XP_LISP_FBODY(obj) = body; return obj; } @@ -473,11 +473,11 @@ xp_lisp_obj_t* xp_lisp_make_macro (xp_lisp_mem_t* mem, xp_lisp_obj_t* formal, xp { xp_lisp_obj_t* obj; - obj = xp_lisp_allocate (mem, RBL_OBJ_MACRO, sizeof(xp_lisp_obj_macro_t)); + obj = xp_lisp_allocate (mem, XP_LISP_OBJ_MACRO, sizeof(xp_lisp_obj_macro_t)); if (obj == XP_NULL) return XP_NULL; - RBL_MFORMAL(obj) = formal; - RBL_MBODY(obj) = body; + XP_LISP_MFORMAL(obj) = formal; + XP_LISP_MBODY(obj) = body; return obj; } @@ -486,10 +486,10 @@ xp_lisp_obj_t* xp_lisp_make_prim (xp_lisp_mem_t* mem, void* impl) { xp_lisp_obj_t* obj; - obj = xp_lisp_allocate (mem, RBL_OBJ_PRIM, sizeof(xp_lisp_obj_prim_t)); + obj = xp_lisp_allocate (mem, XP_LISP_OBJ_PRIM, sizeof(xp_lisp_obj_prim_t)); if (obj == XP_NULL) return XP_NULL; - RBL_PIMPL(obj) = impl; + XP_LISP_PIMPL(obj) = impl; return obj; } @@ -499,7 +499,7 @@ xp_lisp_assoc_t* xp_lisp_lookup (xp_lisp_mem_t* mem, xp_lisp_obj_t* name) xp_lisp_frame_t* frame; xp_lisp_assoc_t* assoc; - xp_lisp_assert (RBL_TYPE(name) == RBL_OBJ_SYMBOL); + xp_lisp_assert (XP_LISP_TYPE(name) == XP_LISP_OBJ_SYMBOL); frame = mem->frame; @@ -530,13 +530,13 @@ xp_size_t xp_lisp_cons_len (xp_lisp_mem_t* mem, xp_lisp_obj_t* obj) { xp_size_t count; - xp_lisp_assert (obj == mem->nil || RBL_TYPE(obj) == RBL_OBJ_CONS); + xp_lisp_assert (obj == mem->nil || XP_LISP_TYPE(obj) == XP_LISP_OBJ_CONS); count = 0; //while (obj != mem->nil) { - while (RBL_TYPE(obj) == RBL_OBJ_CONS) { + while (XP_LISP_TYPE(obj) == XP_LISP_OBJ_CONS) { count++; - obj = RBL_CDR(obj); + obj = XP_LISP_CDR(obj); } return count; @@ -546,9 +546,9 @@ int xp_lisp_probe_args (xp_lisp_mem_t* mem, xp_lisp_obj_t* obj, xp_size_t* len) { xp_size_t count = 0; - while (RBL_TYPE(obj) == RBL_OBJ_CONS) { + while (XP_LISP_TYPE(obj) == XP_LISP_OBJ_CONS) { count++; - obj = RBL_CDR(obj); + obj = XP_LISP_CDR(obj); } if (obj != mem->nil) return -1; @@ -562,19 +562,19 @@ int xp_lisp_comp_symbol (xp_lisp_obj_t* obj, const xp_lisp_char* str) xp_lisp_char* p; xp_size_t index, length; - xp_lisp_assert (RBL_TYPE(obj) == RBL_OBJ_SYMBOL); + xp_lisp_assert (XP_LISP_TYPE(obj) == XP_LISP_OBJ_SYMBOL); index = 0; - length = RBL_SYMLEN(obj); + length = XP_LISP_SYMLEN(obj); - p = RBL_SYMVALUE(obj); + p = XP_LISP_SYMVALUE(obj); while (index < length) { if (*p > *str) return 1; if (*p < *str) return -1; index++; p++; str++; } - return (*str == RBL_CHAR('\0'))? 0: -1; + return (*str == XP_LISP_CHAR('\0'))? 0: -1; } int xp_lisp_comp_symbol2 (xp_lisp_obj_t* obj, const xp_lisp_char* str, xp_size_t len) @@ -582,11 +582,11 @@ int xp_lisp_comp_symbol2 (xp_lisp_obj_t* obj, const xp_lisp_char* str, xp_size_t xp_lisp_char* p; xp_size_t index, length; - xp_lisp_assert (RBL_TYPE(obj) == RBL_OBJ_SYMBOL); + xp_lisp_assert (XP_LISP_TYPE(obj) == XP_LISP_OBJ_SYMBOL); index = 0; - length = RBL_SYMLEN(obj); - p = RBL_SYMVALUE(obj); + length = XP_LISP_SYMLEN(obj); + p = XP_LISP_SYMVALUE(obj); while (index < length && index < len) { if (*p > *str) return 1; @@ -603,19 +603,19 @@ int xp_lisp_comp_string (xp_lisp_obj_t* obj, const xp_lisp_char* str) xp_lisp_char* p; xp_size_t index, length; - xp_lisp_assert (RBL_TYPE(obj) == RBL_OBJ_STRING); + xp_lisp_assert (XP_LISP_TYPE(obj) == XP_LISP_OBJ_STRING); index = 0; - length = RBL_STRLEN(obj); + length = XP_LISP_STRLEN(obj); - p = RBL_STRVALUE(obj); + p = XP_LISP_STRVALUE(obj); while (index < length) { if (*p > *str) return 1; if (*p < *str) return -1; index++; p++; str++; } - return (*str == RBL_CHAR('\0'))? 0: -1; + return (*str == XP_LISP_CHAR('\0'))? 0: -1; } int xp_lisp_comp_string2 (xp_lisp_obj_t* obj, const xp_lisp_char* str, xp_size_t len) @@ -623,11 +623,11 @@ int xp_lisp_comp_string2 (xp_lisp_obj_t* obj, const xp_lisp_char* str, xp_size_t xp_lisp_char* p; xp_size_t index, length; - xp_lisp_assert (RBL_TYPE(obj) == RBL_OBJ_STRING); + xp_lisp_assert (XP_LISP_TYPE(obj) == XP_LISP_OBJ_STRING); index = 0; - length = RBL_STRLEN(obj); - p = RBL_STRVALUE(obj); + length = XP_LISP_STRLEN(obj); + p = XP_LISP_STRVALUE(obj); while (index < length && index < len) { if (*p > *str) return 1; @@ -642,8 +642,8 @@ int xp_lisp_comp_string2 (xp_lisp_obj_t* obj, const xp_lisp_char* str, xp_size_t void xp_lisp_copy_string (xp_lisp_char* dst, const xp_lisp_char* str) { // the buffer pointed by dst should be big enough to hold str - while (*str != RBL_CHAR('\0')) *dst++ = *str++; - *dst = RBL_CHAR('\0'); + while (*str != XP_LISP_CHAR('\0')) *dst++ = *str++; + *dst = XP_LISP_CHAR('\0'); } void xp_lisp_copy_string2 (xp_lisp_char* dst, const xp_lisp_char* str, xp_size_t len) @@ -653,6 +653,6 @@ void xp_lisp_copy_string2 (xp_lisp_char* dst, const xp_lisp_char* str, xp_size_t *dst++ = *str++; len--; } - *dst = RBL_CHAR('\0'); + *dst = XP_LISP_CHAR('\0'); } diff --git a/ase/lsp/memory.h b/ase/lsp/memory.h index 7e288e4e..7193f3da 100644 --- a/ase/lsp/memory.h +++ b/ase/lsp/memory.h @@ -1,13 +1,13 @@ /* - * $Id: memory.h,v 1.1 2005-02-04 15:39:11 bacon Exp $ + * $Id: memory.h,v 1.2 2005-02-04 16:00:37 bacon Exp $ */ -#ifndef _RBL_MEM_H_ -#define _RBL_MEM_H_ +#ifndef _XP_LISP_MEM_H_ +#define _XP_LISP_MEM_H_ -#include "obj.h" -#include "env.h" -#include "array.h" +#include +#include +#include struct xp_lisp_mem_t { @@ -17,8 +17,8 @@ struct xp_lisp_mem_t xp_size_t ubound; // upper bounds of the maximum number of objects xp_size_t ubound_inc; // increment of the upper bounds xp_size_t count; // the number of objects currently allocated - xp_lisp_obj_t* used[RBL_TYPE_COUNT]; - xp_lisp_obj_t* free[RBL_TYPE_COUNT]; + xp_lisp_obj_t* used[XP_LISP_TYPE_COUNT]; + xp_lisp_obj_t* free[XP_LISP_TYPE_COUNT]; xp_lisp_obj_t* locked; /* diff --git a/ase/lsp/object.h b/ase/lsp/object.h index 4c51d9e5..2dbf8140 100644 --- a/ase/lsp/object.h +++ b/ase/lsp/object.h @@ -1,66 +1,66 @@ /* - * $Id: object.h,v 1.1 2005-02-04 15:39:11 bacon Exp $ + * $Id: object.h,v 1.2 2005-02-04 16:00:37 bacon Exp $ */ -#ifndef _RBL_OBJECT_H_ -#define _RBL_OBJECT_H_ +#ifndef _XP_LISP_OBJECT_H_ +#define _XP_LISP_OBJECT_H_ -#include "types.h" +#include // object types enum { - RBL_OBJ_NIL = 0, - RBL_OBJ_TRUE, - RBL_OBJ_INT, - RBL_OBJ_FLOAT, - RBL_OBJ_SYMBOL, - RBL_OBJ_STRING, - RBL_OBJ_CONS, - RBL_OBJ_FUNC, - RBL_OBJ_MACRO, - RBL_OBJ_PRIM, + XP_LISP_OBJ_NIL = 0, + XP_LISP_OBJ_TRUE, + XP_LISP_OBJ_INT, + XP_LISP_OBJ_FLOAT, + XP_LISP_OBJ_SYMBOL, + XP_LISP_OBJ_STRING, + XP_LISP_OBJ_CONS, + XP_LISP_OBJ_FUNC, + XP_LISP_OBJ_MACRO, + XP_LISP_OBJ_PRIM, - RBL_TYPE_COUNT // the number of lisp object types + XP_LISP_TYPE_COUNT // the number of lisp object types }; -#define RBL_OBJ_HEADER \ - rb_uint32 type: 24; \ - rb_uint32 mark: 4; \ - rb_uint32 lock: 4; \ +#define XP_LISP_OBJ_HEADER \ + xp_uint32_t type: 24; \ + xp_uint32_t mark: 4; \ + xp_uint32_t lock: 4; \ xp_size_t size; \ struct xp_lisp_obj_t* link struct xp_lisp_obj_t { - RBL_OBJ_HEADER; + XP_LISP_OBJ_HEADER; }; struct xp_lisp_obj_nil_t { - RBL_OBJ_HEADER; + XP_LISP_OBJ_HEADER; }; struct xp_lisp_obj_true_t { - RBL_OBJ_HEADER; + XP_LISP_OBJ_HEADER; }; struct xp_lisp_obj_int_t { - RBL_OBJ_HEADER; + XP_LISP_OBJ_HEADER; xp_lisp_int value; }; struct xp_lisp_obj_float_t { - RBL_OBJ_HEADER; + XP_LISP_OBJ_HEADER; xp_lisp_float value; }; struct xp_lisp_obj_symbol_t { - RBL_OBJ_HEADER; + XP_LISP_OBJ_HEADER; #ifdef __BORLANDC__ #else xp_lisp_char buffer[0]; @@ -69,7 +69,7 @@ struct xp_lisp_obj_symbol_t struct xp_lisp_obj_string_t { - RBL_OBJ_HEADER; + XP_LISP_OBJ_HEADER; #ifdef __BORLANDC__ #else xp_lisp_char buffer[0]; @@ -78,28 +78,28 @@ struct xp_lisp_obj_string_t struct xp_lisp_obj_cons_t { - RBL_OBJ_HEADER; + XP_LISP_OBJ_HEADER; struct xp_lisp_obj_t* car; struct xp_lisp_obj_t* cdr; }; struct xp_lisp_obj_func_t { - RBL_OBJ_HEADER; + XP_LISP_OBJ_HEADER; struct xp_lisp_obj_t* formal; struct xp_lisp_obj_t* body; }; struct xp_lisp_obj_macro_t { - RBL_OBJ_HEADER; + XP_LISP_OBJ_HEADER; struct xp_lisp_obj_t* formal; struct xp_lisp_obj_t* body; }; struct xp_lisp_obj_prim_t { - RBL_OBJ_HEADER; + XP_LISP_OBJ_HEADER; void* impl; // xp_lisp_prim_t }; @@ -116,36 +116,36 @@ typedef struct xp_lisp_obj_macro_t xp_lisp_obj_macro_t; typedef struct xp_lisp_obj_prim_t xp_lisp_obj_prim_t; // header access -#define RBL_TYPE(x) (((xp_lisp_obj_t*)x)->type) -#define RBL_SIZE(x) (((xp_lisp_obj_t*)x)->size) -#define RBL_MARK(x) (((xp_lisp_obj_t*)x)->mark) -#define RBL_LOCK(x) (((xp_lisp_obj_t*)x)->lock) -#define RBL_LINK(x) (((xp_lisp_obj_t*)x)->link) +#define XP_LISP_TYPE(x) (((xp_lisp_obj_t*)x)->type) +#define XP_LISP_SIZE(x) (((xp_lisp_obj_t*)x)->size) +#define XP_LISP_MARK(x) (((xp_lisp_obj_t*)x)->mark) +#define XP_LISP_LOCK(x) (((xp_lisp_obj_t*)x)->lock) +#define XP_LISP_LINK(x) (((xp_lisp_obj_t*)x)->link) // value access -#define RBL_IVALUE(x) (((xp_lisp_obj_int_t*)x)->value) -#define RBL_FVALUE(x) (((xp_lisp_obj_float_t*)x)->value) +#define XP_LISP_IVALUE(x) (((xp_lisp_obj_int_t*)x)->value) +#define XP_LISP_FVALUE(x) (((xp_lisp_obj_float_t*)x)->value) #ifdef __BORLANDC__ -#define RBL_SYMVALUE(x) ((xp_lisp_char*)(((xp_lisp_obj_symbol_t*)x) + 1)) +#define XP_LISP_SYMVALUE(x) ((xp_lisp_char*)(((xp_lisp_obj_symbol_t*)x) + 1)) #else -#define RBL_SYMVALUE(x) (((xp_lisp_obj_symbol_t*)x)->buffer) +#define XP_LISP_SYMVALUE(x) (((xp_lisp_obj_symbol_t*)x)->buffer) #endif -#define RBL_SYMLEN(x) ((((xp_lisp_obj_symbol_t*)x)->size - sizeof(xp_lisp_obj_t)) / sizeof(xp_lisp_char) - 1) +#define XP_LISP_SYMLEN(x) ((((xp_lisp_obj_symbol_t*)x)->size - sizeof(xp_lisp_obj_t)) / sizeof(xp_lisp_char) - 1) #ifdef __BORLANDC__ -#define RBL_STRVALUE(x) ((xp_lisp_char*)(((xp_lisp_obj_string_t*)x) + 1)) +#define XP_LISP_STRVALUE(x) ((xp_lisp_char*)(((xp_lisp_obj_string_t*)x) + 1)) #else -#define RBL_STRVALUE(x) (((xp_lisp_obj_string_t*)x)->buffer) +#define XP_LISP_STRVALUE(x) (((xp_lisp_obj_string_t*)x)->buffer) #endif -#define RBL_STRLEN(x) ((((xp_lisp_obj_string_t*)x)->size - sizeof(xp_lisp_obj_t)) / sizeof(xp_lisp_char) - 1) +#define XP_LISP_STRLEN(x) ((((xp_lisp_obj_string_t*)x)->size - sizeof(xp_lisp_obj_t)) / sizeof(xp_lisp_char) - 1) -#define RBL_CAR(x) (((xp_lisp_obj_cons_t*)x)->car) -#define RBL_CDR(x) (((xp_lisp_obj_cons_t*)x)->cdr) -#define RBL_FFORMAL(x) (((xp_lisp_obj_func_t*)x)->formal) -#define RBL_FBODY(x) (((xp_lisp_obj_func_t*)x)->body) -#define RBL_MFORMAL(x) (((xp_lisp_obj_macro_t*)x)->formal) -#define RBL_MBODY(x) (((xp_lisp_obj_macro_t*)x)->body) -#define RBL_PIMPL(x) ((xp_lisp_pimpl_t)(((xp_lisp_obj_prim_t*)x)->impl)) +#define XP_LISP_CAR(x) (((xp_lisp_obj_cons_t*)x)->car) +#define XP_LISP_CDR(x) (((xp_lisp_obj_cons_t*)x)->cdr) +#define XP_LISP_FFORMAL(x) (((xp_lisp_obj_func_t*)x)->formal) +#define XP_LISP_FBODY(x) (((xp_lisp_obj_func_t*)x)->body) +#define XP_LISP_MFORMAL(x) (((xp_lisp_obj_macro_t*)x)->formal) +#define XP_LISP_MBODY(x) (((xp_lisp_obj_macro_t*)x)->body) +#define XP_LISP_PIMPL(x) ((xp_lisp_pimpl_t)(((xp_lisp_obj_prim_t*)x)->impl)) #endif diff --git a/ase/lsp/primitive.c b/ase/lsp/primitive.c index e2df5e3d..884f7ebe 100644 --- a/ase/lsp/primitive.c +++ b/ase/lsp/primitive.c @@ -1,5 +1,5 @@ /* - * $Id: primitive.c,v 1.1 2005-02-04 15:39:11 bacon Exp $ + * $Id: primitive.c,v 1.2 2005-02-04 16:00:37 bacon Exp $ */ #include "lisp.h" @@ -8,8 +8,8 @@ xp_lisp_obj_t* xp_lisp_prim_abort (xp_lisp_t* lsp, xp_lisp_obj_t* args) { - RBL_PRIM_CHECK_ARG_COUNT (lsp, args, 0, 0); - lsp->error = RBL_ERR_ABORT; + XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 0, 0); + lsp->error = XP_LISP_ERR_ABORT; return XP_NULL; } @@ -17,10 +17,10 @@ xp_lisp_obj_t* xp_lisp_prim_eval (xp_lisp_t* lsp, xp_lisp_obj_t* args) { xp_lisp_obj_t* tmp; - RBL_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1); - xp_lisp_assert (RBL_TYPE(args) == RBL_OBJ_CONS); + XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1); + xp_lisp_assert (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS); - tmp = xp_lisp_eval (lsp, RBL_CAR(args)); + tmp = xp_lisp_eval (lsp, XP_LISP_CAR(args)); if (tmp == XP_NULL) return XP_NULL; tmp = xp_lisp_eval (lsp, tmp); @@ -33,12 +33,12 @@ xp_lisp_obj_t* xp_lisp_prim_prog1 (xp_lisp_t* lsp, xp_lisp_obj_t* args) { xp_lisp_obj_t* res = XP_NULL, * tmp; - RBL_PRIM_CHECK_ARG_COUNT (lsp, args, 1, RBL_PRIM_MAX_ARG_COUNT); + XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, XP_LISP_PRIM_MAX_ARG_COUNT); //while (args != lsp->mem->nil) { - while (RBL_TYPE(args) == RBL_OBJ_CONS) { + while (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS) { - tmp = xp_lisp_eval (lsp, RBL_CAR(args)); + tmp = xp_lisp_eval (lsp, XP_LISP_CAR(args)); if (tmp == XP_NULL) return XP_NULL; if (res == XP_NULL) { @@ -48,7 +48,7 @@ xp_lisp_obj_t* xp_lisp_prim_prog1 (xp_lisp_t* lsp, xp_lisp_obj_t* args) */ res = tmp; } - args = RBL_CDR(args); + args = XP_LISP_CDR(args); } return res; @@ -58,17 +58,17 @@ xp_lisp_obj_t* xp_lisp_prim_progn (xp_lisp_t* lsp, xp_lisp_obj_t* args) { xp_lisp_obj_t* res, * tmp; - RBL_PRIM_CHECK_ARG_COUNT (lsp, args, 1, RBL_PRIM_MAX_ARG_COUNT); + XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, XP_LISP_PRIM_MAX_ARG_COUNT); res = lsp->mem->nil; //while (args != lsp->mem->nil) { - while (RBL_TYPE(args) == RBL_OBJ_CONS) { + while (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS) { - tmp = xp_lisp_eval (lsp, RBL_CAR(args)); + tmp = xp_lisp_eval (lsp, XP_LISP_CAR(args)); if (tmp == XP_NULL) return XP_NULL; res = tmp; - args = RBL_CDR(args); + args = XP_LISP_CDR(args); } return res; @@ -76,7 +76,7 @@ xp_lisp_obj_t* xp_lisp_prim_progn (xp_lisp_t* lsp, xp_lisp_obj_t* args) xp_lisp_obj_t* xp_lisp_prim_gc (xp_lisp_t* lsp, xp_lisp_obj_t* args) { - RBL_PRIM_CHECK_ARG_COUNT (lsp, args, 0, 0); + XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 0, 0); xp_lisp_garbage_collect (lsp->mem); return lsp->mem->nil; } @@ -93,33 +93,33 @@ xp_lisp_obj_t* xp_lisp_prim_cond (xp_lisp_t* lsp, xp_lisp_obj_t* args) xp_lisp_obj_t* tmp, * ret; - RBL_PRIM_CHECK_ARG_COUNT (lsp, args, 0, RBL_PRIM_MAX_ARG_COUNT); + XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 0, XP_LISP_PRIM_MAX_ARG_COUNT); - while (RBL_TYPE(args) == RBL_OBJ_CONS) { - if (RBL_TYPE(RBL_CAR(args)) != RBL_OBJ_CONS) { - lsp->error = RBL_ERR_BAD_ARG; + while (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS) { + if (XP_LISP_TYPE(XP_LISP_CAR(args)) != XP_LISP_OBJ_CONS) { + lsp->error = XP_LISP_ERR_BAD_ARG; return XP_NULL; } - tmp = xp_lisp_eval (lsp, RBL_CAR(RBL_CAR(args))); + tmp = xp_lisp_eval (lsp, XP_LISP_CAR(XP_LISP_CAR(args))); if (tmp == XP_NULL) return XP_NULL; if (tmp != lsp->mem->nil) { - tmp = RBL_CDR(RBL_CAR(args)); + tmp = XP_LISP_CDR(XP_LISP_CAR(args)); ret = lsp->mem->nil; - while (RBL_TYPE(tmp) == RBL_OBJ_CONS) { - ret = xp_lisp_eval (lsp, RBL_CAR(tmp)); + while (XP_LISP_TYPE(tmp) == XP_LISP_OBJ_CONS) { + ret = xp_lisp_eval (lsp, XP_LISP_CAR(tmp)); if (ret == XP_NULL) return XP_NULL; - tmp = RBL_CDR(tmp); + tmp = XP_LISP_CDR(tmp); } if (tmp != lsp->mem->nil) { - lsp->error = RBL_ERR_BAD_ARG; + lsp->error = XP_LISP_ERR_BAD_ARG; return XP_NULL; } return ret; } - args = RBL_CDR(args); + args = XP_LISP_CDR(args); } return lsp->mem->nil; @@ -129,29 +129,29 @@ xp_lisp_obj_t* xp_lisp_prim_if (xp_lisp_t* lsp, xp_lisp_obj_t* args) { xp_lisp_obj_t* tmp; - RBL_PRIM_CHECK_ARG_COUNT (lsp, args, 2, RBL_PRIM_MAX_ARG_COUNT); - xp_lisp_assert (RBL_TYPE(args) == RBL_OBJ_CONS); + XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, XP_LISP_PRIM_MAX_ARG_COUNT); + xp_lisp_assert (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS); - tmp = xp_lisp_eval (lsp, RBL_CAR(args)); + tmp = xp_lisp_eval (lsp, XP_LISP_CAR(args)); if (tmp == XP_NULL) return XP_NULL; if (tmp != lsp->mem->nil) { - tmp = xp_lisp_eval (lsp, RBL_CAR(RBL_CDR(args))); + tmp = xp_lisp_eval (lsp, XP_LISP_CAR(XP_LISP_CDR(args))); if (tmp == XP_NULL) return XP_NULL; return tmp; } else { xp_lisp_obj_t* res = lsp->mem->nil; - tmp = RBL_CDR(RBL_CDR(args)); + tmp = XP_LISP_CDR(XP_LISP_CDR(args)); - while (RBL_TYPE(tmp) == RBL_OBJ_CONS) { - res = xp_lisp_eval (lsp, RBL_CAR(tmp)); + while (XP_LISP_TYPE(tmp) == XP_LISP_OBJ_CONS) { + res = xp_lisp_eval (lsp, XP_LISP_CAR(tmp)); if (res == XP_NULL) return XP_NULL; - tmp = RBL_CDR(tmp); + tmp = XP_LISP_CDR(tmp); } if (tmp != lsp->mem->nil) { - lsp->error = RBL_ERR_BAD_ARG; + lsp->error = XP_LISP_ERR_BAD_ARG; return XP_NULL; } @@ -168,21 +168,21 @@ xp_lisp_obj_t* xp_lisp_prim_while (xp_lisp_t* lsp, xp_lisp_obj_t* args) xp_lisp_obj_t* tmp; - RBL_PRIM_CHECK_ARG_COUNT (lsp, args, 1, RBL_PRIM_MAX_ARG_COUNT); - xp_lisp_assert (RBL_TYPE(args) == RBL_OBJ_CONS); + XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, XP_LISP_PRIM_MAX_ARG_COUNT); + xp_lisp_assert (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS); for (;;) { - tmp = xp_lisp_eval (lsp, RBL_CAR(args)); + tmp = xp_lisp_eval (lsp, XP_LISP_CAR(args)); if (tmp == XP_NULL) return XP_NULL; if (tmp == lsp->mem->nil) break; - tmp = RBL_CDR(args); - while (RBL_TYPE(tmp) == RBL_OBJ_CONS) { - if (xp_lisp_eval (lsp, RBL_CAR(tmp)) == XP_NULL) return XP_NULL; - tmp = RBL_CDR(tmp); + tmp = XP_LISP_CDR(args); + while (XP_LISP_TYPE(tmp) == XP_LISP_OBJ_CONS) { + if (xp_lisp_eval (lsp, XP_LISP_CAR(tmp)) == XP_NULL) return XP_NULL; + tmp = XP_LISP_CDR(tmp); } if (tmp != lsp->mem->nil) { - lsp->error = RBL_ERR_BAD_ARG; + lsp->error = XP_LISP_ERR_BAD_ARG; return XP_NULL; } } @@ -194,56 +194,56 @@ xp_lisp_obj_t* xp_lisp_prim_car (xp_lisp_t* lsp, xp_lisp_obj_t* args) { xp_lisp_obj_t* tmp; - RBL_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1); - xp_lisp_assert (RBL_TYPE(args) == RBL_OBJ_CONS); + XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1); + xp_lisp_assert (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS); - tmp = xp_lisp_eval (lsp, RBL_CAR(args)); + tmp = xp_lisp_eval (lsp, XP_LISP_CAR(args)); if (tmp == XP_NULL) return XP_NULL; if (tmp == lsp->mem->nil) return lsp->mem->nil; - if (RBL_TYPE(tmp) != RBL_OBJ_CONS) { - lsp->error = RBL_ERR_BAD_ARG; + if (XP_LISP_TYPE(tmp) != XP_LISP_OBJ_CONS) { + lsp->error = XP_LISP_ERR_BAD_ARG; return XP_NULL; } - return RBL_CAR(tmp); + return XP_LISP_CAR(tmp); } xp_lisp_obj_t* xp_lisp_prim_cdr (xp_lisp_t* lsp, xp_lisp_obj_t* args) { xp_lisp_obj_t* tmp; - RBL_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1); - xp_lisp_assert (RBL_TYPE(args) == RBL_OBJ_CONS); + XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1); + xp_lisp_assert (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS); - tmp = xp_lisp_eval (lsp, RBL_CAR(args)); + tmp = xp_lisp_eval (lsp, XP_LISP_CAR(args)); if (tmp == XP_NULL) return XP_NULL; if (tmp == lsp->mem->nil) return lsp->mem->nil; - if (RBL_TYPE(tmp) != RBL_OBJ_CONS) { - lsp->error = RBL_ERR_BAD_ARG; + if (XP_LISP_TYPE(tmp) != XP_LISP_OBJ_CONS) { + lsp->error = XP_LISP_ERR_BAD_ARG; return XP_NULL; } - return RBL_CDR(tmp); + return XP_LISP_CDR(tmp); } xp_lisp_obj_t* xp_lisp_prim_cons (xp_lisp_t* lsp, xp_lisp_obj_t* args) { xp_lisp_obj_t* car, * cdr, * cons; - RBL_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2); - xp_lisp_assert (RBL_TYPE(args) == RBL_OBJ_CONS); + XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2); + xp_lisp_assert (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS); - car = xp_lisp_eval (lsp, RBL_CAR(args)); + car = xp_lisp_eval (lsp, XP_LISP_CAR(args)); if (car == XP_NULL) return XP_NULL; - cdr = xp_lisp_eval (lsp, RBL_CAR(RBL_CDR(args))); + cdr = xp_lisp_eval (lsp, XP_LISP_CAR(XP_LISP_CDR(args))); if (cdr == XP_NULL) return XP_NULL; cons = xp_lisp_make_cons (lsp->mem, car, cdr); if (cons == XP_NULL) { - lsp->error = RBL_ERR_MEM; + lsp->error = XP_LISP_ERR_MEM; return XP_NULL; } @@ -254,22 +254,22 @@ xp_lisp_obj_t* xp_lisp_prim_set (xp_lisp_t* lsp, xp_lisp_obj_t* args) { xp_lisp_obj_t* p1, * p2; - RBL_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2); - xp_lisp_assert (RBL_TYPE(args) == RBL_OBJ_CONS); + XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2); + xp_lisp_assert (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS); - p1 = xp_lisp_eval (lsp, RBL_CAR(args)); + p1 = xp_lisp_eval (lsp, XP_LISP_CAR(args)); if (p1 == XP_NULL) return XP_NULL; - if (RBL_TYPE(p1) != RBL_OBJ_SYMBOL) { - lsp->error = RBL_ERR_BAD_ARG; + if (XP_LISP_TYPE(p1) != XP_LISP_OBJ_SYMBOL) { + lsp->error = XP_LISP_ERR_BAD_ARG; return XP_NULL; } - p2 = xp_lisp_eval (lsp, RBL_CAR(RBL_CDR(args))); + p2 = xp_lisp_eval (lsp, XP_LISP_CAR(XP_LISP_CDR(args))); if (p2 == XP_NULL) return XP_NULL; if (xp_lisp_set (lsp->mem, p1, p2) == XP_NULL) { - lsp->error = RBL_ERR_MEM; + lsp->error = XP_LISP_ERR_MEM; return XP_NULL; } @@ -281,28 +281,28 @@ xp_lisp_obj_t* xp_lisp_prim_setq (xp_lisp_t* lsp, xp_lisp_obj_t* args) xp_lisp_obj_t* p = args, * p1, * p2 = lsp->mem->nil; while (p != lsp->mem->nil) { - xp_lisp_assert (RBL_TYPE(p) == RBL_OBJ_CONS); + xp_lisp_assert (XP_LISP_TYPE(p) == XP_LISP_OBJ_CONS); - p1 = RBL_CAR(p); - if (RBL_TYPE(p1) != RBL_OBJ_SYMBOL) { - lsp->error = RBL_ERR_BAD_ARG; + p1 = XP_LISP_CAR(p); + if (XP_LISP_TYPE(p1) != XP_LISP_OBJ_SYMBOL) { + lsp->error = XP_LISP_ERR_BAD_ARG; return XP_NULL; } - if (RBL_TYPE(RBL_CDR(p)) != RBL_OBJ_CONS) { - lsp->error = RBL_ERR_TOO_FEW_ARGS; + if (XP_LISP_TYPE(XP_LISP_CDR(p)) != XP_LISP_OBJ_CONS) { + lsp->error = XP_LISP_ERR_TOO_FEW_ARGS; return XP_NULL; } - p2 = xp_lisp_eval (lsp, RBL_CAR(RBL_CDR(p))); + p2 = xp_lisp_eval (lsp, XP_LISP_CAR(XP_LISP_CDR(p))); if (p2 == XP_NULL) return XP_NULL; if (xp_lisp_set (lsp->mem, p1, p2) == XP_NULL) { - lsp->error = RBL_ERR_MEM; + lsp->error = XP_LISP_ERR_MEM; return XP_NULL; } - p = RBL_CDR(RBL_CDR(p)); + p = XP_LISP_CDR(XP_LISP_CDR(p)); } return p2; @@ -310,9 +310,9 @@ xp_lisp_obj_t* xp_lisp_prim_setq (xp_lisp_t* lsp, xp_lisp_obj_t* args) xp_lisp_obj_t* xp_lisp_prim_quote (xp_lisp_t* lsp, xp_lisp_obj_t* args) { - RBL_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1); - xp_lisp_assert (RBL_TYPE(args) == RBL_OBJ_CONS); - return RBL_CAR(args); + XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1); + xp_lisp_assert (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS); + return XP_LISP_CAR(args); } xp_lisp_obj_t* xp_lisp_prim_defun (xp_lisp_t* lsp, xp_lisp_obj_t* args) @@ -324,20 +324,20 @@ xp_lisp_obj_t* xp_lisp_prim_defun (xp_lisp_t* lsp, xp_lisp_obj_t* args) xp_lisp_obj_t* name, * fun; - RBL_PRIM_CHECK_ARG_COUNT (lsp, args, 3, RBL_PRIM_MAX_ARG_COUNT); + XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 3, XP_LISP_PRIM_MAX_ARG_COUNT); - name = RBL_CAR(args); - if (RBL_TYPE(name) != RBL_OBJ_SYMBOL) { - lsp->error = RBL_ERR_BAD_ARG; + name = XP_LISP_CAR(args); + if (XP_LISP_TYPE(name) != XP_LISP_OBJ_SYMBOL) { + lsp->error = XP_LISP_ERR_BAD_ARG; return XP_NULL; } fun = xp_lisp_make_func (lsp->mem, - RBL_CAR(RBL_CDR(args)), RBL_CDR(RBL_CDR(args))); + XP_LISP_CAR(XP_LISP_CDR(args)), XP_LISP_CDR(XP_LISP_CDR(args))); if (fun == XP_NULL) return XP_NULL; - if (xp_lisp_set (lsp->mem, RBL_CAR(args), fun) == XP_NULL) { - lsp->error = RBL_ERR_MEM; + if (xp_lisp_set (lsp->mem, XP_LISP_CAR(args), fun) == XP_NULL) { + lsp->error = XP_LISP_ERR_MEM; return XP_NULL; } return fun; @@ -352,20 +352,20 @@ xp_lisp_obj_t* xp_lisp_prim_demac (xp_lisp_t* lsp, xp_lisp_obj_t* args) xp_lisp_obj_t* name, * mac; - RBL_PRIM_CHECK_ARG_COUNT (lsp, args, 3, RBL_PRIM_MAX_ARG_COUNT); + XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 3, XP_LISP_PRIM_MAX_ARG_COUNT); - name = RBL_CAR(args); - if (RBL_TYPE(name) != RBL_OBJ_SYMBOL) { - lsp->error = RBL_ERR_BAD_ARG; + name = XP_LISP_CAR(args); + if (XP_LISP_TYPE(name) != XP_LISP_OBJ_SYMBOL) { + lsp->error = XP_LISP_ERR_BAD_ARG; return XP_NULL; } mac = xp_lisp_make_macro (lsp->mem, - RBL_CAR(RBL_CDR(args)), RBL_CDR(RBL_CDR(args))); + XP_LISP_CAR(XP_LISP_CDR(args)), XP_LISP_CDR(XP_LISP_CDR(args))); if (mac == XP_NULL) return XP_NULL; - if (xp_lisp_set (lsp->mem, RBL_CAR(args), mac) == XP_NULL) { - lsp->error = RBL_ERR_MEM; + if (xp_lisp_set (lsp->mem, XP_LISP_CAR(args), mac) == XP_NULL) { + lsp->error = XP_LISP_ERR_MEM; return XP_NULL; } return mac; @@ -379,12 +379,12 @@ static xp_lisp_obj_t* xp_lisp_prim_let_impl ( xp_lisp_obj_t* body; xp_lisp_obj_t* value; - RBL_PRIM_CHECK_ARG_COUNT (lsp, args, 1, RBL_PRIM_MAX_ARG_COUNT); + XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, XP_LISP_PRIM_MAX_ARG_COUNT); // create a new frame frame = xp_lisp_frame_new (); if (frame == XP_NULL) { - lsp->error = RBL_ERR_MEM; + lsp->error = XP_LISP_ERR_MEM; return XP_NULL; } //frame->link = lsp->mem->frame; @@ -398,17 +398,17 @@ static xp_lisp_obj_t* xp_lisp_prim_let_impl ( lsp->mem->brooding_frame = frame; } - assoc = RBL_CAR(args); + assoc = XP_LISP_CAR(args); //while (assoc != lsp->mem->nil) { - while (RBL_TYPE(assoc) == RBL_OBJ_CONS) { - xp_lisp_obj_t* ass = RBL_CAR(assoc); - if (RBL_TYPE(ass) == RBL_OBJ_CONS) { - xp_lisp_obj_t* n = RBL_CAR(ass); - xp_lisp_obj_t* v = RBL_CDR(ass); + while (XP_LISP_TYPE(assoc) == XP_LISP_OBJ_CONS) { + xp_lisp_obj_t* ass = XP_LISP_CAR(assoc); + if (XP_LISP_TYPE(ass) == XP_LISP_OBJ_CONS) { + xp_lisp_obj_t* n = XP_LISP_CAR(ass); + xp_lisp_obj_t* v = XP_LISP_CDR(ass); - if (RBL_TYPE(n) != RBL_OBJ_SYMBOL) { - lsp->error = RBL_ERR_BAD_ARG; // must be a symbol + if (XP_LISP_TYPE(n) != XP_LISP_OBJ_SYMBOL) { + lsp->error = XP_LISP_ERR_BAD_ARG; // must be a symbol if (sequential) lsp->mem->frame = frame->link; else lsp->mem->brooding_frame = frame->link; xp_lisp_frame_free (frame); @@ -416,14 +416,14 @@ static xp_lisp_obj_t* xp_lisp_prim_let_impl ( } if (v != lsp->mem->nil) { - if (RBL_CDR(v) != lsp->mem->nil) { - lsp->error = RBL_ERR_TOO_MANY_ARGS; // must be a symbol + if (XP_LISP_CDR(v) != lsp->mem->nil) { + lsp->error = XP_LISP_ERR_TOO_MANY_ARGS; // must be a symbol if (sequential) lsp->mem->frame = frame->link; else lsp->mem->brooding_frame = frame->link; xp_lisp_frame_free (frame); return XP_NULL; } - if ((v = xp_lisp_eval(lsp, RBL_CAR(v))) == XP_NULL) { + if ((v = xp_lisp_eval(lsp, XP_LISP_CAR(v))) == XP_NULL) { if (sequential) lsp->mem->frame = frame->link; else lsp->mem->brooding_frame = frame->link; xp_lisp_frame_free (frame); @@ -432,30 +432,30 @@ static xp_lisp_obj_t* xp_lisp_prim_let_impl ( } if (xp_lisp_frame_lookup (frame, n) != XP_NULL) { - lsp->error = RBL_ERR_DUP_FORMAL; + lsp->error = XP_LISP_ERR_DUP_FORMAL; if (sequential) lsp->mem->frame = frame->link; else lsp->mem->brooding_frame = frame->link; xp_lisp_frame_free (frame); return XP_NULL; } if (xp_lisp_frame_insert (frame, n, v) == XP_NULL) { - lsp->error = RBL_ERR_MEM; + lsp->error = XP_LISP_ERR_MEM; if (sequential) lsp->mem->frame = frame->link; else lsp->mem->brooding_frame = frame->link; xp_lisp_frame_free (frame); return XP_NULL; } } - else if (RBL_TYPE(ass) == RBL_OBJ_SYMBOL) { + else if (XP_LISP_TYPE(ass) == XP_LISP_OBJ_SYMBOL) { if (xp_lisp_frame_lookup (frame, ass) != XP_NULL) { - lsp->error = RBL_ERR_DUP_FORMAL; + lsp->error = XP_LISP_ERR_DUP_FORMAL; if (sequential) lsp->mem->frame = frame->link; else lsp->mem->brooding_frame = frame->link; xp_lisp_frame_free (frame); return XP_NULL; } if (xp_lisp_frame_insert (frame, ass, lsp->mem->nil) == XP_NULL) { - lsp->error = RBL_ERR_MEM; + lsp->error = XP_LISP_ERR_MEM; if (sequential) lsp->mem->frame = frame->link; else lsp->mem->brooding_frame = frame->link; xp_lisp_frame_free (frame); @@ -463,18 +463,18 @@ static xp_lisp_obj_t* xp_lisp_prim_let_impl ( } } else { - lsp->error = RBL_ERR_BAD_ARG; + lsp->error = XP_LISP_ERR_BAD_ARG; if (sequential) lsp->mem->frame = frame->link; else lsp->mem->brooding_frame = frame->link; xp_lisp_frame_free (frame); return XP_NULL; } - assoc = RBL_CDR(assoc); + assoc = XP_LISP_CDR(assoc); } if (assoc != lsp->mem->nil) { - lsp->error = RBL_ERR_BAD_ARG; + lsp->error = XP_LISP_ERR_BAD_ARG; if (sequential) lsp->mem->frame = frame->link; else lsp->mem->brooding_frame = frame->link; xp_lisp_frame_free (frame); @@ -490,15 +490,15 @@ static xp_lisp_obj_t* xp_lisp_prim_let_impl ( // evaluate forms in the body value = lsp->mem->nil; - body = RBL_CDR(args); + body = XP_LISP_CDR(args); while (body != lsp->mem->nil) { - value = xp_lisp_eval (lsp, RBL_CAR(body)); + value = xp_lisp_eval (lsp, XP_LISP_CAR(body)); if (value == XP_NULL) { lsp->mem->frame = frame->link; xp_lisp_frame_free (frame); return XP_NULL; } - body = RBL_CDR(body); + body = XP_LISP_CDR(body); } // pop the frame @@ -524,27 +524,27 @@ xp_lisp_obj_t* xp_lisp_prim_plus (xp_lisp_t* lsp, xp_lisp_obj_t* args) xp_lisp_obj_t* body, * tmp; xp_lisp_int value = 0; - RBL_PRIM_CHECK_ARG_COUNT (lsp, args, 1, RBL_PRIM_MAX_ARG_COUNT); - xp_lisp_assert (RBL_TYPE(args) == RBL_OBJ_CONS); + XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, XP_LISP_PRIM_MAX_ARG_COUNT); + xp_lisp_assert (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS); body = args; //while (body != lsp->mem->nil) { - while (RBL_TYPE(body) == RBL_OBJ_CONS) { - tmp = xp_lisp_eval (lsp, RBL_CAR(body)); + while (XP_LISP_TYPE(body) == XP_LISP_OBJ_CONS) { + tmp = xp_lisp_eval (lsp, XP_LISP_CAR(body)); if (tmp == XP_NULL) return XP_NULL; - if (RBL_TYPE(tmp) != RBL_OBJ_INT) { - lsp->error = RBL_ERR_BAD_VALUE; + if (XP_LISP_TYPE(tmp) != XP_LISP_OBJ_INT) { + lsp->error = XP_LISP_ERR_BAD_VALUE; return XP_NULL; } - value = value + RBL_IVALUE(tmp); - body = RBL_CDR(body); + value = value + XP_LISP_IVALUE(tmp); + body = XP_LISP_CDR(body); } tmp = xp_lisp_make_int (lsp->mem, value); if (tmp == XP_NULL) { - lsp->error = RBL_ERR_MEM; + lsp->error = XP_LISP_ERR_MEM; return XP_NULL; } @@ -556,62 +556,62 @@ xp_lisp_obj_t* xp_lisp_prim_gt (xp_lisp_t* lsp, xp_lisp_obj_t* args) xp_lisp_obj_t* p1, * p2; int res; - RBL_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2); - xp_lisp_assert (RBL_TYPE(args) == RBL_OBJ_CONS); + XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2); + xp_lisp_assert (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS); - p1 = xp_lisp_eval (lsp, RBL_CAR(args)); + p1 = xp_lisp_eval (lsp, XP_LISP_CAR(args)); if (p1 == XP_NULL) return XP_NULL; // TODO: lock p1.... - p2 = xp_lisp_eval (lsp, RBL_CAR(RBL_CDR(args))); + p2 = xp_lisp_eval (lsp, XP_LISP_CAR(XP_LISP_CDR(args))); if (p2 == XP_NULL) return XP_NULL; - if (RBL_TYPE(p1) == RBL_OBJ_INT) { - if (RBL_TYPE(p2) == RBL_OBJ_INT) { - res = RBL_IVALUE(p1) > RBL_IVALUE(p2); + if (XP_LISP_TYPE(p1) == XP_LISP_OBJ_INT) { + if (XP_LISP_TYPE(p2) == XP_LISP_OBJ_INT) { + res = XP_LISP_IVALUE(p1) > XP_LISP_IVALUE(p2); } - else if (RBL_TYPE(p2) == RBL_OBJ_FLOAT) { - res = RBL_IVALUE(p1) > RBL_FVALUE(p2); + else if (XP_LISP_TYPE(p2) == XP_LISP_OBJ_FLOAT) { + res = XP_LISP_IVALUE(p1) > XP_LISP_FVALUE(p2); } else { - lsp->error = RBL_ERR_BAD_VALUE; + lsp->error = XP_LISP_ERR_BAD_VALUE; return XP_NULL; } } - else if (RBL_TYPE(p1) == RBL_OBJ_FLOAT) { - if (RBL_TYPE(p2) == RBL_OBJ_INT) { - res = RBL_FVALUE(p1) > RBL_IVALUE(p2); + else if (XP_LISP_TYPE(p1) == XP_LISP_OBJ_FLOAT) { + if (XP_LISP_TYPE(p2) == XP_LISP_OBJ_INT) { + res = XP_LISP_FVALUE(p1) > XP_LISP_IVALUE(p2); } - else if (RBL_TYPE(p2) == RBL_OBJ_FLOAT) { - res = RBL_FVALUE(p1) > RBL_FVALUE(p2); + else if (XP_LISP_TYPE(p2) == XP_LISP_OBJ_FLOAT) { + res = XP_LISP_FVALUE(p1) > XP_LISP_FVALUE(p2); } else { - lsp->error = RBL_ERR_BAD_VALUE; + lsp->error = XP_LISP_ERR_BAD_VALUE; return XP_NULL; } } - else if (RBL_TYPE(p1) == RBL_OBJ_SYMBOL) { - if (RBL_TYPE(p2) == RBL_OBJ_SYMBOL) { + else if (XP_LISP_TYPE(p1) == XP_LISP_OBJ_SYMBOL) { + if (XP_LISP_TYPE(p2) == XP_LISP_OBJ_SYMBOL) { res = xp_lisp_comp_symbol2 ( - p1, RBL_SYMVALUE(p2), RBL_SYMLEN(p2)) > 0; + p1, XP_LISP_SYMVALUE(p2), XP_LISP_SYMLEN(p2)) > 0; } else { - lsp->error = RBL_ERR_BAD_VALUE; + lsp->error = XP_LISP_ERR_BAD_VALUE; return XP_NULL; } } - else if (RBL_TYPE(p1) == RBL_OBJ_STRING) { - if (RBL_TYPE(p2) == RBL_OBJ_STRING) { + else if (XP_LISP_TYPE(p1) == XP_LISP_OBJ_STRING) { + if (XP_LISP_TYPE(p2) == XP_LISP_OBJ_STRING) { res = xp_lisp_comp_string2 ( - p1, RBL_STRVALUE(p2), RBL_STRLEN(p2)) > 0; + p1, XP_LISP_STRVALUE(p2), XP_LISP_STRLEN(p2)) > 0; } else { - lsp->error = RBL_ERR_BAD_VALUE; + lsp->error = XP_LISP_ERR_BAD_VALUE; return XP_NULL; } } else { - lsp->error = RBL_ERR_BAD_VALUE; + lsp->error = XP_LISP_ERR_BAD_VALUE; return XP_NULL; } @@ -623,62 +623,62 @@ xp_lisp_obj_t* xp_lisp_prim_lt (xp_lisp_t* lsp, xp_lisp_obj_t* args) xp_lisp_obj_t* p1, * p2; int res; - RBL_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2); - xp_lisp_assert (RBL_TYPE(args) == RBL_OBJ_CONS); + XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2); + xp_lisp_assert (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS); - p1 = xp_lisp_eval (lsp, RBL_CAR(args)); + p1 = xp_lisp_eval (lsp, XP_LISP_CAR(args)); if (p1 == XP_NULL) return XP_NULL; // TODO: lock p1.... - p2 = xp_lisp_eval (lsp, RBL_CAR(RBL_CDR(args))); + p2 = xp_lisp_eval (lsp, XP_LISP_CAR(XP_LISP_CDR(args))); if (p2 == XP_NULL) return XP_NULL; - if (RBL_TYPE(p1) == RBL_OBJ_INT) { - if (RBL_TYPE(p2) == RBL_OBJ_INT) { - res = RBL_IVALUE(p1) < RBL_IVALUE(p2); + if (XP_LISP_TYPE(p1) == XP_LISP_OBJ_INT) { + if (XP_LISP_TYPE(p2) == XP_LISP_OBJ_INT) { + res = XP_LISP_IVALUE(p1) < XP_LISP_IVALUE(p2); } - else if (RBL_TYPE(p2) == RBL_OBJ_FLOAT) { - res = RBL_IVALUE(p1) < RBL_FVALUE(p2); + else if (XP_LISP_TYPE(p2) == XP_LISP_OBJ_FLOAT) { + res = XP_LISP_IVALUE(p1) < XP_LISP_FVALUE(p2); } else { - lsp->error = RBL_ERR_BAD_VALUE; + lsp->error = XP_LISP_ERR_BAD_VALUE; return XP_NULL; } } - else if (RBL_TYPE(p1) == RBL_OBJ_FLOAT) { - if (RBL_TYPE(p2) == RBL_OBJ_INT) { - res = RBL_FVALUE(p1) < RBL_IVALUE(p2); + else if (XP_LISP_TYPE(p1) == XP_LISP_OBJ_FLOAT) { + if (XP_LISP_TYPE(p2) == XP_LISP_OBJ_INT) { + res = XP_LISP_FVALUE(p1) < XP_LISP_IVALUE(p2); } - else if (RBL_TYPE(p2) == RBL_OBJ_FLOAT) { - res = RBL_FVALUE(p1) < RBL_FVALUE(p2); + else if (XP_LISP_TYPE(p2) == XP_LISP_OBJ_FLOAT) { + res = XP_LISP_FVALUE(p1) < XP_LISP_FVALUE(p2); } else { - lsp->error = RBL_ERR_BAD_VALUE; + lsp->error = XP_LISP_ERR_BAD_VALUE; return XP_NULL; } } - else if (RBL_TYPE(p1) == RBL_OBJ_SYMBOL) { - if (RBL_TYPE(p2) == RBL_OBJ_SYMBOL) { + else if (XP_LISP_TYPE(p1) == XP_LISP_OBJ_SYMBOL) { + if (XP_LISP_TYPE(p2) == XP_LISP_OBJ_SYMBOL) { res = xp_lisp_comp_symbol2 ( - p1, RBL_SYMVALUE(p2), RBL_SYMLEN(p2)) < 0; + p1, XP_LISP_SYMVALUE(p2), XP_LISP_SYMLEN(p2)) < 0; } else { - lsp->error = RBL_ERR_BAD_VALUE; + lsp->error = XP_LISP_ERR_BAD_VALUE; return XP_NULL; } } - else if (RBL_TYPE(p1) == RBL_OBJ_STRING) { - if (RBL_TYPE(p2) == RBL_OBJ_STRING) { + else if (XP_LISP_TYPE(p1) == XP_LISP_OBJ_STRING) { + if (XP_LISP_TYPE(p2) == XP_LISP_OBJ_STRING) { res = xp_lisp_comp_string2 ( - p1, RBL_STRVALUE(p2), RBL_STRLEN(p2)) < 0; + p1, XP_LISP_STRVALUE(p2), XP_LISP_STRLEN(p2)) < 0; } else { - lsp->error = RBL_ERR_BAD_VALUE; + lsp->error = XP_LISP_ERR_BAD_VALUE; return XP_NULL; } } else { - lsp->error = RBL_ERR_BAD_VALUE; + lsp->error = XP_LISP_ERR_BAD_VALUE; return XP_NULL; } diff --git a/ase/lsp/primitive.h b/ase/lsp/primitive.h index 8a5b1e6e..88830996 100644 --- a/ase/lsp/primitive.h +++ b/ase/lsp/primitive.h @@ -1,12 +1,12 @@ /* - * $Id: primitive.h,v 1.1 2005-02-04 15:39:11 bacon Exp $ + * $Id: primitive.h,v 1.2 2005-02-04 16:00:37 bacon Exp $ */ -#ifndef _RBL_PRIM_H_ -#define _RBL_PRIM_H_ +#ifndef _XP_LISP_PRIM_H_ +#define _XP_LISP_PRIM_H_ -#include "types.h" -#include "lsp.h" +#include +#include typedef xp_lisp_obj_t* (*xp_lisp_pimpl_t) (xp_lisp_t*, xp_lisp_obj_t*); @@ -42,23 +42,23 @@ xp_lisp_obj_t* xp_lisp_prim_lt (xp_lisp_t*, xp_lisp_obj_t* args); } #endif -#define RBL_PRIM_CHECK_ARG_COUNT(lsp,args,min,max) \ +#define XP_LISP_PRIM_CHECK_ARG_COUNT(lsp,args,min,max) \ { \ xp_size_t count; \ if (xp_lisp_probe_args(lsp->mem, args, &count) == -1) { \ - lsp->error = RBL_ERR_BAD_ARG; \ + lsp->error = XP_LISP_ERR_BAD_ARG; \ return XP_NULL; \ } \ if (count < min) { \ - lsp->error = RBL_ERR_TOO_FEW_ARGS; \ + lsp->error = XP_LISP_ERR_TOO_FEW_ARGS; \ return XP_NULL; \ } \ if (count > max) { \ - lsp->error = RBL_ERR_TOO_MANY_ARGS; \ + lsp->error = XP_LISP_ERR_TOO_MANY_ARGS; \ return XP_NULL; \ } \ } -#define RBL_PRIM_MAX_ARG_COUNT ((xp_size_t)~(xp_size_t)0) +#define XP_LISP_PRIM_MAX_ARG_COUNT ((xp_size_t)~(xp_size_t)0) #endif diff --git a/ase/lsp/print.c b/ase/lsp/print.c index 44e977a6..5b2f67b5 100644 --- a/ase/lsp/print.c +++ b/ase/lsp/print.c @@ -1,113 +1,113 @@ /* - * $Id: print.c,v 1.1 2005-02-04 15:39:11 bacon Exp $ + * $Id: print.c,v 1.2 2005-02-04 16:00:37 bacon Exp $ */ -#include "lsp.h" +#include void xp_lisp_print_debug (xp_lisp_obj_t* obj) { - switch (RBL_TYPE(obj)) { - case RBL_OBJ_NIL: - rb_printf ( RBL_TEXT("nil")); + switch (XP_LISP_TYPE(obj)) { + case XP_LISP_OBJ_NIL: + xp_printf ( XP_LISP_TEXT("nil")); break; - case RBL_OBJ_TRUE: - rb_printf ( RBL_TEXT("t")); + case XP_LISP_OBJ_TRUE: + xp_printf ( XP_LISP_TEXT("t")); break; - case RBL_OBJ_INT: - rb_printf ( RBL_TEXT("%d"), RBL_IVALUE(obj)); + case XP_LISP_OBJ_INT: + xp_printf ( XP_LISP_TEXT("%d"), XP_LISP_IVALUE(obj)); break; - case RBL_OBJ_FLOAT: - rb_printf ( RBL_TEXT("%f"), RBL_FVALUE(obj)); + case XP_LISP_OBJ_FLOAT: + xp_printf ( XP_LISP_TEXT("%f"), XP_LISP_FVALUE(obj)); break; - case RBL_OBJ_SYMBOL: - rb_printf ( RBL_TEXT("%s"), RBL_SYMVALUE(obj)); + case XP_LISP_OBJ_SYMBOL: + xp_printf ( XP_LISP_TEXT("%s"), XP_LISP_SYMVALUE(obj)); break; - case RBL_OBJ_STRING: - rb_printf ( RBL_TEXT("%s"), RBL_STRVALUE(obj)); + case XP_LISP_OBJ_STRING: + xp_printf ( XP_LISP_TEXT("%s"), XP_LISP_STRVALUE(obj)); break; - case RBL_OBJ_CONS: + case XP_LISP_OBJ_CONS: { xp_lisp_obj_t* p = obj; - rb_printf ( RBL_TEXT("(")); + xp_printf ( XP_LISP_TEXT("(")); do { - xp_lisp_print_debug (RBL_CAR(p)); - p = RBL_CDR(p); - if (RBL_TYPE(p) != RBL_OBJ_NIL) { - rb_printf ( RBL_TEXT(" ")); - if (RBL_TYPE(p) != RBL_OBJ_CONS) { - rb_printf ( RBL_TEXT(". ")); + xp_lisp_print_debug (XP_LISP_CAR(p)); + p = XP_LISP_CDR(p); + if (XP_LISP_TYPE(p) != XP_LISP_OBJ_NIL) { + xp_printf ( XP_LISP_TEXT(" ")); + if (XP_LISP_TYPE(p) != XP_LISP_OBJ_CONS) { + xp_printf ( XP_LISP_TEXT(". ")); xp_lisp_print_debug (p); } } - } while (RBL_TYPE(p) != RBL_OBJ_NIL && RBL_TYPE(p) == RBL_OBJ_CONS); - rb_printf ( RBL_TEXT(")")); + } while (XP_LISP_TYPE(p) != XP_LISP_OBJ_NIL && XP_LISP_TYPE(p) == XP_LISP_OBJ_CONS); + xp_printf ( XP_LISP_TEXT(")")); } break; - case RBL_OBJ_FUNC: - rb_printf ( RBL_TEXT("func")); + case XP_LISP_OBJ_FUNC: + xp_printf ( XP_LISP_TEXT("func")); break; - case RBL_OBJ_MACRO: - rb_printf (RBL_TEXT("macro")); + case XP_LISP_OBJ_MACRO: + xp_printf (XP_LISP_TEXT("macro")); break; - case RBL_OBJ_PRIM: - rb_printf (RBL_TEXT("prim")); + case XP_LISP_OBJ_PRIM: + xp_printf (XP_LISP_TEXT("prim")); break; default: - rb_printf (RBL_TEXT("unknown object type: %d"), RBL_TYPE(obj)); + xp_printf (XP_LISP_TEXT("unknown object type: %d"), XP_LISP_TYPE(obj)); } } void xp_lisp_print (xp_lisp_t* lsp, xp_lisp_obj_t* obj) { - switch (RBL_TYPE(obj)) { - case RBL_OBJ_NIL: - rb_fprintf (lsp->outstream, RBL_TEXT("nil")); + switch (XP_LISP_TYPE(obj)) { + case XP_LISP_OBJ_NIL: + xp_fprintf (lsp->outstream, XP_LISP_TEXT("nil")); break; - case RBL_OBJ_TRUE: - rb_fprintf (lsp->outstream, RBL_TEXT("t")); + case XP_LISP_OBJ_TRUE: + xp_fprintf (lsp->outstream, XP_LISP_TEXT("t")); break; - case RBL_OBJ_INT: - rb_fprintf (lsp->outstream, RBL_TEXT("%d"), RBL_IVALUE(obj)); + case XP_LISP_OBJ_INT: + xp_fprintf (lsp->outstream, XP_LISP_TEXT("%d"), XP_LISP_IVALUE(obj)); break; - case RBL_OBJ_FLOAT: - rb_fprintf (lsp->outstream, RBL_TEXT("%f"), RBL_FVALUE(obj)); + case XP_LISP_OBJ_FLOAT: + xp_fprintf (lsp->outstream, XP_LISP_TEXT("%f"), XP_LISP_FVALUE(obj)); break; - case RBL_OBJ_SYMBOL: - rb_fprintf (lsp->outstream, RBL_TEXT("%s"), RBL_SYMVALUE(obj)); + case XP_LISP_OBJ_SYMBOL: + xp_fprintf (lsp->outstream, XP_LISP_TEXT("%s"), XP_LISP_SYMVALUE(obj)); break; - case RBL_OBJ_STRING: - rb_fprintf (lsp->outstream, RBL_TEXT("\"%s\""), RBL_STRVALUE(obj)); + case XP_LISP_OBJ_STRING: + xp_fprintf (lsp->outstream, XP_LISP_TEXT("\"%s\""), XP_LISP_STRVALUE(obj)); break; - case RBL_OBJ_CONS: + case XP_LISP_OBJ_CONS: { xp_lisp_obj_t* p = obj; - rb_fprintf (lsp->outstream, RBL_TEXT("(")); + xp_fprintf (lsp->outstream, XP_LISP_TEXT("(")); do { - xp_lisp_print (lsp, RBL_CAR(p)); - p = RBL_CDR(p); + xp_lisp_print (lsp, XP_LISP_CAR(p)); + p = XP_LISP_CDR(p); if (p != lsp->mem->nil) { - rb_fprintf (lsp->outstream, RBL_TEXT(" ")); - if (RBL_TYPE(p) != RBL_OBJ_CONS) { - rb_fprintf (lsp->outstream, RBL_TEXT(". ")); + xp_fprintf (lsp->outstream, XP_LISP_TEXT(" ")); + if (XP_LISP_TYPE(p) != XP_LISP_OBJ_CONS) { + xp_fprintf (lsp->outstream, XP_LISP_TEXT(". ")); xp_lisp_print (lsp, p); } } - } while (p != lsp->mem->nil && RBL_TYPE(p) == RBL_OBJ_CONS); - rb_fprintf (lsp->outstream, RBL_TEXT(")")); + } while (p != lsp->mem->nil && XP_LISP_TYPE(p) == XP_LISP_OBJ_CONS); + xp_fprintf (lsp->outstream, XP_LISP_TEXT(")")); } break; - case RBL_OBJ_FUNC: - rb_fprintf (lsp->outstream, RBL_TEXT("func")); + case XP_LISP_OBJ_FUNC: + xp_fprintf (lsp->outstream, XP_LISP_TEXT("func")); break; - case RBL_OBJ_MACRO: - rb_fprintf (lsp->outstream, RBL_TEXT("macro")); + case XP_LISP_OBJ_MACRO: + xp_fprintf (lsp->outstream, XP_LISP_TEXT("macro")); break; - case RBL_OBJ_PRIM: - rb_fprintf (lsp->outstream, RBL_TEXT("prim")); + case XP_LISP_OBJ_PRIM: + xp_fprintf (lsp->outstream, XP_LISP_TEXT("prim")); break; default: - rb_fprintf (lsp->outstream, - RBL_TEXT("unknown object type: %d"), RBL_TYPE(obj)); + xp_fprintf (lsp->outstream, + XP_LISP_TEXT("unknown object type: %d"), XP_LISP_TYPE(obj)); } } diff --git a/ase/lsp/read.c b/ase/lsp/read.c index ccd6c66a..f6c57ea1 100644 --- a/ase/lsp/read.c +++ b/ase/lsp/read.c @@ -1,22 +1,22 @@ /* - * $Id: read.c,v 1.1 2005-02-04 15:39:11 bacon Exp $ + * $Id: read.c,v 1.2 2005-02-04 16:00:37 bacon Exp $ */ -#include "lsp.h" -#include "token.h" +#include +#include -#define IS_SPACE(x) rb_isspace(x) -#define IS_DIGIT(x) rb_isdigit(x) -#define IS_ALPHA(x) rb_isalpha(x) -#define IS_ALNUM(x) rb_isalnum(x) +#define IS_SPACE(x) xp_isspace(x) +#define IS_DIGIT(x) xp_isdigit(x) +#define IS_ALPHA(x) xp_isalpha(x) +#define IS_ALNUM(x) xp_isalnum(x) #define IS_IDENT(c) \ - ((c) == RBL_CHAR('+') || (c) == RBL_CHAR('-') || \ - (c) == RBL_CHAR('*') || (c) == RBL_CHAR('/') || \ - (c) == RBL_CHAR('%') || (c) == RBL_CHAR('&') || \ - (c) == RBL_CHAR('<') || (c) == RBL_CHAR('>') || \ - (c) == RBL_CHAR('=') || (c) == RBL_CHAR('_') || \ - (c) == RBL_CHAR('?')) + ((c) == XP_LISP_CHAR('+') || (c) == XP_LISP_CHAR('-') || \ + (c) == XP_LISP_CHAR('*') || (c) == XP_LISP_CHAR('/') || \ + (c) == XP_LISP_CHAR('%') || (c) == XP_LISP_CHAR('&') || \ + (c) == XP_LISP_CHAR('<') || (c) == XP_LISP_CHAR('>') || \ + (c) == XP_LISP_CHAR('=') || (c) == XP_LISP_CHAR('_') || \ + (c) == XP_LISP_CHAR('?')) #define TOKEN_CLEAR(lsp) xp_lisp_token_clear (lsp->token) #define TOKEN_TYPE(lsp) lsp->token->type @@ -27,7 +27,7 @@ #define TOKEN_ADD_CHAR(lsp,ch) \ do { \ if (xp_lisp_token_addc (lsp->token, ch) == -1) { \ - lsp->error = RBL_ERR_MEM; \ + lsp->error = XP_LISP_ERR_MEM; \ return -1; \ } \ } while (0) @@ -66,7 +66,7 @@ static int read_string (xp_lisp_t* lsp); #define NEXT_CHAR(lsp) \ do { \ if (lsp->creader (&lsp->curc, lsp->creader_extra) == -1) { \ - lsp->error = RBL_ERR_READ; \ + lsp->error = XP_LISP_ERR_READ; \ return -1; \ } \ } while (0) @@ -93,13 +93,13 @@ xp_lisp_obj_t* xp_lisp_read (xp_lisp_t* lsp) if (lsp->creader_just_set) { // NEXT_CHAR (lsp); if (lsp->creader (&lsp->curc, lsp->creader_extra) == -1) { - lsp->error = RBL_ERR_READ; + lsp->error = XP_LISP_ERR_READ; return XP_NULL; } lsp->creader_just_set = 0; } - lsp->error = RBL_ERR_NONE; + lsp->error = XP_LISP_ERR_NONE; NEXT_TOKEN (lsp); if (lsp->mem->locked != XP_NULL) { @@ -116,7 +116,7 @@ static xp_lisp_obj_t* read_obj (xp_lisp_t* lsp) switch (TOKEN_TYPE(lsp)) { case TOKEN_END: - lsp->error = RBL_ERR_END; + lsp->error = XP_LISP_ERR_END; return XP_NULL; case TOKEN_LPAREN: NEXT_TOKEN (lsp); @@ -126,34 +126,34 @@ static xp_lisp_obj_t* read_obj (xp_lisp_t* lsp) return read_quote (lsp); case TOKEN_INT: obj = xp_lisp_make_int (lsp->mem, TOKEN_IVALUE(lsp)); - if (obj == XP_NULL) lsp->error = RBL_ERR_MEM; + if (obj == XP_NULL) lsp->error = XP_LISP_ERR_MEM; xp_lisp_lock (obj); return obj; case TOKEN_FLOAT: obj = xp_lisp_make_float (lsp->mem, TOKEN_FVALUE(lsp)); - if (obj == XP_NULL) lsp->error = RBL_ERR_MEM; + if (obj == XP_NULL) lsp->error = XP_LISP_ERR_MEM; xp_lisp_lock (obj); return obj; case TOKEN_STRING: obj = xp_lisp_make_string ( lsp->mem, TOKEN_SVALUE(lsp), TOKEN_SLENGTH(lsp)); - if (obj == XP_NULL) lsp->error = RBL_ERR_MEM; + if (obj == XP_NULL) lsp->error = XP_LISP_ERR_MEM; xp_lisp_lock (obj); return obj; case TOKEN_IDENT: xp_lisp_assert (lsp->mem->nil != XP_NULL && lsp->mem->t != XP_NULL); - if (TOKEN_COMPARE(lsp, RBL_TEXT("nil")) == 0) obj = lsp->mem->nil; - else if (TOKEN_COMPARE(lsp, RBL_TEXT("t")) == 0) obj = lsp->mem->t; + if (TOKEN_COMPARE(lsp, XP_LISP_TEXT("nil")) == 0) obj = lsp->mem->nil; + else if (TOKEN_COMPARE(lsp, XP_LISP_TEXT("t")) == 0) obj = lsp->mem->t; else { obj = xp_lisp_make_symbol ( lsp->mem, TOKEN_SVALUE(lsp), TOKEN_SLENGTH(lsp)); - if (obj == XP_NULL) lsp->error = RBL_ERR_MEM; + if (obj == XP_NULL) lsp->error = XP_LISP_ERR_MEM; xp_lisp_lock (obj); } return obj; } - lsp->error = RBL_ERR_SYNTAX; + lsp->error = XP_LISP_ERR_SYNTAX; return XP_NULL; } @@ -164,22 +164,22 @@ static xp_lisp_obj_t* read_list (xp_lisp_t* lsp) while (TOKEN_TYPE(lsp) != TOKEN_RPAREN) { if (TOKEN_TYPE(lsp) == TOKEN_END) { - lsp->error = RBL_ERR_SYNTAX; // unexpected end of input + lsp->error = XP_LISP_ERR_SYNTAX; // unexpected end of input return XP_NULL; } if (TOKEN_TYPE(lsp) == TOKEN_DOT) { if (prev == XP_NULL) { - lsp->error = RBL_ERR_SYNTAX; // unexpected . + lsp->error = XP_LISP_ERR_SYNTAX; // unexpected . return XP_NULL; } NEXT_TOKEN (lsp); obj = read_obj (lsp); if (obj == XP_NULL) { - if (lsp->error == RBL_ERR_END) { + if (lsp->error == XP_LISP_ERR_END) { //unexpected end of input - lsp->error = RBL_ERR_SYNTAX; + lsp->error = XP_LISP_ERR_SYNTAX; } return XP_NULL; } @@ -187,7 +187,7 @@ static xp_lisp_obj_t* read_list (xp_lisp_t* lsp) NEXT_TOKEN (lsp); if (TOKEN_TYPE(lsp) != TOKEN_RPAREN) { - lsp->error = RBL_ERR_SYNTAX; // ) expected + lsp->error = XP_LISP_ERR_SYNTAX; // ) expected return XP_NULL; } @@ -196,9 +196,9 @@ static xp_lisp_obj_t* read_list (xp_lisp_t* lsp) obj = read_obj (lsp); if (obj == XP_NULL) { - if (lsp->error == RBL_ERR_END) { + if (lsp->error == XP_LISP_ERR_END) { // unexpected end of input - lsp->error = RBL_ERR_SYNTAX; + lsp->error = XP_LISP_ERR_SYNTAX; } return XP_NULL; } @@ -206,7 +206,7 @@ static xp_lisp_obj_t* read_list (xp_lisp_t* lsp) p = (xp_lisp_obj_cons_t*)xp_lisp_make_cons ( lsp->mem, lsp->mem->nil, lsp->mem->nil); if (p == XP_NULL) { - lsp->error = RBL_ERR_MEM; + lsp->error = XP_LISP_ERR_MEM; return XP_NULL; } xp_lisp_lock ((xp_lisp_obj_t*)p); @@ -229,23 +229,23 @@ static xp_lisp_obj_t* read_quote (xp_lisp_t* lsp) tmp = read_obj (lsp); if (tmp == XP_NULL) { - if (lsp->error == RBL_ERR_END) { + if (lsp->error == XP_LISP_ERR_END) { // unexpected end of input - lsp->error = RBL_ERR_SYNTAX; + lsp->error = XP_LISP_ERR_SYNTAX; } return XP_NULL; } cons = xp_lisp_make_cons (lsp->mem, tmp, lsp->mem->nil); if (cons == XP_NULL) { - lsp->error = RBL_ERR_MEM; + lsp->error = XP_LISP_ERR_MEM; return XP_NULL; } xp_lisp_lock (cons); cons = xp_lisp_make_cons (lsp->mem, lsp->mem->quote, cons); if (cons == XP_NULL) { - lsp->error = RBL_ERR_MEM; + lsp->error = XP_LISP_ERR_MEM; return XP_NULL; } xp_lisp_lock (cons); @@ -264,43 +264,43 @@ static int read_token (xp_lisp_t* lsp) while (IS_SPACE(lsp->curc)) NEXT_CHAR (lsp); // skip the comments here - if (lsp->curc == RBL_CHAR(';')) { + if (lsp->curc == XP_LISP_CHAR(';')) { do { NEXT_CHAR (lsp); - } while (lsp->curc != RBL_CHAR('\n') && lsp->curc != RBL_CHAR_END); + } while (lsp->curc != XP_LISP_CHAR('\n') && lsp->curc != XP_LISP_CHAR_END); } else break; } - if (lsp->curc == RBL_CHAR_END) { + if (lsp->curc == XP_LISP_CHAR_END) { TOKEN_TYPE(lsp) = TOKEN_END; return 0; } - else if (lsp->curc == RBL_CHAR('(')) { + else if (lsp->curc == XP_LISP_CHAR('(')) { TOKEN_ADD_CHAR (lsp, lsp->curc); TOKEN_TYPE(lsp) = TOKEN_LPAREN; NEXT_CHAR (lsp); return 0; } - else if (lsp->curc == RBL_CHAR(')')) { + else if (lsp->curc == XP_LISP_CHAR(')')) { TOKEN_ADD_CHAR (lsp, lsp->curc); TOKEN_TYPE(lsp) = TOKEN_RPAREN; NEXT_CHAR (lsp); return 0; } - else if (lsp->curc == RBL_CHAR('\'')) { + else if (lsp->curc == XP_LISP_CHAR('\'')) { TOKEN_ADD_CHAR (lsp, lsp->curc); TOKEN_TYPE(lsp) = TOKEN_QUOTE; NEXT_CHAR (lsp); return 0; } - else if (lsp->curc == RBL_CHAR('.')) { + else if (lsp->curc == XP_LISP_CHAR('.')) { TOKEN_ADD_CHAR (lsp, lsp->curc); TOKEN_TYPE(lsp) = TOKEN_DOT; NEXT_CHAR (lsp); return 0; } - else if (lsp->curc == RBL_CHAR('-')) { + else if (lsp->curc == XP_LISP_CHAR('-')) { TOKEN_ADD_CHAR (lsp, lsp->curc); NEXT_CHAR (lsp); return (IS_DIGIT(lsp->curc))? @@ -312,7 +312,7 @@ static int read_token (xp_lisp_t* lsp) else if (IS_ALPHA(lsp->curc) || IS_IDENT(lsp->curc)) { return read_ident (lsp); } - else if (lsp->curc == RBL_CHAR('\"')) { + else if (lsp->curc == XP_LISP_CHAR('\"')) { NEXT_CHAR (lsp); return read_string (lsp); } @@ -326,7 +326,7 @@ static int read_number (xp_lisp_t* lsp, int negative) { do { TOKEN_IVALUE(lsp) = - TOKEN_IVALUE(lsp) * 10 + lsp->curc - RBL_CHAR('0'); + TOKEN_IVALUE(lsp) * 10 + lsp->curc - XP_LISP_CHAR('0'); TOKEN_ADD_CHAR (lsp, lsp->curc); NEXT_CHAR (lsp); } while (IS_DIGIT(lsp->curc)); @@ -355,7 +355,7 @@ static int read_string (xp_lisp_t* lsp) xp_lisp_cint code = 0; do { - if (lsp->curc == RBL_CHAR_END) { + if (lsp->curc == XP_LISP_CHAR_END) { TOKEN_TYPE(lsp) = TOKEN_UNTERM_STRING; return 0; } @@ -369,34 +369,34 @@ static int read_string (xp_lisp_t* lsp) } else if (escaped == 1) { /* backslash + character */ - if (lsp->curc == RBL_CHAR('a')) - lsp->curc = RBL_CHAR('\a'); - else if (lsp->curc == RBL_CHAR('b')) - lsp->curc = RBL_CHAR('\b'); - else if (lsp->curc == RBL_CHAR('f')) - lsp->curc = RBL_CHAR('\f'); - else if (lsp->curc == RBL_CHAR('n')) - lsp->curc = RBL_CHAR('\n'); - else if (lsp->curc == RBL_CHAR('r')) - lsp->curc = RBL_CHAR('\r'); - else if (lsp->curc == RBL_CHAR('t')) - lsp->curc = RBL_CHAR('\t'); - else if (lsp->curc == RBL_CHAR('v')) - lsp->curc = RBL_CHAR('\v'); - else if (lsp->curc == RBL_CHAR('0')) { + if (lsp->curc == XP_LISP_CHAR('a')) + lsp->curc = XP_LISP_CHAR('\a'); + else if (lsp->curc == XP_LISP_CHAR('b')) + lsp->curc = XP_LISP_CHAR('\b'); + else if (lsp->curc == XP_LISP_CHAR('f')) + lsp->curc = XP_LISP_CHAR('\f'); + else if (lsp->curc == XP_LISP_CHAR('n')) + lsp->curc = XP_LISP_CHAR('\n'); + else if (lsp->curc == XP_LISP_CHAR('r')) + lsp->curc = XP_LISP_CHAR('\r'); + else if (lsp->curc == XP_LISP_CHAR('t')) + lsp->curc = XP_LISP_CHAR('\t'); + else if (lsp->curc == XP_LISP_CHAR('v')) + lsp->curc = XP_LISP_CHAR('\v'); + else if (lsp->curc == XP_LISP_CHAR('0')) { escaped = 2; code = 0; NEXT_CHAR (lsp); continue; } - else if (lsp->curc == RBL_CHAR('x')) { + else if (lsp->curc == XP_LISP_CHAR('x')) { escaped = 3; code = 0; NEXT_CHAR (lsp); continue; } } - else if (lsp->curc == RBL_CHAR('\\')) { + else if (lsp->curc == XP_LISP_CHAR('\\')) { escaped = 1; NEXT_CHAR (lsp); continue; @@ -404,7 +404,7 @@ static int read_string (xp_lisp_t* lsp) TOKEN_ADD_CHAR (lsp, lsp->curc); NEXT_CHAR (lsp); - } while (lsp->curc != RBL_CHAR('\"')); + } while (lsp->curc != XP_LISP_CHAR('\"')); TOKEN_TYPE(lsp) = TOKEN_STRING; NEXT_CHAR (lsp); diff --git a/ase/lsp/token.c b/ase/lsp/token.c index cd351f88..7e130c42 100644 --- a/ase/lsp/token.c +++ b/ase/lsp/token.c @@ -1,5 +1,5 @@ /* - * $Id: token.c,v 1.1 2005-02-04 15:39:11 bacon Exp $ + * $Id: token.c,v 1.2 2005-02-04 16:00:37 bacon Exp $ */ #include "token.h" @@ -25,7 +25,7 @@ xp_lisp_token_t* xp_lisp_token_new (xp_size_t capacity) token->size = 0; token->capacity = capacity; - token->buffer[0] = RBL_CHAR('\0'); + token->buffer[0] = XP_LISP_CHAR('\0'); return token; } @@ -48,7 +48,7 @@ int xp_lisp_token_addc (xp_lisp_token_t* token, xp_lisp_cint c) } token->buffer[token->size++] = c; - token->buffer[token->size] = RBL_CHAR('\0'); + token->buffer[token->size] = XP_LISP_CHAR('\0'); return 0; } @@ -58,7 +58,7 @@ void xp_lisp_token_clear (xp_lisp_token_t* token) token->fvalue = .0; token->size = 0; - token->buffer[0] = RBL_CHAR('\0'); + token->buffer[0] = XP_LISP_CHAR('\0'); } xp_lisp_char* xp_lisp_token_transfer (xp_lisp_token_t* token, xp_size_t capacity) @@ -72,7 +72,7 @@ xp_lisp_char* xp_lisp_token_transfer (xp_lisp_token_t* token, xp_size_t capacity token->buffer = new_buffer; token->size = 0; token->capacity = capacity; - token->buffer[0] = RBL_CHAR('\0'); + token->buffer[0] = XP_LISP_CHAR('\0'); return old_buffer; } @@ -88,5 +88,5 @@ int xp_lisp_token_compare (xp_lisp_token_t* token, const xp_lisp_char* str) index++; p++; str++; } - return (*str == RBL_CHAR('\0'))? 0: -1; + return (*str == XP_LISP_CHAR('\0'))? 0: -1; } diff --git a/ase/lsp/token.h b/ase/lsp/token.h index 4b916fce..d03ccb09 100644 --- a/ase/lsp/token.h +++ b/ase/lsp/token.h @@ -1,9 +1,9 @@ /* - * $Id: token.h,v 1.1 2005-02-04 15:39:11 bacon Exp $ + * $Id: token.h,v 1.2 2005-02-04 16:00:37 bacon Exp $ */ -#ifndef _RBL_TOKEN_H_ -#define _RBL_TOKEN_H_ +#ifndef _XP_LISP_TOKEN_H_ +#define _XP_LISP_TOKEN_H_ #include "types.h"