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-05 05:18:20 +00:00
parent fd9839e424
commit b472d0006a
11 changed files with 326 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
ase/lsp/env.c
View File

@ -1,5 +1,5 @@
/* /*
* $Id: env.c,v 1.2 2005-02-04 16:00:37 bacon Exp $ * $Id: env.c,v 1.3 2005-02-05 05:18:20 bacon Exp $
*/ */
#include <xp/lisp/env.h> #include <xp/lisp/env.h>
@ -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 (XP_LISP_TYPE(name) == XP_LISP_OBJ_SYMBOL); xp_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 (XP_LISP_TYPE(name) == XP_LISP_OBJ_SYMBOL); xp_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/eval.c
View File

@ -1,5 +1,5 @@
/* /*
* $Id: eval.c,v 1.3 2005-02-04 16:23:34 bacon Exp $ * $Id: eval.c,v 1.4 2005-02-05 05:18:20 bacon Exp $
*/ */
#include <xp/lisp/lisp.h> #include <xp/lisp/lisp.h>
@ -89,7 +89,7 @@ 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 (XP_LISP_TYPE(cons) == XP_LISP_OBJ_CONS); xp_assert (XP_LISP_TYPE(cons) == XP_LISP_OBJ_CONS);
car = XP_LISP_CAR(cons); car = XP_LISP_CAR(cons);
cdr = XP_LISP_CDR(cons); cdr = XP_LISP_CDR(cons);
@ -162,11 +162,11 @@ static xp_lisp_obj_t* apply (xp_lisp_t* lsp, xp_lisp_obj_t* func, xp_lisp_obj_t*
xp_lisp_obj_t* value; xp_lisp_obj_t* value;
xp_lisp_mem_t* mem; xp_lisp_mem_t* mem;
xp_lisp_assert ( xp_assert (
XP_LISP_TYPE(func) == XP_LISP_OBJ_FUNC || XP_LISP_TYPE(func) == XP_LISP_OBJ_FUNC ||
XP_LISP_TYPE(func) == XP_LISP_OBJ_MACRO); XP_LISP_TYPE(func) == XP_LISP_OBJ_MACRO);
xp_lisp_assert (XP_LISP_TYPE(XP_LISP_CDR(func)) == XP_LISP_OBJ_CONS); xp_assert (XP_LISP_TYPE(XP_LISP_CDR(func)) == XP_LISP_OBJ_CONS);
mem = lsp->mem; mem = lsp->mem;

4
ase/lsp/lisp.c
View File

@ -1,5 +1,5 @@
/* /*
* $Id: lisp.c,v 1.3 2005-02-04 16:23:34 bacon Exp $ * $Id: lisp.c,v 1.4 2005-02-05 05:18:20 bacon Exp $
*/ */
#include <xp/lisp/lisp.h> #include <xp/lisp/lisp.h>
@ -47,7 +47,7 @@ xp_lisp_t* xp_lisp_new (xp_size_t mem_ubound, xp_size_t mem_ubound_inc)
void xp_lisp_free (xp_lisp_t* lsp) void xp_lisp_free (xp_lisp_t* lsp)
{ {
xp_lisp_assert (lsp != XP_NULL); xp_assert (lsp != XP_NULL);
xp_lisp_mem_free (lsp->mem); xp_lisp_mem_free (lsp->mem);
xp_lisp_token_free (lsp->token); xp_lisp_token_free (lsp->token);

30
ase/lsp/memory.c
View File

@ -1,5 +1,5 @@
/* /*
* $Id: memory.c,v 1.3 2005-02-04 16:23:34 bacon Exp $ * $Id: memory.c,v 1.4 2005-02-05 05:18:20 bacon Exp $
*/ */
#include <xp/lisp/memory.h> #include <xp/lisp/memory.h>
@ -74,7 +74,7 @@ xp_lisp_mem_t* xp_lisp_mem_new (xp_size_t ubound, xp_size_t ubound_inc)
void xp_lisp_mem_free (xp_lisp_mem_t* mem) void xp_lisp_mem_free (xp_lisp_mem_t* mem)
{ {
xp_lisp_assert (mem != XP_NULL); xp_assert (mem != XP_NULL);
// dispose of the allocated objects // dispose of the allocated objects
xp_lisp_dispose_all (mem); xp_lisp_dispose_all (mem);
@ -179,9 +179,9 @@ xp_lisp_obj_t* xp_lisp_allocate (xp_lisp_mem_t* mem, int type, xp_size_t size)
void xp_lisp_dispose (xp_lisp_mem_t* mem, xp_lisp_obj_t* prev, xp_lisp_obj_t* obj) void xp_lisp_dispose (xp_lisp_mem_t* mem, xp_lisp_obj_t* prev, xp_lisp_obj_t* obj)
{ {
xp_lisp_assert (mem != XP_NULL); xp_assert (mem != XP_NULL);
xp_lisp_assert (obj != XP_NULL); xp_assert (obj != XP_NULL);
xp_lisp_assert (mem->count > 0); xp_assert (mem->count > 0);
// TODO: push the object to the free list for more // TODO: push the object to the free list for more
// efficient memory management // efficient memory management
@ -214,7 +214,7 @@ void xp_lisp_dispose_all (xp_lisp_mem_t* mem)
static void xp_lisp_mark_obj (xp_lisp_obj_t* obj) static void xp_lisp_mark_obj (xp_lisp_obj_t* obj)
{ {
xp_lisp_assert (obj != XP_NULL); xp_assert (obj != XP_NULL);
// TODO:.... // TODO:....
// can it be recursive? // can it be recursive?
@ -241,20 +241,20 @@ 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_assert (obj != XP_NULL);
XP_LISP_LOCK(obj) = 1; XP_LISP_LOCK(obj) = 1;
//XP_LISP_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_assert (obj != XP_NULL);
XP_LISP_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_assert (obj != XP_NULL);
XP_LISP_LOCK(obj) = 0; XP_LISP_LOCK(obj) = 0;
@ -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 (XP_LISP_TYPE(name) == XP_LISP_OBJ_SYMBOL); xp_assert (XP_LISP_TYPE(name) == XP_LISP_OBJ_SYMBOL);
frame = mem->frame; frame = mem->frame;
@ -530,7 +530,7 @@ 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 || XP_LISP_TYPE(obj) == XP_LISP_OBJ_CONS); xp_assert (obj == mem->nil || XP_LISP_TYPE(obj) == XP_LISP_OBJ_CONS);
count = 0; count = 0;
//while (obj != mem->nil) { //while (obj != mem->nil) {
@ -562,7 +562,7 @@ 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 (XP_LISP_TYPE(obj) == XP_LISP_OBJ_SYMBOL); xp_assert (XP_LISP_TYPE(obj) == XP_LISP_OBJ_SYMBOL);
index = 0; index = 0;
length = XP_LISP_SYMLEN(obj); length = XP_LISP_SYMLEN(obj);
@ -582,7 +582,7 @@ 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 (XP_LISP_TYPE(obj) == XP_LISP_OBJ_SYMBOL); xp_assert (XP_LISP_TYPE(obj) == XP_LISP_OBJ_SYMBOL);
index = 0; index = 0;
length = XP_LISP_SYMLEN(obj); length = XP_LISP_SYMLEN(obj);
@ -603,7 +603,7 @@ 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 (XP_LISP_TYPE(obj) == XP_LISP_OBJ_STRING); xp_assert (XP_LISP_TYPE(obj) == XP_LISP_OBJ_STRING);
index = 0; index = 0;
length = XP_LISP_STRLEN(obj); length = XP_LISP_STRLEN(obj);
@ -623,7 +623,7 @@ 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 (XP_LISP_TYPE(obj) == XP_LISP_OBJ_STRING); xp_assert (XP_LISP_TYPE(obj) == XP_LISP_OBJ_STRING);
index = 0; index = 0;
length = XP_LISP_STRLEN(obj); length = XP_LISP_STRLEN(obj);

32
ase/lsp/primitive.c
View File

@ -1,10 +1,10 @@
/* /*
* $Id: primitive.c,v 1.2 2005-02-04 16:00:37 bacon Exp $ * $Id: primitive.c,v 1.3 2005-02-05 05:18:20 bacon Exp $
*/ */
#include "lisp.h" #include <xp/lisp/lisp.h>
#include "memory.h" #include <xp/lisp/memory.h>
#include "primitive.h" #include <xp/lisp/primitive.h>
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)
{ {
@ -18,7 +18,7 @@ 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;
XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1); XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1);
xp_lisp_assert (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS); xp_assert (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS);
tmp = xp_lisp_eval (lsp, XP_LISP_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;
@ -130,7 +130,7 @@ 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;
XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, XP_LISP_PRIM_MAX_ARG_COUNT); XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, XP_LISP_PRIM_MAX_ARG_COUNT);
xp_lisp_assert (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS); xp_assert (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS);
tmp = xp_lisp_eval (lsp, XP_LISP_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;
@ -169,7 +169,7 @@ 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;
XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, XP_LISP_PRIM_MAX_ARG_COUNT); XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, XP_LISP_PRIM_MAX_ARG_COUNT);
xp_lisp_assert (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS); xp_assert (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS);
for (;;) { for (;;) {
tmp = xp_lisp_eval (lsp, XP_LISP_CAR(args)); tmp = xp_lisp_eval (lsp, XP_LISP_CAR(args));
@ -195,7 +195,7 @@ 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;
XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1); XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1);
xp_lisp_assert (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS); xp_assert (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS);
tmp = xp_lisp_eval (lsp, XP_LISP_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;
@ -214,7 +214,7 @@ 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;
XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1); XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1);
xp_lisp_assert (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS); xp_assert (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS);
tmp = xp_lisp_eval (lsp, XP_LISP_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;
@ -233,7 +233,7 @@ 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;
XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2); XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
xp_lisp_assert (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS); xp_assert (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS);
car = xp_lisp_eval (lsp, XP_LISP_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;
@ -255,7 +255,7 @@ 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;
XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2); XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
xp_lisp_assert (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS); xp_assert (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS);
p1 = xp_lisp_eval (lsp, XP_LISP_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;
@ -281,7 +281,7 @@ 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 (XP_LISP_TYPE(p) == XP_LISP_OBJ_CONS); xp_assert (XP_LISP_TYPE(p) == XP_LISP_OBJ_CONS);
p1 = XP_LISP_CAR(p); p1 = XP_LISP_CAR(p);
if (XP_LISP_TYPE(p1) != XP_LISP_OBJ_SYMBOL) { if (XP_LISP_TYPE(p1) != XP_LISP_OBJ_SYMBOL) {
@ -311,7 +311,7 @@ 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)
{ {
XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1); XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1);
xp_lisp_assert (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS); xp_assert (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS);
return XP_LISP_CAR(args); return XP_LISP_CAR(args);
} }
@ -525,7 +525,7 @@ xp_lisp_obj_t* xp_lisp_prim_plus (xp_lisp_t* lsp, xp_lisp_obj_t* args)
xp_lisp_int value = 0; xp_lisp_int value = 0;
XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, XP_LISP_PRIM_MAX_ARG_COUNT); XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, XP_LISP_PRIM_MAX_ARG_COUNT);
xp_lisp_assert (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS); xp_assert (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS);
body = args; body = args;
//while (body != lsp->mem->nil) { //while (body != lsp->mem->nil) {
@ -557,7 +557,7 @@ xp_lisp_obj_t* xp_lisp_prim_gt (xp_lisp_t* lsp, xp_lisp_obj_t* args)
int res; int res;
XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2); XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
xp_lisp_assert (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS); xp_assert (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS);
p1 = xp_lisp_eval (lsp, XP_LISP_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;
@ -624,7 +624,7 @@ xp_lisp_obj_t* xp_lisp_prim_lt (xp_lisp_t* lsp, xp_lisp_obj_t* args)
int res; int res;
XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2); XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
xp_lisp_assert (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS); xp_assert (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS);
p1 = xp_lisp_eval (lsp, XP_LISP_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;

10
ase/lsp/read.c
View File

@ -1,5 +1,5 @@
/* /*
* $Id: read.c,v 1.3 2005-02-04 16:23:34 bacon Exp $ * $Id: read.c,v 1.4 2005-02-05 05:18:20 bacon Exp $
*/ */
#include <xp/lisp/lisp.h> #include <xp/lisp/lisp.h>
@ -79,7 +79,7 @@ static int read_string (xp_lisp_t* lsp);
void xp_lisp_set_creader (xp_lisp_t* lsp, xp_lisp_creader_t func, void* extra) void xp_lisp_set_creader (xp_lisp_t* lsp, xp_lisp_creader_t func, void* extra)
{ {
xp_lisp_assert (lsp != XP_NULL); xp_assert (lsp != XP_NULL);
lsp->creader = func; lsp->creader = func;
lsp->creader_extra = extra; lsp->creader_extra = extra;
@ -88,7 +88,7 @@ void xp_lisp_set_creader (xp_lisp_t* lsp, xp_lisp_creader_t func, void* extra)
xp_lisp_obj_t* xp_lisp_read (xp_lisp_t* lsp) xp_lisp_obj_t* xp_lisp_read (xp_lisp_t* lsp)
{ {
xp_lisp_assert (lsp != XP_NULL && lsp->creader != XP_NULL); xp_assert (lsp != XP_NULL && lsp->creader != XP_NULL);
if (lsp->creader_just_set) { if (lsp->creader_just_set) {
// NEXT_CHAR (lsp); // NEXT_CHAR (lsp);
@ -141,7 +141,7 @@ static xp_lisp_obj_t* read_obj (xp_lisp_t* lsp)
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_assert (lsp->mem->nil != XP_NULL && lsp->mem->t != XP_NULL);
if (TOKEN_COMPARE(lsp,XP_TEXT("nil")) == 0) obj = lsp->mem->nil; if (TOKEN_COMPARE(lsp,XP_TEXT("nil")) == 0) obj = lsp->mem->nil;
else if (TOKEN_COMPARE(lsp,XP_TEXT("t")) == 0) obj = lsp->mem->t; else if (TOKEN_COMPARE(lsp,XP_TEXT("t")) == 0) obj = lsp->mem->t;
else { else {
@ -255,7 +255,7 @@ static xp_lisp_obj_t* read_quote (xp_lisp_t* lsp)
static int read_token (xp_lisp_t* lsp) static int read_token (xp_lisp_t* lsp)
{ {
xp_lisp_assert (lsp->creader != XP_NULL); xp_assert (lsp->creader != XP_NULL);
TOKEN_CLEAR (lsp); TOKEN_CLEAR (lsp);

4
ase/lsp/token.c
View File

@ -1,5 +1,5 @@
/* /*
* $Id: token.c,v 1.3 2005-02-04 16:23:34 bacon Exp $ * $Id: token.c,v 1.4 2005-02-05 05:18:20 bacon Exp $
*/ */
#include "token.h" #include "token.h"
@ -9,7 +9,7 @@ xp_lisp_token_t* xp_lisp_token_new (xp_size_t capacity)
{ {
xp_lisp_token_t* token; xp_lisp_token_t* token;
xp_lisp_assert (capacity > 0); xp_assert (capacity > 0);
token = (xp_lisp_token_t*)malloc (sizeof(xp_lisp_token_t)); token = (xp_lisp_token_t*)malloc (sizeof(xp_lisp_token_t));
if (token == XP_NULL) return XP_NULL; if (token == XP_NULL) return XP_NULL;

93
ase/test/lsp/lisp.c
View File

@ -1,7 +1,98 @@
#include <xp/lisp/lisp.h> #include <xp/lisp/lisp.h>
#include <xp/c/stdio.h>
int xp_main () #ifdef LINUX
#include <mcheck.h>
#endif
static int get_char (xp_lisp_cint* ch, void* arg)
{ {
xp_lisp_cint c;
c = fgetc(stdin);
if (c == XP_EOF) {
if (ferror(stdin)) return -1;
c = XP_EOF;
}
*ch = c;
return 0; return 0;
} }
int to_int (const xp_char_t* str)
{
int r = 0;
while (*str != XP_CHAR('\0')) {
if (!xp_isdigit(*str)) break;
r = r * 10 + (*str - XP_CHAR('0'));
str++;
}
return r;
}
int xp_main (int argc, xp_char_t* argv[])
{
xp_lisp_t* lisp;
xp_lisp_obj_t* obj;
#ifdef LINUX
mtrace ();
#endif
if (argc != 3) {
xp_fprintf (xp_stderr, XP_TEXT("usage: %s mem_ubound mem_ubound_inc\n"), argv[0]);
return -1;
}
lisp = xp_lisp_new (to_int(argv[1]), to_int(argv[2]));
if (lisp == NULL) {
xp_fprintf (xp_stderr, XP_TEXT("can't create a lisp instance\n"));
return -1;
}
xp_printf (XP_TEXT("LISP 0.0001\n"));
xp_lisp_set_creader (lisp, get_char, NULL);
for (;;) {
xp_printf (XP_TEXT("%s> "), argv[0]);
obj = xp_lisp_read (lisp);
if (obj == NULL) {
if (lisp->error != XP_LISP_ERR_END &&
lisp->error != XP_LISP_ERR_ABORT) {
xp_fprintf (xp_stderr,
XP_TEXT("error while reading: %d\n"), lisp->error);
}
if (lisp->error < XP_LISP_ERR_SYNTAX) break;
continue;
}
if ((obj = xp_lisp_eval (lisp, obj)) != NULL) {
xp_lisp_print (lisp, obj);
xp_printf (XP_TEXT("\n"));
}
else {
if (lisp->error == XP_LISP_ERR_ABORT) break;
xp_fprintf (xp_stderr,
XP_TEXT("error while reading: %d\n"), lisp->error);
}
/*
printf ("-----------\n");
xp_lisp_print (lisp, obj);
printf ("\n-----------\n");
*/
}
xp_lisp_free (lisp);
#ifdef LINUX
muntrace ();
#endif
return 0;
}

4
ase/test/lsp/makefile.in
View File

@ -3,8 +3,8 @@ OUTS = $(SRCS:.c=.x)
CC = @CC@ CC = @CC@
CFLAGS = @CFLAGS@ -I@abs_top_builddir@ CFLAGS = @CFLAGS@ -I@abs_top_builddir@
LDFLAGS = @LDFLAGS@ -L@abs_top_builddir@/xp/c LDFLAGS = @LDFLAGS@ -L@abs_top_builddir@/xp/c -L@abs_top_builddir@/xp/lisp
LIBS = @LIBS@ -lxpc LIBS = @LIBS@ -lxpc -lxplisp
all: $(OUTS) all: $(OUTS)

16
ase/test/lsp/t1.lsp Normal file
View File

@ -0,0 +1,16 @@
(setq x (lambda (x) (car x)))
((lambda (x) (+ x 99)) (x '(10 20 30)))
((lambda (x) ((lambda (y) (+ y 1)) x)) 10)
; lisp....
((lambda (x) ((macro (y) (+ y 1)) x)) 10)
;;;;;;;
(setq init-rand (macro (seed) (lambda () (setq seed (+ seed 1)))))
(setq init-rand (lambda (seed) (lambda () (setq seed (+ seed 1)))))
(setq rand (init-rand 1))
(rand)

169
ase/test/lsp/t2.lsp Normal file
View File

@ -0,0 +1,169 @@
(setq x (lambda (x) (+ x 20 30 40)))
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 100)
(x 200)
(x 200)
(x 200)
(x 200)
(x 200)