*** empty log message ***

This commit is contained in:
2007-02-03 10:52:36 +00:00
parent adb88864bd
commit 72a4fe275c
52 changed files with 284 additions and 122 deletions

View File

@ -1,5 +1,7 @@
/*
* $Id: env.c,v 1.13 2006-10-26 09:31:28 bacon Exp $
* $Id: env.c,v 1.14 2007-02-03 10:51:52 bacon Exp $
*
* {License}
*/
#include <ase/lsp/lsp_i.h>

View File

@ -1,5 +1,7 @@
/*
* $Id: env.h,v 1.10 2006-10-26 08:17:37 bacon Exp $
* $Id: env.h,v 1.11 2007-02-03 10:51:52 bacon Exp $
*
* {License}
*/
#ifndef _ASE_LSP_ENV_H_

View File

@ -1,5 +1,7 @@
/*
* $Id: err.c,v 1.8 2006-11-29 02:54:17 bacon Exp $
* $Id: err.c,v 1.9 2007-02-03 10:51:52 bacon Exp $
*
* {License}
*/
#include <ase/lsp/lsp_i.h>

View File

@ -1,5 +1,7 @@
/*
* $Id: eval.c,v 1.23 2006-11-02 11:10:12 bacon Exp $
* $Id: eval.c,v 1.24 2007-02-03 10:51:52 bacon Exp $
*
* {License}
*/
#include <ase/lsp/lsp_i.h>
@ -41,7 +43,7 @@ static ase_lsp_obj_t* __eval (ase_lsp_t* lsp, ase_lsp_obj_t* obj)
/*
if (obj == lsp->mem->lambda || obj == lsp->mem->macro) {
printf ("lambda or macro can't be used as a normal symbol\n");
lsp->errnum = ASE_LSP_ERR_BAD_SYMBOL;
lsp->errnum = ASE_LSP_EBADSYM;
return ASE_NULL;
}
*/
@ -84,7 +86,7 @@ static ase_lsp_obj_t* make_func (ase_lsp_t* lsp, ase_lsp_obj_t* cdr, int is_macr
if (body == lsp->mem->nil)
{
lsp->errnum = ASE_LSP_ERR_EMPTY_BODY;
lsp->errnum = ASE_LSP_EEMPBDY;
return ASE_NULL;
}

View File

@ -1,5 +1,7 @@
/*
* $Id: lsp.c,v 1.20 2007-02-01 08:49:51 bacon Exp $
* $Id: lsp.c,v 1.21 2007-02-03 10:51:52 bacon Exp $
*
* {License}
*/
#if defined(__BORLANDC__)

View File

@ -1,5 +1,7 @@
/*
* $Id: lsp.h,v 1.34 2007-02-01 08:49:51 bacon Exp $
* $Id: lsp.h,v 1.35 2007-02-03 10:51:52 bacon Exp $
*
* {License}
*/
#ifndef _ASE_LSP_LSP_H_
@ -86,25 +88,25 @@ enum
ASE_LSP_ENOERR,
ASE_LSP_ENOMEM,
ASE_LSP_ERR_EXIT,
ASE_LSP_ERR_END,
ASE_LSP_EEXIT,
ASE_LSP_EEND,
ASE_LSP_ERR_INPUT_NOT_ATTACHED,
ASE_LSP_ERR_INPUT,
ASE_LSP_ERR_OUTPUT_NOT_ATTACHED,
ASE_LSP_ERR_OUTPUT,
ASE_LSP_ERR_SYNTAX,
ASE_LSP_ESYNTAX,
ASE_LSP_EARGBAD,
ASE_LSP_EARGFEW,
ASE_LSP_EARGMANY,
ASE_LSP_ERR_UNDEF_FUNC,
ASE_LSP_ERR_BAD_FUNC,
ASE_LSP_ERR_DUP_FORMAL,
ASE_LSP_ERR_BAD_SYMBOL,
ASE_LSP_EBADSYM,
ASE_LSP_ERR_UNDEF_SYMBOL,
ASE_LSP_ERR_EMPTY_BODY,
ASE_LSP_EEMPBDY,
ASE_LSP_EVALBAD,
ASE_LSP_EDIVBYZERO
ASE_LSP_EDIVBY0
};
typedef ase_lsp_obj_t* (*ase_lsp_prim_t) (ase_lsp_t* lsp, ase_lsp_obj_t* obj);

