klisp

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

Added current-second to the ground environment.

Diffstat:
M
src/Makefile
 | 
2
+-
M
src/kground.c
 | 
2
++
M
src/kgsystem.c
 | 
25
++++++++++++++++++++++---
M
src/kgsystem.h
 | 
4
+++-

4 files changed, 28 insertions(+), 5 deletions(-)
diff --git a/src/Makefile b/src/Makefile
@@ -199,7 +199,7 @@ kground.o: kground.c kstate.h klimits.h klisp.h kobject.h klispconf.h \
  kgequalp.h kgsymbols.h kgcontrol.h kgpairs_lists.h kgpair_mut.h \
  kgenvironments.h kgenv_mut.h kgcombiners.h kgcontinuations.h \
  kgencapsulations.h kgpromises.h kgkd_vars.h kgks_vars.h kgnumbers.h \
- kgstrings.h kgchars.h kgports.h kgblobs.h ktable.h keval.h krepl.h
+ kgstrings.h kgchars.h kgports.h kgblobs.h ktable.h keval.h krepl.h kgsystem.h
 kgstrings.o: kgstrings.c kstate.h klimits.h klisp.h kobject.h klispconf.h \
  ktoken.h kmem.h kapplicative.h koperative.h kcontinuation.h kerror.h \
  ksymbol.h kstring.h kghelpers.h kpair.h kgc.h kenvironment.h kgchars.h \
diff --git a/src/kground.c b/src/kground.c
@@ -36,6 +36,7 @@
 #include "kgchars.h"
 #include "kgports.h"
 #include "kgblobs.h"
+#include "kgsystem.h"
 
 /* for initing cont names */
 #include "ktable.h"
@@ -132,6 +133,7 @@ void kinit_ground_env(klisp_State *K)
     kinit_chars_ground_env(K);
     kinit_ports_ground_env(K);
     kinit_blobs_ground_env(K);
+    kinit_system_ground_env(K);
 
     /*
     ** Initialize the names of the continuation used in
diff --git a/src/kgsystem.c b/src/kgsystem.c
@@ -8,6 +8,7 @@
 #include <stdlib.h>
 #include <stdbool.h>
 #include <stdint.h>
+#include <time.h>
 
 #include "kstate.h"
 #include "kobject.h"
@@ -17,7 +18,25 @@
 #include "kghelpers.h"
 #include "kgsystem.h"
 
-/* ??.?.?  */
+/* ??.?.?  current-second */
+void current_second(klisp_State *K, TValue *xparams, TValue ptree, 
+		    TValue denv)
+{
+    time_t now = time(NULL);
+    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;
+	}
+    }
+}
 
 /* init ground */
 void kinit_system_ground_env(klisp_State *K)
@@ -26,9 +45,9 @@ void kinit_system_ground_env(klisp_State *K)
     TValue symbol, value;
 
 /* TODO */
+    /* ??.?.? current-second */
+    add_applicative(K, ground_env, "current-second", current_second, 0);
 #if 0
-    /* 15.2.2 load */
-    add_applicative(K, ground_env, "load", load, 0);
     /* 15.2.3 get-module */
     add_applicative(K, ground_env, "get-module", get_module, 0);
     /* 15.2.? display */
diff --git a/src/kgsystem.h b/src/kgsystem.h
@@ -18,7 +18,9 @@
 #include "kstate.h"
 #include "kghelpers.h"
 
-/* ??.?.? */
+/* ??.?.? current-second */
+void current_second(klisp_State *K, TValue *xparams, TValue ptree, 
+		    TValue denv);
 
 /* init ground */
 void kinit_system_ground_env(klisp_State *K);