From 81e278355c9220d6c05f408b6626354db71899f2 Mon Sep 17 00:00:00 2001
From: "Taylor R. Campbell" <net/mumble/campbell>
Date: Sat, 21 Mar 2009 16:50:26 +0000
Subject: [PATCH] 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.

---
 v7/src/edwin/fileio.scm    |  8 +++++---
 v7/src/runtime/genio.scm   | 10 ++++++++--
 v7/src/runtime/output.scm  |  7 ++++++-
 v7/src/runtime/runtime.pkg |  3 ++-
 4 files changed, 21 insertions(+), 7 deletions(-)

diff --git a/v7/src/edwin/fileio.scm b/v7/src/edwin/fileio.scm
index 4e3012a71..d909a99dd 100644
--- 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 e68ce7f81..cf27fb1ea 100644
--- 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 2db2df0b8..20dce3448 100644
--- 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))))
 
 ;;;; High level
 
diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index a350cd551..130504572 100644
--- 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
-- 
2.25.1