commit a664f5f84a8a0220bc5c8c3e6b9c8e28dfc8dea9
parent 1e3dd1f0ffd4be6910098c22b99a6e5220661ed9
Author: Commit-Bot <unknown>
Date: Thu, 10 Jun 2010 12:59:45 +0000
Automatic commit from picoLisp.tgz, From: Thu, 10 Jun 2010 12:59:45 GMT
Diffstat:
9 files changed, 368 insertions(+), 264 deletions(-)
diff --git a/lib/tags b/lib/tags
@@ -1,52 +1,52 @@
-! (2850 . "@src64/flow.l")
-$ (2952 . "@src64/flow.l")
-% (2251 . "@src64/big.l")
-& (2472 . "@src64/big.l")
-* (2070 . "@src64/big.l")
-*/ (2127 . "@src64/big.l")
-+ (1852 . "@src64/big.l")
-- (1890 . "@src64/big.l")
--> (3788 . "@src64/subr.l")
-/ (2192 . "@src64/big.l")
-: (2896 . "@src64/sym.l")
-:: (2920 . "@src64/sym.l")
-; (2822 . "@src64/sym.l")
-< (2192 . "@src64/subr.l")
-<= (2222 . "@src64/subr.l")
-<> (2129 . "@src64/subr.l")
-= (2100 . "@src64/subr.l")
-=0 (2158 . "@src64/subr.l")
-=: (2851 . "@src64/sym.l")
-== (2044 . "@src64/subr.l")
+! (2858 . "@src64/flow.l")
+$ (2960 . "@src64/flow.l")
+% (2253 . "@src64/big.l")
+& (2474 . "@src64/big.l")
+* (2072 . "@src64/big.l")
+*/ (2129 . "@src64/big.l")
++ (1854 . "@src64/big.l")
+- (1892 . "@src64/big.l")
+-> (3820 . "@src64/subr.l")
+/ (2194 . "@src64/big.l")
+: (2898 . "@src64/sym.l")
+:: (2922 . "@src64/sym.l")
+; (2824 . "@src64/sym.l")
+< (2194 . "@src64/subr.l")
+<= (2224 . "@src64/subr.l")
+<> (2131 . "@src64/subr.l")
+= (2102 . "@src64/subr.l")
+=0 (2160 . "@src64/subr.l")
+=: (2853 . "@src64/sym.l")
+== (2046 . "@src64/subr.l")
==== (967 . "@src64/sym.l")
-=T (2166 . "@src64/subr.l")
-> (2252 . "@src64/subr.l")
->= (2282 . "@src64/subr.l")
->> (2306 . "@src64/big.l")
-abs (2396 . "@src64/big.l")
+=T (2168 . "@src64/subr.l")
+> (2254 . "@src64/subr.l")
+>= (2284 . "@src64/subr.l")
+>> (2308 . "@src64/big.l")
+abs (2398 . "@src64/big.l")
accept (139 . "@src64/net.l")
adr (593 . "@src64/main.l")
alarm (483 . "@src64/main.l")
all (772 . "@src64/sym.l")
-and (1635 . "@src64/flow.l")
-any (3758 . "@src64/io.l")
+and (1643 . "@src64/flow.l")
+any (3764 . "@src64/io.l")
append (1329 . "@src64/subr.l")
-apply (581 . "@src64/apply.l")
-arg (1963 . "@src64/main.l")
-args (1939 . "@src64/main.l")
-argv (2584 . "@src64/main.l")
+apply (597 . "@src64/apply.l")
+arg (1973 . "@src64/main.l")
+args (1949 . "@src64/main.l")
+argv (2594 . "@src64/main.l")
as (146 . "@src64/flow.l")
-asoq (2938 . "@src64/subr.l")
-assoc (2903 . "@src64/subr.l")
-at (2120 . "@src64/flow.l")
-atom (2370 . "@src64/subr.l")
-bind (1373 . "@src64/flow.l")
-bit? (2413 . "@src64/big.l")
-bool (1735 . "@src64/flow.l")
-box (837 . "@src64/flow.l")
+asoq (2942 . "@src64/subr.l")
+assoc (2907 . "@src64/subr.l")
+at (2128 . "@src64/flow.l")
+atom (2372 . "@src64/subr.l")
+bind (1381 . "@src64/flow.l")
+bit? (2415 . "@src64/big.l")
+bool (1743 . "@src64/flow.l")
+box (841 . "@src64/flow.l")
box? (999 . "@src64/sym.l")
-by (1535 . "@src64/apply.l")
-bye (3427 . "@src64/flow.l")
+by (1553 . "@src64/apply.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 (3083 . "@src64/flow.l")
+call (3091 . "@src64/flow.l")
car (5 . "@src64/subr.l")
-case (1976 . "@src64/flow.l")
-catch (2476 . "@src64/flow.l")
-cd (2339 . "@src64/main.l")
+case (1984 . "@src64/flow.l")
+catch (2484 . "@src64/flow.l")
+cd (2349 . "@src64/main.l")
cdaaar (464 . "@src64/subr.l")
cdaadr (487 . "@src64/subr.l")
cdaar (179 . "@src64/subr.l")
@@ -82,270 +82,270 @@ cdddr (245 . "@src64/subr.l")
cddr (79 . "@src64/subr.l")
cdr (17 . "@src64/subr.l")
chain (1132 . "@src64/subr.l")
-char (3240 . "@src64/io.l")
+char (3246 . "@src64/io.l")
chop (1093 . "@src64/sym.l")
circ (816 . "@src64/subr.l")
-clip (1784 . "@src64/subr.l")
-close (4146 . "@src64/io.l")
-cmd (2566 . "@src64/main.l")
-cnt (1279 . "@src64/apply.l")
-co (2558 . "@src64/flow.l")
+clip (1786 . "@src64/subr.l")
+close (4152 . "@src64/io.l")
+cmd (2576 . "@src64/main.l")
+cnt (1297 . "@src64/apply.l")
+co (2566 . "@src64/flow.l")
commit (1503 . "@src64/db.l")
con (725 . "@src64/subr.l")
conc (781 . "@src64/subr.l")
-cond (1930 . "@src64/flow.l")
+cond (1938 . "@src64/flow.l")
connect (201 . "@src64/net.l")
cons (747 . "@src64/subr.l")
copy (1216 . "@src64/subr.l")
-ctl (4086 . "@src64/io.l")
-ctty (2364 . "@src64/main.l")
-cut (1795 . "@src64/sym.l")
-date (2078 . "@src64/main.l")
+ctl (4092 . "@src64/io.l")
+ctty (2374 . "@src64/main.l")
+cut (1797 . "@src64/sym.l")
+date (2088 . "@src64/main.l")
dbck (2092 . "@src64/db.l")
de (549 . "@src64/flow.l")
-dec (2004 . "@src64/big.l")
+dec (2006 . "@src64/big.l")
def (473 . "@src64/flow.l")
-default (1659 . "@src64/sym.l")
-del (1850 . "@src64/sym.l")
+default (1661 . "@src64/sym.l")
+del (1852 . "@src64/sym.l")
delete (1392 . "@src64/subr.l")
delq (1443 . "@src64/subr.l")
-diff (2561 . "@src64/subr.l")
-dir (2497 . "@src64/main.l")
+diff (2563 . "@src64/subr.l")
+dir (2507 . "@src64/main.l")
dm (561 . "@src64/flow.l")
-do (2150 . "@src64/flow.l")
-e (2913 . "@src64/flow.l")
-echo (4177 . "@src64/io.l")
+do (2158 . "@src64/flow.l")
+e (2921 . "@src64/flow.l")
+echo (4183 . "@src64/io.l")
env (605 . "@src64/main.l")
-eof (3317 . "@src64/io.l")
-eol (3308 . "@src64/io.l")
-errno (1290 . "@src64/main.l")
+eof (3323 . "@src64/io.l")
+eol (3314 . "@src64/io.l")
+errno (1300 . "@src64/main.l")
eval (208 . "@src64/flow.l")
-ext (4864 . "@src64/io.l")
+ext (4874 . "@src64/io.l")
ext? (1034 . "@src64/sym.l")
extern (900 . "@src64/sym.l")
-extra (1278 . "@src64/flow.l")
-extract (1084 . "@src64/apply.l")
-fifo (1961 . "@src64/sym.l")
-file (2444 . "@src64/main.l")
-fill (3165 . "@src64/subr.l")
-filter (1027 . "@src64/apply.l")
-fin (2018 . "@src64/subr.l")
-finally (2534 . "@src64/flow.l")
-find (1188 . "@src64/apply.l")
-fish (1479 . "@src64/apply.l")
-flg? (2417 . "@src64/subr.l")
+extra (1284 . "@src64/flow.l")
+extract (1102 . "@src64/apply.l")
+fifo (1963 . "@src64/sym.l")
+file (2454 . "@src64/main.l")
+fill (3177 . "@src64/subr.l")
+filter (1045 . "@src64/apply.l")
+fin (2020 . "@src64/subr.l")
+finally (2542 . "@src64/flow.l")
+find (1206 . "@src64/apply.l")
+fish (1497 . "@src64/apply.l")
+flg? (2419 . "@src64/subr.l")
flip (1686 . "@src64/subr.l")
-flush (4839 . "@src64/io.l")
-fold (3341 . "@src64/sym.l")
-for (2239 . "@src64/flow.l")
-fork (3250 . "@src64/flow.l")
-format (1770 . "@src64/big.l")
+flush (4849 . "@src64/io.l")
+fold (3345 . "@src64/sym.l")
+for (2247 . "@src64/flow.l")
+fork (3258 . "@src64/flow.l")
+format (1772 . "@src64/big.l")
free (2034 . "@src64/db.l")
-from (3336 . "@src64/io.l")
+from (3342 . "@src64/io.l")
full (1066 . "@src64/subr.l")
fun? (734 . "@src64/sym.l")
gc (442 . "@src64/gc.l")
-ge0 (2372 . "@src64/big.l")
-get (2748 . "@src64/sym.l")
+ge0 (2374 . "@src64/big.l")
+get (2750 . "@src64/sym.l")
getd (742 . "@src64/sym.l")
-getl (3030 . "@src64/sym.l")
-glue (1232 . "@src64/sym.l")
-gt0 (2383 . "@src64/big.l")
-head (1805 . "@src64/subr.l")
+getl (3032 . "@src64/sym.l")
+glue (1234 . "@src64/sym.l")
+gt0 (2385 . "@src64/big.l")
+head (1807 . "@src64/subr.l")
heap (538 . "@src64/main.l")
-hear (3058 . "@src64/io.l")
+hear (3064 . "@src64/io.l")
host (184 . "@src64/net.l")
id (1034 . "@src64/db.l")
-idx (2035 . "@src64/sym.l")
-if (1816 . "@src64/flow.l")
-if2 (1835 . "@src64/flow.l")
-ifn (1876 . "@src64/flow.l")
-in (3982 . "@src64/io.l")
-inc (1937 . "@src64/big.l")
-index (2609 . "@src64/subr.l")
-info (2401 . "@src64/main.l")
+idx (2037 . "@src64/sym.l")
+if (1824 . "@src64/flow.l")
+if2 (1843 . "@src64/flow.l")
+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")
intern (875 . "@src64/sym.l")
-ipid (3195 . "@src64/flow.l")
-isa (974 . "@src64/flow.l")
-job (1440 . "@src64/flow.l")
+ipid (3203 . "@src64/flow.l")
+isa (978 . "@src64/flow.l")
+job (1448 . "@src64/flow.l")
journal (977 . "@src64/db.l")
-key (3167 . "@src64/io.l")
-kill (3227 . "@src64/flow.l")
-last (2029 . "@src64/subr.l")
-length (2685 . "@src64/subr.l")
-let (1490 . "@src64/flow.l")
-let? (1551 . "@src64/flow.l")
+key (3173 . "@src64/io.l")
+kill (3235 . "@src64/flow.l")
+last (2031 . "@src64/subr.l")
+length (2687 . "@src64/subr.l")
+let (1498 . "@src64/flow.l")
+let? (1559 . "@src64/flow.l")
lieu (1163 . "@src64/db.l")
-line (3492 . "@src64/io.l")
-lines (3645 . "@src64/io.l")
+line (3498 . "@src64/io.l")
+lines (3651 . "@src64/io.l")
link (1163 . "@src64/subr.l")
list (887 . "@src64/subr.l")
listen (151 . "@src64/net.l")
lit (183 . "@src64/flow.l")
-load (3959 . "@src64/io.l")
+load (3965 . "@src64/io.l")
lock (1191 . "@src64/db.l")
-loop (2182 . "@src64/flow.l")
-low? (3213 . "@src64/sym.l")
-lowc (3243 . "@src64/sym.l")
-lst? (2387 . "@src64/subr.l")
-lt0 (2361 . "@src64/big.l")
-lup (2224 . "@src64/sym.l")
+loop (2190 . "@src64/flow.l")
+low? (3217 . "@src64/sym.l")
+lowc (3247 . "@src64/sym.l")
+lst? (2389 . "@src64/subr.l")
+lt0 (2363 . "@src64/big.l")
+lup (2226 . "@src64/sym.l")
made (1098 . "@src64/subr.l")
make (1079 . "@src64/subr.l")
-map (715 . "@src64/apply.l")
-mapc (757 . "@src64/apply.l")
-mapcan (967 . "@src64/apply.l")
-mapcar (853 . "@src64/apply.l")
-mapcon (907 . "@src64/apply.l")
-maplist (799 . "@src64/apply.l")
-maps (656 . "@src64/apply.l")
+map (733 . "@src64/apply.l")
+mapc (775 . "@src64/apply.l")
+mapcan (985 . "@src64/apply.l")
+mapcar (871 . "@src64/apply.l")
+mapcon (925 . "@src64/apply.l")
+maplist (817 . "@src64/apply.l")
+maps (674 . "@src64/apply.l")
mark (1952 . "@src64/db.l")
-match (3058 . "@src64/subr.l")
-max (2312 . "@src64/subr.l")
-maxi (1377 . "@src64/apply.l")
-member (2427 . "@src64/subr.l")
-memq (2449 . "@src64/subr.l")
-meta (3135 . "@src64/sym.l")
-meth (1100 . "@src64/flow.l")
-method (1064 . "@src64/flow.l")
-min (2341 . "@src64/subr.l")
-mini (1428 . "@src64/apply.l")
+match (3062 . "@src64/subr.l")
+max (2314 . "@src64/subr.l")
+maxi (1395 . "@src64/apply.l")
+member (2429 . "@src64/subr.l")
+memq (2451 . "@src64/subr.l")
+meta (3137 . "@src64/sym.l")
+meth (1106 . "@src64/flow.l")
+method (1070 . "@src64/flow.l")
+min (2343 . "@src64/subr.l")
+mini (1446 . "@src64/apply.l")
mix (1251 . "@src64/subr.l")
-mmeq (2477 . "@src64/subr.l")
-n0 (2174 . "@src64/subr.l")
-n== (2072 . "@src64/subr.l")
-nT (2183 . "@src64/subr.l")
+mmeq (2479 . "@src64/subr.l")
+n0 (2176 . "@src64/subr.l")
+n== (2074 . "@src64/subr.l")
+nT (2185 . "@src64/subr.l")
name (499 . "@src64/sym.l")
-nand (1670 . "@src64/flow.l")
-native (1298 . "@src64/main.l")
+nand (1678 . "@src64/flow.l")
+native (1308 . "@src64/main.l")
need (918 . "@src64/subr.l")
-new (848 . "@src64/flow.l")
-next (1946 . "@src64/main.l")
-nil (1753 . "@src64/flow.l")
-nond (1953 . "@src64/flow.l")
-nor (1691 . "@src64/flow.l")
-not (1743 . "@src64/flow.l")
+new (852 . "@src64/flow.l")
+next (1956 . "@src64/main.l")
+nil (1761 . "@src64/flow.l")
+nond (1961 . "@src64/flow.l")
+nor (1699 . "@src64/flow.l")
+not (1751 . "@src64/flow.l")
nth (685 . "@src64/subr.l")
-num? (2398 . "@src64/subr.l")
-off (1596 . "@src64/sym.l")
-offset (2649 . "@src64/subr.l")
-on (1581 . "@src64/sym.l")
-onOff (1611 . "@src64/sym.l")
-one (1644 . "@src64/sym.l")
-open (4108 . "@src64/io.l")
-opid (3211 . "@src64/flow.l")
-opt (2687 . "@src64/main.l")
-or (1651 . "@src64/flow.l")
-out (4002 . "@src64/io.l")
+num? (2400 . "@src64/subr.l")
+off (1598 . "@src64/sym.l")
+offset (2651 . "@src64/subr.l")
+on (1583 . "@src64/sym.l")
+onOff (1613 . "@src64/sym.l")
+one (1646 . "@src64/sym.l")
+open (4114 . "@src64/io.l")
+opid (3219 . "@src64/flow.l")
+opt (2697 . "@src64/main.l")
+or (1659 . "@src64/flow.l")
+out (4008 . "@src64/io.l")
pack (1144 . "@src64/sym.l")
-pair (2379 . "@src64/subr.l")
-pass (620 . "@src64/apply.l")
+pair (2381 . "@src64/subr.l")
+pass (638 . "@src64/apply.l")
pat? (720 . "@src64/sym.l")
-path (1168 . "@src64/io.l")
-peek (3224 . "@src64/io.l")
-pick (1235 . "@src64/apply.l")
+path (1170 . "@src64/io.l")
+peek (3230 . "@src64/io.l")
+pick (1253 . "@src64/apply.l")
pid (157 . "@src64/flow.l")
-pipe (4023 . "@src64/io.l")
-poll (3120 . "@src64/io.l")
+pipe (4029 . "@src64/io.l")
+poll (3126 . "@src64/io.l")
pool (657 . "@src64/db.l")
-pop (1771 . "@src64/sym.l")
+pop (1773 . "@src64/sym.l")
port (5 . "@src64/net.l")
-pr (4953 . "@src64/io.l")
-pre? (1409 . "@src64/sym.l")
-prin (4763 . "@src64/io.l")
-prinl (4777 . "@src64/io.l")
-print (4803 . "@src64/io.l")
-println (4834 . "@src64/io.l")
-printsp (4819 . "@src64/io.l")
-prog (1771 . "@src64/flow.l")
-prog1 (1779 . "@src64/flow.l")
-prog2 (1796 . "@src64/flow.l")
-prop (2779 . "@src64/sym.l")
+pr (4965 . "@src64/io.l")
+pre? (1411 . "@src64/sym.l")
+prin (4773 . "@src64/io.l")
+prinl (4787 . "@src64/io.l")
+print (4813 . "@src64/io.l")
+println (4844 . "@src64/io.l")
+printsp (4829 . "@src64/io.l")
+prog (1779 . "@src64/flow.l")
+prog1 (1787 . "@src64/flow.l")
+prog2 (1804 . "@src64/flow.l")
+prop (2781 . "@src64/sym.l")
protect (528 . "@src64/main.l")
-prove (3412 . "@src64/subr.l")
-push (1686 . "@src64/sym.l")
-push1 (1722 . "@src64/sym.l")
-put (2696 . "@src64/sym.l")
-putl (2948 . "@src64/sym.l")
-pwd (2328 . "@src64/main.l")
-queue (1918 . "@src64/sym.l")
-quit (1009 . "@src64/main.l")
+prove (3434 . "@src64/subr.l")
+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")
+queue (1920 . "@src64/sym.l")
+quit (1017 . "@src64/main.l")
quote (141 . "@src64/flow.l")
-rand (2640 . "@src64/big.l")
+rand (2642 . "@src64/big.l")
range (988 . "@src64/subr.l")
-rank (2966 . "@src64/subr.l")
+rank (2970 . "@src64/subr.l")
raw (461 . "@src64/main.l")
-rd (4881 . "@src64/io.l")
-read (2498 . "@src64/io.l")
+rd (4891 . "@src64/io.l")
+read (2502 . "@src64/io.l")
replace (1490 . "@src64/subr.l")
-rest (1992 . "@src64/main.l")
+rest (2002 . "@src64/main.l")
reverse (1665 . "@src64/subr.l")
-rewind (4847 . "@src64/io.l")
+rewind (4857 . "@src64/io.l")
rollback (1885 . "@src64/db.l")
rot (848 . "@src64/subr.l")
-rpc (4986 . "@src64/io.l")
+rpc (4998 . "@src64/io.l")
run (331 . "@src64/flow.l")
-sect (2513 . "@src64/subr.l")
-seed (2625 . "@src64/big.l")
-seek (1141 . "@src64/apply.l")
-send (1144 . "@src64/flow.l")
+sect (2515 . "@src64/subr.l")
+seed (2627 . "@src64/big.l")
+seek (1159 . "@src64/apply.l")
+send (1150 . "@src64/flow.l")
seq (1090 . "@src64/db.l")
-set (1480 . "@src64/sym.l")
-setq (1513 . "@src64/sym.l")
+set (1482 . "@src64/sym.l")
+setq (1515 . "@src64/sym.l")
sigio (499 . "@src64/main.l")
-size (2750 . "@src64/subr.l")
-skip (3294 . "@src64/io.l")
-sort (3837 . "@src64/subr.l")
+size (2752 . "@src64/subr.l")
+skip (3300 . "@src64/io.l")
+sort (3869 . "@src64/subr.l")
sp? (711 . "@src64/sym.l")
-space (4781 . "@src64/io.l")
+space (4791 . "@src64/io.l")
split (1579 . "@src64/subr.l")
stack (567 . "@src64/main.l")
-state (2020 . "@src64/flow.l")
-stem (1974 . "@src64/subr.l")
-str (3812 . "@src64/io.l")
+state (2028 . "@src64/flow.l")
+stem (1976 . "@src64/subr.l")
+str (3818 . "@src64/io.l")
str? (1013 . "@src64/sym.l")
strip (1563 . "@src64/subr.l")
-sub? (1442 . "@src64/sym.l")
-sum (1326 . "@src64/apply.l")
-super (1231 . "@src64/flow.l")
-sym (3798 . "@src64/io.l")
-sym? (2406 . "@src64/subr.l")
-sync (3020 . "@src64/io.l")
-sys (3054 . "@src64/flow.l")
-t (1762 . "@src64/flow.l")
-tail (1896 . "@src64/subr.l")
-tell (3090 . "@src64/io.l")
-text (1270 . "@src64/sym.l")
-throw (2502 . "@src64/flow.l")
-tick (3163 . "@src64/flow.l")
-till (3403 . "@src64/io.l")
-time (2211 . "@src64/main.l")
+sub? (1444 . "@src64/sym.l")
+sum (1344 . "@src64/apply.l")
+super (1237 . "@src64/flow.l")
+sym (3804 . "@src64/io.l")
+sym? (2408 . "@src64/subr.l")
+sync (3026 . "@src64/io.l")
+sys (3062 . "@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 (3171 . "@src64/flow.l")
+till (3409 . "@src64/io.l")
+time (2221 . "@src64/main.l")
touch (1049 . "@src64/sym.l")
trim (1746 . "@src64/subr.l")
-try (1185 . "@src64/flow.l")
-type (927 . "@src64/flow.l")
+try (1191 . "@src64/flow.l")
+type (931 . "@src64/flow.l")
udp (268 . "@src64/net.l")
-unify (3810 . "@src64/subr.l")
-unless (1912 . "@src64/flow.l")
-until (2096 . "@src64/flow.l")
+unify (3842 . "@src64/subr.l")
+unless (1920 . "@src64/flow.l")
+until (2104 . "@src64/flow.l")
up (692 . "@src64/main.l")
-upp? (3228 . "@src64/sym.l")
-uppc (3292 . "@src64/sym.l")
-use (1584 . "@src64/flow.l")
-usec (2316 . "@src64/main.l")
-val (1461 . "@src64/sym.l")
-version (2701 . "@src64/main.l")
-wait (2982 . "@src64/io.l")
-when (1895 . "@src64/flow.l")
-while (2072 . "@src64/flow.l")
-wipe (3088 . "@src64/sym.l")
-with (1341 . "@src64/flow.l")
-wr (4970 . "@src64/io.l")
-xchg (1536 . "@src64/sym.l")
-xor (1712 . "@src64/flow.l")
-x| (2552 . "@src64/big.l")
-yield (2716 . "@src64/flow.l")
+upp? (3232 . "@src64/sym.l")
+uppc (3296 . "@src64/sym.l")
+use (1592 . "@src64/flow.l")
+usec (2326 . "@src64/main.l")
+val (1463 . "@src64/sym.l")
+version (2711 . "@src64/main.l")
+wait (2988 . "@src64/io.l")
+when (1903 . "@src64/flow.l")
+while (2080 . "@src64/flow.l")
+wipe (3090 . "@src64/sym.l")
+with (1349 . "@src64/flow.l")
+wr (4982 . "@src64/io.l")
+xchg (1538 . "@src64/sym.l")
+xor (1720 . "@src64/flow.l")
+x| (2554 . "@src64/big.l")
+yield (2724 . "@src64/flow.l")
yoke (1187 . "@src64/subr.l")
zap (1063 . "@src64/sym.l")
-zero (1629 . "@src64/sym.l")
-| (2512 . "@src64/big.l")
+zero (1631 . "@src64/sym.l")
+| (2514 . "@src64/big.l")
diff --git a/src64/apply.l b/src64/apply.l
@@ -1,4 +1,4 @@
-# 22sep09abu
+# 10jun10abu
# (c) Software Lab. Alexander Burger
(code 'applyXYZ_E 0)
@@ -25,6 +25,8 @@
lea A (S II) # Value address
push A # CAR
ld (S V) S # Store CDR of previous cell
+ cmp S (StkLimit) # Stack check
+ jlt stkErrX
loop
link
ld (EnvApply) L # Close apply frame
@@ -35,6 +37,8 @@
end
big C # Undefined if bignum
jnz undefinedCX
+ cmp S (StkLimit) # Stack check
+ jlt stkErrX
atom C # Cell?
if z # Yes
# Apply EXPR
@@ -116,6 +120,8 @@
do
sub Y I
push (Y) # Push next argument
+ cmp S (StkLimit) # Stack check
+ jlt stkErrX
cmp Y Z # More args?
until eq # No
ld (EnvArgs) S # Set new varArgs base
@@ -252,6 +258,8 @@
do
sub Y I
push (Y) # Push next argument
+ cmp S (StkLimit) # Stack check
+ jlt stkErrX
cmp Y Z # More args?
until eq # No
ld (EnvArgs) S # Set new varArgs base
@@ -313,6 +321,8 @@
lea A (S II) # Value address
push A # CAR
ld (S V) S # Store CDR of previous cell
+ cmp S (StkLimit) # Stack check
+ jlt stkErrX
loop
link
ld (EnvApply) L # Close apply frame
@@ -323,6 +333,8 @@
end
big C # Undefined if bignum
jnz undefinedCX
+ cmp S (StkLimit) # Stack check
+ jlt stkErrX
atom C # Cell?
if z # Yes
# Apply EXPR
@@ -404,6 +416,8 @@
do
sub Y I
push ((Y)) # Push CAR of next argument
+ cmp S (StkLimit) # Stack check
+ jlt stkErrX
cmp Y Z # More args?
until eq # No
ld (EnvArgs) S # Set new varArgs base
@@ -540,6 +554,8 @@
do
sub Y I
push ((Y)) # Push CAR of next argument
+ cmp S (StkLimit) # Stack check
+ jlt stkErrX
cmp Y Z # More args?
until eq # No
ld (EnvArgs) S # Set new varArgs base
@@ -605,6 +621,8 @@
atom E # Expand 'lst'
while z
push (E)
+ cmp S (StkLimit) # Stack check
+ jlt stkErrX
ld E (E CDR)
loop
ld Z S # Z on last argument
diff --git a/src64/big.l b/src64/big.l
@@ -1,4 +1,4 @@
-# 19may10abu
+# 10jun10abu
# (c) Software Lab. Alexander Burger
### Destructive primitives ###
@@ -1513,6 +1513,8 @@
ld (S) 1 # Init to '1'
ld X S # Keep pointer to incrementor in X
sub S A # <S III> Accumulator
+ cmp S (StkLimit) # Stack check
+ jlt stkErr
ld (S) 0 # Init to '0'
push S # <S II> Top of accumulator
push X # <S I> Pointer to incrementor
diff --git a/src64/err.l b/src64/err.l
@@ -1,4 +1,4 @@
-# 09jun10abu
+# 10jun10abu
# (c) Software Lab. Alexander Burger
# Debug print routine
@@ -238,19 +238,35 @@
loop
do
cmp (EnvInFrames) (X IV) # Open input frames?
- while nz # Yes
+ while ne # Yes
call popInFiles # Clean up
loop
do
cmp (EnvOutFrames) (X V) # Open output frames?
- while nz # Yes
+ while ne # Yes
call popOutFiles # Clean up
loop
do
cmp (EnvCtlFrames) (X VI) # Open control frames?
- while nz # Yes
+ while ne # Yes
call popCtlFiles # Clean up
loop
+ ld Z (EnvCo7) # Get coroutines
+ do
+ cmp Z (X "EnvCo7-Env") # Skipped?
+ while ne # Yes
+ ld C (Stack0) # Find stack segment
+ ld A 1
+ do
+ sub C (StkSize) # Next segment
+ cmp C (Z II) # Found 'seg'?
+ while ne # No
+ add A A
+ loop
+ not A # Clear in segment bitmask
+ and (Stacks) A
+ ld Z (Z) # Next coroutine
+ loop
load (Env) (EnvEnd) (X III) # Restore environment
ld E (X II) # 'fin'
eval # Evaluate 'finally' expression
@@ -368,6 +384,8 @@
: ProtErr asciz "Protected symbol"
### Error messages ###
+(code 'stkErr)
+ ld E 0
(code 'stkErrE)
ld X E
(code 'stkErrX)
diff --git a/src64/flow.l b/src64/flow.l
@@ -665,6 +665,8 @@
ld Y (C) # Parameter list in Y
ld Z (C CDR) # Body in Z
push (EnvBind) # Build bind frame
+ cmp S (StkLimit) # Stack check
+ jlt stkErr
link
push (At) # Bind At
push At
@@ -824,6 +826,8 @@
ld Z A # Set class list
ld E (A) # Class symbol
push A
+ cmp S (StkLimit) # Stack check
+ jlt stkErr
call methodEY_FCYZ # Found method definition?
pop A
jeq ret # 'z'
@@ -1041,6 +1045,8 @@
push E # object
push X # and list
ld E (X) # Recurse
+ cmp S (StkLimit) # Stack check
+ jlt stkErr
call isaCE_F # Match?
pop X
pop E
@@ -1328,6 +1334,8 @@
end
push X
ld X (X) # Recurse on superclass
+ cmp S (StkLimit) # Stack check
+ jlt stkErr
call extraXY_FCYZ # Found?
pop X
jeq ret # Yes
@@ -2610,16 +2618,16 @@
loop
ld (EnvBind) C # Set local bindings
ld X EnvInFrames # Pointer to input frames
- ld C (Z (pack III "+(EnvMid-EnvInFrames)")) # Local input frames
+ ld C (Z (pack III "+(EnvInFrames-Env)")) # Local input frames
call joinLocalCX # Join locals
ld X EnvOutFrames # Pointer to output frames
- ld C (Z (pack III "+(EnvMid-EnvOutFrames)")) # Local output frames
+ ld C (Z (pack III "+(EnvOutFrames-Env)")) # Local output frames
call joinLocalCX # Join locals
ld X EnvCtlFrames # Pointer to ctlput frames
- ld C (Z (pack III "+(EnvMid-EnvCtlFrames)")) # Local ctlput frames
+ ld C (Z (pack III "+(EnvCtlFrames-Env)")) # Local ctlput frames
call joinLocalCX # Join locals
ld X EnvMeth # Pointer to method frames
- ld C (Z (pack III "+(EnvMid-EnvMeth)")) # Local method frames
+ ld C (Z (pack III "+(EnvMeth-Env)")) # Local method frames
call joinLocalCX # Join locals
ld X EnvApply # Local apply stack
do
@@ -2627,7 +2635,7 @@
while nz # Yes
ld X ((X)) # Follow link
loop
- ld (X) (Z (pack III "+(EnvMid-EnvApply)")) # Join
+ ld (X) (Z (pack III "+(EnvApply-Env)")) # Join
pop X # Get saved L
null X # Any?
if nz # Yes
@@ -2768,22 +2776,22 @@
ld X EnvApply # Pointer to apply stack
do
ld A (X)
- cmp A (Z (pack III "+(EnvMid-EnvApply)")) # Local apply stack?
+ cmp A (Z (pack III "+(EnvApply-Env)")) # Local apply stack?
while ne # Yes
lea X ((A) I) # Get link
loop
ld (X) 0 # Cut off
ld X EnvMeth # Pointer to method frames
- ld C (Z (pack III "+(EnvMid-EnvMeth)")) # Local method frames
+ ld C (Z (pack III "+(EnvMeth-Env)")) # Local method frames
call cutLocalCX # Cut off locals
ld X EnvCtlFrames # Pointer to ctlput frames
- ld C (Z (pack III "+(EnvMid-EnvCtlFrames)")) # Local ctlput frames
+ ld C (Z (pack III "+(EnvCtlFrames-Env)")) # Local ctlput frames
call cutLocalCX # Cut off locals
ld X EnvOutFrames # Pointer to output frames
- ld C (Z (pack III "+(EnvMid-EnvOutFrames)")) # Local output frames
+ ld C (Z (pack III "+(EnvOutFrames-Env)")) # Local output frames
call cutLocalCX # Cut off locals
ld X EnvInFrames # Pointer to input frames
- ld C (Z (pack III "+(EnvMid-EnvInFrames)")) # Local input frames
+ ld C (Z (pack III "+(EnvInFrames-Env)")) # Local input frames
call cutLocalCX # Cut off locals
ld C 0 # Back link
ld X (EnvBind) # Reverse bindings
diff --git a/src64/io.l b/src64/io.l
@@ -1,4 +1,4 @@
-# 30may10abu
+# 10jun10abu
# (c) Software Lab. Alexander Burger
# Close file descriptor
@@ -1082,6 +1082,8 @@
test Z 7 # Buffer full?
if z # Yes
sub S 8 # Extend buffer
+ cmp S (StkLimit) # Stack check
+ jlt stkErr
movm (S) (S 8) (Z)
sub Z 8 # Reset buffer pointer
end
@@ -1111,7 +1113,7 @@
call symByteCX_FACX # Second byte
end
cmp B (char "@") # Home path?
- if ne
+ if ne # No
do
ld (Z) B # Store byte
inc Z
@@ -2017,6 +2019,8 @@
: DelimEnd
(code 'rdList_E)
+ cmp S (StkLimit) # Stack check
+ jlt stkErr
call (EnvGet_A) # Skip paren
do
ld C (char "#")
@@ -2731,6 +2735,8 @@
end
add Y VI # Increment by sizeof(child)
loop
+ cmp S (StkLimit) # Stack check
+ jlt stkErrX
call msec_A # Get milliseconds
ld E A # into E
do
@@ -4528,6 +4534,8 @@
ret
(code 'printE 0)
+ cmp S (StkLimit) # Stack check
+ jlt stkErr
null (Signal) # Signal?
if nz # Yes
call sighandler0
@@ -4708,6 +4716,8 @@
ret
(code 'prinE 0)
+ cmp S (StkLimit) # Stack check
+ jlt stkErr
null (Signal) # Signal?
if nz # Yes
call sighandler0
@@ -4920,6 +4930,8 @@
add Y Z # Point to last byte
sub S E # Buffer
end
+ cmp S (StkLimit) # Stack check
+ jlt stkErr
ld C (C) # Get 'fd' of InFile
ld X S # Buffer pointer
push E # <S> Count
diff --git a/src64/main.l b/src64/main.l
@@ -1,4 +1,4 @@
-# 08jun10abu
+# 10jun10abu
# (c) Software Lab. Alexander Burger
### Global return labels ###
@@ -810,12 +810,16 @@
push (E CDR)
ld A (A) # Recurse on CARs
ld E (E)
+ cmp S (StkLimit) # Stack check
+ jlt stkErr
call equalAE_F # Equal?
pop E # Retrieve CDRs
pop A
break ne # No: 'ne'
atom A # A's CDR atomic?
if nz # Yes
+ cmp S (StkLimit) # Stack check
+ jlt stkErr
call equalAE_F # Compare with E's CDR
break T
end
@@ -956,6 +960,8 @@
push E
ld A (A)
ld E (E)
+ cmp S (StkLimit) # Stack check
+ jlt stkErr
call compareAE_F # Same?
pop E
pop A
@@ -964,6 +970,8 @@
ld E (E CDR)
atom A # End of A?
if nz # Yes
+ cmp S (StkLimit) # Stack check
+ jlt stkErr
call compareAE_F # Compare CDRs
break T
end
@@ -1201,6 +1209,8 @@
end
push E
ld E C
+ cmp S (StkLimit) # Stack check
+ jlt stkErr
call evListE_E
ld C E
pop E
diff --git a/src64/subr.l b/src64/subr.l
@@ -1,4 +1,4 @@
-# 04jun10abu
+# 10jun10abu
# (c) Software Lab. Alexander Burger
# (car 'var) -> any
@@ -1758,6 +1758,8 @@
if z # Yes
push (E) # Save CAR
ld E (E CDR) # Trim CDR
+ cmp S (StkLimit) # Stack check
+ jlt stkErr
call trimE_E
cmp E Nil # All trimmed?
if eq # Yes
@@ -2886,6 +2888,8 @@
if z # Yes
push E
ld E (E) # Count CAR
+ cmp S (StkLimit) # Stack check
+ jlt stkErr
call sizeCE_C
pop E
end
@@ -3112,6 +3116,8 @@
push E # and Data
ld C (C CDR) # Get CDRs
ld E (E CDR)
+ cmp S (StkLimit) # Stack check
+ jlt stkErr
call matchCE_F # Match?
pop E
pop C
@@ -3125,6 +3131,8 @@
push C # Save pattern
push E # and Data
ld C (C CDR) # CDR of pattern
+ cmp S (StkLimit) # Stack check
+ jlt stkErr
call matchCE_F # Match with data?
pop E
pop C
@@ -3135,6 +3143,8 @@
push C # Save pattern
push E # and Data
ld E (E CDR) # CDR of data
+ cmp S (StkLimit) # Stack check
+ jlt stkErr
call matchCE_F # Match with pattern?
pop E
pop C
@@ -3155,6 +3165,8 @@
push (E CDR)
ld C (C) # Get CARs
ld E (E)
+ cmp S (StkLimit) # Stack check
+ jlt stkErr
call matchCE_F # Match?
pop E
pop C
@@ -3216,6 +3228,8 @@
end
push E # <S> Save
ld E (E) # Recurse on CAR
+ cmp S (StkLimit) # Stack check
+ jlt stkErr
call fillE_FE # Modified?
if z # Yes
pop C # Get pattern
@@ -3223,6 +3237,8 @@
push E # <L I> Modified CAR
link
ld E (C CDR) # Recurse on CDR
+ cmp S (StkLimit) # Stack check
+ jlt stkErr
call fillE_FE
call consE_A # Cons result
ld (A) (L I)
@@ -3233,6 +3249,8 @@
ret
end
ld E ((S) CDR) # Recurse on CDR
+ cmp S (StkLimit) # Stack check
+ jlt stkErr
call fillE_FE # Modified?
if z # Yes
call consE_A # Cons result
@@ -3386,6 +3404,8 @@
push Z
ld Y (Y) # car(x1)
ld Z (Z) # car(x2)
+ cmp S (StkLimit) # Stack check
+ jlt stkErr
call unifyCEYZ_F # Match?
pop Z
pop Y
@@ -3394,6 +3414,8 @@
if eq # Yes
ld Y (Y CDR) # cdr(x1)
ld Z (Z CDR) # cdr(x2)
+ cmp S (StkLimit) # Stack check
+ jlt stkErr
call unifyCEYZ_F # Match?
if eq # Yes
pop A # Drop pilog environment
@@ -3716,6 +3738,8 @@
ld A ((Z) CDR)
ld C (A) # n = cadar(y)
ld E (A CDR) # x = cddar(y)
+ cmp S (StkLimit) # Stack check
+ jlt stkErr
jmp lupCE_E
end
end
@@ -3729,6 +3753,8 @@
push C # Save parameters
push E
ld E (E) # lup(n, car(x))
+ cmp S (StkLimit) # Stack check
+ jlt stkErr
call lupCE_E
pop A
pop C
@@ -3736,6 +3762,8 @@
push E # Save
link
ld E (A CDR) # lup(n, cdr(x))
+ cmp S (StkLimit) # Stack check
+ jlt stkErr
call lupCE_E
call consE_A # Cons
ld (A) (L I)
@@ -3769,12 +3797,16 @@
end
push E # Save list
ld E (E) # Recurse on CAR
+ cmp S (StkLimit) # Stack check
+ jlt stkErr
call uniFillE_E
pop A # Get list
link
push E # Save result
link
ld E (A CDR) # Recurse on CDR
+ cmp S (StkLimit) # Stack check
+ jlt stkErr
call uniFillE_E
call consE_A # Return cell
ld (A) (L I)
diff --git a/src64/sym.l b/src64/sym.l
@@ -1,4 +1,4 @@
-# 19may10abu
+# 10jun10abu
# (c) Software Lab. Alexander Burger
### Compare long names ###
@@ -1180,6 +1180,8 @@
do # List
push (E CDR) # Save rest
ld E (E) # Recurse on CAR
+ cmp S (StkLimit) # Stack check
+ jlt stkErr
call packECX_CX
pop E # Done?
atom E
@@ -3188,6 +3190,8 @@
jne Ret # No
push X
ld X ((X)) # Try in superclass(es)
+ cmp S (StkLimit) # Stack check
+ jlt stkErr
call metaCX_E
pop X
cmp E Nil # found?
