implemented basic arithmetic operations for fixed-point decimals

lib/hcl-prv.h

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

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);
+	/* this function assumes that x and y are protected by the caller */
-	ys = HCL_OOP_TO_SMOOI(y->scale);
+
+	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 */
+		nv = xv;
-		x->scale = y->scale;
-		hcl_pushtmp(hcl, &x);
 		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;
+		nv = yv;
-		hcl_pushtmp(hcl, &y);
 		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
-		{
 }
-	}
+
-	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 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);
 }

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

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); 
+				adj = (hcl->inttostr.xbuf.ptr[0] == '-');
-			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;
+				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;
 		}