New output port operation SYNCHRONIZE-OUTPUT requests all data output

to be forced to permanent storage.  Implement this for generic I/O
ports using the CHANNEL-SYNCHRONIZE primitive.  Call this in Edwin
after writing regions to files on disk.

diff --git a/v7/src/edwin/fileio.scm b/v7/src/edwin/fileio.scm
index 4e3012a715a5044904422548fc6669d0ffe339c9..d909a99dd24bbd20199a9478e70dad892d3db802 100644 (file)
--- a/v7/src/edwin/fileio.scm
+++ b/v7/src/edwin/fileio.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: fileio.scm,v 1.174 2008/07/23 11:12:34 cph Exp $
+$Id: fileio.scm,v 1.175 2009/03/21 16:50:25 riastradh Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -693,14 +693,16 @@ Otherwise, a message is written both before and after long file writes."
     (lambda (port)
       (if (not translate?)
          (port/set-line-ending port 'NEWLINE))
-      (group-write-to-port group start end port))))
+      (group-write-to-port group start end port)
+      (output-port/synchronize-output port))))
 
 (define (group-append-to-file translate? group start end filename)
   (call-with-append-file filename
     (lambda (port)
       (if (not translate?)
          (port/set-line-ending port 'NEWLINE))
-      (group-write-to-port group start end port))))
+      (group-write-to-port group start end port)
+      (output-port/synchronize-output port))))
 
 (define (group-write-to-port group start end port)
   (%group-write group start end

diff --git a/v7/src/runtime/genio.scm b/v7/src/runtime/genio.scm
index e68ce7f813453d77d9134e486d6b78a483aa7e56..cf27fb1ea0801f063fdb526de7fd3c4dfa8157be 100644 (file)
--- a/v7/src/runtime/genio.scm
+++ b/v7/src/runtime/genio.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: genio.scm,v 1.70 2008/09/17 06:24:32 cph Exp $
+$Id: genio.scm,v 1.71 2009/03/21 16:50:26 riastradh Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -147,7 +147,8 @@ USA.
           (OUTPUT-CHANNEL ,generic-io/output-channel)
           (OUTPUT-TERMINAL-MODE ,generic-io/output-terminal-mode)
           (SET-OUTPUT-BLOCKING-MODE ,generic-io/set-output-blocking-mode)
-          (SET-OUTPUT-TERMINAL-MODE ,generic-io/set-output-terminal-mode)))
+          (SET-OUTPUT-TERMINAL-MODE ,generic-io/set-output-terminal-mode)
+          (SYNCHRONIZE-OUTPUT ,generic-io/synchronize-output)))
        (other-operations
         `((CLOSE ,generic-io/close)
           (CODING ,generic-io/coding)
@@ -317,6 +318,11 @@ USA.
          ((#F) unspecific)
          (else (error:wrong-type-datum mode "terminal mode"))))))
 
+(define (generic-io/synchronize-output port)
+  (let ((channel (generic-io/output-channel port)))
+    (if channel
+       (channel-synchronize channel))))
+
 (define (generic-io/buffered-output-bytes port)
   (output-buffer-start (port-output-buffer port)))
 

diff --git a/v7/src/runtime/output.scm b/v7/src/runtime/output.scm
index 2db2df0b80b3a6203289ece2741e36f8ed5aca8e..20dce3448f4a960a9b088a1165059faed3c3dd38 100644 (file)
--- a/v7/src/runtime/output.scm
+++ b/v7/src/runtime/output.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: output.scm,v 14.44 2008/07/26 07:01:34 cph Exp $
+$Id: output.scm,v 14.45 2009/03/21 16:50:26 riastradh Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -76,6 +76,11 @@ USA.
   (let ((operation (port/operation port 'BYTES-WRITTEN)))
     (and operation
         (operation port))))
+
+(define (output-port/synchronize-output port)
+  (let ((operation (port/operation port 'SYNCHRONIZE-OUTPUT)))
+    (if operation
+       (operation port))))
 \f
 ;;;; High level
 

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index a350cd551f4a4b4fda0a088e7b63aba934eb56e2..130504572bc8671a921ee01bfe13d32a37a3defa 100644 (file)
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.690 2009/03/21 07:09:09 riastradh Exp $
+$Id: runtime.pkg,v 14.691 2009/03/21 16:50:26 riastradh Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -2147,6 +2147,7 @@ USA.
          output-port/flush-output
          output-port/fresh-line
          output-port/line-start?
+         output-port/synchronize-output
          output-port/write-char
          output-port/write-object
          output-port/write-string