commit 83142b787d6feaa59abd4eec316102bee02996a5
parent 4af5880d55557e18abc109bf09da16cd6bd8fa59
Author: Commit-Bot <unknown>
Date: Fri, 10 Sep 2010 17:47:57 +0000
Automatic commit from picoLisp.tgz, From: Fri, 10 Sep 2010 17:47:57 GMT
Diffstat:
| M | lib/tags | | | 100 | ++++++++++++++++++++++++++++++++++++++++---------------------------------------- |
| M | src/io.c | | | 15 | +++++++++------ |
| M | src64/db.l | | | 43 | ++++++++++++++++++++++--------------------- |
| M | src64/io.l | | | 51 | +++++++++++++++++++++++++-------------------------- |
4 files changed, 106 insertions(+), 103 deletions(-)
diff --git a/lib/tags b/lib/tags
@@ -29,7 +29,7 @@ adr (613 . "@src64/main.l")
alarm (487 . "@src64/main.l")
all (772 . "@src64/sym.l")
and (1643 . "@src64/flow.l")
-any (3779 . "@src64/io.l")
+any (3778 . "@src64/io.l")
append (1329 . "@src64/subr.l")
apply (597 . "@src64/apply.l")
arg (2243 . "@src64/main.l")
@@ -82,26 +82,26 @@ cdddr (245 . "@src64/subr.l")
cddr (79 . "@src64/subr.l")
cdr (17 . "@src64/subr.l")
chain (1132 . "@src64/subr.l")
-char (3261 . "@src64/io.l")
+char (3260 . "@src64/io.l")
chop (1093 . "@src64/sym.l")
circ (816 . "@src64/subr.l")
clip (1786 . "@src64/subr.l")
-close (4167 . "@src64/io.l")
+close (4166 . "@src64/io.l")
cmd (2846 . "@src64/main.l")
cnt (1297 . "@src64/apply.l")
co (2566 . "@src64/flow.l")
-commit (1493 . "@src64/db.l")
+commit (1494 . "@src64/db.l")
con (725 . "@src64/subr.l")
conc (781 . "@src64/subr.l")
cond (1938 . "@src64/flow.l")
connect (201 . "@src64/net.l")
cons (747 . "@src64/subr.l")
copy (1216 . "@src64/subr.l")
-ctl (4107 . "@src64/io.l")
+ctl (4106 . "@src64/io.l")
ctty (2644 . "@src64/main.l")
cut (1797 . "@src64/sym.l")
date (2358 . "@src64/main.l")
-dbck (2086 . "@src64/db.l")
+dbck (2087 . "@src64/db.l")
de (549 . "@src64/flow.l")
dec (2323 . "@src64/big.l")
def (473 . "@src64/flow.l")
@@ -114,13 +114,13 @@ dir (2777 . "@src64/main.l")
dm (561 . "@src64/flow.l")
do (2158 . "@src64/flow.l")
e (2932 . "@src64/flow.l")
-echo (4198 . "@src64/io.l")
+echo (4197 . "@src64/io.l")
env (625 . "@src64/main.l")
-eof (3338 . "@src64/io.l")
-eol (3329 . "@src64/io.l")
+eof (3337 . "@src64/io.l")
+eol (3328 . "@src64/io.l")
errno (1358 . "@src64/main.l")
eval (208 . "@src64/flow.l")
-ext (4927 . "@src64/io.l")
+ext (4926 . "@src64/io.l")
ext? (1034 . "@src64/sym.l")
extern (900 . "@src64/sym.l")
extra (1284 . "@src64/flow.l")
@@ -135,13 +135,13 @@ find (1206 . "@src64/apply.l")
fish (1497 . "@src64/apply.l")
flg? (2419 . "@src64/subr.l")
flip (1686 . "@src64/subr.l")
-flush (4902 . "@src64/io.l")
+flush (4901 . "@src64/io.l")
fold (3343 . "@src64/sym.l")
for (2247 . "@src64/flow.l")
fork (3276 . "@src64/flow.l")
format (2089 . "@src64/big.l")
-free (2028 . "@src64/db.l")
-from (3357 . "@src64/io.l")
+free (2029 . "@src64/db.l")
+from (3356 . "@src64/io.l")
full (1066 . "@src64/subr.l")
fun? (734 . "@src64/sym.l")
gc (439 . "@src64/gc.l")
@@ -153,14 +153,14 @@ glue (1234 . "@src64/sym.l")
gt0 (2702 . "@src64/big.l")
head (1807 . "@src64/subr.l")
heap (542 . "@src64/main.l")
-hear (3079 . "@src64/io.l")
+hear (3078 . "@src64/io.l")
host (184 . "@src64/net.l")
-id (1024 . "@src64/db.l")
+id (1025 . "@src64/db.l")
idx (2037 . "@src64/sym.l")
if (1824 . "@src64/flow.l")
if2 (1843 . "@src64/flow.l")
ifn (1884 . "@src64/flow.l")
-in (4003 . "@src64/io.l")
+in (4002 . "@src64/io.l")
inc (2256 . "@src64/big.l")
index (2611 . "@src64/subr.l")
info (2681 . "@src64/main.l")
@@ -168,23 +168,23 @@ intern (875 . "@src64/sym.l")
ipid (3221 . "@src64/flow.l")
isa (978 . "@src64/flow.l")
job (1448 . "@src64/flow.l")
-journal (967 . "@src64/db.l")
-key (3188 . "@src64/io.l")
+journal (968 . "@src64/db.l")
+key (3187 . "@src64/io.l")
kill (3253 . "@src64/flow.l")
last (2031 . "@src64/subr.l")
length (2687 . "@src64/subr.l")
let (1498 . "@src64/flow.l")
let? (1559 . "@src64/flow.l")
-lieu (1153 . "@src64/db.l")
-line (3513 . "@src64/io.l")
-lines (3666 . "@src64/io.l")
+lieu (1154 . "@src64/db.l")
+line (3512 . "@src64/io.l")
+lines (3665 . "@src64/io.l")
link (1163 . "@src64/subr.l")
lisp (1921 . "@src64/main.l")
list (887 . "@src64/subr.l")
listen (151 . "@src64/net.l")
lit (183 . "@src64/flow.l")
-load (3980 . "@src64/io.l")
-lock (1181 . "@src64/db.l")
+load (3979 . "@src64/io.l")
+lock (1182 . "@src64/db.l")
loop (2190 . "@src64/flow.l")
low? (3215 . "@src64/sym.l")
lowc (3245 . "@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 (1946 . "@src64/db.l")
+mark (1947 . "@src64/db.l")
match (3062 . "@src64/subr.l")
max (2314 . "@src64/subr.l")
maxi (1395 . "@src64/apply.l")
@@ -233,31 +233,31 @@ offset (2651 . "@src64/subr.l")
on (1583 . "@src64/sym.l")
onOff (1613 . "@src64/sym.l")
one (1646 . "@src64/sym.l")
-open (4129 . "@src64/io.l")
+open (4128 . "@src64/io.l")
opid (3237 . "@src64/flow.l")
opt (2967 . "@src64/main.l")
or (1659 . "@src64/flow.l")
-out (4023 . "@src64/io.l")
+out (4022 . "@src64/io.l")
pack (1144 . "@src64/sym.l")
pair (2381 . "@src64/subr.l")
pass (638 . "@src64/apply.l")
pat? (720 . "@src64/sym.l")
path (1200 . "@src64/io.l")
-peek (3245 . "@src64/io.l")
+peek (3244 . "@src64/io.l")
pick (1253 . "@src64/apply.l")
pid (157 . "@src64/flow.l")
-pipe (4044 . "@src64/io.l")
-poll (3141 . "@src64/io.l")
-pool (647 . "@src64/db.l")
+pipe (4043 . "@src64/io.l")
+poll (3140 . "@src64/io.l")
+pool (648 . "@src64/db.l")
pop (1773 . "@src64/sym.l")
port (5 . "@src64/net.l")
-pr (5018 . "@src64/io.l")
+pr (5017 . "@src64/io.l")
pre? (1411 . "@src64/sym.l")
-prin (4826 . "@src64/io.l")
-prinl (4840 . "@src64/io.l")
-print (4866 . "@src64/io.l")
-println (4897 . "@src64/io.l")
-printsp (4882 . "@src64/io.l")
+prin (4825 . "@src64/io.l")
+prinl (4839 . "@src64/io.l")
+print (4865 . "@src64/io.l")
+println (4896 . "@src64/io.l")
+printsp (4881 . "@src64/io.l")
prog (1779 . "@src64/flow.l")
prog1 (1787 . "@src64/flow.l")
prog2 (1804 . "@src64/flow.l")
@@ -276,50 +276,50 @@ rand (2959 . "@src64/big.l")
range (988 . "@src64/subr.l")
rank (2970 . "@src64/subr.l")
raw (465 . "@src64/main.l")
-rd (4944 . "@src64/io.l")
+rd (4943 . "@src64/io.l")
read (2532 . "@src64/io.l")
replace (1490 . "@src64/subr.l")
rest (2272 . "@src64/main.l")
reverse (1665 . "@src64/subr.l")
-rewind (4910 . "@src64/io.l")
-rollback (1879 . "@src64/db.l")
+rewind (4909 . "@src64/io.l")
+rollback (1880 . "@src64/db.l")
rot (848 . "@src64/subr.l")
-rpc (5051 . "@src64/io.l")
+rpc (5050 . "@src64/io.l")
run (331 . "@src64/flow.l")
sect (2515 . "@src64/subr.l")
seed (2944 . "@src64/big.l")
seek (1159 . "@src64/apply.l")
send (1150 . "@src64/flow.l")
-seq (1080 . "@src64/db.l")
+seq (1081 . "@src64/db.l")
set (1482 . "@src64/sym.l")
setq (1515 . "@src64/sym.l")
sigio (503 . "@src64/main.l")
size (2752 . "@src64/subr.l")
-skip (3315 . "@src64/io.l")
+skip (3314 . "@src64/io.l")
sort (3869 . "@src64/subr.l")
sp? (711 . "@src64/sym.l")
-space (4844 . "@src64/io.l")
+space (4843 . "@src64/io.l")
split (1579 . "@src64/subr.l")
stack (571 . "@src64/main.l")
state (2028 . "@src64/flow.l")
stem (1976 . "@src64/subr.l")
-str (3833 . "@src64/io.l")
+str (3832 . "@src64/io.l")
str? (1013 . "@src64/sym.l")
strip (1563 . "@src64/subr.l")
sub? (1444 . "@src64/sym.l")
sum (1344 . "@src64/apply.l")
super (1237 . "@src64/flow.l")
-sym (3819 . "@src64/io.l")
+sym (3818 . "@src64/io.l")
sym? (2408 . "@src64/subr.l")
-sync (3042 . "@src64/io.l")
+sync (3040 . "@src64/io.l")
sys (3073 . "@src64/flow.l")
t (1770 . "@src64/flow.l")
tail (1898 . "@src64/subr.l")
-tell (3111 . "@src64/io.l")
+tell (3110 . "@src64/io.l")
text (1272 . "@src64/sym.l")
throw (2510 . "@src64/flow.l")
tick (3189 . "@src64/flow.l")
-till (3424 . "@src64/io.l")
+till (3423 . "@src64/io.l")
time (2491 . "@src64/main.l")
touch (1049 . "@src64/sym.l")
trim (1746 . "@src64/subr.l")
@@ -336,12 +336,12 @@ use (1592 . "@src64/flow.l")
usec (2596 . "@src64/main.l")
val (1463 . "@src64/sym.l")
version (2981 . "@src64/main.l")
-wait (3004 . "@src64/io.l")
+wait (3002 . "@src64/io.l")
when (1903 . "@src64/flow.l")
while (2080 . "@src64/flow.l")
wipe (3090 . "@src64/sym.l")
with (1349 . "@src64/flow.l")
-wr (5035 . "@src64/io.l")
+wr (5034 . "@src64/io.l")
xchg (1538 . "@src64/sym.l")
xor (1720 . "@src64/flow.l")
x| (2871 . "@src64/big.l")
diff --git a/src/io.c b/src/io.c
@@ -1,4 +1,4 @@
-/* 02sep10abu
+/* 10sep10abu
* (c) Software Lab. Alexander Burger
*/
@@ -1494,14 +1494,17 @@ any doSync(any ex) {
return Nil;
p = (byte*)&Slot;
cnt = sizeof(int);
- do {
- if ((n = write(Mic, p, cnt)) >= 0)
- p += n, cnt -= n;
+ for (;;) {
+ if ((n = write(Mic, p, cnt)) >= 0) {
+ if ((cnt -= n) == 0)
+ break;
+ p += n;
+ }
else if (errno != EINTR)
writeErr("sync");
if (*Signal)
sighandler(ex);
- } while (cnt);
+ }
Sync = NO;
do
waitFd(ex, -1, -1);
@@ -3223,7 +3226,7 @@ void db(any ex, any s, int a) {
tail(s) = ext(x);
}
else if (*p == At)
- *p = At2; // loaded -> dirty
+ *p = At2; // loaded -> dirty
else { // NIL & 1 | 2
adr n;
cell c[1];
diff --git a/src64/db.l b/src64/db.l
@@ -1,4 +1,4 @@
-# 07sep10abu
+# 09sep10abu
# (c) Software Lab. Alexander Burger
# 6 bytes in little endian format
@@ -405,27 +405,28 @@
cmp A C # OK?
jne dbWrErr # No
null (DbJnl) # Journal?
- jz Ret # No
- cmp A ((DbFile) III) # Size (in A and C) equal to current file's block size?
- if eq # Yes
- ld A BLKSIZE # Use block unit size instead
+ if nz # Yes
+ cmp A ((DbFile) III) # Size (in A and C) equal to current file's block size?
+ if eq # Yes
+ ld A BLKSIZE # Use block unit size instead
+ end
+ cc putc_unlocked(A (DbJnl)) # Write size
+ sub S (+ BLK 2) # <S> Buffer
+ ld A ((DbFile) I) # Get file number
+ ld (S) B # Store low byte
+ shr A 8
+ ld (S 1) B # and high byte
+ ld A E # Get position
+ shr A ((DbFile) II) # Un-shift for current file
+ call setAdrAS # Set block address in buffer
+ cc fwrite(S (+ BLK 2) 1 (DbJnl)) # Write file number and address
+ cmp A 1 # OK?
+ jne wrJnlErr # No
+ cc fwrite(Z C 1 (DbJnl)) # Write C bytes from buffer Z
+ cmp A 1 # OK?
+ jne wrJnlErr # No
+ add S (+ BLK 2) # Drop buffer
end
- cc putc_unlocked(A (DbJnl)) # Write size
- sub S (+ BLK 2) # <S> Buffer
- ld A ((DbFile) I) # Get file number
- ld (S) B # Store low byte
- shr A 8
- ld (S 1) B # and high byte
- ld A E # Get position
- shr A ((DbFile) II) # Un-shift for current file
- call setAdrAS # Set block address in buffer
- cc fwrite(S (+ BLK 2) 1 (DbJnl)) # Write file number and address
- cmp A 1 # OK?
- jne wrJnlErr # No
- cc fwrite(Z C 1 (DbJnl)) # Write C bytes from buffer Z
- cmp A 1 # OK?
- jne wrJnlErr # No
- add S (+ BLK 2) # Drop buffer
ret
(code 'logBlock)
diff --git a/src64/io.l b/src64/io.l
@@ -1,4 +1,4 @@
-# 07sep10abu
+# 10sep10abu
# (c) Software Lab. Alexander Burger
# Close file descriptor
@@ -2587,18 +2587,18 @@
cmp (C I) (C II) # Data in buffer ('ix' < 'cnt')?
ret # Yes: Return 'c'
-(code 'rdSetRdyASL_F 0) # Z
+(code 'rdSetRdyAL_F 0) # Z
ld C A
shl C 3 # Vector index
cmp C (InFDs) # 'fd' >= 'InFDs'?
- jge rdSetASL_F # Yes
+ jge rdSetAL_F # Yes
add C (InFiles) # Get vector
ld C (C) # Slot?
null C # Any?
- jz rdSetASL_F # No
+ jz rdSetAL_F # No
cmp (C I) (C II) # Data in buffer ('ix' < 'cnt')?
if z # No
- call rdSetASL_F
+ call rdSetAL_F
if nz # Yes
call slowNbC_FA # Try non-blocking read
jge retnz
@@ -2607,7 +2607,7 @@
end
ret
-(code 'rdSetASL_F 0) # Z
+(code 'rdSetAL_F 0) # Z
lea Z (L -V) # Beyond last 'poll' structure
do
cmp Z (L -V) # More structures?
@@ -2619,7 +2619,7 @@
test A (| POLLIN POLLHUP) # Ready?
ret # Return 'nz'
-(code 'wrSetASL_F 0) # Z
+(code 'wrSetAL_F 0) # Z
lea Z (L -V) # Beyond last 'poll' structure
do
cmp Z (L -V) # More structures?
@@ -2784,7 +2784,7 @@
if nz # Yes
push Z # Outer loop count
ld A (Y I) # Get child's 'hear' fd
- call rdSetASL_F # Ready?
+ call rdSetAL_F # Ready?
if nz # Yes
ld C (Y I) # Get 'hear' fd again
ld E 2 # Size of count
@@ -2793,15 +2793,14 @@
if ge # Yes
if z
call clsChildY # Close child
- pop Z
- continue T
+ jmp 20 # Continue
end
- sub S PIPE_BUF # <S II> Pipe buffer
+ sub S PIPE_BUF # <S I> Pipe buffer
push Y # <S> Outer child index
ld C (Y I) # Get 'hear' fd again
ld2 (Buf) # Get size
ld E A
- lea X (S II) # Buffer pointer
+ lea X (S I) # Buffer pointer
call rdBytesCEX_F # Read data?
if nz # Yes
set (L -IV) 1 # Still got data from pipe
@@ -2814,7 +2813,7 @@
if nz # Yes
ld2 (Buf) # Get size
ld C A
- lea X (S II) # and data
+ lea X (S I) # and data
call wrChildCXY # Write to child
end
end
@@ -2825,15 +2824,14 @@
call clsChildY # Close child
pop Y
add S PIPE_BUF # Drop 'tell' buffer
- pop Z
- continue T
+ jmp 20 # Continue
end
pop Y
add S PIPE_BUF # Drop 'tell' buffer
end
end
ld A (Y II) # Get child's 'tell' fd
- call wrSetASL_F # Ready?
+ call wrSetAL_F # Ready?
if nz # Yes
ld C (Y II) # Get 'tell' fd again
ld X (Y V) # Get buffer pointer
@@ -2867,7 +2865,7 @@
call clsChildY # Close child
end
end
- pop Z
+20 pop Z
end
add Y VI # Increment by sizeof(child)
loop
@@ -2876,7 +2874,7 @@
ld A (Spkr) # Speaker open?
null A
if nz # Yes
- call rdSetASL_F # Ready?
+ call rdSetAL_F # Ready?
if nz # Yes
ld C (Spkr) # Get fd
ld E I # Size of slot
@@ -2900,7 +2898,7 @@
if nz # Yes
cmp A (L -I) # Different from argument-fd?
if ne # Yes
- call rdSetRdyASL_F # Ready?
+ call rdSetRdyAL_F # Ready?
if nz # Yes
call rdHear_FE # Read expression?
if nc # Yes
@@ -2935,7 +2933,7 @@
atom A # End of tasklist?
while z # No
cmp E (A) # Member?
- jeq 20 # Yes: Skip
+ jeq 30 # Yes: Skip
ld A (A CDR)
loop
ld A (E) # Get fd or timeout value
@@ -2959,7 +2957,7 @@
else
cmp A (L -I) # Different from argument-fd?
if ne # Yes
- call rdSetRdyASL_F # Ready?
+ call rdSetRdyAL_F # Ready?
if nz # Yes
ld (At) (E) # Set to fd
ld Z (E CDR) # Run body
@@ -2967,7 +2965,7 @@
end
end
end
-20 ld Y (Y CDR)
+30 ld Y (Y CDR)
loop
pop X # Restore context
null (Signal) # Signal?
@@ -2988,7 +2986,7 @@
ld A (L -I) # File descriptor
null A # Positive?
while ns # Yes
- call rdSetRdyASL_F # Ready?
+ call rdSetRdyAL_F # Ready?
while z # No
lea S (L -V) # Drop 'poll' structures
loop
@@ -3040,9 +3038,10 @@
# (sync) -> flg
(code 'doSync 2)
- ld A (Mic) # 'mic' channel
- or A (Hear) # or 'hear' channel?
- jz retNil # No
+ null (Mic) # No 'mic' channel?
+ jz retNil # Yes
+ null (Hear) # No 'hear' channel?
+ jz retNil # Yes
push X
ld X E
ld E Slot # Buffer pointer
