+ symansistr conditional define that, when activated, makes the symbol/

    mangled name handling ansistring rather than pshortstring based (required
    for JVM target; little effect on speed, some extra memory usage)

git-svn-id: branches/jvmbackend@18597 -

compiler/aasmbase.pas

@@ -154,7 +154,7 @@ interface
          altsymbol  : TAsmSymbol;
          { Cached objsymbol }
          cachedobjsymbol : TObject;
-         constructor Create(AList:TFPHashObjectList;const s:string;_bind:TAsmsymbind;_typ:Tasmsymtype);
+         constructor Create(AList:TFPHashObjectList;const s:TSymStr;_bind:TAsmsymbind;_typ:Tasmsymtype);
          function getaltcopy(AList:TFPHashObjectList;altnr: longint): TAsmSymbol; virtual;
          function  is_used:boolean;
          procedure increfs;
@@ -165,13 +165,13 @@ interface
 
        TAsmLabel = class(TAsmSymbol)
        protected
-         function getname:string;override;
+         function getname:TSymStr;override;
        public
          labelnr   : longint;
          labeltype : TAsmLabelType;
          is_set    : boolean;
          constructor Createlocal(AList:TFPHashObjectList;nr:longint;ltyp:TAsmLabelType);
-         constructor Createglobal(AList:TFPHashObjectList;const modulename:string;nr:longint;ltyp:TAsmLabelType);
+         constructor Createglobal(AList:TFPHashObjectList;const modulename:TSymStr;nr:longint;ltyp:TAsmLabelType);
          function getaltcopy(AList:TFPHashObjectList;altnr: longint): TAsmSymbol; override;
        end;
 
@@ -327,7 +327,7 @@ implementation
                                  TAsmSymbol
 *****************************************************************************}
 
-    constructor TAsmSymbol.Create(AList:TFPHashObjectList;const s:string;_bind:TAsmsymbind;_typ:Tasmsymtype);
+    constructor TAsmSymbol.Create(AList:TFPHashObjectList;const s:TSymStr;_bind:TAsmsymbind;_typ:Tasmsymtype);
       begin;
         inherited Create(AList,s);
         bind:=_bind;
@@ -392,7 +392,7 @@ implementation
       end;
 
 
-    constructor TAsmLabel.Createglobal(AList:TFPHashObjectList;const modulename:string;nr:longint;ltyp:TAsmLabelType);
+    constructor TAsmLabel.Createglobal(AList:TFPHashObjectList;const modulename:TSymStr;nr:longint;ltyp:TAsmLabelType);
       begin
         inherited Create(AList,'_$'+modulename+'$_L'+asmlabeltypeprefix[ltyp]+tostr(nr),AB_GLOBAL,AT_DATA);
         labelnr:=nr;
@@ -421,7 +421,7 @@ implementation
       end;
 
 
-    function TAsmLabel.getname:string;
+    function TAsmLabel.getname:TSymStr;
       begin
         getname:=inherited getname;
         increfs;

compiler/aasmdata.pas

@@ -160,10 +160,10 @@ interface
         constructor create(const n:string);
         destructor  destroy;override;
         { asmsymbol }
-        function  DefineAsmSymbol(const s : string;_bind:TAsmSymBind;_typ:Tasmsymtype) : TAsmSymbol;
-        function  WeakRefAsmSymbol(const s : string) : TAsmSymbol;
-        function  RefAsmSymbol(const s : string) : TAsmSymbol;
-        function  GetAsmSymbol(const s : string) : TAsmSymbol;
+        function  DefineAsmSymbol(const s : TSymStr;_bind:TAsmSymBind;_typ:Tasmsymtype) : TAsmSymbol;
+        function  WeakRefAsmSymbol(const s : TSymStr) : TAsmSymbol;
+        function  RefAsmSymbol(const s : TSymStr) : TAsmSymbol;
+        function  GetAsmSymbol(const s : TSymStr) : TAsmSymbol;
         { create new assembler label }
         procedure getlabel(out l : TAsmLabel;alt:TAsmLabeltype);
         procedure getjumplabel(out l : TAsmLabel);
@@ -377,7 +377,7 @@ implementation
       end;
 
 
-    function TAsmData.DefineAsmSymbol(const s : string;_bind:TAsmSymBind;_typ:Tasmsymtype) : TAsmSymbol;
+    function TAsmData.DefineAsmSymbol(const s : TSymStr;_bind:TAsmSymBind;_typ:Tasmsymtype) : TAsmSymbol;
       var
         hp : TAsmSymbol;
       begin
@@ -404,7 +404,7 @@ implementation
       end;
 
 
-    function TAsmData.RefAsmSymbol(const s : string) : TAsmSymbol;
+    function TAsmData.RefAsmSymbol(const s : TSymStr) : TAsmSymbol;
       begin
         result:=TAsmSymbol(FAsmSymbolDict.Find(s));
         if not assigned(result) then
@@ -415,7 +415,7 @@ implementation
       end;
 
 
-    function TAsmData.WeakRefAsmSymbol(const s : string) : TAsmSymbol;
+    function TAsmData.WeakRefAsmSymbol(const s : TSymStr) : TAsmSymbol;
       begin
         result:=TAsmSymbol(FAsmSymbolDict.Find(s));
         if not assigned(result) then
@@ -423,7 +423,7 @@ implementation
       end;
 
 
-    function TAsmData.GetAsmSymbol(const s : string) : TAsmSymbol;
+    function TAsmData.GetAsmSymbol(const s : TSymStr) : TAsmSymbol;
       begin
         result:=TAsmSymbol(FAsmSymbolDict.Find(s));
       end;

compiler/agjasmin.pas

@@ -51,13 +51,13 @@ interface
         procedure WriteInstruction(hp: tai);
         procedure NewAsmFileForStructDef(obj: tabstractrecorddef);
 
-        function VisibilityToStr(vis: tvisibility): string;
-        function MethodDefinition(pd: tprocdef): string;
+        function VisibilityToStr(vis: tvisibility): ansistring;
+        function MethodDefinition(pd: tprocdef): ansistring;
         function ConstValue(csym: tconstsym): ansistring;
         function ConstAssignmentValue(csym: tconstsym): ansistring;
         function ConstDefinition(sym: tconstsym): ansistring;
-        function FieldDefinition(sym: tabstractvarsym): string;
-        function InnerStructDef(obj: tabstractrecorddef): string;
+        function FieldDefinition(sym: tabstractvarsym): ansistring;
+        function InnerStructDef(obj: tabstractrecorddef): ansistring;
 
         procedure WriteProcDef(pd: tprocdef);
         procedure WriteFieldSym(sym: tabstractvarsym);
@@ -225,13 +225,13 @@ implementation
      end;
 
 
-   function constsingle(s: single): string;
+   function constsingle(s: single): ansistring;
      begin
        result:='0fx'+hexstr(longint(t32bitarray(s)),8);
      end;
 
 
-   function constdouble(d: double): string;
+   function constdouble(d: double): ansistring;
       begin
         // force interpretation as double (since we write it out as an
         // integer, we never have to swap the endianess). We have to
@@ -260,7 +260,7 @@ implementation
         ch       : char;
         hp       : tai;
         hp1      : tailineinfo;
-        s        : string;
+        s        : ansistring;
         i,pos    : longint;
         InlineLevel : longint;
         do_line  : boolean;
@@ -521,7 +521,7 @@ implementation
       var
         superclass,
         intf: tobjectdef;
-        n: string;
+        n: ansistring;
         i: longint;
         toplevelowner: tsymtable;
       begin
@@ -678,7 +678,7 @@ implementation
       end;
 
 
-    function TJasminAssembler.VisibilityToStr(vis: tvisibility): string;
+    function TJasminAssembler.VisibilityToStr(vis: tvisibility): ansistring;
       begin
         case vis of
           vis_hidden,
@@ -699,7 +699,7 @@ implementation
       end;
 
 
-    function TJasminAssembler.MethodDefinition(pd: tprocdef): string;
+    function TJasminAssembler.MethodDefinition(pd: tprocdef): ansistring;
       begin
         result:=VisibilityToStr(pd.visibility);
         if (pd.procsym.owner.symtabletype in [globalsymtable,staticsymtable,localsymtable]) or
@@ -782,7 +782,7 @@ implementation
       end;
 
 
-    function TJasminAssembler.FieldDefinition(sym: tabstractvarsym): string;
+    function TJasminAssembler.FieldDefinition(sym: tabstractvarsym): ansistring;
       var
         vissym: tabstractvarsym;
       begin
@@ -827,10 +827,10 @@ implementation
       end;
 
 
-    function TJasminAssembler.InnerStructDef(obj: tabstractrecorddef): string;
+    function TJasminAssembler.InnerStructDef(obj: tabstractrecorddef): ansistring;
       var
         extname: pshortstring;
-        kindname: string;
+        kindname: ansistring;
       begin
         if not(obj.owner.defowner.typ in [objectdef,recorddef]) then
           internalerror(2011021701);
