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 727ca1cf16e76b0931eb6540116d33c7522f3113..c936b59d7d8376f990d3e54a8268d3cc20352b1c 100755
(executable)
--- a/
lcore.pas
+++ b/
lcore.pas
@@
-16,21
+16,21
@@
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
procedure processtasks;
\r
\r
\r
@@
-73,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
@@
-94,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
@@
-107,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
@@
-120,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
@@
-137,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
@@
-155,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
@@
-172,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
@@
-227,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
@@
-256,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
@@
-343,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
@@
-413,13
+395,13
@@
begin
eventcore.wmasterclr(fdhandleout);//fd_clr(fdhandleout,fdswmaster);
\r
\r
if closehandles then begin
\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
@@
-462,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
@@
-498,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
@@
-543,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
@@
-576,7
+561,7
@@
begin
internalclose(0);
\r
\r
end else begin
\r
internalclose(0);
\r
\r
end else begin
\r
- {$ifdef
win32
}
\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
if getlasterror=WSAEWOULDBLOCK then begin
\r
//the asynchronous nature of windows messages means we sometimes
\r
//get here with the buffer full
\r
@@
-584,7
+569,7
@@
begin
end else
\r
{$endif}
\r
begin
\r
end else
\r
{$endif}
\r
begin
\r
- internalclose({$ifdef
win32
}getlasterror{$else}linuxerror{$endif});
\r
+ internalclose({$ifdef
mswindows
}getlasterror{$else}linuxerror{$endif});
\r
end
\r
end;
\r
end;
\r
end
\r
end;
\r
end;
\r
@@
-611,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
@@
-620,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
@@
-637,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
@@
-666,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
@@
-707,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
@@
-723,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
@@
-752,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
@@
-884,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
@@
-904,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