Browse Source

*** empty log message ***

florian 24 years ago
parent
commit
dcbb5bac16
3 changed files with 72 additions and 16 deletions
  1. 6 1
      rtl/inc/threadh.inc
  2. 42 9
      rtl/win32/system.pp
  3. 24 6
      rtl/win32/thread.inc

+ 6 - 1
rtl/inc/threadh.inc

@@ -16,6 +16,8 @@
  **********************************************************************}
  **********************************************************************}
 
 
 {$ifdef MT}
 {$ifdef MT}
+type
+   TThreadFunc = function(parameter : pointer) : longint;
 {*****************************************************************************
 {*****************************************************************************
                          Multithread Handling
                          Multithread Handling
 *****************************************************************************}
 *****************************************************************************}
@@ -45,7 +47,10 @@ procedure LeaveCriticalsection(var cs : tcriticalsection);
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.3  2001-01-24 21:47:18  florian
+  Revision 1.4  2001-01-26 16:37:54  florian
+  *** empty log message ***
+
+  Revision 1.3  2001/01/24 21:47:18  florian
     + more MT stuff added
     + more MT stuff added
 
 
   Revision 1.2  2001/01/05 17:35:50  florian
   Revision 1.2  2001/01/05 17:35:50  florian

+ 42 - 9
rtl/win32/system.pp

@@ -28,6 +28,20 @@ interface
 { include system-independent routine headers }
 { include system-independent routine headers }
 {$I systemh.inc}
 {$I systemh.inc}
 
 
+type
+   { the fields of this record are os dependent  }
+   { and they shouldn't be used in a program     }
+   { only the type TCriticalSection is important }
+   TCriticalSection = packed record
+      DebugInfo : pointer;
+      LockCount : longint;
+      RecursionCount : longint;
+      OwningThread : DWord;
+      LockSemaphore : DWord;
+      Reserved : DWord;
+   end;
+
+
 { include threading stuff }
 { include threading stuff }
 {$i threadh.inc}
 {$i threadh.inc}
 
 
@@ -283,9 +297,6 @@ begin
   sbrk:=l;
   sbrk:=l;
 end;
 end;
 
 
-{ include threading stuff, this is os independend part }
-{$I thread.inc}
-
 { include standard heap management }
 { include standard heap management }
 {$I heap.inc}
 {$I heap.inc}
 
 
@@ -649,6 +660,23 @@ begin
 end;
 end;
 
 
 
 
+{*****************************************************************************
+                             Thread Handling
+*****************************************************************************}
+
+const
+  fpucw : word = $1332;
+
+procedure InitFPU;assembler;
+
+  asm
+     fninit
+     fldcw   fpucw
+  end;
+
+{ include threading stuff, this is os independend part }
+{$I thread.inc}
+
 {*****************************************************************************
 {*****************************************************************************
                          SystemUnit Initialization
                          SystemUnit Initialization
 *****************************************************************************}
 *****************************************************************************}
@@ -794,9 +822,6 @@ var
     to check if the call stack can be written on exceptions }
     to check if the call stack can be written on exceptions }
   _SS : longint;
   _SS : longint;
 
 
-const
-  fpucw : word = $1332;
-
 procedure Exe_entry;[public, alias : '_FPC_EXE_Entry'];
 procedure Exe_entry;[public, alias : '_FPC_EXE_Entry'];
   begin
   begin
      IsLibrary:=false;
      IsLibrary:=false;
@@ -812,8 +837,7 @@ procedure Exe_entry;[public, alias : '_FPC_EXE_Entry'];
         movl %eax,Win32StackTop
         movl %eax,Win32StackTop
         movw %ss,%bp
         movw %ss,%bp
         movl %ebp,_SS
         movl %ebp,_SS
-        fninit
-        fldcw   fpucw
+        call InitFPU
         xorl %ebp,%ebp
         xorl %ebp,%ebp
         call PASCALMAIN
         call PASCALMAIN
         popl %ebp
         popl %ebp
@@ -860,6 +884,9 @@ var
        DLL_THREAD_ATTACH :
        DLL_THREAD_ATTACH :
          begin
          begin
            inc(Thread_count);
            inc(Thread_count);