@@ -902,15 +902,9 @@ implementation
 
 
     procedure TJasminAssembler.WriteConstSym(sym: tconstsym);
-      var
-        a: ansistring;
       begin
         AsmWrite('.field ');
-        { make sure the ansistring is not freed before we've extracted the
-          pchar }
-        a:=ConstDefinition(sym);
-        AsmWritePChar(pchar(a));
-        AsmLn
+        AsmWriteln(ConstDefinition(sym));
       end;
 
 
@@ -1065,7 +1059,7 @@ implementation
          owner := _owner;
        end;
 
-    function getreferencestring(var ref : treference) : string;
+    function getreferencestring(var ref : treference) : ansistring;
       begin
         if (ref.arrayreftype<>art_none) or
            (ref.index<>NR_NO) then
@@ -1133,7 +1127,7 @@ implementation
       var
         s: ansistring;
         i: byte;
-        sep: string[3];
+        sep: ansistring;
       begin
         s:=#9+jas_op2str[taicpu(hp).opcode];
         if taicpu(hp).ops<>0 then
@@ -1145,8 +1139,7 @@ implementation
                  sep:=' ';
               end;
           end;
-        owner.AsmWritePChar(PChar(s));
-        owner.AsmLn;
+        owner.AsmWriteLn(s);
       end;
 
 {****************************************************************************}

compiler/assemble.pas

