+ initialize threadvars defined local in units

compiler/globals.pas

@@ -143,6 +143,7 @@ interface
        statement_level : integer;
        exceptblockcounter    : integer;  { each except block gets a unique number check gotos      }
        aktexceptblock        : integer;  { the exceptblock number of the current block (0 if none) }
+       have_local_threadvars : boolean;  { set if a table of local threadvars-tables is present and has to be initialized }
 
      { commandline values }
        initdefines        : tstringlist;
@@ -1442,6 +1443,8 @@ implementation
         not_unit_proc:=true;
 
         apptype:=app_cui;
+	
+	have_local_threadvars := false;
      end;
 
 {$ifdef EXTDEBUG}
@@ -1453,7 +1456,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.51  2002-01-24 18:25:48  peter
+  Revision 1.52  2002-03-28 16:07:52  armin
+  + initialize threadvars defined local in units
+
+  Revision 1.51  2002/01/24 18:25:48  peter
    * implicit result variable generation for assembler routines
    * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
 

compiler/i386/cga.pas

@@ -2115,12 +2115,9 @@ implementation
        exprasmlist:=alist;
        if (not inlined) and (aktprocdef.proctypeoption=potype_proginit) then
            begin
-              emitinsertcall('FPC_INITIALIZEUNITS');
-              { initialize profiling for win32 }
-              if (target_info.target=target_I386_WIN32) and
-                 (cs_profile in aktmoduleswitches) then
-                emitinsertcall('__monstartup');
-              { add threadvars }
+	      emitinsertcall('FPC_INITIALIZEUNITS');
+	      
+	      { add global threadvars }
               oldlist:=exprasmlist;
               exprasmlist:=TAAsmoutput.Create;
               p:=symtablestack;
@@ -2132,6 +2129,16 @@ implementation
               oldList.insertlist(exprasmlist);
               exprasmlist.free;
               exprasmlist:=oldlist;
+	      
+	      { add local threadvars in units (only if needed because not all platforms
+	        have threadvar support) }
+	      if have_local_threadvars then
+	        emitinsertcall('FPC_INITIALIZELOCALTHREADVARS');
+              
+              { initialize profiling for win32 }
+              if (target_info.target=target_I386_WIN32) and
+                 (cs_profile in aktmoduleswitches) then
+                emitinsertcall('__monstartup');
            end;
 
 {$ifdef GDB}
@@ -2987,7 +2994,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.16  2002-03-04 19:10:12  peter
+  Revision 1.17  2002-03-28 16:07:52  armin
+  + initialize threadvars defined local in units
+
+  Revision 1.16  2002/03/04 19:10:12  peter
     * removed compiler warnings
 
   Revision 1.15  2002/01/24 18:25:53  peter

compiler/pmodules.pas

@@ -214,7 +214,10 @@ implementation
         dataSegment.concatlist(ResourceStringTables);
         ResourceStringTables.free;
       end;
-
+      
+      
+      
+      
 
     procedure InsertInitFinalTable;
       var
@@ -672,6 +675,67 @@ implementation
            procdef:=aktprocdef;
          end;
       end;
+      
+    procedure insertLocalThreadvarsTablesTable;
+      var
+        hp : tused_unit;
+        ltvTables : taasmoutput;
+        count : longint;
+      begin
+        ltvTables:=TAAsmOutput.Create;
+        count:=0;
+        hp:=tused_unit(usedunits.first);
+        while assigned(hp) do
+         begin
+           If (hp.u.flags and uf_local_threadvars)=uf_local_threadvars then
+            begin
+              ltvTables.concat(Tai_const_symbol.Createname(hp.u.modulename^+'_$LOCALTHREADVARLIST'));
+              inc(count);
+            end;
+           hp:=tused_unit(hp.next);
+         end;
+        { TableCount }
+        ltvTables.insert(Tai_const.Create_32bit(count));
+        ltvTables.insert(Tai_symbol.Createdataname_global('FPC_LOCALTHREADVARTABLES',0));
+        ltvTables.concat(Tai_symbol_end.Createname('FPC_LOCALTHREADVARTABLES'));
+        { insert in data segment }
+        if (cs_create_smart in aktmoduleswitches) then
+          dataSegment.concat(Tai_cut.Create);
+        dataSegment.concatlist(ltvTables);
+        ltvTables.free;
+	if count > 0 then
+  	  have_local_threadvars := true;
+      end;
+      
+      
+      
+    var ltvTable : taasmoutput;
+      
+    procedure addToLocalThreadvarTab(p:tnamedindexitem);
+      var
+        vs   : tvarsym;
+        s    : string;
+	asym : tasmsymbol;
+      begin
+        with tvarsym(p) do
+         begin
+	   if (typ=varsym) and (vo_is_thread_var IN varoptions) then
+	   begin
+	     if ltvTable = nil then
+	     begin   { first threadvar }
+	       ltvTable := TAAsmOutput.Create;
+	       ltvTable.insert(tai_symbol.createdataname_global(current_module.modulename^+'_$LOCALTHREADVARLIST',0));
+	     end;
+	     asym := getasmsymbol('_' + name);
+	     if asym <> nil then
+	     begin
+	       ltvTable.concat(tai_const_symbol.create(asym));    { address of threadvar }
+	       ltvTable.concat(tai_const.create_32bit(getsize));  { size of threadvar }
+	     end;
+	   end;
+         end;
+      end;
+      
 
 
     procedure proc_unit;
@@ -688,7 +752,7 @@ implementation
           ((resourcestringlist=nil) or resourcestringList.empty)
         );
       end;
-
+      
       var
          main_file: tinputfile;
          st     : tsymtable;
