[Guile-commits] 13/16: Remove backend support for cached-module-box et al.

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit 77e7bea4c25431f39bb8ba7f900e35ef008ea00b
Author: Andy Wingo <address@hidden>
Date:   Mon May 14 13:21:16 2018 +0200

    Remove backend support for cached-module-box et al.
    
    * module/language/cps/compile-bytecode.scm (compile-function): Remove
      unused assemblers for cached-module-box, cached-toplevel-box, and
      cache-current-module!.
    * module/language/cps/effects-analysis.scm (&cache): New memory kind.
      (cache-current-module!): Set &cache memory, not &box.
      (resolve-module, lookup-module, cache-ref, cache-set!): Add effect
      annotations.
    * module/system/vm/assembler.scm (emit-cache-current-module!)
      (emit-cached-toplevel-box, emit-cached-module-box): Remove
      assemblers.
    * module/system/vm/disassembler.scm (code-annotation, fold-code-range):
      Remove special cases for toplevel-box and module-box.
    * module/system/xref.scm (program-callee-rev-vars): Add a FIXME for the
      future.
---
 module/language/cps/compile-bytecode.scm |  6 ------
 module/language/cps/effects-analysis.scm | 14 ++++++++++++--
 module/system/vm/assembler.scm           | 19 -------------------
 module/system/vm/disassembler.scm        | 22 ----------------------
 module/system/xref.scm                   |  6 +++++-
 5 files changed, 17 insertions(+), 50 deletions(-)

