mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-06 16:27:57 +02:00
e60a7d01a4
the "nf_modify" flag from the destination so
constant propagation works more efficiently.
6059 lines
240 KiB
ObjectPascal
6059 lines
240 KiB
ObjectPascal
{
|
|
Copyright (c) 1998-2007 by Florian Klaempfl
|
|
|
|
Type checking and register allocation for inline nodes
|
|
|
|
This program is free software; you can redistribute it and/or modify
|
|
it under the terms of the GNU General Public License as published by
|
|
the Free Software Foundation; either version 2 of the License, or
|
|
(at your option) any later version.
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
GNU General Public License for more details.
|
|
|
|
You should have received a copy of the GNU General Public License
|
|
along with this program; if not, write to the Free Software
|
|
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
|
|
****************************************************************************
|
|
}
|
|
unit ninl;
|
|
|
|
{$i fpcdefs.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
node,htypechk,symtype,compinnr;
|
|
|
|
type
|
|
TInlineNodeFlag = (
|
|
inf_inlineconst
|
|
);
|
|
|
|
TInlineNodeFlags = set of TInlineNodeFlag;
|
|
|
|
tinlinenode = class(tunarynode)
|
|
inlinenodeflags : TInlineNodeFlags;
|
|
inlinenumber : tinlinenumber;
|
|
constructor create(number : tinlinenumber;is_const:boolean;l : tnode);virtual;
|
|
constructor createintern(number : tinlinenumber;is_const:boolean;l : tnode);virtual;
|
|
constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
|
|
procedure ppuwrite(ppufile:tcompilerppufile);override;
|
|
function dogetcopy : tnode;override;
|
|
procedure printnodeinfo(var t : text);override;
|
|
{$ifdef DEBUG_NODE_XML}
|
|
procedure XMLPrintNodeInfo(var t : text);override;
|
|
{$endif DEBUG_NODE_XML}
|
|
function pass_1 : tnode;override;
|
|
function pass_typecheck:tnode;override;
|
|
function pass_typecheck_cpu:tnode;virtual;
|
|
function simplify(forinline : boolean): tnode;override;
|
|
function docompare(p: tnode): boolean; override;
|
|
procedure mark_write;override;
|
|
|
|
{ returns a node tree where the inc/dec are replaced by add/sub }
|
|
function getaddsub_for_incdec : tnode;
|
|
|
|
{ pack and unpack are changed into for-loops by the compiler }
|
|
function first_pack_unpack: tnode; virtual;
|
|
|
|
property parameters : tnode read left write left;
|
|
|
|
function may_have_sideeffect_norecurse: boolean;
|
|
protected
|
|
{ All the following routines currently
|
|
call compilerprocs, unless they are
|
|
overridden in which case, the code
|
|
generator handles them.
|
|
}
|
|
function first_pi: tnode ; virtual;
|
|
function first_arctan_real: tnode; virtual;
|
|
function first_abs_real: tnode; virtual;
|
|
function first_sqr_real: tnode; virtual;
|
|
function first_sqrt_real: tnode; virtual;
|
|
function first_ln_real: tnode; virtual;
|
|
function first_cos_real: tnode; virtual;
|
|
function first_sin_real: tnode; virtual;
|
|
function first_exp_real: tnode; virtual;
|
|
function first_frac_real: tnode; virtual;
|
|
function first_round_real: tnode; virtual;
|
|
function first_trunc_real: tnode; virtual;
|
|
function first_int_real: tnode; virtual;
|
|
function first_abs_long: tnode; virtual;
|
|
function first_IncDec: tnode; virtual;
|
|
function first_IncludeExclude: tnode; virtual;
|
|
function first_get_frame: tnode; virtual;
|
|
function first_setlength: tnode; virtual;
|
|
function first_copy: tnode; virtual;
|
|
{ This one by default generates an internal error, because such
|
|
nodes are not generated by the parser. It's however used internally
|
|
by the JVM backend to create new dynamic arrays. }
|
|
function first_new: tnode; virtual;
|
|
function first_length: tnode; virtual;
|
|
function first_high: tnode; virtual;
|
|
function first_box: tnode; virtual; abstract;
|
|
function first_unbox: tnode; virtual; abstract;
|
|
function first_assigned: tnode; virtual;
|
|
function first_assert: tnode; virtual;
|
|
function first_popcnt: tnode; virtual;
|
|
function first_bitscan: tnode; virtual;
|
|
{ override these for Seg() support }
|
|
function typecheck_seg: tnode; virtual;
|
|
function first_seg: tnode; virtual;
|
|
function first_sar: tnode; virtual;
|
|
function first_fma : tnode; virtual;
|
|
function first_minmax: tnode; virtual;
|
|
{$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
|
|
function first_ShiftRot_assign_64bitint: tnode; virtual;
|
|
{$endif not cpu64bitalu and not cpuhighleveltarget}
|
|
function first_AndOrXorShiftRot_assign: tnode; virtual;
|
|
function first_NegNot_assign: tnode; virtual;
|
|
function first_cpu : tnode; virtual;
|
|
|
|
procedure CheckParameters(count : integer);
|
|
private
|
|
function handle_str: tnode;
|
|
function handle_reset_rewrite_typed: tnode;
|
|
function handle_text_read_write(filepara,params:Ttertiarynode;var newstatement:Tnode):boolean;
|
|
function handle_typed_read_write(filepara,params:Ttertiarynode;var newstatement:Tnode):boolean;
|
|
function handle_read_write: tnode;
|
|
function handle_val: tnode;
|
|
function handle_default: tnode;
|
|
function handle_setlength: tnode;
|
|
function handle_copy: tnode;
|
|
function handle_box: tnode;
|
|
function handle_unbox: tnode;
|
|
function handle_insert:tnode;
|
|
function handle_delete:tnode;
|
|
function handle_concat:tnode;
|
|
end;
|
|
tinlinenodeclass = class of tinlinenode;
|
|
|
|
var
|
|
cinlinenode : tinlinenodeclass = tinlinenode;
|
|
|
|
function geninlinenode(number : tinlinenumber;is_const:boolean;l : tnode) : tinlinenode;
|
|
|
|
implementation
|
|
|
|
uses
|
|
verbose,globals,systems,constexp,
|
|
globtype,cutils,cclasses,fmodule,
|
|
symconst,symdef,symsym,symcpu,symtable,paramgr,defcmp,defutil,symbase,
|
|
cpuinfo,cpubase,
|
|
pass_1,ppu,
|
|
ncal,ncon,ncnv,nadd,nld,nbas,nflw,nmem,nmat,nutils,ngenutil,
|
|
nobjc,objcdef,
|
|
cgbase,procinfo;
|
|
|
|
function geninlinenode(number : tinlinenumber;is_const:boolean;l : tnode) : tinlinenode;
|
|
|
|
begin
|
|
geninlinenode:=cinlinenode.create(number,is_const,l);
|
|
end;
|
|
|
|
{*****************************************************************************
|
|
TINLINENODE
|
|
*****************************************************************************}
|
|
|
|
constructor tinlinenode.create(number : tinlinenumber;is_const:boolean;l : tnode);
|
|
begin
|
|
inherited create(inlinen,l);
|
|
if is_const then
|
|
inlinenodeflags:=[inf_inlineconst]
|
|
else
|
|
inlinenodeflags:=[];
|
|
inlinenumber:=number;
|
|
end;
|
|
|
|
|
|
constructor tinlinenode.createintern(number : tinlinenumber; is_const : boolean;
|
|
l : tnode);
|
|
begin
|
|
create(number,is_const,l);
|
|
inlinenodeflags:=[];
|
|
include(flags,nf_internal);
|
|
end;
|
|
|
|
|
|
constructor tinlinenode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
|
|
begin
|
|
inherited ppuload(t,ppufile);
|
|
ppufile.getset(tppuset1(inlinenodeflags));
|
|
inlinenumber:=tinlinenumber(ppufile.getlongint);
|
|
end;
|
|
|
|
|
|
procedure tinlinenode.ppuwrite(ppufile:tcompilerppufile);
|
|
begin
|
|
inherited ppuwrite(ppufile);
|
|
ppufile.putset(tppuset1(inlinenodeflags));
|
|
ppufile.putlongint(longint(inlinenumber));
|
|
end;
|
|
|
|
|
|
function tinlinenode.dogetcopy : tnode;
|
|
var
|
|
n : tinlinenode;
|
|
begin
|
|
n:=tinlinenode(inherited dogetcopy);
|
|
n.inlinenodeflags:=inlinenodeflags;
|
|
n.inlinenumber:=inlinenumber;
|
|
result:=n;
|
|
end;
|
|
|
|
|
|
procedure tinlinenode.printnodeinfo(var t : text);
|
|
begin
|
|
inherited;
|
|
write(t,', inlinenumber = ',inlinenumber);
|
|
end;
|
|
|
|
{$ifdef DEBUG_NODE_XML}
|
|
procedure TInlineNode.XMLPrintNodeInfo(var T: Text);
|
|
var
|
|
i: TInlineNodeFlag;
|
|
First: Boolean;
|
|
begin
|
|
inherited XMLPrintNodeInfo(T);
|
|
First := True;
|
|
for i in inlinenodeflags do
|
|
begin
|
|
if First then
|
|
begin
|
|
Write(T, ' inlinenodeflags="', i);
|
|
First := False;
|
|
end
|
|
else
|
|
Write(T, ',', i)
|
|
end;
|
|
if not First then
|
|
Write(T, '"');
|
|
|
|
Write(T, ' inlinenumber="', inlinenumber, '"');
|
|
end;
|
|
{$endif DEBUG_NODE_XML}
|
|
|
|
function get_str_int_func(def: tdef): string;
|
|
var
|
|
ordtype: tordtype;
|
|
begin
|
|
ordtype := torddef(def).ordtype;
|
|
if not (ordtype in [scurrency,s64bit,u64bit,s32bit,u32bit,s16bit,u16bit,s8bit,u8bit]) then
|
|
internalerror(2013032603);
|
|
|
|
if is_oversizedord(def) then
|
|
begin
|
|
case ordtype of
|
|
scurrency,
|
|
s64bit: exit('int64');
|
|
u64bit: exit('qword');
|
|
s32bit: exit('longint');
|
|
u32bit: exit('longword');
|
|
s16bit: exit('smallint');
|
|
u16bit: exit('word');
|
|
else
|
|
internalerror(2013032604);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
if is_nativeuint(def) then
|
|
exit('uint')
|
|
else
|
|
exit('sint');
|
|
end;
|
|
internalerror(2013032605);
|
|
end;
|
|
|
|
|
|
function tinlinenode.handle_str : tnode;
|
|
var
|
|
lenpara,
|
|
fracpara,
|
|
newparas,
|
|
tmppara,
|
|
dest,
|
|
source : tcallparanode;
|
|
procname: string;
|
|
is_real,is_enum : boolean;
|
|
rt : aint;
|
|
intrinsiccode: TInlineNumber;
|
|
|
|
begin
|
|
result := cerrornode.create;
|
|
|
|
{ get destination string }
|
|
dest := tcallparanode(left);
|
|
|
|
{ get source para (number) }
|
|
source := dest;
|
|
while assigned(source.right) do
|
|
source := tcallparanode(source.right);
|
|
|
|
{ destination parameter must be a normal (not a colon) parameter, this
|
|
check is needed because str(v:len) also has 2 parameters }
|
|
if (source=dest) or
|
|
(cpf_is_colon_para in tcallparanode(dest).callparaflags) then
|
|
begin
|
|
CGMessage1(parser_e_wrong_parameter_size,'Str');
|
|
exit;
|
|
end;
|
|
|
|
{ in case we are in a generic definition, we cannot
|
|
do all checks, the parameters might be type parameters,
|
|
|
|
bailout as well in case of an error before }
|
|
if (df_generic in current_procinfo.procdef.defoptions) or
|
|
(dest.resultdef.typ=errordef) or
|
|
(source.resultdef.typ=errordef) then
|
|
begin
|
|
result.Free;
|
|
result:=nil;
|
|
resultdef:=voidtype;
|
|
exit;
|
|
end;
|
|
|
|
is_real:=(source.resultdef.typ = floatdef) or is_currency(source.resultdef);
|
|
is_enum:=source.left.resultdef.typ=enumdef;
|
|
|
|
if ((dest.left.resultdef.typ<>stringdef) and
|
|
not(is_chararray(dest.left.resultdef))) or
|
|
not(is_real or is_enum or
|
|
(source.left.resultdef.typ=orddef)) then
|
|
begin
|
|
CGMessagePos(fileinfo,parser_e_illegal_expression);
|
|
exit;
|
|
end;
|
|
|
|
{ get len/frac parameters }
|
|
lenpara := nil;
|
|
fracpara := nil;
|
|
if (cpf_is_colon_para in tcallparanode(dest.right).callparaflags) then
|
|
begin
|
|
lenpara := tcallparanode(dest.right);
|
|
|
|
{ we can let the callnode do the type checking of these parameters too, }
|
|
{ but then the error messages aren't as nice }
|
|
if not is_integer(lenpara.resultdef) then
|
|
begin
|
|
CGMessagePos1(lenpara.fileinfo,
|
|
type_e_integer_expr_expected,lenpara.resultdef.typename);
|
|
exit;
|
|
end;
|
|
if (cpf_is_colon_para in tcallparanode(lenpara.right).callparaflags) then
|
|
begin
|
|
{ parameters are in reverse order! }
|
|
fracpara := lenpara;
|
|
lenpara := tcallparanode(lenpara.right);
|
|
if not is_real then
|
|
begin
|
|
CGMessagePos(lenpara.fileinfo,parser_e_illegal_colon_qualifier);
|
|
exit
|
|
end;
|
|
if not is_integer(lenpara.resultdef) then
|
|
begin
|
|
CGMessagePos1(lenpara.fileinfo,
|
|
type_e_integer_expr_expected,lenpara.resultdef.typename);
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ generate the parameter list for the compilerproc }
|
|
newparas := dest;
|
|
|
|
{ if we have a float parameter, insert the realtype, len and fracpara parameters }
|
|
if is_real then
|
|
begin
|
|
{ insert realtype parameter }
|
|
if not is_currency(source.resultdef) then
|
|
begin
|
|
rt:=ord(tfloatdef(source.left.resultdef).floattype);
|
|
newparas.right := ccallparanode.create(cordconstnode.create(
|
|
rt,s32inttype,true),newparas.right);
|
|
tmppara:=tcallparanode(newparas.right);
|
|
end
|
|
else
|
|
tmppara:=newparas;
|
|
{ if necessary, insert a fraction parameter }
|
|
if not assigned(fracpara) then
|
|
begin
|
|
tmppara.right := ccallparanode.create(
|
|
cordconstnode.create(int64(-1),s32inttype,false),
|
|
tmppara.right);
|
|
fracpara := tcallparanode(tmppara.right);
|
|
end;
|
|
{ if necessary, insert a length para }
|
|
if not assigned(lenpara) then
|
|
fracpara.right := ccallparanode.create(
|
|
cordconstnode.create(int64(-32767),s32inttype,false),
|
|
fracpara.right);
|
|
end
|
|
else if is_enum then
|
|
begin
|
|
{Insert a reference to the ord2string index.}
|
|
newparas.right:=Ccallparanode.create(
|
|
Caddrnode.create_internal(
|
|
Crttinode.create(Tenumdef(source.left.resultdef),fullrtti,rdt_normal)
|
|
),
|
|
newparas.right);
|
|
{Insert a reference to the typinfo.}
|
|
newparas.right:=Ccallparanode.create(
|
|
Caddrnode.create_internal(
|
|
Crttinode.create(Tenumdef(source.left.resultdef),fullrtti,rdt_ord2str)
|
|
),
|
|
newparas.right);
|
|
{Insert a type conversion from the enumeration to longint.}
|
|
source.left:=Ctypeconvnode.create_internal(source.left,s32inttype);
|
|
typecheckpass(source.left);
|
|
|
|
{ if necessary, insert a length para }
|
|
if not assigned(lenpara) then
|
|
Tcallparanode(Tcallparanode(newparas.right).right).right:=
|
|
Ccallparanode.create(
|
|
cordconstnode.create(int64(-1),s32inttype,false),
|
|
Tcallparanode(Tcallparanode(newparas.right).right).right
|
|
);
|
|
end
|
|
else
|
|
{ for a normal parameter, insert a only length parameter if one is missing }
|
|
if not assigned(lenpara) then
|
|
newparas.right := ccallparanode.create(cordconstnode.create(int64(-1),s32inttype,false),
|
|
newparas.right);
|
|
|
|
{ remove the parameters from the original node so they won't get disposed, }
|
|
{ since they're reused }
|
|
left := nil;
|
|
|
|
intrinsiccode := Default(TInlineNumber);
|
|
|
|
{ create procedure name }
|
|
if is_chararray(dest.resultdef) then
|
|
procname:='fpc_chararray_'
|
|
else
|
|
procname := 'fpc_' + tstringdef(dest.resultdef).stringtypname+'_';
|
|
if is_real then
|
|
if is_currency(source.resultdef) then
|
|
procname := procname + 'currency'
|
|
else
|
|
procname := procname + 'float'
|
|
else if is_enum then
|
|
procname:=procname+'enum'
|
|
else
|
|
case torddef(source.resultdef).ordtype of
|
|
pasbool1,pasbool8,pasbool16,pasbool32,pasbool64,
|
|
bool8bit,bool16bit,bool32bit,bool64bit:
|
|
procname := procname + 'bool';
|
|
else
|
|
begin
|
|
intrinsiccode := in_str_x_string;
|
|
procname := procname + get_str_int_func(source.resultdef);
|
|
end;
|
|
end;
|
|
|
|
{ for ansistrings insert the encoding argument }
|
|
if is_ansistring(dest.resultdef) then
|
|
newparas:=ccallparanode.create(cordconstnode.create(
|
|
getparaencoding(dest.resultdef),u16inttype,true),newparas);
|
|
|
|
{ free the errornode we generated in the beginning }
|
|
result.free;
|
|
{ create the call node, }
|
|
result := ccallnode.createfromintrinsic(intrinsiccode,procname,newparas);
|
|
end;
|
|
|
|
|
|
function tinlinenode.handle_default: tnode;
|
|
|
|
function getdefaultvarsym(def:tdef):tnode;
|
|
var
|
|
hashedid : thashedidstring;
|
|
srsym : tsym;
|
|
srsymtable : tsymtable;
|
|
defaultname : tidstring;
|
|
begin
|
|
if not assigned(def) or
|
|
not (def.typ in [arraydef,recorddef,variantdef,objectdef,procvardef]) or
|
|
((def.typ=objectdef) and not is_object(def)) then
|
|
internalerror(201202101);
|
|
|
|
{ extra '$' prefix because on darwin the result of makemangledname
|
|
is prefixed by '_' and hence adding a '$' at the start of the
|
|
prefix passed to makemangledname doesn't help (the whole point of
|
|
the copy() operation below is to ensure that the id does not start
|
|
with a '$', because that is interpreted specially by the symtable
|
|
routines -- that's also why we prefix with '$_', so it will still
|
|
work if make_mangledname() would somehow return a name that already
|
|
starts with '$' }
|
|
defaultname:='$_'+make_mangledname('zero',def.owner,def.typesym.Name);
|
|
{ can't hardcode the position of the '$', e.g. on darwin an underscore
|
|
is added }
|
|
hashedid.id:=copy(defaultname,2,255);
|
|
{ in case of a previous error, current_procinfo might not be set
|
|
so avoid a crash in this case }
|
|
if assigned(current_procinfo) then
|
|
begin
|
|
{ the default sym is always part of the current procedure/function }
|
|
srsymtable:=current_module.localsymtable;
|
|
srsym:=tsym(srsymtable.findwithhash(hashedid));
|
|
if not assigned(srsym) then
|
|
begin
|
|
{ no valid default variable found, so create it }
|
|
srsym:=cstaticvarsym.create(defaultname,vs_const,def,[]);
|
|
{ mark the staticvarsym as typedconst }
|
|
include(tabstractvarsym(srsym).varoptions,vo_is_typed_const);
|
|
include(tabstractvarsym(srsym).varoptions,vo_is_default_var);
|
|
{ The variable has a value assigned }
|
|
tabstractvarsym(srsym).varstate:=vs_initialised;
|
|
|
|
srsymtable.insertsym(srsym);
|
|
cnodeutils.insertbssdata(tstaticvarsym(srsym));
|
|
|
|
end;
|
|
result:=cloadnode.create(srsym,srsymtable);
|
|
end
|
|
else
|
|
result:=cerrornode.create;
|
|
end;
|
|
|
|
var
|
|
def : tdef;
|
|
begin
|
|
if not assigned(left) or (left.nodetype<>typen) then
|
|
internalerror(2012032102);
|
|
|
|
def:=ttypenode(left).typedef;
|
|
if assigned(current_procinfo) and
|
|
(df_generic in current_procinfo.procdef.defoptions) then
|
|
begin
|
|
{ don't allow as a default parameter value, because it may not be valid
|
|
when specialising }
|
|
if block_type<>bt_const then
|
|
result:=cpointerconstnode.create(0,def)
|
|
else
|
|
result:=cerrornode.create;
|
|
exit;
|
|
end;
|
|
|
|
result:=nil;
|
|
case def.typ of
|
|
enumdef,
|
|
orddef:
|
|
{ don't do a rangecheck as Default will also return 0
|
|
for the following types (Delphi compatible):
|
|
TRange1 = -10..-5;
|
|
TRange2 = 5..10;
|
|
TEnum = (a:=5;b:=10); }
|
|
result:=cordconstnode.create(0,def,false);
|
|
classrefdef,
|
|
pointerdef:
|
|
result:=cpointerconstnode.create(0,def);
|
|
procvardef:
|
|
if tprocvardef(def).size<>sizeof(pint) then
|
|
result:=getdefaultvarsym(def)
|
|
else
|
|
result:=cpointerconstnode.create(0,def);
|
|
stringdef:
|
|
result:=cstringconstnode.createstr('');
|
|
floatdef:
|
|
result:=crealconstnode.create(0,def);
|
|
objectdef:
|
|
begin
|
|
if is_implicit_pointer_object_type(def) then
|
|
result:=cpointerconstnode.create(0,def)
|
|
else
|
|
if is_object(def) then
|
|
begin
|
|
{ Delphi does not recursively check whether
|
|
an object contains unsupported types }
|
|
if not (m_delphi in current_settings.modeswitches) and
|
|
not is_valid_for_default(def) then
|
|
Message(type_e_type_not_allowed_for_default);
|
|
result:=getdefaultvarsym(def);
|
|
end
|
|
else
|
|
Message(type_e_type_not_allowed_for_default);
|
|
end;
|
|
variantdef,
|
|
recorddef:
|
|
begin
|
|
{ Delphi does not recursively check whether a record
|
|
contains unsupported types }
|
|
if (def.typ=recorddef) and not (m_delphi in current_settings.modeswitches) and
|
|
not is_valid_for_default(def) then
|
|
Message(type_e_type_not_allowed_for_default);
|
|
result:=getdefaultvarsym(def);
|
|
end;
|
|
setdef:
|
|
begin
|
|
result:=csetconstnode.create(nil,def);
|
|
New(tsetconstnode(result).value_set);
|
|
tsetconstnode(result).value_set^:=[];
|
|
end;
|
|
arraydef:
|
|
begin
|
|
{ can other array types be parsed by single_type? }
|
|
if ado_isdynamicarray in tarraydef(def).arrayoptions then
|
|
result:=cpointerconstnode.create(0,def)
|
|
else
|
|
begin
|
|
result:=getdefaultvarsym(def);
|
|
end;
|
|
end;
|
|
undefineddef:
|
|
begin
|
|
if sp_generic_dummy in def.typesym.symoptions then
|
|
begin
|
|
{ this matches the error messages that are printed
|
|
in case of non-Delphi modes }
|
|
Message(parser_e_no_generics_as_types);
|
|
Message(type_e_type_id_expected);
|
|
end
|
|
else
|
|
result:=cpointerconstnode.create(0,def);
|
|
end;
|
|
else
|
|
Message(type_e_type_not_allowed_for_default);
|
|
end;
|
|
if not assigned(result) then
|
|
result:=cerrornode.create;
|
|
end;
|
|
|
|
|
|
function tinlinenode.handle_reset_rewrite_typed: tnode;
|
|
begin
|
|
{ since this is a "in_xxxx_typedfile" node, we can be sure we have }
|
|
{ a typed file as argument and we don't have to check it again (JM) }
|
|
|
|
{ add the recsize parameter }
|
|
|
|
{ iso mode extension with name? }
|
|
if inlinenumber in [in_reset_typedfile_name,in_rewrite_typedfile_name] then
|
|
begin
|
|
left := ccallparanode.create(cordconstnode.create(
|
|
tfiledef(tcallparanode(tcallparanode(left).nextpara).paravalue.resultdef).typedfiledef.size,s32inttype,true),left);
|
|
end
|
|
else
|
|
begin
|
|
{ note: for some reason, the parameter of intern procedures with only one }
|
|
{ parameter is gets lifted out of its original tcallparanode (see round }
|
|
{ line 1306 of ncal.pas), so recreate a tcallparanode here (JM) }
|
|
left := ccallparanode.create(cordconstnode.create(
|
|
tfiledef(left.resultdef).typedfiledef.size,s32inttype,true),
|
|
ccallparanode.create(left,nil));
|
|
end;
|
|
{ create the correct call }
|
|
if m_isolike_io in current_settings.modeswitches then
|
|
begin
|
|
case inlinenumber of
|
|
in_reset_typedfile:
|
|
result := ccallnode.createintern('fpc_reset_typed_iso',left);
|
|
in_reset_typedfile_name:
|
|
result := ccallnode.createintern('fpc_reset_typed_name_iso',left);
|
|
in_rewrite_typedfile:
|
|
result := ccallnode.createintern('fpc_rewrite_typed_iso',left);
|
|
in_rewrite_typedfile_name:
|
|
result := ccallnode.createintern('fpc_rewrite_typed_name_iso',left);
|
|
else
|
|
internalerror(2016101502);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
if inlinenumber=in_reset_typedfile then
|
|
result := ccallnode.createintern('fpc_reset_typed',left)
|
|
else
|
|
result := ccallnode.createintern('fpc_rewrite_typed',left);
|
|
end;
|
|
|
|
{ make sure left doesn't get disposed, since we use it in the new call }
|
|
left := nil;
|
|
end;
|
|
|
|
|
|
procedure maybe_convert_to_string(var n: tnode);
|
|
begin
|
|
{ stringconstnodes are arrays of char. It's much more }
|
|
{ efficient to write a constant string, so convert }
|
|
{ either to shortstring or ansistring depending on }
|
|
{ length }
|
|
if (n.nodetype=stringconstn) then
|
|
if is_chararray(n.resultdef) then
|
|
if (tstringconstnode(n).len<=255) then
|
|
inserttypeconv(n,cshortstringtype)
|
|
else
|
|
inserttypeconv(n,getansistringdef)
|
|
else if is_widechararray(n.resultdef) then
|
|
inserttypeconv(n,cunicodestringtype);
|
|
end;
|
|
|
|
|
|
procedure get_read_write_int_func(def: tdef; out func_suffix: string; out readfunctype: tdef);
|
|
var
|
|
ordtype: tordtype;
|
|
begin
|
|
ordtype := torddef(def).ordtype;
|
|
if is_oversizedint(def) then
|
|
begin
|
|
case ordtype of
|
|
s64bit:
|
|
begin
|
|
func_suffix := 'int64';
|
|
readfunctype:=s64inttype;
|
|
end;
|
|
u64bit :
|
|
begin
|
|
func_suffix := 'qword';
|
|
readfunctype:=u64inttype;
|
|
end;
|
|
s32bit:
|
|
begin
|
|
func_suffix := 'longint';
|
|
readfunctype:=s32inttype;
|
|
end;
|
|
u32bit :
|
|
begin
|
|
func_suffix := 'longword';
|
|
readfunctype:=u32inttype;
|
|
end;
|
|
s16bit:
|
|
begin
|
|
func_suffix := 'smallint';
|
|
readfunctype:=s16inttype;
|
|
end;
|
|
u16bit :
|
|
begin
|
|
func_suffix := 'word';
|
|
readfunctype:=u16inttype;
|
|
end;
|
|
else
|
|
internalerror(2013032602);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
case ordtype of
|
|
s64bit,
|
|
s32bit,
|
|
s16bit,
|
|
s8bit:
|
|
begin
|
|
func_suffix := 'sint';
|
|
readfunctype := sinttype;
|
|
end;
|
|
u64bit,
|
|
u32bit,
|
|
u16bit,
|
|
u8bit:
|
|
begin
|
|
func_suffix := 'uint';
|
|
readfunctype := uinttype;
|
|
end;
|
|
else
|
|
internalerror(2013032601);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
function Tinlinenode.handle_text_read_write(filepara,params:Ttertiarynode;var newstatement:Tnode):boolean;
|
|
|
|
{Read(ln)/write(ln) for text files.}
|
|
|
|
const procprefixes:array[boolean] of string[15]=('fpc_write_text_','fpc_read_text_');
|
|
|
|
var error_para,is_real,special_handling,found_error,do_read:boolean;
|
|
p1:Tnode;
|
|
nextpara,
|
|
indexpara,
|
|
lenpara,
|
|
para,
|
|
fracpara:Tcallparanode;
|
|
temp:Ttempcreatenode;
|
|
readfunctype:Tdef;
|
|
name:string[63];
|
|
func_suffix:string[8];
|
|
|
|
begin
|
|
para:=Tcallparanode(params);
|
|
found_error:=false;
|
|
do_read:=inlinenumber in [in_read_x,in_readln_x,in_readstr_x];
|
|
name:='';
|
|
while assigned(para) do
|
|
begin
|
|
{ is this parameter faulty? }
|
|
error_para:=false;
|
|
{ is this parameter a real? }
|
|
is_real:=false;
|
|
{ type used for the read(), this is used to check
|
|
whether a temp is needed for range checking }
|
|
readfunctype:=nil;
|
|
|
|
{ can't read/write types }
|
|
if (para.left.nodetype=typen) and not(is_typeparam(ttypenode(para.left).typedef)) then
|
|
begin
|
|
CGMessagePos(para.fileinfo,type_e_cant_read_write_type);
|
|
error_para := true;
|
|
end;
|
|
|
|
{ support writeln(procvar) }
|
|
if para.left.resultdef.typ=procvardef then
|
|
begin
|
|
p1:=ccallnode.create_procvar(nil,para.left);
|
|
typecheckpass(p1);
|
|
para.left:=p1;
|
|
end;
|
|
|
|
if inlinenumber in [in_write_x,in_writeln_x] then
|
|
{ prefer strings to chararrays }
|
|
maybe_convert_to_string(para.left);
|
|
if is_typeparam(para.left.resultdef) then
|
|
error_para:=true
|
|
else
|
|
case para.left.resultdef.typ of
|
|
stringdef :
|
|
begin
|
|
name:=procprefixes[do_read]+tstringdef(para.left.resultdef).stringtypname;
|
|
if (m_isolike_io in current_settings.modeswitches) and (tstringdef(para.left.resultdef).stringtype<>st_shortstring) then
|
|
begin
|
|
CGMessagePos(para.fileinfo,type_e_cant_read_write_type_in_iso_mode);
|
|
error_para := true;
|
|
end;
|
|
end;
|
|
pointerdef :
|
|
begin
|
|
if (not is_pchar(para.left.resultdef)) or do_read then
|
|
begin
|
|
CGMessagePos(para.fileinfo,type_e_cant_read_write_type);
|
|
error_para := true;
|
|
end
|
|
else
|
|
name:=procprefixes[do_read]+'pchar_as_pointer';
|
|
end;
|
|
floatdef :
|
|
begin
|
|
is_real:=true;
|
|
if Tfloatdef(para.left.resultdef).floattype=s64currency then
|
|
name := procprefixes[do_read]+'currency'
|
|
else
|
|
begin
|
|
name := procprefixes[do_read]+'float';
|
|
readfunctype:=pbestrealtype^;
|
|
end;
|
|
{ iso pascal needs a different handler }
|
|
if (m_isolike_io in current_settings.modeswitches) and do_read then
|
|
name:=name+'_iso';
|
|
end;
|
|
enumdef:
|
|
begin
|
|
name:=procprefixes[do_read]+'enum';
|
|
if do_read then
|
|
{ read is done with a var parameter so we need the correct
|
|
size for that }
|
|
case para.left.resultdef.size of
|
|
1:
|
|
begin
|
|
name:=name+'_shortint';
|
|
readfunctype:=s8inttype;
|
|
end;
|
|
2:
|
|
begin
|
|
name:=name+'_smallint';
|
|
readfunctype:=s16inttype;
|
|
end;
|
|
4:
|
|
begin
|
|
name:=name+'_longint';
|
|
readfunctype:=s32inttype;
|
|
end;
|
|
else
|
|
internalerror(2022082601);
|
|
end
|
|
else
|
|
readfunctype:=s32inttype;
|
|
end;
|
|
orddef :
|
|
begin
|
|
case Torddef(para.left.resultdef).ordtype of
|
|
s8bit,
|
|
s16bit,
|
|
s32bit,
|
|
s64bit,
|
|
u8bit,
|
|
u16bit,
|
|
u32bit,
|
|
u64bit:
|
|
begin
|
|
get_read_write_int_func(para.left.resultdef,func_suffix,readfunctype);
|
|
name := procprefixes[do_read]+func_suffix;
|
|
if (m_isolike_io in current_settings.modeswitches) and do_read then
|
|
name:=name+'_iso';
|
|
end;
|
|
uchar :
|
|
begin
|
|
name := procprefixes[do_read]+'char';
|
|
{ iso pascal needs a different handler }
|
|
if (m_isolike_io in current_settings.modeswitches) and do_read then
|
|
name:=name+'_iso';
|
|
readfunctype:=cansichartype;
|
|
end;
|
|
uwidechar :
|
|
begin
|
|
name := procprefixes[do_read]+'widechar';
|
|
readfunctype:=cwidechartype;
|
|
end;
|
|
scurrency:
|
|
begin
|
|
name := procprefixes[do_read]+'currency';
|
|
{ iso pascal needs a different handler }
|
|
if (m_isolike_io in current_settings.modeswitches) and do_read then
|
|
name:=name+'_iso';
|
|
readfunctype:=s64currencytype;
|
|
is_real:=true;
|
|
end;
|
|
pasbool1,
|
|
pasbool8,
|
|
pasbool16,
|
|
pasbool32,
|
|
pasbool64,
|
|
bool8bit,
|
|
bool16bit,
|
|
bool32bit,
|
|
bool64bit:
|
|
if do_read then
|
|
begin
|
|
CGMessagePos(para.fileinfo,type_e_cant_read_write_type);
|
|
error_para := true;
|
|
end
|
|
else
|
|
begin
|
|
name := procprefixes[do_read]+'boolean';
|
|
readfunctype:=pasbool1type;
|
|
end
|
|
else
|
|
begin
|
|
CGMessagePos(para.fileinfo,type_e_cant_read_write_type);
|
|
error_para := true;
|
|
end;
|
|
end;
|
|
end;
|
|
variantdef :
|
|
begin
|
|
name:=procprefixes[do_read]+'variant';
|
|
include(current_module.moduleflags,mf_uses_variants);
|
|
end;
|
|
arraydef :
|
|
begin
|
|
if is_chararray(para.left.resultdef) then
|
|
name := procprefixes[do_read]+'pchar_as_array'
|
|
else
|
|
begin
|
|
CGMessagePos(para.fileinfo,type_e_cant_read_write_type);
|
|
error_para := true;
|
|
end
|
|
end;
|
|
else
|
|
begin
|
|
CGMessagePos(para.fileinfo,type_e_cant_read_write_type);
|
|
error_para := true;
|
|
end;
|
|
end;
|
|
|
|
{ iso pascal needs a different handler }
|
|
if (m_isolike_io in current_settings.modeswitches) and not(do_read) then
|
|
name:=name+'_iso';
|
|
|
|
{ check for length/fractional colon para's }
|
|
fracpara:=nil;
|
|
lenpara:=nil;
|
|
indexpara:=nil;
|
|
if assigned(para.right) and
|
|
(cpf_is_colon_para in tcallparanode(para.right).callparaflags) then
|
|
begin
|
|
lenpara := tcallparanode(para.right);
|
|
if assigned(lenpara.right) and
|
|
(cpf_is_colon_para in tcallparanode(lenpara.right).callparaflags) then
|
|
fracpara:=tcallparanode(lenpara.right);
|
|
end;
|
|
{ get the next parameter now already, because we're going }
|
|
{ to muck around with the pointers }
|
|
if assigned(fracpara) then
|
|
nextpara := tcallparanode(fracpara.right)
|
|
else if assigned(lenpara) then
|
|
nextpara := tcallparanode(lenpara.right)
|
|
else
|
|
nextpara := tcallparanode(para.right);
|
|
|
|
{ check if a fracpara is allowed }
|
|
if assigned(fracpara) and not is_real then
|
|
begin
|
|
CGMessagePos(fracpara.fileinfo,parser_e_illegal_colon_qualifier);
|
|
error_para := true;
|
|
end
|
|
else if assigned(lenpara) and do_read then
|
|
begin
|
|
{ I think this is already filtered out by parsing, but I'm not sure (JM) }
|
|
CGMessagePos(lenpara.fileinfo,parser_e_illegal_colon_qualifier);
|
|
error_para := true;
|
|
end;
|
|
|
|
{ adjust found_error }
|
|
found_error := found_error or error_para;
|
|
|
|
if not error_para then
|
|
begin
|
|
special_handling:=false;
|
|
{ create dummy frac/len para's if necessary }
|
|
if not do_read then
|
|
begin
|
|
{ difference in default value for floats and the rest :( }
|
|
if not is_real then
|
|
begin
|
|
if not assigned(lenpara) then
|
|
begin
|
|
if m_isolike_io in current_settings.modeswitches then
|
|
lenpara := ccallparanode.create(
|
|
cordconstnode.create(-1,s32inttype,false),nil)
|
|
else
|
|
lenpara := ccallparanode.create(
|
|
cordconstnode.create(0,s32inttype,false),nil);
|
|
end
|
|
else
|
|
{ make sure we don't pass the successive }
|
|
{ parameters too. We also already have a }
|
|
{ reference to the next parameter in }
|
|
{ nextpara }
|
|
lenpara.right := nil;
|
|
end
|
|
else
|
|
begin
|
|
if not assigned(lenpara) then
|
|
lenpara := ccallparanode.create(
|
|
cordconstnode.create(int64(-32767),s32inttype,false),nil);
|
|
{ also create a default fracpara if necessary }
|
|
if not assigned(fracpara) then
|
|
fracpara := ccallparanode.create(
|
|
cordconstnode.create(int64(-1),s32inttype,false),nil);
|
|
{ add it to the lenpara }
|
|
lenpara.right := fracpara;
|
|
if not is_currency(para.left.resultdef) then
|
|
begin
|
|
{ and add the realtype para (this also removes the link }
|
|
{ to any parameters coming after it) }
|
|
fracpara.right := ccallparanode.create(
|
|
cordconstnode.create(ord(tfloatdef(para.left.resultdef).floattype),
|
|
s32inttype,true),nil);
|
|
end
|
|
else
|
|
fracpara.right:=nil;
|
|
end;
|
|
if para.left.resultdef.typ=enumdef then
|
|
begin
|
|
{To write(ln) an enum we need a some extra parameters.}
|
|
{Insert a reference to the ord2string index.}
|
|
indexpara:=Ccallparanode.create(
|
|
Caddrnode.create_internal(
|
|
Crttinode.create(Tenumdef(para.left.resultdef),fullrtti,rdt_normal)
|
|
),
|
|
nil);
|
|
{Insert a reference to the typinfo.}
|
|
indexpara:=Ccallparanode.create(
|
|
Caddrnode.create_internal(
|
|
Crttinode.create(Tenumdef(para.left.resultdef),fullrtti,rdt_ord2str)
|
|
),
|
|
indexpara);
|
|
{Insert a type conversion to to convert the enum to longint.}
|
|
para.left:=Ctypeconvnode.create_internal(para.left,s32inttype);
|
|
typecheckpass(para.left);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
{To read(ln) an enum we need a an extra parameter.}
|
|
if para.left.resultdef.typ=enumdef then
|
|
begin
|
|
{Insert a reference to the string2ord index.}
|
|
indexpara:=Ccallparanode.create(Caddrnode.create_internal(
|
|
Crttinode.create(Tenumdef(para.left.resultdef),fullrtti,rdt_str2ord)
|
|
),nil);
|
|
{Insert a type conversion to to convert the enum to longint.}
|
|
para.left:=Ctypeconvnode.create_internal(para.left,readfunctype);
|
|
typecheckpass(para.left);
|
|
end;
|
|
{ special handling of reading small numbers, because the helpers }
|
|
{ expect a longint/card/bestreal var parameter. Use a temp. can't }
|
|
{ use functions because then the call to FPC_IOCHECK destroys }
|
|
{ their result before we can store it }
|
|
if (readfunctype<>nil) and (para.left.resultdef<>readfunctype) then
|
|
special_handling:=true;
|
|
end;
|
|
if special_handling then
|
|
begin
|
|
{ since we're not going to pass the parameter as var-parameter }
|
|
{ to the read function, manually check whether the parameter }
|
|
{ can be used as var-parameter (e.g., whether it isn't a }
|
|
{ property) }
|
|
valid_for_var(para.left,true);
|
|
|
|
{ create the parameter list: the temp ... }
|
|
temp := ctempcreatenode.create(readfunctype,readfunctype.size,tt_persistent,false);
|
|
addstatement(Tstatementnode(newstatement),temp);
|
|
|
|
{ ... and the file }
|
|
p1 := ccallparanode.create(ctemprefnode.create(temp),
|
|
filepara.getcopy);
|
|
Tcallparanode(Tcallparanode(p1).right).right:=indexpara;
|
|
|
|
{ create the call to the helper }
|
|
addstatement(Tstatementnode(newstatement),
|
|
ccallnode.createintern(name,tcallparanode(p1)));
|
|
|
|
{ assign the result to the original var (this automatically }
|
|
{ takes care of range checking) }
|
|
addstatement(Tstatementnode(newstatement),
|
|
cassignmentnode.create(para.left,
|
|
ctemprefnode.create(temp)));
|
|
|
|
{ release the temp location }
|
|
addstatement(Tstatementnode(newstatement),ctempdeletenode.create(temp));
|
|
|
|
{ statement of para is used }
|
|
para.left := nil;
|
|
|
|
{ free the enclosing tcallparanode, but not the }
|
|
{ parameters coming after it }
|
|
para.right := nil;
|
|
para.free;
|
|
end
|
|
else
|
|
{ read of non s/u-8/16bit, or a write }
|
|
begin
|
|
{ add the filepara to the current parameter }
|
|
para.right := filepara.getcopy;
|
|
{Add the lenpara and the indexpara(s) (fracpara and realtype are
|
|
already linked with the lenpara if necessary).}
|
|
if indexpara=nil then
|
|
Tcallparanode(para.right).right:=lenpara
|
|
else
|
|
begin
|
|
if lenpara=nil then
|
|
Tcallparanode(para.right).right:=indexpara
|
|
else
|
|
begin
|
|
Tcallparanode(para.right).right:=lenpara;
|
|
lenpara.right:=indexpara;
|
|
end;
|
|
{ indexpara.right:=lenpara;}
|
|
end;
|
|
{ in case of writing a chararray, add whether it's zero-based }
|
|
if para.left.resultdef.typ=arraydef then
|
|
para := ccallparanode.create(cordconstnode.create(
|
|
ord(tarraydef(para.left.resultdef).lowrange=0),pasbool1type,false),para)
|
|
else
|
|
{ in case of reading an ansistring pass a codepage argument }
|
|
if do_read and is_ansistring(para.left.resultdef) then
|
|
para:=ccallparanode.create(cordconstnode.create(
|
|
getparaencoding(para.left.resultdef),u16inttype,true),para);
|
|
{ create the call statement }
|
|
addstatement(Tstatementnode(newstatement),
|
|
ccallnode.createintern(name,para));
|
|
end
|
|
end
|
|
else
|
|
{ error_para = true }
|
|
begin
|
|
{ free the parameter, since it isn't referenced anywhere anymore }
|
|
para.right := nil;
|
|
para.free;
|
|
if assigned(lenpara) then
|
|
begin
|
|
lenpara.right := nil;
|
|
lenpara.free;
|
|
end;
|
|
if assigned(fracpara) then
|
|
begin
|
|
fracpara.right := nil;
|
|
fracpara.free;
|
|
end;
|
|
end;
|
|
|
|
{ process next parameter }
|
|
para := nextpara;
|
|
end;
|
|
|
|
{ if no error, add the write(ln)/read(ln) end calls }
|
|
if not found_error then
|
|
begin
|
|
case inlinenumber of
|
|
in_read_x,
|
|
in_readstr_x:
|
|
name:='fpc_read_end';
|
|
in_write_x,
|
|
in_writestr_x:
|
|
name:='fpc_write_end';
|
|
in_readln_x:
|
|
begin
|
|
name:='fpc_readln_end';
|
|
if m_isolike_io in current_settings.modeswitches then
|
|
name:=name+'_iso';
|
|
end;
|
|
in_writeln_x:
|
|
name:='fpc_writeln_end';
|
|
else
|
|
internalerror(2019050501);
|
|
end;
|
|
addstatement(Tstatementnode(newstatement),ccallnode.createintern(name,filepara.getcopy));
|
|
end;
|
|
handle_text_read_write:=found_error;
|
|
end;
|
|
|
|
function Tinlinenode.handle_typed_read_write(filepara,params:Ttertiarynode;var newstatement:Tnode):boolean;
|
|
|
|
{Read/write for typed files.}
|
|
|
|
const procprefixes:array[boolean,boolean] of string[19]=(('fpc_typed_write','fpc_typed_read'),
|
|
('fpc_typed_write','fpc_typed_read_iso'));
|
|
procnamesdisplay:array[boolean,boolean] of string[8] = (('Write','Read'),('WriteStr','ReadStr'));
|
|
|
|
var found_error,do_read,is_rwstr:boolean;
|
|
para,nextpara:Tcallparanode;
|
|
p1:Tnode;
|
|
temp:Ttempcreatenode;
|
|
begin
|
|
found_error:=false;
|
|
para:=Tcallparanode(params);
|
|
do_read:=inlinenumber in [in_read_x,in_readln_x,in_readstr_x];
|
|
is_rwstr := inlinenumber in [in_readstr_x,in_writestr_x];
|
|
temp:=nil;
|
|
{ add the typesize to the filepara }
|
|
if filepara.resultdef.typ=filedef then
|
|
filepara.right := ccallparanode.create(cordconstnode.create(
|
|
tfiledef(filepara.resultdef).typedfiledef.size,s32inttype,true),nil);
|
|
|
|
{ check for "no parameters" (you need at least one extra para for typed files) }
|
|
if not assigned(para) then
|
|
begin
|
|
CGMessage1(parser_e_wrong_parameter_size,procnamesdisplay[is_rwstr,do_read]);
|
|
found_error := true;
|
|
end;
|
|
|
|
{ process all parameters }
|
|
while assigned(para) do
|
|
begin
|
|
{ check if valid parameter }
|
|
if para.left.nodetype=typen then
|
|
begin
|
|
CGMessagePos(para.left.fileinfo,type_e_cant_read_write_type);
|
|
found_error := true;
|
|
end;
|
|
|
|
{ support writeln(procvar) }
|
|
if (para.left.resultdef.typ=procvardef) then
|
|
begin
|
|
p1:=ccallnode.create_procvar(nil,para.left);
|
|
typecheckpass(p1);
|
|
para.left:=p1;
|
|
end;
|
|
|
|
if filepara.resultdef.typ=filedef then
|
|
inserttypeconv(para.left,tfiledef(filepara.resultdef).typedfiledef);
|
|
|
|
if assigned(para.right) and
|
|
(cpf_is_colon_para in tcallparanode(para.right).callparaflags) then
|
|
begin
|
|
CGMessagePos(para.right.fileinfo,parser_e_illegal_colon_qualifier);
|
|
|
|
{ skip all colon para's }
|
|
nextpara := tcallparanode(tcallparanode(para.right).right);
|
|
while assigned(nextpara) and (cpf_is_colon_para in nextpara.callparaflags) do
|
|
nextpara := tcallparanode(nextpara.right);
|
|
found_error := true;
|
|
end
|
|
else
|
|
{ get next parameter }
|
|
nextpara := tcallparanode(para.right);
|
|
|
|
{ When we have a call, we have a problem: you can't pass the }
|
|
{ result of a call as a formal const parameter. Solution: }
|
|
{ assign the result to a temp and pass this temp as parameter }
|
|
{ This is not very efficient, but write(typedfile,x) is }
|
|
{ already slow by itself anyway (no buffering) (JM) }
|
|
{ Actually, thge same goes for every non-simple expression }
|
|
{ (such as an addition, ...) -> put everything but load nodes }
|
|
{ into temps (JM) }
|
|
{ of course, this must only be allowed for writes!!! (JM) }
|
|
if not(do_read) and (para.left.nodetype <> loadn) then
|
|
begin
|
|
{ create temp for result }
|
|
temp := ctempcreatenode.create(para.left.resultdef,
|
|
para.left.resultdef.size,tt_persistent,false);
|
|
addstatement(Tstatementnode(newstatement),temp);
|
|
{ assign result to temp }
|
|
addstatement(Tstatementnode(newstatement),
|
|
cassignmentnode.create(ctemprefnode.create(temp),
|
|
para.left));
|
|
{ replace (reused) paranode with temp }
|
|
para.left := ctemprefnode.create(temp);
|
|
end;
|
|
{ add fileparameter }
|
|
para.right := filepara.getcopy;
|
|
|
|
{ create call statment }
|
|
{ since the parameters are in the correct order, we have to insert }
|
|
{ the statements always at the end of the current block }
|
|
addstatement(Tstatementnode(newstatement),
|
|
Ccallnode.createintern(procprefixes[m_isolike_io in current_settings.modeswitches,do_read],para
|
|
));
|
|
|
|
{ if we used a temp, free it }
|
|
if para.left.nodetype = temprefn then
|
|
addstatement(Tstatementnode(newstatement),ctempdeletenode.create(temp));
|
|
|
|
{ process next parameter }
|
|
para := nextpara;
|
|
end;
|
|
|
|
handle_typed_read_write:=found_error;
|
|
end;
|
|
|
|
function tinlinenode.handle_read_write: tnode;
|
|
|
|
var
|
|
filepara,
|
|
nextpara,
|
|
params : tcallparanode;
|
|
newstatement : tstatementnode;
|
|
newblock : tblocknode;
|
|
filetemp : Ttempcreatenode;
|
|
name : string[31];
|
|
textsym : ttypesym;
|
|
is_typed,
|
|
do_read,
|
|
is_rwstr,
|
|
found_error : boolean;
|
|
begin
|
|
filepara := nil;
|
|
is_typed := false;
|
|
filetemp := nil;
|
|
do_read := inlinenumber in [in_read_x,in_readln_x,in_readstr_x];
|
|
is_rwstr := inlinenumber in [in_readstr_x,in_writestr_x];
|
|
|
|
{ if we fail, we can quickly exit this way. We must generate something }
|
|
{ instead of the inline node, because firstpass will bomb with an }
|
|
{ internalerror if it encounters a read/write }
|
|
result := cerrornode.create;
|
|
|
|
{ reverse the parameters (needed to get the colon parameters in the }
|
|
{ correct order when processing write(ln) }
|
|
reverseparameters(tcallparanode(left));
|
|
|
|
if is_rwstr then
|
|
begin
|
|
filepara := tcallparanode(left);
|
|
{ needs at least two parameters: source/dest string + min. 1 value }
|
|
if not(assigned(filepara)) or
|
|
not(assigned(filepara.right)) then
|
|
begin
|
|
CGMessagePos1(fileinfo,parser_e_wrong_parameter_size,'ReadStr/WriteStr');
|
|
exit;
|
|
end
|
|
else if (filepara.resultdef.typ <> stringdef) then
|
|
begin
|
|
{ convert chararray to string, or give an appropriate error message }
|
|
{ (if you want to optimize to use shortstring, keep in mind that }
|
|
{ readstr internally always uses ansistring, and to account for }
|
|
{ chararrays with > 255 characters) }
|
|
inserttypeconv(filepara.left,getansistringdef);
|
|
filepara.resultdef:=filepara.left.resultdef;
|
|
if codegenerror then
|
|
exit;
|
|
end
|
|
end
|
|
else if assigned(left) then
|
|
begin
|
|
{ check if we have a file parameter and if yes, what kind it is }
|
|
filepara := tcallparanode(left);
|
|
|
|
if (filepara.resultdef.typ=filedef) then
|
|
begin
|
|
if (tfiledef(filepara.resultdef).filetyp=ft_untyped) then
|
|
begin
|
|
CGMessagePos(fileinfo,type_e_no_read_write_for_untyped_file);
|
|
exit;
|
|
end
|
|
else
|
|
begin
|
|
if (tfiledef(filepara.resultdef).filetyp=ft_typed) then
|
|
begin
|
|
if (inlinenumber in [in_readln_x,in_writeln_x]) then
|
|
begin
|
|
CGMessagePos(fileinfo,type_e_no_readln_writeln_for_typed_file);
|
|
exit;
|
|
end;
|
|
is_typed := true;
|
|
end
|
|
end;
|
|
end
|
|
else
|
|
filepara := nil;
|
|
end;
|
|
|
|
if assigned(filepara) and
|
|
assigned(filepara.right) and
|
|
(cpf_is_colon_para in tcallparanode(filepara.right).callparaflags) then
|
|
begin
|
|
CGMessagePos(filepara.fileinfo,parser_e_illegal_colon_qualifier);
|
|
{ for recovery we can simply continue, because the compiler will
|
|
simply treat the next parameters as normal parameters }
|
|
end;
|
|
|
|
{ create a blocknode in which the successive write/read statements will be }
|
|
{ put, since they belong together. Also create a dummy statement already to }
|
|
{ make inserting of additional statements easier }
|
|
newblock:=internalstatements(newstatement);
|
|
|
|
if is_rwstr then
|
|
begin
|
|
{ create a dummy temp text file that will be used to cache the
|
|
readstr/writestr state. Can't use a global variable in the system
|
|
unit because these can be nested (in case of parameters to
|
|
writestr that are function calls to functions that also call
|
|
readstr/writestr) }
|
|
textsym:=search_system_type('TEXT');
|
|
filetemp:=ctempcreatenode.create(textsym.typedef,textsym.typedef.size,tt_persistent,false);
|
|
addstatement(newstatement,filetemp);
|
|
|
|
if (do_read) then
|
|
name:='fpc_setupreadstr_'
|
|
else
|
|
name:='fpc_setupwritestr_';
|
|
name:=name+tstringdef(filepara.resultdef).stringtypname;
|
|
{ the file para is a var parameter, but it is properly initialized,
|
|
so it should be actually an out parameter }
|
|
if not(do_read) then
|
|
set_varstate(filepara.left,vs_written,[]);
|
|
{ remove the source/destination string parameter from the }
|
|
{ parameter chain }
|
|
left:=filepara.right;
|
|
filepara.right:=ccallparanode.create(ctemprefnode.create(filetemp),nil);
|
|
{ in case of a writestr() to an ansistring, also pass the string's
|
|
code page }
|
|
if not do_read and
|
|
is_ansistring(filepara.left.resultdef) then
|
|
filepara:=ccallparanode.create(genintconstnode(tstringdef(filepara.left.resultdef).encoding),filepara);
|
|
{ pass the temp text file and the source/destination string to the
|
|
setup routine, which will store the string's address in the
|
|
textrec }
|
|
addstatement(newstatement,ccallnode.createintern(name,filepara));
|
|
filepara:=ccallparanode.create(ctemprefnode.create(filetemp),nil);
|
|
end
|
|
{ if we don't have a filepara, create one containing the default }
|
|
else if not assigned(filepara) then
|
|
begin
|
|
{ since the input/output variables are threadvars loading them into
|
|
a temp once is faster. Create a temp which will hold a pointer to the file }
|
|
filetemp := ctempcreatenode.create(voidpointertype,voidpointertype.size,tt_persistent,true);
|
|
addstatement(newstatement,filetemp);
|
|
|
|
{ make sure the resultdef of the temp (and as such of the }
|
|
{ temprefs coming after it) is set (necessary because the }
|
|
{ temprefs will be part of the filepara, of which we need }
|
|
{ the resultdef later on and temprefs can only be }
|
|
{ typecheckpassed if the resultdef of the temp is known) }
|
|
typecheckpass(tnode(filetemp));
|
|
|
|
{ assign the address of the file to the temp }
|
|
if do_read then
|
|
name := 'input'
|
|
else
|
|
name := 'output';
|
|
addstatement(newstatement,
|
|
cassignmentnode.create(ctemprefnode.create(filetemp),
|
|
ccallnode.createintern('fpc_get_'+name,nil)));
|
|
|
|
{ create a new fileparameter as follows: file_type(temp^) }
|
|
{ (so that we pass the value and not the address of the temp }
|
|
{ to the read/write routine) }
|
|
textsym:=search_system_type('TEXT');
|
|
filepara := ccallparanode.create(ctypeconvnode.create_internal(
|
|
cderefnode.create(ctemprefnode.create(filetemp)),textsym.typedef),nil);
|
|
end
|
|
else
|
|
{ remove filepara from the parameter chain }
|
|
begin
|
|
left := filepara.right;
|
|
filepara.right := nil;
|
|
{ the file para is a var parameter, but it must be valid already }
|
|
set_varstate(filepara.left,vs_readwritten,[vsf_must_be_valid]);
|
|
{ check if we should make a temp to store the result of a complex }
|
|
{ expression (better heuristics, anyone?) (JM) }
|
|
if (filepara.left.nodetype <> loadn) then
|
|
begin
|
|
{ create a temp which will hold a pointer to the file }
|
|
filetemp := ctempcreatenode.create(voidpointertype,voidpointertype.size,tt_persistent,true);
|
|
|
|
{ add it to the statements }
|
|
addstatement(newstatement,filetemp);
|
|
|
|
{ make sure the resultdef of the temp (and as such of the }
|
|
{ temprefs coming after it) is set (necessary because the }
|
|
{ temprefs will be part of the filepara, of which we need }
|
|
{ the resultdef later on and temprefs can only be }
|
|
{ typecheckpassed if the resultdef of the temp is known) }
|
|
typecheckpass(tnode(filetemp));
|
|
|
|
{ assign the address of the file to the temp }
|
|
addstatement(newstatement,
|
|
cassignmentnode.create(ctemprefnode.create(filetemp),
|
|
caddrnode.create_internal(filepara.left)));
|
|
typecheckpass(newstatement.left);
|
|
{ create a new fileparameter as follows: file_type(temp^) }
|
|
{ (so that we pass the value and not the address of the temp }
|
|
{ to the read/write routine) }
|
|
nextpara := ccallparanode.create(ctypeconvnode.create_internal(
|
|
cderefnode.create(ctemprefnode.create(filetemp)),filepara.left.resultdef),nil);
|
|
|
|
{ replace the old file para with the new one }
|
|
filepara.left := nil;
|
|
filepara.free;
|
|
filepara := nextpara;
|
|
end;
|
|
end;
|
|
|
|
{ the resultdef of the filepara must be set since it's }
|
|
{ used below }
|
|
filepara.get_paratype;
|
|
|
|
{ now, filepara is nowhere referenced anymore, so we can safely dispose it }
|
|
{ if something goes wrong or at the end of the procedure }
|
|
|
|
{ we're going to reuse the paranodes, so make sure they don't get freed }
|
|
{ twice }
|
|
params:=Tcallparanode(left);
|
|
left := nil;
|
|
|
|
if is_typed then
|
|
found_error:=handle_typed_read_write(filepara,Ttertiarynode(params),tnode(newstatement))
|
|
else
|
|
found_error:=handle_text_read_write(filepara,Ttertiarynode(params),tnode(newstatement));
|
|
|
|
{ free the file parameter (it's copied inside the handle_*_read_write methods) }
|
|
filepara.free;
|
|
|
|
{ if we found an error, simply delete the generated blocknode }
|
|
if found_error then
|
|
begin
|
|
{ ensure that the tempinfo is freed correctly by destroying a
|
|
delete node for it
|
|
Note: this might happen legitimately whe parsing a generic that
|
|
passes a undefined type to Write/Read }
|
|
if assigned(filetemp) then
|
|
ctempdeletenode.create(filetemp).free;
|
|
newblock.free
|
|
end
|
|
else
|
|
begin
|
|
{ deallocate the temp for the file para if we used one }
|
|
if assigned(filetemp) then
|
|
addstatement(newstatement,ctempdeletenode.create(filetemp));
|
|
{ otherwise return the newly generated block of instructions, }
|
|
{ but first free the errornode we generated at the beginning }
|
|
result.free;
|
|
result := newblock
|
|
end;
|
|
end;
|
|
|
|
|
|
function get_val_int_func(def: tdef): string;
|
|
var
|
|
ordtype: tordtype;
|
|
begin
|
|
ordtype := torddef(def).ordtype;
|
|
if not (ordtype in [s64bit,u64bit,s32bit,u32bit,s16bit,u16bit,s8bit,u8bit]) then
|
|
internalerror(2020080101);
|
|
|
|
if is_oversizedint(def) then
|
|
begin
|
|
case ordtype of
|
|
s64bit: exit('int64');
|
|
u64bit: exit('qword');
|
|
s32bit: exit('longint');
|
|
u32bit: exit('longword');
|
|
s16bit: exit('smallint');
|
|
u16bit: exit('word');
|
|
else
|
|
internalerror(2013032606);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
case ordtype of
|
|
s64bit,s32bit,s16bit,s8bit: exit('sint');
|
|
u64bit,u32bit,u16bit,u8bit: exit('uint');
|
|
else
|
|
internalerror(2013032607);
|
|
end;
|
|
end;
|
|
internalerror(2013032608);
|
|
end;
|
|
|
|
|
|
function tinlinenode.handle_val: tnode;
|
|
var
|
|
procname,
|
|
suffix : string[31];
|
|
sourcepara,
|
|
destpara,
|
|
codepara,
|
|
sizepara,
|
|
newparas : tcallparanode;
|
|
orgcode,tc : tnode;
|
|
newstatement : tstatementnode;
|
|
newblock : tblocknode;
|
|
tempcode : ttempcreatenode;
|
|
valsinttype : tdef;
|
|
begin
|
|
{ for easy exiting if something goes wrong }
|
|
result := cerrornode.create;
|
|
|
|
{ check the amount of parameters }
|
|
if not(assigned(left)) or
|
|
not(assigned(tcallparanode(left).right)) then
|
|
begin
|
|
CGMessage1(parser_e_wrong_parameter_size,'Val');
|
|
exit;
|
|
end;
|
|
|
|
suffix:='';
|
|
|
|
{ in case we are in a generic definition, we cannot
|
|
do all checks, the parameters might be type parameters }
|
|
if df_generic in current_procinfo.procdef.defoptions then
|
|
begin
|
|
result.Free;
|
|
result:=nil;
|
|
resultdef:=voidtype;
|
|
exit;
|
|
end;
|
|
|
|
{ retrieve the ValSInt type }
|
|
valsinttype:=search_system_type('VALSINT').typedef;
|
|
|
|
{ reverse parameters for easier processing }
|
|
reverseparameters(tcallparanode(left));
|
|
|
|
{ get the parameters }
|
|
tempcode := nil;
|
|
orgcode := nil;
|
|
sizepara := nil;
|
|
sourcepara := tcallparanode(left);
|
|
destpara := tcallparanode(sourcepara.right);
|
|
codepara := tcallparanode(destpara.right);
|
|
|
|
{ check if codepara is valid }
|
|
if assigned(codepara) and
|
|
(
|
|
not is_integer(codepara.resultdef)
|
|
{$ifndef cpu64bitaddr}
|
|
or is_64bitint(codepara.resultdef)
|
|
{$endif not cpu64bitaddr}
|
|
) then
|
|
begin
|
|
CGMessagePos1(codepara.fileinfo,type_e_integer_expr_expected,codepara.resultdef.typename);
|
|
exit;
|
|
end;
|
|
|
|
{ check if dest para is valid }
|
|
if not is_integer(destpara.resultdef) and
|
|
not is_currency(destpara.resultdef) and
|
|
not(destpara.resultdef.typ in [floatdef,enumdef]) then
|
|
begin
|
|
CGMessagePos(destpara.fileinfo,type_e_integer_or_real_expr_expected);
|
|
exit;
|
|
end;
|
|
|
|
{ we're going to reuse the exisiting para's, so make sure they }
|
|
{ won't be disposed }
|
|
left := nil;
|
|
|
|
{ create the blocknode which will hold the generated statements + }
|
|
{ an initial dummy statement }
|
|
|
|
newblock:=internalstatements(newstatement);
|
|
|
|
{ do we need a temp for code? Yes, if no code specified, or if }
|
|
{ code is not a valsinttype sized parameter (we already checked }
|
|
{ whether the code para, if specified, was an orddef) }
|
|
if not assigned(codepara) or
|
|
(codepara.resultdef.size<>valsinttype.size) then
|
|
begin
|
|
tempcode := ctempcreatenode.create(valsinttype,valsinttype.size,tt_persistent,false);
|
|
addstatement(newstatement,tempcode);
|
|
{ set the resultdef of the temp (needed to be able to get }
|
|
{ the resultdef of the tempref used in the new code para) }
|
|
typecheckpass(tnode(tempcode));
|
|
{ create a temp codepara, but save the original code para to }
|
|
{ assign the result to later on }
|
|
if assigned(codepara) then
|
|
begin
|
|
orgcode := codepara.left;
|
|
codepara.left := ctemprefnode.create(tempcode);
|
|
end
|
|
else
|
|
codepara := ccallparanode.create(ctemprefnode.create(tempcode),nil);
|
|
{ we need its resultdef later on }
|
|
codepara.get_paratype;
|
|
end
|
|
else if (torddef(codepara.resultdef).ordtype <> torddef(valsinttype).ordtype) then
|
|
{ because code is a var parameter, it must match types exactly }
|
|
{ however, since it will return values >= 0, both signed and }
|
|
{ and unsigned ints of the same size are fine. Since the formal }
|
|
{ code para type is sinttype, insert a typecoversion to sint for }
|
|
{ unsigned para's }
|
|
begin
|
|
codepara.left := ctypeconvnode.create_internal(codepara.left,valsinttype);
|
|
{ make it explicit, oterwise you may get a nonsense range }
|
|
{ check error if the cardinal already contained a value }
|
|
{ > $7fffffff }
|
|
codepara.get_paratype;
|
|
end;
|
|
|
|
{ create the procedure name }
|
|
procname := 'fpc_val_';
|
|
|
|
case destpara.resultdef.typ of
|
|
orddef:
|
|
begin
|
|
case torddef(destpara.resultdef).ordtype of
|
|
s8bit,s16bit,s32bit,s64bit,
|
|
u8bit,u16bit,u32bit,u64bit:
|
|
begin
|
|
suffix := get_val_int_func(destpara.resultdef) + '_';
|
|
{ we also need a destsize para in the case of sint or uint }
|
|
if (suffix = 'sint_') or (suffix = 'uint_') then
|
|
sizepara := ccallparanode.create(cordconstnode.create
|
|
(destpara.resultdef.size,s32inttype,true),nil);
|
|
end;
|
|
scurrency: suffix := 'currency_';
|
|
else
|
|
internalerror(200304225);
|
|
end;
|
|
end;
|
|
floatdef:
|
|
suffix:='real_';
|
|
enumdef:
|
|
begin
|
|
suffix:='enum_';
|
|
sizepara:=Ccallparanode.create(Caddrnode.create_internal(
|
|
Crttinode.create(Tenumdef(destpara.resultdef),fullrtti,rdt_str2ord)
|
|
),nil);
|
|
end;
|
|
else
|
|
internalerror(2019050515);
|
|
end;
|
|
|
|
procname := procname + suffix;
|
|
|
|
{ play a trick to have tcallnode handle invalid source parameters: }
|
|
{ the shortstring-longint val routine by default }
|
|
if (sourcepara.resultdef.typ = stringdef) then
|
|
procname := procname + tstringdef(sourcepara.resultdef).stringtypname
|
|
{ zero-based arrays (of char) can be implicitely converted to ansistring, but don't do
|
|
so if not needed because the array is too short }
|
|
else if is_zero_based_array(sourcepara.resultdef) and (sourcepara.resultdef.size>255) then
|
|
procname := procname + 'ansistr'
|
|
else
|
|
procname := procname + 'shortstr';
|
|
|
|
{ set up the correct parameters for the call: the code para... }
|
|
newparas := codepara;
|
|
{ and the source para }
|
|
codepara.right := sourcepara;
|
|
{ sizepara either contains nil if none is needed (which is ok, since }
|
|
{ then the next statement severes any possible links with other paras }
|
|
{ that sourcepara may have) or it contains the necessary size para and }
|
|
{ its right field is nil }
|
|
sourcepara.right := sizepara;
|
|
|
|
{ create the call and assign the result to dest (val helpers are functions).
|
|
Use a trick to prevent a type size mismatch warning to be generated by the
|
|
assignment node. First convert implicitly to the resultdef. This will insert
|
|
the range check. The Second conversion is done explicitly to hide the implicit conversion
|
|
for the assignment node and therefor preventing the warning (PFV)
|
|
|
|
The implicit conversion is avoided for enums because implicit conversion between
|
|
longint (which is what fpc_val_enum_shortstr returns) and enumerations is not
|
|
possible. (DM).
|
|
|
|
The implicit conversion is also avoided for COMP type if it is handled by FPU (x86)
|
|
to prevent warning about automatic type conversion. }
|
|
if (destpara.resultdef.typ=enumdef) or
|
|
((destpara.resultdef.typ=floatdef) and (tfloatdef(destpara.resultdef).floattype=s64comp))
|
|
then
|
|
tc:=ccallnode.createfromintrinsic(in_val_x,procname,newparas)
|
|
else
|
|
tc:=ctypeconvnode.create(ccallnode.createfromintrinsic(in_val_x,procname,newparas),destpara.left.resultdef);
|
|
addstatement(newstatement,cassignmentnode.create(
|
|
destpara.left,ctypeconvnode.create_internal(tc,destpara.left.resultdef)));
|
|
|
|
{ dispose of the enclosing paranode of the destination }
|
|
destpara.left := nil;
|
|
destpara.right := nil;
|
|
destpara.free;
|
|
|
|
{ check if we used a temp for code and whether we have to store }
|
|
{ it to the real code parameter }
|
|
if assigned(orgcode) then
|
|
addstatement(newstatement,cassignmentnode.create(
|
|
orgcode,
|
|
ctypeconvnode.create_internal(
|
|
ctemprefnode.create(tempcode),orgcode.resultdef)));
|
|
|
|
{ release the temp if we allocated one }
|
|
if assigned(tempcode) then
|
|
addstatement(newstatement,ctempdeletenode.create(tempcode));
|
|
|
|
{ free the errornode }
|
|
result.free;
|
|
{ and return it }
|
|
result := newblock;
|
|
end;
|
|
|
|
function tinlinenode.handle_setlength: tnode;
|
|
var
|
|
def: tdef;
|
|
destppn,
|
|
paras: tnode;
|
|
newstatement: tstatementnode;
|
|
ppn: tcallparanode;
|
|
counter,
|
|
dims: longint;
|
|
isarray: boolean;
|
|
begin
|
|
{ for easy exiting if something goes wrong }
|
|
result:=cerrornode.create;
|
|
resultdef:=voidtype;
|
|
paras:=left;
|
|
dims:=0;
|
|
if assigned(paras) then
|
|
begin
|
|
{ check type of lengths }
|
|
ppn:=tcallparanode(paras);
|
|
while assigned(ppn.right) do
|
|
begin
|
|
set_varstate(ppn.left,vs_read,[vsf_must_be_valid]);
|
|
inserttypeconv(ppn.left,sinttype);
|
|
inc(dims);
|
|
ppn:=tcallparanode(ppn.right);
|
|
end;
|
|
end
|
|
else
|
|
internalerror(2013112912);
|
|
if dims=0 then
|
|
begin
|
|
CGMessage1(parser_e_wrong_parameter_size,'SetLength');
|
|
exit;
|
|
end;
|
|
{ last param must be var }
|
|
destppn:=ppn.left;
|
|
valid_for_var(destppn,true);
|
|
set_varstate(destppn,vs_written,[vsf_must_be_valid,vsf_use_hints,vsf_use_hint_for_string_result]);
|
|
{ first param must be a string or dynamic array ...}
|
|
isarray:=is_dynamic_array(destppn.resultdef);
|
|
if not((destppn.resultdef.typ=stringdef) or
|
|
isarray) then
|
|
begin
|
|
{ possibly generic involved? }
|
|
if df_generic in current_procinfo.procdef.defoptions then
|
|
result:=internalstatements(newstatement)
|
|
else
|
|
CGMessage(type_e_mismatch);
|
|
exit;
|
|
end;
|
|
|
|
{ only dynamic arrays accept more dimensions }
|
|
if (dims>1) then
|
|
begin
|
|
if (not isarray) then
|
|
CGMessage(type_e_mismatch)
|
|
else
|
|
begin
|
|
{ check if the amount of dimensions is valid }
|
|
def:=tarraydef(destppn.resultdef).elementdef;
|
|
counter:=dims;
|
|
while counter > 1 do
|
|
begin
|
|
if not(is_dynamic_array(def)) then
|
|
begin
|
|
CGMessage1(parser_e_wrong_parameter_size,'SetLength');
|
|
break;
|
|
end;
|
|
dec(counter);
|
|
def:=tarraydef(def).elementdef;
|
|
end;
|
|
end;
|
|
end;
|
|
result.free;
|
|
result:=nil;
|
|
end;
|
|
|
|
|
|
function tinlinenode.handle_copy: tnode;
|
|
|
|
procedure do_error(typemismatch:boolean;func:string;fi:tfileposinfo);
|
|
|
|
procedure write_dynarray_copy;
|
|
begin
|
|
MessagePos1(fileinfo,sym_e_param_list,'Copy(Dynamic Array;'+sizesinttype.typename+'=`<low>`;'+sizesinttype.typename+'=`<length>`);');
|
|
end;
|
|
|
|
begin
|
|
if typemismatch then
|
|
CGMessagePos(fi,type_e_mismatch)
|
|
else
|
|
CGMessagePos1(fi,parser_e_wrong_parameter_size,'Copy');
|
|
if func='' then
|
|
begin
|
|
write_system_parameter_lists('fpc_shortstr_copy');
|
|
write_system_parameter_lists('fpc_char_copy');
|
|
write_system_parameter_lists('fpc_unicodestr_copy');
|
|
if tf_winlikewidestring in target_info.flags then
|
|
write_system_parameter_lists('fpc_widestr_copy');
|
|
write_system_parameter_lists('fpc_ansistr_copy');
|
|
write_dynarray_copy;
|
|
end
|
|
else if func='fpc_dynarray_copy' then
|
|
write_dynarray_copy
|
|
else
|
|
write_system_parameter_lists(func);
|
|
end;
|
|
|
|
var
|
|
paras : tnode;
|
|
ppn : tcallparanode;
|
|
paradef : tdef;
|
|
counter : integer;
|
|
minargs,
|
|
maxargs : longint;
|
|
func : string;
|
|
begin
|
|
if not assigned(left) then
|
|
begin
|
|
do_error(false,'',fileinfo);
|
|
exit(cerrornode.create);
|
|
end;
|
|
result:=nil;
|
|
{ determine copy function to use based on the first argument,
|
|
also count the number of arguments in this loop }
|
|
counter:=1;
|
|
paras:=left;
|
|
ppn:=tcallparanode(paras);
|
|
while assigned(ppn.right) do
|
|
begin
|
|
inc(counter);
|
|
set_varstate(ppn.left,vs_read,[vsf_must_be_valid]);
|
|
ppn:=tcallparanode(ppn.right);
|
|
end;
|
|
set_varstate(ppn.left,vs_read,[vsf_must_be_valid]);
|
|
paradef:=ppn.left.resultdef;
|
|
{ the string variants all require 2 or 3 args, only the array one allows less }
|
|
minargs:=2;
|
|
maxargs:=3;
|
|
func:='';
|
|
if is_ansistring(paradef) then
|
|
begin
|
|
// set resultdef to argument def
|
|
resultdef:=paradef;
|
|
func:='fpc_ansistr_copy';
|
|
end
|
|
else if (is_chararray(paradef) and (paradef.size>255)) or
|
|
((cs_refcountedstrings in current_settings.localswitches) and is_pchar(paradef)) then
|
|
begin
|
|
// set resultdef to ansistring type since result will be in ansistring codepage
|
|
resultdef:=getansistringdef;
|
|
func:='fpc_ansistr_copy';
|
|
end
|
|
else if is_widestring(paradef) then
|
|
begin
|
|
resultdef:=cwidestringtype;
|
|
func:='fpc_widestr_copy';
|
|
end
|
|
else if is_unicodestring(paradef) or
|
|
is_widechararray(paradef) or
|
|
is_pwidechar(paradef) then
|
|
begin
|
|
resultdef:=cunicodestringtype;
|
|
func:='fpc_unicodestr_copy';
|
|
end
|
|
else
|
|
if is_char(paradef) then
|
|
begin
|
|
resultdef:=cshortstringtype;
|
|
func:='fpc_char_copy';
|
|
end
|
|
else
|
|
if is_dynamic_array(paradef) then
|
|
begin
|
|
minargs:=1;
|
|
resultdef:=paradef;
|
|
func:='fpc_array_to_dynarray_copy';
|
|
end
|
|
else
|
|
if is_open_array(paradef) then
|
|
begin
|
|
minargs:=1;
|
|
resultdef:=carraydef.create(0,-1,tarraydef(paradef).rangedef);
|
|
tarraydef(resultdef).arrayoptions:=tarraydef(resultdef).arrayoptions+[ado_IsDynamicArray];
|
|
tarraydef(resultdef).elementdef:=tarraydef(paradef).elementdef;
|
|
func:='fpc_array_to_dynarray_copy';
|
|
end
|
|
else if counter in [2..3] then
|
|
begin
|
|
resultdef:=cshortstringtype;
|
|
func:='fpc_shortstr_copy';
|
|
end
|
|
else if counter<=maxargs then
|
|
begin
|
|
do_error(true,'',ppn.left.fileinfo);
|
|
exit(cerrornode.create);
|
|
end;
|
|
|
|
if (counter<minargs) or (counter>maxargs) then
|
|
begin
|
|
do_error(false,func,fileinfo);
|
|
exit(cerrornode.create);
|
|
end;
|
|
end;
|
|
|
|
{$maxfpuregisters 0}
|
|
|
|
function getpi : bestreal;
|
|
begin
|
|
{$ifdef x86}
|
|
{ x86 has pi in hardware }
|
|
result:=pi;
|
|
{$else x86}
|
|
{$ifdef cpuextended}
|
|
result:=MathPiExtended.Value;
|
|
{$else cpuextended}
|
|
result:=MathPi.Value;
|
|
{$endif cpuextended}
|
|
{$endif x86}
|
|
end;
|
|
|
|
|
|
function tinlinenode.simplify(forinline : boolean): tnode;
|
|
|
|
function do_lowhigh(def:tdef) : tnode;
|
|
var
|
|
v : tconstexprint;
|
|
enum : tenumsym;
|
|
hp : tnode;
|
|
i : integer;
|
|
begin
|
|
case def.typ of
|
|
orddef:
|
|
begin
|
|
set_varstate(left,vs_read,[]);
|
|
if inlinenumber=in_low_x then
|
|
v:=torddef(def).low
|
|
else
|
|
v:=torddef(def).high;
|
|
hp:=cordconstnode.create(v,def,true);
|
|
typecheckpass(hp);
|
|
do_lowhigh:=hp;
|
|
end;
|
|
enumdef:
|
|
begin
|
|
set_varstate(left,vs_read,[]);
|
|
if inlinenumber=in_high_x then
|
|
v:=tenumdef(def).maxval
|
|
else
|
|
v:=tenumdef(def).minval;
|
|
enum:=nil;
|
|
for i := 0 to tenumdef(def).symtable.SymList.Count - 1 do
|
|
if tenumsym(tenumdef(def).symtable.SymList[i]).value=v then
|
|
begin
|
|
enum:=tenumsym(tenumdef(def).symtable.SymList[i]);
|
|
break;
|
|
end;
|
|
if not assigned(enum) then
|
|
internalerror(309993)
|
|
else
|
|
hp:=genenumnode(enum);
|
|
do_lowhigh:=hp;
|
|
end;
|
|
else
|
|
internalerror(87);
|
|
end;
|
|
end;
|
|
|
|
|
|
function getconstrealvalue : bestreal;
|
|
begin
|
|
case left.nodetype of
|
|
ordconstn:
|
|
getconstrealvalue:=tordconstnode(left).value;
|
|
realconstn:
|
|
getconstrealvalue:=trealconstnode(left).value_real;
|
|
else
|
|
internalerror(309992);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure setconstrealvalue(r : bestreal);
|
|
begin
|
|
result:=crealconstnode.create(r,pbestrealtype^);
|
|
end;
|
|
|
|
|
|
function handle_ln_const(r : bestreal) : tnode;
|
|
begin
|
|
if r<=0.0 then
|
|
if floating_point_range_check_error then
|
|
begin
|
|
result:=crealconstnode.create(0,pbestrealtype^);
|
|
CGMessage(type_e_wrong_math_argument)
|
|
end
|
|
else
|
|
begin
|
|
if r=0.0 then
|
|
result:=crealconstnode.create(MathNegInf.Value,pbestrealtype^)
|
|
else
|
|
result:=crealconstnode.create(MathQNaN.Value,pbestrealtype^)
|
|
end
|
|
else
|
|
result:=crealconstnode.create(ln(r),pbestrealtype^)
|
|
end;
|
|
|
|
|
|
function handle_sqrt_const(r : bestreal) : tnode;
|
|
begin
|
|
if r<0.0 then
|
|
if floating_point_range_check_error then
|
|
begin
|
|
result:=crealconstnode.create(0,pbestrealtype^);
|
|
CGMessage(type_e_wrong_math_argument)
|
|
end
|
|
else
|
|
result:=crealconstnode.create(MathQNaN.Value,pbestrealtype^)
|
|
else
|
|
result:=crealconstnode.create(sqrt(r),pbestrealtype^)
|
|
end;
|
|
|
|
|
|
function handle_const_sar : tnode;
|
|
var
|
|
vl,vl2 : TConstExprInt;
|
|
bits,shift: integer;
|
|
mask : qword;
|
|
def : tdef;
|
|
begin
|
|
result:=nil;
|
|
if (left.nodetype=ordconstn) or ((left.nodetype=callparan) and (tcallparanode(left).left.nodetype=ordconstn)) then
|
|
begin
|
|
if (left.nodetype=callparan) and
|
|
assigned(tcallparanode(left).right) then
|
|
begin
|
|
vl:=tordconstnode(tcallparanode(left).left).value;
|
|
if forinline then
|
|
case resultdef.size of
|
|
1,2,4:
|
|
vl:=vl and byte($1f);
|
|
8:
|
|
vl:=vl and byte($3f);
|
|
else
|
|
internalerror(2013122303);
|
|
end;
|
|
if (tcallparanode(tcallparanode(left).right).left.nodetype=ordconstn) then
|
|
begin
|
|
def:=tcallparanode(tcallparanode(left).right).left.resultdef;
|
|
vl2:=tordconstnode(tcallparanode(tcallparanode(left).right).left).value;
|
|
end
|
|
else if vl=0 then
|
|
begin
|
|
result:=tcallparanode(tcallparanode(left).right).left;
|
|
tcallparanode(tcallparanode(left).right).left:=nil;
|
|
exit;
|
|
end
|
|
else
|
|
exit;
|
|
end
|
|
else
|
|
begin
|
|
def:=left.resultdef;
|
|
vl:=1;
|
|
vl2:=tordconstnode(left).value;
|
|
end;
|
|
|
|
bits:=def.size*8;
|
|
shift:=vl.svalue and (bits-1);
|
|
case bits of
|
|
8:
|
|
mask:=$ff;
|
|
16:
|
|
mask:=$ffff;
|
|
32:
|
|
mask:=$ffffffff;
|
|
64:
|
|
mask:=qword($ffffffffffffffff);
|
|
else
|
|
mask:=qword(1 shl bits)-1;
|
|
end;
|
|
{$push}
|
|
{$r-,q-}
|
|
if shift=0 then
|
|
result:=cordconstnode.create(vl2.svalue,def,false)
|
|
else if vl2.svalue<0 then
|
|
result:=cordconstnode.create(((vl2.svalue shr shift) or (mask shl (bits-shift))) and mask,def,false)
|
|
else
|
|
result:=cordconstnode.create((vl2.svalue shr shift) and mask,def,false);
|
|
{$pop}
|
|
end
|
|
else if (left.nodetype=callparan) and assigned(tcallparanode(left).right) and
|
|
(tcallparanode(tcallparanode(left).right).left.nodetype=ordconstn) then
|
|
begin
|
|
def:=tcallparanode(tcallparanode(left).right).left.resultdef;
|
|
vl2:=tordconstnode(tcallparanode(tcallparanode(left).right).left).value;
|
|
{ sar(0,x) is 0 }
|
|
{ sar32(ffffffff,x) is ffffffff, etc. }
|
|
if ((vl2=0) or
|
|
((resultdef.size=1) and (shortint(vl2.svalue)=-1)) or
|
|
((resultdef.size=2) and (smallint(vl2.svalue)=-1)) or
|
|
((resultdef.size=4) and (longint(vl2.svalue)=-1)) or
|
|
((resultdef.size=8) and (int64(vl2.svalue)=-1))) and
|
|
((cs_opt_level4 in current_settings.optimizerswitches) or
|
|
not might_have_sideeffects(tcallparanode(left).left)) then
|
|
begin
|
|
if vl2=0 then
|
|
result:=cordconstnode.create(0,resultdef,true)
|
|
else
|
|
result:=cordconstnode.create(-1,resultdef,true);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
function handle_const_rox : tnode;
|
|
var
|
|
vl,vl2 : TConstExprInt;
|
|
bits,shift: integer;
|
|
def : tdef;
|
|
begin
|
|
result:=nil;
|
|
if (left.nodetype=ordconstn) or ((left.nodetype=callparan) and (tcallparanode(left).left.nodetype=ordconstn)) then
|
|
begin
|
|
if (left.nodetype=callparan) and
|
|
assigned(tcallparanode(left).right) then
|
|
begin
|
|
vl:=tordconstnode(tcallparanode(left).left).value;
|
|
if forinline then
|
|
case resultdef.size of
|
|
{ unlike shifts, for rotates, when masking out the higher bits
|
|
of the rotate count, we go all the way down to byte, because
|
|
it doesn't matter, it produces the same result, since it's a rotate }
|
|
1:
|
|
vl:=vl and byte($07);
|
|
2:
|
|
vl:=vl and byte($0f);
|
|
4:
|
|
vl:=vl and byte($1f);
|
|
8:
|
|
vl:=vl and byte($3f);
|
|
else
|
|
internalerror(2013122304);
|
|
end;
|
|
if (tcallparanode(tcallparanode(left).right).left.nodetype=ordconstn) then
|
|
begin
|
|
def:=tcallparanode(tcallparanode(left).right).left.resultdef;
|
|
vl2:=tordconstnode(tcallparanode(tcallparanode(left).right).left).value;
|
|
end
|
|
else if vl=0 then
|
|
begin
|
|
result:=tcallparanode(tcallparanode(left).right).left;
|
|
tcallparanode(tcallparanode(left).right).left:=nil;
|
|
exit;
|
|
end
|
|
else
|
|
exit;
|
|
end
|
|
else
|
|
begin
|
|
def:=left.resultdef;
|
|
vl:=1;
|
|
vl2:=tordconstnode(left).value;
|
|
end;
|
|
|
|
bits:=def.size*8;
|
|
shift:=vl.svalue and (bits-1);
|
|
{$push}
|
|
{$r-,q-}
|
|
if shift=0 then
|
|
result:=cordconstnode.create(vl2.svalue,def,false)
|
|
else
|
|
case inlinenumber of
|
|
in_ror_x,in_ror_x_y:
|
|
case def.size of
|
|
1:
|
|
result:=cordconstnode.create(RorByte(Byte(vl2.svalue),shift),def,false);
|
|
2:
|
|
result:=cordconstnode.create(RorWord(Word(vl2.svalue),shift),def,false);
|
|
4:
|
|
result:=cordconstnode.create(RorDWord(DWord(vl2.svalue),shift),def,false);
|
|
8:
|
|
result:=cordconstnode.create(RorQWord(QWord(vl2.svalue),shift),def,false);
|
|
else
|
|
internalerror(2011061903);
|
|
end;
|
|
in_rol_x,in_rol_x_y:
|
|
case def.size of
|
|
1:
|
|
result:=cordconstnode.create(RolByte(Byte(vl2.svalue),shift),def,false);
|
|
2:
|
|
result:=cordconstnode.create(RolWord(Word(vl2.svalue),shift),def,false);
|
|
4:
|
|
result:=cordconstnode.create(RolDWord(DWord(vl2.svalue),shift),def,false);
|
|
8:
|
|
result:=cordconstnode.create(RolQWord(QWord(vl2.svalue),shift),def,false);
|
|
else
|
|
internalerror(2011061902);
|
|
end;
|
|
else
|
|
internalerror(2011061901);
|
|
end;
|
|
{$pop}
|
|
end
|
|
else if (left.nodetype=callparan) and assigned(tcallparanode(left).right) and
|
|
(tcallparanode(tcallparanode(left).right).left.nodetype=ordconstn) then
|
|
begin
|
|
def:=tcallparanode(tcallparanode(left).right).left.resultdef;
|
|
vl2:=tordconstnode(tcallparanode(tcallparanode(left).right).left).value;
|
|
{ rol/ror are unsigned operations, so cut off upper bits }
|
|
case resultdef.size of
|
|
1:
|
|
vl2:=vl2 and byte($ff);
|
|
2:
|
|
vl2:=vl2 and word($ffff);
|
|
4:
|
|
vl2:=vl2 and dword($ffffffff);
|
|
8:
|
|
vl2:=vl2 and qword($ffffffffffffffff);
|
|
else
|
|
internalerror(2017050101);
|
|
end;
|
|
{ rol(0,x) and ror(0,x) are 0 }
|
|
{ rol32(ffffffff,x) and ror32(ffffffff,x) are ffffffff, etc. }
|
|
if ((vl2=0) or
|
|
((resultdef.size=1) and (vl2=$ff)) or
|
|
((resultdef.size=2) and (vl2=$ffff)) or
|
|
((resultdef.size=4) and (vl2=$ffffffff)) or
|
|
((resultdef.size=8) and (vl2.uvalue=qword($ffffffffffffffff)))) and
|
|
((cs_opt_level4 in current_settings.optimizerswitches) or
|
|
not might_have_sideeffects(tcallparanode(left).left)) then
|
|
result:=cordconstnode.create(vl2,resultdef,true);
|
|
end;
|
|
end;
|
|
|
|
function is_minmax_deterministic(var node: tordconstnode; const DoMax: Boolean; out res: Boolean): Boolean;
|
|
begin
|
|
Result := False;
|
|
if not is_integer(resultdef) then
|
|
InternalError(2024031501);
|
|
|
|
if (node.value <= torddef(resultdef).low) then
|
|
begin
|
|
res := not DoMax;
|
|
Exit(True);
|
|
end
|
|
else if (node.value >= torddef(resultdef).high) then
|
|
begin
|
|
res := DoMax;
|
|
Exit(True);
|
|
end
|
|
end;
|
|
|
|
var
|
|
hp,hp2 : tnode;
|
|
vl,vl2 : TConstExprInt;
|
|
vr : bestreal;
|
|
helperres : Boolean;
|
|
|
|
begin { simplify }
|
|
result:=nil;
|
|
{ handle intern constant functions in separate case }
|
|
if inf_inlineconst in inlinenodeflags then
|
|
begin
|
|
{ no parameters? }
|
|
if not assigned(left) then
|
|
internalerror(200501231)
|
|
else
|
|
begin
|
|
vl:=0;
|
|
vl2:=0; { second parameter Ex: ptr(vl,vl2) }
|
|
case left.nodetype of
|
|
realconstn :
|
|
begin
|
|
{ Real functions are all handled with internproc below }
|
|
CGMessage1(type_e_integer_expr_expected,left.resultdef.typename)
|
|
end;
|
|
ordconstn :
|
|
vl:=tordconstnode(left).value;
|
|
callparan :
|
|
begin
|
|
{ both exists, else it was not generated }
|
|
vl:=tordconstnode(tcallparanode(left).left).value;
|
|
vl2:=tordconstnode(tcallparanode(tcallparanode(left).right).left).value;
|
|
end;
|
|
else
|
|
CGMessage(parser_e_illegal_expression);
|
|
end;
|
|
case inlinenumber of
|
|
in_const_abs :
|
|
if vl.signed then
|
|
hp:=create_simplified_ord_const(abs(vl.svalue),resultdef,forinline,false)
|
|
else
|
|
hp:=create_simplified_ord_const(vl.uvalue,resultdef,forinline,false);
|
|
in_const_sqr:
|
|
if vl.signed then
|
|
hp:=create_simplified_ord_const(sqr(vl.svalue),resultdef,forinline,false)
|
|
else
|
|
hp:=create_simplified_ord_const(sqr(vl.uvalue),resultdef,forinline,false);
|
|
in_const_odd :
|
|
hp:=cordconstnode.create(qword(odd(int64(vl))),pasbool1type,true);
|
|
in_const_swap_word :
|
|
hp:=cordconstnode.create((vl and $ff) shl 8+(vl shr 8),left.resultdef,true);
|
|
in_const_swap_long :
|
|
hp:=cordconstnode.create((vl and $ffff) shl 16+(vl shr 16),left.resultdef,true);
|
|
in_const_swap_qword :
|
|
hp:=cordconstnode.create((vl and $ffffffff) shl 32+(vl shr 32),left.resultdef,true);
|
|
in_const_ptr:
|
|
begin
|
|
{Don't construct pointers from negative values.}
|
|
if (vl.signed and (vl.svalue<0)) or (vl2.signed and (vl2.svalue<0)) then
|
|
cgmessage(parser_e_range_check_error);
|
|
{$if defined(i8086)}
|
|
hp:=cpointerconstnode.create((vl2.uvalue shl 16)+vl.uvalue,voidfarpointertype);
|
|
{$elseif defined(i386)}
|
|
hp:=cpointerconstnode.create((vl2.uvalue shl 4)+vl.uvalue,voidnearfspointertype);
|
|
{$else}
|
|
hp:=cpointerconstnode.create((vl2.uvalue shl 4)+vl.uvalue,voidpointertype);
|
|
{$endif}
|
|
end;
|
|
in_const_eh_return_data_regno:
|
|
begin
|
|
vl:=eh_return_data_regno(vl.svalue);
|
|
if vl=-1 then
|
|
CGMessagePos(left.fileinfo,type_e_range_check_error_bounds);
|
|
hp:=genintconstnode(vl);
|
|
end;
|
|
else
|
|
internalerror(88);
|
|
end;
|
|
end;
|
|
if hp=nil then
|
|
hp:=cerrornode.create;
|
|
result:=hp;
|
|
end
|
|
else
|
|
begin
|
|
case inlinenumber of
|
|
in_lo_long,
|
|
in_hi_long,
|
|
in_lo_qword,
|
|
in_hi_qword,
|
|
in_lo_word,
|
|
in_hi_word :
|
|
begin
|
|
if left.nodetype=ordconstn then
|
|
begin
|
|
case inlinenumber of
|
|
in_lo_word :
|
|
result:=cordconstnode.create(tordconstnode(left).value and $ff,u8inttype,true);
|
|
in_hi_word :
|
|
result:=cordconstnode.create(tordconstnode(left).value shr 8,u8inttype,true);
|
|
in_lo_long :
|
|
result:=cordconstnode.create(tordconstnode(left).value and $ffff,u16inttype,true);
|
|
in_hi_long :
|
|
result:=cordconstnode.create(tordconstnode(left).value shr 16,u16inttype,true);
|
|
in_lo_qword :
|
|
result:=cordconstnode.create(tordconstnode(left).value and $ffffffff,u32inttype,true);
|
|
in_hi_qword :
|
|
result:=cordconstnode.create(tordconstnode(left).value shr 32,u32inttype,true);
|
|
else
|
|
internalerror(2019050514);
|
|
end;
|
|
end;
|
|
end;
|
|
in_ord_x:
|
|
begin
|
|
case left.resultdef.typ of
|
|
orddef :
|
|
begin
|
|
case torddef(left.resultdef).ordtype of
|
|
pasbool1,
|
|
pasbool8,
|
|
uchar:
|
|
begin
|
|
{ change to byte() }
|
|
result:=ctypeconvnode.create_internal(left,u8inttype);
|
|
left:=nil;
|
|
end;
|
|
pasbool16,
|
|
uwidechar :
|
|
begin
|
|
{ change to word() }
|
|
result:=ctypeconvnode.create_internal(left,u16inttype);
|
|
left:=nil;
|
|
end;
|
|
pasbool32 :
|
|
begin
|
|
{ change to dword() }
|
|
result:=ctypeconvnode.create_internal(left,u32inttype);
|
|
left:=nil;
|
|
end;
|
|
pasbool64 :
|
|
begin
|
|
{ change to qword() }
|
|
result:=ctypeconvnode.create_internal(left,u64inttype);
|
|
left:=nil;
|
|
end;
|
|
bool8bit:
|
|
begin
|
|
{ change to shortint() }
|
|
result:=ctypeconvnode.create_internal(left,s8inttype);
|
|
left:=nil;
|
|
end;
|
|
bool16bit :
|
|
begin
|
|
{ change to smallint() }
|
|
result:=ctypeconvnode.create_internal(left,s16inttype);
|
|
left:=nil;
|
|
end;
|
|
bool32bit :
|
|
begin
|
|
{ change to longint() }
|
|
result:=ctypeconvnode.create_internal(left,s32inttype);
|
|
left:=nil;
|
|
end;
|
|
bool64bit :
|
|
begin
|
|
{ change to int64() }
|
|
result:=ctypeconvnode.create_internal(left,s64inttype);
|
|
left:=nil;
|
|
end;
|
|
uvoid :
|
|
CGMessage1(type_e_ordinal_expr_expected,left.resultdef.typename);
|
|
else
|
|
begin
|
|
{ all other orddef need no transformation }
|
|
result:=left;
|
|
left:=nil;
|
|
end;
|
|
end;
|
|
end;
|
|
enumdef :
|
|
begin
|
|
result:=ctypeconvnode.create_internal(left,s32inttype);
|
|
left:=nil;
|
|
end;
|
|
undefineddef :
|
|
begin
|
|
{ we just create a constant 0 here, that's marked as a
|
|
parameter }
|
|
result:=cordconstnode.create(0,s32inttype,false);
|
|
include(result.flags,nf_generic_para);
|
|
left:=nil;
|
|
end;
|
|
pointerdef :
|
|
begin
|
|
if m_mac in current_settings.modeswitches then
|
|
begin
|
|
result:=ctypeconvnode.create_internal(left,ptruinttype);
|
|
left:=nil;
|
|
end
|
|
end;
|
|
else
|
|
internalerror(2019050513);
|
|
end;
|
|
(*
|
|
if (left.nodetype=ordconstn) then
|
|
begin
|
|
result:=cordconstnode.create(
|
|
tordconstnode(left).value,sinttype,true);
|
|
end
|
|
else if (m_mac in current_settings.modeswitches) and
|
|
(left.ndoetype=pointerconstn) then
|
|
result:=cordconstnode.create(
|
|
tpointerconstnode(left).value,ptruinttype,true);
|
|
*)
|
|
end;
|
|
in_chr_byte:
|
|
begin
|
|
{ convert to explicit char() }
|
|
result:=ctypeconvnode.create_internal(left,cansichartype);
|
|
left:=nil;
|
|
end;
|
|
in_length_x:
|
|
begin
|
|
case left.resultdef.typ of
|
|
stringdef :
|
|
begin
|
|
if (left.nodetype=stringconstn) then
|
|
begin
|
|
result:=cordconstnode.create(
|
|
tstringconstnode(left).len,sinttype,true);
|
|
end;
|
|
end;
|
|
orddef :
|
|
begin
|
|
{ length of char is always one }
|
|
if is_char(left.resultdef) or
|
|
is_widechar(left.resultdef) then
|
|
begin
|
|
result:=cordconstnode.create(1,sinttype,false);
|
|
end
|
|
end;
|
|
arraydef :
|
|
begin
|
|
if (left.nodetype=stringconstn) then
|
|
begin
|
|
result:=cordconstnode.create(
|
|
tstringconstnode(left).len,sinttype,true);
|
|
end
|
|
else if not is_open_array(left.resultdef) and
|
|
not is_array_of_const(left.resultdef) and
|
|
not is_dynamic_array(left.resultdef) then
|
|
result:=genintconstnode(tarraydef(left.resultdef).highrange-
|
|
tarraydef(left.resultdef).lowrange+1,sizesinttype);
|
|
end;
|
|
else
|
|
;
|
|
end;
|
|
end;
|
|
in_assigned_x:
|
|
begin
|
|
if is_constnode(tcallparanode(left).left) or
|
|
(tcallparanode(left).left.nodetype = pointerconstn) then
|
|
begin
|
|
{ let an add node figure it out }
|
|
result:=caddnode.create(unequaln,tcallparanode(left).left,cnilnode.create);
|
|
tcallparanode(left).left := nil;
|
|
end;
|
|
end;
|
|
in_pred_x,
|
|
in_succ_x:
|
|
begin
|
|
case left.nodetype of
|
|
ordconstn:
|
|
begin
|
|
if inlinenumber=in_succ_x then
|
|
vl:=tordconstnode(left).value+1
|
|
else
|
|
vl:=tordconstnode(left).value-1;
|
|
if is_integer(left.resultdef) then
|
|
{ the type of the original integer constant is irrelevant,
|
|
it should be automatically adapted to the new value
|
|
(except when inlining) }
|
|
result:=create_simplified_ord_const(vl,resultdef,forinline,cs_check_range in localswitches)
|
|
else
|
|
{ check the range for enums, chars, booleans }
|
|
result:=cordconstnode.create(vl,left.resultdef,not(nf_internal in flags));
|
|
result.flags:=result.flags+(flags*[nf_internal]);
|
|
end;
|
|
addn,
|
|
subn:
|
|
begin
|
|
{ fold succ/pred in child add/sub nodes with a constant if possible:
|
|
- no overflow/range checking
|
|
- equal types
|
|
}
|
|
if ([cs_check_overflow,cs_check_range]*current_settings.localswitches)=[] then
|
|
begin
|
|
if inlinenumber=in_succ_x then
|
|
vl:=1
|
|
else
|
|
vl:=-1;
|
|
if (taddnode(left).left.nodetype=ordconstn) and equal_defs(resultdef,taddnode(left).left.resultdef) then
|
|
begin
|
|
tordconstnode(taddnode(left).left).value:=tordconstnode(taddnode(left).left).value+vl;
|
|
result:=left;
|
|
left:=nil;
|
|
end
|
|
else if (taddnode(left).right.nodetype=ordconstn) and equal_defs(resultdef,taddnode(left).right.resultdef) then
|
|
begin
|
|
if left.nodetype=subn then
|
|
tordconstnode(taddnode(left).right).value:=tordconstnode(taddnode(left).right).value-vl
|
|
else
|
|
tordconstnode(taddnode(left).right).value:=tordconstnode(taddnode(left).right).value+vl;
|
|
result:=left;
|
|
left:=nil;
|
|
end;
|
|
end;
|
|
end;
|
|
else
|
|
;
|
|
end;
|
|
end;
|
|
in_low_x,
|
|
in_high_x:
|
|
begin
|
|
case left.resultdef.typ of
|
|
orddef,
|
|
enumdef:
|
|
begin
|
|
result:=do_lowhigh(left.resultdef);
|
|
end;
|
|
setdef:
|
|
begin
|
|
result:=do_lowhigh(tsetdef(left.resultdef).elementdef);
|
|
end;
|
|
arraydef:
|
|
begin
|
|
if (inlinenumber=in_low_x) then
|
|
begin
|
|
result:=cordconstnode.create(int64(tarraydef(
|
|
left.resultdef).lowrange),tarraydef(left.resultdef).rangedef,true);
|
|
end
|
|
else if not is_open_array(left.resultdef) and
|
|
not is_array_of_const(left.resultdef) and
|
|
not is_dynamic_array(left.resultdef) then
|
|
result:=cordconstnode.create(int64(tarraydef(left.resultdef).highrange),
|
|
tarraydef(left.resultdef).rangedef,true);
|
|
end;
|
|
stringdef:
|
|
begin
|
|
if inlinenumber=in_low_x then
|
|
begin
|
|
if is_dynamicstring(left.resultdef) and
|
|
not(cs_zerobasedstrings in current_settings.localswitches) then
|
|
result:=cordconstnode.create(1,u8inttype,false)
|
|
else
|
|
result:=cordconstnode.create(0,u8inttype,false);
|
|
end
|
|
else if not is_dynamicstring(left.resultdef) then
|
|
result:=cordconstnode.create(tstringdef(left.resultdef).len,u8inttype,true)
|
|
end;
|
|
undefineddef:
|
|
begin
|
|
result:=cordconstnode.create(0,u8inttype,false);
|
|
end;
|
|
errordef:
|
|
;
|
|
else
|
|
internalerror(2019050512);
|
|
end;
|
|
end;
|
|
in_exp_real :
|
|
begin
|
|
if left.nodetype in [ordconstn,realconstn] then
|
|
begin
|
|
result:=crealconstnode.create(exp(getconstrealvalue),pbestrealtype^);
|
|
if (trealconstnode(result).value_real=MathInf.Value) and
|
|
floating_point_range_check_error then
|
|
begin
|
|
result:=crealconstnode.create(0,pbestrealtype^);
|
|
CGMessage(parser_e_range_check_error);
|
|
end;
|
|
end
|
|
end;
|
|
in_trunc_real :
|
|
begin
|
|
if left.nodetype in [ordconstn,realconstn] then
|
|
begin
|
|
vr:=getconstrealvalue;
|
|
if (vr>=9223372036854775807.99) or (vr<=-9223372036854775808.0) then
|
|
begin
|
|
message3(type_e_range_check_error_bounds,realtostr(vr),'-9223372036854775808.0','9223372036854775807.99..');
|
|
result:=cordconstnode.create(1,s64inttype,false)
|
|
end
|
|
else
|
|
result:=cordconstnode.create(trunc(vr),s64inttype,true)
|
|
end
|
|
end;
|
|
in_round_real :
|
|
begin
|
|
{ can't evaluate while inlining, may depend on fpu setting }
|
|
if (not forinline) and
|
|
(left.nodetype in [ordconstn,realconstn]) then
|
|
begin
|
|
vr:=getconstrealvalue;
|
|
if (vr>=9223372036854775807.5) or (vr<=-9223372036854775808.5) then
|
|
begin
|
|
message3(type_e_range_check_error_bounds,realtostr(vr),'-9223372036854775808.49..','9223372036854775807.49..');
|
|
result:=cordconstnode.create(1,s64inttype,false)
|
|
end
|
|
else
|
|
result:=cordconstnode.create(round(vr),s64inttype,true)
|
|
end
|
|
end;
|
|
in_frac_real :
|
|
begin
|
|
if left.nodetype in [ordconstn,realconstn] then
|
|
setconstrealvalue(frac(getconstrealvalue))
|
|
end;
|
|
in_int_real :
|
|
begin
|
|
if left.nodetype in [ordconstn,realconstn] then
|
|
setconstrealvalue(int(getconstrealvalue));
|
|
end;
|
|
in_pi_real :
|
|
begin
|
|
if block_type=bt_const then
|
|
setconstrealvalue(getpi)
|
|
end;
|
|
in_cos_real :
|
|
begin
|
|
if left.nodetype in [ordconstn,realconstn] then
|
|
setconstrealvalue(cos(getconstrealvalue))
|
|
end;
|
|
in_sin_real :
|
|
begin
|
|
if left.nodetype in [ordconstn,realconstn] then
|
|
setconstrealvalue(sin(getconstrealvalue))
|
|
end;
|
|
in_arctan_real :
|
|
begin
|
|
if left.nodetype in [ordconstn,realconstn] then
|
|
setconstrealvalue(arctan(getconstrealvalue))
|
|
end;
|
|
in_abs_real :
|
|
begin
|
|
if left.nodetype in [ordconstn,realconstn] then
|
|
setconstrealvalue(abs(getconstrealvalue))
|
|
end;
|
|
in_abs_long:
|
|
begin
|
|
if left.nodetype=ordconstn then
|
|
begin
|
|
if tordconstnode(left).value<0 then
|
|
result:=cordconstnode.create((-tordconstnode(left).value),resultdef,false)
|
|
else
|
|
result:=cordconstnode.create((tordconstnode(left).value),resultdef,false);
|
|
end
|
|
end;
|
|
in_sqr_real :
|
|
begin
|
|
if left.nodetype in [ordconstn,realconstn] then
|
|
setconstrealvalue(sqr(getconstrealvalue))
|
|
end;
|
|
in_sqrt_real :
|
|
begin
|
|
if left.nodetype in [ordconstn,realconstn] then
|
|
result:=handle_sqrt_const(getconstrealvalue);
|
|
end;
|
|
in_ln_real :
|
|
begin
|
|
if left.nodetype in [ordconstn,realconstn] then
|
|
result:=handle_ln_const(getconstrealvalue);
|
|
end;
|
|
in_assert_x_y :
|
|
begin
|
|
if not(cs_do_assertion in current_settings.localswitches) then
|
|
{ we need a valid node, so insert a nothingn }
|
|
result:=cnothingnode.create;
|
|
end;
|
|
in_sar_x,
|
|
in_sar_x_y :
|
|
begin
|
|
result:=handle_const_sar;
|
|
end;
|
|
in_rol_x,
|
|
in_rol_x_y,
|
|
in_ror_x,
|
|
in_ror_x_y :
|
|
result:=handle_const_rox;
|
|
in_bsf_x:
|
|
begin
|
|
if left.nodetype=ordconstn then
|
|
begin
|
|
case left.resultdef.size of
|
|
1:
|
|
result:=cordconstnode.create(BsfByte(Byte(tordconstnode(left).value.uvalue)),resultdef,false);
|
|
2:
|
|
result:=cordconstnode.create(BsfWord(Word(tordconstnode(left).value.uvalue)),resultdef,false);
|
|
4:
|
|
result:=cordconstnode.create(BsfDWord(DWord(tordconstnode(left).value.uvalue)),resultdef,false);
|
|
8:
|
|
result:=cordconstnode.create(BsfQWord(QWord(tordconstnode(left).value.uvalue)),resultdef,false);
|
|
else
|
|
internalerror(2017042401);
|
|
end;
|
|
end;
|
|
end;
|
|
in_bsr_x :
|
|
begin
|
|
if left.nodetype=ordconstn then
|
|
begin
|
|
case left.resultdef.size of
|
|
1:
|
|
result:=cordconstnode.create(BsrByte(Byte(tordconstnode(left).value.uvalue)),resultdef,false);
|
|
2:
|
|
result:=cordconstnode.create(BsrWord(Word(tordconstnode(left).value.uvalue)),resultdef,false);
|
|
4:
|
|
result:=cordconstnode.create(BsrDWord(DWord(tordconstnode(left).value.uvalue)),resultdef,false);
|
|
8:
|
|
result:=cordconstnode.create(BsrQWord(QWord(tordconstnode(left).value.uvalue)),resultdef,false);
|
|
else
|
|
internalerror(2017042402);
|
|
end;
|
|
end;
|
|
end;
|
|
in_popcnt_x :
|
|
begin
|
|
if left.nodetype=ordconstn then
|
|
begin
|
|
result:=cordconstnode.create(PopCnt(tordconstnode(left).value),resultdef,false);
|
|
end;
|
|
end;
|
|
in_min_single,
|
|
in_min_double:
|
|
begin
|
|
{ Check to see if the result is deterministic }
|
|
if left.nodetype=callparan then
|
|
begin
|
|
hp:=tcallparanode(tcallparanode(left).nextpara).paravalue;
|
|
hp2:=tcallparanode(left).paravalue;
|
|
|
|
if (hp.nodetype=realconstn) then
|
|
begin
|
|
if (trealconstnode(hp).value_real = MathQNaN.value) then
|
|
{ If one of the inputs is NaN, the second parameter
|
|
is taken }
|
|
result:=hp2.getcopy()
|
|
else if (trealconstnode(hp).value_real = MathNegInf.value) then
|
|
{ Nothing is less than than -oo }
|
|
result:=crealconstnode.create(MathNegInf.value,resultdef)
|
|
else if (trealconstnode(hp).value_real = MathInf.value) then
|
|
{ Everything is less than +oo }
|
|
result:=hp2.getcopy()
|
|
else if (hp2.nodetype=realconstn) then
|
|
begin
|
|
{ Both actual parameters are constants, so take
|
|
the smaller of the two right now }
|
|
if (trealconstnode(hp).value_real < trealconstnode(hp2).value_real) then
|
|
result:=crealconstnode.create(trealconstnode(hp).value_real,resultdef)
|
|
else
|
|
result:=crealconstnode.create(trealconstnode(hp2).value_real,resultdef);
|
|
end;
|
|
end
|
|
else if (hp2.nodetype=realconstn) then
|
|
begin
|
|
if (trealconstnode(hp2).value_real = MathQNaN.value) then
|
|
{ If one of the inputs is NaN, the second parameter
|
|
is taken (even if it is NaN) }
|
|
result:=crealconstnode.create(MathQNaN.value,resultdef)
|
|
else if (trealconstnode(hp2).value_real = MathNegInf.value) then
|
|
{ Nothing is less than than -oo }
|
|
result:=crealconstnode.create(MathNegInf.value,resultdef)
|
|
else if (trealconstnode(hp2).value_real = MathInf.value) then
|
|
{ Everything is less than +oo }
|
|
result:=hp.getcopy();
|
|
end;
|
|
end;
|
|
end;
|
|
in_max_single,
|
|
in_max_double:
|
|
begin
|
|
{ Check to see if the result is deterministic }
|
|
if left.nodetype=callparan then
|
|
begin
|
|
hp:=tcallparanode(tcallparanode(left).nextpara).paravalue;
|
|
hp2:=tcallparanode(left).paravalue;
|
|
|
|
if (hp.nodetype=realconstn) then
|
|
begin
|
|
if (trealconstnode(hp).value_real = MathQNaN.value) then
|
|
{ If one of the inputs is NaN, the second parameter
|
|
is taken }
|
|
result:=hp2.getcopy()
|
|
else if (trealconstnode(hp).value_real = MathNegInf.value) then
|
|
{ Everything is greater than than -oo }
|
|
result:=hp2.getcopy()
|
|
else if (trealconstnode(hp).value_real = MathInf.value) then
|
|
{ Nothing is greater than +oo }
|
|
result:=crealconstnode.create(MathInf.value,resultdef)
|
|
else if (hp2.nodetype=realconstn) then
|
|
begin
|
|
{ Both actual parameters are constants, so take
|
|
the larger of the two right now }
|
|
if (trealconstnode(hp).value_real > trealconstnode(hp2).value_real) then
|
|
result:=crealconstnode.create(trealconstnode(hp).value_real,resultdef)
|
|
else
|
|
result:=crealconstnode.create(trealconstnode(hp2).value_real,resultdef)
|
|
end;
|
|
end
|
|
else if (hp2.nodetype=realconstn) then
|
|
begin
|
|
if (trealconstnode(hp2).value_real = MathQNaN.value) then
|
|
{ If one of the inputs is NaN, the second parameter
|
|
is taken (even if it is NaN) }
|
|
result:=crealconstnode.create(MathQNaN.value,resultdef)
|
|
else if (trealconstnode(hp2).value_real = MathNegInf.value) then
|
|
{ Everything is greater than than -oo }
|
|
result:=hp.getcopy()
|
|
else if (trealconstnode(hp2).value_real = MathInf.value) then
|
|
{ Nothing is greater than +oo }
|
|
result:=crealconstnode.create(MathInf.value,resultdef);
|
|
end;
|
|
end;
|
|
end;
|
|
in_min_longint,
|
|
in_min_int64:
|
|
begin
|
|
if left.nodetype=callparan then
|
|
begin
|
|
{ Check to see if the result is deterministic }
|
|
hp:=tcallparanode(tcallparanode(left).nextpara).paravalue;
|
|
hp2:=tcallparanode(left).paravalue;
|
|
|
|
if (hp.nodetype=ordconstn) then
|
|
begin
|
|
if (hp2.nodetype=ordconstn) then
|
|
begin
|
|
{ Both actual parameters are constants, so take
|
|
the smaller of the two right now }
|
|
if inlinenumber=in_min_longint then
|
|
result:=cordconstnode.create(min(LongInt(tordconstnode(hp).value.svalue),LongInt(tordconstnode(hp2).value.svalue)),resultdef,false)
|
|
else
|
|
result:=cordconstnode.create(min(tordconstnode(hp).value,tordconstnode(hp2).value),resultdef,false);
|
|
end;
|
|
|
|
if is_minmax_deterministic(tordconstnode(hp), False, helperres) then
|
|
begin
|
|
if helperres then
|
|
result:=cordconstnode.create(tordconstnode(hp).value,resultdef,false)
|
|
else
|
|
result:=hp2.getcopy();
|
|
end;
|
|
end
|
|
else if (hp2.nodetype=ordconstn) then
|
|
begin
|
|
if is_minmax_deterministic(tordconstnode(hp2), False, helperres) then
|
|
begin
|
|
if helperres then
|
|
result:=cordconstnode.create(tordconstnode(hp2).value,resultdef,false)
|
|
else
|
|
result:=hp.getcopy();
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
in_max_longint,
|
|
in_max_int64:
|
|
begin
|
|
if left.nodetype=callparan then
|
|
begin
|
|
{ Check to see if the result is deterministic }
|
|
hp:=tcallparanode(left).paravalue;
|
|
hp2:=tcallparanode(tcallparanode(left).nextpara).paravalue;
|
|
|
|
if (hp.nodetype=ordconstn) then
|
|
begin
|
|
if (hp2.nodetype=ordconstn) then
|
|
begin
|
|
{ Both actual parameters are constants, so take
|
|
the larger of the two right now }
|
|
if inlinenumber=in_max_longint then
|
|
result:=cordconstnode.create(max(LongInt(tordconstnode(hp).value.svalue),LongInt(tordconstnode(hp2).value.svalue)),resultdef,false)
|
|
else
|
|
result:=cordconstnode.create(max(tordconstnode(hp).value,tordconstnode(hp2).value),resultdef,false);
|
|
end;
|
|
|
|
if is_minmax_deterministic(tordconstnode(hp), True, helperres) then
|
|
begin
|
|
if helperres then
|
|
result:=cordconstnode.create(tordconstnode(hp).value,resultdef,false)
|
|
else
|
|
result:=hp2.getcopy();
|
|
end;
|
|
end
|
|
else if (hp2.nodetype=ordconstn) then
|
|
begin
|
|
if is_minmax_deterministic(tordconstnode(hp2), True, helperres) then
|
|
begin
|
|
if helperres then
|
|
result:=cordconstnode.create(tordconstnode(hp2).value,resultdef,false)
|
|
else
|
|
result:=hp.getcopy();
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
in_min_dword,
|
|
in_min_qword:
|
|
begin
|
|
if left.nodetype=callparan then
|
|
begin
|
|
{ Check to see if the result is deterministic }
|
|
hp:=tcallparanode(tcallparanode(left).nextpara).paravalue;
|
|
hp2:=tcallparanode(left).paravalue;
|
|
|
|
if (hp.nodetype=ordconstn) then
|
|
begin
|
|
if (hp2.nodetype=ordconstn) then
|
|
begin
|
|
{ Both actual parameters are constants, so take
|
|
the smaller of the two right now }
|
|
if inlinenumber=in_min_dword then
|
|
result:=cordconstnode.create(min(DWord(tordconstnode(hp).value.uvalue),DWord(tordconstnode(hp2).value.uvalue)),resultdef,false)
|
|
else
|
|
result:=cordconstnode.create(min(tordconstnode(hp).value,tordconstnode(hp2).value),resultdef,false);
|
|
end;
|
|
|
|
if is_minmax_deterministic(tordconstnode(hp), False, helperres) then
|
|
begin
|
|
if helperres then
|
|
result:=cordconstnode.create(tordconstnode(hp).value,resultdef,false)
|
|
else
|
|
result:=hp2.getcopy();
|
|
end;
|
|
end
|
|
else if (hp2.nodetype=ordconstn) then
|
|
begin
|
|
if is_minmax_deterministic(tordconstnode(hp2), False, helperres) then
|
|
begin
|
|
if helperres then
|
|
result:=cordconstnode.create(tordconstnode(hp2).value,resultdef,false)
|
|
else
|
|
result:=hp.getcopy();
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
in_max_dword,
|
|
in_max_qword:
|
|
begin
|
|
if left.nodetype=callparan then
|
|
begin
|
|
{ Check to see if the result is deterministic }
|
|
hp:=tcallparanode(left).paravalue;
|
|
hp2:=tcallparanode(tcallparanode(left).nextpara).paravalue;
|
|
|
|
if (hp.nodetype=ordconstn) then
|
|
begin
|
|
if (hp2.nodetype=ordconstn) then
|
|
begin
|
|
{ Both actual parameters are constants, so take
|
|
the larger of the two right now }
|
|
if inlinenumber=in_max_dword then
|
|
result:=cordconstnode.create(max(DWord(tordconstnode(hp).value.uvalue),DWord(tordconstnode(hp2).value.uvalue)),resultdef,false)
|
|
else
|
|
result:=cordconstnode.create(max(tordconstnode(hp).value,tordconstnode(hp2).value),resultdef,false);
|
|
end;
|
|
|
|
if is_minmax_deterministic(tordconstnode(hp), True, helperres) then
|
|
begin
|
|
if helperres then
|
|
result:=cordconstnode.create(tordconstnode(hp).value,resultdef,false)
|
|
else
|
|
result:=hp2.getcopy();
|
|
end;
|
|
end
|
|
else if (hp2.nodetype=ordconstn) then
|
|
begin
|
|
if is_minmax_deterministic(tordconstnode(hp2), True, helperres) then
|
|
begin
|
|
if helperres then
|
|
result:=cordconstnode.create(tordconstnode(hp2).value,resultdef,false)
|
|
else
|
|
result:=hp.getcopy();
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
else
|
|
;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
function tinlinenode.pass_typecheck:tnode;
|
|
|
|
type
|
|
tfloattypeset = set of tfloattype;
|
|
|
|
function removefloatupcasts(var p: tnode; const floattypes: tfloattypeset): tdef;
|
|
var
|
|
hnode: tnode;
|
|
begin
|
|
{ System unit declares internal functions like this:
|
|
function foo(x: valreal): valreal; [internproc: number];
|
|
Calls to such functions are initially processed by callnode,
|
|
which typechecks the arguments, possibly inserting conversion to valreal.
|
|
To handle smaller types without excess precision, we need to remove
|
|
these extra typecasts. }
|
|
if not(cs_excessprecision in current_settings.localswitches) and
|
|
(p.nodetype=typeconvn) and
|
|
(ttypeconvnode(p).left.resultdef.typ=floatdef) and
|
|
(p.flags*[nf_explicit,nf_internal]=[]) and
|
|
(tfloatdef(ttypeconvnode(p).left.resultdef).floattype in (floattypes*[s32real,s64real,s80real,sc80real,s128real])) then
|
|
begin
|
|
hnode:=ttypeconvnode(p).left;
|
|
ttypeconvnode(p).left:=nil;
|
|
p.free;
|
|
p:=hnode;
|
|
result:=p.resultdef;
|
|
end
|
|
else if (p.nodetype=typeconvn) and
|
|
(p.flags*[nf_explicit,nf_internal]=[]) and
|
|
(ttypeconvnode(p).left.resultdef.typ=floatdef) and
|
|
(tfloatdef(ttypeconvnode(p).left.resultdef).floattype in (floattypes*[s64currency,s64comp])) then
|
|
begin
|
|
hnode:=ttypeconvnode(p).left;
|
|
ttypeconvnode(p).left:=nil;
|
|
p.free;
|
|
p:=hnode;
|
|
if is_currency(p.resultdef) then
|
|
begin
|
|
if (nf_is_currency in p.flags) and
|
|
(p.nodetype=slashn) and
|
|
(taddnode(p).right.nodetype=realconstn) and
|
|
(trealconstnode(taddnode(p).right).value_real=10000.0) and
|
|
not(nf_is_currency in taddnode(p).left.flags) then
|
|
begin
|
|
hnode:=taddnode(p).left;
|
|
taddnode(p).left:=nil;
|
|
p.free;
|
|
p:=hnode;
|
|
end;
|
|
end;
|
|
result:=p.resultdef;
|
|
end
|
|
{ in case the system helper was declared with overloads for different types,
|
|
keep those }
|
|
else if (p.resultdef.typ=floatdef) and
|
|
(tfloatdef(p.resultdef).floattype in (floattypes*[s32real,s64real,s80real,sc80real,s128real])) then
|
|
result:=p.resultdef
|
|
else
|
|
begin
|
|
{ for variant parameters; the rest has been converted by the
|
|
call node already }
|
|
if not(p.nodetype in [ordconstn,realconstn]) then
|
|
inserttypeconv(P,pbestrealtype^);
|
|
result:=p.resultdef
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure handle_pack_unpack;
|
|
var
|
|
source, target, index: tcallparanode;
|
|
unpackedarraydef, packedarraydef: tarraydef;
|
|
tempindex: TConstExprInt;
|
|
begin
|
|
resultdef:=voidtype;
|
|
|
|
unpackedarraydef := nil;
|
|
packedarraydef := nil;
|
|
source := tcallparanode(left);
|
|
if (inlinenumber = in_unpack_x_y_z) then
|
|
begin
|
|
target := tcallparanode(source.right);
|
|
index := tcallparanode(target.right);
|
|
|
|
{ source must be a packed array }
|
|
if not is_packed_array(source.left.resultdef) then
|
|
CGMessagePos2(source.left.fileinfo,type_e_got_expected_packed_array,'1',source.left.resultdef.typename)
|
|
else
|
|
packedarraydef := tarraydef(source.left.resultdef);
|
|
{ target can be any kind of array, as long as it's not packed }
|
|
if (target.left.resultdef.typ <> arraydef) or
|
|
is_packed_array(target.left.resultdef) then
|
|
CGMessagePos2(target.left.fileinfo,type_e_got_expected_unpacked_array,'2',target.left.resultdef.typename)
|
|
else
|
|
unpackedarraydef := tarraydef(target.left.resultdef);
|
|
end
|
|
else
|
|
begin
|
|
index := tcallparanode(source.right);
|
|
target := tcallparanode(index.right);
|
|
|
|
{ source can be any kind of array, as long as it's not packed }
|
|
if (source.left.resultdef.typ <> arraydef) or
|
|
is_packed_array(source.left.resultdef) then
|
|
CGMessagePos2(source.left.fileinfo,type_e_got_expected_unpacked_array,'1',source.left.resultdef.typename)
|
|
else
|
|
unpackedarraydef := tarraydef(source.left.resultdef);
|
|
{ target must be a packed array }
|
|
if not is_packed_array(target.left.resultdef) then
|
|
CGMessagePos2(target.left.fileinfo,type_e_got_expected_packed_array,'3',target.left.resultdef.typename)
|
|
else
|
|
packedarraydef := tarraydef(target.left.resultdef);
|
|
end;
|
|
|
|
if assigned(unpackedarraydef) then
|
|
begin
|
|
{ index must be compatible with the unpacked array's indextype }
|
|
inserttypeconv(index.left,unpackedarraydef.rangedef);
|
|
|
|
{ range check at compile time if possible }
|
|
if assigned(packedarraydef) and
|
|
(index.left.nodetype = ordconstn) and
|
|
not is_special_array(unpackedarraydef) then
|
|
begin
|
|
adaptrange(unpackedarraydef,tordconstnode(index.left).value,false,false,cs_check_range in current_settings.localswitches);
|
|
tempindex := tordconstnode(index.left).value + packedarraydef.highrange-packedarraydef.lowrange;
|
|
adaptrange(unpackedarraydef,tempindex,false,false,cs_check_range in current_settings.localswitches);
|
|
end;
|
|
end;
|
|
|
|
{ source array is read and must be valid }
|
|
set_varstate(source.left,vs_read,[vsf_must_be_valid]);
|
|
{ target array is written }
|
|
valid_for_assignment(target.left,true);
|
|
set_varstate(target.left,vs_written,[]);
|
|
{ index in the unpacked array is read and must be valid }
|
|
set_varstate(index.left,vs_read,[vsf_must_be_valid]);
|
|
{ if the size of the arrays is 0 (array of empty records), }
|
|
{ do nothing }
|
|
if (source.resultdef.size = 0) then
|
|
result:=cnothingnode.create;
|
|
end;
|
|
|
|
|
|
function handle_objc_encode: tnode;
|
|
var
|
|
encodedtype: ansistring;
|
|
errordef: tdef;
|
|
begin
|
|
encodedtype:='';
|
|
if not objctryencodetype(left.resultdef,encodedtype,errordef) then
|
|
Message1(type_e_objc_type_unsupported,errordef.typename);
|
|
result:=cstringconstnode.createpchar(ansistring2pchar(encodedtype),length(encodedtype),nil);
|
|
end;
|
|
|
|
var
|
|
hightree,
|
|
hp : tnode;
|
|
temp_pnode: pnode;
|
|
begin
|
|
result:=nil;
|
|
{ when handling writeln "left" contains no valid address }
|
|
if assigned(left) then
|
|
begin
|
|
if left.nodetype=callparan then
|
|
tcallparanode(left).get_paratype
|
|
else
|
|
typecheckpass(left);
|
|
end;
|
|
|
|
if not(inf_inlineconst in inlinenodeflags) then
|
|
begin
|
|
case inlinenumber of
|
|
in_lo_long,
|
|
in_hi_long,
|
|
in_lo_qword,
|
|
in_hi_qword,
|
|
in_lo_word,
|
|
in_hi_word :
|
|
begin
|
|
{ give warning for incompatibility with tp and delphi }
|
|
if (inlinenumber in [in_lo_long,in_hi_long,in_lo_qword,in_hi_qword]) and
|
|
((m_tp7 in current_settings.modeswitches) or
|
|
(m_delphi in current_settings.modeswitches)) then
|
|
CGMessage(type_w_maybe_wrong_hi_lo);
|
|
set_varstate(left,vs_read,[vsf_must_be_valid]);
|
|
if not is_integer(left.resultdef) then
|
|
CGMessage1(type_e_integer_expr_expected,left.resultdef.typename);
|
|
case inlinenumber of
|
|
in_lo_word,
|
|
in_hi_word :
|
|
resultdef:=u8inttype;
|
|
in_lo_long,
|
|
in_hi_long :
|
|
resultdef:=u16inttype;
|
|
in_lo_qword,
|
|
in_hi_qword :
|
|
resultdef:=u32inttype;
|
|
else
|
|
;
|
|
end;
|
|
end;
|
|
|
|
in_sizeof_x:
|
|
begin
|
|
{ the constant evaluation of in_sizeof_x happens in pexpr where possible,
|
|
though for generics it can reach here as well }
|
|
set_varstate(left,vs_read,[]);
|
|
if (left.resultdef.typ<>undefineddef) and
|
|
assigned(current_procinfo) and
|
|
paramanager.push_high_param(vs_value,left.resultdef,current_procinfo.procdef.proccalloption) then
|
|
begin
|
|
{ this should be an open array or array of const, both of
|
|
which can only be simple load nodes of parameters }
|
|
if left.nodetype<>loadn then
|
|
internalerror(2014120701);
|
|
hightree:=load_high_value_node(tparavarsym(tloadnode(left).symtableentry));
|
|
if assigned(hightree) then
|
|
begin
|
|
hp:=caddnode.create(addn,hightree,
|
|
cordconstnode.create(1,sizesinttype,false));
|
|
if (left.resultdef.typ=arraydef) then
|
|
if not is_packed_array(tarraydef(left.resultdef)) then
|
|
begin
|
|
if (tarraydef(left.resultdef).elesize<>1) then
|
|
hp:=caddnode.create(muln,hp,cordconstnode.create(tarraydef(
|
|
left.resultdef).elesize,sizesinttype,true));
|
|
end
|
|
else if (tarraydef(left.resultdef).elepackedbitsize <> 8) then
|
|
begin
|
|
{ no packed open array support yet }
|
|
if (hp.nodetype <> ordconstn) then
|
|
internalerror(2006081511);
|
|
hp.free;
|
|
hp := cordconstnode.create(left.resultdef.size,sizesinttype,true);
|
|
{
|
|
hp:=
|
|
ctypeconvnode.create_explicit(sizesinttype,
|
|
cmoddivnode.create(divn,
|
|
caddnode.create(addn,
|
|
caddnode.create(muln,hp,cordconstnode.create(tarraydef(
|
|
left.resultdef).elepackedbitsize,s64inttype,true)),
|
|
cordconstnode.create(a,s64inttype,true)),
|
|
cordconstnode.create(8,s64inttype,true)),
|
|
sizesinttype);
|
|
}
|
|
end;
|
|
result:=hp;
|
|
end;
|
|
end
|
|
else
|
|
resultdef:=sizesinttype;
|
|
end;
|
|
|
|
in_typeof_x:
|
|
begin
|
|
if target_info.system in systems_managed_vm then
|
|
message(parser_e_feature_unsupported_for_vm);
|
|
typecheckpass(left);
|
|
set_varstate(left,vs_read,[]);
|
|
if (left.resultdef.typ=objectdef) and
|
|
not(oo_has_vmt in tobjectdef(left.resultdef).objectoptions) then
|
|
message(type_e_typeof_requires_vmt);
|
|
resultdef:=voidpointertype;
|
|
end;
|
|
|
|
in_ord_x:
|
|
begin
|
|
set_varstate(left,vs_read,[vsf_must_be_valid]);
|
|
case left.resultdef.typ of
|
|
orddef,
|
|
enumdef,
|
|
undefineddef :
|
|
;
|
|
pointerdef :
|
|
begin
|
|
if not(m_mac in current_settings.modeswitches) then
|
|
CGMessage1(type_e_ordinal_expr_expected,left.resultdef.typename);
|
|
end
|
|
else
|
|
CGMessage1(type_e_ordinal_expr_expected,left.resultdef.typename);
|
|
end;
|
|
end;
|
|
|
|
in_chr_byte:
|
|
begin
|
|
set_varstate(left,vs_read,[vsf_must_be_valid]);
|
|
end;
|
|
|
|
in_length_x:
|
|
begin
|
|
if ((left.resultdef.typ=arraydef) and
|
|
(not is_special_array(left.resultdef) or
|
|
is_open_array(left.resultdef))) or
|
|
(left.resultdef.typ=orddef) then
|
|
set_varstate(left,vs_read,[])
|
|
else
|
|
set_varstate(left,vs_read,[vsf_must_be_valid]);
|
|
|
|
case left.resultdef.typ of
|
|
variantdef:
|
|
begin
|
|
inserttypeconv(left,getansistringdef);
|
|
end;
|
|
|
|
stringdef :
|
|
begin
|
|
{ we don't need string convertions here, }
|
|
{ except if from widestring to ansistring }
|
|
{ and vice versa (that can change the }
|
|
{ length) }
|
|
if (left.nodetype=typeconvn) and
|
|
(ttypeconvnode(left).left.resultdef.typ=stringdef) and
|
|
not(is_wide_or_unicode_string(left.resultdef) xor
|
|
is_wide_or_unicode_string(ttypeconvnode(left).left.resultdef)) then
|
|
begin
|
|
hp:=ttypeconvnode(left).left;
|
|
ttypeconvnode(left).left:=nil;
|
|
left.free;
|
|
left:=hp;
|
|
end;
|
|
end;
|
|
orddef :
|
|
begin
|
|
{ will be handled in simplify }
|
|
if not is_char(left.resultdef) and
|
|
not is_widechar(left.resultdef) then
|
|
CGMessage(type_e_mismatch);
|
|
end;
|
|
pointerdef :
|
|
begin
|
|
if is_pchar(left.resultdef) then
|
|
begin
|
|
hp := ccallparanode.create(left,nil);
|
|
result := ccallnode.createintern('fpc_pchar_length',hp);
|
|
{ make sure the left node doesn't get disposed, since it's }
|
|
{ reused in the new node (JM) }
|
|
left:=nil;
|
|
exit;
|
|
end
|
|
else if is_pwidechar(left.resultdef) then
|
|
begin
|
|
hp := ccallparanode.create(left,nil);
|
|
result := ccallnode.createintern('fpc_pwidechar_length',hp);
|
|
{ make sure the left node doesn't get disposed, since it's }
|
|
{ reused in the new node (JM) }
|
|
left:=nil;
|
|
exit;
|
|
end
|
|
else
|
|
CGMessage(type_e_mismatch);
|
|
end;
|
|
arraydef :
|
|
begin
|
|
if is_open_array(left.resultdef) or
|
|
is_array_of_const(left.resultdef) then
|
|
begin
|
|
hightree:=load_high_value_node(tparavarsym(tloadnode(left).symtableentry));
|
|
if assigned(hightree) then
|
|
result:=caddnode.create(addn,hightree,
|
|
cordconstnode.create(1,sinttype,false));
|
|
exit;
|
|
end
|
|
{ Length() for dynamic arrays is inlined }
|
|
else
|
|
begin
|
|
{ will be handled in simplify }
|
|
end;
|
|
end;
|
|
undefineddef :
|
|
begin
|
|
if not (df_generic in current_procinfo.procdef.defoptions) then
|
|
CGMessage(type_e_mismatch);
|
|
{ otherwise nothing }
|
|
end;
|
|
else
|
|
CGMessage(type_e_mismatch);
|
|
end;
|
|
|
|
{ shortstring return an 8 bit value as the length
|
|
is the first byte of the string }
|
|
if is_shortstring(left.resultdef) then
|
|
resultdef:=u8inttype
|
|
else
|
|
resultdef:=sizesinttype;
|
|
end;
|
|
|
|
in_typeinfo_x:
|
|
begin
|
|
if target_info.system in systems_managed_vm then
|
|
message(parser_e_feature_unsupported_for_vm);
|
|
if (left.resultdef.typ=enumdef) and
|
|
(tenumdef(left.resultdef).has_jumps) and
|
|
(
|
|
(left.nodetype<>typen) or
|
|
not (sp_generic_para in ttypenode(left).typesym.symoptions)
|
|
) then
|
|
CGMessage(type_e_no_type_info);
|
|
set_varstate(left,vs_read,[vsf_must_be_valid]);
|
|
resultdef:=voidpointertype;
|
|
end;
|
|
|
|
in_gettypekind_x:
|
|
begin
|
|
if target_info.system in systems_managed_vm then
|
|
message(parser_e_feature_unsupported_for_vm);
|
|
set_varstate(left,vs_read,[vsf_must_be_valid]);
|
|
resultdef:=typekindtype;
|
|
end;
|
|
|
|
in_ismanagedtype_x:
|
|
begin
|
|
if target_info.system in systems_managed_vm then
|
|
message(parser_e_feature_unsupported_for_vm);
|
|
set_varstate(left,vs_read,[vsf_must_be_valid]);
|
|
resultdef:=pasbool1type;
|
|
end;
|
|
|
|
in_isconstvalue_x:
|
|
begin
|
|
set_varstate(left,vs_read,[vsf_must_be_valid]);
|
|
resultdef:=pasbool1type;
|
|
end;
|
|
|
|
in_assigned_x:
|
|
begin
|
|
{ the parser has already made sure the expression is valid }
|
|
|
|
{ in case of a complex procvar, only check the "code" pointer }
|
|
if (tcallparanode(left).left.resultdef.typ=procvardef) and
|
|
not tprocvardef(tcallparanode(left).left.resultdef).is_addressonly then
|
|
begin
|
|
inserttypeconv_explicit(tcallparanode(left).left,search_system_type('TMETHOD').typedef);
|
|
tcallparanode(left).left:=csubscriptnode.create(tsym(tabstractrecorddef(tcallparanode(left).left.resultdef).symtable.find('CODE')),tcallparanode(left).left);
|
|
tcallparanode(left).get_paratype;
|
|
end;
|
|
|
|
{ Postpone conversion into addnode until firstpass, so targets
|
|
may override first_assigned and insert specific code. }
|
|
set_varstate(tcallparanode(left).left,vs_read,[vsf_must_be_valid]);
|
|
resultdef:=pasbool1type;
|
|
end;
|
|
|
|
in_ofs_x :
|
|
internalerror(2000101001);
|
|
|
|
in_seg_x :
|
|
begin
|
|
result := typecheck_seg;
|
|
end;
|
|
|
|
in_pred_x,
|
|
in_succ_x:
|
|
begin
|
|
set_varstate(left,vs_read,[vsf_must_be_valid]);
|
|
resultdef:=left.resultdef;
|
|
if is_ordinal(resultdef) or is_typeparam(resultdef) then
|
|
begin
|
|
if (resultdef.typ=enumdef) and
|
|
(tenumdef(resultdef).has_jumps) and
|
|
not(m_delphi in current_settings.modeswitches) and
|
|
not(nf_internal in flags) then
|
|
CGMessage(type_e_succ_and_pred_enums_with_assign_not_possible);
|
|
end
|
|
else
|
|
CGMessage(type_e_ordinal_expr_expected)
|
|
end;
|
|
|
|
in_copy_x:
|
|
result:=handle_copy;
|
|
|
|
in_initialize_x,
|
|
in_finalize_x:
|
|
begin
|
|
{ inlined from pinline }
|
|
internalerror(200204231);
|
|
end;
|
|
in_setlength_x:
|
|
begin
|
|
result:=handle_setlength;
|
|
end;
|
|
in_inc_x,
|
|
in_dec_x:
|
|
begin
|
|
resultdef:=voidtype;
|
|
if not(df_generic in current_procinfo.procdef.defoptions) then
|
|
begin
|
|
if assigned(left) then
|
|
begin
|
|
{ first param must be var }
|
|
valid_for_var(tcallparanode(left).left,true);
|
|
set_varstate(tcallparanode(left).left,vs_readwritten,[vsf_must_be_valid]);
|
|
|
|
if (left.resultdef.typ in [enumdef,pointerdef]) or
|
|
is_ordinal(left.resultdef) or
|
|
is_currency(left.resultdef) then
|
|
begin
|
|
{ value of left gets changed -> must be unique }
|
|
set_unique(tcallparanode(left).left);
|
|
{ two paras ? }
|
|
if assigned(tcallparanode(left).right) then
|
|
begin
|
|
if is_integer(tcallparanode(left).right.resultdef) then
|
|
begin
|
|
set_varstate(tcallparanode(tcallparanode(left).right).left,vs_read,[vsf_must_be_valid]);
|
|
{ when range/overflow checking is on, we
|
|
convert this to a regular add, and for proper
|
|
checking we need the original type }
|
|
if ([cs_check_range,cs_check_overflow]*current_settings.localswitches=[]) then
|
|
if (tcallparanode(left).left.resultdef.typ=pointerdef) then
|
|
begin
|
|
{ don't convert values added to pointers into the pointer types themselves,
|
|
because that will turn signed values into unsigned ones, which then
|
|
goes wrong when they have to be multiplied with the size of the elements
|
|
to which the pointer points in ncginl (mantis #17342) }
|
|
if is_signed(tcallparanode(tcallparanode(left).right).left.resultdef) then
|
|
inserttypeconv(tcallparanode(tcallparanode(left).right).left,tpointerdef(tcallparanode(left).left.resultdef).pointer_arithmetic_int_type)
|
|
else
|
|
inserttypeconv(tcallparanode(tcallparanode(left).right).left,tpointerdef(tcallparanode(left).left.resultdef).pointer_arithmetic_uint_type)
|
|
end
|
|
else if is_integer(tcallparanode(left).left.resultdef) then
|
|
inserttypeconv(tcallparanode(tcallparanode(left).right).left,tcallparanode(left).left.resultdef)
|
|
else
|
|
inserttypeconv_internal(tcallparanode(tcallparanode(left).right).left,tcallparanode(left).left.resultdef);
|
|
if assigned(tcallparanode(tcallparanode(left).right).right) then
|
|
{ should be handled in the parser (JM) }
|
|
internalerror(2006020901);
|
|
end
|
|
else
|
|
CGMessagePos(tcallparanode(left).right.fileinfo,type_e_ordinal_expr_expected);
|
|
end;
|
|
end
|
|
{ generic type parameter? }
|
|
else if is_typeparam(left.resultdef) then
|
|
begin
|
|
result:=cnothingnode.create;
|
|
exit;
|
|
end
|
|
else
|
|
begin
|
|
hp:=self;
|
|
if isunaryoverloaded(hp,[]) then
|
|
begin
|
|
{ inc(rec) and dec(rec) assigns result value to argument }
|
|
result:=cassignmentnode.create(tcallparanode(left).left.getcopy,hp);
|
|
exit;
|
|
end
|
|
else
|
|
CGMessagePos(left.fileinfo,type_e_ordinal_expr_expected);
|
|
end;
|
|
end
|
|
else
|
|
CGMessagePos(fileinfo,type_e_mismatch);
|
|
end;
|
|
end;
|
|
|
|
in_and_assign_x_y,
|
|
in_or_assign_x_y,
|
|
in_xor_assign_x_y,
|
|
in_sar_assign_x_y,
|
|
in_shl_assign_x_y,
|
|
in_shr_assign_x_y,
|
|
in_rol_assign_x_y,
|
|
in_ror_assign_x_y:
|
|
begin
|
|
resultdef:=voidtype;
|
|
if not(df_generic in current_procinfo.procdef.defoptions) then
|
|
begin
|
|
{ first parameter must exist }
|
|
if not assigned(left) or (left.nodetype<>callparan) then
|
|
internalerror(2017032501);
|
|
{ second parameter must exist }
|
|
if not assigned(tcallparanode(left).right) or (tcallparanode(left).right.nodetype<>callparan) then
|
|
internalerror(2017032502);
|
|
{ third parameter must NOT exist }
|
|
if assigned(tcallparanode(tcallparanode(left).right).right) then
|
|
internalerror(2017032503);
|
|
|
|
valid_for_var(tcallparanode(tcallparanode(left).right).left,true);
|
|
set_varstate(tcallparanode(tcallparanode(left).right).left,vs_readwritten,[vsf_must_be_valid]);
|
|
|
|
if is_integer(tcallparanode(left).right.resultdef) then
|
|
begin
|
|
{ value of right gets changed -> must be unique }
|
|
set_unique(tcallparanode(tcallparanode(left).right).left);
|
|
if is_integer(left.resultdef) then
|
|
begin
|
|
set_varstate(tcallparanode(left).left,vs_read,[vsf_must_be_valid]);
|
|
{ these nodes shouldn't be created, when range checking is on }
|
|
if [cs_check_range,cs_check_overflow]*localswitches<>[] then
|
|
internalerror(2017032701);
|
|
if inlinenumber in [in_sar_assign_x_y,in_shl_assign_x_y,in_shr_assign_x_y,in_rol_assign_x_y,in_ror_assign_x_y] then
|
|
inserttypeconv(tcallparanode(left).left,sinttype)
|
|
else
|
|
inserttypeconv(tcallparanode(left).left,tcallparanode(tcallparanode(left).right).left.resultdef);
|
|
end
|
|
else
|
|
CGMessagePos(left.fileinfo,type_e_ordinal_expr_expected);
|
|
end
|
|
{ generic type parameter? }
|
|
else if is_typeparam(tcallparanode(left).right.resultdef) then
|
|
begin
|
|
result:=cnothingnode.create;
|
|
exit;
|
|
end
|
|
else
|
|
CGMessagePos(tcallparanode(left).right.fileinfo,type_e_ordinal_expr_expected);
|
|
end;
|
|
end;
|
|
|
|
in_neg_assign_x,
|
|
in_not_assign_x:
|
|
begin
|
|
resultdef:=voidtype;
|
|
if not(df_generic in current_procinfo.procdef.defoptions) then
|
|
begin
|
|
valid_for_var(left,true);
|
|
set_varstate(left,vs_readwritten,[vsf_must_be_valid]);
|
|
|
|
if is_integer(left.resultdef) then
|
|
begin
|
|
{ value of left gets changed -> must be unique }
|
|
set_unique(left);
|
|
{ these nodes shouldn't be created, when range checking is on }
|
|
if [cs_check_range,cs_check_overflow]*current_settings.localswitches<>[] then
|
|
internalerror(2017040703);
|
|
end
|
|
{ generic type parameter? }
|
|
else if is_typeparam(left.resultdef) then
|
|
begin
|
|
result:=cnothingnode.create;
|
|
exit;
|
|
end
|
|
else
|
|
CGMessagePos(left.fileinfo,type_e_ordinal_expr_expected);
|
|
end;
|
|
end;
|
|
|
|
in_read_x,
|
|
in_readln_x,
|
|
in_readstr_x,
|
|
in_write_x,
|
|
in_writeln_x,
|
|
in_writestr_x :
|
|
begin
|
|
result := handle_read_write;
|
|
end;
|
|
|
|
in_settextbuf_file_x :
|
|
begin
|
|
if target_info.system in systems_managed_vm then
|
|
message(parser_e_feature_unsupported_for_vm);
|
|
resultdef:=voidtype;
|
|
{ now we know the type of buffer }
|
|
hp:=ccallparanode.create(cordconstnode.create(
|
|
tcallparanode(left).left.resultdef.size,s32inttype,true),left);
|
|
result:=ccallnode.createintern('SETTEXTBUF',hp);
|
|
left:=nil;
|
|
end;
|
|
|
|
{ the firstpass of the arg has been done in firstcalln ? }
|
|
in_reset_typedfile,
|
|
in_rewrite_typedfile,
|
|
in_reset_typedfile_name,
|
|
in_rewrite_typedfile_name :
|
|
begin
|
|
result := handle_reset_rewrite_typed;
|
|
end;
|
|
|
|
in_str_x_string :
|
|
begin
|
|
result:=handle_str;
|
|
end;
|
|
|
|
in_val_x :
|
|
begin
|
|
result:=handle_val;
|
|
end;
|
|
|
|
in_include_x_y,
|
|
in_exclude_x_y:
|
|
begin
|
|
resultdef:=voidtype;
|
|
{ the parser already checks whether we have two (and exactly two) }
|
|
{ parameters (JM) }
|
|
{ first param must be var }
|
|
valid_for_var(tcallparanode(left).left,true);
|
|
set_varstate(tcallparanode(left).left,vs_readwritten,[vsf_must_be_valid]);
|
|
{ check type }
|
|
if (left.resultdef.typ=setdef) then
|
|
begin
|
|
{ insert a type conversion }
|
|
{ to the type of the set elements }
|
|
set_varstate(tcallparanode(tcallparanode(left).right).left,vs_read,[vsf_must_be_valid]);
|
|
inserttypeconv(tcallparanode(tcallparanode(left).right).left,
|
|
tsetdef(left.resultdef).elementdef);
|
|
end
|
|
else if left.resultdef.typ<>undefineddef then
|
|
CGMessage(type_e_mismatch);
|
|
end;
|
|
in_pack_x_y_z,
|
|
in_unpack_x_y_z :
|
|
begin
|
|
handle_pack_unpack;
|
|
end;
|
|
|
|
in_slice_x:
|
|
begin
|
|
if target_info.system in systems_managed_vm then
|
|
message(parser_e_feature_unsupported_for_vm);
|
|
result:=nil;
|
|
resultdef:=tcallparanode(left).left.resultdef;
|
|
if (resultdef.typ <> arraydef) then
|
|
CGMessagePos(left.fileinfo,type_e_mismatch)
|
|
else if is_packed_array(resultdef) then
|
|
CGMessagePos2(left.fileinfo,type_e_got_expected_unpacked_array,'1',resultdef.typename);
|
|
if not(is_integer(tcallparanode(tcallparanode(left).right).left.resultdef)) then
|
|
CGMessagePos1(tcallparanode(left).right.fileinfo,
|
|
type_e_integer_expr_expected,
|
|
tcallparanode(tcallparanode(left).right).left.resultdef.typename);
|
|
end;
|
|
|
|
in_new_x:
|
|
resultdef:=left.resultdef;
|
|
|
|
in_low_x,
|
|
in_high_x:
|
|
begin
|
|
case left.resultdef.typ of
|
|
undefineddef,
|
|
orddef,
|
|
enumdef,
|
|
setdef:
|
|
;
|
|
arraydef:
|
|
begin
|
|
if (inlinenumber=in_low_x) then
|
|
set_varstate(left,vs_read,[])
|
|
else
|
|
begin
|
|
if is_open_array(left.resultdef) or
|
|
is_array_of_const(left.resultdef) then
|
|
begin
|
|
set_varstate(left,vs_read,[]);
|
|
result:=load_high_value_node(tparavarsym(tloadnode(left).symtableentry));
|
|
end
|
|
else
|
|
begin
|
|
set_varstate(left,vs_read,[]);
|
|
resultdef:=sizesinttype;
|
|
end;
|
|
end;
|
|
end;
|
|
stringdef:
|
|
begin
|
|
if inlinenumber=in_low_x then
|
|
begin
|
|
set_varstate(left,vs_read,[]);
|
|
end
|
|
else
|
|
begin
|
|
if is_open_string(left.resultdef) then
|
|
begin
|
|
set_varstate(left,vs_read,[]);
|
|
result:=load_high_value_node(tparavarsym(tloadnode(left).symtableentry))
|
|
end
|
|
else if is_dynamicstring(left.resultdef) then
|
|
begin
|
|
result:=cinlinenode.create(in_length_x,false,left);
|
|
if cs_zerobasedstrings in current_settings.localswitches then
|
|
result:=caddnode.create(subn,result,cordconstnode.create(1,sinttype,false));
|
|
{ make sure the left node doesn't get disposed, since it's }
|
|
{ reused in the new node (JM) }
|
|
left:=nil;
|
|
end
|
|
end;
|
|
end;
|
|
else
|
|
CGMessage(type_e_mismatch);
|
|
end;
|
|
end;
|
|
|
|
in_exp_real,
|
|
in_frac_real,
|
|
in_int_real,
|
|
in_cos_real,
|
|
in_sin_real,
|
|
in_arctan_real,
|
|
in_ln_real :
|
|
begin
|
|
{ on the Z80, the double result is returned in a var param, because
|
|
it's too big to fit in registers. In that case we have 2 parameters
|
|
and left.nodetype is a callparan. }
|
|
if left.nodetype = callparan then
|
|
temp_pnode := @tcallparanode(left).left
|
|
else
|
|
temp_pnode := @left;
|
|
set_varstate(temp_pnode^,vs_read,[vsf_must_be_valid]);
|
|
{ converting an int64 to double on platforms without }
|
|
{ extended can cause precision loss }
|
|
if not(temp_pnode^.nodetype in [ordconstn,realconstn]) then
|
|
inserttypeconv(temp_pnode^,pbestrealtype^);
|
|
resultdef:=pbestrealtype^;
|
|
end;
|
|
|
|
in_trunc_real,
|
|
in_round_real :
|
|
begin
|
|
{ on i8086, the int64 result is returned in a var param, because
|
|
it's too big to fit in a register or a pair of registers. In
|
|
that case we have 2 parameters and left.nodetype is a callparan. }
|
|
if left.nodetype=callparan then
|
|
temp_pnode:=@tcallparanode(left).left
|
|
else
|
|
temp_pnode:=@left;
|
|
set_varstate(temp_pnode^,vs_read,[vsf_must_be_valid]);
|
|
{ on platforms where comp and currency are "type int64", this is
|
|
handled via inlined system helpers (-> no need for special
|
|
handling of s64currency/s64comp for them) }
|
|
if inlinenumber=in_trunc_real then
|
|
removefloatupcasts(temp_pnode^,[s32real,s64real,s80real,sc80real,s128real,s64currency,s64comp])
|
|
else
|
|
removefloatupcasts(temp_pnode^,[s32real,s64real,s80real,sc80real,s128real,s64comp]);
|
|
if (inlinenumber=in_trunc_real) and
|
|
is_currency(temp_pnode^.resultdef) then
|
|
begin
|
|
result:=cmoddivnode.create(divn,ctypeconvnode.create_internal(temp_pnode^.getcopy,s64inttype),genintconstnode(10000));
|
|
exit;
|
|
end
|
|
else if is_fpucomp(temp_pnode^.resultdef) then
|
|
begin
|
|
result:=ctypeconvnode.create_internal(temp_pnode^.getcopy,s64inttype);
|
|
exit;
|
|
end;
|
|
resultdef:=s64inttype;
|
|
end;
|
|
|
|
in_pi_real :
|
|
begin
|
|
resultdef:=pbestrealtype^;
|
|
end;
|
|
|
|
in_abs_long:
|
|
begin
|
|
set_varstate(left,vs_read,[vsf_must_be_valid]);
|
|
resultdef:=left.resultdef;
|
|
end;
|
|
|
|
in_abs_real,
|
|
in_sqr_real,
|
|
in_sqrt_real :
|
|
begin
|
|
{ on the Z80, the double result is returned in a var param, because
|
|
it's too big to fit in registers. In that case we have 2 parameters
|
|
and left.nodetype is a callparan. }
|
|
if left.nodetype = callparan then
|
|
temp_pnode := @tcallparanode(left).left
|
|
else
|
|
temp_pnode := @left;
|
|
set_varstate(temp_pnode^,vs_read,[vsf_must_be_valid]);
|
|
resultdef:=removefloatupcasts(temp_pnode^,[s32real,s64real,s80real,sc80real,s128real]);
|
|
end;
|
|
|
|
{$ifdef SUPPORT_MMX}
|
|
in_mmx_pcmpeqb..in_mmx_pcmpgtw:
|
|
begin
|
|
end;
|
|
{$endif SUPPORT_MMX}
|
|
in_aligned_x,
|
|
in_unaligned_x:
|
|
begin
|
|
resultdef:=left.resultdef;
|
|
end;
|
|
in_volatile_x:
|
|
begin
|
|
resultdef:=left.resultdef;
|
|
{ volatile only makes sense if the value is in memory }
|
|
make_not_regable(left,[ra_addr_regable]);
|
|
end;
|
|
in_assert_x_y :
|
|
begin
|
|
resultdef:=voidtype;
|
|
if assigned(left) then
|
|
begin
|
|
set_varstate(tcallparanode(left).left,vs_read,[vsf_must_be_valid]);
|
|
{ check type }
|
|
if is_boolean(left.resultdef) or
|
|
(
|
|
(left.resultdef.typ=undefineddef) and
|
|
(df_generic in current_procinfo.procdef.defoptions)
|
|
) then
|
|
begin
|
|
set_varstate(tcallparanode(tcallparanode(left).right).left,vs_read,[vsf_must_be_valid]);
|
|
{ must always be a string }
|
|
inserttypeconv(tcallparanode(tcallparanode(left).right).left,cshortstringtype);
|
|
end
|
|
else
|
|
CGMessage1(type_e_boolean_expr_expected,left.resultdef.typename);
|
|
end
|
|
else
|
|
CGMessage(type_e_mismatch);
|
|
|
|
if (cs_do_assertion in current_settings.localswitches) then
|
|
include(current_procinfo.flags,pi_do_call);
|
|
end;
|
|
in_prefetch_var:
|
|
resultdef:=voidtype;
|
|
in_get_frame,
|
|
in_get_caller_frame,
|
|
in_get_caller_addr:
|
|
begin
|
|
resultdef:=voidpointertype;
|
|
end;
|
|
in_rol_x,
|
|
in_ror_x,
|
|
in_sar_x:
|
|
begin
|
|
set_varstate(left,vs_read,[vsf_must_be_valid]);
|
|
resultdef:=left.resultdef;
|
|
end;
|
|
in_rol_x_y,
|
|
in_ror_x_y,
|
|
in_sar_x_y:
|
|
begin
|
|
set_varstate(tcallparanode(left).left,vs_read,[vsf_must_be_valid]);
|
|
set_varstate(tcallparanode(tcallparanode(left).right).left,vs_read,[vsf_must_be_valid]);
|
|
resultdef:=tcallparanode(tcallparanode(left).right).left.resultdef;
|
|
end;
|
|
in_bsf_x,
|
|
in_bsr_x:
|
|
begin
|
|
set_varstate(left,vs_read,[vsf_must_be_valid]);
|
|
if not is_integer(left.resultdef) then
|
|
CGMessage1(type_e_integer_expr_expected,left.resultdef.typename);
|
|
if torddef(left.resultdef).ordtype in [u64bit, s64bit] then
|
|
resultdef:=u64inttype
|
|
else
|
|
resultdef:=u32inttype
|
|
end;
|
|
|
|
in_popcnt_x:
|
|
begin
|
|
set_varstate(left,vs_read,[vsf_must_be_valid]);
|
|
if not is_integer(left.resultdef) then
|
|
CGMessage1(type_e_integer_expr_expected,left.resultdef.typename);
|
|
resultdef:=left.resultdef;
|
|
end;
|
|
|
|
in_objc_selector_x:
|
|
begin
|
|
result:=cobjcselectornode.create(left);
|
|
{ reused }
|
|
left:=nil;
|
|
end;
|
|
in_objc_protocol_x:
|
|
begin
|
|
result:=cobjcprotocolnode.create(left);
|
|
{ reused }
|
|
left:=nil;
|
|
end;
|
|
in_objc_encode_x:
|
|
begin
|
|
result:=handle_objc_encode;
|
|
end;
|
|
in_default_x:
|
|
begin
|
|
result:=handle_default;
|
|
end;
|
|
in_box_x:
|
|
begin
|
|
result:=handle_box;
|
|
end;
|
|
in_unbox_x_y:
|
|
begin
|
|
result:=handle_unbox;
|
|
end;
|
|
in_fma_single,
|
|
in_fma_double,
|
|
in_fma_extended,
|
|
in_fma_float128:
|
|
begin
|
|
set_varstate(tcallparanode(left).left,vs_read,[vsf_must_be_valid]);
|
|
set_varstate(tcallparanode(tcallparanode(left).right).left,vs_read,[vsf_must_be_valid]);
|
|
set_varstate(tcallparanode(tcallparanode(tcallparanode(left).right).right).left,vs_read,[vsf_must_be_valid]);
|
|
resultdef:=tcallparanode(left).left.resultdef;
|
|
end;
|
|
in_max_longint,
|
|
in_max_dword,
|
|
in_min_longint,
|
|
in_min_dword,
|
|
in_max_int64,
|
|
in_max_qword,
|
|
in_min_int64,
|
|
in_min_qword,
|
|
in_max_single,
|
|
in_max_double,
|
|
in_min_single,
|
|
in_min_double:
|
|
begin
|
|
set_varstate(tcallparanode(left).left,vs_read,[vsf_must_be_valid]);
|
|
set_varstate(tcallparanode(tcallparanode(left).right).left,vs_read,[vsf_must_be_valid]);
|
|
resultdef:=tcallparanode(left).left.resultdef;
|
|
end;
|
|
in_delete_x_y_z:
|
|
begin
|
|
result:=handle_delete;
|
|
end;
|
|
in_insert_x_y_z:
|
|
begin
|
|
result:=handle_insert;
|
|
end;
|
|
in_concat_x:
|
|
begin
|
|
result:=handle_concat;
|
|
end;
|
|
else
|
|
result:=pass_typecheck_cpu;
|
|
end;
|
|
end;
|
|
|
|
if not assigned(result) and not
|
|
codegenerror then
|
|
result:=simplify(false);
|
|
end;
|
|
|
|
|
|
function tinlinenode.pass_typecheck_cpu : tnode;
|
|
begin
|
|
Result:=nil;
|
|
internalerror(2017110102);
|
|
end;
|
|
|
|
|
|
function tinlinenode.pass_1 : tnode;
|
|
var
|
|
hp: tnode;
|
|
shiftconst: longint;
|
|
objdef: tobjectdef;
|
|
sym : tsym;
|
|
|
|
begin
|
|
result:=nil;
|
|
{ if we handle writeln; left contains no valid address }
|
|
if assigned(left) then
|
|
begin
|
|
if left.nodetype=callparan then
|
|
tcallparanode(left).firstcallparan
|
|
else
|
|
firstpass(left);
|
|
end;
|
|
|
|
{ intern const should already be handled }
|
|
if inf_inlineconst in inlinenodeflags then
|
|
internalerror(200104044);
|
|
case inlinenumber of
|
|
in_lo_qword,
|
|
in_hi_qword,
|
|
in_lo_long,
|
|
in_hi_long,
|
|
in_lo_word,
|
|
in_hi_word:
|
|
begin
|
|
shiftconst := 0;
|
|
case inlinenumber of
|
|
in_hi_qword:
|
|
shiftconst := 32;
|
|
in_hi_long:
|
|
shiftconst := 16;
|
|
in_hi_word:
|
|
shiftconst := 8;
|
|
else
|
|
;
|
|
end;
|
|
if shiftconst <> 0 then
|
|
result := ctypeconvnode.create_internal(cshlshrnode.create(shrn,left,
|
|
cordconstnode.create(shiftconst,sinttype,false)),resultdef)
|
|
else
|
|
result := ctypeconvnode.create_internal(left,resultdef);
|
|
left := nil;
|
|
firstpass(result);
|
|
end;
|
|
|
|
in_sizeof_x,
|
|
in_typeof_x:
|
|
begin
|
|
expectloc:=LOC_REGISTER;
|
|
case left.resultdef.typ of
|
|
objectdef,classrefdef:
|
|
begin
|
|
if left.resultdef.typ=objectdef then
|
|
begin
|
|
result:=cloadvmtaddrnode.create(left);
|
|
objdef:=tobjectdef(left.resultdef);
|
|
end
|
|
else
|
|
begin
|
|
result:=left;
|
|
objdef:=tobjectdef(tclassrefdef(left.resultdef).pointeddef);
|
|
end;
|
|
left:=nil;
|
|
if inlinenumber=in_sizeof_x then
|
|
begin
|
|
inserttypeconv_explicit(result,cpointerdef.getreusable(objdef.vmt_def));
|
|
result:=cderefnode.create(result);
|
|
result:=genloadfield(result,'VINSTANCESIZE');
|
|
end
|
|
else
|
|
inserttypeconv_explicit(result,voidpointertype);
|
|
end;
|
|
undefineddef:
|
|
;
|
|
else
|
|
internalerror(2015122702);
|
|
end;
|
|
end;
|
|
|
|
in_length_x:
|
|
begin
|
|
result:=first_length;
|
|
end;
|
|
|
|
in_typeinfo_x:
|
|
begin
|
|
if (left.resultdef.typ=enumdef) and
|
|
(tenumdef(left.resultdef).has_jumps) then
|
|
begin
|
|
if (left.nodetype=typen) and (sp_generic_para in ttypenode(left).typesym.symoptions) then
|
|
result:=cnilnode.create
|
|
else
|
|
internalerror(2021032601);
|
|
end
|
|
else
|
|
result:=caddrnode.create_internal(
|
|
crttinode.create(tstoreddef(left.resultdef),fullrtti,rdt_normal)
|
|
);
|
|
end;
|
|
|
|
in_gettypekind_x:
|
|
begin
|
|
sym:=tenumdef(typekindtype).int2enumsym(get_typekind(left.resultdef));
|
|
if not assigned(sym) then
|
|
internalerror(2017081101);
|
|
if sym.typ<>enumsym then
|
|
internalerror(2017081102);
|
|
result:=genenumnode(tenumsym(sym));
|
|
end;
|
|
|
|
in_ismanagedtype_x:
|
|
begin
|
|
if left.resultdef.needs_inittable then
|
|
result:=cordconstnode.create(1,resultdef,false)
|
|
else
|
|
result:=cordconstnode.create(0,resultdef,false);
|
|
end;
|
|
|
|
in_isconstvalue_x:
|
|
begin
|
|
if is_constnode(left) then
|
|
result:=cordconstnode.create(1,resultdef,false)
|
|
else
|
|
result:=cordconstnode.create(0,resultdef,false);
|
|
end;
|
|
|
|
in_assigned_x:
|
|
begin
|
|
result:=first_assigned;
|
|
end;
|
|
|
|
in_pred_x,
|
|
in_succ_x:
|
|
begin
|
|
expectloc:=LOC_REGISTER;
|
|
{ in case of range/overflow checking, use a regular addnode
|
|
because it's too complex to handle correctly otherwise }
|
|
{$ifndef jvm}
|
|
{ enums are class instances in the JVM -> always need conversion }
|
|
if (([cs_check_overflow,cs_check_range]*current_settings.localswitches)<>[]) and not(nf_internal in flags) then
|
|
{$endif}
|
|
begin
|
|
{ create constant 1 }
|
|
hp:=cordconstnode.create(1,left.resultdef,false);
|
|
typecheckpass(hp);
|
|
if not is_integer(hp.resultdef) then
|
|
inserttypeconv_internal(hp,sinttype);
|
|
|
|
{ avoid type errors from the addn/subn }
|
|
if not is_integer(left.resultdef) then
|
|
inserttypeconv_internal(left,sinttype);
|
|
|
|
{ addition/substraction depending on succ/pred }
|
|
if inlinenumber=in_succ_x then
|
|
hp:=caddnode.create(addn,left,hp)
|
|
else
|
|
hp:=caddnode.create(subn,left,hp);
|
|
|
|
{ the condition above is not tested for jvm, so we need to avoid overflow checks here
|
|
by setting nf_internal for the add/sub node as well }
|
|
if nf_internal in flags then
|
|
include(hp.flags,nf_internal);
|
|
|
|
{ assign result of addition }
|
|
if not(is_integer(resultdef)) then
|
|
inserttypeconv(hp,corddef.create(
|
|
{$ifdef cpu64bitaddr}
|
|
s64bit,
|
|
{$else cpu64bitaddr}
|
|
s32bit,
|
|
{$endif cpu64bitaddr}
|
|
get_min_value(resultdef),
|
|
get_max_value(resultdef),
|
|
true))
|
|
else
|
|
inserttypeconv(hp,resultdef);
|
|
|
|
if nf_internal in flags then
|
|
include(hp.flags,nf_internal);
|
|
|
|
{ avoid any possible errors/warnings }
|
|
inserttypeconv_internal(hp,resultdef);
|
|
|
|
{ firstpass it }
|
|
firstpass(hp);
|
|
|
|
{ left is reused }
|
|
left:=nil;
|
|
|
|
{ return new node }
|
|
result:=hp;
|
|
end;
|
|
end;
|
|
|
|
in_setlength_x:
|
|
result:=first_setlength;
|
|
in_copy_x:
|
|
result:=first_copy;
|
|
in_initialize_x,
|
|
in_finalize_x:
|
|
begin
|
|
expectloc:=LOC_VOID;
|
|
end;
|
|
|
|
in_inc_x,
|
|
in_dec_x:
|
|
begin
|
|
result:=first_IncDec;
|
|
end;
|
|
|
|
in_and_assign_x_y,
|
|
in_or_assign_x_y,
|
|
in_xor_assign_x_y,
|
|
in_sar_assign_x_y,
|
|
in_shl_assign_x_y,
|
|
in_shr_assign_x_y,
|
|
in_rol_assign_x_y,
|
|
in_ror_assign_x_y:
|
|
begin
|
|
result:=first_AndOrXorShiftRot_assign;
|
|
end;
|
|
|
|
in_neg_assign_x,
|
|
in_not_assign_x:
|
|
begin
|
|
result:=first_NegNot_assign;
|
|
end;
|
|
|
|
in_include_x_y,
|
|
in_exclude_x_y:
|
|
begin
|
|
result:=first_IncludeExclude;
|
|
end;
|
|
|
|
in_pack_x_y_z,
|
|
in_unpack_x_y_z:
|
|
begin
|
|
result:=first_pack_unpack;
|
|
end;
|
|
|
|
in_exp_real:
|
|
begin
|
|
result:= first_exp_real;
|
|
end;
|
|
|
|
in_round_real:
|
|
begin
|
|
result:= first_round_real;
|
|
end;
|
|
|
|
in_trunc_real:
|
|
begin
|
|
result:= first_trunc_real;
|
|
end;
|
|
|
|
in_int_real:
|
|
begin
|
|
result:= first_int_real;
|
|
end;
|
|
|
|
in_frac_real:
|
|
begin
|
|
result:= first_frac_real;
|
|
end;
|
|
|
|
in_cos_real:
|
|
begin
|
|
result:= first_cos_real;
|
|
end;
|
|
|
|
in_sin_real:
|
|
begin
|
|
result := first_sin_real;
|
|
end;
|
|
|
|
in_arctan_real:
|
|
begin
|
|
result := first_arctan_real;
|
|
end;
|
|
|
|
in_pi_real :
|
|
begin
|
|
result := first_pi;
|
|
end;
|
|
|
|
in_abs_real:
|
|
begin
|
|
result := first_abs_real;
|
|
end;
|
|
|
|
in_abs_long:
|
|
begin
|
|
result := first_abs_long;
|
|
end;
|
|
|
|
in_sqr_real:
|
|
begin
|
|
result := first_sqr_real;
|
|
end;
|
|
|
|
in_sqrt_real:
|
|
begin
|
|
result := first_sqrt_real;
|
|
end;
|
|
|
|
in_ln_real:
|
|
begin
|
|
result := first_ln_real;
|
|
end;
|
|
|
|
{$ifdef SUPPORT_MMX}
|
|
in_mmx_pcmpeqb..in_mmx_pcmpgtw:
|
|
begin
|
|
end;
|
|
{$endif SUPPORT_MMX}
|
|
|
|
in_assert_x_y :
|
|
begin
|
|
result:=first_assert;
|
|
end;
|
|
|
|
in_low_x:
|
|
internalerror(200104047);
|
|
in_high_x:
|
|
begin
|
|
result:=first_high;
|
|
end;
|
|
|
|
in_slice_x:
|
|
{ slice can be used only in calls for open array parameters, so it has to be converted appropriatly before
|
|
if we get here, the array could not be passed to an open array parameter so it is an error }
|
|
CGMessagePos(left.fileinfo,type_e_mismatch);
|
|
|
|
in_ord_x,
|
|
in_chr_byte:
|
|
begin
|
|
{ should not happend as it's converted to typeconv }
|
|
internalerror(200104045);
|
|
end;
|
|
|
|
in_ofs_x :
|
|
internalerror(2000101002);
|
|
|
|
in_seg_x :
|
|
begin
|
|
result:=first_seg;
|
|
end;
|
|
|
|
in_settextbuf_file_x,
|
|
in_reset_typedfile,
|
|
in_rewrite_typedfile,
|
|
in_reset_typedfile_name,
|
|
in_rewrite_typedfile_name,
|
|
in_str_x_string,
|
|
in_val_x,
|
|
in_read_x,
|
|
in_readln_x,
|
|
in_write_x,
|
|
in_writeln_x :
|
|
begin
|
|
{ should be handled by pass_typecheck }
|
|
internalerror(2001082302);
|
|
end;
|
|
in_get_frame:
|
|
begin
|
|
result:=first_get_frame;
|
|
end;
|
|
in_get_caller_frame:
|
|
begin
|
|
expectloc:=LOC_REGISTER;
|
|
end;
|
|
in_get_caller_addr:
|
|
begin
|
|
expectloc:=LOC_REGISTER;
|
|
end;
|
|
in_prefetch_var:
|
|
begin
|
|
expectloc:=LOC_VOID;
|
|
end;
|
|
in_aligned_x,
|
|
in_unaligned_x,
|
|
in_volatile_x:
|
|
begin
|
|
expectloc:=tcallparanode(left).left.expectloc;
|
|
end;
|
|
in_rol_x,
|
|
in_rol_x_y,
|
|
in_ror_x,
|
|
in_ror_x_y:
|
|
expectloc:=LOC_REGISTER;
|
|
in_bsf_x,
|
|
in_bsr_x:
|
|
result:=first_bitscan;
|
|
in_sar_x,
|
|
in_sar_x_y:
|
|
result:=first_sar;
|
|
in_popcnt_x:
|
|
result:=first_popcnt;
|
|
in_new_x:
|
|
result:=first_new;
|
|
in_box_x:
|
|
result:=first_box;
|
|
in_unbox_x_y:
|
|
result:=first_unbox;
|
|
in_fma_single,
|
|
in_fma_double,
|
|
in_fma_extended,
|
|
in_fma_float128:
|
|
result:=first_fma;
|
|
in_max_longint,
|
|
in_max_dword,
|
|
in_min_longint,
|
|
in_min_dword,
|
|
in_max_int64,
|
|
in_max_qword,
|
|
in_min_int64,
|
|
in_min_qword,
|
|
in_min_single,
|
|
in_min_double,
|
|
in_max_single,
|
|
in_max_double:
|
|
result:=first_minmax;
|
|
else
|
|
result:=first_cpu;
|
|
end;
|
|
end;
|
|
{$maxfpuregisters default}
|
|
|
|
function tinlinenode.docompare(p: tnode): boolean;
|
|
begin
|
|
docompare :=
|
|
inherited docompare(p) and
|
|
(inlinenumber = tinlinenode(p).inlinenumber);
|
|
end;
|
|
|
|
|
|
procedure tinlinenode.mark_write;
|
|
begin
|
|
case inlinenumber of
|
|
in_aligned_x, in_unaligned_x:
|
|
tcallparanode(left).left.mark_write;
|
|
else
|
|
inherited mark_write;
|
|
end;
|
|
end;
|
|
|
|
function tinlinenode.first_pi : tnode;
|
|
begin
|
|
result:=crealconstnode.create(getpi,pbestrealtype^);
|
|
end;
|
|
|
|
|
|
function tinlinenode.first_arctan_real : tnode;
|
|
var
|
|
temp_pnode: pnode;
|
|
begin
|
|
{ create the call to the helper }
|
|
{ on entry left node contains the parameter }
|
|
if left.nodetype = callparan then
|
|
temp_pnode := @tcallparanode(left).left
|
|
else
|
|
temp_pnode := @left;
|
|
result := ccallnode.createintern('fpc_arctan_real',
|
|
ccallparanode.create(temp_pnode^,nil));
|
|
temp_pnode^ := nil;
|
|
end;
|
|
|
|
function tinlinenode.first_abs_real : tnode;
|
|
var
|
|
callnode : tcallnode;
|
|
temp_pnode: pnode;
|
|
begin
|
|
{ create the call to the helper }
|
|
{ on entry left node contains the parameter }
|
|
if left.nodetype = callparan then
|
|
temp_pnode := @tcallparanode(left).left
|
|
else
|
|
temp_pnode := @left;
|
|
callnode:=ccallnode.createintern('fpc_abs_real',
|
|
ccallparanode.create(temp_pnode^,nil));
|
|
result := ctypeconvnode.create(callnode,resultdef);
|
|
include(callnode.callnodeflags,cnf_check_fpu_exceptions);
|
|
temp_pnode^ := nil;
|
|
end;
|
|
|
|
function tinlinenode.first_sqr_real : tnode;
|
|
var
|
|
callnode : tcallnode;
|
|
temp_pnode: pnode;
|
|
begin
|
|
{$ifndef cpufpemu}
|
|
{ this procedure might be only used for cpus definining cpufpemu else
|
|
the optimizer might go into an endless loop when doing x*x -> changes }
|
|
internalerror(2011092401);
|
|
{$endif cpufpemu}
|
|
{ create the call to the helper }
|
|
{ on entry left node contains the parameter }
|
|
if left.nodetype = callparan then
|
|
temp_pnode := @tcallparanode(left).left
|
|
else
|
|
temp_pnode := @left;
|
|
callnode:=ccallnode.createintern('fpc_sqr_real',
|
|
ccallparanode.create(temp_pnode^,nil));
|
|
result := ctypeconvnode.create(callnode,resultdef);
|
|
include(callnode.callnodeflags,cnf_check_fpu_exceptions);
|
|
temp_pnode^ := nil;
|
|
end;
|
|
|
|
function tinlinenode.first_sqrt_real : tnode;
|
|
var
|
|
fdef: tdef;
|
|
procname: string[31];
|
|
callnode: tcallnode;
|
|
temp_pnode: pnode;
|
|
begin
|
|
if left.nodetype = callparan then
|
|
temp_pnode := @tcallparanode(left).left
|
|
else
|
|
temp_pnode := @left;
|
|
if ((cs_fp_emulation in current_settings.moduleswitches)
|
|
{$ifdef cpufpemu}
|
|
or (current_settings.fputype=fpu_soft)
|
|
{$endif cpufpemu}
|
|
) and not (target_info.system in systems_wince) then
|
|
begin
|
|
case tfloatdef(temp_pnode^.resultdef).floattype of
|
|
s32real:
|
|
begin
|
|
fdef:=search_system_type('FLOAT32REC').typedef;
|
|
procname:='float32_sqrt';
|
|
end;
|
|
s64real:
|
|
begin
|
|
fdef:=search_system_type('FLOAT64').typedef;
|
|
procname:='float64_sqrt';
|
|
end;
|
|
{!!! not yet implemented
|
|
s128real:
|
|
}
|
|
else
|
|
internalerror(2014052101);
|
|
end;
|
|
result:=ctypeconvnode.create_internal(ccallnode.createintern(procname,ccallparanode.create(
|
|
ctypeconvnode.create_internal(temp_pnode^,fdef),nil)),resultdef);
|
|
end
|
|
else
|
|
begin
|
|
{ create the call to the helper }
|
|
{ on entry left node contains the parameter }
|
|
callnode := ccallnode.createintern('fpc_sqrt_real',
|
|
ccallparanode.create(temp_pnode^,nil));
|
|
result := ctypeconvnode.create(callnode,resultdef);
|
|
include(callnode.callnodeflags,cnf_check_fpu_exceptions);
|
|
end;
|
|
temp_pnode^ := nil;
|
|
end;
|
|
|
|
function tinlinenode.first_ln_real : tnode;
|
|
var
|
|
temp_pnode: pnode;
|
|
begin
|
|
{ create the call to the helper }
|
|
{ on entry left node contains the parameter }
|
|
if left.nodetype = callparan then
|
|
temp_pnode := @tcallparanode(left).left
|
|
else
|
|
temp_pnode := @left;
|
|
result := ccallnode.createintern('fpc_ln_real',
|
|
ccallparanode.create(temp_pnode^,nil));
|
|
include(tcallnode(result).callnodeflags,cnf_check_fpu_exceptions);
|
|
temp_pnode^ := nil;
|
|
end;
|
|
|
|
function tinlinenode.first_cos_real : tnode;
|
|
var
|
|
temp_pnode: pnode;
|
|
begin
|
|
{ create the call to the helper }
|
|
{ on entry left node contains the parameter }
|
|
if left.nodetype = callparan then
|
|
temp_pnode := @tcallparanode(left).left
|
|
else
|
|
temp_pnode := @left;
|
|
result := ccallnode.createintern('fpc_cos_real',
|
|
ccallparanode.create(temp_pnode^,nil));
|
|
include(tcallnode(result).callnodeflags,cnf_check_fpu_exceptions);
|
|
temp_pnode^ := nil;
|
|
end;
|
|
|
|
function tinlinenode.first_sin_real : tnode;
|
|
var
|
|
temp_pnode: pnode;
|
|
begin
|
|
{ create the call to the helper }
|
|
{ on entry left node contains the parameter }
|
|
if left.nodetype = callparan then
|
|
temp_pnode := @tcallparanode(left).left
|
|
else
|
|
temp_pnode := @left;
|
|
result := ccallnode.createintern('fpc_sin_real',
|
|
ccallparanode.create(temp_pnode^,nil));
|
|
include(tcallnode(result).callnodeflags,cnf_check_fpu_exceptions);
|
|
temp_pnode^ := nil;
|
|
end;
|
|
|
|
function tinlinenode.first_exp_real : tnode;
|
|
var
|
|
temp_pnode: pnode;
|
|
begin
|
|
{ create the call to the helper }
|
|
{ on entry left node contains the parameter }
|
|
if left.nodetype = callparan then
|
|
temp_pnode := @tcallparanode(left).left
|
|
else
|
|
temp_pnode := @left;
|
|
result := ccallnode.createintern('fpc_exp_real',ccallparanode.create(temp_pnode^,nil));
|
|
include(tcallnode(result).callnodeflags,cnf_check_fpu_exceptions);
|
|
temp_pnode^ := nil;
|
|
end;
|
|
|
|
function tinlinenode.first_int_real : tnode;
|
|
var
|
|
temp_pnode: pnode;
|
|
begin
|
|
{ create the call to the helper }
|
|
{ on entry left node contains the parameter }
|
|
if left.nodetype = callparan then
|
|
temp_pnode := @tcallparanode(left).left
|
|
else
|
|
temp_pnode := @left;
|
|
result := ccallnode.createintern('fpc_int_real',ccallparanode.create(temp_pnode^,nil));
|
|
include(tcallnode(result).callnodeflags,cnf_check_fpu_exceptions);
|
|
temp_pnode^ := nil;
|
|
end;
|
|
|
|
function tinlinenode.first_frac_real : tnode;
|
|
var
|
|
temp_pnode: pnode;
|
|
begin
|
|
{ create the call to the helper }
|
|
{ on entry left node contains the parameter }
|
|
if left.nodetype = callparan then
|
|
temp_pnode := @tcallparanode(left).left
|
|
else
|
|
temp_pnode := @left;
|
|
result := ccallnode.createintern('fpc_frac_real',ccallparanode.create(temp_pnode^,nil));
|
|
include(tcallnode(result).callnodeflags,cnf_check_fpu_exceptions);
|
|
temp_pnode^ := nil;
|
|
end;
|
|
|
|
function tinlinenode.first_round_real : tnode;
|
|
var
|
|
temp_pnode: pnode;
|
|
begin
|
|
{ create the call to the helper }
|
|
{ on entry left node contains the parameter }
|
|
if left.nodetype = callparan then
|
|
temp_pnode := @tcallparanode(left).left
|
|
else
|
|
temp_pnode := @left;
|
|
result := ccallnode.createintern('fpc_round_real',ccallparanode.create(temp_pnode^,nil));
|
|
include(tcallnode(result).callnodeflags,cnf_check_fpu_exceptions);
|
|
temp_pnode^ := nil;
|
|
end;
|
|
|
|
function tinlinenode.first_trunc_real : tnode;
|
|
var
|
|
temp_pnode: pnode;
|
|
begin
|
|
{ create the call to the helper }
|
|
{ on entry left node contains the parameter }
|
|
if left.nodetype = callparan then
|
|
temp_pnode := @tcallparanode(left).left
|
|
else
|
|
temp_pnode := @left;
|
|
result := ccallnode.createintern('fpc_trunc_real',ccallparanode.create(temp_pnode^,nil));
|
|
include(tcallnode(result).callnodeflags,cnf_check_fpu_exceptions);
|
|
temp_pnode^ := nil;
|
|
end;
|
|
|
|
|
|
function tinlinenode.first_abs_long : tnode;
|
|
begin
|
|
expectloc:=LOC_REGISTER;
|
|
result:=nil;
|
|
end;
|
|
|
|
|
|
function tinlinenode.getaddsub_for_incdec : tnode;
|
|
var
|
|
hp,hpp,resultnode : tnode;
|
|
tempnode: ttempcreatenode;
|
|
newstatement: tstatementnode;
|
|
newblock: tblocknode;
|
|
begin
|
|
newblock := internalstatements(newstatement);
|
|
{ extra parameter? }
|
|
if assigned(tcallparanode(left).right) then
|
|
begin
|
|
{ Yes, use for add node }
|
|
hpp := tcallparanode(tcallparanode(left).right).left;
|
|
tcallparanode(tcallparanode(left).right).left := nil;
|
|
if assigned(tcallparanode(tcallparanode(left).right).right) then
|
|
CGMessage(parser_e_illegal_expression);
|
|
end
|
|
else
|
|
begin
|
|
{ no, create constant 1 }
|
|
hpp := cordconstnode.create(1,tcallparanode(left).left.resultdef,false);
|
|
end;
|
|
typecheckpass(hpp);
|
|
|
|
{ make sure we don't call functions part of the left node twice (and generally }
|
|
{ optimize the code generation) }
|
|
{ Storing address is not always an optimization: alignment of left is not known
|
|
at this point, so we must assume the worst and use an unaligned pointer.
|
|
This results in larger and slower code on alignment-sensitive targets.
|
|
Therefore the complexity condition below is questionable, maybe just filtering
|
|
out calls with "= NODE_COMPLEXITY_INF" is sufficient.
|
|
Value of 3 corresponds to subscript nodes, i.e. record field. }
|
|
if node_complexity(tcallparanode(left).left) > 3 then
|
|
begin
|
|
tempnode := ctempcreatenode.create(voidpointertype,voidpointertype.size,tt_persistent,true);
|
|
addstatement(newstatement,tempnode);
|
|
addstatement(newstatement,cassignmentnode.create(ctemprefnode.create(tempnode),
|
|
caddrnode.create_internal(tcallparanode(left).left.getcopy)));
|
|
hp := cderefnode.create(ctemprefnode.create(tempnode));
|
|
inserttypeconv_internal(hp,tcallparanode(left).left.resultdef);
|
|
end
|
|
else
|
|
begin
|
|
hp := tcallparanode(left).left.getcopy;
|
|
tempnode := nil;
|
|
end;
|
|
|
|
resultnode := hp.getcopy;
|
|
{ Remove "modify" flag from what will be an assignment destination }
|
|
Exclude(resultnode.flags, nf_modify);
|
|
|
|
{ avoid type errors from the addn/subn }
|
|
if not is_integer(resultnode.resultdef) then
|
|
begin
|
|
inserttypeconv_internal(hp,sinttype);
|
|
inserttypeconv_internal(hpp,sinttype);
|
|
end;
|
|
|
|
{ addition/subtraction depending on inc/dec }
|
|
if inlinenumber = in_inc_x then
|
|
hpp := caddnode.create_internal(addn,hp,hpp)
|
|
else
|
|
hpp := caddnode.create_internal(subn,hp,hpp);
|
|
|
|
{ assign result of addition }
|
|
|
|
{ inherit internal flag }
|
|
if not(is_integer(resultnode.resultdef)) then
|
|
begin
|
|
if nf_internal in flags then
|
|
inserttypeconv_internal(hpp,corddef.create(
|
|
{$ifdef cpu64bitaddr}
|
|
s64bit,
|
|
{$else cpu64bitaddr}
|
|
s32bit,
|
|
{$endif cpu64bitaddr}
|
|
get_min_value(resultnode.resultdef),
|
|
get_max_value(resultnode.resultdef),
|
|
true))
|
|
else
|
|
inserttypeconv(hpp,corddef.create(
|
|
{$ifdef cpu64bitaddr}
|
|
s64bit,
|
|
{$else cpu64bitaddr}
|
|
s32bit,
|
|
{$endif cpu64bitaddr}
|
|
get_min_value(resultnode.resultdef),
|
|
get_max_value(resultnode.resultdef),
|
|
true))
|
|
end
|
|
else
|
|
begin
|
|
if nf_internal in flags then
|
|
inserttypeconv_internal(hpp,resultnode.resultdef)
|
|
else
|
|
inserttypeconv(hpp,resultnode.resultdef);
|
|
end;
|
|
|
|
{ avoid any possible warnings }
|
|
inserttypeconv_internal(hpp,resultnode.resultdef);
|
|
|
|
{ force pass 1, so copied trees get first pass'ed as well and flags like
|
|
nf_call_unique get set right }
|
|
node_reset_pass1_write(hpp);
|
|
do_typecheckpass(hpp);
|
|
|
|
addstatement(newstatement,cassignmentnode.create(resultnode,hpp));
|
|
|
|
{ firstpass it }
|
|
firstpass(tnode(newstatement.left));
|
|
|
|
{ deallocate the temp }
|
|
if assigned(tempnode) then
|
|
addstatement(newstatement,ctempdeletenode.create(tempnode));
|
|
{ firstpass it }
|
|
firstpass(tnode(newblock));
|
|
{ return new node }
|
|
result := newblock;
|
|
end;
|
|
|
|
|
|
function tinlinenode.first_IncDec: tnode;
|
|
begin
|
|
expectloc:=LOC_VOID;
|
|
result:=nil;
|
|
|
|
{ range/overflow checking doesn't work properly }
|
|
{ with the inc/dec code that's generated (JM) }
|
|
if ((localswitches * [cs_check_overflow,cs_check_range] <> []) and
|
|
{ No overflow check for pointer operations, because inc(pointer,-1) will always
|
|
trigger an overflow. For uint32 it works because then the operation is done
|
|
in 64bit. Range checking is not applicable to pointers either }
|
|
(tcallparanode(left).left.resultdef.typ<>pointerdef))
|
|
{$ifdef jvm}
|
|
{ enums are class instances on the JVM -> special treatment }
|
|
or (tcallparanode(left).left.resultdef.typ=enumdef)
|
|
{$endif}
|
|
then
|
|
{ convert to simple add (JM) }
|
|
result:=getaddsub_for_incdec
|
|
end;
|
|
|
|
|
|
function tinlinenode.first_IncludeExclude: tnode;
|
|
begin
|
|
result:=nil;
|
|
expectloc:=LOC_VOID;
|
|
end;
|
|
|
|
|
|
function tinlinenode.first_get_frame: tnode;
|
|
begin
|
|
include(current_procinfo.flags,pi_needs_stackframe);
|
|
include(current_procinfo.flags,pi_uses_get_frame);
|
|
expectloc:=LOC_CREGISTER;
|
|
result:=nil;
|
|
end;
|
|
|
|
|
|
function tinlinenode.first_setlength: tnode;
|
|
var
|
|
paras : tnode;
|
|
npara,
|
|
ppn : tcallparanode;
|
|
dims,
|
|
counter : integer;
|
|
isarray : boolean;
|
|
destppn : tnode;
|
|
newstatement : tstatementnode;
|
|
temp : ttempcreatenode;
|
|
newblock : tnode;
|
|
begin
|
|
paras:=left;
|
|
ppn:=tcallparanode(paras);
|
|
dims:=0;
|
|
while assigned(ppn.right) do
|
|
begin
|
|
inc(dims);
|
|
ppn:=tcallparanode(ppn.right);
|
|
end;
|
|
|
|
destppn:=ppn.left;
|
|
isarray:=is_dynamic_array(destppn.resultdef);
|
|
{ first param must be a string or dynamic array ...}
|
|
if isarray then
|
|
begin
|
|
{ SetLength(Arr, 0), Arr := nil, Arr := [] }
|
|
if (dims=1) and is_constintvalue(tcallparanode(paras).left, 0) then
|
|
begin
|
|
ppn.left:=nil; { unlink destppn }
|
|
result:=ccallparanode.create(ctypeconvnode.create_internal(destppn,voidpointertype),nil);
|
|
result:=ccallnode.createintern('fpc_dynarray_clear',
|
|
ccallparanode.create(caddrnode.create_internal(
|
|
crttinode.create(tstoreddef(destppn.resultdef),initrtti,rdt_normal)),
|
|
result));
|
|
exit;
|
|
end;
|
|
{ create statements with call initialize the arguments and
|
|
call fpc_dynarr_setlength }
|
|
newblock:=internalstatements(newstatement);
|
|
|
|
{ get temp for array of lengths }
|
|
temp:=ctempcreatenode.create(carraydef.getreusable(sinttype,dims),dims*sinttype.size,tt_persistent,false);
|
|
addstatement(newstatement,temp);
|
|
|
|
{ load array of lengths }
|
|
ppn:=tcallparanode(paras);
|
|
counter:=dims-1;
|
|
while assigned(ppn.right) do
|
|
begin
|
|
addstatement(newstatement,cassignmentnode.create(
|
|
cvecnode.create(
|
|
ctemprefnode.create(temp),
|
|
genintconstnode(counter)
|
|
),
|
|
ppn.left));
|
|
ppn.left:=nil;
|
|
dec(counter);
|
|
ppn:=tcallparanode(ppn.right);
|
|
end;
|
|
{ destppn is also reused }
|
|
ppn.left:=nil;
|
|
|
|
{ create call to fpc_dynarr_setlength }
|
|
npara:=ccallparanode.create(caddrnode.create_internal(
|
|
cvecnode.create(
|
|
ctemprefnode.create(temp),
|
|
genintconstnode(0)
|
|
)),
|
|
ccallparanode.create(cordconstnode.create
|
|
(dims,sinttype,true),
|
|
ccallparanode.create(caddrnode.create_internal
|
|
(crttinode.create(tstoreddef(destppn.resultdef),initrtti,rdt_normal)),
|
|
ccallparanode.create(ctypeconvnode.create_internal(destppn,voidpointertype),nil))));
|
|
addstatement(newstatement,ccallnode.createintern('fpc_dynarray_setlength',npara));
|
|
addstatement(newstatement,ctempdeletenode.create(temp));
|
|
end
|
|
else if is_ansistring(destppn.resultdef) then
|
|
begin
|
|
newblock:=ccallnode.createintern(
|
|
'fpc_'+tstringdef(destppn.resultdef).stringtypname+'_setlength',
|
|
ccallparanode.create(
|
|
cordconstnode.create(getparaencoding(destppn.resultdef),u16inttype,true),
|
|
paras
|
|
)
|
|
);
|
|
{ we reused the parameters, make sure we don't release them }
|
|
left:=nil;
|
|
end
|
|
else
|
|
begin
|
|
{ we can reuse the supplied parameters }
|
|
newblock:=ccallnode.createintern(
|
|
'fpc_'+tstringdef(destppn.resultdef).stringtypname+'_setlength',paras);
|
|
{ we reused the parameters, make sure we don't release them }
|
|
left:=nil;
|
|
end;
|
|
result:=newblock;
|
|
end;
|
|
|
|
function tinlinenode.first_copy: tnode;
|
|
var
|
|
lowppn,
|
|
countppn,
|
|
elesizeppn,
|
|
eletypeppn,
|
|
maxcountppn,
|
|
arrayppn,
|
|
rttippn,
|
|
npara,
|
|
paras : tnode;
|
|
ppn : tcallparanode;
|
|
paradef : tdef;
|
|
counter : integer;
|
|
begin
|
|
{ determine copy function to use based on the first argument,
|
|
also count the number of arguments in this loop }
|
|
counter:=1;
|
|
paras:=left;
|
|
ppn:=tcallparanode(paras);
|
|
while assigned(ppn.right) do
|
|
begin
|
|
inc(counter);
|
|
ppn:=tcallparanode(ppn.right);
|
|
end;
|
|
paradef:=ppn.left.resultdef;
|
|
|
|
{ fill up third parameter }
|
|
if counter=2 then
|
|
begin
|
|
paras:=ccallparanode.create(cordconstnode.create(torddef(sinttype).high,sinttype,false),paras);
|
|
counter:=3;
|
|
end;
|
|
|
|
if is_ansistring(resultdef) then
|
|
{ keep the specific kind of ansistringdef as result }
|
|
result:=ccallnode.createinternres('fpc_ansistr_copy',paras,resultdef)
|
|
else if is_widestring(resultdef) then
|
|
result:=ccallnode.createintern('fpc_widestr_copy',paras)
|
|
else if is_unicodestring(resultdef) then
|
|
result:=ccallnode.createintern('fpc_unicodestr_copy',paras)
|
|
{ can't check for resultdef = cansichartype, because resultdef=
|
|
cshortstringtype here }
|
|
else if is_char(paradef) then
|
|
result:=ccallnode.createintern('fpc_char_copy',paras)
|
|
else if is_dynamic_array(resultdef) then
|
|
begin
|
|
{ create statements with call }
|
|
elesizeppn:=cordconstnode.create(tarraydef(paradef).elesize,sinttype,false);
|
|
if is_managed_type(tarraydef(paradef).elementdef) then
|
|
eletypeppn:=caddrnode.create_internal(
|
|
crttinode.create(tstoreddef(tarraydef(paradef).elementdef),initrtti,rdt_normal))
|
|
else
|
|
eletypeppn:=cordconstnode.create(0,voidpointertype,false);
|
|
maxcountppn:=geninlinenode(in_length_x,false,ppn.left.getcopy);
|
|
case counter of
|
|
1:
|
|
begin
|
|
{ copy the whole array using [0..high(sizeint)] range }
|
|
countppn:=cordconstnode.create(torddef(sinttype).high,sinttype,false);
|
|
lowppn:=cordconstnode.create(0,sinttype,false);
|
|
end;
|
|
2:
|
|
begin
|
|
{ copy the array using [low..high(sizeint)] range }
|
|
countppn:=cordconstnode.create(torddef(sinttype).high,sinttype,false);
|
|
lowppn:=tcallparanode(paras).left.getcopy;
|
|
end;
|
|
3:
|
|
begin
|
|
countppn:=tcallparanode(paras).left.getcopy;
|
|
lowppn:=tcallparanode(tcallparanode(paras).right).left.getcopy;
|
|
end;
|
|
else
|
|
internalerror(2012100703);
|
|
end;
|
|
|
|
if is_open_array(paradef) then
|
|
begin
|
|
arrayppn:=caddrnode.create_internal(ppn.left);
|
|
end
|
|
else if is_dynamic_array(paradef) then
|
|
begin
|
|
arrayppn:=ctypeconvnode.create_internal(ppn.left,voidpointertype);
|
|
end
|
|
else
|
|
internalerror(2012100704);
|
|
|
|
rttippn:=caddrnode.create_internal(crttinode.create(tstoreddef(resultdef),initrtti,rdt_normal));
|
|
|
|
{ create call to fpc_array_to_dynarray_copy }
|
|
npara:=ccallparanode.create(eletypeppn,
|
|
ccallparanode.create(elesizeppn,
|
|
ccallparanode.create(maxcountppn,
|
|
ccallparanode.create(countppn,
|
|
ccallparanode.create(lowppn,
|
|
ccallparanode.create(rttippn,
|
|
ccallparanode.create(arrayppn,nil)))))));
|
|
result:=ccallnode.createinternres('fpc_array_to_dynarray_copy',npara,resultdef);
|
|
|
|
ppn.left:=nil;
|
|
paras.free;
|
|
end
|
|
else
|
|
result:=ccallnode.createintern('fpc_shortstr_copy',paras);
|
|
{ parameters are reused }
|
|
left:=nil;
|
|
end;
|
|
|
|
|
|
function tinlinenode.first_new: tnode;
|
|
var
|
|
newstatement : tstatementnode;
|
|
newblock : tblocknode;
|
|
temp : ttempcreatenode;
|
|
para : tcallparanode;
|
|
begin
|
|
{ create statements with call to getmem+initialize }
|
|
newblock:=internalstatements(newstatement);
|
|
|
|
{ create temp for result }
|
|
temp := ctempcreatenode.create(left.resultdef,left.resultdef.size,tt_persistent,true);
|
|
addstatement(newstatement,temp);
|
|
|
|
{ create call to fpc_getmem }
|
|
para := ccallparanode.create(cordconstnode.create
|
|
(tpointerdef(left.resultdef).pointeddef.size,s32inttype,true),nil);
|
|
addstatement(newstatement,cassignmentnode.create(
|
|
ctemprefnode.create(temp),
|
|
ccallnode.createintern('fpc_getmem',para)));
|
|
|
|
{ create call to fpc_initialize }
|
|
if is_managed_type(tpointerdef(left.resultdef).pointeddef) then
|
|
begin
|
|
para := ccallparanode.create(caddrnode.create_internal(crttinode.create
|
|
(tstoreddef(tpointerdef(left.resultdef).pointeddef),initrtti,rdt_normal)),
|
|
ccallparanode.create(ctemprefnode.create
|
|
(temp),nil));
|
|
addstatement(newstatement,ccallnode.createintern('fpc_initialize',para));
|
|
end;
|
|
|
|
{ the last statement should return the value as
|
|
location and type, this is done be referencing the
|
|
temp and converting it first from a persistent temp to
|
|
normal temp }
|
|
addstatement(newstatement,ctempdeletenode.create_normal_temp(temp));
|
|
addstatement(newstatement,ctemprefnode.create(temp));
|
|
result:=newblock;
|
|
end;
|
|
|
|
|
|
function tinlinenode.first_length: tnode;
|
|
begin
|
|
result:=nil;
|
|
if is_shortstring(left.resultdef) then
|
|
expectloc:=left.expectloc
|
|
else
|
|
begin
|
|
{ ansi/wide string }
|
|
expectloc:=LOC_REGISTER;
|
|
end;
|
|
end;
|
|
|
|
|
|
function tinlinenode.first_high: tnode;
|
|
begin
|
|
result:=nil;
|
|
if not(is_dynamic_array(left.resultdef)) then
|
|
Internalerror(2019122802);
|
|
expectloc:=LOC_REGISTER;
|
|
end;
|
|
|
|
|
|
function tinlinenode.first_assigned: tnode;
|
|
begin
|
|
{ Comparison must not call procvars, indicate that with nf_load_procvar flag }
|
|
result:=caddnode.create(unequaln,tcallparanode(left).left,cnilnode.create);
|
|
include(result.flags,nf_load_procvar);
|
|
tcallparanode(left).left:=nil;
|
|
end;
|
|
|
|
|
|
function tinlinenode.first_assert: tnode;
|
|
var
|
|
paras: tcallparanode;
|
|
begin
|
|
paras:=tcallparanode(tcallparanode(left).right);
|
|
paras:=ccallparanode.create(cstringconstnode.createstr(current_module.sourcefiles.get_file_name(current_filepos.fileindex)),paras);
|
|
paras:=ccallparanode.create(genintconstnode(fileinfo.line),paras);
|
|
{$ifdef SUPPORT_GET_FRAME}
|
|
paras:=ccallparanode.create(geninlinenode(in_get_frame,false,nil),paras);
|
|
{$else}
|
|
paras:=ccallparanode.create(ccallnode.createinternfromunit('SYSTEM','GET_FRAME',nil),paras);
|
|
{$endif}
|
|
result:=cifnode.create(cnotnode.create(tcallparanode(left).left),
|
|
ccallnode.createintern('fpc_assert',paras),nil);
|
|
include(result.flags,nf_internal);
|
|
tcallparanode(left).left:=nil;
|
|
tcallparanode(left).right:=nil;
|
|
end;
|
|
|
|
|
|
function tinlinenode.first_popcnt: tnode;
|
|
var
|
|
suffix : string;
|
|
begin
|
|
case torddef(left.resultdef).ordtype of
|
|
u8bit: suffix:='byte';
|
|
u16bit: suffix:='word';
|
|
u32bit: suffix:='dword';
|
|
u64bit: suffix:='qword';
|
|
else
|
|
internalerror(2012082601);
|
|
end;
|
|
result:=ccallnode.createintern('fpc_popcnt_'+suffix,ccallparanode.create(left,nil));
|
|
left:=nil;
|
|
end;
|
|
|
|
function tinlinenode.first_bitscan: tnode;
|
|
begin
|
|
result:=nil;
|
|
expectloc:=LOC_REGISTER;
|
|
end;
|
|
|
|
|
|
function tinlinenode.typecheck_seg: tnode;
|
|
begin
|
|
if target_info.system in systems_managed_vm then
|
|
message(parser_e_feature_unsupported_for_vm);
|
|
set_varstate(left,vs_read,[]);
|
|
result:=cordconstnode.create(0,s32inttype,false);
|
|
end;
|
|
|
|
|
|
function tinlinenode.first_seg: tnode;
|
|
begin
|
|
internalerror(200104046);
|
|
result:=nil;
|
|
end;
|
|
|
|
|
|
function tinlinenode.first_sar: tnode;
|
|
begin
|
|
result:=nil;
|
|
expectloc:=LOC_REGISTER;
|
|
{$if not defined(cpu64bitalu) and not defined(cpucg64shiftsupport)}
|
|
if is_64bitint(resultdef) then
|
|
begin
|
|
if (inlinenumber=in_sar_x) then
|
|
left:=ccallparanode.create(cordconstnode.create(1,u8inttype,false),
|
|
ccallparanode.create(left,nil));
|
|
result:=ccallnode.createintern('fpc_sarint64',left);
|
|
left:=nil;
|
|
end;
|
|
{$endif not defined(cpu64bitalu) and not defined(cpucg64shiftsupport)}
|
|
end;
|
|
|
|
|
|
function tinlinenode.handle_box: tnode;
|
|
begin
|
|
result:=nil;
|
|
if not assigned(left) or
|
|
assigned(tcallparanode(left).right) then
|
|
CGMessage1(parser_e_wrong_parameter_size,'FpcInternalBox');
|
|
resultdef:=class_tobject;
|
|
end;
|
|
|
|
|
|
function tinlinenode.handle_unbox: tnode;
|
|
begin
|
|
result:=nil;
|
|
if not assigned(left) or
|
|
not assigned(tcallparanode(left).right) or
|
|
assigned(tcallparanode(tcallparanode(left).right).right) then
|
|
CGMessage1(parser_e_wrong_parameter_size,'FpcInternalUnBox');
|
|
if tcallparanode(left).left.nodetype<>typen then
|
|
internalerror(2011071701);
|
|
ttypenode(tcallparanode(left).left).allowed:=true;
|
|
resultdef:=tcallparanode(left).left.resultdef;
|
|
end;
|
|
|
|
function tinlinenode.handle_insert: tnode;
|
|
|
|
procedure do_error;
|
|
begin
|
|
CGMessagePos1(fileinfo,parser_e_wrong_parameter_size,'Insert');
|
|
write_system_parameter_lists('fpc_shortstr_insert');
|
|
write_system_parameter_lists('fpc_shortstr_insert_char');
|
|
write_system_parameter_lists('fpc_unicodestr_insert');
|
|
if tf_winlikewidestring in target_info.flags then
|
|
write_system_parameter_lists('fpc_widestr_insert');
|
|
write_system_parameter_lists('fpc_ansistr_insert');
|
|
MessagePos1(fileinfo,sym_e_param_list,'Insert(Dynamic Array;var Dynamic Array;'+sinttype.typename+');');
|
|
MessagePos1(fileinfo,sym_e_param_list,'Insert(Element;var Dynamic Array;'+sinttype.typename+');');
|
|
end;
|
|
|
|
var
|
|
procname : String;
|
|
newn,
|
|
datan,
|
|
datacountn,
|
|
firstn,
|
|
secondn : tnode;
|
|
first,
|
|
second : tdef;
|
|
isconstr,
|
|
iscomparray,
|
|
iscompelem : boolean;
|
|
datatemp : ttempcreatenode;
|
|
insertblock : tblocknode;
|
|
insertstatement : tstatementnode;
|
|
begin
|
|
if not assigned(left) or
|
|
not assigned(tcallparanode(left).right) or
|
|
not assigned(tcallparanode(tcallparanode(left).right).right) or
|
|
assigned(tcallparanode(tcallparanode(tcallparanode(left).right).right).right) then
|
|
begin
|
|
do_error;
|
|
exit(cerrornode.create);
|
|
end;
|
|
{ determine the correct function based on the second parameter }
|
|
firstn:=tcallparanode(tcallparanode(tcallparanode(left).right).right).left;
|
|
first:=firstn.resultdef;
|
|
secondn:=tcallparanode(tcallparanode(left).right).left;
|
|
second:=secondn.resultdef;
|
|
if is_shortstring(second) then
|
|
begin
|
|
if is_char(first) then
|
|
procname:='fpc_shortstr_insert_char'
|
|
else
|
|
procname:='fpc_shortstr_insert';
|
|
end
|
|
else if is_unicodestring(second) then
|
|
procname:='fpc_unicodestr_insert'
|
|
else if is_widestring(second) then
|
|
procname:='fpc_widestr_insert'
|
|
else if is_ansistring(second) then
|
|
procname:='fpc_ansistr_insert'
|
|
else if is_dynamic_array(second) then
|
|
begin
|
|
{ The first parameter needs to be
|
|
a) a dynamic array of the same type
|
|
b) a single element of the same type
|
|
c) a static array of the same type (not Delphi compatible)
|
|
}
|
|
isconstr:=is_array_constructor(first);
|
|
iscomparray:=(first.typ=arraydef) and equal_defs(tarraydef(first).elementdef,tarraydef(second).elementdef);
|
|
iscompelem:=compare_defs(first,tarraydef(second).elementdef,niln)<>te_incompatible;
|
|
if not iscomparray
|
|
and not iscompelem
|
|
and not isconstr then
|
|
begin
|
|
CGMessagePos(fileinfo,type_e_array_required);
|
|
exit(cerrornode.create);
|
|
end;
|
|
insertblock:=internalstatements(insertstatement);
|
|
datatemp:=nil;
|
|
if iscomparray then
|
|
begin
|
|
datatemp:=ctempcreatenode.create_value(first,first.size,tt_normal,false,firstn);
|
|
addstatement(insertstatement,datatemp);
|
|
if is_dynamic_array(first) then
|
|
datan:=ctypeconvnode.create_internal(ctemprefnode.create(datatemp),voidpointertype)
|
|
else
|
|
datan:=caddrnode.create_internal(cvecnode.create(ctemprefnode.create(datatemp),cordconstnode.create(0,sizesinttype,false)));
|
|
datacountn:=cinlinenode.create(in_length_x,false,ctemprefnode.create(datatemp));
|
|
end
|
|
else if isconstr then
|
|
begin
|
|
inserttypeconv(firstn,second);
|
|
datatemp:=ctempcreatenode.create_value(second,second.size,tt_normal,false,firstn);
|
|
addstatement(insertstatement,datatemp);
|
|
datan:=ctypeconvnode.create_internal(ctemprefnode.create(datatemp),voidpointertype);
|
|
datacountn:=cinlinenode.create(in_length_x,false,ctemprefnode.create(datatemp));
|
|
end
|
|
else
|
|
begin
|
|
if is_const(firstn) then
|
|
begin
|
|
datatemp:=ctempcreatenode.create_value(tarraydef(second).elementdef,tarraydef(second).elementdef.size,tt_normal,false,firstn);
|
|
addstatement(insertstatement,datatemp);
|
|
datan:=caddrnode.create_internal(ctemprefnode.create(datatemp));
|
|
end
|
|
else
|
|
begin
|
|
datan:=firstn;
|
|
inserttypeconv(datan,tarraydef(second).elementdef);
|
|
datan:=caddrnode.create_internal(datan);
|
|
end;
|
|
datacountn:=cordconstnode.create(1,sizesinttype,false);
|
|
end;
|
|
procname:='fpc_dynarray_insert';
|
|
{ recreate the parameters as array pointer, source, data, count, typeinfo }
|
|
newn:=ccallparanode.create(caddrnode.create_internal(crttinode.create(tstoreddef(second),initrtti,rdt_normal)),
|
|
ccallparanode.create(datacountn,
|
|
ccallparanode.create(datan,
|
|
ccallparanode.create(tcallparanode(left).left,
|
|
ccallparanode.create(ctypeconvnode.create_internal(secondn,voidpointertype),nil)))));
|
|
addstatement(insertstatement,ccallnode.createintern(procname,newn));
|
|
if assigned(datatemp) then
|
|
addstatement(insertstatement,ctempdeletenode.create(datatemp));
|
|
tcallparanode(tcallparanode(tcallparanode(left).right).right).left:=nil; // insert idx
|
|
tcallparanode(tcallparanode(left).right).left:=nil; // dyn array
|
|
tcallparanode(left).left:=nil; // insert element/array
|
|
left.free;
|
|
left:=nil;
|
|
result:=insertblock;
|
|
exit; { ! }
|
|
end
|
|
else if second.typ=undefineddef then
|
|
{ just pick one }
|
|
procname:='fpc_ansistr_insert'
|
|
else
|
|
begin
|
|
do_error;
|
|
exit(cerrornode.create);
|
|
end;
|
|
result:=ccallnode.createintern(procname,left);
|
|
left:=nil;
|
|
end;
|
|
|
|
function tinlinenode.handle_delete: tnode;
|
|
|
|
procedure do_error;
|
|
begin
|
|
CGMessagePos1(fileinfo,parser_e_wrong_parameter_size,'Delete');
|
|
write_system_parameter_lists('fpc_shortstr_delete');
|
|
write_system_parameter_lists('fpc_unicodestr_delete');
|
|
if tf_winlikewidestring in target_info.flags then
|
|
write_system_parameter_lists('fpc_widestr_delete');
|
|
write_system_parameter_lists('fpc_ansistr_delete');
|
|
MessagePos1(fileinfo,sym_e_param_list,'Delete(var Dynamic Array;'+sinttype.typename+';'+sinttype.typename+');');
|
|
end;
|
|
|
|
var
|
|
procname : String;
|
|
first : tdef;
|
|
firstn,
|
|
newn : tnode;
|
|
begin
|
|
if not assigned(left) or
|
|
not assigned(tcallparanode(left).right) or
|
|
not assigned(tcallparanode(tcallparanode(left).right).right) or
|
|
assigned(tcallparanode(tcallparanode(tcallparanode(left).right).right).right) then
|
|
begin
|
|
do_error;
|
|
exit(cerrornode.create);
|
|
end;
|
|
{ determine the correct function based on the first parameter }
|
|
firstn:=tcallparanode(tcallparanode(tcallparanode(left).right).right).left;
|
|
first:=firstn.resultdef;
|
|
if is_shortstring(first) then
|
|
procname:='fpc_shortstr_delete'
|
|
else if is_unicodestring(first) then
|
|
procname:='fpc_unicodestr_delete'
|
|
else if is_widestring(first) then
|
|
procname:='fpc_widestr_delete'
|
|
else if is_ansistring(first) then
|
|
procname:='fpc_ansistr_delete'
|
|
else if is_dynamic_array(first) then
|
|
begin
|
|
procname:='fpc_dynarray_delete';
|
|
{ recreate the parameters as array pointer, src, count, typeinfo }
|
|
newn:=ccallparanode.create(caddrnode.create_internal
|
|
(crttinode.create(tstoreddef(first),initrtti,rdt_normal)),
|
|
ccallparanode.create(tcallparanode(left).left,
|
|
ccallparanode.create(tcallparanode(tcallparanode(left).right).left,
|
|
ccallparanode.create(ctypeconvnode.create_internal(firstn,voidpointertype),nil))));
|
|
tcallparanode(tcallparanode(tcallparanode(left).right).right).left:=nil;
|
|
tcallparanode(tcallparanode(left).right).left:=nil;
|
|
tcallparanode(left).left:=nil;
|
|
left.free;
|
|
left:=newn;
|
|
end
|
|
else if first.typ=undefineddef then
|
|
{ just pick one }
|
|
procname:='fpc_ansistr_delete'
|
|
else
|
|
begin
|
|
do_error;
|
|
exit(cerrornode.create);
|
|
end;
|
|
result:=ccallnode.createintern(procname,left);
|
|
left:=nil;
|
|
end;
|
|
|
|
|
|
function tinlinenode.handle_concat:tnode;
|
|
|
|
procedure do_error;
|
|
begin
|
|
CGMessagePos1(fileinfo,parser_e_wrong_parameter_size,'Concat');
|
|
MessagePos1(fileinfo,sym_e_param_list,'Concat(String[;String;...])');
|
|
MessagePos1(fileinfo,sym_e_param_list,'Concat(Dynamic Array[;Dynamic Array;...])');
|
|
end;
|
|
|
|
var
|
|
cpn : tcallparanode;
|
|
list : tfpobjectlist;
|
|
n,
|
|
arrn,
|
|
firstn : tnode;
|
|
i : longint;
|
|
arrconstr : tarrayconstructornode;
|
|
newstatement : tstatementnode;
|
|
tempnode : ttempcreatenode;
|
|
lastchanged : boolean;
|
|
begin
|
|
if not assigned(left) then
|
|
begin
|
|
do_error;
|
|
exit(cerrornode.create);
|
|
end;
|
|
result:=nil;
|
|
{ the arguments are right to left, but we need to work on them from
|
|
left to right, so insert them in a list and process that from back
|
|
to front }
|
|
list:=tfpobjectlist.create(false);
|
|
{ remember the last (aka first) dynamic array parameter (important
|
|
in case of array constructors) }
|
|
arrn:=nil;
|
|
cpn:=tcallparanode(left);
|
|
while assigned(cpn) do
|
|
begin
|
|
list.add(cpn.left);
|
|
if is_dynamic_array(cpn.left.resultdef) then
|
|
arrn:=cpn.left;
|
|
cpn.left:=nil;
|
|
cpn:=tcallparanode(cpn.right);
|
|
end;
|
|
|
|
if list.count=0 then
|
|
internalerror(2017100901);
|
|
|
|
firstn:=tnode(list.last);
|
|
if not assigned(firstn) then
|
|
internalerror(2017100902);
|
|
|
|
{ are we dealing with strings or dynamic arrays? }
|
|
if is_dynamic_array(firstn.resultdef) or is_array_constructor(firstn.resultdef) then
|
|
begin
|
|
{ try to combine all consecutive array constructors }
|
|
lastchanged:=false;
|
|
i:=0;
|
|
repeat
|
|
if lastchanged or is_array_constructor(tnode(list[i]).resultdef) then
|
|
begin
|
|
if (i<list.count-1) and is_array_constructor(tnode(list[i+1]).resultdef) then
|
|
begin
|
|
arrconstr:=tarrayconstructornode(list[i+1]);
|
|
while assigned(arrconstr.right) do
|
|
arrconstr:=tarrayconstructornode(arrconstr.right);
|
|
arrconstr.right:=tnode(list[i]);
|
|
list[i]:=list[i+1];
|
|
list.delete(i+1);
|
|
lastchanged:=true;
|
|
tnode(list[i]).resultdef:=nil;
|
|
{ don't increase index! }
|
|
continue;
|
|
end;
|
|
if lastchanged then
|
|
begin
|
|
{ we concatted all consecutive ones, so typecheck the new one again }
|
|
n:=tnode(list[i]);
|
|
typecheckpass(n);
|
|
list[i]:=n;
|
|
end;
|
|
lastchanged:=false;
|
|
end;
|
|
inc(i);
|
|
until i=list.count;
|
|
|
|
if list.count=1 then
|
|
begin
|
|
{ no need to call the concat helper }
|
|
result:=firstn;
|
|
end
|
|
else
|
|
begin
|
|
{ if we reach this point then the concat list didn't consist
|
|
solely of array constructors }
|
|
if not assigned(arrn) then
|
|
internalerror(2017101001);
|
|
|
|
result:=internalstatements(newstatement);
|
|
|
|
{ generate the open array constructor for the source arrays
|
|
note: the order needs to be swapped again here! }
|
|
arrconstr:=nil;
|
|
for i:=0 to list.count-1 do
|
|
begin
|
|
n:=tnode(list[i]);
|
|
{ first convert to the target type }
|
|
if not is_array_constructor(n.resultdef) then
|
|
inserttypeconv(n,arrn.resultdef);
|
|
{ we need to ensure that we get a reference counted
|
|
assignement for the temp array }
|
|
tempnode:=ctempcreatenode.create(arrn.resultdef,arrn.resultdef.size,tt_persistent,true);
|
|
addstatement(newstatement,tempnode);
|
|
addstatement(newstatement,cassignmentnode.create(ctemprefnode.create(tempnode),n));
|
|
addstatement(newstatement,ctempdeletenode.create_normal_temp(tempnode));
|
|
n:=ctemprefnode.create(tempnode);
|
|
{ then to a plain pointer for the helper }
|
|
inserttypeconv_internal(n,voidpointertype);
|
|
arrconstr:=carrayconstructornode.create(n,arrconstr);
|
|
end;
|
|
Include(arrconstr.arrayconstructornodeflags,acnf_allow_array_constructor);
|
|
|
|
{ based on the code from nopt.genmultistringadd() }
|
|
tempnode:=ctempcreatenode.create(arrn.resultdef,arrn.resultdef.size,tt_persistent,true);
|
|
addstatement(newstatement,tempnode);
|
|
{ initialize the temp, since it will be passed to a
|
|
var-parameter (and finalization, which is performed by the
|
|
ttempcreate node and which takes care of the initialization
|
|
on native targets, is a noop on managed VM targets) }
|
|
if (target_info.system in systems_managed_vm) and
|
|
is_managed_type(arrn.resultdef) then
|
|
addstatement(newstatement,cinlinenode.create(in_setlength_x,
|
|
false,
|
|
ccallparanode.create(genintconstnode(0),
|
|
ccallparanode.create(ctemprefnode.create(tempnode),nil))));
|
|
|
|
cpn:=ccallparanode.create(
|
|
arrconstr,
|
|
ccallparanode.create(
|
|
caddrnode.create_internal(crttinode.create(tstoreddef(arrn.resultdef),initrtti,rdt_normal)),
|
|
ccallparanode.create(ctypeconvnode.create_internal(ctemprefnode.create(tempnode),voidpointertype),nil))
|
|
);
|
|
addstatement(
|
|
newstatement,
|
|
ccallnode.createintern(
|
|
'fpc_dynarray_concat_multi',
|
|
cpn
|
|
)
|
|
);
|
|
addstatement(newstatement,ctempdeletenode.create_normal_temp(tempnode));
|
|
addstatement(newstatement,ctemprefnode.create(tempnode));
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
{ enforce strings }
|
|
for i:=list.count-1 downto 0 do
|
|
begin
|
|
if assigned(result) then
|
|
result:=caddnode.create(addn,result,tnode(list[i]))
|
|
else
|
|
begin
|
|
result:=tnode(list[i]);
|
|
{ Force string type if it isn't yet }
|
|
if not(
|
|
(result.resultdef.typ=stringdef) or
|
|
is_chararray(result.resultdef) or
|
|
is_char(result.resultdef)
|
|
) then
|
|
inserttypeconv(result,cshortstringtype);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
list.free;
|
|
end;
|
|
|
|
|
|
function tinlinenode.first_pack_unpack: tnode;
|
|
var
|
|
loopstatement : tstatementnode;
|
|
loop : tblocknode;
|
|
loopvar : ttempcreatenode;
|
|
tempnode,
|
|
source,
|
|
target,
|
|
index,
|
|
unpackednode,
|
|
packednode,
|
|
sourcevecindex,
|
|
targetvecindex,
|
|
loopbody : tnode;
|
|
temprangedef : tdef;
|
|
ulorange,
|
|
uhirange,
|
|
plorange,
|
|
phirange : TConstExprInt;
|
|
begin
|
|
{ transform into a for loop which assigns the data of the (un)packed }
|
|
{ array to the other one }
|
|
source := left;
|
|
if (inlinenumber = in_unpack_x_y_z) then
|
|
begin
|
|
target := tcallparanode(source).right;
|
|
index := tcallparanode(target).right;
|
|
packednode := tcallparanode(source).left;
|
|
unpackednode := tcallparanode(target).left;
|
|
end
|
|
else
|
|
begin
|
|
index := tcallparanode(source).right;
|
|
target := tcallparanode(index).right;
|
|
packednode := tcallparanode(target).left;
|
|
unpackednode := tcallparanode(source).left;
|
|
end;
|
|
source := tcallparanode(source).left;
|
|
target := tcallparanode(target).left;
|
|
index := tcallparanode(index).left;
|
|
|
|
loop := internalstatements(loopstatement);
|
|
loopvar := ctempcreatenode.create(
|
|
tarraydef(packednode.resultdef).rangedef,
|
|
tarraydef(packednode.resultdef).rangedef.size,
|
|
tt_persistent,true);
|
|
addstatement(loopstatement,loopvar);
|
|
|
|
{ For range checking: we have to convert to an integer type (in case the index type }
|
|
{ is an enum), add the index and loop variable together, convert the result }
|
|
{ implicitly to an orddef with range equal to the rangedef to get range checking }
|
|
{ and finally convert it explicitly back to the actual rangedef to avoid type }
|
|
{ errors }
|
|
temprangedef:=nil;
|
|
getrange(unpackednode.resultdef,ulorange,uhirange);
|
|
getrange(packednode.resultdef,plorange,phirange);
|
|
{ does not really need to be registered, but then we would have to
|
|
record it elsewhere so it still can be freed }
|
|
temprangedef:=corddef.create(torddef(sinttype).ordtype,ulorange,uhirange,true);
|
|
sourcevecindex := ctemprefnode.create(loopvar);
|
|
targetvecindex := ctypeconvnode.create_internal(index.getcopy,sinttype);
|
|
targetvecindex := caddnode.create(subn,targetvecindex,cordconstnode.create(plorange,sinttype,true));
|
|
targetvecindex := caddnode.create(addn,targetvecindex,ctemprefnode.create(loopvar));
|
|
targetvecindex := ctypeconvnode.create(targetvecindex,temprangedef);
|
|
targetvecindex := ctypeconvnode.create_explicit(targetvecindex,tarraydef(unpackednode.resultdef).rangedef);
|
|
|
|
if (inlinenumber = in_pack_x_y_z) then
|
|
begin
|
|
{ swap source and target vec indices }
|
|
tempnode := sourcevecindex;
|
|
sourcevecindex := targetvecindex;
|
|
targetvecindex := tempnode;
|
|
end;
|
|
|
|
{ create the assignment in the loop body }
|
|
loopbody :=
|
|
cassignmentnode.create(
|
|
cvecnode.create(target.getcopy,targetvecindex),
|
|
cvecnode.create(source.getcopy,sourcevecindex)
|
|
);
|
|
{ create the actual for loop }
|
|
tempnode := cfornode.create(
|
|
ctemprefnode.create(loopvar),
|
|
cinlinenode.create(in_low_x,false,packednode.getcopy),
|
|
cinlinenode.create(in_high_x,false,packednode.getcopy),
|
|
loopbody,
|
|
false);
|
|
addstatement(loopstatement,tempnode);
|
|
{ free the loop counter }
|
|
addstatement(loopstatement,ctempdeletenode.create(loopvar));
|
|
result := loop;
|
|
end;
|
|
|
|
function tinlinenode.may_have_sideeffect_norecurse: boolean;
|
|
begin
|
|
result:=
|
|
(inlinenumber in [in_write_x,in_writeln_x,in_read_x,in_readln_x,in_str_x_string,
|
|
in_val_x,in_reset_x,in_rewrite_x,in_reset_typedfile,in_rewrite_typedfile,
|
|
in_reset_typedfile_name,in_rewrite_typedfile_name,in_settextbuf_file_x,
|
|
in_inc_x,in_dec_x,in_include_x_y,in_exclude_x_y,in_break,in_continue,in_setlength_x,
|
|
in_finalize_x,in_new_x,in_dispose_x,in_exit,in_copy_x,in_initialize_x,in_leave,in_cycle,
|
|
in_and_assign_x_y,in_or_assign_x_y,in_xor_assign_x_y,in_sar_assign_x_y,in_shl_assign_x_y,
|
|
in_shr_assign_x_y,in_rol_assign_x_y,in_ror_assign_x_y,in_neg_assign_x,in_not_assign_x]) or
|
|
((inlinenumber = in_assert_x_y) and
|
|
(cs_do_assertion in localswitches));
|
|
end;
|
|
|
|
|
|
function tinlinenode.first_fma: tnode;
|
|
begin
|
|
CGMessage1(cg_e_function_not_support_by_selected_instruction_set,'FMA');
|
|
result:=nil;
|
|
end;
|
|
|
|
|
|
function tinlinenode.first_minmax: tnode;
|
|
begin
|
|
CGMessage1(cg_e_function_not_support_by_selected_instruction_set,'MIN/MAX');
|
|
result:=nil;
|
|
end;
|
|
|
|
//
|
|
//||||||| .merge-left.r31134
|
|
//
|
|
//{$ifdef ARM}
|
|
// {$i armtype.inc}
|
|
//{$endif ARM}
|
|
//=======
|
|
//
|
|
//{$ifdef x86}
|
|
// {$i x86type.inc}
|
|
//{$endif x86}
|
|
//{$ifdef ARM}
|
|
// {$i armtype.inc}
|
|
//{$endif ARM}
|
|
{$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
|
|
function tinlinenode.first_ShiftRot_assign_64bitint: tnode;
|
|
var
|
|
procname: string[31];
|
|
begin
|
|
{$ifdef cpucg64shiftsupport}
|
|
if inlinenumber in [in_sar_assign_x_y,in_shl_assign_x_y,in_shr_assign_x_y] then
|
|
begin
|
|
result:=nil;
|
|
expectloc:=tcallparanode(tcallparanode(left).right).left.expectloc;
|
|
exit;
|
|
end;
|
|
{$endif cpucg64shiftsupport}
|
|
result := nil;
|
|
if is_signed(tcallparanode(left).right.resultdef) then
|
|
procname:='int64'
|
|
else
|
|
procname:='qword';
|
|
case inlinenumber of
|
|
in_sar_assign_x_y:
|
|
procname := 'fpc_sar_assign_'+procname;
|
|
in_shl_assign_x_y:
|
|
procname := 'fpc_shl_assign_'+procname;
|
|
in_shr_assign_x_y:
|
|
procname := 'fpc_shr_assign_'+procname;
|
|
in_rol_assign_x_y:
|
|
procname := 'fpc_rol_assign_'+procname;
|
|
in_ror_assign_x_y:
|
|
procname := 'fpc_ror_assign_'+procname;
|
|
else
|
|
internalerror(2017041301);
|
|
end;
|
|
result := ccallnode.createintern(procname,ccallparanode.create(tcallparanode(left).left,
|
|
ccallparanode.create(tcallparanode(tcallparanode(left).right).left,nil)));
|
|
tcallparanode(tcallparanode(left).right).left := nil;
|
|
tcallparanode(left).left := nil;
|
|
firstpass(result);
|
|
end;
|
|
{$endif not cpu64bitalu and nto cpuhighleveltarget}
|
|
|
|
|
|
function tinlinenode.first_AndOrXorShiftRot_assign: tnode;
|
|
begin
|
|
{$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
|
|
{ 64 bit ints have their own shift handling }
|
|
if is_64bit(tcallparanode(left).right.resultdef) and
|
|
(inlinenumber in [in_sar_assign_x_y,in_shl_assign_x_y,in_shr_assign_x_y,in_rol_assign_x_y,in_ror_assign_x_y]) then
|
|
result := first_ShiftRot_assign_64bitint
|
|
else
|
|
{$endif not cpu64bitalu and not cpuhighleveltarget}
|
|
begin
|
|
result:=nil;
|
|
expectloc:=tcallparanode(tcallparanode(left).right).left.expectloc;
|
|
end;
|
|
end;
|
|
|
|
|
|
function tinlinenode.first_NegNot_assign: tnode;
|
|
begin
|
|
result:=nil;
|
|
expectloc:=left.expectloc;
|
|
end;
|
|
|
|
|
|
function tinlinenode.first_cpu : tnode;
|
|
begin
|
|
Result:=nil;
|
|
internalerror(2017110101);
|
|
end;
|
|
|
|
|
|
procedure tinlinenode.CheckParameters(count: integer);
|
|
var
|
|
p: tnode;
|
|
begin
|
|
if count=1 then
|
|
begin
|
|
// Sometimes there are more callparanodes
|
|
if left is tcallparanode then
|
|
set_varstate(tcallparanode(left).left,vs_read,[vsf_must_be_valid])
|
|
else
|
|
set_varstate(left,vs_read,[vsf_must_be_valid])
|
|
end
|
|
else
|
|
begin
|
|
p:=left;
|
|
while count>0 do
|
|
begin
|
|
set_varstate(tcallparanode(p).left,vs_read,[vsf_must_be_valid]);
|
|
|
|
p:=tcallparanode(p).right;
|
|
dec(count);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
end.
|
|
|