From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 9 Jan 2017 03:34:07 +0000 (-0800)
Subject: Implement support for converting legacy strings to bytevectors.
X-Git-Tag: mit-scheme-pucked-9.2.12~227^2~170
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=98bf6d7e8eff54e375146ddc31c582052573ef27;p=mit-scheme.git

Implement support for converting legacy strings to bytevectors.
---

diff --git a/src/runtime/bytevector.scm b/src/runtime/bytevector.scm
index 281b86247..23a439fb9 100644
--- a/src/runtime/bytevector.scm
+++ b/src/runtime/bytevector.scm
@@ -54,6 +54,16 @@ USA.
       (bytevector-u8-set! bytevector i (car bytes)))
     bytevector))
 
+(define (legacy-string->bytevector string)
+  (if (bytevector? string)
+      string
+      (begin
+	(guarantee legacy-string? string 'legacy-string->bytevector)
+	(object-new-type bytevector-type string))))
+
+;;; TODO(cph): eliminate after 9.3 release:
+(define-integrable bytevector-type #x33)
+
 (define (bytevector-append . bytevectors)
   (let* ((k
 	  (do ((bytevectors bytevectors (cdr bytevectors))
diff --git a/src/runtime/predicate-metadata.scm b/src/runtime/predicate-metadata.scm
index ab66b660b..d26dcf342 100644
--- a/src/runtime/predicate-metadata.scm
+++ b/src/runtime/predicate-metadata.scm
@@ -308,6 +308,7 @@ USA.
    (register-predicate! interned-symbol? 'interned-symbol '<= symbol?)
    (register-predicate! keyword? 'keyword '<= symbol?)
    (register-predicate! lambda-tag? 'lambda-tag)
+   (register-predicate! legacy-string? 'legacy-string)
    (register-predicate! named-structure? 'named-structure)
    (register-predicate! population? 'population)
    (register-predicate! promise? 'promise)
diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 1eb46e7e7..1125727b6 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -969,6 +969,7 @@ USA.
 	  guarantee-substring-start-index
 	  guarantee-xstring
 	  hexadecimal->vector-8b
+	  legacy-string?
 	  lisp-string->camel-case
 	  list->string
 	  make-string
@@ -1127,6 +1128,7 @@ USA.
 	  bytevector-u8-set!
 	  bytevector=?
 	  bytevector?
+	  legacy-string->bytevector
 	  make-bytevector
 	  string->utf8
 	  utf8->string))
diff --git a/src/runtime/string.scm b/src/runtime/string.scm
index 7e9e6b03c..6293b9fce 100644
--- a/src/runtime/string.scm
+++ b/src/runtime/string.scm
@@ -43,6 +43,7 @@ USA.
 ;;;; Primitives
 
 (define-primitives
+  (legacy-string? string? 1)
   (set-string-length! 2)
   (string-allocate 1)
   (string-hash-mod 2)