@@ -103,13 +103,17 @@ interface
         Procedure AsmClear;
 
         {# Write a string to the assembler file }
+        Procedure AsmWrite(const c:char);
         Procedure AsmWrite(const s:string);
+        Procedure AsmWrite(const s:ansistring);
 
         {# Write a string to the assembler file }
         Procedure AsmWritePChar(p:pchar);
 
         {# Write a string to the assembler file followed by a new line }
+        Procedure AsmWriteLn(const c:char);
         Procedure AsmWriteLn(const s:string);
+        Procedure AsmWriteLn(const s:ansistring);
 
         {# Write a new line to the assembler file }
         Procedure AsmLn;
@@ -455,6 +459,16 @@ Implementation
       end;
 
 
+    Procedure TExternalAssembler.AsmWrite(const c: char);
+      begin
+        if OutCnt+1>=AsmOutSize then
+         AsmFlush;
+        OutBuf[OutCnt]:=c;
+        inc(OutCnt);
+        inc(AsmSize);
+      end;
+
+
     Procedure TExternalAssembler.AsmWrite(const s:string);
       begin
         if OutCnt+length(s)>=AsmOutSize then
@@ -465,6 +479,25 @@ Implementation
       end;
 
 
+    Procedure TExternalAssembler.AsmWrite(const s:ansistring);
+      begin
+        if s='' then
+          exit;
+        if OutCnt+length(s)>=AsmOutSize then
+         AsmFlush;
+        Move(s[1],OutBuf[OutCnt],length(s));
+        inc(OutCnt,length(s));
+        inc(AsmSize,length(s));
+      end;
+
+
+    procedure TExternalAssembler.AsmWriteLn(const c: char);
+      begin
+        AsmWrite(c);
+        AsmLn;
+      end;
+
+
     Procedure TExternalAssembler.AsmWriteLn(const s:string);
       begin
         AsmWrite(s);
@@ -472,6 +505,13 @@ Implementation
       end;
 
 
+    Procedure TExternalAssembler.AsmWriteLn(const s: ansistring);
+      begin
+        AsmWrite(s);
+        AsmLn;
+      end;
+
+
     Procedure TExternalAssembler.AsmWritePChar(p:pchar);
       var
         i,j : longint;

compiler/cclasses.pas

@@ -194,17 +194,21 @@ type
     FHashTable    : PHashTable;
     FHashCapacity : Integer;
     { Strings }
+{$ifdef symansistr}
+    FStrs     : PAnsiString;
+{$else symansistr}
     FStrs     : PChar;
+{$endif symansistr}
     FStrCount,
     FStrCapacity : Integer;
-    function InternalFind(AHash:LongWord;const AName:shortstring;out PrevIndex:Integer):Integer;
+    function InternalFind(AHash:LongWord;const AName:TSymStr;out PrevIndex:Integer):Integer;
   protected
     function Get(Index: Integer): Pointer;
     procedure Put(Index: Integer; Item: Pointer);
     procedure SetCapacity(NewCapacity: Integer);
     procedure SetCount(NewCount: Integer);
     Procedure RaiseIndexError(Index : Integer);
-    function  AddStr(const s:shortstring): Integer;
+    function  AddStr(const s:TSymStr): Integer;
     procedure AddToHashTable(Index: Integer);
     procedure StrExpand(MinIncSize:Integer);
     procedure SetStrCapacity(NewCapacity: Integer);
@@ -213,9 +217,9 @@ type
   public
     constructor Create;
     destructor Destroy; override;
-    function Add(const AName:shortstring;Item: Pointer): Integer;
+    function Add(const AName:TSymStr;Item: Pointer): Integer;
     procedure Clear;
-    function NameOfIndex(Index: Integer): ShortString;
+    function NameOfIndex(Index: Integer): TSymStr;
     function HashOfIndex(Index: Integer): LongWord;
     function GetNextCollision(Index: Integer): Integer;
     procedure Delete(Index: Integer);
@@ -223,10 +227,10 @@ type
     function Expand: TFPHashList;
     function Extract(item: Pointer): Pointer;
     function IndexOf(Item: Pointer): Integer;
-    function Find(const AName:shortstring): Pointer;
-    function FindIndexOf(const AName:shortstring): Integer;
-    function FindWithHash(const AName:shortstring;AHash:LongWord): Pointer;
-    function Rename(const AOldName,ANewName:shortstring): Integer;
+    function Find(const AName:TSymStr): Pointer;
+    function FindIndexOf(const AName:TSymStr): Integer;
+    function FindWithHash(const AName:TSymStr;AHash:LongWord): Pointer;
+    function Rename(const AOldName,ANewName:TSymStr): Integer;
     function Remove(Item: Pointer): Integer;
     procedure Pack;
     procedure ShowStatistics;
@@ -236,7 +240,11 @@ type
     property Count: Integer read FCount write SetCount;
     property Items[Index: Integer]: Pointer read Get write Put; default;
     property List: PHashItemList read FHashList;
+{$ifdef symansistr}
+    property Strs: PSymStr read FStrs;
+{$else}
     property Strs: PChar read FStrs;
+{$endif}
   end;
 
 
@@ -251,19 +259,18 @@ type
   TFPHashObject = class
   private
     FOwner     : TFPHashObjectList;
-    FCachedStr : pshortstring;
     FStrIndex  : Integer;
-    procedure InternalChangeOwner(HashObjectList:TFPHashObjectList;const s:shortstring);
+    procedure InternalChangeOwner(HashObjectList:TFPHashObjectList;const s:TSymStr);
   protected
-    function GetName:shortstring;virtual;
+    function GetName:TSymStr;virtual;
     function GetHash:Longword;virtual;
   public
     constructor CreateNotOwned;
-    constructor Create(HashObjectList:TFPHashObjectList;const s:shortstring);
+    constructor Create(HashObjectList:TFPHashObjectList;const s:TSymStr);
     procedure ChangeOwner(HashObjectList:TFPHashObjectList);
-    procedure ChangeOwnerAndName(HashObjectList:TFPHashObjectList;const s:shortstring); {$ifdef CCLASSESINLINE}inline;{$endif}
-    procedure Rename(const ANewName:shortstring);
-    property Name:shortstring read GetName;
+    procedure ChangeOwnerAndName(HashObjectList:TFPHashObjectList;const s:TSymStr); {$ifdef CCLASSESINLINE}inline;{$endif}
+    procedure Rename(const ANewName:TSymStr);
+    property Name:TSymStr read GetName;
     property Hash:Longword read GetHash;
   end;
 
@@ -282,8 +289,8 @@ type
     constructor Create(FreeObjects : boolean = True);
     destructor Destroy; override;
     procedure Clear;
-    function Add(const AName:shortstring;AObject: TObject): Integer; {$ifdef CCLASSESINLINE}inline;{$endif}
-    function NameOfIndex(Index: Integer): ShortString; {$ifdef CCLASSESINLINE}inline;{$endif}
+    function Add(const AName:TSymStr;AObject: TObject): Integer; {$ifdef CCLASSESINLINE}inline;{$endif}
+    function NameOfIndex(Index: Integer): TSymStr; {$ifdef CCLASSESINLINE}inline;{$endif}
     function HashOfIndex(Index: Integer): LongWord; {$ifdef CCLASSESINLINE}inline;{$endif}
     function GetNextCollision(Index: Integer): Integer; {$ifdef CCLASSESINLINE}inline;{$endif}
     procedure Delete(Index: Integer);
@@ -291,10 +298,10 @@ type
     function Extract(Item: TObject): TObject; {$ifdef CCLASSESINLINE}inline;{$endif}
     function Remove(AObject: TObject): Integer;
     function IndexOf(AObject: TObject): Integer; {$ifdef CCLASSESINLINE}inline;{$endif}
-    function Find(const s:shortstring): TObject; {$ifdef CCLASSESINLINE}inline;{$endif}
-    function FindIndexOf(const s:shortstring): Integer; {$ifdef CCLASSESINLINE}inline;{$endif}
-    function FindWithHash(const AName:shortstring;AHash:LongWord): Pointer;
-    function Rename(const AOldName,ANewName:shortstring): Integer; {$ifdef CCLASSESINLINE}inline;{$endif}
+    function Find(const s:TSymStr): TObject; {$ifdef CCLASSESINLINE}inline;{$endif}
+    function FindIndexOf(const s:TSymStr): Integer; {$ifdef CCLASSESINLINE}inline;{$endif}
+    function FindWithHash(const AName:TSymStr;AHash:LongWord): Pointer;
+    function Rename(const AOldName,ANewName:TSymStr): Integer; {$ifdef CCLASSESINLINE}inline;{$endif}
     function FindInstanceOf(AClass: TClass; AExact: Boolean; AStartAt: Integer): Integer;
     procedure Pack; {$ifdef CCLASSESINLINE}inline;{$endif}
     procedure ShowStatistics; {$ifdef CCLASSESINLINE}inline;{$endif}
@@ -536,6 +543,7 @@ type
 
     function FPHash(const s:shortstring):LongWord;
     function FPHash(P: PChar; Len: Integer): LongWord;
+    function FPHash(const a:ansistring):LongWord;
 
 
 implementation
@@ -1119,6 +1127,12 @@ end;
       end;
 
 
+    function FPHash(const a: ansistring): LongWord;
+      begin
+         result:=fphash(pchar(a),length(a));
+      end;
+
+
 procedure TFPHashList.RaiseIndexError(Index : Integer);
 begin
   Error(SListIndexError, Index);
@@ -1141,14 +1155,14 @@ begin
 end;
 
 
-function TFPHashList.NameOfIndex(Index: Integer): shortstring;
+function TFPHashList.NameOfIndex(Index: Integer): TSymStr;
 begin
   If (Index < 0) or (Index >= FCount) then
     RaiseIndexError(Index);
   with FHashList^[Index] do
     begin
       if StrIndex>=0 then
-        Result:=PShortString(@FStrs[StrIndex])^
+        Result:=PSymStr(@FStrs[StrIndex])^
       else
         Result:='';
     end;
@@ -1221,12 +1235,27 @@ end;
 
 
 procedure TFPHashList.SetStrCapacity(NewCapacity: Integer);
+{$ifdef symansistr}
+var
+  i: longint;
+{$endif symansistr}
 begin
   If (NewCapacity < FStrCount) or (NewCapacity > MaxHashStrSize) then
      Error (SListCapacityError, NewCapacity);
   if NewCapacity = FStrCapacity then
     exit;
+{$ifdef symansistr}
+{ array of ansistrings -> finalize }
+  if (NewCapacity < FStrCapacity) then
+    for i:=NewCapacity to FStrCapacity-1 do
+      finalize(FStrs[i]);
+  ReallocMem(FStrs, NewCapacity*sizeof(pansistring));
+  { array of ansistrings -> initialize to nil }
+  if (NewCapacity > FStrCapacity) then
+    fillchar(FStrs[FStrCapacity],(NewCapacity-FStrCapacity)*sizeof(pansistring),0);
+{$else symansistr}
   ReallocMem(FStrs, NewCapacity);
+{$endif symansistr}
   FStrCapacity := NewCapacity;
 end;
 
@@ -1274,16 +1303,26 @@ begin
 end;
 
 
-function TFPHashList.AddStr(const s:shortstring): Integer;
+function TFPHashList.AddStr(const s:TSymStr): Integer;
+{$ifndef symansistr}
 var
   Len : Integer;
+{$endif symansistr}
 begin
+{$ifdef symansistr}
+  if FStrCount+1 >= FStrCapacity then
+    StrExpand(FStrCount+1);
+  FStrs[FStrCount]:=s;
+  result:=FStrCount;
+  inc(FStrCount);
+{$else symansistr}
   len:=length(s)+1;
   if FStrCount+Len >= FStrCapacity then
     StrExpand(Len);
   System.Move(s[0],FStrs[FStrCount],Len);
   result:=FStrCount;
   inc(FStrCount,Len);
+{$endif symansistr}
 end;
 
 
@@ -1302,7 +1341,7 @@ begin
 end;
 
 
-function TFPHashList.Add(const AName:shortstring;Item: Pointer): Integer;
+function TFPHashList.Add(const AName:TSymStr;Item: Pointer): Integer;
 begin
   if FCount = FCapacity then
     Expand;
@@ -1405,9 +1444,11 @@ begin
     end;
 end;
 
-function TFPHashList.InternalFind(AHash:LongWord;const AName:shortstring;out PrevIndex:Integer):Integer;
+function TFPHashList.InternalFind(AHash:LongWord;const AName:TSymStr;out PrevIndex:Integer):Integer;
+var
+  HashIndex : Integer;
 begin
-  prefetch(AName);
+  prefetch(AName[1]);
   Result:=FHashTable^[AHash and FCapacityMask];
   PrevIndex:=-1;
   while Result<>-1 do
@@ -1416,7 +1457,7 @@ begin
         begin
           if assigned(Data) and
              (HashValue=AHash) and
-             (AName=PShortString(@FStrs[StrIndex])^) then
+             (AName=PSymStr(@FStrs[StrIndex])^) then
             exit;
           PrevIndex:=Result;
           Result:=NextIndex;
@@ -1425,7 +1466,7 @@ begin
 end;
 
 
-function TFPHashList.Find(const AName:shortstring): Pointer;
+function TFPHashList.Find(const AName:TSymStr): Pointer;
 var
   Index,
   PrevIndex : Integer;
@@ -1438,7 +1479,7 @@ begin
 end;
 
 
-function TFPHashList.FindIndexOf(const AName:shortstring): Integer;
+function TFPHashList.FindIndexOf(const AName:TSymStr): Integer;
 var
   PrevIndex : Integer;
 begin
@@ -1446,7 +1487,7 @@ begin
 end;
 
 
-function TFPHashList.FindWithHash(const AName:shortstring;AHash:LongWord): Pointer;
+function TFPHashList.FindWithHash(const AName:TSymStr;AHash:LongWord): Pointer;
 var
   Index,
   PrevIndex : Integer;
@@ -1459,7 +1500,7 @@ begin
 end;
 
 
-function TFPHashList.Rename(const AOldName,ANewName:shortstring): Integer;
+function TFPHashList.Rename(const AOldName,ANewName:TSymStr): Integer;
 var
   PrevIndex,
   Index : Integer;
@@ -1585,14 +1626,13 @@ end;
                                TFPHashObject
 *****************************************************************************}
 
-procedure TFPHashObject.InternalChangeOwner(HashObjectList:TFPHashObjectList;const s:shortstring);
+procedure TFPHashObject.InternalChangeOwner(HashObjectList:TFPHashObjectList;const s:TSymStr);
 var
   Index : integer;
 begin
   FOwner:=HashObjectList;
   Index:=HashObjectList.Add(s,Self);
   FStrIndex:=HashObjectList.List.List^[Index].StrIndex;
-  FCachedStr:=PShortString(@FOwner.List.Strs[FStrIndex]);
 end;
 
 
@@ -1602,7 +1642,7 @@ begin
 end;
 
 
-constructor TFPHashObject.Create(HashObjectList:TFPHashObjectList;const s:shortstring);
+constructor TFPHashObject.Create(HashObjectList:TFPHashObjectList;const s:TSymStr);
 begin
   InternalChangeOwner(HashObjectList,s);
 end;
@@ -1610,36 +1650,30 @@ end;
 
 procedure TFPHashObject.ChangeOwner(HashObjectList:TFPHashObjectList);
 begin
-  InternalChangeOwner(HashObjectList,PShortString(@FOwner.List.Strs[FStrIndex])^);
+  InternalChangeOwner(HashObjectList,PSymStr(@FOwner.List.Strs[FStrIndex])^);
 end;
 
 
-procedure TFPHashObject.ChangeOwnerAndName(HashObjectList:TFPHashObjectList;const s:shortstring);
+procedure TFPHashObject.ChangeOwnerAndName(HashObjectList:TFPHashObjectList;const s:TSymStr);
 begin
   InternalChangeOwner(HashObjectList,s);
 end;
 
 
-procedure TFPHashObject.Rename(const ANewName:shortstring);
+procedure TFPHashObject.Rename(const ANewName:TSymStr);
 var
   Index : integer;
 begin
-  Index:=FOwner.Rename(PShortString(@FOwner.List.Strs[FStrIndex])^,ANewName);
+  Index:=FOwner.Rename(PSymStr(@FOwner.List.Strs[FStrIndex])^,ANewName);
   if Index<>-1 then
-    begin
-      FStrIndex:=FOwner.List.List^[Index].StrIndex;
-      FCachedStr:=PShortString(@FOwner.List.Strs[FStrIndex]);
-    end;
+    FStrIndex:=FOwner.List.List^[Index].StrIndex;
 end;
 
 
-function TFPHashObject.GetName:shortstring;
+function TFPHashObject.GetName:TSymStr;
 begin
   if FOwner<>nil then
-    begin
-      FCachedStr:=PShortString(@FOwner.List.Strs[FStrIndex]);
-      Result:=FCachedStr^;
-    end
+    Result:=PSymStr(@FOwner.List.Strs[FStrIndex])^
   else
     Result:='';
 end;
@@ -1648,7 +1682,7 @@ end;
 function TFPHashObject.GetHash:Longword;
 begin
   if FOwner<>nil then
-    Result:=FPHash(PShortString(@FOwner.List.Strs[FStrIndex])^)
+    Result:=FPHash(PSymStr(@FOwner.List.Strs[FStrIndex])^)
   else
     Result:=$ffffffff;
 end;
@@ -1718,12 +1752,12 @@ begin
   Result := FHashList.Capacity;
 end;
 
-function TFPHashObjectList.Add(const AName:shortstring;AObject: TObject): Integer;
+function TFPHashObjectList.Add(const AName:TSymStr;AObject: TObject): Integer;
 begin
   Result := FHashList.Add(AName,AObject);
 end;
 
-function TFPHashObjectList.NameOfIndex(Index: Integer): shortstring;
+function TFPHashObjectList.NameOfIndex(Index: Integer): TSymStr;
 begin
   Result := FHashList.NameOfIndex(Index);
 end;
@@ -1773,25 +1807,25 @@ begin
 end;
 
 
-function TFPHashObjectList.Find(const s:shortstring): TObject;
+function TFPHashObjectList.Find(const s:TSymStr): TObject;
 begin
   result:=TObject(FHashList.Find(s));
 end;
 
 
-function TFPHashObjectList.FindIndexOf(const s:shortstring): Integer;
+function TFPHashObjectList.FindIndexOf(const s:TSymStr): Integer;
 begin
   result:=FHashList.FindIndexOf(s);
 end;
 
 
-function TFPHashObjectList.FindWithHash(const AName:shortstring;AHash:LongWord): Pointer;
+function TFPHashObjectList.FindWithHash(const AName:TSymStr;AHash:LongWord): Pointer;
 begin
   Result:=TObject(FHashList.FindWithHash(AName,AHash));
 end;
 
 
-function TFPHashObjectList.Rename(const AOldName,ANewName:shortstring): Integer;
+function TFPHashObjectList.Rename(const AOldName,ANewName:TSymStr): Integer;
 begin
   Result:=FHashList.Rename(AOldName,ANewName);
 end;

compiler/fpcdefs.inc

@@ -157,6 +157,7 @@
   {$define cpu64bitalu}
   {$define cpu32bitaddr}
   {$define cpuhighleveltarget}
+  {$define symansistr}
 {$endif}
 
 {$IFDEF MACOS}

compiler/gendef.pas

@@ -25,15 +25,15 @@ unit gendef;
 
 interface
 uses
-  cclasses;
+  globtype,cclasses;
 
 type
   tdeffile=class
     fname : string;
     constructor create(const fn:string);
     destructor  destroy;override;
-    procedure addexport(const s:string);
-    procedure addimport(const s:string);
+    procedure addexport(const s:TSymStr);
+    procedure addimport(const s:TSymStr);
     procedure writefile;
     function empty : boolean;
   private
@@ -51,7 +51,7 @@ implementation
 
 uses
   SysUtils,
-  systems,cutils,globtype,globals;
+  systems,cutils,globals;
 
 {******************************************************************************
                                TDefFile
@@ -78,14 +78,14 @@ end;
 
 
 
-procedure tdeffile.addexport(const s:string);
+procedure tdeffile.addexport(const s:TSymStr);
 begin
   exportlist.insert(s);
   is_empty:=false;
 end;
 
 
-procedure tdeffile.addimport(const s:string);
+procedure tdeffile.addimport(const s:TSymStr);
 begin
   importlist.insert(s);
   is_empty:=false;

compiler/globtype.pas

@@ -34,6 +34,13 @@ interface
        TCmdStr = AnsiString;
        TPathStr = AnsiString;
 
+{$ifdef symansistr}
+       TSymStr = AnsiString;
+{$else symansistr}
+       TSymStr = ShortString;
+{$endif symansistr}
+       PSymStr = ^TSymStr;
+
        { Integer type corresponding to pointer size }
 {$ifdef cpu64bitaddr}
        PUint = qword;

compiler/hlcg2ll.pas

@@ -152,12 +152,12 @@ unit hlcg2ll;
           }
           procedure a_loadaddr_ref_cgpara(list : TAsmList;fromsize, tosize : tdef;const r : treference;const cgpara : TCGPara);override;
 
-          procedure a_call_name(list : TAsmList;pd : tprocdef;const s : string; weak: boolean);override;
+          procedure a_call_name(list : TAsmList;pd : tprocdef;const s : TSymStr; weak: boolean);override;
           procedure a_call_reg(list : TAsmList;pd : tabstractprocdef;reg : tregister);override;
           procedure a_call_ref(list : TAsmList;pd : tabstractprocdef;ref : treference);override;
           { same as a_call_name, might be overridden on certain architectures to emit
             static calls without usage of a got trampoline }
-          procedure a_call_name_static(list : TAsmList;pd : tprocdef;const s : string);override;
+          procedure a_call_name_static(list : TAsmList;pd : tprocdef;const s : TSymStr);override;
 
           { move instructions }
           procedure a_load_const_reg(list : TAsmList;tosize : tdef;a : aint;register : tregister);override;
@@ -521,7 +521,7 @@ implementation
       cg.a_loadaddr_ref_cgpara(list,r,cgpara);
     end;
 
-  procedure thlcg2ll.a_call_name(list: TAsmList; pd: tprocdef; const s: string; weak: boolean);
+  procedure thlcg2ll.a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; weak: boolean);
     begin
       cg.a_call_name(list,s,weak);
     end;
@@ -536,7 +536,7 @@ implementation
       cg.a_call_ref(list,ref);
     end;
 
-  procedure thlcg2ll.a_call_name_static(list: TAsmList; pd: tprocdef; const s: string);
+  procedure thlcg2ll.a_call_name_static(list: TAsmList; pd: tprocdef; const s: TSymStr);
     begin
       cg.a_call_name_static(list,s);
     end;

compiler/hlcgobj.pas

@@ -180,15 +180,15 @@ unit hlcgobj;
           {# Emits instruction to call the method specified by symbol name.
              This routine must be overridden for each new target cpu.
           }
-          procedure a_call_name(list : TAsmList;pd : tprocdef;const s : string; weak: boolean);virtual;abstract;
+          procedure a_call_name(list : TAsmList;pd : tprocdef;const s : TSymStr; weak: boolean);virtual;abstract;
           procedure a_call_reg(list : TAsmList;pd : tabstractprocdef;reg : tregister);virtual;abstract;
           procedure a_call_ref(list : TAsmList;pd : tabstractprocdef;ref : treference);virtual;abstract;
           { same as a_call_name, might be overridden on certain architectures to emit
             static calls without usage of a got trampoline }
-          procedure a_call_name_static(list : TAsmList;pd : tprocdef;const s : string);virtual;
+          procedure a_call_name_static(list : TAsmList;pd : tprocdef;const s : TSymStr);virtual;
           { same as a_call_name, might be overridden on certain architectures to emit
             special static calls for inherited methods }
-          procedure a_call_name_inherited(list : TAsmList;pd : tprocdef;const s : string);virtual;
+          procedure a_call_name_inherited(list : TAsmList;pd : tprocdef;const s : TSymStr);virtual;
 
           { move instructions }
           procedure a_load_const_reg(list : TAsmList;tosize : tdef;a : aint;register : tregister);virtual;abstract;
@@ -771,12 +771,12 @@ implementation
          end;
     end;
 
-  procedure thlcgobj.a_call_name_static(list: TAsmList; pd: tprocdef; const s: string);
+  procedure thlcgobj.a_call_name_static(list: TAsmList; pd: tprocdef; const s: TSymStr);
     begin
       a_call_name(list,pd,s,false);
     end;
 
-    procedure thlcgobj.a_call_name_inherited(list: TAsmList; pd: tprocdef; const s: string);
+    procedure thlcgobj.a_call_name_inherited(list: TAsmList; pd: tprocdef; const s: TSymStr);
       begin
         a_call_name(list,pd,s,false);
       end;

compiler/jvm/hlcgcpu.pas

@@ -48,8 +48,8 @@ uses
 
       function def2regtyp(def: tdef): tregistertype; override;
 
-      procedure a_call_name(list : TAsmList;pd : tprocdef;const s : string; weak: boolean);override;
-      procedure a_call_name_inherited(list : TAsmList;pd : tprocdef;const s : string);override;
+      procedure a_call_name(list : TAsmList;pd : tprocdef;const s : TSymStr; weak: boolean);override;
+      procedure a_call_name_inherited(list : TAsmList;pd : tprocdef;const s : TSymStr);override;
 
       procedure a_load_const_reg(list : TAsmList;tosize : tdef;a : aint;register : tregister);override;
       procedure a_load_const_ref(list : TAsmList;tosize : tdef;a : aint;const ref : treference);override;
@@ -182,7 +182,7 @@ uses
         JVM does not support unsigned divisions }
       procedure maybepreparedivu32(list: TAsmList; var op: topcg; size: tdef; out isdivu32: boolean);
       { common implementation of a_call_* }
-      procedure a_call_name_intern(list : TAsmList;pd : tprocdef;const s : string; inheritedcall: boolean);
+      procedure a_call_name_intern(list : TAsmList;pd : tprocdef;const s : TSymStr; inheritedcall: boolean);
 
       { concatcopy helpers }
       procedure concatcopy_normal_array(list: TAsmList; size: tdef; const source, dest: treference);
@@ -268,12 +268,12 @@ implementation
       end;
     end;
 
-  procedure thlcgjvm.a_call_name(list: TAsmList; pd: tprocdef; const s: string; weak: boolean);
+  procedure thlcgjvm.a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; weak: boolean);
     begin
       a_call_name_intern(list,pd,s,false);
     end;
 
