From: Chris Hanson <org/chris-hanson/cph>
Date: Sat, 6 Jan 2001 19:08:00 +0000 (+0000)
Subject: Strip off external-string wrapper before handing it to the microcode.
X-Git-Tag: 20090517-FFI~3006
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=3b08976c1fa4afd10178b3a8e20448ea4e6a3b1f;p=mit-scheme.git

Strip off external-string wrapper before handing it to the microcode.
---

diff --git a/v7/src/runtime/io.scm b/v7/src/runtime/io.scm
index 386b1880f..96a27bf52 100644
--- a/v7/src/runtime/io.scm
+++ b/v7/src/runtime/io.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: io.scm,v 14.61 2000/04/10 18:32:34 cph Exp $
+$Id: io.scm,v 14.62 2001/01/06 19:08:00 cph Exp $
 
-Copyright (c) 1988-2000 Massachusetts Institute of Technology
+Copyright (c) 1988-2001 Massachusetts Institute of Technology
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -230,8 +230,13 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 (define (channel-read channel buffer start end)
   (let ((do-read
 	 (lambda ()
-	   ((ucode-primitive channel-read 4) (channel-descriptor channel)
-					     buffer start end))))
+	   ((ucode-primitive channel-read 4)
+	    (channel-descriptor channel)
+	    (if (external-string? buffer)
+		(external-string-descriptor buffer)
+		buffer)
+	    start
+	    end))))
     (declare (integrate-operator do-read))
     (if (and have-select? (not (channel-type=file? channel)))
 	(with-thread-events-blocked
@@ -272,7 +277,11 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 
 (define (channel-write channel buffer start end)
   ((ucode-primitive channel-write 4) (channel-descriptor channel)
-				     buffer start end))
+				     (if (external-string? buffer)
+					 (external-string-descriptor buffer)
+					 buffer)
+				     start
+				     end))
 
 (define (channel-write-block channel buffer start end)
   (let loop ((start start) (n-left (- end start)))
diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index 132fdc7bd..6bbad9f6c 100644
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.357 2001/01/05 20:06:57 cph Exp $
+$Id: runtime.pkg,v 14.358 2001/01/06 19:07:55 cph Exp $
 
 Copyright (c) 1988-2001 Massachusetts Institute of Technology
 
@@ -203,6 +203,8 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 	  xsubstring-move!)
   (export (runtime char-syntax)
 	  guarantee-substring)
+  (export (runtime primitive-io)
+	  external-string-descriptor)
   (initialization (initialize-package!)))
 
 (define-package (runtime 1d-property)