Merged revisions 7799,7804,7830,7836-7839,7846,7849,7862,7864-7865,7869,7872,7877,7882,7927-7929,7949,7953,7961,7967,7971,7985-7987,7990-7994,7998-8000,8004-8006,8008-8012,8016,8027,8034,8036-8037,8039,8044,8046,8048,8051,8060,8071,8075-8076,8082-8083,8087-8089,8093-8096,8099-8100,8136,8187,8190,8203,8206-8207,8212-8213,8215,8225,8227,8233-8239,8262,8302,8307,8309,8316,8318-8319,8336,8338-8340,8363,8367-8368,8375 via svnmerge from

http://svn.freepascal.org/svn/fpc/trunk

........
  r7799 | florian | 2007-06-24 22:28:40 +0200 (Sun, 24 Jun 2007) | 2 lines
  
  + ModuleIs* typed consts added
........
  r7804 | daniel | 2007-06-24 23:17:43 +0200 (Sun, 24 Jun 2007) | 2 lines
  
    * Fix comparedword and change it to cardinal.
........
  r7949 | jonas | 2007-07-04 20:10:34 +0200 (Wed, 04 Jul 2007) | 10 lines
  
    * made cwstring thread safe without locks + test (twide4): widestring
      manager now has two extra parameterless procedures (ThreadInitProc
      and ThreadFiniProc) which are called whenever a thread begins/ends,
      and cwstring uses these to create separate iconv handles for
      each thread (via threadvars)
    * renamed UCS4 to UCS-4BE/LE, because UCS4 is not recognised by most
      systems
    * clean up all iconv handles on exit, and check whether they are
      valid before doing so
........
  r7985 | marco | 2007-07-09 10:07:42 +0200 (Mon, 09 Jul 2007) | 2 lines
  
   * Safeloadlibrary
........
  r8093 | micha | 2007-07-18 22:13:39 +0200 (Wed, 18 Jul 2007) | 1 line
  
  * dump stack when thread terminates because of exception (unix)
........
  r8094 | micha | 2007-07-18 22:14:48 +0200 (Wed, 18 Jul 2007) | 1 line
  
  * print thread handle unsigned in unix thread debug info
........
  r8363 | michael | 2007-09-02 23:57:51 +0200 (Sun, 02 Sep 2007) | 1 line
  
  * Small patch from Inoussa OUEDRAOGO so it compiles with Delphi
