commit 87318d11b07e03ed99a046e3aa60dcd60f7eba97
parent 6754ba87e492c82bba0fe40b854f5693467bfdb6
Author: Commit-Bot <unknown>
Date: Thu, 23 Dec 2010 19:05:28 +0000
Automatic commit from picoLisp.tgz, From: Thu, 23 Dec 2010 19:05:28 GMT
Diffstat:
4 files changed, 73 insertions(+), 69 deletions(-)
diff --git a/ersatz/picolisp.jar b/ersatz/picolisp.jar
Binary files differ.
diff --git a/lib/tags b/lib/tags
@@ -32,9 +32,9 @@ and (1621 . "@src64/flow.l")
any (3870 . "@src64/io.l")
append (1338 . "@src64/subr.l")
apply (591 . "@src64/apply.l")
-arg (2270 . "@src64/main.l")
-args (2246 . "@src64/main.l")
-argv (2891 . "@src64/main.l")
+arg (2274 . "@src64/main.l")
+args (2250 . "@src64/main.l")
+argv (2895 . "@src64/main.l")
as (146 . "@src64/flow.l")
asoq (3001 . "@src64/subr.l")
assoc (2966 . "@src64/subr.l")
@@ -65,7 +65,7 @@ call (3074 . "@src64/flow.l")
car (5 . "@src64/subr.l")
case (1962 . "@src64/flow.l")
catch (2462 . "@src64/flow.l")
-cd (2646 . "@src64/main.l")
+cd (2650 . "@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 (4258 . "@src64/io.l")
-cmd (2873 . "@src64/main.l")
+cmd (2877 . "@src64/main.l")
cnt (1291 . "@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 (4198 . "@src64/io.l")
-ctty (2671 . "@src64/main.l")
+ctty (2675 . "@src64/main.l")
cut (1797 . "@src64/sym.l")
-date (2385 . "@src64/main.l")
+date (2389 . "@src64/main.l")
dbck (2105 . "@src64/db.l")
de (531 . "@src64/flow.l")
dec (2323 . "@src64/big.l")
@@ -111,7 +111,7 @@ del (1852 . "@src64/sym.l")
delete (1401 . "@src64/subr.l")
delq (1452 . "@src64/subr.l")
diff (2585 . "@src64/subr.l")
-dir (2804 . "@src64/main.l")
+dir (2808 . "@src64/main.l")
dm (543 . "@src64/flow.l")
do (2136 . "@src64/flow.l")
e (2904 . "@src64/flow.l")
@@ -127,7 +127,7 @@ extern (900 . "@src64/sym.l")
extra (1263 . "@src64/flow.l")
extract (1096 . "@src64/apply.l")
fifo (1963 . "@src64/sym.l")
-file (2751 . "@src64/main.l")
+file (2755 . "@src64/main.l")
fill (3236 . "@src64/subr.l")
filter (1039 . "@src64/apply.l")
fin (2029 . "@src64/subr.l")
@@ -164,7 +164,7 @@ ifn (1862 . "@src64/flow.l")
in (4094 . "@src64/io.l")
inc (2256 . "@src64/big.l")
index (2633 . "@src64/subr.l")
-info (2708 . "@src64/main.l")
+info (2712 . "@src64/main.l")
intern (875 . "@src64/sym.l")
ipid (3193 . "@src64/flow.l")
isa (959 . "@src64/flow.l")
@@ -180,7 +180,7 @@ lieu (1156 . "@src64/db.l")
line (3604 . "@src64/io.l")
lines (3757 . "@src64/io.l")
link (1172 . "@src64/subr.l")
-lisp (1948 . "@src64/main.l")
+lisp (1952 . "@src64/main.l")
list (887 . "@src64/subr.l")
listen (151 . "@src64/net.l")
lit (157 . "@src64/flow.l")
@@ -222,7 +222,7 @@ nand (1656 . "@src64/flow.l")
native (1393 . "@src64/main.l")
need (919 . "@src64/subr.l")
new (833 . "@src64/flow.l")
-next (2253 . "@src64/main.l")
+next (2257 . "@src64/main.l")
nil (1739 . "@src64/flow.l")
nond (1939 . "@src64/flow.l")
nor (1677 . "@src64/flow.l")
@@ -236,7 +236,7 @@ onOff (1613 . "@src64/sym.l")
one (1646 . "@src64/sym.l")
open (4220 . "@src64/io.l")
opid (3209 . "@src64/flow.l")
-opt (2994 . "@src64/main.l")
+opt (2998 . "@src64/main.l")
or (1637 . "@src64/flow.l")
out (4114 . "@src64/io.l")
pack (1144 . "@src64/sym.l")
@@ -269,7 +269,7 @@ push (1688 . "@src64/sym.l")
push1 (1724 . "@src64/sym.l")
put (2698 . "@src64/sym.l")
putl (2950 . "@src64/sym.l")
-pwd (2635 . "@src64/main.l")
+pwd (2639 . "@src64/main.l")
queue (1920 . "@src64/sym.l")
quit (1102 . "@src64/main.l")
quote (141 . "@src64/flow.l")
@@ -280,7 +280,7 @@ raw (465 . "@src64/main.l")
rd (5036 . "@src64/io.l")
read (2562 . "@src64/io.l")
replace (1499 . "@src64/subr.l")
-rest (2299 . "@src64/main.l")
+rest (2303 . "@src64/main.l")
reverse (1674 . "@src64/subr.l")
rewind (5002 . "@src64/io.l")
rollback (1890 . "@src64/db.l")
@@ -321,7 +321,7 @@ text (1272 . "@src64/sym.l")
throw (2488 . "@src64/flow.l")
tick (3161 . "@src64/flow.l")
till (3515 . "@src64/io.l")
-time (2518 . "@src64/main.l")
+time (2522 . "@src64/main.l")
touch (1049 . "@src64/sym.l")
trim (1755 . "@src64/subr.l")
try (1172 . "@src64/flow.l")
@@ -334,9 +334,9 @@ up (716 . "@src64/main.l")
upp? (3230 . "@src64/sym.l")
uppc (3294 . "@src64/sym.l")
use (1570 . "@src64/flow.l")
-usec (2623 . "@src64/main.l")
+usec (2627 . "@src64/main.l")
val (1463 . "@src64/sym.l")
-version (3008 . "@src64/main.l")
+version (3012 . "@src64/main.l")
wait (3053 . "@src64/io.l")
when (1881 . "@src64/flow.l")
while (2058 . "@src64/flow.l")
diff --git a/src64/main.l b/src64/main.l
@@ -1,4 +1,4 @@
-# 07dec10abu
+# 23dec10abu
# (c) Software Lab. Alexander Burger
### Global return labels ###
@@ -1718,54 +1718,58 @@
else
atom E # Atomic?
if z # No: Arrary or structure
- null C # Pointer?
- ldz C A # Yes: Load into C
- push X
- push Y
- push Z
- ld X E # Get specification in X
- ld E (X)
- call natRetACE_CE # First item
- call cons_Y # Make cell
- ld (Y) E
- ld (Y CDR) Nil
- link
- push Y # <L I> Result
- link
- do
- ld Z (X CDR)
- cnt Z # (sym . cnt)
- if nz
- shr Z 4 # Normalize
- do
- dec Z # Decrement count
- while nz
- ld E (X) # Repeat last type
- call natRetACE_CE # Next item
- call cons_A # Cons into cell
- ld (A) E
- ld (A CDR) Nil
- ld (Y CDR) A # Append to result
- ld Y A
- loop
- break T
- end
- atom Z # End of specification?
- while z # No
- ld X Z
- ld E (X) # Next type
- call natRetACE_CE # Next item
- call cons_A # Cons into cell
- ld (A) E
- ld (A CDR) Nil
- ld (Y CDR) A # Append to result
- ld Y A
- loop
- ld E (L I) # Get result
- drop
- pop Z
- pop Y
- pop X
+ null A # Returned NULL?
+ ldz E Nil # Yes: Return NIL
+ if nz
+ null C # Pointer?
+ ldz C A # Yes: Load into C
+ push X
+ push Y
+ push Z
+ ld X E # Get specification in X
+ ld E (X)
+ call natRetACE_CE # First item
+ call cons_Y # Make cell
+ ld (Y) E
+ ld (Y CDR) Nil
+ link
+ push Y # <L I> Result
+ link
+ do
+ ld Z (X CDR)
+ cnt Z # (sym . cnt)
+ if nz
+ shr Z 4 # Normalize
+ do
+ dec Z # Decrement count
+ while nz
+ ld E (X) # Repeat last type
+ call natRetACE_CE # Next item
+ call cons_A # Cons into cell
+ ld (A) E
+ ld (A CDR) Nil
+ ld (Y CDR) A # Append to result
+ ld Y A
+ loop
+ break T
+ end
+ atom Z # End of specification?
+ while z # No
+ ld X Z
+ ld E (X) # Next type
+ call natRetACE_CE # Next item
+ call cons_A # Cons into cell
+ ld (A) E
+ ld (A CDR) Nil
+ ld (Y CDR) A # Append to result
+ ld Y A
+ loop
+ ld E (L I) # Get result
+ drop
+ pop Z
+ pop Y
+ pop X
+ end
end
end
end
diff --git a/src64/version.l b/src64/version.l
@@ -1,6 +1,6 @@
-# 14dec10abu
+# 23dec10abu
# (c) Software Lab. Alexander Burger
-(de *Version 3 0 4 19)
+(de *Version 3 0 4 20)
# vi:et:ts=3:sw=3
