This change requires microcode 11.163 or later.

Rationalize naming of time-conversion procedures.  Implement
procedures to manage decoded time in UTC.  Implement procedure to
convert an RFC-822 time string to decoded-time format.

diff --git a/v7/src/runtime/datime.scm b/v7/src/runtime/datime.scm
index f267029ee9254c47f325ab6aa82a6608e080fb1a..a72e06e7406e70b1a5090ed1c4d00dedc0d96cd8 100644 (file)
--- a/v7/src/runtime/datime.scm
+++ b/v7/src/runtime/datime.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: datime.scm,v 14.17 1999/01/02 06:11:34 cph Exp $
+$Id: datime.scm,v 14.18 1999/04/07 04:09:01 cph Exp $
 
 Copyright (c) 1988-1999 Massachusetts Institute of Technology
 
@@ -48,42 +48,88 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   (daylight-savings-time #f read-only #t)
   (zone #f))
 
-(define (make-decoded-time second minute hour day month year)
-  (let ((dt
-        (let ((limit
-               (lambda (low number high)
-                 (cond ((< number low) low)
-                       ((> number high) high)
-                       (else number)))))
-          (let ((month (limit 1 month 12)))
-            (%make-decoded-time (limit 0 second 59)
-                                (limit 0 minute 59)
-                                (limit 0 hour 23)
-                                (limit 1 day (month/max-days month))
-                                month
-                                (if (< year 0) 0 year)
-                                0
-                                -1
-                                #f)))))
-    ;; These calls fill in the other fields of the structure.
-    ;; ENCODE-TIME can easily signal an error, for example on unix
-    ;; machines when the time is prior to 1970.
-    (let ((t (ignore-errors (lambda () ((ucode-primitive encode-time 1) dt)))))
-      (if (condition? t)
-         (set-decoded-time/day-of-week! dt #f)
-         ((ucode-primitive decode-time 2) dt t)))
-    (if (decoded-time/zone dt)
-       (set-decoded-time/zone! dt (/ (decoded-time/zone dt) 3600)))
-    dt))
-
-(define (decode-universal-time time)
+(define (make-decoded-time second minute hour day month year #!optional zone)
+  (check-decoded-time-args second minute hour day month year
+                          'MAKE-DECODED-TIME)
+  (let ((zone (if (default-object? zone) #f zone)))
+    (if (and zone (not (time-zone? zone)))
+       (error:bad-range-argument zone "time zone" 'MAKE-DECODED-TIME))
+    (if zone
+       (%make-decoded-time second minute hour day month
+                           (compute-day-of-week day month year)
+                           0
+                           zone)
+       (let ((dt (%make-decoded-time second minute hour day month 0 -1 #f)))
+         ;; These calls fill in the other fields of the structure.
+         ;; ENCODE-TIME can easily signal an error, for example on
+         ;; unix machines when the time is prior to 1970.
+         (let ((t (ignore-errors
+                   (lambda () ((ucode-primitive encode-time 1) dt)))))
+           (if (condition? t)
+               (set-decoded-time/day-of-week!
+                dt
+                (compute-day-of-week day month year))
+               ((ucode-primitive decode-time 2) dt t)))
+         (if (decoded-time/zone dt)
+             (set-decoded-time/zone! dt (/ (decoded-time/zone dt) 3600)))
+         dt))))
+\f
+(define (check-decoded-time-args second minute hour day month year procedure)
+  (let ((check-type
+        (lambda (object)
+          (if (not (exact-nonnegative-integer? object))
+              (error:wrong-type-argument object
+                                         "exact non-negative integer"
+                                         procedure)))))
+    (let ((check-range
+          (lambda (object min max)
+            (check-type object)
+            (if (not (<= min object max))
+                (error:bad-range-argument object procedure)))))
+      (check-type year)
+      (check-range month 1 12)
+      (check-range day 1 (month/max-days month))
+      (check-range hour 0 23)
+      (check-range minute 0 59)
+      (check-range second 0 59))))
+
+(define (compute-day-of-week day month year)
+  ;; This implements Zeller's Congruence.
+  (modulo (+ day
+            (let ((y (remainder year 100)))
+              (+ y
+                 (floor (/ y 4))))
+            (let ((c (quotient year 100)))
+              (- (floor (/ c 4))
+                 (* 2 c)))
+            (let ((m (modulo (- month 2) 12)))
+              (- (floor (/ (- (* 13 m) 1) 5))
+                 (* (floor (/ m 11))
+                    (if (and (= 0 (remainder year 4))
+                             (or (not (= 0 (remainder year 100)))
+                                 (= 0 (remainder year 400))))
+                        2
+                        1))))
+            ;; This -1 adjusts so that 0 corresponds to Monday.
+            ;; Normally, 0 corresponds to Sunday.
+            -1)
+         7))
+\f
+(define (universal-time->local-decoded-time time)
   (let ((result (allocate-decoded-time)))
     ((ucode-primitive decode-time 2) result (- time epoch))
     (if (decoded-time/zone result)
        (set-decoded-time/zone! result (/ (decoded-time/zone result) 3600)))
     result))
 
-(define (encode-universal-time dt)
+(define (universal-time->global-decoded-time time)
+  (let ((result (allocate-decoded-time)))
+    ((ucode-primitive decode-utc 2) result (- time epoch))
+    (if (decoded-time/zone result)
+       (set-decoded-time/zone! result (/ (decoded-time/zone result) 3600)))
+    result))
+
+(define (decoded-time->universal-time dt)
   (+ ((ucode-primitive encode-time 1)
       (if (decoded-time/zone dt)
          (let ((dt* (copy-decoded-time dt)))
@@ -97,8 +143,11 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 
 (define epoch 2208988800)
 
-(define (get-decoded-time)
-  (decode-universal-time (get-universal-time)))
+(define (local-decoded-time)
+  (universal-time->local-decoded-time (get-universal-time)))
+
+(define (global-decoded-time)
+  (universal-time->global-decoded-time (get-universal-time)))
 
 (define (time-zone? object)
   (and (number? object)
@@ -135,11 +184,17 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
                   " "
                   (if (< hour 12) "AM" "PM"))))
 
-(define (universal-time->string time)
-  (decoded-time->string (decode-universal-time time)))
+(define (universal-time->local-time-string time)
+  (decoded-time->string (universal-time->local-decoded-time time)))
 
-(define (file-time->string time)
-  (decoded-time->string (decode-file-time time)))
+(define (universal-time->global-time-string time)
+  (decoded-time->string (universal-time->global-decoded-time time)))
+
+(define (file-time->local-time-string time)
+  (decoded-time->string (file-time->local-decoded-time time)))
+
+(define (file-time->global-time-string time)
+  (decoded-time->string (file-time->global-decoded-time time)))
 
 (define (decoded-time->string dt)
   ;; The returned string is in the format specified by RFC 822,
@@ -171,6 +226,22 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
                               (- zone 1)
                               zone)))
                         "")))))
+
+(define (string->decoded-time string)
+  ;; STRING must be in RFC-822 format.
+  (let ((tokens (burst-string string #\space)))
+    (if (not (fix:= 6 (length tokens)))
+       (error "Ill-formed RFC-822 time string:" string))
+    (let ((tokens (burst-string (list-ref tokens 4) #\:)))
+      (if (not (fix:= 3 (length tokens)))
+         (error "Malformed time:" string))
+      (make-decoded-time (string->number (caddr tokens))
+                        (string->number (cadr tokens))
+                        (string->number (car tokens))
+                        (string->number (list-ref tokens 1))
+                        (short-string->month (list-ref tokens 2))
+                        (string->number (list-ref tokens 3))
+                        (string->time-zone (list-ref tokens 5))))))
 \f
 (define (time-zone->string tz)
   (if (not (time-zone? tz))
@@ -182,15 +253,39 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
                     (d2 (integer-divide-quotient qr))
                     (d2 (integer-divide-remainder qr))))))
 
+(define (string->time-zone string)
+  (let ((n (string->number string)))
+    (if (not (and (exact-nonnegative-integer? n)
+                 (<= -2400 n 2400)))
+       (error "Malformed time zone:" string))
+    (let ((qr (integer-divide (abs n) 100)))
+      (let ((hours (integer-divide-quotient qr))
+           (minutes (integer-divide-remainder qr)))
+       (if (not (<= 0 minutes 59))
+           (error "Malformed time zone:" string))
+       (let ((hours (+ hours (/ minutes 60))))
+         (if (< n 0)
+             hours
+             (- hours)))))))
+
 (define (month/max-days month)
   (guarantee-month month 'MONTH/MAX-DAYS)
   (vector-ref '#(31 29 31 30 31 30 31 31 30 31 30 31) (- month 1)))
 
 (define (month/short-string month)
   (guarantee-month month 'MONTH/SHORT-STRING)
-  (vector-ref '#("Jan" "Feb" "Mar" "Apr" "May" "Jun"
-                      "Jul" "Aug" "Sep" "Oct" "Nov" "Dec")
-             (- month 1)))
+  (vector-ref month/short-strings (- month 1)))
+
+(define (short-string->month string)
+  (let loop ((index 0))
+    (if (fix:= index 12)
+       (error "Unknown month designation:" string))
+    (if (string-ci=? string (vector-ref month/short-strings index))
+       (fix:+ index 1)
+       (loop (fix:+ index 1)))))
+
+(define month/short-strings
+  '#("Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"))
 
 (define (month/long-string month)
   (guarantee-month month 'MONTH/LONG-STRING)
@@ -219,4 +314,11 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   (if (not (exact-integer? day))
       (error:wrong-type-argument day "day-of-week integer" name))
   (if (not (<= 0 day 6))
-      (error:bad-range-argument day name)))
\ No newline at end of file
+      (error:bad-range-argument day name)))
+
+;; Upwards compatibility
+(define decode-universal-time universal-time->local-decoded-time)
+(define encode-universal-time decoded-time->universal-time)
+(define get-decoded-time local-decoded-time)
+(define universal-time->string universal-time->local-time-string)
+(define file-time->string file-time->local-time-string)
\ No newline at end of file

diff --git a/v7/src/runtime/dosprm.scm b/v7/src/runtime/dosprm.scm
index 903bacf20f64663249d375e3e479fe4d9c1919de..576fdfa4d4ed7c067b578b75cd9d995848e79a32 100644 (file)
--- a/v7/src/runtime/dosprm.scm
+++ b/v7/src/runtime/dosprm.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: dosprm.scm,v 1.41 1999/01/02 06:11:34 cph Exp $
+$Id: dosprm.scm,v 1.42 1999/04/07 04:09:01 cph Exp $
 
 Copyright (c) 1992-1999 Massachusetts Institute of Technology
 
@@ -248,15 +248,17 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
                    user-name)))))
       (merge-pathnames "\\")))
 
-(define (decode-file-time time)
-  (decode-universal-time (file-time->universal-time time)))
+(define (file-time->local-decoded-time time)
+  (universal-time->local-decoded-time (file-time->universal-time time)))
 
-(define (encode-file-time dt)
-  (universal-time->file-time (encode-universal-time dt)))
+(define (decoded-time->file-time dt)
+  (universal-time->file-time (decoded-time->universal-time dt)))
 
 (define (file-time->universal-time time) (+ time epoch))
 (define (universal-time->file-time time) (- time epoch))
 
+(define decode-file-time file-time->local-decoded-time)
+(define encode-file-time decoded-time->file-time)
 (define dos/user-home-directory user-home-directory)
 (define dos/current-user-name current-user-name)
 (define dos/current-home-directory current-home-directory)

diff --git a/v7/src/runtime/krypt.scm b/v7/src/runtime/krypt.scm
index eed9aa28d89a3ad0e0deb58017c4b4c48210fb0f..1a9aee33005ccb2453dbc38e088326b30f4e7fa5 100644 (file)
--- a/v7/src/runtime/krypt.scm
+++ b/v7/src/runtime/krypt.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: krypt.scm,v 1.8 1999/01/02 06:11:34 cph Exp $
+$Id: krypt.scm,v 1.9 1999/04/07 04:09:02 cph Exp $
 
 Copyright (c) 1988-1999 Massachusetts Institute of Technology
 
@@ -27,19 +27,13 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 ;;; This implementation is based on krypt.c, written by Ron Rivest.
 ;;; encrypt and decrypt are compatible with krypt.c.
 
-(define-integrable ts 256)                             ; Actual table size to use
+(define-integrable ts 256)             ; Actual table size to use
 
 (define-structure (krypt-key (conc-name krypt-key/)
-                            (constructor %make-krypt-key))
-  state-table
-  index-i
-  index-j)
-
-(define (make-krypt-key)
-  (%make-krypt-key
-    (make-vector ts)
-    #f
-    #f))
+                            (constructor make-krypt-key ()))
+  (state-table (make-vector ts))
+  (index-i #f)
+  (index-j #f))
 
 (define (rcm-keyinit key)
   (let loop ((i 0))
@@ -89,21 +83,22 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
                   (t (vector-ref s i)))
              (vector-set! s i (vector-ref s j))
              (vector-set! s j t)
-             (vector-8b-set! buf k
-                             (fix:xor (vector-8b-ref buf k)
-                                      (vector-ref s (inc-mod
-                                                     (fix:+ (fix:1+ (vector-ref s i))
-                                                            (vector-ref s j)) 
-                                                     ts))))
+             (vector-8b-set!
+              buf k
+              (fix:xor (vector-8b-ref buf k)
+                       (vector-ref s (inc-mod
+                                      (fix:+ (fix:1+ (vector-ref s i))
+                                             (vector-ref s j)) 
+                                      ts))))
              (loop (fix:1+ k) i j)))
          (begin
            (set-krypt-key/index-i! key i)
            (set-krypt-key/index-j! key j))))))
-
+\f
 (define kryptid "This file krypted ")
 
 (define (get-krypt-time-string)
-  (let ((the-time (get-decoded-time)))
+  (let ((the-time (local-decoded-time)))
     (string-append
      (vector-ref '#("Mon" "Tue" "Wed" "Thu" "Fri" "Sat" "Sun")
                 (decoded-time/day-of-week the-time))
@@ -129,12 +124,13 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
       (if (fix:< i end-index)
          (loop (fix:1+ i) (fix:+ checksum (vector-8b-ref block i)))
          (fix:remainder checksum 256)))))
-
+\f
 (define (encrypt input-string password)
   (let* ((checksum 0)
         (header (string-append kryptid (get-krypt-time-string) "\n"))
         (hlen (string-length header))
-        (output-string (make-string (fix:+ 6 (fix:+ hlen (string-length input-string)))))
+        (output-string
+         (make-string (fix:+ 6 (fix:+ hlen (string-length input-string)))))
         (end-index (fix:- (string-length output-string) ts)))
     (let ((key1 (make-krypt-key)))
       (rcm-keyinit key1)
@@ -144,7 +140,8 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
        (rcm key1 5 passwordmac)
        (substring-move-left! header 0 hlen output-string 0)
        (substring-move-left! passwordmac 0 5 output-string hlen)
-       (substring-move-left! input-string 0 (string-length input-string) output-string (fix:+ hlen 5)))
+       (substring-move-left! input-string 0 (string-length input-string)
+                             output-string (fix:+ hlen 5)))
       (let loop ((index (fix:+ hlen 5)))
        (if (fix:< index end-index)
            (begin
@@ -152,18 +149,23 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
              (rcm-iter key1 ts output-string index)
              (loop (fix:+ index ts)))
            (let ((count (fix:- (string-length output-string) (fix:1+ index))))
-             (set! checksum (update-checksum checksum output-string index count))
+             (set! checksum
+                   (update-checksum checksum output-string index count))
              (rcm-iter key1 count output-string index))))
       (let ((check-char (ascii->char (modulo (- checksum) ts))))
        (let ((cc-string (char->string check-char)))
          (rcm key1 1 cc-string)
-         (string-set! output-string (fix:-1+ (string-length output-string)) (string-ref cc-string 0))))
+         (string-set! output-string
+                      (fix:-1+ (string-length output-string))
+                      (string-ref cc-string 0))))
       output-string)))
 
-(define (decrypt input-string password #!optional password-error checksum-error)
+(define (decrypt input-string password
+                #!optional password-error checksum-error)
   (let* ((header-length (+ (string-length kryptid) 25))
         (header (string-head input-string header-length))
-        (pwordmac (substring input-string header-length (fix:+ header-length 5)))
+        (pwordmac
+         (substring input-string header-length (fix:+ header-length 5)))
         (output-string (string-tail input-string (fix:+ header-length 5)))
         (end-index (fix:- (string-length output-string) ts))
         (key1 (make-krypt-key))
@@ -179,19 +181,23 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
                (if (fix:< index end-index)
                    (begin
                      (rcm-iter key1 ts output-string index)
-                     (set! checksum (update-checksum checksum output-string index ts))
+                     (set! checksum
+                           (update-checksum checksum output-string index ts))
                      (loop (fix:+ index ts)))
                    (let ((count (fix:- (string-length output-string) index)))
                      (rcm-iter key1 count output-string index)
-                     (set! checksum (update-checksum checksum output-string index count)))))
+                     (set! checksum
+                           (update-checksum checksum output-string index
+                                            count)))))
              (if (not (= (modulo checksum 256) 0))
                  (if (default-object? checksum-error)
                      (error "krypt: Checksum error.")
                      (checksum-error output-string))
                  (begin
-                   (set-string-length! output-string (fix:-1+ (string-length output-string)))
+                   (set-string-length!
+                    output-string
+                    (fix:-1+ (string-length output-string)))
                    output-string)))
            (if (default-object? password-error)
                (error "krypt: Password error.")
-               (password-error))))))
-         
\ No newline at end of file
+               (password-error))))))
\ No newline at end of file

diff --git a/v7/src/runtime/ntprm.scm b/v7/src/runtime/ntprm.scm
index 431660985a6ed13cc5a8987e94bdf55ab1cab733..d4c7177bbebcdc364223457882fc550e6038492d 100644 (file)
--- a/v7/src/runtime/ntprm.scm
+++ b/v7/src/runtime/ntprm.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: ntprm.scm,v 1.30 1999/03/26 01:55:48 cph Exp $
+$Id: ntprm.scm,v 1.31 1999/04/07 04:09:03 cph Exp $
 
 Copyright (c) 1992-1999 Massachusetts Institute of Technology
 
@@ -115,11 +115,17 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
      (or access-time (file-access-time filename))
      (or modification-time (file-modification-time filename)))))
 
