Support for catch tags in slime

armedbear · Feb 27, 2022 · fc29139 · fc29139
1 parent 3c6092f
commit fc29139
Show file tree

Hide file tree

Showing 3 changed files with 7 additions and 0 deletions.
diff --git a/contrib/abcl-introspect/abcl-introspect.lisp b/contrib/abcl-introspect/abcl-introspect.lisp
@@ -378,6 +378,9 @@ above have used annotate local functions"
          for symbol = (jss:get-java-field binding "symbol" t)
          for value = (jss:get-java-field binding "value" t)
          for special = (jss:get-java-field binding "specialp" t)
+         if (member symbol '(:catch))
+           collect `(,symbol ,value) into them
+         else
          unless (find symbol them :key 'second)
            collect (list (if special
                              :special-variable

diff --git a/src/org/armedbear/lisp/Keyword.java b/src/org/armedbear/lisp/Keyword.java
@@ -51,6 +51,7 @@ public final class Keyword
         CAPITALIZE          = internKeyword("CAPITALIZE"),
         CAPITALIZE_FIRST    = internKeyword("CAPITALIZE-FIRST"),
         CASE                = internKeyword("CASE"),
+        CATCH               = internKeyword("CATCH"),
         CAUSE               = internKeyword("CAUSE"),
         CHAR                = internKeyword("CHAR"),
         COMMON              = internKeyword("COMMON"),

diff --git a/src/org/armedbear/lisp/Primitives.java b/src/org/armedbear/lisp/Primitives.java
@@ -3805,7 +3805,9 @@ public LispObject execute(LispObject args, Environment env)
             thread.pushCatchTag(tag);
             LispObject body = args.cdr();
             LispObject result = NIL;
+            Environment ext = new Environment(env,Keyword.CATCH,tag);
             try {
+                thread.envStack.push(ext);
                 return progn(body, env, thread);
             } catch (Throw t) {
                 if (t.tag == tag) {
@@ -3816,6 +3818,7 @@ public LispObject execute(LispObject args, Environment env)
                 throw ret;
             }
             finally {
+                while (thread.envStack.pop() != ext) {};
                 thread.popCatchTag();
             }
         }