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-29 13:40:33 +00:00
parent 4c57a641d5
commit 94ca0b812f
15 changed files with 217 additions and 178 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
ase/lsp/aselsp.bdsproj
View File

@ -19,15 +19,17 @@
<property category="build.config" name="excludedefaultforzero" value="0"/>
<property category="build.config.0" name="builddir" value="Debug"/>
<property category="build.config.0" name="key" value="Debug_Build"/>
<property category="build.config.0" name="name" value="Debug Build"/>
<property category="build.config.0" name="name" value="Debug Win32"/>
<property category="build.config.0" name="settings.win32b" value="default"/>
<property category="build.config.0" name="type" value="Toolset"/>
<property category="build.config.0" name="win32.win32b.builddir" value="Debug_Build"/>
<property category="build.config.0" name="win32.win32b.builddir" value="..\debug\win32\bds"/>
<property category="build.config.1" name="key" value="Release_Build"/>
<property category="build.config.1" name="name" value="Release Build"/>
<property category="build.config.1" name="name" value="Release Win32"/>
<property category="build.config.1" name="settings.win32b" value="default"/>
<property category="build.config.1" name="type" value="Toolset"/>
<property category="build.config.1" name="win32.win32b.builddir" value="Release_Build"/>
<property category="build.config.1" name="win32.win32b.builddir" value="..\release\win32\bds"/>
<property category="build.node" name="lastconfig" value="Debug_Build"/>
<property category="build.node" name="libraries" value="vcl.lib rtl.lib"/>
<property category="build.node" name="name" value="aselsp.lib"/>
<property category="build.node" name="packages" value="vclx;vcl;rtl;dbrtl;vcldb;adortl;dbxcds;dbexpress;xmlrtl;vclie;inet;inetdbbde;inetdbxpress;soaprtl;dsnap;bdertl;vcldbx"/>
<property category="build.node" name="sparelibs" value="rtl.lib vcl.lib"/>
@ -38,11 +40,18 @@
<property category="build.platform" name="win32.default" value="win32b"/>
<property category="build.platform" name="win32.enabled" value="1"/>
<property category="build.platform" name="win32.win32b.enabled" value="1"/>
<property category="win32.*.win32b.dcc32" name="param.filenames.merge" value="1"/>
<property category="win32.*.win32b.tasm32" name="param.listfile.merge" value="1"/>
<property category="win32.*.win32b.tasm32" name="param.objfile.merge" value="1"/>
<property category="win32.*.win32b.tasm32" name="param.xreffile.merge" value="1"/>
<property category="win32.Debug_Build.win32b.bcc32" name="option.D.arg.1" value="_DEBUG"/>
<property category="win32.Debug_Build.win32b.bcc32" name="option.D.arg.merge" value="1"/>
<property category="win32.Debug_Build.win32b.bcc32" name="option.D.enabled" value="1"/>
<property category="win32.Debug_Build.win32b.bcc32" name="option.Od.enabled" value="1"/>
<property category="win32.Debug_Build.win32b.bcc32" name="option.k.enabled" value="1"/>
<property category="win32.Debug_Build.win32b.bcc32" name="option.n.arg.1" value="debug\win32\bds"/>
<property category="win32.Debug_Build.win32b.bcc32" name="option.n.arg.merge" value="0"/>
<property category="win32.Debug_Build.win32b.bcc32" name="option.n.enabled" value="1"/>
<property category="win32.Debug_Build.win32b.bcc32" name="option.r.enabled" value="0"/>
<property category="win32.Debug_Build.win32b.bcc32" name="option.v.enabled" value="1"/>
<property category="win32.Debug_Build.win32b.bcc32" name="option.vi.enabled" value="0"/>
@ -67,6 +76,9 @@
<property category="win32.Release_Build.win32b.bcc32" name="option.D.enabled" value="1"/>
<property category="win32.Release_Build.win32b.bcc32" name="option.O2.enabled" value="1"/>
<property category="win32.Release_Build.win32b.bcc32" name="option.k.enabled" value="0"/>
<property category="win32.Release_Build.win32b.bcc32" name="option.n.arg.1" value="release\win32\bds"/>
<property category="win32.Release_Build.win32b.bcc32" name="option.n.arg.merge" value="0"/>
<property category="win32.Release_Build.win32b.bcc32" name="option.n.enabled" value="1"/>
<property category="win32.Release_Build.win32b.bcc32" name="option.r.enabled" value="1"/>
<property category="win32.Release_Build.win32b.bcc32" name="option.vi.enabled" value="1"/>
<property category="win32.Release_Build.win32b.dcc32" name="option.$D.enabled" value="0"/>
@ -85,7 +97,7 @@
<property category="win32.*.win32b.bcc32" name="option.H=.arg.merge" value="1"/>
<property category="win32.*.win32b.bcc32" name="option.H=.enabled" value="1"/>
<property category="win32.*.win32b.bcc32" name="option.Hc.enabled" value="1"/>
<property category="win32.*.win32b.bcc32" name="option.I.arg.1" value="C:\projects\ase\lsp"/>
<property category="win32.*.win32b.bcc32" name="option.I.arg.1" value="..\.."/>
<property category="win32.*.win32b.bcc32" name="option.I.arg.2" value="$(BDS)\include"/>
<property category="win32.*.win32b.bcc32" name="option.I.arg.3" value="$(BDS)\include\dinkumware"/>
<property category="win32.*.win32b.bcc32" name="option.I.arg.4" value="$(BDS)\include\vcl"/>
@ -204,6 +216,6 @@
<Linker Name="LibVersion"></Linker>
</Linker>
</IDEOPTIONS>
</BCBPROJECT>
</CPlusPlusBuilder.Personality>
</BCBPROJECT> <buildevents/>
</CPlusPlusBuilder.Personality>
</BorlandProject>

