From 5aa0d6f39d5329363461a6bb46dcafb4aa1f9145 Mon Sep 17 00:00:00 2001 From: Taylor R Campbell Date: Mon, 10 May 2010 22:29:07 +0000 Subject: [PATCH] Fix x86-64 lapgen rules for simple float offsets. This should fix flonum vector references in cases where type and range checks are disabled. --- src/compiler/machines/x86-64/lapgen.scm | 33 +++++++++---------------- 1 file changed, 12 insertions(+), 21 deletions(-) diff --git a/src/compiler/machines/x86-64/lapgen.scm b/src/compiler/machines/x86-64/lapgen.scm index d1f335ee7..222bc7fb9 100644 --- a/src/compiler/machines/x86-64/lapgen.scm +++ b/src/compiler/machines/x86-64/lapgen.scm @@ -592,13 +592,13 @@ USA. (and (rtl:float-offset? expression) (let ((base (rtl:float-offset-base expression)) (offset (rtl:float-offset-offset expression))) - (and (or (rtl:machine-constant? offset) - (rtl:register? offset)) - (or (rtl:register? base) - (and (rtl:offset-address? base) - (rtl:register? (rtl:offset-address-base base)) - (rtl:machine-constant? - (rtl:offset-address-offset base)))))) + (if (rtl:register? base) + (or (rtl:machine-constant? offset) + (rtl:register? offset)) + (and (rtl:float-offset-address? base) + (rtl:machine-constant? offset) + (rtl:register? (rtl:float-offset-address-base base)) + (rtl:register? (rtl:float-offset-address-offset base))))) expression)) (define (float-offset->reference! offset) @@ -608,20 +608,11 @@ USA. (objects-per-float (quotient address-units-per-float address-units-per-object))) (cond ((not (rtl:register? base)) - (let ((base* - (rtl:register-number (rtl:offset-address-base base))) - (w-offset - (rtl:machine-constant-value - (rtl:offset-address-offset base)))) - (if (rtl:machine-constant? offset) - (indirect-reference! - base* - (+ (* objects-per-float (rtl:machine-constant-value offset)) - w-offset)) - (indexed-ea base* - (rtl:register-number offset) - address-units-per-float - (* address-units-per-object w-offset))))) + (indexed-ea + (rtl:register-number (rtl:float-offset-address-base base)) + (rtl:register-number (rtl:float-offset-address-offset base)) + address-units-per-float + (* address-units-per-float (rtl:machine-constant-value offset)))) ((rtl:machine-constant? offset) (indirect-reference! (rtl:register-number base) (* objects-per-float -- 2.25.1