Evan Hanson writes:
> Hi megane,
>
> Thanks, this seems like a good fix for now.
>
> On 2019-06-23 17:29, megane wrote:
>> diff --git a/support.scm b/support.scm
>> index f412627d..90635761 100644
>> --- a/support.scm
>> +++ b/support.scm
>> @@ -769,11 +776,11 @@
>> ((assq 'inlinable plist))
>> (lparams (node-parameters (cdr val)))
>> ((not (db-get db sym 'hidden-refs)))
>> -((case (variable-mark sym '##compiler#inline)
>> - ((yes) #t)
>> - ((no) #f)
>> - (else
>> -(< (fourth lparams) inline-limit) ) ) ) )
>> +((not (eq? 'no (variable-mark sym '##compiler#inline
>> +((< (fourth lparams) inline-limit))
>> +;; ;; See #1440
>> +((not (uses-foreign-stubs? (cdr val
>> +)
>> (set! lst (cons sym lst))
>> (set! out (cons (list sym (node->sexpr (cdr val))) out)
>> db)
>
> ISTM this changes the inlining logic slightly in that symbols marked
> with '##compiler#inline => 'yes will now only be inlined if they're
> under the inline-limit. Previously, they would always be inlined. Is
> that right, and is the change intentional?
Good catch! Didn't intend to change other logic.
Fixed version attached.
>From 4a5334b0fcee91594abbea434a617074e9b91881 Mon Sep 17 00:00:00 2001
From: megane
Date: Sun, 23 Jun 2019 16:46:50 +0300
Subject: [PATCH] Disable inlining for functions using foreign stubs
A workaround until a better solution appears.
Fixes #1440
---
batch-driver.scm | 3 ++-
support.scm | 20 ++--
tests/inline-me.scm | 9 +
tests/inlining-tests.scm | 3 +++
tests/runtests.sh| 1 +
5 files changed, 29 insertions(+), 7 deletions(-)
create mode 100644 tests/inline-me.scm
diff --git a/batch-driver.scm b/batch-driver.scm
index f0cfc2b1..a7d791fd 100644
--- a/batch-driver.scm
+++ b/batch-driver.scm
@@ -819,7 +819,8 @@
(dribble "generating global inline file `~a'
..." f)
(emit-global-inline-file
filename f db block-compilation
-inline-max-size) ) )
+inline-max-size
+(map foreign-stub-id foreign-lambda-stubs)) ) )
(begin-time)
;; Closure conversion
(set! node2 (perform-closure-conversion node2 db))
diff --git a/support.scm b/support.scm
index f412627d..f373566a 100644
--- a/support.scm
+++ b/support.scm
@@ -755,7 +755,14 @@
;; Only used in batch-driver.scm
(define (emit-global-inline-file source-file inline-file db
-block-compilation inline-limit)
+block-compilation inline-limit
+foreign-stubs)
+ (define (uses-foreign-stubs? node)
+(let walk ((n node))
+ (case (node-class n)
+ ((##core#inline)
+(memq (car (node-parameters n)) foreign-stubs))
+ (else (any walk (node-subexpressions n))
(let ((lst '())
(out '()))
(hash-table-for-each
@@ -769,11 +776,12 @@
((assq 'inlinable plist))
(lparams (node-parameters (cdr val)))
((not (db-get db sym 'hidden-refs)))
- ((case (variable-mark sym '##compiler#inline)
- ((yes) #t)
- ((no) #f)
- (else
- (< (fourth lparams) inline-limit) ) ) ) )
+ ((not (eq? 'no (variable-mark sym '##compiler#inline
+ ((or (eq? 'yes (variable-mark sym '##compiler#inline))
+(< (fourth lparams) inline-limit)))
+ ;; See #1440
+ ((not (uses-foreign-stubs? (cdr val
+ )
(set! lst (cons sym lst))
(set! out (cons (list sym (node->sexpr (cdr val))) out)
db)
diff --git a/tests/inline-me.scm b/tests/inline-me.scm
new file mode 100644
index ..f66ce670
--- /dev/null
+++ b/tests/inline-me.scm
@@ -0,0 +1,9 @@
+(module
+ inline-me
+ (foreign-foo)
+ (import scheme (chicken base))
+ (import (only (chicken foreign) foreign-lambda*))
+
+ (define foreign-foo (foreign-lambda* int ((int x)) "C_return ( x + 1 );"))
+
+)
diff --git a/tests/inlining-tests.scm b/tests/inlining-tests.scm
index 7080d476..9adc0f64 100644
--- a/tests/inlining-tests.scm
+++ b/tests/inlining-tests.scm
@@ -25,3 +25,6 @@
(define (foo) 0)
(bar)
(assert (= 1 (foo)))
+
+(import inline-me)
+(assert (= 42 (foreign-foo 41)))
diff --git a/tests/runtests.sh b/tests/runtests.sh
index fc90ebbe..1811cc35 100755
--- a/tests/runtests.sh
+++ b/tests/runtests.sh
@@ -91,6 +91,7 @@ echo
