commit aabad3050c61203684eb30bf60625cab6dde47e0
parent afebe19768b86e79ded1ab0e91e9dd97e59588bc
Author: Commit-Bot <unknown>
Date: Sun, 30 May 2010 12:23:59 +0000
Automatic commit from picoLisp.tgz, From: Sun, 30 May 2010 09:23:59 GMT
Diffstat:
7 files changed, 62 insertions(+), 59 deletions(-)
diff --git a/doc/refS.html b/doc/refS.html
@@ -436,10 +436,11 @@ href="refS.html#show">show</a></code>.
-> NIL
</code></pre>
-<dt><a name="sigio"><code>(sigio 'cnt [. prg]) -> cnt</code></a>
+<dt><a name="sigio"><code>(sigio ['cnt [. prg]]) -> cnt | prg</code></a>
<dd>Sets a signal handler <code>prg</code> for SIGIO on the file descriptor
-<code>cnt</code>. See also <code><a href="refA.html#alarm">alarm</a></code>,
-<code><a href="refH.html#*Hup">*Hup</a></code> and <code><a
+<code>cnt</code>. If called without arguments, the currently installed handler
+is returned. See also <code><a href="refA.html#alarm">alarm</a></code>, <code><a
+href="refH.html#*Hup">*Hup</a></code> and <code><a
href="refS.html#*Sig1">*Sig[12]</a></code>.
<pre><code>
diff --git a/lib.l b/lib.l
@@ -1,4 +1,4 @@
-# 27may10abu
+# 30may10abu
# (c) Software Lab. Alexander Burger
(de task (Key . Prg)
@@ -48,8 +48,7 @@
(macro
(task (pipe (pr (prog . "@Prg")))
(setq "@Var" (in @ (rd)))
- (close @)
- (task @) ) )
+ (task (close @)) ) )
"@Var" )
(de recur recurse
diff --git a/lib/http.l b/lib/http.l
@@ -1,4 +1,4 @@
-# 30apr10abu
+# 30may10abu
# (c) Software Lab. Alexander Burger
# *Home *Gate *Host *Port *Port1 *Http1 *Chunked
@@ -139,8 +139,7 @@
(in S
(cond
((not (setq L (line)))
- (close S)
- (task S)
+ (task (close S))
(off S)
(throw "http") )
((match '("G" "E" "T" " " "/" @U " " "H" "T" "T" "P" "/" "1" "." @H) L)
@@ -171,15 +170,13 @@
("C" "O" "N" "N" "E" "C" "T") ) ) )
(httpStat 501 "Method Not Implemented" "Allow: GET, POST")
(httpStat 400 "Bad Request") ) )
- (close S)
- (task S)
+ (task (close S))
(off S)
(throw "http") ) )
(if (<> *ConId *SesId)
(if *ConId
(out S (http404))
- (close S)
- (task S)
+ (task (close S))
(off S) )
(setq
L (split @U "?")
@@ -219,7 +216,7 @@
(apply script L *Url)
(http404) ) )
(T (httpEcho *Url "application/octet-stream" 1 T)) ) ) ) ) )
- (and S (=0 *Http1) (close S) (task S)) ) )
+ (and S (=0 *Http1) (task (close S))) ) )
(de _htHead ()
(use (L @X @Y)
diff --git a/lib/tags b/lib/tags
@@ -25,16 +25,16 @@ $ (2662 . "@src64/flow.l")
>> (2306 . "@src64/big.l")
abs (2396 . "@src64/big.l")
accept (139 . "@src64/net.l")
-adr (555 . "@src64/main.l")
+adr (560 . "@src64/main.l")
alarm (475 . "@src64/main.l")
all (772 . "@src64/sym.l")
and (1637 . "@src64/flow.l")
any (3758 . "@src64/io.l")
append (1329 . "@src64/subr.l")
apply (581 . "@src64/apply.l")
-arg (1923 . "@src64/main.l")
-args (1899 . "@src64/main.l")
-argv (2544 . "@src64/main.l")
+arg (1928 . "@src64/main.l")
+args (1904 . "@src64/main.l")
+argv (2549 . "@src64/main.l")
as (146 . "@src64/flow.l")
asoq (2938 . "@src64/subr.l")
assoc (2903 . "@src64/subr.l")
@@ -65,7 +65,7 @@ call (2793 . "@src64/flow.l")
car (5 . "@src64/subr.l")
case (1978 . "@src64/flow.l")
catch (2478 . "@src64/flow.l")
-cd (2299 . "@src64/main.l")
+cd (2304 . "@src64/main.l")
cdaaar (464 . "@src64/subr.l")
cdaadr (487 . "@src64/subr.l")
cdaar (179 . "@src64/subr.l")
@@ -87,7 +87,7 @@ chop (1093 . "@src64/sym.l")
circ (816 . "@src64/subr.l")
clip (1784 . "@src64/subr.l")
close (4146 . "@src64/io.l")
-cmd (2526 . "@src64/main.l")
+cmd (2531 . "@src64/main.l")
cnt (1279 . "@src64/apply.l")
commit (1503 . "@src64/db.l")
con (725 . "@src64/subr.l")
@@ -97,9 +97,9 @@ connect (201 . "@src64/net.l")
cons (747 . "@src64/subr.l")
copy (1216 . "@src64/subr.l")
ctl (4086 . "@src64/io.l")
-ctty (2324 . "@src64/main.l")
+ctty (2329 . "@src64/main.l")
cut (1795 . "@src64/sym.l")
-date (2038 . "@src64/main.l")
+date (2043 . "@src64/main.l")
dbck (2092 . "@src64/db.l")
de (551 . "@src64/flow.l")
dec (2004 . "@src64/big.l")
@@ -109,15 +109,15 @@ del (1850 . "@src64/sym.l")
delete (1392 . "@src64/subr.l")
delq (1443 . "@src64/subr.l")
diff (2561 . "@src64/subr.l")
-dir (2457 . "@src64/main.l")
+dir (2462 . "@src64/main.l")
dm (563 . "@src64/flow.l")
do (2152 . "@src64/flow.l")
e (2623 . "@src64/flow.l")
echo (4166 . "@src64/io.l")
-env (567 . "@src64/main.l")
+env (572 . "@src64/main.l")
eof (3317 . "@src64/io.l")
eol (3308 . "@src64/io.l")
-errno (1250 . "@src64/main.l")
+errno (1255 . "@src64/main.l")
eval (208 . "@src64/flow.l")
ext (4853 . "@src64/io.l")
ext? (1034 . "@src64/sym.l")
@@ -125,7 +125,7 @@ extern (900 . "@src64/sym.l")
extra (1280 . "@src64/flow.l")
extract (1084 . "@src64/apply.l")
fifo (1961 . "@src64/sym.l")
-file (2404 . "@src64/main.l")
+file (2409 . "@src64/main.l")
fill (3165 . "@src64/subr.l")
filter (1027 . "@src64/apply.l")
fin (2018 . "@src64/subr.l")
@@ -151,7 +151,7 @@ getl (3030 . "@src64/sym.l")
glue (1232 . "@src64/sym.l")
gt0 (2383 . "@src64/big.l")
head (1805 . "@src64/subr.l")
-heap (525 . "@src64/main.l")
+heap (530 . "@src64/main.l")
hear (3058 . "@src64/io.l")
host (184 . "@src64/net.l")
id (1034 . "@src64/db.l")
@@ -162,7 +162,7 @@ ifn (1878 . "@src64/flow.l")
in (3982 . "@src64/io.l")
inc (1937 . "@src64/big.l")
index (2609 . "@src64/subr.l")
-info (2361 . "@src64/main.l")
+info (2366 . "@src64/main.l")
intern (875 . "@src64/sym.l")
ipid (2905 . "@src64/flow.l")
isa (976 . "@src64/flow.l")
@@ -216,10 +216,10 @@ n== (2072 . "@src64/subr.l")
nT (2183 . "@src64/subr.l")
name (499 . "@src64/sym.l")
nand (1672 . "@src64/flow.l")
-native (1258 . "@src64/main.l")
+native (1263 . "@src64/main.l")
need (918 . "@src64/subr.l")
new (850 . "@src64/flow.l")
-next (1906 . "@src64/main.l")
+next (1911 . "@src64/main.l")
nil (1755 . "@src64/flow.l")
nond (1955 . "@src64/flow.l")
nor (1693 . "@src64/flow.l")
@@ -233,7 +233,7 @@ onOff (1611 . "@src64/sym.l")
one (1644 . "@src64/sym.l")
open (4108 . "@src64/io.l")
opid (2921 . "@src64/flow.l")
-opt (2647 . "@src64/main.l")
+opt (2652 . "@src64/main.l")
or (1653 . "@src64/flow.l")
out (4002 . "@src64/io.l")
pack (1144 . "@src64/sym.l")
@@ -260,15 +260,15 @@ prog (1773 . "@src64/flow.l")
prog1 (1781 . "@src64/flow.l")
prog2 (1798 . "@src64/flow.l")
prop (2779 . "@src64/sym.l")
-protect (515 . "@src64/main.l")
+protect (520 . "@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 (2288 . "@src64/main.l")
+pwd (2293 . "@src64/main.l")
queue (1918 . "@src64/sym.l")
-quit (971 . "@src64/main.l")
+quit (976 . "@src64/main.l")
quote (141 . "@src64/flow.l")
rand (2640 . "@src64/big.l")
range (988 . "@src64/subr.l")
@@ -277,7 +277,7 @@ raw (453 . "@src64/main.l")
rd (4870 . "@src64/io.l")
read (2498 . "@src64/io.l")
replace (1490 . "@src64/subr.l")
-rest (1952 . "@src64/main.l")
+rest (1957 . "@src64/main.l")
reverse (1665 . "@src64/subr.l")
rewind (4836 . "@src64/io.l")
rollback (1885 . "@src64/db.l")
@@ -317,7 +317,7 @@ text (1270 . "@src64/sym.l")
throw (2504 . "@src64/flow.l")
tick (2873 . "@src64/flow.l")
till (3403 . "@src64/io.l")
-time (2171 . "@src64/main.l")
+time (2176 . "@src64/main.l")
touch (1049 . "@src64/sym.l")
trim (1746 . "@src64/subr.l")
try (1187 . "@src64/flow.l")
@@ -326,13 +326,13 @@ udp (268 . "@src64/net.l")
unify (3810 . "@src64/subr.l")
unless (1914 . "@src64/flow.l")
until (2098 . "@src64/flow.l")
-up (654 . "@src64/main.l")
+up (659 . "@src64/main.l")
upp? (3228 . "@src64/sym.l")
uppc (3292 . "@src64/sym.l")
use (1586 . "@src64/flow.l")
-usec (2276 . "@src64/main.l")
+usec (2281 . "@src64/main.l")
val (1461 . "@src64/sym.l")
-version (2661 . "@src64/main.l")
+version (2666 . "@src64/main.l")
wait (2982 . "@src64/io.l")
when (1897 . "@src64/flow.l")
while (2074 . "@src64/flow.l")
diff --git a/src/main.c b/src/main.c
@@ -1,4 +1,4 @@
-/* 26may10abu
+/* 30may10abu
* (c) Software Lab. Alexander Burger
*/
@@ -202,13 +202,14 @@ any doAlarm(any x) {
return boxCnt(n);
}
-// (sigio 'cnt [. prg]) -> cnt
+// (sigio ['cnt [. prg]]) -> cnt | prg
any doSigio(any ex) {
any x;
int fd;
- x = cdr(ex), x = EVAL(car(x));
- fd = (int)xCnt(ex,x);
+ if (!isCell(x = cdr(ex)))
+ return Sigio;
+ x = EVAL(car(x)), fd = (int)xCnt(ex,x);
if (isCell(Sigio = cddr(ex))) {
fcntl(fd, F_SETOWN, unBox(val(Pid)));
fcntl(fd, F_SETFL, fcntl(fd, F_GETFL, 0) | O_NONBLOCK|O_ASYNC);
diff --git a/src64/main.l b/src64/main.l
@@ -1,4 +1,4 @@
-# 20may10abu
+# 30may10abu
# (c) Software Lab. Alexander Burger
### Global return labels ###
@@ -487,26 +487,31 @@
pop X
ret
-# (sigio 'cnt [. prg]) -> cnt
+# (sigio ['cnt [. prg]]) -> cnt | prg
(code 'doSigio 2)
push X
push Y
ld X E
ld Y (E CDR) # Y on args
- call evCntXY_FE # Get fd
- ld Y (Y CDR) # 'prg'
- ld (Sigio) Y # Save in 'Sigio'
atom Y # Any?
- if z # Yes
- ld A (Pid) # Get process ID
- shr A 4 # Normalize
- cc fcntl(E F_SETOWN A) # Receive SIGIO events
- cc fcntl(E F_GETFL 0) # Get file status flags
- or A (| O_NONBLOCK O_ASYNC)
- cc fcntl(E F_SETFL A) # Set file status flags
+ if nz # No
+ ld E (Sigio) # Return current handler
+ else
+ call evCntXY_FE # Get fd
+ ld Y (Y CDR) # Handler 'prg'
+ ld (Sigio) Y # Save in 'Sigio'
+ atom Y # Any?
+ if z # Yes
+ ld A (Pid) # Get process ID
+ shr A 4 # Normalize
+ cc fcntl(E F_SETOWN A) # Receive SIGIO events
+ cc fcntl(E F_GETFL 0) # Get file status flags
+ or A (| O_NONBLOCK O_ASYNC)
+ cc fcntl(E F_SETFL A) # Set file status flags
+ end
+ shl E 4 # Return fd
+ or E CNT
end
- shl E 4 # Return fd
- or E CNT
pop Y
pop X
ret
diff --git a/src64/version.l b/src64/version.l
@@ -1,6 +1,6 @@
-# 27may10abu
+# 30may10abu
# (c) Software Lab. Alexander Burger
-(de *Version 3 0 2 24)
+(de *Version 3 0 2 25)
# vi:et:ts=3:sw=3