-(define (decode-file-time time)
-  (decode-universal-time (file-time->universal-time time)))
+(define (file-time->local-decoded-time time)
+  (universal-time->local-decoded-time (file-time->universal-time time)))
 
-(define (encode-file-time dt)
-  (universal-time->file-time (encode-universal-time dt)))
+(define (file-time->global-decoded-time time)
+  (universal-time->global-decoded-time (file-time->universal-time time)))
+
+(define (decoded-time->file-time dt)
+  (universal-time->file-time (decoded-time->universal-time dt)))
+
+(define decode-file-time file-time->local-decoded-time)
+(define encode-file-time decoded-time->file-time)
 
 (define (file-time->universal-time time) (+ time epoch))
 (define (universal-time->file-time time) (- time epoch))

diff --git a/v7/src/runtime/os2prm.scm b/v7/src/runtime/os2prm.scm
index cf68fc23b9b99acd5d247c68776d36aac575c4a9..b9d8ba943eeeaffb8e620da38e01c3a93b539529 100644 (file)
--- a/v7/src/runtime/os2prm.scm
+++ b/v7/src/runtime/os2prm.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: os2prm.scm,v 1.41 1999/02/25 22:15:41 cph Exp $
+$Id: os2prm.scm,v 1.42 1999/04/07 04:09:03 cph Exp $
 
 Copyright (c) 1994-1999 Massachusetts Institute of Technology
 
