Implement support for time-zone information in decoded-time data

type.  Generalize the procedure FILE-TIME->STRING so that it generates
an RFC-822 time string (when time-zone information is available from
the microcode).

diff --git a/v7/src/runtime/datime.scm b/v7/src/runtime/datime.scm
index ee6d9afdc6f783b73fd3f51f93347266e7dd38de..302ae711e04ee54ca08d78db437cca7319ae035e 100644 (file)
--- a/v7/src/runtime/datime.scm
+++ b/v7/src/runtime/datime.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: datime.scm,v 14.12 1995/04/23 05:58:14 cph Exp $
+$Id: datime.scm,v 14.13 1996/04/24 03:22:03 cph Exp $
 
-Copyright (c) 1988-95 Massachusetts Institute of Technology
+Copyright (c) 1988-96 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -57,7 +57,8 @@ MIT in each case. |#
   (month #f read-only #t)
   (year #f read-only #t)
   (day-of-week #f read-only #t)
-  (daylight-savings-time #f read-only #t))
+  (daylight-savings-time #f read-only #t)
+  (zone #f))
 
 (define (make-decoded-time second minute hour day month year)
   (let ((dt
@@ -74,14 +75,19 @@ MIT in each case. |#
                                 month
                                 (if (< year 0) 0 year)
                                 0
-                                -1)))))
+                                -1
+                                #f)))))
     ;; These calls fill in the other fields of the structure.
     ((ucode-primitive decode-time 2) dt ((ucode-primitive encode-time 1) dt))
+    (if (decoded-time/zone dt)
+       (set-decoded-time/zone! dt (/ (decoded-time/zone dt) 3600)))
     dt))
 
 (define (decode-universal-time time)
   (let ((result (allocate-decoded-time)))
     ((ucode-primitive decode-time 2) result time)
+    (if (decoded-time/zone result)
+       (set-decoded-time/zone! result (/ (decoded-time/zone result) 3600)))
     result))
 
 (define (encode-universal-time dt)
@@ -126,6 +132,41 @@ MIT in each case. |#
                   " "
                   (if (< hour 12) "AM" "PM"))))
 
+(define (universal-time->string time)
+  (decoded-time->string (decode-universal-time time)))
+
+(define (file-time->string time)
+  (decoded-time->string (decode-file-time time)))
+
+(define (decoded-time->string dt)
+  ;; The returned string is in the format specified by RFC 822,
+  ;; "Standard for the Format of ARPA Internet Text Messages",
+  ;; provided that time-zone information is available from the C
+  ;; library.
+  (let ((d2 (lambda (n) (string-pad-left (number->string n) 2 #\0))))
+    (string-append (day-of-week/short-string (decoded-time/day-of-week dt))
+                  ", "
+                  (number->string (decoded-time/day dt))
+                  " "
+                  (month/short-string (decoded-time/month dt))
+                  " "
+                  (number->string (decoded-time/year dt))
+                  " "
+                  (d2 (decoded-time/hour dt))
+                  ":"
+                  (d2 (decoded-time/minute dt))
+                  ":"
+                  (d2 (decoded-time/second dt))
+                  (let ((zone (decoded-time/zone dt)))
+                    (if zone
+                        (string-append
+                         " "
+                         (time-zone->string
+                          (if (decoded-time/daylight-savings-time? dt)
+                              (- zone 1)
+                              zone)))
+                        "")))))
+\f
 (define (time-zone->string tz)
   (if (not (time-zone? tz))
       (error:wrong-type-argument tz "time zone" 'TIME-ZONE->STRING))

diff --git a/v7/src/runtime/dosprm.scm b/v7/src/runtime/dosprm.scm
index 795a857152f360fc6598dcb49e8752f95a85bf1b..607b301139a283b918b9285cd9d7eafd285c605b 100644 (file)
--- a/v7/src/runtime/dosprm.scm
+++ b/v7/src/runtime/dosprm.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: dosprm.scm,v 1.36 1995/11/10 23:48:18 cph Exp $
+$Id: dosprm.scm,v 1.37 1996/04/24 03:21:49 cph Exp $
 
 Copyright (c) 1992-95 Massachusetts Institute of Technology
 
@@ -257,10 +257,6 @@ MIT in each case. |#
                    user-name)))))
       (merge-pathnames "\\")))
 
-(define (file-time->string time)
-  (or ((ucode-primitive file-time->string 1) time)
-      "Thu Jan  1 00:00:00 1970"))
-
 (define (decode-file-time time) (decode-universal-time time))
 (define (encode-file-time dt) (encode-universal-time dt))
 (define (file-time->universal-time time) time)
@@ -269,7 +265,6 @@ MIT in each case. |#
 (define dos/user-home-directory user-home-directory)
 (define dos/current-user-name current-user-name)
 (define dos/current-home-directory current-home-directory)
-(define dos/file-time->string file-time->string)
 
 (define (file-touch filename)
   ((ucode-primitive file-touch 1)

diff --git a/v7/src/runtime/ntprm.scm b/v7/src/runtime/ntprm.scm
index 9d6a29ca717119ae0ca141168baece298370a8f1..e5f5eb596da5f0e64aa12f13ab97e0b488ebc935 100644 (file)
--- a/v7/src/runtime/ntprm.scm
+++ b/v7/src/runtime/ntprm.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: ntprm.scm,v 1.4 1996/04/09 20:13:30 adams Exp $
+$Id: ntprm.scm,v 1.5 1996/04/24 03:21:37 cph Exp $
 
 Copyright (c) 1992-96 Massachusetts Institute of Technology
 
@@ -274,10 +274,6 @@ MIT in each case. |#
         (pathname-as-directory
          (merge-pathnames (or homepath home) homedrive)))))
 