-  procedure thlcgjvm.a_call_name_inherited(list: TAsmList; pd: tprocdef; const s: string);
+  procedure thlcgjvm.a_call_name_inherited(list: TAsmList; pd: tprocdef; const s: TSymStr);
     begin
       a_call_name_intern(list,pd,s,true);
     end;
@@ -1903,7 +1903,7 @@ implementation
         isdivu32:=false;
     end;
 
-  procedure thlcgjvm.a_call_name_intern(list: TAsmList; pd: tprocdef; const s: string; inheritedcall: boolean);
+  procedure thlcgjvm.a_call_name_intern(list: TAsmList; pd: tprocdef; const s: TSymStr; inheritedcall: boolean);
     var
       opc: tasmop;
     begin

compiler/jvmdef.pas

@@ -28,6 +28,7 @@ unit jvmdef;
 interface
 
     uses
+      globtype,
       node,
       symbase,symtype;
 
@@ -38,29 +39,29 @@ interface
     function jvmtypeneedssignature(def: tdef): boolean;
     { create a signature encoding of a particular type; requires that
       jvmtypeneedssignature returned "true" for this type }
-    procedure jvmaddencodedsignature(def: tdef; bpacked: boolean; var encodedstr: string);
+    procedure jvmaddencodedsignature(def: tdef; bpacked: boolean; var encodedstr: TSymStr);
 
     { Encode a type into the internal format used by the JVM (descriptor).
       Returns false if a type is not representable by the JVM,
       and in that case also the failing definition.  }
