[Chicken-hackers] [PATCH] Disable inlining for functions using foreign stubs

[megane]

Greetings,

This is a workaround for the situation described in #1440

I guess in theory the inlining could be supported.

I could get the inlining to work by manually:

 1. Adding a "extern" declaration for the foreign stub in the main
    program.

 2. Linking the main program with the module that contains the inline
    (i.e. my-module.so)

>From dbd56ad4fcca22b6b4a5be3e50c655ab8425bc1c Mon Sep 17 00:00:00 2001
From: megane <address@hidden>
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              | 19 +++++++++++++------
 tests/inline-me.scm      |  9 +++++++++
 tests/inlining-tests.scm |  3 +++
 tests/runtests.sh        |  1 +
 5 files changed, 28 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..90635761 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,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)
diff --git a/tests/inline-me.scm b/tests/inline-me.scm
new file mode 100644
index 00000000..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 "======================================== csc tests ..."
 $interpret -s csc-tests.scm
 
 echo "======================================== compiler inlining tests  ..."
+$compile_r inline-me.scm -s -J -oi inline-me.inline
 $compile inlining-tests.scm -optimize-level 3
 ./a.out
 
-- 
2.17.1