From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 5 Jan 2001 20:15:29 +0000 (+0000)
Subject: Pass external-string descriptor to substring-move-FOO! rather than
X-Git-Tag: 20090517-FFI~3017
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=182d51a46661f5d1811b55258cfaf081bd5c871f;p=mit-scheme.git

Pass external-string descriptor to substring-move-FOO! rather than
runtime's wrapper.
---

diff --git a/v7/src/runtime/string.scm b/v7/src/runtime/string.scm
index 5c04f73a9..8464060e5 100644
--- a/v7/src/runtime/string.scm
+++ b/v7/src/runtime/string.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: string.scm,v 14.37 2001/01/05 20:06:52 cph Exp $
+$Id: string.scm,v 14.38 2001/01/05 20:15:29 cph Exp $
 
 Copyright (c) 1988-2001 Massachusetts Institute of Technology
 
@@ -1009,10 +1009,17 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   (xsubstring-move! xstring1 0 (xstring-length xstring1) xstring2 start2))
 
 (define (xsubstring-move! xstring1 start1 end1 xstring2 start2)
-  (cond ((or (not (eq? xstring2 xstring1)) (< start2 start1))
-	 (substring-move-left! xstring1 start1 end1 xstring2 start2))
-	((> start2 start1)
-	 (substring-move-right! xstring1 0 end1 xstring2 start2))))
+  (let ((deref
+	 (lambda (xstring)
+	   (if (external-string? xstring)
+	       (external-string-descriptor xstring)
+	       xstring))))
+    (cond ((or (not (eq? xstring2 xstring1)) (< start2 start1))
+	   (substring-move-left! (deref xstring1) start1 end1
+				 (deref xstring2) start2))
+	  ((> start2 start1)
+	   (substring-move-right! (deref xstring1) start1 end1
+				  (deref xstring2) start2)))))
 
 ;;;; Guarantors
 ;;