use better hash function (FNV-1a)

[lcore.git] / lmessages.pas

diff --git a/lmessages.pas b/lmessages.pas
old mode 100755 (executable)
new mode 100644 (file)
index 7bb73fd..d5521e5
--- a/lmessages.pas
+++ b/lmessages.pas
@@ -1,9 +1,24 @@
+{ Copyright (C) 2005 Bas Steendijk and Peter Green\r
+  For conditions of distribution and use, see copyright notice in zlib_license.txt\r
+  which is included in the package\r
+  ----------------------------------------------------------------------------- }\r
+\r
+//this unit provides a rough approximation of windows messages on linux\r
+//it is useful for multithreaded applications on linux to communicate back to\r
+//the main lcore thread\r
+//This unit is *nix only, on windows you should use the real thing\r
+\r

 unit lmessages;\r
 //windows messages like system based on lcore tasks\r
 interface\r
 \r
 uses pgtypes,sysutils,bsearchtree,strings,syncobjs;\r
 \r
 unit lmessages;\r
 //windows messages like system based on lcore tasks\r
 interface\r
 \r
 uses pgtypes,sysutils,bsearchtree,strings,syncobjs;\r
 \r

+\r
+{$if (fpc_version < 2) or ((fpc_version=2) and ((fpc_release < 2) or ((fpc_release = 2) and (fpc_patch < 2)) ))}\r
+  {$error this code is only supported under fpc 2.2.2 and above due to bugs in the eventobject code in older versions}\r
+{$endif}\r
+\r

 type\r
   lparam=taddrint;\r
   wparam=taddrint;\r
 type\r
   lparam=taddrint;\r
   wparam=taddrint;\r


@@ -58,11 +73,13 @@ type
 const\r
   WS_EX_TOOLWINDOW = $80;\r
   WS_POPUP = longint($80000000);\r
 const\r
   WS_EX_TOOLWINDOW = $80;\r
   WS_POPUP = longint($80000000);\r

+  CW_USEDEFAULT=$80000000;\r

   hinstance=nil;\r
   PM_REMOVE = 1;\r
   WM_USER = 1024;\r
   WM_TIMER = 275;\r
   INFINITE = syncobjs.infinite;\r
   hinstance=nil;\r
   PM_REMOVE = 1;\r
   WM_USER = 1024;\r
   WM_TIMER = 275;\r
   INFINITE = syncobjs.infinite;\r

+\r

 function getwindowlongptr(ahwnd:hwnd;nindex:integer) : taddrint;\r
 function setwindowlongptr(ahwnd:hwnd;nindex:integer;dwNewLong : taddrint) : taddrint;\r
 function DefWindowProc(ahWnd:HWND; auMsg:Integer; awParam:WPARAM; alParam:LPARAM):Integer; stdcall;\r
 function getwindowlongptr(ahwnd:hwnd;nindex:integer) : taddrint;\r
 function setwindowlongptr(ahwnd:hwnd;nindex:integer;dwNewLong : taddrint) : taddrint;\r
 function DefWindowProc(ahWnd:HWND; auMsg:Integer; awParam:WPARAM; alParam:LPARAM):Integer; stdcall;\r


@@ -84,10 +101,11 @@ procedure init;
 \r
 implementation\r
 uses\r
 \r
 implementation\r
 uses\r

-  baseunix,unix,lcore;//,safewriteln;\r
+  baseunix,unix,lcore,unixutil,ltimevalstuff,sockets;//,safewriteln;\r

 {$i unixstuff.inc}\r
 \r
 type\r
 {$i unixstuff.inc}\r
 \r
 type\r

+  \r

   tmessageintransit = class\r
     msg : tmsg;\r
     next : tmessageintransit;\r
   tmessageintransit = class\r
     msg : tmsg;\r
     next : tmessageintransit;\r


@@ -99,7 +117,7 @@ type
     waiting : boolean;\r
     lcorethread : boolean;\r
     nexttimer : ttimeval;\r
     waiting : boolean;\r
     lcorethread : boolean;\r
     nexttimer : ttimeval;\r

-    threadid : integer;\r
+    threadid : tthreadid;\r

   end;\r
   twindow=class\r
     hwnd : hwnd;\r
   end;\r
   twindow=class\r
     hwnd : hwnd;\r


@@ -116,22 +134,22 @@ var
   lcorelinkpiperecv : tlasio;\r
   windows : thashtable;\r
   //I would rather things crash immediately\r
   lcorelinkpiperecv : tlasio;\r
   windows : thashtable;\r
   //I would rather things crash immediately\r

-  //if they use an insufficiant size type\r
+  //if they use an insufficient size type\r

   //than crash after over four billion\r
   //windows have been made ;)\r
   nextwindowhandle : qword = $100000000;\r
   //than crash after over four billion\r
   //windows have been made ;)\r
   nextwindowhandle : qword = $100000000;\r

-{$i ltimevalstuff.inc}\r
+\r

 \r
 //findthreaddata should only be called while holding the structurelock\r
 \r
 //findthreaddata should only be called while holding the structurelock\r

-function findthreaddata(threadid : integer) : tthreaddata;\r
+function findthreaddata(threadid : tthreadid) : tthreaddata;\r

 begin\r
 begin\r

