* rearchitect release method to use tasks (making it work on windows)
authorplugwash <plugwash@p10link.net>
Thu, 5 Feb 2009 21:52:57 +0000 (21:52 +0000)
committerplugwash <plugwash@p10link.net>
Thu, 5 Feb 2009 21:52:57 +0000 (21:52 +0000)
* 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
lcoreselect.pas
lcoretest.dpr

index 727ca1cf16e76b0931eb6540116d33c7522f3113..6effe0e0bad0165f76bc606dafeddd4275163f06 100755 (executable)
--- a/lcore.pas
+++ b/lcore.pas
@@ -73,8 +73,9 @@ interface
     TSendData          = procedure (Sender: TObject; BytesSent: Integer) of object;\r
 \r
     tlcomponent = class(tcomponent)\r
+    private
+      procedure releasetaskhandler(wparam,lparam:longint);
     public\r
-      released:boolean;\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
-      nextasin           : tlasio            ;\r
-      prevasin           : tlasio            ;\r
 \r
       recvq              : tfifo;\r
       OnBgException      : TBgExceptionEvent ;\r
@@ -227,7 +226,6 @@ procedure messageloop;
 procedure exitmessageloop;\r
 \r
 var\r
-  firstasin                             : tlasio     ;\r
   firsttimer                            : tltimer    ;\r
   firsttask  , lasttask   , currenttask : tltask     ;\r
 \r
@@ -285,12 +283,15 @@ begin
   inherited destroy;\r
 end;\r
 \r
-\r
+procedure tlcomponent.releasetaskhandler(wparam,lparam:longint);
+begin
+  free;
+end;
 \r
 \r
 procedure tlcomponent.release;\r
 begin\r
-  released := true;\r
+  addtask(releasetaskhandler,self,0,0);
 end;\r
 \r
 procedure tlasio.release;\r
@@ -343,26 +344,12 @@ begin
   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
-  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
@@ -752,8 +739,6 @@ begin
   end;\r
   interval := 1000;\r
   enabled := true;\r
-  released := false;\r
-\r
 end;\r
 \r
 destructor tltimer.destroy;\r
@@ -904,7 +889,6 @@ end;
 \r
 \r
 begin\r
-  firstasin := nil;\r
   firsttask := nil;\r
   \r
 \r
index 16134ee6a73fc3a323ca19521f14de5326c9d617..77da21f33a8e2fdae3c0f4498041d67113686d9d 100755 (executable)
@@ -84,7 +84,6 @@ begin
     end;\r
     temptimer := currenttimer;\r
     currenttimer := currenttimer.nexttimer;\r
-    if temptimer.released then temptimer.free;\r
   end;\r
 end;\r
 \r
@@ -135,17 +134,6 @@ begin
     end;\r
   end;\r
 \r
-  if asinreleaseflag then begin\r
-    asinreleaseflag := false;\r
-    currentsocket := firstasin;\r
-    while assigned(currentsocket) do begin\r
-      tempsocket := currentsocket;\r
-      currentsocket := currentsocket.nextasin;\r
-      if tempsocket.released then begin\r
-        tempsocket.free;\r
-      end;\r
-    end;\r
-  end;\r
   {\r
   !!! issues:\r
   - sockets which are released may not be freed because theyre never processed by the loop\r
@@ -295,25 +283,6 @@ begin
   repeat\r
 \r
     //the message loop will exit if all lasio's and ltimer's and lsignal's are destroyed\r
-    if (not assigned(firstasin)) and (not assigned(firsttimer)) {$ifndef nosignal} and (not assigned(firstsignal)){$endif} then exit;\r
-    {fd_zero(FDSR);\r
-    fd_zero(FDSW);\r
-    currentsocket := firstasin;\r
-    if not assigned(currentsocket) then exit; //the message loop will exit if all lsockets are destroyed\r
-\r
-    repeat\r
-      if (not currentsocket.released) and (currentsocket.state<>wsclosed) then fd_set(currentsocket.fdhandlein,fdsr);\r
-      if (not currentsocket.released) and (currentsocket.state=wsconnecting) then fd_set(currentsocket.fdhandleout,fdsw);\r
-      if currentsocket is tlsocket then begin\r
-         if (not currentsocket.released) and (currentsocket.state=wsconnected) and(tlsocket(currentsocket).sendq <> '') then fd_set(currentsocket.fdhandleout,fdsw);\r
-      end;\r
-      tempsocket := currentsocket;\r
-      currentsocket := currentsocket.nextasin;\r
-      if tempsocket.released then begin\r
-        tempsocket.free;\r
-      end;\r
-    until not assigned(currentsocket);\r
-    }\r
     processtasks;\r
     //currenttask := nil;\r
     {beware}\r
index 150b488988437d146784d7184c9f210b02be8469..61d771f3fd4118d25b5963a8f806c059e8881a18 100755 (executable)
@@ -36,6 +36,9 @@ type
     procedure dnsrequestdone(sender:tobject;error : word);\r
     procedure sessionclosed(sender:tobject;error : word);\r
   end;\r
+  treleasetest=class(tlcomponent)
+    destructor destroy; override;
+  end;
 var\r
   listensocket : tlsocket;\r
   serversocket : tlsocket;\r
@@ -147,7 +150,14 @@ end;
 procedure tsc.timehandler(sender:tobject);\r
 begin\r
   //writeln('got timer event');\r
-end;\r
+end;
+
+destructor treleasetest.destroy;
+begin
+  writeln('releasetest.destroy called');
+  inherited destroy;
+end;
+\r
 procedure tsc.sessionclosed(sender:tobject;error : word);\r
 begin\r
   Writeln('session closed with error ',error);\r
@@ -157,8 +167,12 @@ var
   ipbin : tbinip;\r
   dummy : integer;\r
   iplist : tbiniplist;\r
+  releasetest : treleasetest;
 begin\r
   lcoreinit;\r
+  releasetest := treleasetest.create(nil);
+  releasetest.release;
+  
   ipbin := forwardlookup('invalid.domain',5);\r
   writeln(ipbintostr(ipbin));\r
 \r