Add optional second argument to `open-output-file': if supplied and

not false, the file is opened for append.

diff --git a/v7/src/runtime/io.scm b/v7/src/runtime/io.scm
index 2bec879a461d8582069ed07904ec6e232c0fef91..a8ac79277c5a0596a08f8a0736f3306aadf24442 100644 (file)
--- a/v7/src/runtime/io.scm
+++ b/v7/src/runtime/io.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/io.scm,v 14.4 1990/02/27 19:39:34 markf Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/io.scm,v 14.5 1990/04/10 20:05:13 cph Exp $
 
-Copyright (c) 1988, 1989 Massachusetts Institute of Technology
+Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -38,8 +38,6 @@ MIT in each case. |#
 (declare (usual-integrations))
 \f
 (define (initialize-package!)
-  (set! open-input-channel (open-channel-wrapper false))
-  (set! open-output-channel (open-channel-wrapper true))
   (set! close-all-open-files (close-files file-close-channel))
   (set! primitive-io/reset! (close-files (lambda (ignore) ignore)))
   (set! open-files-list (list 'OPEN-FILES-LIST))
@@ -80,22 +78,38 @@ MIT in each case. |#
 ;;;; Open/Close Files
 
 ;;;  Direction is one of the following:
-;;;     - true:   output channel
-;;;    - false:  input channel
-;;;    - 0:      closed channel
+;;;    - #f:           input channel
+;;;     - #t:          output channel
+;;;     - 'append:     append output channel
+;;;    - 0:            closed channel
 
-(define ((open-channel-wrapper direction) filename-or-process)
+(define (open-channel filename-or-process direction)
   (without-interrupts
    (lambda ()
      (let ((channel
-           (make-physical-channel
-            (if (process? filename-or-process)
-                (if direction
-                    (process-get-input-channel filename-or-process)
-                    (process-get-output-channel filename-or-process))
-                (file-open-channel filename-or-process direction))
-            filename-or-process
-            direction)))
+           (case direction
+             ((#F)
+              (make-physical-channel
+               (if (process? filename-or-process)
+                   (process-get-input-channel filename-or-process)
+                   (file-open-channel filename-or-process direction))
+               filename-or-process
+               direction))
+             ((#T)
+              (make-physical-channel
+               (if (process? filename-or-process)
+                   (process-get-output-channel filename-or-process)
+                   (file-open-channel filename-or-process direction))
+               filename-or-process
+               direction))
+             (else
+              (if (process? filename-or-process)
+                  (error "Can't open process channel for append"
+                         filename-or-process))
+              (make-physical-channel
+               (file-open-channel filename-or-process 'APPEND)
+               filename-or-process
+               #T)))))
        (with-absolutely-no-interrupts
        (lambda ()
          (set-cdr! open-files-list
@@ -105,8 +119,14 @@ MIT in each case. |#
                          (cdr open-files-list)))))
        channel))))
 
-(define open-input-channel)
-(define open-output-channel)
+(define (open-input-channel filename-or-process)
+  (open-channel filename-or-process false))
+
+(define (open-output-channel filename-or-process)
+  (open-channel filename-or-process true))
+
+(define (open-append-channel filename)
+  (open-channel filename 'APPEND))
 \f
 ;;; This is locked from interrupts, but GC can occur since the
 ;;; procedure itself hangs on to the channel until the last moment,

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index cb1ffabc6ee5db682455ea4e9fdd11dc45a2e07a..ba305bd03b5b4b93d7c0531371862afeb1dd76e5 100644 (file)
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/runtime.pkg,v 14.63 1990/03/26 19:38:29 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/runtime.pkg,v 14.64 1990/04/10 20:05:18 cph Exp $
 
 Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
@@ -1268,6 +1268,7 @@ MIT in each case. |#
   (export (runtime file-output)
          channel-name
          close-physical-channel
+         open-append-channel
          open-output-channel)
   (export (runtime subprocesses input)
          close-physical-channel

diff --git a/v7/src/runtime/version.scm b/v7/src/runtime/version.scm
index bc36138a47e53346af67ca58cb01456aba13119c..6f89fdb896902549096fc68eb606e8520a2009c0 100644 (file)
--- a/v7/src/runtime/version.scm
+++ b/v7/src/runtime/version.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/version.scm,v 14.77 1990/03/02 20:24:46 markf Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/version.scm,v 14.78 1990/04/10 20:05:26 cph Exp $
 
 Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
@@ -45,7 +45,7 @@ MIT in each case. |#
                     '()))
   (add-system! microcode-system)
   (add-event-receiver! event:after-restore snarf-microcode-version!)
-  (add-identification! "Runtime" 14 77))
+  (add-identification! "Runtime" 14 78))
 
 (define microcode-system)
 

diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg
index b3987bf6c5ed1c54a0365419dcdb2774f9185b69..483cf13437c3f41c978b80f16864cade32c695cd 100644 (file)
--- a/v8/src/runtime/runtime.pkg
+++ b/v8/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/runtime.pkg,v 14.63 1990/03/26 19:38:29 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/runtime.pkg,v 14.64 1990/04/10 20:05:18 cph Exp $
 
 Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
@@ -1268,6 +1268,7 @@ MIT in each case. |#
   (export (runtime file-output)
          channel-name
          close-physical-channel
+         open-append-channel
          open-output-channel)
   (export (runtime subprocesses input)
          close-physical-channel