Strip off external-string wrapper before handing it to the microcode.
authorChris Hanson <org/chris-hanson/cph>
Sat, 6 Jan 2001 19:08:00 +0000 (19:08 +0000)
committerChris Hanson <org/chris-hanson/cph>
Sat, 6 Jan 2001 19:08:00 +0000 (19:08 +0000)
v7/src/runtime/io.scm
v7/src/runtime/runtime.pkg

index 386b1880f7bc7c0af41bc30f3e134d65cbd22d22..96a27bf52b9758d9465478f0d76db6cdb92ba969 100644 (file)
@@ -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.
 \f
 (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)))
index 132fdc7bda0a8ff707f60b0c802833fc8a7b852d..6bbad9f6c4f3c0aa7cd0fca1427fe668bb63292e 100644 (file)
@@ -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)