4
ase/lsp/err.c
View File

@ -1,5 +1,5 @@
/*
* $Id: err.c,v 1.5 2006-10-29 13:00:39 bacon Exp $
* $Id: err.c,v 1.6 2006-10-29 13:40:30 bacon Exp $
*/
#include <ase/lsp/lsp_i.h>
@ -15,7 +15,7 @@ const ase_char_t* ase_lsp_geterrstr (int errnum)
{
ASE_T("no error"),
ASE_T("out of memory"),
ASE_T("abort"),
ASE_T("exit"),
ASE_T("end"),
ASE_T("input not attached"),
ASE_T("input"),

40
ase/lsp/eval.c
View File

@ -1,5 +1,5 @@
/*
* $Id: eval.c,v 1.19 2006-10-29 13:00:39 bacon Exp $
* $Id: eval.c,v 1.20 2006-10-29 13:40:30 bacon Exp $
*/
#include <ase/lsp/lsp_i.h>
@ -10,6 +10,8 @@ static ase_lsp_obj_t* eval_cons (
ase_lsp_t* lsp, ase_lsp_obj_t* cons);
static ase_lsp_obj_t* apply (
ase_lsp_t* lsp, ase_lsp_obj_t* func, ase_lsp_obj_t* actual);
static ase_lsp_obj_t* apply_to_prim (
ase_lsp_t* lsp, ase_lsp_obj_t* func, ase_lsp_obj_t* actual);
ase_lsp_obj_t* ase_lsp_eval (ase_lsp_t* lsp, ase_lsp_obj_t* obj)
{
@ -139,7 +141,7 @@ static ase_lsp_obj_t* eval_cons (ase_lsp_t* lsp, ase_lsp_obj_t* cons)
else if (ASE_LSP_TYPE(func) == ASE_LSP_OBJ_PRIM)
{
/* primitive function */
return ASE_LSP_PIMPL(func) (lsp, cdr);
return apply_to_prim (lsp, func, cdr);
}
else
{
@ -321,3 +323,37 @@ static ase_lsp_obj_t* apply (
return value;
}
static ase_lsp_obj_t* apply_to_prim (
ase_lsp_t* lsp, ase_lsp_obj_t* func, ase_lsp_obj_t* actual)
{
ase_lsp_obj_t* obj;
ase_size_t count = 0;
ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(func) == ASE_LSP_OBJ_PRIM);
obj = actual;
while (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_CONS)
{
count++;
obj = ASE_LSP_CDR(obj);
}
if (obj != lsp->mem->nil)
{
lsp->errnum = ASE_LSP_ERR_BAD_ARG;
return ASE_NULL;
}
if (count < ASE_LSP_PMINARGS(func))
{
lsp->errnum = ASE_LSP_ERR_TOO_FEW_ARGS;
return ASE_NULL;
}
if (count > ASE_LSP_PMAXARGS(func))
{
lsp->errnum = ASE_LSP_ERR_TOO_MANY_ARGS;
return ASE_NULL;
}
return ASE_LSP_PIMPL(func) (lsp, actual);
}

6
ase/lsp/lsp.c
View File

@ -1,5 +1,5 @@
/*
* $Id: lsp.c,v 1.13 2006-10-29 13:00:39 bacon Exp $
* $Id: lsp.c,v 1.14 2006-10-29 13:40:31 bacon Exp $
*/
#if defined(__BORLANDC__)
@ -174,7 +174,7 @@ static int __add_builtin_prims (ase_lsp_t* lsp)
#define ADD_PRIM(mem,name,name_len,pimpl,min_args,max_args) \
if (ase_lsp_addprim(mem,name,name_len,pimpl,min_args,max_args) == -1) return -1;
ADD_PRIM (lsp, ASE_T("abort"), 5, ase_lsp_prim_abort, 0, 0);
ADD_PRIM (lsp, ASE_T("exit"), 4, ase_lsp_prim_exit, 0, 0);
ADD_PRIM (lsp, ASE_T("eval"), 4, ase_lsp_prim_eval, 1, 1);
ADD_PRIM (lsp, ASE_T("prog1"), 5, ase_lsp_prim_prog1, 1, ASE_TYPE_MAX(ase_size_t));
ADD_PRIM (lsp, ASE_T("progn"), 5, ase_lsp_prim_progn, 1, ASE_TYPE_MAX(ase_size_t));
@ -202,7 +202,7 @@ static int __add_builtin_prims (ase_lsp_t* lsp)
ADD_PRIM (lsp, ASE_T(">="), 2, ase_lsp_prim_ge, 2, 2);
ADD_PRIM (lsp, ASE_T("<="), 2, ase_lsp_prim_le, 2, 2);
ADD_PRIM (lsp, ASE_T("+"), 1, ase_lsp_prim_plus,, 1, ASE_TYPE_MAX(ase_size_t));
ADD_PRIM (lsp, ASE_T("+"), 1, ase_lsp_prim_plus, 1, ASE_TYPE_MAX(ase_size_t));
ADD_PRIM (lsp, ASE_T("-"), 1, ase_lsp_prim_minus, 1, ASE_TYPE_MAX(ase_size_t));
ADD_PRIM (lsp, ASE_T("*"), 1, ase_lsp_prim_mul, 1, ASE_TYPE_MAX(ase_size_t));
ADD_PRIM (lsp, ASE_T("/"), 1, ase_lsp_prim_div, 1, ASE_TYPE_MAX(ase_size_t));

8
ase/lsp/lsp.dsp
View File

@ -155,6 +155,10 @@ SOURCE=.\lsp.h
# End Source File
# Begin Source File
SOURCE=.\lsp_i.h
# End Source File
# Begin Source File
SOURCE=.\mem.h
# End Source File
# Begin Source File
@ -173,10 +177,6 @@ SOURCE=.\obj.h
SOURCE=.\prim.h
# End Source File
# Begin Source File
SOURCE=.\types.h
# End Source File
# End Group
# End Target
# End Project

4
ase/lsp/lsp.h
View File

@ -1,5 +1,5 @@
/*
* $Id: lsp.h,v 1.29 2006-10-29 13:00:39 bacon Exp $
* $Id: lsp.h,v 1.30 2006-10-29 13:40:32 bacon Exp $
*/
#ifndef _ASE_LSP_LSP_H_
@ -70,7 +70,7 @@ enum
ASE_LSP_ENOERR,
ASE_LSP_ENOMEM,
ASE_LSP_ERR_ABORT,
ASE_LSP_ERR_EXIT,
ASE_LSP_ERR_END,
ASE_LSP_ERR_INPUT_NOT_ATTACHED,
ASE_LSP_ERR_INPUT,

17
ase/lsp/mem.c
View File

@ -1,5 +1,5 @@
/*
* $Id: mem.c,v 1.17 2006-10-29 13:00:39 bacon Exp $
* $Id: mem.c,v 1.18 2006-10-29 13:40:33 bacon Exp $
*/
#include <ase/lsp/lsp_i.h>
@ -590,20 +590,5 @@ ase_size_t ase_lsp_conslen (ase_lsp_mem_t* mem, ase_lsp_obj_t* obj)
return count;
}
int ase_lsp_probeargs (ase_lsp_mem_t* mem, ase_lsp_obj_t* obj, ase_size_t* len)
{
ase_size_t count = 0;
while (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_CONS)
{
count++;
obj = ASE_LSP_CDR(obj);
}
if (obj != mem->nil) return -1;
*len = count;
return 0;
}

9
ase/lsp/mem.h
View File

@ -1,5 +1,5 @@
/*
* $Id: mem.h,v 1.13 2006-10-29 13:00:39 bacon Exp $
* $Id: mem.h,v 1.14 2006-10-29 13:40:33 bacon Exp $
*/
#ifndef _ASE_LSP_MEM_H_
@ -67,7 +67,7 @@ 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);
void ase_lsp_unlockallobjs (ase_lsp_t* lsp, ase_lsp_obj_t* obj);
// object creation of standard types
/* object creation of standard types */
ase_lsp_obj_t* ase_lsp_makenil (ase_lsp_mem_t* mem);
ase_lsp_obj_t* ase_lsp_maketrue (ase_lsp_mem_t* mem);
ase_lsp_obj_t* ase_lsp_makeintobj (ase_lsp_mem_t* mem, ase_long_t value);
@ -88,16 +88,15 @@ ase_lsp_obj_t* ase_lsp_makemacro (
ase_lsp_obj_t* ase_lsp_makeprim (ase_lsp_mem_t* mem,
ase_lsp_prim_t impl, ase_size_t min_args, ase_size_t max_args);
// frame lookup
/* frame lookup */
ase_lsp_assoc_t* ase_lsp_lookup (ase_lsp_mem_t* mem, ase_lsp_obj_t* name);
ase_lsp_assoc_t* ase_lsp_setvalue (
ase_lsp_mem_t* mem, ase_lsp_obj_t* name, ase_lsp_obj_t* value);
ase_lsp_assoc_t* ase_lsp_setfunc (
ase_lsp_mem_t* mem, ase_lsp_obj_t* name, ase_lsp_obj_t* func);
// cons operations
/* cons operations */
ase_size_t ase_lsp_conslen (ase_lsp_mem_t* mem, ase_lsp_obj_t* obj);
int ase_lsp_probeargs (ase_lsp_mem_t* mem, ase_lsp_obj_t* obj, ase_size_t* len);
#ifdef __cplusplus
}

