commit 17e6baf1d13ca8814198bdfe71e58b38c7d64b12
parent 4822d6bdf946f17482900bacb4bd53110eb171f3
Author: Alexander Burger <abu@software-lab.de>
Date: Wed, 5 Oct 2011 15:02:36 +0200
'open' optional 'flg' argument
Diffstat:
9 files changed, 68 insertions(+), 59 deletions(-)
diff --git a/CHANGES b/CHANGES
@@ -1,4 +1,5 @@
* XXdec11 picoLisp-3.0.9
+ 'open' optional 'flg' argument
* 30sep11 picoLisp-3.0.8
'load' preserves current namespace
diff --git a/doc/refO.html b/doc/refO.html
@@ -176,13 +176,15 @@ href="refO.html#one">one</a></code>.
-> NIL
</code></pre>
-<dt><a name="open"><code>(open 'any) -> cnt | NIL</code></a>
-<dd>Opens the file with the name <code>any</code> in read/write mode, and
-returns a file descriptor <code>cnt</code> (or <code>NIL</code> on error). A
-leading "<code>@</code>" character in <code>any</code> is substituted with the
+<dt><a name="open"><code>(open 'any ['flg]) -> cnt | NIL</code></a>
+<dd>Opens the file with the name <code>any</code> in read/write mode (or
+read-only if <code>flg</code> is non-<code>NIL</code>), and returns a file
+descriptor <code>cnt</code> (or <code>NIL</code> on error). A leading
+"<code>@</code>" character in <code>any</code> is substituted with the
<u>PicoLisp Home Directory</u>, as it was remembered during interpreter startup.
-If the file does not exist, it is created. The file descriptor can be used in
-subsequent calls to <code><a href="refI.html#in">in</a></code> and <code><a
+If <code>flg</code> is <code>NIL</code> and the file does not exist, it is
+created. The file descriptor can be used in subsequent calls to <code><a
+href="refI.html#in">in</a></code> and <code><a
href="refO.html#out">out</a></code>. See also <code><a
href="refC.html#close">close</a></code> and <code><a
href="refP.html#poll">poll</a></code>.
diff --git a/ersatz/picolisp.jar b/ersatz/picolisp.jar
Binary files differ.
diff --git a/lib/tags b/lib/tags
@@ -87,7 +87,7 @@ chop (1208 . "@src64/sym.l")
circ (816 . "@src64/subr.l")
circ? (2402 . "@src64/subr.l")
clip (1799 . "@src64/subr.l")
-close (4373 . "@src64/io.l")
+close (4378 . "@src64/io.l")
cmd (2912 . "@src64/main.l")
cnt (1413 . "@src64/apply.l")
co (2540 . "@src64/flow.l")
@@ -115,14 +115,14 @@ dir (2843 . "@src64/main.l")
dm (542 . "@src64/flow.l")
do (2133 . "@src64/flow.l")
e (2914 . "@src64/flow.l")
-echo (4404 . "@src64/io.l")
+echo (4409 . "@src64/io.l")
env (606 . "@src64/main.l")
eof (3524 . "@src64/io.l")
eol (3515 . "@src64/io.l")
err (4231 . "@src64/io.l")
errno (1374 . "@src64/main.l")
eval (175 . "@src64/flow.l")
-ext (5132 . "@src64/io.l")
+ext (5137 . "@src64/io.l")
ext? (1149 . "@src64/sym.l")
extern (1015 . "@src64/sym.l")
extra (1261 . "@src64/flow.l")
@@ -137,7 +137,7 @@ find (1322 . "@src64/apply.l")
fish (1613 . "@src64/apply.l")
flg? (2445 . "@src64/subr.l")
flip (1699 . "@src64/subr.l")
-flush (5107 . "@src64/io.l")
+flush (5112 . "@src64/io.l")
fold (3489 . "@src64/sym.l")
for (2222 . "@src64/flow.l")
fork (3256 . "@src64/flow.l")
@@ -254,13 +254,13 @@ poll (3320 . "@src64/io.l")
pool (648 . "@src64/db.l")
pop (1887 . "@src64/sym.l")
port (5 . "@src64/net.l")
-pr (5215 . "@src64/io.l")
+pr (5220 . "@src64/io.l")
pre? (1525 . "@src64/sym.l")
-prin (5031 . "@src64/io.l")
-prinl (5045 . "@src64/io.l")
-print (5071 . "@src64/io.l")
-println (5102 . "@src64/io.l")
-printsp (5087 . "@src64/io.l")
+prin (5036 . "@src64/io.l")
+prinl (5050 . "@src64/io.l")
+print (5076 . "@src64/io.l")
+println (5107 . "@src64/io.l")
+printsp (5092 . "@src64/io.l")
prior (2713 . "@src64/subr.l")
prog (1752 . "@src64/flow.l")
prog1 (1760 . "@src64/flow.l")
@@ -280,12 +280,12 @@ rand (3003 . "@src64/big.l")
range (997 . "@src64/subr.l")
rank (3033 . "@src64/subr.l")
raw (449 . "@src64/main.l")
-rd (5149 . "@src64/io.l")
+rd (5154 . "@src64/io.l")
read (2656 . "@src64/io.l")
replace (1499 . "@src64/subr.l")
rest (2339 . "@src64/main.l")
reverse (1678 . "@src64/subr.l")
-rewind (5115 . "@src64/io.l")
+rewind (5120 . "@src64/io.l")
rollback (1889 . "@src64/db.l")
rot (848 . "@src64/subr.l")
run (306 . "@src64/flow.l")
@@ -301,7 +301,7 @@ size (2806 . "@src64/subr.l")
skip (3501 . "@src64/io.l")
sort (3962 . "@src64/subr.l")
sp? (719 . "@src64/sym.l")
-space (5049 . "@src64/io.l")
+space (5054 . "@src64/io.l")
split (1592 . "@src64/subr.l")
stack (555 . "@src64/main.l")
state (2001 . "@src64/flow.l")
@@ -345,7 +345,7 @@ when (1876 . "@src64/flow.l")
while (2053 . "@src64/flow.l")
wipe (3236 . "@src64/sym.l")
with (1324 . "@src64/flow.l")
-wr (5232 . "@src64/io.l")
+wr (5237 . "@src64/io.l")
xchg (1652 . "@src64/sym.l")
xor (1693 . "@src64/flow.l")
x| (2887 . "@src64/big.l")
diff --git a/src/io.c b/src/io.c
@@ -1,4 +1,4 @@
-/* 18aug11abu
+/* 05oct11abu
* (c) Software Lab. Alexander Burger
*/
@@ -2171,14 +2171,15 @@ any doPipe(any ex) {
return x;
}
-// (open 'any) -> cnt | NIL
+// (open 'any ['flg]) -> cnt | NIL
any doOpen(any ex) {
any x = evSym(cdr(ex));
char nm[pathSize(x)];
int fd;
pathString(x, nm);
- while ((fd = open(nm, O_CREAT|O_RDWR, 0666)) < 0) {
+ x = caddr(ex);
+ while ((fd = open(nm, isNil(EVAL(x))? O_CREAT|O_RDWR:O_RDONLY, 0666)) < 0) {
if (errno != EINTR)
return Nil;
if (*Signal)
diff --git a/src/vers.h b/src/vers.h
@@ -1 +1 @@
-static byte Version[4] = {3,0,8,1};
+static byte Version[4] = {3,0,8,2};
diff --git a/src64/io.l b/src64/io.l
@@ -1,4 +1,4 @@
-# 29sep11abu
+# 05oct11abu
# (c) Software Lab. Alexander Burger
# Close file descriptor
@@ -4331,7 +4331,7 @@
pop X
ret
-# (open 'sym) -> cnt | NIL
+# (open 'any ['flg]) -> cnt | NIL
(code 'doOpen 2)
push X
push Z
@@ -4339,8 +4339,13 @@
ld E ((E CDR)) # Get arg
call evSymE_E # Evaluate to a symbol
call pathStringE_SZ # Write to stack buffer
+ ld E (((X CDR) CDR)) # Get flg
+ eval
+ cmp E Nil # Read-only?
+ ldnz E O_RDONLY # Yes
+ ldz E (| O_CREAT O_RDWR) # No
do
- cc open(S (| O_CREAT O_RDWR) (oct "0666")) # Try to open
+ cc open(S E (oct "0666")) # Try to open
nul4 # OK?
while s # No
call errno_A
diff --git a/src64/tags b/src64/tags
@@ -617,7 +617,7 @@ doChop ./sym.l 1208
doCirc ./subr.l 816
doCircQ ./subr.l 2402
doClip ./subr.l 1799
-doClose ./io.l 4373
+doClose ./io.l 4378
doCmd ./main.l 2912
doCnt ./apply.l 1413
doCo ./flow.l 2540
@@ -647,7 +647,7 @@ doDiv ./big.l 2513
doDm ./flow.l 542
doDo ./flow.l 2133
doE ./flow.l 2914
-doEcho ./io.l 4404
+doEcho ./io.l 4409
doEnv ./main.l 606
doEof ./io.l 3524
doEol ./io.l 3515
@@ -658,7 +658,7 @@ doEqual ./subr.l 2115
doErr ./io.l 4231
doErrno ./main.l 1374
doEval ./flow.l 175
-doExt ./io.l 5132
+doExt ./io.l 5137
doExtQ ./sym.l 1149
doExtern ./sym.l 1015
doExtra ./flow.l 1261
@@ -673,7 +673,7 @@ doFind ./apply.l 1322
doFish ./apply.l 1613
doFlgQ ./subr.l 2445
doFlip ./subr.l 1699
-doFlush ./io.l 5107
+doFlush ./io.l 5112
doFold ./sym.l 3489
doFor ./flow.l 2222
doFork ./flow.l 3256
@@ -798,13 +798,13 @@ doPoll ./io.l 3320
doPool ./db.l 648
doPop ./sym.l 1887
doPort ./net.l 5
-doPr ./io.l 5215
+doPr ./io.l 5220
doPreQ ./sym.l 1525
-doPrin ./io.l 5031
-doPrinl ./io.l 5045
-doPrint ./io.l 5071
-doPrintln ./io.l 5102
-doPrintsp ./io.l 5087
+doPrin ./io.l 5036
+doPrinl ./io.l 5050
+doPrint ./io.l 5076
+doPrintln ./io.l 5107
+doPrintsp ./io.l 5092
doPrior ./subr.l 2713
doProg ./flow.l 1752
doProg1 ./flow.l 1760
@@ -825,13 +825,13 @@ doRand ./big.l 3003
doRange ./subr.l 997
doRank ./subr.l 3033
doRaw ./main.l 449
-doRd ./io.l 5149
+doRd ./io.l 5154
doRead ./io.l 2656
doRem ./big.l 2572
doReplace ./subr.l 1499
doRest ./main.l 2339
doReverse ./subr.l 1678
-doRewind ./io.l 5115
+doRewind ./io.l 5120
doRollback ./db.l 1889
doRot ./subr.l 848
doRun ./flow.l 306
@@ -850,7 +850,7 @@ doSize ./subr.l 2806
doSkip ./io.l 3501
doSort ./subr.l 3962
doSpQ ./sym.l 719
-doSpace ./io.l 5049
+doSpace ./io.l 5054
doSplit ./subr.l 1592
doStack ./main.l 555
doState ./flow.l 2001
@@ -896,7 +896,7 @@ doWhen ./flow.l 1876
doWhile ./flow.l 2053
doWipe ./sym.l 3236
doWith ./flow.l 1324
-doWr ./io.l 5232
+doWr ./io.l 5237
doXchg ./sym.l 1652
doXor ./flow.l 1693
doYield ./flow.l 2709
@@ -1030,7 +1030,7 @@ needVarAX ./err.l 346
needVarEX ./err.l 356
newBlock_X ./db.l 449
newIdEX_X ./db.l 492
-newline ./io.l 4660
+newline ./io.l 4665
noFdErrX ./err.l 529
nonblockingA_A ./io.l 51
numErrAX ./err.l 412
@@ -1038,13 +1038,13 @@ numErrEX ./err.l 414
oct3C_CA ./db.l 180
openErrEX ./err.l 500
oruAE_A ./big.l 394
-outAoA ./io.l 4709
-outNameE ./io.l 4733
-outNumE ./io.l 4669
-outOctA ./io.l 4696
-outStringC ./io.l 4723
-outStringS ./io.l 4721
-outWordA ./io.l 4676
+outAoA ./io.l 4714
+outNameE ./io.l 4738
+outNumE ./io.l 4674
+outOctA ./io.l 4701
+outStringC ./io.l 4728
+outStringS ./io.l 4726
+outWordA ./io.l 4681
packAoACX_CX ./db.l 108
packECX_CX ./sym.l 1292
packExtNmX_E ./db.l 87
@@ -1060,14 +1060,14 @@ popOutFiles ./io.l 1914
prByteCEXY ./io.l 680
prCntCE ./io.l 703
prE ./io.l 728
-prExtNmX ./io.l 4688
-prNameX ./io.l 4741
+prExtNmX ./io.l 4693
+prNameX ./io.l 4746
prTellEZ ./io.l 722
preCEXY_F ./sym.l 1459
-prinE ./io.l 4976
-prinE_E ./io.l 4970
-printE ./io.l 4757
-printE_E ./io.l 4751
+prinE ./io.l 4981
+prinE_E ./io.l 4975
+printE ./io.l 4762
+printE_E ./io.l 4756
propEC_E ./sym.l 2734
protErrEX ./err.l 386
pushCtlFilesY ./io.l 1858
@@ -1077,7 +1077,7 @@ pushOutFilesY ./io.l 1842
putACE ./sym.l 2480
putBlockBZ ./db.l 609
putSrcEC_E ./flow.l 25
-putStdoutB ./io.l 4617
+putStdoutB ./io.l 4622
putStringB ./main.l 2236
putTellBZ ./io.l 996
putUdpBZ ./net.l 328
@@ -1140,7 +1140,7 @@ sizeCE_C ./subr.l 2926
skipC_A ./io.l 2007
slowNbC_FA ./io.l 207
slowZ_F ./io.l 185
-space ./io.l 4664
+space ./io.l 4669
stdinByte_A ./io.l 425
stkErr ./err.l 395
stkErrE ./err.l 397
diff --git a/src64/version.l b/src64/version.l
@@ -1,6 +1,6 @@
-# 30sep11abu
+# 05oct11abu
# (c) Software Lab. Alexander Burger
-(de *Version 3 0 8 1)
+(de *Version 3 0 8 2)
# vi:et:ts=3:sw=3