-  result := tthreaddata(findtree(@threaddata,inttostr(threadid)));\r
+  result := tthreaddata(findtree(@threaddata,inttostr(taddrint(threadid))));\r

   if result = nil then begin\r
     result := tthreaddata.create;\r
     result.messageevent := teventobject.create(nil,false,false,inttostr(taddrint(result)));\r
     result.nexttimer := tv_invalidtimebig;\r
     result.threadid := threadid;\r
   if result = nil then begin\r
     result := tthreaddata.create;\r
     result.messageevent := teventobject.create(nil,false,false,inttostr(taddrint(result)));\r
     result.nexttimer := tv_invalidtimebig;\r
     result.threadid := threadid;\r

-    addtree(@threaddata,inttostr(threadid),result);\r
+    addtree(@threaddata,inttostr(taddrint(threadid)),result);\r

   end;\r
 end;\r
 \r
   end;\r
 end;\r
 \r


@@ -145,7 +163,7 @@ begin
     //writeln('freeing thread data object');\r
     athreaddata.free;\r
     //writeln('deleting thread data object from hashtable');\r
     //writeln('freeing thread data object');\r
     athreaddata.free;\r
     //writeln('deleting thread data object from hashtable');\r

-    deltree(@threaddata,inttostr(athreaddata.threadid));\r
+    deltree(@threaddata,inttostr(taddrint(athreaddata.threadid)));\r

     //writeln('finished deleting thread data');\r
   end else begin\r
     //writeln('thread data is not unused');\r
     //writeln('finished deleting thread data');\r
   end else begin\r
     //writeln('thread data is not unused');\r


@@ -217,7 +235,7 @@ begin
         //swriteln('duplicate window class registered with different settings');\r
         raise exception.create('duplicate window class registered with different settings');\r
       end else begin\r
         //swriteln('duplicate window class registered with different settings');\r
         raise exception.create('duplicate window class registered with different settings');\r
       end else begin\r

-        //swriteln('duplicate window class registered with same settings, tollerated');\r
+        //swriteln('duplicate window class registered with same settings, tolerated');\r

       end;\r
     end else begin\r
       //swriteln('about to allocate memory for new windowclass');\r
       end;\r
     end else begin\r
       //swriteln('about to allocate memory for new windowclass');\r


@@ -274,10 +292,10 @@ begin
     window := twindow(findtree(@windows,inttostr(ahwnd)));\r
     if window <> nil then begin\r
       freemem(window.extrawindowmemory);\r
     window := twindow(findtree(@windows,inttostr(ahwnd)));\r
     if window <> nil then begin\r
       freemem(window.extrawindowmemory);\r

-      //writeln('aboute to delete window from windows structure');\r
+      //writeln('about to delete window from windows structure');\r

       deltree(@windows,inttostr(ahwnd));\r
       //writeln('deleted window from windows structure');\r
       deltree(@windows,inttostr(ahwnd));\r
       //writeln('deleted window from windows structure');\r

-      windowthreaddata := tthreaddata(findtree(@threaddata,inttostr(window.threadid)));\r
+      windowthreaddata := tthreaddata(findtree(@threaddata,inttostr(taddrint(window.threadid))));\r

 \r
       if windowthreaddata <> nil then begin\r
         //writeln('found thread data scanning for messages to clean up');\r
 \r
       if windowthreaddata <> nil then begin\r
         //writeln('found thread data scanning for messages to clean up');\r


@@ -394,11 +412,15 @@ begin
       //we have to get the window procedure while the structurelock\r
       //is still held as the window could be destroyed from another thread\r
       //otherwise.\r
       //we have to get the window procedure while the structurelock\r
       //is still held as the window could be destroyed from another thread\r
       //otherwise.\r

-      windowproc := window.windowproc;\r
+      if window <> nil then begin\r
+        windowproc := window.windowproc;\r
+      end else begin\r
+        windowproc := nil;\r
+      end;\r

     finally\r
       structurelock.release;\r
     end;\r
     finally\r
       structurelock.release;\r
     end;\r

-    if window <> nil then begin\r
+    if assigned(windowproc) then begin\r

       result := windowproc(lpmsg.hwnd,lpmsg.message,lpmsg.wparam,lpmsg.lparam);\r
     end else begin\r
       result := -1;\r
       result := windowproc(lpmsg.hwnd,lpmsg.message,lpmsg.wparam,lpmsg.lparam);\r
     end else begin\r
       result := -1;\r


@@ -475,7 +497,7 @@ end;
 \r
 function PeekMessage(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax, wRemoveMsg: UINT): WINBOOL;\r
 begin\r
 \r
 function PeekMessage(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax, wRemoveMsg: UINT): WINBOOL;\r
 begin\r

-  result := getmessageinternal(lpmsg,hwnd,wmsgfiltermin,wmsgfiltermax,PM_REMOVE,true);\r
+  result := getmessageinternal(lpmsg,hwnd,wmsgfiltermin,wmsgfiltermax,wRemoveMsg,true);\r

 end;\r
 \r
 function SetEvent(hEvent:THevent):WINBOOL;\r
 end;\r
 \r
 function SetEvent(hEvent:THevent):WINBOOL;\r


@@ -653,4 +675,4 @@ begin
   end;\r
 end;\r
 \r
   end;\r
 end;\r
 \r

-end.
\ No newline at end of file
+end.\r