lcore.org gitweb / lcore.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
redefine dvar for convenience
[lcore.git] / lcore.pas
diff --git a/lcore.pas b/lcore.pas
index 77bf4f0674db0b63eebc8df4346c44fb19c7be60..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:tbufferstring; 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 : tbufferstring);virtual;\r
+      procedure putstringinsendbuffer(const newstring : tbufferstring);\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
@@ -405,18 +387,21 @@ 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
 \r
     if closehandles then begin\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
 \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
@@ -459,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 : tbufferstring);\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 : tbufferstring);\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 +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
@@ -540,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
@@ -573,16 +561,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
-            internalclose({$ifdef win32}getlasterror{$else}linuxerror{$endif});\r
-          end  
+          {$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
+            //so do nothing in that case\r
+          end else\r
+          {$endif}\r
+          begin\r
+            internalclose({$ifdef mswindows}getlasterror{$else}linuxerror{$endif});\r
+          end  \r
         end;\r
       end;\r
 \r
         end;\r
       end;\r
 \r
@@ -608,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
@@ -617,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
@@ -634,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
@@ -663,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
@@ -704,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
@@ -720,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
@@ -749,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
@@ -881,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
@@ -901,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
Unnamed repository; edit this file 'description' to name the repository.