qse/ase/lsp/prim_math.c

379 lines
7.0 KiB
C
Raw Normal View History

2005-09-20 08:05:32 +00:00
/*
2006-10-30 11:26:57 +00:00
* $Id: prim_math.c,v 1.15 2006-10-30 11:26:57 bacon Exp $
2005-09-20 08:05:32 +00:00
*/
2006-10-26 08:17:38 +00:00
#include <ase/lsp/lsp_i.h>
2005-09-20 08:05:32 +00:00
2006-10-24 04:22:40 +00:00
ase_lsp_obj_t* ase_lsp_prim_plus (ase_lsp_t* lsp, ase_lsp_obj_t* args)
2005-09-20 08:05:32 +00:00
{
2006-10-24 04:22:40 +00:00
ase_lsp_obj_t* body, * tmp;
2006-10-30 03:49:06 +00:00
ase_long_t ival = 0;
ase_real_t rval = .0;
2006-10-24 04:22:40 +00:00
ase_bool_t realnum = ase_false;
2005-09-20 08:05:32 +00:00
2006-10-26 09:31:28 +00:00
ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
2005-09-20 08:05:32 +00:00
body = args;
2006-10-29 13:40:33 +00:00
/*while (body != lsp->mem->nil) */
while (ASE_LSP_TYPE(body) == ASE_LSP_OBJ_CONS)
{
2006-10-24 04:22:40 +00:00
tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(body));
2006-10-29 13:40:33 +00:00
if (tmp == ASE_NULL)
{
2006-10-30 11:26:57 +00:00
/*lsp->errnum = ASE_LSP_EVALBAD; */
2006-10-24 04:22:40 +00:00
return ASE_NULL;
2005-09-20 12:06:51 +00:00
}
2005-09-20 08:05:32 +00:00
2006-10-29 13:40:33 +00:00
if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT)
{
if (body == args)
{
2006-10-26 09:31:28 +00:00
ASE_LSP_ASSERT (lsp, realnum == ase_false);
2006-10-30 03:49:06 +00:00
ival = ASE_LSP_IVAL(tmp);
2005-09-20 12:06:51 +00:00
}
2006-10-29 13:40:33 +00:00
else
{
2005-09-20 12:06:51 +00:00
if (!realnum)
2006-10-30 03:49:06 +00:00
ival = ival + ASE_LSP_IVAL(tmp);
2005-09-20 12:06:51 +00:00
else
2006-10-30 03:49:06 +00:00
rval = rval + ASE_LSP_IVAL(tmp);
2005-09-20 12:06:51 +00:00
}
2005-09-20 11:19:15 +00:00
}
2006-10-29 13:40:33 +00:00
else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL)
{
if (body == args)
{
2006-10-26 09:31:28 +00:00
ASE_LSP_ASSERT (lsp, realnum == ase_false);
2006-10-24 04:22:40 +00:00
realnum = ase_true;
2006-10-30 03:49:06 +00:00
rval = ASE_LSP_RVAL(tmp);
2005-09-20 12:06:51 +00:00
}
2006-10-29 13:40:33 +00:00
else
{
if (!realnum)
{
2006-10-24 04:22:40 +00:00
realnum = ase_true;
2006-10-30 03:49:06 +00:00
rval = (ase_real_t)ival;
2005-09-20 12:06:51 +00:00
}
2006-10-30 03:49:06 +00:00
rval = rval + ASE_LSP_RVAL(tmp);
2005-09-20 11:19:15 +00:00
}
}
2006-10-29 13:40:33 +00:00
else
{
2006-10-30 11:26:57 +00:00
lsp->errnum = ASE_LSP_EVALBAD;
2006-10-24 04:22:40 +00:00
return ASE_NULL;
2005-09-20 08:05:32 +00:00
}
2005-09-20 12:06:51 +00:00
2006-10-24 04:22:40 +00:00
body = ASE_LSP_CDR(body);
2005-09-20 08:05:32 +00:00
}
2006-10-26 09:31:28 +00:00
ASE_LSP_ASSERT (lsp, body == lsp->mem->nil);
2005-09-20 09:17:06 +00:00
2005-09-20 11:19:15 +00:00
tmp = (realnum)?
2006-10-30 03:49:06 +00:00
ase_lsp_makerealobj (lsp->mem, rval):
ase_lsp_makeintobj (lsp->mem, ival);
2006-10-29 13:40:33 +00:00
if (tmp == ASE_NULL)
{
2006-10-26 08:17:38 +00:00
lsp->errnum = ASE_LSP_ENOMEM;
2006-10-24 04:22:40 +00:00
return ASE_NULL;
2005-09-20 08:05:32 +00:00
}
return tmp;
}
2006-10-24 04:22:40 +00:00
ase_lsp_obj_t* ase_lsp_prim_minus (ase_lsp_t* lsp, ase_lsp_obj_t* args)
2005-09-20 08:05:32 +00:00
{
2006-10-24 04:22:40 +00:00
ase_lsp_obj_t* body, * tmp;
2006-10-30 03:49:06 +00:00
ase_long_t ival = 0;
ase_real_t rval = .0;
2006-10-24 04:22:40 +00:00
ase_bool_t realnum = ase_false;
2005-09-20 08:05:32 +00:00
2006-10-26 09:31:28 +00:00
ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
2005-09-20 08:05:32 +00:00
body = args;
2006-10-29 13:40:33 +00:00
/*while (body != lsp->mem->nil) */
while (ASE_LSP_TYPE(body) == ASE_LSP_OBJ_CONS)
{
2006-10-24 04:22:40 +00:00
tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(body));
if (tmp == ASE_NULL) return ASE_NULL;
2005-09-20 08:05:32 +00:00
2005-09-20 11:19:15 +00:00
2006-10-29 13:40:33 +00:00
if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT)
{
if (body == args)
{
2006-10-26 09:31:28 +00:00
ASE_LSP_ASSERT (lsp, realnum == ase_false);
2006-10-30 03:49:06 +00:00
ival = ASE_LSP_IVAL(tmp);
2005-09-20 11:19:15 +00:00
}
2006-10-29 13:40:33 +00:00
else
{
2005-09-20 11:19:15 +00:00
if (!realnum)
2006-10-30 03:49:06 +00:00
ival = ival - ASE_LSP_IVAL(tmp);
2005-09-20 11:19:15 +00:00
else
2006-10-30 03:49:06 +00:00
rval = rval - ASE_LSP_IVAL(tmp);
2005-09-20 11:19:15 +00:00
}
}
2006-10-29 13:40:33 +00:00
else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL)
{
if (body == args)
{
2006-10-26 09:31:28 +00:00
ASE_LSP_ASSERT (lsp, realnum == ase_false);
2006-10-24 04:22:40 +00:00
realnum = ase_true;
2006-10-30 03:49:06 +00:00
rval = ASE_LSP_RVAL(tmp);
2005-09-20 11:19:15 +00:00
}
2006-10-29 13:40:33 +00:00
else
{
if (!realnum)
{
2006-10-24 04:22:40 +00:00
realnum = ase_true;
2006-10-30 03:49:06 +00:00
rval = (ase_real_t)ival;
2005-09-20 11:19:15 +00:00
}
2006-10-30 03:49:06 +00:00
rval = rval - ASE_LSP_RVAL(tmp);
2005-09-20 11:19:15 +00:00
}
}
2006-10-29 13:40:33 +00:00
else
{
2006-10-30 11:26:57 +00:00
lsp->errnum = ASE_LSP_EVALBAD;
2006-10-24 04:22:40 +00:00
return ASE_NULL;
2005-09-20 08:05:32 +00:00
}
2005-09-20 09:17:06 +00:00
2006-10-24 04:22:40 +00:00
body = ASE_LSP_CDR(body);
2005-09-20 08:05:32 +00:00
}
2006-10-26 09:31:28 +00:00
ASE_LSP_ASSERT (lsp, body == lsp->mem->nil);
2005-09-20 09:17:06 +00:00
2005-09-20 11:19:15 +00:00
tmp = (realnum)?
2006-10-30 03:49:06 +00:00
ase_lsp_makerealobj (lsp->mem, rval):
ase_lsp_makeintobj (lsp->mem, ival);
2006-10-29 13:40:33 +00:00
if (tmp == ASE_NULL)
{
2006-10-26 08:17:38 +00:00
lsp->errnum = ASE_LSP_ENOMEM;
2006-10-24 04:22:40 +00:00
return ASE_NULL;
2005-09-20 08:05:32 +00:00
}
return tmp;
}
2005-09-20 11:19:15 +00:00
2006-10-29 13:00:39 +00:00
ase_lsp_obj_t* ase_lsp_prim_mul (ase_lsp_t* lsp, ase_lsp_obj_t* args)
2005-09-20 12:06:51 +00:00
{
2006-10-24 04:22:40 +00:00
ase_lsp_obj_t* body, * tmp;
2006-10-30 03:49:06 +00:00
ase_long_t ival = 0;
ase_real_t rval = .0;
2006-10-24 04:22:40 +00:00
ase_bool_t realnum = ase_false;
2005-09-20 12:06:51 +00:00
2006-10-26 09:31:28 +00:00
ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
2005-09-20 12:06:51 +00:00
body = args;
2006-10-29 13:40:33 +00:00
/*while (body != lsp->mem->nil) */
while (ASE_LSP_TYPE(body) == ASE_LSP_OBJ_CONS)
{
2006-10-24 04:22:40 +00:00
tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(body));
if (tmp == ASE_NULL) return ASE_NULL;
2005-09-20 12:06:51 +00:00
2006-10-29 13:40:33 +00:00
if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT)
{
if (body == args)
{
2006-10-26 09:31:28 +00:00
ASE_LSP_ASSERT (lsp, realnum == ase_false);
2006-10-30 03:49:06 +00:00
ival = ASE_LSP_IVAL(tmp);
2005-09-20 12:06:51 +00:00
}
2006-10-29 13:40:33 +00:00
else
{
2005-09-20 12:06:51 +00:00
if (!realnum)
2006-10-30 03:49:06 +00:00
ival = ival * ASE_LSP_IVAL(tmp);
2005-09-20 12:06:51 +00:00
else
2006-10-30 03:49:06 +00:00
rval = rval * ASE_LSP_IVAL(tmp);
2005-09-20 12:06:51 +00:00
}
}
2006-10-29 13:40:33 +00:00
else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL)
{
if (body == args)
{
2006-10-26 09:31:28 +00:00
ASE_LSP_ASSERT (lsp, realnum == ase_false);
2006-10-24 04:22:40 +00:00
realnum = ase_true;
2006-10-30 03:49:06 +00:00
rval = ASE_LSP_RVAL(tmp);
2005-09-20 12:06:51 +00:00
}
2006-10-29 13:40:33 +00:00
else
{
if (!realnum)
{
2006-10-24 04:22:40 +00:00
realnum = ase_true;
2006-10-30 03:49:06 +00:00
rval = (ase_real_t)ival;
2005-09-20 12:06:51 +00:00
}
2006-10-30 03:49:06 +00:00
rval = rval * ASE_LSP_RVAL(tmp);
2005-09-20 12:06:51 +00:00
}
}
2006-10-29 13:40:33 +00:00
else
{
2006-10-30 11:26:57 +00:00
lsp->errnum = ASE_LSP_EVALBAD;
2006-10-24 04:22:40 +00:00
return ASE_NULL;
2005-09-20 12:06:51 +00:00
}
2006-10-24 04:22:40 +00:00
body = ASE_LSP_CDR(body);
2005-09-20 12:06:51 +00:00
}
2006-10-26 09:31:28 +00:00
ASE_LSP_ASSERT (lsp, body == lsp->mem->nil);
2005-09-20 12:06:51 +00:00
tmp = (realnum)?
2006-10-30 03:49:06 +00:00
ase_lsp_makerealobj (lsp->mem, rval):
ase_lsp_makeintobj (lsp->mem, ival);
2006-10-29 13:40:33 +00:00
if (tmp == ASE_NULL)
{
2006-10-26 08:17:38 +00:00
lsp->errnum = ASE_LSP_ENOMEM;
2006-10-24 04:22:40 +00:00
return ASE_NULL;
2005-09-20 12:06:51 +00:00
}
return tmp;
}
2006-10-29 13:00:39 +00:00
ase_lsp_obj_t* ase_lsp_prim_div (ase_lsp_t* lsp, ase_lsp_obj_t* args)
2005-09-20 12:06:51 +00:00
{
2006-10-24 04:22:40 +00:00
ase_lsp_obj_t* body, * tmp;
2006-10-30 03:49:06 +00:00
ase_long_t ival = 0;
ase_real_t rval = .0;
2006-10-24 04:22:40 +00:00
ase_bool_t realnum = ase_false;
2005-09-20 12:06:51 +00:00
2006-10-26 09:31:28 +00:00
ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
2005-09-20 12:06:51 +00:00
body = args;
2006-10-29 13:40:33 +00:00
/*while (body != lsp->mem->nil)*/
while (ASE_LSP_TYPE(body) == ASE_LSP_OBJ_CONS)
{
2006-10-24 04:22:40 +00:00
tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(body));
if (tmp == ASE_NULL) return ASE_NULL;
2005-09-20 12:06:51 +00:00
2006-10-29 13:40:33 +00:00
if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT)
{
if (body == args)
{
2006-10-26 09:31:28 +00:00
ASE_LSP_ASSERT (lsp, realnum == ase_false);
2006-10-30 03:49:06 +00:00
ival = ASE_LSP_IVAL(tmp);
2005-09-20 12:06:51 +00:00
}
2006-10-29 13:40:33 +00:00
else
{
if (!realnum)
{
2006-10-30 03:49:06 +00:00
if (ASE_LSP_IVAL(tmp) == 0)
2006-10-29 13:40:33 +00:00
{
2006-10-26 08:17:38 +00:00
lsp->errnum = ASE_LSP_EDIVBYZERO;
2006-10-24 04:22:40 +00:00
return ASE_NULL;
2005-09-21 12:04:05 +00:00
}
2006-10-30 03:49:06 +00:00
ival = ival / ASE_LSP_IVAL(tmp);
2005-09-21 12:04:05 +00:00
}
2005-09-20 12:06:51 +00:00
else
2006-10-30 03:49:06 +00:00
rval = rval / ASE_LSP_IVAL(tmp);
2005-09-20 12:06:51 +00:00
}
}
2006-10-29 13:40:33 +00:00
else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL)
{
if (body == args)
{
2006-10-26 09:31:28 +00:00
ASE_LSP_ASSERT (lsp, realnum == ase_false);
2006-10-24 04:22:40 +00:00
realnum = ase_true;
2006-10-30 03:49:06 +00:00
rval = ASE_LSP_RVAL(tmp);
2005-09-20 12:06:51 +00:00
}
2006-10-29 13:40:33 +00:00
else
{
if (!realnum)
{
2006-10-24 04:22:40 +00:00
realnum = ase_true;
2006-10-30 03:49:06 +00:00
rval = (ase_real_t)ival;
2005-09-20 12:06:51 +00:00
}
2006-10-30 03:49:06 +00:00
rval = rval / ASE_LSP_RVAL(tmp);
2005-09-20 12:06:51 +00:00
}
}
2006-10-29 13:40:33 +00:00
else
{
2006-10-30 11:26:57 +00:00
lsp->errnum = ASE_LSP_EVALBAD;
2006-10-24 04:22:40 +00:00
return ASE_NULL;
2005-09-20 12:06:51 +00:00
}
2006-10-24 04:22:40 +00:00
body = ASE_LSP_CDR(body);
2005-09-20 12:06:51 +00:00
}
2006-10-26 09:31:28 +00:00
ASE_LSP_ASSERT (lsp, body == lsp->mem->nil);
2005-09-20 12:06:51 +00:00
tmp = (realnum)?
2006-10-30 03:49:06 +00:00
ase_lsp_makerealobj (lsp->mem, rval):
ase_lsp_makeintobj (lsp->mem, ival);
2006-10-26 08:17:38 +00:00
if (tmp == ASE_NULL)
{
lsp->errnum = ASE_LSP_ENOMEM;
2006-10-24 04:22:40 +00:00
return ASE_NULL;
2005-09-20 12:06:51 +00:00
}
return tmp;
}
2006-10-29 13:00:39 +00:00
ase_lsp_obj_t* ase_lsp_prim_mod (ase_lsp_t* lsp, ase_lsp_obj_t* args)
2005-09-20 12:06:51 +00:00
{
2006-10-24 04:22:40 +00:00
ase_lsp_obj_t* body, * tmp;
2006-10-30 03:49:06 +00:00
ase_long_t ival = 0;
2005-09-20 12:06:51 +00:00
2006-10-26 09:31:28 +00:00
ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
2005-09-20 12:06:51 +00:00
body = args;
//while (body != lsp->mem->nil) {
2006-10-29 13:40:33 +00:00
while (ASE_LSP_TYPE(body) == ASE_LSP_OBJ_CONS)
{
2006-10-24 04:22:40 +00:00
tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(body));
if (tmp == ASE_NULL) return ASE_NULL;
2005-09-20 12:06:51 +00:00
2006-10-29 13:40:33 +00:00
if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT)
{
if (body == args)
{
2006-10-30 03:49:06 +00:00
ival = ASE_LSP_IVAL(tmp);
2005-09-20 12:06:51 +00:00
}
2006-10-29 13:40:33 +00:00
else
{
2006-10-30 03:49:06 +00:00
if (ASE_LSP_IVAL(tmp) == 0)
2006-10-29 13:40:33 +00:00
{
2006-10-26 08:17:38 +00:00
lsp->errnum = ASE_LSP_EDIVBYZERO;
2006-10-24 04:22:40 +00:00
return ASE_NULL;
2005-09-21 12:04:05 +00:00
}
2006-10-30 03:49:06 +00:00
ival = ival % ASE_LSP_IVAL(tmp);
2005-09-20 12:06:51 +00:00
}
}
2006-10-29 13:40:33 +00:00
else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL)
{
if (body == args)
{
2006-10-30 03:49:06 +00:00
ival = (ase_long_t)ASE_LSP_RVAL(tmp);
2005-09-20 12:06:51 +00:00
}
2006-10-29 13:40:33 +00:00
else
{
2006-10-30 03:49:06 +00:00
ase_long_t tmpi = (ase_long_t)ASE_LSP_RVAL(tmp);
2006-10-29 13:40:33 +00:00
if (tmpi == 0)
{
2006-10-26 08:17:38 +00:00
lsp->errnum = ASE_LSP_EDIVBYZERO;
2006-10-24 04:22:40 +00:00
return ASE_NULL;
2005-09-21 12:04:05 +00:00
}
2006-10-30 03:49:06 +00:00
ival = ival % tmpi;
2005-09-20 12:06:51 +00:00
}
}
2006-10-29 13:40:33 +00:00
else
{
2006-10-30 11:26:57 +00:00
lsp->errnum = ASE_LSP_EVALBAD;
2006-10-24 04:22:40 +00:00
return ASE_NULL;
2005-09-20 12:06:51 +00:00
}
2006-10-24 04:22:40 +00:00
body = ASE_LSP_CDR(body);
2005-09-20 12:06:51 +00:00
}
2006-10-26 09:31:28 +00:00
ASE_LSP_ASSERT (lsp, body == lsp->mem->nil);
2005-09-20 12:06:51 +00:00
2006-10-30 03:49:06 +00:00
tmp = ase_lsp_makeintobj (lsp->mem, ival);
2006-10-25 13:42:31 +00:00
if (tmp == ASE_NULL)
{
lsp->errnum = ASE_LSP_ENOMEM;
2006-10-24 04:22:40 +00:00
return ASE_NULL;
2005-09-20 12:06:51 +00:00
}
return tmp;
}