diff --git a/mats/fx.ms b/mats/fx.ms index 5dce3e2f2..e71f9d36b 100644 --- a/mats/fx.ms +++ b/mats/fx.ms @@ -2561,6 +2561,12 @@ (map (lambda (x) (let-values ([ls (fxdiv-and-mod x 64)]) ls)) '(0 -5 -31 -32 -33 -63 -64 -65 -127 -128 -129)) '((0 0) (-1 59) (-1 33) (-1 32) (-1 31) (-1 1) (-1 0) (-2 63) (-2 1) (-2 0) (-3 63))) + (test-cp0-expansion + '(#3%fxdiv-and-mod x 1000) + '(#3%fxdiv-and-mod x 1000)) + (test-cp0-expansion + '(#3%fxdiv-and-mod x 1024) + '(let ([t x]) (#3%values (#3%fxdiv t 1024) (#3%fxmod t 1024)))) ) (mat fxdiv0-and-mod0 diff --git a/release_notes/release_notes.stex b/release_notes/release_notes.stex index 2c3fc5f57..4170a0d3a 100644 --- a/release_notes/release_notes.stex +++ b/release_notes/release_notes.stex @@ -2769,6 +2769,13 @@ in fasl files does not generally make sense. %----------------------------------------------------------------------------- \section{Bug Fixes}\label{section:bugfixes} +\subsection{Performance regression for \scheme{fxdiv-and-mod} at optimize-level 3 (10.2.0)} + +At optimize-level 3, the source optimizer (cp0) could replace calls to +\scheme{fxdiv-and-mod}, where the second argument is constant, with calls to +\scheme{fxdiv} and \scheme{fxmod} that the back-end would choose not to inline +because the constant was not a power of two. + \subsection{Repair executable-relative search for NetBSD (10.2.0)} An incorrect approach to finding the current executable's path on diff --git a/s/base-lang.ss b/s/base-lang.ss index b3066ac3f..433e701c4 100644 --- a/s/base-lang.ss +++ b/s/base-lang.ss @@ -21,7 +21,7 @@ preinfo-call-can-inline? preinfo-call-no-return? preinfo-call-single-valued? prelex? make-prelex prelex-name prelex-name-set! prelex-flags prelex-flags-set! prelex-source prelex-operand prelex-operand-set! prelex-uname make-prelex* - target-fixnum? target-bignum?) + target-fixnum? target-fixnum-power-of-two target-bignum?) (module (lookup-primref primref? primref-name primref-flags primref-arity primref-level) (include "primref.ss") diff --git a/s/cp0.ss b/s/cp0.ss index 6b53747f4..be6d88b1e 100644 --- a/s/cp0.ss +++ b/s/cp0.ss @@ -3367,7 +3367,7 @@ (define-inline 3 fxdiv-and-mod [(x y) (and likely-to-be-compiled? - (cp0-constant? (result-exp (value-visit-operand! y))) + (cp0-constant? target-fixnum-power-of-two (result-exp (value-visit-operand! y))) (cp0 (let ([tx (cp0-make-temp #t)] [ty (cp0-make-temp #t)]) (let ([refx (build-ref tx)] [refy (build-ref ty)]) diff --git a/s/cpprim.ss b/s/cpprim.ss index 2bade4419..248367f1c 100644 --- a/s/cpprim.ss +++ b/s/cpprim.ss @@ -1865,27 +1865,22 @@ (goto ,Llib))))]) (let () - (define fixnum-powers-of-two - (let f ([m 2] [e 1]) - (if (<= m (constant most-positive-fixnum)) - (cons (cons m e) (f (* m 2) (fx+ e 1))) - '()))) (define-inline 3 fxdiv [(e1 e2) (nanopass-case (L7 Expr) e2 [(quote ,d) - (let ([a (assv d fixnum-powers-of-two)]) - (and a + (let ([n (target-fixnum-power-of-two d)]) + (and n (%inline logand - ,(%inline sra ,e1 (immediate ,(cdr a))) + ,(%inline sra ,e1 (immediate ,n)) (immediate ,(- (constant fixnum-factor))))))] [else #f])]) (define-inline 3 fxmod [(e1 e2) (nanopass-case (L7 Expr) e2 [(quote ,d) - (let ([a (assv d fixnum-powers-of-two)]) - (and a (%inline logand ,e1 (immediate ,(fix (- d 1))))))] + (and (target-fixnum-power-of-two d) + (%inline logand ,e1 (immediate ,(fix (- d 1)))))] [else #f])]) (let () (define (build-fx* e1 e2 ovfl?) @@ -1908,8 +1903,8 @@ ,(%inline sll ,e (immediate 3)) ,e) ,e))] - [(assv n fixnum-powers-of-two) => - (lambda (a) (%inline sll ,e (immediate ,(cdr a))))] + [(target-fixnum-power-of-two n) => + (lambda (i) (%inline sll ,e (immediate ,i)))] [else (%inline * ,e (immediate ,n))]))) (nanopass-case (L7 Expr) e2 [(quote ,d) (guard (target-fixnum? d)) (fx*-constant e1 d)] @@ -1989,8 +1984,8 @@ (lambda (src sexpr e1 e2) (or (nanopass-case (L7 Expr) e2 [(quote ,d) - (let ([a (assv d fixnum-powers-of-two)]) - (and a (build-fx/p2 e1 (cdr a))))] + (let ([i (target-fixnum-power-of-two d)]) + (and i (build-fx/p2 e1 i)))] [else #f]) (if (constant integer-divide-instruction) (build-fix (%inline / ,e1 ,e2)) diff --git a/s/np-help.ss b/s/np-help.ss index aa2fb1c2a..1eace060a 100644 --- a/s/np-help.ss +++ b/s/np-help.ss @@ -159,13 +159,7 @@ [(= mask (constant byte-constant-mask)) (%inline eq? ,expr (immediate ,type))] [else (%inline type-check? ,expr (immediate ,mask) (immediate ,type))])))))]))) -(define target-fixnum? - (if (and (= (constant most-negative-fixnum) (most-negative-fixnum)) - (= (constant most-positive-fixnum) (most-positive-fixnum))) - fixnum? - (lambda (x) - (and (or (fixnum? x) (bignum? x)) - (<= (constant most-negative-fixnum) x (constant most-positive-fixnum)))))) +(include "target-fixnum.ss") (define unfix (lambda (imm) diff --git a/s/target-fixnum.ss b/s/target-fixnum.ss index e4e299193..4e130c23f 100644 --- a/s/target-fixnum.ss +++ b/s/target-fixnum.ss @@ -36,3 +36,17 @@ (lambda (x) (and (bignum? x) (not (<= (constant most-negative-fixnum) x (constant most-positive-fixnum)))))])) + +(define target-fixnum-power-of-two + (let ([vec (list->vector + (do ([i 0 (fx+ i 1)] [m 2 (* m 2)] [ls '() (cons m ls)]) + ((not (target-fixnum? m)) (reverse ls))))]) + (lambda (x) + (and (target-fixnum? x) + (let ([end (vector-length vec)]) + (let f ([i 0]) + (and (fx< i end) + (let ([n (vector-ref vec i)] [next (fx+ i 1)]) + (if (= x n) + next + (and (> x n) (f next)))))))))))