[Guile-commits] branch master updated: Debugging names in baseline compiler; emit/immediate? fixes

[Andy Wingo]

This is an automated email from the git hooks/post-receive script.

wingo pushed a commit to branch master
in repository guile.

The following commit(s) were added to refs/heads/master by this push:
     new f0a9e53  Debugging names in baseline compiler; emit/immediate? fixes
f0a9e53 is described below

commit f0a9e537a0eb167acb71cdc223380610287e99fe
Author: Andy Wingo <address@hidden>
AuthorDate: Mon May 4 16:12:22 2020 +0200

    Debugging names in baseline compiler; emit/immediate? fixes
    
    * module/language/tree-il/compile-bytecode.scm (compile-closure):
      Provide names for locals, including the closure.  Fix emission of
      primitives with immediate args.
---
 module/language/tree-il/compile-bytecode.scm | 67 ++++++++++++++--------------
 1 file changed, 34 insertions(+), 33 deletions(-)

diff --git a/module/language/tree-il/compile-bytecode.scm 
b/module/language/tree-il/compile-bytecode.scm
index 616aa11..92f6a37 100644
--- a/module/language/tree-il/compile-bytecode.scm
+++ b/module/language/tree-il/compile-bytecode.scm
@@ -38,8 +38,6 @@
 
 ;; FIXME: Add debugging source-location info.
 
-;; FIXME: Add debugging variable name info.
-
 (define-module (language tree-il compile-bytecode)
   #:use-module (ice-9 match)
   #:use-module (language bytecode)
@@ -753,41 +751,42 @@ in the frame with for the lambda-case clause 
@var{clause}."
       (($ <env> prev)
        (frame-base prev))))
 
-  (define (push-free-var sym idx env)
-    (make-env env sym sym idx #t (assigned? sym) #f))
+  (define (compile-body clause module-scope free-vars frame-size)
+    (define (push-free-var sym idx env)
+      (make-env env sym sym idx #t (assigned? sym) #f))
 
-  (define (push-closure frame-size env)
-    (push-local 'closure #f
-                (make-env env 'frame-base #f #f #f #f (- frame-size 1))))
+    (define (push-closure env)
+      (push-local 'closure #f
+                  (make-env env 'frame-base #f #f #f #f (- frame-size 1))))
 
-  (define (push-local name sym env)
-    (let ((idx (env-next-local env)))
-      (make-env env name sym idx #f (assigned? sym) (1- idx))))
+    (define (push-local name sym env)
+      (let ((idx (env-next-local env)))
+        (emit-definition asm name (- frame-size idx 1) 'scm)
+        (make-env env name sym idx #f (assigned? sym) (1- idx))))
 
-  (define (push-local-alias name sym idx env)
-    (make-env env name sym idx #f #f (env-next-local env)))
+    (define (push-local-alias name sym idx env)
+      (make-env env name sym idx #f #f (env-next-local env)))
 
-  (define (push-temp env)
-    (let ((idx (env-next-local env)))
-      (make-env env #f #f idx #f #f (1- idx))))
+    (define (push-temp env)
+      (let ((idx (env-next-local env)))
+        (make-env env #f #f idx #f #f (1- idx))))
 
-  (define (push-frame env)
-    (let lp ((i 0) (env env))
-      (if (< i call-frame-size)
-          (lp (1+ i) (push-temp env))
-          env)))
+    (define (push-frame env)
+      (let lp ((i 0) (env env))
+        (if (< i call-frame-size)
+            (lp (1+ i) (push-temp env))
+            env)))
 
-  (define (create-initial-env names syms free-syms frame-size)
-    (define (push-free-vars env)
-      (let lp ((idx 0) (free free-syms) (env env))
-        (match free
-          (() env)
-          ((sym . free)
-           (lp (1+ idx) free
-               (push-free-var sym idx env))))))
-    (fold push-local (push-closure frame-size (push-free-vars #f)) names syms))
+    (define (create-initial-env names syms free-syms)
+      (define (push-free-vars env)
+        (let lp ((idx 0) (free free-syms) (env env))
+          (match free
+            (() env)
+            ((sym . free)
+             (lp (1+ idx) free
+                 (push-free-var sym idx env))))))
+      (fold push-local (push-closure (push-free-vars #f)) names syms))
 
-  (define (compile-body clause module-scope free-vars frame-size)
     (define (stack-height env)
       (- frame-size (env-next-local env) 1))
 
@@ -988,7 +987,8 @@ in the frame with for the lambda-case clause @var{clause}."
         (($ <primcall> src name args)
          (let ((prim (lookup-primitive name)))
            (define (emit/immediate? val)
-             (and=> (primitive-immediate-in-range-predicate prim) val))
+             (and=> (primitive-immediate-in-range-predicate prim)
+                    (lambda (pred) (pred val))))
            (cond
             ((primitive-has-result? prim)
              (for-value exp env))
@@ -1144,7 +1144,8 @@ in the frame with for the lambda-case clause 
@var{clause}."
         (($ <primcall> src name args)
          (let ((prim (lookup-primitive name)))
            (define (emit/immediate? val)
-             (and=> (primitive-immediate-in-range-predicate prim) val))
+             (and=> (primitive-immediate-in-range-predicate prim)
+                    (lambda (pred) (pred val))))
            (cond
             ((not (primitive-has-result? prim))
              (for-effect exp env)
@@ -1274,7 +1275,7 @@ in the frame with for the lambda-case clause 
@var{clause}."
                             (list-tail inits (if opt (length opt) 0)))))
          (unless (= (length names) (length syms) (length inits))
            (error "unexpected args" names syms inits))
-         (let ((env (create-initial-env names syms free-vars frame-size)))
+         (let ((env (create-initial-env names syms free-vars)))
            (for-each (lambda (sym init) (for-init sym init env)) syms inits)
            (for-tail body env))))))