picolisp

Unnamed repository; edit this file to name it for gitweb.
git clone https://logand.com/git/picolisp.git/
Log | Files | Refs | README | LICENSE

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:
MCHANGES | 1+
Mdoc/refA.html | 6+++++-
Mdoc/refH.html | 5++---
Mdoc/refS.html | 14+++++++++++---
Mlib/tags | 51++++++++++++++++++++++++++-------------------------
Msrc/main.c | 18++++++++++++++++--
Msrc/pico.h | 3++-
Msrc/tab.c | 3++-
Msrc64/glob.l | 3++-
Msrc64/main.l | 26+++++++++++++++++++++++++-
Msrc64/sys/linux.defs.l | 4+++-
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