From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED.blaine.gmane.org!not-for-mail From: =?utf-8?Q?Ludovic_Court=C3=A8s?= Newsgroups: gmane.lisp.guile.devel Subject: Re: SHA256 performance with Guile 2.2 vs. Guile 3.0 Date: Sat, 04 Jan 2020 01:40:08 +0100 Message-ID: <87sgkwm4uv.fsf@gnu.org> References: <874kxcnlh8.fsf@inria.fr> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: blaine.gmane.org; posting-host="blaine.gmane.org:195.159.176.226"; logging-data="144068"; mail-complaints-to="usenet@blaine.gmane.org" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.3 (gnu/linux) Cc: Andy Wingo To: Guile Devel Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Sat Jan 04 01:40:22 2020 Return-path: Envelope-to: guile-devel@m.gmane.org Original-Received: from lists.gnu.org ([209.51.188.17]) by blaine.gmane.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.89) (envelope-from ) id 1inXUM-000bMF-9c for guile-devel@m.gmane.org; Sat, 04 Jan 2020 01:40:22 +0100 Original-Received: from localhost ([::1]:58330 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1inXUK-0004PL-UB for guile-devel@m.gmane.org; Fri, 03 Jan 2020 19:40:20 -0500 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:35930) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1inXUC-0004Nu-VI for guile-devel@gnu.org; Fri, 03 Jan 2020 19:40:14 -0500 Original-Received: from fencepost.gnu.org ([2001:470:142:3::e]:45066) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1inXUB-0006da-Fy; Fri, 03 Jan 2020 19:40:11 -0500 Original-Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=59486 helo=ribbon) by fencepost.gnu.org with esmtpsa (TLS1.2:RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1inXUA-0001YN-R9; Fri, 03 Jan 2020 19:40:11 -0500 X-URL: http://www.fdn.fr/~lcourtes/ X-Revolutionary-Date: 15 =?utf-8?Q?Niv=C3=B4se?= an 228 de la =?utf-8?Q?R?= =?utf-8?Q?=C3=A9volution?= X-PGP-Key-ID: 0x090B11993D9AEBB5 X-PGP-Key: http://www.fdn.fr/~lcourtes/ludovic.asc X-PGP-Fingerprint: 3CE4 6455 8A84 FDC6 9DB4 0CFB 090B 1199 3D9A EBB5 X-OS: x86_64-pc-linux-gnu In-Reply-To: <874kxcnlh8.fsf@inria.fr> ("Ludovic \=\?utf-8\?Q\?Court\=C3\=A8s\=22\?\= \=\?utf-8\?Q\?'s\?\= message of "Sat, 04 Jan 2020 00:55:47 +0100") X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.23 Precedence: list List-Id: "Developers list for Guile, the GNU extensibility library" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Original-Sender: "guile-devel" Xref: news.gmane.org gmane.lisp.guile.devel:20210 Archived-At: --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Ludovic Court=C3=A8s skribis: > ludo@ribbon ~/src/guix$ ./pre-inst-env guix environment --pure --ad-hoc g= uile-next guile3.0-hashing -- guile ~/tmp/sha256.scm > > ;;; (hash "b33576331465a60b003573541bf3b1c205936a16c407bc69f8419a527bf5c9= 88") > clock utime stime cutime cstime gctime > 65.17 89.75 0.45 0.00 0.00 35.63 The patch below gives us: --8<---------------cut here---------------start------------->8--- ludo@ribbon /tmp/hashing$ guile --r6rs -L .. ~/tmp/sha256.scm ;;; (hash "b33576331465a60b003573541bf3b1c205936a16c407bc69f8419a527bf5c988= ") clock utime stime cutime cstime gctime 59.31 80.65 0.39 0.00 0.00 30.73 --8<---------------cut here---------------end--------------->8--- It=E2=80=99s a disappointingly small improvement. The reason is that (hash= ing fixnums) adds another layer of opacity, where it ends up doing essentially: (define fx32xor fxxor) =E2=80=A6 Thus, no inlining, and no easy trick to solve that. :-/ Anyhow, I think the patch is probably a good idea. WDYT? Thanks, Ludo=E2=80=99. --=-=-= Content-Type: text/x-patch Content-Disposition: inline diff --git a/module/rnrs/arithmetic/fixnums.scm b/module/rnrs/arithmetic/fixnums.scm index 4ec1cae0c..c30807eb5 100644 --- a/module/rnrs/arithmetic/fixnums.scm +++ b/module/rnrs/arithmetic/fixnums.scm @@ -1,6 +1,6 @@ ;;; fixnums.scm --- The R6RS fixnums arithmetic library -;; Copyright (C) 2010, 2011, 2013 Free Software Foundation, Inc. +;; Copyright (C) 2010, 2011, 2013, 2020 Free Software Foundation, Inc. ;; ;; This library is free software; you can redistribute it and/or ;; modify it under the terms of the GNU Lesser General Public @@ -75,25 +75,26 @@ fxrotate-bit-field fxreverse-bit-field) (import (only (guile) ash - cons* - define-inlinable - inexact->exact - logand - logbit? - logcount - logior - lognot - logxor - most-positive-fixnum - most-negative-fixnum - object-address) + cons* + define-inlinable + inexact->exact + logand + logbit? + logcount + logior + lognot + logxor + most-positive-fixnum + most-negative-fixnum + object-address) (ice-9 optargs) (rnrs base (6)) (rnrs control (6)) (rnrs arithmetic bitwise (6)) (rnrs conditions (6)) (rnrs exceptions (6)) - (rnrs lists (6))) + (rnrs lists (6)) + (rnrs syntax-case (6))) (define fixnum-width (let ((w (do ((i 0 (+ 1 i)) @@ -121,70 +122,105 @@ (or (for-all inline-fixnum? args) (raise (make-assertion-violation)))) (define-syntax define-fxop* + (lambda (s) + (syntax-case s () + ((_ name op) + (with-syntax ((proc (datum->syntax + #'name + (string->symbol + (string-append "%" + (symbol->string + (syntax->datum #'name)) + "-proc"))))) + #'(begin + ;; Define a procedure for when the inline case doesn't + ;; apply. + (define proc + (case-lambda + ((x y) + (assert-fixnum x y) + (op x y)) + (args + (assert-fixnums args) + (apply op args)))) + + (define-syntax name + (lambda (s) + (syntax-case s () + ((_ args (... ...)) + #'(begin + (assert-fixnum args (... ...)) + (op args (... ...)))) + (x + (identifier? #'x) + #'proc)))))))))) + + (define-syntax define-alias (syntax-rules () - ((_ name op) - (define name - (case-lambda - ((x y) - (assert-fixnum x y) - (op x y)) - (args - (assert-fixnums args) - (apply op args))))))) + ((_ new old) + (define-syntax new (identifier-syntax old))))) ;; All these predicates don't check their arguments for fixnum-ness, ;; as this doesn't seem to be strictly required by R6RS. - (define fx=? =) - (define fx>? >) - (define fx=? >=) - (define fx<=? <=) + (define-alias fx=? =) + (define-alias fx>? >) + (define-alias fx=? >=) + (define-alias fx<=? <=) - (define fxzero? zero?) - (define fxpositive? positive?) - (define fxnegative? negative?) - (define fxodd? odd?) - (define fxeven? even?) + (define-alias fxzero? zero?) + (define-alias fxpositive? positive?) + (define-alias fxnegative? negative?) + (define-alias fxodd? odd?) + (define-alias fxeven? even?) (define-fxop* fxmax max) (define-fxop* fxmin min) - (define (fx+ fx1 fx2) + (define-inlinable (fx+ fx1 fx2) (assert-fixnum fx1 fx2) (let ((r (+ fx1 fx2))) (or (inline-fixnum? r) (raise (make-implementation-restriction-violation))) r)) - (define (fx* fx1 fx2) + (define-inlinable (fx* fx1 fx2) (assert-fixnum fx1 fx2) (let ((r (* fx1 fx2))) (or (inline-fixnum? r) (raise (make-implementation-restriction-violation))) r)) - (define* (fx- fx1 #:optional fx2) - (assert-fixnum fx1) - (if fx2 - (begin - (assert-fixnum fx2) - (let ((r (- fx1 fx2))) - (or (inline-fixnum? r) (raise (make-assertion-violation))) - r)) - (let ((r (- fx1))) - (or (inline-fixnum? r) (raise (make-assertion-violation))) - r))) - - (define (fxdiv fx1 fx2) + (define-syntax fx- + (lambda (s) + (syntax-case s () + ((_ fx) + #'(begin + (assert-fixnum fx) + (let ((r (- fx))) + (unless (inline-fixnum? r) (raise (make-assertion-violation))) + (- fx)))) + ((_ fx1 fx2) + #'(begin + (assert-fixnum fx1) + (assert-fixnum fx2) + (let ((r (- fx1 fx2))) + (unless (inline-fixnum? r) (raise (make-assertion-violation))) + r))) + (x + (identifier? #'x) + #'-)))) + + (define-inlinable (fxdiv fx1 fx2) (assert-fixnum fx1 fx2) (div fx1 fx2)) - (define (fxmod fx1 fx2) + (define-inlinable (fxmod fx1 fx2) (assert-fixnum fx1 fx2) (mod fx1 fx2)) - (define (fxdiv-and-mod fx1 fx2) + (define-inlinable (fxdiv-and-mod fx1 fx2) (assert-fixnum fx1 fx2) (div-and-mod fx1 fx2)) @@ -221,71 +257,71 @@ (s1 (div0 s (expt 2 (fixnum-width))))) (values s0 s1))) - (define (fxnot fx) (assert-fixnum fx) (lognot fx)) + (define-inlinable (fxnot fx) (assert-fixnum fx) (lognot fx)) (define-fxop* fxand logand) (define-fxop* fxior logior) (define-fxop* fxxor logxor) - (define (fxif fx1 fx2 fx3) + (define-inlinable (fxif fx1 fx2 fx3) (assert-fixnum fx1 fx2 fx3) (bitwise-if fx1 fx2 fx3)) - (define (fxbit-count fx) + (define-inlinable (fxbit-count fx) (assert-fixnum fx) (if (negative? fx) (bitwise-not (logcount fx)) (logcount fx))) - (define (fxlength fx) (assert-fixnum fx) (bitwise-length fx)) - (define (fxfirst-bit-set fx) (assert-fixnum fx) (bitwise-first-bit-set fx)) - (define (fxbit-set? fx1 fx2) (assert-fixnum fx1 fx2) (logbit? fx2 fx1)) + (define-inlinable (fxlength fx) (assert-fixnum fx) (bitwise-length fx)) + (define-inlinable (fxfirst-bit-set fx) (assert-fixnum fx) (bitwise-first-bit-set fx)) + (define-inlinable (fxbit-set? fx1 fx2) (assert-fixnum fx1 fx2) (logbit? fx2 fx1)) - (define (fxcopy-bit fx1 fx2 fx3) + (define-inlinable (fxcopy-bit fx1 fx2 fx3) (assert-fixnum fx1 fx2 fx3) (unless (and (<= 0 fx2) (< fx2 (fixnum-width))) (raise (make-assertion-violation))) (bitwise-copy-bit fx1 fx2 fx3)) - (define (fxbit-field fx1 fx2 fx3) + (define-inlinable (fxbit-field fx1 fx2 fx3) (assert-fixnum fx1 fx2 fx3) (unless (and (<= 0 fx2 fx3) (< fx3 (fixnum-width))) (raise (make-assertion-violation))) (bitwise-bit-field fx1 fx2 fx3)) - (define (fxcopy-bit-field fx1 fx2 fx3 fx4) + (define-inlinable (fxcopy-bit-field fx1 fx2 fx3 fx4) (assert-fixnum fx1 fx2 fx3 fx4) (unless (and (<= 0 fx2 fx3) (< fx3 (fixnum-width))) (raise (make-assertion-violation))) (bitwise-copy-bit-field fx1 fx2 fx3 fx4)) - (define (fxarithmetic-shift fx1 fx2) + (define-inlinable (fxarithmetic-shift fx1 fx2) (assert-fixnum fx1 fx2) (unless (< (abs fx2) (fixnum-width)) (raise (make-assertion-violation))) (ash fx1 fx2)) - (define (fxarithmetic-shift-left fx1 fx2) + (define-inlinable (fxarithmetic-shift-left fx1 fx2) (assert-fixnum fx1 fx2) (unless (and (<= 0 fx2) (< fx2 (fixnum-width))) (raise (make-assertion-violation))) (ash fx1 fx2)) - (define (fxarithmetic-shift-right fx1 fx2) + (define-inlinable (fxarithmetic-shift-right fx1 fx2) (assert-fixnum fx1 fx2) (unless (and (<= 0 fx2) (< fx2 (fixnum-width))) (raise (make-assertion-violation))) (ash fx1 (- fx2))) - (define (fxrotate-bit-field fx1 fx2 fx3 fx4) + (define-inlinable (fxrotate-bit-field fx1 fx2 fx3 fx4) (assert-fixnum fx1 fx2 fx3 fx4) (unless (and (<= 0 fx2 fx3) (< fx3 (fixnum-width)) (< fx4 (- fx3 fx2))) (raise (make-assertion-violation))) (bitwise-rotate-bit-field fx1 fx2 fx3 fx4)) - (define (fxreverse-bit-field fx1 fx2 fx3) + (define-inlinable (fxreverse-bit-field fx1 fx2 fx3) (assert-fixnum fx1 fx2 fx3) (unless (and (<= 0 fx2 fx3) (< fx3 (fixnum-width))) (raise (make-assertion-violation))) (bitwise-reverse-bit-field fx1 fx2 fx3)) -) + ) --=-=-=--