lcore.org gitweb
/
lcore.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
fix signal hang
[lcore.git]
/
lcore.pas
diff --git
a/lcore.pas
b/lcore.pas
index 77bf4f0674db0b63eebc8df4346c44fb19c7be60..0f6eaef5025a5cbf3a9b8db87bf33b047108c24e 100755
(executable)
--- a/
lcore.pas
+++ b/
lcore.pas
@@
-26,11
+26,11
@@
interface
{$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
@@
-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
@@
-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
@@
-262,7
+254,6
@@
implementation
{$ifndef win32}
\r
{$include unixstuff.inc}
\r
{$endif}
\r
{$ifndef win32}
\r
{$include unixstuff.inc}
\r
{$endif}
\r
-{$include ltimevalstuff.inc}
\r
\r
\r
{!!! added sleep call -beware}
\r
\r
\r
{!!! added sleep call -beware}
\r
@@
-285,12
+276,15
@@
begin
inherited destroy;
\r
end;
\r
\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
+337,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
@@
-405,6
+385,9
@@
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
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
@@
-459,13
+442,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
@@
-495,7
+478,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
@@
-573,16
+559,16
@@
begin
internalclose(0);
\r
\r
end else begin
\r
internalclose(0);
\r
\r
end else begin
\r
- {$ifdef win32}
- if getlasterror=WSAEWOULDBLOCK then begin
- //the asynchronous nature of windows messages means we sometimes
- //get here with the buffer full
- //so do nothing in that case
- end else
- {$endif}
- begin
+ {$ifdef win32}
\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 win32}getlasterror{$else}linuxerror{$endif});
\r
internalclose({$ifdef win32}getlasterror{$else}linuxerror{$endif});
\r
- end
+ end
\r
end;
\r
end;
\r
\r
end;
\r
end;
\r
\r
@@
-749,8
+735,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
@@
-901,7
+885,6
@@
end;
\r
\r
begin
\r
\r
\r
begin
\r
- firstasin := nil;
\r
firsttask := nil;
\r
\r
\r
firsttask := nil;
\r
\r
\r