klisp

commit 2a98dcc9aeb81e545fe6b6e3d958ec70b9e42384
parent 5ff7316ff7905e0f44c817b06b0a7fa8b0b67d5a
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Sat, 16 Jul 2011 00:21:16 -0300

Added current-jiffy and jiffies-per-second to the ground environment.

Diffstat:
M
src/kgsystem.c
 | 
53
++++++++++++++++++++++++++++++++++++++++++++++-------
M
src/kgsystem.h
 | 
3
+++

2 files changed, 49 insertions(+), 7 deletions(-)
diff --git a/src/kgsystem.c b/src/kgsystem.c
@@ -18,6 +18,10 @@
 #include "kghelpers.h"
 #include "kgsystem.h"
 
+/* 
+** SOURCE NOTE: These are all from the r7rs draft.
+*/
+
 /* ??.?.?  current-second */
 void current_second(klisp_State *K, TValue *xparams, TValue ptree, 
 		    TValue denv)
@@ -38,19 +42,54 @@ void current_second(klisp_State *K, TValue *xparams, TValue ptree,
     }
 }
 
+/* ??.?.?  current-jiffy */
+void current_jiffy(klisp_State *K, TValue *xparams, TValue ptree, 
+		   TValue denv)
+{
+    /* TODO, this may wrap around... use time+clock to a better number */
+    /* XXX doesn't seem to work... should probably use gettimeofday
+       in posix anyways */
+    clock_t now = clock();
+    if (now == -1) {
+	klispE_throw_simple(K, "couldn't get time");
+	return;
+    } else {
+	if (now > INT32_MAX) {
+	    /* XXX/TODO create bigint */
+	    klispE_throw_simple(K, "integer too big");
+	    return;
+	} else {
+	    kapply_cc(K, i2tv((int32_t) now));
+	    return;
+	}
+    }
+}
+
+/* ??.?.?  jiffies-per-second */
+void jiffies_per_second(klisp_State *K, TValue *xparams, TValue ptree, 
+			TValue denv)
+{
+    if (CLOCKS_PER_SEC > INT32_MAX) {
+	    /* XXX/TODO create bigint */
+	    klispE_throw_simple(K, "integer too big");
+	    return;
+    } else {
+	kapply_cc(K, i2tv((int32_t) CLOCKS_PER_SEC));
+	return;
+    }
+}
+
 /* init ground */
 void kinit_system_ground_env(klisp_State *K)
 {
     TValue ground_env = K->ground_env;
     TValue symbol, value;
 
-/* TODO */
     /* ??.?.? current-second */
     add_applicative(K, ground_env, "current-second", current_second, 0);
-#if 0
-    /* 15.2.3 get-module */
-    add_applicative(K, ground_env, "get-module", get_module, 0);
-    /* 15.2.? display */
-    add_applicative(K, ground_env, "display", display, 0);
-#endif
+    /* ??.?.? current-jiffy */
+    add_applicative(K, ground_env, "current-jiffy", current_jiffy, 0);
+    /* ??.?.? jiffies-per-second */
+    add_applicative(K, ground_env, "jiffies-per-second", jiffies_per_second, 
+		    0);
 }
diff --git a/src/kgsystem.h b/src/kgsystem.h
@@ -21,6 +21,9 @@
 /* ??.?.? current-second */
 void current_second(klisp_State *K, TValue *xparams, TValue ptree, 
 		    TValue denv);
+/* ??.?.?  current-jiffy */
+void current_jiffy(klisp_State *K, TValue *xparams, TValue ptree, 
+		   TValue denv);
 
 /* init ground */
 void kinit_system_ground_env(klisp_State *K);