@@ -97,7 +97,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
    access-time
    modification-time))
 \f
-(define (decode-file-time time)
+(define (file-time->local-decoded-time time)
   (let* ((twosecs (remainder time 32)) (time (quotient time 32))
         (minutes (remainder time 64)) (time (quotient time 64))
         (hours   (remainder time 32)) (time (quotient time 32))
@@ -105,7 +105,10 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
         (month   (remainder time 16)) (year (quotient time 16)))
     (make-decoded-time (* twosecs 2) minutes hours day month (+ 1980 year))))
 
-(define (encode-file-time dt)
+(define (file-time->global-decoded-time time)
+  (universal-time->global-decoded-time (file-time->universal-time time)))
+
+(define (decoded-time->file-time dt)
   (let ((f (lambda (i j k) (+ (* i j) k))))
     (f (f (f (f (f (let ((year (decoded-time/year dt)))
                     (if (< year 1980)
@@ -117,11 +120,14 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
          64 (decoded-time/minute dt))
        32 (quotient (decoded-time/second dt) 2))))
 
+(define decode-file-time file-time->local-decoded-time)
+(define encode-file-time decoded-time->file-time)
+
 (define (file-time->universal-time time)
-  (encode-universal-time (decode-file-time time)))
+  (decoded-time->universal-time (file-time->local-decoded-time time)))
 
 (define (universal-time->file-time time)
-  (encode-file-time (decode-universal-time time)))
+  (decoded-time->file-time (universal-time->local-decoded-time time)))
 
 (define (file-attributes filename)
   ((ucode-primitive file-info 1)

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index 1611e849435c776e727d01aff01ecc12f1ac94fd..988d427225a090542034c745274bac2fb8366f13 100644 (file)
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.322 1999/04/07 04:06:07 cph Exp $
+$Id: runtime.pkg,v 14.323 1999/04/07 04:09:16 cph Exp $
 
 Copyright (c) 1988-1999 Massachusetts Institute of Technology
 
@@ -478,6 +478,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
          day-of-week/short-string
          decode-universal-time
          decoded-time->string
+         decoded-time->universal-time
          decoded-time/date-string
          decoded-time/day
          decoded-time/day-of-week
@@ -491,15 +492,24 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
          decoded-time/zone
          encode-universal-time
          epoch
+         file-time->global-time-string
+         file-time->local-time-string
          file-time->string
          get-decoded-time
          get-universal-time
+         global-decoded-time
+         local-decoded-time
          make-decoded-time
          month/long-string
          month/max-days
          month/short-string
+         string->decoded-time
          time-zone->string
          time-zone?
+         universal-time->global-decoded-time
+         universal-time->global-time-string
+         universal-time->local-decoded-time
+         universal-time->local-time-string
          universal-time->string))
 
 (define-package (runtime debugger)

diff --git a/v7/src/runtime/savres.scm b/v7/src/runtime/savres.scm
index 1ef3781bd5e9e042338694d78ac5a2898216ec65..113b187aadd0b661f704475ad1ac6ff2b853808f 100644 (file)
--- a/v7/src/runtime/savres.scm
+++ b/v7/src/runtime/savres.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: savres.scm,v 14.30 1999/01/02 06:11:34 cph Exp $
+$Id: savres.scm,v 14.31 1999/04/07 04:09:06 cph Exp $
 
 Copyright (c) 1988-1999 Massachusetts Institute of Technology
 
@@ -49,7 +49,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   (lambda (filename #!optional identify)
     (let ((identify
           (if (default-object? identify) world-identification identify))
-         (time (get-decoded-time)))
+         (time (local-decoded-time)))
       (gc-clean)
       (save-image
        filename

diff --git a/v7/src/runtime/unxprm.scm b/v7/src/runtime/unxprm.scm
index 38059048c150385fcc25068b2434340e30052e61..2ea40192e0827e2ce24f5ef6d9d3bfcfbd75238c 100644 (file)
--- a/v7/src/runtime/unxprm.scm
+++ b/v7/src/runtime/unxprm.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: unxprm.scm,v 1.54 1999/02/25 22:15:37 cph Exp $
+$Id: unxprm.scm,v 1.55 1999/04/07 04:09:07 cph Exp $
 
 Copyright (c) 1988-1999 Massachusetts Institute of Technology
 
@@ -221,15 +221,20 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 (define-integrable current-user-name
   (ucode-primitive current-user-name 0))
 
-(define (decode-file-time time)
-  (decode-universal-time (file-time->universal-time time)))
+(define (file-time->local-decoded-time time)
+  (universal-time->local-decoded-time (file-time->universal-time time)))
 
-(define (encode-file-time dt)
-  (universal-time->file-time (encode-universal-time dt)))
+(define (file-time->global-decoded-time time)
+  (universal-time->global-decoded-time (file-time->universal-time time)))
+
+(define (decoded-time->file-time dt)
+  (universal-time->file-time (decoded-time->universal-time dt)))
 
 (define (file-time->universal-time time) (+ time epoch))
 (define (universal-time->file-time time) (- time epoch))
 
+(define decode-file-time file-time->local-decoded-time)
+(define encode-file-time decoded-time->file-time)
 (define unix/user-home-directory user-home-directory)
 (define unix/current-home-directory current-home-directory)
 (define unix/current-user-name current-user-name)

diff --git a/v7/src/runtime/version.scm b/v7/src/runtime/version.scm
index ec07cf609b16991698dd5d67a6160c403b558750..b908a59e84eaf1d14cc4be382d0d431aebea50e6 100644 (file)
--- a/v7/src/runtime/version.scm
+++ b/v7/src/runtime/version.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: version.scm,v 14.179 1999/02/18 04:04:43 cph Exp $
+$Id: version.scm,v 14.180 1999/04/07 04:09:08 cph Exp $
 
 Copyright (c) 1988-1999 Massachusetts Institute of Technology
 
@@ -27,7 +27,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 (define (initialize-package!)
   (snarf-microcode-version!)
   (add-event-receiver! event:after-restore snarf-microcode-version!)
-  (add-identification! "Runtime" 14 179))
+  (add-identification! "Runtime" 14 180))
 
 (define (snarf-microcode-version!)
   (add-identification! "Microcode"

diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg
index 5dabfe533c348f2052583d1f1b31faf7e23ac219..db773755b949b6d67108215d2d19f49c984d1709 100644 (file)
--- a/v8/src/runtime/runtime.pkg
+++ b/v8/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.327 1999/04/07 04:05:33 cph Exp $
+$Id: runtime.pkg,v 14.328 1999/04/07 04:09:04 cph Exp $
 
 Copyright (c) 1988-1999 Massachusetts Institute of Technology
 
@@ -480,6 +480,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
          day-of-week/short-string
          decode-universal-time
          decoded-time->string
+         decoded-time->universal-time
          decoded-time/date-string
          decoded-time/day
          decoded-time/day-of-week
@@ -493,15 +494,24 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
          decoded-time/zone
          encode-universal-time
          epoch
+         file-time->global-time-string
+         file-time->local-time-string
          file-time->string
          get-decoded-time
          get-universal-time
+         global-decoded-time
+         local-decoded-time
          make-decoded-time
          month/long-string
          month/max-days
          month/short-string
+         string->decoded-time
          time-zone->string
          time-zone?
+         universal-time->global-decoded-time
+         universal-time->global-time-string
+         universal-time->local-decoded-time
+         universal-time->local-time-string
          universal-time->string))
 
 (define-package (runtime debugger)