Przeglądaj źródła

* patch by Rika to pass some strings by reference, resolves #39338

florian 3 lat temu
rodzic
commit
e4ee8fa6a2

+ 5 - 5
compiler/assemble.pas

@@ -280,7 +280,7 @@ Implementation
     var
     var
       CAssembler : array[tasm] of TAssemblerClass;
       CAssembler : array[tasm] of TAssemblerClass;
 
 
-    function fixline(s:string):string;
+    function fixline(const s:string):string;
      {
      {
        return s with all leading and ending spaces and tabs removed
        return s with all leading and ending spaces and tabs removed
      }
      }
@@ -293,10 +293,10 @@ Implementation
         j:=1;
         j:=1;
         while (j<i) and (s[j] in [#9,' ']) do
         while (j<i) and (s[j] in [#9,' ']) do
           inc(j);
           inc(j);
-        for k:=j to i do
-          if s[k] in [#0..#31,#127..#255] then
-            s[k]:='.';
-        fixline:=Copy(s,j,i-j+1);
+        result := Copy(s, j, i - j + 1);
+        for k:=1 to length(result) do
+          if result[k] in [#0..#31,#127..#255] then
+            result[k]:='.';
       end;
       end;
 
 
 {*****************************************************************************
 {*****************************************************************************

+ 2 - 2
compiler/cstreams.pas

@@ -95,7 +95,7 @@ type
     procedure WriteByte(b : Byte); {$ifdef USEINLINE}inline;{$endif}
     procedure WriteByte(b : Byte); {$ifdef USEINLINE}inline;{$endif}
     procedure WriteWord(w : Word); {$ifdef USEINLINE}inline;{$endif}
     procedure WriteWord(w : Word); {$ifdef USEINLINE}inline;{$endif}
     procedure WriteDWord(d : Cardinal); {$ifdef USEINLINE}inline;{$endif}
     procedure WriteDWord(d : Cardinal); {$ifdef USEINLINE}inline;{$endif}
-    Procedure WriteAnsiString (S : AnsiString);
+    Procedure WriteAnsiString (const S : AnsiString);
     property Position: Longint read GetPosition write SetPosition;
     property Position: Longint read GetPosition write SetPosition;
     property Size: Longint read GetSize write SetSize;
     property Size: Longint read GetSize write SetSize;
   end;
   end;
@@ -345,7 +345,7 @@ implementation
      end;
      end;
    end;
    end;
 
 
-  Procedure TCStream.WriteAnsiString (S : AnsiString);
+  Procedure TCStream.WriteAnsiString (const S : AnsiString);
 
 
   Var L : Longint;
   Var L : Longint;
 
 

+ 14 - 14
compiler/globals.pas

@@ -207,16 +207,16 @@ interface
       private
       private
         itemcnt : longint;
         itemcnt : longint;
         fmap : Array Of TLinkRec;
         fmap : Array Of TLinkRec;
-        function  Lookup(key:Ansistring):longint;
+        function  Lookup(const key:Ansistring):longint;
         function getlinkrec(i:longint):TLinkRec;
         function getlinkrec(i:longint):TLinkRec;
       public
       public
-        procedure Add(key:ansistring;value:AnsiString='';weight:longint=LinkMapWeightDefault);
-        procedure addseries(keys:AnsiString;weight:longint=LinkMapWeightDefault);
-        function  AddDep(keyvalue:String):boolean;
-        function  AddWeight(keyvalue:String):boolean;
-        procedure SetValue(key:AnsiString;Weight:Integer);
+        procedure Add(const key:ansistring;const value:AnsiString='';weight:longint=LinkMapWeightDefault);
+        procedure addseries(const keys:AnsiString;weight:longint=LinkMapWeightDefault);
+        function  AddDep(const keyvalue:String):boolean;
+        function  AddWeight(const keyvalue:String):boolean;
+        procedure SetValue(const key:AnsiString;Weight:Integer);
         procedure SortonWeight;
         procedure SortonWeight;
-        function Find(key:AnsiString):AnsiString;
+        function Find(const key:AnsiString):AnsiString;
         procedure Expand(src:TCmdStrList;dest: TLinkStrMap);
         procedure Expand(src:TCmdStrList;dest: TLinkStrMap);
         procedure UpdateWeights(Weightmap:TLinkStrMap);
         procedure UpdateWeights(Weightmap:TLinkStrMap);
         constructor Create;
         constructor Create;
@@ -699,7 +699,7 @@ implementation
       end;
       end;
 
 
 
 
-    procedure TLinkStrMap.Add(key:ansistring;value:AnsiString='';weight:longint=LinkMapWeightDefault);
+    procedure TLinkStrMap.Add(const key:ansistring;const value:AnsiString='';weight:longint=LinkMapWeightDefault);
       begin
       begin
         if lookup(key)<>-1 Then
         if lookup(key)<>-1 Then
           exit;
           exit;
@@ -712,7 +712,7 @@ implementation
       end;
       end;
 
 
 
 
-    function  TLinkStrMap.AddDep(keyvalue:String):boolean;
+    function  TLinkStrMap.AddDep(const keyvalue:String):boolean;
       var
       var
         i : Longint;
         i : Longint;
       begin
       begin
@@ -725,7 +725,7 @@ implementation
       end;
       end;
 
 
 
 
-    function  TLinkStrMap.AddWeight(keyvalue:String):boolean;
+    function  TLinkStrMap.AddWeight(const keyvalue:String):boolean;
       var
       var
         i,j    : Longint;
         i,j    : Longint;
         Code : Word;
         Code : Word;
@@ -745,7 +745,7 @@ implementation
       end;
       end;
 
 
 
 
-    procedure TLinkStrMap.addseries(keys:AnsiString;weight:longint);
+    procedure TLinkStrMap.addseries(const keys:AnsiString;weight:longint);
       var
       var
         i,j,k : longint;
         i,j,k : longint;
       begin
       begin
@@ -761,7 +761,7 @@ implementation
          end;
          end;
       end;
       end;
 
 
-    procedure TLinkStrMap.SetValue(Key:Ansistring;weight:Integer);
+    procedure TLinkStrMap.SetValue(const Key:Ansistring;weight:Integer);
       var
       var
         j : longint;
         j : longint;
       begin
       begin
@@ -771,7 +771,7 @@ implementation
       end;
       end;
 
 
 
 
-    function TLinkStrMap.find(key:Ansistring):Ansistring;
+    function TLinkStrMap.find(const key:Ansistring):Ansistring;
       var
       var
         j : longint;
         j : longint;
       begin
       begin
@@ -782,7 +782,7 @@ implementation
       end;
       end;
 
 
 
 
-    function TLinkStrMap.lookup(key:Ansistring):longint;
+    function TLinkStrMap.lookup(const key:Ansistring):longint;
       var
       var
         i : longint;
         i : longint;
       begin
       begin

+ 1 - 1
compiler/pexpr.pas

@@ -1772,7 +1772,7 @@ implementation
 ****************************************************************************}
 ****************************************************************************}
 
 
 
 
-    function real_const_node_from_pattern(s:string):tnode;
+    function real_const_node_from_pattern(const s:string):tnode;
       var
       var
         d : bestreal;
         d : bestreal;
         code : integer;
         code : integer;

+ 12 - 12
compiler/pgenutil.pas

@@ -36,18 +36,18 @@ uses
   { symtable }
   { symtable }
   symtype,symdef,symbase;
   symtype,symdef,symbase;
 
 
-    procedure generate_specialization(var tt:tdef;parse_class_parent:boolean;_prettyname:string;parsedtype:tdef;symname:string;parsedpos:tfileposinfo);inline;
-    procedure generate_specialization(var tt:tdef;parse_class_parent:boolean;_prettyname:string);inline;
+    procedure generate_specialization(var tt:tdef;parse_class_parent:boolean;const _prettyname:string;parsedtype:tdef;const symname:string;parsedpos:tfileposinfo);inline;
+    procedure generate_specialization(var tt:tdef;parse_class_parent:boolean;const _prettyname:string);inline;
     function generate_specialization_phase1(out context:tspecializationcontext;genericdef:tdef):tdef;inline;
     function generate_specialization_phase1(out context:tspecializationcontext;genericdef:tdef):tdef;inline;
-    function generate_specialization_phase1(out context:tspecializationcontext;genericdef:tdef;symname:string;symtable:tsymtable):tdef;inline;
-    function generate_specialization_phase1(out context:tspecializationcontext;genericdef:tdef;parsedtype:tdef;symname:string;symtable:tsymtable;parsedpos:tfileposinfo):tdef;
-    function generate_specialization_phase2(context:tspecializationcontext;genericdef:tstoreddef;parse_class_parent:boolean;_prettyname:ansistring):tdef;
+    function generate_specialization_phase1(out context:tspecializationcontext;genericdef:tdef;const symname:string;symtable:tsymtable):tdef;inline;
+    function generate_specialization_phase1(out context:tspecializationcontext;genericdef:tdef;parsedtype:tdef;const symname:string;symtable:tsymtable;parsedpos:tfileposinfo):tdef;
+    function generate_specialization_phase2(context:tspecializationcontext;genericdef:tstoreddef;parse_class_parent:boolean;const _prettyname:ansistring):tdef;
     function check_generic_constraints(genericdef:tstoreddef;paramlist:tfpobjectlist;poslist:tfplist):boolean;
     function check_generic_constraints(genericdef:tstoreddef;paramlist:tfpobjectlist;poslist:tfplist):boolean;
     function parse_generic_parameters(allowconstraints:boolean):tfphashobjectlist;
     function parse_generic_parameters(allowconstraints:boolean):tfphashobjectlist;
     function parse_generic_specialization_types(paramlist:tfpobjectlist;poslist:tfplist;out prettyname,specializename:ansistring):boolean;
     function parse_generic_specialization_types(paramlist:tfpobjectlist;poslist:tfplist;out prettyname,specializename:ansistring):boolean;
     procedure insert_generic_parameter_types(def:tstoreddef;genericdef:tstoreddef;genericlist:tfphashobjectlist);
     procedure insert_generic_parameter_types(def:tstoreddef;genericdef:tstoreddef;genericlist:tfphashobjectlist);
     procedure maybe_insert_generic_rename_symbol(const name:tidstring;genericlist:tfphashobjectlist);
     procedure maybe_insert_generic_rename_symbol(const name:tidstring;genericlist:tfphashobjectlist);
-    function generate_generic_name(const name:tidstring;specializename:ansistring;owner_hierarchy:string):tidstring;
+    function generate_generic_name(const name:tidstring;const specializename:ansistring;const owner_hierarchy:string):tidstring;
     procedure split_generic_name(const name:tidstring;out nongeneric:string;out count:longint);
     procedure split_generic_name(const name:tidstring;out nongeneric:string;out count:longint);
     procedure add_generic_dummysym(sym:tsym);
     procedure add_generic_dummysym(sym:tsym);
     function resolve_generic_dummysym(const name:tidstring):tsym;
     function resolve_generic_dummysym(const name:tidstring):tsym;
@@ -601,7 +601,7 @@ uses
       end;
       end;
 
 
 
 
-    procedure generate_specialization(var tt:tdef;parse_class_parent:boolean;_prettyname:string);
+    procedure generate_specialization(var tt:tdef;parse_class_parent:boolean;const _prettyname:string);
       var
       var
         dummypos : tfileposinfo;
         dummypos : tfileposinfo;
       begin
       begin
@@ -621,7 +621,7 @@ uses
 {$pop}
 {$pop}
 
 
 
 
-    function generate_specialization_phase1(out context:tspecializationcontext;genericdef:tdef;symname:string;symtable:tsymtable):tdef;
+    function generate_specialization_phase1(out context:tspecializationcontext;genericdef:tdef;const symname:string;symtable:tsymtable):tdef;
       var
       var
         dummypos : tfileposinfo;
         dummypos : tfileposinfo;
 {$push}
 {$push}
@@ -632,7 +632,7 @@ uses
 {$pop}
 {$pop}
 
 
 
 
-    function generate_specialization_phase1(out context:tspecializationcontext;genericdef:tdef;parsedtype:tdef;symname:string;symtable:tsymtable;parsedpos:tfileposinfo):tdef;
+    function generate_specialization_phase1(out context:tspecializationcontext;genericdef:tdef;parsedtype:tdef;const symname:string;symtable:tsymtable;parsedpos:tfileposinfo):tdef;
       var
       var
         found,
         found,
         err : boolean;
         err : boolean;
@@ -809,7 +809,7 @@ uses
           consume(_RSHARPBRACKET);
           consume(_RSHARPBRACKET);
       end;
       end;
 
 
-    function generate_specialization_phase2(context:tspecializationcontext;genericdef:tstoreddef;parse_class_parent:boolean;_prettyname:ansistring):tdef;
+    function generate_specialization_phase2(context:tspecializationcontext;genericdef:tstoreddef;parse_class_parent:boolean;const _prettyname:ansistring):tdef;
 
 
         procedure unset_forwarddef(def: tdef);
         procedure unset_forwarddef(def: tdef);
           var
           var
@@ -1357,7 +1357,7 @@ uses
       end;
       end;
 
 
 
 
-    procedure generate_specialization(var tt:tdef;parse_class_parent:boolean;_prettyname:string;parsedtype:tdef;symname:string;parsedpos:tfileposinfo);
+    procedure generate_specialization(var tt:tdef;parse_class_parent:boolean;const _prettyname:string;parsedtype:tdef;const symname:string;parsedpos:tfileposinfo);
       var
       var
         context : tspecializationcontext;
         context : tspecializationcontext;
         genericdef : tstoreddef;
         genericdef : tstoreddef;
@@ -1730,7 +1730,7 @@ uses
           end;
           end;
       end;
       end;
 
 
-    function generate_generic_name(const name:tidstring;specializename:ansistring;owner_hierarchy:string):tidstring;
+    function generate_generic_name(const name:tidstring;const specializename:ansistring;const owner_hierarchy:string):tidstring;
     var
     var
       crc : cardinal;
       crc : cardinal;
     begin
     begin

+ 1 - 1
compiler/pinline.pas

@@ -660,7 +660,7 @@ implementation
       end;
       end;
 
 
 
 
-    function inline_copy_insert_delete(nr:tinlinenumber;name:string;checkempty:boolean) : tnode;
+    function inline_copy_insert_delete(nr:tinlinenumber;const name:string;checkempty:boolean) : tnode;
       var
       var
         paras   : tnode;
         paras   : tnode;
         { for easy exiting if something goes wrong }
         { for easy exiting if something goes wrong }

+ 21 - 17
compiler/scanner.pas

@@ -968,11 +968,11 @@ type
     constructor create_int(v: int64);
     constructor create_int(v: int64);
     constructor create_uint(v: qword);
     constructor create_uint(v: qword);
     constructor create_bool(b: boolean);
     constructor create_bool(b: boolean);
-    constructor create_str(s: string);
+    constructor create_str(const s: string);
     constructor create_set(ns: tnormalset);
     constructor create_set(ns: tnormalset);
     constructor create_real(r: bestreal);
     constructor create_real(r: bestreal);
-    class function try_parse_number(s:string):texprvalue; static;
-    class function try_parse_real(s:string):texprvalue; static;
+    class function try_parse_number(const s:string):texprvalue; static;
+    class function try_parse_real(const s:string):texprvalue; static;
     function evaluate(v:texprvalue;op:ttoken):texprvalue;
     function evaluate(v:texprvalue;op:ttoken):texprvalue;
     procedure error(expecteddef, place: string);
     procedure error(expecteddef, place: string);
     function isBoolean: Boolean;
     function isBoolean: Boolean;
@@ -1087,7 +1087,7 @@ type
       def:=booldef;
       def:=booldef;
     end;
     end;
 
 
-  constructor texprvalue.create_str(s: string);
+  constructor texprvalue.create_str(const s: string);
     var
     var
       sp: pansichar;
       sp: pansichar;
       len: integer;
       len: integer;
@@ -1120,7 +1120,7 @@ type
       def:=realdef;
       def:=realdef;
     end;
     end;
 
 
-  class function texprvalue.try_parse_number(s:string):texprvalue;
+  class function texprvalue.try_parse_number(const s:string):texprvalue;
     var
     var
       ic: int64;
       ic: int64;
       qc: qword;
       qc: qword;
@@ -1141,7 +1141,7 @@ type
         end;
         end;
     end;
     end;
 
 
-  class function texprvalue.try_parse_real(s:string):texprvalue;
+  class function texprvalue.try_parse_real(const s:string):texprvalue;
     var
     var
       d: bestreal;
       d: bestreal;
       code: integer;
       code: integer;
@@ -1648,7 +1648,7 @@ type
                end;
                end;
           end;
           end;
 
 
-        function preproc_substitutedtoken(searchstr:string;eval:Boolean):texprvalue;
+        function preproc_substitutedtoken(const basesearchstr:string;eval:Boolean):texprvalue;
         { Currently this parses identifiers as well as numbers.
         { Currently this parses identifiers as well as numbers.
           The result from this procedure can either be that the token
           The result from this procedure can either be that the token
           itself is a value, or that it is a compile time variable/macro,
           itself is a value, or that it is a compile time variable/macro,
@@ -1661,20 +1661,23 @@ type
           macrocount,
           macrocount,
           len: integer;
           len: integer;
           foundmacro: boolean;
           foundmacro: boolean;
+          searchstr: pshortstring;
+          searchstr2store: string;
         begin
         begin
           if not eval then
           if not eval then
             begin
             begin
-              result:=texprvalue.create_str(searchstr);
+              result:=texprvalue.create_str(basesearchstr);
               exit;
               exit;
             end;
             end;
 
 
+          searchstr := @basesearchstr;
           mac:=nil;
           mac:=nil;
           foundmacro:=false;
           foundmacro:=false;
           { Substitue macros and compiler variables with their content/value.
           { Substitue macros and compiler variables with their content/value.
             For real macros also do recursive substitution. }
             For real macros also do recursive substitution. }
           macrocount:=0;
           macrocount:=0;
           repeat
           repeat
-            mac:=tmacro(search_macro(searchstr));
+            mac:=tmacro(search_macro(searchstr^));
 
 
             inc(macrocount);
             inc(macrocount);
             if macrocount>max_macro_nesting then
             if macrocount>max_macro_nesting then
@@ -1695,13 +1698,14 @@ type
                     len:=mac.buflen;
                     len:=mac.buflen;
                   hs[0]:=char(len);
                   hs[0]:=char(len);
                   move(mac.buftext^,hs[1],len);
                   move(mac.buftext^,hs[1],len);
-                  searchstr:=upcase(hs);
+                  searchstr2store:=upcase(hs);
+                  searchstr:=@searchstr2store;
                   mac.is_used:=true;
                   mac.is_used:=true;
                   foundmacro:=true;
                   foundmacro:=true;
                 end
                 end
               else
               else
                 begin
                 begin
-                  Message1(scan_e_error_macro_lacks_value,searchstr);
+                  Message1(scan_e_error_macro_lacks_value,searchstr^);
                   break;
                   break;
                 end
                 end
             else
             else
@@ -1713,12 +1717,12 @@ type
 
 
           { At this point, result do contain the value. Do some decoding and
           { At this point, result do contain the value. Do some decoding and
             determine the type.}
             determine the type.}
-          result:=texprvalue.try_parse_number(searchstr);
+          result:=texprvalue.try_parse_number(searchstr^);
           if not assigned(result) then
           if not assigned(result) then
             begin
             begin
-              if foundmacro and (searchstr='FALSE') then
+              if foundmacro and (searchstr^='FALSE') then
                 result:=texprvalue.create_bool(false)
                 result:=texprvalue.create_bool(false)
-              else if foundmacro and (searchstr='TRUE') then
+              else if foundmacro and (searchstr^='TRUE') then
                 result:=texprvalue.create_bool(true)
                 result:=texprvalue.create_bool(true)
               else if (m_mac in current_settings.modeswitches) and
               else if (m_mac in current_settings.modeswitches) and
                       (not assigned(mac) or not mac.defined) and
                       (not assigned(mac) or not mac.defined) and
@@ -1726,11 +1730,11 @@ type
                 begin
                 begin
                   {Errors in mode mac is issued here. For non macpas modes there is
                   {Errors in mode mac is issued here. For non macpas modes there is
                    more liberty, but the error will eventually be caught at a later stage.}
                    more liberty, but the error will eventually be caught at a later stage.}
-                  Message1(scan_e_error_macro_undefined,searchstr);
-                  result:=texprvalue.create_str(searchstr); { just to have something }
+                  Message1(scan_e_error_macro_undefined,searchstr^);
+                  result:=texprvalue.create_str(searchstr^); { just to have something }
                 end
                 end
               else
               else
-                result:=texprvalue.create_str(searchstr);
+                result:=texprvalue.create_str(searchstr^);
             end;
             end;
         end;
         end;
 
 

+ 2 - 2
compiler/symtable.pas

@@ -322,7 +322,7 @@ interface
 
 
 {*** Misc ***}
 {*** Misc ***}
     function  FullTypeName(def,otherdef:tdef):string;
     function  FullTypeName(def,otherdef:tdef):string;
-    function generate_nested_name(symtable:tsymtable;delimiter:string):string;
+    function generate_nested_name(symtable:tsymtable;const delimiter:string):string;
     { def is the extended type of a helper }
     { def is the extended type of a helper }
     function generate_objectpascal_helper_key(def:tdef):string;
     function generate_objectpascal_helper_key(def:tdef):string;
     procedure incompatibletypes(def1,def2:tdef);
     procedure incompatibletypes(def1,def2:tdef);
@@ -2931,7 +2931,7 @@ implementation
         FullTypeName:=s1;
         FullTypeName:=s1;
       end;
       end;
 
 
-    function generate_nested_name(symtable:tsymtable;delimiter:string):string;
+    function generate_nested_name(symtable:tsymtable;const delimiter:string):string;
       begin
       begin
         result:='';
         result:='';
         while assigned(symtable) and (symtable.symtabletype in [ObjectSymtable,recordsymtable]) do
         while assigned(symtable) and (symtable.symtabletype in [ObjectSymtable,recordsymtable]) do