From 535f1d0f767393b1e39adf6886d94c5b5e616be8 Mon Sep 17 00:00:00 2001 From: Matt Birkholz 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