Adapt LIARC to use new strings.

diff --git a/src/compiler/machines/C/cout.scm b/src/compiler/machines/C/cout.scm
index cc998b041ec6893290d335d2e607b28f0d3744fc..ce152b5dc144248a2717ca044969d72521f1b5ae 100644 (file)
--- a/src/compiler/machines/C/cout.scm
+++ b/src/compiler/machines/C/cout.scm
@@ -603,31 +603,33 @@ USA.
 ;; the characters are not really characters at all.
 
 (define (C-quotify-data-string/breakup string)
-  (let ((n-bytes (vector-8b-length string))
-       (new-string
-        (lambda ()
-          (let ((s (make-string 66)))
-            (string-set! s 0 #\")
-            s))))
-    (let loop ((i 0) (s (new-string)) (j 1))
-      (if (fix:< i n-bytes)
-         (if (fix:< j 62)
-             (let ((b (vector-8b-ref string i)))
-               (string-set! s j #\\)
-               (string-set! s (fix:+ j 1) #\x)
-               (string-set! s (fix:+ j 2)
-                            (digit->char (fix:quotient b #x10) 16))
-               (string-set! s (fix:+ j 3)
-                            (digit->char (fix:remainder b #x10) 16))
-               (loop (fix:+ i 1) s (fix:+ j 4)))
-             (begin
-               (string-set! s j #\")
-               (cons s (loop i (new-string) 1))))
-         (if (fix:> j 1)
-             (begin
-               (string-set! s j #\")
-               (list (substring s 0 (fix:+ j 1))))
-             '())))))
+  (let ((builder (string-builder)))
+    (map (lambda (part)
+          (builder 'reset!)
+          (builder #\")
+          (string-for-each
+           (lambda (char)
+             (let ((b (char->integer char)))
+               (builder #\\)
+               (builder #\x)
+               (builder (digit->char (fix:quotient b #x10) 16))
+               (builder (digit->char (fix:remainder b #x10) 16))))
+           part)
+          (builder #\")
+          (builder 'immutable))
+        (split-string string 64))))
+
+(define (split-string string n)
+  (let ((len (string-length string)))
+    (let loop ((start 0) (parts '()))
+      (let ((end (fix:+ start n)))
+       (if (fix:<= end len)
+           (reverse!
+            (cons (string-slice string start len)
+                  parts))
+           (loop end
+                 (cons (string-slice string start end)
+                       parts)))))))
 \f
 (define (handle-objects start-offset)
   (if *use-stackify?*

diff --git a/src/compiler/machines/C/ctop.scm b/src/compiler/machines/C/ctop.scm
index 3193fdacccea88762ec3fd62c71b23c7c577a63e..0c8ed3922fe2d8ec6af3520bdf35b9ca16e78421 100644 (file)
--- a/src/compiler/machines/C/ctop.scm
+++ b/src/compiler/machines/C/ctop.scm
@@ -435,21 +435,18 @@ USA.
 
 (define compiler:dump-info-file compiler:dump-bci-file)
 \f
-;; This defintion exported to compiler to handle losing C name restrictions
+;; This definition exported to compiler to handle losing C name restrictions.
 
 (define (canonicalize-label-name prefix)
   (if (string-null? prefix)
       "empty_string"
-      (let* ((str (if (char-alphabetic? (string-ref prefix 0))
-                     (string-copy prefix)
-                     (string-append "Z_" prefix)))
-            (len (string-length str)))
-       (do ((i 0 (1+ i)))
-           ((>= i len) str)
-         (let ((char (string-ref str i)))
-           (if (not (char-alphanumeric? char))
-               (string-set! str i
-                            (case char
-                              ((#\?) #\P)
-                              ((#\!) #\B)
-                              (else #\_)))))))))
+      (string-map (lambda (char)
+                   (if (char-alphanumeric? char)
+                       char
+                       (case char
+                         ((#\?) #\P)
+                         ((#\!) #\B)
+                         (else #\_))))
+                 (if (char-alphabetic? (string-ref prefix 0))
+                     prefix
+                     (string-append "Z_" prefix)))))
\ No newline at end of file

diff --git a/src/compiler/machines/C/stackify.scm b/src/compiler/machines/C/stackify.scm
index d7fd2d568d0e97efbab3e08c820b9077b20b9635..6dcd3ee0f3ee754344ffd1d27a7798af3773f157 100644 (file)
--- a/src/compiler/machines/C/stackify.scm
+++ b/src/compiler/machines/C/stackify.scm
@@ -250,7 +250,7 @@ USA.
        (length (string-list/length sl)))
     (if (fix:< ptr (string-length current))
        (begin
-         (vector-8b-set! current ptr byte)
+         (string-set! current ptr (integer->char byte))
          (set-string-list/pointer! sl (fix:+ ptr 1))
          (set-string-list/length! sl (fix:+ length 1))
          sl)

diff --git a/src/compiler/machines/C/stackops.scm b/src/compiler/machines/C/stackops.scm
index 709e6ac03d40d157ceac10d792a0516e54450e90..4582b4a8355e66b8f51dc03a7f77be56b7913b88 100644 (file)
--- a/src/compiler/machines/C/stackops.scm
+++ b/src/compiler/machines/C/stackops.scm
@@ -359,20 +359,13 @@ push-primitive-7                  ; name in string table
        unspecific)))
 
 (define (stackify/c-quotify str)
-  (let* ((len (string-length str))
-        (res (make-string len)))
-    (do ((i 0 (1+ i)))
-       ((>= i len) res)
-      (let ((c (string-ref str i)))
-       (case c
-         ((#\*)
-          (string-set! res i #\S))
-         ((#\- #\/)
-          (string-set! res i #\_))
-         ((#\+)
-          (string-set! res i #\P))
-         (else
-          (string-set! res i c)))))))
+  (string-map (lambda (c)
+               (case c
+                 ((#\*) #\S)
+                 ((#\- #\/) #\_)
+                 ((#\+) #\P)
+                 (else c)))
+             str))
 
 (define (stackify/dump-c-enums output)
   (with-output-to-file output