mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-27 10:13:51 +02:00
1869 lines
72 KiB
ObjectPascal
1869 lines
72 KiB
ObjectPascal
{
|
|
$Id$
|
|
Copyright (c) 1998-2000 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 defines.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
node,htypechk,cpuinfo;
|
|
|
|
{$i compinnr.inc}
|
|
|
|
type
|
|
tinlinenode = class(tunarynode)
|
|
inlinenumber : byte;
|
|
constructor create(number : byte;is_const:boolean;l : tnode);virtual;
|
|
function getcopy : tnode;override;
|
|
function pass_1 : tnode;override;
|
|
function det_resulttype:tnode;override;
|
|
function docompare(p: tnode): boolean; override;
|
|
end;
|
|
|
|
var
|
|
cinlinenode : class of tinlinenode;
|
|
|
|
function geninlinenode(number : byte;is_const:boolean;l : tnode) : tinlinenode;
|
|
|
|
implementation
|
|
|
|
uses
|
|
verbose,globals,systems,
|
|
globtype,
|
|
symconst,symtype,symdef,symsym,symtable,types,
|
|
pass_1,
|
|
ncal,ncon,ncnv,nadd,nld,nbas,
|
|
cpubase,hcodegen,tgcpu
|
|
{$ifdef newcg}
|
|
,cgbase
|
|
{$endif newcg}
|
|
;
|
|
|
|
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;
|
|
|
|
|
|
function tinlinenode.getcopy : tnode;
|
|
var
|
|
n : tinlinenode;
|
|
begin
|
|
n:=tinlinenode(inherited getcopy);
|
|
n.inlinenumber:=inlinenumber;
|
|
result:=n;
|
|
end;
|
|
|
|
|
|
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) }
|
|
if is_signed(t.def) and
|
|
is_64bitint(t.def) then
|
|
if (inlinenumber=in_low_x) then
|
|
v := int64($80000000) shl 32
|
|
else
|
|
v := (int64($7fffffff) shl 32) or $ffffffff
|
|
else
|
|
if is_64bitint(t.def) then
|
|
{ we have to use a dirty trick for high(qword), }
|
|
{ because it's bigger than high(tconstexprint) (JM) }
|
|
v := 0
|
|
else
|
|
if not is_signed(t.def) then
|
|
v := cardinal(v);
|
|
hp:=cordconstnode.create(v,t);
|
|
resulttypepass(hp);
|
|
{ fix high(qword) }
|
|
if not is_signed(t.def) and
|
|
is_64bitint(t.def) 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);
|
|
var
|
|
hp : tnode;
|
|
begin
|
|
hp:=crealconstnode.create(r,pbestrealtype^);
|
|
resulttypepass(hp);
|
|
result:=hp;
|
|
end;
|
|
|
|
var
|
|
counter : longint;
|
|
ppn : tcallparanode;
|
|
dummycoll : tparaitem;
|
|
vl,vl2 : longint;
|
|
vr : bestreal;
|
|
hp : tnode;
|
|
srsym : tsym;
|
|
p1,hpp : tnode;
|
|
frac_para,
|
|
length_para : tnode;
|
|
isreal,
|
|
iswrite,
|
|
file_is_typed : 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(cg_e_illegal_expression);
|
|
end;
|
|
case inlinenumber of
|
|
in_const_trunc :
|
|
begin
|
|
if isreal then
|
|
begin
|
|
if (vr>=2147483648.0) or (vr<=-2147483649.0) then
|
|
begin
|
|
CGMessage(parser_e_range_check_error);
|
|
hp:=cordconstnode.create(1,s32bittype)
|
|
end
|
|
else
|
|
hp:=cordconstnode.create(trunc(vr),s32bittype)
|
|
end
|
|
else
|
|
hp:=cordconstnode.create(trunc(vl),s32bittype);
|
|
end;
|
|
in_const_round :
|
|
begin
|
|
if isreal then
|
|
begin
|
|
if (vr>=2147483647.5) or (vr<=-2147483648.5) then
|
|
begin
|
|
CGMessage(parser_e_range_check_error);
|
|
hp:=cordconstnode.create(1,s32bittype)
|
|
end
|
|
else
|
|
hp:=cordconstnode.create(round(vr),s32bittype)
|
|
end
|
|
else
|
|
hp:=cordconstnode.create(round(vl),s32bittype);
|
|
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);
|
|
end;
|
|
in_const_sqr :
|
|
begin
|
|
if isreal then
|
|
hp:=crealconstnode.create(sqr(vr),pbestrealtype^)
|
|
else
|
|
hp:=cordconstnode.create(sqr(vl),left.resulttype);
|
|
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);
|
|
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);
|
|
end;
|
|
in_const_swap_long :
|
|
begin
|
|
if isreal then
|
|
CGMessage(type_e_mismatch)
|
|
else
|
|
hp:=cordconstnode.create((vl and $ffff) shl 16+(vl shr 16),left.resulttype);
|
|
end;
|
|
in_const_ptr :
|
|
begin
|
|
if isreal then
|
|
CGMessage(type_e_mismatch)
|
|
else
|
|
hp:=cpointerconstnode.create((vl2 shl 4)+vl,voidfarpointertype);
|
|
end;
|
|
in_const_sqrt :
|
|
begin
|
|
if isreal then
|
|
begin
|
|
if vr<0.0 then
|
|
CGMessage(type_e_wrong_math_argument)
|
|
else
|
|
hp:=crealconstnode.create(sqrt(vr),pbestrealtype^)
|
|
end
|
|
else
|
|
begin
|
|
if vl<0 then
|
|
CGMessage(type_e_wrong_math_argument)
|
|
else
|
|
hp:=crealconstnode.create(sqrt(vl),pbestrealtype^);
|
|
end;
|
|
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
|
|
begin
|
|
if vr<=0.0 then
|
|
CGMessage(type_e_wrong_math_argument)
|
|
else
|
|
hp:=crealconstnode.create(ln(vr),pbestrealtype^)
|
|
end
|
|
else
|
|
begin
|
|
if vl<=0 then
|
|
CGMessage(type_e_wrong_math_argument)
|
|
else
|
|
hp:=crealconstnode.create(ln(vl),pbestrealtype^);
|
|
end;
|
|
end;
|
|
else
|
|
internalerror(88);
|
|
end;
|
|
end;
|
|
if hp=nil then
|
|
hp:=tnode.create(errorn);
|
|
resulttypepass(hp);
|
|
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_tp 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);
|
|
in_hi_word :
|
|
hp:=cordconstnode.create(tordconstnode(left).value shr 8,left.resulttype);
|
|
in_lo_long :
|
|
hp:=cordconstnode.create(tordconstnode(left).value and $ffff,left.resulttype);
|
|
in_hi_long :
|
|
hp:=cordconstnode.create(tordconstnode(left).value shr 16,left.resulttype);
|
|
in_lo_qword :
|
|
hp:=cordconstnode.create(tordconstnode(left).value and $ffffffff,left.resulttype);
|
|
in_hi_qword :
|
|
hp:=cordconstnode.create(tordconstnode(left).value shr 32,left.resulttype);
|
|
end;
|
|
resulttypepass(hp);
|
|
result:=hp;
|
|
goto myexit;
|
|
end;
|
|
set_varstate(left,true);
|
|
if not is_integer(left.resulttype.def) then
|
|
CGMessage(type_e_mismatch);
|
|
case inlinenumber of
|
|
in_lo_word,
|
|
in_hi_word :
|
|
resulttype:=u8bittype;
|
|
in_lo_long,
|
|
in_hi_long :
|
|
resulttype:=u16bittype;
|
|
in_lo_qword,
|
|
in_hi_qword :
|
|
resulttype:=u32bittype;
|
|
end;
|
|
end;
|
|
|
|
|
|
in_sizeof_x:
|
|
begin
|
|
set_varstate(left,false);
|
|
resulttype:=s32bittype;
|
|
end;
|
|
|
|
in_typeof_x:
|
|
begin
|
|
set_varstate(left,false);
|
|
resulttype:=voidpointertype;
|
|
end;
|
|
|
|
in_ord_x:
|
|
begin
|
|
if (left.nodetype=ordconstn) then
|
|
begin
|
|
hp:=cordconstnode.create(tordconstnode(left).value,s32bittype);
|
|
resulttypepass(hp);
|
|
result:=hp;
|
|
goto myexit;
|
|
end;
|
|
set_varstate(left,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(left,u8bittype);
|
|
left:=nil;
|
|
include(hp.flags,nf_explizit);
|
|
resulttypepass(hp);
|
|
result:=hp;
|
|
end;
|
|
bool16bit,
|
|
uwidechar :
|
|
begin
|
|
{ change to word() }
|
|
hp:=ctypeconvnode.create(left,u16bittype);
|
|
left:=nil;
|
|
include(hp.flags,nf_explizit);
|
|
resulttypepass(hp);
|
|
result:=hp;
|
|
end;
|
|
bool32bit :
|
|
begin
|
|
{ change to dword() }
|
|
hp:=ctypeconvnode.create(left,u32bittype);
|
|
left:=nil;
|
|
include(hp.flags,nf_explizit);
|
|
resulttypepass(hp);
|
|
result:=hp;
|
|
end;
|
|
uvoid :
|
|
CGMessage(type_e_mismatch)
|
|
else
|
|
begin
|
|
{ all other orddef need no transformation }
|
|
hp:=left;
|
|
left:=nil;
|
|
result:=hp;
|
|
end;
|
|
end;
|
|
end;
|
|
enumdef :
|
|
begin
|
|
hp:=ctypeconvnode.create(left,s32bittype);
|
|
left:=nil;
|
|
include(hp.flags,nf_explizit);
|
|
resulttypepass(hp);
|
|
result:=hp;
|
|
end;
|
|
else
|
|
CGMessage(type_e_mismatch);
|
|
end;
|
|
end;
|
|
|
|
in_chr_byte:
|
|
begin
|
|
{ convert to explicit char() }
|
|
set_varstate(left,true);
|
|
hp:=ctypeconvnode.create(left,cchartype);
|
|
include(hp.flags,nf_explizit);
|
|
left:=nil;
|
|
resulttypepass(hp);
|
|
result:=hp;
|
|
end;
|
|
|
|
in_length_string:
|
|
begin
|
|
set_varstate(left,true);
|
|
|
|
{ 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,s32bittype);
|
|
resulttypepass(hp);
|
|
result:=hp;
|
|
goto myexit;
|
|
end
|
|
{ length of char is one allways }
|
|
else if is_constcharnode(left) then
|
|
begin
|
|
hp:=cordconstnode.create(1,s32bittype);
|
|
resulttypepass(hp);
|
|
result:=hp;
|
|
goto myexit;
|
|
end;
|
|
|
|
if is_ansistring(left.resulttype.def) or
|
|
is_widestring(left.resulttype.def) or
|
|
is_dynamic_array(left.resulttype.def) then
|
|
resulttype:=s32bittype
|
|
else
|
|
resulttype:=u8bittype;
|
|
|
|
{ check the type, must be string or char }
|
|
if (left.resulttype.def.deftype<>stringdef) and
|
|
(not is_char(left.resulttype.def)) then
|
|
CGMessage(type_e_mismatch);
|
|
end;
|
|
|
|
in_typeinfo_x:
|
|
begin
|
|
set_varstate(left,true);
|
|
resulttype:=voidpointertype;
|
|
end;
|
|
|
|
in_assigned_x:
|
|
begin
|
|
set_varstate(left,true);
|
|
resulttype:=booltype;
|
|
end;
|
|
|
|
in_ofs_x :
|
|
internalerror(2000101001);
|
|
|
|
in_seg_x :
|
|
begin
|
|
set_varstate(left,false);
|
|
hp:=cordconstnode.create(0,s32bittype);
|
|
resulttypepass(hp);
|
|
result:=hp;
|
|
goto myexit;
|
|
end;
|
|
|
|
in_pred_x,
|
|
in_succ_x:
|
|
begin
|
|
set_varstate(left,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;
|
|
|
|
{ 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)
|
|
else
|
|
hp:=cordconstnode.create(tordconstnode(left).value-1,left.resulttype);
|
|
resulttypepass(hp);
|
|
result:=hp;
|
|
end;
|
|
end;
|
|
|
|
in_setlength_x:
|
|
begin
|
|
resulttype:=voidtype;
|
|
if assigned(left) then
|
|
begin
|
|
ppn:=tcallparanode(left);
|
|
counter:=0;
|
|
{ check type }
|
|
while assigned(ppn.right) do
|
|
begin
|
|
set_varstate(ppn.left,true);
|
|
inserttypeconv(ppn.left,s32bittype);
|
|
inc(counter);
|
|
ppn:=tcallparanode(ppn.right);
|
|
end;
|
|
{ last param must be var }
|
|
valid_for_assign(ppn.left,false);
|
|
set_varstate(ppn.left,false);
|
|
{ first param must be a string or dynamic array ...}
|
|
if not((ppn.left.resulttype.def.deftype=stringdef) or
|
|
(is_dynamic_array(ppn.left.resulttype.def))) then
|
|
CGMessage(type_e_mismatch);
|
|
|
|
{ only dynamic arrays accept more dimensions }
|
|
if (counter>1) and
|
|
(not(is_dynamic_array(left.resulttype.def))) then
|
|
CGMessage(type_e_mismatch);
|
|
|
|
{ convert shortstrings to openstring parameters }
|
|
{ (generate the hightree) (JM) }
|
|
if (ppn.left.resulttype.def.deftype = stringdef) and
|
|
(tstringdef(ppn.left.resulttype.def).string_typ =
|
|
st_shortstring) then
|
|
begin
|
|
dummycoll:=tparaitem.create;
|
|
dummycoll.paratyp:=vs_var;
|
|
dummycoll.paratype:=openshortstringtype;
|
|
tcallparanode(ppn).insert_typeconv(dummycoll,false);
|
|
dummycoll.destroy;
|
|
end;
|
|
end
|
|
else
|
|
CGMessage(type_e_mismatch);
|
|
end;
|
|
|
|
in_finalize_x:
|
|
begin
|
|
resulttype:=voidtype;
|
|
if assigned(left) and assigned(tcallparanode(left).left) then
|
|
begin
|
|
{ first param must be var }
|
|
valid_for_assign(tcallparanode(left).left,false);
|
|
set_varstate(tcallparanode(left).left,true);
|
|
|
|
{ two parameters?, the last parameter must be a longint }
|
|
if assigned(tcallparanode(left).right) then
|
|
inserttypeconv(tcallparanode(tcallparanode(left).right).left,s32bittype);
|
|
end
|
|
else
|
|
CGMessage(type_e_mismatch);
|
|
end;
|
|
|
|
in_inc_x,
|
|
in_dec_x:
|
|
begin
|
|
resulttype:=voidtype;
|
|
if assigned(left) then
|
|
begin
|
|
set_varstate(left,true);
|
|
if codegenerror then
|
|
exit;
|
|
{ first param must be var }
|
|
valid_for_assign(tcallparanode(left).left,false);
|
|
|
|
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
|
|
{ insert a type conversion }
|
|
{ the second param is always longint }
|
|
inserttypeconv(tcallparanode(tcallparanode(left).right).left,s32bittype);
|
|
|
|
if assigned(tcallparanode(tcallparanode(left).right).right) then
|
|
CGMessage(cg_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
|
|
resulttype:=voidtype;
|
|
{ we must know if it is a typed file or not }
|
|
{ but we must first do the firstpass for it }
|
|
file_is_typed:=false;
|
|
if assigned(left) then
|
|
begin
|
|
iswrite:=(inlinenumber in [in_write_x,in_writeln_x]);
|
|
set_varstate(left,iswrite);
|
|
{ now we can check }
|
|
hp:=left;
|
|
while assigned(tcallparanode(hp).right) do
|
|
hp:=tcallparanode(hp).right;
|
|
{ if resulttype.def is not assigned, then automatically }
|
|
{ file is not typed. }
|
|
if assigned(hp) and assigned(hp.resulttype.def) then
|
|
Begin
|
|
if (hp.resulttype.def.deftype=filedef) then
|
|
if (tfiledef(hp.resulttype.def).filetyp=ft_untyped) then
|
|
begin
|
|
if (inlinenumber in [in_readln_x,in_writeln_x]) then
|
|
CGMessage(type_e_no_readln_writeln_for_typed_file)
|
|
else
|
|
CGMessage(type_e_no_read_write_for_untyped_file);
|
|
end
|
|
else if (tfiledef(hp.resulttype.def).filetyp=ft_typed) then
|
|
begin
|
|
file_is_typed:=true;
|
|
{ test the type }
|
|
if (inlinenumber in [in_readln_x,in_writeln_x]) then
|
|
CGMessage(type_e_no_readln_writeln_for_typed_file);
|
|
hpp:=left;
|
|
while (hpp<>hp) do
|
|
begin
|
|
if (tcallparanode(hpp).left.nodetype=typen) then
|
|
CGMessage(type_e_cant_read_write_type);
|
|
if not is_equal(hpp.resulttype.def,tfiledef(hp.resulttype.def).typedfiletype.def) then
|
|
CGMessage(type_e_mismatch);
|
|
{ generate the high() value for the shortstring }
|
|
if ((not iswrite) and is_shortstring(tcallparanode(hpp).left.resulttype.def)) or
|
|
(is_chararray(tcallparanode(hpp).left.resulttype.def)) then
|
|
tcallparanode(hpp).gen_high_tree(true);
|
|
{ read(ln) is call by reference (JM) }
|
|
if not iswrite then
|
|
make_not_regable(tcallparanode(hpp).left);
|
|
hpp:=tcallparanode(hpp).right;
|
|
end;
|
|
end;
|
|
end; { endif assigned(hp) }
|
|
|
|
{ insert type conversions for write(ln) }
|
|
if (not file_is_typed) then
|
|
begin
|
|
hp:=left;
|
|
while assigned(hp) do
|
|
begin
|
|
if (tcallparanode(hp).left.nodetype=typen) then
|
|
CGMessage(type_e_cant_read_write_type);
|
|
if assigned(tcallparanode(hp).left.resulttype.def) then
|
|
begin
|
|
isreal:=false;
|
|
{ support writeln(procvar) }
|
|
if (tcallparanode(hp).left.resulttype.def.deftype=procvardef) then
|
|
begin
|
|
p1:=ccallnode.create(nil,nil,nil,nil);
|
|
tcallnode(p1).set_procvar(tcallparanode(hp).left);
|
|
resulttypepass(p1);
|
|
tcallparanode(hp).left:=p1;
|
|
end;
|
|
case tcallparanode(hp).left.resulttype.def.deftype of
|
|
filedef :
|
|
begin
|
|
{ only allowed as first parameter }
|
|
if assigned(tcallparanode(hp).right) then
|
|
CGMessage(type_e_cant_read_write_type);
|
|
end;
|
|
stringdef :
|
|
begin
|
|
{ generate the high() value for the shortstring }
|
|
if (not iswrite) and
|
|
is_shortstring(tcallparanode(hp).left.resulttype.def) then
|
|
tcallparanode(hp).gen_high_tree(true);
|
|
end;
|
|
pointerdef :
|
|
begin
|
|
if not is_pchar(tcallparanode(hp).left.resulttype.def) then
|
|
CGMessage(type_e_cant_read_write_type);
|
|
end;
|
|
floatdef :
|
|
begin
|
|
isreal:=true;
|
|
end;
|
|
orddef :
|
|
begin
|
|
case torddef(tcallparanode(hp).left.resulttype.def).typ of
|
|
uchar,
|
|
u32bit,s32bit,
|
|
u64bit,s64bit:
|
|
;
|
|
u8bit,s8bit,
|
|
u16bit,s16bit :
|
|
if iswrite then
|
|
inserttypeconv(tcallparanode(hp).left,s32bittype);
|
|
bool8bit,
|
|
bool16bit,
|
|
bool32bit :
|
|
if iswrite then
|
|
inserttypeconv(tcallparanode(hp).left,booltype)
|
|
else
|
|
CGMessage(type_e_cant_read_write_type);
|
|
else
|
|
CGMessage(type_e_cant_read_write_type);
|
|
end;
|
|
end;
|
|
arraydef :
|
|
begin
|
|
if is_chararray(tcallparanode(hp).left.resulttype.def) then
|
|
tcallparanode(hp).gen_high_tree(true)
|
|
else
|
|
CGMessage(type_e_cant_read_write_type);
|
|
end;
|
|
else
|
|
CGMessage(type_e_cant_read_write_type);
|
|
end;
|
|
|
|
{ some format options ? }
|
|
if cpf_is_colon_para in tcallparanode(hp).callparaflags then
|
|
begin
|
|
if cpf_is_colon_para in tcallparanode(tcallparanode(hp).right).callparaflags then
|
|
begin
|
|
frac_para:=hp;
|
|
length_para:=tcallparanode(hp).right;
|
|
hp:=tcallparanode(hp).right;
|
|
hpp:=tcallparanode(hp).right;
|
|
end
|
|
else
|
|
begin
|
|
length_para:=hp;
|
|
frac_para:=nil;
|
|
hpp:=tcallparanode(hp).right;
|
|
end;
|
|
{ can be nil if you use "write(e:0:6)" while e is undeclared (JM) }
|
|
if assigned(tcallparanode(hpp).left.resulttype.def) then
|
|
isreal:=(tcallparanode(hpp).left.resulttype.def.deftype=floatdef)
|
|
else
|
|
exit;
|
|
if (not is_integer(tcallparanode(length_para).left.resulttype.def)) then
|
|
CGMessage1(type_e_integer_expr_expected,tcallparanode(length_para).left.resulttype.def.typename)
|
|
else
|
|
inserttypeconv(tcallparanode(length_para).left,s32bittype);
|
|
if assigned(frac_para) then
|
|
begin
|
|
if isreal then
|
|
begin
|
|
if (not is_integer(tcallparanode(frac_para).left.resulttype.def)) then
|
|
CGMessage1(type_e_integer_expr_expected,tcallparanode(frac_para).left.resulttype.def.typename)
|
|
else
|
|
inserttypeconv(tcallparanode(frac_para).left,s32bittype);
|
|
end
|
|
else
|
|
CGMessage(parser_e_illegal_colon_qualifier);
|
|
end;
|
|
{ do the checking for the colon'd arg }
|
|
hp:=length_para;
|
|
end;
|
|
end;
|
|
hp:=tcallparanode(hp).right;
|
|
end;
|
|
end;
|
|
if codegenerror then
|
|
exit;
|
|
set_varstate(left,true);
|
|
end;
|
|
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,s32bittype),left);
|
|
hp:=ccallnode.create(hp,tprocsym(srsym),systemunit,nil);
|
|
left:=nil;
|
|
resulttypepass(hp);
|
|
result:=hp;
|
|
end;
|
|
|
|
{ the firstpass of the arg has been done in firstcalln ? }
|
|
in_reset_typedfile,
|
|
in_rewrite_typedfile :
|
|
begin
|
|
set_varstate(left,true);
|
|
resulttype:=voidtype;
|
|
end;
|
|
|
|
in_str_x_string :
|
|
begin
|
|
resulttype:=voidtype;
|
|
set_varstate(left,false);
|
|
{ remove warning when result is passed }
|
|
set_funcret_is_valid(tcallparanode(left).left);
|
|
set_varstate(tcallparanode(tcallparanode(left).right).left,true);
|
|
hp:=left;
|
|
{ valid string ? }
|
|
if not assigned(hp) or
|
|
(tcallparanode(hp).left.resulttype.def.deftype<>stringdef) or
|
|
(tcallparanode(hp).right=nil) then
|
|
CGMessage(cg_e_illegal_expression);
|
|
{ we need a var parameter }
|
|
valid_for_assign(tcallparanode(hp).left,false);
|
|
{ generate the high() value for the shortstring }
|
|
if is_shortstring(tcallparanode(hp).left.resulttype.def) then
|
|
tcallparanode(hp).gen_high_tree(true);
|
|
{ !!!! check length of string }
|
|
while assigned(tcallparanode(hp).right) do
|
|
hp:=tcallparanode(hp).right;
|
|
if not assigned(tcallparanode(hp).resulttype.def) then
|
|
exit;
|
|
{ check and convert the first param }
|
|
if (cpf_is_colon_para in tcallparanode(hp).callparaflags) or
|
|
not assigned(hp.resulttype.def) then
|
|
CGMessage(cg_e_illegal_expression);
|
|
|
|
isreal:=false;
|
|
case hp.resulttype.def.deftype of
|
|
orddef :
|
|
begin
|
|
case torddef(tcallparanode(hp).left.resulttype.def).typ of
|
|
u32bit,s32bit,
|
|
s64bit,u64bit:
|
|
;
|
|
u8bit,s8bit,
|
|
u16bit,s16bit:
|
|
inserttypeconv(tcallparanode(hp).left,s32bittype);
|
|
else
|
|
CGMessage(type_e_integer_or_real_expr_expected);
|
|
end;
|
|
end;
|
|
floatdef :
|
|
begin
|
|
isreal:=true;
|
|
end;
|
|
else
|
|
CGMessage(type_e_integer_or_real_expr_expected);
|
|
end;
|
|
|
|
{ some format options ? }
|
|
hpp:=tcallparanode(left).right;
|
|
if assigned(hpp) and (cpf_is_colon_para in tcallparanode(hpp).callparaflags) then
|
|
begin
|
|
set_varstate(tcallparanode(hpp).left,true);
|
|
if (not is_integer(tcallparanode(hpp).left.resulttype.def)) then
|
|
CGMessage1(type_e_integer_expr_expected,tcallparanode(hpp).left.resulttype.def.typename)
|
|
else
|
|
inserttypeconv(tcallparanode(hpp).left,s32bittype);
|
|
hpp:=tcallparanode(hpp).right;
|
|
if assigned(hpp) and (cpf_is_colon_para in tcallparanode(hpp).callparaflags) then
|
|
begin
|
|
if isreal then
|
|
begin
|
|
if (not is_integer(tcallparanode(hpp).left.resulttype.def)) then
|
|
CGMessage1(type_e_integer_expr_expected,tcallparanode(hpp).left.resulttype.def.typename)
|
|
else
|
|
begin
|
|
set_varstate(tcallparanode(hpp).left,true);
|
|
inserttypeconv(tcallparanode(hpp).left,s32bittype);
|
|
end;
|
|
end
|
|
else
|
|
CGMessage(parser_e_illegal_colon_qualifier);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
in_val_x :
|
|
begin
|
|
resulttype:=voidtype;
|
|
{ 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;
|
|
{ there is a "code" parameter }
|
|
If Assigned(tcallparanode(tcallparanode(left).right).right) Then
|
|
Begin
|
|
{ first pass just the code parameter for first local use}
|
|
hp := tcallparanode(left).right;
|
|
tcallparanode(left).right := nil;
|
|
make_not_regable(tcallparanode(left).left);
|
|
set_varstate(left,false);
|
|
if codegenerror then
|
|
exit;
|
|
tcallparanode(left).right := hp;
|
|
{ code has to be a var parameter }
|
|
if valid_for_assign(tcallparanode(left).left,false) then
|
|
begin
|
|
if (tcallparanode(left).left.resulttype.def.deftype <> orddef) or
|
|
not(torddef(tcallparanode(left).left.resulttype.def).typ in [u16bit,s16bit,u32bit,s32bit]) then
|
|
CGMessage(type_e_mismatch);
|
|
end;
|
|
hpp := tcallparanode(left).right
|
|
End
|
|
Else
|
|
hpp := left;
|
|
{ now hpp = the destination value tree }
|
|
{ first pass just the destination parameter for first local use }
|
|
hp:=tcallparanode(hpp).right;
|
|
tcallparanode(hpp).right:=nil;
|
|
{ hpp = destination }
|
|
make_not_regable(tcallparanode(hpp).left);
|
|
set_varstate(hpp,false);
|
|
if codegenerror then
|
|
exit;
|
|
{ remove warning when result is passed }
|
|
set_funcret_is_valid(tcallparanode(hpp).left);
|
|
tcallparanode(hpp).right := hp;
|
|
if valid_for_assign(tcallparanode(hpp).left,false) then
|
|
begin
|
|
If Not((tcallparanode(hpp).left.resulttype.def.deftype = floatdef) or
|
|
is_integer(tcallparanode(hpp).left.resulttype.def)) then
|
|
CGMessage(type_e_mismatch);
|
|
end;
|
|
{ hp = source (String) }
|
|
{ if not a stringdef then insert a type conv which
|
|
does the other type checking }
|
|
If (tcallparanode(hp).left.resulttype.def.deftype<>stringdef) then
|
|
inserttypeconv(tcallparanode(hp).left,cshortstringtype);
|
|
set_varstate(hp,true);
|
|
end;
|
|
|
|
in_include_x_y,
|
|
in_exclude_x_y:
|
|
begin
|
|
resulttype:=voidtype;
|
|
if assigned(left) then
|
|
begin
|
|
set_varstate(left,true);
|
|
{ remove warning when result is passed }
|
|
set_funcret_is_valid(tcallparanode(left).left);
|
|
{ first param must be var }
|
|
valid_for_assign(tcallparanode(left).left,false);
|
|
{ check type }
|
|
if assigned(left.resulttype.def) and
|
|
(left.resulttype.def.deftype=setdef) then
|
|
begin
|
|
{ two paras ? }
|
|
if assigned(tcallparanode(left).right) then
|
|
begin
|
|
{ insert a type conversion }
|
|
{ to the type of the set elements }
|
|
inserttypeconv(tcallparanode(tcallparanode(left).right).left,
|
|
tsetdef(left.resulttype.def).elementtype);
|
|
{ only three parameters are allowed }
|
|
if assigned(tcallparanode(tcallparanode(left).right).right) then
|
|
CGMessage(cg_e_illegal_expression);
|
|
end;
|
|
end
|
|
else
|
|
CGMessage(type_e_mismatch);
|
|
end
|
|
else
|
|
CGMessage(type_e_mismatch);
|
|
end;
|
|
|
|
in_low_x,
|
|
in_high_x:
|
|
begin
|
|
set_varstate(left,false);
|
|
case left.resulttype.def.deftype of
|
|
orddef,
|
|
enumdef:
|
|
begin
|
|
hp:=do_lowhigh(left.resulttype);
|
|
resulttypepass(hp);
|
|
result:=hp;
|
|
end;
|
|
setdef:
|
|
begin
|
|
hp:=do_lowhigh(tsetdef(left.resulttype.def).elementtype);
|
|
resulttypepass(hp);
|
|
result:=hp;
|
|
end;
|
|
arraydef:
|
|
begin
|
|
if inlinenumber=in_low_x then
|
|
begin
|
|
hp:=cordconstnode.create(tarraydef(left.resulttype.def).lowrange,tarraydef(left.resulttype.def).rangetype);
|
|
resulttypepass(hp);
|
|
result:=hp;
|
|
end
|
|
else
|
|
begin
|
|
if is_open_array(left.resulttype.def) or
|
|
is_array_of_const(left.resulttype.def) then
|
|
begin
|
|
srsym:=searchsymonlyin(tloadnode(left).symtable,'high'+tvarsym(tloadnode(left).symtableentry).name);
|
|
hp:=cloadnode.create(tvarsym(srsym),tloadnode(left).symtable);
|
|
resulttypepass(hp);
|
|
result:=hp;
|
|
end
|
|
else
|
|
begin
|
|
hp:=cordconstnode.create(tarraydef(left.resulttype.def).highrange,tarraydef(left.resulttype.def).rangetype);
|
|
resulttypepass(hp);
|
|
result:=hp;
|
|
end;
|
|
end;
|
|
end;
|
|
stringdef:
|
|
begin
|
|
if inlinenumber=in_low_x then
|
|
begin
|
|
hp:=cordconstnode.create(0,u8bittype);
|
|
resulttypepass(hp);
|
|
result:=hp;
|
|
end
|
|
else
|
|
begin
|
|
if is_open_string(left.resulttype.def) then
|
|
begin
|
|
srsym:=searchsymonlyin(tloadnode(left).symtable,'high'+tvarsym(tloadnode(left).symtableentry).name);
|
|
hp:=cloadnode.create(tvarsym(srsym),tloadnode(left).symtable);
|
|
resulttypepass(hp);
|
|
result:=hp;
|
|
end
|
|
else
|
|
begin
|
|
hp:=cordconstnode.create(tstringdef(left.resulttype.def).len,u8bittype);
|
|
resulttypepass(hp);
|
|
result:=hp;
|
|
end;
|
|
end;
|
|
end;
|
|
else
|
|
CGMessage(type_e_mismatch);
|
|
end;
|
|
end;
|
|
|
|
in_pi:
|
|
begin
|
|
if block_type=bt_const then
|
|
setconstrealvalue(pi)
|
|
else
|
|
resulttype:=s80floattype;
|
|
end;
|
|
|
|
in_cos_extended :
|
|
begin
|
|
if left.nodetype in [ordconstn,realconstn] then
|
|
setconstrealvalue(cos(getconstrealvalue))
|
|
else
|
|
begin
|
|
set_varstate(left,true);
|
|
inserttypeconv(left,s80floattype);
|
|
resulttype:=s80floattype;
|
|
end;
|
|
end;
|
|
|
|
in_sin_extended :
|
|
begin
|
|
if left.nodetype in [ordconstn,realconstn] then
|
|
setconstrealvalue(sin(getconstrealvalue))
|
|
else
|
|
begin
|
|
set_varstate(left,true);
|
|
inserttypeconv(left,s80floattype);
|
|
resulttype:=s80floattype;
|
|
end;
|
|
end;
|
|
|
|
in_arctan_extended :
|
|
begin
|
|
if left.nodetype in [ordconstn,realconstn] then
|
|
setconstrealvalue(arctan(getconstrealvalue))
|
|
else
|
|
begin
|
|
set_varstate(left,true);
|
|
inserttypeconv(left,s80floattype);
|
|
resulttype:=s80floattype;
|
|
end;
|
|
end;
|
|
|
|
in_abs_extended :
|
|
begin
|
|
if left.nodetype in [ordconstn,realconstn] then
|
|
setconstrealvalue(abs(getconstrealvalue))
|
|
else
|
|
begin
|
|
set_varstate(left,true);
|
|
inserttypeconv(left,s80floattype);
|
|
resulttype:=s80floattype;
|
|
end;
|
|
end;
|
|
|
|
in_sqr_extended :
|
|
begin
|
|
if left.nodetype in [ordconstn,realconstn] then
|
|
setconstrealvalue(sqr(getconstrealvalue))
|
|
else
|
|
begin
|
|
set_varstate(left,true);
|
|
inserttypeconv(left,s80floattype);
|
|
resulttype:=s80floattype;
|
|
end;
|
|
end;
|
|
|
|
in_sqrt_extended :
|
|
begin
|
|
if left.nodetype in [ordconstn,realconstn] then
|
|
begin
|
|
vr:=getconstrealvalue;
|
|
if vr<0.0 then
|
|
begin
|
|
CGMessage(type_e_wrong_math_argument);
|
|
setconstrealvalue(0);
|
|
end
|
|
else
|
|
setconstrealvalue(sqrt(vr));
|
|
end
|
|
else
|
|
begin
|
|
set_varstate(left,true);
|
|
inserttypeconv(left,s80floattype);
|
|
resulttype:=s80floattype;
|
|
end;
|
|
end;
|
|
|
|
in_ln_extended :
|
|
begin
|
|
if left.nodetype in [ordconstn,realconstn] then
|
|
begin
|
|
vr:=getconstrealvalue;
|
|
if vr<=0.0 then
|
|
begin
|
|
CGMessage(type_e_wrong_math_argument);
|
|
setconstrealvalue(0);
|
|
end
|
|
else
|
|
setconstrealvalue(ln(vr));
|
|
end
|
|
else
|
|
begin
|
|
set_varstate(left,true);
|
|
inserttypeconv(left,s80floattype);
|
|
resulttype:=s80floattype;
|
|
end;
|
|
end;
|
|
|
|
{$ifdef SUPPORT_MMX}
|
|
in_mmx_pcmpeqb..in_mmx_pcmpgtw:
|
|
begin
|
|
end;
|
|
{$endif SUPPORT_MMX}
|
|
|
|
in_assert_x_y :
|
|
begin
|
|
resulttype:=voidtype;
|
|
if assigned(left) then
|
|
begin
|
|
set_varstate(left,true);
|
|
{ check type }
|
|
if is_boolean(left.resulttype.def) then
|
|
begin
|
|
{ must always be a string }
|
|
inserttypeconv(tcallparanode(tcallparanode(left).right).left,cshortstringtype);
|
|
end
|
|
else
|
|
CGMessage(type_e_mismatch);
|
|
end
|
|
else
|
|
CGMessage(type_e_mismatch);
|
|
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;
|
|
|
|
|
|
{$ifdef fpc}
|
|
{$maxfpuregisters 0}
|
|
{$endif fpc}
|
|
function tinlinenode.pass_1 : tnode;
|
|
var
|
|
srsym : tsym;
|
|
hp,hpp : tnode;
|
|
extra_register,
|
|
iswrite,
|
|
file_is_typed : boolean;
|
|
|
|
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(nil,false)
|
|
else
|
|
firstpass(left);
|
|
left_max;
|
|
set_location(location,left.location);
|
|
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
|
|
if registers32<1 then
|
|
registers32:=1;
|
|
location.loc:=LOC_REGISTER;
|
|
end;
|
|
|
|
in_sizeof_x:
|
|
begin
|
|
if push_high_param(left.resulttype.def) then
|
|
begin
|
|
srsym:=searchsymonlyin(tloadnode(left).symtable,'high'+tvarsym(tloadnode(left).symtableentry).name);
|
|
hp:=caddnode.create(addn,cloadnode.create(tvarsym(srsym),tloadnode(left).symtable),
|
|
cordconstnode.create(1,s32bittype));
|
|
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,s32bittype));
|
|
firstpass(hp);
|
|
result:=hp;
|
|
end
|
|
else
|
|
begin
|
|
if registers32<1 then
|
|
registers32:=1;
|
|
location.loc:=LOC_REGISTER;
|
|
end;
|
|
end;
|
|
|
|
in_typeof_x:
|
|
begin
|
|
if registers32<1 then
|
|
registers32:=1;
|
|
location.loc:=LOC_REGISTER;
|
|
end;
|
|
|
|
in_ord_x,
|
|
in_chr_byte:
|
|
begin
|
|
{ should not happend as it's converted to typeconv }
|
|
internalerror(200104045);
|
|
end;
|
|
|
|
|
|
in_length_string:
|
|
begin
|
|
end;
|
|
|
|
in_typeinfo_x:
|
|
begin
|
|
location.loc:=LOC_REGISTER;
|
|
registers32:=1;
|
|
end;
|
|
|
|
in_assigned_x:
|
|
begin
|
|
location.loc:=LOC_FLAGS;
|
|
end;
|
|
|
|
in_ofs_x :
|
|
internalerror(2000101001);
|
|
|
|
in_seg_x :
|
|
internalerror(200104046);
|
|
|
|
in_pred_x,
|
|
in_succ_x:
|
|
begin
|
|
if is_64bitint(resulttype.def) then
|
|
begin
|
|
if (registers32<2) then
|
|
registers32:=2
|
|
end
|
|
else
|
|
begin
|
|
if (registers32<1) then
|
|
registers32:=1;
|
|
end;
|
|
location.loc:=LOC_REGISTER;
|
|
end;
|
|
|
|
in_setlength_x:
|
|
begin
|
|
end;
|
|
|
|
in_finalize_x:
|
|
begin
|
|
end;
|
|
|
|
in_inc_x,
|
|
in_dec_x:
|
|
begin
|
|
{ check type }
|
|
if is_64bitint(left.resulttype.def) or
|
|
{ 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
|
|
{ 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(cg_e_illegal_expression);
|
|
end
|
|
else
|
|
{ no, create constant 1 }
|
|
hpp := cordconstnode.create(1,s32bittype);
|
|
{ addition/substraction depending on inc/dec }
|
|
if inlinenumber = in_inc_x then
|
|
hp := caddnode.create(addn,tcallparanode(left).left.getcopy,hpp)
|
|
else
|
|
hp := caddnode.create(subn,tcallparanode(left).left.getcopy,hpp);
|
|
{ assign result of addition }
|
|
hpp := cassignmentnode.create(tcallparanode(left).left,hp);
|
|
tcallparanode(left).left := nil;
|
|
{ firstpass it }
|
|
firstpass(hpp);
|
|
{ return new node }
|
|
result := hpp;
|
|
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.location.loc in [LOC_MEM,LOC_REFERENCE]) and
|
|
(tcallparanode(tcallparanode(left).right).left.registers32<=1) then
|
|
inc(registers32);
|
|
|
|
{ do we need an additional register to restore the first parameter? }
|
|
if tcallparanode(tcallparanode(left).right).left.registers32>=registers32 then
|
|
inc(registers32);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
in_read_x,
|
|
in_readln_x,
|
|
in_write_x,
|
|
in_writeln_x :
|
|
begin
|
|
{ needs a call }
|
|
procinfo^.flags:=procinfo^.flags or pi_do_call;
|
|
{ true, if readln needs an extra register }
|
|
extra_register:=false;
|
|
{ we must know if it is a typed file or not }
|
|
{ but we must first do the firstpass for it }
|
|
file_is_typed:=false;
|
|
if assigned(left) then
|
|
begin
|
|
iswrite:=(inlinenumber in [in_write_x,in_writeln_x]);
|
|
{ now we can check }
|
|
hp:=left;
|
|
while assigned(tcallparanode(hp).right) do
|
|
hp:=tcallparanode(hp).right;
|
|
{ if resulttype.def is not assigned, then automatically }
|
|
{ file is not typed. }
|
|
if assigned(hp) then
|
|
Begin
|
|
if (hp.resulttype.def.deftype=filedef) and
|
|
(tfiledef(hp.resulttype.def).filetyp=ft_typed) then
|
|
file_is_typed:=true;
|
|
end; { endif assigned(hp) }
|
|
if (not file_is_typed) then
|
|
begin
|
|
hp:=left;
|
|
while assigned(hp) do
|
|
begin
|
|
{$ifdef i386}
|
|
incrementregisterpushed($ff);
|
|
{$else}
|
|
incrementregisterpushed(ALL_REGISTERS);
|
|
{$endif}
|
|
if assigned(tcallparanode(hp).left.resulttype.def) then
|
|
begin
|
|
case tcallparanode(hp).left.resulttype.def.deftype of
|
|
orddef :
|
|
begin
|
|
if not(iswrite) and
|
|
not(is_64bitint(tcallparanode(hp).left.resulttype.def)) then
|
|
extra_register:=true;
|
|
end;
|
|
end;
|
|
end;
|
|
hp:=tcallparanode(hp).right;
|
|
end;
|
|
end;
|
|
{ calc registers }
|
|
left_max;
|
|
if extra_register then
|
|
inc(registers32);
|
|
end;
|
|
end;
|
|
|
|
in_settextbuf_file_x :
|
|
internalerror(200104262);
|
|
|
|
in_reset_typedfile,
|
|
in_rewrite_typedfile :
|
|
begin
|
|
procinfo^.flags:=procinfo^.flags or pi_do_call;
|
|
end;
|
|
|
|
in_str_x_string :
|
|
begin
|
|
procinfo^.flags:=procinfo^.flags or pi_do_call;
|
|
{ calc registers }
|
|
left_max;
|
|
end;
|
|
|
|
in_val_x :
|
|
begin
|
|
procinfo^.flags:=procinfo^.flags or pi_do_call;
|
|
{ calc registers }
|
|
left_max;
|
|
{ val doesn't calculate the registers really }
|
|
{ correct, we need one register extra (FK) }
|
|
{ there is a "code" parameter }
|
|
If Assigned(tcallparanode(tcallparanode(left).right).right) Then
|
|
hpp := tcallparanode(left).right
|
|
Else
|
|
hpp := left;
|
|
{ now hpp = the destination value tree }
|
|
if is_64bitint(tcallparanode(hpp).left.resulttype.def) then
|
|
inc(registers32,2)
|
|
else
|
|
inc(registers32,1);
|
|
end;
|
|
|
|
in_include_x_y,
|
|
in_exclude_x_y:
|
|
begin
|
|
registers32:=left.registers32;
|
|
registersfpu:=left.registersfpu;
|
|
{$ifdef SUPPORT_MMX}
|
|
registersmmx:=left.registersmmx;
|
|
{$endif SUPPORT_MMX}
|
|
end;
|
|
|
|
in_low_x,
|
|
in_high_x:
|
|
internalerror(200104047);
|
|
|
|
in_cos_extended:
|
|
begin
|
|
location.loc:=LOC_FPU;
|
|
registers32:=left.registers32;
|
|
registersfpu:=left.registersfpu;
|
|
{$ifdef SUPPORT_MMX}
|
|
registersmmx:=left.registersmmx;
|
|
{$endif SUPPORT_MMX}
|
|
end;
|
|
|
|
in_sin_extended:
|
|
begin
|
|
location.loc:=LOC_FPU;
|
|
registers32:=left.registers32;
|
|
registersfpu:=left.registersfpu;
|
|
{$ifdef SUPPORT_MMX}
|
|
registersmmx:=left.registersmmx;
|
|
{$endif SUPPORT_MMX}
|
|
end;
|
|
|
|
in_arctan_extended:
|
|
begin
|
|
location.loc:=LOC_FPU;
|
|
registers32:=left.registers32;
|
|
registersfpu:=left.registersfpu;
|
|
{$ifdef SUPPORT_MMX}
|
|
registersmmx:=left.registersmmx;
|
|
{$endif SUPPORT_MMX}
|
|
end;
|
|
|
|
in_pi:
|
|
begin
|
|
location.loc:=LOC_FPU;
|
|
end;
|
|
|
|
in_abs_extended:
|
|
begin
|
|
location.loc:=LOC_FPU;
|
|
registers32:=left.registers32;
|
|
registersfpu:=left.registersfpu;
|
|
{$ifdef SUPPORT_MMX}
|
|
registersmmx:=left.registersmmx;
|
|
{$endif SUPPORT_MMX}
|
|
end;
|
|
|
|
in_sqr_extended:
|
|
begin
|
|
location.loc:=LOC_FPU;
|
|
registers32:=left.registers32;
|
|
registersfpu:=left.registersfpu;
|
|
{$ifdef SUPPORT_MMX}
|
|
registersmmx:=left.registersmmx;
|
|
{$endif SUPPORT_MMX}
|
|
end;
|
|
|
|
in_sqrt_extended:
|
|
begin
|
|
location.loc:=LOC_FPU;
|
|
registers32:=left.registers32;
|
|
registersfpu:=left.registersfpu;
|
|
{$ifdef SUPPORT_MMX}
|
|
registersmmx:=left.registersmmx;
|
|
{$endif SUPPORT_MMX}
|
|
end;
|
|
|
|
in_ln_extended:
|
|
begin
|
|
location.loc:=LOC_FPU;
|
|
registers32:=left.registers32;
|
|
registersfpu:=left.registersfpu;
|
|
{$ifdef SUPPORT_MMX}
|
|
registersmmx:=left.registersmmx;
|
|
{$endif SUPPORT_MMX}
|
|
end;
|
|
|
|
{$ifdef SUPPORT_MMX}
|
|
in_mmx_pcmpeqb..in_mmx_pcmpgtw:
|
|
begin
|
|
end;
|
|
{$endif SUPPORT_MMX}
|
|
|
|
in_assert_x_y :
|
|
begin
|
|
{ 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
|
|
begin
|
|
registers32:=left.registers32;
|
|
registersfpu:=left.registersfpu;
|
|
{$ifdef SUPPORT_MMX}
|
|
registersmmx:=left.registersmmx;
|
|
{$endif SUPPORT_MMX}
|
|
end;
|
|
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;
|
|
|
|
|
|
begin
|
|
cinlinenode:=tinlinenode;
|
|
end.
|
|
{
|
|
$Log$
|
|
Revision 1.39 2001-04-26 21:57:05 peter
|
|
* moved code from firstpass to det_resulttype and remove extraneous
|
|
calls to firstcallparan for in_str,in_write,in_val
|
|
|
|
Revision 1.38 2001/04/21 12:03:11 peter
|
|
* m68k updates merged from fixes branch
|
|
|
|
Revision 1.37 2001/04/13 22:22:30 peter
|
|
* call set_varstate for setlength
|
|
* ptr returns pointerconstnode instead of ordconstnode
|
|
|
|
Revision 1.36 2001/04/13 01:22:09 peter
|
|
* symtable change to classes
|
|
* range check generation and errors fixed, make cycle DEBUG=1 works
|
|
* memory leaks fixed
|
|
|
|
Revision 1.35 2001/04/05 21:02:13 peter
|
|
* fixed fpu inline functions typeconvs
|
|
|
|
Revision 1.34 2001/04/04 22:42:40 peter
|
|
* move constant folding into det_resulttype
|
|
|
|
Revision 1.33 2001/04/04 21:30:43 florian
|
|
* applied several fixes to get the DD8 Delphi Unit compiled
|
|
e.g. "forward"-interfaces are working now
|
|
|
|
Revision 1.32 2001/04/02 21:20:31 peter
|
|
* resulttype rewrite
|
|
|
|
Revision 1.31 2001/03/23 00:16:07 florian
|
|
+ some stuff to compile FreeCLX added
|
|
|
|
Revision 1.30 2001/03/12 12:47:46 michael
|
|
+ Patches from peter
|
|
|
|
Revision 1.29 2001/03/03 12:38:08 jonas
|
|
* fixed low() for signed types < 64bit
|
|
|
|
Revision 1.28 2001/02/26 19:44:53 peter
|
|
* merged generic m68k updates from fixes branch
|
|
|
|
Revision 1.27 2001/02/22 11:24:40 jonas
|
|
* fixed bug in previous fix (hopped over revision 1.26 because that one
|
|
also removed the fix for high(cardinal))
|
|
|
|
Revision 1.26 2001/02/21 20:50:59 peter
|
|
* fix to compile again, but high(cardinal) with $R+ still fails!
|
|
|
|
Revision 1.25 2001/02/21 12:57:46 jonas
|
|
* fixed high/low for cardinal, int64 and qword
|
|
|
|
Revision 1.24 2001/01/06 19:54:11 peter
|
|
* merged fix for 1310
|
|
|
|
Revision 1.23 2001/01/06 18:28:39 peter
|
|
* fixed wrong notes about locals
|
|
|
|
Revision 1.22 2000/12/31 11:14:10 jonas
|
|
+ implemented/fixed docompare() mathods for all nodes (not tested)
|
|
+ nopt.pas, nadd.pas, i386/n386opt.pas: optimized nodes for adding strings
|
|
and constant strings/chars together
|
|
* n386add.pas: don't copy temp strings (of size 256) to another temp string
|
|
when adding
|
|
|
|
Revision 1.21 2000/12/25 00:07:26 peter
|
|
+ new tlinkedlist class (merge of old tstringqueue,tcontainer and
|
|
tlinkedlist objects)
|
|
|
|
Revision 1.20 2000/12/17 14:35:41 peter
|
|
* fixed crash with val()
|
|
|
|
Revision 1.19 2000/11/29 00:30:33 florian
|
|
* unused units removed from uses clause
|
|
* some changes for widestrings
|
|
|
|
Revision 1.18 2000/11/12 15:27:22 jonas
|
|
* also don't do conversion for chars/booleans (hopefully final change :/)
|
|
|
|
Revision 1.17 2000/11/11 21:08:13 jonas
|
|
* don't do inc/dec to add/sub conversion for enums
|
|
|
|
Revision 1.16 2000/11/11 16:18:35 peter
|
|
* ptr returns farpointer
|
|
|
|
Revision 1.15 2000/11/11 15:59:07 jonas
|
|
* convert inc/dec to add/sub when range/overflow checking is on
|
|
|
|
Revision 1.14 2000/11/09 17:46:54 florian
|
|
* System.TypeInfo fixed
|
|
+ System.Finalize implemented
|
|
+ some new keywords for interface support added
|
|
|
|
Revision 1.13 2000/11/04 16:48:32 florian
|
|
* innr.inc renamed to make compiler compilation easier because the rtl contains
|
|
a file of the same name
|
|
|
|
Revision 1.12 2000/10/31 22:02:48 peter
|
|
* symtable splitted, no real code changes
|
|
|
|
Revision 1.11 2000/10/26 14:15:06 jonas
|
|
* fixed setlength for shortstrings
|
|
|
|
Revision 1.10 2000/10/21 18:16:11 florian
|
|
* a lot of changes:
|
|
- basic dyn. array support
|
|
- basic C++ support
|
|
- some work for interfaces done
|
|
....
|
|
|
|
Revision 1.9 2000/10/15 08:38:46 jonas
|
|
* added missing getcopy for previous addition
|
|
|
|
Revision 1.8 2000/10/14 18:27:53 jonas
|
|
* merged fix for inc/dec on 64bit types from tcinl
|
|
|
|
Revision 1.7 2000/10/14 10:14:50 peter
|
|
* moehrendorf oct 2000 rewrite
|
|
|
|
Revision 1.6 2000/10/01 19:48:24 peter
|
|
* lot of compile updates for cg11
|
|
|
|
Revision 1.5 2000/09/28 19:49:52 florian
|
|
*** empty log message ***
|
|
|
|
Revision 1.4 2000/09/28 16:34:47 florian
|
|
*** empty log message ***
|
|
|
|
Revision 1.3 2000/09/27 21:33:22 florian
|
|
* finally nadd.pas compiles
|
|
|
|
Revision 1.2 2000/09/27 20:25:44 florian
|
|
* more stuff fixed
|
|
|
|
Revision 1.1 2000/09/26 14:59:34 florian
|
|
* more conversion work done
|
|
|
|
}
|