@@ -949,6 +1013,18 @@ implementation
                 codeSegment.concat(Tai_cut.Create);
               genimplicitunitfinal(codesegment);
            end;
+	 
+	 { generate a list of local threadvars }  
+	 ltvTable := nil;
+	 st.foreach_static (@addToLocalThreadvarTab);
+	 if ltvTable <> nil then
+	 begin
+	   ltvTable.concat(tai_const.create_32bit(0));  { end of list marker }
+	   ltvTable.concat(tai_symbol_end.createname(current_module.modulename^+'_$LOCALTHREADVARLIST'));
+	   dataSegment.concatlist(ltvTable);
+	   ltvTable.Free;
+	   current_module.flags:=current_module.flags or uf_local_threadvars;
+	 end;
 
          { the last char should always be a point }
          consume(_POINT);
@@ -1223,7 +1299,10 @@ implementation
             aktprocdef.aliasnames.insert('PASCALMAIN');
             aktprocdef.aliasnames.insert(target_info.cprefix+'main');
           end;
+	  writeLn ('1');
+	 insertLocalThreadvarsTablesTable;
          compile_proc_body(true,false);
+	  writeln ('2');
 
          { Add symbol to the exports section for win32 so smartlinking a
            DLL will include the edata section }
@@ -1299,6 +1378,7 @@ implementation
 
          { insert heap }
          insertResourceTablesTable;
+	 
          insertinitfinaltable;
          insertheap;
          inserttargetspecific;
@@ -1349,7 +1429,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.51  2002-01-24 18:25:49  peter
+  Revision 1.52  2002-03-28 16:07:52  armin
+  + initialize threadvars defined local in units
+
+  Revision 1.51  2002/01/24 18:25:49  peter
    * implicit result variable generation for assembler routines
    * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
 

compiler/ppu.pas

@@ -128,6 +128,7 @@ const
   uf_has_resources = $800; { unit has resource section }
   uf_little_endian = $1000;
   uf_release       = $2000;{ unit was compiled with -Ur option }
+  uf_local_threadvars = $4000;  { unit has local threadvars }
 
 type
   ppureal=extended;
@@ -986,7 +987,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.14  2001-12-06 17:57:37  florian
+  Revision 1.15  2002-03-28 16:07:52  armin
+  + initialize threadvars defined local in units
+
+  Revision 1.14  2001/12/06 17:57:37  florian
     + parasym to tparaitem added
 
   Revision 1.13  2001/09/22 04:51:58  carl

rtl/netware/thread.inc

@@ -1,5 +1,5 @@
 {
-    $Id: 
+    $Id$
     This file is part of the Free Pascal run time library.
     Copyright (c) 2001-2002 by the Free Pascal development team.
 
@@ -52,6 +52,44 @@ begin
   {$endif DEBUG_MT}
 end;
 
+type ltvInitEntry = 
+  record
+    varaddr : pdword;
+    size    : longint;
+  end;
+  pltvInitEntry = ^ltvInitEntry;
+
+procedure init_unit_threadvars (tableEntry : pltvInitEntry);
+begin
+  while tableEntry^.varaddr <> nil do
+  begin
+    {$ifdef DEBUG_MT}
+    ConsolePrintf3(#13'init_unit_threadvars, size: %d, addr: %d'#13#10,tableEntry^.size,dword(tableEntry^.varaddr),0);
+    {$endif}
+    init_threadvar (tableEntry^.varaddr^, tableEntry^.size);
+    inc (pchar (tableEntry), sizeof (tableEntry^));
+  end;
+end;
+
+type TltvInitTablesTable =
+  record
+    count : dword;
+    tables: array [1..32767] of pltvInitEntry;
+  end;
+  
+var
+  ThreadvarTablesTable : TltvInitTablesTable; external name 'FPC_LOCALTHREADVARTABLES';
+  
+procedure init_all_unit_threadvars; [public,alias: 'FPC_INITIALIZELOCALTHREADVARS'];
+var i : integer;
+begin
+  {$ifdef DEBUG_MT}
+  ConsolePrintf(#13'init_all_unit_threadvars (%d) units'#13#10,ThreadvarTablesTable.count);
+  {$endif}
+  for i := 1 to ThreadvarTablesTable.count do
+    init_unit_threadvars (ThreadvarTablesTable.tables[i]);
+  
+end;
 
 {$ifdef DEBUG_MT}
 var dummy_buff : array [0..255] of char;  // to avoid abends (for current compiler error that not all threadvars are initialized)
@@ -275,8 +313,15 @@ end;
 procedure InitCriticalSection(var cs : TRTLCriticalSection);
 begin
   cs.SemaHandle := _OpenLocalSemaphore (1);
-  cs.SemaIsOpen := true;
-  SaveSema (cs.SemaHandle);
+  if cs.SemaHandle <> 0 then
+  begin
+    cs.SemaIsOpen := true;
+    SaveSema (cs.SemaHandle);
+  end else
+  begin
+    cs.SemaIsOpen := false;
+    ConsolePrintf (#13'fpc-rtl: InitCriticalsection, OpenLocalSemaphore returned error'#13#10,0);
+  end;
 end;
 
 procedure DoneCriticalsection(var cs : TRTLCriticalSection);
@@ -310,7 +355,10 @@ end;
 
 {
   $Log$
-  Revision 1.1  2002-03-17 17:57:33  armin
+  Revision 1.2  2002-03-28 16:11:17  armin
+  + initialize threadvars defined local in units
+
+  Revision 1.1  2002/03/17 17:57:33  armin
   + threads and winsock2 implemented
 
 }