X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/2dd575b95694c126013c912526093ff4915f3398..90c7057fc0ae5d85a6443e7633642ef43553ab28:/lcore.pas

diff --git a/lcore.pas b/lcore.pas
index 727ca1c..c936b59 100755
--- a/lcore.pas
+++ b/lcore.pas
@@ -16,21 +16,21 @@ unit lcore;
 {$ifdef fpc}
   {$mode delphi}
 {$endif}
-{$ifdef win32}
+{$ifdef mswindows}
   {$define nosignal}
 {$endif}
 interface
   uses
     sysutils,
-    {$ifndef win32}
+    {$ifndef mswindows}
       {$ifdef VER1_0}
         linux,
       {$else}
-        baseunix,unix,unixutil,
+        baseunix,unix,unixutil,sockets,
       {$endif}
       fd_utils,
     {$endif}
-    classes,pgtypes,bfifo;
+    classes,pgtypes,bfifo,ltimevalstuff;
   procedure processtasks;
 
 
@@ -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 ;
@@ -107,7 +106,7 @@ interface
       lasterror:integer;
       destroying:boolean;
       recvbufsize:integer;
-      function receivestr:string; virtual;
+      function receivestr:tbufferstring; virtual;
       procedure close;
       procedure abort;
       procedure internalclose(error:word); virtual;
@@ -120,8 +119,8 @@ interface
       procedure dup(invalue:longint);
 
       function sendflush : integer;
-      procedure sendstr(const str : string);virtual;
-      procedure putstringinsendbuffer(const newstring : string);
+      procedure sendstr(const str : tbufferstring);virtual;
+      procedure putstringinsendbuffer(const newstring : tbufferstring);
       function send(data:pointer;len:integer):integer;virtual;
       procedure putdatainsendbuffer(data:pointer;len:integer); virtual;
       procedure deletebuffereddata;
@@ -137,9 +136,9 @@ interface
 
       function RealSend(Data : Pointer; Len : Integer) : Integer; //added for bewarehttpd
 
-      procedure myfdclose(fd : integer); virtual;{$ifdef win32}abstract;{$endif}
-      function myfdwrite(fd: LongInt;const buf;size: LongInt):LongInt; virtual;{$ifdef win32}abstract;{$endif}
-      function myfdread(fd: LongInt;var buf;size: LongInt):LongInt; virtual;{$ifdef win32}abstract;{$endif}
+      procedure myfdclose(fd : integer); virtual;{$ifdef mswindows}abstract;{$endif}
+      function myfdwrite(fd: LongInt;const buf;size: LongInt):LongInt; virtual;{$ifdef mswindows}abstract;{$endif}
+      function myfdread(fd: LongInt;var buf;size: LongInt):LongInt; virtual;{$ifdef mswindows}abstract;{$endif}
     protected
       procedure dupnowatch(invalue:longint);
     end;
@@ -155,12 +154,6 @@ interface
   var
     timerwrapperinterface : ttimerwrapperinterface;
   type
-    {$ifdef win32}
-      ttimeval = record
-        tv_sec : longint;
-        tv_usec : longint;
-      end;
-    {$endif}
     tltimer=class(tlcomponent)
     protected
 
@@ -172,7 +165,7 @@ interface
       fontimer            : tnotifyevent      ;
       fenabled            : boolean           ;
       finterval	          : integer	     ; {miliseconds, default 1000}
-      {$ifndef win32}
+      {$ifndef mswindows}
         procedure resettimes;
       {$endif}
 //      procedure setinitialevent(newvalue : boolean);
@@ -227,7 +220,6 @@ procedure messageloop;
 procedure exitmessageloop;
 
 var
-  firstasin                             : tlasio     ;
   firsttimer                            : tltimer    ;
   firsttask  , lasttask   , currenttask : tltask     ;
 
@@ -256,41 +248,45 @@ implementation
 {$ifndef nosignal}
   uses {sockets,}lloopback,lsignal;
 {$endif}
-{$ifdef win32}
+{$ifdef mswindows}
   uses windows,winsock;
 {$endif}
-{$ifndef win32}
+{$ifndef mswindows}
   {$include unixstuff.inc}
 {$endif}
-{$include ltimevalstuff.inc}
 
 
 {!!! added sleep call -beware}
 procedure sleep(i:integer);
+{$ifdef mswindows}
+begin
+  windows.sleep(i);
+{$else}
 var
   tv:ttimeval;
 begin
-  {$ifdef win32}
-    windows.sleep(i);
-  {$else}
-    tv.tv_sec := i div 1000;
-    tv.tv_usec := (i mod 1000) * 1000;
-    select(0,nil,nil,nil,@tv);
-  {$endif}
+  tv.tv_sec := i div 1000;
+  tv.tv_usec := (i mod 1000) * 1000;
+  select(0,nil,nil,nil,@tv);
+{$endif}
 end;
 
+
 destructor tlcomponent.destroy;
 begin
   disconnecttasks(self);
   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 +339,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;