View File

@ -1,5 +1,7 @@
/*
* $Id: lsp_i.h,v 1.6 2007-02-01 08:49:52 bacon Exp $
* $Id: lsp_i.h,v 1.7 2007-02-03 10:51:52 bacon Exp $
*
* {License}
*/
#ifndef _ASE_LSP_LSPI_H_

View File

@ -1,5 +1,7 @@
/*
* $Id: mem.c,v 1.25 2006-11-29 02:54:17 bacon Exp $
* $Id: mem.c,v 1.26 2007-02-03 10:51:52 bacon Exp $
*
* {License}
*/
#include <ase/lsp/lsp_i.h>
@ -90,6 +92,7 @@ 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);
if (mem->count >= mem->ubound)

View File

@ -1,5 +1,7 @@
/*
* $Id: mem.h,v 1.16 2006-11-02 10:12:01 bacon Exp $
* $Id: mem.h,v 1.17 2007-02-03 10:51:52 bacon Exp $
*
* {License}
*/
#ifndef _ASE_LSP_MEM_H_

View File

@ -1,5 +1,7 @@
/*
* $Id: misc.c,v 1.7 2007-02-01 08:49:52 bacon Exp $
* $Id: misc.c,v 1.8 2007-02-03 10:51:52 bacon Exp $
*
* {License}
*/
#include <ase/lsp/lsp_i.h>

View File

@ -1,5 +1,7 @@
/*
* $Id: misc.h,v 1.3 2006-10-26 09:31:28 bacon Exp $
* $Id: misc.h,v 1.4 2007-02-03 10:51:52 bacon Exp $
*
* {License}
*/
#ifndef _ASE_LSP_MISC_H_

View File

@ -1,5 +1,7 @@
/*
* $Id: name.c,v 1.13 2006-12-05 03:38:11 bacon Exp $
* $Id: name.c,v 1.14 2007-02-03 10:51:52 bacon Exp $
*
* {License}
*/
#include <ase/lsp/lsp_i.h>

View File

@ -1,5 +1,7 @@
/*
* $Id: name.h,v 1.8 2006-11-02 10:12:01 bacon Exp $
* $Id: name.h,v 1.9 2007-02-03 10:51:52 bacon Exp $
*
* {License}
*/
#ifndef _ASE_LSP_NAME_H_

View File

@ -1,5 +1,7 @@
/*
* $Id: obj.h,v 1.15 2006-11-02 10:12:01 bacon Exp $
* $Id: obj.h,v 1.16 2007-02-03 10:51:53 bacon Exp $
*
* {License}
*/
#ifndef _ASE_LSP_OBJ_H_

View File

