From: Chris Hanson <org/chris-hanson/cph>
Date: Sat, 5 Sep 1992 03:07:07 +0000 (+0000)
Subject: Add new procedures to read file access time and to set file times.
X-Git-Tag: 20090517-FFI~8999
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=6572a16b12353625a82340bf3ddb1bbf5ebe6ece;p=mit-scheme.git

Add new procedures to read file access time and to set file times.
---

diff --git a/v7/src/runtime/unxprm.scm b/v7/src/runtime/unxprm.scm
index 2751e64fd..6ef346033 100644
--- a/v7/src/runtime/unxprm.scm
+++ b/v7/src/runtime/unxprm.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/unxprm.scm,v 1.19 1992/07/07 00:44:54 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/unxprm.scm,v 1.20 1992/09/05 03:07:07 cph Exp $
 
-Copyright (c) 1988-1992 Massachusetts Institute of Technology
+Copyright (c) 1988-92 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -135,6 +135,24 @@ MIT in each case. |#
 
 (define file-modification-time
   file-modification-time-indirect)
+
+(define (file-access-time-direct filename)
+  ((ucode-primitive file-access-time 1)
+   (->namestring (merge-pathnames filename))))
+
+(define (file-access-time-indirect filename)
+  ((ucode-primitive file-access-time-indirect 1)
+   (->namestring (merge-pathnames filename))))
+
+(define file-access-time
+  file-access-time-indirect)
+
+(define (set-file-times! filename access-time modification-time)
+  (let ((filename (->namestring (merge-pathnames filename))))
+    ((ucode-primitive set-file-times!)
+     filename
+     (or access-time (file-access-time-direct filename))
+     (or modification-time (file-modification-time-direct filename)))))
 
 (define get-environment-variable)
 (define set-environment-variable!)