[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] branch master updated: Tree-IL-to-CPS compiler delays ca
From: |
Ludovic Courtès |
Subject: |
[Guile-commits] branch master updated: Tree-IL-to-CPS compiler delays calls to 'target-most-positive-fixnum'. |
Date: |
Fri, 19 Jun 2020 10:02:09 -0400 |
This is an automated email from the git hooks/post-receive script.
civodul pushed a commit to branch master
in repository guile.
The following commit(s) were added to refs/heads/master by this push:
new a0b9d86 Tree-IL-to-CPS compiler delays calls to
'target-most-positive-fixnum'.
a0b9d86 is described below
commit a0b9d866380b04aff27dcbcf1e13051f3d9685ad
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Fri Jun 19 15:06:42 2020 +0200
Tree-IL-to-CPS compiler delays calls to 'target-most-positive-fixnum'.
Fixes a bug whereby, for example, "guild compile --target=i686-linux-gnu"
running on x86_64 would generate invalid code for
'bytevector-u32-native-set!'
because 'target-most-positive-fixnum' was called from the top-level
when (language tree-il compile-cps) was loaded.
Consequently, the .go files under prebuilt/ would be invalid, leading to
build failures on 32-bit platforms.
This issue became apparent with cb8cabe85f535542ac4fcb165d89722500e42653.
* module/language/tree-il/compile-cps.scm (bytevector-ref-converter)[tag]:
Turn into a lambda so that 'target-most-positive-fixnum' is called in
the right context.
(bytevector-set-converter)[integer-unboxer]: Likewise.
---
.dir-locals.el | 1 +
module/language/tree-il/compile-cps.scm | 63 +++++++++++++++------------------
2 files changed, 29 insertions(+), 35 deletions(-)
diff --git a/.dir-locals.el b/.dir-locals.el
index 14c5d6d..26e4ff9 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -14,6 +14,7 @@
(eval . (put 'with-test-prefix/c&e 'scheme-indent-function 1))
(eval . (put 'with-code-coverage 'scheme-indent-function 1))
(eval . (put 'with-statprof 'scheme-indent-function 1))
+ (eval . (put 'with-target 'scheme-indent-function 1))
(eval . (put 'let-gensyms 'scheme-indent-function 1))
(eval . (put 'let-fresh 'scheme-indent-function 2))
(eval . (put 'with-fresh-name-state 'scheme-indent-function 1))
diff --git a/module/language/tree-il/compile-cps.scm
b/module/language/tree-il/compile-cps.scm
index bd2bd77..334b4ce 100644
--- a/module/language/tree-il/compile-cps.scm
+++ b/module/language/tree-il/compile-cps.scm
@@ -1,6 +1,6 @@
;;; Continuation-passing style (CPS) intermediate language (IL)
-;; Copyright (C) 2013-2015,2017-2019 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2015,2017-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
@@ -895,37 +895,32 @@
($ (ensure-bytevector klen src op pred bv))))
(define (bytevector-ref-converter scheme-name ptr-op width kind)
- (define tag
+ (define (tag cps k src val)
(match kind
('unsigned
(if (< (ash 1 (* width 8)) (target-most-positive-fixnum))
- (lambda (cps k src val)
- (with-cps cps
- (letv s)
- (letk kcvt
- ($kargs ('s) (s)
- ($continue k src ($primcall 'tag-fixnum #f (s)))))
- (build-term
- ($continue kcvt src ($primcall 'u64->s64 #f (val))))))
- (lambda (cps k src val)
- (with-cps cps
- (build-term
- ($continue k src ($primcall 'u64->scm #f (val))))))))
+ (with-cps cps
+ (letv s)
+ (letk kcvt
+ ($kargs ('s) (s)
+ ($continue k src ($primcall 'tag-fixnum #f (s)))))
+ (build-term
+ ($continue kcvt src ($primcall 'u64->s64 #f (val)))))
+ (with-cps cps
+ (build-term
+ ($continue k src ($primcall 'u64->scm #f (val)))))))
('signed
(if (< (ash 1 (* width 8)) (target-most-positive-fixnum))
- (lambda (cps k src val)
- (with-cps cps
- (build-term
- ($continue k src ($primcall 'tag-fixnum #f (val))))))
- (lambda (cps k src val)
- (with-cps cps
- (build-term
- ($continue k src ($primcall 's64->scm #f (val))))))))
+ (with-cps cps
+ (build-term
+ ($continue k src ($primcall 'tag-fixnum #f (val)))))
+ (with-cps cps
+ (build-term
+ ($continue k src ($primcall 's64->scm #f (val)))))))
('float
- (lambda (cps k src val)
- (with-cps cps
- (build-term
- ($continue k src ($primcall 'f64->scm #f (val)))))))))
+ (with-cps cps
+ (build-term
+ ($continue k src ($primcall 'f64->scm #f (val))))))))
(lambda (cps k src op param bv idx)
(prepare-bytevector-access
cps src scheme-name 'bytevector? bv idx width
@@ -962,9 +957,9 @@
(build-term
($branch k' kbad src 'imm-s64-< hi (sval)))))
(define (integer-unboxer lo hi)
- (cond
- ((<= hi (target-most-positive-fixnum))
- (lambda (cps src val have-val)
+ (lambda (cps src val have-val)
+ (cond
+ ((<= hi (target-most-positive-fixnum))
(let ((have-val (if (zero? lo)
(lambda (cps s)
(with-cps cps
@@ -989,17 +984,15 @@
($kargs () ()
($continue klo src ($primcall 'untag-fixnum #f (val)))))
(build-term
- ($branch kbad kuntag src 'fixnum? #f (val)))))))
- ((zero? lo)
- (lambda (cps src val have-val)
+ ($branch kbad kuntag src 'fixnum? #f (val))))))
+ ((zero? lo)
(with-cps cps
(letv u)
(let$ body (limit-urange src val u hi have-val))
(letk khi ($kargs ('u) (u) ,body))
(build-term
- ($continue khi src ($primcall 'scm->u64 #f (val)))))))
- (else
- (lambda (cps src val have-val)
+ ($continue khi src ($primcall 'scm->u64 #f (val))))))
+ (else
(with-cps cps
(letv s)
(let$ body (limit-srange src val s lo hi have-val))
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] branch master updated: Tree-IL-to-CPS compiler delays calls to 'target-most-positive-fixnum'.,
Ludovic Courtès <=