commit 56476b8f5b5c5b7be548e4c1d8c291bb4771bda9
parent ad6b8d9a2418ef598cb9a3642ce3e994e4d63dfa
Author: Commit-Bot <unknown>
Date: Tue, 28 Sep 2010 07:06:52 +0000
Automatic commit from picoLisp.tgz, From: Tue, 28 Sep 2010 07:06:52 GMT
Diffstat:
9 files changed, 162 insertions(+), 103 deletions(-)
diff --git a/CHANGES b/CHANGES
@@ -1,4 +1,6 @@
* XXsep10 picoLisp-3.0.4
+ 'tell' accepts PID argument
+ Deprecated 'pid'
Extended protocol for 'sync'
MIT/X11 License
Drag & Drop file upload
diff --git a/ReleaseNotes b/ReleaseNotes
@@ -1,4 +1,4 @@
-24sep10abu
+28sep10abu
(c) Software Lab. Alexander Burger
@@ -51,3 +51,8 @@ F. The usage of the poll(2) system call in the 64-bit version was found to cause
between child processes. This required a slight change in the semantics of
'sync' and 'tell', which should however not have any influence on normal
applications.
+
+G. The 'pid' function is deprecated. It will be removed in the next release.
+ This was announced in the mailing list in
+
+ http://www.mail-archive.com/picolisp@software-lab.de/msg01949.html
diff --git a/doc/refP.html b/doc/refP.html
@@ -252,6 +252,15 @@ another process.
-> 0
</code></pre>
+<p><strong>Note:</strong> This function is deprecated, and will be removed in
+the next version. Please use the PID argument feature of <code>tell</code>
+instead. With that, the above example reduces to
+
+<pre><code>
+: (tell 20290 'gc 0)
+-> 0
+</code></pre>
+
<dt><a name="pilog"><code>(pilog 'lst . prg) -> any</code></a>
<dd>Evaluates a <a href="ref.html#pilog">Pilog</a> query, and executes
<code>prg</code> for each result set with all Pilog variables bound to their
diff --git a/doc/refT.html b/doc/refT.html
@@ -204,11 +204,13 @@ href="refF.html#format">format</a></code>.
-> "01234 5678-0"
</code></pre>
-<dt><a name="tell"><code>(tell 'sym ['any ..]) -> any</code></a>
+<dt><a name="tell"><code>(tell ['cnt] 'sym ['any ..]) -> any</code></a>
<dd>Family IPC: Send an executable list <code>(sym any ..)</code> to all family
members (i.e. all children of the current process, and all other children of the
parent process, see <code><a href="refF.html#fork">fork</a></code>) for
-automatic execution. <code>tell</code> can also be used by <code><a
+automatic execution. When the <code>cnt</code> argument is given and non-zero,
+it should be the PID of such a process, and the list will be sent only to that
+process. <code>tell</code> is also used internally by <code><a
href="refC.html#commit">commit</a></code> to notify about database changes. When
called without arguments, no message is actually sent, and the parent process
may grant <code><a href="refS.html#sync">sync</a></code> to the next waiting
diff --git a/lib/tags b/lib/tags
@@ -29,7 +29,7 @@ adr (613 . "@src64/main.l")
alarm (487 . "@src64/main.l")
all (772 . "@src64/sym.l")
and (1643 . "@src64/flow.l")
-any (3841 . "@src64/io.l")
+any (3869 . "@src64/io.l")
append (1329 . "@src64/subr.l")
apply (597 . "@src64/apply.l")
arg (2243 . "@src64/main.l")
@@ -82,11 +82,11 @@ cdddr (245 . "@src64/subr.l")
cddr (79 . "@src64/subr.l")
cdr (17 . "@src64/subr.l")
chain (1132 . "@src64/subr.l")
-char (3323 . "@src64/io.l")
+char (3351 . "@src64/io.l")
chop (1093 . "@src64/sym.l")
circ (816 . "@src64/subr.l")
clip (1786 . "@src64/subr.l")
-close (4229 . "@src64/io.l")
+close (4257 . "@src64/io.l")
cmd (2846 . "@src64/main.l")
cnt (1297 . "@src64/apply.l")
co (2566 . "@src64/flow.l")
@@ -97,11 +97,11 @@ cond (1938 . "@src64/flow.l")
connect (201 . "@src64/net.l")
cons (747 . "@src64/subr.l")
copy (1216 . "@src64/subr.l")
-ctl (4169 . "@src64/io.l")
+ctl (4197 . "@src64/io.l")
ctty (2644 . "@src64/main.l")
cut (1797 . "@src64/sym.l")
date (2358 . "@src64/main.l")
-dbck (2102 . "@src64/db.l")
+dbck (2105 . "@src64/db.l")
de (549 . "@src64/flow.l")
dec (2323 . "@src64/big.l")
def (473 . "@src64/flow.l")
@@ -114,13 +114,13 @@ dir (2777 . "@src64/main.l")
dm (561 . "@src64/flow.l")
do (2158 . "@src64/flow.l")
e (2932 . "@src64/flow.l")
-echo (4260 . "@src64/io.l")
+echo (4288 . "@src64/io.l")
env (625 . "@src64/main.l")
-eof (3400 . "@src64/io.l")
-eol (3391 . "@src64/io.l")
+eof (3428 . "@src64/io.l")
+eol (3419 . "@src64/io.l")
errno (1358 . "@src64/main.l")
eval (208 . "@src64/flow.l")
-ext (4989 . "@src64/io.l")
+ext (5017 . "@src64/io.l")
ext? (1034 . "@src64/sym.l")
extern (900 . "@src64/sym.l")
extra (1284 . "@src64/flow.l")
@@ -135,13 +135,13 @@ find (1206 . "@src64/apply.l")
fish (1497 . "@src64/apply.l")
flg? (2419 . "@src64/subr.l")
flip (1686 . "@src64/subr.l")
-flush (4964 . "@src64/io.l")
+flush (4992 . "@src64/io.l")
fold (3343 . "@src64/sym.l")
for (2247 . "@src64/flow.l")
fork (3276 . "@src64/flow.l")
format (2089 . "@src64/big.l")
-free (2044 . "@src64/db.l")
-from (3419 . "@src64/io.l")
+free (2047 . "@src64/db.l")
+from (3447 . "@src64/io.l")
full (1066 . "@src64/subr.l")
fun? (734 . "@src64/sym.l")
gc (439 . "@src64/gc.l")
@@ -153,14 +153,14 @@ glue (1234 . "@src64/sym.l")
gt0 (2702 . "@src64/big.l")
head (1807 . "@src64/subr.l")
heap (542 . "@src64/main.l")
-hear (3116 . "@src64/io.l")
+hear (3130 . "@src64/io.l")
host (184 . "@src64/net.l")
id (1027 . "@src64/db.l")
idx (2037 . "@src64/sym.l")
if (1824 . "@src64/flow.l")
if2 (1843 . "@src64/flow.l")
ifn (1884 . "@src64/flow.l")
-in (4065 . "@src64/io.l")
+in (4093 . "@src64/io.l")
inc (2256 . "@src64/big.l")
index (2611 . "@src64/subr.l")
info (2681 . "@src64/main.l")
@@ -169,21 +169,21 @@ ipid (3221 . "@src64/flow.l")
isa (978 . "@src64/flow.l")
job (1448 . "@src64/flow.l")
journal (970 . "@src64/db.l")
-key (3250 . "@src64/io.l")
+key (3278 . "@src64/io.l")
kill (3253 . "@src64/flow.l")
last (2031 . "@src64/subr.l")
length (2687 . "@src64/subr.l")
let (1498 . "@src64/flow.l")
let? (1559 . "@src64/flow.l")
lieu (1156 . "@src64/db.l")
-line (3575 . "@src64/io.l")
-lines (3728 . "@src64/io.l")
+line (3603 . "@src64/io.l")
+lines (3756 . "@src64/io.l")
link (1163 . "@src64/subr.l")
lisp (1921 . "@src64/main.l")
list (887 . "@src64/subr.l")
listen (151 . "@src64/net.l")
lit (183 . "@src64/flow.l")
-load (4042 . "@src64/io.l")
+load (4070 . "@src64/io.l")
lock (1184 . "@src64/db.l")
loop (2190 . "@src64/flow.l")
low? (3215 . "@src64/sym.l")
@@ -200,7 +200,7 @@ mapcar (871 . "@src64/apply.l")
mapcon (925 . "@src64/apply.l")
maplist (817 . "@src64/apply.l")
maps (674 . "@src64/apply.l")
-mark (1962 . "@src64/db.l")
+mark (1965 . "@src64/db.l")
match (3062 . "@src64/subr.l")
max (2314 . "@src64/subr.l")
maxi (1395 . "@src64/apply.l")
@@ -233,31 +233,31 @@ offset (2651 . "@src64/subr.l")
on (1583 . "@src64/sym.l")
onOff (1613 . "@src64/sym.l")
one (1646 . "@src64/sym.l")
-open (4191 . "@src64/io.l")
+open (4219 . "@src64/io.l")
opid (3237 . "@src64/flow.l")
opt (2967 . "@src64/main.l")
or (1659 . "@src64/flow.l")
-out (4085 . "@src64/io.l")
+out (4113 . "@src64/io.l")
pack (1144 . "@src64/sym.l")
pair (2381 . "@src64/subr.l")
pass (638 . "@src64/apply.l")
pat? (720 . "@src64/sym.l")
-path (1221 . "@src64/io.l")
-peek (3307 . "@src64/io.l")
+path (1229 . "@src64/io.l")
+peek (3335 . "@src64/io.l")
pick (1253 . "@src64/apply.l")
pid (157 . "@src64/flow.l")
-pipe (4106 . "@src64/io.l")
-poll (3194 . "@src64/io.l")
+pipe (4134 . "@src64/io.l")
+poll (3222 . "@src64/io.l")
pool (648 . "@src64/db.l")
pop (1773 . "@src64/sym.l")
port (5 . "@src64/net.l")
-pr (5080 . "@src64/io.l")
+pr (5108 . "@src64/io.l")
pre? (1411 . "@src64/sym.l")
-prin (4888 . "@src64/io.l")
-prinl (4902 . "@src64/io.l")
-print (4928 . "@src64/io.l")
-println (4959 . "@src64/io.l")
-printsp (4944 . "@src64/io.l")
+prin (4916 . "@src64/io.l")
+prinl (4930 . "@src64/io.l")
+print (4956 . "@src64/io.l")
+println (4987 . "@src64/io.l")
+printsp (4972 . "@src64/io.l")
prog (1779 . "@src64/flow.l")
prog1 (1787 . "@src64/flow.l")
prog2 (1804 . "@src64/flow.l")
@@ -276,15 +276,15 @@ rand (2959 . "@src64/big.l")
range (988 . "@src64/subr.l")
rank (2970 . "@src64/subr.l")
raw (465 . "@src64/main.l")
-rd (5006 . "@src64/io.l")
-read (2553 . "@src64/io.l")
+rd (5034 . "@src64/io.l")
+read (2561 . "@src64/io.l")
replace (1490 . "@src64/subr.l")
rest (2272 . "@src64/main.l")
reverse (1665 . "@src64/subr.l")
-rewind (4972 . "@src64/io.l")
-rollback (1887 . "@src64/db.l")
+rewind (5000 . "@src64/io.l")
+rollback (1890 . "@src64/db.l")
rot (848 . "@src64/subr.l")
-rpc (5113 . "@src64/io.l")
+rpc (5141 . "@src64/io.l")
run (331 . "@src64/flow.l")
sect (2515 . "@src64/subr.l")
seed (2944 . "@src64/big.l")
@@ -295,31 +295,31 @@ set (1482 . "@src64/sym.l")
setq (1515 . "@src64/sym.l")
sigio (503 . "@src64/main.l")
size (2752 . "@src64/subr.l")
-skip (3377 . "@src64/io.l")
+skip (3405 . "@src64/io.l")
sort (3869 . "@src64/subr.l")
sp? (711 . "@src64/sym.l")
-space (4906 . "@src64/io.l")
+space (4934 . "@src64/io.l")
split (1579 . "@src64/subr.l")
stack (571 . "@src64/main.l")
state (2028 . "@src64/flow.l")
stem (1976 . "@src64/subr.l")
-str (3895 . "@src64/io.l")
+str (3923 . "@src64/io.l")
str? (1013 . "@src64/sym.l")
strip (1563 . "@src64/subr.l")
sub? (1444 . "@src64/sym.l")
sum (1344 . "@src64/apply.l")
super (1237 . "@src64/flow.l")
-sym (3881 . "@src64/io.l")
+sym (3909 . "@src64/io.l")
sym? (2408 . "@src64/subr.l")
-sync (3076 . "@src64/io.l")
+sync (3090 . "@src64/io.l")
sys (3073 . "@src64/flow.l")
t (1770 . "@src64/flow.l")
tail (1898 . "@src64/subr.l")
-tell (3148 . "@src64/io.l")
+tell (3162 . "@src64/io.l")
text (1272 . "@src64/sym.l")
throw (2510 . "@src64/flow.l")
tick (3189 . "@src64/flow.l")
-till (3486 . "@src64/io.l")
+till (3514 . "@src64/io.l")
time (2491 . "@src64/main.l")
touch (1049 . "@src64/sym.l")
trim (1746 . "@src64/subr.l")
@@ -336,12 +336,12 @@ use (1592 . "@src64/flow.l")
usec (2596 . "@src64/main.l")
val (1463 . "@src64/sym.l")
version (2981 . "@src64/main.l")
-wait (3038 . "@src64/io.l")
+wait (3052 . "@src64/io.l")
when (1903 . "@src64/flow.l")
while (2080 . "@src64/flow.l")
wipe (3090 . "@src64/sym.l")
with (1349 . "@src64/flow.l")
-wr (5097 . "@src64/io.l")
+wr (5125 . "@src64/io.l")
xchg (1538 . "@src64/sym.l")
xor (1720 . "@src64/flow.l")
x| (2871 . "@src64/big.l")
diff --git a/src/io.c b/src/io.c
@@ -1,4 +1,4 @@
-/* 23sep10abu
+/* 27sep10abu
* (c) Software Lab. Alexander Burger
*/
@@ -455,15 +455,15 @@ static void tellBeg(ptr *pb, ptr *pp, ptr buf) {
static void prTell(any x) {putBin = putTell, binPrint(0, x);}
-static void tellEnd(ptr *pb, ptr *pp) {
+static void tellEnd(ptr *pb, ptr *pp, int pid) {
int i, n;
*PipePtr++ = END;
- *(int*)PipeBuf = n = PipePtr - PipeBuf - sizeof(int);
+ *(int*)PipeBuf = (n = PipePtr - PipeBuf - sizeof(int)) | pid << 16;
if (Tell && !wrBytes(Tell, PipeBuf, n+sizeof(int)))
close(Tell), Tell = 0;
for (i = 0; i < Children; ++i)
- if (Child[i].pid)
+ if (Child[i].pid && (!pid || pid == Child[i].pid))
wrChild(i, PipeBuf+sizeof(int), n);
PipePtr = *pp, PipeBuf = *pb;
}
@@ -1423,14 +1423,19 @@ long waitFd(any ex, int fd, long ms) {
if (Child[i].pid == Talking)
Talking = 0;
}
- else if (rdBytes(Child[i].hear, buf, n, NO)) {
- for (j = 0; j < Children; ++j)
- if (j != i && Child[j].pid)
- wrChild(j, buf, n);
- }
else {
- clsChild(i);
- continue;
+ pid_t pid = n >> 16;
+
+ n &= 0xFFFF;
+ if (rdBytes(Child[i].hear, buf, n, NO)) {
+ for (j = 0; j < Children; ++j)
+ if (j != i && Child[j].pid && (!pid || pid == Child[j].pid))
+ wrChild(j, buf, n);
+ }
+ else {
+ clsChild(i);
+ continue;
+ }
}
}
}
@@ -1556,9 +1561,10 @@ any doHear(any ex) {
return x;
}
-// (tell 'sym ['any ..]) -> any
+// (tell ['cnt] 'sym ['any ..]) -> any
any doTell(any x) {
any y;
+ int pid;
ptr pbSave, ppSave;
byte buf[PIPE_BUF];
@@ -1568,11 +1574,15 @@ any doTell(any x) {
unsync();
return Nil;
}
+ pid = 0;
+ if (isNum(y = EVAL(car(x)))) {
+ pid = (int)unDig(y)/2;
+ x = cdr(x), y = EVAL(car(x));
+ }
tellBeg(&pbSave, &ppSave, buf);
- do
- prTell(y = EVAL(car(x)));
- while (isCell(x = cdr(x)));
- tellEnd(&pbSave, &ppSave);
+ while (prTell(y), isCell(x = cdr(x)))
+ y = EVAL(car(x));
+ tellEnd(&pbSave, &ppSave, pid);
return y;
}
@@ -3401,7 +3411,7 @@ any doCommit(any ex) {
cdr(z) = At; // loaded
if (note) {
if (PipePtr >= PipeBuf + PIPE_BUF - 12) { // EXTERN <2+1+7> END
- tellEnd(&pbSave, &ppSave);
+ tellEnd(&pbSave, &ppSave, 0);
tellBeg(&pbSave, &ppSave, buf), prTell(data(c1));
}
prTell(car(x));
@@ -3414,7 +3424,7 @@ any doCommit(any ex) {
cleanUp(n*BLKSIZE);
if (note) {
if (PipePtr >= PipeBuf + PIPE_BUF - 12) { // EXTERN <2+1+7> END
- tellEnd(&pbSave, &ppSave);
+ tellEnd(&pbSave, &ppSave, 0);
tellBeg(&pbSave, &ppSave, buf), prTell(data(c1));
}
prTell(car(x));
@@ -3425,7 +3435,7 @@ any doCommit(any ex) {
}
}
if (note)
- tellEnd(&pbSave, &ppSave);
+ tellEnd(&pbSave, &ppSave, 0);
x = cdddr(ex), EVAL(car(x));
if (Jnl)
fflush(Jnl), lockFile(fileno(Jnl), F_SETLK, F_UNLCK);
diff --git a/src64/db.l b/src64/db.l
@@ -1,4 +1,4 @@
-# 23sep10abu
+# 27sep10abu
# (c) Software Lab. Alexander Burger
# 6 bytes in little endian format
@@ -1736,7 +1736,8 @@
lea A ((TellBuf) (- PIPE_BUF 10)) # Space for EXTERN+<8>+END?
cmp Z A
if ge # No
- call tellEndZ # Close 'tell'
+ ld A 0 # Send to all PIDs
+ call tellEndAZ # Close 'tell'
lea Z (L (- (+ III PIPE_BUF))) # Reset buffer pointer
call tellBegZ_Z # Start new 'tell' message
ld E (L I) # Get 'any'
@@ -1764,7 +1765,8 @@
lea A ((TellBuf) (- PIPE_BUF 10)) # Space for EXTERN+<8>+END?
cmp Z A
if ge # No
- call tellEndZ # Close 'tell'
+ ld A 0 # Send to all PIDs
+ call tellEndAZ # Close 'tell'
lea Z (L (- (+ III PIPE_BUF))) # Reset buffer pointer
call tellBegZ_Z # Start new 'tell' message
ld E (L I) # Get 'any'
@@ -1812,8 +1814,9 @@
pop X
null (L -I) # Notify?
if nz # Yes
+ ld A 0 # Send to all PIDs
ld Z (L -II) # Get buffer pointer
- call tellEndZ # Close 'tell'
+ call tellEndAZ # Close 'tell'
add S PIPE_BUF # Drop 'tell' buffer
pop (TellBuf)
end
diff --git a/src64/io.l b/src64/io.l
@@ -1,4 +1,4 @@
-# 23sep10abu
+# 28sep10abu
# (c) Software Lab. Alexander Burger
# Close file descriptor
@@ -371,16 +371,16 @@
end
ld A (Y V) # Get buffer
add E C # Increment count
- add E 2 # plus count size
+ add E 4 # plus count size
call allocAE_A # Extend buffer
ld (Y V) A # Store
ld E (Y IV) # Get buffer count again
add E A # Point to new count
ld A C # Store new
- st2 (E)
- add E 2 # Point to new data
+ st4 (E)
+ add E 4 # Point to new data
movn (E) (X) C # Copy data
- add C 2 # Total new size
+ add C 4 # Total new size
add (Y IV) C # Add to buffer count
ret
@@ -988,22 +988,24 @@
(code 'tellBegZ_Z 0)
ld (TellBuf) Z # Set global buffer
- add Z 2 # 2 bytes space for count
+ add Z 4 # 4 bytes space (PID and count)
set (Z) BEG # Begin a list
inc Z
ret
-(code 'tellEndZ)
+(code 'tellEndAZ)
push X
push Y
set (Z) END # Close list
inc Z
ld X (TellBuf) # Get buffer
+ st2 (X) # Store PID
+ push A # <S I> PID
ld E Z # Calculate total size
sub E X
ld A E # Size in A
- sub A 2 # without count
- st2 (X) # Store in buffer count
+ sub A 4 # without PID and count
+ st2 (X 2) # Store in buffer count
push A # <S> Size
ld C (Tell) # File descriptor
null C # Any?
@@ -1021,13 +1023,19 @@
while ge # Yes
null (Y) # 'pid'?
if nz # Yes
- ld C (S) # Get size
- lea X ((TellBuf) 2) # and data
- call wrChildCXY # Write to child
+ ld A (S I) # Get PID
+ null A # Any?
+ jz 10 # Yes
+ cmp A (Y) # Same as 'pid'?
+ if eq # Yes
+10 ld C (S) # Get size
+ lea X ((TellBuf) 4) # and data
+ call wrChildCXY # Write to child
+ end
end
add Y VI # Increment by sizeof(child)
loop
- pop A # Drop size
+ add S II # Drop size and PID
pop Y
pop X
ret
@@ -1038,7 +1046,7 @@
if nz # Yes
push 0 # Send zero
ld X S # Get buffer
- ld E 2 # Size
+ ld E 4 # Size (PID and count)
call wrBytesCEX_F # Write buffer to pipe
if nz # Not successful
cc close(C) # Close 'Tell'
@@ -2799,12 +2807,12 @@
call msec_A # Get milliseconds
sub A E # Time difference
ld (L -III) A # Save it
+ push X # Save context again
null (Spkr) # Speaker open?
if nz # Yes
inc (EnvProtect) # Protect child communication
ld Y (Child) # Iterate children
ld Z (Children) # Count
- push X # Save context again
do
sub Z VI # More?
while ge # Yes
@@ -2815,7 +2823,7 @@
call rdSetCL_F # Ready?
if nz # Yes
ld C (Y I) # Get 'hear' fd again
- ld E 2 # Size of count
+ ld E 4 # Size of PID and count
ld X Buf # Buffer pointer
call rdBytesNbCEX_F # Read count?
if ge # Yes
@@ -2823,7 +2831,7 @@
call clsChildY # Close child
jmp 20 # Continue
end
- ld2 (Buf) # Size?
+ ld4 (Buf) # PID and size?
null A
if z # No
cmp (Y) (Talking) # Currently active?
@@ -2834,7 +2842,7 @@
sub S PIPE_BUF # <S I> Pipe buffer
push Y # <S> Outer child index
ld C (Y I) # Get 'hear' fd again
- ld2 (Buf) # Get size
+ ld2 (Buf 2) # Get size
ld E A
lea X (S I) # Buffer pointer
call rdBytesCEX_F # Read data?
@@ -2846,10 +2854,16 @@
if ne # No
null (Y) # 'pid'?
if nz # Yes
- ld2 (Buf) # Get size
- ld C A
- lea X (S I) # and data
- call wrChildCXY # Write to child
+ ld2 (Buf) # Get PID
+ null A # Any?
+ jz 15 # Yes
+ cmp A (Y) # Same as 'pid'?
+ if eq # Yes
+15 ld2 (Buf 2) # Get size
+ ld C A
+ lea X (S I) # and data
+ call wrChildCXY # Write to child
+ end
end
end
add Y VI # Increment by sizeof(child)
@@ -2872,15 +2886,15 @@
ld C (Y II) # Get 'tell' fd again
ld X (Y V) # Get buffer pointer
add X (Y III) # plus buffer offset
- ld2 (X) # Get size
+ ld4 (X) # Get size
ld E A
- add X 2 # Point to data (beyond size)
+ add X 4 # Point to data (beyond size)
push E # Keep size
call wrBytesCEX_F # Write data?
pop E
if z # Yes
add E (Y III) # Add size to buffer offset
- add E 2 # plus size of size
+ add E 4 # plus size of size
ld (Y III) E # New buffer offset
add E E # Twice the offset
cmp E (Y IV) # greater or equal to buffer count?
@@ -3144,7 +3158,7 @@
pop X
ret
-# (tell 'sym ['any ..]) -> any
+# (tell ['cnt] 'sym ['any ..]) -> any
(code 'doTell 2)
ld A (Tell) # RPC?
or A (Children)
@@ -3161,16 +3175,30 @@
push (TellBuf) # Save current 'tell' env
sub S PIPE_BUF # New 'tell' buffer
ld Z S # Buffer pointer
+ ld E (X) # Eval first argument
+ eval
+ num E # PID argument?
+ if z # No
+ push 0 # Send to all
+ else
+ shr E 4 # Normalize PID
+ push E # Save it
+ ld X (X CDR) # Next arg
+ ld E (X) # Eval
+ eval
+ end
call tellBegZ_Z # Start 'tell' message
do
- ld E (X) # Eval next
- eval
ld Y E # Keep result
call prTellEZ # Print to 'tell'
ld X (X CDR) # More args?
atom X
- until nz # No
- call tellEndZ # Close 'tell'
+ while z # Yes
+ ld E (X) # Eval next
+ eval
+ loop
+ pop A # Get PID
+ call tellEndAZ # Close 'tell'
add S PIPE_BUF # Drop 'tell' buffer
pop (TellBuf)
ld E Y # Get result
diff --git a/src64/version.l b/src64/version.l
@@ -1,6 +1,6 @@
-# 23sep10abu
+# 28sep10abu
# (c) Software Lab. Alexander Burger
-(de *Version 3 0 3 24)
+(de *Version 3 0 3 25)
# vi:et:ts=3:sw=3
