Hi all, Attached is a patch to restore rewrites for the common arithmetic operators when in fixnum arithmetic mode.
I'm not 100% happy with it, because as the patch says, the scrutinizer will preemptively rewrite some calls before we can figure out that we can unsafely use the fixnum versions. Maybe we can add something to declare specializations as being for fixnum mode or regular mode? Anyway, something for later; it might fit in with the restructuring of #1611. Or not. Finally, I ran into this head scratcher: I tried to replace = with eq? in the code and it sped up the code by a *lot*. However, in fixnum arithmetic mode, = gets rewritten to C_eqp. The difference in the C output is that the code that uses eq? directly gets this completely inlined in the same C function as the following subtractions. The code that uses = will get the comparisons in a C function and then call a CPS function which does the subtractions. Any ideas why this is? It makes a massive difference, so I think it's worthwhile to at least understand what's going on here. Cheers, Peter
From 00d69b1c8c93cfbf714cbf820f78e4c6d0279983 Mon Sep 17 00:00:00 2001 From: Peter Bex <[email protected]> Date: Sat, 18 May 2019 14:38:21 +0200 Subject: [PATCH] Fix the most of #1604 by restoring rewrites dropped in 61af5f1 To make this work, we must remove the numeric operator rewrites for (* *) in types.db, and instead rely on the rewrites in c-platform.scm (which were already there), because specialization happens before optimization. So in the generic case, we'll end up with the same code, but in fixnum arithmetic we'll end up with the fixnum-specific versions. Unfortunately, this still means that if the scrutinizer detects that arguments are known to be integers (but not certain to be fixnums), we'll generate calls to the more generic C_s_a_u_i_integer_... C functions. If they're known to be fixnums, we'll generate calls to C_a_i_fixnum_..., which can overflow into bignums. This is still not optimal in fixnum arithmetic mode, because in that mode we'd want to unsafely ignore overflow. --- NEWS | 4 ++ c-platform.scm | 151 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++- types.db | 57 +++++++--------------- 3 files changed, 172 insertions(+), 40 deletions(-) diff --git a/NEWS b/NEWS index 7b3a9790..919a8762 100644 --- a/NEWS +++ b/NEWS @@ -2,6 +2,10 @@ - Runtime system - Use arc4random on FreeBSD (thanks to Tobias Kortkamp and gahr) +- Compiler + - Restored optimized implementations of =, +, -, /, * and quotient in + fixnum-arithmetic mode (fixes #1604 mostly; thanks to "chickendan"). + 5.0.2 - Core libraries diff --git a/c-platform.scm b/c-platform.scm index 03f356ce..f5206e91 100644 --- a/c-platform.scm +++ b/c-platform.scm @@ -258,7 +258,7 @@ (append +fixnum-bindings+ +flonum-bindings+ +extended-bindings+)) (set! internal-bindings - '(##sys#slot ##sys#setslot ##sys#block-ref ##sys#block-set! + '(##sys#slot ##sys#setslot ##sys#block-ref ##sys#block-set! ##sys#/-2 ##sys#call-with-current-continuation ##sys#size ##sys#byte ##sys#setbyte ##sys#pointer? ##sys#generic-structure? ##sys#structure? ##sys#check-structure ##sys#check-exact ##sys#check-number ##sys#check-list ##sys#check-pair ##sys#check-string @@ -725,6 +725,155 @@ (rewrite 'scheme#lcm 18 1) (rewrite 'scheme#list 18 '()) +(rewrite + 'scheme#* 8 + (lambda (db classargs cont callargs) + ;; (*) -> 1 + ;; (* <x>) -> <x> + ;; (* <x1> ...) -> (##core#inline "C_fixnum_times" <x1> (##core#inline "C_fixnum_times" ...)) [fixnum-mode] + ;; - Remove "1" from arguments. + ;; - Replace multiplications with 2 by shift left. [fixnum-mode] + (let ((callargs + (filter + (lambda (x) + (not (and (eq? 'quote (node-class x)) + (eq? 1 (first (node-parameters x))) ) ) ) + callargs) ) ) + (cond ((null? callargs) (make-node '##core#call (list #t) (list cont (qnode 0)))) + ((null? (cdr callargs)) + (make-node '##core#call (list #t) (list cont (first callargs))) ) + ((eq? number-type 'fixnum) + (make-node + '##core#call (list #t) + (list + cont + (fold-inner + (lambda (x y) + (if (and (eq? 'quote (node-class y)) (eq? 2 (first (node-parameters y)))) + (make-node '##core#inline '("C_fixnum_shift_left") (list x (qnode 1))) + (make-node '##core#inline '("C_fixnum_times") (list x y)) ) ) + callargs) ) ) ) + (else #f) ) ) ) ) + +(rewrite + 'scheme#+ 8 + (lambda (db classargs cont callargs) + ;; (+ <x>) -> <x> + ;; (+ <x1> ...) -> (##core#inline "C_fixnum_plus" <x1> (##core#inline "C_fixnum_plus" ...)) [fixnum-mode] + ;; (+ <x1> ...) -> (##core#inline "C_u_fixnum_plus" <x1> (##core#inline "C_u_fixnum_plus" ...)) + ;; [fixnum-mode + unsafe] + ;; - Remove "0" from arguments, if more than 1. + (cond ((or (null? callargs) (not (eq? number-type 'fixnum))) #f) + ((null? (cdr callargs)) + (make-node + '##core#call (list #t) + (list cont + (make-node '##core#inline + (if unsafe '("C_u_fixnum_plus") '("C_fixnum_plus")) + callargs)) ) ) + (else + (let ((callargs + (cons (car callargs) + (filter + (lambda (x) + (not (and (eq? 'quote (node-class x)) + (zero? (first (node-parameters x))) ) ) ) + (cdr callargs) ) ) ) ) + (and (>= (length callargs) 2) + (make-node + '##core#call (list #t) + (list + cont + (fold-inner + (lambda (x y) + (make-node '##core#inline + (if unsafe '("C_u_fixnum_plus") '("C_fixnum_plus")) + (list x y) ) ) + callargs) ) ) ) ) ) ) ) ) + +(rewrite + 'scheme#- 8 + (lambda (db classargs cont callargs) + ;; (- <x>) -> (##core#inline "C_fixnum_negate" <x>) [fixnum-mode] + ;; (- <x>) -> (##core#inline "C_u_fixnum_negate" <x>) [fixnum-mode + unsafe] + ;; (- <x1> ...) -> (##core#inline "C_fixnum_difference" <x1> (##core#inline "C_fixnum_difference" ...)) [fixnum-mode] + ;; (- <x1> ...) -> (##core#inline "C_u_fixnum_difference" <x1> (##core#inline "C_u_fixnum_difference" ...)) + ;; [fixnum-mode + unsafe] + ;; - Remove "0" from arguments, if more than 1. + (cond ((or (null? callargs) (not (eq? number-type 'fixnum))) #f) + ((null? (cdr callargs)) + (make-node + '##core#call (list #t) + (list cont + (make-node '##core#inline + (if unsafe '("C_u_fixnum_negate") '("C_fixnum_negate")) + callargs)) ) ) + (else + (let ((callargs + (cons (car callargs) + (filter + (lambda (x) + (not (and (eq? 'quote (node-class x)) + (zero? (first (node-parameters x))) ) ) ) + (cdr callargs) ) ) ) ) + (and (>= (length callargs) 2) + (make-node + '##core#call (list #t) + (list + cont + (fold-inner + (lambda (x y) + (make-node '##core#inline + (if unsafe '("C_u_fixnum_difference") '("C_fixnum_difference")) + (list x y) ) ) + callargs) ) ) ) ) ) ) ) ) + +(let () + (define (rewrite-div db classargs cont callargs) + ;; (/ <x1> ...) -> (##core#inline "C_fixnum_divide" <x1> (##core#inline "C_fixnum_divide" ...)) [fixnum-mode] + ;; - Remove "1" from arguments, if more than 1. + ;; - Replace divisions by 2 with shift right. [fixnum-mode] + (and (eq? number-type 'fixnum) + (>= (length callargs) 2) + (let ((callargs + (cons (car callargs) + (filter + (lambda (x) + (not (and (eq? 'quote (node-class x)) + (eq? 1 (first (node-parameters x))) ) ) ) + (cdr callargs) ) ) ) ) + (and (>= (length callargs) 2) + (make-node + '##core#call (list #t) + (list + cont + (fold-inner + (lambda (x y) + (if (and (eq? 'quote (node-class y)) (eq? 2 (first (node-parameters y)))) + (make-node '##core#inline '("C_fixnum_shift_right") (list x (qnode 1))) + (make-node '##core#inline '("C_fixnum_divide") (list x y)) ) ) + callargs) ) ) ) ) ) ) + (rewrite 'scheme#/ 8 rewrite-div) + (rewrite '##sys#/-2 8 rewrite-div)) + +(rewrite + 'scheme#quotient 8 + (lambda (db classargs cont callargs) + ;; (quotient <x> 2) -> (##core#inline "C_fixnum_shift_right" <x> 1) [fixnum-mode] + ;; (quotient <x> <y>) -> (##core#inline "C_fixnum_divide" <x> <y>) [fixnum-mode] + (and (eq? 'fixnum number-type) + (= (length callargs) 2) + (make-node + '##core#call (list #t) + (let ([arg2 (second callargs)]) + (list cont + (if (and (eq? 'quote (node-class arg2)) + (eq? 2 (first (node-parameters arg2))) ) + (make-node + '##core#inline '("C_fixnum_shift_right") + (list (first callargs) (qnode 1)) ) + (make-node '##core#inline '("C_fixnum_divide") callargs) ) ) ) ) ) ) ) + (rewrite 'scheme#+ 19) (rewrite 'scheme#- 19) (rewrite 'scheme#* 19) diff --git a/types.db b/types.db index 6eff7d1f..3d274db4 100644 --- a/types.db +++ b/types.db @@ -64,8 +64,7 @@ (scheme#eqv? (#(procedure #:pure #:foldable) scheme#eqv? (* *) boolean) (((or immediate symbol) *) (scheme#eq? #(1) #(2))) - ((* (or immediate symbol)) (scheme#eq? #(1) #(2))) - ((* *) (##core#inline "C_i_eqvp" #(1) #(2)))) + ((* (or immediate symbol)) (scheme#eq? #(1) #(2)))) (scheme#equal? (#(procedure #:pure #:foldable) scheme#equal? (* *) boolean) (((or immediate symbol) *) (scheme#eq? #(1) #(2))) @@ -314,9 +313,7 @@ ((fixnum fixnum) (integer) (##core#inline_allocate ("C_a_i_fixnum_plus" 5) #(1) #(2))) ((integer integer) (integer) - (##core#inline_allocate ("C_s_a_u_i_integer_plus" 5) #(1) #(2))) - ((* *) (number) - (##core#inline_allocate ("C_s_a_i_plus" 29) #(1) #(2)))) + (##core#inline_allocate ("C_s_a_u_i_integer_plus" 5) #(1) #(2)))) (scheme#- (#(procedure #:clean #:enforce #:foldable) scheme#- (number #!rest number) number) ((fixnum) (integer) (##core#inline_allocate ("C_a_i_fixnum_negate" 5) #(1))) @@ -339,9 +336,7 @@ ((fixnum fixnum) (integer) (##core#inline_allocate ("C_a_i_fixnum_difference" 5) #(1) #(2))) ((integer integer) (integer) - (##core#inline_allocate ("C_s_a_u_i_integer_minus" 5) #(1) #(2))) - ((* *) (number) - (##core#inline_allocate ("C_s_a_i_minus" 29) #(1) #(2)))) + (##core#inline_allocate ("C_s_a_u_i_integer_minus" 5) #(1) #(2)))) (scheme#* (#(procedure #:clean #:enforce #:foldable) scheme#* (#!rest number) number) (() (fixnum) '1) @@ -367,9 +362,7 @@ ((fixnum fixnum) (integer) (##core#inline_allocate ("C_a_i_fixnum_times" 5) #(1) #(2))) ((integer integer) (integer) - (##core#inline_allocate ("C_s_a_u_i_integer_times" 5) #(1) #(2))) - ((* *) (number) - (##core#inline_allocate ("C_s_a_i_times" 33) #(1) #(2)))) + (##core#inline_allocate ("C_s_a_u_i_integer_times" 5) #(1) #(2)))) (scheme#/ (#(procedure #:clean #:enforce #:foldable) scheme#/ (number #!rest number) number) ((float fixnum) (float) @@ -395,40 +388,35 @@ ((number) (let ((#(tmp) #(1))) '#t)) ((fixnum fixnum) (scheme#eq? #(1) #(2))) ((float float) (##core#inline "C_flonum_equalp" #(1) #(2))) - ((integer integer) (##core#inline "C_i_integer_equalp" #(1) #(2))) - ((* *) (##core#inline "C_i_nequalp" #(1) #(2)))) + ((integer integer) (##core#inline "C_i_integer_equalp" #(1) #(2)))) (scheme#> (#(procedure #:clean #:enforce #:foldable) scheme#> (#!rest number) boolean) (() '#t) ((number) (let ((#(tmp) #(1))) '#t)) ((fixnum fixnum) (chicken.fixnum#fx> #(1) #(2))) ((float float) (##core#inline "C_flonum_greaterp" #(1) #(2))) - ((integer integer) (##core#inline "C_i_integer_greaterp" #(1) #(2))) - ((* *) (##core#inline "C_i_greaterp" #(1) #(2)))) + ((integer integer) (##core#inline "C_i_integer_greaterp" #(1) #(2)))) (scheme#< (#(procedure #:clean #:enforce #:foldable) scheme#< (#!rest number) boolean) (() '#t) ((number) (let ((#(tmp) #(1))) '#t)) ((fixnum fixnum) (chicken.fixnum#fx< #(1) #(2))) ((integer integer) (##core#inline "C_i_integer_lessp" #(1) #(2))) - ((float float) (##core#inline "C_flonum_lessp" #(1) #(2))) - ((* *) (##core#inline "C_i_lessp" #(1) #(2)))) + ((float float) (##core#inline "C_flonum_lessp" #(1) #(2)))) (scheme#>= (#(procedure #:clean #:enforce #:foldable) scheme#>= (#!rest number) boolean) (() '#t) ((number) (let ((#(tmp) #(1))) '#t)) ((fixnum fixnum) (chicken.fixnum#fx>= #(1) #(2))) ((integer integer) (##core#inline "C_i_integer_greater_or_equalp" #(1) #(2))) - ((float float) (##core#inline "C_flonum_greater_or_equal_p" #(1) #(2))) - ((* *) (##core#inline "C_i_greater_or_equalp" #(1) #(2)))) + ((float float) (##core#inline "C_flonum_greater_or_equal_p" #(1) #(2)))) (scheme#<= (#(procedure #:clean #:enforce #:foldable) scheme#<= (#!rest number) boolean) (() '#t) ((number) (let ((#(tmp) #(1))) '#t)) ((fixnum fixnum) (chicken.fixnum#fx<= #(1) #(2))) ((integer integer) (##core#inline "C_i_integer_less_or_equalp" #(1) #(2))) - ((float float) (##core#inline "C_flonum_less_or_equal_p" #(1) #(2))) - ((* *) (##core#inline "C_i_less_or_equalp" #(1) #(2)))) + ((float float) (##core#inline "C_flonum_less_or_equal_p" #(1) #(2)))) (scheme#quotient (#(procedure #:clean #:enforce #:foldable) scheme#quotient ((or integer float) (or integer float)) (or integer float)) ;;XXX flonum/mixed case @@ -439,8 +427,7 @@ (##core#inline_allocate ("C_a_i_fixnum_quotient_checked" 5) #(1) #(2))) ((integer integer) (integer) - (##core#inline_allocate ("C_s_a_u_i_integer_quotient" 5) #(1) #(2))) - ((* *) (##core#inline_allocate ("C_s_a_i_quotient" 5) #(1) #(2)))) + (##core#inline_allocate ("C_s_a_u_i_integer_quotient" 5) #(1) #(2)))) (scheme#remainder (#(procedure #:clean #:enforce #:foldable) scheme#remainder ((or integer float) (or integer float)) (or integer float)) ((float float) (float) @@ -450,8 +437,7 @@ ((fixnum fixnum) (fixnum) (##core#inline "C_i_fixnum_remainder_checked" #(1) #(2))) ((integer integer) (integer) - (##core#inline_allocate ("C_s_a_u_i_integer_remainder" 5) #(1) #(2))) - ((* *) (##core#inline_allocate ("C_s_a_i_remainder" 5) #(1) #(2)))) + (##core#inline_allocate ("C_s_a_u_i_integer_remainder" 5) #(1) #(2)))) (scheme#modulo (#(procedure #:clean #:enforce #:foldable) scheme#modulo ((or integer float) (or integer float)) (or integer float)) ((float float) (float) @@ -461,8 +447,7 @@ ((fixnum fixnum) (fixnum) (##core#inline "C_fixnum_modulo" #(1) #(2))) ((integer integer) (integer) - (##core#inline_allocate ("C_s_a_u_i_integer_modulo" 5) #(1) #(2))) - ((* *) (##core#inline_allocate ("C_s_a_i_modulo" 5) #(1) #(2)))) + (##core#inline_allocate ("C_s_a_u_i_integer_modulo" 5) #(1) #(2)))) (scheme#gcd (#(procedure #:clean #:enforce #:foldable) scheme#gcd (#!rest (or integer float)) (or integer float)) (() '0) @@ -1072,41 +1057,35 @@ ((*) (##core#inline "C_i_integer_length" #(1)))) (chicken.bitwise#arithmetic-shift - (#(procedure #:clean #:enforce #:foldable) chicken.bitwise#arithmetic-shift (integer fixnum) integer) - ((* *) (##core#inline_allocate ("C_s_a_i_arithmetic_shift" 5) #(1) #(2)))) + (#(procedure #:clean #:enforce #:foldable) chicken.bitwise#arithmetic-shift (integer fixnum) integer)) (chicken.bitwise#bit->boolean (#(procedure #:clean #:enforce #:foldable) chicken.bitwise#bit->boolean (integer integer) boolean) - ((fixnum fixnum) (##core#inline "C_i_fixnum_bit_to_bool" #(1) #(2))) - ((* *) (##core#inline "C_i_bit_to_bool" #(1) #(2)))) + ((fixnum fixnum) (##core#inline "C_i_fixnum_bit_to_bool" #(1) #(2)))) (chicken.bitwise#bitwise-and (#(procedure #:clean #:enforce #:foldable) chicken.bitwise#bitwise-and (#!rest integer) integer) (() '-1) ((fixnum) (fixnum) #(1)) ((integer) #(1)) - ((fixnum fixnum) (fixnum) (##core#inline "C_u_fixnum_and" #(1) #(2))) - ((* *) (##core#inline_allocate ("C_s_a_i_bitwise_and" 5) #(1) #(2)))) + ((fixnum fixnum) (fixnum) (##core#inline "C_u_fixnum_and" #(1) #(2)))) (chicken.bitwise#bitwise-ior (#(procedure #:clean #:enforce #:foldable) chicken.bitwise#bitwise-ior (#!rest integer) integer) (() '0) ((fixnum) (fixnum) #(1)) ((integer) #(1)) - ((fixnum fixnum) (fixnum) (##core#inline "C_u_fixnum_or" #(1) #(2))) - ((* *) (##core#inline_allocate ("C_s_a_i_bitwise_ior" 5) #(1) #(2)))) + ((fixnum fixnum) (fixnum) (##core#inline "C_u_fixnum_or" #(1) #(2)))) (chicken.bitwise#bitwise-xor (#(procedure #:clean #:enforce #:foldable) chicken.bitwise#bitwise-xor (#!rest integer) integer) (() '0) ((fixnum) (fixnum) #(1)) ((integer) #(1)) - ((fixnum fixnum) (fixnum) (##core#inline "C_fixnum_xor" #(1) #(2))) - ((* *) (##core#inline_allocate ("C_s_a_i_bitwise_xor" 5) #(1) #(2)))) + ((fixnum fixnum) (fixnum) (##core#inline "C_fixnum_xor" #(1) #(2)))) (chicken.bitwise#bitwise-not - (#(procedure #:clean #:enforce #:foldable) chicken.bitwise#bitwise-not (integer) integer) - ((* *) (##core#inline_allocate ("C_s_a_i_bitwise_not" 5) #(1)))) + (#(procedure #:clean #:enforce #:foldable) chicken.bitwise#bitwise-not (integer) integer)) ;; blob -- 2.11.0
signature.asc
Description: PGP signature
_______________________________________________ Chicken-hackers mailing list [email protected] https://lists.nongnu.org/mailman/listinfo/chicken-hackers
