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 2007-02-10 13:52:41 +00:00
parent 9ae7e92bc5
commit be28132f06
16 changed files with 567 additions and 461 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
ase/lsp/env.c
View File

@ -1,5 +1,5 @@
/*
* $Id: env.c,v 1.14 2007-02-03 10:51:52 bacon Exp $
* $Id: env.c,v 1.15 2007-02-10 13:52:22 bacon Exp $
*
* {License}
*/
@ -16,7 +16,11 @@ static ase_lsp_assoc_t* __new_assoc (
assoc = (ase_lsp_assoc_t*)
ASE_LSP_MALLOC (lsp, sizeof(ase_lsp_assoc_t));
if (assoc == ASE_NULL) return ASE_NULL;
if (assoc == ASE_NULL)
{
lsp->errnum = ASE_LSP_ENOMEM;
return ASE_NULL;
}
assoc->name = name;
assoc->value = value;
@ -32,7 +36,11 @@ ase_lsp_frame_t* ase_lsp_newframe (ase_lsp_t* lsp)
frame = (ase_lsp_frame_t*)
ASE_LSP_MALLOC (lsp, sizeof(ase_lsp_frame_t));
if (frame == ASE_NULL) return ASE_NULL;
if (frame == ASE_NULL)
{
lsp->errnum = ASE_LSP_ENOMEM;
return ASE_NULL;
}
frame->assoc = ASE_NULL;
frame->link = ASE_NULL;
@ -72,7 +80,7 @@ ase_lsp_assoc_t* ase_lsp_lookupinframe (
return ASE_NULL;
}
ase_lsp_assoc_t* ase_lsp_insertvalueintoframe (
ase_lsp_assoc_t* ase_lsp_insvalueintoframe (
ase_lsp_t* lsp, ase_lsp_frame_t* frame,
ase_lsp_obj_t* name, ase_lsp_obj_t* value)
{
@ -82,12 +90,13 @@ ase_lsp_assoc_t* ase_lsp_insertvalueintoframe (
assoc = __new_assoc (lsp, name, value, ASE_NULL);
if (assoc == ASE_NULL) return ASE_NULL;
assoc->link = frame->assoc;
frame->assoc = assoc;
return assoc;
}
ase_lsp_assoc_t* ase_lsp_insertfuncintoframe (
ase_lsp_assoc_t* ase_lsp_insfuncintoframe (
ase_lsp_t* lsp, ase_lsp_frame_t* frame,
ase_lsp_obj_t* name, ase_lsp_obj_t* func)
{
@ -97,7 +106,41 @@ ase_lsp_assoc_t* ase_lsp_insertfuncintoframe (
assoc = __new_assoc (lsp, name, ASE_NULL, func);
if (assoc == ASE_NULL) return ASE_NULL;
assoc->link = frame->assoc;
frame->assoc = assoc;
return assoc;
}
ase_lsp_tlink_t* ase_lsp_pushtmp (ase_lsp_t* lsp, ase_lsp_obj_t* obj)
{
ase_lsp_tlink_t* tlink;
tlink = (ase_lsp_tlink_t*)
ASE_LSP_MALLOC (lsp, sizeof(ase_lsp_tlink_t));
if (tlink == ASE_NULL)
{
lsp->errnum = ASE_LSP_ENOMEM;
return ASE_NULL;
}
tlink->obj = obj;
tlink->link = lsp->mem->tlink;
lsp->mem->tlink = tlink;
lsp->mem->tlink_count++;
return tlink;
}
void ase_lsp_poptmp (ase_lsp_t* lsp)
{
ase_lsp_tlink_t* top;
ASE_LSP_ASSERT (lsp, lsp->mem->tlink != ASE_NULL);
top = lsp->mem->tlink;
lsp->mem->tlink = top->link;
lsp->mem->tlink_count--;
ASE_LSP_FREE (lsp, top);
}

19
ase/lsp/env.h
View File

@ -1,5 +1,5 @@
/*
* $Id: env.h,v 1.11 2007-02-03 10:51:52 bacon Exp $
* $Id: env.h,v 1.12 2007-02-10 13:52:22 bacon Exp $
*
* {License}
*/
@ -13,11 +13,11 @@
typedef struct ase_lsp_assoc_t ase_lsp_assoc_t;
typedef struct ase_lsp_frame_t ase_lsp_frame_t;
typedef struct ase_lsp_tlink_t ase_lsp_tlink_t;
struct ase_lsp_assoc_t
{
ase_lsp_obj_t* name; /* ase_lsp_obj_symbol_t */
/*ase_lsp_obj_t* value;*/
ase_lsp_obj_t* name; /* ase_lsp_obj_sym_t */
ase_lsp_obj_t* value; /* value as a variable */
ase_lsp_obj_t* func; /* function definition */
@ -30,6 +30,12 @@ struct ase_lsp_frame_t
ase_lsp_frame_t* link;
};
struct ase_lsp_tlink_t
{
ase_lsp_obj_t* obj;
ase_lsp_tlink_t* link;
};
#ifdef __cplusplus
extern "C" {
#endif
@ -40,13 +46,16 @@ void ase_lsp_freeframe (ase_lsp_t* lsp, ase_lsp_frame_t* frame);
ase_lsp_assoc_t* ase_lsp_lookupinframe (
ase_lsp_t* lsp, ase_lsp_frame_t* frame, ase_lsp_obj_t* name);
ase_lsp_assoc_t* ase_lsp_insertvalueintoframe (
ase_lsp_assoc_t* ase_lsp_insvalueintoframe (
ase_lsp_t* lsp, ase_lsp_frame_t* frame,
ase_lsp_obj_t* name, ase_lsp_obj_t* value);
ase_lsp_assoc_t* ase_lsp_insertfuncintoframe (
ase_lsp_assoc_t* ase_lsp_insfuncintoframe (
ase_lsp_t* lsp, ase_lsp_frame_t* frame,
ase_lsp_obj_t* name, ase_lsp_obj_t* func);
ase_lsp_tlink_t* ase_lsp_pushtmp (ase_lsp_t* lsp, ase_lsp_obj_t* obj);
void ase_lsp_poptmp (ase_lsp_t* lsp);
#ifdef __cplusplus
}
#endif

5
ase/lsp/err.c
View File

@ -1,5 +1,5 @@
/*
* $Id: err.c,v 1.9 2007-02-03 10:51:52 bacon Exp $
* $Id: err.c,v 1.10 2007-02-10 13:52:23 bacon Exp $
*
* {License}
*/
@ -18,7 +18,8 @@ const ase_char_t* ase_lsp_geterrstr (int errnum)
ASE_T("no error"),
ASE_T("out of memory"),
ASE_T("exit"),
ASE_T("end"),
ASE_T("end of source"),
ASE_T("unexpected end of string"),
ASE_T("input not attached"),
ASE_T("input"),
ASE_T("output not attached"),

21
ase/lsp/eval.c
View File

@ -1,5 +1,5 @@
/*
* $Id: eval.c,v 1.24 2007-02-03 10:51:52 bacon Exp $
* $Id: eval.c,v 1.25 2007-02-10 13:52:23 bacon Exp $
*
* {License}
*/
@ -105,11 +105,7 @@ static ase_lsp_obj_t* make_func (ase_lsp_t* lsp, ase_lsp_obj_t* cdr, int is_macr
func = (is_macro)?
ase_lsp_makemacro (lsp->mem, formal, body):
ase_lsp_makefunc (lsp->mem, formal, body);
if (func == ASE_NULL)
{
lsp->errnum = ASE_LSP_ENOMEM;
return ASE_NULL;
}
if (func == ASE_NULL) return ASE_NULL;
return func;
}
@ -231,14 +227,10 @@ static ase_lsp_obj_t* apply (
/* make a new frame. */
frame = ase_lsp_newframe (lsp);
if (frame == ASE_NULL)
{
lsp->errnum = ASE_LSP_ENOMEM;
return ASE_NULL;
}
if (frame == ASE_NULL) return ASE_NULL;
/* attach it to the brooding frame list to
* prevent them from begin garbage-collected. */
* prevent them from being garbage-collected. */
frame->link = mem->brooding_frame;
mem->brooding_frame = frame;
@ -269,16 +261,15 @@ static ase_lsp_obj_t* apply (
if (ase_lsp_lookupinframe (
lsp, frame, ASE_LSP_CAR(formal)) != ASE_NULL)
{
lsp->errnum = ASE_LSP_ERR_DUP_FORMAL;
lsp->errnum = ASE_LSP_EDUPFML;
mem->brooding_frame = frame->link;
ase_lsp_freeframe (lsp, frame);
return ASE_NULL;
}
if (ase_lsp_insertvalueintoframe (
if (ase_lsp_insvalueintoframe (
lsp, frame, ASE_LSP_CAR(formal), value) == ASE_NULL)
{
lsp->errnum = ASE_LSP_ENOMEM;
mem->brooding_frame = frame->link;
ase_lsp_freeframe (lsp, frame);
return ASE_NULL;

5
ase/lsp/lsp.h
View File

@ -1,5 +1,5 @@
/*
* $Id: lsp.h,v 1.35 2007-02-03 10:51:52 bacon Exp $
* $Id: lsp.h,v 1.36 2007-02-10 13:52:23 bacon Exp $
*
* {License}
*/
@ -90,6 +90,7 @@ enum
ASE_LSP_EEXIT,
ASE_LSP_EEND,
ASE_LSP_EENDSTR,
ASE_LSP_ERR_INPUT_NOT_ATTACHED,
ASE_LSP_ERR_INPUT,
ASE_LSP_ERR_OUTPUT_NOT_ATTACHED,
@ -100,7 +101,7 @@ enum
ASE_LSP_EARGMANY,
ASE_LSP_ERR_UNDEF_FUNC,
ASE_LSP_ERR_BAD_FUNC,
ASE_LSP_ERR_DUP_FORMAL,
ASE_LSP_EDUPFML,
ASE_LSP_EBADSYM,
ASE_LSP_ERR_UNDEF_SYMBOL,
ASE_LSP_EEMPBDY,

43
ase/lsp/mem.c
View File

@ -1,5 +1,5 @@
/*
* $Id: mem.c,v 1.27 2007-02-06 10:57:00 bacon Exp $
* $Id: mem.c,v 1.28 2007-02-10 13:52:23 bacon Exp $
*
* {License}
*/
@ -28,6 +28,8 @@ ase_lsp_mem_t* ase_lsp_openmem (
}
mem->root_frame = mem->frame;
mem->brooding_frame = ASE_NULL;
mem->tlink = ASE_NULL;
mem->tlink_count = 0;
/* initialize object allocation list */
mem->ubound = ubound;
@ -93,8 +95,8 @@ ase_lsp_obj_t* ase_lsp_alloc (ase_lsp_mem_t* mem, int type, ase_size_t size)
ase_lsp_obj_t* obj;
/* TODO: remove the following line... */
ase_lsp_collectgarbage(mem);
if (mem->count >= mem->ubound) ase_lsp_collectgarbage (mem);
ase_lsp_gc (mem);
if (mem->count >= mem->ubound) ase_lsp_gc (mem);
if (mem->count >= mem->ubound)
{
mem->ubound += mem->ubound_inc;
@ -104,10 +106,14 @@ ase_lsp_collectgarbage(mem);
obj = (ase_lsp_obj_t*) ASE_LSP_MALLOC (mem->lsp, size);
if (obj == ASE_NULL)
{
ase_lsp_collectgarbage (mem);
ase_lsp_gc (mem);
obj = (ase_lsp_obj_t*) ASE_LSP_MALLOC (mem->lsp, size);
if (obj == ASE_NULL) return ASE_NULL;
if (obj == ASE_NULL)
{
mem->lsp->errnum = ASE_LSP_ENOMEM;
return ASE_NULL;
}
}
ASE_LSP_TYPE(obj) = type;
@ -249,6 +255,7 @@ static void __mark_objs_in_use (ase_lsp_mem_t* mem)
{
ase_lsp_frame_t* frame;
ase_lsp_assoc_t* assoc;
ase_lsp_tlink_t* tlink;
/*ase_lsp_arr_t* arr;*/
/*ase_size_t i;*/
@ -302,6 +309,12 @@ static void __mark_objs_in_use (ase_lsp_mem_t* mem)
/* ase_dprint0 (ASE_T("marking the read object\n"));*/
if (mem->read != ASE_NULL) __mark_obj (mem->lsp, mem->read);
/* ase_dprint0 (ASE_T("marking the temporary objects\n"));*/
for (tlink = mem->tlink; tlink != ASE_NULL; tlink = tlink->link)
{
__mark_obj (mem->lsp, tlink->obj);
}
#if 0
ase_dprint0 (ASE_T("marking builtin objects\n"));
#endif
@ -337,9 +350,13 @@ static void __sweep_unmarked_objs (ase_lsp_mem_t* mem)
{
/* dispose of unused objects */
if (i == ASE_LSP_OBJ_INT)
xp_printf (ASE_T("disposing....%d [%d]\n"), i, ASE_LSP_IVAL(obj));
wprintf (ASE_T("disposing....%d [%d]\n"), i, (int)ASE_LSP_IVAL(obj));
if (i == ASE_LSP_OBJ_REAL)
wprintf (ASE_T("disposing....%d [%Lf]\n"), i, (double)ASE_LSP_RVAL(obj));
else if (i == ASE_LSP_OBJ_SYM)
wprintf (ASE_T("disposing....%d [%s]\n"), i, ASE_LSP_SYMPTR(obj));
else
xp_printf (ASE_T("disposing....%d\n"), i);
wprintf (ASE_T("disposing....%d\n"), i);
ase_lsp_dispose (mem, prev, obj);
}
else
@ -354,7 +371,7 @@ xp_printf (ASE_T("disposing....%d\n"), i);
}
}
void ase_lsp_collectgarbage (ase_lsp_mem_t* mem)
void ase_lsp_gc (ase_lsp_mem_t* mem)
{
__mark_objs_in_use (mem);
__sweep_unmarked_objs (mem);
@ -450,7 +467,8 @@ ase_lsp_obj_t* ase_lsp_makecons (
{
ase_lsp_obj_t* obj;
obj = ase_lsp_alloc (mem, ASE_LSP_OBJ_CONS, ASE_SIZEOF(ase_lsp_obj_cons_t));
obj = ase_lsp_alloc (mem,
ASE_LSP_OBJ_CONS, ASE_SIZEOF(ase_lsp_obj_cons_t));
if (obj == ASE_NULL) return ASE_NULL;
ASE_LSP_CAR(obj) = car;
@ -464,7 +482,8 @@ ase_lsp_obj_t* ase_lsp_makefunc (
{
ase_lsp_obj_t* obj;
obj = ase_lsp_alloc (mem, ASE_LSP_OBJ_FUNC, ASE_SIZEOF(ase_lsp_obj_func_t));
obj = ase_lsp_alloc (mem,
ASE_LSP_OBJ_FUNC, ASE_SIZEOF(ase_lsp_obj_func_t));
if (obj == ASE_NULL) return ASE_NULL;
ASE_LSP_FFORMAL(obj) = formal;
@ -530,7 +549,7 @@ ase_lsp_assoc_t* ase_lsp_setvalue (
assoc = ase_lsp_lookup (mem, name);
if (assoc == ASE_NULL)
{
assoc = ase_lsp_insertvalueintoframe (
assoc = ase_lsp_insvalueintoframe (
mem->lsp, mem->root_frame, name, value);
if (assoc == ASE_NULL) return ASE_NULL;
}
@ -547,7 +566,7 @@ ase_lsp_assoc_t* ase_lsp_setfunc (
assoc = ase_lsp_lookup (mem, name);
if (assoc == ASE_NULL)
{
assoc = ase_lsp_insertfuncintoframe (
assoc = ase_lsp_insfuncintoframe (
mem->lsp, mem->root_frame, name, func);
if (assoc == ASE_NULL) return ASE_NULL;
}

8
ase/lsp/mem.h
View File

@ -1,5 +1,5 @@
/*
* $Id: mem.h,v 1.17 2007-02-03 10:51:52 bacon Exp $
* $Id: mem.h,v 1.18 2007-02-10 13:52:23 bacon Exp $
*
* {License}
*/
@ -38,6 +38,10 @@ struct ase_lsp_mem_t
ase_lsp_frame_t* root_frame;
/* pointer to an interim frame not yet added to "frame" */
ase_lsp_frame_t* brooding_frame;
/* links for temporary objects */
ase_lsp_tlink_t* tlink;
ase_size_t tlink_count;
};
#ifdef __cplusplus
@ -51,7 +55,7 @@ void ase_lsp_closemem (ase_lsp_mem_t* mem);
ase_lsp_obj_t* ase_lsp_alloc (ase_lsp_mem_t* mem, int type, ase_size_t size);
void ase_lsp_dispose (ase_lsp_mem_t* mem, ase_lsp_obj_t* prev, ase_lsp_obj_t* obj);
void ase_lsp_dispose_all (ase_lsp_mem_t* mem);
void ase_lsp_collectgarbage (ase_lsp_mem_t* mem);
void ase_lsp_gc (ase_lsp_mem_t* mem);
void ase_lsp_lockobj (ase_lsp_t* lsp, ase_lsp_obj_t* obj);
void ase_lsp_unlockobj (ase_lsp_t* lsp, ase_lsp_obj_t* obj);

164
ase/lsp/prim.c
View File

@ -1,5 +1,5 @@
/*
* $Id: prim.c,v 1.20 2007-02-06 10:57:01 bacon Exp $
* $Id: prim.c,v 1.21 2007-02-10 13:52:23 bacon Exp $
*
* {License}
*/
@ -32,26 +32,30 @@ static int __add_prim (ase_lsp_mem_t* mem,
n = ase_lsp_makesym (mem, name, name_len);
if (n == ASE_NULL) return -1;
ase_lsp_lockobj (mem->lsp, n);
if (ase_lsp_pushtmp (mem->lsp, n) == ASE_NULL) return -1;
p = ase_lsp_makeprim (mem, pimpl, min_args, max_args);
if (p == ASE_NULL)
{
ase_lsp_unlockobj (mem->lsp, n);
ase_lsp_poptmp (mem->lsp);
return -1;
}
ase_lsp_lockobj (mem->lsp, p);
if (ase_lsp_pushtmp (mem->lsp, p) == ASE_NULL)
{
ase_lsp_poptmp (mem->lsp);
return -1;
}
if (ase_lsp_setfunc(mem, n, p) == ASE_NULL)
{
ase_lsp_unlockobj (mem->lsp, p);
ase_lsp_unlockobj (mem->lsp, n);
ase_lsp_poptmp (mem->lsp);
ase_lsp_poptmp (mem->lsp);
return -1;
}
ase_lsp_unlockobj (mem->lsp, p);
ase_lsp_unlockobj (mem->lsp, n);
ase_lsp_poptmp (mem->lsp);
ase_lsp_poptmp (mem->lsp);
return 0;
}
@ -70,22 +74,22 @@ ase_lsp_obj_t* ase_lsp_prim_eval (ase_lsp_t* lsp, ase_lsp_obj_t* args)
tmp1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
if (tmp1 == ASE_NULL) return ASE_NULL;
ase_lsp_lockobj (lsp, tmp1);
if (ase_lsp_pushtmp (lsp, tmp1) == ASE_NULL) return ASE_NULL;
tmp2 = ase_lsp_eval (lsp, tmp1);
if (tmp2 == ASE_NULL)
{
ase_lsp_unlockobj (lsp, tmp1);
ase_lsp_poptmp (lsp);
return ASE_NULL;
}
ase_lsp_unlockobj (lsp, tmp1);
ase_lsp_poptmp (lsp);
return tmp2;
}
ase_lsp_obj_t* ase_lsp_prim_gc (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{
ase_lsp_collectgarbage (lsp->mem);
ase_lsp_gc (lsp->mem);
return lsp->mem->nil;
}
@ -112,24 +116,50 @@ ase_lsp_obj_t* ase_lsp_prim_cond (ase_lsp_t* lsp, ase_lsp_obj_t* args)
tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(ASE_LSP_CAR(args)));
if (tmp == ASE_NULL) return ASE_NULL;
if (ase_lsp_pushtmp (lsp, tmp) == ASE_NULL) return ASE_NULL;
if (tmp != lsp->mem->nil)
{
int f = 0;
tmp = ASE_LSP_CDR(ASE_LSP_CAR(args));
ret = lsp->mem->nil;
while (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_CONS)
{
ret = ase_lsp_eval (lsp, ASE_LSP_CAR(tmp));
if (ret == ASE_NULL) return ASE_NULL;
if (ret == ASE_NULL)
{
if (!f) ase_lsp_poptmp (lsp); /* ret */
ase_lsp_poptmp (lsp); /* tmp */
return ASE_NULL;
}
if (!f) ase_lsp_poptmp (lsp); /* ret */
if (ase_lsp_pushtmp (lsp, ret) == ASE_NULL)
{
ase_lsp_poptmp (lsp); /* tmp */
return ASE_NULL;
}
f = 1;
tmp = ASE_LSP_CDR(tmp);
}
if (tmp != lsp->mem->nil)
{
if (!f) ase_lsp_poptmp (lsp); /* ret */
ase_lsp_poptmp (lsp); /* tmp */
lsp->errnum = ASE_LSP_EARGBAD;
return ASE_NULL;
}
if (!f) ase_lsp_poptmp (lsp); /* ret */
ase_lsp_poptmp (lsp); /* tmp */
return ret;
}
ase_lsp_poptmp (lsp); /* tmp */
args = ASE_LSP_CDR(args);
}
@ -145,30 +175,59 @@ ase_lsp_obj_t* ase_lsp_prim_if (ase_lsp_t* lsp, ase_lsp_obj_t* args)
tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
if (tmp == ASE_NULL) return ASE_NULL;
if (ase_lsp_pushtmp (lsp, tmp) == ASE_NULL) return ASE_NULL;
if (tmp != lsp->mem->nil)
{
tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(ASE_LSP_CDR(args)));
if (tmp == ASE_NULL) return ASE_NULL;
if (tmp == ASE_NULL)
{
ase_lsp_poptmp (lsp); /* tmp */
return ASE_NULL;
}
ase_lsp_poptmp (lsp); /* tmp */
return tmp;
}
else
{
ase_lsp_obj_t* res = lsp->mem->nil;
int f = 0;
tmp = ASE_LSP_CDR(ASE_LSP_CDR(args));
while (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_CONS)
{
res = ase_lsp_eval (lsp, ASE_LSP_CAR(tmp));
if (res == ASE_NULL) return ASE_NULL;
if (res == ASE_NULL)
{
if (!f) ase_lsp_poptmp (lsp); /* res */
ase_lsp_poptmp (lsp); /* tmp */
return ASE_NULL;
}
if (!f) ase_lsp_poptmp (lsp); /* res */
if (ase_lsp_pushtmp (lsp, res) == ASE_NULL)
{
ase_lsp_poptmp (lsp); /* tmp */
return ASE_NULL;
}
f = 1;
tmp = ASE_LSP_CDR(tmp);
}
if (tmp != lsp->mem->nil)
{
if (!f) ase_lsp_poptmp (lsp); /* ret */
ase_lsp_poptmp (lsp); /* tmp */
lsp->errnum = ASE_LSP_EARGBAD;
return ASE_NULL;
}
if (!f) ase_lsp_poptmp (lsp); /* ret */
ase_lsp_poptmp (lsp); /* tmp */
return res;
}
}
@ -190,19 +249,28 @@ ase_lsp_obj_t* ase_lsp_prim_while (ase_lsp_t* lsp, ase_lsp_obj_t* args)
if (tmp == ASE_NULL) return ASE_NULL;
if (tmp == lsp->mem->nil) break;
if (ase_lsp_pushtmp (lsp, tmp) == ASE_NULL) return ASE_NULL;
tmp = ASE_LSP_CDR(args);
while (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_CONS)
{
if (ase_lsp_eval(lsp, ASE_LSP_CAR(tmp)) == ASE_NULL)
{
ase_lsp_poptmp (lsp); /* tmp */
return ASE_NULL;
}
tmp = ASE_LSP_CDR(tmp);
}
if (tmp != lsp->mem->nil)
{
ase_lsp_poptmp (lsp); /* tmp */
lsp->errnum = ASE_LSP_EARGBAD;
return ASE_NULL;
}
ase_lsp_poptmp (lsp); /* tmp */
}
return lsp->mem->nil;
@ -268,16 +336,31 @@ ase_lsp_obj_t* ase_lsp_prim_cons (ase_lsp_t* lsp, ase_lsp_obj_t* args)
car = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
if (car == ASE_NULL) return ASE_NULL;
if (ase_lsp_pushtmp (lsp, car) == ASE_NULL) return ASE_NULL;
cdr = ase_lsp_eval (lsp, ASE_LSP_CAR(ASE_LSP_CDR(args)));
if (cdr == ASE_NULL) return ASE_NULL;
if (cdr == ASE_NULL)
{
ase_lsp_poptmp (lsp); /* car */
return ASE_NULL;
}
if (ase_lsp_pushtmp (lsp, cdr) == ASE_NULL)
{
ase_lsp_poptmp (lsp); /* car */
return ASE_NULL;
}
cons = ase_lsp_makecons (lsp->mem, car, cdr);
if (cons == ASE_NULL)
{
lsp->errnum = ASE_LSP_ENOMEM;
ase_lsp_poptmp (lsp); /* cdr */
ase_lsp_poptmp (lsp); /* car */
return ASE_NULL;
}
ase_lsp_poptmp (lsp); /* cdr */
ase_lsp_poptmp (lsp); /* car */
return cons;
}
@ -286,7 +369,7 @@ ase_lsp_obj_t* ase_lsp_prim_set (ase_lsp_t* lsp, ase_lsp_obj_t* args)
/*
* (set 'flowers 'rose)
* (set flowers 20)
* (rose)
* rose
*/
ase_lsp_obj_t* p1, * p2;
@ -296,21 +379,37 @@ ase_lsp_obj_t* ase_lsp_prim_set (ase_lsp_t* lsp, ase_lsp_obj_t* args)
p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
if (p1 == ASE_NULL) return ASE_NULL;
if (ase_lsp_pushtmp (lsp, p1) == ASE_NULL) return ASE_NULL;
if (ASE_LSP_TYPE(p1) != ASE_LSP_OBJ_SYM)
{
ase_lsp_poptmp (lsp); /* p1 */
lsp->errnum = ASE_LSP_EARGBAD;
return ASE_NULL;
}
p2 = ase_lsp_eval (lsp, ASE_LSP_CAR(ASE_LSP_CDR(args)));
if (p2 == ASE_NULL) return ASE_NULL;
if (ase_lsp_setvalue (lsp->mem, p1, p2) == ASE_NULL)
if (p2 == ASE_NULL)
{
lsp->errnum = ASE_LSP_ENOMEM;
ase_lsp_poptmp (lsp); /* p1 */
return ASE_NULL;
}
if (ase_lsp_pushtmp (lsp, p2) == ASE_NULL)
{
ase_lsp_poptmp (lsp); /* p1 */
return ASE_NULL;
}
if (ase_lsp_setvalue (lsp->mem, p1, p2) == ASE_NULL)
{
ase_lsp_poptmp (lsp); /* p2 */
ase_lsp_poptmp (lsp); /* p1 */
return ASE_NULL;
}
ase_lsp_poptmp (lsp); /* p2 */
ase_lsp_poptmp (lsp); /* p1 */
return p2;
}
@ -318,7 +417,7 @@ ase_lsp_obj_t* ase_lsp_prim_setq (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{
/*
* (setq x 10)
* (setq x "stirng")
* (setq x "string")
*/
ase_lsp_obj_t* p = args, * p1, * p2 = lsp->mem->nil;
@ -343,12 +442,15 @@ ase_lsp_obj_t* ase_lsp_prim_setq (ase_lsp_t* lsp, ase_lsp_obj_t* args)
p2 = ase_lsp_eval (lsp, ASE_LSP_CAR(ASE_LSP_CDR(p)));
if (p2 == ASE_NULL) return ASE_NULL;
if (ase_lsp_pushtmp (lsp, p2) == ASE_NULL) return ASE_NULL;
if (ase_lsp_setvalue (lsp->mem, p1, p2) == ASE_NULL)
{
lsp->errnum = ASE_LSP_ENOMEM;
ase_lsp_poptmp (lsp);
return ASE_NULL;
}
ase_lsp_poptmp (lsp);
p = ASE_LSP_CDR(ASE_LSP_CDR(p));
}
@ -389,11 +491,15 @@ ase_lsp_obj_t* ase_lsp_prim_defun (ase_lsp_t* lsp, ase_lsp_obj_t* args)
ASE_LSP_CAR(ASE_LSP_CDR(args)), ASE_LSP_CDR(ASE_LSP_CDR(args)));
if (fun == ASE_NULL) return ASE_NULL;
if (ase_lsp_pushtmp (lsp, fun) == ASE_NULL) return ASE_NULL;
if (ase_lsp_setfunc (lsp->mem, ASE_LSP_CAR(args), fun) == ASE_NULL)
{
lsp->errnum = ASE_LSP_ENOMEM;
ase_lsp_poptmp (lsp);
return ASE_NULL;
}
ase_lsp_poptmp (lsp);
return fun;
}
@ -401,7 +507,7 @@ ase_lsp_obj_t* ase_lsp_prim_demac (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{
/*
* (demac x (abc) x y z)
*(setq x (macro (abc) x y z))
* (setq x (macro (abc) x y z))
*/
ase_lsp_obj_t* name, * mac;
@ -417,11 +523,15 @@ ase_lsp_obj_t* ase_lsp_prim_demac (ase_lsp_t* lsp, ase_lsp_obj_t* args)
ASE_LSP_CAR(ASE_LSP_CDR(args)), ASE_LSP_CDR(ASE_LSP_CDR(args)));
if (mac == ASE_NULL) return ASE_NULL;
if (ase_lsp_pushtmp (lsp, mac) == ASE_NULL) return ASE_NULL;
if (ase_lsp_setfunc (lsp->mem, ASE_LSP_CAR(args), mac) == ASE_NULL)
{
lsp->errnum = ASE_LSP_ENOMEM;
ase_lsp_poptmp (lsp);
return ASE_NULL;
}
ase_lsp_poptmp (lsp);
return mac;
}

36
ase/lsp/prim_compar.c
View File

@ -1,5 +1,5 @@
/*
* $Id: prim_compar.c,v 1.11 2007-02-03 10:51:53 bacon Exp $
* $Id: prim_compar.c,v 1.12 2007-02-10 13:52:23 bacon Exp $
*
* {License}
*/
@ -14,16 +14,20 @@
\
p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args)); \
if (p1 == ASE_NULL) return ASE_NULL; \
ase_lsp_lockobj (lsp, p1); \
if (ase_lsp_pushtmp (lsp, p1) == ASE_NULL) return ASE_NULL; \
\
p2 = ase_lsp_eval (lsp, ASE_LSP_CAR(ASE_LSP_CDR(args))); \
if (p2 == ASE_NULL) \
{ \
ase_lsp_unlockobj (lsp, p1); \
ase_lsp_poptmp (lsp); \
return ASE_NULL; \
} \
\
ase_lsp_lockobj (lsp, p2); \
if (ase_lsp_pushtmp (lsp, p2) == ASE_NULL) \
{ \
ase_lsp_poptmp (lsp); \
return ASE_NULL; \
} \
\
if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_INT) \
{ \
@ -37,8 +41,8 @@
} \
else \
{ \
ase_lsp_unlockobj (lsp, p1); \
ase_lsp_unlockobj (lsp, p2); \
ase_lsp_poptmp (lsp); \
ase_lsp_poptmp (lsp); \
lsp->errnum = ASE_LSP_EVALBAD; \
return ASE_NULL; \
} \
@ -55,8 +59,8 @@
} \
else \
{ \
ase_lsp_unlockobj (lsp, p1); \
ase_lsp_unlockobj (lsp, p2); \
ase_lsp_poptmp (lsp); \
ase_lsp_poptmp (lsp); \
lsp->errnum = ASE_LSP_EVALBAD; \
return ASE_NULL; \
} \
@ -71,8 +75,8 @@
} \
else \
{ \
ase_lsp_unlockobj (lsp, p1); \
ase_lsp_unlockobj (lsp, p2); \
ase_lsp_poptmp (lsp); \
ase_lsp_poptmp (lsp); \
lsp->errnum = ASE_LSP_EVALBAD; \
return ASE_NULL; \
} \
@ -87,22 +91,22 @@
} \
else \
{ \
ase_lsp_unlockobj (lsp, p1); \
ase_lsp_unlockobj (lsp, p2); \
ase_lsp_poptmp (lsp); \
ase_lsp_poptmp (lsp); \
lsp->errnum = ASE_LSP_EVALBAD; \
return ASE_NULL; \
} \
} \
else \
{ \
ase_lsp_unlockobj (lsp, p1); \
ase_lsp_unlockobj (lsp, p2); \
ase_lsp_poptmp (lsp); \
ase_lsp_poptmp (lsp); \
lsp->errnum = ASE_LSP_EVALBAD; \
return ASE_NULL; \
} \
\
ase_lsp_unlockobj (lsp, p1); \
ase_lsp_unlockobj (lsp, p2); \
ase_lsp_poptmp (lsp); \
ase_lsp_poptmp (lsp); \
return (res)? lsp->mem->t: lsp->mem->nil; \
}

26
ase/lsp/prim_let.c
View File

@ -1,5 +1,5 @@
/*
* $Id: prim_let.c,v 1.10 2007-02-03 10:51:53 bacon Exp $
* $Id: prim_let.c,v 1.11 2007-02-10 13:52:23 bacon Exp $
*
* {License}
*/
@ -14,14 +14,10 @@ static ase_lsp_obj_t* __prim_let (
ase_lsp_obj_t* body;
ase_lsp_obj_t* value;
// create a new frame
/* create a new frameq */
frame = ase_lsp_newframe (lsp);
if (frame == ASE_NULL)
{
lsp->errnum = ASE_LSP_ENOMEM;
return ASE_NULL;
}
//frame->link = lsp->mem->frame;
if (frame == ASE_NULL) return ASE_NULL;
/*frame->link = lsp->mem->frame;*/
if (sequential)
{
@ -36,7 +32,7 @@ static ase_lsp_obj_t* __prim_let (
assoc = ASE_LSP_CAR(args);
//while (assoc != lsp->mem->nil) {
/*while (assoc != lsp->mem->nil) {*/
while (ASE_LSP_TYPE(assoc) == ASE_LSP_OBJ_CONS)
{
ase_lsp_obj_t* ass = ASE_LSP_CAR(assoc);
@ -47,7 +43,7 @@ static ase_lsp_obj_t* __prim_let (
if (ASE_LSP_TYPE(n) != ASE_LSP_OBJ_SYM)
{
lsp->errnum = ASE_LSP_EARGBAD; // must be a symbol
lsp->errnum = ASE_LSP_EARGBAD;
if (sequential) lsp->mem->frame = frame->link;
else lsp->mem->brooding_frame = frame->link;
ase_lsp_freeframe (lsp, frame);
@ -75,15 +71,14 @@ static ase_lsp_obj_t* __prim_let (
if (ase_lsp_lookupinframe (lsp, frame, n) != ASE_NULL)
{
lsp->errnum = ASE_LSP_ERR_DUP_FORMAL;
lsp->errnum = ASE_LSP_EDUPFML;
if (sequential) lsp->mem->frame = frame->link;
else lsp->mem->brooding_frame = frame->link;
ase_lsp_freeframe (lsp, frame);
return ASE_NULL;
}
if (ase_lsp_insertvalueintoframe (lsp, frame, n, v) == ASE_NULL)
if (ase_lsp_insvalueintoframe (lsp, frame, n, v) == ASE_NULL)
{
lsp->errnum = ASE_LSP_ENOMEM;
if (sequential) lsp->mem->frame = frame->link;
else lsp->mem->brooding_frame = frame->link;
ase_lsp_freeframe (lsp, frame);
@ -94,15 +89,14 @@ static ase_lsp_obj_t* __prim_let (
{
if (ase_lsp_lookupinframe (lsp, frame, ass) != ASE_NULL)
{
lsp->errnum = ASE_LSP_ERR_DUP_FORMAL;
lsp->errnum = ASE_LSP_EDUPFML;
if (sequential) lsp->mem->frame = frame->link;
else lsp->mem->brooding_frame = frame->link;
ase_lsp_freeframe (lsp, frame);
return ASE_NULL;
}
if (ase_lsp_insertvalueintoframe (lsp, frame, ass, lsp->mem->nil) == ASE_NULL)
if (ase_lsp_insvalueintoframe (lsp, frame, ass, lsp->mem->nil) == ASE_NULL)
{
lsp->errnum = ASE_LSP_ENOMEM;
if (sequential) lsp->mem->frame = frame->link;
else lsp->mem->brooding_frame = frame->link;
ase_lsp_freeframe (lsp, frame);

38
ase/lsp/prim_math.c
View File

@ -1,5 +1,5 @@
/*
* $Id: prim_math.c,v 1.16 2007-02-03 10:51:53 bacon Exp $
* $Id: prim_math.c,v 1.17 2007-02-10 13:52:23 bacon Exp $
*
* {License}
*/
@ -20,11 +20,7 @@ ase_lsp_obj_t* ase_lsp_prim_plus (ase_lsp_t* lsp, ase_lsp_obj_t* args)
while (ASE_LSP_TYPE(body) == ASE_LSP_OBJ_CONS)
{
tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(body));
if (tmp == ASE_NULL)
{
/*lsp->errnum = ASE_LSP_EVALBAD; */
return ASE_NULL;
}
if (tmp == ASE_NULL) return ASE_NULL;
if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT)
{
@ -74,11 +70,7 @@ ase_lsp_obj_t* ase_lsp_prim_plus (ase_lsp_t* lsp, ase_lsp_obj_t* args)
tmp = (realnum)?
ase_lsp_makerealobj (lsp->mem, rval):
ase_lsp_makeintobj (lsp->mem, ival);
if (tmp == ASE_NULL)
{
lsp->errnum = ASE_LSP_ENOMEM;
return ASE_NULL;
}
if (tmp == ASE_NULL) return ASE_NULL;
return tmp;
}
@ -148,11 +140,7 @@ ase_lsp_obj_t* ase_lsp_prim_minus (ase_lsp_t* lsp, ase_lsp_obj_t* args)
tmp = (realnum)?
ase_lsp_makerealobj (lsp->mem, rval):
ase_lsp_makeintobj (lsp->mem, ival);
if (tmp == ASE_NULL)
{
lsp->errnum = ASE_LSP_ENOMEM;
return ASE_NULL;
}
if (tmp == ASE_NULL) return ASE_NULL;
return tmp;
}
@ -221,11 +209,7 @@ ase_lsp_obj_t* ase_lsp_prim_mul (ase_lsp_t* lsp, ase_lsp_obj_t* args)
tmp = (realnum)?
ase_lsp_makerealobj (lsp->mem, rval):
ase_lsp_makeintobj (lsp->mem, ival);
if (tmp == ASE_NULL)
{
lsp->errnum = ASE_LSP_ENOMEM;
return ASE_NULL;
}
if (tmp == ASE_NULL) return ASE_NULL;
return tmp;
}
@ -301,11 +285,7 @@ ase_lsp_obj_t* ase_lsp_prim_div (ase_lsp_t* lsp, ase_lsp_obj_t* args)
tmp = (realnum)?
ase_lsp_makerealobj (lsp->mem, rval):
ase_lsp_makeintobj (lsp->mem, ival);
if (tmp == ASE_NULL)
{
lsp->errnum = ASE_LSP_ENOMEM;
return ASE_NULL;
}
if (tmp == ASE_NULL) return ASE_NULL;
return tmp;
}
@ -370,11 +350,7 @@ ase_lsp_obj_t* ase_lsp_prim_mod (ase_lsp_t* lsp, ase_lsp_obj_t* args)
ASE_LSP_ASSERT (lsp, body == lsp->mem->nil);
tmp = ase_lsp_makeintobj (lsp->mem, ival);
if (tmp == ASE_NULL)
{
lsp->errnum = ASE_LSP_ENOMEM;
return ASE_NULL;
}
if (tmp == ASE_NULL) return ASE_NULL;
return tmp;
}

10
ase/lsp/prim_prog.c
View File

@ -1,5 +1,5 @@
/*
* $Id: prim_prog.c,v 1.7 2007-02-03 10:51:53 bacon Exp $
* $Id: prim_prog.c,v 1.8 2007-02-10 13:52:23 bacon Exp $
*
* {License}
*/
@ -9,7 +9,6 @@
ase_lsp_obj_t* ase_lsp_prim_prog1 (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{
/* (prog1 1 2 3) returns 1 */
ase_lsp_obj_t* res = ASE_NULL, * tmp;
/*while (args != lsp->mem->nil) {*/
@ -21,12 +20,15 @@ ase_lsp_obj_t* ase_lsp_prim_prog1 (ase_lsp_t* lsp, ase_lsp_obj_t* args)
if (res == ASE_NULL)
{
res = tmp;
ase_lsp_lockobj (lsp, res);
if (ase_lsp_pushtmp (lsp, res) == ASE_NULL)
{
return ASE_NULL;
}
}
args = ASE_LSP_CDR(args);
}
if (res != ASE_NULL) ase_lsp_unlockobj (lsp, res);
if (res != ASE_NULL) ase_lsp_poptmp (lsp);
return res;
}

281
ase/lsp/read.c
View File

@ -1,5 +1,5 @@
/*
* $Id: read.c,v 1.30 2007-02-03 10:51:53 bacon Exp $
* $Id: read.c,v 1.31 2007-02-10 13:52:23 bacon Exp $
*
* {License}
*/
@ -45,6 +45,12 @@
#define NEXT_CHAR(lsp) \
do { if (read_char(lsp) == -1) return -1;} while (0)
#define NEXT_CHAR_TO(lsp,c) \
do { \
if (read_char(lsp) == -1) return -1;\
c = (lsp)->curc; \
} while (0)
#define NEXT_TOKEN(lsp) \
do { if (read_token(lsp) == -1) return ASE_NULL; } while (0)
@ -355,7 +361,6 @@ static int read_token (ase_lsp_t* lsp)
}
else if (lsp->curc == ASE_T('\"'))
{
NEXT_CHAR (lsp);
return read_string (lsp);
}
@ -367,7 +372,7 @@ static int read_token (ase_lsp_t* lsp)
static int read_number (ase_lsp_t* lsp, int negative)
{
ase_long_t ival = 0;
ase_real_t rval = 0.;
ase_real_t rval = .0;
do
{
@ -375,7 +380,7 @@ static int read_number (ase_lsp_t* lsp, int negative)
TOKEN_ADD_CHAR (lsp, lsp->curc);
NEXT_CHAR (lsp);
}
while (ASE_LSP_ISDIGIT(lsp,lsp->curc));
while (ASE_LSP_ISDIGIT(lsp, lsp->curc));
/* TODO: extend parsing floating point number */
if (lsp->curc == ASE_T('.'))
@ -396,7 +401,8 @@ static int read_number (ase_lsp_t* lsp, int negative)
TOKEN_TYPE(lsp) = TOKEN_REAL;
if (negative) rval *= -1;
}
else {
else
{
TOKEN_IVAL(lsp) = ival;
TOKEN_TYPE(lsp) = TOKEN_INT;
if (negative) ival *= -1;
@ -405,103 +411,6 @@ static int read_number (ase_lsp_t* lsp, int negative)
return 0;
}
#if 0
static int __read_number (ase_lsp_t* lsp, int negative)
{
ase_cint_t c;
ASE_LSP_ASSERT (lsp, ASE_LSP_STR_LEN(&lsp->token.name) == 0);
SET_TOKEN_TYPE (lsp, TOKEN_INT);
c = lsp->src.lex.curc;
if (c == ASE_T('0'))
{
ADD_TOKEN_CHAR (lsp, c);
GET_CHAR_TO (lsp, c);
if (c == ASE_T('x') || c == ASE_T('X'))
{
/* hexadecimal number */
do
{
ADD_TOKEN_CHAR (lsp, c);
GET_CHAR_TO (lsp, c);
}
while (ASE_LSP_ISXDIGIT (lsp, c));
return 0;
}
else if (c == ASE_T('b') || c == ASE_T('B'))
{
/* binary number */
do
{
ADD_TOKEN_CHAR (lsp, c);
GET_CHAR_TO (lsp, c);
}
while (c == ASE_T('0') || c == ASE_T('1'));
return 0;
}
else if (c != '.')
{
/* octal number */
while (c >= ASE_T('0') && c <= ASE_T('7'))
{
ADD_TOKEN_CHAR (lsp, c);
GET_CHAR_TO (lsp, c);
}
return 0;
}
}
while (ASE_LSP_ISDIGIT (lsp, c))
{
ADD_TOKEN_CHAR (lsp, c);
GET_CHAR_TO (lsp, c);
}
if (c == ASE_T('.'))
{
/* floating-point number */
SET_TOKEN_TYPE (lsp, TOKEN_REAL);
ADD_TOKEN_CHAR (lsp, c);
GET_CHAR_TO (lsp, c);
while (ASE_LSP_ISDIGIT (lsp, c))
{
ADD_TOKEN_CHAR (lsp, c);
GET_CHAR_TO (lsp, c);
}
}
if (c == ASE_T('E') || c == ASE_T('e'))
{
SET_TOKEN_TYPE (lsp, TOKEN_REAL);
ADD_TOKEN_CHAR (lsp, c);
GET_CHAR_TO (lsp, c);
if (c == ASE_T('+') || c == ASE_T('-'))
{
ADD_TOKEN_CHAR (lsp, c);
GET_CHAR_TO (lsp, c);
}
while (ASE_LSP_ISDIGIT (lsp, c))
{
ADD_TOKEN_CHAR (lsp, c);
GET_CHAR_TO (lsp, c);
}
}
return 0;
}
#endif
static int read_ident (ase_lsp_t* lsp)
{
do
@ -516,72 +425,152 @@ static int read_ident (ase_lsp_t* lsp)
static int read_string (ase_lsp_t* lsp)
{
ase_cint_t c;
int escaped = 0;
ase_cint_t code = 0;
int digit_count = 0;
ase_cint_t c_acc = 0;
do
while (1)
{
if (lsp->curc == ASE_CHAR_EOF)
NEXT_CHAR_TO (lsp, c);
if (c == ASE_CHAR_EOF)
{
TOKEN_TYPE(lsp) = TOKEN_UNTERM_STRING;
return 0;
/*ase_lsp_seterror (
lsp, ASE_LSP_EENDSTR, lsp->token.line,
ASE_T("string not closed with a quote"));*/
lsp->errnum = ASE_LSP_EENDSTR;
return -1;
}
/* TODO: */
if (escaped == 3)
{
/* \xNN */
if (c >= ASE_T('0') && c <= ASE_T('7'))
{
c_acc = c_acc * 8 + c - ASE_T('0');
digit_count++;
if (digit_count >= escaped)
{
TOKEN_ADD_CHAR (lsp, c_acc);
escaped = 0;
}
else if (escaped == 2)
{
/* \000 */
}
else if (escaped == 1)
{
/* backslash + character */
if (lsp->curc == ASE_T('a'))
lsp->curc = ASE_T('\a');
else if (lsp->curc == ASE_T('b'))
lsp->curc = ASE_T('\b');
else if (lsp->curc == ASE_T('f'))
lsp->curc = ASE_T('\f');
else if (lsp->curc == ASE_T('n'))
lsp->curc = ASE_T('\n');
else if (lsp->curc == ASE_T('r'))
lsp->curc = ASE_T('\r');
else if (lsp->curc == ASE_T('t'))
lsp->curc = ASE_T('\t');
else if (lsp->curc == ASE_T('v'))
lsp->curc = ASE_T('\v');
else if (lsp->curc == ASE_T('0'))
{
escaped = 2;
code = 0;
NEXT_CHAR (lsp);
continue;
}
else if (lsp->curc == ASE_T('x'))
else
{
escaped = 3;
code = 0;
NEXT_CHAR (lsp);
TOKEN_ADD_CHAR (lsp, c_acc);
escaped = 0;
}
}
else if (escaped == 2 || escaped == 4 || escaped == 8)
{
if (c >= ASE_T('0') && c <= ASE_T('9'))
{
c_acc = c_acc * 16 + c - ASE_T('0');
digit_count++;
if (digit_count >= escaped)
{
TOKEN_ADD_CHAR (lsp, c_acc);
escaped = 0;
}
continue;
}
else if (c >= ASE_T('A') && c <= ASE_T('F'))
{
c_acc = c_acc * 16 + c - ASE_T('A') + 10;
digit_count++;
if (digit_count >= escaped)
{
TOKEN_ADD_CHAR (lsp, c_acc);
escaped = 0;
}
else if (lsp->curc == ASE_T('\\'))
continue;
}
else if (c >= ASE_T('a') && c <= ASE_T('f'))
{
c_acc = c_acc * 16 + c - ASE_T('a') + 10;
digit_count++;
if (digit_count >= escaped)
{
TOKEN_ADD_CHAR (lsp, c_acc);
escaped = 0;
}
continue;
}
else
{
ase_char_t rc;
rc = (escaped == 2)? ASE_T('x'):
(escaped == 4)? ASE_T('u'): ASE_T('U');
if (digit_count == 0) TOKEN_ADD_CHAR (lsp, rc);
else TOKEN_ADD_CHAR (lsp, c_acc);
escaped = 0;
}
}
if (escaped == 0 && c == ASE_T('\"'))
{
/* terminating quote */
/*NEXT_CHAR_TO (lsp, c);*/
NEXT_CHAR (lsp);
break;
}
if (escaped == 0 && c == ASE_T('\\'))
{
escaped = 1;
NEXT_CHAR (lsp);
continue;
}
TOKEN_ADD_CHAR (lsp, lsp->curc);
NEXT_CHAR (lsp);
if (escaped == 1)
{
if (c == ASE_T('n')) c = ASE_T('\n');
else if (c == ASE_T('r')) c = ASE_T('\r');
else if (c == ASE_T('t')) c = ASE_T('\t');
else if (c == ASE_T('f')) c = ASE_T('\f');
else if (c == ASE_T('b')) c = ASE_T('\b');
else if (c == ASE_T('v')) c = ASE_T('\v');
else if (c == ASE_T('a')) c = ASE_T('\a');
else if (c >= ASE_T('0') && c <= ASE_T('7'))
{
escaped = 3;
digit_count = 1;
c_acc = c - ASE_T('0');
continue;
}
else if (c == ASE_T('x'))
{
escaped = 2;
digit_count = 0;
c_acc = 0;
continue;
}
#ifdef ASE_CHAR_IS_WCHAR
else if (c == ASE_T('u') && ASE_SIZEOF(ase_char_t) >= 2)
{
escaped = 4;
digit_count = 0;
c_acc = 0;
continue;
}
else if (c == ASE_T('U') && ASE_SIZEOF(ase_char_t) >= 4)
{
escaped = 8;
digit_count = 0;
c_acc = 0;
continue;
}
#endif
escaped = 0;
}
TOKEN_ADD_CHAR (lsp, c);
}
while (lsp->curc != ASE_T('\"'));
TOKEN_TYPE(lsp) = TOKEN_STRING;
NEXT_CHAR (lsp);
return 0;
}

13
ase/test/awk/awk.c
View File

@ -1,5 +1,5 @@
/*
* $Id: awk.c,v 1.163 2007-02-07 05:43:37 bacon Exp $
* $Id: awk.c,v 1.164 2007-02-10 13:52:41 bacon Exp $
*/
#include <ase/awk/awk.h>
@ -267,7 +267,11 @@ static ase_ssize_t process_extio_pipe (
case ASE_AWK_IO_READ:
{
if (awk_fgets (data, size, (FILE*)epa->handle) == ASE_NULL) return 0;
if (awk_fgets (data, size, (FILE*)epa->handle) == ASE_NULL)
{
if (ferror((FILE*)epa->handle)) return -1;
return 0;
}
return ase_awk_strlen(data);
}
@ -343,7 +347,10 @@ static ase_ssize_t process_extio_file (
case ASE_AWK_IO_READ:
{
if (awk_fgets (data, size, (FILE*)epa->handle) == ASE_NULL)
{
if (ferror((FILE*)epa->handle)) return -1;
return 0;
}
return ase_awk_strlen(data);
}
@ -414,6 +421,8 @@ static ase_ssize_t process_extio_console (
{
while (awk_fgets (data, size, (FILE*)epa->handle) == ASE_NULL)
{
if (ferror((FILE*)epa->handle)) return -1;
/* it has reached the end of the current file.
* open the next file if available */
if (infiles[infile_no] == ASE_NULL)

294
ase/test/lsp/lsp.c
View File

@ -3,6 +3,7 @@
#include "../../etc/main.c"
#ifdef _WIN32
#include <windows.h>
#include <tchar.h>
#endif
@ -19,7 +20,25 @@
#include <mcheck.h>
#endif
static ase_ssize_t get_input (int cmd, void* arg, ase_char_t* data, ase_size_t size)
#if defined(_WIN32)
#define awk_fgets _fgetts
#define awk_fgetc _fgettc
#define awk_fputs _fputts
#define awk_fputc _fputtc
#elif defined(ASE_CHAR_IS_MCHAR)
#define awk_fgets fgets
#define awk_fgetc fgetc
#define awk_fputs fputs
#define awk_fputc fputc
#else
#define awk_fgets fgetws
#define awk_fgetc fgetwc
#define awk_fputs fputws
#define awk_fputc fputwc
#endif
static ase_ssize_t get_input (
int cmd, void* arg, ase_char_t* data, ase_size_t size)
{
ase_ssize_t n;
@ -31,20 +50,37 @@ static ase_ssize_t get_input (int cmd, void* arg, ase_char_t* data, ase_size_t s
case ASE_LSP_IO_READ:
{
if (size < 0) return -1;
n = xp_sio_getc (xp_sio_in, data);
if (n == 0) return 0;
if (n != 1) return -1;
return n;
/*
if (awk_fgets (data, size, stdin) == ASE_NULL)
{
if (ferror(stdin)) return -1;
return 0;
}
return ase_lsp_strlen(data);
*/
ase_cint_t c;
if (size <= 0) return -1;
c = awk_fgetc (stdin);
if (c == ASE_CHAR_EOF)
{
if (ferror(stdin)) return -1;
return 0;
}
data[0] = c;
return 1;
}
}
return -1;
}
static ase_ssize_t put_output (int cmd, void* arg, ase_char_t* data, ase_size_t size)
static ase_ssize_t put_output (
int cmd, void* arg, ase_char_t* data, ase_size_t size)
{
switch (cmd)
{
case ASE_LSP_IO_OPEN:
@ -52,86 +88,21 @@ static ase_ssize_t put_output (int cmd, void* arg, ase_char_t* data, ase_size_t
return 0;
case ASE_LSP_IO_WRITE:
return xp_sio_putsx (xp_sio_out, data, size);
{
int n = ase_fprintf (
stdout, ASE_T("%.*s"), size, data);
if (n < 0) return -1;
return size;
}
}
return -1;
}
int to_int (const ase_char_t* str)
{
int r = 0;
while (*str != ASE_T('\0'))
{
if (!xp_isdigit(*str)) break;
r = r * 10 + (*str - ASE_T('0'));
str++;
}
return r;
}
#include <locale.h>
int handle_cli_error (
const xp_cli_t* cli, int code,
const ase_char_t* name, const ase_char_t* value)
{
xp_printf (ASE_T("usage: %s /memory=nnn /increment=nnn\n"), cli->verb);
if (code == ASE_CLI_ERROR_INVALID_OPTNAME) {
xp_printf (ASE_T("unknown option - %s\n"), name);
}
else if (code == ASE_CLI_ERROR_MISSING_OPTNAME) {
xp_printf (ASE_T("missing option - %s\n"), name);
}
else if (code == ASE_CLI_ERROR_REDUNDANT_OPTVAL) {
xp_printf (ASE_T("redundant value %s for %s\n"), value, name);
}
else if (code == ASE_CLI_ERROR_MISSING_OPTVAL) {
xp_printf (ASE_T("missing value for %s\n"), name);
}
else if (code == ASE_CLI_ERROR_MEMORY) {
xp_printf (ASE_T("memory error in processing %s\n"), name);
}
else {
xp_printf (ASE_T("error code: %d\n"), code);
}
return -1;
}
xp_cli_t* parse_cli (int argc, ase_char_t* argv[])
{
static const ase_char_t* optsta[] =
{
ASE_T("/"), ASE_T("--"), ASE_NULL
};
static xp_cliopt_t opts[] =
{
{ ASE_T("memory"), ASE_CLI_OPTNAME | ASE_CLI_OPTVAL },
{ ASE_T("increment"), ASE_CLI_OPTNAME | ASE_CLI_OPTVAL },
{ ASE_NULL, 0 }
};
static xp_cli_t cli =
{
handle_cli_error,
optsta,
ASE_T("="),
opts
};
if (xp_parsecli (argc, argv, &cli) == -1) return ASE_NULL;
return &cli;
}
#ifdef _WIN32
typedef struct syscas_data_t syscas_data_t;
struct syscas_data_t
typedef struct prmfns_data_t prmfns_data_t;
struct prmfns_data_t
{
HANDLE heap;
};
@ -140,7 +111,7 @@ struct syscas_data_t
static void* __lsp_malloc (ase_size_t n, void* custom_data)
{
#ifdef _WIN32
return HeapAlloc (((syscas_data_t*)custom_data)->heap, 0, n);
return HeapAlloc (((prmfns_data_t*)custom_data)->heap, 0, n);
#else
return malloc (n);
#endif
@ -151,9 +122,9 @@ static void* __lsp_realloc (void* ptr, ase_size_t n, void* custom_data)
#ifdef _WIN32
/* HeapReAlloc behaves differently from realloc */
if (ptr == NULL)
return HeapAlloc (((syscas_data_t*)custom_data)->heap, 0, n);
return HeapAlloc (((prmfns_data_t*)custom_data)->heap, 0, n);
else
return HeapReAlloc (((syscas_data_t*)custom_data)->heap, 0, ptr, n);
return HeapReAlloc (((prmfns_data_t*)custom_data)->heap, 0, ptr, n);
#else
return realloc (ptr, n);
#endif
@ -162,7 +133,7 @@ static void* __lsp_realloc (void* ptr, ase_size_t n, void* custom_data)
static void __lsp_free (void* ptr, void* custom_data)
{
#ifdef _WIN32
HeapFree (((syscas_data_t*)custom_data)->heap, 0, ptr);
HeapFree (((prmfns_data_t*)custom_data)->heap, 0, ptr);
#else
free (ptr);
#endif
@ -227,115 +198,96 @@ static void lsp_printf (const ase_char_t* fmt, ...)
va_end (ap);
}
int __main (int argc, ase_char_t* argv[])
int lsp_main (int argc, ase_char_t* argv[])
{
ase_lsp_t* lsp;
ase_lsp_obj_t* obj;
xp_cli_t* cli;
int mem, inc;
ase_lsp_syscas_t syscas;
ase_lsp_prmfns_t prmfns;
#ifdef _WIN32
syscas_data_t syscas_data;
prmfns_data_t prmfns_data;
#endif
/*
if (xp_setlocale () == -1) {
xp_fprintf (xp_stderr,
ASE_T("error: cannot set locale\n"));
return -1;
}
*/
if ((cli = parse_cli (argc, argv)) == ASE_NULL) return -1;
mem = to_int(xp_getclioptval(cli, ASE_T("memory")));
inc = to_int(xp_getclioptval(cli, ASE_T("increment")));
xp_clearcli (cli);
mem = 1000;
inc = 1000;
if (mem <= 0)
{
xp_fprintf (xp_stderr,
ASE_T("error: invalid memory size given\n"));
ase_printf (ASE_T("error: invalid memory size given\n"));
return -1;
}
memset (&prmfns, 0, sizeof(prmfns));
prmfns.malloc = __lsp_malloc;
prmfns.realloc = __lsp_realloc;
prmfns.free = __lsp_free;
memset (&syscas, 0, sizeof(syscas));
syscas.malloc = __lsp_malloc;
syscas.realloc = __lsp_realloc;
syscas.free = __lsp_free;
#ifdef ASE_T_IS_MCHAR
syscas.is_upper = isupper;
syscas.is_lower = islower;
syscas.is_alpha = isalpha;
syscas.is_digit = isdigit;
syscas.is_xdigit = isxdigit;
syscas.is_alnum = isalnum;
syscas.is_space = isspace;
syscas.is_print = isprint;
syscas.is_graph = isgraph;
syscas.is_cntrl = iscntrl;
syscas.is_punct = ispunct;
syscas.to_upper = toupper;
syscas.to_lower = tolower;
#ifdef ASE_CHAR_IS_MCHAR
prmfns.is_upper = isupper;
prmfns.is_lower = islower;
prmfns.is_alpha = isalpha;
prmfns.is_digit = isdigit;
prmfns.is_xdigit = isxdigit;
prmfns.is_alnum = isalnum;
prmfns.is_space = isspace;
prmfns.is_print = isprint;
prmfns.is_graph = isgraph;
prmfns.is_cntrl = iscntrl;
prmfns.is_punct = ispunct;
prmfns.to_upper = toupper;
prmfns.to_lower = tolower;
#else
syscas.is_upper = iswupper;
syscas.is_lower = iswlower;
syscas.is_alpha = iswalpha;
syscas.is_digit = iswdigit;
syscas.is_xdigit = iswxdigit;
syscas.is_alnum = iswalnum;
syscas.is_space = iswspace;
syscas.is_print = iswprint;
syscas.is_graph = iswgraph;
syscas.is_cntrl = iswcntrl;
syscas.is_punct = iswpunct;
syscas.to_upper = towupper;
syscas.to_lower = towlower;
prmfns.is_upper = iswupper;
prmfns.is_lower = iswlower;
prmfns.is_alpha = iswalpha;
prmfns.is_digit = iswdigit;
prmfns.is_xdigit = iswxdigit;
prmfns.is_alnum = iswalnum;
prmfns.is_space = iswspace;
prmfns.is_print = iswprint;
prmfns.is_graph = iswgraph;
prmfns.is_cntrl = iswcntrl;
prmfns.is_punct = iswpunct;
prmfns.to_upper = towupper;
prmfns.to_lower = towlower;
#endif
syscas.memcpy = memcpy;
syscas.memset = memset;
syscas.sprintf = xp_sprintf;
syscas.aprintf = lsp_aprintf;
syscas.dprintf = lsp_dprintf;
syscas.abort = lsp_abort;
prmfns.memcpy = memcpy;
prmfns.memset = memset;
prmfns.sprintf = lsp_sprintf;
prmfns.aprintf = lsp_aprintf;
prmfns.dprintf = lsp_dprintf;
prmfns.abort = lsp_abort;
#ifdef _WIN32
syscas_data.heap = HeapCreate (0, 1000000, 1000000);
if (syscas_data.heap == NULL)
prmfns_data.heap = HeapCreate (0, 1000000, 1000000);
if (prmfns_data.heap == NULL)
{
xp_printf (ASE_T("Error: cannot create an lsp heap\n"));
ase_printf (ASE_T("Error: cannot create an lsp heap\n"));
return -1;
}
syscas.custom_data = &syscas_data;
prmfns.custom_data = &prmfns_data;
#endif
lsp = ase_lsp_open (&syscas, mem, inc);
lsp = ase_lsp_open (&prmfns, mem, inc);
if (lsp == ASE_NULL)
{
#ifdef _WIN32
HeapDestroy (syscas_data.heap);
HeapDestroy (prmfns_data.heap);
#endif
xp_fprintf (xp_stderr,
ASE_T("error: cannot create a lsp instance\n"));
ase_printf (ASE_T("error: cannot create a lsp instance\n"));
return -1;
}
xp_printf (ASE_T("LSP 0.0001\n"));
ase_printf (ASE_T("LSP 0.0001\n"));
ase_lsp_attach_input (lsp, get_input, ASE_NULL);
ase_lsp_attach_output (lsp, put_output, ASE_NULL);
while (1)
{
xp_sio_puts (xp_sio_out, ASE_T("["));
xp_sio_puts (xp_sio_out, argv[0]);
xp_sio_puts (xp_sio_out, ASE_T("]"));
xp_sio_flush (xp_sio_out);
ase_printf (ASE_T("lsp> "));
fflush (stdout);
obj = ase_lsp_read (lsp);
if (obj == ASE_NULL)
@ -343,22 +295,23 @@ int __main (int argc, ase_char_t* argv[])
int errnum = ase_lsp_geterrnum(lsp);
const ase_char_t* errstr;
if (errnum != ASE_LSP_ERR_END &&
errnum != ASE_LSP_ERR_EXIT)
if (errnum != ASE_LSP_EEND &&
errnum != ASE_LSP_EEXIT)
{
errstr = ase_lsp_geterrstr(errnum);
xp_fprintf (xp_stderr,
ASE_T("error in read: [%d] %s\n"), errnum, errstr);
ase_printf (
ASE_T("error in read: [%d] %s\n"),
errnum, errstr);
}
if (errnum < ASE_LSP_ERR_SYNTAX) break;
if (errnum < ASE_LSP_ESYNTAX) break;
continue;
}
if ((obj = ase_lsp_eval (lsp, obj)) != ASE_NULL)
{
ase_lsp_print (lsp, obj);
xp_sio_puts (xp_sio_out, ASE_T("\n"));
ase_printf (ASE_T("\n"));
}
else
{
@ -366,23 +319,24 @@ int __main (int argc, ase_char_t* argv[])
const ase_char_t* errstr;
errnum = ase_lsp_geterrnum(lsp);
if (errnum == ASE_LSP_ERR_EXIT) break;
if (errnum == ASE_LSP_EEXIT) break;
errstr = ase_lsp_geterrstr(errnum);
xp_fprintf (xp_stderr,
ASE_T("error in eval: [%d] %s\n"), errnum, errstr);
ase_printf (
ASE_T("error in eval: [%d] %s\n"),
errnum, errstr);
}
}
ase_lsp_close (lsp);
#ifdef _WIN32
HeapDestroy (syscas_data.heap);
HeapDestroy (prmfns_data.heap);
#endif
return 0;
}
int xp_main (int argc, ase_char_t* argv[])
int ase_main (int argc, ase_char_t* argv[])
{
int n;
@ -390,7 +344,7 @@ int xp_main (int argc, ase_char_t* argv[])
mtrace ();
#endif
n = __main (argc, argv);
n = lsp_main (argc, argv);
#if defined(__linux) && defined(_DEBUG)
muntrace ();

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

@ -1,8 +1,8 @@
CC = bcc32
LD = ilink32
CFLAGS = -I..\..\.. -I$(XPKIT)
LDFLAGS = -L..\..\lsp -L"c:\program files\borland\bds\4.0\lib" -L$(XPKIT)\xp\bas
LIBS = import32.lib cw32mt.lib aselsp.lib xpbas.lib
LDFLAGS = -L..\..\lsp -L"c:\program files\borland\bds\4.0\lib"
LIBS = import32.lib cw32mt.lib aselsp.lib
STARTUP = c0x32w.obj
all: lsp