commit 33eaea1aa5a10363f1898f2b1dc297f4480fd47a
parent 3781ff253913e65e96e65e84dd545b463b6b90e4
Author: Oto Havle <havleoto@gmail.com>
Date: Sat, 26 Nov 2011 16:22:17 +0100
Platform-dependent current-jiffy, jiffies-per-second.
Diffstat:
12 files changed, 222 insertions(+), 58 deletions(-)
diff --git a/src/Makefile b/src/Makefile
@@ -34,7 +34,7 @@ KRN_A= libklisp.a
CORE_O= kobject.o ktoken.o kpair.o kstring.o ksymbol.o kread.o \
kwrite.o kstate.o kmem.o kerror.o kauxlib.o kenvironment.o \
kcontinuation.o koperative.o kapplicative.o keval.o krepl.o \
- kencapsulation.o kpromise.o kport.o kinteger.o krational.o \
+ kencapsulation.o kpromise.o kport.o kinteger.o krational.o ksystem.o \
kreal.o ktable.o kgc.o imath.o imrat.o kbytevector.o kvector.o \
kchar.o kground.o kghelpers.o kgbooleans.o kgeqp.o kgequalp.o \
kgsymbols.o kgcontrol.o kgpairs_lists.o kgpair_mut.o kgenvironments.o \
@@ -285,6 +285,8 @@ kstring.o: kstring.c kstring.h kobject.h klimits.h klisp.h klispconf.h \
kstate.h ktoken.h kmem.h kgc.h
ksymbol.o: ksymbol.c ksymbol.h kobject.h klimits.h klisp.h klispconf.h \
kstate.h ktoken.h kmem.h kstring.h kgc.h
+ksystem.o: ksystem.c ksystem.posix.c ksystem.win32.c kobject.h klimits.h klisp.h klispconf.h kstate.h \
+ ktoken.h kmem.h ksystem.h
ktable.o: ktable.c klisp.h kobject.h klimits.h klispconf.h kgc.h kstate.h \
ktoken.h kmem.h ktable.h kapplicative.h koperative.h kgeqp.h kinteger.h \
imath.h krational.h imrat.h kghelpers.h kerror.h kpair.h kcontinuation.h \
diff --git a/src/kgffi.c b/src/kgffi.c
@@ -279,25 +279,8 @@ static void ffi_encode_sint32(ffi_codec_t *self, klisp_State *K, TValue v, void
static TValue ffi_decode_uint64(ffi_codec_t *self, klisp_State *K, const void *buf)
{
- /* TODO */
UNUSED(self);
- uint64_t x = *(uint64_t *)buf;
- if (x <= INT32_MAX) {
- return i2tv((int32_t) x);
- } else {
- TValue res = kbigint_make_simple(K);
- krooted_tvs_push(K, res);
-
- uint8_t d[8];
- for (int i = 7; i >= 0; i--) {
- d[i] = (x & 0xFF);
- x >>= 8;
- }
-
- mp_int_read_unsigned(K, tv2bigint(res), d, 8);
- krooted_tvs_pop(K);
- return res;
- }
+ return kinteger_new_uint64(K, *(uint64_t *)buf);
}
static void ffi_encode_uint64(ffi_codec_t *self, klisp_State *K, TValue v, void *buf)
diff --git a/src/kgsystem.c b/src/kgsystem.c
@@ -16,6 +16,7 @@
#include "kobject.h"
#include "kpair.h"
#include "kerror.h"
+#include "ksystem.h"
#include "kghelpers.h"
#include "kgsystem.h"
@@ -54,52 +55,17 @@ void current_second(klisp_State *K)
/* ??.?.? current-jiffy */
void current_jiffy(klisp_State *K)
{
- TValue *xparams = K->next_xparams;
TValue ptree = K->next_value;
- TValue denv = K->next_env;
- klisp_assert(ttisenvironment(K->next_env));
- UNUSED(xparams);
- UNUSED(denv);
-
check_0p(K, ptree);
- /* 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;
- }
- }
+ kapply_cc(K, ksystem_current_jiffy(K));
}
/* ??.?.? jiffies-per-second */
void jiffies_per_second(klisp_State *K)
{
- TValue *xparams = K->next_xparams;
TValue ptree = K->next_value;
- TValue denv = K->next_env;
- klisp_assert(ttisenvironment(K->next_env));
- UNUSED(xparams);
- UNUSED(denv);
-
check_0p(K, ptree);
- 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;
- }
+ kapply_cc(K, ksystem_jiffies_per_second(K));
}
/* 15.1.? file-exists? */
@@ -237,7 +203,11 @@ void get_environment_variables(klisp_State *K)
defined. The correct way to do that would be to define _GNU_SOURCE
before including any system files... That's not so good for an
embeddable interpreter, but it could be done in the makefile I guess */
-extern char **environ;
+extern
+#ifdef _WIN32
+ __declspec(dllimport)
+#endif
+ char **environ;
/* Helper for get-environment-variables */
TValue create_env_var_list(klisp_State *K)
diff --git a/src/kinteger.c b/src/kinteger.c
@@ -293,3 +293,23 @@ TValue kbigint_lcm(klisp_State *K, TValue n1, TValue n2)
krooted_tvs_pop(K);
return kbigint_try_fixint(K, tv_res);
}
+
+TValue kinteger_new_uint64(klisp_State *K, uint64_t x)
+{
+ if (x <= INT32_MAX) {
+ return i2tv((int32_t) x);
+ } else {
+ TValue res = kbigint_make_simple(K);
+ krooted_tvs_push(K, res);
+
+ uint8_t d[8];
+ for (int i = 7; i >= 0; i--) {
+ d[i] = (x & 0xFF);
+ x >>= 8;
+ }
+
+ mp_int_read_unsigned(K, tv2bigint(res), d, 8);
+ krooted_tvs_pop(K);
+ return res;
+ }
+}
diff --git a/src/kinteger.h b/src/kinteger.h
@@ -132,4 +132,7 @@ TValue kbigint_abs(klisp_State *K, TValue tv_bigint);
TValue kbigint_gcd(klisp_State *K, TValue n1, TValue n2);
TValue kbigint_lcm(klisp_State *K, TValue n1, TValue n2);
+/* conversion from uint64_t */
+TValue kinteger_new_uint64(klisp_State *K, uint64_t x);
+
#endif
diff --git a/src/ksystem.c b/src/ksystem.c
@@ -0,0 +1,68 @@
+/*
+** ksystem.c
+** Platform dependent functionality.
+** See Copyright Notice in klisp.h
+*/
+
+#include "kobject.h"
+#include "kstate.h"
+#include "kerror.h"
+#include "ksystem.h"
+
+/* detect platform
+ * TODO: sync with klispconf.h and kgffi.c */
+
+#if defined(KLISP_USE_POSIX)
+# define KLISP_PLATFORM_POSIX
+#elif defined(_WIN32)
+# define KLISP_PLATFORM_WIN32
+#endif
+
+/* Include platform-dependent versions. The platform-dependent
+ * code #defines macro HAVE_PLATFORM_<functionality>, if it
+ * actually implements <functionality>.
+ */
+
+#if defined(KLISP_PLATFORM_POSIX)
+# include "ksystem.posix.c"
+#elif defined(KLISP_PLATFORM_WIN32)
+# include "ksystem.win32.c"
+#endif
+
+/* Fall back to platform-independent versions if necessaty. */
+
+#ifndef HAVE_PLATFORM_JIFFIES
+
+#include <time.h>
+
+TValue ksystem_current_jiffy(klisp_State *K)
+{
+ /* N.B. clock() returns an approximation of processor time
+ * used by the program. We want wall clock time here. */
+
+ clock_t now = clock();
+ if (now == -1) {
+ klispE_throw_simple(K, "couldn't get time");
+ return KFALSE;
+ } else {
+ if (now > INT32_MAX) {
+ klispE_throw_simple(K, "integer too big");
+ return KFALSE;
+ } else {
+ return i2tv((int32_t) now);
+ }
+ }
+}
+
+TValue ksystem_jiffies_per_second(klisp_State *K)
+{
+ if (CLOCKS_PER_SEC > INT32_MAX) {
+ /* XXX/TODO create bigint */
+ klispE_throw_simple(K, "integer too big");
+ return KFALSE;
+ } else {
+ return i2tv((int32_t) CLOCKS_PER_SEC);
+ }
+}
+
+#endif
+\ No newline at end of file
diff --git a/src/ksystem.h b/src/ksystem.h
@@ -0,0 +1,16 @@
+/*
+** ksystem.h
+** Platform dependent functionality.
+** See Copyright Notice in klisp.h
+*/
+
+#ifndef ksystem_h
+#define ksystem_h
+
+#include "kobject.h"
+
+TValue ksystem_current_jiffy(klisp_State *K);
+TValue ksystem_jiffies_per_second(klisp_State *K);
+
+#endif
+
diff --git a/src/ksystem.posix.c b/src/ksystem.posix.c
@@ -0,0 +1,42 @@
+/*
+** ksystem.posix.c
+** Platform dependent functionality - version for POSIX systems.
+** See Copyright Notice in klisp.h
+*/
+
+#include <sys/time.h>
+#include "kobject.h"
+#include "kstate.h"
+#include "kinteger.h"
+#include "ksystem.h"
+
+/* declare implemented functionality */
+
+#define HAVE_PLATFORM_JIFFIES
+
+/* jiffies */
+
+TValue ksystem_current_jiffy(klisp_State *K)
+{
+ /* TEMP: use gettimeofday(). clock_gettime(CLOCK_MONOTONIC,...)
+ * might be more apropriate, but it is reportedly not
+ * supported on MacOS X. */
+
+ struct timeval tv;
+ gettimeofday(&tv, NULL);
+
+ TValue res = kbigint_make_simple(K);
+ krooted_vars_push(K, &res);
+ mp_int_set_value(K, tv2bigint(res), tv.tv_sec);
+ mp_int_mul_value(K, tv2bigint(res), 1000000, tv2bigint(res));
+ mp_int_add_value(K, tv2bigint(res), tv.tv_usec, tv2bigint(res));
+ krooted_vars_pop(K);
+
+ return res;
+}
+
+TValue ksystem_jiffies_per_second(klisp_State *K)
+{
+ UNUSED(K);
+ return i2tv(1000000);
+}
diff --git a/src/ksystem.win32.c b/src/ksystem.win32.c
@@ -0,0 +1,31 @@
+/*
+** ksystem.win32.c
+** Platform dependent functionality - version for Windows.
+** See Copyright Notice in klisp.h
+*/
+
+#include <windows.h>
+#include "kobject.h"
+#include "kstate.h"
+#include "kinteger.h"
+#include "ksystem.h"
+
+/* declare implemented functionality */
+
+#define HAVE_PLATFORM_JIFFIES
+
+/* jiffies */
+
+TValue ksystem_current_jiffy(klisp_State *K)
+{
+ LARGE_INTEGER li;
+ QueryPerformanceCounter(&li);
+ return kinteger_new_uint64(K, li.QuadPart);
+}
+
+TValue ksystem_jiffies_per_second(klisp_State *K)
+{
+ LARGE_INTEGER li;
+ QueryPerformanceFrequency(&li);
+ return kinteger_new_uint64(K, li.QuadPart);
+}
diff --git a/src/ktable.c b/src/ktable.c
@@ -73,7 +73,7 @@ static const Node dummynode_ = {
/*
** hash for klisp numbers
*/
-inline static Node *hashfixint (const Table *t, int32_t n) {
+inline /*static*/ Node *hashfixint (const Table *t, int32_t n) {
return hashmod(t, (uint32_t) n);
}
diff --git a/src/tests/system.k b/src/tests/system.k
@@ -0,0 +1,27 @@
+;; check.k & test-helpers.k should be loaded
+;;
+;; Tests of system features.
+;;
+
+;; (R7RS 3rd draft, section 6.7.4) current-second
+
+($check-predicate (applicative? current-second))
+($check-predicate (number? (current-second)))
+
+;; TODO: Update before the year 2031....
+
+($let ((T-2011-01-01 1293836400) (T-2031-01-01 1924988400))
+ ($check-predicate (<? T-2011-01-01 (current-second)))
+ ($check-predicate (>? T-2031-01-01 (current-second))))
+
+;; (R7RS 3rd draft, section 6.7.4) current-jiffy jiffies-per-second
+
+($check-predicate (applicative? current-jiffy jiffies-per-second))
+($check-predicate (exact-integer? (current-jiffy) (jiffies-per-second)))
+($check-predicate (positive? (current-jiffy) (jiffies-per-second)))
+
+($let* ((jiffy1 (current-jiffy)) (jiffy2 (current-jiffy)))
+ ($check-predicate (<=? jiffy1 jiffy2)))
+
+($let* ((jps1 (jiffies-per-second)) (jps2 (jiffies-per-second)))
+ ($check-predicate (=? jps1 jps2)))
diff --git a/src/tests/test-all.k b/src/tests/test-all.k
@@ -25,5 +25,6 @@
(load "tests/error.k")
(load "tests/bytevectors.k")
(load "tests/vectors.k")
+(load "tests/system.k")
(check-report)
