Eliminate use of external strings in Edwin.

diff --git a/src/edwin/struct.scm b/src/edwin/struct.scm
index 93953c2410630876d8f22f2cc0f88451b55fb6d9..f1dba5bcb9a28d72f9d7d6f051e945e5a34b73da 100644 (file)
--- 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)
 \f
@@ -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 45f9f7bbf8a0b4a5e3b602170ee9fcac28da6c71..9d4a814ea503267bfcaee2481603d019f799bbe1 100644 (file)
--- 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))
 \f
 (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 822e0b427c595ca54117f1cdc21fae9e43829b50..95a6bb9d88279477e8fd29423bd28630ebbc1118 100644 (file)
--- 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 86d69b23855d6708b83cbfd4809757fa295863f3..24517a9282f3c193db1e48597e9ab05f74106865 100644 (file)
--- 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 ebbb4627411891e913fe5320d74c413f1b4831ee..036c765133f765a2dcec79672782266e4d3c592a 100644 (file)
--- 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));
+}
 \f
 /* Currently the strings used in symbols have type codes in the length
    field.  They should be changed to have just longwords there.  */