-    function jvmtryencodetype(def: tdef; out encodedtype: string; forcesignature: boolean; out founderror: tdef): boolean;
+    function jvmtryencodetype(def: tdef; out encodedtype: TSymStr; forcesignature: boolean; out founderror: tdef): boolean;
 
     { same as above, but throws an internal error on failure }
-    function jvmencodetype(def: tdef; withsignature: boolean): string;
+    function jvmencodetype(def: tdef; withsignature: boolean): TSymStr;
 
     { Check whether a type can be used in a JVM methom signature or field
       declaration.  }
     function jvmchecktype(def: tdef; out founderror: tdef): boolean;
 
     { incremental version of jvmtryencodetype() }
-    function jvmaddencodedtype(def: tdef; bpacked: boolean; var encodedstr: string; forcesignature: boolean; out founderror: tdef): boolean;
+    function jvmaddencodedtype(def: tdef; bpacked: boolean; var encodedstr: TSymStr; forcesignature: boolean; out founderror: tdef): boolean;
 
     { add type prefix (package name) to a type }
-    procedure jvmaddtypeownerprefix(owner: tsymtable; var name: string);
+    procedure jvmaddtypeownerprefix(owner: tsymtable; var name: TSymStr);
 
     { returns type string for a single-dimensional array (different from normal
       typestring in case of a primitive type) }
-    function jvmarrtype(def: tdef; out primitivetype: boolean): string;
+    function jvmarrtype(def: tdef; out primitivetype: boolean): TSymStr;
     function jvmarrtype_setlength(def: tdef): char;
 
     { returns whether a def is emulated using an implicit pointer type on the
@@ -70,13 +71,12 @@ interface
     { returns the mangled base name for a tsym (type + symbol name, no
       visibility etc); also adds signature attribute if requested and
       appropriate }
-    function jvmmangledbasename(sym: tsym; withsignature: boolean): string;
-    function jvmmangledbasename(sym: tsym; const usesymname: string; withsignature: boolean): string;
+    function jvmmangledbasename(sym: tsym; withsignature: boolean): TSymStr;
+    function jvmmangledbasename(sym: tsym; const usesymname: TSymStr; withsignature: boolean): TSymStr;
 
 implementation
 
   uses
-    globtype,
     cutils,cclasses,
     verbose,systems,
     fmodule,
@@ -120,7 +120,7 @@ implementation
       end;
 
 
-    procedure jvmaddencodedsignature(def: tdef; bpacked: boolean; var encodedstr: string);
+    procedure jvmaddencodedsignature(def: tdef; bpacked: boolean; var encodedstr: TSymStr);
       var
         founderror: tdef;
       begin
@@ -182,7 +182,7 @@ implementation
       end;
 
 
-    function jvmaddencodedtype(def: tdef; bpacked: boolean; var encodedstr: string; forcesignature: boolean; out founderror: tdef): boolean;
+    function jvmaddencodedtype(def: tdef; bpacked: boolean; var encodedstr: TSymStr; forcesignature: boolean; out founderror: tdef): boolean;
       var
         c: char;
       begin
@@ -362,17 +362,17 @@ implementation
       end;
 
 
-    function jvmtryencodetype(def: tdef; out encodedtype: string; forcesignature: boolean; out founderror: tdef): boolean;
+    function jvmtryencodetype(def: tdef; out encodedtype: TSymStr; forcesignature: boolean; out founderror: tdef): boolean;
       begin
         encodedtype:='';
         result:=jvmaddencodedtype(def,false,encodedtype,forcesignature,founderror);
       end;
 
 
-    procedure jvmaddtypeownerprefix(owner: tsymtable; var name: string);
+    procedure jvmaddtypeownerprefix(owner: tsymtable; var name: TSymStr);
       var
         owningcontainer: tsymtable;
-        tmpresult: string;
+        tmpresult: TSymStr;
         module: tmodule;
         nameendpos: longint;
       begin
@@ -414,7 +414,7 @@ implementation
       end;
 
 
-    function jvmarrtype(def: tdef; out primitivetype: boolean): string;
+    function jvmarrtype(def: tdef; out primitivetype: boolean): TSymStr;
       var
         errdef: tdef;
       begin
@@ -451,7 +451,7 @@ implementation
     function jvmarrtype_setlength(def: tdef): char;
       var
         errdef: tdef;
-        res: string;
+        res: TSymStr;
       begin
         { keep in sync with rtl/java/jdynarrh.inc and usage in njvminl }
         if is_record(def) then
@@ -492,7 +492,7 @@ implementation
       end;
 
 
-    function jvmmangledbasename(sym: tsym; const usesymname: string; withsignature: boolean): string;
+    function jvmmangledbasename(sym: tsym; const usesymname: TSymStr; withsignature: boolean): TSymStr;
       var
         container: tsymtable;
         vsym: tabstractvarsym;
@@ -590,7 +590,7 @@ implementation
       end;
 
 
-    function jvmmangledbasename(sym: tsym; withsignature: boolean): string;
+    function jvmmangledbasename(sym: tsym; withsignature: boolean): TSymStr;
       begin
         if (sym.typ=fieldvarsym) and
            assigned(tfieldvarsym(sym).externalname) then
@@ -603,7 +603,7 @@ implementation
                     jvm type validity checking
 *******************************************************************}
 
-   function jvmencodetype(def: tdef; withsignature: boolean): string;
+   function jvmencodetype(def: tdef; withsignature: boolean): TSymStr;
      var
        errordef: tdef;
      begin
@@ -614,7 +614,7 @@ implementation
 
    function jvmchecktype(def: tdef; out founderror: tdef): boolean;
       var