@@ -413,13 +395,13 @@ begin
     eventcore.wmasterclr(fdhandleout);//fd_clr(fdhandleout,fdswmaster);
 
     if closehandles then begin
-      {$ifndef win32}
+      {$ifndef mswindows}
         //anyone remember why this is here? --plugwash
         fcntl(fdhandlein,F_SETFL,0);
       {$endif}
       myfdclose(fdhandlein);
       if fdhandleout <> fdhandlein then begin
-        {$ifndef win32}
+        {$ifndef mswindows}
           fcntl(fdhandleout,F_SETFL,0);
         {$endif}
         myfdclose(fdhandleout);
@@ -462,13 +444,13 @@ begin
   end;
 end;
 
-procedure tlasio.sendstr(const str : string);
+procedure tlasio.sendstr(const str : tbufferstring);
 begin
   putstringinsendbuffer(str);
   sendflush;
 end;
 
-procedure tlasio.putstringinsendbuffer(const newstring : string);
+procedure tlasio.putstringinsendbuffer(const newstring : tbufferstring);
 begin
   if newstring <> '' then putdatainsendbuffer(@newstring[1],length(newstring));
 end;
@@ -498,7 +480,10 @@ var
 //  fdstestr : fdset;
 //  fdstestw : fdset;
 begin
-  if state <> wsconnected then exit;
+  if state <> wsconnected then begin
+    result := -1;
+    exit;
+  end;
 
   lensent := sendq.get(data,packetbasesize*2);
   if assigned(data) then result := myfdwrite(fdhandleout,data^,lensent) else result := 0;
@@ -543,7 +528,7 @@ begin
   fdhandlein := invalue;
   fdhandleout := invalue;
   eventcore.setfdreverse(fdhandlein,self);
-  {$ifndef win32}
+  {$ifndef mswindows}
     fcntl(fdhandlein,F_SETFL,OPEN_NONBLOCK);
   {$endif}
   state := wsconnected;
@@ -576,7 +561,7 @@ begin
           internalclose(0);
 
         end else begin
-          {$ifdef win32}
+          {$ifdef mswindows}
           if getlasterror=WSAEWOULDBLOCK then begin
             //the asynchronous nature of windows messages means we sometimes
             //get here with the buffer full
@@ -584,7 +569,7 @@ begin
           end else
           {$endif}
           begin
-            internalclose({$ifdef win32}getlasterror{$else}linuxerror{$endif});
+            internalclose({$ifdef mswindows}getlasterror{$else}linuxerror{$endif});
           end  
         end;
       end;
@@ -611,7 +596,7 @@ begin
 
         internalclose(0);
       end else if (numread=-1) then begin
-        {$ifdef win32}
+        {$ifdef mswindows}
           //sometimes on windows we get stale messages due to the inherent delays
           //in the windows message queue
           if WSAGetLastError = wsaewouldblock then begin
@@ -620,7 +605,7 @@ begin
         {$endif}
         begin
           numread := 0;
-          internalclose({$ifdef win32}wsagetlasterror{$else}linuxerror{$endif});
+          internalclose({$ifdef mswindows}wsagetlasterror{$else}linuxerror{$endif});
         end;
       end else if numread > 0 then recvq.add(@tempbuf,numread);
     end;
@@ -637,7 +622,7 @@ begin
 end;
 
 procedure tlasio.flush;
-{$ifdef win32}
+{$ifdef mswindows}
 type fdset = tfdset;
 {$endif}
 var
@@ -666,7 +651,7 @@ begin
   tlasio(sender).recvq.del(maxlongint);
 end;
 
-{$ifndef win32}
+{$ifndef mswindows}
   procedure tltimer.resettimes;
   begin
     gettimeofday(nextts);
@@ -707,7 +692,7 @@ begin
     if assigned(timerwrapperinterface) then begin
       timerwrapperinterface.setenabled(wrappedtimer,newvalue);
     end else begin
-      {$ifdef win32}
+      {$ifdef mswindows}
         raise exception.create('non wrapper timers are not permitted on windows');
       {$else}
         resettimes;
@@ -723,7 +708,7 @@ begin
     if assigned(timerwrapperinterface) then begin
       timerwrapperinterface.setinterval(wrappedtimer,newvalue);
     end else begin
-      {$ifdef win32}
+      {$ifdef mswindows}
         raise exception.create('non wrapper timers are not permitted on windows');
       {$else}
         resettimes;
@@ -752,8 +737,6 @@ begin
   end;
   interval := 1000;
   enabled := true;
-  released := false;
-
 end;
 
 destructor tltimer.destroy;
@@ -884,7 +867,7 @@ begin
   if (result > 0) and assigned(onsenddata) then onsenddata(self,result);
   eventcore.wmasterset(fdhandleout);
 end;
-{$ifndef win32}
+{$ifndef mswindows}
   procedure tlasio.myfdclose(fd : integer);
   begin
     fdclose(fd);
@@ -904,7 +887,6 @@ end;
 
 
 begin
-  firstasin := nil;
   firsttask := nil;