25
ase/lsp/prim.c
View File

@ -1,5 +1,5 @@
/*
* $Id: prim.c,v 1.14 2006-10-29 13:00:39 bacon Exp $
* $Id: prim.c,v 1.15 2006-10-29 13:40:33 bacon Exp $
*/
#include <ase/lsp/lsp_i.h>
@ -42,10 +42,9 @@ static int __add_prim (ase_lsp_mem_t* mem,
return 0;
}
ase_lsp_obj_t* ase_lsp_prim_abort (ase_lsp_t* lsp, ase_lsp_obj_t* args)
ase_lsp_obj_t* ase_lsp_prim_exit (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 0, 0);
lsp->errnum = ASE_LSP_ERR_ABORT;
lsp->errnum = ASE_LSP_ERR_EXIT;
return ASE_NULL;
}
@ -53,7 +52,6 @@ ase_lsp_obj_t* ase_lsp_prim_eval (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{
ase_lsp_obj_t* tmp;
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1);
ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
@ -67,7 +65,6 @@ ase_lsp_obj_t* ase_lsp_prim_eval (ase_lsp_t* lsp, ase_lsp_obj_t* args)
ase_lsp_obj_t* ase_lsp_prim_gc (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 0, 0);
ase_lsp_collectgarbage (lsp->mem);
return lsp->mem->nil;
}
@ -84,8 +81,6 @@ ase_lsp_obj_t* ase_lsp_prim_cond (ase_lsp_t* lsp, ase_lsp_obj_t* args)
ase_lsp_obj_t* tmp, * ret;
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 0, ASE_LSP_PRIM_MAX_ARG_COUNT);
while (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS)
{
if (ASE_LSP_TYPE(ASE_LSP_CAR(args)) != ASE_LSP_OBJ_CONS)
@ -125,7 +120,6 @@ ase_lsp_obj_t* ase_lsp_prim_if (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{
ase_lsp_obj_t* tmp;
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, ASE_LSP_PRIM_MAX_ARG_COUNT);
ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
@ -168,10 +162,10 @@ ase_lsp_obj_t* ase_lsp_prim_while (ase_lsp_t* lsp, ase_lsp_obj_t* args)
ase_lsp_obj_t* tmp;
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT);
ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
for (;;) {
while (1)
{
tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
if (tmp == ASE_NULL) return ASE_NULL;
if (tmp == lsp->mem->nil) break;
@ -202,7 +196,6 @@ ase_lsp_obj_t* ase_lsp_prim_car (ase_lsp_t* lsp, ase_lsp_obj_t* args)
ase_lsp_obj_t* tmp;
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1);
ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
@ -226,7 +219,6 @@ ase_lsp_obj_t* ase_lsp_prim_cdr (ase_lsp_t* lsp, ase_lsp_obj_t* args)
ase_lsp_obj_t* tmp;
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1);
ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
@ -251,7 +243,6 @@ ase_lsp_obj_t* ase_lsp_prim_cons (ase_lsp_t* lsp, ase_lsp_obj_t* args)
ase_lsp_obj_t* car, * cdr, * cons;
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
car = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
@ -280,7 +271,6 @@ ase_lsp_obj_t* ase_lsp_prim_set (ase_lsp_t* lsp, ase_lsp_obj_t* args)
ase_lsp_obj_t* p1, * p2;
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
@ -351,7 +341,6 @@ ase_lsp_obj_t* ase_lsp_prim_quote (ase_lsp_t* lsp, ase_lsp_obj_t* args)
* (quote (10 20 30 50))
*/
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1);
ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
return ASE_LSP_CAR(args);
}
@ -369,8 +358,6 @@ ase_lsp_obj_t* ase_lsp_prim_defun (ase_lsp_t* lsp, ase_lsp_obj_t* args)
ase_lsp_obj_t* name, * fun;
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 3, ASE_LSP_PRIM_MAX_ARG_COUNT);
name = ASE_LSP_CAR(args);
if (ASE_LSP_TYPE(name) != ASE_LSP_OBJ_SYM)
{
@ -399,8 +386,6 @@ ase_lsp_obj_t* ase_lsp_prim_demac (ase_lsp_t* lsp, ase_lsp_obj_t* args)
ase_lsp_obj_t* name, * mac;
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 3, ASE_LSP_PRIM_MAX_ARG_COUNT);
name = ASE_LSP_CAR(args);
if (ASE_LSP_TYPE(name) != ASE_LSP_OBJ_SYM)
{

27
ase/lsp/prim.h
View File

@ -1,17 +1,19 @@
/*
* $Id: prim.h,v 1.10 2006-10-29 13:00:39 bacon Exp $
* $Id: prim.h,v 1.11 2006-10-29 13:40:33 bacon Exp $
*/
#ifndef _ASE_LSP_PRIM_H_
#define _ASE_LSP_PRIM_H_
#include <ase/lsp/lsp.h>
#ifndef _ASE_LSP_LSP_H_
#error Never include this file directly. Include <ase/lsp/lsp.h> instead
#endif
#ifdef __cplusplus
extern "C" {
#endif
ase_lsp_obj_t* ase_lsp_prim_abort (ase_lsp_t* lsp, ase_lsp_obj_t* args);
ase_lsp_obj_t* ase_lsp_prim_exit (ase_lsp_t* lsp, ase_lsp_obj_t* args);
ase_lsp_obj_t* ase_lsp_prim_eval (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);
ase_lsp_obj_t* ase_lsp_prim_progn (ase_lsp_t* lsp, ase_lsp_obj_t* args);
@ -54,23 +56,4 @@ ase_lsp_obj_t* ase_lsp_prim_mod (ase_lsp_t* lsp, ase_lsp_obj_t* args);
}
#endif
#define ASE_LSP_PRIM_CHECK_ARG_COUNT(lsp,args,min,max) \
{ \
ase_size_t count; \
if (ase_lsp_probeargs(lsp->mem, args, &count) == -1) { \
lsp->errnum = ASE_LSP_ERR_BAD_ARG; \
return ASE_NULL; \
} \
if (count < min) { \
lsp->errnum = ASE_LSP_ERR_TOO_FEW_ARGS; \
return ASE_NULL; \
} \
if (count > max) { \
lsp->errnum = ASE_LSP_ERR_TOO_MANY_ARGS; \
return ASE_NULL; \
} \
}
#define ASE_LSP_PRIM_MAX_ARG_COUNT ((ase_size_t)~(ase_size_t)0)
#endif

11
ase/lsp/prim_compar.c
View File

@ -1,5 +1,5 @@
/*
* $Id: prim_compar.c,v 1.7 2006-10-26 09:31:28 bacon Exp $
* $Id: prim_compar.c,v 1.8 2006-10-29 13:40:33 bacon Exp $
*/
#include <ase/lsp/lsp_i.h>
@ -9,7 +9,6 @@ ase_lsp_obj_t* ase_lsp_prim_eq (ase_lsp_t* lsp, ase_lsp_obj_t* args)
ase_lsp_obj_t* p1, * p2;
int res;
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
@ -92,7 +91,6 @@ ase_lsp_obj_t* ase_lsp_prim_ne (ase_lsp_t* lsp, ase_lsp_obj_t* args)
ase_lsp_obj_t* p1, * p2;
int res;
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
@ -176,7 +174,6 @@ ase_lsp_obj_t* ase_lsp_prim_gt (ase_lsp_t* lsp, ase_lsp_obj_t* args)
ase_lsp_obj_t* p1, * p2;
int res;
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
@ -260,7 +257,6 @@ ase_lsp_obj_t* ase_lsp_prim_lt (ase_lsp_t* lsp, ase_lsp_obj_t* args)
ase_lsp_obj_t* p1, * p2;
int res;
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
@ -343,7 +339,6 @@ ase_lsp_obj_t* ase_lsp_prim_ge (ase_lsp_t* lsp, ase_lsp_obj_t* args)
ase_lsp_obj_t* p1, * p2;
int res;
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
@ -426,7 +421,6 @@ ase_lsp_obj_t* ase_lsp_prim_le (ase_lsp_t* lsp, ase_lsp_obj_t* args)
ase_lsp_obj_t* p1, * p2;
int res;
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
@ -490,7 +484,8 @@ ase_lsp_obj_t* ase_lsp_prim_le (ase_lsp_t* lsp, ase_lsp_obj_t* args)
ASE_LSP_STRPTR(p1), ASE_LSP_STRLEN(p1),
ASE_LSP_STRPTR(p2), ASE_LSP_STRLEN(p2)) <= 0;
}
else {
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}

