diff --git a/bin/ikarus b/bin/ikarus index ca1bf67..541421a 100755 Binary files a/bin/ikarus and b/bin/ikarus differ diff --git a/bin/ikarus-data.h b/bin/ikarus-data.h index 5508783..bf86509 100644 --- a/bin/ikarus-data.h +++ b/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 diff --git a/src/ikarus.boot b/src/ikarus.boot index 439904f..d0434b0 100644 Binary files a/src/ikarus.boot and b/src/ikarus.boot differ diff --git a/src/ikarus.compiler.ss b/src/ikarus.compiler.ss index 77db7b7..302849a 100644 --- a/src/ikarus.compiler.ss +++ b/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) diff --git a/src/ikarus.strings.ss b/src/ikarus.strings.ss index 7a53999..8930769 100644 --- a/src/ikarus.strings.ss +++ b/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!