-        encodedtype: string;
+        encodedtype: TSymStr;
       begin
         { don't duplicate the code like in objcdef, since the resulting strings
           are much shorter here so it's not worth it }

compiler/ppu.pas

@@ -43,7 +43,7 @@ type
 {$endif Test_Double_checksum}
 
 const
-  CurrentPPUVersion = 135;
+  CurrentPPUVersion = 136;
 
 { buffer sizes }
   maxentrysize = 1024;
@@ -939,24 +939,19 @@ begin
 end;
 
 
-function tppufile.getansistring: ansistring;
+function tppufile.getansistring:ansistring;
 var
-  l : longint;
+  len: longint;
 begin
-  l:=getlongint;
-  if entryidx+l>entry.size then
+  len:=getlongint;
+  if entryidx+len>entry.size then
    begin
      error:=true;
      exit;
    end;
-  if l>0 then
-    begin
-      SetLength(Result,l);
-      ReadData(result[1],l);
-    end
-  else
-    Result:='';
-  inc(entryidx,l);
+  setlength(result,len);
+  if len>0 then
+    getdata(result[1],len);
 end;
 
 
@@ -1312,14 +1307,14 @@ procedure tppufile.putstring(const s:string);
   end;
 
 
-procedure tppufile.putansistring(const s: ansistring);
+procedure tppufile.putansistring(const s:ansistring);
   var
-    l : longint;
+    len: longint;
   begin
-    l:=length(s);
-    putdata(l,4);
-    if l>0 then
-      putdata(s[1],l);
+    len:=length(s);
+    putlongint(len);
+    if len>0 then
+      putdata(s[1],len);
   end;
 
 

compiler/symdef.pas

@@ -102,7 +102,7 @@ interface
           procedure buildderef;override;
           procedure deref;override;
           function  GetTypeName:string;override;
-          function  getmangledparaname:string;override;
+          function  getmangledparaname:TSymStr;override;
           procedure setsize;
        end;
 
@@ -147,7 +147,7 @@ interface
           constructor create;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           function  GetTypeName:string;override;
-          function  getmangledparaname : string;override;
+          function  getmangledparaname : TSymStr;override;
        end;
 
        tabstractpointerdef = class(tstoreddef)
@@ -322,7 +322,7 @@ interface
           function  is_related(d : tdef) : boolean;override;
           function  needs_inittable : boolean;override;
           function  rtti_mangledname(rt:trttitype):string;override;
-          function  vmt_mangledname : string;
+          function  vmt_mangledname : TSymStr;
           procedure check_forwards; override;
           procedure insertvmt;
           procedure set_parent(c : tobjectdef);
@@ -379,7 +379,7 @@ interface
           function getcopy : tstoreddef;override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           function  GetTypeName:string;override;
-          function  getmangledparaname : string;override;
+          function  getmangledparaname : TSymStr;override;
           procedure buildderef;override;
           procedure deref;override;
           function size : asizeint;override;
@@ -473,7 +473,7 @@ interface
           function  is_publishable : boolean;override;
           function  is_methodpointer:boolean;override;
           function  is_addressonly:boolean;override;
-          function  getmangledparaname:string;override;
+          function  getmangledparaname:TSymStr;override;
        end;
 
        tmessageinf = record
@@ -517,7 +517,11 @@ interface
 
        tprocdef = class(tabstractprocdef)
        private
+{$ifdef symansistr}
+          _mangledname : ansistring;
+{$else symansistr}
           _mangledname : pshortstring;
+{$endif}
        public
           messageinf : tmessageinf;
           dispid : longint;
@@ -614,14 +618,14 @@ interface
           }
           function  getcopy: tstoreddef; override;
           function  GetTypeName : string;override;
-          function  mangledname : string;
-          procedure setmangledname(const s : string);
+          function  mangledname : TSymStr;
+          procedure setmangledname(const s : TSymStr);
           function  fullprocname(showhidden:boolean):string;
           function  customprocname(pno: tprocnameoptions):ansistring;
-          function  defaultmangledname: string;
-          function  cplusplusmangledname : string;
-          function  objcmangledname : string;
-          function  jvmmangledbasename(signature: boolean): string;
+          function  defaultmangledname: TSymStr;
+          function  cplusplusmangledname : TSymStr;
+          function  objcmangledname : TSymStr;
+          function  jvmmangledbasename(signature: boolean): TSymStr;
           function  is_methodpointer:boolean;override;
           function  is_addressonly:boolean;override;
           procedure make_external;
@@ -652,7 +656,7 @@ interface
           function  stringtypname:string;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           function  GetTypeName:string;override;
-          function  getmangledparaname:string;override;
+          function  getmangledparaname:TSymStr;override;
           function  is_publishable : boolean;override;
           function alignment : shortint;override;
           function  needs_inittable : boolean;override;
@@ -857,9 +861,9 @@ interface
        pbestrealtype : ^tdef = @s64floattype;
 {$endif JVM}
 
-    function make_mangledname(const typeprefix:string;st:TSymtable;const suffix:string):string;
-    function make_dllmangledname(const dllname,importname:string;
-                                 import_nr : word; pco : tproccalloption):string;
+    function make_mangledname(const typeprefix:TSymStr;st:TSymtable;const suffix:TSymStr):TSymStr;
+    function make_dllmangledname(const dllname,importname:TSymStr;
+                                 import_nr : word; pco : tproccalloption):TSymStr;
 
     { should be in the types unit, but the types unit uses the node stuff :( }
     function is_interfacecom(def: tdef): boolean;
@@ -920,10 +924,10 @@ implementation
                                   Helpers
 ****************************************************************************}
 
-    function make_mangledname(const typeprefix:string;st:TSymtable;const suffix:string):string;
+    function make_mangledname(const typeprefix:TSymStr;st:TSymtable;const suffix:TSymStr):TSymStr;
       var
         s,hs,
-        prefix : string;
+        prefix : TSymStr;
         oldlen,
         newlen,
         i   : longint;
@@ -1016,12 +1020,12 @@ implementation
           result := '_' + result;
       end;
 
-    function make_dllmangledname(const dllname,importname:string;import_nr : word; pco : tproccalloption):string;
+    function make_dllmangledname(const dllname,importname:TSymStr;import_nr : word; pco : tproccalloption):TSymStr;
        var
          crc : cardinal;
          i : longint;
          use_crc : boolean;
-         dllprefix : string;
+         dllprefix : TSymStr;
       begin
         if (target_info.system in (systems_all_windows + systems_nativent +
                            [system_i386_emx, system_i386_os2]))
@@ -1655,7 +1659,7 @@ implementation
       end;
 
 
-    function tstringdef.getmangledparaname : string;
+    function tstringdef.getmangledparaname : TSymStr;
       begin
         getmangledparaname:='STRING';
       end;
@@ -2249,7 +2253,7 @@ implementation
       end;
 
 
-    function tfiledef.getmangledparaname : string;
+    function tfiledef.getmangledparaname : TSymStr;
       begin
          case filetyp of
            ft_untyped:
@@ -2873,7 +2877,7 @@ implementation
       end;
 
 
-    function tarraydef.getmangledparaname : string;
+    function tarraydef.getmangledparaname : TSymStr;
       begin
          if ado_isarrayofconst in arrayoptions then
           getmangledparaname:='array_of_const'
@@ -3654,7 +3658,11 @@ implementation
       begin
          inherited create(procdef,level);
          localst:=tlocalsymtable.create(self,parast.symtablelevel);
+{$ifdef symansistr}
+         _mangledname:='';
+{$else symansistr}
          _mangledname:=nil;
+{$endif symansistr}
          fileinfo:=current_filepos;
          extnumber:=$ffff;
          aliasnames:=TCmdStrList.create;
@@ -3681,10 +3689,17 @@ implementation
         level : byte;
       begin
          inherited ppuload(procdef,ppufile);
+{$ifdef symansistr}
+         if po_has_mangledname in procoptions then
+           _mangledname:=ppufile.getansistring
+         else
+           _mangledname:='';
+{$else symansistr}
          if po_has_mangledname in procoptions then
           _mangledname:=stringdup(ppufile.getstring)
          else
           _mangledname:=nil;
+{$endif symansistr}
          extnumber:=ppufile.getword;
          level:=ppufile.getbyte;
          ppufile.getderef(structderef);
@@ -3806,6 +3821,7 @@ implementation
          stringdispose(deprecatedmsg);
          if (po_msgstr in procoptions) then
            stringdispose(messageinf.str);
+{$ifndef symansistr}
          if assigned(_mangledname) then
           begin
 {$ifdef MEMDEBUG}
@@ -3816,6 +3832,7 @@ implementation
             memmanglednames.stop;
 {$endif MEMDEBUG}
           end;
+{$endif symansistr}
          inherited destroy;
       end;
 
@@ -3831,8 +3848,13 @@ implementation
            exit;
 
          inherited ppuwrite(ppufile);
+{$ifdef symansistr}
+         if po_has_mangledname in procoptions then
+           ppufile.putansistring(_mangledname);
+{$else symansistr}
          if po_has_mangledname in procoptions then
           ppufile.putstring(_mangledname^);
+{$endif symansistr}
 
          ppufile.putword(extnumber);
          ppufile.putbyte(parast.symtablelevel);
@@ -4210,15 +4232,24 @@ implementation
       end;
 
 
