Fix bug: previously, "universal time" was really unix time. This fix

does the translation between universal time and unix time.

diff --git a/v7/src/runtime/datime.scm b/v7/src/runtime/datime.scm
index 9d25698cdd281fb46088467c99e3f3d2e0dcada0..a02150b7b054b51fa0df37d322f116d6e5064ec6 100644 (file)
--- a/v7/src/runtime/datime.scm
+++ b/v7/src/runtime/datime.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: datime.scm,v 14.14 1996/05/04 17:30:08 cph Exp $
+$Id: datime.scm,v 14.15 1996/10/07 18:13:34 cph Exp $
 
 Copyright (c) 1988-96 Massachusetts Institute of Technology
 
@@ -86,21 +86,24 @@ MIT in each case. |#
 
 (define (decode-universal-time time)
   (let ((result (allocate-decoded-time)))
-    ((ucode-primitive decode-time 2) result 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)
-  ((ucode-primitive encode-time 1)
-   (if (decoded-time/zone dt)
-       (let ((dt* (copy-decoded-time dt)))
-        (set-decoded-time/zone! dt* (* (decoded-time/zone dt*) 3600))
-        dt*)
-       dt)))
+  (+ ((ucode-primitive encode-time 1)
+      (if (decoded-time/zone dt)
+         (let ((dt* (copy-decoded-time dt)))
+           (set-decoded-time/zone! dt* (* (decoded-time/zone dt*) 3600))
+           dt*)
+         dt))
+     epoch))
 
 (define (get-universal-time)
-  ((ucode-primitive encoded-time 0)))
+  (+ epoch ((ucode-primitive encoded-time 0))))
+
+(define epoch 2208988800)
 
 (define (get-decoded-time)
   (decode-universal-time (get-universal-time)))

diff --git a/v7/src/runtime/dosprm.scm b/v7/src/runtime/dosprm.scm
index 2808abef5e158f77d7b3841d5f573c7f0d71d13f..d8d78a6134b8fe11167aaa66512a65c2a73efef4 100644 (file)
--- a/v7/src/runtime/dosprm.scm
+++ b/v7/src/runtime/dosprm.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: dosprm.scm,v 1.38 1996/04/24 03:39:47 cph Exp $
+$Id: dosprm.scm,v 1.39 1996/10/07 18:13:47 cph Exp $
 
 Copyright (c) 1992-96 Massachusetts Institute of Technology
 
@@ -257,10 +257,14 @@ MIT in each case. |#
                    user-name)))))
       (merge-pathnames "\\")))
 
-(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)
-(define (universal-time->file-time time) time)
+(define (decode-file-time time)
+  (decode-universal-time (file-time->universal-time time)))
+
+(define (encode-file-time dt)
+  (universal-time->file-time (encode-universal-time dt)))
+
+(define (file-time->universal-time time) (+ time epoch))
+(define (universal-time->file-time time) (- time epoch))
 
 (define dos/user-home-directory user-home-directory)
 (define dos/current-user-name current-user-name)

diff --git a/v7/src/runtime/ntprm.scm b/v7/src/runtime/ntprm.scm
index 94ead104a6e33fc287f98107dc943864e6c1ccfe..8cb2007ad7dc2d33ea41fee3843092b75126b7fe 100644 (file)
--- a/v7/src/runtime/ntprm.scm
+++ b/v7/src/runtime/ntprm.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: ntprm.scm,v 1.7 1996/05/03 07:41:10 cph Exp $
+$Id: ntprm.scm,v 1.8 1996/10/07 18:14:27 cph Exp $
 
 Copyright (c) 1992-96 Massachusetts Institute of Technology
 
@@ -109,12 +109,8 @@ MIT in each case. |#
 (define (file-attributes filename)
   ((ucode-primitive file-attributes 1)
    (->namestring (merge-pathnames filename))))
-
-(define file-attributes-direct
-  file-attributes)
-
-(define file-attributes-indirect
-  file-attributes)
+(define file-attributes-direct file-attributes)
+(define file-attributes-indirect file-attributes)
 
 (define-structure (file-attributes
                   (type vector)
@@ -131,40 +127,39 @@ MIT in each case. |#
   (mode-string false read-only true)
   (inode-number false read-only true))
 
-(define (file-length filename)
-  (file-attributes/length (file-attributes filename)))
+(define (file-length namestring)
+  (let ((attr (file-attributes namestring)))
+    (and attr
+        (file-attributes/length attr))))
 
 (define (file-modification-time filename)
   ((ucode-primitive file-mod-time 1)
    (->namestring (merge-pathnames filename))))
+(define file-modification-time-direct file-modification-time)
+(define file-modification-time-indirect file-modification-time)
 
-(define file-modification-time-direct
-  file-modification-time)
-
-(define file-modification-time-indirect
-  file-modification-time)
-
-;; These are obviously incorrect, but there is no alternative.
-;; DOS only keeps track of modification times.
-
-(define file-access-time-direct
-  file-modification-time-direct)
-
-(define file-access-time-indirect
-  file-modification-time-indirect)
-
-(define file-access-time
-  file-modification-time)
+(define (file-access-time namestring)
+  (let ((attr (file-attributes namestring)))
+    (and attr
+        (file-attributes/access-time attr))))
+(define file-access-time-direct file-modification-time-direct)
+(define file-access-time-indirect file-modification-time-indirect)
 
 (define (set-file-times! filename access-time modification-time)
-  (let ((filename (->namestring (merge-pathnames filename)))
-       (time (or modification-time
-                 access-time
-                 (file-modification-time-direct filename))))
+  (let ((filename (->namestring (merge-pathnames filename))))
     ((ucode-primitive set-file-times! 3)
      filename
-     (or access-time time)
-     (or modification-time time))))
+     (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 (encode-file-time dt)
+  (universal-time->file-time (encode-universal-time dt)))
+
+(define (file-time->universal-time time) (+ time epoch))
+(define (universal-time->file-time time) (- time epoch))
 \f
 (define get-environment-variable)
 (define set-environment-variable!)
@@ -274,11 +269,6 @@ MIT in each case. |#
         (pathname-as-directory
          (merge-pathnames (or homepath home) homedrive)))))
 
-(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)
-(define (universal-time->file-time time) 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/unxprm.scm b/v7/src/runtime/unxprm.scm
index 2dfecd1913e6c257aedbea30540c7ffaf8f7ff5f..2a1794eaf8ffd333b331f6fffd28931b72096a8d 100644 (file)
--- a/v7/src/runtime/unxprm.scm
+++ b/v7/src/runtime/unxprm.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: unxprm.scm,v 1.45 1996/04/24 18:44:05 cph Exp $
+$Id: unxprm.scm,v 1.46 1996/10/07 18:13:40 cph Exp $
 
 Copyright (c) 1988-96 Massachusetts Institute of Technology
 
@@ -230,10 +230,14 @@ MIT in each case. |#
 (define-integrable current-user-name
   (ucode-primitive current-user-name 0))
 
-(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)
-(define (universal-time->file-time time) time)
+(define (decode-file-time time)
+  (decode-universal-time (file-time->universal-time time)))
+
+(define (encode-file-time dt)
+  (universal-time->file-time (encode-universal-time dt)))
+
+(define (file-time->universal-time time) (+ time epoch))
+(define (universal-time->file-time time) (- time epoch))
 
 (define unix/user-home-directory user-home-directory)
 (define unix/current-home-directory current-home-directory)