hyung-hwan/hak
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

implemented basic arithmetic operations for fixed-point decimals

Browse Source
This commit is contained in:
hyung-hwan
2018-03-30 15:43:09 +00:00
parent dae10ef59c
commit 2253d09a18
4 changed files with 259 additions and 62 deletions
Download Patch File Download Diff File Expand all files Collapse all files

13
lib/hcl-prv.h
View File

@ -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 */
/* ========================================================================= */

236
lib/number.c
View File

@ -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))
{
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);
v = hcl_addints(hcl, ((hcl_oop_fpdec_t)x)->value, ((hcl_oop_fpdec_t)y)->value);
hcl_poptmps (hcl, 2);
return hcl_makefpdec(hcl, v, scale);
}
else
{
}
/* both are probably integers */
return hcl_addints(hcl, x, y);
}
else
{
if (HCL_IS_FPDEC(hcl, y))
hcl_oop_t v;
hcl_ooi_t scale;
hcl_pushtmp (hcl, &x);
hcl_pushtmp (hcl, &y);
scale = equalize_scale(hcl, &x, &y);
if (scale <= -1)
{
hcl_poptmps (hcl, 2);
return HCL_NULL;
}
else
{
return hcl_addints(hcl, x, y);
}
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);
}
}
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))
{
hcl_oop_t v;
hcl_ooi_t scale;
hcl_pushtmp (hcl, &x);
hcl_pushtmp (hcl, &y);
scale = equalize_scale (hcl, x, y);
v = hcl_subints(hcl, ((hcl_oop_fpdec_t)x)->value, ((hcl_oop_fpdec_t)y)->value);
hcl_poptmps (hcl, 2);
return hcl_makefpdec(hcl, v, scale);
}
else
{
}
/* both are probably integers */
return hcl_subints(hcl, x, y);
}
else
{
if (HCL_IS_FPDEC(hcl, y))
hcl_oop_t v;
hcl_ooi_t scale;
hcl_pushtmp (hcl, &x);
hcl_pushtmp (hcl, &y);
scale = equalize_scale(hcl, &x, &y);
if (scale <= -1)
{
hcl_poptmps (hcl, 2);
return HCL_NULL;
}
else
{
return hcl_subints(hcl, x, y);
}
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);
}
}
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 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 = 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
View File

@ -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, { '>' } },

49
lib/print.c
View File

@ -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);
tmp = hcl_inttostr(hcl, f->value, 10, -1);
if (!tmp) return -1;
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;
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;
tmp = hcl_inttostr(hcl, f->value, 10, -1);
if (!tmp) 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;
}