Changeset 15554

Timestamp:

02/23/22 14:37:02 (11 months ago)

Author:

Mark Evenson

Message:

Record environments in interpreted code

Provide API from ABCL-INTROSPECT.

Includes
0b061d71 | * alanr/patch-couple-more-places
<​https://github.com/armedbear/abcl/pull/443#issuecomment-1046533222>
<​https://github.com/armedbear/abcl/pull/443/commits/27da8d221813ffb7f0689eb48625ac44c02dfaf7>

Location:

trunk/abcl

Files:

• contrib/abcl-introspect/abcl-introspect.lisp (modified) (3 diffs)
• src/org/armedbear/lisp/Primitives.java (modified) (3 diffs)
• src/org/armedbear/lisp/SpecialOperators.java (modified) (3 diffs)

trunk/abcl/contrib/abcl-introspect/abcl-introspect.lisp

@@ -373 +373 @@
 (defun environment-parts(env)
   (append
-   (loop for binding =  (jss:get-java-field env "vars" t) then (jss:get-java-field binding "next" t)
+   (loop for binding = (jss:get-java-field env "vars" t) then (jss:get-java-field binding "next" t)
          while binding
          for symbol = (jss:get-java-field binding "symbol" t)
@@ -381 +381 @@
            collect (list (if special
                              :special-variable
+                             (if (jss:jtypep value 'lisp.SymbolMacro)
+         :symbol-macro
+         :lexical-variable))
                              :lexical-variable)
                          symbol
-                         (if special
-                             (symbol-value symbol)
+                         (if (jss:jtypep value 'lisp.SymbolMacro)
+                             (#"getExpansion" value)
                              value))
              into them
          finally (return them))
-   (loop for binding =  (jss:get-java-field env "lastFunctionBinding" t)
+   (loop for binding = (jss:get-java-field env "lastFunctionBinding" t)
            then (jss:get-java-field binding "next" t)
          while binding
@@ -395 +398 @@
          unless (find name them :key 'second)
            collect (list :lexical-function name value) into them
-         finally (return them))))
+         finally (return them))
+   (loop for binding = (jss::get-java-field env "blocks" t)
+     then (jss::get-java-field binding "next" t)
+   while binding
+   for name = (jss::get-java-field binding "symbol" t)
+   for value = (jss::get-java-field  binding "value" t)
+   unless (find name them :key 'second)
+     collect (list :block name value) into them
+   finally (return them))))
 
 ;; Locals

trunk/abcl/src/org/armedbear/lisp/Primitives.java

@@ -3690 +3690 @@
         {
             Environment ext = new Environment(env);
+            LispThread thread = LispThread.currentThread();
             try {
+                thread.envStack.push(ext);
                 return processTagBody(args, preprocessTagBody(args, ext), ext);
             }
             finally {
                 ext.inactive = true;
+                while (thread.envStack.pop() != ext) {};
             }
         }
@@ -3746 +3749 @@
             final LispThread thread = LispThread.currentThread();
             try {
+                thread.envStack.push(ext);
                 return progn(body, ext, thread);
             } catch (Return ret) {
@@ -3754 +3758 @@
             }
             finally {
+                while (thread.envStack.pop() != ext) {};
                 ext.inactive = true;
             }

trunk/abcl/src/org/armedbear/lisp/SpecialOperators.java

@@ -193 +193 @@
             Environment ext = new Environment(env);
             try {
+                thread.envStack.push(ext);
                 // Declare our free specials, this will correctly raise
                 LispObject body = ext.processDeclarations(args.cdr());
@@ -217 +218 @@
             finally {
                 thread.resetSpecialBindings(mark);
+                while (thread.envStack.pop() != ext) {};
             }
         }
@@ -257 +259 @@
             final LispThread thread = LispThread.currentThread();
             final Environment ext = new Environment(env);
-            args = ext.processDeclarations(args);
-            return progn(args, ext, thread);
+            try {
+          thread.envStack.push(ext);
+    args = ext.processDeclarations(args);
+    return progn(args, ext, thread);
+      }
+      finally {
+              while (thread.envStack.pop() != ext) {};
+            }
         }
     };