From: Chris Hanson Date: Mon, 7 Oct 1996 18:14:27 +0000 (+0000) Subject: Fix bug: previously, "universal time" was really unix time. This fix X-Git-Tag: 20090517-FFI~5364 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=999eec218614a3890fce87ab771251f3bd05bdba;p=mit-scheme.git 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 9d25698cd..a02150b7b 100644 --- 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 2808abef5..d8d78a613 100644 --- 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 94ead104a..8cb2007ad 100644 --- 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)) (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 2dfecd191..2a1794eaf 100644 --- 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)