@ -1,5 +1,7 @@
/*
* $Id: prim.c,v 1.18 2006-11-02 11:10:12 bacon Exp $
* $Id: prim.c,v 1.19 2007-02-03 10:51:53 bacon Exp $
*
* {License}
*/
#include <ase/lsp/lsp_i.h>
@ -33,33 +35,51 @@ static int __add_prim (ase_lsp_mem_t* mem,
ase_lsp_lockobj (mem->lsp, n);
p = ase_lsp_makeprim (mem, pimpl, min_args, max_args);
if (p == ASE_NULL) return -1;
if (p == ASE_NULL)
{
ase_lsp_unlockobj (mem->lsp, n);
return -1;
}
ase_lsp_lockobj (mem->lsp, p);
if (ase_lsp_setfunc(mem, n, p) == ASE_NULL)
{
ase_lsp_unlockobj (mem->lsp, p);
ase_lsp_unlockobj (mem->lsp, n);
return -1;
}
ase_lsp_unlockobj (mem->lsp, p);
ase_lsp_unlockobj (mem->lsp, n);
if (ase_lsp_setfunc(mem, n, p) == ASE_NULL) return -1;
return 0;
}
ase_lsp_obj_t* ase_lsp_prim_exit (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{
lsp->errnum = ASE_LSP_ERR_EXIT;
lsp->errnum = ASE_LSP_EEXIT;
return ASE_NULL;
}
ase_lsp_obj_t* ase_lsp_prim_eval (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{
ase_lsp_obj_t* tmp;
ase_lsp_obj_t* tmp1, * tmp2;
ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
if (tmp == ASE_NULL) return ASE_NULL;
tmp1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
if (tmp1 == ASE_NULL) return ASE_NULL;
tmp = ase_lsp_eval (lsp, tmp);
if (tmp == ASE_NULL) return ASE_NULL;
ase_lsp_lockobj (mem->lsp, tmp1);
tmp2 = ase_lsp_eval (lsp, tmp1);
if (tmp2 == ASE_NULL)
{
ase_lsp_unlockobj (mem->lsp, tmp1);
return ASE_NULL;
}
ase_lsp_unlockobj (mem->lsp, tmp1);
return tmp;
}

View File

@ -1,5 +1,7 @@
/*
* $Id: prim.h,v 1.13 2006-11-02 11:10:12 bacon Exp $
* $Id: prim.h,v 1.14 2007-02-03 10:51:53 bacon Exp $
*
* {License}
*/
#ifndef _ASE_LSP_PRIM_H_

View File

@ -1,5 +1,7 @@
/*
* $Id: prim_compar.c,v 1.10 2006-10-30 11:26:56 bacon Exp $
* $Id: prim_compar.c,v 1.11 2007-02-03 10:51:53 bacon Exp $
*
* {License}
*/
#include <ase/lsp/lsp_i.h>

View File

@ -1,5 +1,7 @@
/*
* $Id: prim_let.c,v 1.9 2006-10-30 03:34:41 bacon Exp $
* $Id: prim_let.c,v 1.10 2007-02-03 10:51:53 bacon Exp $
*
* {License}
*/
#include <ase/lsp/lsp_i.h>

View File

@ -1,5 +1,7 @@
/*
* $Id: prim_math.c,v 1.15 2006-10-30 11:26:57 bacon Exp $
* $Id: prim_math.c,v 1.16 2007-02-03 10:51:53 bacon Exp $
*
* {License}
*/
#include <ase/lsp/lsp_i.h>
@ -257,7 +259,7 @@ ase_lsp_obj_t* ase_lsp_prim_div (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{
if (ASE_LSP_IVAL(tmp) == 0)
{
lsp->errnum = ASE_LSP_EDIVBYZERO;
lsp->errnum = ASE_LSP_EDIVBY0;
return ASE_NULL;
}
ival = ival / ASE_LSP_IVAL(tmp);
@ -332,7 +334,7 @@ ase_lsp_obj_t* ase_lsp_prim_mod (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{
if (ASE_LSP_IVAL(tmp) == 0)
{
lsp->errnum = ASE_LSP_EDIVBYZERO;
lsp->errnum = ASE_LSP_EDIVBY0;
return ASE_NULL;
}
ival = ival % ASE_LSP_IVAL(tmp);
@ -349,7 +351,7 @@ ase_lsp_obj_t* ase_lsp_prim_mod (ase_lsp_t* lsp, ase_lsp_obj_t* args)
ase_long_t tmpi = (ase_long_t)ASE_LSP_RVAL(tmp);
if (tmpi == 0)
{
lsp->errnum = ASE_LSP_EDIVBYZERO;
lsp->errnum = ASE_LSP_EDIVBY0;
return ASE_NULL;
}
ival = ival % tmpi;

View File

@ -1,5 +1,7 @@
/*
* $Id: prim_prog.c,v 1.6 2006-10-30 11:26:57 bacon Exp $
* $Id: prim_prog.c,v 1.7 2007-02-03 10:51:53 bacon Exp $
*
* {License}
*/
#include <ase/lsp/lsp_i.h>

View File

@ -1,5 +1,7 @@
/*
* $Id: print.c,v 1.20 2007-02-01 08:49:52 bacon Exp $
* $Id: print.c,v 1.21 2007-02-03 10:51:53 bacon Exp $
*
* {License}
*/
#include <ase/lsp/lsp_i.h>

View File

@ -1,5 +1,7 @@
/*
* $Id: read.c,v 1.29 2006-11-02 10:12:01 bacon Exp $
* $Id: read.c,v 1.30 2007-02-03 10:51:53 bacon Exp $
*
* {License}
*/
#include <ase/lsp/lsp_i.h>
@ -77,7 +79,7 @@ static ase_lsp_obj_t* read_obj (ase_lsp_t* lsp)
switch (TOKEN_TYPE(lsp))
{
case TOKEN_END:
lsp->errnum = ASE_LSP_ERR_END;
lsp->errnum = ASE_LSP_EEND;
return ASE_NULL;
case TOKEN_LPAREN:
@ -128,7 +130,7 @@ static ase_lsp_obj_t* read_obj (ase_lsp_t* lsp)
return obj;
}
lsp->errnum = ASE_LSP_ERR_SYNTAX;
lsp->errnum = ASE_LSP_ESYNTAX;
return ASE_NULL;
}
@ -141,7 +143,8 @@ static ase_lsp_obj_t* read_list (ase_lsp_t* lsp)
{
if (TOKEN_TYPE(lsp) == TOKEN_END)
{
lsp->errnum = ASE_LSP_ERR_SYNTAX; /* unexpected end of input */
/* unexpected end of input */
lsp->errnum = ASE_LSP_ESYNTAX;
return ASE_NULL;
}
@ -149,7 +152,8 @@ static ase_lsp_obj_t* read_list (ase_lsp_t* lsp)
{
if (prev == ASE_NULL)
{
lsp->errnum = ASE_LSP_ERR_SYNTAX; /* unexpected dot */
/* unexpected dot */
lsp->errnum = ASE_LSP_ESYNTAX;
return ASE_NULL;
}
@ -157,10 +161,10 @@ static ase_lsp_obj_t* read_list (ase_lsp_t* lsp)
obj = read_obj (lsp);
if (obj == ASE_NULL)
{
if (lsp->errnum == ASE_LSP_ERR_END)
if (lsp->errnum == ASE_LSP_EEND)
{
/* unexpected end of input */
lsp->errnum = ASE_LSP_ERR_SYNTAX;
lsp->errnum = ASE_LSP_ESYNTAX;
}
return ASE_NULL;
}
@ -169,7 +173,8 @@ static ase_lsp_obj_t* read_list (ase_lsp_t* lsp)
NEXT_TOKEN (lsp);
if (TOKEN_TYPE(lsp) != TOKEN_RPAREN)
{
lsp->errnum = ASE_LSP_ERR_SYNTAX; /* ) expected */
/* ) expected */
lsp->errnum = ASE_LSP_ESYNTAX;
return ASE_NULL;
}
@ -179,10 +184,10 @@ static ase_lsp_obj_t* read_list (ase_lsp_t* lsp)
obj = read_obj (lsp);
if (obj == ASE_NULL)
{
if (lsp->errnum == ASE_LSP_ERR_END)
if (lsp->errnum == ASE_LSP_EEND)
{
/* unexpected end of input */
lsp->errnum = ASE_LSP_ERR_SYNTAX;
lsp->errnum = ASE_LSP_ESYNTAX;
}
return ASE_NULL;
}
@ -215,10 +220,10 @@ static ase_lsp_obj_t* read_quote (ase_lsp_t* lsp)
tmp = read_obj (lsp);
if (tmp == ASE_NULL)
{
if (lsp->errnum == ASE_LSP_ERR_END)
if (lsp->errnum == ASE_LSP_EEND)
{
// unexpected end of input
lsp->errnum = ASE_LSP_ERR_SYNTAX;
/* unexpected end of input */
lsp->errnum = ASE_LSP_ESYNTAX;
}
return ASE_NULL;
}
@ -273,10 +278,10 @@ static int read_token (ase_lsp_t* lsp)
while (1)
{
// skip white spaces
/* skip white spaces */
while (ASE_LSP_ISSPACE(lsp, lsp->curc)) NEXT_CHAR (lsp);
// skip the comments here
/* skip the comments here */
if (lsp->curc == ASE_T(';'))
{
do
@ -355,7 +360,7 @@ static int read_token (ase_lsp_t* lsp)
}
TOKEN_TYPE(lsp) = TOKEN_INVALID;
NEXT_CHAR (lsp); // consume
NEXT_CHAR (lsp); /* consume */
return 0;
}
@ -522,7 +527,7 @@ static int read_string (ase_lsp_t* lsp)
return 0;
}
// TODO:
/* TODO: */
if (escaped == 3)
{
/* \xNN */