+ Native threadvar implementation for Win32 and Win64 (most of it, but not yet complete).

git-svn-id: trunk@23359 -

compiler/ncgld.pas

@@ -330,21 +330,41 @@ implementation
                  begin
                     if (tf_section_threadvars in target_info.flags) then
                       begin
-                        if gvs.localloc.loc=LOC_INVALID then
-                          if not(vo_is_weak_external in gvs.varoptions) then
-                            reference_reset_symbol(location.reference,current_asmdata.RefAsmSymbol(gvs.mangledname),0,location.reference.alignment)
-                          else
-                            reference_reset_symbol(location.reference,current_asmdata.WeakRefAsmSymbol(gvs.mangledname),0,location.reference.alignment)
+                        if target_info.system in [system_i386_win32,system_x86_64_win64] then
+                          begin
+                            paraloc1.init;
+                            pd:=search_system_proc('fpc_tls_add');
+                            paramanager.getintparaloc(pd,1,paraloc1);
+                            if not(vo_is_weak_external in gvs.varoptions) then
+                              reference_reset_symbol(href,current_asmdata.RefAsmSymbol(gvs.mangledname),0,sizeof(pint))
+                            else
+                              reference_reset_symbol(href,current_asmdata.WeakRefAsmSymbol(gvs.mangledname),0,sizeof(pint));
+                            cg.a_loadaddr_ref_cgpara(current_asmdata.CurrAsmList,href,paraloc1);
+                            paramanager.freecgpara(current_asmdata.CurrAsmList,paraloc1);
+                            paraloc1.done;
+
+                            cg.g_call(current_asmdata.CurrAsmList,'FPC_TLS_ADD');
+                            cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_FUNCTION_RESULT_REG);
+                            hregister:=cg.getaddressregister(current_asmdata.CurrAsmList);
+                            cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,NR_FUNCTION_RESULT_REG,hregister);
+                            location.reference.base:=hregister;
+                          end
                         else
-                          location:=gvs.localloc;
+                          begin
+                            if gvs.localloc.loc=LOC_INVALID then
+                              if not(vo_is_weak_external in gvs.varoptions) then
+                                reference_reset_symbol(location.reference,current_asmdata.RefAsmSymbol(gvs.mangledname),0,location.reference.alignment)
+                              else
+                                reference_reset_symbol(location.reference,current_asmdata.WeakRefAsmSymbol(gvs.mangledname),0,location.reference.alignment)
+                            else
+                              location:=gvs.localloc;
 {$ifdef i386}
-                        case target_info.system of
-                          system_i386_linux:
-                            location.reference.segment:=NR_GS;
-                          system_i386_win32:
-                            location.reference.segment:=NR_FS;
-                        end;
+                            case target_info.system of
+                              system_i386_linux:
+                                location.reference.segment:=NR_GS;
+                            end;
 {$endif i386}
+                          end;
                       end
                     else
                       begin

rtl/win/sysosh.inc

@@ -82,3 +82,7 @@ var
 {$ifdef FPC_USE_WIN64_SEH}
 procedure _fpc_local_unwind(frame,target: Pointer);compilerproc;
 {$endif FPC_USE_WIN64_SEH}
+{$ifdef FPC_SECTION_THREADVARS}
+function fpc_tls_add(addr: pointer):pointer;compilerproc;
+{$endif FPC_SECTION_THREADVARS}
+

rtl/win32/system.pp

@@ -557,6 +557,40 @@ begin
 end;
 {$endif Set_i386_Exception_handler}
 
+{$ifdef FPC_SECTION_THREADVARS}
+function fpc_tls_add(addr: pointer): pointer; assembler; nostackframe;
+  [public,alias: 'FPC_TLS_ADD']; compilerproc;
+  asm
+      sub   $tls_data_start,%eax
+      cmpb  $0,IsLibrary
+      mov   _tls_index,%ecx
+      jnz   .L1
+      mov   %fs:(0x2c),%edx
+      add   (%edx,%ecx,4),%eax
+      ret
+.L1:
+      push  %ebx
+      mov   %eax,%ebx
+      call  GetLastError
+      push  %eax                      { save LastError }
+      push  _tls_index
+      call  TlsGetValue
+      test  %eax,%eax
+      jnz   .L2
+      { This can happen when a thread existed before DLL was loaded,
+        or if DisableThreadLibraryCalls was called. }
+      call  SysAllocateThreadVars
+      mov   $0x1000000,%eax
+      call  InitThread
+      push  _tls_index
+      call  TlsGetValue
+.L2:
+      add   %eax,%ebx
+      call  SetLastError              { restore (value is on stack) }
+      mov   %ebx,%eax
+      pop   %ebx
+  end;
+{$endif FPC_SECTION_THREADVARS}
 
 function CheckInitialStkLen(stklen : SizeUInt) : SizeUInt;
   type

rtl/win64/system.pp

@@ -490,6 +490,46 @@ begin
   Exe_entry;
 end;
 
+{$ifdef FPC_SECTION_THREADVARS}
+function fpc_tls_add(addr: pointer): pointer; assembler; nostackframe;
+  [public,alias: 'FPC_TLS_ADD']; compilerproc;
+  asm
+      sub   $56,%rsp                  { 32 spill area + 16 local vars + 8 misalignment }
+  .seh_stackalloc 56
+  .seh_endprologue
+      lea   tls_data_start(%rip),%rax
+      sub   %rax,%rcx
+      cmpb  $0,IsLibrary(%rip)
+      mov   _tls_index(%rip),%eax
+      jnz   .L1
+      mov   %gs:(88),%rdx
+      add   (%rdx,%rax,8),%rcx
+      mov   %rcx,%rax
+      jmp   .L3
+.L1:
+      mov   %rcx,32(%rsp)
+      call  GetLastError
+      mov   %rax,40(%rsp)             { save LastError }
+      mov   _tls_index(%rip),%ecx
+      call  TlsGetValue
+      test  %rax,%rax
+      jnz   .L2
+      { This can happen when a thread existed before DLL was loaded,
+        or if DisableThreadLibraryCalls was called. }
+      call  SysAllocateThreadVars
+      mov   $0x1000000,%rcx
+      call  InitThread
+      mov   _tls_index(%rip),%ecx
+      call  TlsGetValue
+.L2:
+      add   %rax,32(%rsp)
+      mov   40(%rsp),%rcx
+      call  SetLastError
+      mov   32(%rsp),%rax
+.L3:
+      add   $56,%rsp
+  end;
+{$endif FPC_SECTION_THREADVARS}
 
 function CheckInitialStkLen(stklen : SizeUInt) : SizeUInt;
   type