picolisp

commit 644e32c9d80ce09bff51c929dcb0dd4035159b2c
parent f97472196d52791f4ec70141c71944622be8a07a
Author: Alexander Burger <abu@software-lab.de>
Date:   Thu,  3 Feb 2011 09:59:16 +0100

Added stack checks
Diffstat:
M
lib/tags
 | 
40
++++++++++++++++++++--------------------
M
src64/apply.l
 | 
8
++++++++

2 files changed, 28 insertions(+), 20 deletions(-)
diff --git a/lib/tags b/lib/tags
@@ -31,7 +31,7 @@ all (772 . "@src64/sym.l")
 and (1621 . "@src64/flow.l")
 any (3877 . "@src64/io.l")
 append (1338 . "@src64/subr.l")
-apply (703 . "@src64/apply.l")
+apply (711 . "@src64/apply.l")
 arg (2267 . "@src64/main.l")
 args (2243 . "@src64/main.l")
 argv (2888 . "@src64/main.l")
@@ -45,7 +45,7 @@ bit? (2746 . "@src64/big.l")
 bool (1721 . "@src64/flow.l")
 box (822 . "@src64/flow.l")
 box? (999 . "@src64/sym.l")
-by (1659 . "@src64/apply.l")
+by (1667 . "@src64/apply.l")
 bye (3422 . "@src64/flow.l")
 caaaar (271 . "@src64/subr.l")
 caaadr (288 . "@src64/subr.l")
@@ -89,7 +89,7 @@ circ? (2398 . "@src64/subr.l")
 clip (1795 . "@src64/subr.l")
 close (4265 . "@src64/io.l")
 cmd (2870 . "@src64/main.l")
-cnt (1403 . "@src64/apply.l")
+cnt (1411 . "@src64/apply.l")
 co (2544 . "@src64/flow.l")
 commit (1496 . "@src64/db.l")
 con (725 . "@src64/subr.l")
@@ -125,15 +125,15 @@ ext (5026 . "@src64/io.l")
 ext? (1034 . "@src64/sym.l")
 extern (900 . "@src64/sym.l")
 extra (1263 . "@src64/flow.l")
-extract (1208 . "@src64/apply.l")
+extract (1216 . "@src64/apply.l")
 fifo (1963 . "@src64/sym.l")
 file (2748 . "@src64/main.l")
 fill (3236 . "@src64/subr.l")
-filter (1151 . "@src64/apply.l")
+filter (1159 . "@src64/apply.l")
 fin (2029 . "@src64/subr.l")
 finally (2520 . "@src64/flow.l")
-find (1312 . "@src64/apply.l")
-fish (1603 . "@src64/apply.l")
+find (1320 . "@src64/apply.l")
+fish (1611 . "@src64/apply.l")
 flg? (2441 . "@src64/subr.l")
 flip (1695 . "@src64/subr.l")
 flush (5001 . "@src64/io.l")
@@ -195,24 +195,24 @@ lt0 (2680 . "@src64/big.l")
 lup (2226 . "@src64/sym.l")
 made (1107 . "@src64/subr.l")
 make (1088 . "@src64/subr.l")
-map (839 . "@src64/apply.l")
-mapc (881 . "@src64/apply.l")
-mapcan (1091 . "@src64/apply.l")
-mapcar (977 . "@src64/apply.l")
-mapcon (1031 . "@src64/apply.l")
-maplist (923 . "@src64/apply.l")
-maps (780 . "@src64/apply.l")
+map (847 . "@src64/apply.l")
+mapc (889 . "@src64/apply.l")
+mapcan (1099 . "@src64/apply.l")
+mapcar (985 . "@src64/apply.l")
+mapcon (1039 . "@src64/apply.l")
+maplist (931 . "@src64/apply.l")
+maps (788 . "@src64/apply.l")
 mark (1965 . "@src64/db.l")
 match (3121 . "@src64/subr.l")
 max (2323 . "@src64/subr.l")
-maxi (1501 . "@src64/apply.l")
+maxi (1509 . "@src64/apply.l")
 member (2451 . "@src64/subr.l")
 memq (2473 . "@src64/subr.l")
 meta (3135 . "@src64/sym.l")
 meth (1087 . "@src64/flow.l")
 method (1051 . "@src64/flow.l")
 min (2352 . "@src64/subr.l")
-mini (1552 . "@src64/apply.l")
+mini (1560 . "@src64/apply.l")
 mix (1260 . "@src64/subr.l")
 mmeq (2501 . "@src64/subr.l")
 n0 (2185 . "@src64/subr.l")
@@ -242,11 +242,11 @@ or (1637 . "@src64/flow.l")
 out (4121 . "@src64/io.l")
 pack (1144 . "@src64/sym.l")
 pair (2390 . "@src64/subr.l")
-pass (744 . "@src64/apply.l")
+pass (752 . "@src64/apply.l")
 pat? (720 . "@src64/sym.l")
 path (1238 . "@src64/io.l")
 peek (3343 . "@src64/io.l")
-pick (1359 . "@src64/apply.l")
+pick (1367 . "@src64/apply.l")
 pipe (4142 . "@src64/io.l")
 poll (3232 . "@src64/io.l")
 pool (648 . "@src64/db.l")
@@ -290,7 +290,7 @@ rpc (5142 . "@src64/io.l")
 run (313 . "@src64/flow.l")
 sect (2537 . "@src64/subr.l")
 seed (2958 . "@src64/big.l")
-seek (1265 . "@src64/apply.l")
+seek (1273 . "@src64/apply.l")
 send (1131 . "@src64/flow.l")
 seq (1083 . "@src64/db.l")
 set (1482 . "@src64/sym.l")
@@ -309,7 +309,7 @@ str (3931 . "@src64/io.l")
 str? (1013 . "@src64/sym.l")
 strip (1572 . "@src64/subr.l")
 sub? (1444 . "@src64/sym.l")
-sum (1450 . "@src64/apply.l")
+sum (1458 . "@src64/apply.l")
 super (1218 . "@src64/flow.l")
 sym (3917 . "@src64/io.l")
 sym? (2430 . "@src64/subr.l")
diff --git a/src64/apply.l b/src64/apply.l
@@ -109,6 +109,8 @@
                   push E  # Dummy cell's CDR
                   lea A (S II)  # Value address
                   push A  # CAR
+                  cmp S (StkLimit)  # Stack check
+                  jlt stkErrX
                   ld E S  # Set 'args' list
                   add Z I
                   cmp Z Y  # More args?
@@ -271,6 +273,8 @@
                   push E  # Dummy cell's CDR
                   lea A (S II)  # Value address
                   push A  # CAR
+                  cmp S (StkLimit)  # Stack check
+                  jlt stkErrX
                   ld E S  # Set 'args' list
                   add Z I
                   cmp Z Y  # More args?
@@ -458,6 +462,8 @@
                   push E  # Dummy cell's CDR
                   lea A (S II)  # Value address
                   push A  # CAR
+                  cmp S (StkLimit)  # Stack check
+                  jlt stkErrX
                   ld E S  # Set 'args' list
                   add Z I
                   cmp Z Y  # More args?
@@ -620,6 +626,8 @@
                   push E  # Dummy cell's CDR
                   lea A (S II)  # Value address
                   push A  # CAR
+                  cmp S (StkLimit)  # Stack check
+                  jlt stkErrX
                   ld E S  # Set 'args' list
                   add Z I
                   cmp Z Y  # More args?