commit c24fb652d3d40b5eb1f78bb6b49b337c48c0f0d0
parent 8b30ca21bdc2dc03a72d5aab567b1f069077e918
Author: Alexander Burger <abu@software-lab.de>
Date: Wed, 6 Feb 2013 19:29:38 +0100
Omit gettimeofday() system calls before/after select() on Linux also on pil64
Diffstat:
8 files changed, 189 insertions(+), 163 deletions(-)
diff --git a/ersatz/picolisp.jar b/ersatz/picolisp.jar
Binary files differ.
diff --git a/lib/map b/lib/map
@@ -29,12 +29,12 @@ adr (587 . "@src64/main.l")
alarm (473 . "@src64/main.l")
all (788 . "@src64/sym.l")
and (1624 . "@src64/flow.l")
-any (3983 . "@src64/io.l")
+any (3999 . "@src64/io.l")
append (1338 . "@src64/subr.l")
apply (713 . "@src64/apply.l")
-arg (2573 . "@src64/main.l")
-args (2549 . "@src64/main.l")
-argv (3201 . "@src64/main.l")
+arg (2575 . "@src64/main.l")
+args (2551 . "@src64/main.l")
+argv (3203 . "@src64/main.l")
as (139 . "@src64/flow.l")
asoq (3020 . "@src64/subr.l")
assoc (2985 . "@src64/subr.l")
@@ -66,7 +66,7 @@ call (3096 . "@src64/flow.l")
car (5 . "@src64/subr.l")
case (1965 . "@src64/flow.l")
catch (2467 . "@src64/flow.l")
-cd (2953 . "@src64/main.l")
+cd (2955 . "@src64/main.l")
cdaaar (464 . "@src64/subr.l")
cdaadr (487 . "@src64/subr.l")
cdaar (179 . "@src64/subr.l")
@@ -83,13 +83,13 @@ cdddr (245 . "@src64/subr.l")
cddr (79 . "@src64/subr.l")
cdr (17 . "@src64/subr.l")
chain (1141 . "@src64/subr.l")
-char (3465 . "@src64/io.l")
+char (3481 . "@src64/io.l")
chop (1228 . "@src64/sym.l")
circ (816 . "@src64/subr.l")
circ? (2402 . "@src64/subr.l")
clip (1799 . "@src64/subr.l")
-close (4396 . "@src64/io.l")
-cmd (3183 . "@src64/main.l")
+close (4412 . "@src64/io.l")
+cmd (3185 . "@src64/main.l")
cnt (1413 . "@src64/apply.l")
co (2548 . "@src64/flow.l")
commit (1403 . "@src64/db.l")
@@ -99,10 +99,10 @@ cond (1919 . "@src64/flow.l")
connect (227 . "@src64/net.l")
cons (747 . "@src64/subr.l")
copy (1225 . "@src64/subr.l")
-ctl (4269 . "@src64/io.l")
-ctty (2978 . "@src64/main.l")
+ctl (4285 . "@src64/io.l")
+ctty (2980 . "@src64/main.l")
cut (1931 . "@src64/sym.l")
-date (2687 . "@src64/main.l")
+date (2689 . "@src64/main.l")
dbck (2018 . "@src64/db.l")
de (532 . "@src64/flow.l")
dec (2323 . "@src64/big.l")
@@ -112,24 +112,24 @@ del (1986 . "@src64/sym.l")
delete (1401 . "@src64/subr.l")
delq (1452 . "@src64/subr.l")
diff (2589 . "@src64/subr.l")
-dir (3113 . "@src64/main.l")
+dir (3115 . "@src64/main.l")
dm (545 . "@src64/flow.l")
do (2141 . "@src64/flow.l")
e (2928 . "@src64/flow.l")
-echo (4427 . "@src64/io.l")
+echo (4443 . "@src64/io.l")
env (599 . "@src64/main.l")
-eof (3542 . "@src64/io.l")
-eol (3533 . "@src64/io.l")
-err (4249 . "@src64/io.l")
+eof (3558 . "@src64/io.l")
+eol (3549 . "@src64/io.l")
+err (4265 . "@src64/io.l")
errno (1575 . "@src64/main.l")
eval (175 . "@src64/flow.l")
-ext (5161 . "@src64/io.l")
+ext (5177 . "@src64/io.l")
ext? (1166 . "@src64/sym.l")
extern (1032 . "@src64/sym.l")
extra (1269 . "@src64/flow.l")
extract (1218 . "@src64/apply.l")
fifo (2097 . "@src64/sym.l")
-file (3060 . "@src64/main.l")
+file (3062 . "@src64/main.l")
fill (3255 . "@src64/subr.l")
filter (1161 . "@src64/apply.l")
fin (2033 . "@src64/subr.l")
@@ -138,13 +138,13 @@ find (1322 . "@src64/apply.l")
fish (1613 . "@src64/apply.l")
flg? (2445 . "@src64/subr.l")
flip (1699 . "@src64/subr.l")
-flush (5136 . "@src64/io.l")
+flush (5152 . "@src64/io.l")
fold (3521 . "@src64/sym.l")
for (2230 . "@src64/flow.l")
fork (3270 . "@src64/flow.l")
format (2089 . "@src64/big.l")
free (1960 . "@src64/db.l")
-from (3561 . "@src64/io.l")
+from (3577 . "@src64/io.l")
full (1075 . "@src64/subr.l")
fun? (750 . "@src64/sym.l")
gc (435 . "@src64/gc.l")
@@ -157,23 +157,23 @@ gt0 (2718 . "@src64/big.l")
hash (2976 . "@src64/big.l")
head (1820 . "@src64/subr.l")
heap (519 . "@src64/main.l")
-hear (3246 . "@src64/io.l")
+hear (3262 . "@src64/io.l")
host (193 . "@src64/net.l")
id (1028 . "@src64/db.l")
idx (2171 . "@src64/sym.l")
if (1805 . "@src64/flow.l")
if2 (1824 . "@src64/flow.l")
ifn (1865 . "@src64/flow.l")
-in (4209 . "@src64/io.l")
+in (4225 . "@src64/io.l")
inc (2256 . "@src64/big.l")
index (2637 . "@src64/subr.l")
-info (3015 . "@src64/main.l")
+info (3017 . "@src64/main.l")
intern (1007 . "@src64/sym.l")
ipid (3215 . "@src64/flow.l")
isa (967 . "@src64/flow.l")
job (1429 . "@src64/flow.l")
journal (971 . "@src64/db.l")
-key (3394 . "@src64/io.l")
+key (3410 . "@src64/io.l")
kill (3247 . "@src64/flow.l")
last (2044 . "@src64/subr.l")
le0 (2693 . "@src64/big.l")
@@ -181,14 +181,14 @@ length (2741 . "@src64/subr.l")
let (1479 . "@src64/flow.l")
let? (1540 . "@src64/flow.l")
lieu (1157 . "@src64/db.l")
-line (3717 . "@src64/io.l")
-lines (3870 . "@src64/io.l")
+line (3733 . "@src64/io.l")
+lines (3886 . "@src64/io.l")
link (1172 . "@src64/subr.l")
lisp (2244 . "@src64/main.l")
list (887 . "@src64/subr.l")
listen (160 . "@src64/net.l")
lit (150 . "@src64/flow.l")
-load (4186 . "@src64/io.l")
+load (4202 . "@src64/io.l")
lock (1185 . "@src64/db.l")
loop (2173 . "@src64/flow.l")
low? (3387 . "@src64/sym.l")
@@ -226,7 +226,7 @@ nand (1659 . "@src64/flow.l")
native (1583 . "@src64/main.l")
need (919 . "@src64/subr.l")
new (839 . "@src64/flow.l")
-next (2556 . "@src64/main.l")
+next (2558 . "@src64/main.l")
nil (1742 . "@src64/flow.l")
nond (1942 . "@src64/flow.l")
nor (1680 . "@src64/flow.l")
@@ -238,30 +238,30 @@ offset (2677 . "@src64/subr.l")
on (1717 . "@src64/sym.l")
onOff (1747 . "@src64/sym.l")
one (1780 . "@src64/sym.l")
-open (4353 . "@src64/io.l")
+open (4369 . "@src64/io.l")
opid (3231 . "@src64/flow.l")
-opt (3304 . "@src64/main.l")
+opt (3306 . "@src64/main.l")
or (1640 . "@src64/flow.l")
-out (4229 . "@src64/io.l")
+out (4245 . "@src64/io.l")
pack (1279 . "@src64/sym.l")
pair (2394 . "@src64/subr.l")
pass (754 . "@src64/apply.l")
pat? (736 . "@src64/sym.l")
path (1251 . "@src64/io.l")
-peek (3449 . "@src64/io.l")
+peek (3465 . "@src64/io.l")
pick (1369 . "@src64/apply.l")
-pipe (4290 . "@src64/io.l")
-poll (3338 . "@src64/io.l")
+pipe (4306 . "@src64/io.l")
+poll (3354 . "@src64/io.l")
pool (651 . "@src64/db.l")
pop (1907 . "@src64/sym.l")
port (5 . "@src64/net.l")
-pr (5244 . "@src64/io.l")
+pr (5260 . "@src64/io.l")
pre? (1545 . "@src64/sym.l")
-prin (5060 . "@src64/io.l")
-prinl (5074 . "@src64/io.l")
-print (5100 . "@src64/io.l")
-println (5131 . "@src64/io.l")
-printsp (5116 . "@src64/io.l")
+prin (5076 . "@src64/io.l")
+prinl (5090 . "@src64/io.l")
+print (5116 . "@src64/io.l")
+println (5147 . "@src64/io.l")
+printsp (5132 . "@src64/io.l")
prior (2713 . "@src64/subr.l")
prog (1760 . "@src64/flow.l")
prog1 (1768 . "@src64/flow.l")
@@ -273,7 +273,7 @@ push (1822 . "@src64/sym.l")
push1 (1858 . "@src64/sym.l")
put (2844 . "@src64/sym.l")
putl (3122 . "@src64/sym.l")
-pwd (2942 . "@src64/main.l")
+pwd (2944 . "@src64/main.l")
queue (2054 . "@src64/sym.l")
quit (1285 . "@src64/main.l")
quote (134 . "@src64/flow.l")
@@ -281,12 +281,12 @@ rand (3003 . "@src64/big.l")
range (997 . "@src64/subr.l")
rank (3048 . "@src64/subr.l")
raw (451 . "@src64/main.l")
-rd (5178 . "@src64/io.l")
+rd (5194 . "@src64/io.l")
read (2674 . "@src64/io.l")
replace (1499 . "@src64/subr.l")
-rest (2602 . "@src64/main.l")
+rest (2604 . "@src64/main.l")
reverse (1678 . "@src64/subr.l")
-rewind (5144 . "@src64/io.l")
+rewind (5160 . "@src64/io.l")
rollback (1803 . "@src64/db.l")
rot (848 . "@src64/subr.l")
run (306 . "@src64/flow.l")
@@ -299,34 +299,34 @@ set (1616 . "@src64/sym.l")
setq (1649 . "@src64/sym.l")
sigio (489 . "@src64/main.l")
size (2808 . "@src64/subr.l")
-skip (3519 . "@src64/io.l")
+skip (3535 . "@src64/io.l")
sort (3977 . "@src64/subr.l")
sp? (727 . "@src64/sym.l")
-space (5078 . "@src64/io.l")
+space (5094 . "@src64/io.l")
split (1592 . "@src64/subr.l")
stack (548 . "@src64/main.l")
state (2009 . "@src64/flow.l")
stem (1989 . "@src64/subr.l")
-str (4037 . "@src64/io.l")
+str (4053 . "@src64/io.l")
str? (1145 . "@src64/sym.l")
strip (1576 . "@src64/subr.l")
struct (2035 . "@src64/main.l")
sub? (1578 . "@src64/sym.l")
sum (1460 . "@src64/apply.l")
super (1225 . "@src64/flow.l")
-sym (4023 . "@src64/io.l")
+sym (4039 . "@src64/io.l")
sym? (2434 . "@src64/subr.l")
symbols (942 . "@src64/sym.l")
-sync (3206 . "@src64/io.l")
+sync (3222 . "@src64/io.l")
sys (3067 . "@src64/flow.l")
t (1751 . "@src64/flow.l")
tail (1911 . "@src64/subr.l")
-tell (3278 . "@src64/io.l")
+tell (3294 . "@src64/io.l")
text (1407 . "@src64/sym.l")
throw (2493 . "@src64/flow.l")
tick (3183 . "@src64/flow.l")
-till (3628 . "@src64/io.l")
-time (2820 . "@src64/main.l")
+till (3644 . "@src64/io.l")
+time (2822 . "@src64/main.l")
touch (1181 . "@src64/sym.l")
trail (698 . "@src64/main.l")
trim (1759 . "@src64/subr.l")
@@ -340,15 +340,15 @@ up (766 . "@src64/main.l")
upp? (3402 . "@src64/sym.l")
uppc (3469 . "@src64/sym.l")
use (1573 . "@src64/flow.l")
-usec (2924 . "@src64/main.l")
+usec (2926 . "@src64/main.l")
val (1597 . "@src64/sym.l")
-version (3318 . "@src64/main.l")
-wait (3168 . "@src64/io.l")
+version (3320 . "@src64/main.l")
+wait (3184 . "@src64/io.l")
when (1884 . "@src64/flow.l")
while (2061 . "@src64/flow.l")
wipe (3262 . "@src64/sym.l")
with (1332 . "@src64/flow.l")
-wr (5261 . "@src64/io.l")
+wr (5277 . "@src64/io.l")
xchg (1672 . "@src64/sym.l")
xor (1701 . "@src64/flow.l")
x| (2887 . "@src64/big.l")
diff --git a/src/vers.h b/src/vers.h
@@ -1 +1 @@
-static byte Version[4] = {3,1,1,10};
+static byte Version[4] = {3,1,1,11};
diff --git a/src64/arch/emu.l b/src64/arch/emu.l
@@ -1,4 +1,4 @@
-# 05jan13abu
+# 06feb13abu
# (c) Software Lab. Alexander Burger
# Byte order
@@ -774,7 +774,7 @@
(stat i p "struct stat")
(fcntl i i i p)
(pipe i "int")
- (select i i "fd_set" "fd_set" "fd_set" 2)
+ (select i i "fd_set" "fd_set" "fd_set" (2 . -2))
(open i p i i)
(dup i i)
(dup2 - i i)
@@ -839,6 +839,8 @@
(wtermsigS_A n) )
(de ccArg (P S O P2)
+ (and (pair P) (setq P (car @)))
+ (and (pair P2) (setq P2 (car @)))
(case P
(p (op.p S O))
(n (op.n S O))
@@ -870,8 +872,15 @@
(list 'glue ", " Args)
(list 'extract
''((A P)
+ (and (pair P) (setq P (cdr @)))
(when (lt0 P)
- (pack " retv(" (abs @) ", " A ");") ) )
+ (use (@N @A)
+ (pack
+ " retv("
+ (abs @)
+ ", "
+ (if (match '(~(chop "argv(") @N "," " " @A ")") (chop A)) @A A)
+ ");" ) ) ) )
Args
'(cdr Par) ) )
Body ) ) )
diff --git a/src64/io.l b/src64/io.l
@@ -1,4 +1,4 @@
-# 31jan13abu
+# 06feb13abu
# (c) Software Lab. Alexander Burger
# Close file descriptor
@@ -2901,10 +2901,12 @@
ld A C # and microseconds
mul 1000
ld (L -IV) A
- lea C (L -V)
+ lea C (L -V) # Set timeval structure pointer
+ ? (<> *TargetOS "Linux") # Non-Linux?
+ call msec_A # Get milliseconds
+ ld E A # into E
+ =
end
- call msec_A # Get milliseconds
- ld E A # into E
do
cc select(Z &(S FD_SET) S 0 C) # Wait for event or timeout
nul4 # OK?
@@ -2920,9 +2922,23 @@
call sighandlerX
end
loop
- call msec_A # Get milliseconds
- sub A E # Time difference
- ld (L -III) A # Save it
+ null C # Timeval structure pointer?
+ if nz # Yes
+ ? (= *TargetOS "Linux") # Linux?
+ ld A (L -V) # Seconds not slept
+ mul 1000 # Calculate milliseconds
+ ld E A
+ ld A (L -IV) # Microseconds not slept
+ div 1000 # Calculate milliseconds
+ add A E # Milliseconds not slept
+ sub (L -III) A # Time difference
+ =
+ ? (<> *TargetOS "Linux") # Else
+ call msec_A # Get milliseconds
+ sub A E # Time difference
+ ld (L -III) A # Save it
+ =
+ end
push X # Save context again
null (Spkr) # Speaker open?
if nz # Yes
@@ -3111,7 +3127,7 @@
ld A (C) # and CADR
shr A 4 # Normalize
sub A (L -III) # Subtract time difference
- if nc # Not yet timed out
+ if gt # Not yet timed out
shl A 4 # Make short number
or A CNT
ld (C) A # Store in '*Run'
diff --git a/src64/main.l b/src64/main.l
@@ -1,4 +1,4 @@
-# 12jan13abu
+# 06feb13abu
# (c) Software Lab. Alexander Burger
(code 'Code)
@@ -2533,17 +2533,19 @@
drop
jmp (A) # Return
-(code 'msec_A)
- push C
- cc gettimeofday(Buf 0) # Get time
- ld A (Buf) # tv_sec
- mul 1000 # Convert to milliseconds
- ld (Buf) A # Save
- ld A (Buf I) # tv_usec
- div 1000 # Convert to milliseconds (C is zero)
- add A (Buf)
- pop C
- ret
+? (<> *TargetOS "Linux")
+ (code 'msec_A)
+ push C
+ cc gettimeofday(Buf 0) # Get time
+ ld A (Buf) # tv_sec
+ mul 1000 # Convert to milliseconds
+ ld (Buf) A # Save
+ ld A (Buf I) # tv_usec
+ div 1000 # Convert to milliseconds (C is zero)
+ add A (Buf)
+ pop C
+ ret
+=
# (args) -> flg
(code 'doArgs 2)
diff --git a/src64/tags b/src64/tags
@@ -409,7 +409,7 @@ sys/x86-64.linux.defs.l,1959
UndefErr1246,85370
DlErr1247,85399
-./main.l,2244
+./main.l,2225
Code4,51
Ret8,106
Retc10,127
@@ -507,27 +507,26 @@ sys/x86-64.linux.defs.l,1959
putStringB2499,61344
begString2511,61558
endString_E2522,61784
-msec_A2536,62107
-doArgs2549,62381
-doNext2556,62495
-doArg2573,62811
-doRest2602,63453
-tmDateC_E2616,63700
-dateXYZ_E2626,63877
-doDate2687,65238
-tmTimeY_E2803,68849
-doTime2820,69182
-doUsec2924,72160
-doPwd2942,72577
-doCd2953,72832
-doCtty2978,73448
-doInfo3015,74382
-doFile3060,75477
-doDir3113,76713
-doCmd3183,78331
-doArgv3201,78790
-doOpt3304,81336
-doVersion3318,81667
+doArgs2551,62441
+doNext2558,62555
+doArg2575,62871
+doRest2604,63513
+tmDateC_E2618,63760
+dateXYZ_E2628,63937
+doDate2689,65298
+tmTimeY_E2805,68909
+doTime2822,69242
+doUsec2926,72220
+doPwd2944,72637
+doCd2955,72892
+doCtty2980,73508
+doInfo3017,74442
+doFile3062,75537
+doDir3115,76773
+doCmd3185,78391
+doArgv3203,78850
+doOpt3306,81396
+doVersion3320,81727
./big.l,1059
zapZeroA_A6,106
@@ -662,65 +661,65 @@ sys/x86-64.linux.defs.l,1959
wrSetCL_F2755,70505
rdSetRdyCL_F2760,70628
waitFdCEX_A2782,71089
-doWait3168,83913
-doSync3206,84636
-doHear3246,85576
-doTell3278,86270
-fdSetC_Y3327,87358
-doPoll3338,87592
-doKey3394,88963
-doPeek3449,90402
-doChar3465,90680
-doSkip3519,91625
-doEol3533,91972
-doEof3542,92138
-doFrom3561,92495
-doTill3628,94164
-eolA_F3702,96113
-doLine3717,96417
-doLines3870,100457
-parseBCE_E3911,101358
-doAny3983,103013
-doSym4023,103951
-doStr4037,104210
-loadBEX_E4090,105336
-doLoad4186,107686
-doIn4209,108098
-doOut4229,108428
-doErr4249,108762
-doCtl4269,109097
-doPipe4290,109452
-doOpen4353,110998
-doClose4396,111978
-doEcho4427,112569
-putStdoutB4640,118093
-newline4683,119075
-space4687,119117
-outNumE4692,119181
-outWordA4699,119309
-prExtNmX4711,119547
-outOctA4719,119741
-outAoA4732,120009
-outStringS4744,120257
-outStringC4746,120327
-outNameE4756,120466
-prNameX4764,120583
-printE_E4774,120738
-printE4783,120874
-prinE_E4996,126490
-prinE5005,126626
-doPrin5060,127888
-doPrinl5074,128158
-doSpace5078,128226
-doPrint5100,128625
-doPrintsp5116,128920
-doPrintln5131,129209
-doFlush5136,129297
-doRewind5144,129434
-doExt5161,129824
-doRd5178,130163
-doPr5244,131943
-doWr5261,132275
+doWait3184,84515
+doSync3222,85238
+doHear3262,86178
+doTell3294,86872
+fdSetC_Y3343,87960
+doPoll3354,88194
+doKey3410,89565
+doPeek3465,91004
+doChar3481,91282
+doSkip3535,92227
+doEol3549,92574
+doEof3558,92740
+doFrom3577,93097
+doTill3644,94766
+eolA_F3718,96715
+doLine3733,97019
+doLines3886,101059
+parseBCE_E3927,101960
+doAny3999,103615
+doSym4039,104553
+doStr4053,104812
+loadBEX_E4106,105938
+doLoad4202,108288
+doIn4225,108700
+doOut4245,109030
+doErr4265,109364
+doCtl4285,109699
+doPipe4306,110054
+doOpen4369,111600
+doClose4412,112580
+doEcho4443,113171
+putStdoutB4656,118695
+newline4699,119677
+space4703,119719
+outNumE4708,119783
+outWordA4715,119911
+prExtNmX4727,120149
+outOctA4735,120343
+outAoA4748,120611
+outStringS4760,120859
+outStringC4762,120929
+outNameE4772,121068
+prNameX4780,121185
+printE_E4790,121340
+printE4799,121476
+prinE_E5012,127092
+prinE5021,127228
+doPrin5076,128490
+doPrinl5090,128760
+doSpace5094,128828
+doPrint5116,129227
+doPrintsp5132,129522
+doPrintln5147,129811
+doFlush5152,129899
+doRewind5160,130036
+doExt5177,130426
+doRd5194,130765
+doPr5260,132545
+doWr5277,132877
./apply.l,445
applyXYZ_E4,51
diff --git a/src64/version.l b/src64/version.l
@@ -1,6 +1,6 @@
-# 04feb13abu
+# 06feb13abu
# (c) Software Lab. Alexander Burger
-(de *Version 3 1 1 10)
+(de *Version 3 1 1 11)
# vi:et:ts=3:sw=3
