From e14f985630dc9b0edad92d591fbede30928cda37 Mon Sep 17 00:00:00 2001 From: plugwash Date: Thu, 5 Feb 2009 21:52:57 +0000 Subject: [PATCH] * rearchitect release method to use tasks (making it work on windows) * drop the feature that the message loop on linux auto-exits when everything is destroyed (rarely if ever used) * get rid of now redundant linked list of sockets git-svn-id: file:///svnroot/lcore/trunk@36 b1de8a11-f9be-4011-bde0-cc7ace90066a --- lcore.pas | 30 +++++++----------------------- lcoreselect.pas | 31 ------------------------------- lcoretest.dpr | 16 +++++++++++++++- 3 files changed, 22 insertions(+), 55 deletions(-) diff --git a/lcore.pas b/lcore.pas index 727ca1c..6effe0e 100755 --- a/lcore.pas +++ b/lcore.pas @@ -73,8 +73,9 @@ interface TSendData = procedure (Sender: TObject; BytesSent: Integer) of object; tlcomponent = class(tcomponent) + private + procedure releasetaskhandler(wparam,lparam:longint); public - released:boolean; procedure release; virtual; destructor destroy; override; end; @@ -94,8 +95,6 @@ interface onsenddata : tsenddata ; ondatasent : tsocketevent ; //connected : boolean ; - nextasin : tlasio ; - prevasin : tlasio ; recvq : tfifo; OnBgException : TBgExceptionEvent ; @@ -227,7 +226,6 @@ procedure messageloop; procedure exitmessageloop; var - firstasin : tlasio ; firsttimer : tltimer ; firsttask , lasttask , currenttask : tltask ; @@ -285,12 +283,15 @@ begin inherited destroy; end; - +procedure tlcomponent.releasetaskhandler(wparam,lparam:longint); +begin + free; +end; procedure tlcomponent.release; begin - released := true; + addtask(releasetaskhandler,self,0,0); end; procedure tlasio.release; @@ -343,26 +344,12 @@ begin state := wsclosed; fdhandlein := -1; fdhandleout := -1; - nextasin := firstasin; - prevasin := nil; - if assigned(nextasin) then nextasin.prevasin := self; - firstasin := self; - - released := false; end; destructor tlasio.destroy; begin destroying := true; if state <> wsclosed then close; - if prevasin <> nil then begin - prevasin.nextasin := nextasin; - end else begin - firstasin := nextasin; - end; - if nextasin <> nil then begin - nextasin.prevasin := prevasin; - end; recvq.free; sendq.free; inherited destroy; @@ -752,8 +739,6 @@ begin end; interval := 1000; enabled := true; - released := false; - end; destructor tltimer.destroy; @@ -904,7 +889,6 @@ end; begin - firstasin := nil; firsttask := nil; diff --git a/lcoreselect.pas b/lcoreselect.pas index 16134ee..77da21f 100755 --- a/lcoreselect.pas +++ b/lcoreselect.pas @@ -84,7 +84,6 @@ begin end; temptimer := currenttimer; currenttimer := currenttimer.nexttimer; - if temptimer.released then temptimer.free; end; end; @@ -135,17 +134,6 @@ begin end; end; - if asinreleaseflag then begin - asinreleaseflag := false; - currentsocket := firstasin; - while assigned(currentsocket) do begin - tempsocket := currentsocket; - currentsocket := currentsocket.nextasin; - if tempsocket.released then begin - tempsocket.free; - end; - end; - end; { !!! issues: - sockets which are released may not be freed because theyre never processed by the loop @@ -295,25 +283,6 @@ begin repeat //the message loop will exit if all lasio's and ltimer's and lsignal's are destroyed - if (not assigned(firstasin)) and (not assigned(firsttimer)) {$ifndef nosignal} and (not assigned(firstsignal)){$endif} then exit; - {fd_zero(FDSR); - fd_zero(FDSW); - currentsocket := firstasin; - if not assigned(currentsocket) then exit; //the message loop will exit if all lsockets are destroyed - - repeat - if (not currentsocket.released) and (currentsocket.state<>wsclosed) then fd_set(currentsocket.fdhandlein,fdsr); - if (not currentsocket.released) and (currentsocket.state=wsconnecting) then fd_set(currentsocket.fdhandleout,fdsw); - if currentsocket is tlsocket then begin - if (not currentsocket.released) and (currentsocket.state=wsconnected) and(tlsocket(currentsocket).sendq <> '') then fd_set(currentsocket.fdhandleout,fdsw); - end; - tempsocket := currentsocket; - currentsocket := currentsocket.nextasin; - if tempsocket.released then begin - tempsocket.free; - end; - until not assigned(currentsocket); - } processtasks; //currenttask := nil; {beware} diff --git a/lcoretest.dpr b/lcoretest.dpr index 150b488..61d771f 100755 --- a/lcoretest.dpr +++ b/lcoretest.dpr @@ -36,6 +36,9 @@ type procedure dnsrequestdone(sender:tobject;error : word); procedure sessionclosed(sender:tobject;error : word); end; + treleasetest=class(tlcomponent) + destructor destroy; override; + end; var listensocket : tlsocket; serversocket : tlsocket; @@ -147,7 +150,14 @@ end; procedure tsc.timehandler(sender:tobject); begin //writeln('got timer event'); -end; +end; + +destructor treleasetest.destroy; +begin + writeln('releasetest.destroy called'); + inherited destroy; +end; + procedure tsc.sessionclosed(sender:tobject;error : word); begin Writeln('session closed with error ',error); @@ -157,8 +167,12 @@ var ipbin : tbinip; dummy : integer; iplist : tbiniplist; + releasetest : treleasetest; begin lcoreinit; + releasetest := treleasetest.create(nil); + releasetest.release; + ipbin := forwardlookup('invalid.domain',5); writeln(ipbintostr(ipbin)); -- 2.30.2