commit 5abc0b66057a361eb68c241cfcba5aa6b63d73c3
parent 16308d53306b0dbb774d9443d72663f167766b74
Author: Alexander Burger <abu@software-lab.de>
Date: Wed, 9 Mar 2011 18:09:14 +0100
Added 'err' (stderr redirection) function
Diffstat:
20 files changed, 277 insertions(+), 93 deletions(-)
diff --git a/CHANGES b/CHANGES
@@ -1,4 +1,5 @@
* XXmar11 picoLisp-3.0.6
+ 'err' function
Removed 'rpc' function
man pages for 'picolisp' and 'pil'
'version' also for 32-bit
diff --git a/ReleaseNotes b/ReleaseNotes
@@ -39,7 +39,7 @@
5. The name of the GUI function 'err' in "lib/form.l" was changed to 'error'
(and also that of the corresponding default CSS type in "lib.css"). This was
- done to reserve the name "err" for future standard error redirection.
+ done to reserve the name "err" for standard error redirection (point 8).
6. The "opt/" directory (until now containing only a single "pilog.l" file) was
removed from the base distribution. It is now tracked separately. To install
@@ -51,3 +51,6 @@
7. The 'rpc' function was removed from the release. It is seldom used, and also
redundant: (rpc 'foo ''arg) is equivalent to (pr '(foo 'arg))
+
+8. A new function 'err' for standard error redirection is now available. It is
+ analog to 'out', but accepts only a symbolic argument (like 'ctl').
diff --git a/doc/ref.html b/doc/ref.html
@@ -2164,11 +2164,12 @@ abbreviations:
<dd><code>
<a href="refP.html#path">path</a>
<a href="refI.html#in">in</a>
- <a href="refI.html#ipid">ipid</a>
<a href="refO.html#out">out</a>
+ <a href="refE.html#err">err</a>
+ <a href="refC.html#ctl">ctl</a>
+ <a href="refI.html#ipid">ipid</a>
<a href="refO.html#opid">opid</a>
<a href="refP.html#pipe">pipe</a>
- <a href="refC.html#ctl">ctl</a>
<a href="refA.html#any">any</a>
<a href="refS.html#sym">sym</a>
<a href="refS.html#str">str</a>
diff --git a/doc/refC.html b/doc/refC.html
@@ -619,8 +619,9 @@ files does not exist, it will be created. When <code>sym</code> is
<code>NIL</code>, a shared lock is tried on the current innermost I/O channel,
and when it is <code>T</code>, an exclusive lock is tried instead. See also
<code><a href="refI.html#in">in</a></code>, <code><a
-href="refP.html#pipe">pipe</a></code> and <code><a
-href="refO.html#out">out</a></code>.
+href="refO.html#out">out</a></code>, <code><a
+href="refE.html#err">err</a></code> and <code><a
+href="refP.html#pipe">pipe</a></code>.
<pre><code>
$ echo 9 >count # Write '9' to file "count"
diff --git a/doc/refE.html b/doc/refE.html
@@ -267,6 +267,22 @@ href="refM.html#member/2">member/2</a></code>.
-> NIL
</code></pre>
+<dt><a name="err"><code>(err 'sym . prg) -> any</code></a>
+<dd>Redirects the standard error stream to <code>sym</code> during the execution
+of <code>prg</code>. The current standard error stream will be saved and
+restored appropriately. If the argument is <code>NIL</code>, the current output
+stream will be used. Otherwise, <code>sym</code> is taken as a file name (opened
+in "append" mode if the first character is "+"), where standard error is to be
+written to. See also <code><a href="refI.html#in">in</a></code>, <code><a
+href="refO.html#out">out</a></code> and <code><a
+href="refC.html#ctl">ctl</a></code>.
+
+<pre><code>
+: (err "/dev/null" # Suppress error messages
+ (call 'ls 'noSuchFile) )
+-> NIL
+</code></pre>
+
<dt><a name="errno"><code>(errno) -> cnt</code></a>
<dd>(64-bit version only) Returns the value of the standard I/O 'errno'
variable.
diff --git a/doc/refI.html b/doc/refI.html
@@ -168,6 +168,7 @@ href="refC.html#call">call</a></code>, <code><a
href="refL.html#load">load</a></code>, <code><a
href="refF.html#file">file</a></code>, <code><a
href="refO.html#out">out</a></code>, <code><a
+href="refE.html#err">err</a></code>, <code><a
href="refP.html#poll">poll</a></code>, <code><a
href="refP.html#pipe">pipe</a></code> and <code><a
href="refC.html#ctl">ctl</a></code>.
diff --git a/doc/refO.html b/doc/refO.html
@@ -254,9 +254,10 @@ list), it is taken as a command with arguments, and a pipe is opened for output.
See also <code><a href="refO.html#opid">opid</a></code>, <code> <a
href="refC.html#call">call</a></code>, <code><a
href="refI.html#in">in</a></code>, <code> <a
-href="refP.html#poll">poll</a></code>, <code> <a
-href="refP.html#pipe">pipe</a></code>, <code> <a
+href="refE.html#err">err</a></code>, <code> <a
href="refC.html#ctl">ctl</a></code>, <code><a
+href="refP.html#pipe">pipe</a></code>, <code> <a
+href="refP.html#poll">poll</a></code>, <code> <a
href="refC.html#close">close</a></code> and <code><a
href="refL.html#load">load</a></code>.
diff --git a/doc64/structures b/doc64/structures
@@ -1,4 +1,4 @@
-# 03feb11abu
+# 09mar11abu
# (c) Software Lab. Alexander Burger
@@ -208,7 +208,7 @@
<III> put/get |
<II> pid |
<I> fd |
- LINK ----+ <-- inFrames, outFrames, ctlFrames
+ LINK ----+ <-- inFrames, outFrames, errFrames, ctlFrames
Coroutine frame:
diff --git a/ersatz/picolisp.jar b/ersatz/picolisp.jar
Binary files differ.
diff --git a/lib/tags b/lib/tags
@@ -29,7 +29,7 @@ adr (603 . "@src64/main.l")
alarm (480 . "@src64/main.l")
all (772 . "@src64/sym.l")
and (1621 . "@src64/flow.l")
-any (3879 . "@src64/io.l")
+any (3933 . "@src64/io.l")
append (1338 . "@src64/subr.l")
apply (713 . "@src64/apply.l")
arg (2270 . "@src64/main.l")
@@ -82,12 +82,12 @@ cdddr (245 . "@src64/subr.l")
cddr (79 . "@src64/subr.l")
cdr (17 . "@src64/subr.l")
chain (1141 . "@src64/subr.l")
-char (3361 . "@src64/io.l")
+char (3415 . "@src64/io.l")
chop (1093 . "@src64/sym.l")
circ (816 . "@src64/subr.l")
circ? (2398 . "@src64/subr.l")
clip (1795 . "@src64/subr.l")
-close (4267 . "@src64/io.l")
+close (4339 . "@src64/io.l")
cmd (2873 . "@src64/main.l")
cnt (1413 . "@src64/apply.l")
co (2546 . "@src64/flow.l")
@@ -98,7 +98,7 @@ cond (1916 . "@src64/flow.l")
connect (201 . "@src64/net.l")
cons (747 . "@src64/subr.l")
copy (1225 . "@src64/subr.l")
-ctl (4207 . "@src64/io.l")
+ctl (4217 . "@src64/io.l")
ctty (2671 . "@src64/main.l")
cut (1797 . "@src64/sym.l")
date (2385 . "@src64/main.l")
@@ -115,13 +115,14 @@ dir (2804 . "@src64/main.l")
dm (543 . "@src64/flow.l")
do (2138 . "@src64/flow.l")
e (2920 . "@src64/flow.l")
-echo (4298 . "@src64/io.l")
+echo (4370 . "@src64/io.l")
env (615 . "@src64/main.l")
-eof (3438 . "@src64/io.l")
-eol (3429 . "@src64/io.l")
+eof (3492 . "@src64/io.l")
+eol (3483 . "@src64/io.l")
+err (4197 . "@src64/io.l")
errno (1381 . "@src64/main.l")
eval (182 . "@src64/flow.l")
-ext (5028 . "@src64/io.l")
+ext (5100 . "@src64/io.l")
ext? (1034 . "@src64/sym.l")
extern (900 . "@src64/sym.l")
extra (1263 . "@src64/flow.l")
@@ -136,13 +137,13 @@ find (1322 . "@src64/apply.l")
fish (1613 . "@src64/apply.l")
flg? (2441 . "@src64/subr.l")
flip (1695 . "@src64/subr.l")
-flush (5003 . "@src64/io.l")
+flush (5075 . "@src64/io.l")
fold (3343 . "@src64/sym.l")
for (2227 . "@src64/flow.l")
fork (3264 . "@src64/flow.l")
format (2089 . "@src64/big.l")
free (2047 . "@src64/db.l")
-from (3457 . "@src64/io.l")
+from (3511 . "@src64/io.l")
full (1075 . "@src64/subr.l")
fun? (734 . "@src64/sym.l")
gc (432 . "@src64/gc.l")
@@ -154,14 +155,14 @@ glue (1234 . "@src64/sym.l")
gt0 (2716 . "@src64/big.l")
head (1816 . "@src64/subr.l")
heap (535 . "@src64/main.l")
-hear (3142 . "@src64/io.l")
+hear (3196 . "@src64/io.l")
host (184 . "@src64/net.l")
id (1027 . "@src64/db.l")
idx (2037 . "@src64/sym.l")
if (1802 . "@src64/flow.l")
if2 (1821 . "@src64/flow.l")
ifn (1862 . "@src64/flow.l")
-in (4103 . "@src64/io.l")
+in (4157 . "@src64/io.l")
inc (2256 . "@src64/big.l")
index (2633 . "@src64/subr.l")
info (2708 . "@src64/main.l")
@@ -170,7 +171,7 @@ ipid (3209 . "@src64/flow.l")
isa (959 . "@src64/flow.l")
job (1426 . "@src64/flow.l")
journal (970 . "@src64/db.l")
-key (3290 . "@src64/io.l")
+key (3344 . "@src64/io.l")
kill (3241 . "@src64/flow.l")
last (2040 . "@src64/subr.l")
le0 (2691 . "@src64/big.l")
@@ -178,14 +179,14 @@ length (2737 . "@src64/subr.l")
let (1476 . "@src64/flow.l")
let? (1537 . "@src64/flow.l")
lieu (1156 . "@src64/db.l")
-line (3613 . "@src64/io.l")
-lines (3766 . "@src64/io.l")
+line (3667 . "@src64/io.l")
+lines (3820 . "@src64/io.l")
link (1172 . "@src64/subr.l")
lisp (1948 . "@src64/main.l")
list (887 . "@src64/subr.l")
listen (151 . "@src64/net.l")
lit (157 . "@src64/flow.l")
-load (4080 . "@src64/io.l")
+load (4134 . "@src64/io.l")
lock (1184 . "@src64/db.l")
loop (2170 . "@src64/flow.l")
low? (3215 . "@src64/sym.l")
@@ -235,30 +236,30 @@ offset (2673 . "@src64/subr.l")
on (1583 . "@src64/sym.l")
onOff (1613 . "@src64/sym.l")
one (1646 . "@src64/sym.l")
-open (4229 . "@src64/io.l")
+open (4301 . "@src64/io.l")
opid (3225 . "@src64/flow.l")
opt (2994 . "@src64/main.l")
or (1637 . "@src64/flow.l")
-out (4123 . "@src64/io.l")
+out (4177 . "@src64/io.l")
pack (1144 . "@src64/sym.l")
pair (2390 . "@src64/subr.l")
pass (754 . "@src64/apply.l")
pat? (720 . "@src64/sym.l")
path (1238 . "@src64/io.l")
-peek (3345 . "@src64/io.l")
+peek (3399 . "@src64/io.l")
pick (1369 . "@src64/apply.l")
-pipe (4144 . "@src64/io.l")
-poll (3234 . "@src64/io.l")
+pipe (4238 . "@src64/io.l")
+poll (3288 . "@src64/io.l")
pool (648 . "@src64/db.l")
pop (1773 . "@src64/sym.l")
port (5 . "@src64/net.l")
-pr (5111 . "@src64/io.l")
+pr (5183 . "@src64/io.l")
pre? (1411 . "@src64/sym.l")
-prin (4927 . "@src64/io.l")
-prinl (4941 . "@src64/io.l")
-print (4967 . "@src64/io.l")
-println (4998 . "@src64/io.l")
-printsp (4983 . "@src64/io.l")
+prin (4999 . "@src64/io.l")
+prinl (5013 . "@src64/io.l")
+print (5039 . "@src64/io.l")
+println (5070 . "@src64/io.l")
+printsp (5055 . "@src64/io.l")
prior (2709 . "@src64/subr.l")
prog (1757 . "@src64/flow.l")
prog1 (1765 . "@src64/flow.l")
@@ -278,12 +279,12 @@ rand (2973 . "@src64/big.l")
range (997 . "@src64/subr.l")
rank (3029 . "@src64/subr.l")
raw (458 . "@src64/main.l")
-rd (5045 . "@src64/io.l")
-read (2573 . "@src64/io.l")
+rd (5117 . "@src64/io.l")
+read (2627 . "@src64/io.l")
replace (1499 . "@src64/subr.l")
rest (2299 . "@src64/main.l")
reverse (1674 . "@src64/subr.l")
-rewind (5011 . "@src64/io.l")
+rewind (5083 . "@src64/io.l")
rollback (1890 . "@src64/db.l")
rot (848 . "@src64/subr.l")
run (313 . "@src64/flow.l")
@@ -296,31 +297,31 @@ set (1482 . "@src64/sym.l")
setq (1515 . "@src64/sym.l")
sigio (496 . "@src64/main.l")
size (2802 . "@src64/subr.l")
-skip (3415 . "@src64/io.l")
+skip (3469 . "@src64/io.l")
sort (3958 . "@src64/subr.l")
sp? (711 . "@src64/sym.l")
-space (4945 . "@src64/io.l")
+space (5017 . "@src64/io.l")
split (1588 . "@src64/subr.l")
stack (564 . "@src64/main.l")
state (2006 . "@src64/flow.l")
stem (1985 . "@src64/subr.l")
-str (3933 . "@src64/io.l")
+str (3987 . "@src64/io.l")
str? (1013 . "@src64/sym.l")
strip (1572 . "@src64/subr.l")
sub? (1444 . "@src64/sym.l")
sum (1460 . "@src64/apply.l")
super (1218 . "@src64/flow.l")
-sym (3919 . "@src64/io.l")
+sym (3973 . "@src64/io.l")
sym? (2430 . "@src64/subr.l")
-sync (3102 . "@src64/io.l")
+sync (3156 . "@src64/io.l")
sys (3061 . "@src64/flow.l")
t (1748 . "@src64/flow.l")
tail (1907 . "@src64/subr.l")
-tell (3174 . "@src64/io.l")
+tell (3228 . "@src64/io.l")
text (1272 . "@src64/sym.l")
throw (2490 . "@src64/flow.l")
tick (3177 . "@src64/flow.l")
-till (3524 . "@src64/io.l")
+till (3578 . "@src64/io.l")
time (2518 . "@src64/main.l")
touch (1049 . "@src64/sym.l")
trim (1755 . "@src64/subr.l")
@@ -337,12 +338,12 @@ use (1570 . "@src64/flow.l")
usec (2623 . "@src64/main.l")
val (1463 . "@src64/sym.l")
version (3008 . "@src64/main.l")
-wait (3064 . "@src64/io.l")
+wait (3118 . "@src64/io.l")
when (1881 . "@src64/flow.l")
while (2058 . "@src64/flow.l")
wipe (3090 . "@src64/sym.l")
with (1327 . "@src64/flow.l")
-wr (5128 . "@src64/io.l")
+wr (5200 . "@src64/io.l")
xchg (1538 . "@src64/sym.l")
xor (1698 . "@src64/flow.l")
x| (2885 . "@src64/big.l")
diff --git a/src/io.c b/src/io.c
@@ -795,6 +795,38 @@ void wrOpen(any ex, any x, outFrame *f) {
}
}
+void erOpen(any ex, any x, errFrame *f) {
+ int fd;
+
+ NeedSym(ex,x);
+ f->fd = dup(STDERR_FILENO);
+ if (isNil(x))
+ fd = dup(OutFile->fd);
+ else {
+ char nm[pathSize(x)];
+
+ pathString(x,nm);
+ if (nm[0] == '+') {
+ while ((fd = open(nm+1, O_APPEND|O_CREAT|O_WRONLY, 0666)) < 0) {
+ if (errno != EINTR)
+ openErr(ex, nm);
+ if (*Signal)
+ sighandler(ex);
+ }
+ }
+ else {
+ while ((fd = open(nm, O_CREAT|O_TRUNC|O_WRONLY, 0666)) < 0) {
+ if (errno != EINTR)
+ openErr(ex, nm);
+ if (*Signal)
+ sighandler(ex);
+ }
+ }
+ closeOnExec(ex, fd);
+ }
+ dup2(fd, STDERR_FILENO), close(fd);
+}
+
void ctOpen(any ex, any x, ctlFrame *f) {
NeedSym(ex,x);
if (isNil(x)) {
@@ -882,6 +914,10 @@ void pushOutFiles(outFrame *f) {
f->link = Env.outFrames, Env.outFrames = f;
}
+void pushErrFiles(errFrame *f) {
+ f->link = Env.errFrames, Env.errFrames = f;
+}
+
void pushCtlFiles(ctlFrame *f) {
f->link = Env.ctlFrames, Env.ctlFrames = f;
}
@@ -921,6 +957,12 @@ void popOutFiles(void) {
OutFile = OutFiles[(Env.outFrames = Env.outFrames->link)? Env.outFrames->fd : STDOUT_FILENO];
}
+void popErrFiles(void) {
+ dup2(Env.errFrames->fd, STDERR_FILENO);
+ close(Env.errFrames->fd);
+ Env.errFrames = Env.errFrames->link;
+}
+
void popCtlFiles(void) {
if (Env.ctlFrames->fd >= 0)
close(Env.ctlFrames->fd);
@@ -2064,6 +2106,32 @@ any doOut(any ex) {
return x;
}
+// (err 'sym . prg) -> any
+any doErr(any ex) {
+ any x;
+ errFrame f;
+
+ x = cdr(ex), x = EVAL(car(x));
+ erOpen(ex,x,&f);
+ pushErrFiles(&f);
+ x = prog(cddr(ex));
+ popErrFiles();
+ return x;
+}
+
+// (ctl 'sym . prg) -> any
+any doCtl(any ex) {
+ any x;
+ ctlFrame f;
+
+ x = cdr(ex), x = EVAL(car(x));
+ ctOpen(ex,x,&f);
+ pushCtlFiles(&f);
+ x = prog(cddr(ex));
+ popCtlFiles();
+ return x;
+}
+
// (pipe exe) -> cnt
// (pipe exe . prg) -> any
any doPipe(any ex) {
@@ -2101,19 +2169,6 @@ any doPipe(any ex) {
return x;
}
-// (ctl 'sym . prg) -> any
-any doCtl(any ex) {
- any x;
- ctlFrame f;
-
- x = cdr(ex), x = EVAL(car(x));
- ctOpen(ex,x,&f);
- pushCtlFiles(&f);
- x = prog(cddr(ex));
- popCtlFiles();
- return x;
-}
-
// (open 'any) -> cnt | NIL
any doOpen(any ex) {
any x = evSym(cdr(ex));
diff --git a/src/main.c b/src/main.c
@@ -1,4 +1,4 @@
-/* 07mar11abu
+/* 09mar11abu
* (c) Software Lab. Alexander Burger
*/
@@ -616,6 +616,8 @@ void unwind(catchFrame *catch) {
popInFiles();
while (Env.outFrames != q->env.outFrames)
popOutFiles();
+ while (Env.errFrames != q->env.errFrames)
+ popErrFiles();
while (Env.ctlFrames != q->env.ctlFrames)
popCtlFiles();
Env = q->env;
@@ -634,6 +636,8 @@ void unwind(catchFrame *catch) {
popInFiles();
while (Env.outFrames)
popOutFiles();
+ while (Env.errFrames)
+ popErrFiles();
while (Env.ctlFrames)
popCtlFiles();
}
diff --git a/src/pico.h b/src/pico.h
@@ -102,6 +102,11 @@ typedef struct outFrame {
int fd;
} outFrame;
+typedef struct errFrame {
+ struct errFrame *link;
+ int fd;
+} errFrame;
+
typedef struct ctlFrame {
struct ctlFrame *link;
int fd;
@@ -119,6 +124,7 @@ typedef struct stkEnv {
any cls, key, task, *make, *yoke;
inFrame *inFrames;
outFrame *outFrames;
+ errFrame *errFrames;
ctlFrame *ctlFrames;
parseFrame *parser;
void (*get)(void);
@@ -298,6 +304,7 @@ unsigned long ehash(any);
any endString(void);
bool eol(void);
bool equal(any,any);
+void erOpen(any,any,errFrame*);
void err(any,any,char*,...) __attribute__ ((noreturn));
any evExpr(any,any);
long evCnt(any,any);
@@ -354,6 +361,7 @@ void pathString(any,char*);
void pipeError(any,char*);
void popCtlFiles(void);
void popInFiles(void);
+void popErrFiles(void);
void popOutFiles(void);
void pr(int,any);
void prin(any);
@@ -362,9 +370,10 @@ void print(any);
void print1(any);
void prn(long);
void protError(any,any) __attribute__ ((noreturn));
+void pushCtlFiles(ctlFrame*);
void pushInFiles(inFrame*);
+void pushErrFiles(errFrame*);
void pushOutFiles(outFrame*);
-void pushCtlFiles(ctlFrame*);
void put(any,any,any);
void putStdout(int);
void rdOpen(any,any,inFrame*);
@@ -500,6 +509,7 @@ any doEq(any);
any doEq0(any);
any doEqT(any);
any doEqual(any);
+any doErr(any);
any doEval(any);
any doExt(any);
any doExtern(any);
diff --git a/src/tab.c b/src/tab.c
@@ -114,6 +114,7 @@ static symInit Symbols[] = {
{doEq0, "=0"},
{doEqT, "=T"},
{doEqual, "="},
+ {doErr, "err"},
{doEval, "eval"},
{doExt, "ext"},
{doExtern, "extern"},
diff --git a/src/vers.h b/src/vers.h
@@ -1 +1 @@
-static byte Version[4] = {3,0,5,21};
+static byte Version[4] = {3,0,5,22};
diff --git a/src64/err.l b/src64/err.l
@@ -1,4 +1,4 @@
-# 01mar11abu
+# 09mar11abu
# (c) Software Lab. Alexander Burger
# Debug print routine
@@ -241,7 +241,12 @@
call popOutFiles # Clean up
loop
do
- cmp (EnvCtlFrames) (X VI) # Open control frames?
+ cmp (EnvErrFrames) (X VI) # Open error frames?
+ while ne # Yes
+ call popErrFiles # Clean up
+ loop
+ do
+ cmp (EnvCtlFrames) (X VII) # Open control frames?
while ne # Yes
call popCtlFiles # Clean up
loop
@@ -304,6 +309,11 @@
call popOutFiles # Clean up
loop
do
+ null (EnvErrFrames) # Open error frames?
+ while nz # Yes
+ call popErrFiles # Clean up
+ loop
+ do
null (EnvCtlFrames) # Open control frames?
while nz # Yes
call popCtlFiles # Clean up
diff --git a/src64/glob.l b/src64/glob.l
@@ -505,8 +505,9 @@
initFun NIL "load" doLoad
initFun NIL "in" doIn
initFun NIL "out" doOut
- initFun NIL "pipe" doPipe
+ initFun NIL "err" doErr
initFun NIL "ctl" doCtl
+ initFun NIL "pipe" doPipe
initFun NIL "open" doOpen
initFun NIL "close" doClose
initFun NIL "echo" doEcho
@@ -581,7 +582,8 @@
: EnvBind word 0 # <III> Bind frames (first item in Env)
: EnvInFrames word 0 # <IV> Input frames
: EnvOutFrames word 0 # <V> Output frames
-: EnvCtlFrames word 0 # <VI> Control frames
+: EnvErrFrames word 0 # <VI> Error frames
+: EnvCtlFrames word 0 # <VII> Control frames
: EnvArgs word 0 # Varargs frame
: EnvNext word 0 # Next vararg
: EnvCls word 0 # Method class
diff --git a/src64/io.l b/src64/io.l
@@ -1617,6 +1617,48 @@
end
ret
+(code 'erOpenEXY)
+ num E # Need symbol
+ jnz symErrEX
+ sym E
+ jz symErrEX
+ cc dup(2) # Duplicate current stderr
+ ld (Y I) A # Save it
+ cmp E Nil # Use current output channel?
+ if eq # Yes
+ cc dup(((OutFile))) # Duplicate 'fd'
+ ld C A # Keep in C
+ else
+ push Z
+ call pathStringE_SZ # File name
+ do
+ ld B (S) # First char
+ cmp B (char "+") # Plus?
+ if eq # Yes
+ cc open(&(S 1) (| O_APPEND O_CREAT O_WRONLY) (oct "0666"))
+ else
+ cc open(S (| O_CREAT O_TRUNC O_WRONLY) (oct "0666"))
+ end
+ nul4 # OK?
+ while s # No
+ call errno_A
+ cmp A EINTR # Interrupted?
+ jne openErrEX # No
+ null (Signal) # Signal?
+ if nz # Yes
+ call sighandlerX
+ end
+ loop
+ ld S Z # Drop buffer
+ pop Z
+ ld C A # Keep 'fd' in C
+ call closeOnExecAX
+ end
+ cc dup2(C 2) # Dup 'fd' to STDERR_FILENO
+ ld A C
+ call closeAX
+ ret
+
(code 'ctOpenEXY)
num E # Need symbol
jnz symErrEX
@@ -1800,6 +1842,11 @@
ld (EnvOutFrames) Y # Link frame
ret
+(code 'pushErrFilesY)
+ ld (Y) (EnvErrFrames) # Set link
+ ld (EnvErrFrames) Y # Link frame
+ ret
+
(code 'pushCtlFilesY)
ld (Y) (EnvCtlFrames) # Set link
ld (EnvCtlFrames) Y # Link frame
@@ -1896,6 +1943,13 @@
ld (OutFile) A # Set OutFile
ret
+(code 'popErrFiles) # C
+ ld C (EnvErrFrames) # Get ErrFrames
+ cc dup2((C I) 2) # Restore stderr
+ cc close((C I)) # Close 'fd'
+ ld (EnvErrFrames) ((EnvErrFrames)) # Restore ErrFrames
+ ret
+
(code 'popCtlFiles) # C
ld C (EnvCtlFrames) # Get CtlFrames
null (C I) # 'fd' >= 0?
@@ -4139,6 +4193,46 @@
pop X
ret
+# (err 'sym . prg) -> any
+(code 'doErr 2)
+ push X
+ push Y
+ ld X E # Expression in X
+ ld E (E CDR)
+ ld E (E) # Eval 'any'
+ eval
+ sub S II # ErrFrame
+ ld Y S
+ call erOpenEXY
+ call pushErrFilesY
+ ld X ((X CDR) CDR) # Get 'prg'
+ prog X
+ call popErrFiles
+ add S II # Drop ErrFrame
+ pop Y
+ pop X
+ ret
+
+# (ctl 'sym . prg) -> any
+(code 'doCtl 2)
+ push X
+ push Y
+ ld X E # Expression in X
+ ld E (E CDR)
+ ld E (E) # Eval 'any'
+ eval
+ sub S II # CtlFrame
+ ld Y S
+ call ctOpenEXY
+ call pushCtlFilesY
+ ld X ((X CDR) CDR) # Get 'prg'
+ prog X
+ call popCtlFiles
+ add S II # Drop CtlFrame
+ pop Y
+ pop X
+ ret
+
# (pipe exe) -> cnt
# (pipe exe . prg) -> any
(code 'doPipe 2)
@@ -4203,28 +4297,6 @@
pop X
ret
-# (ctl 'sym . prg) -> any
-(code 'doCtl 2)
- push X
- push Y
- ld X E # Expression in X
- ld E (E CDR)
- ld E (E) # Eval 'any'
- eval
- push A # CtlFrame
- push A
- ld Y S
- call ctOpenEXY
- call pushCtlFilesY
- ld X ((X CDR) CDR) # Get 'prg'
- prog X
- call popCtlFiles
- pop A # Drop CtlFrame
- pop A
- pop Y
- pop X
- ret
-
# (open 'sym) -> cnt | NIL
(code 'doOpen 2)
push X
diff --git a/src64/version.l b/src64/version.l
@@ -1,6 +1,6 @@
-# 07mar11abu
+# 09mar11abu
# (c) Software Lab. Alexander Burger
-(de *Version 3 0 5 21)
+(de *Version 3 0 5 22)
# vi:et:ts=3:sw=3
diff --git a/test/src/io.l b/test/src/io.l
@@ -112,7 +112,7 @@
(test 6 (load "-* 1 2 3"))
-### in out ###
+### in out err ###
(out (tmp "file")
(println 123)
(println 'abc)
@@ -124,6 +124,11 @@
(test 'abc (in -1 (read))) )
(test '(d e f) (read)) )
+(let Err (tmp "err")
+ (test 1 (err Err (msg 1)))
+ (test 2 (err (pack "+" Err) (msg 2)))
+ (test "1^J2^J" (in Err (till NIL T))) )
+
### pipe ###
(test 123 (pipe (println 123) (read)))
