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
2006-10-30 11:26:57 +00:00
parent 3b10af5547
commit 09dd5ff969
5 changed files with 127 additions and 489 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
ase/lsp/lsp.h
View File

@ -1,5 +1,5 @@
/* /*
* $Id: lsp.h,v 1.31 2006-10-30 03:34:41 bacon Exp $ * $Id: lsp.h,v 1.32 2006-10-30 11:26:56 bacon Exp $
*/ */
#ifndef _ASE_LSP_LSP_H_ #ifndef _ASE_LSP_LSP_H_
@ -86,7 +86,7 @@ enum
ASE_LSP_ERR_BAD_SYMBOL, ASE_LSP_ERR_BAD_SYMBOL,
ASE_LSP_ERR_UNDEF_SYMBOL, ASE_LSP_ERR_UNDEF_SYMBOL,
ASE_LSP_ERR_EMPTY_BODY, ASE_LSP_ERR_EMPTY_BODY,
ASE_LSP_ERR_BAD_VALUE, ASE_LSP_EVALBAD,
ASE_LSP_EDIVBYZERO ASE_LSP_EDIVBYZERO
}; };

6
ase/lsp/mem.c
View File

@ -1,5 +1,5 @@
/* /*
* $Id: mem.c,v 1.19 2006-10-30 03:49:05 bacon Exp $ * $Id: mem.c,v 1.20 2006-10-30 11:26:56 bacon Exp $
*/ */
#include <ase/lsp/lsp_i.h> #include <ase/lsp/lsp_i.h>
@ -121,7 +121,8 @@ ase_lsp_obj_t* ase_lsp_alloc (ase_lsp_mem_t* mem, int type, ase_size_t size)
ase_lsp_obj_t* obj; ase_lsp_obj_t* obj;
if (mem->count >= mem->ubound) ase_lsp_collectgarbage (mem); if (mem->count >= mem->ubound) ase_lsp_collectgarbage (mem);
if (mem->count >= mem->ubound) { if (mem->count >= mem->ubound)
{
mem->ubound += mem->ubound_inc; mem->ubound += mem->ubound_inc;
if (mem->count >= mem->ubound) return ASE_NULL; if (mem->count >= mem->ubound) return ASE_NULL;
} }
@ -373,6 +374,7 @@ static void ase_lsp_sweepunmarkedobjs (ase_lsp_mem_t* mem)
void ase_lsp_collectgarbage (ase_lsp_mem_t* mem) void ase_lsp_collectgarbage (ase_lsp_mem_t* mem)
{ {
xp_printf (ASE_T("collecting garbage...\n"));
ase_lsp_markobjsinuse (mem); ase_lsp_markobjsinuse (mem);
ase_lsp_sweepunmarkedobjs (mem); ase_lsp_sweepunmarkedobjs (mem);
} }

579
ase/lsp/prim_compar.c
View File

