paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-15 00:40:30 +02:00
Code Issues Packages Projects Releases Wiki Activity

* TCallNode.simplify method introduced to convert Str with a constant into a direct string assignment

Browse Source
This commit is contained in:
J. Gareth "Curious Kit" Moreton 2022-12-14 21:33:29 +00:00 committed by FPK
parent e1f993c363
commit 81b22cc5d1
1 changed files with 88 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

88
compiler/ncal.pas
View File

@ -92,6 +92,7 @@ interface
function pass1_normal:tnode;
procedure register_created_object_types;
function get_expect_loc: tcgloc;
function handle_compilerproc: tnode;
protected
function safe_call_self_node: tnode;
@ -201,6 +202,7 @@ interface
procedure insertintolist(l : tnodelist);override;
function pass_1 : tnode;override;
function pass_typecheck:tnode;override;
function simplify(forinline : boolean) : tnode;override;
{$ifdef state_tracking}
function track_state_pass(exec_known:boolean):boolean;override;
{$endif state_tracking}
@ -2724,6 +2726,82 @@ implementation
end;
function tcallnode.handle_compilerproc: tnode;
var
para: TCallParaNode;
maxlennode, outnode, valnode: TNode;
MaxStrLen: Int64;
StringLiteral: string;
begin
result := nil;
case intrinsiccode of
in_str_x_string:
begin
{ If n is a constant, attempt to convert, for example:
"Str(5, Output);" to "Output := '5';" }
{ Format of the internal function (also for fpc_shortstr_uint) is:
$fpc_shortstr_sint(Int64;Int64;out OpenString;<const Int64>); }
{ Remember the parameters are in reverse order - the leftmost one
can usually be ignored }
para := GetParaFromIndex(1);
if Assigned(para) then
begin
{ Output variable }
outnode := para.left;
para := GetParaFromIndex(2);
if Assigned(para) then
begin
{ Maximum length }
maxlennode := para.left;
if is_integer(maxlennode.resultdef) then
begin
para := GetParaFromIndex(3);
while (maxlennode.nodetype = typeconvn) and (ttypeconvnode(maxlennode).convtype in [tc_equal, tc_int_2_int]) do
begin
maxlennode := ttypeconvnode(maxlennode).left;
end;
if Assigned(para) and is_constintnode(maxlennode) then
begin
{ Numeric value }
valnode := para.left;
if is_integer(valnode.resultdef) and not Assigned(GetParaFromIndex(4)) then
begin
while (valnode.nodetype = typeconvn) and (ttypeconvnode(valnode).convtype in [tc_equal, tc_int_2_int]) do
begin
valnode := ttypeconvnode(valnode).left;
end;
if is_constintnode(valnode) then
begin
MaxStrLen := TOrdConstNode(maxlennode).value.svalue;
{ If we've gotten this far, we can convert the node into a direct assignment }
StringLiteral := tostr(tordconstnode(valnode).value);
if MaxStrLen <> -1 then
SetLength(StringLiteral, Integer(MaxStrLen));
result := cassignmentnode.create(
outnode.getcopy,
cstringconstnode.createstr(StringLiteral)
);
end;
end;
end;
end;
end;
end;
end;
else
;
end;
end;
function tcallnode.safe_call_self_node: tnode;
begin
if not assigned(call_self_node) then
@ -4267,6 +4345,16 @@ implementation
end;
function tcallnode.simplify(forinline : boolean) : tnode;
begin
{ See if there's any special handling we can do based on the intrinsic code }
if (intrinsiccode <> Default(TInlineNumber)) then
result := handle_compilerproc
else
result := nil;
end;
procedure tcallnode.order_parameters;
var
hp,hpcurr,hpnext,hpfirst,hpprev : tcallparanode;