From 535f1d0f767393b1e39adf6886d94c5b5e616be8 Mon Sep 17 00:00:00 2001
From: Matt Birkholz <matt@birkholz.chandler.az.us>
Date: Thu, 12 Sep 2013 12:07:57 -0700
Subject: [PATCH] Add xstring-byte-ref and xstring-byte-set!.
Made external-string-ref and external-string-set! integrable.
---
src/runtime/runtime.pkg | 2 ++
src/runtime/string.scm | 29 ++++++++++++++++++++++++-----
2 files changed, 26 insertions(+), 5 deletions(-)
diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index cf4d0d243..b710d8820 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -1075,7 +1075,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 41567ee7e..f7279c8fe 100644
--- a/src/runtime/string.scm
+++ b/src/runtime/string.scm
@@ -1607,14 +1607,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)
@@ -1640,12 +1646,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))
--
2.25.1