@ -1,500 +1,135 @@
/* /*
* $Id: prim_compar.c,v 1.9 2006-10-30 03:49:05 bacon Exp $ * $Id: prim_compar.c,v 1.10 2006-10-30 11:26:56 bacon Exp $
*/ */
#include <ase/lsp/lsp_i.h> #include <ase/lsp/lsp_i.h>
#define PRIM_COMPAR(lsp,args,op) \
{ \
ase_lsp_obj_t* p1, * p2; \
int res; \
ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); \
\
p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args)); \
if (p1 == ASE_NULL) return ASE_NULL; \
ase_lsp_lockobj (lsp, p1); \
\
p2 = ase_lsp_eval (lsp, ASE_LSP_CAR(ASE_LSP_CDR(args))); \
if (p2 == ASE_NULL) \
{ \
ase_lsp_unlockobj (lsp, p1); \
return ASE_NULL; \
} \
\
ase_lsp_lockobj (lsp, p2); \
\
if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_INT) \
{ \
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) \
{ \
res = ASE_LSP_IVAL(p1) op ASE_LSP_IVAL(p2); \
} \
else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL) \
{ \
res = ASE_LSP_IVAL(p1) op ASE_LSP_RVAL(p2); \
} \
else \
{ \
ase_lsp_unlockobj (lsp, p1); \
ase_lsp_unlockobj (lsp, p2); \
lsp->errnum = ASE_LSP_EVALBAD; \
return ASE_NULL; \
} \
} \
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_REAL) \
{ \
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) \
{ \
res = ASE_LSP_RVAL(p1) op ASE_LSP_IVAL(p2); \
} \
else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL) \
{ \
res = ASE_LSP_RVAL(p1) op ASE_LSP_RVAL(p2); \
} \
else \
{ \
ase_lsp_unlockobj (lsp, p1); \
ase_lsp_unlockobj (lsp, p2); \
lsp->errnum = ASE_LSP_EVALBAD; \
return ASE_NULL; \
} \
} \
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_SYM) \
{ \
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYM) \
{ \
res = ase_lsp_strxncmp ( \
ASE_LSP_SYMPTR(p1), ASE_LSP_SYMLEN(p1), \
ASE_LSP_SYMPTR(p2), ASE_LSP_SYMLEN(p2)) op 0; \
} \
else \
{ \
ase_lsp_unlockobj (lsp, p1); \
ase_lsp_unlockobj (lsp, p2); \
lsp->errnum = ASE_LSP_EVALBAD; \
return ASE_NULL; \
} \
} \
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_STR) \
{ \
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_STR) \
{ \
res = ase_lsp_strxncmp ( \
ASE_LSP_STRPTR(p1), ASE_LSP_STRLEN(p1), \
ASE_LSP_STRPTR(p2), ASE_LSP_STRLEN(p2)) op 0; \
} \
else \
{ \
ase_lsp_unlockobj (lsp, p1); \
ase_lsp_unlockobj (lsp, p2); \
lsp->errnum = ASE_LSP_EVALBAD; \
return ASE_NULL; \
} \
} \
else \
{ \
ase_lsp_unlockobj (lsp, p1); \
ase_lsp_unlockobj (lsp, p2); \
lsp->errnum = ASE_LSP_EVALBAD; \
return ASE_NULL; \
} \
\
ase_lsp_unlockobj (lsp, p1); \
ase_lsp_unlockobj (lsp, p2); \
return (res)? lsp->mem->t: lsp->mem->nil; \
}
ase_lsp_obj_t* ase_lsp_prim_eq (ase_lsp_t* lsp, ase_lsp_obj_t* args) ase_lsp_obj_t* ase_lsp_prim_eq (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{ {
ase_lsp_obj_t* p1, * p2; PRIM_COMPAR (lsp, args, ==);
int res;
ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
if (p1 == ASE_NULL) return ASE_NULL;
// TODO: lock p1....
p2 = ase_lsp_eval (lsp, ASE_LSP_CAR(ASE_LSP_CDR(args)));
if (p2 == ASE_NULL) return ASE_NULL;
if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_INT)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT)
{
res = ASE_LSP_IVAL(p1) == ASE_LSP_IVAL(p2);
}
else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL)
{
res = ASE_LSP_IVAL(p1) == ASE_LSP_RVAL(p2);
}
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_REAL)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT)
{
res = ASE_LSP_RVAL(p1) == ASE_LSP_IVAL(p2);
}
else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL)
{
res = ASE_LSP_RVAL(p1) == ASE_LSP_RVAL(p2);
}
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_SYM)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYM)
{
res = ase_lsp_strxncmp (
ASE_LSP_SYMPTR(p1), ASE_LSP_SYMLEN(p1),
ASE_LSP_SYMPTR(p2), ASE_LSP_SYMLEN(p2)) == 0;
}
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_STR)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_STR)
{
res = ase_lsp_strxncmp (
ASE_LSP_STRPTR(p1), ASE_LSP_STRLEN(p1),
ASE_LSP_STRPTR(p2), ASE_LSP_STRLEN(p2)) == 0;
}
else {
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
return (res)? lsp->mem->t: lsp->mem->nil;
} }
ase_lsp_obj_t* ase_lsp_prim_ne (ase_lsp_t* lsp, ase_lsp_obj_t* args) ase_lsp_obj_t* ase_lsp_prim_ne (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{ {
ase_lsp_obj_t* p1, * p2; PRIM_COMPAR (lsp, args, !=);
int res;
ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
if (p1 == ASE_NULL) return ASE_NULL;
// TODO: lock p1....
p2 = ase_lsp_eval (lsp, ASE_LSP_CAR(ASE_LSP_CDR(args)));
if (p2 == ASE_NULL) return ASE_NULL;
if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_INT)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT)
{
res = ASE_LSP_IVAL(p1) != ASE_LSP_IVAL(p2);
}
else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL)
{
res = ASE_LSP_IVAL(p1) != ASE_LSP_RVAL(p2);
}
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_REAL)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT)
{
res = ASE_LSP_RVAL(p1) != ASE_LSP_IVAL(p2);
}
else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL)
{
res = ASE_LSP_RVAL(p1) != ASE_LSP_RVAL(p2);
}
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_SYM)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYM)
{
res = ase_lsp_strxncmp (
ASE_LSP_SYMPTR(p1), ASE_LSP_SYMLEN(p1),
ASE_LSP_SYMPTR(p2), ASE_LSP_SYMLEN(p2)) != 0;
}
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_STR)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_STR)
{
res = ase_lsp_strxncmp (
ASE_LSP_STRPTR(p1), ASE_LSP_STRLEN(p1),
ASE_LSP_STRPTR(p2), ASE_LSP_STRLEN(p2)) != 0;
}
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
return (res)? lsp->mem->t: lsp->mem->nil;
} }
ase_lsp_obj_t* ase_lsp_prim_gt (ase_lsp_t* lsp, ase_lsp_obj_t* args) ase_lsp_obj_t* ase_lsp_prim_gt (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{ {
ase_lsp_obj_t* p1, * p2; PRIM_COMPAR (lsp, args, >);
int res;
ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
if (p1 == ASE_NULL) return ASE_NULL;
// TODO: lock p1....
p2 = ase_lsp_eval (lsp, ASE_LSP_CAR(ASE_LSP_CDR(args)));
if (p2 == ASE_NULL) return ASE_NULL;
if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_INT)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT)
{
res = ASE_LSP_IVAL(p1) > ASE_LSP_IVAL(p2);
}
else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL)
{
res = ASE_LSP_IVAL(p1) > ASE_LSP_RVAL(p2);
}
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_REAL)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT)
{
res = ASE_LSP_RVAL(p1) > ASE_LSP_IVAL(p2);
}
else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL)
{
res = ASE_LSP_RVAL(p1) > ASE_LSP_RVAL(p2);
}
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_SYM)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYM)
{
res = ase_lsp_strxncmp (
ASE_LSP_SYMPTR(p1), ASE_LSP_SYMLEN(p1),
ASE_LSP_SYMPTR(p2), ASE_LSP_SYMLEN(p2)) > 0;
}
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_STR)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_STR)
{
res = ase_lsp_strxncmp (
ASE_LSP_STRPTR(p1), ASE_LSP_STRLEN(p1),
ASE_LSP_STRPTR(p2), ASE_LSP_STRLEN(p2)) > 0;
}
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
return (res)? lsp->mem->t: lsp->mem->nil;
} }
ase_lsp_obj_t* ase_lsp_prim_lt (ase_lsp_t* lsp, ase_lsp_obj_t* args) ase_lsp_obj_t* ase_lsp_prim_lt (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{ {
ase_lsp_obj_t* p1, * p2; PRIM_COMPAR (lsp, args, <);
int res;
ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
if (p1 == ASE_NULL) return ASE_NULL;
// TODO: lock p1....
p2 = ase_lsp_eval (lsp, ASE_LSP_CAR(ASE_LSP_CDR(args)));
if (p2 == ASE_NULL) return ASE_NULL;
if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_INT)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT)
{
res = ASE_LSP_IVAL(p1) < ASE_LSP_IVAL(p2);
}
else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL)
{
res = ASE_LSP_IVAL(p1) < ASE_LSP_RVAL(p2);
}
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_REAL)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT)
{
res = ASE_LSP_RVAL(p1) < ASE_LSP_IVAL(p2);
}
else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL)
{
res = ASE_LSP_RVAL(p1) < ASE_LSP_RVAL(p2);
}
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_SYM)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYM)
{
res = ase_lsp_strxncmp (
ASE_LSP_SYMPTR(p1), ASE_LSP_SYMLEN(p1),
ASE_LSP_SYMPTR(p2), ASE_LSP_SYMLEN(p2)) < 0;
}
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_STR)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_STR)
{
res = ase_lsp_strxncmp (
ASE_LSP_STRPTR(p1), ASE_LSP_STRLEN(p1),
ASE_LSP_STRPTR(p2), ASE_LSP_STRLEN(p2)) < 0;
}
else {
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
return (res)? lsp->mem->t: lsp->mem->nil;
} }
ase_lsp_obj_t* ase_lsp_prim_ge (ase_lsp_t* lsp, ase_lsp_obj_t* args) ase_lsp_obj_t* ase_lsp_prim_ge (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{ {
ase_lsp_obj_t* p1, * p2; PRIM_COMPAR (lsp, args, >=);
int res;
ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
if (p1 == ASE_NULL) return ASE_NULL;
// TODO: lock p1....
p2 = ase_lsp_eval (lsp, ASE_LSP_CAR(ASE_LSP_CDR(args)));
if (p2 == ASE_NULL) return ASE_NULL;
if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_INT)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT)
{
res = ASE_LSP_IVAL(p1) >= ASE_LSP_IVAL(p2);
}
else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL)
{
res = ASE_LSP_IVAL(p1) >= ASE_LSP_RVAL(p2);
}
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_REAL)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT)
{
res = ASE_LSP_RVAL(p1) >= ASE_LSP_IVAL(p2);
}
else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL)
{
res = ASE_LSP_RVAL(p1) >= ASE_LSP_RVAL(p2);
}
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_SYM)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYM)
{
res = ase_lsp_strxncmp (
ASE_LSP_SYMPTR(p1), ASE_LSP_SYMLEN(p1),
ASE_LSP_SYMPTR(p2), ASE_LSP_SYMLEN(p2)) >= 0;
}
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_STR)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_STR)
{
res = ase_lsp_strxncmp (
ASE_LSP_STRPTR(p1), ASE_LSP_STRLEN(p1),
ASE_LSP_STRPTR(p2), ASE_LSP_STRLEN(p2)) >= 0;
}
else {
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
return (res)? lsp->mem->t: lsp->mem->nil;
} }
ase_lsp_obj_t* ase_lsp_prim_le (ase_lsp_t* lsp, ase_lsp_obj_t* args) ase_lsp_obj_t* ase_lsp_prim_le (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{ {
ase_lsp_obj_t* p1, * p2; PRIM_COMPAR (lsp, args, <=);
int res;
ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
if (p1 == ASE_NULL) return ASE_NULL;
// TODO: lock p1....
p2 = ase_lsp_eval (lsp, ASE_LSP_CAR(ASE_LSP_CDR(args)));
if (p2 == ASE_NULL) return ASE_NULL;
if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_INT)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT)
{
res = ASE_LSP_IVAL(p1) <= ASE_LSP_IVAL(p2);
}
else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL)
{
res = ASE_LSP_IVAL(p1) <= ASE_LSP_RVAL(p2);
}
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_REAL)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT)
{
res = ASE_LSP_RVAL(p1) <= ASE_LSP_IVAL(p2);
}
else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL)
{
res = ASE_LSP_RVAL(p1) <= ASE_LSP_RVAL(p2);
}
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_SYM)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYM)
{
res = ase_lsp_strxncmp (
ASE_LSP_SYMPTR(p1), ASE_LSP_SYMLEN(p1),
ASE_LSP_SYMPTR(p2), ASE_LSP_SYMLEN(p2)) <= 0;
}
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_STR)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_STR)
{
res = ase_lsp_strxncmp (
ASE_LSP_STRPTR(p1), ASE_LSP_STRLEN(p1),
ASE_LSP_STRPTR(p2), ASE_LSP_STRLEN(p2)) <= 0;
}
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
return (res)? lsp->mem->t: lsp->mem->nil;
} }

