[armedbear-cvs] r12166 - trunk/abcl/src/org/armedbear/lisp

[Erik Huelsmann]

Author: ehuelsmann
Date: Tue Sep 29 15:54:02 2009
New Revision: 12166

Log:
More TAGBODY processing duplication removal; DOTIMES and DOLIST this time.

Modified:
   trunk/abcl/src/org/armedbear/lisp/dolist.java
   trunk/abcl/src/org/armedbear/lisp/dotimes.java

Modified: trunk/abcl/src/org/armedbear/lisp/dolist.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/dolist.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/dolist.java	Tue Sep 29 15:54:02 2009
@@ -57,25 +57,18 @@
     LispObject specials = parseSpecials(bodyAndDecls.NTH(1));
     bodyForm = bodyAndDecls.car();
 
+    LispObject blockId = new LispObject();
     try
       {
         final Environment ext = new Environment(env);
         // Implicit block.
-        ext.addBlock(NIL, new LispObject());
+        ext.addBlock(NIL, blockId);
         // Evaluate the list form.
         LispObject list = checkList(eval(listForm, ext, thread));
         // Look for tags.
         LispObject remaining = bodyForm;
-        while (remaining != NIL)
-          {
-            LispObject current = remaining.car();
-            remaining = remaining.cdr();
-            if (current instanceof Cons)
-              continue;
-            // It's a tag.
-            ext.addTagBinding(current, remaining);
-          }
-        // Establish a reusable binding.
+        LispObject localTags = preprocessTagBody(bodyForm, ext);
+
         final Object binding;
         if (specials != NIL && memq(var, specials))
           {
@@ -104,42 +97,9 @@
               ((SpecialBinding)binding).value = list.car();
             else
               ((Binding)binding).value = list.car();
-            LispObject body = bodyForm;
-            while (body != NIL)
-              {
-                LispObject current = body.car();
-                if (current instanceof Cons)
-                  {
-                    try
-                      {
-                        // Handle GO inline if possible.
-                        if (current.car() == Symbol.GO)
-                          {
-                            LispObject tag = current.cadr();
-                            Binding b = ext.getTagBinding(tag);
-                            if (b != null && b.value != null)
-                              {
-                                body = b.value;
-                                continue;
-                              }
-                            throw new Go(tag);
-                          }
-                        eval(current, ext, thread);
-                      }
-                    catch (Go go)
-                      {
-                        LispObject tag = go.getTag();
-                        Binding b = ext.getTagBinding(tag);
-                        if (b != null && b.value != null)
-                          {
-                            body = b.value;
-                            continue;
-                          }
-                        throw go;
-                      }
-                  }
-                body = body.cdr();
-              }
+
+            processTagBody(bodyForm, localTags, ext);
+
             list = list.cdr();
             if (interrupted)
               handleInterrupt();
@@ -153,7 +113,7 @@
       }
     catch (Return ret)
       {
-        if (ret.getTag() == NIL)
+        if (ret.getBlock() == blockId)
           {
             return ret.getResult();
           }

Modified: trunk/abcl/src/org/armedbear/lisp/dotimes.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/dotimes.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/dotimes.java	Tue Sep 29 15:54:02 2009
@@ -56,25 +56,14 @@
     LispObject specials = parseSpecials(bodyAndDecls.NTH(1));
     bodyForm = bodyAndDecls.car();
 
+    LispObject blockId = new LispObject();
     try
       {
         LispObject limit = eval(countForm, env, thread);
         Environment ext = new Environment(env);
-        LispObject localTags = NIL; // Tags that are local to this TAGBODY.
-        // Look for tags.
-        LispObject remaining = bodyForm;
-        while (remaining != NIL)
-          {
-            LispObject current = remaining.car();
-            remaining = remaining.cdr();
-            if (current instanceof Cons)
-              continue;
-            // It's a tag.
-            ext.addTagBinding(current, remaining);
-            localTags = new Cons(current, localTags);
-          }
-        // Implicit block.
-        ext.addBlock(NIL, new LispObject());
+        LispObject localTags = preprocessTagBody(bodyForm, ext);
+
+        ext.addBlock(NIL, blockId);
         LispObject result;
         // Establish a reusable binding.
         final Object binding;
@@ -109,48 +98,9 @@
                   ((SpecialBinding)binding).value = Fixnum.getInstance(i);
                 else
                   ((Binding)binding).value = Fixnum.getInstance(i);
-                LispObject body = bodyForm;
-                while (body != NIL)
-                  {
-                    LispObject current = body.car();
-                    if (current instanceof Cons)
-                      {
-                        try
-                          {
-                            // Handle GO inline if possible.
-                            if (current.car() == Symbol.GO)
-                              {
-                                LispObject tag = current.cadr();
-                                if (memql(tag, localTags))
-                                  {
-                                    Binding b = ext.getTagBinding(tag);
-                                    if (b != null && b.value != null)
-                                      {
-                                        body = b.value;
-                                        continue;
-                                      }
-                                  }
-                                throw new Go(tag);
-                              }
-                            eval(current, ext, thread);
-                          }
-                        catch (Go go)
-                          {
-                            LispObject tag = go.getTag();
-                            if (memql(tag, localTags))
-                              {
-                                Binding b = ext.getTagBinding(tag);
-                                if (b != null && b.value != null)
-                                  {
-                                    body = b.value;
-                                    continue;
-                                  }
-                              }
-                            throw go;
-                          }
-                      }
-                    body = body.cdr();
-                  }
+
+                processTagBody(bodyForm, localTags, ext);
+
                 if (interrupted)
                   handleInterrupt();
               }
@@ -169,48 +119,9 @@
                   ((SpecialBinding)binding).value = i;
                 else
                   ((Binding)binding).value = i;
-                LispObject body = bodyForm;
-                while (body != NIL)
-                  {
-                    LispObject current = body.car();
-                    if (current instanceof Cons)
-                      {
-                        try
-                          {
-                            // Handle GO inline if possible.
-                            if (current.car() == Symbol.GO)
-                              {
-                                LispObject tag = current.cadr();
-                                if (memql(tag, localTags))
-                                  {
-                                    Binding b = ext.getTagBinding(tag);
-                                    if (b != null && b.value != null)
-                                      {
-                                        body = b.value;
-                                        continue;
-                                      }
-                                  }
-                                throw new Go(tag);
-                              }
-                            eval(current, ext, thread);
-                          }
-                        catch (Go go)
-                          {
-                            LispObject tag = go.getTag();
-                            if (memql(tag, localTags))
-                              {
-                                Binding b = ext.getTagBinding(tag);
-                                if (b != null && b.value != null)
-                                  {
-                                    body = b.value;
-                                    continue;
-                                  }
-                              }
-                            throw go;
-                          }
-                      }
-                    body = body.cdr();
-                  }
+
+                processTagBody(bodyForm, localTags, ext);
+
                 i = i.incr();
                 if (interrupted)
                   handleInterrupt();
@@ -227,7 +138,7 @@
       }
     catch (Return ret)
       {
-        if (ret.getTag() == NIL)
+        if (ret.getBlock() == blockId)
           {
             return ret.getResult();
           }