mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-15 16:43:21 +01:00
c7fbf7b11b
tree
+ support for inlining value and const parameters at the node level
(all procedures without local variables and without formal parameters
can now be inlined at the node level)
2469 lines
94 KiB
ObjectPascal
2469 lines
94 KiB
ObjectPascal
{
|
|
$Id$
|
|
Copyright (c) 1998-2002 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,cpuinfo,symtype;
|
|
|
|
{$i compinnr.inc}
|
|
|
|
type
|
|
tinlinenode = class(tunarynode)
|
|
inlinenumber : byte;
|
|
constructor create(number : byte;is_const:boolean;l : tnode);virtual;
|
|
constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
|
|
procedure ppuwrite(ppufile:tcompilerppufile);override;
|
|
function getcopy : tnode;override;
|
|
function pass_1 : tnode;override;
|
|
function det_resulttype:tnode;override;
|
|
function docompare(p: tnode): boolean; override;
|
|
{ All the following routines currently
|
|
call compilerproc's, unless they are
|
|
overriden 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;
|
|
private
|
|
function handle_str: tnode;
|
|
function handle_reset_rewrite_typed: tnode;
|
|
function handle_read_write: tnode;
|
|
function handle_val: tnode;
|
|
end;
|
|
tinlinenodeclass = class of tinlinenode;
|
|
|
|
var
|
|
cinlinenode : tinlinenodeclass;
|
|
|
|
function geninlinenode(number : byte;is_const:boolean;l : tnode) : tinlinenode;
|
|
|
|
implementation
|
|
|
|
uses
|
|
verbose,globals,systems,
|
|
globtype, cutils,
|
|
symbase,symconst,symdef,symsym,symtable,paramgr,defutil,defcmp,
|
|
pass_1,
|
|
ncal,ncon,ncnv,nadd,nld,nbas,nflw,nmem,nmat,nutils,
|
|
cgbase,procinfo
|
|
;
|
|
|
|
function geninlinenode(number : byte;is_const:boolean;l : tnode) : tinlinenode;
|
|
|
|
begin
|
|
geninlinenode:=cinlinenode.create(number,is_const,l);
|
|
end;
|
|
|
|
{*****************************************************************************
|
|
TINLINENODE
|
|
*****************************************************************************}
|
|
|
|
constructor tinlinenode.create(number : byte;is_const:boolean;l : tnode);
|
|
|
|
begin
|
|
inherited create(inlinen,l);
|
|
if is_const then
|
|
include(flags,nf_inlineconst);
|
|
inlinenumber:=number;
|
|
end;
|
|
|
|
|
|
constructor tinlinenode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
|
|
begin
|
|
inherited ppuload(t,ppufile);
|
|
inlinenumber:=ppufile.getbyte;
|
|
end;
|
|
|
|
|
|
procedure tinlinenode.ppuwrite(ppufile:tcompilerppufile);
|
|
begin
|
|
inherited ppuwrite(ppufile);
|
|
ppufile.putbyte(inlinenumber);
|
|
end;
|
|
|
|
|
|
function tinlinenode.getcopy : tnode;
|
|
var
|
|
n : tinlinenode;
|
|
begin
|
|
n:=tinlinenode(inherited getcopy);
|
|
n.inlinenumber:=inlinenumber;
|
|
result:=n;
|
|
end;
|
|
|
|
|
|
function tinlinenode.handle_str : tnode;
|
|
var
|
|
lenpara,
|
|
fracpara,
|
|
newparas,
|
|
dest,
|
|
source : tcallparanode;
|
|
procname: string;
|
|
is_real : boolean;
|
|
|
|
begin
|
|
result := cerrornode.create;
|
|
|
|
{ make sure we got at least two parameters (if we got only one, }
|
|
{ this parameter may not be encapsulated in a callparan) }
|
|
if not assigned(left) or
|
|
(left.nodetype <> callparan) then
|
|
begin
|
|
CGMessage(parser_e_wrong_parameter_size);
|
|
exit;
|
|
end;
|
|
{ get destination string }
|
|
dest := tcallparanode(left);
|
|
|
|
{ get source para (number) }
|
|
source := dest;
|
|
while assigned(source.right) do
|
|
source := tcallparanode(source.right);
|
|
is_real := source.resulttype.def.deftype = floatdef;
|
|
|
|
if not assigned(dest) or
|
|
((dest.left.resulttype.def.deftype<>stringdef) and
|
|
not(is_chararray(dest.left.resulttype.def))) or
|
|
not(is_real or
|
|
(source.left.resulttype.def.deftype = orddef)) then
|
|
begin
|
|
{ the parser will give this message already because we }
|
|
{ return an errornode (JM) }
|
|
{ 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.resulttype.def) then
|
|
begin
|
|
CGMessagePos1(lenpara.fileinfo,
|
|
type_e_integer_expr_expected,lenpara.resulttype.def.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.resulttype.def) then
|
|
begin
|
|
CGMessagePos1(lenpara.fileinfo,
|
|
type_e_integer_expr_expected,lenpara.resulttype.def.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 }
|
|
newparas.right := ccallparanode.create(cordconstnode.create(
|
|
ord(tfloatdef(source.left.resulttype.def).typ),s32inttype,true),
|
|
newparas.right);
|
|
{ if necessary, insert a fraction parameter }
|
|
if not assigned(fracpara) then
|
|
begin
|
|
tcallparanode(newparas.right).right := ccallparanode.create(
|
|
cordconstnode.create(-1,s32inttype,false),
|
|
tcallparanode(newparas.right).right);
|
|
fracpara := tcallparanode(tcallparanode(newparas.right).right);
|
|
end;
|
|
{ if necessary, insert a length para }
|
|
if not assigned(lenpara) then
|
|
fracpara.right := ccallparanode.create(
|
|
cordconstnode.create(-32767,s32inttype,false),
|
|
fracpara.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(-1,s32inttype,false),
|
|
newparas.right);
|
|
|
|
{ remove the parameters from the original node so they won't get disposed, }
|
|
{ since they're reused }
|
|
left := nil;
|
|
|
|
{ create procedure name }
|
|
if is_chararray(dest.resulttype.def) then
|
|
procname:='fpc_chararray_'
|
|
else
|
|
procname := 'fpc_' + tstringdef(dest.resulttype.def).stringtypname+'_';
|
|
if is_real then
|
|
procname := procname + 'float'
|
|
else
|
|
case torddef(source.resulttype.def).typ of
|
|
{$ifdef cpu64bit}
|
|
u64bit:
|
|
procname := procname + 'uint';
|
|
{$else}
|
|
u32bit:
|
|
procname := procname + 'uint';
|
|
u64bit:
|
|
procname := procname + 'qword';
|
|
scurrency,
|
|
s64bit:
|
|
procname := procname + 'int64';
|
|
{$endif}
|
|
else
|
|
procname := procname + 'sint';
|
|
end;
|
|
|
|
{ free the errornode we generated in the beginning }
|
|
result.free;
|
|
{ create the call node, }
|
|
result := ccallnode.createintern(procname,newparas);
|
|
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 }
|
|
{ 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.resulttype.def).typedfiletype.def.size,s32inttype,true),
|
|
ccallparanode.create(left,nil));
|
|
{ create the correct call }
|
|
if inlinenumber=in_reset_typedfile then
|
|
result := ccallnode.createintern('fpc_reset_typed',left)
|
|
else
|
|
result := ccallnode.createintern('fpc_rewrite_typed',left);
|
|
{ make sure left doesn't get disposed, since we use it in the new call }
|
|
left := nil;
|
|
end;
|
|
|
|
|
|
function tinlinenode.handle_read_write: tnode;
|
|
|
|
const
|
|
{$ifdef cpu64bit}
|
|
hasownreadfunc = [uchar,uwidechar,bool8bit,bool16bit,bool32bit];
|
|
{$else cpu64bit}
|
|
hasownreadfunc = [uchar,uwidechar,bool8bit,bool16bit,bool32bit,s64bit,u64bit];
|
|
{$endif cpu64bit}
|
|
|
|
procnames: array[boolean,boolean] of string[11] =
|
|
(('write_text_','read_text_'),('typed_write','typed_read'));
|
|
|
|
var
|
|
filepara,
|
|
lenpara,
|
|
fracpara,
|
|
nextpara,
|
|
para : tcallparanode;
|
|
newstatement : tstatementnode;
|
|
newblock : tblocknode;
|
|
p1 : tnode;
|
|
filetemp,
|
|
temp : ttempcreatenode;
|
|
procprefix,
|
|
name : string[31];
|
|
srsym : tvarsym;
|
|
tempowner : tsymtable;
|
|
restype : ^ttype;
|
|
is_typed,
|
|
do_read,
|
|
is_real,
|
|
error_para,
|
|
found_error,
|
|
is_ordinal : boolean;
|
|
begin
|
|
filepara := nil;
|
|
is_typed := false;
|
|
filetemp := nil;
|
|
do_read := inlinenumber in [in_read_x,in_readln_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) }
|
|
left := reverseparameters(tcallparanode(left));
|
|
|
|
if assigned(left) then
|
|
begin
|
|
{ check if we have a file parameter and if yes, what kind it is }
|
|
filepara := tcallparanode(left);
|
|
|
|
if (filepara.resulttype.def.deftype=filedef) then
|
|
begin
|
|
if (tfiledef(filepara.resulttype.def).filetyp=ft_untyped) then
|
|
begin
|
|
CGMessagePos(fileinfo,type_e_no_read_write_for_untyped_file);
|
|
exit;
|
|
end
|
|
else
|
|
begin
|
|
if (tfiledef(filepara.resulttype.def).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;
|
|
|
|
{ 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 we don't have a filepara, create one containing the default }
|
|
if not assigned(filepara) then
|
|
begin
|
|
{ retrieve the symbols for standard input/output handle }
|
|
if do_read then
|
|
name := 'INPUT'
|
|
else
|
|
name := 'OUTPUT';
|
|
if not searchsysvar(name,srsym,tempowner) then
|
|
internalerror(200108141);
|
|
|
|
{ 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_reg(voidpointertype,voidpointertype.def.size,tt_persistent);
|
|
addstatement(newstatement,filetemp);
|
|
|
|
{ make sure the resulttype 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 resulttype later on and temprefs can only be }
|
|
{ resulttypepassed if the resulttype of the temp is known) }
|
|
resulttypepass(tnode(filetemp));
|
|
|
|
{ assign the address of the file to the temp }
|
|
addstatement(newstatement,
|
|
cassignmentnode.create(ctemprefnode.create(filetemp),
|
|
caddrnode.create(cloadnode.create(srsym,tempowner))));
|
|
|
|
{ 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) }
|
|
filepara := ccallparanode.create(ctypeconvnode.create_explicit(
|
|
cderefnode.create(ctemprefnode.create(filetemp)),srsym.vartype),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_used,true);
|
|
{ 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_reg(voidpointertype,voidpointertype.def.size,tt_persistent);
|
|
|
|
{ add it to the statements }
|
|
addstatement(newstatement,filetemp);
|
|
|
|
{ make sure the resulttype 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 resulttype later on and temprefs can only be }
|
|
{ resulttypepassed if the resulttype of the temp is known) }
|
|
resulttypepass(tnode(filetemp));
|
|
|
|
{ assign the address of the file to the temp }
|
|
addstatement(newstatement,
|
|
cassignmentnode.create(ctemprefnode.create(filetemp),
|
|
caddrnode.create(filepara.left)));
|
|
resulttypepass(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_explicit(
|
|
cderefnode.create(ctemprefnode.create(filetemp)),filepara.left.resulttype),nil);
|
|
|
|
{ replace the old file para with the new one }
|
|
filepara.left := nil;
|
|
filepara.free;
|
|
filepara := nextpara;
|
|
end;
|
|
end;
|
|
|
|
{ the resulttype 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 }
|
|
|
|
{ choose the correct procedure prefix }
|
|
procprefix := 'fpc_'+procnames[is_typed,do_read];
|
|
|
|
{ we're going to reuse the paranodes, so make sure they don't get freed }
|
|
{ twice }
|
|
para := tcallparanode(left);
|
|
left := nil;
|
|
|
|
{ no errors found yet... }
|
|
found_error := false;
|
|
|
|
if is_typed then
|
|
begin
|
|
{ add the typesize to the filepara }
|
|
filepara.right := ccallparanode.create(cordconstnode.create(
|
|
tfiledef(filepara.resulttype.def).typedfiletype.def.size,s32inttype,true),nil);
|
|
|
|
{ check for "no parameters" (you need at least one extra para for typed files) }
|
|
if not assigned(para) then
|
|
begin
|
|
CGMessage(parser_e_wrong_parameter_size);
|
|
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.resulttype.def.deftype=procvardef) then
|
|
begin
|
|
p1:=ccallnode.create_procvar(nil,para.left);
|
|
resulttypepass(p1);
|
|
para.left:=p1;
|
|
end;
|
|
|
|
inserttypeconv(para.left,tfiledef(filepara.resulttype.def).typedfiletype);
|
|
|
|
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.resulttype,
|
|
para.left.resulttype.def.size,tt_persistent);
|
|
addstatement(newstatement,temp);
|
|
{ assign result to temp }
|
|
addstatement(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(newstatement,ccallnode.createintern(procprefix,para));
|
|
|
|
{ if we used a temp, free it }
|
|
if para.left.nodetype = temprefn then
|
|
addstatement(newstatement,ctempdeletenode.create(temp));
|
|
|
|
{ process next parameter }
|
|
para := nextpara;
|
|
end;
|
|
|
|
{ free the file parameter }
|
|
filepara.free;
|
|
end
|
|
else
|
|
{ text read/write }
|
|
begin
|
|
while assigned(para) do
|
|
begin
|
|
{ is this parameter faulty? }
|
|
error_para := false;
|
|
{ is this parameter an ordinal? }
|
|
is_ordinal := false;
|
|
{ is this parameter a real? }
|
|
is_real:=false;
|
|
|
|
{ can't read/write types }
|
|
if para.left.nodetype=typen then
|
|
begin
|
|
CGMessagePos(para.fileinfo,type_e_cant_read_write_type);
|
|
error_para := true;
|
|
end;
|
|
|
|
{ support writeln(procvar) }
|
|
if (para.left.resulttype.def.deftype=procvardef) then
|
|
begin
|
|
p1:=ccallnode.create_procvar(nil,para.left);
|
|
resulttypepass(p1);
|
|
para.left:=p1;
|
|
end;
|
|
|
|
{ Currency will be written using the bestreal }
|
|
if is_currency(para.left.resulttype.def) then
|
|
inserttypeconv(para.left,pbestrealtype^);
|
|
|
|
case para.left.resulttype.def.deftype of
|
|
stringdef :
|
|
begin
|
|
name := procprefix+tstringdef(para.left.resulttype.def).stringtypname;
|
|
end;
|
|
pointerdef :
|
|
begin
|
|
if not is_pchar(para.left.resulttype.def) then
|
|
begin
|
|
CGMessagePos(para.fileinfo,type_e_cant_read_write_type);
|
|
error_para := true;
|
|
end
|
|
else
|
|
name := procprefix+'pchar_as_pointer';
|
|
end;
|
|
floatdef :
|
|
begin
|
|
is_real:=true;
|
|
name := procprefix+'float';
|
|
end;
|
|
orddef :
|
|
begin
|
|
is_ordinal := true;
|
|
case torddef(para.left.resulttype.def).typ of
|
|
{$ifdef cpu64bit}
|
|
s64bit,
|
|
{$endif cpu64bit}
|
|
s8bit,
|
|
s16bit,
|
|
s32bit :
|
|
name := procprefix+'sint';
|
|
{$ifdef cpu64bit}
|
|
u64bit,
|
|
{$endif cpu64bit}
|
|
u8bit,
|
|
u16bit,
|
|
u32bit :
|
|
name := procprefix+'uint';
|
|
uchar :
|
|
name := procprefix+'char';
|
|
uwidechar :
|
|
name := procprefix+'widechar';
|
|
{$ifndef cpu64bit}
|
|
s64bit :
|
|
name := procprefix+'int64';
|
|
u64bit :
|
|
name := procprefix+'qword';
|
|
{$endif cpu64bit}
|
|
bool8bit,
|
|
bool16bit,
|
|
bool32bit :
|
|
begin
|
|
if do_read then
|
|
begin
|
|
CGMessagePos(para.fileinfo,type_e_cant_read_write_type);
|
|
error_para := true;
|
|
end
|
|
else
|
|
name := procprefix+'boolean'
|
|
end
|
|
else
|
|
begin
|
|
CGMessagePos(para.fileinfo,type_e_cant_read_write_type);
|
|
error_para := true;
|
|
end;
|
|
end;
|
|
end;
|
|
variantdef :
|
|
name:=procprefix+'variant';
|
|
arraydef :
|
|
begin
|
|
if is_chararray(para.left.resulttype.def) then
|
|
name := procprefix+'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;
|
|
|
|
{ check for length/fractional colon para's }
|
|
fracpara := nil;
|
|
lenpara := 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
|
|
{ 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
|
|
lenpara := ccallparanode.create(
|
|
cordconstnode.create(0,sinttype,false),nil)
|
|
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(-32767,sinttype,false),nil);
|
|
{ also create a default fracpara if necessary }
|
|
if not assigned(fracpara) then
|
|
fracpara := ccallparanode.create(
|
|
cordconstnode.create(-1,sinttype,false),nil);
|
|
{ add it to the lenpara }
|
|
lenpara.right := fracpara;
|
|
{ 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.resulttype.def).typ),
|
|
sinttype,true),nil);
|
|
end;
|
|
end;
|
|
|
|
if do_read and
|
|
((is_ordinal and
|
|
not(torddef(para.left.resulttype.def).typ in hasownreadfunc) and
|
|
(para.left.resulttype.def.size<>sinttype.def.size)
|
|
) or
|
|
(is_real and
|
|
not equal_defs(para.left.resulttype.def,pbestrealtype^.def)
|
|
)
|
|
) then
|
|
{ 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 }
|
|
begin
|
|
{ get the resulttype of the var parameter of the helper }
|
|
if is_real then
|
|
restype := pbestrealtype
|
|
else if is_signed(para.left.resulttype.def) then
|
|
restype := @sinttype
|
|
else
|
|
restype := @uinttype;
|
|
|
|
{ create the parameter list: the temp ... }
|
|
temp := ctempcreatenode.create(restype^,restype^.def.size,tt_persistent);
|
|
addstatement(newstatement,temp);
|
|
|
|
{ ... and the file }
|
|
p1 := ccallparanode.create(ctemprefnode.create(temp),
|
|
filepara.getcopy);
|
|
|
|
{ create the call to the helper }
|
|
addstatement(newstatement,
|
|
ccallnode.createintern(name,tcallparanode(p1)));
|
|
|
|
{ assign the result to the original var (this automatically }
|
|
{ takes care of range checking) }
|
|
addstatement(newstatement,
|
|
cassignmentnode.create(para.left,
|
|
ctemprefnode.create(temp)));
|
|
|
|
{ release the temp location }
|
|
addstatement(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 (fracpara and realtype are already linked }
|
|
{ with it if necessary) }
|
|
tcallparanode(para.right).right := lenpara;
|
|
{ create the call statement }
|
|
addstatement(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:
|
|
name:='fpc_read_end';
|
|
in_write_x:
|
|
name:='fpc_write_end';
|
|
in_readln_x:
|
|
name:='fpc_readln_end';
|
|
in_writeln_x:
|
|
name:='fpc_writeln_end';
|
|
end;
|
|
addstatement(newstatement,ccallnode.createintern(name,filepara));
|
|
end;
|
|
end;
|
|
|
|
{ if we found an error, simply delete the generated blocknode }
|
|
if found_error then
|
|
newblock.free
|
|
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 tinlinenode.handle_val: tnode;
|
|
var
|
|
procname,
|
|
suffix : string[31];
|
|
sourcepara,
|
|
destpara,
|
|
codepara,
|
|
sizepara,
|
|
newparas : tcallparanode;
|
|
orgcode : tnode;
|
|
newstatement : tstatementnode;
|
|
newblock : tblocknode;
|
|
tempcode : ttempcreatenode;
|
|
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
|
|
CGMessage(parser_e_wrong_parameter_size);
|
|
exit;
|
|
end;
|
|
|
|
{ reverse parameters for easier processing }
|
|
left := 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
|
|
(
|
|
(codepara.resulttype.def.deftype <> orddef)
|
|
{$ifndef cpu64bit}
|
|
or is_64bitint(codepara.resulttype.def)
|
|
{$endif cpu64bit}
|
|
) then
|
|
begin
|
|
CGMessagePos1(codepara.fileinfo,type_e_integer_expr_expected,codepara.resulttype.def.typename);
|
|
exit;
|
|
end;
|
|
|
|
{ check if dest para is valid }
|
|
if not(destpara.resulttype.def.deftype in [orddef,floatdef]) 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 32bit parameter (we already checked whether the }
|
|
{ the code para, if specified, was an orddef) }
|
|
if not assigned(codepara) or
|
|
(codepara.resulttype.def.size<>sinttype.def.size) then
|
|
begin
|
|
tempcode := ctempcreatenode.create(sinttype,sinttype.def.size,tt_persistent);
|
|
addstatement(newstatement,tempcode);
|
|
{ set the resulttype of the temp (needed to be able to get }
|
|
{ the resulttype of the tempref used in the new code para) }
|
|
resulttypepass(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 resulttype later on }
|
|
codepara.get_paratype;
|
|
end
|
|
else if (torddef(codepara.resulttype.def).typ = torddef(sinttype.def).typ) then
|
|
{ because code is a var parameter, it must match types exactly }
|
|
{ however, since it will return values in [0..255], both longints }
|
|
{ and cardinals are fine. Since the formal code para type is }
|
|
{ longint, insert a typecoversion to longint for cardinal para's }
|
|
begin
|
|
codepara.left := ctypeconvnode.create_explicit(codepara.left,sinttype);
|
|
{ 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.resulttype.def.deftype of
|
|
orddef:
|
|
begin
|
|
case torddef(destpara.resulttype.def).typ of
|
|
{$ifdef cpu64bit}
|
|
scurrency,
|
|
s64bit,
|
|
{$endif cpu64bit}
|
|
s8bit,
|
|
s16bit,
|
|
s32bit:
|
|
begin
|
|
suffix := 'sint_';
|
|
{ we also need a destsize para in this case }
|
|
sizepara := ccallparanode.create(cordconstnode.create
|
|
(destpara.resulttype.def.size,s32inttype,true),nil);
|
|
end;
|
|
{$ifdef cpu64bit}
|
|
u64bit,
|
|
{$endif cpu64bit}
|
|
u8bit,
|
|
u16bit,
|
|
u32bit:
|
|
suffix := 'uint_';
|
|
{$ifndef cpu64bit}
|
|
scurrency,
|
|
s64bit: suffix := 'int64_';
|
|
u64bit: suffix := 'qword_';
|
|
{$endif cpu64bit}
|
|
else
|
|
internalerror(200304225);
|
|
end;
|
|
end;
|
|
floatdef:
|
|
begin
|
|
suffix := 'real_';
|
|
end;
|
|
end;
|
|
|
|
procname := procname + suffix;
|
|
|
|
{ play a trick to have tcallnode handle invalid source parameters: }
|
|
{ the shortstring-longint val routine by default }
|
|
if (sourcepara.resulttype.def.deftype = stringdef) then
|
|
procname := procname + tstringdef(sourcepara.resulttype.def).stringtypname
|
|
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) }
|
|
{ the assignment will take care of rangechecking }
|
|
addstatement(newstatement,cassignmentnode.create(
|
|
destpara.left,ccallnode.createintern(procname,newparas)));
|
|
|
|
{ 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,
|
|
ctemprefnode.create(tempcode)));
|
|
|
|
{ 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;
|
|
|
|
|
|
{$ifdef fpc}
|
|
{$maxfpuregisters 0}
|
|
{$endif fpc}
|
|
|
|
function tinlinenode.det_resulttype:tnode;
|
|
|
|
function do_lowhigh(const t:ttype) : tnode;
|
|
var
|
|
v : tconstexprint;
|
|
enum : tenumsym;
|
|
hp : tnode;
|
|
begin
|
|
case t.def.deftype of
|
|
orddef:
|
|
begin
|
|
if inlinenumber=in_low_x then
|
|
v:=torddef(t.def).low
|
|
else
|
|
v:=torddef(t.def).high;
|
|
{ low/high of torddef are longints, so we need special }
|
|
{ handling for cardinal and 64bit types (JM) }
|
|
{ 1.0.x doesn't support int64($ffffffff) correct, it'll expand
|
|
to -1 instead of staying $ffffffff. Therefor we use $ffff with
|
|
shl twice (PFV) }
|
|
case torddef(t.def).typ of
|
|
s64bit,scurrency :
|
|
begin
|
|
if (inlinenumber=in_low_x) then
|
|
v := int64($80000000) shl 32
|
|
else
|
|
v := (int64($7fffffff) shl 32) or int64($ffff) shl 16 or int64($ffff)
|
|
end;
|
|
u64bit :
|
|
begin
|
|
{ we have to use a dirty trick for high(qword), }
|
|
{ because it's bigger than high(tconstexprint) (JM) }
|
|
v := 0
|
|
end
|
|
else
|
|
begin
|
|
if not is_signed(t.def) then
|
|
v := cardinal(v);
|
|
end;
|
|
end;
|
|
hp:=cordconstnode.create(v,t,true);
|
|
resulttypepass(hp);
|
|
{ fix high(qword) }
|
|
if (torddef(t.def).typ=u64bit) and
|
|
(inlinenumber = in_high_x) then
|
|
tordconstnode(hp).value := -1; { is the same as qword($ffffffffffffffff) }
|
|
do_lowhigh:=hp;
|
|
end;
|
|
enumdef:
|
|
begin
|
|
enum:=tenumsym(tenumdef(t.def).firstenum);
|
|
v:=tenumdef(t.def).maxval;
|
|
if inlinenumber=in_high_x then
|
|
while assigned(enum) and (enum.value <> v) do
|
|
enum:=enum.nextenum;
|
|
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 (cs_check_range in aktlocalswitches) or
|
|
(cs_check_overflow in aktlocalswitches) then
|
|
begin
|
|
result:=crealconstnode.create(0,pbestrealtype^);
|
|
CGMessage(type_e_wrong_math_argument)
|
|
end
|
|
else
|
|
begin
|
|
if r=0.0 then
|
|
result:=crealconstnode.create(double(MathQNaN),pbestrealtype^)
|
|
else
|
|
result:=crealconstnode.create(double(MathNegInf),pbestrealtype^)
|
|
end
|
|
else
|
|
result:=crealconstnode.create(ln(r),pbestrealtype^)
|
|
end;
|
|
|
|
|
|
function handle_sqrt_const(r : bestreal) : tnode;
|
|
begin
|
|
if r<0.0 then
|
|
if (cs_check_range in aktlocalswitches) or
|
|
(cs_check_overflow in aktlocalswitches) then
|
|
begin
|
|
result:=crealconstnode.create(0,pbestrealtype^);
|
|
CGMessage(type_e_wrong_math_argument)
|
|
end
|
|
else
|
|
result:=crealconstnode.create(double(MathQNaN),pbestrealtype^)
|
|
else
|
|
result:=crealconstnode.create(sqrt(r),pbestrealtype^)
|
|
end;
|
|
|
|
|
|
var
|
|
vl,vl2 : TConstExprInt;
|
|
vr : bestreal;
|
|
hightree,
|
|
hp : tnode;
|
|
srsym : tsym;
|
|
isreal : boolean;
|
|
checkrange : boolean;
|
|
label
|
|
myexit;
|
|
begin
|
|
result:=nil;
|
|
{ if we handle writeln; left contains no valid address }
|
|
if assigned(left) then
|
|
begin
|
|
if left.nodetype=callparan then
|
|
tcallparanode(left).get_paratype
|
|
else
|
|
resulttypepass(left);
|
|
end;
|
|
inc(parsing_para_level);
|
|
|
|
{ handle intern constant functions in separate case }
|
|
if nf_inlineconst in flags then
|
|
begin
|
|
{ no parameters? }
|
|
if not assigned(left) then
|
|
begin
|
|
case inlinenumber of
|
|
in_const_pi :
|
|
hp:=crealconstnode.create(pi,pbestrealtype^);
|
|
else
|
|
internalerror(89);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
vl:=0;
|
|
vl2:=0; { second parameter Ex: ptr(vl,vl2) }
|
|
vr:=0;
|
|
isreal:=false;
|
|
case left.nodetype of
|
|
realconstn :
|
|
begin
|
|
isreal:=true;
|
|
vr:=trealconstnode(left).value_real;
|
|
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_trunc :
|
|
begin
|
|
if isreal then
|
|
begin
|
|
if (vr>=9223372036854775808.0) or (vr<=-9223372036854775809.0) then
|
|
begin
|
|
CGMessage(parser_e_range_check_error);
|
|
hp:=cordconstnode.create(1,s64inttype,false)
|
|
end
|
|
else
|
|
hp:=cordconstnode.create(trunc(vr),s64inttype,true)
|
|
end
|
|
else
|
|
hp:=cordconstnode.create(trunc(vl),s64inttype,true);
|
|
end;
|
|
in_const_round :
|
|
begin
|
|
if isreal then
|
|
begin
|
|
if (vr>=9223372036854775807.5) or (vr<=-9223372036854775808.5) then
|
|
begin
|
|
CGMessage(parser_e_range_check_error);
|
|
hp:=cordconstnode.create(1,s64inttype,false)
|
|
end
|
|
else
|
|
hp:=cordconstnode.create(round(vr),s64inttype,true)
|
|
end
|
|
else
|
|
hp:=cordconstnode.create(round(vl),s64inttype,true);
|
|
end;
|
|
in_const_frac :
|
|
begin
|
|
if isreal then
|
|
hp:=crealconstnode.create(frac(vr),pbestrealtype^)
|
|
else
|
|
hp:=crealconstnode.create(frac(vl),pbestrealtype^);
|
|
end;
|
|
in_const_int :
|
|
begin
|
|
if isreal then
|
|
hp:=crealconstnode.create(int(vr),pbestrealtype^)
|
|
else
|
|
hp:=crealconstnode.create(int(vl),pbestrealtype^);
|
|
end;
|
|
in_const_abs :
|
|
begin
|
|
if isreal then
|
|
hp:=crealconstnode.create(abs(vr),pbestrealtype^)
|
|
else
|
|
hp:=cordconstnode.create(abs(vl),left.resulttype,true);
|
|
end;
|
|
in_const_sqr :
|
|
begin
|
|
if isreal then
|
|
hp:=crealconstnode.create(sqr(vr),pbestrealtype^)
|
|
else
|
|
hp:=cordconstnode.create(sqr(vl),left.resulttype,true);
|
|
end;
|
|
in_const_odd :
|
|
begin
|
|
if isreal then
|
|
CGMessage1(type_e_integer_expr_expected,left.resulttype.def.typename)
|
|
else
|
|
hp:=cordconstnode.create(byte(odd(vl)),booltype,true);
|
|
end;
|
|
in_const_swap_word :
|
|
begin
|
|
if isreal then
|
|
CGMessage1(type_e_integer_expr_expected,left.resulttype.def.typename)
|
|
else
|
|
hp:=cordconstnode.create((vl and $ff) shl 8+(vl shr 8),left.resulttype,true);
|
|
end;
|
|
in_const_swap_long :
|
|
begin
|
|
if isreal then
|
|
CGMessage1(type_e_integer_expr_expected,left.resulttype.def.typename)
|
|
else
|
|
hp:=cordconstnode.create((vl and $ffff) shl 16+(vl shr 16),left.resulttype,true);
|
|
end;
|
|
in_const_swap_qword :
|
|
begin
|
|
if isreal then
|
|
CGMessage1(type_e_integer_expr_expected,left.resulttype.def.typename)
|
|
else
|
|
hp:=cordconstnode.create((vl and $ffff) shl 32+(vl shr 32),left.resulttype,true);
|
|
end;
|
|
in_const_ptr :
|
|
begin
|
|
if isreal then
|
|
CGMessage1(type_e_integer_expr_expected,left.resulttype.def.typename)
|
|
else
|
|
hp:=cpointerconstnode.create((vl2 shl 4)+vl,voidfarpointertype);
|
|
end;
|
|
in_const_sqrt :
|
|
begin
|
|
if isreal then
|
|
hp:=handle_sqrt_const(vr)
|
|
else
|
|
hp:=handle_sqrt_const(vl)
|
|
end;
|
|
in_const_arctan :
|
|
begin
|
|
if isreal then
|
|
hp:=crealconstnode.create(arctan(vr),pbestrealtype^)
|
|
else
|
|
hp:=crealconstnode.create(arctan(vl),pbestrealtype^);
|
|
end;
|
|
in_const_cos :
|
|
begin
|
|
if isreal then
|
|
hp:=crealconstnode.create(cos(vr),pbestrealtype^)
|
|
else
|
|
hp:=crealconstnode.create(cos(vl),pbestrealtype^);
|
|
end;
|
|
in_const_sin :
|
|
begin
|
|
if isreal then
|
|
hp:=crealconstnode.create(sin(vr),pbestrealtype^)
|
|
else
|
|
hp:=crealconstnode.create(sin(vl),pbestrealtype^);
|
|
end;
|
|
in_const_exp :
|
|
begin
|
|
if isreal then
|
|
hp:=crealconstnode.create(exp(vr),pbestrealtype^)
|
|
else
|
|
hp:=crealconstnode.create(exp(vl),pbestrealtype^);
|
|
end;
|
|
in_const_ln :
|
|
begin
|
|
if isreal then
|
|
hp:=handle_ln_const(vr)
|
|
else
|
|
hp:=handle_ln_const(vl)
|
|
end;
|
|
else
|
|
internalerror(88);
|
|
end;
|
|
end;
|
|
if hp=nil then
|
|
hp:=tnode.create(errorn);
|
|
result:=hp;
|
|
goto myexit;
|
|
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
|
|
{ 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 aktmodeswitches) or
|
|
(m_delphi in aktmodeswitches)) then
|
|
CGMessage(type_w_maybe_wrong_hi_lo);
|
|
{ constant folding }
|
|
if left.nodetype=ordconstn then
|
|
begin
|
|
case inlinenumber of
|
|
in_lo_word :
|
|
hp:=cordconstnode.create(tordconstnode(left).value and $ff,left.resulttype,true);
|
|
in_hi_word :
|
|
hp:=cordconstnode.create(tordconstnode(left).value shr 8,left.resulttype,true);
|
|
in_lo_long :
|
|
hp:=cordconstnode.create(tordconstnode(left).value and $ffff,left.resulttype,true);
|
|
in_hi_long :
|
|
hp:=cordconstnode.create(tordconstnode(left).value shr 16,left.resulttype,true);
|
|
in_lo_qword :
|
|
hp:=cordconstnode.create(tordconstnode(left).value and $ffffffff,left.resulttype,true);
|
|
in_hi_qword :
|
|
hp:=cordconstnode.create(tordconstnode(left).value shr 32,left.resulttype,true);
|
|
end;
|
|
result:=hp;
|
|
goto myexit;
|
|
end;
|
|
set_varstate(left,vs_used,true);
|
|
if not is_integer(left.resulttype.def) then
|
|
CGMessage1(type_e_integer_expr_expected,left.resulttype.def.typename);
|
|
case inlinenumber of
|
|
in_lo_word,
|
|
in_hi_word :
|
|
resulttype:=u8inttype;
|
|
in_lo_long,
|
|
in_hi_long :
|
|
resulttype:=u16inttype;
|
|
in_lo_qword,
|
|
in_hi_qword :
|
|
resulttype:=u32inttype;
|
|
end;
|
|
end;
|
|
|
|
|
|
in_sizeof_x:
|
|
begin
|
|
set_varstate(left,vs_used,false);
|
|
if paramanager.push_high_param(vs_value,left.resulttype.def,current_procinfo.procdef.proccalloption) then
|
|
begin
|
|
hightree:=load_high_value_node(tvarsym(tloadnode(left).symtableentry));
|
|
if assigned(hightree) then
|
|
begin
|
|
hp:=caddnode.create(addn,hightree,
|
|
cordconstnode.create(1,sinttype,false));
|
|
if (left.resulttype.def.deftype=arraydef) and
|
|
(tarraydef(left.resulttype.def).elesize<>1) then
|
|
hp:=caddnode.create(muln,hp,cordconstnode.create(tarraydef(
|
|
left.resulttype.def).elesize,sinttype,true));
|
|
result:=hp;
|
|
end;
|
|
end
|
|
else
|
|
resulttype:=sinttype;
|
|
end;
|
|
|
|
in_typeof_x:
|
|
begin
|
|
set_varstate(left,vs_used,false);
|
|
resulttype:=voidpointertype;
|
|
end;
|
|
|
|
in_ord_x:
|
|
begin
|
|
if (left.nodetype=ordconstn) then
|
|
begin
|
|
hp:=cordconstnode.create(
|
|
tordconstnode(left).value,sinttype,true);
|
|
result:=hp;
|
|
goto myexit;
|
|
end;
|
|
set_varstate(left,vs_used,true);
|
|
case left.resulttype.def.deftype of
|
|
orddef :
|
|
begin
|
|
case torddef(left.resulttype.def).typ of
|
|
bool8bit,
|
|
uchar:
|
|
begin
|
|
{ change to byte() }
|
|
hp:=ctypeconvnode.create_explicit(left,u8inttype);
|
|
left:=nil;
|
|
result:=hp;
|
|
end;
|
|
bool16bit,
|
|
uwidechar :
|
|
begin
|
|
{ change to word() }
|
|
hp:=ctypeconvnode.create_explicit(left,u16inttype);
|
|
left:=nil;
|
|
result:=hp;
|
|
end;
|
|
bool32bit :
|
|
begin
|
|
{ change to dword() }
|
|
hp:=ctypeconvnode.create_explicit(left,u32inttype);
|
|
left:=nil;
|
|
result:=hp;
|
|
end;
|
|
uvoid :
|
|
CGMessage1(type_e_ordinal_expr_expected,left.resulttype.def.typename);
|
|
else
|
|
begin
|
|
{ all other orddef need no transformation }
|
|
hp:=left;
|
|
left:=nil;
|
|
result:=hp;
|
|
end;
|
|
end;
|
|
end;
|
|
enumdef :
|
|
begin
|
|
hp:=ctypeconvnode.create_explicit(left,s32inttype);
|
|
left:=nil;
|
|
result:=hp;
|
|
end;
|
|
pointerdef :
|
|
begin
|
|
if m_mac in aktmodeswitches then
|
|
begin
|
|
hp:=ctypeconvnode.create_explicit(left,ptrinttype);
|
|
left:=nil;
|
|
result:=hp;
|
|
end
|
|
else
|
|
CGMessage1(type_e_ordinal_expr_expected,left.resulttype.def.typename);
|
|
end
|
|
else
|
|
CGMessage1(type_e_ordinal_expr_expected,left.resulttype.def.typename);
|
|
end;
|
|
end;
|
|
|
|
in_chr_byte:
|
|
begin
|
|
{ convert to explicit char() }
|
|
set_varstate(left,vs_used,true);
|
|
hp:=ctypeconvnode.create_explicit(left,cchartype);
|
|
left:=nil;
|
|
result:=hp;
|
|
end;
|
|
|
|
in_length_x:
|
|
begin
|
|
set_varstate(left,vs_used,true);
|
|
|
|
case left.resulttype.def.deftype of
|
|
stringdef :
|
|
begin
|
|
{ we don't need string convertions here }
|
|
if (left.nodetype=typeconvn) and
|
|
(ttypeconvnode(left).left.resulttype.def.deftype=stringdef) then
|
|
begin
|
|
hp:=ttypeconvnode(left).left;
|
|
ttypeconvnode(left).left:=nil;
|
|
left.free;
|
|
left:=hp;
|
|
end;
|
|
|
|
{ evaluates length of constant strings direct }
|
|
if (left.nodetype=stringconstn) then
|
|
begin
|
|
hp:=cordconstnode.create(
|
|
tstringconstnode(left).len,s32inttype,true);
|
|
result:=hp;
|
|
goto myexit;
|
|
end;
|
|
end;
|
|
orddef :
|
|
begin
|
|
{ length of char is one allways }
|
|
if is_char(left.resulttype.def) or
|
|
is_widechar(left.resulttype.def) then
|
|
begin
|
|
hp:=cordconstnode.create(1,s32inttype,false);
|
|
result:=hp;
|
|
goto myexit;
|
|
end
|
|
else
|
|
CGMessage(type_e_mismatch);
|
|
end;
|
|
pointerdef :
|
|
begin
|
|
if is_pchar(left.resulttype.def) 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;
|
|
goto myexit;
|
|
end
|
|
else if is_pwidechar(left.resulttype.def) 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;
|
|
goto myexit;
|
|
end
|
|
else
|
|
CGMessage(type_e_mismatch);
|
|
end;
|
|
arraydef :
|
|
begin
|
|
if is_open_array(left.resulttype.def) or
|
|
is_array_of_const(left.resulttype.def) then
|
|
begin
|
|
hightree:=load_high_value_node(tvarsym(tloadnode(left).symtableentry));
|
|
if assigned(hightree) then
|
|
begin
|
|
hp:=caddnode.create(addn,hightree,
|
|
cordconstnode.create(1,s32inttype,false));
|
|
result:=hp;
|
|
end;
|
|
goto myexit;
|
|
end
|
|
else
|
|
if not is_dynamic_array(left.resulttype.def) then
|
|
begin
|
|
hp:=cordconstnode.create(tarraydef(left.resulttype.def).highrange-
|
|
tarraydef(left.resulttype.def).lowrange+1,
|
|
s32inttype,true);
|
|
result:=hp;
|
|
goto myexit;
|
|
end
|
|
else
|
|
begin
|
|
hp := ccallparanode.create(ctypeconvnode.create_explicit(left,voidpointertype),nil);
|
|
result := ccallnode.createintern('fpc_dynarray_length',hp);
|
|
{ make sure the left node doesn't get disposed, since it's }
|
|
{ reused in the new node (JM) }
|
|
left:=nil;
|
|
goto myexit;
|
|
end;
|
|
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.resulttype.def) then
|
|
resulttype:=u8inttype
|
|
else
|
|
resulttype:=sinttype;
|
|
end;
|
|
|
|
in_typeinfo_x:
|
|
begin
|
|
set_varstate(left,vs_used,true);
|
|
resulttype:=voidpointertype;
|
|
end;
|
|
|
|
in_assigned_x:
|
|
begin
|
|
{ the parser has already made sure the expression is valid }
|
|
|
|
{ handle constant expressions }
|
|
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;
|
|
{ free left, because otherwise some code at 'myexit' tries }
|
|
{ to run get_paratype for it, which crashes since left.left }
|
|
{ is now nil }
|
|
left.free;
|
|
left := nil;
|
|
goto myexit;
|
|
end;
|
|
{ otherwise handle separately, because there could be a procvar, which }
|
|
{ is 2*sizeof(pointer), while we must only check the first pointer }
|
|
set_varstate(tcallparanode(left).left,vs_used,true);
|
|
resulttype:=booltype;
|
|
end;
|
|
|
|
in_ofs_x :
|
|
internalerror(2000101001);
|
|
|
|
in_seg_x :
|
|
begin
|
|
set_varstate(left,vs_used,false);
|
|
hp:=cordconstnode.create(0,s32inttype,false);
|
|
result:=hp;
|
|
goto myexit;
|
|
end;
|
|
|
|
in_pred_x,
|
|
in_succ_x:
|
|
begin
|
|
set_varstate(left,vs_used,true);
|
|
resulttype:=left.resulttype;
|
|
if not is_ordinal(resulttype.def) then
|
|
CGMessage(type_e_ordinal_expr_expected)
|
|
else
|
|
begin
|
|
if (resulttype.def.deftype=enumdef) and
|
|
(tenumdef(resulttype.def).has_jumps) then
|
|
CGMessage(type_e_succ_and_pred_enums_with_assign_not_possible);
|
|
end;
|
|
|
|
{ only if the result is an enum do we do range checking }
|
|
if (resulttype.def.deftype=enumdef) then
|
|
checkrange := true
|
|
else
|
|
checkrange := false;
|
|
|
|
{ do constant folding after check for jumps }
|
|
if left.nodetype=ordconstn then
|
|
begin
|
|
if inlinenumber=in_succ_x then
|
|
hp:=cordconstnode.create(tordconstnode(left).value+1,left.resulttype,checkrange)
|
|
else
|
|
hp:=cordconstnode.create(tordconstnode(left).value-1,left.resulttype,checkrange);
|
|
result:=hp;
|
|
end;
|
|
end;
|
|
|
|
in_initialize_x,
|
|
in_finalize_x,
|
|
in_setlength_x:
|
|
begin
|
|
{ inlined from pinline }
|
|
internalerror(200204231);
|
|
end;
|
|
|
|
in_inc_x,
|
|
in_dec_x:
|
|
begin
|
|
resulttype:=voidtype;
|
|
if assigned(left) then
|
|
begin
|
|
{ first param must be var }
|
|
valid_for_var(tcallparanode(left).left);
|
|
set_varstate(tcallparanode(left).left,vs_used,true);
|
|
|
|
if (left.resulttype.def.deftype in [enumdef,pointerdef]) or
|
|
is_ordinal(left.resulttype.def) or
|
|
is_currency(left.resulttype.def) then
|
|
begin
|
|
{ value of left gets changed -> must be unique }
|
|
set_unique(tcallparanode(left).left);
|
|
{ two paras ? }
|
|
if assigned(tcallparanode(left).right) then
|
|
begin
|
|
set_varstate(tcallparanode(tcallparanode(left).right).left,vs_used,true);
|
|
inserttypeconv_explicit(tcallparanode(tcallparanode(left).right).left,tcallparanode(left).left.resulttype);
|
|
if assigned(tcallparanode(tcallparanode(left).right).right) then
|
|
CGMessage(parser_e_illegal_expression);
|
|
end;
|
|
end
|
|
else
|
|
CGMessage(type_e_ordinal_expr_expected);
|
|
end
|
|
else
|
|
CGMessage(type_e_mismatch);
|
|
end;
|
|
|
|
in_read_x,
|
|
in_readln_x,
|
|
in_write_x,
|
|
in_writeln_x :
|
|
begin
|
|
result := handle_read_write;
|
|
end;
|
|
|
|
in_settextbuf_file_x :
|
|
begin
|
|
resulttype:=voidtype;
|
|
{ now we know the type of buffer }
|
|
srsym:=searchsymonlyin(systemunit,'SETTEXTBUF');
|
|
hp:=ccallparanode.create(cordconstnode.create(
|
|
tcallparanode(left).left.resulttype.def.size,s32inttype,true),left);
|
|
hp:=ccallnode.create(hp,tprocsym(srsym),systemunit,nil,[]);
|
|
left:=nil;
|
|
result:=hp;
|
|
end;
|
|
|
|
{ the firstpass of the arg has been done in firstcalln ? }
|
|
in_reset_typedfile,
|
|
in_rewrite_typedfile :
|
|
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
|
|
resulttype:=voidtype;
|
|
{ the parser already checks whether we have two (and exectly two) }
|
|
{ parameters (JM) }
|
|
{ first param must be var }
|
|
valid_for_var(tcallparanode(left).left);
|
|
set_varstate(tcallparanode(left).left,vs_used,true);
|
|
{ check type }
|
|
if (left.resulttype.def.deftype=setdef) then
|
|
begin
|
|
{ insert a type conversion }
|
|
{ to the type of the set elements }
|
|
set_varstate(tcallparanode(tcallparanode(left).right).left,vs_used,true);
|
|
inserttypeconv(tcallparanode(tcallparanode(left).right).left,
|
|
tsetdef(left.resulttype.def).elementtype);
|
|
end
|
|
else
|
|
CGMessage(type_e_mismatch);
|
|
end;
|
|
|
|
in_low_x,
|
|
in_high_x:
|
|
begin
|
|
set_varstate(left,vs_used,false);
|
|
case left.resulttype.def.deftype of
|
|
orddef,
|
|
enumdef:
|
|
begin
|
|
result:=do_lowhigh(left.resulttype);
|
|
end;
|
|
setdef:
|
|
begin
|
|
result:=do_lowhigh(tsetdef(left.resulttype.def).elementtype);
|
|
end;
|
|
arraydef:
|
|
begin
|
|
if inlinenumber=in_low_x then
|
|
begin
|
|
result:=cordconstnode.create(tarraydef(
|
|
left.resulttype.def).lowrange,tarraydef(left.resulttype.def).rangetype,true);
|
|
end
|
|
else
|
|
begin
|
|
if is_open_array(left.resulttype.def) or
|
|
is_array_of_const(left.resulttype.def) then
|
|
begin
|
|
result:=load_high_value_node(tvarsym(tloadnode(left).symtableentry));
|
|
end
|
|
else
|
|
if is_dynamic_array(left.resulttype.def) then
|
|
begin
|
|
{ can't use inserttypeconv because we need }
|
|
{ an explicit type conversion (JM) }
|
|
hp := ccallparanode.create(ctypeconvnode.create_explicit(left,voidpointertype),nil);
|
|
result := ccallnode.createintern('fpc_dynarray_high',hp);
|
|
{ make sure the left node doesn't get disposed, since it's }
|
|
{ reused in the new node (JM) }
|
|
left:=nil;
|
|
end
|
|
else
|
|
begin
|
|
result:=cordconstnode.create(tarraydef(
|
|
left.resulttype.def).highrange,tarraydef(left.resulttype.def).rangetype,true);
|
|
end;
|
|
end;
|
|
end;
|
|
stringdef:
|
|
begin
|
|
if inlinenumber=in_low_x then
|
|
begin
|
|
result:=cordconstnode.create(0,u8inttype,false);
|
|
end
|
|
else
|
|
begin
|
|
if is_open_string(left.resulttype.def) then
|
|
result:=load_high_value_node(tvarsym(tloadnode(left).symtableentry))
|
|
else
|
|
result:=cordconstnode.create(tstringdef(left.resulttype.def).len,u8inttype,true);
|
|
end;
|
|
end;
|
|
else
|
|
CGMessage(type_e_mismatch);
|
|
end;
|
|
end;
|
|
|
|
in_pi:
|
|
begin
|
|
if block_type=bt_const then
|
|
setconstrealvalue(pi)
|
|
else
|
|
resulttype:=pbestrealtype^;
|
|
end;
|
|
in_cos_extended :
|
|
begin
|
|
if left.nodetype in [ordconstn,realconstn] then
|
|
setconstrealvalue(cos(getconstrealvalue))
|
|
else
|
|
begin
|
|
set_varstate(left,vs_used,true);
|
|
inserttypeconv(left,pbestrealtype^);
|
|
resulttype:=pbestrealtype^;
|
|
end;
|
|
end;
|
|
|
|
in_sin_extended :
|
|
begin
|
|
if left.nodetype in [ordconstn,realconstn] then
|
|
setconstrealvalue(sin(getconstrealvalue))
|
|
else
|
|
begin
|
|
set_varstate(left,vs_used,true);
|
|
inserttypeconv(left,pbestrealtype^);
|
|
resulttype:=pbestrealtype^;
|
|
end;
|
|
end;
|
|
|
|
in_arctan_extended :
|
|
begin
|
|
if left.nodetype in [ordconstn,realconstn] then
|
|
setconstrealvalue(arctan(getconstrealvalue))
|
|
else
|
|
begin
|
|
set_varstate(left,vs_used,true);
|
|
inserttypeconv(left,pbestrealtype^);
|
|
resulttype:=pbestrealtype^;
|
|
end;
|
|
end;
|
|
|
|
in_abs_extended :
|
|
begin
|
|
if left.nodetype in [ordconstn,realconstn] then
|
|
setconstrealvalue(abs(getconstrealvalue))
|
|
else
|
|
begin
|
|
set_varstate(left,vs_used,true);
|
|
inserttypeconv(left,pbestrealtype^);
|
|
resulttype:=pbestrealtype^;
|
|
end;
|
|
end;
|
|
|
|
in_sqr_extended :
|
|
begin
|
|
if left.nodetype in [ordconstn,realconstn] then
|
|
setconstrealvalue(sqr(getconstrealvalue))
|
|
else
|
|
begin
|
|
set_varstate(left,vs_used,true);
|
|
inserttypeconv(left,pbestrealtype^);
|
|
resulttype:=pbestrealtype^;
|
|
end;
|
|
end;
|
|
|
|
in_sqrt_extended :
|
|
begin
|
|
if left.nodetype in [ordconstn,realconstn] then
|
|
begin
|
|
vr:=getconstrealvalue;
|
|
if vr<0.0 then
|
|
result:=handle_sqrt_const(vr)
|
|
else
|
|
setconstrealvalue(sqrt(vr));
|
|
end
|
|
else
|
|
begin
|
|
set_varstate(left,vs_used,true);
|
|
inserttypeconv(left,pbestrealtype^);
|
|
resulttype:=pbestrealtype^;
|
|
end;
|
|
end;
|
|
|
|
in_ln_extended :
|
|
begin
|
|
if left.nodetype in [ordconstn,realconstn] then
|
|
begin
|
|
vr:=getconstrealvalue;
|
|
if vr<=0.0 then
|
|
result:=handle_ln_const(vr)
|
|
else
|
|
setconstrealvalue(ln(vr));
|
|
end
|
|
else
|
|
begin
|
|
set_varstate(left,vs_used,true);
|
|
inserttypeconv(left,pbestrealtype^);
|
|
resulttype:=pbestrealtype^;
|
|
end;
|
|
end;
|
|
|
|
{$ifdef SUPPORT_MMX}
|
|
in_mmx_pcmpeqb..in_mmx_pcmpgtw:
|
|
begin
|
|
end;
|
|
{$endif SUPPORT_MMX}
|
|
in_prefetch_var:
|
|
begin
|
|
resulttype:=voidtype;
|
|
end;
|
|
in_assert_x_y :
|
|
begin
|
|
resulttype:=voidtype;
|
|
if assigned(left) then
|
|
begin
|
|
set_varstate(tcallparanode(left).left,vs_used,true);
|
|
{ check type }
|
|
if is_boolean(left.resulttype.def) then
|
|
begin
|
|
set_varstate(tcallparanode(tcallparanode(left).right).left,vs_used,true);
|
|
{ must always be a string }
|
|
inserttypeconv(tcallparanode(tcallparanode(left).right).left,cshortstringtype);
|
|
end
|
|
else
|
|
CGMessage1(type_e_boolean_expr_expected,left.resulttype.def.typename);
|
|
end
|
|
else
|
|
CGMessage(type_e_mismatch);
|
|
|
|
{ We've checked the whole statement for correctness, now we
|
|
can remove it if assertions are off }
|
|
if not(cs_do_assertion in aktlocalswitches) then
|
|
begin
|
|
{ we need a valid node, so insert a nothingn }
|
|
result:=cnothingnode.create;
|
|
end
|
|
else
|
|
include(current_procinfo.flags,pi_do_call);
|
|
end;
|
|
|
|
else
|
|
internalerror(8);
|
|
end;
|
|
end;
|
|
|
|
myexit:
|
|
{ Run get_paratype again to update maybe inserted typeconvs }
|
|
if not codegenerror then
|
|
begin
|
|
if assigned(left) and
|
|
(left.nodetype=callparan) then
|
|
tcallparanode(left).get_paratype;
|
|
end;
|
|
dec(parsing_para_level);
|
|
end;
|
|
|
|
|
|
function tinlinenode.pass_1 : tnode;
|
|
var
|
|
hp,hpp : tnode;
|
|
shiftconst: longint;
|
|
tempnode: ttempcreatenode;
|
|
newstatement: tstatementnode;
|
|
newblock: tblocknode;
|
|
|
|
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);
|
|
left_max;
|
|
end;
|
|
|
|
inc(parsing_para_level);
|
|
{ intern const should already be handled }
|
|
if nf_inlineconst in flags 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;
|
|
end;
|
|
if shiftconst <> 0 then
|
|
result := ctypeconvnode.create_explicit(cshlshrnode.create(shrn,left,
|
|
cordconstnode.create(shiftconst,u32inttype,false)),resulttype)
|
|
else
|
|
result := ctypeconvnode.create_explicit(left,resulttype);
|
|
left := nil;
|
|
firstpass(result);
|
|
end;
|
|
|
|
in_sizeof_x:
|
|
begin
|
|
if registersint<1 then
|
|
registersint:=1;
|
|
expectloc:=LOC_REGISTER;
|
|
end;
|
|
|
|
in_typeof_x:
|
|
begin
|
|
if registersint<1 then
|
|
registersint:=1;
|
|
expectloc:=LOC_REGISTER;
|
|
end;
|
|
|
|
in_length_x:
|
|
begin
|
|
if is_shortstring(left.resulttype.def) then
|
|
expectloc:=left.expectloc
|
|
else
|
|
begin
|
|
{ ansi/wide string }
|
|
if registersint<1 then
|
|
registersint:=1;
|
|
expectloc:=LOC_REGISTER;
|
|
end;
|
|
end;
|
|
|
|
in_typeinfo_x:
|
|
begin
|
|
expectloc:=LOC_REGISTER;
|
|
registersint:=1;
|
|
end;
|
|
|
|
in_assigned_x:
|
|
begin
|
|
expectloc := LOC_JUMP;
|
|
registersint:=1;
|
|
end;
|
|
|
|
in_pred_x,
|
|
in_succ_x:
|
|
begin
|
|
if is_64bit(resulttype.def) then
|
|
begin
|
|
if (registersint<2) then
|
|
registersint:=2
|
|
end
|
|
else
|
|
begin
|
|
if (registersint<1) then
|
|
registersint:=1;
|
|
end;
|
|
expectloc:=LOC_REGISTER;
|
|
end;
|
|
|
|
in_setlength_x,
|
|
in_initialize_x,
|
|
in_finalize_x:
|
|
begin
|
|
expectloc:=LOC_VOID;
|
|
end;
|
|
|
|
in_inc_x,
|
|
in_dec_x:
|
|
begin
|
|
expectloc:=LOC_VOID;
|
|
|
|
{ check type }
|
|
if
|
|
{$ifndef cpu64bit}
|
|
is_64bit(left.resulttype.def) or
|
|
{$endif cpu64bit}
|
|
{ range/overflow checking doesn't work properly }
|
|
{ with the inc/dec code that's generated (JM) }
|
|
(
|
|
(left.resulttype.def.deftype = orddef) and
|
|
not(is_char(left.resulttype.def)) and
|
|
not(is_boolean(left.resulttype.def)) and
|
|
(aktlocalswitches * [cs_check_overflow,cs_check_range] <> [])
|
|
) then
|
|
{ convert to simple add (JM) }
|
|
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
|
|
{ no, create constant 1 }
|
|
hpp := cordconstnode.create(1,tcallparanode(left).left.resulttype,false);
|
|
{ make sure we don't call functions part of the left node twice (and generally }
|
|
{ optimize the code generation) }
|
|
if node_complexity(tcallparanode(left).left) > 1 then
|
|
begin
|
|
tempnode := ctempcreatenode.create_reg(voidpointertype,voidpointertype.def.size,tt_persistent);
|
|
addstatement(newstatement,tempnode);
|
|
addstatement(newstatement,cassignmentnode.create(ctemprefnode.create(tempnode),
|
|
caddrnode.create(tcallparanode(left).left.getcopy)));
|
|
hp := cderefnode.create(ctemprefnode.create(tempnode));
|
|
inserttypeconv_explicit(hp,tcallparanode(left).left.resulttype);
|
|
end
|
|
else
|
|
begin
|
|
hp := tcallparanode(left).left.getcopy;
|
|
tempnode := nil;
|
|
end;
|
|
{ addition/substraction depending on inc/dec }
|
|
if inlinenumber = in_inc_x then
|
|
hpp := caddnode.create(addn,hp,hpp)
|
|
else
|
|
hpp := caddnode.create(subn,hp,hpp);
|
|
{ assign result of addition }
|
|
addstatement(newstatement,cassignmentnode.create(hp.getcopy,hpp));
|
|
{ deallocate the temp }
|
|
if assigned(tempnode) then
|
|
addstatement(newstatement,ctempdeletenode.create(tempnode));
|
|
{ firstpass it }
|
|
firstpass(newblock);
|
|
{ return new node }
|
|
result := newblock;
|
|
end
|
|
else if (left.resulttype.def.deftype in [enumdef,pointerdef]) or
|
|
is_ordinal(left.resulttype.def) then
|
|
begin
|
|
{ two paras ? }
|
|
if assigned(tcallparanode(left).right) then
|
|
begin
|
|
{ need we an additional register ? }
|
|
if not(is_constintnode(tcallparanode(tcallparanode(left).right).left)) and
|
|
(tcallparanode(tcallparanode(left).right).left.expectloc in [LOC_CREFERENCE,LOC_REFERENCE]) and
|
|
(tcallparanode(tcallparanode(left).right).left.registersint<=1) then
|
|
inc(registersint);
|
|
|
|
{ do we need an additional register to restore the first parameter? }
|
|
if tcallparanode(tcallparanode(left).right).left.registersint>=registersint then
|
|
inc(registersint);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
in_include_x_y,
|
|
in_exclude_x_y:
|
|
begin
|
|
expectloc:=LOC_VOID;
|
|
|
|
registersint:=left.registersint;
|
|
registersfpu:=left.registersfpu;
|
|
{$ifdef SUPPORT_MMX}
|
|
registersmmx:=left.registersmmx;
|
|
{$endif SUPPORT_MMX}
|
|
end;
|
|
|
|
in_cos_extended:
|
|
begin
|
|
result:= first_cos_real;
|
|
end;
|
|
|
|
in_sin_extended:
|
|
begin
|
|
result := first_sin_real;
|
|
end;
|
|
|
|
in_arctan_extended:
|
|
begin
|
|
result := first_arctan_real;
|
|
end;
|
|
|
|
in_pi:
|
|
begin
|
|
result := first_pi;
|
|
end;
|
|
|
|
in_abs_extended:
|
|
begin
|
|
result := first_abs_real;
|
|
end;
|
|
|
|
in_sqr_extended:
|
|
begin
|
|
result := first_sqr_real;
|
|
end;
|
|
|
|
in_sqrt_extended:
|
|
begin
|
|
result := first_sqrt_real;
|
|
end;
|
|
|
|
in_ln_extended:
|
|
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
|
|
expectloc:=LOC_VOID;
|
|
registersint:=left.registersint;
|
|
registersfpu:=left.registersfpu;
|
|
{$ifdef SUPPORT_MMX}
|
|
registersmmx:=left.registersmmx;
|
|
{$endif SUPPORT_MMX}
|
|
end;
|
|
|
|
in_low_x,
|
|
in_high_x:
|
|
internalerror(200104047);
|
|
|
|
in_ord_x,
|
|
in_chr_byte:
|
|
begin
|
|
{ should not happend as it's converted to typeconv }
|
|
internalerror(200104045);
|
|
end;
|
|
|
|
in_ofs_x :
|
|
internalerror(2000101001);
|
|
|
|
in_seg_x :
|
|
internalerror(200104046);
|
|
|
|
in_settextbuf_file_x,
|
|
in_reset_typedfile,
|
|
in_rewrite_typedfile,
|
|
in_str_x_string,
|
|
in_val_x,
|
|
in_read_x,
|
|
in_readln_x,
|
|
in_write_x,
|
|
in_writeln_x :
|
|
begin
|
|
{ should be handled by det_resulttype }
|
|
internalerror(200108234);
|
|
end;
|
|
|
|
in_prefetch_var:
|
|
begin
|
|
expectloc:=LOC_VOID;
|
|
end;
|
|
|
|
else
|
|
internalerror(8);
|
|
end;
|
|
dec(parsing_para_level);
|
|
end;
|
|
{$ifdef fpc}
|
|
{$maxfpuregisters default}
|
|
{$endif fpc}
|
|
|
|
function tinlinenode.docompare(p: tnode): boolean;
|
|
begin
|
|
docompare :=
|
|
inherited docompare(p) and
|
|
(inlinenumber = tinlinenode(p).inlinenumber);
|
|
end;
|
|
|
|
|
|
function tinlinenode.first_pi : tnode;
|
|
begin
|
|
result := crealconstnode.create(pi,pbestrealtype^);
|
|
end;
|
|
|
|
|
|
function tinlinenode.first_arctan_real : tnode;
|
|
begin
|
|
{ create the call to the helper }
|
|
{ on entry left node contains the parameter }
|
|
first_arctan_real := ccallnode.createintern('fpc_arctan_real',
|
|
ccallparanode.create(left,nil));
|
|
left := nil;
|
|
end;
|
|
|
|
function tinlinenode.first_abs_real : tnode;
|
|
begin
|
|
{ create the call to the helper }
|
|
{ on entry left node contains the parameter }
|
|
first_abs_real := ccallnode.createintern('fpc_abs_real',
|
|
ccallparanode.create(left,nil));
|
|
left := nil;
|
|
end;
|
|
|
|
function tinlinenode.first_sqr_real : tnode;
|
|
begin
|
|
{ create the call to the helper }
|
|
{ on entry left node contains the parameter }
|
|
first_sqr_real := ccallnode.createintern('fpc_sqr_real',
|
|
ccallparanode.create(left,nil));
|
|
left := nil;
|
|
end;
|
|
|
|
function tinlinenode.first_sqrt_real : tnode;
|
|
begin
|
|
{ create the call to the helper }
|
|
{ on entry left node contains the parameter }
|
|
first_sqrt_real := ccallnode.createintern('fpc_sqrt_real',
|
|
ccallparanode.create(left,nil));
|
|
left := nil;
|
|
end;
|
|
|
|
function tinlinenode.first_ln_real : tnode;
|
|
begin
|
|
{ create the call to the helper }
|
|
{ on entry left node contains the parameter }
|
|
first_ln_real := ccallnode.createintern('fpc_ln_real',
|
|
ccallparanode.create(left,nil));
|
|
left := nil;
|
|
end;
|
|
|
|
function tinlinenode.first_cos_real : tnode;
|
|
begin
|
|
{ create the call to the helper }
|
|
{ on entry left node contains the parameter }
|
|
first_cos_real := ccallnode.createintern('fpc_cos_real',
|
|
ccallparanode.create(left,nil));
|
|
left := nil;
|
|
end;
|
|
|
|
function tinlinenode.first_sin_real : tnode;
|
|
begin
|
|
{ create the call to the helper }
|
|
{ on entry left node contains the parameter }
|
|
first_sin_real := ccallnode.createintern('fpc_sin_real',
|
|
ccallparanode.create(left,nil));
|
|
left := nil;
|
|
end;
|
|
|
|
|
|
begin
|
|
cinlinenode:=tinlinenode;
|
|
end.
|
|
{
|
|
$Log$
|
|
Revision 1.141 2004-07-15 19:55:39 jonas
|
|
+ (incomplete) node_complexity function to assess the complexity of a
|
|
tree
|
|
+ support for inlining value and const parameters at the node level
|
|
(all procedures without local variables and without formal parameters
|
|
can now be inlined at the node level)
|
|
|
|
Revision 1.140 2004/07/14 21:40:52 olle
|
|
+ added Ord(pointer) for macpas
|
|
|
|
Revision 1.139 2004/07/14 14:38:35 jonas
|
|
* fix for web bug 3210
|
|
|
|
Revision 1.138 2004/06/20 08:55:29 florian
|
|
* logs truncated
|
|
|
|
Revision 1.137 2004/06/18 15:16:46 peter
|
|
* remove obsolete cardinal() typecasts
|
|
|
|
Revision 1.136 2004/06/16 20:07:08 florian
|
|
* dwarf branch merged
|
|
|
|
Revision 1.135 2004/05/28 21:15:20 peter
|
|
* inc(x,y) makes y always of type x to prevent 64bit operations
|
|
when x is a u32bit and y is signed
|
|
|
|
Revision 1.134 2004/05/23 18:28:41 peter
|
|
* methodpointer is loaded into a temp when it was a calln
|
|
|
|
Revision 1.133.2.9 2004/05/03 16:49:00 peter
|
|
* sizeof fixed
|
|
|
|
}
|