* string transition completed. string data is now 32-bit

tagged characters.

bin/ikarus-data.h

@@ -98,11 +98,13 @@
 #define off_string_data (disp_string_data - string_tag)
 
 //#define string_data(x)  ((char*)((x) + off_string_data))
+//#define string_set(x,i,c) 
+//  ((((unsigned char*)(x)) + off_string_data + (int)(i))[0] = 
+//   (((int)(c)) >> IK_CHAR_SHIFT))
 #define string_set(x,i,c) \
-  ((((unsigned char*)(x)) + off_string_data + (int)(i))[0] = \
-   (((int)(c)) >> IK_CHAR_SHIFT))
+  (((ikp*)(((ikp)(x)) + off_string_data))[i] = ((ikp)(c)))
 #define integer_to_char(x) ((ikp)((((int)(x)) << IK_CHAR_SHIFT) + IK_CHAR_TAG))
-#define string_char_size 1
+#define string_char_size 4
 
 #define vector_tag 5
 #define disp_vector_length 0

src/ikarus.compiler.ss

@@ -1959,8 +1959,7 @@
       [($vector-ref $vector-set!)
        (and ((check op vector?) (car rand*))
             ((check op nonnegative-fixnum?) (cadr rand*)))]
-      [($string-ref $string-set!
-        $string-ref-16+0 $string-ref-16+1 $string-ref-8+0 $string-ref-8+2)
+      [($string-ref $string-set!)
        (and ((check op string?) (car rand*))
             ((check op nonnegative-fixnum?) (cadr rand*)))]
       [($symbol-string $symbol-unique-string)
@@ -2345,17 +2344,15 @@
            [($frame->continuation $code->closure) 
             (check-const 
               (fx+ disp-closure-data (fx* (length arg*) wordsize)) x)]
-           [($make-string $make-bytevector) 
+           [($make-bytevector) 
             (record-case (car arg*)
               [(constant i)
                (check-const (fx+ i (fx+ disp-string-data 1)) x)]
               [else
                (check-bytes (fxadd1 disp-string-data) (car arg*) x)])]
-           [($string)
-            (check-const (fx+ (length arg*) (fx+ disp-string-data 1)) x)]
            [($make-port/input $make-port/output $make-port/both)
             (check-const port-size x)]
-           [($make-vector) 
+           [($make-vector $make-string) 
             (record-case (car arg*)
               [(constant i)
                (check-const (fx+ (fx* i wordsize) disp-vector-data) x)]
@@ -2371,7 +2368,7 @@
             (check-const (fx* (fxsub1 (length arg*)) pair-size) x)]
            [(list)
             (check-const (fx* (length arg*) pair-size) x)]
-           [(vector $record)
+           [(vector $record $string)
             (check-const (fx+ (fx* (length arg*) wordsize) disp-vector-data) x)]
            [else x]))]
       [(forcall op arg*)
@@ -3829,6 +3826,12 @@
               (movb (mem (fx- disp-bignum-data record-tag) ebx) al)
               (sall (int fx-shift) eax)
               ac)]
+      ; STRING
+      [($string-ref) 
+       (list* (movl (Simple (cadr arg*)) ebx)
+              (addl (Simple (car arg*)) ebx)
+              (movl (mem (fx- disp-string-data string-tag) ebx) eax)
+              ac)] 
       [($string-ref) 
        (list* (movl (Simple (cadr arg*)) ebx)
               (sarl (int fx-shift) ebx)
@@ -3836,6 +3839,17 @@
               (movl (int char-tag) eax)
               (movb (mem (fx- disp-string-data string-tag) ebx) ah)
               ac)]
+      ; STRING
+      [($make-string) 
+       (list* (movl (Simple (car arg*)) ebx)
+              (movl ebx (mem disp-string-length apr))
+              (movl apr eax)
+              (addl (int string-tag) eax)
+              (addl ebx apr)
+              (addl (int (fx+ disp-string-data (fxsub1 object-alignment))) apr)
+              (sarl (int align-shift) apr)
+              (sall (int align-shift) apr)
+              ac)]
       [($make-string) 
        (list* (movl (Simple (car arg*)) ebx)
               (movl ebx (mem disp-string-length apr))
@@ -3993,6 +4007,21 @@
             (list* (movl (Simple (car arg*)) eax)
                    (movl eax (mem idx apr))
                    (f (cdr arg*) (fx+ idx wordsize)))]))]
+     ; STRING
+      [($string) 
+       (let f ([arg* arg*] [idx disp-string-data])
+         (cond
+           [(null? arg*) 
+            (list* (movl apr eax)
+                   (addl (int string-tag) eax)
+                   (movl (int (fx- idx disp-string-data))
+                         (mem disp-string-length apr))
+                   (addl (int (align idx)) apr)
+                   ac)]
+           [else 
+            (list* (movl (Simple (car arg*)) eax)
+                   (movl eax (mem idx apr))
+                   (f (cdr arg*) (fx+ idx wordsize)))]))] 
      [($string)
       (let f ([arg* arg*] [idx disp-string-data])
         (cond
@@ -4157,6 +4186,13 @@
               (sall (int (fx- 8 fx-shift)) ebx) ;;; move to high byte
               (movb bh (mem (fx- disp-code-data vector-tag) eax))
               ac)]
+      ; STRING
+      [($string-set!) 
+       (list* (movl (Simple (cadr arg*)) eax)
+              (addl (Simple (car arg*)) eax)
+              (movl (Simple (caddr arg*)) ebx)
+              (movl ebx (mem (fx- disp-string-data string-tag) eax))
+              ac)]
       [($string-set!) 
        (list* (movl (Simple (cadr arg*)) eax)
               (sarl (int fx-shift) eax)

src/ikarus.strings.ss

@@ -28,7 +28,10 @@
     (unless (and ($fx< i ($string-length s))
                  ($fx<= 0 i))
       (error 'string-ref "index ~s is out of range for ~s" i s))
-    ($string-ref s i))
+    (let ([c ($string-ref s i)])
+      (unless (char? c)
+        (error 'string-ref "BUG: got a non-char"))
+      c))
   
 
   (define string-set!