implemented basic arithmetic operations for fixed-point decimals
This commit is contained in:
parent
dae10ef59c
commit
2253d09a18
@ -977,6 +977,19 @@ hcl_oop_t hcl_subnums (
|
||||
hcl_oop_t x,
|
||||
hcl_oop_t y
|
||||
);
|
||||
|
||||
hcl_oop_t hcl_mulnums (
|
||||
hcl_t* hcl,
|
||||
hcl_oop_t x,
|
||||
hcl_oop_t y
|
||||
);
|
||||
|
||||
hcl_oop_t hcl_divnums (
|
||||
hcl_t* hcl,
|
||||
hcl_oop_t x,
|
||||
hcl_oop_t y
|
||||
);
|
||||
|
||||
/* ========================================================================= */
|
||||
/* comp.c */
|
||||
/* ========================================================================= */
|
||||
|
202
lib/number.c
202
lib/number.c
@ -26,35 +26,71 @@
|
||||
|
||||
#include "hcl-prv.h"
|
||||
|
||||
static hcl_ooi_t equalize_scale (hcl_t* hcl, hcl_oop_fpdec_t x, hcl_oop_fpdec_t y)
|
||||
|
||||
static hcl_ooi_t equalize_scale (hcl_t* hcl, hcl_oop_t* x, hcl_oop_t* y)
|
||||
{
|
||||
hcl_ooi_t xs, ys;
|
||||
hcl_oop_t nv;
|
||||
hcl_oop_t xv, yv;
|
||||
|
||||
xs = HCL_OOP_TO_SMOOI(x->scale);
|
||||
ys = HCL_OOP_TO_SMOOI(y->scale);
|
||||
/* this function assumes that x and y are protected by the caller */
|
||||
|
||||
xs = 0;
|
||||
xv = *x;
|
||||
if (HCL_IS_FPDEC(hcl, xv))
|
||||
{
|
||||
xs = HCL_OOP_TO_SMOOI(((hcl_oop_fpdec_t)xv)->scale);
|
||||
xv = ((hcl_oop_fpdec_t)xv)->value;
|
||||
}
|
||||
else if (!hcl_isint(hcl, xv))
|
||||
{
|
||||
hcl_seterrbfmt (hcl, HCL_EINVAL, "parameter not numeric - %O", xv);
|
||||
return -1;
|
||||
}
|
||||
|
||||
ys = 0;
|
||||
yv = *y;
|
||||
if (HCL_IS_FPDEC(hcl, *y))
|
||||
{
|
||||
ys = HCL_OOP_TO_SMOOI(((hcl_oop_fpdec_t)yv)->scale);
|
||||
yv = ((hcl_oop_fpdec_t)yv)->value;
|
||||
}
|
||||
else if (!hcl_isint(hcl, yv))
|
||||
{
|
||||
hcl_seterrbfmt (hcl, HCL_EINVAL, "parameter not numeric - %O", yv);
|
||||
return -1;
|
||||
}
|
||||
|
||||
if (xs < ys)
|
||||
{
|
||||
/* TODO: don't change x or y. create new objects */
|
||||
x->scale = y->scale;
|
||||
hcl_pushtmp(hcl, &x);
|
||||
nv = xv;
|
||||
while (xs < ys)
|
||||
{
|
||||
x->value = hcl_mulints(hcl, x->value, HCL_SMOOI_TO_OOP(10));
|
||||
/* TODO: optmize this. less multiplications */
|
||||
nv = hcl_mulints(hcl, nv, HCL_SMOOI_TO_OOP(10));
|
||||
if (!nv) return -1;
|
||||
xs++;
|
||||
}
|
||||
hcl_poptmp(hcl);
|
||||
|
||||
nv = hcl_makefpdec(hcl, nv, xs);
|
||||
if (!nv) return -1;
|
||||
|
||||
*x = nv;
|
||||
}
|
||||
else if (xs > ys)
|
||||
{
|
||||
y->scale = x->scale;
|
||||
hcl_pushtmp(hcl, &y);
|
||||
nv = yv;
|
||||
while (ys < xs)
|
||||
{
|
||||
y->value = hcl_mulints(hcl, y->value, HCL_SMOOI_TO_OOP(10));
|
||||
nv = hcl_mulints(hcl, nv, HCL_SMOOI_TO_OOP(10));
|
||||
if (!nv) return -1;
|
||||
ys++;
|
||||
}
|
||||
hcl_poptmp(hcl);
|
||||
|
||||
nv = hcl_makefpdec(hcl, nv, ys);
|
||||
if (!nv) return -1;
|
||||
|
||||
*y = nv;
|
||||
}
|
||||
|
||||
return xs;
|
||||
@ -62,65 +98,155 @@ static hcl_ooi_t equalize_scale (hcl_t* hcl, hcl_oop_fpdec_t x, hcl_oop_fpdec_t
|
||||
|
||||
hcl_oop_t hcl_addnums (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y)
|
||||
{
|
||||
if (HCL_IS_FPDEC(hcl, x))
|
||||
if (!HCL_IS_FPDEC(hcl, x) && !HCL_IS_FPDEC(hcl, y))
|
||||
{
|
||||
if (HCL_IS_FPDEC(hcl, y))
|
||||
/* both are probably integers */
|
||||
return hcl_addints(hcl, x, y);
|
||||
}
|
||||
else
|
||||
{
|
||||
hcl_oop_t v;
|
||||
hcl_ooi_t scale;
|
||||
|
||||
/* TODO: error handling */
|
||||
hcl_pushtmp (hcl, &x);
|
||||
hcl_pushtmp (hcl, &y);
|
||||
scale = equalize_scale (hcl, x, y);
|
||||
|
||||
scale = equalize_scale(hcl, &x, &y);
|
||||
if (scale <= -1)
|
||||
{
|
||||
hcl_poptmps (hcl, 2);
|
||||
return HCL_NULL;
|
||||
}
|
||||
v = hcl_addints(hcl, ((hcl_oop_fpdec_t)x)->value, ((hcl_oop_fpdec_t)y)->value);
|
||||
hcl_poptmps (hcl, 2);
|
||||
if (!v) return HCL_NULL;
|
||||
|
||||
return hcl_makefpdec(hcl, v, scale);
|
||||
}
|
||||
else
|
||||
{
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
if (HCL_IS_FPDEC(hcl, y))
|
||||
{
|
||||
}
|
||||
else
|
||||
{
|
||||
return hcl_addints(hcl, x, y);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
hcl_oop_t hcl_subnums (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y)
|
||||
{
|
||||
if (HCL_IS_FPDEC(hcl, x))
|
||||
if (!HCL_IS_FPDEC(hcl, x) && !HCL_IS_FPDEC(hcl, y))
|
||||
{
|
||||
if (HCL_IS_FPDEC(hcl, y))
|
||||
/* both are probably integers */
|
||||
return hcl_subints(hcl, x, y);
|
||||
}
|
||||
else
|
||||
{
|
||||
hcl_oop_t v;
|
||||
hcl_ooi_t scale;
|
||||
|
||||
hcl_pushtmp (hcl, &x);
|
||||
hcl_pushtmp (hcl, &y);
|
||||
scale = equalize_scale (hcl, x, y);
|
||||
|
||||
scale = equalize_scale(hcl, &x, &y);
|
||||
if (scale <= -1)
|
||||
{
|
||||
hcl_poptmps (hcl, 2);
|
||||
return HCL_NULL;
|
||||
}
|
||||
v = hcl_subints(hcl, ((hcl_oop_fpdec_t)x)->value, ((hcl_oop_fpdec_t)y)->value);
|
||||
hcl_poptmps (hcl, 2);
|
||||
if (!v) return HCL_NULL;
|
||||
|
||||
return hcl_makefpdec(hcl, v, scale);
|
||||
}
|
||||
else
|
||||
}
|
||||
|
||||
hcl_oop_t hcl_mulnums (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y)
|
||||
{
|
||||
hcl_ooi_t xs, ys, scale;
|
||||
hcl_oop_t nv;
|
||||
hcl_oop_t xv, yv;
|
||||
|
||||
xs = 0;
|
||||
xv = x;
|
||||
if (HCL_IS_FPDEC(hcl, xv))
|
||||
{
|
||||
xs = HCL_OOP_TO_SMOOI(((hcl_oop_fpdec_t)xv)->scale);
|
||||
xv = ((hcl_oop_fpdec_t)xv)->value;
|
||||
}
|
||||
}
|
||||
else
|
||||
else if (!hcl_isint(hcl, xv))
|
||||
{
|
||||
hcl_seterrbfmt (hcl, HCL_EINVAL, "parameter not numeric - %O", xv);
|
||||
return HCL_NULL;
|
||||
}
|
||||
|
||||
ys = 0;
|
||||
yv = y;
|
||||
if (HCL_IS_FPDEC(hcl, y))
|
||||
{
|
||||
ys = HCL_OOP_TO_SMOOI(((hcl_oop_fpdec_t)yv)->scale);
|
||||
yv = ((hcl_oop_fpdec_t)yv)->value;
|
||||
}
|
||||
else
|
||||
else if (!hcl_isint(hcl, yv))
|
||||
{
|
||||
return hcl_subints(hcl, x, y);
|
||||
hcl_seterrbfmt (hcl, HCL_EINVAL, "parameter not numeric - %O", yv);
|
||||
return HCL_NULL;
|
||||
}
|
||||
|
||||
nv = hcl_mulints(hcl, xv, yv);
|
||||
if (!nv) return HCL_NULL;
|
||||
|
||||
scale = xs + ys;
|
||||
if (scale > HCL_SMOOI_MAX)
|
||||
{
|
||||
/* TODO: limit scale */
|
||||
}
|
||||
|
||||
return hcl_makefpdec(hcl, nv, scale);
|
||||
}
|
||||
|
||||
|
||||
hcl_oop_t hcl_divnums (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y)
|
||||
{
|
||||
hcl_ooi_t xs, ys, i;
|
||||
hcl_oop_t nv;
|
||||
hcl_oop_t xv, yv;
|
||||
|
||||
xs = 0;
|
||||
xv = x;
|
||||
if (HCL_IS_FPDEC(hcl, xv))
|
||||
{
|
||||
xs = HCL_OOP_TO_SMOOI(((hcl_oop_fpdec_t)xv)->scale);
|
||||
xv = ((hcl_oop_fpdec_t)xv)->value;
|
||||
}
|
||||
else if (!hcl_isint(hcl, xv))
|
||||
{
|
||||
hcl_seterrbfmt (hcl, HCL_EINVAL, "parameter not numeric - %O", xv);
|
||||
return HCL_NULL;
|
||||
}
|
||||
|
||||
ys = 0;
|
||||
yv = y;
|
||||
if (HCL_IS_FPDEC(hcl, y))
|
||||
{
|
||||
ys = HCL_OOP_TO_SMOOI(((hcl_oop_fpdec_t)yv)->scale);
|
||||
yv = ((hcl_oop_fpdec_t)yv)->value;
|
||||
}
|
||||
else if (!hcl_isint(hcl, yv))
|
||||
{
|
||||
hcl_seterrbfmt (hcl, HCL_EINVAL, "parameter not numeric - %O", yv);
|
||||
return HCL_NULL;
|
||||
}
|
||||
|
||||
nv = xv;
|
||||
|
||||
hcl_pushtmp (hcl, &y);
|
||||
for (i = 0; i < ys; i++)
|
||||
{
|
||||
nv = hcl_mulints(hcl, nv, HCL_SMOOI_TO_OOP(10));
|
||||
if (!nv)
|
||||
{
|
||||
hcl_poptmp (hcl);
|
||||
return HCL_NULL;
|
||||
}
|
||||
}
|
||||
|
||||
nv = hcl_divints(hcl, nv, y, 0, HCL_NULL);
|
||||
hcl_poptmp (hcl);
|
||||
if (!nv) return HCL_NULL;
|
||||
|
||||
return hcl_makefpdec(hcl, nv, xs);
|
||||
}
|
||||
|
23
lib/prim.c
23
lib/prim.c
@ -421,7 +421,25 @@ static hcl_pfrc_t pf_integer_mul (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
|
||||
for (i = 1; i < nargs; i++)
|
||||
{
|
||||
arg = HCL_STACK_GETARG(hcl, nargs, i);
|
||||
ret = hcl_mulints(hcl, ret, arg);
|
||||
/*ret = hcl_mulints(hcl, ret, arg);*/
|
||||
ret = hcl_mulnums(hcl, ret, arg);
|
||||
if (!ret) return HCL_PF_FAILURE;
|
||||
}
|
||||
|
||||
HCL_STACK_SETRET (hcl, nargs, ret);
|
||||
return HCL_PF_SUCCESS;
|
||||
}
|
||||
|
||||
static hcl_pfrc_t pf_integer_div (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
|
||||
{
|
||||
hcl_ooi_t i;
|
||||
hcl_oop_t arg, ret;
|
||||
|
||||
ret = HCL_STACK_GETARG(hcl, nargs, 0);
|
||||
for (i = 1; i < nargs; i++)
|
||||
{
|
||||
arg = HCL_STACK_GETARG(hcl, nargs, i);
|
||||
ret = hcl_divnums(hcl, ret, arg);
|
||||
if (!ret) return HCL_PF_FAILURE;
|
||||
}
|
||||
|
||||
@ -546,7 +564,8 @@ static pf_t builtin_prims[] =
|
||||
{ 1, HCL_TYPE_MAX(hcl_oow_t), pf_integer_add, 1, { '+' } },
|
||||
{ 1, HCL_TYPE_MAX(hcl_oow_t), pf_integer_sub, 1, { '-' } },
|
||||
{ 1, HCL_TYPE_MAX(hcl_oow_t), pf_integer_mul, 1, { '*' } },
|
||||
{ 1, HCL_TYPE_MAX(hcl_oow_t), pf_integer_quo, 1, { '/' } },
|
||||
{ 1, HCL_TYPE_MAX(hcl_oow_t), pf_integer_div, 1, { '/' } },
|
||||
{ 1, HCL_TYPE_MAX(hcl_oow_t), pf_integer_quo, 3, { 'q','u','o' } },
|
||||
{ 2, HCL_TYPE_MAX(hcl_oow_t), pf_integer_rem, 3, { 'm','o','d' } },
|
||||
|
||||
{ 2, 2, pf_integer_gt, 1, { '>' } },
|
||||
|
45
lib/print.c
45
lib/print.c
@ -290,17 +290,56 @@ next:
|
||||
|
||||
case HCL_BRAND_FPDEC:
|
||||
{
|
||||
hcl_oop_t tmp;
|
||||
hcl_oop_fpdec_t f = (hcl_oop_fpdec_t)obj;
|
||||
hcl_ooi_t scale;
|
||||
|
||||
scale = HCL_OOP_TO_SMOOI(f->scale);
|
||||
|
||||
if (f->value == HCL_SMOOI_TO_OOP(0))
|
||||
{
|
||||
if (scale == 0)
|
||||
{
|
||||
if (outbfmt(hcl, mask, "0.") <= -1) return -1;
|
||||
}
|
||||
else
|
||||
{
|
||||
if (outbfmt(hcl, mask, "0.%0*d", scale, 0) <= -1) return -1;
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
hcl_oop_t tmp;
|
||||
hcl_oow_t len, adj;
|
||||
|
||||
tmp = hcl_inttostr(hcl, f->value, 10, -1);
|
||||
if (!tmp) return -1;
|
||||
|
||||
HCL_ASSERT (hcl, (hcl_oop_t)tmp == hcl->_nil);
|
||||
if (outbfmt(hcl, mask, "%.*js.%.*js", hcl->inttostr.xbuf.len - scale, hcl->inttostr.xbuf.ptr, scale, &hcl->inttostr.xbuf.ptr[hcl->inttostr.xbuf.len - scale]) <= -1) return -1;
|
||||
adj = (hcl->inttostr.xbuf.ptr[0] == '-');
|
||||
len = hcl->inttostr.xbuf.len - adj;
|
||||
|
||||
if (len <= scale)
|
||||
{
|
||||
if (scale == len)
|
||||
{
|
||||
if (outbfmt(hcl, mask, "%.*js0.%.*js",
|
||||
adj, hcl->inttostr.xbuf.ptr,
|
||||
len, &hcl->inttostr.xbuf.ptr[adj]) <= -1) return -1;
|
||||
}
|
||||
else
|
||||
{
|
||||
if (outbfmt(hcl, mask, "%.*js0.%0*d%.*js",
|
||||
adj, hcl->inttostr.xbuf.ptr,
|
||||
scale - len, 0,
|
||||
len, &hcl->inttostr.xbuf.ptr[adj]) <= -1) return -1;
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
hcl_ooi_t ndigits;
|
||||
ndigits = hcl->inttostr.xbuf.len - scale;
|
||||
if (outbfmt(hcl, mask, "%.*js.%.*js", ndigits, hcl->inttostr.xbuf.ptr, scale, &hcl->inttostr.xbuf.ptr[ndigits]) <= -1) return -1;
|
||||
}
|
||||
}
|
||||
break;
|
||||
}
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user