commit 72233020f0c1abae34ea89bf7e2d1385a824472e
parent 861cbe9ffcec60e872050fc007560a0ebc67863d
Author: Commit-Bot <unknown>
Date: Sat, 12 Jun 2010 06:21:13 +0000
Automatic commit from picoLisp.tgz, From: Sat, 12 Jun 2010 06:21:13 GMT
Diffstat:
3 files changed, 53 insertions(+), 29 deletions(-)
diff --git a/doc/refS.html b/doc/refS.html
@@ -589,12 +589,14 @@ href="refS.html#stem">stem</a></code>.
-> 100000000000000000000
</code></pre>
-<dt><a name="stack"><code>(stack ['cnt]) -> cnt</code></a>
+<dt><a name="stack"><code>(stack ['cnt]) -> cnt | (.. sym . cnt)</code></a>
<dd>(64-bit version only) Maintains the stack segment size. If called without a
<code>cnt</code> argument, or if already one or more <a
href="ref.html#coroutines">coroutines</a> are running, the current size in
megabytes is returned. Otherwise, the stack segment size is set to the new
-value. Default is 4 MB. See also <code><a href="refH.html#heap">heap</a></code>.
+value. Default is 4 MB. If there are running coroutines, their tags will be
+<code><a href="refC.html#cons">cons</a></code>ed in front of the size. See also
+<code><a href="refH.html#heap">heap</a></code>.
<pre><code>
: (stack) # Get current stack segment size
@@ -607,6 +609,13 @@ Stack overflow
? N
-> 109181
?
+
+: (co "routine" (yield 7)) # Create two coroutines
+-> 7
+: (co "routine2" (yield 8))
+-> 8
+: (stack)
+-> ("routine2" "routine" . 4)
</code></pre>
<dt><a name="stamp"><code>(stamp ['dat 'tim]) -> sym</code></a>
diff --git a/lib/tags b/lib/tags
@@ -25,16 +25,16 @@ $ (2966 . "@src64/flow.l")
>> (2308 . "@src64/big.l")
abs (2398 . "@src64/big.l")
accept (139 . "@src64/net.l")
-adr (593 . "@src64/main.l")
+adr (608 . "@src64/main.l")
alarm (483 . "@src64/main.l")
all (772 . "@src64/sym.l")
and (1643 . "@src64/flow.l")
any (3764 . "@src64/io.l")
append (1329 . "@src64/subr.l")
apply (597 . "@src64/apply.l")
-arg (1973 . "@src64/main.l")
-args (1949 . "@src64/main.l")
-argv (2594 . "@src64/main.l")
+arg (1988 . "@src64/main.l")
+args (1964 . "@src64/main.l")
+argv (2609 . "@src64/main.l")
as (146 . "@src64/flow.l")
asoq (2942 . "@src64/subr.l")
assoc (2907 . "@src64/subr.l")
@@ -65,7 +65,7 @@ call (3097 . "@src64/flow.l")
car (5 . "@src64/subr.l")
case (1984 . "@src64/flow.l")
catch (2484 . "@src64/flow.l")
-cd (2349 . "@src64/main.l")
+cd (2364 . "@src64/main.l")
cdaaar (464 . "@src64/subr.l")
cdaadr (487 . "@src64/subr.l")
cdaar (179 . "@src64/subr.l")
@@ -87,7 +87,7 @@ chop (1093 . "@src64/sym.l")
circ (816 . "@src64/subr.l")
clip (1786 . "@src64/subr.l")
close (4152 . "@src64/io.l")
-cmd (2576 . "@src64/main.l")
+cmd (2591 . "@src64/main.l")
cnt (1297 . "@src64/apply.l")
co (2566 . "@src64/flow.l")
commit (1503 . "@src64/db.l")
@@ -98,9 +98,9 @@ connect (201 . "@src64/net.l")
cons (747 . "@src64/subr.l")
copy (1216 . "@src64/subr.l")
ctl (4092 . "@src64/io.l")
-ctty (2374 . "@src64/main.l")
+ctty (2389 . "@src64/main.l")
cut (1797 . "@src64/sym.l")
-date (2088 . "@src64/main.l")
+date (2103 . "@src64/main.l")
dbck (2092 . "@src64/db.l")
de (549 . "@src64/flow.l")
dec (2006 . "@src64/big.l")
@@ -110,15 +110,15 @@ del (1852 . "@src64/sym.l")
delete (1392 . "@src64/subr.l")
delq (1443 . "@src64/subr.l")
diff (2563 . "@src64/subr.l")
-dir (2507 . "@src64/main.l")
+dir (2522 . "@src64/main.l")
dm (561 . "@src64/flow.l")
do (2158 . "@src64/flow.l")
e (2927 . "@src64/flow.l")
echo (4183 . "@src64/io.l")
-env (605 . "@src64/main.l")
+env (620 . "@src64/main.l")
eof (3323 . "@src64/io.l")
eol (3314 . "@src64/io.l")
-errno (1300 . "@src64/main.l")
+errno (1315 . "@src64/main.l")
eval (208 . "@src64/flow.l")
ext (4874 . "@src64/io.l")
ext? (1034 . "@src64/sym.l")
@@ -126,7 +126,7 @@ extern (900 . "@src64/sym.l")
extra (1284 . "@src64/flow.l")
extract (1102 . "@src64/apply.l")
fifo (1963 . "@src64/sym.l")
-file (2454 . "@src64/main.l")
+file (2469 . "@src64/main.l")
fill (3177 . "@src64/subr.l")
filter (1045 . "@src64/apply.l")
fin (2020 . "@src64/subr.l")
@@ -163,7 +163,7 @@ ifn (1884 . "@src64/flow.l")
in (3988 . "@src64/io.l")
inc (1939 . "@src64/big.l")
index (2611 . "@src64/subr.l")
-info (2411 . "@src64/main.l")
+info (2426 . "@src64/main.l")
intern (875 . "@src64/sym.l")
ipid (3209 . "@src64/flow.l")
isa (978 . "@src64/flow.l")
@@ -217,10 +217,10 @@ n== (2074 . "@src64/subr.l")
nT (2185 . "@src64/subr.l")
name (499 . "@src64/sym.l")
nand (1678 . "@src64/flow.l")
-native (1308 . "@src64/main.l")
+native (1323 . "@src64/main.l")
need (918 . "@src64/subr.l")
new (852 . "@src64/flow.l")
-next (1956 . "@src64/main.l")
+next (1971 . "@src64/main.l")
nil (1761 . "@src64/flow.l")
nond (1961 . "@src64/flow.l")
nor (1699 . "@src64/flow.l")
@@ -234,7 +234,7 @@ onOff (1613 . "@src64/sym.l")
one (1646 . "@src64/sym.l")
open (4114 . "@src64/io.l")
opid (3225 . "@src64/flow.l")
-opt (2697 . "@src64/main.l")
+opt (2712 . "@src64/main.l")
or (1659 . "@src64/flow.l")
out (4008 . "@src64/io.l")
pack (1144 . "@src64/sym.l")
@@ -267,9 +267,9 @@ push (1688 . "@src64/sym.l")
push1 (1724 . "@src64/sym.l")
put (2698 . "@src64/sym.l")
putl (2950 . "@src64/sym.l")
-pwd (2338 . "@src64/main.l")
+pwd (2353 . "@src64/main.l")
queue (1920 . "@src64/sym.l")
-quit (1017 . "@src64/main.l")
+quit (1032 . "@src64/main.l")
quote (141 . "@src64/flow.l")
rand (2642 . "@src64/big.l")
range (988 . "@src64/subr.l")
@@ -278,7 +278,7 @@ raw (461 . "@src64/main.l")
rd (4891 . "@src64/io.l")
read (2502 . "@src64/io.l")
replace (1490 . "@src64/subr.l")
-rest (2002 . "@src64/main.l")
+rest (2017 . "@src64/main.l")
reverse (1665 . "@src64/subr.l")
rewind (4857 . "@src64/io.l")
rollback (1885 . "@src64/db.l")
@@ -319,7 +319,7 @@ text (1272 . "@src64/sym.l")
throw (2510 . "@src64/flow.l")
tick (3177 . "@src64/flow.l")
till (3409 . "@src64/io.l")
-time (2221 . "@src64/main.l")
+time (2236 . "@src64/main.l")
touch (1049 . "@src64/sym.l")
trim (1746 . "@src64/subr.l")
try (1191 . "@src64/flow.l")
@@ -328,13 +328,13 @@ udp (268 . "@src64/net.l")
unify (3842 . "@src64/subr.l")
unless (1920 . "@src64/flow.l")
until (2104 . "@src64/flow.l")
-up (692 . "@src64/main.l")
+up (707 . "@src64/main.l")
upp? (3232 . "@src64/sym.l")
uppc (3296 . "@src64/sym.l")
use (1592 . "@src64/flow.l")
-usec (2326 . "@src64/main.l")
+usec (2341 . "@src64/main.l")
val (1463 . "@src64/sym.l")
-version (2711 . "@src64/main.l")
+version (2726 . "@src64/main.l")
wait (2988 . "@src64/io.l")
when (1903 . "@src64/flow.l")
while (2080 . "@src64/flow.l")
diff --git a/src64/main.l b/src64/main.l
@@ -1,4 +1,4 @@
-# 11jun10abu
+# 12jun10abu
# (c) Software Lab. Alexander Burger
### Global return labels ###
@@ -563,7 +563,7 @@
or E CNT
ret
-# (stack ['cnt]) -> cnt
+# (stack ['cnt]) -> cnt | (.. sym . cnt)
(code 'doStack 2)
push X
ld X E
@@ -579,12 +579,27 @@
lea A ((Stack0) 4096) # and stack limit
sub A E
ld (StkLimit) A
- jmp 10
+ shr E 16 # Make short number [MB]
+ or E CNT
+ pop X
+ ret
end
end
ld E (StkSize) # Return current stack size
-10 shr E 16 # Make short number in MB
+ shr E 16 # Make short number [MB]
or E CNT
+ ld X (Stack0) # Collect coroutines
+ ld C (Stacks) # Segment bitmask
+ do
+ sub X (StkSize) # Next segment
+ shr C 1 # In use?
+ if c # Yes
+ call consE_A # Cons 'tag'
+ ld (A) (X -I)
+ ld (A CDR) E
+ ld E A
+ end
+ until z
pop X
ret
