From 3aea514147119a2b32d4281760844d8fd4b58b91 Mon Sep 17 00:00:00 2001 From: dvanhorn Date: Fri, 31 Oct 2025 19:21:05 +0000 Subject: [PATCH] crook --- hoax-plus/compile-ops.rkt | 18 ++++++------------ hoax-plus/test/test-runner.rkt | 4 ++++ iniquity-plus/compile-ops.rkt | 18 ++++++------------ iniquity-plus/test/test-runner.rkt | 4 ++++ knock-plus/compile-ops.rkt | 18 ++++++------------ knock-plus/test/test-runner.rkt | 4 ++++ 6 files changed, 30 insertions(+), 36 deletions(-) diff --git a/hoax-plus/compile-ops.rkt b/hoax-plus/compile-ops.rkt index 2b02cd4..9fe6aa8 100644 --- a/hoax-plus/compile-ops.rkt +++ b/hoax-plus/compile-ops.rkt @@ -230,18 +230,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-plus/test/test-runner.rkt b/hoax-plus/test/test-runner.rkt index 586f01c..bce8e3c 100644 --- a/hoax-plus/test/test-runner.rkt +++ b/hoax-plus/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-plus/compile-ops.rkt b/iniquity-plus/compile-ops.rkt index 25ed45c..edcd826 100644 --- a/iniquity-plus/compile-ops.rkt +++ b/iniquity-plus/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-plus/test/test-runner.rkt b/iniquity-plus/test/test-runner.rkt index d18e075..3d3aaee 100644 --- a/iniquity-plus/test/test-runner.rkt +++ b/iniquity-plus/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-plus/compile-ops.rkt b/knock-plus/compile-ops.rkt index a31fd6f..e59d2e7 100644 --- a/knock-plus/compile-ops.rkt +++ b/knock-plus/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))))])) ;; OpN Natural -> Asm diff --git a/knock-plus/test/test-runner.rkt b/knock-plus/test/test-runner.rkt index 86bee5a..c26075c 100644 --- a/knock-plus/test/test-runner.rkt +++ b/knock-plus/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 '"") "")