-    function tprocdef.mangledname : string;
+    function tprocdef.mangledname : TSymStr;
       begin
+{$ifdef symansistr}
+        if _mangledname<>'' then
+{$else symansistr}
         if assigned(_mangledname) then
-         begin
-         {$ifdef compress}
+{$endif symansistr}
+          begin
+{$ifdef compress}
+           {$error add support for ansistrings in case of symansistr}
            mangledname:=minilzw_decode(_mangledname^);
-         {$else}
+{$else}
+  {$ifdef symansistr}
+           mangledname:=_mangledname;
+  {$else symansistr}
            mangledname:=_mangledname^;
-         {$endif}
+  {$endif symansistr}
+{$endif}
            exit;
          end;
 {$ifndef jvm}
@@ -4236,18 +4267,23 @@ implementation
         else
           jvmaddtypeownerprefix(owner,mangledname);
 {$endif not jvm}
-       {$ifdef compress}
+{$ifdef compress}
+       {$error add support for ansistrings in case of symansistr}
         _mangledname:=stringdup(minilzw_encode(mangledname));
-       {$else}
+{$else}
+  {$ifdef symansistr}
+        _mangledname:=mangledname;
+  {$else symansistr}
         _mangledname:=stringdup(mangledname);
-       {$endif}
+  {$endif symansistr}
+{$endif}
       end;
 
 
-    function tprocdef.defaultmangledname: string;
+    function tprocdef.defaultmangledname: TSymStr;
       var
         hp   : TParavarsym;
-        hs   : string;
+        hs   : TSymStr;
         crc  : dword;
         newlen,
         oldlen,
@@ -4290,9 +4326,9 @@ implementation
       end;
 
 
-    function tprocdef.cplusplusmangledname : string;
+    function tprocdef.cplusplusmangledname : TSymStr;
 
-      function getcppparaname(p : tdef) : string;
+      function getcppparaname(p : tdef) : TSymStr;
 
         const
 {$ifdef NAMEMANGLING_GCC2}
@@ -4317,7 +4353,7 @@ implementation
 {$endif NAMEMANGLING_GCC2}
 
         var
-           s : string;
+           s : TSymStr;
 
         begin
            case p.typ of
@@ -4336,7 +4372,7 @@ implementation
         end;
 
       var
-         s,s2 : string;
+         s,s2 : TSymStr;
          hp   : TParavarsym;
          i    : integer;
 
@@ -4435,7 +4471,7 @@ implementation
       end;
 
 
-    function  tprocdef.objcmangledname : string;
+    function  tprocdef.objcmangledname : TSymStr;
       var
         manglednamelen: longint;
         iscatmethod   : boolean;
@@ -4466,12 +4502,12 @@ implementation
       end;
 
 
-    function tprocdef.jvmmangledbasename(signature: boolean): string;
+    function tprocdef.jvmmangledbasename(signature: boolean): TSymStr;
       var
         vs: tparavarsym;
         i: longint;
         founderror: tdef;
