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" name="excludedefaultforzero" value="0"/>
<property category="build.config.0" name="builddir" value="Debug"/> <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="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="settings.win32b" value="default"/>
<property category="build.config.0" name="type" value="Toolset"/> <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="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="settings.win32b" value="default"/>
<property category="build.config.1" name="type" value="Toolset"/> <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="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="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"/> <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.default" value="win32b"/>
<property category="build.platform" name="win32.enabled" value="1"/> <property category="build.platform" name="win32.enabled" value="1"/>
<property category="build.platform" name="win32.win32b.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.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.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.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.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.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.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.v.enabled" value="1"/>
<property category="win32.Debug_Build.win32b.bcc32" name="option.vi.enabled" value="0"/> <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.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.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.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.r.enabled" value="1"/>
<property category="win32.Release_Build.win32b.bcc32" name="option.vi.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"/> <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=.arg.merge" value="1"/>
<property category="win32.*.win32b.bcc32" name="option.H=.enabled" 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.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.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.3" value="$(BDS)\include\dinkumware"/>
<property category="win32.*.win32b.bcc32" name="option.I.arg.4" value="$(BDS)\include\vcl"/> <property category="win32.*.win32b.bcc32" name="option.I.arg.4" value="$(BDS)\include\vcl"/>
@ -204,6 +216,6 @@
<Linker Name="LibVersion"></Linker> <Linker Name="LibVersion"></Linker>
</Linker> </Linker>
</IDEOPTIONS> </IDEOPTIONS>
</BCBPROJECT> </BCBPROJECT> <buildevents/>
</CPlusPlusBuilder.Personality> </CPlusPlusBuilder.Personality>
</BorlandProject> </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> #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("no error"),
ASE_T("out of memory"), ASE_T("out of memory"),
ASE_T("abort"), ASE_T("exit"),
ASE_T("end"), ASE_T("end"),
ASE_T("input not attached"), ASE_T("input not attached"),
ASE_T("input"), 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> #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); ase_lsp_t* lsp, ase_lsp_obj_t* cons);
static ase_lsp_obj_t* apply ( static ase_lsp_obj_t* apply (
ase_lsp_t* lsp, ase_lsp_obj_t* func, ase_lsp_obj_t* actual); 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) 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) else if (ASE_LSP_TYPE(func) == ASE_LSP_OBJ_PRIM)
{ {
/* primitive function */ /* primitive function */
return ASE_LSP_PIMPL(func) (lsp, cdr); return apply_to_prim (lsp, func, cdr);
} }
else else
{ {
@ -321,3 +323,37 @@ static ase_lsp_obj_t* apply (
return value; 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__) #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) \ #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; 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("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("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)); 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_ge, 2, 2);
ADD_PRIM (lsp, ASE_T("<="), 2, ase_lsp_prim_le, 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_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_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)); 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 # End Source File
# Begin Source File # Begin Source File
SOURCE=.\lsp_i.h
# End Source File
# Begin Source File
SOURCE=.\mem.h SOURCE=.\mem.h
# End Source File # End Source File
# Begin Source File # Begin Source File
@ -173,10 +177,6 @@ SOURCE=.\obj.h
SOURCE=.\prim.h SOURCE=.\prim.h
# End Source File # End Source File
# Begin Source File
SOURCE=.\types.h
# End Source File
# End Group # End Group
# End Target # End Target
# End Project # 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_ #ifndef _ASE_LSP_LSP_H_
@ -70,7 +70,7 @@ enum
ASE_LSP_ENOERR, ASE_LSP_ENOERR,
ASE_LSP_ENOMEM, ASE_LSP_ENOMEM,
ASE_LSP_ERR_ABORT, ASE_LSP_ERR_EXIT,
ASE_LSP_ERR_END, ASE_LSP_ERR_END,
ASE_LSP_ERR_INPUT_NOT_ATTACHED, ASE_LSP_ERR_INPUT_NOT_ATTACHED,
ASE_LSP_ERR_INPUT, 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> #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; 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_ #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_unlockobj (ase_lsp_t* lsp, ase_lsp_obj_t* obj);
void ase_lsp_unlockallobjs (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_makenil (ase_lsp_mem_t* mem);
ase_lsp_obj_t* ase_lsp_maketrue (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); 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_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); 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_lookup (ase_lsp_mem_t* mem, ase_lsp_obj_t* name);
ase_lsp_assoc_t* ase_lsp_setvalue ( ase_lsp_assoc_t* ase_lsp_setvalue (
ase_lsp_mem_t* mem, ase_lsp_obj_t* name, ase_lsp_obj_t* value); ase_lsp_mem_t* mem, ase_lsp_obj_t* name, ase_lsp_obj_t* value);
ase_lsp_assoc_t* ase_lsp_setfunc ( ase_lsp_assoc_t* ase_lsp_setfunc (
ase_lsp_mem_t* mem, ase_lsp_obj_t* name, ase_lsp_obj_t* func); 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); 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 #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> #include <ase/lsp/lsp_i.h>
@ -42,10 +42,9 @@ static int __add_prim (ase_lsp_mem_t* mem,
return 0; 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_EXIT;
lsp->errnum = ASE_LSP_ERR_ABORT;
return ASE_NULL; 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_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); ASE_LSP_ASSERT (lsp, 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));
@ -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_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); ase_lsp_collectgarbage (lsp->mem);
return lsp->mem->nil; 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_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) while (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS)
{ {
if (ASE_LSP_TYPE(ASE_LSP_CAR(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_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); ASE_LSP_ASSERT (lsp, 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));
@ -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_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); ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
for (;;) { while (1)
{
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;
if (tmp == lsp->mem->nil) break; 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_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); ASE_LSP_ASSERT (lsp, 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));
@ -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_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); ASE_LSP_ASSERT (lsp, 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));
@ -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_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); ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
car = ase_lsp_eval (lsp, ASE_LSP_CAR(args)); 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_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); ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args)); 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)) * (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); ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
return ASE_LSP_CAR(args); 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_obj_t* name, * fun;
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 3, ASE_LSP_PRIM_MAX_ARG_COUNT);
name = ASE_LSP_CAR(args); name = ASE_LSP_CAR(args);
if (ASE_LSP_TYPE(name) != ASE_LSP_OBJ_SYM) 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_obj_t* name, * mac;
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 3, ASE_LSP_PRIM_MAX_ARG_COUNT);
name = ASE_LSP_CAR(args); name = ASE_LSP_CAR(args);
if (ASE_LSP_TYPE(name) != ASE_LSP_OBJ_SYM) 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_ #ifndef _ASE_LSP_PRIM_H_
#define _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 #ifdef __cplusplus
extern "C" { extern "C" {
#endif #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_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_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); 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 #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 #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> #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; ase_lsp_obj_t* p1, * p2;
int res; int res;
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args)); 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; ase_lsp_obj_t* p1, * p2;
int res; int res;
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args)); 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; ase_lsp_obj_t* p1, * p2;
int res; int res;
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args)); 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; ase_lsp_obj_t* p1, * p2;
int res; int res;
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args)); 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; ase_lsp_obj_t* p1, * p2;
int res; int res;
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args)); 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; ase_lsp_obj_t* p1, * p2;
int res; int res;
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args)); 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(p1), ASE_LSP_STRLEN(p1),
ASE_LSP_STRPTR(p2), ASE_LSP_STRLEN(p2)) <= 0; ASE_LSP_STRPTR(p2), ASE_LSP_STRLEN(p2)) <= 0;
} }
else { else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL; 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> #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* body;
ase_lsp_obj_t* value; ase_lsp_obj_t* value;
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT);
// create a new frame // create a new frame
frame = ase_lsp_newframe (lsp); frame = ase_lsp_newframe (lsp);
if (frame == ASE_NULL) if (frame == ASE_NULL)
@ -129,19 +127,22 @@ static ase_lsp_obj_t* __prim_let (
return ASE_NULL; return ASE_NULL;
} }
// push the frame /* push the frame */
if (!sequential) { if (!sequential)
{
lsp->mem->brooding_frame = frame->link; lsp->mem->brooding_frame = frame->link;
frame->link = lsp->mem->frame; frame->link = lsp->mem->frame;
lsp->mem->frame = frame; lsp->mem->frame = frame;
} }
// evaluate forms in the body /* evaluate forms in the body */
value = lsp->mem->nil; value = lsp->mem->nil;
body = ASE_LSP_CDR(args); body = ASE_LSP_CDR(args);
while (body != lsp->mem->nil) { while (body != lsp->mem->nil)
{
value = ase_lsp_eval (lsp, ASE_LSP_CAR(body)); value = ase_lsp_eval (lsp, ASE_LSP_CAR(body));
if (value == ASE_NULL) { if (value == ASE_NULL)
{
lsp->mem->frame = frame->link; lsp->mem->frame = frame->link;
ase_lsp_freeframe (lsp, frame); ase_lsp_freeframe (lsp, frame);
return ASE_NULL; return ASE_NULL;
@ -149,10 +150,10 @@ static ase_lsp_obj_t* __prim_let (
body = ASE_LSP_CDR(body); body = ASE_LSP_CDR(body);
} }
// pop the frame /* pop the frame */
lsp->mem->frame = frame->link; lsp->mem->frame = frame->link;
// destroy the frame /* destroy the frame */
ase_lsp_freeframe (lsp, frame); ase_lsp_freeframe (lsp, frame);
return value; 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> #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_real_t rvalue = .0;
ase_bool_t realnum = ase_false; 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); ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
body = args; body = args;
//while (body != lsp->mem->nil) { /*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)); 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_ERR_BAD_VALUE; */
return ASE_NULL; return ASE_NULL;
} }
if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT) { if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT)
if (body == args) { {
if (body == args)
{
ASE_LSP_ASSERT (lsp, realnum == ase_false); ASE_LSP_ASSERT (lsp, realnum == ase_false);
ivalue = ASE_LSP_IVALUE(tmp); ivalue = ASE_LSP_IVALUE(tmp);
} }
else { else
{
if (!realnum) if (!realnum)
ivalue = ivalue + ASE_LSP_IVALUE(tmp); ivalue = ivalue + ASE_LSP_IVALUE(tmp);
else else
rvalue = rvalue + ASE_LSP_IVALUE(tmp); rvalue = rvalue + ASE_LSP_IVALUE(tmp);
} }
} }
else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL) { else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL)
if (body == args) { {
if (body == args)
{
ASE_LSP_ASSERT (lsp, realnum == ase_false); ASE_LSP_ASSERT (lsp, realnum == ase_false);
realnum = ase_true; realnum = ase_true;
rvalue = ASE_LSP_RVALUE(tmp); rvalue = ASE_LSP_RVALUE(tmp);
} }
else { else
if (!realnum) { {
if (!realnum)
{
realnum = ase_true; realnum = ase_true;
rvalue = (ase_real_t)ivalue; rvalue = (ase_real_t)ivalue;
} }
rvalue = rvalue + ASE_LSP_RVALUE(tmp); rvalue = rvalue + ASE_LSP_RVALUE(tmp);
} }
} }
else { else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL; 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)? tmp = (realnum)?
ase_lsp_makerealobj (lsp->mem, rvalue): ase_lsp_makerealobj (lsp->mem, rvalue):
ase_lsp_makeintobj (lsp->mem, ivalue); ase_lsp_makeintobj (lsp->mem, ivalue);
if (tmp == ASE_NULL) { if (tmp == ASE_NULL)
{
lsp->errnum = ASE_LSP_ENOMEM; lsp->errnum = ASE_LSP_ENOMEM;
return ASE_NULL; 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_real_t rvalue = .0;
ase_bool_t realnum = ase_false; 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); ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
body = args; body = args;
//while (body != lsp->mem->nil) { /*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)); tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(body));
if (tmp == ASE_NULL) return ASE_NULL; if (tmp == ASE_NULL) return ASE_NULL;
if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT) { if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT)
if (body == args) { {
if (body == args)
{
ASE_LSP_ASSERT (lsp, realnum == ase_false); ASE_LSP_ASSERT (lsp, realnum == ase_false);
ivalue = ASE_LSP_IVALUE(tmp); ivalue = ASE_LSP_IVALUE(tmp);
} }
else { else
{
if (!realnum) if (!realnum)
ivalue = ivalue - ASE_LSP_IVALUE(tmp); ivalue = ivalue - ASE_LSP_IVALUE(tmp);
else else
rvalue = rvalue - ASE_LSP_IVALUE(tmp); rvalue = rvalue - ASE_LSP_IVALUE(tmp);
} }
} }
else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL) { else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL)
if (body == args) { {
if (body == args)
{
ASE_LSP_ASSERT (lsp, realnum == ase_false); ASE_LSP_ASSERT (lsp, realnum == ase_false);
realnum = ase_true; realnum = ase_true;
rvalue = ASE_LSP_RVALUE(tmp); rvalue = ASE_LSP_RVALUE(tmp);
} }
else { else
if (!realnum) { {
if (!realnum)
{
realnum = ase_true; realnum = ase_true;
rvalue = (ase_real_t)ivalue; rvalue = (ase_real_t)ivalue;
} }
rvalue = rvalue - ASE_LSP_RVALUE(tmp); rvalue = rvalue - ASE_LSP_RVALUE(tmp);
} }
} }
else { else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL; 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)? tmp = (realnum)?
ase_lsp_makerealobj (lsp->mem, rvalue): ase_lsp_makerealobj (lsp->mem, rvalue):
ase_lsp_makeintobj (lsp->mem, ivalue); ase_lsp_makeintobj (lsp->mem, ivalue);
if (tmp == ASE_NULL) { if (tmp == ASE_NULL)
{
lsp->errnum = ASE_LSP_ENOMEM; lsp->errnum = ASE_LSP_ENOMEM;
return ASE_NULL; 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_real_t rvalue = .0;
ase_bool_t realnum = ase_false; 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); ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
body = args; body = args;
//while (body != lsp->mem->nil) { /*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)); tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(body));
if (tmp == ASE_NULL) return ASE_NULL; if (tmp == ASE_NULL) return ASE_NULL;
if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT)
if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT) { {
if (body == args) { if (body == args)
{
ASE_LSP_ASSERT (lsp, realnum == ase_false); ASE_LSP_ASSERT (lsp, realnum == ase_false);
ivalue = ASE_LSP_IVALUE(tmp); ivalue = ASE_LSP_IVALUE(tmp);
} }
else { else
{
if (!realnum) if (!realnum)
ivalue = ivalue * ASE_LSP_IVALUE(tmp); ivalue = ivalue * ASE_LSP_IVALUE(tmp);
else else
rvalue = rvalue * ASE_LSP_IVALUE(tmp); rvalue = rvalue * ASE_LSP_IVALUE(tmp);
} }
} }
else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL) { else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL)
if (body == args) { {
if (body == args)
{
ASE_LSP_ASSERT (lsp, realnum == ase_false); ASE_LSP_ASSERT (lsp, realnum == ase_false);
realnum = ase_true; realnum = ase_true;
rvalue = ASE_LSP_RVALUE(tmp); rvalue = ASE_LSP_RVALUE(tmp);
} }
else { else
if (!realnum) { {
if (!realnum)
{
realnum = ase_true; realnum = ase_true;
rvalue = (ase_real_t)ivalue; rvalue = (ase_real_t)ivalue;
} }
rvalue = rvalue * ASE_LSP_RVALUE(tmp); rvalue = rvalue * ASE_LSP_RVALUE(tmp);
} }
} }
else { else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL; 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)? tmp = (realnum)?
ase_lsp_makerealobj (lsp->mem, rvalue): ase_lsp_makerealobj (lsp->mem, rvalue):
ase_lsp_makeintobj (lsp->mem, ivalue); ase_lsp_makeintobj (lsp->mem, ivalue);
if (tmp == ASE_NULL) { if (tmp == ASE_NULL)
{
lsp->errnum = ASE_LSP_ENOMEM; lsp->errnum = ASE_LSP_ENOMEM;
return ASE_NULL; 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_real_t rvalue = .0;
ase_bool_t realnum = ase_false; 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); ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
body = args; body = args;
//while (body != lsp->mem->nil) { /*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)); tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(body));
if (tmp == ASE_NULL) return ASE_NULL; if (tmp == ASE_NULL) return ASE_NULL;
if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT)
if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT) { {
if (body == args) { if (body == args)
{
ASE_LSP_ASSERT (lsp, realnum == ase_false); ASE_LSP_ASSERT (lsp, realnum == ase_false);
ivalue = ASE_LSP_IVALUE(tmp); ivalue = ASE_LSP_IVALUE(tmp);
} }
else { else
if (!realnum) { {
if (ASE_LSP_IVALUE(tmp) == 0) { if (!realnum)
{
if (ASE_LSP_IVALUE(tmp) == 0)
{
lsp->errnum = ASE_LSP_EDIVBYZERO; lsp->errnum = ASE_LSP_EDIVBYZERO;
return ASE_NULL; 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); rvalue = rvalue / ASE_LSP_IVALUE(tmp);
} }
} }
else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL) { else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL)
if (body == args) { {
if (body == args)
{
ASE_LSP_ASSERT (lsp, realnum == ase_false); ASE_LSP_ASSERT (lsp, realnum == ase_false);
realnum = ase_true; realnum = ase_true;
rvalue = ASE_LSP_RVALUE(tmp); rvalue = ASE_LSP_RVALUE(tmp);
} }
else { else
if (!realnum) { {
if (!realnum)
{
realnum = ase_true; realnum = ase_true;
rvalue = (ase_real_t)ivalue; rvalue = (ase_real_t)ivalue;
} }
rvalue = rvalue / ASE_LSP_RVALUE(tmp); rvalue = rvalue / ASE_LSP_RVALUE(tmp);
} }
} }
else { else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL; 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_lsp_obj_t* body, * tmp;
ase_long_t ivalue = 0; 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); ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
body = args; body = args;
//while (body != lsp->mem->nil) { //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)); tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(body));
if (tmp == ASE_NULL) return ASE_NULL; if (tmp == ASE_NULL) return ASE_NULL;
if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT) { if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT)
if (body == args) { {
if (body == args)
{
ivalue = ASE_LSP_IVALUE(tmp); ivalue = ASE_LSP_IVALUE(tmp);
} }
else { else
if (ASE_LSP_IVALUE(tmp) == 0) { {
if (ASE_LSP_IVALUE(tmp) == 0)
{
lsp->errnum = ASE_LSP_EDIVBYZERO; lsp->errnum = ASE_LSP_EDIVBYZERO;
return ASE_NULL; return ASE_NULL;
} }
ivalue = ivalue % ASE_LSP_IVALUE(tmp); ivalue = ivalue % ASE_LSP_IVALUE(tmp);
} }
} }
else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL) { else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL)
if (body == args) { {
if (body == args)
{
ivalue = (ase_long_t)ASE_LSP_RVALUE(tmp); ivalue = (ase_long_t)ASE_LSP_RVALUE(tmp);
} }
else { else
{
ase_long_t tmpi = (ase_long_t)ASE_LSP_RVALUE(tmp); ase_long_t tmpi = (ase_long_t)ASE_LSP_RVALUE(tmp);
if (tmpi == 0) { if (tmpi == 0)
{
lsp->errnum = ASE_LSP_EDIVBYZERO; lsp->errnum = ASE_LSP_EDIVBYZERO;
return ASE_NULL; return ASE_NULL;
} }
ivalue = ivalue % tmpi; ivalue = ivalue % tmpi;
} }
} }
else { else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL; 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> #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_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)); tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
if (tmp == ASE_NULL) return ASE_NULL; 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_t* ta = lsp->mem->temp_arr;
ase_lsp_arr_insert (ta, ta->size, tmp); 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_obj_t* res, * tmp;
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT);
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;

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