diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h index b91e7e1f3..83299b8d7 100644 --- a/src/c/symbols_list.h +++ b/src/c/symbols_list.h @@ -445,7 +445,7 @@ cl_symbols[] = { {"GET-OUTPUT-STREAM-STRING", CL_ORDINARY, cl_get_output_stream_string, 1, OBJNULL}, {"GET-PROPERTIES", CL_ORDINARY, cl_get_properties, 2, OBJNULL}, {"GET-SETF-EXPANSION", CL_ORDINARY, NULL, -1, OBJNULL}, -{"GET-UNIVERSAL-TIME", CL_ORDINARY, cl_get_universal_time, 0, OBJNULL}, +{"GET-UNIVERSAL-TIME", CL_ORDINARY, ECL_NAME(cl_get_universal_time), -1, OBJNULL}, {"GETF", CL_ORDINARY, cl_getf, -1, OBJNULL}, {"GETHASH", CL_ORDINARY, cl_gethash, -1, OBJNULL}, {"GO", CL_FORM, NULL, -1, OBJNULL}, @@ -1081,7 +1081,6 @@ cl_symbols[] = { {SYS_ "COMPILED-FUNCTION-BLOCK", SI_ORDINARY, si_compiled_function_block, 1, OBJNULL}, {SYS_ "COMPILED-FUNCTION-NAME", SI_ORDINARY, si_compiled_function_name, 1, OBJNULL}, {SYS_ "COPY-STREAM", SI_ORDINARY, si_copy_stream, 1, OBJNULL}, -{SYS_ "DAYLIGHT-SAVING-TIME-P", SI_ORDINARY, si_daylight_saving_time_p, -1, OBJNULL}, {SYS_ "DO-READ-SEQUENCE", SI_ORDINARY, si_do_read_sequence, 4, OBJNULL}, {SYS_ "DO-WRITE-SEQUENCE", SI_ORDINARY, si_do_write_sequence, 4, OBJNULL}, {SYS_ "ELT-SET", SI_ORDINARY, si_elt_set, 3, OBJNULL}, @@ -1106,7 +1105,6 @@ cl_symbols[] = { #if defined(_MSC_VER) || defined(mingw32) {SYS_ "GET-LIBRARY-PATHNAME", SI_ORDINARY, si_get_library_pathname, 0, OBJNULL}, #endif -{SYS_ "GET-LOCAL-TIME-ZONE", SI_ORDINARY, si_get_local_time_zone, 0, OBJNULL}, {SYS_ "GET-SYSPROP", SI_ORDINARY, si_get_sysprop, 2, OBJNULL}, {SYS_ "GET-STRING-INPUT-STREAM-INDEX", SI_ORDINARY, si_get_string_input_stream_index, 1, OBJNULL}, {SYS_ "GETENV", SI_ORDINARY, si_getenv, 1, OBJNULL}, diff --git a/src/c/symbols_list2.h b/src/c/symbols_list2.h index db56b2a0e..8940f8da5 100644 --- a/src/c/symbols_list2.h +++ b/src/c/symbols_list2.h @@ -445,7 +445,7 @@ cl_symbols[] = { {"GET-OUTPUT-STREAM-STRING","cl_get_output_stream_string"}, {"GET-PROPERTIES","cl_get_properties"}, {"GET-SETF-EXPANSION",NULL}, -{"GET-UNIVERSAL-TIME","cl_get_universal_time"}, +{"GET-UNIVERSAL-TIME","ECL_NAME(cl_get_universal_time)"}, {"GETF","cl_getf"}, {"GETHASH","cl_gethash"}, {"GO",NULL}, @@ -1081,7 +1081,6 @@ cl_symbols[] = { {SYS_ "COMPILED-FUNCTION-BLOCK","si_compiled_function_block"}, {SYS_ "COMPILED-FUNCTION-NAME","si_compiled_function_name"}, {SYS_ "COPY-STREAM","si_copy_stream"}, -{SYS_ "DAYLIGHT-SAVING-TIME-P","si_daylight_saving_time_p"}, {SYS_ "DO-READ-SEQUENCE","si_do_read_sequence"}, {SYS_ "DO-WRITE-SEQUENCE","si_do_write_sequence"}, {SYS_ "ELT-SET","si_elt_set"}, @@ -1106,7 +1105,6 @@ cl_symbols[] = { #if defined(_MSC_VER) || defined(mingw32) {SYS_ "GET-LIBRARY-PATHNAME","si_get_library_pathname"}, #endif -{SYS_ "GET-LOCAL-TIME-ZONE","si_get_local_time_zone"}, {SYS_ "GET-SYSPROP","si_get_sysprop"}, {SYS_ "GET-STRING-INPUT-STREAM-INDEX","si_get_string_input_stream_index"}, {SYS_ "GETENV","si_getenv"}, diff --git a/src/c/time.d b/src/c/time.d index e952e15b5..843f3f4c5 100644 --- a/src/c/time.d +++ b/src/c/time.d @@ -57,18 +57,6 @@ ecl_runtime(void) #endif } -cl_object -UTC_time_to_universal_time(cl_fixnum i) -{ - return number_plus(bignum1(i), cl_core.Jan1st1970UT); -} - -cl_object -cl_get_universal_time() -{ - @(return UTC_time_to_universal_time(time(0))) -} - cl_object cl_sleep(cl_object z) { @@ -116,50 +104,6 @@ cl_get_internal_real_time() @(return MAKE_FIXNUM((time(0) - beginning)*HZ)) } -/* - * Return the hours west of Greenwich for the current timezone. - * - * Based on Lott's get_timezone() function from CMU Common Lisp. - */ -cl_object -si_get_local_time_zone() -{ - struct tm ltm, gtm; - int mw; - time_t when = 0L; - - ltm = *localtime(&when); - gtm = *gmtime(&when); - - mw = (gtm.tm_min + 60 * gtm.tm_hour) - (ltm.tm_min + 60 * ltm.tm_hour); - - if ((gtm.tm_wday + 1) % 7 == ltm.tm_wday) - mw -= 24*60; - else if (gtm.tm_wday == (ltm.tm_wday + 1) % 7) - mw += 24*60; - - @(return make_ratio(MAKE_FIXNUM(mw), MAKE_FIXNUM(60))) -} - -/* - * Return T if daylight saving is in effect at Universal Time UT, which - * defaults to current time. - * - */ -@(defun si::daylight-saving-time-p (&optional UT) - struct tm *ltm; - time_t when; -@ - if (narg == 0) { - when = time(0); - } else { /* narg == 1 */ - cl_object UTC = number_minus(UT, cl_core.Jan1st1970UT); - when = object_to_fixnum(UTC); - } - ltm = localtime(&when); - @(return (ltm->tm_isdst ? Ct : Cnil)) -@) - void init_unixtime(void) { diff --git a/src/c/unixfsys.d b/src/c/unixfsys.d index fbf7b5cef..bc4021fa7 100644 --- a/src/c/unixfsys.d +++ b/src/c/unixfsys.d @@ -30,6 +30,7 @@ #include #include "ecl.h" #include "ecl-inl.h" +#include "internal.h" #ifdef HAVE_DIRENT_H # include #else diff --git a/src/cmp/sysfun.lsp b/src/cmp/sysfun.lsp index 12dcd6b96..e5565848f 100644 --- a/src/cmp/sysfun.lsp +++ b/src/cmp/sysfun.lsp @@ -1222,11 +1222,10 @@ type_of(#0)==t_bitvector") ;; file unixtime.d -(proclaim-function si:daylight-saving-time-p (*) t :predicate t) -(proclaim-function get-universal-time (*) t) -(proclaim-function get-internal-run-time (*) t) -(proclaim-function get-internal-real-time (*) t) -(proclaim-function si:get-local-time-zone (*) t) +(proclaim-function get-universal-time () t) +(proclaim-function get-decoded-time () *) +(proclaim-function get-internal-run-time () t) +(proclaim-function get-internal-real-time () t) (proclaim-function sleep (real) t) ;; file typeof.d @@ -1330,7 +1329,7 @@ type_of(#0)==t_bitvector") nsubst-if nsubst-if-not ;; mislib.lsp logical-pathname-translations load-logical-pathname-translations decode-universal-time - encode-universal-time get-decoded-time + encode-universal-time get-decoded-time get-universal-time ensure-directories-exist si::simple-program-error ;; module.lsp provide require diff --git a/src/configure b/src/configure index 0466ff756..c39205ddb 100755 --- a/src/configure +++ b/src/configure @@ -9578,8 +9578,9 @@ done + for ac_func in nanosleep alarm times isnanf select setenv putenv \ - lstat mkstemp sigprocmask isatty feenableexcept + lstat mkstemp sigprocmask isatty feenableexcept tzset do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` echo "$as_me:$LINENO: checking for $ac_func" >&5 diff --git a/src/configure.in b/src/configure.in index d566195cf..cc20d655d 100644 --- a/src/configure.in +++ b/src/configure.in @@ -370,7 +370,7 @@ AC_CHECK_FUNCS( [floor getcwd gethostbyaddr gethostbyname getpagesize] \ dnl !!! end autoscan AC_CHECK_FUNCS( [nanosleep alarm times isnanf select setenv putenv] \ - [lstat mkstemp sigprocmask isatty feenableexcept] ) + [lstat mkstemp sigprocmask isatty feenableexcept tzset] ) dnl ===================================================================== dnl Checks for system services diff --git a/src/doc/help.lsp b/src/doc/help.lsp index f3c181d94..d86aaf320 100644 --- a/src/doc/help.lsp +++ b/src/doc/help.lsp @@ -1042,11 +1042,6 @@ Returns the number of elements in SEQUENCE satisfying TEST.") (start 0) (end (length sequence)) (from-end nil)) " Returns the number of elements in SEQUENCE not satisfying TEST.") -(docfun si::daylight-saving-time-p function (&optional UT) " -ECL specific. -Returns T if Daylight Saving Time applies to the local time zone at -Universal Time UT, which defaults to the current time.") - (docfun declare special "(declare {decl-spec}*)" " Gives declarations. Possible DECL-SPECs are: (SPECIAL {var}*) @@ -1586,10 +1581,6 @@ Returns the time (in 1/100 seconds) since the invocation of ECL.") (docfun get-internal-run-time function () " Returns the CPU time (in 1/100 seconds) since the invocation of ECL.") -(docfun si::get-local-time-zone function () " -ECL specific. -Returns the number of hours West of Greenwich for the local time zone.") - (docfun get-macro-character function (char &optional (readtable *readtable*)) " Returns the read macro associated with the macro character CHAR in READTABLE. Returns the non-terminating-p flag (see READTABLE) as the second value. diff --git a/src/h/config.h.in b/src/h/config.h.in index 0f4d81e0b..896632679 100644 --- a/src/h/config.h.in +++ b/src/h/config.h.in @@ -207,6 +207,8 @@ typedef unsigned @CL_FIXNUM_TYPE@ cl_hashkey; #undef HAVE_FENV_H /* can activate individual traps in floating point environment */ #undef HAVE_FEENABLEEXCEPT +/* the tzset() function gets the current time zone */ +#undef HAVE_TZSET /* what characters are used to mark beginning of new line */ #undef ECL_NEWLINE_IS_CRLF diff --git a/src/h/external.h b/src/h/external.h index 9c402aacc..b26bfbd71 100644 --- a/src/h/external.h +++ b/src/h/external.h @@ -1378,14 +1378,9 @@ extern void ecl_release_current_thread(void); /* time.c */ -extern cl_object cl_get_universal_time(void); extern cl_object cl_sleep(cl_object z); extern cl_object cl_get_internal_run_time(void); extern cl_object cl_get_internal_real_time(void); -extern cl_object si_get_local_time_zone(void); -extern cl_object si_daylight_saving_time_p _ARGS((cl_narg narg, ...)); - -extern cl_object UTC_time_to_universal_time(cl_fixnum i); /* typespec.c */ @@ -1526,6 +1521,7 @@ extern cl_object cl_logical_pathname_translations _ARGS((cl_narg narg, cl_object extern cl_object cl_load_logical_pathname_translations _ARGS((cl_narg, cl_object V1, ...)); extern cl_object cl_decode_universal_time _ARGS((cl_narg narg, cl_object V1, ...)); extern cl_object cl_encode_universal_time _ARGS((cl_narg narg, cl_object V1, cl_object V2, cl_object V3, cl_object V4, cl_object V5, cl_object V6, ...)); +extern cl_object cl_get_universal_time _ARGS((cl_narg narg, ...)); extern cl_object cl_get_decoded_time _ARGS((cl_narg narg, ...)); extern cl_object cl_ensure_directories_exist _ARGS((cl_narg narg, cl_object V1, ...)); extern cl_object si_simple_program_error _ARGS((cl_narg narg, cl_object format, ...)) /*__attribute__((noreturn))*/; diff --git a/src/h/internal.h b/src/h/internal.h index 42463fea1..8e2d7d601 100644 --- a/src/h/internal.h +++ b/src/h/internal.h @@ -211,6 +211,7 @@ extern void cl_write_object(cl_object x, cl_object stream); /* time.d */ +#define UTC_time_to_universal_time(x) number_plus(make_integer(x),cl_core.Jan1st1970UT) extern cl_fixnum ecl_runtime(void); /* unixint.d */ diff --git a/src/lsp/mislib.lsp b/src/lsp/mislib.lsp index 62e82870a..71033584b 100644 --- a/src/lsp/mislib.lsp +++ b/src/lsp/mislib.lsp @@ -79,6 +79,39 @@ Evaluates FORM, outputs the realtime and runtime used for the evaluation to (defconstant month-startdays #(0 31 59 90 120 151 181 212 243 273 304 334 365)) +#-ecl-min +(ffi:clines " +#include +") + +#-ecl-min +(defun get-local-time-zone () + "Returns the number of hours West of Greenwich for the local time zone." + (declare (si::c-local)) + (ffi::c-inline () () :object " +{ + cl_fixnum mw; +#ifdef HAVE_TZSET + tzset(); + mw = timezone/60; +#else + struct tm ltm, gtm; + time_t when = 0L; + + ltm = *localtime(&when); + gtm = *gmtime(&when); + + mw = (gtm.tm_min + 60 * gtm.tm_hour) - (ltm.tm_min + 60 * ltm.tm_hour); + + if ((gtm.tm_wday + 1) % 7 == ltm.tm_wday) + mw -= 24*60; + else if (gtm.tm_wday == (ltm.tm_wday + 1) % 7) + mw += 24*60; +#endif + @(return) = make_ratio(MAKE_FIXNUM(mw),MAKE_FIXNUM(60)); +}" + :one-liner nil)) + (defun recode-universal-time (sec min hour day month year tz dst) (declare (si::c-local)) (let ((days (+ (if (and (leap-year-p year) (> month 2)) 1 0) @@ -87,14 +120,24 @@ Evaluates FORM, outputs the realtime and runtime used for the evaluation to (number-of-days-from-1900 year)))) (+ sec (* 60 (+ min (* 60 (+ tz dst hour (* 24 days)))))))) -(defun safe-daylight-saving-time-p (sec min hour day month year tz dst) +(defun daylight-saving-time-p (sec min hour day month year tz dst) + "Returns T if Daylight Saving Time applies to the local time zone at +Universal Time UT, which defaults to the current time." (declare (si::c-local)) (cond ((< 2004 year) (setf year 2004)) ((< year 1970) (setf year 1970))) - (si::daylight-saving-time-p - (recode-universal-time sec min hour day month year tz dst))) + #-ecl-min + (ffi::c-inline ((recode-universal-time sec min hour day month year tz dst)) + (:object) :bool " +{ + cl_object UTC = number_minus(#0, cl_core.Jan1st1970UT); + time_t when = object_to_fixnum(UTC); + struct tm *ltm = localtime(&when); + @(return) = ltm->tm_isdst; +}" + :one-liner nil)) (defun decode-universal-time (orig-ut &optional (tz nil tz-p) &aux (dstp nil)) "Args: (integer &optional (timezone (si::get-local-time-zone))) @@ -122,7 +165,7 @@ DECODED-TIME." (setq month (position day month-startdays :test #'<=) day (- day (svref month-startdays (1- month))))) (if (and (not tz-p) - (safe-daylight-saving-time-p sec min hour day month year tz -1)) + (daylight-saving-time-p sec min hour day month year tz -1)) (setf tz-p t dstp t) (return (values sec min hour day month year dow dstp tz)))))) @@ -140,7 +183,7 @@ GET-DECODED-TIME." (let ((dst 0)) (unless tz (setq tz (rational (get-local-time-zone))) - (when (safe-daylight-saving-time-p sec min hour day month year tz -1) + (when (daylight-saving-time-p sec min hour day month year tz -1) ;; assume DST applies, and check if at corresponging UT it applies. ;; There is an ambiguity between midnight and 1 o'clock on the day ;; when time reverts from DST to solar: @@ -149,6 +192,15 @@ GET-DECODED-TIME." (setf dst -1))) (recode-universal-time sec min hour day month year tz dst))) +(defun get-universal-time () + #-ecl-min + (ffi:c-inline () () :object " +{ + cl_object utc = make_integer(time(0)); + @(return) = number_plus(utc, cl_core.Jan1st1970UT); +}" + :one-liner nil)) + (defun get-decoded-time () "Args: () Returns the current day-and-time as nine values: