Browse Source

+ more MT stuff added

florian 24 years ago
parent
commit
ddd5f168eb
6 changed files with 169 additions and 19 deletions
  1. 9 4
      rtl/inc/except.inc
  2. 120 2
      rtl/inc/heap.inc
  3. 11 4
      rtl/inc/systemh.inc
  4. 9 4
      rtl/inc/threadh.inc
  5. 10 1
      rtl/win32/system.pp
  6. 10 4
      rtl/win32/thread.inc

+ 9 - 4
rtl/inc/except.inc

@@ -39,8 +39,11 @@ Type
 
 Const
   CatchAllExceptions = -1;
-
+{$ifdef MT}
+ThreadVar
+{$else MT}
 Var
+{$endif MT}
   ExceptAddrStack   : PExceptAddr;
   ExceptObjectStack : PExceptObject;
 
@@ -53,7 +56,7 @@ end;
 {$ifndef HAS_ADDR_STACK_ON_STACK}
 Function PushExceptAddr (Ft: Longint): PJmp_buf ;
   [Public, Alias : 'FPC_PUSHEXCEPTADDR'];saveregisters;
-{$else ADDR_STACK_ON_HEAP}
+{$else HAS_ADDR_STACK_ON_HEAP}
 Function PushExceptAddr (Ft: Longint;_buf,_newaddr : pointer): PJmp_buf ;
   [Public, Alias : 'FPC_PUSHEXCEPTADDR'];saveregisters;
 {$endif HAS_ADDR_STACK_ON_STACK}
@@ -266,7 +269,10 @@ begin
 end;
 {
   $Log$
-  Revision 1.4  2001-01-05 17:35:50  florian
+  Revision 1.5  2001-01-24 21:47:18  florian
+    + more MT stuff added
+
+  Revision 1.4  2001/01/05 17:35:50  florian
   * the info about exception frames is stored now on the stack
   instead on the heap
 
@@ -276,5 +282,4 @@ end;
 
   Revision 1.2  2000/07/13 11:33:42  michael
   + removed logs
-
 }

+ 120 - 2
rtl/inc/heap.inc

@@ -37,6 +37,10 @@
 {$define TestFreeLists}
 {$endif SYSTEMDEBUG}
 
+{$ifdef MT}
+var
+   cs_systemheap : TCriticalSection;
+{$endif MT}
 
 const
   blocksize    = 16;  { at least size of freerecord }
@@ -212,13 +216,31 @@ end;
 
 function SysHeapsize : longint;
 begin
+{$ifdef MT}
+  try
+    EnterCriticalSection(cs_systemheap);
+{$endif MT}    
   Sysheapsize:=internal_heapsize;
+{$ifdef MT}
+  finally
+    LeaveCriticalSection(cs_systemheap);
+  end;
+{$endif MT}
 end;
 
 
 function SysMemavail : longint;
 begin
+{$ifdef MT}
+  try
+    EnterCriticalSection(cs_systemheap);
+{$endif MT}    
   Sysmemavail:=internal_memavail;
+{$ifdef MT}
+  finally
+    LeaveCriticalSection(cs_systemheap);
+  end;
+{$endif MT}
 end;
 
 
@@ -226,6 +248,10 @@ function SysMaxavail : longint;
 var
   hp : pfreerecord;
 begin
+{$ifdef MT}
+  try
+    EnterCriticalSection(cs_systemheap);
+{$endif MT}    
   Sysmaxavail:=heapend-heapptr;
   hp:=freelists[0];
   while assigned(hp) do
@@ -234,6 +260,11 @@ begin
        Sysmaxavail:=hp^.size;
      hp:=hp^.next;
    end;
+{$ifdef MT}
+  finally
+    LeaveCriticalSection(cs_systemheap);
+  end;
+{$endif MT}
 end;
 
 
@@ -243,6 +274,10 @@ var
   s,i,j : longint;
   hp  : pfreerecord;
 begin
+{$ifdef MT}
+  try
+    EnterCriticalSection(cs_systemheap);
+{$endif MT}    
   for i:=1 to maxblock do
    begin
      hp:=freelists[i];
@@ -266,6 +301,11 @@ begin
      hp:=hp^.next;
    end;
   writeln('Main: ',j,' maxsize: ',s);
+{$ifdef MT}
+  finally
+    LeaveCriticalSection(cs_systemheap);
+  end;
+{$endif MT}
 end;
 {$endif}
 
@@ -276,6 +316,10 @@ var
   i,j : longint;
   hp  : pfreerecord;
 begin
+{$ifdef MT}
+  try
+    EnterCriticalSection(cs_systemheap);
+{$endif MT}    
   for i:=0 to maxblock do
    begin
      j:=0;
@@ -290,6 +334,11 @@ begin
       if j<>freecount[i] then
         RunError(204);
     end;
+{$ifdef MT}
+  finally
+    LeaveCriticalSection(cs_systemheap);
+  end;
+{$endif MT}
 end;
 {$endif TestFreeLists}
 
@@ -311,6 +360,10 @@ var
   pbest : pfreerecord;
 {$endif}
 begin
+{$ifdef MT}
+  try
+    EnterCriticalSection(cs_systemheap);
+{$endif MT}    
 { Something to allocate ? }
   if size<=0 then
    begin
@@ -507,6 +560,11 @@ begin
   if test_each then
     TestFreeLists;
 {$endif TestFreeLists}
+{$ifdef MT}
+  finally
+    LeaveCriticalSection(cs_systemheap);
+  end;
+{$endif MT}
 end;
 
 
@@ -586,6 +644,10 @@ var
   pcurrsize,s : longint;
   pcurr : pfreerecord;
 begin
+{$ifdef MT}
+  try
+    EnterCriticalSection(cs_systemheap);
+{$endif MT}    
   if p=nil then
    HandleError(204);
 { fix p to point to the heaprecord }
@@ -618,6 +680,11 @@ begin
   if test_each then
     TestFreeLists;
 {$endif TestFreeLists}
+{$ifdef MT}
+  finally
+    LeaveCriticalSection(cs_systemheap);
+  end;
+{$endif MT}
 end;
 
 
@@ -630,6 +697,10 @@ var
   pcurrsize,s : longint;
   pcurr : pfreerecord;
 begin
+{$ifdef MT}
+  try
+    EnterCriticalSection(cs_systemheap);
+{$endif MT}    
   SysFreeMemSize:=0;
   if size<=0 then
    begin
@@ -675,6 +746,11 @@ begin
   if test_each then
     TestFreeLists;
 {$endif TestFreeLists}
+{$ifdef MT}
+  finally
+    LeaveCriticalSection(cs_systemheap);
+  end;
+{$endif MT}
 end;
 
 
@@ -684,7 +760,16 @@ end;
 
 function SysMemSize(p:pointer):longint;
 begin
+{$ifdef MT}
+  try
+    EnterCriticalSection(cs_systemheap);
+{$endif MT}    
   SysMemSize:=(pheaprecord(pointer(p)-sizeof(theaprecord))^.size and sizemask)-sizeof(theaprecord);
+{$ifdef MT}
+  finally
+    LeaveCriticalSection(cs_systemheap);
+  end;
+{$endif MT}
 end;
 
 
@@ -716,6 +801,10 @@ var
   pnew,
   pcurr : pfreerecord;
 begin
+{$ifdef MT}
+  try
+    EnterCriticalSection(cs_systemheap);
+{$endif MT}    
 { fix needed size }
   size:=(size+sizeof(theaprecord)+(blocksize-1)) and (not (blocksize-1));
 { fix p to point to the heaprecord }
@@ -847,6 +936,11 @@ begin
   if test_each then
     TestFreeLists;
 {$endif TestFreeLists}
+{$ifdef MT}
+  finally
+    LeaveCriticalSection(cs_systemheap);
+  end;
+{$endif MT}
 end;
 
 
@@ -859,6 +953,10 @@ var
   oldsize : longint;
   p2 : pointer;
 begin
+{$ifdef MT}
+  try
+    EnterCriticalSection(cs_systemheap);
+{$endif MT}    
   { Free block? }
   if size=0 then
    begin
@@ -883,6 +981,11 @@ begin
       p:=p2;
     end;
   SysReAllocMem:=p;
+{$ifdef MT}
+  finally
+    LeaveCriticalSection(cs_systemheap);
+  end;
+{$endif MT}
 end;
 
 
@@ -910,6 +1013,10 @@ var
   NewPos    : longint;
   pcurr     : pfreerecord;
 begin
+{$ifdef MT}
+  try
+    EnterCriticalSection(cs_systemheap);
+{$endif MT}    
 {$ifdef DUMPGROW}
   writeln('grow ',size);
   DumpBlocks;
@@ -985,6 +1092,11 @@ begin
 {$ifdef TestFreeLists}
   TestFreeLists;
 {$endif TestFreeLists}
+{$ifdef MT}
+  finally
+    LeaveCriticalSection(cs_systemheap);
+  end;
+{$endif MT}
 end;
 
 
@@ -1006,11 +1118,17 @@ begin
   HeapPtr:=HeapOrg;
   HeapEnd:=HeapOrg+internal_memavail;
   HeapError:=@GrowHeap;
+{$ifdef MT}
+  InitCriticalSection(cs_systemheap);
+{$endif MT}
 end;
 
 {
   $Log$
-  Revision 1.4  2000-08-08 19:22:46  peter
+  Revision 1.5  2001-01-24 21:47:18  florian
+    + more MT stuff added
+
+  Revision 1.4  2000/08/08 19:22:46  peter
     * smallatheapptr undef and other cleanup (merged)
 
   Revision 1.3  2000/07/14 10:33:10  michael
@@ -1018,5 +1136,5 @@ end;
 
   Revision 1.2  2000/07/13 11:33:43  michael
   + removed logs
-
 }
+

+ 11 - 4
rtl/inc/systemh.inc

@@ -173,14 +173,18 @@ var
   Input,
   StdOut,
   StdErr      : Text;
-  ExitCode,
-  InOutRes    : Word;
+  ExitCode    : Word;
   StackBottom,
   LowestStack,
   RandSeed    : Cardinal;
 { Delphi compatible }
   IsLibrary,IsMultiThreaded,IsConsole : boolean;
-
+{$ifdef MT}
+ThreadVar
+{$else MT}
+Var
+{$endif MT}
+  InOutRes    : Word;
 
 {****************************************************************************
                         Processor specific routines
@@ -484,7 +488,10 @@ const
 
 {
   $Log$
-  Revision 1.15  2000-12-16 15:56:19  jonas
+  Revision 1.16  2001-01-24 21:47:18  florian
+    + more MT stuff added
+
+  Revision 1.15  2000/12/16 15:56:19  jonas
     - removed all ifdef cardinalmulfix code
 
   Revision 1.14  2000/12/08 14:04:43  jonas

+ 9 - 4
rtl/inc/threadh.inc

@@ -15,7 +15,7 @@
 
  **********************************************************************}
 
-
+{$ifdef MT}
 {*****************************************************************************
                          Multithread Handling
 *****************************************************************************}
@@ -41,11 +41,16 @@ procedure DoneCriticalsection(var cs : tcriticalsection);
 procedure EnterCriticalsection(var cs : tcriticalsection);
 procedure LeaveCriticalsection(var cs : tcriticalsection);
 
+{$endif MT}
+
 {
   $Log$
-  Revision 1.2  2001-01-05 17:35:50  florian
-  * the info about exception frames is stored now on the stack
-  instead on the heap
+  Revision 1.3  2001-01-24 21:47:18  florian
+    + more MT stuff added
+
+  Revision 1.2  2001/01/05 17:35:50  florian
+    * the info about exception frames is stored now on the stack
+      instead on the heap
 
   Revision 1.1  2001/01/01 19:06:59  florian
     + initial release

+ 10 - 1
rtl/win32/system.pp

@@ -28,6 +28,9 @@ interface
 { include system-independent routine headers }
 {$I systemh.inc}
 
+{ include threading stuff }
+{$i threadh.inc}
+
 { include heap support headers }
 {$I heaph.inc}
 
@@ -280,6 +283,9 @@ begin
   sbrk:=l;
 end;
 
+{ include threading stuff, this is os independend part }
+{$I thread.inc}
+
 { include standard heap management }
 {$I heap.inc}
 
@@ -1387,7 +1393,10 @@ end.
 
 {
   $Log$
-  Revision 1.3  2001-01-05 15:44:35  florian
+  Revision 1.4  2001-01-24 21:47:38  florian
+    + more MT stuff added
+
+  Revision 1.3  2001/01/05 15:44:35  florian
     * some stuff for MT
 
   Revision 1.2  2000/12/18 17:28:58  jonas

+ 10 - 4
rtl/win32/thread.inc

@@ -13,6 +13,7 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
+{$ifdef MT}
 const
    threadvarblocksize : dword = 0;
 
@@ -82,7 +83,7 @@ procedure InitThread;
      { so every thread has its on exception handling capabilities }
      InitExceptions;
      InOutRes:=0;
-     ErrNo:=0;
+     // ErrNo:=0;
   end;
 
 procedure DoneThread;
@@ -214,9 +215,14 @@ procedure EnterCriticalSection(var cs : tcriticalsection);
 procedure LeaveCriticalSection(var cs : tcriticalsection);
   external 'kernel32' name 'LeaveCriticalSection';
 }
+
+{$endif MT}
+
 {
   $Log$
-  Revision 1.1  2001-01-01 19:06:36  florian
-    + initial release
+  Revision 1.2  2001-01-24 21:47:38  florian
+    + more MT stuff added
 
-}
+  Revision 1.1  2001/01/01 19:06:36  florian
+    + initial release
+}