diff --git a/module/language/cps/compile-bytecode.scm 
b/module/language/cps/compile-bytecode.scm
index fdf9953..fddf2fd 100644
--- a/module/language/cps/compile-bytecode.scm
+++ b/module/language/cps/compile-bytecode.scm
@@ -143,10 +143,6 @@
          (emit-current-module asm (from-sp dst)))
         (($ $primcall 'current-thread)
          (emit-current-thread asm (from-sp dst)))
-        (($ $primcall 'cached-toplevel-box (scope name bound?))
-         (emit-cached-toplevel-box asm (from-sp dst) scope name bound?))
-        (($ $primcall 'cached-module-box (mod name public? bound?) ())
-         (emit-cached-module-box asm (from-sp dst) mod name public? bound?))
         (($ $primcall 'define! #f (sym))
          (emit-define! asm (from-sp dst) (from-sp (slot sym))))
         (($ $primcall 'resolve (bound?) (name))
@@ -285,8 +281,6 @@
     (define (compile-effect label exp k)
       (match exp
         (($ $values ()) #f)
-        (($ $primcall 'cache-current-module! (scope) (mod))
-         (emit-cache-current-module! asm (from-sp (slot mod)) scope))
         (($ $primcall 'cache-set! key (val))
          (emit-cache-set! asm key (from-sp (slot val))))
         (($ $primcall 'scm-set! annotation (obj idx val))
diff --git a/module/language/cps/effects-analysis.scm 
b/module/language/cps/effects-analysis.scm
index 3484a10..1e14848 100644
--- a/module/language/cps/effects-analysis.scm
+++ b/module/language/cps/effects-analysis.scm
@@ -188,7 +188,10 @@
   &closure
 
   ;; Indicates a dependency on a raw bitmask, measured in 32-bit units.
-  &bitmask)
+  &bitmask
+
+  ;; Indicates a dependency on the value of a cache cell.
+  &cache)
 
 (define-inlinable (&field kind field)
   (ash (logior (ash field &memory-kind-bits) kind) &effect-kind-bits))
@@ -454,12 +457,19 @@ the LABELS that are clobbered by the effects of LABEL."
 ;; Modules.
 (define-primitive-effects
   ((current-module)                (&read-object &module))
-  ((cache-current-module! m)       (&write-object &box))
+  ((cache-current-module! m)       (&write-object &cache))
   ((resolve name)                  (&read-object &module)      &type-check)
+  ((resolve-module mod)            (&read-object &module)      &type-check)
+  ((lookup mod name)               (&read-object &module)      &type-check)
   ((cached-toplevel-box)                                       &type-check)
   ((cached-module-box)                                         &type-check)
   ((define! name)                  (&read-object &module)))
 
+;; Cache cells.
+(define-primitive-effects
+  ((cache-ref)                     (&read-object &cache))
+  ((cache-set! x)                  (&write-object &cache)))
+
 ;; Numbers.
 (define-primitive-effects
   ((heap-numbers-equal? . _))
diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index 4c4eec4..e8e767d 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -252,8 +252,6 @@
             emit-current-module
             emit-resolve
             emit-define!
-            emit-toplevel-box
-            emit-module-box
             emit-prompt
             emit-current-thread
             emit-fadd
@@ -1495,29 +1493,12 @@ returned instead."
                       (- (asm-start asm) (arity-low-pc arity)))))
     (set-arity-definitions! arity (cons def (arity-definitions arity)))))
 
-(define-macro-assembler (cache-current-module! asm module scope)
-  (let ((mod-label (intern-cache-cell asm scope)))
-    (emit-static-set! asm module mod-label 0)))
-
 (define-macro-assembler (cache-ref asm dst key)
   (emit-static-ref asm dst (intern-cache-cell asm key)))
 
 (define-macro-assembler (cache-set! asm key val)
   (emit-static-set! asm val (intern-cache-cell asm key) 0))
 
-(define-macro-assembler (cached-toplevel-box asm dst scope sym bound?)
-  (let ((sym-label (intern-non-immediate asm sym))
-        (mod-label (intern-cache-cell asm scope))
-        (cell-label (intern-cache-cell asm (cons scope sym))))
-    (emit-toplevel-box asm dst cell-label mod-label sym-label bound?)))
-
-(define-macro-assembler (cached-module-box asm dst module-name sym public? 
bound?)
-  (let* ((sym-label (intern-non-immediate asm sym))
-         (key (cons public? module-name))
-         (mod-name-label (intern-constant asm key))
-         (cell-label (intern-cache-cell asm (acons public? module-name sym))))
-    (emit-module-box asm dst cell-label mod-name-label sym-label bound?)))
-
 (define-macro-assembler (slot-map asm proc-slot slot-map)
   (unless (zero? slot-map)
     (set-asm-slot-maps! asm (cons
diff --git a/module/system/vm/disassembler.scm 
b/module/system/vm/disassembler.scm
index ac4c55c..2ab2bf5 100644
--- a/module/system/vm/disassembler.scm
+++ b/module/system/vm/disassembler.scm
@@ -284,14 +284,6 @@ address of that offset."
      (list "address@hidden" (dereference-scm target)))
     (('resolve-module dst name public)
      (list "~a" (if (zero? public) "private" "public")))
-    (('toplevel-box _ var-offset mod-offset sym-offset bound?)
-     (list "`~A'~A" (dereference-scm sym-offset)
-           (if bound? "" " (maybe unbound)")))
-    (('module-box _ var-offset mod-name-offset sym-offset bound?)
-     (let ((mod-name (reference-scm mod-name-offset)))
-       (list "`(~A ~A ~A)'~A" (if (car mod-name) '@ '@@) (cdr mod-name)
-             (dereference-scm sym-offset)
-             (if bound? "" " (maybe unbound)"))))
     (('load-typed-array dst type shape target len)
      (let ((addr (u32-offset->addr (+ offset target) context)))
        (list "~a bytes from #x~X" len addr)))
@@ -426,20 +418,6 @@ address of that offset."
        `(builtin-ref ,dst ,(builtin-index->name idx)))
       (((or 'static-ref 'static-set!) dst target)
        `(,(car code) ,dst ,(dereference-scm target)))
-      (('toplevel-box dst var-offset mod-offset sym-offset bound?)
-       `(toplevel-box ,dst
-                      ,(dereference-scm var-offset)
-                      ,(dereference-scm mod-offset)
-                      ,(dereference-scm sym-offset)
-                      ,bound?))
-      (('module-box dst var-offset mod-name-offset sym-offset bound?)
-       (let ((mod-name (reference-scm mod-name-offset)))
-         `(module-box ,dst
-                      ,(dereference-scm var-offset)
-                      ,(car mod-name)
-                      ,(cdr mod-name)
-                      ,(dereference-scm sym-offset)
-                      ,bound?)))
       (_ code)))
   (let lp ((offset start) (seed seed))
     (cond
diff --git a/module/system/xref.scm b/module/system/xref.scm
index 2b943fd..e335f94 100644
--- a/module/system/xref.scm
+++ b/module/system/xref.scm
@@ -1,4 +1,4 @@
-;;;;   Copyright (C) 2009, 2010, 2013 Free Software Foundation, Inc.
+;;;;   Copyright (C) 2009, 2010, 2013, 2018 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
@@ -56,6 +56,10 @@
   (fold (lambda (prog out)
           (fold-program-code
            (lambda (elt out)
+             ;; FIXME: Update for change to top-level variable
+             ;; resolution.  Need to build a per-program map of
+             ;; IP->SLOT->CONSTANT to be able to resolve operands to
+             ;; resolve-module and lookup intrinsic calls.
              (match elt
                (('toplevel-box dst var mod sym bound?)
                 (let ((var (or var (and mod (module-variable mod sym)))))