14
ase/lsp/prim_math.c
View File

@ -1,5 +1,5 @@
/* /*
* $Id: prim_math.c,v 1.14 2006-10-30 03:49:06 bacon Exp $ * $Id: prim_math.c,v 1.15 2006-10-30 11:26:57 bacon Exp $
*/ */
#include <ase/lsp/lsp_i.h> #include <ase/lsp/lsp_i.h>
@ -20,7 +20,7 @@ ase_lsp_obj_t* ase_lsp_prim_plus (ase_lsp_t* lsp, ase_lsp_obj_t* args)
tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(body)); tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(body));
if (tmp == ASE_NULL) if (tmp == ASE_NULL)
{ {
/*lsp->errnum = ASE_LSP_ERR_BAD_VALUE; */ /*lsp->errnum = ASE_LSP_EVALBAD; */
return ASE_NULL; return ASE_NULL;
} }
@ -59,7 +59,7 @@ ase_lsp_obj_t* ase_lsp_prim_plus (ase_lsp_t* lsp, ase_lsp_obj_t* args)
} }
else else
{ {
lsp->errnum = ASE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_EVALBAD;
return ASE_NULL; return ASE_NULL;
} }
@ -133,7 +133,7 @@ ase_lsp_obj_t* ase_lsp_prim_minus (ase_lsp_t* lsp, ase_lsp_obj_t* args)
} }
else else
{ {
lsp->errnum = ASE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_EVALBAD;
return ASE_NULL; return ASE_NULL;
} }
@ -206,7 +206,7 @@ ase_lsp_obj_t* ase_lsp_prim_mul (ase_lsp_t* lsp, ase_lsp_obj_t* args)
} }
else else
{ {
lsp->errnum = ASE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_EVALBAD;
return ASE_NULL; return ASE_NULL;
} }
@ -286,7 +286,7 @@ ase_lsp_obj_t* ase_lsp_prim_div (ase_lsp_t* lsp, ase_lsp_obj_t* args)
} }
else else
{ {
lsp->errnum = ASE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_EVALBAD;
return ASE_NULL; return ASE_NULL;
} }
@ -357,7 +357,7 @@ ase_lsp_obj_t* ase_lsp_prim_mod (ase_lsp_t* lsp, ase_lsp_obj_t* args)
} }
else else
{ {
lsp->errnum = ASE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_EVALBAD;
return ASE_NULL; return ASE_NULL;
} }

