commit 60cdeea743c249a5b737a683825a490c0ef0ee37
parent 224085c7f69433118e5b0b562f368d1987824fa1
Author: Commit-Bot <unknown>
Date: Mon, 30 Aug 2010 14:59:20 +0000
Automatic commit from picoLisp.tgz, From: Mon, 30 Aug 2010 14:59:20 GMT
Diffstat:
8 files changed, 70 insertions(+), 65 deletions(-)
diff --git a/doc/refD.html b/doc/refD.html
@@ -210,6 +210,7 @@ month and day is returned. When called with three numbers (or a list of three
numbers) for the year, month and day, the corresponding date is returned (or
<code>NIL</code> if they do not represent a legal date). See also <code><a
href="refT.html#time">time</a></code>, <code><a
+href="refS.html#stamp">stamp</a></code>, <code><a
href="ref_.html#$dat">$dat</a></code>, <code><a
href="refD.html#dat$">dat$</a></code>, <code><a
href="refD.html#datSym">datSym</a></code>, <code><a
diff --git a/doc/refS.html b/doc/refS.html
@@ -618,11 +618,12 @@ Stack overflow
-> ("routine2" "routine" . 4)
</code></pre>
-<dt><a name="stamp"><code>(stamp ['dat 'tim]) -> sym</code></a>
+<dt><a name="stamp"><code>(stamp ['dat 'tim]|['T]) -> sym</code></a>
<dd>Returns a date-time string in the form "YYYY-MM-DD HH:MM:SS". If
-<code>dat</code> and/or <code>tim</code> is missing, the current date or time is
-used. See also <code><a href="refD.html#date">date</a></code> and <code><a
-href="refT.html#time">time</a></code>.
+<code>dat</code> and <code>tim</code> is missing, the current date and time is
+used. If <code>T</code> is passed, the current Coordinated Universal Time (UTC)
+is used instead. See also <code><a href="refD.html#date">date</a></code> and
+<code><a href="refT.html#time">time</a></code>.
<pre><code>
: (stamp)
diff --git a/doc/refT.html b/doc/refT.html
@@ -362,6 +362,8 @@ corresponding hour, minute and second is returned. When called with two or three
numbers (or a list of two or three numbers) for the hour, minute (and optionally
the second), the corresponding time value is returned (or <code>NIL</code> if
they do not represent a legal time). See also <code><a
+href="refD.html#date">date</a></code>, <code><a
+href="refS.html#stamp">stamp</a></code>, <code><a
href="refU.html#usec">usec</a></code>, <code><a
href="refT.html#tim$">tim$</a></code> and <code><a
href="ref_.html#$tim">$tim</a></code>.
diff --git a/doc/tut.html b/doc/tut.html
@@ -833,7 +833,8 @@ href="refS.html#stamp">stamp</a></code> system function.
<pre><code>
: (pp 'stamp)
(de stamp (Dat Tim)
- (default Dat (date) Tim (time T))
+ (and (=T Dat) (setq Dat (date T)))
+ (default Dat (date) Tim (time T))
(pack (dat$ Dat "-") " " (tim$ Tim T)) )
-> stamp
</code></pre>
@@ -842,15 +843,17 @@ href="refS.html#stamp">stamp</a></code> system function.
: (debug 'stamp) # Debug it
-> T
: (stamp) # Call it again
-(default Dat (date) Tim (time T)) # stopped at first expression
+(and (=T Dat) (setq Dat (date T))) # stopped at first expression
! # ENTER
-(pack (dat$ Dat "-") " " (tim$ ... # second expression
+(default Dat (date) Tim (time T)) # second expression
+! # ENTER
+(pack (dat$ Dat "-") " " (tim$ ... # third expression
! Tim # inspect 'Tim' variable
-> 41908
! (time Tim) # convert it
-> (11 38 28)
! # ENTER
--> "2004-10-29 11:38:28" # done, as there are only 2 expressions
+-> "2004-10-29 11:38:28" # done, as there are only 3 expressions
</code></pre>
<p>Now we execute it again, but this time we want to look at what's happening
@@ -858,6 +861,8 @@ inside the second expression.
<pre><code>
: (stamp) # Call it again
+(and (=T Dat) (setq Dat (date T)))
+! # ENTER
(default Dat (date) Tim (time T))
! # ENTER
(pack (dat$ Dat "-") " " (tim$ ... # here we want to look closer
@@ -881,6 +886,7 @@ pretty-print it:
<pre><code>
: (pp 'stamp)
(de stamp (Dat Tim)
+ (! and (=T Dat) (setq Dat (date T)))
(! default Dat (date) Tim (time T))
(! pack
(! dat$ Dat "-")
diff --git a/lib/misc.l b/lib/misc.l
@@ -1,4 +1,4 @@
-# 09aug10abu
+# 30aug10abu
# (c) Software Lab. Alexander Burger
# *Allow *Tmp
@@ -381,7 +381,8 @@
(or (format (caddr S)) 0) ) ) )
(de stamp (Dat Tim)
- (default Dat (date) Tim (time T))
+ (and (=T Dat) (setq Dat (date T)))
+ (default Dat (date) Tim (time T))
(pack (dat$ Dat "-") " " (tim$ Tim T)) )
### I/O ###
diff --git a/lib/tags b/lib/tags
@@ -90,7 +90,7 @@ close (4182 . "@src64/io.l")
cmd (2846 . "@src64/main.l")
cnt (1297 . "@src64/apply.l")
co (2566 . "@src64/flow.l")
-commit (1503 . "@src64/db.l")
+commit (1497 . "@src64/db.l")
con (725 . "@src64/subr.l")
conc (781 . "@src64/subr.l")
cond (1938 . "@src64/flow.l")
@@ -101,7 +101,7 @@ ctl (4122 . "@src64/io.l")
ctty (2644 . "@src64/main.l")
cut (1797 . "@src64/sym.l")
date (2358 . "@src64/main.l")
-dbck (2092 . "@src64/db.l")
+dbck (2086 . "@src64/db.l")
de (549 . "@src64/flow.l")
dec (2323 . "@src64/big.l")
def (473 . "@src64/flow.l")
@@ -140,7 +140,7 @@ fold (3345 . "@src64/sym.l")
for (2247 . "@src64/flow.l")
fork (3269 . "@src64/flow.l")
format (2089 . "@src64/big.l")
-free (2034 . "@src64/db.l")
+free (2028 . "@src64/db.l")
from (3372 . "@src64/io.l")
full (1066 . "@src64/subr.l")
fun? (734 . "@src64/sym.l")
@@ -155,7 +155,7 @@ head (1807 . "@src64/subr.l")
heap (542 . "@src64/main.l")
hear (3094 . "@src64/io.l")
host (184 . "@src64/net.l")
-id (1034 . "@src64/db.l")
+id (1028 . "@src64/db.l")
idx (2037 . "@src64/sym.l")
if (1824 . "@src64/flow.l")
if2 (1843 . "@src64/flow.l")
@@ -168,14 +168,14 @@ intern (875 . "@src64/sym.l")
ipid (3214 . "@src64/flow.l")
isa (978 . "@src64/flow.l")
job (1448 . "@src64/flow.l")
-journal (977 . "@src64/db.l")
+journal (971 . "@src64/db.l")
key (3203 . "@src64/io.l")
kill (3246 . "@src64/flow.l")
last (2031 . "@src64/subr.l")
length (2687 . "@src64/subr.l")
let (1498 . "@src64/flow.l")
let? (1559 . "@src64/flow.l")
-lieu (1163 . "@src64/db.l")
+lieu (1157 . "@src64/db.l")
line (3528 . "@src64/io.l")
lines (3681 . "@src64/io.l")
link (1163 . "@src64/subr.l")
@@ -184,7 +184,7 @@ list (887 . "@src64/subr.l")
listen (151 . "@src64/net.l")
lit (183 . "@src64/flow.l")
load (3995 . "@src64/io.l")
-lock (1191 . "@src64/db.l")
+lock (1185 . "@src64/db.l")
loop (2190 . "@src64/flow.l")
low? (3217 . "@src64/sym.l")
lowc (3247 . "@src64/sym.l")
@@ -200,7 +200,7 @@ mapcar (871 . "@src64/apply.l")
mapcon (925 . "@src64/apply.l")
maplist (817 . "@src64/apply.l")
maps (674 . "@src64/apply.l")
-mark (1952 . "@src64/db.l")
+mark (1946 . "@src64/db.l")
match (3062 . "@src64/subr.l")
max (2314 . "@src64/subr.l")
maxi (1395 . "@src64/apply.l")
@@ -248,7 +248,7 @@ pick (1253 . "@src64/apply.l")
pid (157 . "@src64/flow.l")
pipe (4059 . "@src64/io.l")
poll (3156 . "@src64/io.l")
-pool (657 . "@src64/db.l")
+pool (651 . "@src64/db.l")
pop (1773 . "@src64/sym.l")
port (5 . "@src64/net.l")
pr (5033 . "@src64/io.l")
@@ -282,7 +282,7 @@ replace (1490 . "@src64/subr.l")
rest (2272 . "@src64/main.l")
reverse (1665 . "@src64/subr.l")
rewind (4925 . "@src64/io.l")
-rollback (1885 . "@src64/db.l")
+rollback (1879 . "@src64/db.l")
rot (848 . "@src64/subr.l")
rpc (5066 . "@src64/io.l")
run (331 . "@src64/flow.l")
@@ -290,7 +290,7 @@ sect (2515 . "@src64/subr.l")
seed (2944 . "@src64/big.l")
seek (1159 . "@src64/apply.l")
send (1150 . "@src64/flow.l")
-seq (1090 . "@src64/db.l")
+seq (1084 . "@src64/db.l")
set (1482 . "@src64/sym.l")
setq (1515 . "@src64/sym.l")
sigio (503 . "@src64/main.l")
diff --git a/src/io.c b/src/io.c
@@ -1,4 +1,4 @@
-/* 23aug10abu
+/* 30aug10abu
* (c) Software Lab. Alexander Burger
*/
@@ -2721,7 +2721,7 @@ static pid_t tryLock(off_t n, off_t len) {
}
if (errno != EINTR && errno != EACCES && errno != EAGAIN)
lockErr();
- fl.l_type = F_WRLCK; //??
+ // fl.l_type = F_WRLCK;
fl.l_whence = SEEK_SET;
fl.l_start = n;
fl.l_len = len;
diff --git a/src64/db.l b/src64/db.l
@@ -1,4 +1,4 @@
-# 19may10abu
+# 30aug10abu
# (c) Software Lab. Alexander Burger
# 6 bytes in little endian format
@@ -254,53 +254,47 @@
(code 'rdLockDb)
cmp (Solo) TSym # Already locked whole DB?
- if ne # No
- ld A (| F_RDLCK (hex "10000")) # Read lock, length 1
- ld C ((DbFiles)) # Descriptor of first file
- jmp lockFileAC
- end
- ret
+ jeq ret # Yes
+ ld A (| F_RDLCK (hex "10000")) # Read lock, length 1
+ ld C ((DbFiles)) # Descriptor of first file
+ jmp lockFileAC
(code 'wrLockDb)
cmp (Solo) TSym # Already locked whole DB?
- if ne # No
- ld A (| F_WRLCK (hex "10000")) # Write lock, length 1
- ld C ((DbFiles)) # Descriptor of first file
- jmp lockFileAC
- end
- ret
+ jeq ret # Yes
+ ld A (| F_WRLCK (hex "10000")) # Write lock, length 1
+ ld C ((DbFiles)) # Descriptor of first file
+ jmp lockFileAC
(code 'rwUnlockDbA)
cmp (Solo) TSym # Already locked whole DB?
- if ne # No
- null A # Length zero?
- if z # Yes
- push X
- push Y
- ld X (DbFiles) # Iterate DB files
- ld Y (DBs) # Count
- do
- sub Y VIII # Done?
- while ne # No
- add X VIII # Skip first, increment by sizeof(dbFile)
- nul (X (+ IV 0)) # This one locked?
- if nz # Yes
- ld A (| F_UNLCK (hex "00000")) # Unlock, length 0
- ld C (X) # File descriptor
- call unLockFileAC
- set (X (+ IV 0)) 0 # Clear lock entry
- end
- loop
- pop Y
- pop X
- ld (Solo) ZERO # Reset solo mode
- ld A 0 # Length zero again
- end
- or A F_UNLCK
- ld C ((DbFiles)) # Unlock first file
- call unLockFileAC
+ jeq ret # Yes
+ null A # Length zero?
+ if z # Yes
+ push X
+ push Y
+ ld X (DbFiles) # Iterate DB files
+ ld Y (DBs) # Count
+ do
+ sub Y VIII # Done?
+ while ne # No
+ add X VIII # Skip first, increment by sizeof(dbFile)
+ nul (X (+ IV 0)) # This one locked?
+ if nz # Yes
+ ld A (| F_UNLCK (hex "00000")) # Unlock, length 0
+ ld C (X) # File descriptor
+ call unLockFileAC
+ set (X (+ IV 0)) 0 # Clear lock entry
+ end
+ loop
+ pop Y
+ pop X
+ ld (Solo) ZERO # Reset solo mode
+ ld A 0 # Length zero again
end
- ret
+ or A F_UNLCK
+ ld C ((DbFiles)) # Unlock first file
+ jmp unLockFileAC
(code 'tryLockCE_FA)
do
@@ -319,9 +313,9 @@
cmp (Solo) TSym # Already locked whole DB?
if ne # No
ld (Solo) Nil # Clear solo mode
+ setz
end
end
- setz
ret # 'z'
end
call errno_A