-        tmpresult: string;
+        tmpresult: TSymStr;
         container: tsymtable;
       begin
         { format:
@@ -4561,33 +4597,47 @@ implementation
       end;
 
 
-    procedure tprocdef.setmangledname(const s : string);
+    procedure tprocdef.setmangledname(const s : TSymStr);
       begin
         { This is not allowed anymore, the forward declaration
           already needs to create the correct mangledname, no changes
           afterwards are allowed (PFV) }
         { Exception: interface definitions in mode macpas, since in that }
         {   case no reference to the old name can exist yet (JM)         }
+{$ifdef symansistr}
+        if _mangledname<>'' then
+          if ((m_mac in current_settings.modeswitches) and
+              (interfacedef)) then
+            _mangledname:=''
+          else
+            internalerror(200411171);
+{$else symansistr}
         if assigned(_mangledname) then
           if ((m_mac in current_settings.modeswitches) and
               (interfacedef)) then
             stringdispose(_mangledname)
           else
             internalerror(200411171);
-      {$ifdef jvm}
+{$endif symansistr}
+{$ifdef jvm}
         { this routine can be called for compilerproces. can't set mangled
           name since it must be calculated, but it uses import_name when set
           -> set that one }
         import_name:=stringdup(s);
         include(procoptions,po_has_importname);
         include(procoptions,po_has_mangledname);
-      {$else}
-      {$ifdef compress}
+{$else}
+  {$ifdef compress}
+        {$error add support for symansistr}
         _mangledname:=stringdup(minilzw_encode(s));
-      {$else}
+  {$else}
+    {$ifdef symansistr}
+        _mangledname:=s;
+    {$else symansistr}
         _mangledname:=stringdup(s);
-      {$endif}
-      {$endif jvm}
+    {$endif symansistr}
+  {$endif}
+{$endif jvm}
         include(procoptions,po_has_mangledname);
       end;
 
@@ -4696,7 +4746,7 @@ implementation
       end;
 
 
-    function tprocvardef.getmangledparaname:string;
+    function tprocvardef.getmangledparaname:TSymStr;
       begin
         if not(po_methodpointer in procoptions) then
           if not is_nested_pd(self) then
@@ -5437,7 +5487,7 @@ implementation
       end;
 
 
-    function tobjectdef.vmt_mangledname : string;
+    function tobjectdef.vmt_mangledname : TSymStr;
       begin
         if not(oo_has_vmt in objectoptions) then
           Message1(parser_n_object_has_no_vmt,objrealname^);
@@ -6040,7 +6090,7 @@ implementation
       end;
 
 
-    function terrordef.getmangledparaname:string;
+    function terrordef.getmangledparaname:TSymStr;
       begin
         getmangledparaname:='error';
       end;

compiler/symsym.pas

@@ -67,7 +67,7 @@ interface
           constructor create(const n : string);
           constructor ppuload(ppufile:tcompilerppufile);
           procedure ppuwrite(ppufile:tcompilerppufile);override;
-          function mangledname:string;override;
+          function mangledname:TSymStr;override;
        end;
 
        tunitsym = class(Tstoredsym)
@@ -159,12 +159,16 @@ interface
       tfieldvarsym = class(tabstractvarsym)
           fieldoffset   : asizeint;   { offset in record/object }
           externalname  : pshortstring;
+{$ifdef symansistr}
+          cachedmangledname: TSymStr; { mangled name for ObjC or Java }
+{$else symansistr}
           cachedmangledname: pshortstring; { mangled name for ObjC or Java }
+{$endif symansistr}
           constructor create(const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions);
           constructor ppuload(ppufile:tcompilerppufile);
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           procedure set_externalname(const s:string);
-          function mangledname:string;override;
+          function mangledname:TSymStr;override;
           destructor destroy;override;
       end;
 
@@ -205,17 +209,21 @@ interface
 
       tstaticvarsym = class(tabstractnormalvarsym)
       private
+{$ifdef symansistr}
+          _mangledname : TSymStr;
+{$else symansistr}
           _mangledname : pshortstring;
+{$endif symansistr}
       public
           section : ansistring;
           constructor create(const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions);
           constructor create_dll(const n : string;vsp:tvarspez;def:tdef);
-          constructor create_C(const n,mangled : string;vsp:tvarspez;def:tdef);
+          constructor create_C(const n: string; const mangled : TSymStr;vsp:tvarspez;def:tdef);
           constructor ppuload(ppufile:tcompilerppufile);
           destructor destroy;override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
-          function mangledname:string;override;
-          procedure set_mangledname(const s:string);
+          function mangledname:TSymStr;override;
+          procedure set_mangledname(const s:TSymStr);
       end;
 
       tabsolutevarsym = class(tabstractvarsym)
@@ -233,7 +241,7 @@ interface
          constructor ppuload(ppufile:tcompilerppufile);
          procedure buildderef;override;
          procedure deref;override;
-         function  mangledname : string;override;
+         function  mangledname : TSymStr;override;
          procedure ppuwrite(ppufile:tcompilerppufile);override;
       end;
 
@@ -450,7 +458,7 @@ implementation
       end;
 
 
-   function tlabelsym.mangledname:string;
+   function tlabelsym.mangledname:TSymStr;
      begin
        if not(defined) then
          begin
@@ -1287,11 +1295,13 @@ implementation
 
 
     procedure tfieldvarsym.set_externalname(const s: string);
-      var
-        tmp: string;
       begin
         { make sure it is recalculated }
+{$ifdef symansistr}
+        cachedmangledname:='';
+{$else symansistr}
         stringdispose(cachedmangledname);
+{$endif symansistr}
 {$ifdef jvm}
         if is_java_class_or_interface(tdef(owner.defowner)) then
           begin
@@ -1304,7 +1314,7 @@ implementation
       end;
 
 
-    function tfieldvarsym.mangledname:string;
+    function tfieldvarsym.mangledname:TSymStr;
       var
         srsym : tsym;
         srsymtable : tsymtable;
@@ -1313,13 +1323,13 @@ implementation
         if is_java_class_or_interface(tdef(owner.defowner)) or
            (tdef(owner.defowner).typ=recorddef) then
           begin
-            if assigned(cachedmangledname) then
-              result:=cachedmangledname^
+            if cachedmangledname<>'' then
+              result:=cachedmangledname
             else
               begin
                 result:=jvmmangledbasename(self,false);
                 jvmaddtypeownerprefix(owner,result);
-                cachedmangledname:=stringdup(result);
+                cachedmangledname:=result;
               end;
           end
         else
@@ -1338,12 +1348,21 @@ implementation
           end
         else if is_objcclass(tdef(owner.defowner)) then
           begin
+{$ifdef symansistr}
+            if cachedmangledname<>'' then
+              result:=cachedmangledname
+{$else symansistr}
             if assigned(cachedmangledname) then
               result:=cachedmangledname^
+{$endif symansistr}
             else
               begin
                 result:=target_info.cprefix+'OBJC_IVAR_$_'+tobjectdef(owner.defowner).objextname^+'.'+RealName;
+{$ifdef symansistr}
+                cachedmangledname:=result;
+{$else symansistr}
                 cachedmangledname:=stringdup(result);
+{$endif symansistr}
               end;
           end
         else
@@ -1353,7 +1372,9 @@ implementation
 
     destructor tfieldvarsym.destroy;
       begin
+{$ifndef symansistr}
         stringdispose(cachedmangledname);
+{$endif symansistr}
         inherited destroy;
       end;
 
@@ -1408,7 +1429,11 @@ implementation
     constructor tstaticvarsym.create(const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions);
       begin
          inherited create(staticvarsym,n,vsp,def,vopts);
+{$ifdef symansistr}
+         _mangledname:='';
+{$else symansistr}
          _mangledname:=nil;
+{$endif symansistr}
       end;
 
 
@@ -1418,7 +1443,7 @@ implementation
       end;
 
 
-    constructor tstaticvarsym.create_C(const n,mangled : string;vsp:tvarspez;def:tdef);
+    constructor tstaticvarsym.create_C(const n: string; const mangled : TSymStr;vsp:tvarspez;def:tdef);
       begin
          tstaticvarsym(self).create(n,vsp,def,[]);
          set_mangledname(mangled);
@@ -1428,17 +1453,25 @@ implementation
     constructor tstaticvarsym.ppuload(ppufile:tcompilerppufile);
       begin
          inherited ppuload(staticvarsym,ppufile);
+{$ifdef symansistr}
+         if vo_has_mangledname in varoptions then
+           _mangledname:=ppufile.getansistring
+         else
+           _mangledname:='';
+{$else symansistr}
          if vo_has_mangledname in varoptions then
            _mangledname:=stringdup(ppufile.getstring)
          else
            _mangledname:=nil;
          if vo_has_section in varoptions then
            section:=ppufile.getansistring;
+{$endif symansistr}
       end;
 
 
     destructor tstaticvarsym.destroy;
       begin
+{$ifndef symansistr}
         if assigned(_mangledname) then
           begin
 {$ifdef MEMDEBUG}
@@ -1449,6 +1482,7 @@ implementation
             memmanglednames.stop;
 {$endif MEMDEBUG}
           end;
+{$endif}
         inherited destroy;
       end;
 
@@ -1457,58 +1491,73 @@ implementation
       begin
          inherited ppuwrite(ppufile);
          if vo_has_mangledname in varoptions then
+{$ifdef symansistr}
+           ppufile.putansistring(_mangledname);
+{$else symansistr}
            ppufile.putstring(_mangledname^);
          if vo_has_section in varoptions then
            ppufile.putansistring(section);
+{$endif symansistr}
          ppufile.writeentry(ibstaticvarsym);
       end;
 
 
-    function tstaticvarsym.mangledname:string;
+    function tstaticvarsym.mangledname:TSymStr;
+{$ifndef jvm}
       var
-{$ifdef jvm}
-        tmpname: string;
-{$else jvm}
-        prefix : string[2];
+        prefix : TSymStr;
 {$endif jvm}
       begin
+{$ifdef symansistr}
+        if _mangledname='' then
+{$else symansistr}
         if not assigned(_mangledname) then
+{$endif symansistr}
           begin
 {$ifdef jvm}
-            tmpname:=jvmmangledbasename(self,false);
-            jvmaddtypeownerprefix(owner,tmpname);
-            _mangledname:=stringdup(tmpname);
+            _mangledname:=jvmmangledbasename(self,false);
+            jvmaddtypeownerprefix(owner,_mangledname);
 {$else jvm}
             if (vo_is_typed_const in varoptions) then
               prefix:='TC'
             else
               prefix:='U';
 {$ifdef compress}
+            {$error add ansistring support for symansistr}
             _mangledname:=stringdup(minilzw_encode(make_mangledname(prefix,owner,name)));
 {$else compress}
+  {$ifdef symansistr}
+           _mangledname:=make_mangledname(prefix,owner,name);
+  {$else symansistr}
            _mangledname:=stringdup(make_mangledname(prefix,owner,name));
+  {$endif symansistr}
 {$endif compress}
 {$endif jvm}
           end;
+{$ifdef symansistr}
+        result:=_mangledname;
+{$else symansistr}
         result:=_mangledname^;
+{$endif symansistr}
       end;
 
 
-    procedure tstaticvarsym.set_mangledname(const s:string);
-{$ifdef jvm}
-      var
-        tmpname: string;
-{$endif}
+    procedure tstaticvarsym.set_mangledname(const s:TSymStr);
       begin
+{$ifndef symansistr}
         stringdispose(_mangledname);
+{$endif}
 {$if defined(jvm)}
-        tmpname:=jvmmangledbasename(self,s,false);
-        jvmaddtypeownerprefix(owner,tmpname);
-        _mangledname:=stringdup(tmpname);
+        _mangledname:=jvmmangledbasename(self,s,false);
+        jvmaddtypeownerprefix(owner,_mangledname);
 {$elseif defined(compress)}
         _mangledname:=stringdup(minilzw_encode(s));
 {$else}
+  {$ifdef symansistr}
+        _mangledname:=s;
+  {$else symansistr}
         _mangledname:=stringdup(s);
+  {$endif symansistr}
 {$endif}
         include(varoptions,vo_has_mangledname);
       end;
@@ -1706,7 +1755,7 @@ implementation
       end;
 
 
-    function tabsolutevarsym.mangledname : string;
+    function tabsolutevarsym.mangledname : TSymStr;
       begin
          case abstyp of
            toasm :

compiler/symtype.pas

@@ -71,7 +71,7 @@ interface
          function  GetTypeName:string;virtual;
          function  typesymbolprettyname:string;virtual;
          function  mangledparaname:string;
-         function  getmangledparaname:string;virtual;
+         function  getmangledparaname:TSymStr;virtual;
          function  rtti_mangledname(rt:trttitype):string;virtual;abstract;
          function  OwnerHierarchyName: string; virtual; abstract;
          function  size:asizeint;virtual;abstract;
@@ -110,7 +110,7 @@ interface
          deprecatedmsg: pshortstring;
          constructor create(st:tsymtyp;const aname:string);
          destructor  destroy;override;
-         function  mangledname:string; virtual;
+         function  mangledname:TSymStr; virtual;
          function  prettyname:string; virtual;
          procedure buildderef;virtual;
          procedure deref;virtual;
@@ -296,7 +296,7 @@ implementation
       end;
 
 
-    function tdef.getmangledparaname:string;
+    function tdef.getmangledparaname:TSymStr;
       begin
          result:='<unknown type>';
       end;
@@ -403,7 +403,7 @@ implementation
       end;
 
 
-    function tsym.mangledname : string;
+    function tsym.mangledname : TSymStr;
       begin
         internalerror(200204171);
         result:='';

compiler/utils/ppudump.pp

@@ -20,7 +20,7 @@
  ****************************************************************************}
 program ppudump;
 
-{$mode objfpc}
+{$i fpcdefs.inc}
 {$H+}
 
 {$define IN_PPUDUMP}
@@ -1663,7 +1663,11 @@ begin
              write  (space,' DefaultConst : ');
              readderef('');
              if (vo_has_mangledname in varoptions) then
+{$ifdef symansistr}
+               writeln(space,' Mangledname : ',getansistring);
+{$else symansistr}
                writeln(space,' Mangledname : ',getstring);
+{$endif symansistr}
            end;
 
          iblocalvarsym :
@@ -1861,7 +1865,11 @@ begin
              readcommondef('Procedure definition',defoptions);
              read_abstract_proc_def(calloption,procoptions);
              if (po_has_mangledname in procoptions) then
+{$ifdef symansistr}
+               writeln(space,'     Mangled name : ',getansistring);
+{$else symansistr}
                writeln(space,'     Mangled name : ',getstring);
+{$endif symansistr}
              writeln(space,'           Number : ',getword);
              writeln(space,'            Level : ',getbyte);
              write  (space,'            Class : ');