hyung-hwan/qse
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

*** empty log message ***

Browse Source
This commit is contained in:
hyung-hwan 2005-02-04 16:00:37 +00:00
parent dbc3c255e6
commit ce62271756
17 changed files with 626 additions and 624 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
ase/lsp/array.c
View File

@ -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 <xp/lisp/array.h>
#include <stdlib.h> #include <xp/c/stdlib.h>
#include <assert.h> #include <xp/c/assert.h>
xp_lisp_array_t* xp_lisp_array_new (xp_size_t capacity) xp_lisp_array_t* xp_lisp_array_new (xp_size_t capacity)
{ {
xp_lisp_array_t* array; xp_lisp_array_t* array;
assert (capacity > 0); xp_assert (capacity > 0);
array = (xp_lisp_array_t*)malloc (sizeof(xp_lisp_array_t)); array = (xp_lisp_array_t*)malloc (sizeof(xp_lisp_array_t));
if (array == XP_NULL) return XP_NULL; 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) while (array->size > 0)
free (array->buffer[--array->size]); free (array->buffer[--array->size]);
assert (array->size == 0); xp_assert (array->size == 0);
free (array->buffer); free (array->buffer);
free (array); 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) 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) while (array->size > 0)
free (array->buffer[--array->size]); free (array->buffer[--array->size]);
assert (array->size == 0); xp_assert (array->size == 0);
array->buffer[0] = XP_NULL; array->buffer[0] = XP_NULL;
} }

22
ase/lsp/array.h
View File

