From 389a7e838753cafd1edfbc922ca592e371f7ae34 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Sun, 8 Jan 2017 13:31:56 -0800
Subject: [PATCH] Eliminate use of external strings in Edwin.

---
 src/edwin/struct.scm   | 16 +++-------------
 src/edwin/utils.scm    | 19 ++-----------------
 src/microcode/edwin.h  |  2 +-
 src/microcode/extern.h |  1 +
 src/microcode/string.c |  8 ++++++++
 5 files changed, 15 insertions(+), 31 deletions(-)

diff --git a/src/edwin/struct.scm b/src/edwin/struct.scm
index 93953c241..f1dba5bcb 100644
--- a/src/edwin/struct.scm
+++ b/src/edwin/struct.scm
@@ -73,10 +73,10 @@ USA.
 		   (named)
 		   (constructor %make-group (buffer)))
   ;; The microcode file "edwin.h" depends on this structure being a
-  ;; named vector, and knows the indexes of the fields TEXT-DESCRIPTOR,
+  ;; named vector, and knows the indexes of the fields TEXT,
   ;; GAP-START, GAP-LENGTH, GAP-END, START-MARK, END-MARK, and
   ;; MODIFIED?.
-  text-descriptor
+  text
   (gap-start 0)
   (gap-length 0)
   (gap-end 0)
@@ -96,8 +96,7 @@ USA.
   buffer
   (shrink-length 0)
   (text-properties #f)
-  (%hash-number #f)
-  %text)
+  (%hash-number #f))
 
 (define-integrable group-point group-%point)
 
@@ -113,15 +112,6 @@ USA.
     (set-group-%point! group (make-permanent-mark group 0 #t))
     group))
 
-(define (set-group-text! group text)
-  (without-interrupts
-   (lambda ()
-     (set-group-%text! group text)
-     (set-group-text-descriptor! group (external-string-descriptor text)))))
-
-(define-integrable (group-text group)
-  (group-%text group))
-
 (define (group-length group)
   (fix:- (xstring-length (group-text group)) (group-gap-length group)))
 
diff --git a/src/edwin/utils.scm b/src/edwin/utils.scm
index 45f9f7bbf..9d4a814ea 100644
--- a/src/edwin/utils.scm
+++ b/src/edwin/utils.scm
@@ -63,20 +63,8 @@ USA.
   ;; Too much of Edwin relies on fixnum-specific arithmetic for this
   ;; to be safe.  Unfortunately, this means that Edwin can't edit
   ;; files >32MB.
-  (let ((signal-failure
-	 (lambda ()
-	   (error:allocation-failure (chars->words n-chars)
-				     'ALLOCATE-BUFFER-STORAGE))))
-    (if (not (fix:fixnum? n-chars))
-	(signal-failure)
-	;; The ALLOCATE-EXTERNAL-STRING signals a bad-range-argument
-	;; if the allocation with `malloc' (or `mmap') fails.
-	(bind-condition-handler (list condition-type:bad-range-argument)
-	    (lambda (condition)
-	      condition
-	      (signal-failure))
-	  (lambda ()
-	    (allocate-external-string n-chars))))))
+  (guarantee-index-fixnum n-chars 'ALLOCATE-BUFFER-STORAGE)
+  (make-string n-chars))
 
 (define-syntax chars-to-words-shift
   (sc-macro-transformer
@@ -134,9 +122,6 @@ USA.
 			  target start-target)
   (cond ((not (fix:< start-source end-source))
 	 unspecific)
-	((or (external-string? source) (external-string? target))
-	 (xsubstring-move! source start-source end-source
-			   target start-target))
 	((not (eq? source target))
 	 (if (fix:< (fix:- end-source start-source) 32)
 	     (do ((scan-source start-source (fix:+ scan-source 1))
diff --git a/src/microcode/edwin.h b/src/microcode/edwin.h
index 822e0b427..95a6bb9d8 100644
--- a/src/microcode/edwin.h
+++ b/src/microcode/edwin.h
@@ -30,7 +30,7 @@ USA.
 #define GROUP_P VECTOR_P
 
 #define GROUP_TEXT(group, len_r)					\
-  (lookup_external_string ((VECTOR_REF ((group), 1)), (len_r)))
+  (string_to_char_pointer ((VECTOR_REF ((group), 1)), (len_r)))
 
 #define GROUP_TEXT_LOC(group, offset) ((GROUP_TEXT ((group), 0)) + (offset))
 #define GROUP_GAP_START(group) (FIXNUM_TO_ULONG (VECTOR_REF ((group), 2)))
diff --git a/src/microcode/extern.h b/src/microcode/extern.h
index 86d69b238..24517a928 100644
--- a/src/microcode/extern.h
+++ b/src/microcode/extern.h
@@ -295,6 +295,7 @@ extern SCHEME_OBJECT memory_to_string (unsigned long, const void *);
 extern SCHEME_OBJECT memory_to_string_no_gc (unsigned long, const void *);
 extern SCHEME_OBJECT char_pointer_to_string (const char *);
 extern SCHEME_OBJECT char_pointer_to_string_no_gc (const char *);
+extern unsigned char * string_to_char_pointer (SCHEME_OBJECT, unsigned long *);
 extern SCHEME_OBJECT allocate_bit_string (unsigned long);
 extern const char * arg_symbol (int);
 extern const char * arg_interned_symbol (int);
diff --git a/src/microcode/string.c b/src/microcode/string.c
index ebbb46274..036c76513 100644
--- a/src/microcode/string.c
+++ b/src/microcode/string.c
@@ -84,6 +84,14 @@ char_pointer_to_string_no_gc (const char * cp)
       ;
   return (memory_to_string_no_gc (((scan - 1) - cp), cp));
 }
+
+unsigned char *
+string_to_char_pointer (SCHEME_OBJECT string, unsigned long * lp)
+{
+  if (lp != 0)
+    (*lp) = (STRING_LENGTH (string));
+  return (STRING_LOC (string, 0));
+}
 
 /* Currently the strings used in symbols have type codes in the length
    field.  They should be changed to have just longwords there.  */
-- 
2.25.1