<short summary of the patch>

TODO: Put a short summary on the line above and replace this paragraph
with a longer explanation of this change. Complete the meta-information
with other relevant fields (see below for details). To make it easier, the
information below has been extracted from the changelog. Adjust it or drop
it.

gcl (2.6.13-3) unstable; urgency=medium

  * Version_2_6_14pre2

Gbp-Pq: Name Version_2_6_14pre2

diff --git a/git.tag b/git.tag
index b9b4539de5dc08747a0ecdd989f744423a56407d..d56e2412c06693102469fc3383c257e700443f85 100644 (file)
--- a/git.tag
+++ b/git.tag
@@ -1,2 +1,2 @@
-"Version_2_6_14pre1"
+"Version_2_6_14pre2"
 

diff --git a/lsp/gcl_mislib.lsp b/lsp/gcl_mislib.lsp
index 70d84ef3072733a700fcf737add9efaeaa20bca1..c564c0c32cca070f15d9aee277d3ffb63ad2c0bf 100755 (executable)
--- a/lsp/gcl_mislib.lsp
+++ b/lsp/gcl_mislib.lsp
@@ -50,77 +50,33 @@
                 (/ ,gbc-time internal-time-units-per-second))))
        (values-list ,x))))
 
-(defconstant seconds-per-day #.(* 24 3600))
-
-(defun leap-year-p (y)
-  (and (zerop (mod y 4))
-       (or (not (zerop (mod y 100))) (zerop (mod y 400)))))
-
-(defun number-of-days-from-1900 (y)
-  (let ((y1 (1- y)))
-    (+ (* (- y 1900) 365)
-       (floor y1 4) (- (floor y1 100)) (floor y1 400)
-       -460)))
-
-(eval-when
- (compile eval)
- (defmacro mmd (n &optional lp 
-                 &aux (l '(31 28 31 30 31 30 31 31 30 31 30 31))
-                 (l (if lp (cons (pop l) (cons (1+ (pop l)) l)) l))(r 0)(s (mapcar (lambda (x) (incf r x)) l)))
-  `(defconstant ,n (make-array ,(length s) :element-type '(integer ,(car s) ,(car (last s))) :initial-contents ',s))))
-       
-(mmd +md+)
-(mmd +lmd+ t)
-
-(defun decode-universal-time (ut &optional (tz (let ((x (current-timezone))) (if (current-dstp) (1+ x) x)) tzp)
-                                &aux (out ut)(ut (- ut (* tz 3600))))
+
+(defun this-tz (&aux (x (current-timezone)))
+  (if (current-dstp) (1+ x) x))
+
+(defun decode-universal-time (ut &optional (tz (this-tz) tzp))
   (declare (optimize (safety 2)))
   (check-type ut integer)
   (check-type tz rational)
+  (let ((ut (+ ut (* (- (this-tz) tz) 3600) #.(* -1 (+ 17 (* 70 365)) 24 60 60))))
   (multiple-value-bind
-   (d ut) (floor ut seconds-per-day)
-   (let* ((dow (mod d 7))(y (+ 1900 (floor d 366))))
-     (labels ((l (y dd &aux (lyp (leap-year-p y))(td (if lyp 366 365))(x (- d dd)))
-               (if (< x td) (values (1+ x) y lyp) (l (1+ y) (+ dd td)))))
-            (multiple-value-bind
-             (d y lyp) (l y (number-of-days-from-1900 y))
-             (let* ((l (if lyp +lmd+ +md+))
-                    (m (position d l :test '<=))
-                    (d (if (> m 0) (- d (aref l (1- m))) d)))
-               (multiple-value-bind
-                     (h ut) (floor ut 3600)
-                 (labels ((nsdom (d dow n) (+ (mod (- d dow 1) 7) (* (1- n) 7)))
-                          (dstp (dow d m h)
-                            (cond ((> 10 m 2))
-                                  ((eql m 2) (let ((s (nsdom d dow 2))) (or (> d s) (when (= d s) (>= h 2)))))
-                                  ((eql m 10) (let ((s (nsdom d dow 1))) (or (< d s) (when (= d s) (< h 1))))))))
-                   (if (unless tzp (dstp dow d m h))
-                       (multiple-value-bind
-                             (s m h d o y w) (decode-universal-time out (1- tz))
-                         (values s m h d o y w t tz))
-                       (multiple-value-bind
-                             (min sec) (floor ut 60)
-                         (values sec min h d (1+ m) y dow nil tz)))))))))))
-
-(defun encode-universal-time (sec min h d m y &optional (tz (let ((x (current-timezone))) (if (current-dstp) (1+ x) x))))
+       (s n h d m y w yd dstp off) (localtime ut)
+    (when (when tzp (> dstp 0))
+      (multiple-value-setq (s n h d m y w yd) (localtime (- ut 3600))))
+    (values s n h d (1+ m) (+ 1900 y) (1- w) (unless tzp (> dstp 0)) (if tzp tz (+ (truncate (- off) 3600) dstp))))))
+
+(defun encode-universal-time (s n h d m y &optional (tz (this-tz) tzp))
   (declare (optimize (safety 2)))
-  (check-type sec (integer 0 59))
-  (check-type min (integer 0 59))
+  (check-type s (integer 0 59))
+  (check-type n (integer 0 59))
   (check-type h (integer 0 23))
   (check-type d (integer 1 31))
   (check-type m (integer 1 12))
   (check-type y integer)
   (check-type tz rational)
-  (when (<= 0 y 99)
-    (multiple-value-bind
-     (sec min h d m y1 dow dstp tz) (get-decoded-time)
-     (declare (ignore sec min h d m dow dstp tz))
-     (incf y (- y1 (mod y1 100)))
-     (cond ((< (- y y1) -50) (incf y 100))
-          ((>= (- y y1) 50) (decf y 100)))))
-  (+ (* (+ (1- d) (number-of-days-from-1900 y) (if (> m 1) (aref (if (leap-year-p y) +lmd+ +md+) (- m 2)) 0))
-        seconds-per-day)
-     (* (+ h tz) 3600) (* min 60) sec))
+  (multiple-value-bind
+       (tm dstp) (mktime s n h d (1- m) (- y 1900))
+    (+ tm #.(* (+ 17 (* 70 365)) 24 60 60) (* (- tz (this-tz)) 3600) (if tzp (* dstp 3600) 0))))
 
 (defun compile-file-pathname (pathname)
   (make-pathname :defaults pathname :type "o"))

diff --git a/o/unixtime.c b/o/unixtime.c
index 3be590d903958b993ab8b888714fed9081bfe4ae..e265ef2d2773d28f9747972c0f99b1bef17dabed 100755 (executable)
--- a/o/unixtime.c
+++ b/o/unixtime.c
@@ -302,3 +302,83 @@ DEFUN_NEW("CURRENT-DSTP",object,fScurrent_dstp,SI,0,0,NONE,OO,OO,OO,OO,(void),""
   return localtime(&_t)->tm_isdst > 0 ? Ct : Cnil;
 #endif
 }
+
+DEFUNM_NEW("LOCALTIME",object,fSlocaltime,SI,1,1,NONE,OI,OO,OO,OO,(fixnum t),"") {
+
+#if defined NO_SYSTEM_TIME_ZONE /*solaris*/
+  return Cnil;
+#else
+
+#if defined(__MINGW32__)
+  fixnum gmt_hour=gmtime(&t)->tm_hour;
+#endif
+  struct tm *lt=localtime(&t);
+
+  RETURN(11,object,
+        make_fixnum(lt->tm_sec),
+        (
+         RV(make_fixnum(lt->tm_min)),
+         RV(make_fixnum(lt->tm_hour)),
+         RV(make_fixnum(lt->tm_mday)),
+         RV(make_fixnum(lt->tm_mon)),
+         RV(make_fixnum(lt->tm_year)),
+         RV(make_fixnum(lt->tm_wday)),
+         RV(make_fixnum(lt->tm_yday)),
+         RV(make_fixnum(lt->tm_isdst)),
+#if defined(__MINGW32__)
+         RV(make_fixnum((lt->tm_hour-gmt_hour)*3600)),
+         RV(Cnil)
+#else
+         RV(make_fixnum(lt->tm_gmtoff)),
+         RV(make_simple_string(lt->tm_zone))
+#endif
+         ));
+#endif
+}
+
+
+DEFUNM_NEW("GMTIME",object,fSgmtime,SI,1,1,NONE,OI,OO,OO,OO,(fixnum t),"") {
+
+#if defined NO_SYSTEM_TIME_ZONE /*solaris*/
+  return Cnil;
+#else
+  struct tm *lt=gmtime(&t);
+  RETURN(11,object,
+        make_fixnum(lt->tm_sec),
+        (
+         RV(make_fixnum(lt->tm_min)),
+         RV(make_fixnum(lt->tm_hour)),
+         RV(make_fixnum(lt->tm_mday)),
+         RV(make_fixnum(lt->tm_mon)),
+         RV(make_fixnum(lt->tm_year)),
+         RV(make_fixnum(lt->tm_wday)),
+         RV(make_fixnum(lt->tm_yday)),
+         RV(make_fixnum(lt->tm_isdst)),
+#if defined(__MINGW32__)
+         RV(make_fixnum(0)),
+         RV(Cnil)
+#else
+         RV(make_fixnum(lt->tm_gmtoff)),
+         RV(make_simple_string(lt->tm_zone))
+#endif
+         ));
+#endif
+}
+
+
+DEFUNM_NEW("MKTIME",object,fSmktime,SI,6,6,NONE,OI,II,II,IO,(fixnum s,fixnum n,fixnum h,fixnum d,fixnum m,fixnum y),"") {
+
+  struct tm lt;
+
+  lt.tm_sec=s;
+  lt.tm_min=n;
+  lt.tm_hour=h;
+  lt.tm_mday=d;
+  lt.tm_mon=m;
+  lt.tm_year=y;
+  lt.tm_isdst=-1;
+
+  RETURN(2,object,make_fixnum(mktime(&lt)),(RV(make_fixnum(lt.tm_isdst))));
+
+}
+

diff --git a/unixport/sys_init.lsp.in b/unixport/sys_init.lsp.in
index ce41b9b836faba3d4d6d2db2c58bba9855f4354b..c1facecdfe6787ea624db71893c729d14bd22008 100644 (file)
--- a/unixport/sys_init.lsp.in
+++ b/unixport/sys_init.lsp.in
@@ -82,7 +82,7 @@
 #+ansi-cl (use-package :pcl :user)
 
 (import 'si::(clines defentry defcfun object void int double quit bye gbc system
-                    *lib-directory* *system-directory* while) :user)
+                    *lib-directory* *system-directory* while help) :user)
 
 (let* ((i 4096)(j (si::equal-tail-recursion-check i)))
   (unless (<= (ash i -1) j)