commit 75feefbe3784a24b36a0cd3a0643e24f9e9b940e
parent 57d3bff73d6d696c1e3add6c5df5b6205b2ed44d
Author: Andres Navarro <canavarro82@gmail.com>
Date: Mon, 21 Mar 2011 17:05:33 -0300
Added div, mod, div-and-mod, div0, mod0 and div0-and-mod0 to the ground environment.
Diffstat:
4 files changed, 123 insertions(+), 5 deletions(-)
diff --git a/src/Makefile b/src/Makefile
@@ -128,4 +128,5 @@ kgports.o: kgports.c kgports.h kghelpers.h kstate.h klisp.h \
kgchars.o: kgchars.c kgchars.h kghelpers.h kstate.h klisp.h \
kobject.h kerror.h kapplicative.h koperative.h kcontinuation.h
kgnumbers.o: kgnumbers.c kgnumbers.h kghelpers.h kstate.h klisp.h \
- kobject.h kerror.h kapplicative.h koperative.h kcontinuation.h
+ kobject.h kerror.h kapplicative.h koperative.h kcontinuation.h \
+ ksymbol.h
diff --git a/src/kgnumbers.c b/src/kgnumbers.c
@@ -16,6 +16,7 @@
#include "koperative.h"
#include "kcontinuation.h"
#include "kerror.h"
+#include "ksymbol.h"
#include "kghelpers.h"
#include "kgnumbers.h"
@@ -229,10 +230,101 @@ void kminus(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
bool kzerop(TValue n) { return kfast_zerop(n); }
/* 12.5.8 div, mod, div-and-mod */
-/* TODO */
+/* use div_mod */
/* 12.5.9 div0, mod0, div0-and-mod0 */
-/* TODO */
+/* use div_mod */
+
+/* Helpers for div, mod, div0 and mod0 */
+
+/* zerop signals div0 and mod0 if true div and mod if false */
+inline void div_mod(bool zerop, int32_t n, int32_t d, int32_t *div,
+ int32_t *mod)
+{
+ *div = n / d;
+ *mod = n % d;
+
+ if (zerop) {
+ /* div0, mod0 or div-and-mod0 */
+ /* -|d/2| <= mod0 < |d/2| */
+
+ int32_t dabs = ((d<0? -d : d) + 1) / 2;
+
+ if (*mod < -dabs) {
+ if (d < 0) {
+ *mod -= d;
+ ++(*div);
+ } else {
+ *mod += d;
+ --(*div);
+ }
+ } else if (*mod >= dabs) {
+ if (d < 0) {
+ *mod += d;
+ --(*div);
+ } else {
+ *mod -= d;
+ ++(*div);
+ }
+ }
+ } else {
+ /* div, mod or div-and-mod */
+ /* 0 <= mod0 < |d| */
+ if (*mod < 0) {
+ if (d < 0) {
+ *mod -= d;
+ ++(*div);
+ } else {
+ *mod += d;
+ --(*div);
+ }
+ }
+ }
+}
+
+/* flags are FDIV_DIV, FDIV_MOD, FDIV_ZERO */
+void kdiv_mod(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+{
+ /*
+ ** xparams[0]: name symbol
+ ** xparams[1]: div_mod_flags
+ */
+ char *name = ksymbol_buf(xparams[0]);
+ int32_t flags = ivalue(xparams[1]);
+
+ bind_2tp(K, name, ptree, "number", knumberp, tv_n,
+ "number", knumberp, tv_d);
+
+ /* TEMP: only fixnums */
+ TValue tv_div, tv_mod;
+
+ if (kfast_zerop(tv_d)) {
+ klispE_throw_extra(K, name, ": division by zero");
+ return;
+ } else if (ttiseinf(tv_n)) {
+ klispE_throw_extra(K, name, ": non finite dividend");
+ return;
+ } else if (ttiseinf(tv_d)) {
+ tv_div = ((ivalue(tv_n) ^ ivalue(tv_d)) < 0)? KEPINF : KEMINF;
+ tv_mod = i2tv(0);
+ } else {
+ int32_t div, mod;
+ div_mod(flags & FDIV_ZERO, ivalue(tv_n), ivalue(tv_d), &div, &mod);
+ tv_div = i2tv(div);
+ tv_mod = i2tv(mod);
+ }
+ TValue res;
+ if (flags & FDIV_DIV) {
+ if (flags & FDIV_MOD) { /* return both div and mod */
+ res = kcons(K, tv_div, kcons(K, tv_mod, KNIL));
+ } else {
+ res = tv_div;
+ }
+ } else {
+ res = tv_mod;
+ }
+ kapply_cc(K, res);
+}
/* 12.5.10 positive?, negative? */
/* use ftyped_predp */
@@ -267,3 +359,4 @@ void kabs(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
return;
}
}
+
diff --git a/src/kgnumbers.h b/src/kgnumbers.h
@@ -80,6 +80,20 @@ bool knegativep(TValue n);
bool koddp(TValue n);
bool kevenp(TValue n);
+/* 12.5.8 div, mod, div-and-mod */
+/* use div_mod */
+
+/* 12.5.9 div0, mod0, div0-and-mod0 */
+/* use div_mod */
+
+/* Helper for div and mod */
+#define FDIV_DIV 1
+#define FDIV_MOD 2
+#define FDIV_ZERO 4
+
+void kdiv_mod(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+
+
/* 12.5.12 abs */
void kabs(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
diff --git a/src/kground.c b/src/kground.c
@@ -522,10 +522,20 @@ void kinit_ground_env(klisp_State *K)
p2tv(knumberp), p2tv(kzerop));
/* 12.5.8 div, mod, div-and-mod */
- /* TODO */
+ add_applicative(K, ground_env, "div", kdiv_mod, 2, symbol,
+ i2tv(FDIV_DIV));
+ add_applicative(K, ground_env, "mod", kdiv_mod, 2, symbol,
+ i2tv(FDIV_MOD));
+ add_applicative(K, ground_env, "div-and-mod", kdiv_mod, 2, symbol,
+ i2tv(FDIV_DIV | FDIV_MOD));
/* 12.5.9 div0, mod0, div0-and-mod0 */
- /* TODO */
+ add_applicative(K, ground_env, "div0", kdiv_mod, 2, symbol,
+ i2tv(FDIV_ZERO | FDIV_DIV));
+ add_applicative(K, ground_env, "mod0", kdiv_mod, 2, symbol,
+ i2tv(FDIV_ZERO | FDIV_MOD));
+ add_applicative(K, ground_env, "div0-and-mod0", kdiv_mod, 2, symbol,
+ i2tv(FDIV_ZERO | FDIV_DIV | FDIV_MOD));
/* 12.5.10 positive?, negative? */
add_applicative(K, ground_env, "positive?", ftyped_predp, 3, symbol,
