picolisp

commit 968a44c022214fe228c5ba101f5de56894ac28ed
parent 2a9223d48190e9aae0e9654f9b44750f312d6f06
Author: Commit-Bot <unknown>
Date:   Sun, 13 Jun 2010 08:45:25 +0000

Automatic commit from picoLisp.tgz, From: Sun, 13 Jun 2010 08:45:25 GMT
Diffstat:
M
lib/tags
 | 
22
+++++++++++-----------
M
src64/flow.l
 | 
13
+++++++++----

2 files changed, 20 insertions(+), 15 deletions(-)
diff --git a/lib/tags b/lib/tags
@@ -1,5 +1,5 @@
-! (2864 . "@src64/flow.l")
-$ (2966 . "@src64/flow.l")
+! (2869 . "@src64/flow.l")
+$ (2971 . "@src64/flow.l")
 % (2253 . "@src64/big.l")
 & (2474 . "@src64/big.l")
 * (2072 . "@src64/big.l")
@@ -46,7 +46,7 @@ bool (1743 . "@src64/flow.l")
 box (841 . "@src64/flow.l")
 box? (999 . "@src64/sym.l")
 by (1553 . "@src64/apply.l")
-bye (3441 . "@src64/flow.l")
+bye (3446 . "@src64/flow.l")
 caaaar (271 . "@src64/subr.l")
 caaadr (288 . "@src64/subr.l")
 caaar (99 . "@src64/subr.l")
@@ -61,7 +61,7 @@ caddar (409 . "@src64/subr.l")
 cadddr (435 . "@src64/subr.l")
 caddr (156 . "@src64/subr.l")
 cadr (45 . "@src64/subr.l")
-call (3097 . "@src64/flow.l")
+call (3102 . "@src64/flow.l")
 car (5 . "@src64/subr.l")
 case (1984 . "@src64/flow.l")
 catch (2484 . "@src64/flow.l")
@@ -113,7 +113,7 @@ diff (2563 . "@src64/subr.l")
 dir (2523 . "@src64/main.l")
 dm (561 . "@src64/flow.l")
 do (2158 . "@src64/flow.l")
-e (2927 . "@src64/flow.l")
+e (2932 . "@src64/flow.l")
 echo (4183 . "@src64/io.l")
 env (621 . "@src64/main.l")
 eof (3323 . "@src64/io.l")
@@ -138,7 +138,7 @@ flip (1686 . "@src64/subr.l")
 flush (4849 . "@src64/io.l")
 fold (3345 . "@src64/sym.l")
 for (2247 . "@src64/flow.l")
-fork (3264 . "@src64/flow.l")
+fork (3269 . "@src64/flow.l")
 format (1772 . "@src64/big.l")
 free (2034 . "@src64/db.l")
 from (3342 . "@src64/io.l")
@@ -165,12 +165,12 @@ inc (1939 . "@src64/big.l")
 index (2611 . "@src64/subr.l")
 info (2427 . "@src64/main.l")
 intern (875 . "@src64/sym.l")
-ipid (3209 . "@src64/flow.l")
+ipid (3214 . "@src64/flow.l")
 isa (978 . "@src64/flow.l")
 job (1448 . "@src64/flow.l")
 journal (977 . "@src64/db.l")
 key (3173 . "@src64/io.l")
-kill (3241 . "@src64/flow.l")
+kill (3246 . "@src64/flow.l")
 last (2031 . "@src64/subr.l")
 length (2687 . "@src64/subr.l")
 let (1498 . "@src64/flow.l")
@@ -233,7 +233,7 @@ on (1583 . "@src64/sym.l")
 onOff (1613 . "@src64/sym.l")
 one (1646 . "@src64/sym.l")
 open (4114 . "@src64/io.l")
-opid (3225 . "@src64/flow.l")
+opid (3230 . "@src64/flow.l")
 opt (2713 . "@src64/main.l")
 or (1659 . "@src64/flow.l")
 out (4008 . "@src64/io.l")
@@ -311,13 +311,13 @@ super (1237 . "@src64/flow.l")
 sym (3804 . "@src64/io.l")
 sym? (2408 . "@src64/subr.l")
 sync (3026 . "@src64/io.l")
-sys (3068 . "@src64/flow.l")
+sys (3073 . "@src64/flow.l")
 t (1770 . "@src64/flow.l")
 tail (1898 . "@src64/subr.l")
 tell (3096 . "@src64/io.l")
 text (1272 . "@src64/sym.l")
 throw (2510 . "@src64/flow.l")
-tick (3177 . "@src64/flow.l")
+tick (3182 . "@src64/flow.l")
 till (3409 . "@src64/io.l")
 time (2237 . "@src64/main.l")
 touch (1049 . "@src64/sym.l")
diff --git a/src64/flow.l b/src64/flow.l
@@ -1,4 +1,4 @@
-# 11jun10abu
+# 13jun10abu
 # (c) Software Lab. Alexander Burger
 
 (code 'redefMsgEC)
@@ -2767,6 +2767,8 @@
          ld X (L)  # Pointer to link
          do
             ld A (X)  # Get link
+            null A  # Any?
+            jz 10  # No
             cmp A C  # Reached main routine's link?
          while ne  # No
             ld X A  # Follow link
@@ -2774,7 +2776,7 @@
          ld (X) 0  # Clear link
       end
    end
-   push L  # End of segment
+10 push L  # End of segment
    push Y  # Save taget coroutine
    ld X EnvApply  # Pointer to apply stack
    do
@@ -2842,12 +2844,15 @@
 
 (code 'cutLocalCX 0)
    do
-      cmp C (X)  # More locals?
+      ld A (X)  # Get link
+      null A  # Any?
+      jz ret  # No
+      cmp A C  # More locals?
       if eq  # No
          ld (X) 0  # Cut off
          ret
       end
-      ld X (X)  # Next frame
+      ld X A  # Next frame
    loop
 
 (code 'joinLocalCX 0)