paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-12-06 12:29:11 +01:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source
This commit is contained in:
florian 2021-11-09 22:17:46 +01:00
parent c6723ed2c4
commit e4ee8fa6a2
8 changed files with 58 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
compiler/assemble.pas
View File

@ -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 result := Copy(s, j, i - j + 1);
if s[k] in [#0..#31,#127..#255] then for k:=1 to length(result) do
s[k]:='.'; if result[k] in [#0..#31,#127..#255] then
fixline:=Copy(s,j,i-j+1); result[k]:='.';
end; end;
{***************************************************************************** {*****************************************************************************

4
compiler/cstreams.pas
View File

@ -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;

28
compiler/globals.pas
View File

@ -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 Add(const key:ansistring;const value:AnsiString='';weight:longint=LinkMapWeightDefault);
procedure addseries(keys:AnsiString;weight:longint=LinkMapWeightDefault); procedure addseries(const keys:AnsiString;weight:longint=LinkMapWeightDefault);
function AddDep(keyvalue:String):boolean; function AddDep(const keyvalue:String):boolean;
function AddWeight(keyvalue:String):boolean; function AddWeight(const keyvalue:String):boolean;
procedure SetValue(key:AnsiString;Weight:Integer); 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

2
compiler/pexpr.pas
View File

@ -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;

24
compiler/pgenutil.pas
View File

@ -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;const _prettyname:string;parsedtype:tdef;const 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);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;const 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_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;_prettyname:ansistring):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

2
compiler/pinline.pas
View File

@ -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 }

38
compiler/scanner.pas
View File

@ -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_number(const s:string):texprvalue; static;
class function try_parse_real(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); Message1(scan_e_error_macro_undefined,searchstr^);
result:=texprvalue.create_str(searchstr); { just to have something } 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;

4
compiler/symtable.pas
View File

@ -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