-(define (file-time->string time)
-  (or ((ucode-primitive file-time->string 1) time)
-      "Thu Jan  1 00:00:00 1970"))
-
 (define (decode-file-time time) (decode-universal-time time))
 (define (encode-file-time dt) (encode-universal-time dt))
 (define (file-time->universal-time time) time)
@@ -286,7 +282,6 @@ MIT in each case. |#
 (define dos/user-home-directory user-home-directory)
 (define dos/current-user-name current-user-name)
 (define dos/current-home-directory current-home-directory)
-(define dos/file-time->string file-time->string)
 
 (define (file-touch filename)
   ((ucode-primitive file-touch 1)

diff --git a/v7/src/runtime/os2prm.scm b/v7/src/runtime/os2prm.scm
index d29e09982451b23550fd9b4afa684de0d5e94a49..b0d0e119ab20da4f61b4448f781a22250f23354b 100644 (file)
--- a/v7/src/runtime/os2prm.scm
+++ b/v7/src/runtime/os2prm.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: os2prm.scm,v 1.25 1996/04/24 03:21:30 cph Exp $
+$Id: os2prm.scm,v 1.26 1996/04/24 03:25:32 cph Exp $
 
 Copyright (c) 1994-95 Massachusetts Institute of Technology
 
@@ -110,12 +110,6 @@ MIT in each case. |#
    access-time
    modification-time))
 \f
-(define (local-time-zone)
-  (/ ((ucode-primitive os2-time-zone 0)) 3600))
-
-(define os2/daylight-savings-time?
-  (ucode-primitive os2-daylight-savings-time? 0))
-
 (define (decode-file-time time)
   (let* ((twosecs (remainder time 32)) (time (quotient time 32))
         (minutes (remainder time 64)) (time (quotient time 64))

diff --git a/v7/src/runtime/unxprm.scm b/v7/src/runtime/unxprm.scm
index 21748c9cbd67037e2bf2b1dbf2a7baae47c03f44..b92bf7f133a2b9f600e933ae6981f379c4b4fef6 100644 (file)
--- a/v7/src/runtime/unxprm.scm
+++ b/v7/src/runtime/unxprm.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: unxprm.scm,v 1.41 1995/10/28 01:16:00 cph Exp $
+$Id: unxprm.scm,v 1.42 1996/04/24 03:27:06 cph Exp $
 
 Copyright (c) 1988-95 Massachusetts Institute of Technology
 
@@ -230,9 +230,6 @@ MIT in each case. |#
 (define-integrable current-user-name
   (ucode-primitive current-user-name 0))
 
-(define-integrable file-time->string
-  (ucode-primitive file-time->string 1))
-
 (define (decode-file-time time) (decode-universal-time time))
 (define (encode-file-time dt) (encode-universal-time dt))
 (define (file-time->universal-time time) time)
@@ -241,7 +238,6 @@ MIT in each case. |#
 (define unix/user-home-directory user-home-directory)
 (define unix/current-home-directory current-home-directory)
 (define unix/current-user-name current-user-name)
-(define unix/file-time->string file-time->string)
 
 (define-integrable unix/current-uid
   (ucode-primitive current-uid 0))