........
  r8367 | yury | 2007-09-03 15:35:54 +0200 (Mon, 03 Sep 2007) | 2 lines
  
  * Patch from Sergei Gorelkin (Mantis #9547). Fixed .fpc.resspare section processing in fpcres. Also remove hardcoded section name offsets (and 3 kBytes of code, too :).
........
  r8368 | yury | 2007-09-03 15:41:38 +0200 (Mon, 03 Sep 2007) | 5 lines
  
  * Patch from Sergei Gorelkin (Mantis #9558):
    - Enables support for resource types;
    - Enables support for numeric resource IDs;
    - Removes initialization and runtime resource info. That initialization only did two pointer additions per resource, but required use of ansistrings and memory manager. I believe that positive impact on resource usage overweights performance impact from inlining the pointer additions...
........
  r8375 | yury | 2007-09-04 14:28:14 +0200 (Tue, 04 Sep 2007) | 1 line
  
  * Fix for tres.pp test by Sergei Gorelkin.
........

git-svn-id: branches/fixes_2_2@8587 -

.gitattributes

@@ -7058,6 +7058,7 @@ tests/test/tw6727.pp svneol=native#text/plain
 tests/test/twide1.pp svneol=native#text/plain
 tests/test/twide2.pp svneol=native#text/plain
 tests/test/twide3.pp svneol=native#text/plain
+tests/test/twide4.pp svneol=native#text/plain
 tests/test/uabstrcl.pp svneol=native#text/plain
 tests/test/uenum2a.pp svneol=native#text/plain
 tests/test/uenum2b.pp svneol=native#text/plain

rtl/inc/dynlibs.pas

@@ -33,6 +33,7 @@ interface
   ---------------------------------------------------------------------}
 
 
+Function SafeLoadLibrary(Name : AnsiString) : TLibHandle;
 Function LoadLibrary(Name : AnsiString) : TLibHandle;
 Function GetProcedureAddress(Lib : TlibHandle; ProcName : AnsiString) : Pointer;
 Function UnloadLibrary(Lib : TLibHandle) : Boolean;
@@ -65,4 +66,22 @@ begin
   Result:=GetProcedureAddress(Lib,Procname);
 end;
 
+Function SafeLoadLibrary(Name : AnsiString) : TLibHandle;
+
+{$ifdef i386}
+ var w : word;
+{$endif}
+
+
+Begin
+{$ifdef i386}
+  w:=get8087cw;
+{$endif}
+ result:=loadlibrary(name);
+
+{$ifdef i386}
+  set8087cw(w);
+{$endif}
+End;
+
 end.

rtl/inc/elfres32.inc

@@ -30,36 +30,30 @@ type
   end;
   PFPCResourceInfo = ^TFPCResourceInfo;
 
-  TFPCRuntimeResourceInfo = packed record
-    reshash: longint;    // always 32bit, contains an ELF hash of the resource entries name
-    restype: longint;    // always 32bit, contains the resource type ID compatible with Windows RES IDs
-    ptr:     pointer;    // Memory pointer to the reosource
-    name:    ansistring; // String containing the name of the resource
-    size:    longint;    // The size of the resource entry - 32/64 Bit, depending on platform
-  end;
-  PFPCRuntimeResourceInfo = ^TFPCRuntimeResourceInfo;
-
 Var
-  InitRes : Boolean = False;
 {$ifdef FPC_HAS_RESOURCES}
   FPCResourceSectionLocation : pFPCResourceSectionTable; external name 'FPC_RESLOCATION';
 {$else}
   FPCResourceSectionLocation : pFPCResourceSectionTable = Nil;
 {$endif}
-  FPCRuntimeResourceInfoArray : PFPCRuntimeResourceInfo;
-  ResInfoCount : Cardinal;
 
-function HashELF(const S : string) : longint;
+const
+  LCase: set of char = ['a'..'z'];
+
+function HashELFUppercase(S: PChar) : longint;
 {Note: this hash function is described in "Practical Algorithms For
        Programmers" by Andrew Binstock and John Rex, Addison Wesley,
        with modifications in Dr Dobbs Journal, April 1996}
 var
-  G : longint;
-  i : longint;
+  G: longint;
+  C: Char;
 begin
   Result := 0;
-  for i := 1 to length(S) do begin
-    Result := (Result shl 4) + ord(S[i]);
+  while S^ <> #0 do begin
+    C := S^;
+    if C in LCase then Dec(ord(C), 32);
+    Result := (Result shl 4) + ord(C);
+    Inc(S);
     G := Result and $F0000000;
     if (G <> 0) then
       Result := Result xor (G shr 24);
@@ -67,82 +61,110 @@ begin
   end;
 end;
 
-procedure InitializeResources;
+Function HINSTANCE : HMODULE;
 
-var
-  i:longint;
-  CurrentResource:pFPCResourceInfo;
+begin
+  Result:=0;
+end;
 
+function _StrIComp(S1, S2: PChar): LongInt;
+var
+  C1, C2: Char;
 begin
-  If (FPCResourceSectionLocation=Nil) then
-    ResInfoCount:=0
-  else
-    ResInfoCount:=FPCResourceSectionLocation^.resentries;
-  If (ResInfoCount<>0) then
+  Result := 0;
+  repeat
+    C1 := S1^;
+    C2 := S2^;
+    Result := ord(C1) - ord(C2);
+    if Result <> 0 then
     begin
-    FPCRuntimeResourceInfoArray:=GetMem(SizeOf(TFPCRuntimeResourceInfo)*ResInfoCount);
-    { we must zero out this because name is an ansistring }
-    fillchar(FPCRuntimeResourceInfoArray^,SizeOf(TFPCRuntimeResourceInfo)*ResInfoCount,0);
-
-    for i:=0 to ResInfoCount-1 do
-      begin
-        CurrentResource:=pFPCResourceInfo(pointer(FPCResourceSectionLocation^.reshash.ptr+i*sizeof(TFPCResourceInfo)));
-        FPCRuntimeResourceInfoArray[i].reshash:=CurrentResource^.reshash;
-        FPCRuntimeResourceInfoArray[i].restype:=CurrentResource^.restype;
-        FPCRuntimeResourceInfoArray[i].ptr:=pointer(CurrentResource^.ptr)+ptruint(FPCResourceSectionLocation^.resdata.ptr);
-        FPCRuntimeResourceInfoArray[i].name:=pchar(CurrentResource^.name)+ptruint(FPCResourceSectionLocation^.ressym.ptr);
-        FPCRuntimeResourceInfoArray[i].size:=CurrentResource^.size;
-      end;
+      if C1 in LCase then Dec(ord(C1), 32);
+      if C2 in LCase then Dec(ord(C2), 32);
+      Result := ord(C1) - ord(C2);
     end;
-  InitRes:=true;
+    Inc(S1);
+    Inc(S2);
+  until (Result <> 0) or ((S1^ = #0) or (S2^ = #0));
 end;
 
-Function HINSTANCE : HMODULE;
-
-begin
-  Result:=0;
-end;
 
 function FindResource(ModuleHandle: HMODULE; ResourceName: PChar; ResourceType: PChar): TResourceHandle;
-
 var
   i:longint;
   searchhash:longint;
-  n : string;
-
+  ResEntry: PFPCResourceInfo;
+  pResName: PChar;
+  tmp: array[0..7] of char;
 begin
   Result:=0;
-  if (ResourceName=nil) then
+  if (ResourceName=nil) or (FPCResourceSectionLocation = nil) then
     Exit;
-  If Not InitRes then
-    InitializeResources;
+    
+  { This is a temporary fix to stay compatible with fpcres
+    which currently converts all string types to RT_RCDATA. }
+  if ResourceType > PChar($FFFF) then
+    ResourceType := PChar(10);
+    
+  { support numeric resource IDs }
+  if ResourceName <= PChar($FFFF) then
+  begin
+    { convert number to string inline, this should be faster than messing with strings }
+    i := LongInt(ResourceName);
+    ResourceName := @tmp[7];
+    ResourceName^ := #0;
+    Dec(ResourceName);
+    repeat
+      ResourceName^ := Char((i mod 10) + ord('0'));
+      Dec(ResourceName);
+      i := i div 10;
+    until i = 0;
+    ResourceName^ := '#';
+  end;
   { resources aren't case sensitive }
-  n:=upcase(strpas(resourcename));
-  searchhash:=HashELF(n);
-  for i:=0 to ResInfoCount-1 do
-    if (FPCRuntimeResourceInfoArray[i].reshash=searchhash) and (upcase(FPCRuntimeResourceInfoArray[i].name)=n) then
+  searchhash := HashELFUppercase(ResourceName);
+  ResEntry := FPCResourceSectionLocation^.reshash.ptr;
+  for i:=0 to FPCResourceSectionLocation^.resentries-1 do
+    with ResEntry[I] do
+    begin
+      if (PChar(ResType) = ResourceType) and (reshash = searchhash) then
       begin
-        result:=i+1;
-        break;
+        pResName := PChar(FPCResourceSectionLocation^.ressym.ptr);
+        Inc(pResName, PtrUInt(Name));
+        if _StrIComp(pResName, ResourceName) = 0 then
+        begin
+          result:=i+1;
+          break;
+        end;
       end;
+    end;
 end;
 
 function LoadResource(ModuleHandle: HMODULE; ResHandle: TResourceHandle): HGLOBAL;
+var
+  ResEntry: PFPCResourceInfo;
 begin
-  If Not InitRes then
-    InitializeResources;
-  if (ResHandle>0) and (ResHandle-1<=ResInfoCount) then
-    result:=HGLOBAL(FPCRuntimeResourceInfoArray[ResHandle-1].ptr)
+  if FPCResourceSectionLocation = nil then
+    Exit;
+  if (ResHandle>0) and (LongInt(ResHandle)-1<=FPCResourceSectionLocation^.resentries) then
+  begin
+    ResEntry := FPCResourceSectionLocation^.reshash.ptr;
+    result := HGLOBAL(PtrUInt(FPCResourceSectionLocation^.resdata.ptr) + PtrUInt(ResEntry[LongInt(ResHandle)-1].ptr));
+  end
   else
     result:=0;
 end;
 
 function SizeofResource(ModuleHandle: HMODULE; ResHandle: TResourceHandle): Integer;
+var
+  ResEntry: PFPCResourceInfo;
 begin
-  If Not InitRes then
-    InitializeResources;
-  if (ResHandle>0) and (ResHandle-1<=ResInfoCount) then
-    result:=FPCRuntimeResourceInfoArray[ResHandle-1].size
+  if FPCResourceSectionLocation = nil then
+    Exit;
+  if (ResHandle>0) and (LongInt(ResHandle)-1<=FPCResourceSectionLocation^.resentries) then
+  begin
+    ResEntry := FPCResourceSectionLocation^.reshash.ptr;
+    result := ResEntry[LongInt(ResHandle)-1].size;
+  end
   else
     result:=0;
 end;

rtl/inc/generic.inc

@@ -262,20 +262,20 @@ end;
 {$ifndef FPC_SYSTEM_HAS_COMPAREDWORD}
 function CompareDWord(Const buf1,buf2;len:SizeInt):SizeInt;
 type
-  longintarray = array [0..high(sizeint) div 4-1] of longint;
+  cardinalarray = array [0..high(sizeint) div 4-1] of cardinal;
 var
-  I : longint;
+  I : int64;
 begin
   I:=0;
   if (Len<>0) and (@Buf1<>@Buf2) then
    begin
-     while (longintarray(Buf1)[I]=longintarray(Buf2)[I]) and (I<Len) do
+     while (cardinalarray(Buf1)[I]=cardinalarray(Buf2)[I]) and (I<Len) do
       inc(I);
      if I=Len then  {No difference}
       I:=0
      else
       begin
-        I:=longintarray(Buf1)[I]-longintarray(Buf2)[I];
+        I:=int64(cardinalarray(Buf1)[I])-int64(cardinalarray(Buf2)[I]);
         if I>0 then
          I:=1
         else

rtl/inc/getopts.pp

@@ -47,20 +47,20 @@ Function GetLongOpts (ShortOpts : String;LongOpts : POption;var Longind : Longin
 
 
 Implementation
-
-{$ifdef TP}
-uses
-  strings;
-{$endif}
-
+{$IFNDEF FPC}
+  {$ifdef TP}
+    uses strings;
+  {$else }
+    uses SysUtils;
+    type PtrInt = Integer;
+  {$endif}
+{$ENDIF FPC}
 
 {***************************************************************************
                                Create an ArgV
 ***************************************************************************}
 
-{$ifdef TP}
-
-
+{$IF not Declared(argv)} //{$ifdef TP}
 
 type
   ppchar = ^pchar;
@@ -134,7 +134,7 @@ begin
   move(argsbuf,argv,count shl 2);
 end;
 
-{$endif TP}
+{$IFEND} //{$endif TP}
 
 {***************************************************************************
                                Real Getopts
@@ -336,7 +336,7 @@ begin
               else
                ambig:=true;
            end;
-          inc(pointer(p),sizeof(toption));
+          inc(PByte(p),sizeof(toption)); //inc(pointer(p),sizeof(toption)); // for Delphi compatibility
           inc(option_index);
         end;
        if ambig and not exact then
@@ -490,10 +490,18 @@ begin
   getlongopts:=internal_getopt(shortopts,longopts,@longind,true);
 end;
 
-
-begin
+{$ifdef FPC}
+    initialization
+{$endif}
+{$ifndef FPC}
+  {$ifdef TP}
+    begin
+  {$else}
+    initialization
+  {$endif}
+{$endif}
 { create argv if running under TP }
-{$ifdef TP}
+{$ifndef FPC}
   setup_arguments;
 {$endif}
 { Needed to detect startup }

rtl/inc/systemh.inc

@@ -357,6 +357,10 @@ const
   { Indicates if there was an error }
   StackError : boolean = FALSE;
   InitProc : Pointer = nil;
+  { compatibility }
+  ModuleIsLib : Boolean = FALSE;
+  ModuleIsPackage : Boolean = FALSE;
+  ModuleIsCpp : Boolean = FALSE;
 
 var
   ExitCode    : Longint; public name 'operatingsystem_result';

rtl/inc/thread.inc

@@ -24,6 +24,10 @@ Var
     procedure InitThread(stklen:SizeUInt);
       begin
         SysResetFPU;
+{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
+        if assigned(widestringmanager.ThreadInitProc) then
+          widestringmanager.ThreadInitProc;
+{$endif FPC_HAS_FEATURE_WIDESTRINGS}
         { ExceptAddrStack and ExceptObjectStack are threadvars       }
         { so every thread has its on exception handling capabilities }
         SysInitExceptions;
@@ -37,6 +41,18 @@ Var
         ThreadID := CurrentTM.GetCurrentThreadID();
       end;
 
+    procedure DoneThread;
+      begin
+{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
+        if assigned(widestringmanager.ThreadFiniProc) then
+          widestringmanager.ThreadFiniProc;
+{$endif FPC_HAS_FEATURE_WIDESTRINGS}
+{$ifndef HAS_MEMORYMANAGER}
+        FinalizeHeap;
+{$endif HAS_MEMORYMANAGER}
+        CurrentTM.ReleaseThreadVars;
+      end;
+
 {*****************************************************************************
                             Overloaded functions
 *****************************************************************************}

rtl/inc/wstringh.inc

@@ -71,6 +71,8 @@ Type
     StrLICompAnsiStringProc : function(S1, S2: PChar; MaxLen: PtrUInt): PtrInt;
     StrLowerAnsiStringProc : function(Str: PChar): PChar;
     StrUpperAnsiStringProc : function(Str: PChar): PChar;
+    ThreadInitProc : procedure;
+    ThreadFiniProc : procedure;
   end;
 
 

rtl/unix/cwstring.pp

@@ -44,16 +44,7 @@ Const
     libiconvname='iconv';
 {$endif}
 
-{ Case-mapping "arrays" }
-var
-  AnsiUpperChars: AnsiString; // 1..255
-  AnsiLowerChars: AnsiString; // 1..255
-  WideUpperChars: WideString; // 1..65535
-  WideLowerChars: WideString; // 1..65535
-
-{ the following declarations are from the libc unit for linux so they
-  might be very linux centric
-  maybe this needs to be splitted in an os depend way later }
+{ helper functions from libc }
 function towlower(__wc:wint_t):wint_t;cdecl;external libiconvname name 'towlower';
 function towupper(__wc:wint_t):wint_t;cdecl;external libiconvname name 'towupper';
 function wcscoll (__s1:pwchar_t; __s2:pwchar_t):cint;cdecl;external libiconvname name 'wcscoll';
@@ -99,9 +90,11 @@ const
 
 { unicode encoding name }
 {$ifdef FPC_LITTLE_ENDIAN}
-  unicode_encoding = 'UTF-16LE';
+  unicode_encoding2 = 'UTF-16LE';
+  unicode_encoding4 = 'UCS-4LE'; 
 {$else  FPC_LITTLE_ENDIAN}
-  unicode_encoding = 'UTF-16BE';
+  unicode_encoding2 = 'UTF-16BE';
+  unicode_encoding4 = 'UCS-4BE';
 {$endif  FPC_LITTLE_ENDIAN}
 
 type
@@ -122,33 +115,11 @@ function iconv(__cd:iconv_t; __inbuf:ppchar; __inbytesleft:psize_t; __outbuf:ppc
 function iconv_close(__cd:iconv_t):cint;cdecl;external libiconvname name 'libiconv_close';
 {$endif}
 
-var
+threadvar
   iconv_ansi2ucs4,
   iconv_ucs42ansi,
   iconv_ansi2wide,
   iconv_wide2ansi : iconv_t;
-  
-  lock_ansi2ucs4 : integer = -1;
-  lock_ucs42ansi : integer = -1;
-  lock_ansi2wide : integer = -1;
-  lock_wide2ansi : integer = -1;
-
-  iconv_lock : TRTLcriticalsection;
-
-{
-procedure lockiconv(var lockcount: integer);
-begin
- while interlockedincrement(lockcount) <> 0 do begin
-  interlockeddecrement(lockcount);
-  sleep(0);
- end;
-end;
-
-procedure unlockiconv(var lockcount: integer);
-begin
- interlockeddecrement(lockcount);
-end;
-}
  
 {$ifdef beos}
 function nl_langinfo(__item:nl_item):pchar;
@@ -178,7 +149,6 @@ procedure Wide2AnsiMove(source:pwidechar;var dest:ansistring;len:SizeInt);
     srcpos:=source;
     destpos:=pchar(dest);
     outleft:=outlength;
-    entercriticalsection(iconv_lock);
     while iconv(iconv_wide2ansi,ppchar(@srcpos),@srclen,@destpos,@outleft)=size_t(-1) do
       begin
         case fpgetCerrno of
@@ -204,11 +174,9 @@ procedure Wide2AnsiMove(source:pwidechar;var dest:ansistring;len:SizeInt);
               destpos:=pchar(dest)+outoffset;
             end;
           else
-            leavecriticalsection(iconv_lock);
             runerror(231);
         end;
       end;
-    leavecriticalsection(iconv_lock);
     // truncate string
     setlength(dest,length(dest)-outleft);
   end;
@@ -233,7 +201,6 @@ procedure Ansi2WideMove(source:pchar;var dest:widestring;len:SizeInt);
     srcpos:=source;
     destpos:=pchar(dest);
     outleft:=outlength*2;
-    entercriticalsection(iconv_lock);
     while iconv(iconv_ansi2wide,@srcpos,psize(@len),@destpos,@outleft)=size_t(-1) do
       begin
         case fpgetCerrno of
@@ -259,11 +226,9 @@ procedure Ansi2WideMove(source:pchar;var dest:widestring;len:SizeInt);
               destpos:=pchar(dest)+outoffset;
             end;
           else
-            leavecriticalsection(iconv_lock);
             runerror(231);
         end;
       end;
-    leavecriticalsection(iconv_lock);
     // truncate string
     setlength(dest,length(dest)-outleft div 2);
   end;
@@ -308,7 +273,6 @@ procedure Ansi2UCS4Move(source:pchar;var dest:UCS4String;len:SizeInt);
     srcpos:=source;
     destpos:=pchar(dest);
     outleft:=outlength*4;
-    entercriticalsection(iconv_lock);
     while iconv(iconv_ansi2ucs4,@srcpos,psize(@len),@destpos,@outleft)=size_t(-1) do
       begin
         case fpgetCerrno of
@@ -323,11 +287,9 @@ procedure Ansi2UCS4Move(source:pchar;var dest:UCS4String;len:SizeInt);
               destpos:=pchar(dest)+outoffset;
             end;
           else
-            leavecriticalsection(iconv_lock);
             runerror(231);
         end;
       end;
-    leavecriticalsection(iconv_lock);
     // truncate string
     setlength(dest,length(dest)-outleft div 4);
   end;
@@ -355,6 +317,28 @@ function StrCompAnsi(s1,s2 : PChar): PtrInt;
   end;
 
 
+procedure InitThread;
+begin
+  iconv_wide2ansi:=iconv_open(nl_langinfo(CODESET),unicode_encoding2);
+  iconv_ansi2wide:=iconv_open(unicode_encoding2,nl_langinfo(CODESET));
+  iconv_ucs42ansi:=iconv_open(nl_langinfo(CODESET),unicode_encoding4);
+  iconv_ansi2ucs4:=iconv_open(unicode_encoding4,nl_langinfo(CODESET));
+end;
+
+
+procedure FiniThread;
+begin
+  if (iconv_wide2ansi <> iconv_t(-1)) then
+    iconv_close(iconv_wide2ansi);
+  if (iconv_ansi2wide <> iconv_t(-1)) then
+    iconv_close(iconv_ansi2wide);
+  if (iconv_ucs42ansi <> iconv_t(-1)) then
+    iconv_close(iconv_ucs42ansi);
+  if (iconv_ansi2ucs4 <> iconv_t(-1)) then
+    iconv_close(iconv_ansi2ucs4);
+end;
+
+
 Procedure SetCWideStringManager;
 Var
   CWideStringManager : TWideStringManager;
@@ -386,6 +370,8 @@ begin
       StrLowerAnsiStringProc
       StrUpperAnsiStringProc
       }
+      ThreadInitProc:=@InitThread;
+      ThreadFiniProc:=@FiniThread;
     end;
   SetWideStringManager(CWideStringManager);
 end;
@@ -393,19 +379,15 @@ end;
 
 initialization
   SetCWideStringManager;
-  initcriticalsection(iconv_lock);
 
   { you have to call setlocale(LC_ALL,'') to initialise the langinfo stuff  }
   { with the information from the environment variables according to POSIX  }
   { (some OSes do this automatically, but e.g. Darwin and Solaris don't)    }
   setlocale(LC_ALL,'');
 
-  { init conversion tables }
-  iconv_wide2ansi:=iconv_open(nl_langinfo(CODESET),unicode_encoding);
-  iconv_ansi2wide:=iconv_open(unicode_encoding,nl_langinfo(CODESET));
-  iconv_ucs42ansi:=iconv_open(nl_langinfo(CODESET),'UCS4');
-  iconv_ansi2ucs4:=iconv_open('UCS4',nl_langinfo(CODESET));
+  { init conversion tables for main program }
+  InitThread;
 finalization
-  donecriticalsection(iconv_lock);
-  iconv_close(iconv_ansi2wide);
+  { fini conversion tables for main program }
+  FiniThread;
 end.

rtl/unix/tthread.inc

@@ -73,19 +73,21 @@ end;
 function ThreadFunc(parameter: Pointer): ptrint;
 var
   LThread: TThread;
+  lErrorAddr, lErrorBase: Pointer;
 begin
   WRITE_DEBUG('ThreadFunc is here...');
   LThread := TThread(parameter);
-  WRITE_DEBUG('thread initing, parameter = ', ptrint(LThread));
+  WRITE_DEBUG('thread initing, parameter = ', ptruint(LThread));
   try
     // wait until AfterConstruction has been called, so we cannot
     // free ourselves before TThread.Create has finished
     // (since that one may check our VTM in case of $R+, and
     //  will call the AfterConstruction method in all cases)
 //    LThread.Suspend;
-    WRITE_DEBUG('AfterConstruction should have been called for ',ptrint(lthread));
+    WRITE_DEBUG('AfterConstruction should have been called for ',ptruint(lthread));
     if LThread.FInitialSuspended then
       begin
+        WRITE_DEBUG('thread ', ptruint(LThread), ' waiting for semaphore ', ptruint(LThread.FSem));
         CurrentTM.SemaphoreWait(LThread.FSem);
         if not(LThread.FTerminated) then
           begin
@@ -94,8 +96,12 @@ begin
                 LThread.FInitialSuspended := false;
                 WRITE_DEBUG('going into LThread.Execute');
                 LThread.Execute;
-              end;
-          end;
+              end
+            else
+              WRITE_DEBUG('thread ', ptruint(LThread), ' initially created suspended, resumed, but still suspended?!');
+          end
+        else
+          WRITE_DEBUG('initially created suspended, but already terminated');
       end
      else
        begin
@@ -104,8 +110,14 @@ begin
        end;
   except
     on e: exception do begin
-      WRITE_DEBUG('got exception: ',e.message);
       LThread.FFatalException := TObject(AcquireExceptionObject);
+      lErrorAddr:=ExceptAddr;
+      lErrorBase:=ExceptFrames^;
+      writeln(stderr,'Exception caught in thread $',hexstr(LThread),
+        ' at $',hexstr(lErrorAddr));
+      writeln(stderr,BackTraceStrFunc(lErrorAddr));
+      dump_stack(stderr,lErrorBase);
+      writeln(stderr);
       // not sure if we should really do this...
       // but .Destroy was called, so why not try FreeOnTerminate?
       if e is EThreadDestroyCalled then LThread.FFreeOnTerminate := true;
@@ -118,7 +130,7 @@ begin
   LThread.DoTerminate;
   if LThread.FreeOnTerminate then
     begin
-      WRITE_DEBUG('Thread ',ptrint(lthread),' should be freed');
+      WRITE_DEBUG('Thread ',ptruint(lthread),' should be freed');
       LThread.Free;
       WRITE_DEBUG('Thread freed');
       WRITE_DEBUG('thread func calling EndThread');
@@ -144,6 +156,7 @@ begin
   FSem := CurrentTM.SemaphoreInit();
   if FSem = nil then
     raise EThread.create('Semaphore init failed (possibly too many concurrent threads)');
+  WRITE_DEBUG('thread ', ptruint(self), ' created semaphore ', ptruint(FSem));
   FSuspended := CreateSuspended;
   FSuspendedExternal := false;
   FThreadReaped := false;
@@ -153,7 +166,7 @@ begin
   FHandle:= BeginThread(@ThreadFunc, Pointer(Self), FThreadID, StackSize);
   if FHandle = TThreadID(0) then
     raise EThread.create('Failed to create new thread');
-  WRITE_DEBUG('TThread.Create done, fhandle = ', ptrint(fhandle));
+  WRITE_DEBUG('TThread.Create done, fhandle = ', ptruint(fhandle));
 end;
 
 
@@ -237,7 +250,7 @@ begin
       if FSuspended and
          (InterLockedExchange(longint(FSuspended),ord(false)) = ord(true)) then
         begin
-          WRITE_DEBUG('resuming ',ptrint(self));
+          WRITE_DEBUG('resuming ',ptruint(self));
           CurrentTM.SemaphorePost(FSem);
         end
     end
@@ -257,7 +270,7 @@ end;
 
 function TThread.WaitFor: Integer;
 begin
-  WRITE_DEBUG('waiting for thread ',ptrint(FHandle));
+  WRITE_DEBUG('waiting for thread ',ptruint(FHandle));
   WaitFor := WaitForThreadTerminate(FHandle, 0);
   { should actually check for errors in WaitForThreadTerminate, but no }
   { error api is defined for that function                             }

tests/test/twide4.pp

@@ -0,0 +1,92 @@
+
+{$ifdef fpc}
+{$mode objfpc}
+{$endif fpc}
+
+uses
+{$ifdef unix}
+  cthreads, cwstring,
+{$endif}
+  Classes, SysUtils;
+
+type
+  tc = class(tthread)
+    orgstr: ansistring;
+    cnvstr: widestring;
+    constructor create(const s: ansistring; const w: widestring);
+    procedure execute; override;
+  end;
+
+const
+  // string with an invalid utf-8 code sequence
+  str1 = #$c1#$34'Życie'#$c1#$34' jest jak papier '#$c1#$34'toaletowy'#$c1#$34' : długie, szare i '#$c1#$34'do'#$c1#$34' dupy';
+  str2 = 'Życie '#$c1#$34'jest'#$c1#$34' jak papier toaletowy : '#$c1#$34'długie'#$c1#$34', szare i do '#$c1#$34'dupy'#$c1#$34'222222222222222222222222222222222222222222222222';
+  str3 = 'Życie jest '#$c1#$34'jak'#$c1#$34' papier 333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333 toaletowy : długie, '#$c1#$34'szare'#$c1#$34' i do dupy';
+  str4 = 'Życie jest 4444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444 jak '#$c1#$34'papier'#$c1#$34' toaletowy : długie, szare '#$c1#$34'i'#$c1#$34' do dupy';
+  count = 20000;
+
+var
+  wstr: widestring;
+//  cnvstr: ansistring;
+  error: boolean;
+
+
+constructor tc.create(const s: ansistring; const w: widestring);
+begin
+  orgstr:=s;
+  cnvstr:=w;
+  inherited create(true);
+end;
+
+
+procedure tc.execute;
+var
+  i: longint;
+  w: widestring;
+begin
+  for i := 1 to count do
+    begin
+      w:=orgstr;
+      if (w<>cnvstr) then
+        error:=true;
+    end;
+end;
+
+var
+  a: array[1..4] of tc;
+  w1,w2,w3,w4: widestring;
+  cnvstr: ansistring;
+begin
+  error:=false;
+  cnvstr:=str1;
+  w1:=cnvstr;
+  cnvstr:=str2;
+  w2:=cnvstr;
+  cnvstr:=str3;
+  w3:=cnvstr;
+  cnvstr:=str4;
+  w4:=cnvstr;
+  writeln(w1);
+  writeln(w2);
+  writeln(w3);
+  writeln(w4);
+  a[1]:=tc.create(str1,w1);
+  a[2]:=tc.create(str2,w2);
+  a[3]:=tc.create(str3,w3);
+  a[4]:=tc.create(str4,w4);
+  a[1].resume;
+  a[2].resume;
+  a[3].resume;
+  a[4].resume;
+  a[1].waitfor;
+  a[2].waitfor;
+  a[3].waitfor;
+  a[4].waitfor;
+  a[1].free;
+  a[2].free;
+  a[3].free;
+  a[4].free;
+  
+  if error then
+    halt(1);  
+end.

utils/fpcres/elfres.pas

@@ -76,11 +76,12 @@ uses
 
 const fpcres2elf_version=1;
 
+type
+  TSectionKind = (skSymtab, skStrtab, skShstrtab, skText, skData, skBss, skFpcRessym, skFpcResstr,
+                  skFpcReshash, skFpcResdata, skFpcResspare);
+
 // Do not change the following consts, they are dummy tables to generate an .o that makes ld happy
-const shstrtab = #0+'.symtab'+#0+'.strtab'+#0+'.shstrtab'+#0+'.text'+#0+'.data'+#0+
-                 '.bss'+#0+'.fpc.ressym'+#0+'.fpc.resstr'+#0+'.fpc.reshash'+#0+
-                 '.fpc.resdata'+#0+'.fpc.resspare'+#0+#0;
-      symtab =   #$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00+
+const symtab =   #$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00+
                  #$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$03#$00#$01#$00+
                  #$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$03#$00#$02#$00+
                  #$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$03#$00#$03#$00+
@@ -91,7 +92,6 @@ const shstrtab = #0+'.symtab'+#0+'.strtab'+#0+'.shstrtab'+#0+'.text'+#0+'.data'+
                  #$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$03#$00#$08#$00;
       strtab =   #$00#$00; // this actually is just one byte long
       zeros  =   #$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00;
-      fake   =   'fakefakefakefakefakefakefakefake';
 
       // header of a windows 32 bit .res file (16 bytes)
       reshdr =   #$00#$00#$00#$00#$20#$00#$00#$00#$FF#$FF#$00#$00#$FF#$FF#$00#$00+
@@ -112,6 +112,8 @@ Type
     FOverwrite: Boolean;
     FVerbose: Boolean;
     FVersion: Integer;
+    FShStrTab: string;
+    FShStrOffsets: array[TSectionKind] of Longint;
   Protected
     FSectionStream: TMemoryStream;
     FDataStream: TMemoryStream;
@@ -146,6 +148,7 @@ Type
   Protected
     Procedure AllocateData; override;
     Procedure FreeData; override;
+    procedure AddSection(aKind: TSectionKind; atype, aflags, aaddr, aoffset, asize, alink, ainfo, aaddralign, aentsize: longint);
   public
     procedure LoadBinaryDFMEntry(const rs:TStream; const DataStream:TMemoryStream; const SymStream:TMemoryStream; var resinfo:TELF32ResourceInfo);
     procedure LoadTextDFMEntry(const rs:TStream; const DataStream:TMemoryStream; const SymStream:TMemoryStream; var resinfo:TELF32ResourceInfo);
@@ -198,12 +201,35 @@ end;
 
 { TElfResCreator }
 
+const
+  sectionNames: array[TSectionKind] of PChar = (
+    '.symtab',
+    '.strtab',
+    '.shstrtab',
+    '.text',
+    '.data',
+    '.bss',
+    '.fpc.ressym',
+    '.fpc.resstr',
+    '.fpc.reshash',
+    '.fpc.resdata',
+    '.fpc.resspare'
+  );
+
 procedure TElfResCreator.AllocateData;
+var
+  i: TSectionKind;
 begin
   FSectionStream:=TMemoryStream.Create;
   FDataStream:=TMemoryStream.Create;
   FSymStream:=TMemoryStream.Create;
   FHashStream:=TMemoryStream.Create;
+  for i := Low(TSectionKind) to High(TSectionKind) do
+  begin
+    FShStrOffsets[i] := Length(FShStrTab) + 1;
+    FShStrTab := FShStrTab + #0 + string(sectionNames[i]);
+  end;
+  FShStrTab := FShStrTab + #0#0;
 end;
 
 procedure TElfResCreator.FreeData;
@@ -412,6 +438,23 @@ begin
   end;
 end;
 
+procedure TElf32ResCreator.AddSection(aKind: TSectionKind; atype, aflags, aaddr, aoffset, asize, alink, ainfo, aaddralign, aentsize: longint);
+var
+  sechdr: TElf32sechdr;
+begin
+  sechdr.sh_name := FShStrOffsets[aKind];
+  sechdr.sh_type := atype;
+  sechdr.sh_flags := aflags;
+  sechdr.sh_addr := aaddr;
+  sechdr.sh_offset := aoffset;
+  sechdr.sh_size := asize;
+  sechdr.sh_link := alink;
+  sechdr.sh_info := ainfo;
+  sechdr.sh_addralign := aaddralign;
+  sechdr.sh_entsize := aentsize;
+  FSectionStream.Write(sechdr, sizeOf(sechdr));
+end;
+
 procedure TElf32ResCreator.DoConvertStreams(Source, Dest: TStream);
 
 Var
@@ -494,7 +537,7 @@ begin
 
   // shstrtab - this is not aligned
   shstrtab_ofs:=FSectionStream.Position+sizeof(TElf32Header);
-  FSectionStream.Write(shstrtab[1],length(shstrtab));
+  FSectionStream.Write(FShStrtab[1], length(FShStrtab));
 
   // Write 12 section headers. The headers itself don't need to be aligned,
   // as their size can be divided by 4. As shstrtab is uneven and not aligned,
@@ -506,149 +549,17 @@ begin
   fillchar(SectionHeader,sizeof(SectionHeader),0);
   FSectionStream.Write(SectionHeader,sizeOf(SectionHeader));
 
-  // .text
-  SectionHeader.sh_name:=$1B;
-  SectionHeader.sh_type:=1; // PROGBITS
-  SectionHeader.sh_flags:=6; // AX
-  SectionHeader.sh_addr:=0;
-  SectionHeader.sh_offset:=sizeof(TElf32Header); // after header, dummy as size is 0
-  SectionHeader.sh_size:=0; // yep, pretty empty it is
-  SectionHeader.sh_link:=0;
-  SectionHeader.sh_info:=0;
-  SectionHeader.sh_addralign:=4; // alignment
-  SectionHeader.sh_entsize:=0;
-  FSectionStream.Write(SectionHeader,sizeOf(SectionHeader));
-
-  // .data
-  SectionHeader.sh_name:=$21;
-  SectionHeader.sh_type:=1; // PROGBITS
-  SectionHeader.sh_flags:=3; // WA
-  SectionHeader.sh_addr:=0;
-  SectionHeader.sh_offset:=sizeof(TElf32Header); // after header, dummy as size is 0
-  SectionHeader.sh_size:=0; // yep, pretty empty it is
-  SectionHeader.sh_link:=0;
-  SectionHeader.sh_info:=0;
-  SectionHeader.sh_addralign:=4; // alignment
-  SectionHeader.sh_entsize:=0;
-  FSectionStream.Write(SectionHeader,sizeOf(SectionHeader));
-
-  // .bss
-  SectionHeader.sh_name:=$27;
-  SectionHeader.sh_type:=8; // NOBITS
-  SectionHeader.sh_flags:=3; // WA
-  SectionHeader.sh_addr:=0;
-  SectionHeader.sh_offset:=sizeof(TElf32Header); // after header, dummy as size is 0
-  SectionHeader.sh_size:=0; // yep, pretty empty it is
-  SectionHeader.sh_link:=0;
-  SectionHeader.sh_info:=0;
-  SectionHeader.sh_addralign:=4; // alignment
-  SectionHeader.sh_entsize:=0;
-  FSectionStream.Write(SectionHeader,sizeOf(SectionHeader));
-
-  // .fpc.ressym
-  SectionHeader.sh_name:=$2C;
-  SectionHeader.sh_type:=1; // PROGBITS
-  SectionHeader.sh_flags:=2; // A
-  SectionHeader.sh_addr:=0;
-  SectionHeader.sh_offset:=ressym.ptr; // directly after header
-  SectionHeader.sh_size:=FSymStream.Size;
-  SectionHeader.sh_link:=0;
-  SectionHeader.sh_info:=0;
-  SectionHeader.sh_addralign:=1; // DON'T align this, as this section will be merged by ld
-  SectionHeader.sh_entsize:=0;
-  FSectionStream.Write(SectionHeader,sizeOf(SectionHeader));
-
-  // .fpc.resstr
-  SectionHeader.sh_name:=$38;
-  SectionHeader.sh_type:=1; // PROGBITS
-  SectionHeader.sh_flags:=2; // A
-  SectionHeader.sh_addr:=0;
-  SectionHeader.sh_offset:=resstr.ptr;
-  SectionHeader.sh_size:=0; // currently empty
-  SectionHeader.sh_link:=0;
-  SectionHeader.sh_info:=0;
-  SectionHeader.sh_addralign:=4; // alignment
-  SectionHeader.sh_entsize:=0;
-  FSectionStream.Write(SectionHeader,sizeOf(SectionHeader));
-
-  // .fpc.reshash
-  SectionHeader.sh_name:=$44;
-  SectionHeader.sh_type:=1; // PROGBITS
-  SectionHeader.sh_flags:=2; // A
-  SectionHeader.sh_addr:=0;
-  SectionHeader.sh_offset:=reshash.ptr;
-  SectionHeader.sh_size:=length(ResourceEntries)*sizeof(TELF32ResourceInfo);
-  SectionHeader.sh_link:=0;
-  SectionHeader.sh_info:=0;
-  SectionHeader.sh_addralign:=4; // alignment
-  SectionHeader.sh_entsize:=0;
-  FSectionStream.Write(SectionHeader,sizeOf(SectionHeader));
-
-  // .fpc.resdata
-  SectionHeader.sh_name:=$51;
-  SectionHeader.sh_type:=1; // PROGBITS
-  SectionHeader.sh_flags:=2; // A
-  SectionHeader.sh_addr:=0;
-  SectionHeader.sh_offset:=resdata.ptr;
-  SectionHeader.sh_size:=FDataStream.Size;
-  SectionHeader.sh_link:=0;
-  SectionHeader.sh_info:=0;
-  SectionHeader.sh_addralign:=4; // alignment
-  SectionHeader.sh_entsize:=0;
-  FSectionStream.Write(SectionHeader,sizeOf(SectionHeader));
-
-  // .fpc.resspare
-  // Not used in V1
-  SectionHeader.sh_name:=$5f;
-  SectionHeader.sh_type:=8; // NOBITS
-  SectionHeader.sh_flags:=2; // A
-  SectionHeader.sh_addr:=0;
-  SectionHeader.sh_offset:=resspare.ptr; // fake, as it's empty, should be equal to shstrtab's offset
-  SectionHeader.sh_size:=0; //DataStream.Size; // Leave as much room as we currently have in resdata section
-  SectionHeader.sh_link:=0;
-  SectionHeader.sh_info:=0;
-  SectionHeader.sh_addralign:=4; // alignment
-  SectionHeader.sh_entsize:=0;
-  FSectionStream.Write(SectionHeader,sizeOf(SectionHeader));
-
-  // .shstrtab
-  SectionHeader.sh_name:=$11;
-  SectionHeader.sh_type:=3; // STRTAB
-  SectionHeader.sh_flags:=0;
-  SectionHeader.sh_addr:=0;
-  SectionHeader.sh_offset:=shstrtab_ofs;  // $3E
-  SectionHeader.sh_size:=$67;
-  SectionHeader.sh_link:=0;
-  SectionHeader.sh_info:=0;
-  SectionHeader.sh_addralign:=1; // alignment
-  SectionHeader.sh_entsize:=0;
-  FSectionStream.Write(SectionHeader,sizeOf(SectionHeader));
-
-  // .symtab
-  SectionHeader.sh_name:=$01;
-  SectionHeader.sh_type:=2; // SYMTAB
-  SectionHeader.sh_flags:=0;
-  SectionHeader.sh_addr:=0;
-  SectionHeader.sh_offset:=FSectionStream.Position+sizeof(TElf32Header)+sizeOf(SectionHeader)+sizeOf(SectionHeader); // will come directly after this and the next section. $0288;
-  SectionHeader.sh_size:=$90;
-  SectionHeader.sh_link:=$0B;
-  SectionHeader.sh_info:=$09;
-  SectionHeader.sh_addralign:=4; // alignment
-  SectionHeader.sh_entsize:=$10;
-  FSectionStream.Write(SectionHeader,sizeOf(SectionHeader));
-
-  // .strtab
-  SectionHeader.sh_name:=$09;
-  SectionHeader.sh_type:=3; // STRTAB
-  SectionHeader.sh_flags:=0;
-  SectionHeader.sh_addr:=0;
-  SectionHeader.sh_offset:=FSectionStream.Position+sizeof(TElf32Header)+sizeOf(SectionHeader)+$90; // will come after this sectionheader and the $90 bytes symtab - $0318; end of file
-  SectionHeader.sh_size:=1;
-  SectionHeader.sh_link:=0;
-  SectionHeader.sh_info:=0;
-  SectionHeader.sh_addralign:=1; // alignment
-  SectionHeader.sh_entsize:=$0;
-  FSectionStream.Write(SectionHeader,sizeOf(SectionHeader));
+  AddSection(skText,        SHT_PROGBITS, 6 {AX}, 0, sizeof(TElf32Header), 0, 0, 0, 4, 0);
+  AddSection(skData,        SHT_PROGBITS, 3 {WA}, 0, sizeof(TElf32Header), 0, 0, 0, 4, 0);
+  AddSection(skBss,         SHT_NOBITS,   3 {WA}, 0, sizeof(TElf32Header), 0, 0, 0, 4, 0);
+  AddSection(skFpcRessym,   SHT_PROGBITS, 2 {A},  0, ressym.ptr, FSymStream.Size, 0, 0, 1, 0);
+  AddSection(skFpcResstr,   SHT_PROGBITS, 2 {A},  0, resstr.ptr, 0, 0, 0, 4, 0);
+  AddSection(skFpcReshash,  SHT_PROGBITS, 2 {A},  0, reshash.ptr, length(ResourceEntries)*sizeof(TELF32ResourceInfo), 0, 0, 4, 0);
+  AddSection(skFpcResdata,  SHT_PROGBITS, 2 {A},  0, resdata.ptr, FDataStream.Size, 0, 0, 4, 0);
+  AddSection(skFpcResspare, SHT_NOBITS,   2 {A},  0, resspare.ptr, 0, 0, 0, 4, 0);
+  AddSection(skShstrtab,    SHT_STRTAB,   0,      0, shstrtab_ofs, length(FShStrtab), 0, 0, 1, 0);
+  AddSection(skSymtab,      SHT_SYMTAB,   0,      0, FSectionStream.Position+sizeof(TElf32Header) + 2 * sizeof(SectionHeader), length(symtab), $0B, $09, 4, $10);
+  AddSection(skStrtab,      SHT_STRTAB,   0,      0, FSectionStream.Position+sizeof(TElf32Header) + sizeof(SectionHeader) + length(symtab), 1, 0, 0, 1, 0);
 
   // now write the symbol table
   FSectionStream.Write(symtab[1],length(symtab));

utils/fpcres/elfresfix.pas

@@ -197,7 +197,8 @@ begin
 
   ResPtrsSection:=-1;
   ResHashSection:=-1;
-  ResourceSectionTable.version:=66;
+  FillChar(ResourceSectionTable, sizeof(ResourceSectionTable), 0);
+  ResourceSectionTable.version:=1;
 
   // Next cycle through all sections to gather pointers to all the resource
   // sections, and note the index of the resptrs section