Added xstring-byte-ref/set! for external string buffers.

To replace vector-8b-ref/set! in generic-i/o, to allow external string
buffers.

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index bd205aab06045df31fc0a95938460f5ee01ff810..fe0413d72a99a0fa4c3d4f3b762877a97eee3fa8 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -1063,7 +1063,9 @@ USA.
          xstring-length
          xstring-move!
          xstring-ref
+         xstring-byte-ref
          xstring-set!
+         xstring-byte-set!
          xstring?
          xsubstring
          xsubstring-fill!

diff --git a/src/runtime/string.scm b/src/runtime/string.scm
index fe0de39c2ac6d464910b09080f93ebc5a9eb9cd2..28b726f459dbd7c1813eef6d66ce28485cede5e2 100644 (file)
--- a/src/runtime/string.scm
+++ b/src/runtime/string.scm
@@ -1523,14 +1523,20 @@ USA.
        ((ucode-primitive allocate-external-string) n-bytes)
        n-bytes)))))
 
-(define (external-string-ref string index)
+(define-integrable (external-string-ref string index)
   (ascii->char
-   ((ucode-primitive read-byte-from-memory)
-    (+ (external-string-descriptor string) index))))
+   (external-string-byte-ref string index)))
 
-(define (external-string-set! string index char)
+(define-integrable (external-string-byte-ref string index)
+  ((ucode-primitive read-byte-from-memory)
+   (+ (external-string-descriptor string) index)))
+
+(define-integrable (external-string-set! string index char)
+  (external-string-byte-set! string index (char->ascii char)))
+
+(define-integrable (external-string-byte-set! string index byte)
   ((ucode-primitive write-byte-to-memory)
-   (char->ascii char)
+   byte
    (+ (external-string-descriptor string) index)))
 
 (define-integrable (external-substring-fill! string start end char)
@@ -1556,12 +1562,25 @@ USA.
        ((external-string? string) (external-string-ref string index))
        (else (error:not-xstring string 'XSTRING-REF))))
 
+(define (xstring-byte-ref string index)
+  (cond ((string? string) (vector-8b-ref string index))
+       ((wide-string? string) (wide-string-ref string index))
+       ((external-string? string) (external-string-byte-ref string index))
+       (else (error:not-xstring string 'XSTRING-BYTE-REF))))
+
 (define (xstring-set! string index char)
   (cond ((string? string) (string-set! string index char))
        ((wide-string? string) (wide-string-set! string index char))
        ((external-string? string) (external-string-set! string index char))
        (else (error:not-xstring string 'XSTRING-SET!))))
 
+(define (xstring-byte-set! string index byte)
+  (cond ((string? string) (vector-8b-set! string index byte))
+       ((wide-string? string) (wide-string-set! string index byte))
+       ((external-string? string)
+        (external-string-byte-set! string index byte))
+       (else (error:not-xstring string 'XSTRING-BYTE-SET!))))
+
 (define (xstring-move! xstring1 xstring2 start2)
   (xsubstring-move! xstring1 0 (xstring-length xstring1) xstring2 start2))