Hi
I've tested some of benchmark on
http://shootout.alioth.debian.org/
I've see that reverse-complement benchmark
<http://shootout.alioth.debian.org/benchmark.php?test=revcomp&lang=all> for FPC
is very slow. I discover, that problem is with readln, that function consume about 90% of
time. Because I use it in my program, I implemented new version of reading files. My
propositions is add tTextStream to unit Classes
using is very similar
while not eof do
begin
readln(s);
end;
changed to
tx:=tTextStream.create('name') //or via handle
while tx.readln(d)>=0 do
tx.free;
My implementation cause than benchmark run 4 times faster. But I think, it
need some improvements.
Is this enough to add it to Classes. If so, I'll work on it.
Darek
type
TTextStream = class(TFileStream)
private
bufStream : array[0..BufTextStreamSize] of char;
BufPtr : integer; {Positions within buffer. Meaning
depends}
BufEnd : integer; {... on read or write mode}
bufpos : integer;
procedure readBuffer;
public
function Read(var Buffer; Count: Longint): Longint; override;
function readLn(var ss : ShortString):longint;
end;
implementation
function HeapFunc(Size : Word) : Integer;
{-Return nil pointer if insufficient memory}
begin
HeapFunc := 1;
end;
function GetMemCheck(var P; Bytes : integer) : Boolean;
{-Allocate heap space, returning true if successful}
var
Pt : Pointer absolute P;
begin
GetMem(Pt, Bytes);
GetMemCheck := (Pt <> nil);
end;
function tTextStream.read(var Buffer; Count: Longint): Longint;
var
UserBuf : ByteArray absolute Buffer;
UserPos : integer;
Bytes : integer;
io : longint;
begin
userPos:=0;
while Count > 0 do begin
if BufPtr >= BufEnd then begin
readBuffer;
end;
Bytes := BufEnd-BufPtr;
if bytes=0 then begin
break;
end else if Count <= Bytes then begin
move(BufStream[BufPtr], UserBuf[UserPos], count);
inc(BufPtr, count);
inc(userPos,count);
break;
end else begin
dec(Count, Bytes);
inc(BufPtr, Bytes);
move(BufStream[BufPtr], UserBuf[UserPos], Bytes);
inc(UserPos, Bytes);
end;
{Adjust counters}
end;
result:=userPos;
end;
function StrLScan(const Str: PChar; Chr: Char;maxLen : cardinal): PChar;
assembler;
asm
PUSH EDI
MOV EDI,Str
MOV AL,Chr
REPNE SCASB
MOV EAX,0
JNE @@1
MOV EAX,EDI
DEC EAX
@@1: POP EDI
end;
procedure tTextStream.readBuffer;
var
io : longint;
begin
io:= inherited read(bufStream,BufTextStreamSize);
if io=0 then begin
bufPtr:=0;
bufEnd:=0;
exit;
end;
bufPtr:=0;
bufEnd:=io;
inc(bufPos,io);
end;
function tTextStream.readln(var ss : shortString): Longint;
var
UserPos : integer;
Bytes : integer;
i : longint;
count : integer;
function endofLine(i : integer):boolean;
begin
result:= (bufStream[i]=#13) or (bufStream[i]=#10);
end;
procedure skipendofLine;
begin
if bufPtr>=BufEnd then readBuffer;
if bufStream[bufPtr]=#13 then begin
inc(bufPtr);
if bufPtr>=BufEnd then readBuffer;
end;
if bufStream[bufPtr]=#10 then inc(bufPtr);
end;
function findEndLine: longint;
var
pp,pc,pk : pchar;
begin
pp:=@(bufstream[bufPtr]);
// pc:=pp;
result:=bufEnd-bufPtr;
pc:=strLScan(pp,#10,bufEnd-bufPtr);
if pc=nil then begin
pc:=strLScan(pp,#13,bufEnd-bufPtr);
end else if pchar(pc-1)^=#13 then dec(pc);
if (pc<>nil) and endOfLine(longint(pc)-longint(@bufStream)) then begin
result:= longint(pc)-longint(pp);
count:=result;
end;
end;
function findEndLine2: longint;
var
i : integer;
pp,pc,pk : pchar;
begin
result:=bufEnd-bufPtr;
for i:=bufPtr to bufEnd do begin
if (bufstream[i]<#14) and endOfLine(i) then begin
result:=i-bufPtr;
count:=result;
exit;
end;
end;
end;
function findEndLine3: longint;
var
pp,pc,pk : pchar;
begin
pp:=@(bufstream[bufPtr]);
pc:=pp;
pk:=@(bufstream[bufEnd]);
result:=bufEnd-bufPtr;
repeat
if (pc^<#14) and endOfLine(longint(pc)-longint(@bufStream)) then begin
result:= longint(pc)-longint(pp);
count:=result;
exit;
end;
inc(pc);
until (pc=pk);
end;
begin
userPos:=0;
count:=255;
while Count > 0 do begin
if BufPtr >= BufEnd then begin
readBuffer;
end;
bytes:=BufEnd-bufPtr;
if bytes=0 then begin
if userPos=0 then userPos:=-1;
break;
end;
bytes:=findEndLine;
if Count <= Bytes then begin
move(BufStream[BufPtr], ss[UserPos+1], count);
inc(BufPtr, count);
inc(userPos,count);
break;
end else begin
dec(Count, Bytes);
inc(BufPtr, Bytes);
move(BufStream[BufPtr], ss[UserPos+1], Bytes);
inc(UserPos, Bytes);
end;
{Adjust counters}
end;
ss[0]:=char(userPos);
skipEndOfLine;
result:=userPos;
end;
_______________________________________________
fpc-devel maillist - [email protected]
http://lists.freepascal.org/mailman/listinfo/fpc-devel
