commit 8454cb6bd0c793b829e50586f19408f4e61e722d
parent ec9f99ab985b1212424fa125ece5d6724ed7193a
Author: Commit-Bot <unknown>
Date: Thu, 20 May 2010 10:08:17 +0000
Automatic commit from picoLisp.tgz, From: Thu, 20 May 2010 07:08:17 GMT
Diffstat:
11 files changed, 95 insertions(+), 39 deletions(-)
diff --git a/CHANGES b/CHANGES
@@ -1,4 +1,5 @@
* XXjun10 picoLisp-3.0.3
+ 'sigio' function
'sqrt' optionally rounds
'format' also accepts 'lst' argument
'adr' function
diff --git a/doc/refA.html b/doc/refA.html
@@ -177,7 +177,11 @@ href="refR.html#rc">rc</a></code>.
<dd>Sets an alarm timer scheduling <code>prg</code> to be executed after
<code>cnt</code> seconds, and returns the number of seconds remaining until any
previously scheduled alarm was due to be delivered. Calling <code>(alarm
-0)</code> will cancel an alarm.
+0)</code> will cancel an alarm. See also <code><a
+href="refA.html#abort">abort</a></code>, <code><a
+href="refS.html#sigio">sigio</a></code>, <code><a
+href="refH.html#*Hup">*Hup</a></code> and <code><a
+href="refS.html#*Sig1">*Sig[12]</a></code>.
<pre><code>
: (prinl (tim$ (time) T)) (alarm 10 (prinl (tim$ (time) T)))
diff --git a/doc/refH.html b/doc/refH.html
@@ -15,9 +15,8 @@
<dd>Global variable holding a (possibly empty) <code>prg</code> body, which will
be executed when a SIGHUP signal is sent to the current process. See also
<code><a href="refA.html#alarm">alarm</a></code>, <code><a
-href="refR.html#*Run">*Run</a></code>, <code><a
-href="refS.html#*Sig1">*Sig[12]</a></code> and <code><a
-href="refE.html#*Err">*Err</a></code>.
+href="refS.html#sigio">sigio</a></code> and <code><a
+href="refS.html#*Sig1">*Sig[12]</a></code>.
<pre><code>
: (de *Hup (msg 'SIGHUP))
diff --git a/doc/refS.html b/doc/refS.html
@@ -31,9 +31,8 @@ href="refS.html#scl">scl</a></code>.
will be executed when a SIGUSR1 signal (or a SIGUSR2 signal, respectively) is
sent to the current process. See also <code><a
href="refA.html#alarm">alarm</a></code>, <code><a
-href="refR.html#*Run">*Run</a></code>, <code><a
-href="refH.html#*Hup">*Hup</a></code> and <code><a
-href="refE.html#*Err">*Err</a></code>.
+href="refS.html#sigio">sigio</a></code> and <code><a
+href="refH.html#*Hup">*Hup</a></code>.
<pre><code>
: (de *Sig1 (msg 'SIGUSR1))
@@ -437,6 +436,15 @@ href="refS.html#show">show</a></code>.
-> NIL
</code></pre>
+<dt><a name="sigio"><code>(sigio 'cnt [. prg]) -> cnt</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
+href="refS.html#*Sig1">*Sig[12]</a></code>.
+
+<pre><code>
+</code></pre>
+
<dt><a name="size"><code>(size 'any) -> cnt</code></a>
<dd>Returns the "size" of <code>any</code>. For numbers this is the number of
bytes needed for the value, for external symbols it is the number of bytes it
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 (531 . "@src64/main.l")
+adr (555 . "@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 (1899 . "@src64/main.l")
-args (1875 . "@src64/main.l")
-argv (2520 . "@src64/main.l")
+arg (1923 . "@src64/main.l")
+args (1899 . "@src64/main.l")
+argv (2544 . "@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 (2275 . "@src64/main.l")
+cd (2299 . "@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 (2502 . "@src64/main.l")
+cmd (2526 . "@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 (2300 . "@src64/main.l")
+ctty (2324 . "@src64/main.l")
cut (1795 . "@src64/sym.l")
-date (2014 . "@src64/main.l")
+date (2038 . "@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 (2433 . "@src64/main.l")
+dir (2457 . "@src64/main.l")
dm (563 . "@src64/flow.l")
do (2152 . "@src64/flow.l")
e (2623 . "@src64/flow.l")
echo (4166 . "@src64/io.l")
-env (543 . "@src64/main.l")
+env (567 . "@src64/main.l")
eof (3317 . "@src64/io.l")
eol (3308 . "@src64/io.l")
-errno (1226 . "@src64/main.l")
+errno (1250 . "@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 (2380 . "@src64/main.l")
+file (2404 . "@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 (501 . "@src64/main.l")
+heap (525 . "@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 (2337 . "@src64/main.l")
+info (2361 . "@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 (1234 . "@src64/main.l")
+native (1258 . "@src64/main.l")
need (918 . "@src64/subr.l")
new (850 . "@src64/flow.l")
-next (1882 . "@src64/main.l")
+next (1906 . "@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 (2623 . "@src64/main.l")
+opt (2647 . "@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 (491 . "@src64/main.l")
+protect (515 . "@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 (2264 . "@src64/main.l")
+pwd (2288 . "@src64/main.l")
queue (1918 . "@src64/sym.l")
-quit (947 . "@src64/main.l")
+quit (971 . "@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 (1928 . "@src64/main.l")
+rest (1952 . "@src64/main.l")
reverse (1665 . "@src64/subr.l")
rewind (4836 . "@src64/io.l")
rollback (1885 . "@src64/db.l")
@@ -291,6 +291,7 @@ send (1146 . "@src64/flow.l")
seq (1090 . "@src64/db.l")
set (1480 . "@src64/sym.l")
setq (1513 . "@src64/sym.l")
+sigio (491 . "@src64/main.l")
size (2750 . "@src64/subr.l")
skip (3294 . "@src64/io.l")
sort (3837 . "@src64/subr.l")
@@ -316,7 +317,7 @@ text (1270 . "@src64/sym.l")
throw (2504 . "@src64/flow.l")
tick (2873 . "@src64/flow.l")
till (3403 . "@src64/io.l")
-time (2147 . "@src64/main.l")
+time (2171 . "@src64/main.l")
touch (1049 . "@src64/sym.l")
trim (1746 . "@src64/subr.l")
try (1187 . "@src64/flow.l")
@@ -325,13 +326,13 @@ udp (268 . "@src64/net.l")
unify (3810 . "@src64/subr.l")
unless (1914 . "@src64/flow.l")
until (2098 . "@src64/flow.l")
-up (630 . "@src64/main.l")
+up (654 . "@src64/main.l")
upp? (3228 . "@src64/sym.l")
uppc (3292 . "@src64/sym.l")
use (1586 . "@src64/flow.l")
-usec (2252 . "@src64/main.l")
+usec (2276 . "@src64/main.l")
val (1461 . "@src64/sym.l")
-version (2637 . "@src64/main.l")
+version (2661 . "@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 @@
-/* 19may10abu
+/* 20may10abu
* (c) Software Lab. Alexander Burger
*/
@@ -84,7 +84,7 @@ void sighandler(any ex) {
do {
if (Signal[SIGIO]) {
--Signal[0], --Signal[SIGIO];
- /* ... */
+ run(Sigio);
}
else if (Signal[SIGUSR1]) {
--Signal[0], --Signal[SIGUSR1];
@@ -198,6 +198,20 @@ any doAlarm(any x) {
return boxCnt(n);
}
+// (sigio 'cnt [. prg]) -> cnt
+any doSigio(any ex) {
+ any x;
+ int fd;
+
+ x = cdr(ex), 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);
+ }
+ return x;
+}
+
// (protect . prg) -> any
any doProtect(any x) {
++Env.protect;
diff --git a/src/pico.h b/src/pico.h
@@ -1,4 +1,4 @@
-/* 19may10abu
+/* 20may10abu
* (c) Software Lab. Alexander Burger
*/
@@ -688,6 +688,7 @@ any doSet(any);
any doSetCol(any);
any doSetq(any);
any doShift(any);
+any doSigio(any);
any doSize(any);
any doSkip(any);
any doSort(any);
diff --git a/src/tab.c b/src/tab.c
@@ -1,4 +1,4 @@
-/* 26apr10abu
+/* 20may10abu
* (c) Software Lab. Alexander Burger
*/
@@ -296,6 +296,7 @@ static symInit Symbols[] = {
{doSetCol, "=:"},
{doSetq, "setq"},
{doShift, ">>"},
+ {doSigio, "sigio"},
{doSize, "size"},
{doSkip, "skip"},
{doSort, "sort"},
diff --git a/src64/glob.l b/src64/glob.l
@@ -1,4 +1,4 @@
-# 19may10abu
+# 20may10abu
# (c) Software Lab. Alexander Burger
(data 'Globals 0)
@@ -126,6 +126,7 @@
# System functions
initSym NIL "raw" doRaw
initSym NIL "alarm" doAlarm
+ initSym NIL "sigio" doSigio
initSym NIL "protect" doProtect
initSym NIL "heap" doHeap
initSym NIL "adr" doAdr
diff --git a/src64/main.l b/src64/main.l
@@ -1,4 +1,4 @@
-# 19may10abu
+# 20may10abu
# (c) Software Lab. Alexander Burger
### Global return labels ###
@@ -487,6 +487,30 @@
pop X
ret
+# (sigio 'cnt [. prg]) -> cnt
+(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
+ end
+ shl E 4 # Return fd
+ or E CNT
+ pop Y
+ pop X
+ ret
+
# (protect . prg) -> any
(code 'doProtect 2)
push X
diff --git a/src64/sys/linux.defs.l b/src64/sys/linux.defs.l
@@ -1,4 +1,4 @@
-# 19may10abu
+# 20may10abu
# (c) Software Lab. Alexander Burger
# errno
@@ -47,7 +47,9 @@
(equ F_GETLK 5)
(equ F_SETLK 6)
(equ F_SETLKW 7)
+(equ F_SETOWN 8)
(equ O_NONBLOCK 2048)
+(equ O_ASYNC 8192)
# stat
(equ STAT 144) # File status structure
