commit 9a16ac99912c09b780b7ba5454aca2b36b139d23
parent c844ff963ff67d3d8ee39a762b0114d0f1fce321
Author: Alexander Burger <abu@software-lab.de>
Date: Wed, 16 Feb 2011 11:48:21 +0100
More flexible stack limits
Diffstat:
7 files changed, 66 insertions(+), 53 deletions(-)
diff --git a/ersatz/picolisp.jar b/ersatz/picolisp.jar
Binary files differ.
diff --git a/lib/tags b/lib/tags
@@ -1,5 +1,5 @@
-! (2841 . "@src64/flow.l")
-$ (2943 . "@src64/flow.l")
+! (2854 . "@src64/flow.l")
+$ (2956 . "@src64/flow.l")
% (2570 . "@src64/big.l")
& (2805 . "@src64/big.l")
* (2389 . "@src64/big.l")
@@ -25,16 +25,16 @@ $ (2943 . "@src64/flow.l")
>> (2625 . "@src64/big.l")
abs (2729 . "@src64/big.l")
accept (139 . "@src64/net.l")
-adr (606 . "@src64/main.l")
+adr (603 . "@src64/main.l")
alarm (480 . "@src64/main.l")
all (772 . "@src64/sym.l")
and (1621 . "@src64/flow.l")
any (3879 . "@src64/io.l")
append (1338 . "@src64/subr.l")
apply (713 . "@src64/apply.l")
-arg (2267 . "@src64/main.l")
-args (2243 . "@src64/main.l")
-argv (2888 . "@src64/main.l")
+arg (2264 . "@src64/main.l")
+args (2240 . "@src64/main.l")
+argv (2885 . "@src64/main.l")
as (146 . "@src64/flow.l")
asoq (3001 . "@src64/subr.l")
assoc (2966 . "@src64/subr.l")
@@ -46,7 +46,7 @@ bool (1721 . "@src64/flow.l")
box (822 . "@src64/flow.l")
box? (999 . "@src64/sym.l")
by (1669 . "@src64/apply.l")
-bye (3422 . "@src64/flow.l")
+bye (3435 . "@src64/flow.l")
caaaar (271 . "@src64/subr.l")
caaadr (288 . "@src64/subr.l")
caaar (99 . "@src64/subr.l")
@@ -61,11 +61,11 @@ caddar (409 . "@src64/subr.l")
cadddr (435 . "@src64/subr.l")
caddr (156 . "@src64/subr.l")
cadr (45 . "@src64/subr.l")
-call (3074 . "@src64/flow.l")
+call (3087 . "@src64/flow.l")
car (5 . "@src64/subr.l")
case (1962 . "@src64/flow.l")
catch (2462 . "@src64/flow.l")
-cd (2643 . "@src64/main.l")
+cd (2640 . "@src64/main.l")
cdaaar (464 . "@src64/subr.l")
cdaadr (487 . "@src64/subr.l")
cdaar (179 . "@src64/subr.l")
@@ -88,7 +88,7 @@ circ (816 . "@src64/subr.l")
circ? (2398 . "@src64/subr.l")
clip (1795 . "@src64/subr.l")
close (4267 . "@src64/io.l")
-cmd (2870 . "@src64/main.l")
+cmd (2867 . "@src64/main.l")
cnt (1413 . "@src64/apply.l")
co (2544 . "@src64/flow.l")
commit (1496 . "@src64/db.l")
@@ -99,9 +99,9 @@ connect (201 . "@src64/net.l")
cons (747 . "@src64/subr.l")
copy (1225 . "@src64/subr.l")
ctl (4207 . "@src64/io.l")
-ctty (2668 . "@src64/main.l")
+ctty (2665 . "@src64/main.l")
cut (1797 . "@src64/sym.l")
-date (2382 . "@src64/main.l")
+date (2379 . "@src64/main.l")
dbck (2105 . "@src64/db.l")
de (531 . "@src64/flow.l")
dec (2323 . "@src64/big.l")
@@ -111,15 +111,15 @@ del (1852 . "@src64/sym.l")
delete (1401 . "@src64/subr.l")
delq (1452 . "@src64/subr.l")
diff (2585 . "@src64/subr.l")
-dir (2801 . "@src64/main.l")
+dir (2798 . "@src64/main.l")
dm (543 . "@src64/flow.l")
do (2136 . "@src64/flow.l")
-e (2904 . "@src64/flow.l")
+e (2917 . "@src64/flow.l")
echo (4298 . "@src64/io.l")
-env (618 . "@src64/main.l")
+env (615 . "@src64/main.l")
eof (3438 . "@src64/io.l")
eol (3429 . "@src64/io.l")
-errno (1378 . "@src64/main.l")
+errno (1375 . "@src64/main.l")
eval (182 . "@src64/flow.l")
ext (5028 . "@src64/io.l")
ext? (1034 . "@src64/sym.l")
@@ -127,7 +127,7 @@ extern (900 . "@src64/sym.l")
extra (1263 . "@src64/flow.l")
extract (1218 . "@src64/apply.l")
fifo (1963 . "@src64/sym.l")
-file (2748 . "@src64/main.l")
+file (2745 . "@src64/main.l")
fill (3236 . "@src64/subr.l")
filter (1161 . "@src64/apply.l")
fin (2029 . "@src64/subr.l")
@@ -139,13 +139,13 @@ flip (1695 . "@src64/subr.l")
flush (5003 . "@src64/io.l")
fold (3343 . "@src64/sym.l")
for (2225 . "@src64/flow.l")
-fork (3248 . "@src64/flow.l")
+fork (3261 . "@src64/flow.l")
format (2089 . "@src64/big.l")
free (2047 . "@src64/db.l")
from (3457 . "@src64/io.l")
full (1075 . "@src64/subr.l")
fun? (734 . "@src64/sym.l")
-gc (429 . "@src64/gc.l")
+gc (432 . "@src64/gc.l")
ge0 (2705 . "@src64/big.l")
get (2750 . "@src64/sym.l")
getd (742 . "@src64/sym.l")
@@ -164,14 +164,14 @@ ifn (1862 . "@src64/flow.l")
in (4103 . "@src64/io.l")
inc (2256 . "@src64/big.l")
index (2633 . "@src64/subr.l")
-info (2705 . "@src64/main.l")
+info (2702 . "@src64/main.l")
intern (875 . "@src64/sym.l")
-ipid (3193 . "@src64/flow.l")
+ipid (3206 . "@src64/flow.l")
isa (959 . "@src64/flow.l")
job (1426 . "@src64/flow.l")
journal (970 . "@src64/db.l")
key (3290 . "@src64/io.l")
-kill (3225 . "@src64/flow.l")
+kill (3238 . "@src64/flow.l")
last (2040 . "@src64/subr.l")
le0 (2691 . "@src64/big.l")
length (2737 . "@src64/subr.l")
@@ -181,7 +181,7 @@ lieu (1156 . "@src64/db.l")
line (3613 . "@src64/io.l")
lines (3766 . "@src64/io.l")
link (1172 . "@src64/subr.l")
-lisp (1945 . "@src64/main.l")
+lisp (1942 . "@src64/main.l")
list (887 . "@src64/subr.l")
listen (151 . "@src64/net.l")
lit (157 . "@src64/flow.l")
@@ -220,10 +220,10 @@ n== (2083 . "@src64/subr.l")
nT (2194 . "@src64/subr.l")
name (499 . "@src64/sym.l")
nand (1656 . "@src64/flow.l")
-native (1386 . "@src64/main.l")
+native (1383 . "@src64/main.l")
need (919 . "@src64/subr.l")
new (833 . "@src64/flow.l")
-next (2250 . "@src64/main.l")
+next (2247 . "@src64/main.l")
nil (1739 . "@src64/flow.l")
nond (1939 . "@src64/flow.l")
nor (1677 . "@src64/flow.l")
@@ -236,8 +236,8 @@ on (1583 . "@src64/sym.l")
onOff (1613 . "@src64/sym.l")
one (1646 . "@src64/sym.l")
open (4229 . "@src64/io.l")
-opid (3209 . "@src64/flow.l")
-opt (2991 . "@src64/main.l")
+opid (3222 . "@src64/flow.l")
+opt (2988 . "@src64/main.l")
or (1637 . "@src64/flow.l")
out (4123 . "@src64/io.l")
pack (1144 . "@src64/sym.l")
@@ -270,9 +270,9 @@ push (1688 . "@src64/sym.l")
push1 (1724 . "@src64/sym.l")
put (2698 . "@src64/sym.l")
putl (2950 . "@src64/sym.l")
-pwd (2632 . "@src64/main.l")
+pwd (2629 . "@src64/main.l")
queue (1920 . "@src64/sym.l")
-quit (1095 . "@src64/main.l")
+quit (1092 . "@src64/main.l")
quote (141 . "@src64/flow.l")
rand (2973 . "@src64/big.l")
range (997 . "@src64/subr.l")
@@ -281,7 +281,7 @@ raw (458 . "@src64/main.l")
rd (5045 . "@src64/io.l")
read (2573 . "@src64/io.l")
replace (1499 . "@src64/subr.l")
-rest (2296 . "@src64/main.l")
+rest (2293 . "@src64/main.l")
reverse (1674 . "@src64/subr.l")
rewind (5011 . "@src64/io.l")
rollback (1890 . "@src64/db.l")
@@ -314,15 +314,15 @@ super (1218 . "@src64/flow.l")
sym (3919 . "@src64/io.l")
sym? (2430 . "@src64/subr.l")
sync (3102 . "@src64/io.l")
-sys (3045 . "@src64/flow.l")
+sys (3058 . "@src64/flow.l")
t (1748 . "@src64/flow.l")
tail (1907 . "@src64/subr.l")
tell (3174 . "@src64/io.l")
text (1272 . "@src64/sym.l")
throw (2488 . "@src64/flow.l")
-tick (3161 . "@src64/flow.l")
+tick (3174 . "@src64/flow.l")
till (3524 . "@src64/io.l")
-time (2515 . "@src64/main.l")
+time (2512 . "@src64/main.l")
touch (1049 . "@src64/sym.l")
trim (1755 . "@src64/subr.l")
try (1172 . "@src64/flow.l")
@@ -331,13 +331,13 @@ udp (268 . "@src64/net.l")
unify (3931 . "@src64/subr.l")
unless (1898 . "@src64/flow.l")
until (2082 . "@src64/flow.l")
-up (709 . "@src64/main.l")
+up (706 . "@src64/main.l")
upp? (3230 . "@src64/sym.l")
uppc (3294 . "@src64/sym.l")
use (1570 . "@src64/flow.l")
-usec (2620 . "@src64/main.l")
+usec (2617 . "@src64/main.l")
val (1463 . "@src64/sym.l")
-version (3005 . "@src64/main.l")
+version (3002 . "@src64/main.l")
wait (3064 . "@src64/io.l")
when (1881 . "@src64/flow.l")
while (2058 . "@src64/flow.l")
@@ -347,7 +347,7 @@ wr (5128 . "@src64/io.l")
xchg (1538 . "@src64/sym.l")
xor (1698 . "@src64/flow.l")
x| (2885 . "@src64/big.l")
-yield (2699 . "@src64/flow.l")
+yield (2712 . "@src64/flow.l")
yoke (1196 . "@src64/subr.l")
zap (1063 . "@src64/sym.l")
zero (1631 . "@src64/sym.l")
diff --git a/src64/err.l b/src64/err.l
@@ -1,4 +1,4 @@
-# 12oct10abu
+# 16feb11abu
# (c) Software Lab. Alexander Burger
# Debug print routine
@@ -159,9 +159,7 @@
ld (EnvTrace) 0
ld L 0 # Init link register
ld S (Stack0) # stack pointer
- lea A (S 4096) # and stack limit
- sub A (StkSize)
- ld (StkLimit) A
+ ld (StkLimit) 0 # Clear stack limit
ld (Stacks) 0 # Free all stack segments
jmp restart # Restart interpreter
: ErrTok asciz "!? "
@@ -261,8 +259,10 @@
while ne # No
add A A
loop
- not A # Clear in segment bitmask
- and (Stacks) A
+ xor (Stacks) A # Clear in segment bitmask
+ if z # Last coroutine?
+ ld (StkLimit) 0 # Yes: Clear stack limit
+ end
ld Z (Z) # Next coroutine
loop
load (Env) (EnvEnd) (X III) # Restore environment
@@ -390,7 +390,7 @@
ld E 0
(code 'stkErrEX)
ld Y StkErr
- ld (StkLimit) 0 # Temporarily without stack limit
+ ld (StkLimit) 0 # Reset stack limit
jmp errEXYZ
: StkErr asciz "Stack overflow"
diff --git a/src64/flow.l b/src64/flow.l
@@ -1,4 +1,4 @@
-# 27jan11abu
+# 16feb11abu
# (c) Software Lab. Alexander Burger
(code 'redefMsgEC)
@@ -2633,6 +2633,12 @@
ld Y (Stack0) # Find unused stack segment
ld Z 1 # New mask
ld C (Stacks) # Segment bitmask
+ null C # Starting first coroutine?
+ if z # Yes
+ lea A ((Stack0) 4096) # Set stack limit
+ sub A (StkSize)
+ ld (StkLimit) A
+ end
do
sub Y (StkSize) # Next segment
test C Z # Free?
@@ -2662,6 +2668,10 @@
load (EnvCo) (EnvMid) (S III) # Restore environment
pop (EnvCo7) # Restore coroutine link
pop (StkLimit) # 'lim'
+ null (Stacks) # Stopped last coroutine?
+ if z # Yes
+ ld (StkLimit) 0 # Yes: Clear stack limit
+ end
add S (pack I "+(EnvMid-EnvCo)") # Clean up
pop L
pop Z
@@ -2682,6 +2692,9 @@
ldz E Nil
if nz # No
xor (Stacks) A # Clear in segment bitmask
+ if z # Stopped last coroutine?
+ ld (StkLimit) 0 # Yes: Clear stack limit
+ end
ld E TSym # Return T
end
pop X
diff --git a/src64/gc.l b/src64/gc.l
@@ -1,4 +1,4 @@
-# 12oct10abu
+# 16feb11abu
# (c) Software Lab. Alexander Burger
# Mark data
@@ -324,6 +324,9 @@
test ((Y -I)) 1 # 'tag' symbol gone?
if nz # Yes
xor (Stacks) A # Clear in segment bitmask
+ if z # Last coroutine?
+ ld (StkLimit) 0 # Yes: Clear stack limit
+ end
else
null (Y -II) # Active?
if nz # No
diff --git a/src64/main.l b/src64/main.l
@@ -1,4 +1,4 @@
-# 25jan11abu
+# 16feb11abu
# (c) Software Lab. Alexander Burger
### Global return labels ###
@@ -82,7 +82,7 @@
or A CNT
ld (Pid) A
ld (Stack0) S # Save top level stack pointer
- lea (StkLimit) (S (- 4096 STACK)) # Set stack limit
+ ld (StkLimit) 0 # Initially without stack limit
ld L 0 # Init link register
call heapAlloc # Allocate initial heap
ld E Nil # Init internal symbols
@@ -573,9 +573,6 @@
call evCntEX_FE
shl E 20 # [MB]
ld (StkSize) E # Set new stack size
- lea A ((Stack0) 4096) # and stack limit
- sub A E
- ld (StkLimit) A
shr E 16 # Make short number [MB]
or E CNT
pop X
diff --git a/src64/version.l b/src64/version.l
@@ -1,6 +1,6 @@
-# 06feb11abu
+# 16feb11abu
# (c) Software Lab. Alexander Burger
-(de *Version 3 0 5 13)
+(de *Version 3 0 5 14)
# vi:et:ts=3:sw=3
