From 6eacca0caa47bdb90b2fe0e961a410c90cdf83e0 Mon Sep 17 00:00:00 2001 From: dvanhorn Date: Fri, 31 Oct 2025 19:21:05 +0000 Subject: [PATCH] crook --- hoax/compile-ops.rkt | 18 ++++++------------ hoax/test/test-runner.rkt | 4 ++++ iniquity/compile-ops.rkt | 18 ++++++------------ iniquity/test/test-runner.rkt | 4 ++++ jig/compile-ops.rkt | 18 ++++++------------ jig/test/test-runner.rkt | 4 ++++ knock/compile-ops.rkt | 18 ++++++------------ knock/test/test-runner.rkt | 4 ++++ loot/compile-ops.rkt | 18 ++++++------------ loot/test/test-runner.rkt | 4 ++++ 10 files changed, 50 insertions(+), 60 deletions(-) diff --git a/hoax/compile-ops.rkt b/hoax/compile-ops.rkt index 035536b..1bb76cb 100644 --- a/hoax/compile-ops.rkt +++ b/hoax/compile-ops.rkt @@ -218,18 +218,12 @@ (seq (Pop r10) (Pop r8) (assert-vector r8) - (assert-integer r10) - (Cmp r10 0) - (Jl 'err) - (Xor r8 type-vect) ; r8 = ptr - (Mov r9 (Mem r8)) ; r9 = len - (Sar r10 int-shift) ; r10 = index - (Sub r9 1) - (Cmp r9 r10) - (Jl 'err) - (Sal r10 3) - (Add r8 r10) - (Mov (Mem r8 8) rax) + (assert-natural r10) + (Mov r9 (Mem r8 (- type-vect))) + (Cmp r10 r9) + (Jge 'err) + (Sar r10 1) ; convert to byte offset + (Mov (Mem r8 r10 (- 8 type-vect)) rax) (Mov rax (value->bits (void))))])) (define (type-pred mask type) diff --git a/hoax/test/test-runner.rkt b/hoax/test/test-runner.rkt index 29eff4b..3b3f151 100644 --- a/hoax/test/test-runner.rkt +++ b/hoax/test/test-runner.rkt @@ -138,6 +138,10 @@ (begin (vector-set! x 1 4) x))) #(5 4 5)) + (check-equal? (run '(let ((x (make-vector 3 5))) + (begin (vector-set! x 3 4) + x))) + 'err) (check-equal? (run '(vector-length (make-vector 3 #f))) 3) (check-equal? (run '(vector-length (make-vector 0 #f))) 0) (check-equal? (run '"") "") diff --git a/iniquity/compile-ops.rkt b/iniquity/compile-ops.rkt index 035536b..1bb76cb 100644 --- a/iniquity/compile-ops.rkt +++ b/iniquity/compile-ops.rkt @@ -218,18 +218,12 @@ (seq (Pop r10) (Pop r8) (assert-vector r8) - (assert-integer r10) - (Cmp r10 0) - (Jl 'err) - (Xor r8 type-vect) ; r8 = ptr - (Mov r9 (Mem r8)) ; r9 = len - (Sar r10 int-shift) ; r10 = index - (Sub r9 1) - (Cmp r9 r10) - (Jl 'err) - (Sal r10 3) - (Add r8 r10) - (Mov (Mem r8 8) rax) + (assert-natural r10) + (Mov r9 (Mem r8 (- type-vect))) + (Cmp r10 r9) + (Jge 'err) + (Sar r10 1) ; convert to byte offset + (Mov (Mem r8 r10 (- 8 type-vect)) rax) (Mov rax (value->bits (void))))])) (define (type-pred mask type) diff --git a/iniquity/test/test-runner.rkt b/iniquity/test/test-runner.rkt index 558308f..d2e9383 100644 --- a/iniquity/test/test-runner.rkt +++ b/iniquity/test/test-runner.rkt @@ -138,6 +138,10 @@ (begin (vector-set! x 1 4) x))) #(5 4 5)) + (check-equal? (run '(let ((x (make-vector 3 5))) + (begin (vector-set! x 3 4) + x))) + 'err) (check-equal? (run '(vector-length (make-vector 3 #f))) 3) (check-equal? (run '(vector-length (make-vector 0 #f))) 0) (check-equal? (run '"") "") diff --git a/jig/compile-ops.rkt b/jig/compile-ops.rkt index 035536b..1bb76cb 100644 --- a/jig/compile-ops.rkt +++ b/jig/compile-ops.rkt @@ -218,18 +218,12 @@ (seq (Pop r10) (Pop r8) (assert-vector r8) - (assert-integer r10) - (Cmp r10 0) - (Jl 'err) - (Xor r8 type-vect) ; r8 = ptr - (Mov r9 (Mem r8)) ; r9 = len - (Sar r10 int-shift) ; r10 = index - (Sub r9 1) - (Cmp r9 r10) - (Jl 'err) - (Sal r10 3) - (Add r8 r10) - (Mov (Mem r8 8) rax) + (assert-natural r10) + (Mov r9 (Mem r8 (- type-vect))) + (Cmp r10 r9) + (Jge 'err) + (Sar r10 1) ; convert to byte offset + (Mov (Mem r8 r10 (- 8 type-vect)) rax) (Mov rax (value->bits (void))))])) (define (type-pred mask type) diff --git a/jig/test/test-runner.rkt b/jig/test/test-runner.rkt index 558308f..d2e9383 100644 --- a/jig/test/test-runner.rkt +++ b/jig/test/test-runner.rkt @@ -138,6 +138,10 @@ (begin (vector-set! x 1 4) x))) #(5 4 5)) + (check-equal? (run '(let ((x (make-vector 3 5))) + (begin (vector-set! x 3 4) + x))) + 'err) (check-equal? (run '(vector-length (make-vector 3 #f))) 3) (check-equal? (run '(vector-length (make-vector 0 #f))) 0) (check-equal? (run '"") "") diff --git a/knock/compile-ops.rkt b/knock/compile-ops.rkt index 035536b..1bb76cb 100644 --- a/knock/compile-ops.rkt +++ b/knock/compile-ops.rkt @@ -218,18 +218,12 @@ (seq (Pop r10) (Pop r8) (assert-vector r8) - (assert-integer r10) - (Cmp r10 0) - (Jl 'err) - (Xor r8 type-vect) ; r8 = ptr - (Mov r9 (Mem r8)) ; r9 = len - (Sar r10 int-shift) ; r10 = index - (Sub r9 1) - (Cmp r9 r10) - (Jl 'err) - (Sal r10 3) - (Add r8 r10) - (Mov (Mem r8 8) rax) + (assert-natural r10) + (Mov r9 (Mem r8 (- type-vect))) + (Cmp r10 r9) + (Jge 'err) + (Sar r10 1) ; convert to byte offset + (Mov (Mem r8 r10 (- 8 type-vect)) rax) (Mov rax (value->bits (void))))])) (define (type-pred mask type) diff --git a/knock/test/test-runner.rkt b/knock/test/test-runner.rkt index 68306a3..889ab7c 100644 --- a/knock/test/test-runner.rkt +++ b/knock/test/test-runner.rkt @@ -138,6 +138,10 @@ (begin (vector-set! x 1 4) x))) #(5 4 5)) + (check-equal? (run '(let ((x (make-vector 3 5))) + (begin (vector-set! x 3 4) + x))) + 'err) (check-equal? (run '(vector-length (make-vector 3 #f))) 3) (check-equal? (run '(vector-length (make-vector 0 #f))) 0) (check-equal? (run '"") "") diff --git a/loot/compile-ops.rkt b/loot/compile-ops.rkt index 6ad911e..a648695 100644 --- a/loot/compile-ops.rkt +++ b/loot/compile-ops.rkt @@ -218,18 +218,12 @@ (seq (Pop r10) (Pop r8) (assert-vector r8) - (assert-integer r10) - (Cmp r10 0) - (Jl 'err) - (Xor r8 type-vect) ; r8 = ptr - (Mov r9 (Mem r8)) ; r9 = len - (Sar r10 int-shift) ; r10 = index - (Sub r9 1) - (Cmp r9 r10) - (Jl 'err) - (Sal r10 3) - (Add r8 r10) - (Mov (Mem r8 8) rax) + (assert-natural r10) + (Mov r9 (Mem r8 (- type-vect))) + (Cmp r10 r9) + (Jge 'err) + (Sar r10 1) ; convert to byte offset + (Mov (Mem r8 r10 (- 8 type-vect)) rax) (Mov rax (value->bits (void))))])) (define (type-pred mask type) diff --git a/loot/test/test-runner.rkt b/loot/test/test-runner.rkt index d5ecf65..37b2c6f 100644 --- a/loot/test/test-runner.rkt +++ b/loot/test/test-runner.rkt @@ -138,6 +138,10 @@ (begin (vector-set! x 1 4) x))) #(5 4 5)) + (check-equal? (run '(let ((x (make-vector 3 5))) + (begin (vector-set! x 3 4) + x))) + 'err) (check-equal? (run '(vector-length (make-vector 3 #f))) 3) (check-equal? (run '(vector-length (make-vector 0 #f))) 0) (check-equal? (run '"") "")