lcore.org gitweb
/
lcore.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
wrapped rdtsc and added x64 support
[lcore.git]
/
lcore.pas
diff --git
a/lcore.pas
b/lcore.pas
index da0fd66b89365b4272b74707dd40de189c7f2f58..c936b59d7d8376f990d3e54a8268d3cc20352b1c 100755
(executable)
--- a/
lcore.pas
+++ b/
lcore.pas
@@
-16,26
+16,32
@@
unit lcore;
{$ifdef fpc}
\r
{$mode delphi}
\r
{$endif}
\r
{$ifdef fpc}
\r
{$mode delphi}
\r
{$endif}
\r
-{$ifdef
win32
}
\r
+{$ifdef
mswindows
}
\r
{$define nosignal}
\r
{$endif}
\r
interface
\r
uses
\r
sysutils,
\r
{$define nosignal}
\r
{$endif}
\r
interface
\r
uses
\r
sysutils,
\r
- {$ifndef
win32
}
\r
+ {$ifndef
mswindows
}
\r
{$ifdef VER1_0}
\r
linux,
\r
{$else}
\r
{$ifdef VER1_0}
\r
linux,
\r
{$else}
\r
- baseunix,unix,unixutil,
\r
+ baseunix,unix,unixutil,
sockets,
\r
{$endif}
\r
fd_utils,
\r
{$endif}
\r
{$endif}
\r
fd_utils,
\r
{$endif}
\r
- classes,pgtypes,bfifo;
\r
+ classes,pgtypes,bfifo
,ltimevalstuff
;
\r
procedure processtasks;
\r
\r
\r
const
\r
procedure processtasks;
\r
\r
\r
const
\r
- packetbasesize = 1460;
\r
+ {how this number is made up:
\r
+ - ethernet: MTU 1500
\r
+ - be safe for either "ethernet v1" or "PPPoE", both take 8 bytes
\r
+ - IPv6 header: 40 bytes (IPv4 is 20)
\r
+ - TCP/UDP header: 20 bytes
\r
+ }
\r
+ packetbasesize = 1432;
\r
receivebufsize=packetbasesize*8;
\r
\r
var
\r
receivebufsize=packetbasesize*8;
\r
\r
var
\r
@@
-67,8
+73,9
@@
interface
TSendData = procedure (Sender: TObject; BytesSent: Integer) of object;
\r
\r
tlcomponent = class(tcomponent)
\r
TSendData = procedure (Sender: TObject; BytesSent: Integer) of object;
\r
\r
tlcomponent = class(tcomponent)
\r
+ private
\r
+ procedure releasetaskhandler(wparam,lparam:longint);
\r
public
\r
public
\r
- released:boolean;
\r
procedure release; virtual;
\r
destructor destroy; override;
\r
end;
\r
procedure release; virtual;
\r
destructor destroy; override;
\r
end;
\r
@@
-88,8
+95,6
@@
interface
onsenddata : tsenddata ;
\r
ondatasent : tsocketevent ;
\r
//connected : boolean ;
\r
onsenddata : tsenddata ;
\r
ondatasent : tsocketevent ;
\r
//connected : boolean ;
\r
- nextasin : tlasio ;
\r
- prevasin : tlasio ;
\r
\r
recvq : tfifo;
\r
OnBgException : TBgExceptionEvent ;
\r
\r
recvq : tfifo;
\r
OnBgException : TBgExceptionEvent ;
\r
@@
-101,7
+106,7
@@
interface
lasterror:integer;
\r
destroying:boolean;
\r
recvbufsize:integer;
\r
lasterror:integer;
\r
destroying:boolean;
\r
recvbufsize:integer;
\r
- function receivestr:string; virtual;
\r
+ function receivestr:
tbuffer
string; virtual;
\r
procedure close;
\r
procedure abort;
\r
procedure internalclose(error:word); virtual;
\r
procedure close;
\r
procedure abort;
\r
procedure internalclose(error:word); virtual;
\r
@@
-114,8
+119,8
@@
interface
procedure dup(invalue:longint);
\r
\r
function sendflush : integer;
\r
procedure dup(invalue:longint);
\r
\r
function sendflush : integer;
\r
- procedure sendstr(const str : string);virtual;
\r
- procedure putstringinsendbuffer(const newstring : string);
\r
+ procedure sendstr(const str :
tbuffer
string);virtual;
\r
+ procedure putstringinsendbuffer(const newstring :
tbuffer
string);
\r
function send(data:pointer;len:integer):integer;virtual;
\r
procedure putdatainsendbuffer(data:pointer;len:integer); virtual;
\r
procedure deletebuffereddata;
\r
function send(data:pointer;len:integer):integer;virtual;
\r
procedure putdatainsendbuffer(data:pointer;len:integer); virtual;
\r
procedure deletebuffereddata;
\r
@@
-131,9
+136,9
@@
interface
\r
function RealSend(Data : Pointer; Len : Integer) : Integer; //added for bewarehttpd
\r
\r
\r
function RealSend(Data : Pointer; Len : Integer) : Integer; //added for bewarehttpd
\r
\r
- procedure myfdclose(fd : integer); virtual;{$ifdef
win32
}abstract;{$endif}
\r
- function myfdwrite(fd: LongInt;const buf;size: LongInt):LongInt; virtual;{$ifdef
win32
}abstract;{$endif}
\r
- function myfdread(fd: LongInt;var buf;size: LongInt):LongInt; virtual;{$ifdef
win32
}abstract;{$endif}
\r
+ procedure myfdclose(fd : integer); virtual;{$ifdef
mswindows
}abstract;{$endif}
\r
+ function myfdwrite(fd: LongInt;const buf;size: LongInt):LongInt; virtual;{$ifdef
mswindows
}abstract;{$endif}
\r
+ function myfdread(fd: LongInt;var buf;size: LongInt):LongInt; virtual;{$ifdef
mswindows
}abstract;{$endif}
\r
protected
\r
procedure dupnowatch(invalue:longint);
\r
end;
\r
protected
\r
procedure dupnowatch(invalue:longint);
\r
end;
\r
@@
-149,12
+154,6
@@
interface
var
\r
timerwrapperinterface : ttimerwrapperinterface;
\r
type
\r
var
\r
timerwrapperinterface : ttimerwrapperinterface;
\r
type
\r
- {$ifdef win32}
\r
- ttimeval = record
\r
- tv_sec : longint;
\r
- tv_usec : longint;
\r
- end;
\r
- {$endif}
\r
tltimer=class(tlcomponent)
\r
protected
\r
\r
tltimer=class(tlcomponent)
\r
protected
\r
\r
@@
-166,7
+165,7
@@
interface
fontimer : tnotifyevent ;
\r
fenabled : boolean ;
\r
finterval : integer ; {miliseconds, default 1000}
\r
fontimer : tnotifyevent ;
\r
fenabled : boolean ;
\r
finterval : integer ; {miliseconds, default 1000}
\r
- {$ifndef
win32
}
\r
+ {$ifndef
mswindows
}
\r
procedure resettimes;
\r
{$endif}
\r
// procedure setinitialevent(newvalue : boolean);
\r
procedure resettimes;
\r
{$endif}
\r
// procedure setinitialevent(newvalue : boolean);
\r
@@
-221,7
+220,6
@@
procedure messageloop;
procedure exitmessageloop;
\r
\r
var
\r
procedure exitmessageloop;
\r
\r
var
\r
- firstasin : tlasio ;
\r
firsttimer : tltimer ;
\r
firsttask , lasttask , currenttask : tltask ;
\r
\r
firsttimer : tltimer ;
\r
firsttask , lasttask , currenttask : tltask ;
\r
\r
@@
-250,41
+248,45
@@
implementation
{$ifndef nosignal}
\r
uses {sockets,}lloopback,lsignal;
\r
{$endif}
\r
{$ifndef nosignal}
\r
uses {sockets,}lloopback,lsignal;
\r
{$endif}
\r
-{$ifdef
win32
}
\r
+{$ifdef
mswindows
}
\r
uses windows,winsock;
\r
{$endif}
\r
uses windows,winsock;
\r
{$endif}
\r
-{$ifndef
win32
}
\r
+{$ifndef
mswindows
}
\r
{$include unixstuff.inc}
\r
{$endif}
\r
{$include unixstuff.inc}
\r
{$endif}
\r
-{$include ltimevalstuff.inc}
\r
\r
\r
{!!! added sleep call -beware}
\r
procedure sleep(i:integer);
\r
\r
\r
{!!! added sleep call -beware}
\r
procedure sleep(i:integer);
\r
+{$ifdef mswindows}
\r
+begin
\r
+ windows.sleep(i);
\r
+{$else}
\r
var
\r
tv:ttimeval;
\r
begin
\r
var
\r
tv:ttimeval;
\r
begin
\r
- {$ifdef win32}
\r
- windows.sleep(i);
\r
- {$else}
\r
- tv.tv_sec := i div 1000;
\r
- tv.tv_usec := (i mod 1000) * 1000;
\r
- select(0,nil,nil,nil,@tv);
\r
- {$endif}
\r
+ tv.tv_sec := i div 1000;
\r
+ tv.tv_usec := (i mod 1000) * 1000;
\r
+ select(0,nil,nil,nil,@tv);
\r
+{$endif}
\r
end;
\r
\r
end;
\r
\r
+
\r
destructor tlcomponent.destroy;
\r
begin
\r
disconnecttasks(self);
\r
inherited destroy;
\r
end;
\r
\r
destructor tlcomponent.destroy;
\r
begin
\r
disconnecttasks(self);
\r
inherited destroy;
\r
end;
\r
\r
-
\r
+procedure tlcomponent.releasetaskhandler(wparam,lparam:longint);
\r
+begin
\r
+ free;
\r
+end;
\r
\r
\r
procedure tlcomponent.release;
\r
begin
\r
\r
\r
procedure tlcomponent.release;
\r
begin
\r
-
released := true
;
\r
+
addtask(releasetaskhandler,self,0,0)
;
\r
end;
\r
\r
procedure tlasio.release;
\r
end;
\r
\r
procedure tlasio.release;
\r
@@
-337,26
+339,12
@@
begin
state := wsclosed;
\r
fdhandlein := -1;
\r
fdhandleout := -1;
\r
state := wsclosed;
\r
fdhandlein := -1;
\r
fdhandleout := -1;
\r
- nextasin := firstasin;
\r
- prevasin := nil;
\r
- if assigned(nextasin) then nextasin.prevasin := self;
\r
- firstasin := self;
\r
-
\r
- released := false;
\r
end;
\r
\r
destructor tlasio.destroy;
\r
begin
\r
destroying := true;
\r
if state <> wsclosed then close;
\r
end;
\r
\r
destructor tlasio.destroy;
\r
begin
\r
destroying := true;
\r
if state <> wsclosed then close;
\r
- if prevasin <> nil then begin
\r
- prevasin.nextasin := nextasin;
\r
- end else begin
\r
- firstasin := nextasin;
\r
- end;
\r
- if nextasin <> nil then begin
\r
- nextasin.prevasin := prevasin;
\r
- end;
\r
recvq.free;
\r
sendq.free;
\r
inherited destroy;
\r
recvq.free;
\r
sendq.free;
\r
inherited destroy;
\r
@@
-399,18
+387,21
@@
end;
procedure tlasio.internalclose(error:word);
\r
begin
\r
if (state<>wsclosed) and (state<>wsinvalidstate) then begin
\r
procedure tlasio.internalclose(error:word);
\r
begin
\r
if (state<>wsclosed) and (state<>wsinvalidstate) then begin
\r
+ // -2 is a special indication that we should just exist silently
\r
+ // (used for connect failure handling when socket creation fails)
\r
+ if (fdhandlein = -2) and (fdhandleout = -2) then exit;
\r
if (fdhandlein < 0) or (fdhandleout < 0) then raise exception.create('internalclose called with invalid fd handles');
\r
eventcore.rmasterclr(fdhandlein);//fd_clr(fdhandlein,fdsrmaster);
\r
eventcore.wmasterclr(fdhandleout);//fd_clr(fdhandleout,fdswmaster);
\r
\r
if closehandles then begin
\r
if (fdhandlein < 0) or (fdhandleout < 0) then raise exception.create('internalclose called with invalid fd handles');
\r
eventcore.rmasterclr(fdhandlein);//fd_clr(fdhandlein,fdsrmaster);
\r
eventcore.wmasterclr(fdhandleout);//fd_clr(fdhandleout,fdswmaster);
\r
\r
if closehandles then begin
\r
- {$ifndef
win32
}
\r
+ {$ifndef
mswindows
}
\r
//anyone remember why this is here? --plugwash
\r
fcntl(fdhandlein,F_SETFL,0);
\r
{$endif}
\r
myfdclose(fdhandlein);
\r
if fdhandleout <> fdhandlein then begin
\r
//anyone remember why this is here? --plugwash
\r
fcntl(fdhandlein,F_SETFL,0);
\r
{$endif}
\r
myfdclose(fdhandlein);
\r
if fdhandleout <> fdhandlein then begin
\r
- {$ifndef
win32
}
\r
+ {$ifndef
mswindows
}
\r
fcntl(fdhandleout,F_SETFL,0);
\r
{$endif}
\r
myfdclose(fdhandleout);
\r
fcntl(fdhandleout,F_SETFL,0);
\r
{$endif}
\r
myfdclose(fdhandleout);
\r
@@
-453,13
+444,13
@@
begin
end;
\r
end;
\r
\r
end;
\r
end;
\r
\r
-procedure tlasio.sendstr(const str : string);
\r
+procedure tlasio.sendstr(const str :
tbuffer
string);
\r
begin
\r
putstringinsendbuffer(str);
\r
sendflush;
\r
end;
\r
\r
begin
\r
putstringinsendbuffer(str);
\r
sendflush;
\r
end;
\r
\r
-procedure tlasio.putstringinsendbuffer(const newstring : string);
\r
+procedure tlasio.putstringinsendbuffer(const newstring :
tbuffer
string);
\r
begin
\r
if newstring <> '' then putdatainsendbuffer(@newstring[1],length(newstring));
\r
end;
\r
begin
\r
if newstring <> '' then putdatainsendbuffer(@newstring[1],length(newstring));
\r
end;
\r
@@
-489,7
+480,10
@@
var
// fdstestr : fdset;
\r
// fdstestw : fdset;
\r
begin
\r
// fdstestr : fdset;
\r
// fdstestw : fdset;
\r
begin
\r
- if state <> wsconnected then exit;
\r
+ if state <> wsconnected then begin
\r
+ result := -1;
\r
+ exit;
\r
+ end;
\r
\r
lensent := sendq.get(data,packetbasesize*2);
\r
if assigned(data) then result := myfdwrite(fdhandleout,data^,lensent) else result := 0;
\r
\r
lensent := sendq.get(data,packetbasesize*2);
\r
if assigned(data) then result := myfdwrite(fdhandleout,data^,lensent) else result := 0;
\r
@@
-534,7
+528,7
@@
begin
fdhandlein := invalue;
\r
fdhandleout := invalue;
\r
eventcore.setfdreverse(fdhandlein,self);
\r
fdhandlein := invalue;
\r
fdhandleout := invalue;
\r
eventcore.setfdreverse(fdhandlein,self);
\r
- {$ifndef
win32
}
\r
+ {$ifndef
mswindows
}
\r
fcntl(fdhandlein,F_SETFL,OPEN_NONBLOCK);
\r
{$endif}
\r
state := wsconnected;
\r
fcntl(fdhandlein,F_SETFL,OPEN_NONBLOCK);
\r
{$endif}
\r
state := wsconnected;
\r
@@
-567,7
+561,16
@@
begin
internalclose(0);
\r
\r
end else begin
\r
internalclose(0);
\r
\r
end else begin
\r
- internalclose({$ifdef win32}getlasterror{$else}linuxerror{$endif});
\r
+ {$ifdef mswindows}
\r
+ if getlasterror=WSAEWOULDBLOCK then begin
\r
+ //the asynchronous nature of windows messages means we sometimes
\r
+ //get here with the buffer full
\r
+ //so do nothing in that case
\r
+ end else
\r
+ {$endif}
\r
+ begin
\r
+ internalclose({$ifdef mswindows}getlasterror{$else}linuxerror{$endif});
\r
+ end
\r
end;
\r
end;
\r
\r
end;
\r
end;
\r
\r
@@
-593,7
+596,7
@@
begin
\r
internalclose(0);
\r
end else if (numread=-1) then begin
\r
\r
internalclose(0);
\r
end else if (numread=-1) then begin
\r
- {$ifdef
win32
}
\r
+ {$ifdef
mswindows
}
\r
//sometimes on windows we get stale messages due to the inherent delays
\r
//in the windows message queue
\r
if WSAGetLastError = wsaewouldblock then begin
\r
//sometimes on windows we get stale messages due to the inherent delays
\r
//in the windows message queue
\r
if WSAGetLastError = wsaewouldblock then begin
\r
@@
-602,7
+605,7
@@
begin
{$endif}
\r
begin
\r
numread := 0;
\r
{$endif}
\r
begin
\r
numread := 0;
\r
- internalclose({$ifdef
win32
}wsagetlasterror{$else}linuxerror{$endif});
\r
+ internalclose({$ifdef
mswindows
}wsagetlasterror{$else}linuxerror{$endif});
\r
end;
\r
end else if numread > 0 then recvq.add(@tempbuf,numread);
\r
end;
\r
end;
\r
end else if numread > 0 then recvq.add(@tempbuf,numread);
\r
end;
\r
@@
-619,7
+622,7
@@
begin
end;
\r
\r
procedure tlasio.flush;
\r
end;
\r
\r
procedure tlasio.flush;
\r
-{$ifdef
win32
}
\r
+{$ifdef
mswindows
}
\r
type fdset = tfdset;
\r
{$endif}
\r
var
\r
type fdset = tfdset;
\r
{$endif}
\r
var
\r
@@
-648,7
+651,7
@@
begin
tlasio(sender).recvq.del(maxlongint);
\r
end;
\r
\r
tlasio(sender).recvq.del(maxlongint);
\r
end;
\r
\r
-{$ifndef
win32
}
\r
+{$ifndef
mswindows
}
\r
procedure tltimer.resettimes;
\r
begin
\r
gettimeofday(nextts);
\r
procedure tltimer.resettimes;
\r
begin
\r
gettimeofday(nextts);
\r
@@
-689,7
+692,7
@@
begin
if assigned(timerwrapperinterface) then begin
\r
timerwrapperinterface.setenabled(wrappedtimer,newvalue);
\r
end else begin
\r
if assigned(timerwrapperinterface) then begin
\r
timerwrapperinterface.setenabled(wrappedtimer,newvalue);
\r
end else begin
\r
- {$ifdef
win32
}
\r
+ {$ifdef
mswindows
}
\r
raise exception.create('non wrapper timers are not permitted on windows');
\r
{$else}
\r
resettimes;
\r
raise exception.create('non wrapper timers are not permitted on windows');
\r
{$else}
\r
resettimes;
\r
@@
-705,7
+708,7
@@
begin
if assigned(timerwrapperinterface) then begin
\r
timerwrapperinterface.setinterval(wrappedtimer,newvalue);
\r
end else begin
\r
if assigned(timerwrapperinterface) then begin
\r
timerwrapperinterface.setinterval(wrappedtimer,newvalue);
\r
end else begin
\r
- {$ifdef
win32
}
\r
+ {$ifdef
mswindows
}
\r
raise exception.create('non wrapper timers are not permitted on windows');
\r
{$else}
\r
resettimes;
\r
raise exception.create('non wrapper timers are not permitted on windows');
\r
{$else}
\r
resettimes;
\r
@@
-734,8
+737,6
@@
begin
end;
\r
interval := 1000;
\r
enabled := true;
\r
end;
\r
interval := 1000;
\r
enabled := true;
\r
- released := false;
\r
-
\r
end;
\r
\r
destructor tltimer.destroy;
\r
end;
\r
\r
destructor tltimer.destroy;
\r
@@
-866,7
+867,7
@@
begin
if (result > 0) and assigned(onsenddata) then onsenddata(self,result);
\r
eventcore.wmasterset(fdhandleout);
\r
end;
\r
if (result > 0) and assigned(onsenddata) then onsenddata(self,result);
\r
eventcore.wmasterset(fdhandleout);
\r
end;
\r
-{$ifndef
win32
}
\r
+{$ifndef
mswindows
}
\r
procedure tlasio.myfdclose(fd : integer);
\r
begin
\r
fdclose(fd);
\r
procedure tlasio.myfdclose(fd : integer);
\r
begin
\r
fdclose(fd);
\r
@@
-886,7
+887,6
@@
end;
\r
\r
begin
\r
\r
\r
begin
\r
- firstasin := nil;
\r
firsttask := nil;
\r
\r
\r
firsttask := nil;
\r
\r
\r
lcore.org gitweb / lcore.git / blobdiff