From 1928aa26ceab8601049565a9064d68ff76dc25c3 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Sun, 8 Apr 2012 19:23:58 -0700 Subject: * arith.c (bignum): Previously static function now exposed as external. * arith.h (bignum): Declared. * configure: Added check for tm_gmtoff and tm_tmzone fields being present in struct tm. * eval.c (eval_init): New intrinsic functions: time, time-usec. * lib.c (num): If the cnum is outside of the fixnum range, then construct a bignum. (time_sec, time_sec_usec): New functions. * lib.h (mut): Slight change to macro to eliminate compiler warning. (time_sec, time_sec_usec): Declared. * txr.1: Stub section for time and time-usec. * txr.vim: Highlighting for time and time-usec. --- ChangeLog | 22 ++++++++++++++++++++++ arith.c | 2 +- arith.h | 1 + configure | 37 +++++++++++++++++++++++++++++++++++++ eval.c | 3 +++ lib.c | 22 ++++++++++++++++++++-- lib.h | 4 +++- txr.1 | 2 ++ txr.vim | 1 + 9 files changed, 90 insertions(+), 4 deletions(-) diff --git a/ChangeLog b/ChangeLog index dd5d4994..b0dd92ec 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,25 @@ +2012-04-08 Kaz Kylheku + + * arith.c (bignum): Previously static function now exposed as external. + + * arith.h (bignum): Declared. + + * configure: Added check for tm_gmtoff and tm_tmzone fields + being present in struct tm. + + * eval.c (eval_init): New intrinsic functions: time, time-usec. + + * lib.c (num): If the cnum is outside of the fixnum range, then + construct a bignum. + (time_sec, time_sec_usec): New functions. + + * lib.h (mut): Slight change to macro to eliminate compiler warning. + (time_sec, time_sec_usec): Declared. + + * txr.1: Stub section for time and time-usec. + + * txr.vim: Highlighting for time and time-usec. + 2012-04-08 Kaz Kylheku * txr.vim: Fixed accidental breakage. diff --git a/arith.c b/arith.c index 30ba88c2..f06e77b6 100644 --- a/arith.c +++ b/arith.c @@ -61,7 +61,7 @@ val make_bignum(void) return n; } -static val bignum(cnum cn) +val bignum(cnum cn) { val n = make_bignum(); mp_set_intptr(mp(n), cn); diff --git a/arith.h b/arith.h index 48d0eefd..91e197e0 100644 --- a/arith.h +++ b/arith.h @@ -25,6 +25,7 @@ */ val make_bignum(void); +val bignum(cnum cn); int highest_bit(int_ptr_t n); val normalize(val bignum); void arith_init(void); diff --git a/configure b/configure index 46667045..b91551b2 100755 --- a/configure +++ b/configure @@ -1108,6 +1108,43 @@ done printf "done\n" +# +# Check for fields inside struct tm +# + +printf "Printf detecting timezone fields in struct tm ..." + +tm_gmtoff= +tm_tmzone= + +for try_field in tm_gmtoff __tm_gmtoff ; do + cat > conftest.c < +int x = sizeof ((struct tm *) 0)->$try_field; +! + rm -f conftest.o + if make conftest.o > conftest.err 2>&1 ; then + printf "#define HAVE_TM_GMTOFF 1\n" >> config.h + printf "#define TM_GMTOFF %s\n" $try_field >> config.h + break + fi +done + +for try_field in tm_zone __tm_zone ; do + cat > conftest.c < +int x = sizeof ((struct tm *) 0)->$try_field; +! + rm -f conftest.o + if make conftest.o > conftest.err 2>&1 ; then + printf "#define HAVE_TM_ZONE 1\n" >> config.h + printf "#define TM_ZONE %s\n" $try_field >> config.h + break + fi +done + +printf "done\n" + # # Extra debugging. # diff --git a/eval.c b/eval.c index a97aa819..c683a0b3 100644 --- a/eval.c +++ b/eval.c @@ -2405,6 +2405,9 @@ void eval_init(void) reg_fun(intern(lit("url-encode"), user_package), func_n2o(url_encode, 1)); reg_fun(intern(lit("url-decode"), user_package), func_n2o(url_decode, 1)); + reg_fun(intern(lit("time"), user_package), func_n0(time_sec)); + reg_fun(intern(lit("time-usec"), user_package), func_n0(time_sec_usec)); + eval_error_s = intern(lit("eval-error"), user_package); uw_register_subtype(eval_error_s, error_s); } diff --git a/lib.c b/lib.c index 51c584b0..3b116464 100644 --- a/lib.c +++ b/lib.c @@ -36,6 +36,7 @@ #include #include #include +#include #include "config.h" #ifdef HAVE_GETENVIRONMENTSTRINGS #define NOMINMAX @@ -1143,8 +1144,9 @@ val improper_plist_to_alist(val list, val boolean_keys) val num(cnum n) { - numeric_assert (n >= NUM_MIN && n <= NUM_MAX); - return (val) ((n << TAG_SHIFT) | TAG_NUM); + if (n >= NUM_MIN && n <= NUM_MAX) + return (val) ((n << TAG_SHIFT) | TAG_NUM); + return bignum(n); } cnum c_num(val num) @@ -4467,6 +4469,22 @@ val tostringp(val obj) return get_string_from_stream(ss); } +val time_sec(void) +{ + struct timeval tv; + if (gettimeofday(&tv, 0) == -1) + return nil; + return num(tv.tv_sec); +} + +val time_sec_usec(void) +{ + struct timeval tv; + if (gettimeofday(&tv, 0) == -1) + return nil; + return cons(num(tv.tv_sec), num(tv.tv_usec)); +} + void init(const wchar_t *pn, mem_t *(*oom)(mem_t *, size_t), val *stack_bottom) { diff --git a/lib.h b/lib.h index 672f2fcf..18530770 100644 --- a/lib.h +++ b/lib.h @@ -235,7 +235,7 @@ val gc_set(val *, val); #define mpush(val, place) (gc_push(val, &(place))) #else #define set(place, val) ((place) = (val)) -#define mut(obj) (obj) +#define mut(obj) ((void) (obj)) #define mpush(val, place) (push(val, &(place))) #endif @@ -640,6 +640,8 @@ val obj_print(val obj, val stream); val obj_pprint(val obj, val stream); val tostring(val obj); val tostringp(val obj); +val time_sec(void); +val time_sec_usec(void); void init(const wchar_t *progname, mem_t *(*oom_realloc)(mem_t *, size_t), val *stack_bottom); diff --git a/txr.1 b/txr.1 index 09db9309..6fb80aa2 100644 --- a/txr.1 +++ b/txr.1 @@ -7520,6 +7520,8 @@ Examples: .SS Functions url-encode and url-decode +.SS Functions time and time-usec + .SH DEBUGGER .B TXR diff --git a/txr.vim b/txr.vim index 2e3f4f8f..dff02491 100644 --- a/txr.vim +++ b/txr.vim @@ -92,6 +92,7 @@ syn keyword txl_keyword contained random-fixnum random rand syn keyword txl_keyword contained range range* generate repeat force syn keyword txl_keyword contained throw throwf error match-fun url-encode url-decode +syn keyword txl_keyword contained time time-usec syn match txr_error "@[\t ]*[*]\?[\t ]*." syn match txr_nested_error "[^\t `]\+" contained -- cgit v1.2.3