Changeset 4017

Timestamp:

09/23/03 14:55:06 (20 years ago)

Author:

piso

Message:

DOTIMES: implicit TAGBODY.

File:

• trunk/j/src/org/armedbear/lisp/Primitives.java (modified) (4 diffs)

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

@@ -3 +3 @@
  *
  * Copyright (C) 2002-2003 Peter Graves
- * $Id: Primitives.java,v 1.428 2003-09-23 14:29:17 piso Exp $
+ * $Id: Primitives.java,v 1.429 2003-09-23 14:55:06 piso Exp $
  *
  * This program is free software; you can redistribute it and/or
@@ -1584 +1584 @@
             try {
                 LispObject limit = eval(countForm, env, thread);
+                // Look for tags.
+                Binding tags = null;
+                LispObject remaining = bodyForm;
+                while (remaining != NIL) {
+                    LispObject current = remaining.car();
+                    remaining = remaining.cdr();
+                    if (current instanceof Cons)
+                        continue;
+                    // It's a tag.
+                    tags = new Binding(current, remaining, tags);
+                }
                 LispObject result;
                 if (limit instanceof Fixnum) {
@@ -1593 +1604 @@
                         LispObject body = bodyForm;
                         while (body != NIL) {
-                            eval(body.car(), ext, thread);
+                            LispObject current = body.car();
+                            if (current instanceof Cons) {
+                                try {
+                                    // Handle GO inline if possible.
+                                    if (current.car() == Symbol.GO) {
+                                        LispObject code = null;
+                                        LispObject tag = current.cadr();
+                                        for (Binding binding = tags; binding != null; binding = binding.next) {
+                                            if (binding.symbol.eql(tag)) {
+                                                code = binding.value;
+                                                break;
+                                            }
+                                        }
+                                        if (code != null) {
+                                            body = code;
+                                            continue;
+                                        }
+                                        throw new Go(tag);
+                                    }
+                                    eval(current, ext, thread);
+                                }
+                                catch (Go go) {
+                                    LispObject code = null;
+                                    LispObject tag = go.getTag();
+                                    for (Binding binding = tags; binding != null; binding = binding.next) {
+                                        if (binding.symbol.eql(tag)) {
+                                            code = binding.value;
+                                            break;
+                                        }
+                                    }
+                                    if (code != null) {
+                                        body = code;
+                                        thread.setStackDepth(depth);
+                                        continue;
+                                    }
+                                    throw go;
+                                }
+                            }
                             body = body.cdr();
                         }
@@ -1607 +1655 @@
                         LispObject body = bodyForm;
                         while (body != NIL) {
-                            eval(body.car(), ext, thread);
+                            LispObject current = body.car();
+                            if (current instanceof Cons) {
+                                try {
+                                    // Handle GO inline if possible.
+                                    if (current.car() == Symbol.GO) {
+                                        LispObject code = null;
+                                        LispObject tag = current.cadr();
+                                        for (Binding binding = tags; binding != null; binding = binding.next) {
+                                            if (binding.symbol.eql(tag)) {
+                                                code = binding.value;
+                                                break;
+                                            }
+                                        }
+                                        if (code != null) {
+                                            body = code;
+                                            continue;
+                                        }
+                                        throw new Go(tag);
+                                    }
+                                    eval(current, ext, thread);
+                                }
+                                catch (Go go) {
+                                    LispObject code = null;
+                                    LispObject tag = go.getTag();
+                                    for (Binding binding = tags; binding != null; binding = binding.next) {
+                                        if (binding.symbol.eql(tag)) {
+                                            code = binding.value;
+                                            break;
+                                        }
+                                    }
+                                    if (code != null) {
+                                        body = code;
+                                        thread.setStackDepth(depth);
+                                        continue;
+                                    }
+                                    throw go;
+                                }
+                            }
                             body = body.cdr();
                         }