* string transition completed. string data is now 32-bit
tagged characters.
This commit is contained in:
parent
182de12428
commit
1abce54167
BIN
bin/ikarus
BIN
bin/ikarus
Binary file not shown.
|
@ -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
|
||||
|
|
BIN
src/ikarus.boot
BIN
src/ikarus.boot
Binary file not shown.
|
@ -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)
|
||||
|
|
|
@ -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!
|
||||
|
|
Loading…
Reference in New Issue