@ -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_ #ifndef _XP_LISP_ARRAY_H_
#define _RBL_ARRAY_H_ #define _XP_LISP_ARRAY_H_
#include <rb/types.h> #include <xp/types.h>
struct xp_lisp_array_t { struct xp_lisp_array_t {
void** buffer; void** buffer;
@ -19,13 +19,13 @@ typedef struct xp_lisp_array_t xp_lisp_array_t;
extern "C" { extern "C" {
#endif #endif
xp_lisp_array_t* xp_lisp_array_new (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); 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_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); 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_delete (xp_lisp_array_t* array, xp_size_t index);
void xp_lisp_array_clear (xp_lisp_array_t* array); void xp_lisp_array_clear (xp_lisp_array_t* array);
void** xp_lisp_array_transfer (xp_lisp_array_t* array, xp_size_t capacity); void** xp_lisp_array_transfer (xp_lisp_array_t* array, xp_size_t capacity);
#ifdef __cplusplus #ifdef __cplusplus
} }

8
ase/lsp/env.c
View File

@ -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 <xp/lisp/env.h>
#include <xp/c/stdlib.h> #include <xp/c/stdlib.h>
xp_lisp_assoc_t* xp_lisp_assoc_new (xp_lisp_obj_t* name, xp_lisp_obj_t* value) 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_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; assoc = frame->assoc;
while (assoc != XP_NULL) { while (assoc != XP_NULL) {
@ -71,7 +71,7 @@ xp_lisp_assoc_t* xp_lisp_frame_insert (
{ {
xp_lisp_assoc_t* assoc; 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); assoc = xp_lisp_assoc_new (name, value);
if (assoc == XP_NULL) return XP_NULL; if (assoc == XP_NULL) return XP_NULL;

8
ase/lsp/env.h
View File

@ -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_ #ifndef _XP_LISP_ENV_H_
#define _RBL_ENV_H_ #define _XP_LISP_ENV_H_
#include "object.h" #include <xp/lisp/object.h>
struct xp_lisp_assoc_t struct xp_lisp_assoc_t
{ {

122
ase/lsp/eval.c
View File

@ -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 <xp/lisp/lisp.h>
#include "env.h" #include <xp/lisp/env.h>
#include "prim.h" #include <xp/lisp/primitive.h>
#ifdef __cplusplus #ifdef __cplusplus
extern "C" { 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) 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); 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; xp_lisp_assoc_t* assoc;
/* /*
if (obj == lsp->mem->lambda || obj == lsp->mem->macro) { if (obj == lsp->mem->lambda || obj == lsp->mem->macro) {
printf ("lambda or macro can't be used as a normal symbol\n"); 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; return XP_NULL;
} }
*/ */
if ((assoc = xp_lisp_lookup (lsp->mem, obj)) == XP_NULL) { if ((assoc = xp_lisp_lookup (lsp->mem, obj)) == XP_NULL) {
if (lsp->opt_undef_symbol) { if (lsp->opt_undef_symbol) {
lsp->error = RBL_ERR_UNDEF_SYMBOL; lsp->error = XP_LISP_ERR_UNDEF_SYMBOL;
return XP_NULL; return XP_NULL;
} }
return lsp->mem->nil; 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"); printf ("about to create a function or a macro ....\n");
if (cdr == lsp->mem->nil) { if (cdr == lsp->mem->nil) {
lsp->error = RBL_ERR_TOO_FEW_ARGS; lsp->error = XP_LISP_ERR_TOO_FEW_ARGS;
return XP_NULL; return XP_NULL;
} }
if (RBL_TYPE(cdr) != RBL_OBJ_CONS) { if (XP_LISP_TYPE(cdr) != XP_LISP_OBJ_CONS) {
lsp->error = RBL_ERR_BAD_ARG; lsp->error = XP_LISP_ERR_BAD_ARG;
return XP_NULL; return XP_NULL;
} }
formal = RBL_CAR(cdr); formal = XP_LISP_CAR(cdr);
body = RBL_CDR(cdr); body = XP_LISP_CDR(cdr);
if (body == lsp->mem->nil) { if (body == lsp->mem->nil) {
lsp->error = RBL_ERR_EMPTY_BODY; lsp->error = XP_LISP_ERR_EMPTY_BODY;
return XP_NULL; 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_macro (lsp->mem, formal, body):
xp_lisp_make_func (lsp->mem, formal, body); xp_lisp_make_func (lsp->mem, formal, body);
if (func == XP_NULL) { if (func == XP_NULL) {
lsp->error = RBL_ERR_MEM; lsp->error = XP_LISP_ERR_MEM;
return XP_NULL; 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_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); car = XP_LISP_CAR(cons);
cdr = RBL_CDR(cons); cdr = XP_LISP_CDR(cons);
if (car == lsp->mem->lambda) { if (car == lsp->mem->lambda) {
return make_func (lsp, cdr, 0); 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) { else if (car == lsp->mem->macro) {
return make_func (lsp, cdr, 1); 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; xp_lisp_assoc_t* assoc;
if ((assoc = xp_lisp_lookup (lsp->mem, car)) != XP_NULL) { if ((assoc = xp_lisp_lookup (lsp->mem, car)) != XP_NULL) {
xp_lisp_obj_t* func = assoc->value; xp_lisp_obj_t* func = assoc->value;
if (RBL_TYPE(func) == RBL_OBJ_FUNC || if (XP_LISP_TYPE(func) == XP_LISP_OBJ_FUNC ||
RBL_TYPE(func) == RBL_OBJ_MACRO) { XP_LISP_TYPE(func) == XP_LISP_OBJ_MACRO) {
return apply (lsp, func, cdr); 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 // primitive function
return RBL_PIMPL(func) (lsp, cdr); return XP_LISP_PIMPL(func) (lsp, cdr);
} }
else { else {
printf ("undefined function: "); printf ("undefined function: ");
xp_lisp_print (lsp, car); xp_lisp_print (lsp, car);
printf ("\n"); printf ("\n");
lsp->error = RBL_ERR_UNDEF_FUNC; lsp->error = XP_LISP_ERR_UNDEF_FUNC;
return XP_NULL; 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: "); printf ("undefined function: ");
xp_lisp_print (lsp, car); xp_lisp_print (lsp, car);
printf ("\n"); printf ("\n");
lsp->error = RBL_ERR_UNDEF_FUNC; lsp->error = XP_LISP_ERR_UNDEF_FUNC;
return XP_NULL; return XP_NULL;
} }
} }
else if (RBL_TYPE(car) == RBL_OBJ_FUNC || else if (XP_LISP_TYPE(car) == XP_LISP_OBJ_FUNC ||
RBL_TYPE(car) == RBL_OBJ_MACRO) { XP_LISP_TYPE(car) == XP_LISP_OBJ_MACRO) {
return apply (lsp, car, cdr); return apply (lsp, car, cdr);
} }
else if (RBL_TYPE(car) == RBL_OBJ_CONS) { else if (XP_LISP_TYPE(car) == XP_LISP_OBJ_CONS) {
if (RBL_CAR(car) == lsp->mem->lambda) { if (XP_LISP_CAR(car) == lsp->mem->lambda) {
xp_lisp_obj_t* func = make_func (lsp, RBL_CDR(car), 0); xp_lisp_obj_t* func = make_func (lsp, XP_LISP_CDR(car), 0);
if (func == XP_NULL) return XP_NULL; if (func == XP_NULL) return XP_NULL;
return apply (lsp, func, cdr); return apply (lsp, func, cdr);
} }
else if (RBL_CAR(car) == lsp->mem->macro) { else if (XP_LISP_CAR(car) == lsp->mem->macro) {
xp_lisp_obj_t* func = make_func (lsp, RBL_CDR(car), 1); xp_lisp_obj_t* func = make_func (lsp, XP_LISP_CDR(car), 1);
if (func == XP_NULL) return XP_NULL; if (func == XP_NULL) return XP_NULL;
return apply (lsp, func, cdr); return apply (lsp, func, cdr);
} }
} }
rb_printf (RBL_TEXT("bad function: ")); xp_printf (XP_LISP_TEXT("bad function: "));
xp_lisp_print (lsp, car); xp_lisp_print (lsp, car);
rb_printf (RBL_TEXT("\n")); xp_printf (XP_LISP_TEXT("\n"));
lsp->error = RBL_ERR_BAD_FUNC; lsp->error = XP_LISP_ERR_BAD_FUNC;
return XP_NULL; 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_mem_t* mem;
xp_lisp_assert ( xp_lisp_assert (
RBL_TYPE(func) == RBL_OBJ_FUNC || XP_LISP_TYPE(func) == XP_LISP_OBJ_FUNC ||
RBL_TYPE(func) == RBL_OBJ_MACRO); 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; mem = lsp->mem;
if (RBL_TYPE(func) == RBL_OBJ_MACRO) { if (XP_LISP_TYPE(func) == XP_LISP_OBJ_MACRO) {
formal = RBL_MFORMAL (func); formal = XP_LISP_MFORMAL (func);
body = RBL_MBODY (func); body = XP_LISP_MBODY (func);
} }
else { else {
formal = RBL_FFORMAL (func); formal = XP_LISP_FFORMAL (func);
body = RBL_FBODY (func); body = XP_LISP_FBODY (func);
} }
// make a new frame. // make a new frame.
frame = xp_lisp_frame_new (); frame = xp_lisp_frame_new ();
if (frame == XP_NULL) { if (frame == XP_NULL) {
lsp->error = RBL_ERR_MEM; lsp->error = XP_LISP_ERR_MEM;
return XP_NULL; 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. // evaluate arguments and push them into the frame.
while (formal != mem->nil) { while (formal != mem->nil) {
if (actual == 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; mem->brooding_frame = frame->link;
xp_lisp_frame_free (frame); xp_lisp_frame_free (frame);
return XP_NULL; return XP_NULL;
} }
value = RBL_CAR(actual); value = XP_LISP_CAR(actual);
if (RBL_TYPE(func) != RBL_OBJ_MACRO) { if (XP_LISP_TYPE(func) != XP_LISP_OBJ_MACRO) {
// macro doesn't evaluate actual arguments. // macro doesn't evaluate actual arguments.
value = xp_lisp_eval (lsp, value); value = xp_lisp_eval (lsp, value);
if (value == XP_NULL) { 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) { if (xp_lisp_frame_lookup (frame, XP_LISP_CAR(formal)) != XP_NULL) {
lsp->error = RBL_ERR_DUP_FORMAL; lsp->error = XP_LISP_ERR_DUP_FORMAL;
mem->brooding_frame = frame->link; mem->brooding_frame = frame->link;
xp_lisp_frame_free (frame); xp_lisp_frame_free (frame);
return XP_NULL; return XP_NULL;
} }
if (xp_lisp_frame_insert (frame, RBL_CAR(formal), value) == XP_NULL) { if (xp_lisp_frame_insert (frame, XP_LISP_CAR(formal), value) == XP_NULL) {
lsp->error = RBL_ERR_MEM; lsp->error = XP_LISP_ERR_MEM;
mem->brooding_frame = frame->link; mem->brooding_frame = frame->link;
xp_lisp_frame_free (frame); xp_lisp_frame_free (frame);
return XP_NULL; return XP_NULL;
} }
actual = RBL_CDR(actual); actual = XP_LISP_CDR(actual);
formal = RBL_CDR(formal); formal = XP_LISP_CDR(formal);
} }
if (RBL_TYPE(actual) == RBL_OBJ_CONS) { if (XP_LISP_TYPE(actual) == XP_LISP_OBJ_CONS) {
lsp->error = RBL_ERR_TOO_MANY_ARGS; lsp->error = XP_LISP_ERR_TOO_MANY_ARGS;
mem->brooding_frame = frame->link; mem->brooding_frame = frame->link;
xp_lisp_frame_free (frame); xp_lisp_frame_free (frame);
return XP_NULL; return XP_NULL;
} }
else if (actual != mem->nil) { else if (actual != mem->nil) {
lsp->error = RBL_ERR_BAD_ARG; lsp->error = XP_LISP_ERR_BAD_ARG;
mem->brooding_frame = frame->link; mem->brooding_frame = frame->link;
xp_lisp_frame_free (frame); xp_lisp_frame_free (frame);
return XP_NULL; 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 // do the evaluation of the body
value = mem->nil; value = mem->nil;
while (body != 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) { if (value == XP_NULL) {
mem->frame = frame->link; mem->frame = frame->link;
xp_lisp_frame_free (frame); xp_lisp_frame_free (frame);
return XP_NULL; return XP_NULL;
} }
body = RBL_CDR(body); body = XP_LISP_CDR(body);
} }
// pop the frame. // 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. // destroy the frame.
xp_lisp_frame_free (frame); xp_lisp_frame_free (frame);
//if (RBL_CAR(func) == mem->macro) { //if (XP_LISP_CAR(func) == mem->macro) {
if (RBL_TYPE(func) == RBL_OBJ_MACRO) { if (XP_LISP_TYPE(func) == XP_LISP_OBJ_MACRO) {
value = xp_lisp_eval(lsp, value); value = xp_lisp_eval(lsp, value);
if (value == XP_NULL) return XP_NULL; if (value == XP_NULL) return XP_NULL;
} }

16
ase/lsp/lisp.c
View File

@ -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 <xp/lisp/lisp.h>
#include <stdlib.h> #include <xp/c/stdlib.h>
xp_lisp_t* xp_lisp_new (xp_size_t mem_ubound, xp_size_t mem_ubound_inc) xp_lisp_t* xp_lisp_new (xp_size_t mem_ubound, xp_size_t mem_ubound_inc)
{ {
xp_lisp_t* lsp; 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; if (lsp == XP_NULL) return lsp;
lsp->token = xp_lisp_token_new (256); lsp->token = xp_lisp_token_new (256);
if (lsp->token == XP_NULL) { if (lsp->token == XP_NULL) {
free (lsp); xp_free (lsp);
return XP_NULL; return XP_NULL;
} }
lsp->error = RBL_ERR_NONE; lsp->error = XP_LISP_ERR_NONE;
//lsp->opt_undef_symbol = 1; //lsp->opt_undef_symbol = 1;
lsp->opt_undef_symbol = 0; lsp->opt_undef_symbol = 0;
lsp->curc = RBL_CHAR_END; lsp->curc = XP_LISP_CHAR_END;
lsp->creader = XP_NULL; lsp->creader = XP_NULL;
lsp->creader_extra = XP_NULL; lsp->creader_extra = XP_NULL;
lsp->creader_just_set = 0; lsp->creader_just_set = 0;
lsp->outstream = stdout; lsp->outstream = xp_stdout;
lsp->mem = xp_lisp_mem_new (mem_ubound, mem_ubound_inc); lsp->mem = xp_lisp_mem_new (mem_ubound, mem_ubound_inc);
if (lsp->mem == XP_NULL) { if (lsp->mem == XP_NULL) {

58
ase/lsp/lisp.h
View File

@ -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_ #ifndef _XP_LISP_LISP_H_
#define _RBL_LISP_H_ #define _XP_LISP_LISP_H_
#include <xp/lisp/types.h> #include <xp/lisp/types.h>
#include <xp/lisp/token.h> #include <xp/lisp/token.h>
#include <xp/lisp/object.h> #include <xp/lisp/object.h>
#include <xp/lisp/memory.h> #include <xp/lisp/memory.h>
#include <xp/c/stdio.h> // TODO: may have to remove dependency on stdio?
// NOTICE: the function of xp_lisp_creader_t must return -1 on error // NOTICE: the function of xp_lisp_creader_t must return -1 on error
// and 0 on success. the first argument must be set to // 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*); typedef int (*xp_lisp_creader_t) (xp_lisp_cint*, void*);
#define RBL_ERR(lsp) ((lsp)->error) #define XP_LISP_ERR(lsp) ((lsp)->error)
#define RBL_ERR_NONE 0 #define XP_LISP_ERR_NONE 0
#define RBL_ERR_ABORT 1 #define XP_LISP_ERR_ABORT 1
#define RBL_ERR_END 2 #define XP_LISP_ERR_END 2
#define RBL_ERR_MEM 3 #define XP_LISP_ERR_MEM 3
#define RBL_ERR_READ 4 #define XP_LISP_ERR_READ 4
#define RBL_ERR_SYNTAX 5 #define XP_LISP_ERR_SYNTAX 5
#define RBL_ERR_BAD_ARG 6 #define XP_LISP_ERR_BAD_ARG 6
#define RBL_ERR_WRONG_ARG 7 #define XP_LISP_ERR_WRONG_ARG 7
#define RBL_ERR_TOO_FEW_ARGS 8 #define XP_LISP_ERR_TOO_FEW_ARGS 8
#define RBL_ERR_TOO_MANY_ARGS 9 #define XP_LISP_ERR_TOO_MANY_ARGS 9
#define RBL_ERR_UNDEF_FUNC 10 #define XP_LISP_ERR_UNDEF_FUNC 10
#define RBL_ERR_BAD_FUNC 11 #define XP_LISP_ERR_BAD_FUNC 11
#define RBL_ERR_DUP_FORMAL 12 #define XP_LISP_ERR_DUP_FORMAL 12
#define RBL_ERR_BAD_SYMBOL 13 #define XP_LISP_ERR_BAD_SYMBOL 13
#define RBL_ERR_UNDEF_SYMBOL 14 #define XP_LISP_ERR_UNDEF_SYMBOL 14
#define RBL_ERR_EMPTY_BODY 15 #define XP_LISP_ERR_EMPTY_BODY 15
#define RBL_ERR_BAD_VALUE 16 #define XP_LISP_ERR_BAD_VALUE 16
struct xp_lisp_t struct xp_lisp_t
{ {
@ -41,10 +43,10 @@ struct xp_lisp_t
int opt_undef_symbol; int opt_undef_symbol;
/* for read */ /* for read */
xp_lisp_cint curc; xp_lisp_cint curc;
xp_lisp_creader_t creader; xp_lisp_creader_t creader;
void* creader_extra; void* creader_extra;
int creader_just_set; int creader_just_set;
xp_lisp_token_t* token; xp_lisp_token_t* token;
/* for eval */ /* for eval */
@ -52,10 +54,10 @@ struct xp_lisp_t
xp_size_t eval_depth; xp_size_t eval_depth;
/* for print */ /* for print */
FILE* outstream; XP_FILE* outstream;
/* memory manager */ /* memory manager */
xp_lisp_mem_t* mem; xp_lisp_mem_t* mem;
}; };
typedef struct xp_lisp_t xp_lisp_t; typedef struct xp_lisp_t xp_lisp_t;

2
ase/lsp/makefile.in
View File

@ -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) OBJS = $(SRCS:.c=.o)
OUT = libxplisp.a OUT = libxplisp.a

236
ase/lsp/memory.c
View File

@ -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 <xp/lisp/memory.h> #include <xp/lisp/memory.h>
@ -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 = ubound;
mem->ubound_inc = ubound_inc; mem->ubound_inc = ubound_inc;
mem->count = 0; 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->used[i] = XP_NULL;
mem->free[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 // initialize common object pointers
mem->nil = xp_lisp_make_nil (mem); mem->nil = xp_lisp_make_nil (mem);
mem->t = xp_lisp_make_true (mem); mem->t = xp_lisp_make_true (mem);
mem->quote = xp_lisp_make_symbol (mem, RBL_TEXT("quote"), 5); mem->quote = xp_lisp_make_symbol (mem, XP_LISP_TEXT("quote"), 5);
mem->lambda = xp_lisp_make_symbol (mem, RBL_TEXT("lambda"), 6); mem->lambda = xp_lisp_make_symbol (mem, XP_LISP_TEXT("lambda"), 6);
mem->macro = xp_lisp_make_symbol (mem, RBL_TEXT("macro"), 5); mem->macro = xp_lisp_make_symbol (mem, XP_LISP_TEXT("macro"), 5);
if (mem->nil == XP_NULL || if (mem->nil == XP_NULL ||
mem->t == 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) \ #define ADD_PRIM(mem,name,len,prim) \
if (xp_lisp_add_prim(mem,name,len,prim) == -1) return -1; 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, XP_TEXT("abort"), 5, xp_lisp_prim_abort);
ADD_PRIM (mem, RB_TEXT("eval"), 4, xp_lisp_prim_eval); ADD_PRIM (mem, XP_TEXT("eval"), 4, xp_lisp_prim_eval);
ADD_PRIM (mem, RB_TEXT("prog1"), 5, xp_lisp_prim_prog1); ADD_PRIM (mem, XP_TEXT("prog1"), 5, xp_lisp_prim_prog1);
ADD_PRIM (mem, RB_TEXT("progn"), 5, xp_lisp_prim_progn); ADD_PRIM (mem, XP_TEXT("progn"), 5, xp_lisp_prim_progn);
ADD_PRIM (mem, RB_TEXT("gc"), 2, xp_lisp_prim_gc); 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, XP_TEXT("cond"), 4, xp_lisp_prim_cond);
ADD_PRIM (mem, RB_TEXT("if"), 2, xp_lisp_prim_if); ADD_PRIM (mem, XP_TEXT("if"), 2, xp_lisp_prim_if);
ADD_PRIM (mem, RB_TEXT("while"), 5, xp_lisp_prim_while); 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, XP_TEXT("car"), 3, xp_lisp_prim_car);
ADD_PRIM (mem, RB_TEXT("cdr"), 3, xp_lisp_prim_cdr); ADD_PRIM (mem, XP_TEXT("cdr"), 3, xp_lisp_prim_cdr);
ADD_PRIM (mem, RB_TEXT("cons"), 4, xp_lisp_prim_cons); ADD_PRIM (mem, XP_TEXT("cons"), 4, xp_lisp_prim_cons);
ADD_PRIM (mem, RB_TEXT("set"), 3, xp_lisp_prim_set); ADD_PRIM (mem, XP_TEXT("set"), 3, xp_lisp_prim_set);
ADD_PRIM (mem, RB_TEXT("setq"), 4, xp_lisp_prim_setq); ADD_PRIM (mem, XP_TEXT("setq"), 4, xp_lisp_prim_setq);
ADD_PRIM (mem, RB_TEXT("quote"), 5, xp_lisp_prim_quote); ADD_PRIM (mem, XP_TEXT("quote"), 5, xp_lisp_prim_quote);
ADD_PRIM (mem, RB_TEXT("defun"), 5, xp_lisp_prim_defun); ADD_PRIM (mem, XP_TEXT("defun"), 5, xp_lisp_prim_defun);
ADD_PRIM (mem, RB_TEXT("demac"), 5, xp_lisp_prim_demac); ADD_PRIM (mem, XP_TEXT("demac"), 5, xp_lisp_prim_demac);
ADD_PRIM (mem, RB_TEXT("let"), 3, xp_lisp_prim_let); ADD_PRIM (mem, XP_TEXT("let"), 3, xp_lisp_prim_let);
ADD_PRIM (mem, RB_TEXT("let*"), 4, xp_lisp_prim_letx); ADD_PRIM (mem, XP_TEXT("let*"), 4, xp_lisp_prim_letx);
ADD_PRIM (mem, RB_TEXT("+"), 1, xp_lisp_prim_plus); ADD_PRIM (mem, XP_TEXT("+"), 1, xp_lisp_prim_plus);
ADD_PRIM (mem, RB_TEXT(">"), 1, xp_lisp_prim_gt); ADD_PRIM (mem, XP_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_lt);
return 0; 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; if (obj == XP_NULL) return XP_NULL;
} }
RBL_TYPE(obj) = type; XP_LISP_TYPE(obj) = type;
RBL_SIZE(obj) = size; XP_LISP_SIZE(obj) = size;
RBL_MARK(obj) = 0; XP_LISP_MARK(obj) = 0;
RBL_LOCK(obj) = 0; XP_LISP_LOCK(obj) = 0;
// insert the object at the head of the used list // 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->used[type] = obj;
mem->count++; mem->count++;
RB_DEBUG1 (RB_TEXT("mem->count: %u\n"), mem->count); XP_DEBUG1 (XP_TEXT("mem->count: %u\n"), mem->count);
return obj; 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 // efficient memory management
if (prev == XP_NULL) if (prev == XP_NULL)
mem->used[RBL_TYPE(obj)] = RBL_LINK(obj); mem->used[XP_LISP_TYPE(obj)] = XP_LISP_LINK(obj);
else RBL_LINK(prev) = RBL_LINK(obj); else XP_LISP_LINK(prev) = XP_LISP_LINK(obj);
mem->count--; 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); xp_free (obj);
} }
@ -201,11 +201,11 @@ void xp_lisp_dispose_all (xp_lisp_mem_t* mem)
xp_lisp_obj_t* obj, * next; xp_lisp_obj_t* obj, * next;
xp_size_t i; 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]; obj = mem->used[i];
while (obj != XP_NULL) { while (obj != XP_NULL) {
next = RBL_LINK(obj); next = XP_LISP_LINK(obj);
xp_lisp_dispose (mem, XP_NULL, obj); xp_lisp_dispose (mem, XP_NULL, obj);
obj = next; obj = next;
} }
@ -218,21 +218,21 @@ static void xp_lisp_mark_obj (xp_lisp_obj_t* obj)
// TODO:.... // TODO:....
// can it be recursive? // 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) { if (XP_LISP_TYPE(obj) == XP_LISP_OBJ_CONS) {
xp_lisp_mark_obj (RBL_CAR(obj)); xp_lisp_mark_obj (XP_LISP_CAR(obj));
xp_lisp_mark_obj (RBL_CDR(obj)); xp_lisp_mark_obj (XP_LISP_CDR(obj));
} }
else if (RBL_TYPE(obj) == RBL_OBJ_FUNC) { else if (XP_LISP_TYPE(obj) == XP_LISP_OBJ_FUNC) {
xp_lisp_mark_obj (RBL_FFORMAL(obj)); xp_lisp_mark_obj (XP_LISP_FFORMAL(obj));
xp_lisp_mark_obj (RBL_FBODY(obj)); xp_lisp_mark_obj (XP_LISP_FBODY(obj));
} }
else if (RBL_TYPE(obj) == RBL_OBJ_MACRO) { else if (XP_LISP_TYPE(obj) == XP_LISP_OBJ_MACRO) {
xp_lisp_mark_obj (RBL_MFORMAL(obj)); xp_lisp_mark_obj (XP_LISP_MFORMAL(obj));
xp_lisp_mark_obj (RBL_MBODY(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) void xp_lisp_lock (xp_lisp_obj_t* obj)
{ {
xp_lisp_assert (obj != XP_NULL); xp_lisp_assert (obj != XP_NULL);
RBL_LOCK(obj) = 1; XP_LISP_LOCK(obj) = 1;
//RBL_MARK(obj) = 1; //XP_LISP_MARK(obj) = 1;
} }
void xp_lisp_unlock (xp_lisp_obj_t* obj) void xp_lisp_unlock (xp_lisp_obj_t* obj)
{ {
xp_lisp_assert (obj != XP_NULL); 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) void xp_lisp_unlock_all (xp_lisp_obj_t* obj)
{ {
xp_lisp_assert (obj != XP_NULL); xp_lisp_assert (obj != XP_NULL);
RBL_LOCK(obj) = 0; XP_LISP_LOCK(obj) = 0;
if (RBL_TYPE(obj) == RBL_OBJ_CONS) { if (XP_LISP_TYPE(obj) == XP_LISP_OBJ_CONS) {
xp_lisp_unlock_all (RBL_CAR(obj)); xp_lisp_unlock_all (XP_LISP_CAR(obj));
xp_lisp_unlock_all (RBL_CDR(obj)); xp_lisp_unlock_all (XP_LISP_CDR(obj));
} }
else if (RBL_TYPE(obj) == RBL_OBJ_FUNC) { else if (XP_LISP_TYPE(obj) == XP_LISP_OBJ_FUNC) {
xp_lisp_unlock_all (RBL_FFORMAL(obj)); xp_lisp_unlock_all (XP_LISP_FFORMAL(obj));
xp_lisp_unlock_all (RBL_FBODY(obj)); xp_lisp_unlock_all (XP_LISP_FBODY(obj));
} }
else if (RBL_TYPE(obj) == RBL_OBJ_MACRO) { else if (XP_LISP_TYPE(obj) == XP_LISP_OBJ_MACRO) {
xp_lisp_unlock_all (RBL_MFORMAL(obj)); xp_lisp_unlock_all (XP_LISP_MFORMAL(obj));
xp_lisp_unlock_all (RBL_MBODY(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_lisp_array_t* array;
xp_size_t i; 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 // mark objects in the environment frames
frame = mem->frame; frame = mem->frame;
while (frame != XP_NULL) { while (frame != XP_NULL) {
@ -293,7 +293,7 @@ static void xp_lisp_mark (xp_lisp_mem_t* mem)
frame = frame->link; 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 // mark objects in the interim frames
frame = mem->brooding_frame; 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); 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; array = mem->temp_array;
for (i = 0; i < array->size; i++) { for (i = 0; i < array->size; i++) {
xp_lisp_mark_obj (array->buffer[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 // mark common objects
if (mem->t != XP_NULL) xp_lisp_mark_obj (mem->t); if (mem->t != XP_NULL) xp_lisp_mark_obj (mem->t);
if (mem->nil != XP_NULL) xp_lisp_mark_obj (mem->nil); 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; xp_size_t i;
// scan all the allocated objects and get rid of unused objects // scan all the allocated objects and get rid of unused objects
for (i = 0; i < RBL_TYPE_COUNT; i++) { for (i = 0; i < XP_LISP_TYPE_COUNT; i++) {
//for (i = RBL_TYPE_COUNT; i > 0; /*i--*/) { //for (i = XP_LISP_TYPE_COUNT; i > 0; /*i--*/) {
prev = XP_NULL; prev = XP_NULL;
obj = mem->used[i]; obj = mem->used[i];
//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) { 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 // dispose of unused objects
xp_lisp_dispose (mem, prev, obj); xp_lisp_dispose (mem, prev, obj);
} }
else { else {
// unmark the object in use // unmark the object in use
RBL_MARK(obj) = 0; XP_LISP_MARK(obj) = 0;
prev = obj; 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) xp_lisp_obj_t* xp_lisp_make_nil (xp_lisp_mem_t* mem)
{ {
if (mem->nil != XP_NULL) return mem->nil; 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; return mem->nil;
} }
xp_lisp_obj_t* xp_lisp_make_true (xp_lisp_mem_t* mem) xp_lisp_obj_t* xp_lisp_make_true (xp_lisp_mem_t* mem)
{ {
if (mem->t != XP_NULL) return mem->t; 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; 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; 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; if (obj == XP_NULL) return XP_NULL;
RBL_IVALUE(obj) = value; XP_LISP_IVALUE(obj) = value;
return obj; 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; 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; if (obj == XP_NULL) return XP_NULL;
RBL_FVALUE(obj) = value; XP_LISP_FVALUE(obj) = value;
return obj; 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; xp_lisp_obj_t* obj;
// look for a sysmbol with the given name // 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) { while (obj != XP_NULL) {
// if there is a symbol with the same name, it is just used. // if there is a symbol with the same name, it is just used.
if (xp_lisp_comp_symbol2 (obj, str, len) == 0) return obj; 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 // 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)); sizeof(xp_lisp_obj_symbol_t) + (len + 1) * sizeof(xp_lisp_char));
if (obj == XP_NULL) return XP_NULL; if (obj == XP_NULL) return XP_NULL;
// fill in the symbol buffer // 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; 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; xp_lisp_obj_t* obj;
// allocate memory for the string // 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)); sizeof(xp_lisp_obj_string_t) + (len + 1) * sizeof(xp_lisp_char));
if (obj == XP_NULL) return XP_NULL; if (obj == XP_NULL) return XP_NULL;
// fill in the string buffer // 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; 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; 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; if (obj == XP_NULL) return XP_NULL;
RBL_CAR(obj) = car; XP_LISP_CAR(obj) = car;
RBL_CDR(obj) = cdr; XP_LISP_CDR(obj) = cdr;
return obj; 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; 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; if (obj == XP_NULL) return XP_NULL;
RBL_FFORMAL(obj) = formal; XP_LISP_FFORMAL(obj) = formal;
RBL_FBODY(obj) = body; XP_LISP_FBODY(obj) = body;
return obj; 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; 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; if (obj == XP_NULL) return XP_NULL;
RBL_MFORMAL(obj) = formal; XP_LISP_MFORMAL(obj) = formal;
RBL_MBODY(obj) = body; XP_LISP_MBODY(obj) = body;
return obj; 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; 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; if (obj == XP_NULL) return XP_NULL;
RBL_PIMPL(obj) = impl; XP_LISP_PIMPL(obj) = impl;
return obj; 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_frame_t* frame;
xp_lisp_assoc_t* assoc; 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; 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_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; count = 0;
//while (obj != mem->nil) { //while (obj != mem->nil) {
while (RBL_TYPE(obj) == RBL_OBJ_CONS) { while (XP_LISP_TYPE(obj) == XP_LISP_OBJ_CONS) {
count++; count++;
obj = RBL_CDR(obj); obj = XP_LISP_CDR(obj);
} }
return count; 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; xp_size_t count = 0;
while (RBL_TYPE(obj) == RBL_OBJ_CONS) { while (XP_LISP_TYPE(obj) == XP_LISP_OBJ_CONS) {
count++; count++;
obj = RBL_CDR(obj); obj = XP_LISP_CDR(obj);
} }
if (obj != mem->nil) return -1; 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_lisp_char* p;
xp_size_t index, length; 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; index = 0;
length = RBL_SYMLEN(obj); length = XP_LISP_SYMLEN(obj);
p = RBL_SYMVALUE(obj); p = XP_LISP_SYMVALUE(obj);
while (index < length) { while (index < length) {
if (*p > *str) return 1; if (*p > *str) return 1;
if (*p < *str) return -1; if (*p < *str) return -1;
index++; p++; str++; 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) 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_lisp_char* p;
xp_size_t index, length; 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; index = 0;
length = RBL_SYMLEN(obj); length = XP_LISP_SYMLEN(obj);
p = RBL_SYMVALUE(obj); p = XP_LISP_SYMVALUE(obj);
while (index < length && index < len) { while (index < length && index < len) {
if (*p > *str) return 1; 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_lisp_char* p;
xp_size_t index, length; 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; index = 0;
length = RBL_STRLEN(obj); length = XP_LISP_STRLEN(obj);
p = RBL_STRVALUE(obj); p = XP_LISP_STRVALUE(obj);
while (index < length) { while (index < length) {
if (*p > *str) return 1; if (*p > *str) return 1;
if (*p < *str) return -1; if (*p < *str) return -1;
index++; p++; str++; 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) 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_lisp_char* p;
xp_size_t index, length; 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; index = 0;
length = RBL_STRLEN(obj); length = XP_LISP_STRLEN(obj);
p = RBL_STRVALUE(obj); p = XP_LISP_STRVALUE(obj);
while (index < length && index < len) { while (index < length && index < len) {
if (*p > *str) return 1; 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) 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 // the buffer pointed by dst should be big enough to hold str
while (*str != RBL_CHAR('\0')) *dst++ = *str++; while (*str != XP_LISP_CHAR('\0')) *dst++ = *str++;
*dst = RBL_CHAR('\0'); *dst = XP_LISP_CHAR('\0');
} }
void xp_lisp_copy_string2 (xp_lisp_char* dst, const xp_lisp_char* str, xp_size_t len) 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++; *dst++ = *str++;
len--; len--;
} }
*dst = RBL_CHAR('\0'); *dst = XP_LISP_CHAR('\0');
} }

16
ase/lsp/memory.h
View File

@ -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_ #ifndef _XP_LISP_MEM_H_
#define _RBL_MEM_H_ #define _XP_LISP_MEM_H_
#include "obj.h" #include <xp/lisp/object.h>
#include "env.h" #include <xp/lisp/env.h>
#include "array.h" #include <xp/lisp/array.h>
struct xp_lisp_mem_t 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; // upper bounds of the maximum number of objects
xp_size_t ubound_inc; // increment of the upper bounds xp_size_t ubound_inc; // increment of the upper bounds
xp_size_t count; // the number of objects currently allocated xp_size_t count; // the number of objects currently allocated
xp_lisp_obj_t* used[RBL_TYPE_COUNT]; xp_lisp_obj_t* used[XP_LISP_TYPE_COUNT];
xp_lisp_obj_t* free[RBL_TYPE_COUNT]; xp_lisp_obj_t* free[XP_LISP_TYPE_COUNT];
xp_lisp_obj_t* locked; xp_lisp_obj_t* locked;
/* /*

100
ase/lsp/object.h
View File

@ -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_ #ifndef _XP_LISP_OBJECT_H_
#define _RBL_OBJECT_H_ #define _XP_LISP_OBJECT_H_
#include "types.h" #include <xp/lisp/types.h>
// object types // object types
enum enum
{ {
RBL_OBJ_NIL = 0, XP_LISP_OBJ_NIL = 0,
RBL_OBJ_TRUE, XP_LISP_OBJ_TRUE,
RBL_OBJ_INT, XP_LISP_OBJ_INT,
RBL_OBJ_FLOAT, XP_LISP_OBJ_FLOAT,
RBL_OBJ_SYMBOL, XP_LISP_OBJ_SYMBOL,
RBL_OBJ_STRING, XP_LISP_OBJ_STRING,
RBL_OBJ_CONS, XP_LISP_OBJ_CONS,
RBL_OBJ_FUNC, XP_LISP_OBJ_FUNC,
RBL_OBJ_MACRO, XP_LISP_OBJ_MACRO,
RBL_OBJ_PRIM, 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 \ #define XP_LISP_OBJ_HEADER \
rb_uint32 type: 24; \ xp_uint32_t type: 24; \
rb_uint32 mark: 4; \ xp_uint32_t mark: 4; \
rb_uint32 lock: 4; \ xp_uint32_t lock: 4; \
xp_size_t size; \ xp_size_t size; \
struct xp_lisp_obj_t* link struct xp_lisp_obj_t* link
struct xp_lisp_obj_t struct xp_lisp_obj_t
{ {
RBL_OBJ_HEADER; XP_LISP_OBJ_HEADER;
}; };
struct xp_lisp_obj_nil_t struct xp_lisp_obj_nil_t
{ {
RBL_OBJ_HEADER; XP_LISP_OBJ_HEADER;
}; };
struct xp_lisp_obj_true_t struct xp_lisp_obj_true_t
{ {
RBL_OBJ_HEADER; XP_LISP_OBJ_HEADER;
}; };
struct xp_lisp_obj_int_t struct xp_lisp_obj_int_t
{ {
RBL_OBJ_HEADER; XP_LISP_OBJ_HEADER;
xp_lisp_int value; xp_lisp_int value;
}; };
struct xp_lisp_obj_float_t struct xp_lisp_obj_float_t
{ {
RBL_OBJ_HEADER; XP_LISP_OBJ_HEADER;
xp_lisp_float value; xp_lisp_float value;
}; };
struct xp_lisp_obj_symbol_t struct xp_lisp_obj_symbol_t
{ {
RBL_OBJ_HEADER; XP_LISP_OBJ_HEADER;
#ifdef __BORLANDC__ #ifdef __BORLANDC__
#else #else
xp_lisp_char buffer[0]; xp_lisp_char buffer[0];
@ -69,7 +69,7 @@ struct xp_lisp_obj_symbol_t
struct xp_lisp_obj_string_t struct xp_lisp_obj_string_t
{ {
RBL_OBJ_HEADER; XP_LISP_OBJ_HEADER;
#ifdef __BORLANDC__ #ifdef __BORLANDC__
#else #else
xp_lisp_char buffer[0]; xp_lisp_char buffer[0];
@ -78,28 +78,28 @@ struct xp_lisp_obj_string_t
struct xp_lisp_obj_cons_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* car;
struct xp_lisp_obj_t* cdr; struct xp_lisp_obj_t* cdr;
}; };
struct xp_lisp_obj_func_t struct xp_lisp_obj_func_t
{ {
RBL_OBJ_HEADER; XP_LISP_OBJ_HEADER;
struct xp_lisp_obj_t* formal; struct xp_lisp_obj_t* formal;
struct xp_lisp_obj_t* body; struct xp_lisp_obj_t* body;
}; };
struct xp_lisp_obj_macro_t struct xp_lisp_obj_macro_t
{ {
RBL_OBJ_HEADER; XP_LISP_OBJ_HEADER;
struct xp_lisp_obj_t* formal; struct xp_lisp_obj_t* formal;
struct xp_lisp_obj_t* body; struct xp_lisp_obj_t* body;
}; };
struct xp_lisp_obj_prim_t struct xp_lisp_obj_prim_t
{ {
RBL_OBJ_HEADER; XP_LISP_OBJ_HEADER;
void* impl; // xp_lisp_prim_t 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; typedef struct xp_lisp_obj_prim_t xp_lisp_obj_prim_t;
// header access // header access
#define RBL_TYPE(x) (((xp_lisp_obj_t*)x)->type) #define XP_LISP_TYPE(x) (((xp_lisp_obj_t*)x)->type)
#define RBL_SIZE(x) (((xp_lisp_obj_t*)x)->size) #define XP_LISP_SIZE(x) (((xp_lisp_obj_t*)x)->size)
#define RBL_MARK(x) (((xp_lisp_obj_t*)x)->mark) #define XP_LISP_MARK(x) (((xp_lisp_obj_t*)x)->mark)
#define RBL_LOCK(x) (((xp_lisp_obj_t*)x)->lock) #define XP_LISP_LOCK(x) (((xp_lisp_obj_t*)x)->lock)
#define RBL_LINK(x) (((xp_lisp_obj_t*)x)->link) #define XP_LISP_LINK(x) (((xp_lisp_obj_t*)x)->link)
// value access // value access
#define RBL_IVALUE(x) (((xp_lisp_obj_int_t*)x)->value) #define XP_LISP_IVALUE(x) (((xp_lisp_obj_int_t*)x)->value)
#define RBL_FVALUE(x) (((xp_lisp_obj_float_t*)x)->value) #define XP_LISP_FVALUE(x) (((xp_lisp_obj_float_t*)x)->value)
#ifdef __BORLANDC__ #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 #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 #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__ #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 #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 #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 XP_LISP_CAR(x) (((xp_lisp_obj_cons_t*)x)->car)
#define RBL_CDR(x) (((xp_lisp_obj_cons_t*)x)->cdr) #define XP_LISP_CDR(x) (((xp_lisp_obj_cons_t*)x)->cdr)
#define RBL_FFORMAL(x) (((xp_lisp_obj_func_t*)x)->formal) #define XP_LISP_FFORMAL(x) (((xp_lisp_obj_func_t*)x)->formal)
#define RBL_FBODY(x) (((xp_lisp_obj_func_t*)x)->body) #define XP_LISP_FBODY(x) (((xp_lisp_obj_func_t*)x)->body)
#define RBL_MFORMAL(x) (((xp_lisp_obj_macro_t*)x)->formal) #define XP_LISP_MFORMAL(x) (((xp_lisp_obj_macro_t*)x)->formal)
#define RBL_MBODY(x) (((xp_lisp_obj_macro_t*)x)->body) #define XP_LISP_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_PIMPL(x) ((xp_lisp_pimpl_t)(((xp_lisp_obj_prim_t*)x)->impl))
#endif #endif

352
ase/lsp/primitive.c
View File

@ -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" #include "lisp.h"
@ -8,8 +8,8 @@
xp_lisp_obj_t* xp_lisp_prim_abort (xp_lisp_t* lsp, xp_lisp_obj_t* args) 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); XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 0, 0);
lsp->error = RBL_ERR_ABORT; lsp->error = XP_LISP_ERR_ABORT;
return XP_NULL; 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; xp_lisp_obj_t* tmp;
RBL_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1); XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1);
xp_lisp_assert (RBL_TYPE(args) == RBL_OBJ_CONS); 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 == XP_NULL) return XP_NULL;
tmp = xp_lisp_eval (lsp, tmp); 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; 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 (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 (tmp == XP_NULL) return XP_NULL;
if (res == 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; res = tmp;
} }
args = RBL_CDR(args); args = XP_LISP_CDR(args);
} }
return res; 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; 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; res = lsp->mem->nil;
//while (args != 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; if (tmp == XP_NULL) return XP_NULL;
res = tmp; res = tmp;
args = RBL_CDR(args); args = XP_LISP_CDR(args);
} }
return res; 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) 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); xp_lisp_garbage_collect (lsp->mem);
return lsp->mem->nil; 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; 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) { while (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS) {
if (RBL_TYPE(RBL_CAR(args)) != RBL_OBJ_CONS) { if (XP_LISP_TYPE(XP_LISP_CAR(args)) != XP_LISP_OBJ_CONS) {
lsp->error = RBL_ERR_BAD_ARG; lsp->error = XP_LISP_ERR_BAD_ARG;
return XP_NULL; 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 == XP_NULL) return XP_NULL;
if (tmp != lsp->mem->nil) { if (tmp != lsp->mem->nil) {
tmp = RBL_CDR(RBL_CAR(args)); tmp = XP_LISP_CDR(XP_LISP_CAR(args));
ret = lsp->mem->nil; ret = lsp->mem->nil;
while (RBL_TYPE(tmp) == RBL_OBJ_CONS) { while (XP_LISP_TYPE(tmp) == XP_LISP_OBJ_CONS) {
ret = xp_lisp_eval (lsp, RBL_CAR(tmp)); ret = xp_lisp_eval (lsp, XP_LISP_CAR(tmp));
if (ret == XP_NULL) return XP_NULL; if (ret == XP_NULL) return XP_NULL;
tmp = RBL_CDR(tmp); tmp = XP_LISP_CDR(tmp);
} }
if (tmp != lsp->mem->nil) { if (tmp != lsp->mem->nil) {
lsp->error = RBL_ERR_BAD_ARG; lsp->error = XP_LISP_ERR_BAD_ARG;
return XP_NULL; return XP_NULL;
} }
return ret; return ret;
} }
args = RBL_CDR(args); args = XP_LISP_CDR(args);
} }
return lsp->mem->nil; 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; xp_lisp_obj_t* tmp;
RBL_PRIM_CHECK_ARG_COUNT (lsp, args, 2, RBL_PRIM_MAX_ARG_COUNT); XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, XP_LISP_PRIM_MAX_ARG_COUNT);
xp_lisp_assert (RBL_TYPE(args) == RBL_OBJ_CONS); 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 == XP_NULL) return XP_NULL;
if (tmp != lsp->mem->nil) { 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; if (tmp == XP_NULL) return XP_NULL;
return tmp; return tmp;
} }
else { else {
xp_lisp_obj_t* res = lsp->mem->nil; 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) { while (XP_LISP_TYPE(tmp) == XP_LISP_OBJ_CONS) {
res = xp_lisp_eval (lsp, RBL_CAR(tmp)); res = xp_lisp_eval (lsp, XP_LISP_CAR(tmp));
if (res == XP_NULL) return XP_NULL; if (res == XP_NULL) return XP_NULL;
tmp = RBL_CDR(tmp); tmp = XP_LISP_CDR(tmp);
} }
if (tmp != lsp->mem->nil) { if (tmp != lsp->mem->nil) {
lsp->error = RBL_ERR_BAD_ARG; lsp->error = XP_LISP_ERR_BAD_ARG;
return XP_NULL; 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; xp_lisp_obj_t* 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);
xp_lisp_assert (RBL_TYPE(args) == RBL_OBJ_CONS); xp_lisp_assert (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS);
for (;;) { 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 == XP_NULL) return XP_NULL;
if (tmp == lsp->mem->nil) break; if (tmp == lsp->mem->nil) break;
tmp = RBL_CDR(args); tmp = XP_LISP_CDR(args);
while (RBL_TYPE(tmp) == RBL_OBJ_CONS) { while (XP_LISP_TYPE(tmp) == XP_LISP_OBJ_CONS) {
if (xp_lisp_eval (lsp, RBL_CAR(tmp)) == XP_NULL) return XP_NULL; if (xp_lisp_eval (lsp, XP_LISP_CAR(tmp)) == XP_NULL) return XP_NULL;
tmp = RBL_CDR(tmp); tmp = XP_LISP_CDR(tmp);
} }
if (tmp != lsp->mem->nil) { if (tmp != lsp->mem->nil) {
lsp->error = RBL_ERR_BAD_ARG; lsp->error = XP_LISP_ERR_BAD_ARG;
return XP_NULL; 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; xp_lisp_obj_t* tmp;
RBL_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1); XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1);
xp_lisp_assert (RBL_TYPE(args) == RBL_OBJ_CONS); 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 == XP_NULL) return XP_NULL;
if (tmp == lsp->mem->nil) return lsp->mem->nil; if (tmp == lsp->mem->nil) return lsp->mem->nil;
if (RBL_TYPE(tmp) != RBL_OBJ_CONS) { if (XP_LISP_TYPE(tmp) != XP_LISP_OBJ_CONS) {
lsp->error = RBL_ERR_BAD_ARG; lsp->error = XP_LISP_ERR_BAD_ARG;
return XP_NULL; 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* xp_lisp_prim_cdr (xp_lisp_t* lsp, xp_lisp_obj_t* args)
{ {
xp_lisp_obj_t* tmp; xp_lisp_obj_t* tmp;
RBL_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1); XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1);
xp_lisp_assert (RBL_TYPE(args) == RBL_OBJ_CONS); 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 == XP_NULL) return XP_NULL;
if (tmp == lsp->mem->nil) return lsp->mem->nil; if (tmp == lsp->mem->nil) return lsp->mem->nil;
if (RBL_TYPE(tmp) != RBL_OBJ_CONS) { if (XP_LISP_TYPE(tmp) != XP_LISP_OBJ_CONS) {
lsp->error = RBL_ERR_BAD_ARG; lsp->error = XP_LISP_ERR_BAD_ARG;
return XP_NULL; 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* xp_lisp_prim_cons (xp_lisp_t* lsp, xp_lisp_obj_t* args)
{ {
xp_lisp_obj_t* car, * cdr, * cons; xp_lisp_obj_t* car, * cdr, * cons;
RBL_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2); XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
xp_lisp_assert (RBL_TYPE(args) == RBL_OBJ_CONS); 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; 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; if (cdr == XP_NULL) return XP_NULL;
cons = xp_lisp_make_cons (lsp->mem, car, cdr); cons = xp_lisp_make_cons (lsp->mem, car, cdr);
if (cons == XP_NULL) { if (cons == XP_NULL) {
lsp->error = RBL_ERR_MEM; lsp->error = XP_LISP_ERR_MEM;
return XP_NULL; 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; xp_lisp_obj_t* p1, * p2;
RBL_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2); XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
xp_lisp_assert (RBL_TYPE(args) == RBL_OBJ_CONS); 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 (p1 == XP_NULL) return XP_NULL;
if (RBL_TYPE(p1) != RBL_OBJ_SYMBOL) { if (XP_LISP_TYPE(p1) != XP_LISP_OBJ_SYMBOL) {
lsp->error = RBL_ERR_BAD_ARG; lsp->error = XP_LISP_ERR_BAD_ARG;
return XP_NULL; 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 (p2 == XP_NULL) return XP_NULL;
if (xp_lisp_set (lsp->mem, p1, p2) == 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; 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; xp_lisp_obj_t* p = args, * p1, * p2 = lsp->mem->nil;
while (p != 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); p1 = XP_LISP_CAR(p);
if (RBL_TYPE(p1) != RBL_OBJ_SYMBOL) { if (XP_LISP_TYPE(p1) != XP_LISP_OBJ_SYMBOL) {
lsp->error = RBL_ERR_BAD_ARG; lsp->error = XP_LISP_ERR_BAD_ARG;
return XP_NULL; return XP_NULL;
} }
if (RBL_TYPE(RBL_CDR(p)) != RBL_OBJ_CONS) { if (XP_LISP_TYPE(XP_LISP_CDR(p)) != XP_LISP_OBJ_CONS) {
lsp->error = RBL_ERR_TOO_FEW_ARGS; lsp->error = XP_LISP_ERR_TOO_FEW_ARGS;
return XP_NULL; 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 (p2 == XP_NULL) return XP_NULL;
if (xp_lisp_set (lsp->mem, p1, p2) == 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; return XP_NULL;
} }
p = RBL_CDR(RBL_CDR(p)); p = XP_LISP_CDR(XP_LISP_CDR(p));
} }
return p2; 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) 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_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1);
xp_lisp_assert (RBL_TYPE(args) == RBL_OBJ_CONS); xp_lisp_assert (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS);
return RBL_CAR(args); return XP_LISP_CAR(args);
} }
xp_lisp_obj_t* xp_lisp_prim_defun (xp_lisp_t* lsp, xp_lisp_obj_t* 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; 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); name = XP_LISP_CAR(args);
if (RBL_TYPE(name) != RBL_OBJ_SYMBOL) { if (XP_LISP_TYPE(name) != XP_LISP_OBJ_SYMBOL) {
lsp->error = RBL_ERR_BAD_ARG; lsp->error = XP_LISP_ERR_BAD_ARG;
return XP_NULL; return XP_NULL;
} }
fun = xp_lisp_make_func (lsp->mem, 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 (fun == XP_NULL) return XP_NULL;
if (xp_lisp_set (lsp->mem, RBL_CAR(args), fun) == XP_NULL) { if (xp_lisp_set (lsp->mem, XP_LISP_CAR(args), fun) == XP_NULL) {
lsp->error = RBL_ERR_MEM; lsp->error = XP_LISP_ERR_MEM;
return XP_NULL; return XP_NULL;
} }
return fun; 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; 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); name = XP_LISP_CAR(args);
if (RBL_TYPE(name) != RBL_OBJ_SYMBOL) { if (XP_LISP_TYPE(name) != XP_LISP_OBJ_SYMBOL) {
lsp->error = RBL_ERR_BAD_ARG; lsp->error = XP_LISP_ERR_BAD_ARG;
return XP_NULL; return XP_NULL;
} }
mac = xp_lisp_make_macro (lsp->mem, 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 (mac == XP_NULL) return XP_NULL;
if (xp_lisp_set (lsp->mem, RBL_CAR(args), mac) == XP_NULL) { if (xp_lisp_set (lsp->mem, XP_LISP_CAR(args), mac) == XP_NULL) {
lsp->error = RBL_ERR_MEM; lsp->error = XP_LISP_ERR_MEM;
return XP_NULL; return XP_NULL;
} }
return mac; 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* body;
xp_lisp_obj_t* value; 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 // create a new frame
frame = xp_lisp_frame_new (); frame = xp_lisp_frame_new ();
if (frame == XP_NULL) { if (frame == XP_NULL) {
lsp->error = RBL_ERR_MEM; lsp->error = XP_LISP_ERR_MEM;
return XP_NULL; return XP_NULL;
} }
//frame->link = lsp->mem->frame; //frame->link = lsp->mem->frame;
@ -398,17 +398,17 @@ static xp_lisp_obj_t* xp_lisp_prim_let_impl (
lsp->mem->brooding_frame = frame; lsp->mem->brooding_frame = frame;
} }
assoc = RBL_CAR(args); assoc = XP_LISP_CAR(args);
//while (assoc != lsp->mem->nil) { //while (assoc != lsp->mem->nil) {
while (RBL_TYPE(assoc) == RBL_OBJ_CONS) { while (XP_LISP_TYPE(assoc) == XP_LISP_OBJ_CONS) {
xp_lisp_obj_t* ass = RBL_CAR(assoc); xp_lisp_obj_t* ass = XP_LISP_CAR(assoc);
if (RBL_TYPE(ass) == RBL_OBJ_CONS) { if (XP_LISP_TYPE(ass) == XP_LISP_OBJ_CONS) {
xp_lisp_obj_t* n = RBL_CAR(ass); xp_lisp_obj_t* n = XP_LISP_CAR(ass);
xp_lisp_obj_t* v = RBL_CDR(ass); xp_lisp_obj_t* v = XP_LISP_CDR(ass);
if (RBL_TYPE(n) != RBL_OBJ_SYMBOL) { if (XP_LISP_TYPE(n) != XP_LISP_OBJ_SYMBOL) {
lsp->error = RBL_ERR_BAD_ARG; // must be a symbol lsp->error = XP_LISP_ERR_BAD_ARG; // must be a symbol
if (sequential) lsp->mem->frame = frame->link; if (sequential) lsp->mem->frame = frame->link;
else lsp->mem->brooding_frame = frame->link; else lsp->mem->brooding_frame = frame->link;
xp_lisp_frame_free (frame); 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 (v != lsp->mem->nil) {
if (RBL_CDR(v) != lsp->mem->nil) { if (XP_LISP_CDR(v) != lsp->mem->nil) {
lsp->error = RBL_ERR_TOO_MANY_ARGS; // must be a symbol lsp->error = XP_LISP_ERR_TOO_MANY_ARGS; // must be a symbol
if (sequential) lsp->mem->frame = frame->link; if (sequential) lsp->mem->frame = frame->link;
else lsp->mem->brooding_frame = frame->link; else lsp->mem->brooding_frame = frame->link;
xp_lisp_frame_free (frame); xp_lisp_frame_free (frame);
return XP_NULL; 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; if (sequential) lsp->mem->frame = frame->link;
else lsp->mem->brooding_frame = frame->link; else lsp->mem->brooding_frame = frame->link;
xp_lisp_frame_free (frame); 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) { 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; if (sequential) lsp->mem->frame = frame->link;
else lsp->mem->brooding_frame = frame->link; else lsp->mem->brooding_frame = frame->link;
xp_lisp_frame_free (frame); xp_lisp_frame_free (frame);
return XP_NULL; return XP_NULL;
} }
if (xp_lisp_frame_insert (frame, n, v) == 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; if (sequential) lsp->mem->frame = frame->link;
else lsp->mem->brooding_frame = frame->link; else lsp->mem->brooding_frame = frame->link;
xp_lisp_frame_free (frame); xp_lisp_frame_free (frame);
return XP_NULL; 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) { 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; if (sequential) lsp->mem->frame = frame->link;
else lsp->mem->brooding_frame = frame->link; else lsp->mem->brooding_frame = frame->link;
xp_lisp_frame_free (frame); xp_lisp_frame_free (frame);
return XP_NULL; return XP_NULL;
} }
if (xp_lisp_frame_insert (frame, ass, lsp->mem->nil) == 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; if (sequential) lsp->mem->frame = frame->link;
else lsp->mem->brooding_frame = frame->link; else lsp->mem->brooding_frame = frame->link;
xp_lisp_frame_free (frame); xp_lisp_frame_free (frame);
@ -463,18 +463,18 @@ static xp_lisp_obj_t* xp_lisp_prim_let_impl (
} }
} }
else { else {
lsp->error = RBL_ERR_BAD_ARG; lsp->error = XP_LISP_ERR_BAD_ARG;
if (sequential) lsp->mem->frame = frame->link; if (sequential) lsp->mem->frame = frame->link;
else lsp->mem->brooding_frame = frame->link; else lsp->mem->brooding_frame = frame->link;
xp_lisp_frame_free (frame); xp_lisp_frame_free (frame);
return XP_NULL; return XP_NULL;
} }
assoc = RBL_CDR(assoc); assoc = XP_LISP_CDR(assoc);
} }
if (assoc != lsp->mem->nil) { 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; if (sequential) lsp->mem->frame = frame->link;
else lsp->mem->brooding_frame = frame->link; else lsp->mem->brooding_frame = frame->link;
xp_lisp_frame_free (frame); xp_lisp_frame_free (frame);
@ -490,15 +490,15 @@ static xp_lisp_obj_t* xp_lisp_prim_let_impl (
// evaluate forms in the body // evaluate forms in the body
value = lsp->mem->nil; value = lsp->mem->nil;
body = RBL_CDR(args); body = XP_LISP_CDR(args);
while (body != lsp->mem->nil) { 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) { if (value == XP_NULL) {
lsp->mem->frame = frame->link; lsp->mem->frame = frame->link;
xp_lisp_frame_free (frame); xp_lisp_frame_free (frame);
return XP_NULL; return XP_NULL;
} }
body = RBL_CDR(body); body = XP_LISP_CDR(body);
} }
// pop the frame // 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_obj_t* body, * tmp;
xp_lisp_int value = 0; xp_lisp_int value = 0;
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);
xp_lisp_assert (RBL_TYPE(args) == RBL_OBJ_CONS); xp_lisp_assert (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS);
body = args; body = args;
//while (body != lsp->mem->nil) { //while (body != lsp->mem->nil) {
while (RBL_TYPE(body) == RBL_OBJ_CONS) { while (XP_LISP_TYPE(body) == XP_LISP_OBJ_CONS) {
tmp = xp_lisp_eval (lsp, RBL_CAR(body)); tmp = xp_lisp_eval (lsp, XP_LISP_CAR(body));
if (tmp == XP_NULL) return XP_NULL; if (tmp == XP_NULL) return XP_NULL;
if (RBL_TYPE(tmp) != RBL_OBJ_INT) { if (XP_LISP_TYPE(tmp) != XP_LISP_OBJ_INT) {
lsp->error = RBL_ERR_BAD_VALUE; lsp->error = XP_LISP_ERR_BAD_VALUE;
return XP_NULL; return XP_NULL;
} }
value = value + RBL_IVALUE(tmp); value = value + XP_LISP_IVALUE(tmp);
body = RBL_CDR(body); body = XP_LISP_CDR(body);
} }
tmp = xp_lisp_make_int (lsp->mem, value); tmp = xp_lisp_make_int (lsp->mem, value);
if (tmp == XP_NULL) { if (tmp == XP_NULL) {
lsp->error = RBL_ERR_MEM; lsp->error = XP_LISP_ERR_MEM;
return XP_NULL; 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; xp_lisp_obj_t* p1, * p2;
int res; int res;
RBL_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2); XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
xp_lisp_assert (RBL_TYPE(args) == RBL_OBJ_CONS); 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 (p1 == XP_NULL) return XP_NULL;
// TODO: lock p1.... // 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 (p2 == XP_NULL) return XP_NULL;
if (RBL_TYPE(p1) == RBL_OBJ_INT) { if (XP_LISP_TYPE(p1) == XP_LISP_OBJ_INT) {
if (RBL_TYPE(p2) == RBL_OBJ_INT) { if (XP_LISP_TYPE(p2) == XP_LISP_OBJ_INT) {
res = RBL_IVALUE(p1) > RBL_IVALUE(p2); res = XP_LISP_IVALUE(p1) > XP_LISP_IVALUE(p2);
} }
else if (RBL_TYPE(p2) == RBL_OBJ_FLOAT) { else if (XP_LISP_TYPE(p2) == XP_LISP_OBJ_FLOAT) {
res = RBL_IVALUE(p1) > RBL_FVALUE(p2); res = XP_LISP_IVALUE(p1) > XP_LISP_FVALUE(p2);
} }
else { else {
lsp->error = RBL_ERR_BAD_VALUE; lsp->error = XP_LISP_ERR_BAD_VALUE;
return XP_NULL; return XP_NULL;
} }
} }
else if (RBL_TYPE(p1) == RBL_OBJ_FLOAT) { else if (XP_LISP_TYPE(p1) == XP_LISP_OBJ_FLOAT) {
if (RBL_TYPE(p2) == RBL_OBJ_INT) { if (XP_LISP_TYPE(p2) == XP_LISP_OBJ_INT) {
res = RBL_FVALUE(p1) > RBL_IVALUE(p2); res = XP_LISP_FVALUE(p1) > XP_LISP_IVALUE(p2);
} }
else if (RBL_TYPE(p2) == RBL_OBJ_FLOAT) { else if (XP_LISP_TYPE(p2) == XP_LISP_OBJ_FLOAT) {
res = RBL_FVALUE(p1) > RBL_FVALUE(p2); res = XP_LISP_FVALUE(p1) > XP_LISP_FVALUE(p2);
} }
else { else {
lsp->error = RBL_ERR_BAD_VALUE; lsp->error = XP_LISP_ERR_BAD_VALUE;
return XP_NULL; return XP_NULL;
} }
} }
else if (RBL_TYPE(p1) == RBL_OBJ_SYMBOL) { else if (XP_LISP_TYPE(p1) == XP_LISP_OBJ_SYMBOL) {
if (RBL_TYPE(p2) == RBL_OBJ_SYMBOL) { if (XP_LISP_TYPE(p2) == XP_LISP_OBJ_SYMBOL) {
res = xp_lisp_comp_symbol2 ( res = xp_lisp_comp_symbol2 (
p1, RBL_SYMVALUE(p2), RBL_SYMLEN(p2)) > 0; p1, XP_LISP_SYMVALUE(p2), XP_LISP_SYMLEN(p2)) > 0;
} }
else { else {
lsp->error = RBL_ERR_BAD_VALUE; lsp->error = XP_LISP_ERR_BAD_VALUE;
return XP_NULL; return XP_NULL;
} }
} }
else if (RBL_TYPE(p1) == RBL_OBJ_STRING) { else if (XP_LISP_TYPE(p1) == XP_LISP_OBJ_STRING) {
if (RBL_TYPE(p2) == RBL_OBJ_STRING) { if (XP_LISP_TYPE(p2) == XP_LISP_OBJ_STRING) {
res = xp_lisp_comp_string2 ( res = xp_lisp_comp_string2 (
p1, RBL_STRVALUE(p2), RBL_STRLEN(p2)) > 0; p1, XP_LISP_STRVALUE(p2), XP_LISP_STRLEN(p2)) > 0;
} }
else { else {
lsp->error = RBL_ERR_BAD_VALUE; lsp->error = XP_LISP_ERR_BAD_VALUE;
return XP_NULL; return XP_NULL;
} }
} }
else { else {
lsp->error = RBL_ERR_BAD_VALUE; lsp->error = XP_LISP_ERR_BAD_VALUE;
return XP_NULL; 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; xp_lisp_obj_t* p1, * p2;
int res; int res;
RBL_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2); XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
xp_lisp_assert (RBL_TYPE(args) == RBL_OBJ_CONS); 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 (p1 == XP_NULL) return XP_NULL;
// TODO: lock p1.... // 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 (p2 == XP_NULL) return XP_NULL;
if (RBL_TYPE(p1) == RBL_OBJ_INT) { if (XP_LISP_TYPE(p1) == XP_LISP_OBJ_INT) {
if (RBL_TYPE(p2) == RBL_OBJ_INT) { if (XP_LISP_TYPE(p2) == XP_LISP_OBJ_INT) {
res = RBL_IVALUE(p1) < RBL_IVALUE(p2); res = XP_LISP_IVALUE(p1) < XP_LISP_IVALUE(p2);
} }
else if (RBL_TYPE(p2) == RBL_OBJ_FLOAT) { else if (XP_LISP_TYPE(p2) == XP_LISP_OBJ_FLOAT) {
res = RBL_IVALUE(p1) < RBL_FVALUE(p2); res = XP_LISP_IVALUE(p1) < XP_LISP_FVALUE(p2);
} }
else { else {
lsp->error = RBL_ERR_BAD_VALUE; lsp->error = XP_LISP_ERR_BAD_VALUE;
return XP_NULL; return XP_NULL;
} }
} }
else if (RBL_TYPE(p1) == RBL_OBJ_FLOAT) { else if (XP_LISP_TYPE(p1) == XP_LISP_OBJ_FLOAT) {
if (RBL_TYPE(p2) == RBL_OBJ_INT) { if (XP_LISP_TYPE(p2) == XP_LISP_OBJ_INT) {
res = RBL_FVALUE(p1) < RBL_IVALUE(p2); res = XP_LISP_FVALUE(p1) < XP_LISP_IVALUE(p2);
} }
else if (RBL_TYPE(p2) == RBL_OBJ_FLOAT) { else if (XP_LISP_TYPE(p2) == XP_LISP_OBJ_FLOAT) {
res = RBL_FVALUE(p1) < RBL_FVALUE(p2); res = XP_LISP_FVALUE(p1) < XP_LISP_FVALUE(p2);
} }
else { else {
lsp->error = RBL_ERR_BAD_VALUE; lsp->error = XP_LISP_ERR_BAD_VALUE;
return XP_NULL; return XP_NULL;
} }
} }
else if (RBL_TYPE(p1) == RBL_OBJ_SYMBOL) { else if (XP_LISP_TYPE(p1) == XP_LISP_OBJ_SYMBOL) {
if (RBL_TYPE(p2) == RBL_OBJ_SYMBOL) { if (XP_LISP_TYPE(p2) == XP_LISP_OBJ_SYMBOL) {
res = xp_lisp_comp_symbol2 ( res = xp_lisp_comp_symbol2 (
p1, RBL_SYMVALUE(p2), RBL_SYMLEN(p2)) < 0; p1, XP_LISP_SYMVALUE(p2), XP_LISP_SYMLEN(p2)) < 0;
} }
else { else {
lsp->error = RBL_ERR_BAD_VALUE; lsp->error = XP_LISP_ERR_BAD_VALUE;
return XP_NULL; return XP_NULL;
} }
} }
else if (RBL_TYPE(p1) == RBL_OBJ_STRING) { else if (XP_LISP_TYPE(p1) == XP_LISP_OBJ_STRING) {
if (RBL_TYPE(p2) == RBL_OBJ_STRING) { if (XP_LISP_TYPE(p2) == XP_LISP_OBJ_STRING) {
res = xp_lisp_comp_string2 ( res = xp_lisp_comp_string2 (
p1, RBL_STRVALUE(p2), RBL_STRLEN(p2)) < 0; p1, XP_LISP_STRVALUE(p2), XP_LISP_STRLEN(p2)) < 0;
} }
else { else {
lsp->error = RBL_ERR_BAD_VALUE; lsp->error = XP_LISP_ERR_BAD_VALUE;
return XP_NULL; return XP_NULL;
} }
} }
else { else {
lsp->error = RBL_ERR_BAD_VALUE; lsp->error = XP_LISP_ERR_BAD_VALUE;
return XP_NULL; return XP_NULL;
} }

20
ase/lsp/primitive.h
View File

@ -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_ #ifndef _XP_LISP_PRIM_H_
#define _RBL_PRIM_H_ #define _XP_LISP_PRIM_H_
#include "types.h" #include <xp/lisp/types.h>
#include "lsp.h" #include <xp/lisp/lisp.h>
typedef xp_lisp_obj_t* (*xp_lisp_pimpl_t) (xp_lisp_t*, xp_lisp_obj_t*); 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 #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; \ xp_size_t count; \
if (xp_lisp_probe_args(lsp->mem, args, &count) == -1) { \ 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; \ return XP_NULL; \
} \ } \
if (count < min) { \ if (count < min) { \
lsp->error = RBL_ERR_TOO_FEW_ARGS; \ lsp->error = XP_LISP_ERR_TOO_FEW_ARGS; \
return XP_NULL; \ return XP_NULL; \
} \ } \
if (count > max) { \ if (count > max) { \
lsp->error = RBL_ERR_TOO_MANY_ARGS; \ lsp->error = XP_LISP_ERR_TOO_MANY_ARGS; \
return XP_NULL; \ 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 #endif

124
ase/lsp/print.c
View File

@ -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 <xp/lisp/lisp.h>
void xp_lisp_print_debug (xp_lisp_obj_t* obj) void xp_lisp_print_debug (xp_lisp_obj_t* obj)
{ {
switch (RBL_TYPE(obj)) { switch (XP_LISP_TYPE(obj)) {
case RBL_OBJ_NIL: case XP_LISP_OBJ_NIL:
rb_printf ( RBL_TEXT("nil")); xp_printf ( XP_LISP_TEXT("nil"));
break; break;
case RBL_OBJ_TRUE: case XP_LISP_OBJ_TRUE:
rb_printf ( RBL_TEXT("t")); xp_printf ( XP_LISP_TEXT("t"));
break; break;
case RBL_OBJ_INT: case XP_LISP_OBJ_INT:
rb_printf ( RBL_TEXT("%d"), RBL_IVALUE(obj)); xp_printf ( XP_LISP_TEXT("%d"), XP_LISP_IVALUE(obj));
break; break;
case RBL_OBJ_FLOAT: case XP_LISP_OBJ_FLOAT:
rb_printf ( RBL_TEXT("%f"), RBL_FVALUE(obj)); xp_printf ( XP_LISP_TEXT("%f"), XP_LISP_FVALUE(obj));
break; break;
case RBL_OBJ_SYMBOL: case XP_LISP_OBJ_SYMBOL:
rb_printf ( RBL_TEXT("%s"), RBL_SYMVALUE(obj)); xp_printf ( XP_LISP_TEXT("%s"), XP_LISP_SYMVALUE(obj));
break; break;
case RBL_OBJ_STRING: case XP_LISP_OBJ_STRING:
rb_printf ( RBL_TEXT("%s"), RBL_STRVALUE(obj)); xp_printf ( XP_LISP_TEXT("%s"), XP_LISP_STRVALUE(obj));
break; break;
case RBL_OBJ_CONS: case XP_LISP_OBJ_CONS:
{ {
xp_lisp_obj_t* p = obj; xp_lisp_obj_t* p = obj;
rb_printf ( RBL_TEXT("(")); xp_printf ( XP_LISP_TEXT("("));
do { do {
xp_lisp_print_debug (RBL_CAR(p)); xp_lisp_print_debug (XP_LISP_CAR(p));
p = RBL_CDR(p); p = XP_LISP_CDR(p);
if (RBL_TYPE(p) != RBL_OBJ_NIL) { if (XP_LISP_TYPE(p) != XP_LISP_OBJ_NIL) {
rb_printf ( RBL_TEXT(" ")); xp_printf ( XP_LISP_TEXT(" "));
if (RBL_TYPE(p) != RBL_OBJ_CONS) { if (XP_LISP_TYPE(p) != XP_LISP_OBJ_CONS) {
rb_printf ( RBL_TEXT(". ")); xp_printf ( XP_LISP_TEXT(". "));
xp_lisp_print_debug (p); xp_lisp_print_debug (p);
} }
} }
} while (RBL_TYPE(p) != RBL_OBJ_NIL && RBL_TYPE(p) == RBL_OBJ_CONS); } while (XP_LISP_TYPE(p) != XP_LISP_OBJ_NIL && XP_LISP_TYPE(p) == XP_LISP_OBJ_CONS);
rb_printf ( RBL_TEXT(")")); xp_printf ( XP_LISP_TEXT(")"));
} }
break; break;
case RBL_OBJ_FUNC: case XP_LISP_OBJ_FUNC:
rb_printf ( RBL_TEXT("func")); xp_printf ( XP_LISP_TEXT("func"));
break; break;
case RBL_OBJ_MACRO: case XP_LISP_OBJ_MACRO:
rb_printf (RBL_TEXT("macro")); xp_printf (XP_LISP_TEXT("macro"));
break; break;
case RBL_OBJ_PRIM: case XP_LISP_OBJ_PRIM:
rb_printf (RBL_TEXT("prim")); xp_printf (XP_LISP_TEXT("prim"));
break; break;
default: 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) void xp_lisp_print (xp_lisp_t* lsp, xp_lisp_obj_t* obj)
{ {
switch (RBL_TYPE(obj)) { switch (XP_LISP_TYPE(obj)) {
case RBL_OBJ_NIL: case XP_LISP_OBJ_NIL:
rb_fprintf (lsp->outstream, RBL_TEXT("nil")); xp_fprintf (lsp->outstream, XP_LISP_TEXT("nil"));
break; break;
case RBL_OBJ_TRUE: case XP_LISP_OBJ_TRUE:
rb_fprintf (lsp->outstream, RBL_TEXT("t")); xp_fprintf (lsp->outstream, XP_LISP_TEXT("t"));
break; break;
case RBL_OBJ_INT: case XP_LISP_OBJ_INT:
rb_fprintf (lsp->outstream, RBL_TEXT("%d"), RBL_IVALUE(obj)); xp_fprintf (lsp->outstream, XP_LISP_TEXT("%d"), XP_LISP_IVALUE(obj));
break; break;
case RBL_OBJ_FLOAT: case XP_LISP_OBJ_FLOAT:
rb_fprintf (lsp->outstream, RBL_TEXT("%f"), RBL_FVALUE(obj)); xp_fprintf (lsp->outstream, XP_LISP_TEXT("%f"), XP_LISP_FVALUE(obj));
break; break;
case RBL_OBJ_SYMBOL: case XP_LISP_OBJ_SYMBOL:
rb_fprintf (lsp->outstream, RBL_TEXT("%s"), RBL_SYMVALUE(obj)); xp_fprintf (lsp->outstream, XP_LISP_TEXT("%s"), XP_LISP_SYMVALUE(obj));
break; break;
case RBL_OBJ_STRING: case XP_LISP_OBJ_STRING:
rb_fprintf (lsp->outstream, RBL_TEXT("\"%s\""), RBL_STRVALUE(obj)); xp_fprintf (lsp->outstream, XP_LISP_TEXT("\"%s\""), XP_LISP_STRVALUE(obj));
break; break;
case RBL_OBJ_CONS: case XP_LISP_OBJ_CONS:
{ {
xp_lisp_obj_t* p = obj; xp_lisp_obj_t* p = obj;
rb_fprintf (lsp->outstream, RBL_TEXT("(")); xp_fprintf (lsp->outstream, XP_LISP_TEXT("("));
do { do {
xp_lisp_print (lsp, RBL_CAR(p)); xp_lisp_print (lsp, XP_LISP_CAR(p));
p = RBL_CDR(p); p = XP_LISP_CDR(p);
if (p != lsp->mem->nil) { if (p != lsp->mem->nil) {
rb_fprintf (lsp->outstream, RBL_TEXT(" ")); xp_fprintf (lsp->outstream, XP_LISP_TEXT(" "));
if (RBL_TYPE(p) != RBL_OBJ_CONS) { if (XP_LISP_TYPE(p) != XP_LISP_OBJ_CONS) {
rb_fprintf (lsp->outstream, RBL_TEXT(". ")); xp_fprintf (lsp->outstream, XP_LISP_TEXT(". "));
xp_lisp_print (lsp, p); xp_lisp_print (lsp, p);
} }
} }
} while (p != lsp->mem->nil && RBL_TYPE(p) == RBL_OBJ_CONS); } while (p != lsp->mem->nil && XP_LISP_TYPE(p) == XP_LISP_OBJ_CONS);
rb_fprintf (lsp->outstream, RBL_TEXT(")")); xp_fprintf (lsp->outstream, XP_LISP_TEXT(")"));
} }
break; break;
case RBL_OBJ_FUNC: case XP_LISP_OBJ_FUNC:
rb_fprintf (lsp->outstream, RBL_TEXT("func")); xp_fprintf (lsp->outstream, XP_LISP_TEXT("func"));
break; break;
case RBL_OBJ_MACRO: case XP_LISP_OBJ_MACRO:
rb_fprintf (lsp->outstream, RBL_TEXT("macro")); xp_fprintf (lsp->outstream, XP_LISP_TEXT("macro"));
break; break;
case RBL_OBJ_PRIM: case XP_LISP_OBJ_PRIM:
rb_fprintf (lsp->outstream, RBL_TEXT("prim")); xp_fprintf (lsp->outstream, XP_LISP_TEXT("prim"));
break; break;
default: default:
rb_fprintf (lsp->outstream, xp_fprintf (lsp->outstream,
RBL_TEXT("unknown object type: %d"), RBL_TYPE(obj)); XP_LISP_TEXT("unknown object type: %d"), XP_LISP_TYPE(obj));
} }
} }

132
ase/lsp/read.c
View File

@ -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 <xp/lisp/lisp.h>
#include "token.h" #include <xp/lisp/token.h>
#define IS_SPACE(x) rb_isspace(x) #define IS_SPACE(x) xp_isspace(x)
#define IS_DIGIT(x) rb_isdigit(x) #define IS_DIGIT(x) xp_isdigit(x)
#define IS_ALPHA(x) rb_isalpha(x) #define IS_ALPHA(x) xp_isalpha(x)
#define IS_ALNUM(x) rb_isalnum(x) #define IS_ALNUM(x) xp_isalnum(x)
#define IS_IDENT(c) \ #define IS_IDENT(c) \
((c) == RBL_CHAR('+') || (c) == RBL_CHAR('-') || \ ((c) == XP_LISP_CHAR('+') || (c) == XP_LISP_CHAR('-') || \
(c) == RBL_CHAR('*') || (c) == RBL_CHAR('/') || \ (c) == XP_LISP_CHAR('*') || (c) == XP_LISP_CHAR('/') || \
(c) == RBL_CHAR('%') || (c) == RBL_CHAR('&') || \ (c) == XP_LISP_CHAR('%') || (c) == XP_LISP_CHAR('&') || \
(c) == RBL_CHAR('<') || (c) == RBL_CHAR('>') || \ (c) == XP_LISP_CHAR('<') || (c) == XP_LISP_CHAR('>') || \
(c) == RBL_CHAR('=') || (c) == RBL_CHAR('_') || \ (c) == XP_LISP_CHAR('=') || (c) == XP_LISP_CHAR('_') || \
(c) == RBL_CHAR('?')) (c) == XP_LISP_CHAR('?'))
#define TOKEN_CLEAR(lsp) xp_lisp_token_clear (lsp->token) #define TOKEN_CLEAR(lsp) xp_lisp_token_clear (lsp->token)
#define TOKEN_TYPE(lsp) lsp->token->type #define TOKEN_TYPE(lsp) lsp->token->type
@ -27,7 +27,7 @@
#define TOKEN_ADD_CHAR(lsp,ch) \ #define TOKEN_ADD_CHAR(lsp,ch) \
do { \ do { \
if (xp_lisp_token_addc (lsp->token, ch) == -1) { \ if (xp_lisp_token_addc (lsp->token, ch) == -1) { \
lsp->error = RBL_ERR_MEM; \ lsp->error = XP_LISP_ERR_MEM; \
return -1; \ return -1; \
} \ } \
} while (0) } while (0)
@ -66,7 +66,7 @@ static int read_string (xp_lisp_t* lsp);
#define NEXT_CHAR(lsp) \ #define NEXT_CHAR(lsp) \
do { \ do { \
if (lsp->creader (&lsp->curc, lsp->creader_extra) == -1) { \ if (lsp->creader (&lsp->curc, lsp->creader_extra) == -1) { \
lsp->error = RBL_ERR_READ; \ lsp->error = XP_LISP_ERR_READ; \
return -1; \ return -1; \
} \ } \
} while (0) } while (0)
@ -93,13 +93,13 @@ xp_lisp_obj_t* xp_lisp_read (xp_lisp_t* lsp)
if (lsp->creader_just_set) { if (lsp->creader_just_set) {
// NEXT_CHAR (lsp); // NEXT_CHAR (lsp);
if (lsp->creader (&lsp->curc, lsp->creader_extra) == -1) { if (lsp->creader (&lsp->curc, lsp->creader_extra) == -1) {
lsp->error = RBL_ERR_READ; lsp->error = XP_LISP_ERR_READ;
return XP_NULL; return XP_NULL;
} }
lsp->creader_just_set = 0; lsp->creader_just_set = 0;
} }
lsp->error = RBL_ERR_NONE; lsp->error = XP_LISP_ERR_NONE;
NEXT_TOKEN (lsp); NEXT_TOKEN (lsp);
if (lsp->mem->locked != XP_NULL) { 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)) { switch (TOKEN_TYPE(lsp)) {
case TOKEN_END: case TOKEN_END:
lsp->error = RBL_ERR_END; lsp->error = XP_LISP_ERR_END;
return XP_NULL; return XP_NULL;
case TOKEN_LPAREN: case TOKEN_LPAREN:
NEXT_TOKEN (lsp); NEXT_TOKEN (lsp);
@ -126,34 +126,34 @@ static xp_lisp_obj_t* read_obj (xp_lisp_t* lsp)
return read_quote (lsp); return read_quote (lsp);
case TOKEN_INT: case TOKEN_INT:
obj = xp_lisp_make_int (lsp->mem, TOKEN_IVALUE(lsp)); 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); xp_lisp_lock (obj);
return obj; return obj;
case TOKEN_FLOAT: case TOKEN_FLOAT:
obj = xp_lisp_make_float (lsp->mem, TOKEN_FVALUE(lsp)); 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); xp_lisp_lock (obj);
return obj; return obj;
case TOKEN_STRING: case TOKEN_STRING:
obj = xp_lisp_make_string ( obj = xp_lisp_make_string (
lsp->mem, TOKEN_SVALUE(lsp), TOKEN_SLENGTH(lsp)); 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); xp_lisp_lock (obj);
return obj; return obj;
case TOKEN_IDENT: case TOKEN_IDENT:
xp_lisp_assert (lsp->mem->nil != XP_NULL && lsp->mem->t != XP_NULL); 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; if (TOKEN_COMPARE(lsp, XP_LISP_TEXT("nil")) == 0) obj = lsp->mem->nil;
else if (TOKEN_COMPARE(lsp, RBL_TEXT("t")) == 0) obj = lsp->mem->t; else if (TOKEN_COMPARE(lsp, XP_LISP_TEXT("t")) == 0) obj = lsp->mem->t;
else { else {
obj = xp_lisp_make_symbol ( obj = xp_lisp_make_symbol (
lsp->mem, TOKEN_SVALUE(lsp), TOKEN_SLENGTH(lsp)); 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); xp_lisp_lock (obj);
} }
return obj; return obj;
} }
lsp->error = RBL_ERR_SYNTAX; lsp->error = XP_LISP_ERR_SYNTAX;
return XP_NULL; return XP_NULL;
} }
@ -164,22 +164,22 @@ static xp_lisp_obj_t* read_list (xp_lisp_t* lsp)
while (TOKEN_TYPE(lsp) != TOKEN_RPAREN) { while (TOKEN_TYPE(lsp) != TOKEN_RPAREN) {
if (TOKEN_TYPE(lsp) == TOKEN_END) { 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; return XP_NULL;
} }
if (TOKEN_TYPE(lsp) == TOKEN_DOT) { if (TOKEN_TYPE(lsp) == TOKEN_DOT) {
if (prev == XP_NULL) { if (prev == XP_NULL) {
lsp->error = RBL_ERR_SYNTAX; // unexpected . lsp->error = XP_LISP_ERR_SYNTAX; // unexpected .
return XP_NULL; return XP_NULL;
} }
NEXT_TOKEN (lsp); NEXT_TOKEN (lsp);
obj = read_obj (lsp); obj = read_obj (lsp);
if (obj == XP_NULL) { if (obj == XP_NULL) {
if (lsp->error == RBL_ERR_END) { if (lsp->error == XP_LISP_ERR_END) {
//unexpected end of input //unexpected end of input
lsp->error = RBL_ERR_SYNTAX; lsp->error = XP_LISP_ERR_SYNTAX;
} }
return XP_NULL; return XP_NULL;
} }
@ -187,7 +187,7 @@ static xp_lisp_obj_t* read_list (xp_lisp_t* lsp)
NEXT_TOKEN (lsp); NEXT_TOKEN (lsp);
if (TOKEN_TYPE(lsp) != TOKEN_RPAREN) { if (TOKEN_TYPE(lsp) != TOKEN_RPAREN) {
lsp->error = RBL_ERR_SYNTAX; // ) expected lsp->error = XP_LISP_ERR_SYNTAX; // ) expected
return XP_NULL; return XP_NULL;
} }
@ -196,9 +196,9 @@ static xp_lisp_obj_t* read_list (xp_lisp_t* lsp)
obj = read_obj (lsp); obj = read_obj (lsp);
if (obj == XP_NULL) { if (obj == XP_NULL) {
if (lsp->error == RBL_ERR_END) { if (lsp->error == XP_LISP_ERR_END) {
// unexpected end of input // unexpected end of input
lsp->error = RBL_ERR_SYNTAX; lsp->error = XP_LISP_ERR_SYNTAX;
} }
return XP_NULL; 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 ( p = (xp_lisp_obj_cons_t*)xp_lisp_make_cons (
lsp->mem, lsp->mem->nil, lsp->mem->nil); lsp->mem, lsp->mem->nil, lsp->mem->nil);
if (p == XP_NULL) { if (p == XP_NULL) {
lsp->error = RBL_ERR_MEM; lsp->error = XP_LISP_ERR_MEM;
return XP_NULL; return XP_NULL;
} }
xp_lisp_lock ((xp_lisp_obj_t*)p); 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); tmp = read_obj (lsp);
if (tmp == XP_NULL) { if (tmp == XP_NULL) {
if (lsp->error == RBL_ERR_END) { if (lsp->error == XP_LISP_ERR_END) {
// unexpected end of input // unexpected end of input
lsp->error = RBL_ERR_SYNTAX; lsp->error = XP_LISP_ERR_SYNTAX;
} }
return XP_NULL; return XP_NULL;
} }
cons = xp_lisp_make_cons (lsp->mem, tmp, lsp->mem->nil); cons = xp_lisp_make_cons (lsp->mem, tmp, lsp->mem->nil);
if (cons == XP_NULL) { if (cons == XP_NULL) {
lsp->error = RBL_ERR_MEM; lsp->error = XP_LISP_ERR_MEM;
return XP_NULL; return XP_NULL;
} }
xp_lisp_lock (cons); xp_lisp_lock (cons);
cons = xp_lisp_make_cons (lsp->mem, lsp->mem->quote, cons); cons = xp_lisp_make_cons (lsp->mem, lsp->mem->quote, cons);
if (cons == XP_NULL) { if (cons == XP_NULL) {
lsp->error = RBL_ERR_MEM; lsp->error = XP_LISP_ERR_MEM;
return XP_NULL; return XP_NULL;
} }
xp_lisp_lock (cons); xp_lisp_lock (cons);
@ -264,43 +264,43 @@ static int read_token (xp_lisp_t* lsp)
while (IS_SPACE(lsp->curc)) NEXT_CHAR (lsp); while (IS_SPACE(lsp->curc)) NEXT_CHAR (lsp);
// skip the comments here // skip the comments here
if (lsp->curc == RBL_CHAR(';')) { if (lsp->curc == XP_LISP_CHAR(';')) {
do { do {
NEXT_CHAR (lsp); 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; else break;
} }
if (lsp->curc == RBL_CHAR_END) { if (lsp->curc == XP_LISP_CHAR_END) {
TOKEN_TYPE(lsp) = TOKEN_END; TOKEN_TYPE(lsp) = TOKEN_END;
return 0; return 0;
} }
else if (lsp->curc == RBL_CHAR('(')) { else if (lsp->curc == XP_LISP_CHAR('(')) {
TOKEN_ADD_CHAR (lsp, lsp->curc); TOKEN_ADD_CHAR (lsp, lsp->curc);
TOKEN_TYPE(lsp) = TOKEN_LPAREN; TOKEN_TYPE(lsp) = TOKEN_LPAREN;
NEXT_CHAR (lsp); NEXT_CHAR (lsp);
return 0; return 0;
} }
else if (lsp->curc == RBL_CHAR(')')) { else if (lsp->curc == XP_LISP_CHAR(')')) {
TOKEN_ADD_CHAR (lsp, lsp->curc); TOKEN_ADD_CHAR (lsp, lsp->curc);
TOKEN_TYPE(lsp) = TOKEN_RPAREN; TOKEN_TYPE(lsp) = TOKEN_RPAREN;
NEXT_CHAR (lsp); NEXT_CHAR (lsp);
return 0; return 0;
} }
else if (lsp->curc == RBL_CHAR('\'')) { else if (lsp->curc == XP_LISP_CHAR('\'')) {
TOKEN_ADD_CHAR (lsp, lsp->curc); TOKEN_ADD_CHAR (lsp, lsp->curc);
TOKEN_TYPE(lsp) = TOKEN_QUOTE; TOKEN_TYPE(lsp) = TOKEN_QUOTE;
NEXT_CHAR (lsp); NEXT_CHAR (lsp);
return 0; return 0;
} }
else if (lsp->curc == RBL_CHAR('.')) { else if (lsp->curc == XP_LISP_CHAR('.')) {
TOKEN_ADD_CHAR (lsp, lsp->curc); TOKEN_ADD_CHAR (lsp, lsp->curc);
TOKEN_TYPE(lsp) = TOKEN_DOT; TOKEN_TYPE(lsp) = TOKEN_DOT;
NEXT_CHAR (lsp); NEXT_CHAR (lsp);
return 0; return 0;
} }
else if (lsp->curc == RBL_CHAR('-')) { else if (lsp->curc == XP_LISP_CHAR('-')) {
TOKEN_ADD_CHAR (lsp, lsp->curc); TOKEN_ADD_CHAR (lsp, lsp->curc);
NEXT_CHAR (lsp); NEXT_CHAR (lsp);
return (IS_DIGIT(lsp->curc))? 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)) { else if (IS_ALPHA(lsp->curc) || IS_IDENT(lsp->curc)) {
return read_ident (lsp); return read_ident (lsp);
} }
else if (lsp->curc == RBL_CHAR('\"')) { else if (lsp->curc == XP_LISP_CHAR('\"')) {
NEXT_CHAR (lsp); NEXT_CHAR (lsp);
return read_string (lsp); return read_string (lsp);
} }
@ -326,7 +326,7 @@ static int read_number (xp_lisp_t* lsp, int negative)
{ {
do { do {
TOKEN_IVALUE(lsp) = 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); TOKEN_ADD_CHAR (lsp, lsp->curc);
NEXT_CHAR (lsp); NEXT_CHAR (lsp);
} while (IS_DIGIT(lsp->curc)); } while (IS_DIGIT(lsp->curc));
@ -355,7 +355,7 @@ static int read_string (xp_lisp_t* lsp)
xp_lisp_cint code = 0; xp_lisp_cint code = 0;
do { do {
if (lsp->curc == RBL_CHAR_END) { if (lsp->curc == XP_LISP_CHAR_END) {
TOKEN_TYPE(lsp) = TOKEN_UNTERM_STRING; TOKEN_TYPE(lsp) = TOKEN_UNTERM_STRING;
return 0; return 0;
} }
@ -369,34 +369,34 @@ static int read_string (xp_lisp_t* lsp)
} }
else if (escaped == 1) { else if (escaped == 1) {
/* backslash + character */ /* backslash + character */
if (lsp->curc == RBL_CHAR('a')) if (lsp->curc == XP_LISP_CHAR('a'))
lsp->curc = RBL_CHAR('\a'); lsp->curc = XP_LISP_CHAR('\a');
else if (lsp->curc == RBL_CHAR('b')) else if (lsp->curc == XP_LISP_CHAR('b'))
lsp->curc = RBL_CHAR('\b'); lsp->curc = XP_LISP_CHAR('\b');
else if (lsp->curc == RBL_CHAR('f')) else if (lsp->curc == XP_LISP_CHAR('f'))
lsp->curc = RBL_CHAR('\f'); lsp->curc = XP_LISP_CHAR('\f');
else if (lsp->curc == RBL_CHAR('n')) else if (lsp->curc == XP_LISP_CHAR('n'))
lsp->curc = RBL_CHAR('\n'); lsp->curc = XP_LISP_CHAR('\n');
else if (lsp->curc == RBL_CHAR('r')) else if (lsp->curc == XP_LISP_CHAR('r'))
lsp->curc = RBL_CHAR('\r'); lsp->curc = XP_LISP_CHAR('\r');
else if (lsp->curc == RBL_CHAR('t')) else if (lsp->curc == XP_LISP_CHAR('t'))
lsp->curc = RBL_CHAR('\t'); lsp->curc = XP_LISP_CHAR('\t');
else if (lsp->curc == RBL_CHAR('v')) else if (lsp->curc == XP_LISP_CHAR('v'))
lsp->curc = RBL_CHAR('\v'); lsp->curc = XP_LISP_CHAR('\v');
else if (lsp->curc == RBL_CHAR('0')) { else if (lsp->curc == XP_LISP_CHAR('0')) {
escaped = 2; escaped = 2;
code = 0; code = 0;
NEXT_CHAR (lsp); NEXT_CHAR (lsp);
continue; continue;
} }
else if (lsp->curc == RBL_CHAR('x')) { else if (lsp->curc == XP_LISP_CHAR('x')) {
escaped = 3; escaped = 3;
code = 0; code = 0;
NEXT_CHAR (lsp); NEXT_CHAR (lsp);
continue; continue;
} }
} }
else if (lsp->curc == RBL_CHAR('\\')) { else if (lsp->curc == XP_LISP_CHAR('\\')) {
escaped = 1; escaped = 1;
NEXT_CHAR (lsp); NEXT_CHAR (lsp);
continue; continue;
@ -404,7 +404,7 @@ static int read_string (xp_lisp_t* lsp)
TOKEN_ADD_CHAR (lsp, lsp->curc); TOKEN_ADD_CHAR (lsp, lsp->curc);
NEXT_CHAR (lsp); NEXT_CHAR (lsp);
} while (lsp->curc != RBL_CHAR('\"')); } while (lsp->curc != XP_LISP_CHAR('\"'));
TOKEN_TYPE(lsp) = TOKEN_STRING; TOKEN_TYPE(lsp) = TOKEN_STRING;
NEXT_CHAR (lsp); NEXT_CHAR (lsp);

12
ase/lsp/token.c
View File

@ -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" #include "token.h"
@ -25,7 +25,7 @@ xp_lisp_token_t* xp_lisp_token_new (xp_size_t capacity)
token->size = 0; token->size = 0;
token->capacity = capacity; token->capacity = capacity;
token->buffer[0] = RBL_CHAR('\0'); token->buffer[0] = XP_LISP_CHAR('\0');
return token; 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++] = c;
token->buffer[token->size] = RBL_CHAR('\0'); token->buffer[token->size] = XP_LISP_CHAR('\0');
return 0; return 0;
} }
@ -58,7 +58,7 @@ void xp_lisp_token_clear (xp_lisp_token_t* token)
token->fvalue = .0; token->fvalue = .0;
token->size = 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) 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->buffer = new_buffer;
token->size = 0; token->size = 0;
token->capacity = capacity; token->capacity = capacity;
token->buffer[0] = RBL_CHAR('\0'); token->buffer[0] = XP_LISP_CHAR('\0');
return old_buffer; 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++; index++; p++; str++;
} }
return (*str == RBL_CHAR('\0'))? 0: -1; return (*str == XP_LISP_CHAR('\0'))? 0: -1;
} }

6
ase/lsp/token.h
View File

@ -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_ #ifndef _XP_LISP_TOKEN_H_
#define _RBL_TOKEN_H_ #define _XP_LISP_TOKEN_H_
#include "types.h" #include "types.h"