13
ase/lsp/prim_prog.c
View File

@ -1,11 +1,13 @@
/* /*
* $Id: prim_prog.c,v 1.5 2006-10-29 13:40:33 bacon Exp $ * $Id: prim_prog.c,v 1.6 2006-10-30 11:26:57 bacon Exp $
*/ */
#include <ase/lsp/lsp_i.h> #include <ase/lsp/lsp_i.h>
ase_lsp_obj_t* ase_lsp_prim_prog1 (ase_lsp_t* lsp, ase_lsp_obj_t* args) 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; ase_lsp_obj_t* res = ASE_NULL, * tmp;
/*while (args != lsp->mem->nil) {*/ /*while (args != lsp->mem->nil) {*/
@ -16,27 +18,26 @@ ase_lsp_obj_t* ase_lsp_prim_prog1 (ase_lsp_t* lsp, ase_lsp_obj_t* args)
if (res == ASE_NULL) if (res == ASE_NULL)
{ {
/*
ase_lsp_arr_t* ta = lsp->mem->temp_arr;
ase_lsp_arr_insert (ta, ta->size, tmp);
*/
res = tmp; res = tmp;
ase_lsp_lockobj (lsp, res);
} }
args = ASE_LSP_CDR(args); args = ASE_LSP_CDR(args);
} }
if (res != ASE_NULL) ase_lsp_unlockobj (lsp, res);
return res; return res;
} }
ase_lsp_obj_t* ase_lsp_prim_progn (ase_lsp_t* lsp, ase_lsp_obj_t* args) ase_lsp_obj_t* ase_lsp_prim_progn (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{ {
/* (progn 1 2 3) returns 3 */
ase_lsp_obj_t* res, * tmp; ase_lsp_obj_t* res, * tmp;
res = lsp->mem->nil; res = lsp->mem->nil;
/*while (args != lsp->mem->nil) {*/ /*while (args != lsp->mem->nil) {*/
while (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS) while (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS)
{ {
tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(args)); tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
if (tmp == ASE_NULL) return ASE_NULL; if (tmp == ASE_NULL) return ASE_NULL;