Changeset 12165


Ignore:
Timestamp:
09/29/09 19:08:59 (12 years ago)
Author:
ehuelsmann
Message:

Removal of duplication of TAGBODY processing code in DO*/DO and TAGBODY.

Location:
trunk/abcl/src/org/armedbear/lisp
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/Do.java

    r12055 r12165  
    121121      }
    122122    // Look for tags.
    123     LispObject remaining = body;
    124     while (remaining != NIL)
    125       {
    126         LispObject current = remaining.car();
    127         remaining = remaining.cdr();
    128         if (current instanceof Cons)
    129           continue;
    130         // It's a tag.
    131         ext.addTagBinding(current, remaining);
    132       }
     123    LispObject localTags = preprocessTagBody(body, ext);
     124    LispObject blockId = new LispObject();
    133125    try
    134126      {
    135127        // Implicit block.
    136         ext.addBlock(NIL, new LispObject());
     128        ext.addBlock(NIL, blockId);
    137129        while (true)
    138130          {
     
    141133            if (eval(end_test_form, ext, thread) != NIL)
    142134              break;
    143             remaining = body;
    144             while (remaining != NIL)
    145               {
    146                 LispObject current = remaining.car();
    147                 if (current instanceof Cons)
    148                   {
    149                     try
    150                       {
    151                         // Handle GO inline if possible.
    152                         if (current.car() == Symbol.GO)
    153                           {
    154                             LispObject tag = current.cadr();
    155                             Binding binding = ext.getTagBinding(tag);
    156                             if (binding != null && binding.value != null)
    157                               {
    158                                 remaining = binding.value;
    159                                 continue;
    160                               }
    161                             throw new Go(tag);
    162                           }
    163                         eval(current, ext, thread);
    164                       }
    165                     catch (Go go)
    166                       {
    167                         LispObject tag = go.getTag();
    168                         Binding binding = ext.getTagBinding(tag);
    169                         if (binding != null && binding.value != null)
    170                           {
    171                             remaining = binding.value;
    172                             continue;
    173                           }
    174                         throw go;
    175                       }
    176                   }
    177                 remaining = remaining.cdr();
    178               }
     135
     136            processTagBody(body, localTags, ext);
     137
    179138            // Update variables.
    180139            if (sequential)
     
    231190    catch (Return ret)
    232191      {
    233         if (ret.getTag() == NIL)
     192        if (ret.getBlock() == blockId)
    234193          {
    235194            return ret.getResult();
  • trunk/abcl/src/org/armedbear/lisp/Lisp.java

    r12159 r12165  
    625625      }
    626626    return result;
     627  }
     628
     629  public static final LispObject preprocessTagBody(LispObject body,
     630                                                   Environment env)
     631    throws ConditionThrowable
     632  {
     633    LispObject localTags = NIL; // Tags that are local to this TAGBODY.
     634    while (body != NIL)
     635      {
     636        LispObject current = body.car();
     637        body = ((Cons)body).cdr;
     638        if (current instanceof Cons)
     639          continue;
     640        // It's a tag.
     641        env.addTagBinding(current, body);
     642        localTags = new Cons(current, localTags);
     643      }
     644    return localTags;
     645  }
     646
     647  public static final LispObject processTagBody(LispObject body,
     648                                                LispObject localTags,
     649                                                Environment env)
     650    throws ConditionThrowable
     651  {
     652    LispObject remaining = body;
     653    LispThread thread = LispThread.currentThread();
     654    while (remaining != NIL)
     655      {
     656        LispObject current = remaining.car();
     657        if (current instanceof Cons)
     658          {
     659            try {
     660              // Handle GO inline if possible.
     661              if (((Cons)current).car == Symbol.GO)
     662                {
     663                  if (interrupted)
     664                    handleInterrupt();
     665                  LispObject tag = current.cadr();
     666                  Binding binding = env.getTagBinding(tag);
     667                  if (binding == null)
     668                    return error(new ControlError("No tag named " +
     669                                                  tag.writeToString() +
     670                                                  " is currently visible."));
     671                  else if (memql(tag, localTags))
     672                    {
     673                      if (binding.value != null)
     674                        {
     675                          remaining = binding.value;
     676                          continue;
     677                        }
     678                    }
     679                  throw new Go(tag);
     680                }
     681              eval(current, env, thread);
     682            }
     683            catch (Go go)
     684              {
     685                LispObject tag = go.getTag();
     686                if (memql(tag, localTags))
     687                  {
     688                    Binding binding = env.getTagBinding(tag);
     689                    if (binding != null && binding.value != null)
     690                      {
     691                        remaining = binding.value;
     692                        continue;
     693                      }
     694                  }
     695                throw go;
     696              }
     697          }
     698        remaining = ((Cons)remaining).cdr;
     699      }
     700    thread._values = null;
     701    return NIL;
    627702  }
    628703
  • trunk/abcl/src/org/armedbear/lisp/Primitives.java

    r12079 r12165  
    34973497      {
    34983498        Environment ext = new Environment(env);
    3499         LispObject localTags = NIL; // Tags that are local to this TAGBODY.
    3500         LispObject body = args;
    3501         while (body != NIL)
    3502           {
    3503             LispObject current = body.car();
    3504             body = ((Cons)body).cdr;
    3505             if (current instanceof Cons)
    3506               continue;
    3507             // It's a tag.
    3508             ext.addTagBinding(current, body);
    3509             localTags = new Cons(current, localTags);
    3510           }
    3511         final LispThread thread = LispThread.currentThread();
    3512         LispObject remaining = args;
    3513         while (remaining != NIL)
    3514           {
    3515             LispObject current = remaining.car();
    3516             if (current instanceof Cons)
    3517               {
    3518                 try
    3519                   {
    3520                     // Handle GO inline if possible.
    3521                     if (((Cons)current).car == Symbol.GO)
    3522                       {
    3523                         if (interrupted)
    3524                           handleInterrupt();
    3525                         LispObject tag = current.cadr();
    3526                         if (memql(tag, localTags))
    3527                           {
    3528                             Binding binding = ext.getTagBinding(tag);
    3529                             if (binding != null && binding.value != null)
    3530                               {
    3531                                 remaining = binding.value;
    3532                                 continue;
    3533                               }
    3534                           }
    3535                         throw new Go(tag);
    3536                       }
    3537                     eval(current, ext, thread);
    3538                   }
    3539                 catch (Go go)
    3540                   {
    3541                     LispObject tag = go.getTag();
    3542                     if (memql(tag, localTags))
    3543                       {
    3544                         Binding binding = ext.getTagBinding(tag);
    3545                         if (binding != null && binding.value != null)
    3546                           {
    3547                             remaining = binding.value;
    3548                             continue;
    3549                           }
    3550                       }
    3551                     throw go;
    3552                   }
    3553               }
    3554             remaining = ((Cons)remaining).cdr;
    3555           }
    3556         thread._values = null;
    3557         return NIL;
     3499        return processTagBody(args, preprocessTagBody(args, ext), ext);
    35583500      }
    35593501    };
Note: See TracChangeset for help on using the changeset viewer.