+{$ifdef MT}
+           AllocateThreadVars;
+{$endif MT}
            if assigned(Dll_Thread_Attach_Hook) then
            if assigned(Dll_Thread_Attach_Hook) then
              Dll_Thread_Attach_Hook(DllParam);
              Dll_Thread_Attach_Hook(DllParam);
            Dll_entry:=true; { return value is ignored }
            Dll_entry:=true; { return value is ignored }
@@ -869,6 +896,9 @@ var
            dec(Thread_count);
            dec(Thread_count);
            if assigned(Dll_Thread_Detach_Hook) then
            if assigned(Dll_Thread_Detach_Hook) then
              Dll_Thread_Detach_Hook(DllParam);
              Dll_Thread_Detach_Hook(DllParam);
+{$ifdef MT}
+           ReleaseThreadVars;
+{$endif MT}
            Dll_entry:=true; { return value is ignored }
            Dll_entry:=true; { return value is ignored }
          end;
          end;
        DLL_PROCESS_DETACH :
        DLL_PROCESS_DETACH :
@@ -1393,7 +1423,10 @@ end.
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.4  2001-01-24 21:47:38  florian
+  Revision 1.5  2001-01-26 16:38:03  florian
+  *** empty log message ***
+
+  Revision 1.4  2001/01/24 21:47:38  florian
     + more MT stuff added
     + more MT stuff added
 
 
   Revision 1.3  2001/01/05 15:44:35  florian
   Revision 1.3  2001/01/05 15:44:35  florian

+ 24 - 6
rtl/win32/thread.inc

@@ -41,6 +41,14 @@ function CreateThread(lpThreadAttributes : pointer;
   external 'kernel32' name 'CreateThread';
   external 'kernel32' name 'CreateThread';
 procedure ExitThread(dwExitCode : DWord);
 procedure ExitThread(dwExitCode : DWord);
   external 'kernel32' name 'ExitThread';
   external 'kernel32' name 'ExitThread';
+function GlobalAlloc(uFlags:UINT; dwBytes:DWORD):Pointer;
+  external 'kernel32' name 'GlobalAlloc';
+function GlobalFree(hMem : Pointer):Pointer; external 'kernel32' name 'GlobalFree';
+
+const
+  { GlobalAlloc, GlobalFlags  }
+  GMEM_FIXED = 0;
+  GMEM_ZEROINIT = 64;
 
 
 procedure init_threadvar(var offset : dword;size : dword);[public,alias: 'FPC_INIT_THREADVAR'];
 procedure init_threadvar(var offset : dword;size : dword);[public,alias: 'FPC_INIT_THREADVAR'];
 
 
@@ -72,6 +80,17 @@ procedure AllocateThreadVars;
      TlsSetValue(dataindex,threadvars);
      TlsSetValue(dataindex,threadvars);
   end;
   end;
 
 
+procedure ReleaseThreadVars;
+
+  var
+     threadvars : pointer;
+
+  begin
+     { release thread vars }
+     threadvars:=TlsGetValue(dataindex);
+     GlobalFree(threadvars);
+  end;
+
 procedure InitThread;
 procedure InitThread;
 
 
   begin
   begin
@@ -88,13 +107,9 @@ procedure InitThread;
 
 
 procedure DoneThread;
 procedure DoneThread;
 
 
-  var
-     threadvars : pointer;
-
   begin
   begin
      { release thread vars }
      { release thread vars }
-     threadvars:=TlsGetValue(dataindex);
-     GlobalFree(threadvars);
+     ReleaseThreadVars;
   end;
   end;
 
 
 function ThreadMain(param : pointer) : dword;stdcall;
 function ThreadMain(param : pointer) : dword;stdcall;
@@ -220,7 +235,10 @@ procedure LeaveCriticalSection(var cs : tcriticalsection);
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.2  2001-01-24 21:47:38  florian
+  Revision 1.3  2001-01-26 16:38:03  florian
+  *** empty log message ***
+
+  Revision 1.2  2001/01/24 21:47:38  florian
     + more MT stuff added
     + more MT stuff added
 
 
   Revision 1.1  2001/01/01 19:06:36  florian
   Revision 1.1  2001/01/01 19:06:36  florian