From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 24 Jan 2017 16:57:38 +0000 (-0800)
Subject: Change reload-save-string/reload-retrieve-string to preserve type.
X-Git-Tag: mit-scheme-pucked-9.2.12~227^2~95
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=e3911d1632fd37be57bee1ac6212cd5d242195bd;p=mit-scheme.git

Change reload-save-string/reload-retrieve-string to preserve type.
---

diff --git a/src/microcode/boot.c b/src/microcode/boot.c
index 15fda4245..11fc8a25a 100644
--- a/src/microcode/boot.c
+++ b/src/microcode/boot.c
@@ -59,6 +59,7 @@ struct obstack ffi_obstack;
 void * initial_C_stack_pointer;
 static char * reload_saved_string;
 static unsigned int reload_saved_string_length;
+static bool reload_saved_legacy_p;
 
 void *
 obstack_chunk_alloc (size_t size)
@@ -291,21 +292,16 @@ DEFINE_PRIMITIVE ("RELOAD-SAVE-STRING", Prim_reload_save_string, 1, 1, 0)
   if ((ARG_REF (1)) != SHARP_F)
     {
       CHECK_ARG (1, STRING_P);
-      {
-	unsigned int length = (STRING_LENGTH (ARG_REF (1)));
-	if (length > 0)
-	  {
-	    reload_saved_string = (OS_malloc (length));
-	    reload_saved_string_length = length;
-	    {
-	      char * scan = (STRING_POINTER (ARG_REF (1)));
-	      char * end = (scan + length);
-	      char * scan_result = reload_saved_string;
-	      while (scan < end)
-		(*scan_result++) = (*scan++);
-	    }
-	  }
-      }
+      SCHEME_OBJECT string = (ARG_REF (1));
+      unsigned int length = (STRING_LENGTH (string));
+      if (length > 0)
+        {
+          reload_saved_legacy_p = (LEGACY_STRING_P (string));
+          reload_saved_string = (OS_malloc (length));
+          reload_saved_string_length = length;
+
+          memcpy (reload_saved_string, (STRING_POINTER (string)), length);
+        }
     }
   PRIMITIVE_RETURN (UNSPECIFIC);
 }
@@ -315,14 +311,15 @@ DEFINE_PRIMITIVE ("RELOAD-RETRIEVE-STRING", Prim_reload_retrieve_string, 0, 0, 0
   PRIMITIVE_HEADER (0);
   if (reload_saved_string == 0)
     PRIMITIVE_RETURN (SHARP_F);
-  {
-    SCHEME_OBJECT result =
-      (memory_to_string (reload_saved_string_length,
-			 ((unsigned char *) reload_saved_string)));
-    free (reload_saved_string);
-    reload_saved_string = 0;
-    PRIMITIVE_RETURN (result);
-  }
+
+  SCHEME_OBJECT result = reload_saved_legacy_p
+    ? (memory_to_string (reload_saved_string_length,
+                         ((unsigned char *) reload_saved_string)))
+    : (memory_to_bytevector (reload_saved_string_length,
+                             ((unsigned char *) reload_saved_string)));
+  free (reload_saved_string);
+  reload_saved_string = 0;
+  PRIMITIVE_RETURN (result);
 }
 
 DEFINE_PRIMITIVE ("BATCH-MODE?", Prim_batch_mode_p, 0, 0, 0)
diff --git a/src/microcode/bytevector.c b/src/microcode/bytevector.c
index cf103da29..bf070b6bc 100644
--- a/src/microcode/bytevector.c
+++ b/src/microcode/bytevector.c
@@ -37,7 +37,7 @@ USA.
 
 #define BYTEVECTOR_POINTER(v) ((uint8_t *) (MEMORY_LOC ((v), BYTEVECTOR_DATA)))
 
-static uint8_t *
+uint8_t *
 arg_bytevector (int n, unsigned long * len_r)
 {
   CHECK_ARG (n, BYTEVECTOR_P);
@@ -58,7 +58,7 @@ arg_byte (int n)
   return (uint8_t) value;
 }
 
-static SCHEME_OBJECT
+SCHEME_OBJECT
 allocate_bytevector (unsigned long nbytes)
 {
   SCHEME_OBJECT result
@@ -70,7 +70,7 @@ allocate_bytevector (unsigned long nbytes)
   return (result);
 }
 
-static SCHEME_OBJECT
+SCHEME_OBJECT
 memory_to_bytevector (unsigned long n_bytes, const void * vp)
 {
   SCHEME_OBJECT result = (allocate_bytevector (n_bytes));
diff --git a/src/microcode/extern.h b/src/microcode/extern.h
index 47b51877b..c6f77061e 100644
--- a/src/microcode/extern.h
+++ b/src/microcode/extern.h
@@ -298,6 +298,9 @@ 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 uint8_t * arg_bytevector (int, unsigned long *);
+extern SCHEME_OBJECT allocate_bytevector (unsigned long);
+extern SCHEME_OBJECT memory_to_bytevector (unsigned long, const void *);
 extern SCHEME_OBJECT allocate_bit_string (unsigned long);
 extern const char * arg_symbol (int);
 extern const char * arg_interned_symbol (int);