From e4ee8fa6a2b6fbebf8723712c63d9e0504d1396e Mon Sep 17 00:00:00 2001 From: florian Date: Tue, 9 Nov 2021 22:17:46 +0100 Subject: [PATCH] * patch by Rika to pass some strings by reference, resolves #39338 --- compiler/assemble.pas | 10 +++++----- compiler/cstreams.pas | 4 ++-- compiler/globals.pas | 28 ++++++++++++++-------------- compiler/pexpr.pas | 2 +- compiler/pgenutil.pas | 24 ++++++++++++------------ compiler/pinline.pas | 2 +- compiler/scanner.pas | 38 +++++++++++++++++++++----------------- compiler/symtable.pas | 4 ++-- 8 files changed, 58 insertions(+), 54 deletions(-) diff --git a/compiler/assemble.pas b/compiler/assemble.pas index 08a1818f4d..7775e4c35b 100644 --- a/compiler/assemble.pas +++ b/compiler/assemble.pas @@ -280,7 +280,7 @@ Implementation var 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 } @@ -293,10 +293,10 @@ Implementation j:=1; while (j-1 Then exit; @@ -712,7 +712,7 @@ implementation end; - function TLinkStrMap.AddDep(keyvalue:String):boolean; + function TLinkStrMap.AddDep(const keyvalue:String):boolean; var i : Longint; begin @@ -725,7 +725,7 @@ implementation end; - function TLinkStrMap.AddWeight(keyvalue:String):boolean; + function TLinkStrMap.AddWeight(const keyvalue:String):boolean; var i,j : Longint; Code : Word; @@ -745,7 +745,7 @@ implementation end; - procedure TLinkStrMap.addseries(keys:AnsiString;weight:longint); + procedure TLinkStrMap.addseries(const keys:AnsiString;weight:longint); var i,j,k : longint; begin @@ -761,7 +761,7 @@ implementation end; end; - procedure TLinkStrMap.SetValue(Key:Ansistring;weight:Integer); + procedure TLinkStrMap.SetValue(const Key:Ansistring;weight:Integer); var j : longint; begin @@ -771,7 +771,7 @@ implementation end; - function TLinkStrMap.find(key:Ansistring):Ansistring; + function TLinkStrMap.find(const key:Ansistring):Ansistring; var j : longint; begin @@ -782,7 +782,7 @@ implementation end; - function TLinkStrMap.lookup(key:Ansistring):longint; + function TLinkStrMap.lookup(const key:Ansistring):longint; var i : longint; begin diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas index de850e1c50..649e583caf 100644 --- a/compiler/pexpr.pas +++ b/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 d : bestreal; code : integer; diff --git a/compiler/pgenutil.pas b/compiler/pgenutil.pas index f082b737b0..486e8a6923 100644 --- a/compiler/pgenutil.pas +++ b/compiler/pgenutil.pas @@ -36,18 +36,18 @@ uses { symtable } 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;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 parse_generic_parameters(allowconstraints:boolean):tfphashobjectlist; 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 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 add_generic_dummysym(sym:tsym); function resolve_generic_dummysym(const name:tidstring):tsym; @@ -601,7 +601,7 @@ uses 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 dummypos : tfileposinfo; begin @@ -621,7 +621,7 @@ uses {$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 dummypos : tfileposinfo; {$push} @@ -632,7 +632,7 @@ uses {$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 found, err : boolean; @@ -809,7 +809,7 @@ uses consume(_RSHARPBRACKET); 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); var @@ -1357,7 +1357,7 @@ uses 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 context : tspecializationcontext; genericdef : tstoreddef; @@ -1730,7 +1730,7 @@ uses 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 crc : cardinal; begin diff --git a/compiler/pinline.pas b/compiler/pinline.pas index 2f47fee9b3..243b684457 100644 --- a/compiler/pinline.pas +++ b/compiler/pinline.pas @@ -660,7 +660,7 @@ implementation 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 paras : tnode; { for easy exiting if something goes wrong } diff --git a/compiler/scanner.pas b/compiler/scanner.pas index e860a8ff3a..ef58913c91 100644 --- a/compiler/scanner.pas +++ b/compiler/scanner.pas @@ -968,11 +968,11 @@ type constructor create_int(v: int64); constructor create_uint(v: qword); constructor create_bool(b: boolean); - constructor create_str(s: string); + constructor create_str(const s: string); constructor create_set(ns: tnormalset); 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; procedure error(expecteddef, place: string); function isBoolean: Boolean; @@ -1087,7 +1087,7 @@ type def:=booldef; end; - constructor texprvalue.create_str(s: string); + constructor texprvalue.create_str(const s: string); var sp: pansichar; len: integer; @@ -1120,7 +1120,7 @@ type def:=realdef; end; - class function texprvalue.try_parse_number(s:string):texprvalue; + class function texprvalue.try_parse_number(const s:string):texprvalue; var ic: int64; qc: qword; @@ -1141,7 +1141,7 @@ type end; end; - class function texprvalue.try_parse_real(s:string):texprvalue; + class function texprvalue.try_parse_real(const s:string):texprvalue; var d: bestreal; code: integer; @@ -1648,7 +1648,7 @@ type 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. The result from this procedure can either be that the token itself is a value, or that it is a compile time variable/macro, @@ -1661,20 +1661,23 @@ type macrocount, len: integer; foundmacro: boolean; + searchstr: pshortstring; + searchstr2store: string; begin if not eval then begin - result:=texprvalue.create_str(searchstr); + result:=texprvalue.create_str(basesearchstr); exit; end; + searchstr := @basesearchstr; mac:=nil; foundmacro:=false; { Substitue macros and compiler variables with their content/value. For real macros also do recursive substitution. } macrocount:=0; repeat - mac:=tmacro(search_macro(searchstr)); + mac:=tmacro(search_macro(searchstr^)); inc(macrocount); if macrocount>max_macro_nesting then @@ -1695,13 +1698,14 @@ type len:=mac.buflen; hs[0]:=char(len); move(mac.buftext^,hs[1],len); - searchstr:=upcase(hs); + searchstr2store:=upcase(hs); + searchstr:=@searchstr2store; mac.is_used:=true; foundmacro:=true; end else begin - Message1(scan_e_error_macro_lacks_value,searchstr); + Message1(scan_e_error_macro_lacks_value,searchstr^); break; end else @@ -1713,12 +1717,12 @@ type { At this point, result do contain the value. Do some decoding and determine the type.} - result:=texprvalue.try_parse_number(searchstr); + result:=texprvalue.try_parse_number(searchstr^); if not assigned(result) then begin - if foundmacro and (searchstr='FALSE') then + if foundmacro and (searchstr^='FALSE') then result:=texprvalue.create_bool(false) - else if foundmacro and (searchstr='TRUE') then + else if foundmacro and (searchstr^='TRUE') then result:=texprvalue.create_bool(true) else if (m_mac in current_settings.modeswitches) and (not assigned(mac) or not mac.defined) and @@ -1726,11 +1730,11 @@ type begin {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.} - 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 else - result:=texprvalue.create_str(searchstr); + result:=texprvalue.create_str(searchstr^); end; end; diff --git a/compiler/symtable.pas b/compiler/symtable.pas index 140412c765..8df7c66efd 100644 --- a/compiler/symtable.pas +++ b/compiler/symtable.pas @@ -322,7 +322,7 @@ interface {*** Misc ***} 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 } function generate_objectpascal_helper_key(def:tdef):string; procedure incompatibletypes(def1,def2:tdef); @@ -2931,7 +2931,7 @@ implementation FullTypeName:=s1; end; - function generate_nested_name(symtable:tsymtable;delimiter:string):string; + function generate_nested_name(symtable:tsymtable;const delimiter:string):string; begin result:=''; while assigned(symtable) and (symtable.symtabletype in [ObjectSymtable,recordsymtable]) do