21
ase/lsp/prim_let.c
View File

@ -1,5 +1,5 @@
/*
* $Id: prim_let.c,v 1.7 2006-10-26 08:17:37 bacon Exp $
* $Id: prim_let.c,v 1.8 2006-10-29 13:40:33 bacon Exp $
*/
#include <ase/lsp/lsp_i.h>
@ -12,8 +12,6 @@ static ase_lsp_obj_t* __prim_let (
ase_lsp_obj_t* body;
ase_lsp_obj_t* value;
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT);
// create a new frame
frame = ase_lsp_newframe (lsp);
if (frame == ASE_NULL)
@ -129,19 +127,22 @@ static ase_lsp_obj_t* __prim_let (
return ASE_NULL;
}
// push the frame
if (!sequential) {
/* push the frame */
if (!sequential)
{
lsp->mem->brooding_frame = frame->link;
frame->link = lsp->mem->frame;
lsp->mem->frame = frame;
}
// evaluate forms in the body
/* evaluate forms in the body */
value = lsp->mem->nil;
body = ASE_LSP_CDR(args);
while (body != lsp->mem->nil) {
while (body != lsp->mem->nil)
{
value = ase_lsp_eval (lsp, ASE_LSP_CAR(body));
if (value == ASE_NULL) {
if (value == ASE_NULL)
{
lsp->mem->frame = frame->link;
ase_lsp_freeframe (lsp, frame);
return ASE_NULL;
@ -149,10 +150,10 @@ static ase_lsp_obj_t* __prim_let (
body = ASE_LSP_CDR(body);
}
// pop the frame
/* pop the frame */
lsp->mem->frame = frame->link;
// destroy the frame
/* destroy the frame */
ase_lsp_freeframe (lsp, frame);
return value;
}

173
ase/lsp/prim_math.c
View File

@ -1,5 +1,5 @@
/*
* $Id: prim_math.c,v 1.12 2006-10-29 13:00:39 bacon Exp $
* $Id: prim_math.c,v 1.13 2006-10-29 13:40:33 bacon Exp $
*/
#include <ase/lsp/lsp_i.h>
@ -11,45 +11,54 @@ ase_lsp_obj_t* ase_lsp_prim_plus (ase_lsp_t* lsp, ase_lsp_obj_t* args)
ase_real_t rvalue = .0;
ase_bool_t realnum = ase_false;
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT);
ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
body = args;
//while (body != lsp->mem->nil) {
while (ASE_LSP_TYPE(body) == ASE_LSP_OBJ_CONS) {
/*while (body != lsp->mem->nil) */
while (ASE_LSP_TYPE(body) == ASE_LSP_OBJ_CONS)
{
tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(body));
if (tmp == ASE_NULL) {
if (tmp == ASE_NULL)
{
/*lsp->errnum = ASE_LSP_ERR_BAD_VALUE; */
return ASE_NULL;
}
if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT) {
if (body == args) {
if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT)
{
if (body == args)
{
ASE_LSP_ASSERT (lsp, realnum == ase_false);
ivalue = ASE_LSP_IVALUE(tmp);
}
else {
else
{
if (!realnum)
ivalue = ivalue + ASE_LSP_IVALUE(tmp);
else
rvalue = rvalue + ASE_LSP_IVALUE(tmp);
}
}
else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL) {
if (body == args) {
else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL)
{
if (body == args)
{
ASE_LSP_ASSERT (lsp, realnum == ase_false);
realnum = ase_true;
rvalue = ASE_LSP_RVALUE(tmp);
}
else {
if (!realnum) {
else
{
if (!realnum)
{
realnum = ase_true;
rvalue = (ase_real_t)ivalue;
}
rvalue = rvalue + ASE_LSP_RVALUE(tmp);
}
}
else {
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
@ -63,7 +72,8 @@ ase_lsp_obj_t* ase_lsp_prim_plus (ase_lsp_t* lsp, ase_lsp_obj_t* args)
tmp = (realnum)?
ase_lsp_makerealobj (lsp->mem, rvalue):
ase_lsp_makeintobj (lsp->mem, ivalue);
if (tmp == ASE_NULL) {
if (tmp == ASE_NULL)
{
lsp->errnum = ASE_LSP_ENOMEM;
return ASE_NULL;
}
@ -78,43 +88,51 @@ ase_lsp_obj_t* ase_lsp_prim_minus (ase_lsp_t* lsp, ase_lsp_obj_t* args)
ase_real_t rvalue = .0;
ase_bool_t realnum = ase_false;
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT);
ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
body = args;
//while (body != lsp->mem->nil) {
while (ASE_LSP_TYPE(body) == ASE_LSP_OBJ_CONS) {
/*while (body != lsp->mem->nil) */
while (ASE_LSP_TYPE(body) == ASE_LSP_OBJ_CONS)
{
tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(body));
if (tmp == ASE_NULL) return ASE_NULL;
if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT) {
if (body == args) {
if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT)
{
if (body == args)
{
ASE_LSP_ASSERT (lsp, realnum == ase_false);
ivalue = ASE_LSP_IVALUE(tmp);
}
else {
else
{
if (!realnum)
ivalue = ivalue - ASE_LSP_IVALUE(tmp);
else
rvalue = rvalue - ASE_LSP_IVALUE(tmp);
}
}
else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL) {
if (body == args) {
else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL)
{
if (body == args)
{
ASE_LSP_ASSERT (lsp, realnum == ase_false);
realnum = ase_true;
rvalue = ASE_LSP_RVALUE(tmp);
}
else {
if (!realnum) {
else
{
if (!realnum)
{
realnum = ase_true;
rvalue = (ase_real_t)ivalue;
}
rvalue = rvalue - ASE_LSP_RVALUE(tmp);
}
}
else {
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
@ -128,7 +146,8 @@ ase_lsp_obj_t* ase_lsp_prim_minus (ase_lsp_t* lsp, ase_lsp_obj_t* args)
tmp = (realnum)?
ase_lsp_makerealobj (lsp->mem, rvalue):
ase_lsp_makeintobj (lsp->mem, ivalue);
if (tmp == ASE_NULL) {
if (tmp == ASE_NULL)
{
lsp->errnum = ASE_LSP_ENOMEM;
return ASE_NULL;
}
@ -143,43 +162,50 @@ ase_lsp_obj_t* ase_lsp_prim_mul (ase_lsp_t* lsp, ase_lsp_obj_t* args)
ase_real_t rvalue = .0;
ase_bool_t realnum = ase_false;
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT);
ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
body = args;
//while (body != lsp->mem->nil) {
while (ASE_LSP_TYPE(body) == ASE_LSP_OBJ_CONS) {
/*while (body != lsp->mem->nil) */
while (ASE_LSP_TYPE(body) == ASE_LSP_OBJ_CONS)
{
tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(body));
if (tmp == ASE_NULL) return ASE_NULL;
if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT) {
if (body == args) {
if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT)
{
if (body == args)
{
ASE_LSP_ASSERT (lsp, realnum == ase_false);
ivalue = ASE_LSP_IVALUE(tmp);
}
else {
else
{
if (!realnum)
ivalue = ivalue * ASE_LSP_IVALUE(tmp);
else
rvalue = rvalue * ASE_LSP_IVALUE(tmp);
}
}
else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL) {
if (body == args) {
else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL)
{
if (body == args)
{
ASE_LSP_ASSERT (lsp, realnum == ase_false);
realnum = ase_true;
rvalue = ASE_LSP_RVALUE(tmp);
}
else {
if (!realnum) {
else
{
if (!realnum)
{
realnum = ase_true;
rvalue = (ase_real_t)ivalue;
}
rvalue = rvalue * ASE_LSP_RVALUE(tmp);
}
}
else {
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
@ -193,7 +219,8 @@ ase_lsp_obj_t* ase_lsp_prim_mul (ase_lsp_t* lsp, ase_lsp_obj_t* args)
tmp = (realnum)?
ase_lsp_makerealobj (lsp->mem, rvalue):
ase_lsp_makeintobj (lsp->mem, ivalue);
if (tmp == ASE_NULL) {
if (tmp == ASE_NULL)
{
lsp->errnum = ASE_LSP_ENOMEM;
return ASE_NULL;
}
@ -208,24 +235,28 @@ ase_lsp_obj_t* ase_lsp_prim_div (ase_lsp_t* lsp, ase_lsp_obj_t* args)
ase_real_t rvalue = .0;
ase_bool_t realnum = ase_false;
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT);
ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
body = args;
//while (body != lsp->mem->nil) {
while (ASE_LSP_TYPE(body) == ASE_LSP_OBJ_CONS) {
/*while (body != lsp->mem->nil)*/
while (ASE_LSP_TYPE(body) == ASE_LSP_OBJ_CONS)
{
tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(body));
if (tmp == ASE_NULL) return ASE_NULL;
if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT) {
if (body == args) {
if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT)
{
if (body == args)
{
ASE_LSP_ASSERT (lsp, realnum == ase_false);
ivalue = ASE_LSP_IVALUE(tmp);
}
else {
if (!realnum) {
if (ASE_LSP_IVALUE(tmp) == 0) {
else
{
if (!realnum)
{
if (ASE_LSP_IVALUE(tmp) == 0)
{
lsp->errnum = ASE_LSP_EDIVBYZERO;
return ASE_NULL;
}
@ -235,21 +266,26 @@ ase_lsp_obj_t* ase_lsp_prim_div (ase_lsp_t* lsp, ase_lsp_obj_t* args)
rvalue = rvalue / ASE_LSP_IVALUE(tmp);
}
}
else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL) {
if (body == args) {
else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL)
{
if (body == args)
{
ASE_LSP_ASSERT (lsp, realnum == ase_false);
realnum = ase_true;
rvalue = ASE_LSP_RVALUE(tmp);
}
else {
if (!realnum) {
else
{
if (!realnum)
{
realnum = ase_true;
rvalue = (ase_real_t)ivalue;
}
rvalue = rvalue / ASE_LSP_RVALUE(tmp);
}
}
else {
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
@ -277,41 +313,50 @@ ase_lsp_obj_t* ase_lsp_prim_mod (ase_lsp_t* lsp, ase_lsp_obj_t* args)
ase_lsp_obj_t* body, * tmp;
ase_long_t ivalue = 0;
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT);
ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
body = args;
//while (body != lsp->mem->nil) {
while (ASE_LSP_TYPE(body) == ASE_LSP_OBJ_CONS) {
while (ASE_LSP_TYPE(body) == ASE_LSP_OBJ_CONS)
{
tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(body));
if (tmp == ASE_NULL) return ASE_NULL;
if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT) {
if (body == args) {
if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT)
{
if (body == args)
{
ivalue = ASE_LSP_IVALUE(tmp);
}
else {
if (ASE_LSP_IVALUE(tmp) == 0) {
else
{
if (ASE_LSP_IVALUE(tmp) == 0)
{
lsp->errnum = ASE_LSP_EDIVBYZERO;
return ASE_NULL;
}
ivalue = ivalue % ASE_LSP_IVALUE(tmp);
}
}
else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL) {
if (body == args) {
else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL)
{
if (body == args)
{
ivalue = (ase_long_t)ASE_LSP_RVALUE(tmp);
}
else {
else
{
ase_long_t tmpi = (ase_long_t)ASE_LSP_RVALUE(tmp);
if (tmpi == 0) {
if (tmpi == 0)
{
lsp->errnum = ASE_LSP_EDIVBYZERO;
return ASE_NULL;
}
ivalue = ivalue % tmpi;
}
}
else {
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}

20
ase/lsp/prim_prog.c
View File

@ -1,5 +1,5 @@
/*
* $Id: prim_prog.c,v 1.4 2006-10-26 08:17:38 bacon Exp $
* $Id: prim_prog.c,v 1.5 2006-10-29 13:40:33 bacon Exp $
*/
#include <ase/lsp/lsp_i.h>
@ -8,15 +8,14 @@ ase_lsp_obj_t* ase_lsp_prim_prog1 (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{
ase_lsp_obj_t* res = ASE_NULL, * tmp;
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT);
//while (args != lsp->mem->nil) {
while (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS) {
/*while (args != lsp->mem->nil) {*/
while (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS)
{
tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
if (tmp == ASE_NULL) return ASE_NULL;
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);
@ -33,11 +32,10 @@ ase_lsp_obj_t* ase_lsp_prim_progn (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{
ase_lsp_obj_t* res, * tmp;
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT);
res = lsp->mem->nil;
//while (args != lsp->mem->nil) {
while (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS) {
/*while (args != lsp->mem->nil) {*/
while (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS)
{
tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
if (tmp == ASE_NULL) return ASE_NULL;

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

@ -324,7 +324,7 @@ int __main (int argc, xp_char_t* argv[])
const xp_char_t* errstr;
if (errnum != ASE_LSP_ERR_END &&
errnum != ASE_LSP_ERR_ABORT)
errnum != ASE_LSP_ERR_EXIT)
{
errstr = ase_lsp_geterrstr(errnum);
xp_fprintf (xp_stderr,
@ -346,7 +346,7 @@ int __main (int argc, xp_char_t* argv[])
const xp_char_t* errstr;
errnum = ase_lsp_geterrnum(lsp);
if (errnum == ASE_LSP_ERR_ABORT) break;
if (errnum == ASE_LSP_ERR_EXIT) break;
errstr = ase_lsp_geterrstr(errnum);
xp_fprintf (xp_stderr,