mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-15 14:59:26 +02:00
996e325175
generator to the typecheck pass, so that it also works for platforms
that use the parentfpstruct way to handle accesses to nested frames
in case the array has been migrated to such a parentfpstruct
o additionally, the number of comparisons for such range checks
has been reduced from 3 (for signed indices) or 2 (for unsigned
indices) to 1 in all cases
o the range checking code is disabled for the JVM target, as the
JVM automatically range checks all array accesses itself anyway
git-svn-id: trunk@34034 -
1326 lines
48 KiB
ObjectPascal
1326 lines
48 KiB
ObjectPascal
{
|
|
Copyright (c) 2000-2002 by Florian Klaempfl
|
|
|
|
Type checking and register allocation for memory related 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 nmem;
|
|
|
|
{$i fpcdefs.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
node,
|
|
symdef,symsym,symtable,symtype;
|
|
|
|
type
|
|
tloadvmtaddrnode = class(tunarynode)
|
|
{ unless this is for a call, we have to send the "class" message to
|
|
the objctype because the type information only gets initialized
|
|
after the first message has been sent -> crash if you pass an
|
|
uninitialized type to e.g. class_getInstanceSize() or so. No need
|
|
to save to/restore from ppu. }
|
|
forcall: boolean;
|
|
constructor create(l : tnode);virtual;
|
|
function pass_1 : tnode;override;
|
|
function pass_typecheck:tnode;override;
|
|
function docompare(p: tnode): boolean; override;
|
|
function dogetcopy: tnode; override;
|
|
end;
|
|
tloadvmtaddrnodeclass = class of tloadvmtaddrnode;
|
|
|
|
tloadparentfpkind = (
|
|
{ as parameter to a nested routine (current routine's frame) }
|
|
lpf_forpara,
|
|
{ to load a local from a parent routine in the current nested routine
|
|
(some parent routine's frame) }
|
|
lpf_forload
|
|
);
|
|
tloadparentfpnode = class(tunarynode)
|
|
parentpd : tprocdef;
|
|
parentpdderef : tderef;
|
|
kind: tloadparentfpkind;
|
|
constructor create(pd: tprocdef; fpkind: tloadparentfpkind);virtual;
|
|
constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
|
|
procedure ppuwrite(ppufile:tcompilerppufile);override;
|
|
procedure buildderefimpl;override;
|
|
procedure derefimpl;override;
|
|
function pass_1 : tnode;override;
|
|
function pass_typecheck:tnode;override;
|
|
function docompare(p: tnode): boolean; override;
|
|
function dogetcopy : tnode;override;
|
|
end;
|
|
tloadparentfpnodeclass = class of tloadparentfpnode;
|
|
|
|
taddrnode = class(tunarynode)
|
|
getprocvardef : tprocvardef;
|
|
getprocvardefderef : tderef;
|
|
constructor create(l : tnode);virtual;
|
|
constructor create_internal(l : tnode); virtual;
|
|
constructor create_internal_nomark(l : tnode); virtual;
|
|
constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
|
|
procedure ppuwrite(ppufile:tcompilerppufile);override;
|
|
procedure mark_write;override;
|
|
procedure buildderefimpl;override;
|
|
procedure derefimpl;override;
|
|
function docompare(p: tnode): boolean; override;
|
|
function dogetcopy : tnode;override;
|
|
function pass_1 : tnode;override;
|
|
function pass_typecheck:tnode;override;
|
|
function simplify(forinline : boolean) : tnode; override;
|
|
protected
|
|
mark_read_written: boolean;
|
|
function typecheck_non_proc(realsource: tnode; out res: tnode): boolean; virtual;
|
|
end;
|
|
taddrnodeclass = class of taddrnode;
|
|
|
|
tderefnode = class(tunarynode)
|
|
constructor create(l : tnode);virtual;
|
|
function pass_1 : tnode;override;
|
|
function pass_typecheck:tnode;override;
|
|
procedure mark_write;override;
|
|
end;
|
|
tderefnodeclass = class of tderefnode;
|
|
|
|
tsubscriptnode = class(tunarynode)
|
|
vs : tfieldvarsym;
|
|
vsderef : tderef;
|
|
constructor create(varsym : tsym;l : tnode);virtual;
|
|
constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
|
|
procedure ppuwrite(ppufile:tcompilerppufile);override;
|
|
procedure buildderefimpl;override;
|
|
procedure derefimpl;override;
|
|
function dogetcopy : tnode;override;
|
|
function pass_1 : tnode;override;
|
|
function docompare(p: tnode): boolean; override;
|
|
function pass_typecheck:tnode;override;
|
|
procedure mark_write;override;
|
|
end;
|
|
tsubscriptnodeclass = class of tsubscriptnode;
|
|
|
|
tvecnode = class(tbinarynode)
|
|
protected
|
|
function first_arraydef: tnode; virtual;
|
|
function gen_array_rangecheck: tnode; virtual;
|
|
public
|
|
constructor create(l,r : tnode);virtual;
|
|
function pass_1 : tnode;override;
|
|
function pass_typecheck:tnode;override;
|
|
procedure mark_write;override;
|
|
end;
|
|
tvecnodeclass = class of tvecnode;
|
|
|
|
twithnode = class(tunarynode)
|
|
constructor create(l:tnode);
|
|
destructor destroy;override;
|
|
constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
|
|
procedure ppuwrite(ppufile:tcompilerppufile);override;
|
|
function dogetcopy : tnode;override;
|
|
function pass_1 : tnode;override;
|
|
function docompare(p: tnode): boolean; override;
|
|
function pass_typecheck:tnode;override;
|
|
end;
|
|
twithnodeclass = class of twithnode;
|
|
|
|
var
|
|
cloadvmtaddrnode : tloadvmtaddrnodeclass= tloadvmtaddrnode;
|
|
caddrnode : taddrnodeclass= taddrnode;
|
|
cderefnode : tderefnodeclass= tderefnode;
|
|
csubscriptnode : tsubscriptnodeclass= tsubscriptnode;
|
|
cvecnode : tvecnodeclass= tvecnode;
|
|
cwithnode : twithnodeclass= twithnode;
|
|
cloadparentfpnode : tloadparentfpnodeclass = tloadparentfpnode;
|
|
|
|
function is_big_untyped_addrnode(p: tnode): boolean;
|
|
|
|
implementation
|
|
|
|
uses
|
|
globtype,systems,constexp,
|
|
cutils,verbose,globals,
|
|
symconst,symbase,defutil,defcmp,
|
|
nadd,nbas,nflw,ninl,nutils,objcutil,
|
|
wpobase,
|
|
{$ifdef i8086}
|
|
cpuinfo,
|
|
{$endif i8086}
|
|
htypechk,pass_1,ncal,nld,ncon,ncnv,cgbase,procinfo
|
|
;
|
|
|
|
{*****************************************************************************
|
|
TLOADVMTADDRNODE
|
|
*****************************************************************************}
|
|
|
|
constructor tloadvmtaddrnode.create(l : tnode);
|
|
begin
|
|
inherited create(loadvmtaddrn,l);
|
|
end;
|
|
|
|
|
|
function tloadvmtaddrnode.pass_typecheck:tnode;
|
|
var
|
|
defaultresultdef : boolean;
|
|
begin
|
|
result:=nil;
|
|
typecheckpass(left);
|
|
if codegenerror then
|
|
exit;
|
|
|
|
case left.resultdef.typ of
|
|
classrefdef :
|
|
resultdef:=left.resultdef;
|
|
recorddef,
|
|
objectdef:
|
|
begin
|
|
if (left.resultdef.typ=objectdef) or
|
|
((target_info.system in systems_jvm) and
|
|
(left.resultdef.typ=recorddef)) then
|
|
begin
|
|
{ access to the classtype while specializing? }
|
|
if (df_generic in left.resultdef.defoptions) then
|
|
begin
|
|
defaultresultdef:=true;
|
|
if assigned(current_structdef) then
|
|
begin
|
|
if assigned(current_structdef.genericdef) then
|
|
if current_structdef.genericdef=left.resultdef then
|
|
begin
|
|
resultdef:=cclassrefdef.create(current_structdef);
|
|
defaultresultdef:=false;
|
|
end
|
|
else
|
|
CGMessage(parser_e_cant_create_generics_of_this_type);
|
|
end
|
|
else
|
|
message(parser_e_cant_create_generics_of_this_type);
|
|
if defaultresultdef then
|
|
resultdef:=cclassrefdef.create(left.resultdef);
|
|
end
|
|
else
|
|
resultdef:=cclassrefdef.create(left.resultdef);
|
|
end
|
|
else
|
|
CGMessage(parser_e_pointer_to_class_expected);
|
|
end
|
|
else
|
|
CGMessage(parser_e_pointer_to_class_expected);
|
|
end;
|
|
end;
|
|
|
|
|
|
function tloadvmtaddrnode.docompare(p: tnode): boolean;
|
|
begin
|
|
result:=inherited docompare(p);
|
|
if result then
|
|
result:=forcall=tloadvmtaddrnode(p).forcall;
|
|
end;
|
|
|
|
|
|
function tloadvmtaddrnode.dogetcopy: tnode;
|
|
begin
|
|
result:=inherited dogetcopy;
|
|
tloadvmtaddrnode(result).forcall:=forcall;
|
|
end;
|
|
|
|
|
|
function tloadvmtaddrnode.pass_1 : tnode;
|
|
var
|
|
vs: tsym;
|
|
begin
|
|
result:=nil;
|
|
expectloc:=LOC_REGISTER;
|
|
if (left.nodetype=typen) and
|
|
(cs_create_pic in current_settings.moduleswitches) then
|
|
include(current_procinfo.flags,pi_needs_got);
|
|
if left.nodetype<>typen then
|
|
begin
|
|
if (is_objc_class_or_protocol(left.resultdef) or
|
|
is_objcclassref(left.resultdef)) then
|
|
begin
|
|
{ on non-fragile ABI platforms, the ISA pointer may be opaque
|
|
and we must call Object_getClass to obtain the real ISA
|
|
pointer }
|
|
if target_info.system in systems_objc_nfabi then
|
|
begin
|
|
result:=ccallnode.createinternfromunit('OBJC','OBJECT_GETCLASS',ccallparanode.create(left,nil));
|
|
inserttypeconv_explicit(result,resultdef);
|
|
end
|
|
else
|
|
result:=objcloadbasefield(left,'ISA');
|
|
end
|
|
else
|
|
result:=ctypeconvnode.create_internal(load_vmt_for_self_node(left),resultdef);
|
|
{ reused }
|
|
left:=nil;
|
|
end
|
|
else if not is_objcclass(left.resultdef) and
|
|
not is_objcclassref(left.resultdef) then
|
|
begin
|
|
if not(nf_ignore_for_wpo in flags) and
|
|
(not assigned(current_procinfo) or
|
|
(po_inline in current_procinfo.procdef.procoptions) or
|
|
wpoinfomanager.symbol_live(current_procinfo.procdef.mangledname)) then
|
|
begin
|
|
{ keep track of which classes might be instantiated via a classrefdef }
|
|
if (left.resultdef.typ=classrefdef) then
|
|
tobjectdef(tclassrefdef(left.resultdef).pointeddef).register_maybe_created_object_type
|
|
else if (left.resultdef.typ=objectdef) then
|
|
tobjectdef(left.resultdef).register_maybe_created_object_type
|
|
end
|
|
end
|
|
else if is_objcclass(left.resultdef) and
|
|
not(forcall) then
|
|
begin
|
|
{ call "class" method (= "classclass" in FPC), because otherwise
|
|
we may use the class information before it has been
|
|
initialized }
|
|
vs:=search_struct_member(tobjectdef(left.resultdef),'CLASSCLASS');
|
|
if not assigned(vs) or
|
|
(vs.typ<>procsym) then
|
|
internalerror(2011080601);
|
|
{ can't reuse "self", because it will be freed when we return }
|
|
result:=ccallnode.create(nil,tprocsym(vs),vs.owner,self.getcopy,[],nil);
|
|
end;
|
|
end;
|
|
|
|
|
|
{*****************************************************************************
|
|
TLOADPARENTFPNODE
|
|
*****************************************************************************}
|
|
|
|
constructor tloadparentfpnode.create(pd: tprocdef; fpkind: tloadparentfpkind);
|
|
begin
|
|
inherited create(loadparentfpn,nil);
|
|
if not assigned(pd) then
|
|
internalerror(200309288);
|
|
if (pd.parast.symtablelevel>current_procinfo.procdef.parast.symtablelevel) then
|
|
internalerror(200309284);
|
|
parentpd:=pd;
|
|
kind:=fpkind;
|
|
end;
|
|
|
|
|
|
constructor tloadparentfpnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
|
|
begin
|
|
inherited ppuload(t,ppufile);
|
|
ppufile.getderef(parentpdderef);
|
|
kind:=tloadparentfpkind(ppufile.getbyte);
|
|
end;
|
|
|
|
|
|
procedure tloadparentfpnode.ppuwrite(ppufile:tcompilerppufile);
|
|
begin
|
|
inherited ppuwrite(ppufile);
|
|
ppufile.putderef(parentpdderef);
|
|
ppufile.putbyte(byte(kind));
|
|
end;
|
|
|
|
|
|
procedure tloadparentfpnode.buildderefimpl;
|
|
begin
|
|
inherited buildderefimpl;
|
|
parentpdderef.build(parentpd);
|
|
end;
|
|
|
|
|
|
procedure tloadparentfpnode.derefimpl;
|
|
begin
|
|
inherited derefimpl;
|
|
parentpd:=tprocdef(parentpdderef.resolve);
|
|
end;
|
|
|
|
|
|
function tloadparentfpnode.docompare(p: tnode): boolean;
|
|
begin
|
|
result:=
|
|
inherited docompare(p) and
|
|
(tloadparentfpnode(p).parentpd=parentpd) and
|
|
(tloadparentfpnode(p).kind=kind);
|
|
end;
|
|
|
|
|
|
function tloadparentfpnode.dogetcopy : tnode;
|
|
var
|
|
p : tloadparentfpnode;
|
|
begin
|
|
p:=tloadparentfpnode(inherited dogetcopy);
|
|
p.parentpd:=parentpd;
|
|
p.kind:=kind;
|
|
dogetcopy:=p;
|
|
end;
|
|
|
|
|
|
function tloadparentfpnode.pass_typecheck:tnode;
|
|
{$ifdef dummy}
|
|
var
|
|
currpi : tprocinfo;
|
|
hsym : tparavarsym;
|
|
{$endif dummy}
|
|
begin
|
|
result:=nil;
|
|
resultdef:=parentfpvoidpointertype;
|
|
{$ifdef dummy}
|
|
{ currently parentfps are never loaded in registers (FK) }
|
|
if (current_procinfo.procdef.parast.symtablelevel<>parentpd.parast.symtablelevel) then
|
|
begin
|
|
currpi:=current_procinfo;
|
|
{ walk parents }
|
|
while (currpi.procdef.owner.symtablelevel>parentpd.parast.symtablelevel) do
|
|
begin
|
|
currpi:=currpi.parent;
|
|
if not assigned(currpi) then
|
|
internalerror(2005040602);
|
|
hsym:=tparavarsym(currpi.procdef.parast.Find('parentfp'));
|
|
if not assigned(hsym) then
|
|
internalerror(2005040601);
|
|
hsym.varregable:=vr_none;
|
|
end;
|
|
end;
|
|
{$endif dummy}
|
|
end;
|
|
|
|
|
|
function tloadparentfpnode.pass_1 : tnode;
|
|
begin
|
|
result:=nil;
|
|
expectloc:=LOC_REGISTER;
|
|
end;
|
|
|
|
|
|
{*****************************************************************************
|
|
TADDRNODE
|
|
*****************************************************************************}
|
|
|
|
constructor taddrnode.create(l : tnode);
|
|
|
|
begin
|
|
inherited create(addrn,l);
|
|
getprocvardef:=nil;
|
|
mark_read_written := true;
|
|
end;
|
|
|
|
|
|
constructor taddrnode.create_internal(l : tnode);
|
|
begin
|
|
self.create(l);
|
|
include(flags,nf_internal);
|
|
end;
|
|
|
|
|
|
constructor taddrnode.create_internal_nomark(l : tnode);
|
|
begin
|
|
self.create_internal(l);
|
|
mark_read_written := false;
|
|
end;
|
|
|
|
|
|
constructor taddrnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
|
|
begin
|
|
inherited ppuload(t,ppufile);
|
|
ppufile.getderef(getprocvardefderef);
|
|
end;
|
|
|
|
|
|
procedure taddrnode.ppuwrite(ppufile:tcompilerppufile);
|
|
begin
|
|
inherited ppuwrite(ppufile);
|
|
ppufile.putderef(getprocvardefderef);
|
|
end;
|
|
|
|
procedure Taddrnode.mark_write;
|
|
|
|
begin
|
|
{@procvar:=nil is legal in Delphi mode.}
|
|
left.mark_write;
|
|
end;
|
|
|
|
procedure taddrnode.buildderefimpl;
|
|
begin
|
|
inherited buildderefimpl;
|
|
getprocvardefderef.build(getprocvardef);
|
|
end;
|
|
|
|
|
|
procedure taddrnode.derefimpl;
|
|
begin
|
|
inherited derefimpl;
|
|
getprocvardef:=tprocvardef(getprocvardefderef.resolve);
|
|
end;
|
|
|
|
|
|
function taddrnode.docompare(p: tnode): boolean;
|
|
begin
|
|
result:=
|
|
inherited docompare(p) and
|
|
(taddrnode(p).getprocvardef=getprocvardef);
|
|
end;
|
|
|
|
|
|
function taddrnode.dogetcopy : tnode;
|
|
var
|
|
p : taddrnode;
|
|
begin
|
|
p:=taddrnode(inherited dogetcopy);
|
|
p.getprocvardef:=getprocvardef;
|
|
dogetcopy:=p;
|
|
end;
|
|
|
|
|
|
function taddrnode.pass_typecheck:tnode;
|
|
var
|
|
hp : tnode;
|
|
hsym : tfieldvarsym;
|
|
isprocvar : boolean;
|
|
procpointertype: tdef;
|
|
begin
|
|
result:=nil;
|
|
typecheckpass(left);
|
|
if codegenerror then
|
|
exit;
|
|
|
|
make_not_regable(left,[ra_addr_regable,ra_addr_taken]);
|
|
|
|
{ don't allow constants, for internal use we also
|
|
allow taking the address of strings and sets }
|
|
if is_constnode(left) and
|
|
not(
|
|
(nf_internal in flags) and
|
|
(left.nodetype in [stringconstn,setconstn])
|
|
) then
|
|
begin
|
|
CGMessagePos(left.fileinfo,type_e_no_addr_of_constant);
|
|
exit;
|
|
end;
|
|
|
|
{ Handle @proc special, also @procvar in tp-mode needs
|
|
special handling }
|
|
if (left.resultdef.typ=procdef) or
|
|
(
|
|
{ in case of nf_internal, follow the normal FPC semantics so that
|
|
we can easily get the actual address of a procvar }
|
|
not(nf_internal in flags) and
|
|
(left.resultdef.typ=procvardef) and
|
|
((m_tp_procvar in current_settings.modeswitches) or
|
|
(m_mac_procvar in current_settings.modeswitches))
|
|
) then
|
|
begin
|
|
isprocvar:=(left.resultdef.typ=procvardef);
|
|
|
|
if not isprocvar then
|
|
begin
|
|
left:=ctypeconvnode.create_proc_to_procvar(left);
|
|
left.fileinfo:=fileinfo;
|
|
typecheckpass(left);
|
|
end;
|
|
|
|
{ In tp procvar mode the result is always a voidpointer. Insert
|
|
a typeconversion to voidpointer. For methodpointers we need
|
|
to load the proc field }
|
|
if (m_tp_procvar in current_settings.modeswitches) or
|
|
(m_mac_procvar in current_settings.modeswitches) then
|
|
begin
|
|
if tabstractprocdef(left.resultdef).is_addressonly then
|
|
begin
|
|
result:=ctypeconvnode.create_internal(left,tabstractprocdef(left.resultdef).address_type);
|
|
include(result.flags,nf_load_procvar);
|
|
left:=nil;
|
|
end
|
|
else
|
|
begin
|
|
{ For procvars and for nested routines we need to return
|
|
the proc field of the methodpointer }
|
|
if isprocvar or
|
|
is_nested_pd(tabstractprocdef(left.resultdef)) then
|
|
begin
|
|
if tabstractprocdef(left.resultdef).is_methodpointer then
|
|
procpointertype:=methodpointertype
|
|
else
|
|
procpointertype:=nestedprocpointertype;
|
|
{ find proc field in methodpointer record }
|
|
hsym:=tfieldvarsym(trecorddef(procpointertype).symtable.Find('proc'));
|
|
if not assigned(hsym) then
|
|
internalerror(200412041);
|
|
{ Load tmehodpointer(left).proc }
|
|
result:=csubscriptnode.create(
|
|
hsym,
|
|
ctypeconvnode.create_internal(left,procpointertype));
|
|
left:=nil;
|
|
end
|
|
else
|
|
CGMessage(type_e_variable_id_expected);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
{ Return the typeconvn only }
|
|
result:=left;
|
|
left:=nil;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
hp:=left;
|
|
while assigned(hp) and (hp.nodetype in [typeconvn,derefn,subscriptn]) do
|
|
hp:=tunarynode(hp).left;
|
|
if not assigned(hp) then
|
|
internalerror(200412042);
|
|
if typecheck_non_proc(hp,result) then
|
|
begin
|
|
if assigned(result) then
|
|
exit;
|
|
end
|
|
else
|
|
CGMessage(type_e_variable_id_expected);
|
|
end;
|
|
|
|
if mark_read_written then
|
|
begin
|
|
{ This is actually only "read", but treat it nevertheless as }
|
|
{ modified due to the possible use of pointers }
|
|
{ To avoid false positives regarding "uninitialised" }
|
|
{ warnings when using arrays, perform it in two steps }
|
|
set_varstate(left,vs_written,[]);
|
|
{ vsf_must_be_valid so it doesn't get changed into }
|
|
{ vsf_referred_not_inited }
|
|
set_varstate(left,vs_read,[vsf_must_be_valid]);
|
|
end;
|
|
if not(assigned(result)) then
|
|
result:=simplify(false);
|
|
end;
|
|
|
|
|
|
function taddrnode.simplify(forinline : boolean) : tnode;
|
|
var
|
|
hsym : tfieldvarsym;
|
|
begin
|
|
result:=nil;
|
|
if ((left.nodetype=subscriptn) and
|
|
(tsubscriptnode(left).left.nodetype=derefn) and
|
|
(tsubscriptnode(left).left.resultdef.typ=recorddef) and
|
|
(tderefnode(tsubscriptnode(left).left).left.nodetype=niln)) or
|
|
((left.nodetype=subscriptn) and
|
|
(tsubscriptnode(left).left.nodetype=typeconvn) and
|
|
(tsubscriptnode(left).left.resultdef.typ=recorddef) and
|
|
(ttypeconvnode(tsubscriptnode(left).left).left.nodetype=derefn) and
|
|
(tderefnode(ttypeconvnode(tsubscriptnode(left).left).left).left.nodetype=niln)) then
|
|
begin
|
|
hsym:=tsubscriptnode(left).vs;
|
|
if tabstractrecordsymtable(hsym.owner).is_packed then
|
|
result:=cpointerconstnode.create(hsym.fieldoffset div 8,resultdef)
|
|
else
|
|
result:=cpointerconstnode.create(hsym.fieldoffset,resultdef);
|
|
end;
|
|
end;
|
|
|
|
|
|
function taddrnode.typecheck_non_proc(realsource: tnode; out res: tnode): boolean;
|
|
var
|
|
hp : tnode;
|
|
hsym : tfieldvarsym;
|
|
offset: asizeint;
|
|
begin
|
|
result:=false;
|
|
res:=nil;
|
|
if (realsource.nodetype=loadn) and
|
|
(tloadnode(realsource).symtableentry.typ=absolutevarsym) and
|
|
(tabsolutevarsym(tloadnode(realsource).symtableentry).abstyp=toaddr) then
|
|
begin
|
|
offset:=tabsolutevarsym(tloadnode(realsource).symtableentry).addroffset;
|
|
hp:=left;
|
|
while assigned(hp)and(hp.nodetype=subscriptn) do
|
|
begin
|
|
hsym:=tsubscriptnode(hp).vs;
|
|
if tabstractrecordsymtable(hsym.owner).is_packed then
|
|
begin
|
|
{ can't calculate the address of a non-byte aligned field }
|
|
if (hsym.fieldoffset mod 8)<>0 then
|
|
begin
|
|
CGMessagePos(hp.fileinfo,parser_e_packed_element_no_var_addr);
|
|
exit
|
|
end;
|
|
inc(offset,hsym.fieldoffset div 8)
|
|
end
|
|
else
|
|
inc(offset,hsym.fieldoffset);
|
|
hp:=tunarynode(hp).left;
|
|
end;
|
|
if nf_typedaddr in flags then
|
|
res:=cpointerconstnode.create(offset,cpointerdef.getreusable(left.resultdef))
|
|
else
|
|
res:=cpointerconstnode.create(offset,voidpointertype);
|
|
result:=true;
|
|
end
|
|
else if (nf_internal in flags) or
|
|
valid_for_addr(left,true) then
|
|
begin
|
|
if not(nf_typedaddr in flags) then
|
|
resultdef:=voidpointertype
|
|
else
|
|
resultdef:=cpointerdef.getreusable(left.resultdef);
|
|
result:=true;
|
|
end
|
|
end;
|
|
|
|
|
|
function taddrnode.pass_1 : tnode;
|
|
begin
|
|
result:=nil;
|
|
firstpass(left);
|
|
if codegenerror then
|
|
exit;
|
|
|
|
{ is this right for object of methods ?? }
|
|
expectloc:=LOC_REGISTER;
|
|
end;
|
|
|
|
|
|
{*****************************************************************************
|
|
TDEREFNODE
|
|
*****************************************************************************}
|
|
|
|
constructor tderefnode.create(l : tnode);
|
|
begin
|
|
inherited create(derefn,l);
|
|
end;
|
|
|
|
|
|
function tderefnode.pass_typecheck:tnode;
|
|
begin
|
|
result:=nil;
|
|
typecheckpass(left);
|
|
set_varstate(left,vs_read,[vsf_must_be_valid]);
|
|
if codegenerror then
|
|
exit;
|
|
|
|
{ tp procvar support }
|
|
maybe_call_procvar(left,true);
|
|
|
|
if left.resultdef.typ=pointerdef then
|
|
resultdef:=tpointerdef(left.resultdef).pointeddef
|
|
else
|
|
CGMessage(parser_e_invalid_qualifier);
|
|
end;
|
|
|
|
procedure Tderefnode.mark_write;
|
|
|
|
begin
|
|
include(flags,nf_write);
|
|
end;
|
|
|
|
function tderefnode.pass_1 : tnode;
|
|
begin
|
|
result:=nil;
|
|
firstpass(left);
|
|
if codegenerror then
|
|
exit;
|
|
|
|
expectloc:=LOC_REFERENCE;
|
|
end;
|
|
|
|
|
|
{*****************************************************************************
|
|
TSUBSCRIPTNODE
|
|
*****************************************************************************}
|
|
|
|
constructor tsubscriptnode.create(varsym : tsym;l : tnode);
|
|
|
|
begin
|
|
inherited create(subscriptn,l);
|
|
{ vs should be changed to tsym! }
|
|
vs:=tfieldvarsym(varsym);
|
|
end;
|
|
|
|
constructor tsubscriptnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
|
|
begin
|
|
inherited ppuload(t,ppufile);
|
|
ppufile.getderef(vsderef);
|
|
end;
|
|
|
|
|
|
procedure tsubscriptnode.ppuwrite(ppufile:tcompilerppufile);
|
|
begin
|
|
inherited ppuwrite(ppufile);
|
|
ppufile.putderef(vsderef);
|
|
end;
|
|
|
|
|
|
procedure tsubscriptnode.buildderefimpl;
|
|
begin
|
|
inherited buildderefimpl;
|
|
vsderef.build(vs);
|
|
end;
|
|
|
|
|
|
procedure tsubscriptnode.derefimpl;
|
|
begin
|
|
inherited derefimpl;
|
|
vs:=tfieldvarsym(vsderef.resolve);
|
|
end;
|
|
|
|
|
|
function tsubscriptnode.dogetcopy : tnode;
|
|
var
|
|
p : tsubscriptnode;
|
|
begin
|
|
p:=tsubscriptnode(inherited dogetcopy);
|
|
p.vs:=vs;
|
|
dogetcopy:=p;
|
|
end;
|
|
|
|
|
|
function tsubscriptnode.pass_typecheck:tnode;
|
|
begin
|
|
result:=nil;
|
|
typecheckpass(left);
|
|
{ tp procvar support }
|
|
maybe_call_procvar(left,true);
|
|
resultdef:=vs.vardef;
|
|
|
|
// don't put records from which we load float fields
|
|
// in integer registers
|
|
if (left.resultdef.typ=recorddef) and
|
|
(resultdef.typ=floatdef) then
|
|
make_not_regable(left,[ra_addr_regable]);
|
|
end;
|
|
|
|
procedure Tsubscriptnode.mark_write;
|
|
begin
|
|
include(flags,nf_write);
|
|
{ if an element of a record is written, then the whole record is changed/it is written to it,
|
|
for data types being implicit pointers this does not apply as the object itself does not change }
|
|
if not(is_implicit_pointer_object_type(left.resultdef)) then
|
|
left.mark_write;
|
|
end;
|
|
|
|
|
|
function tsubscriptnode.pass_1 : tnode;
|
|
begin
|
|
result:=nil;
|
|
firstpass(left);
|
|
if codegenerror then
|
|
exit;
|
|
|
|
{ several object types must be dereferenced implicitly }
|
|
if is_implicit_pointer_object_type(left.resultdef) then
|
|
expectloc:=LOC_REFERENCE
|
|
else
|
|
begin
|
|
case left.expectloc of
|
|
{ if a floating point value is casted into a record, it
|
|
can happen that we get here an fpu or mm register }
|
|
LOC_CMMREGISTER,
|
|
LOC_CFPUREGISTER,
|
|
LOC_MMREGISTER,
|
|
LOC_FPUREGISTER,
|
|
LOC_CONSTANT,
|
|
LOC_REGISTER,
|
|
LOC_SUBSETREG:
|
|
// can happen for function results on win32 and darwin/x86
|
|
if (left.resultdef.size > sizeof(pint)) then
|
|
expectloc:=LOC_REFERENCE
|
|
else
|
|
expectloc:=LOC_SUBSETREG;
|
|
LOC_CREGISTER,
|
|
LOC_CSUBSETREG:
|
|
expectloc:=LOC_CSUBSETREG;
|
|
LOC_REFERENCE,
|
|
LOC_CREFERENCE:
|
|
expectloc:=left.expectloc;
|
|
else internalerror(20060521);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function tsubscriptnode.docompare(p: tnode): boolean;
|
|
begin
|
|
docompare :=
|
|
inherited docompare(p) and
|
|
(vs = tsubscriptnode(p).vs);
|
|
end;
|
|
|
|
|
|
{*****************************************************************************
|
|
TVECNODE
|
|
*****************************************************************************}
|
|
|
|
constructor tvecnode.create(l,r : tnode);
|
|
|
|
begin
|
|
inherited create(vecn,l,r);
|
|
end;
|
|
|
|
|
|
function tvecnode.pass_typecheck:tnode;
|
|
var
|
|
htype,elementdef,elementptrdef : tdef;
|
|
newordtyp: tordtype;
|
|
valid : boolean;
|
|
begin
|
|
result:=nil;
|
|
typecheckpass(left);
|
|
typecheckpass(right);
|
|
|
|
{ implicitly convert stringconstant to stringdef,
|
|
see tbs/tb0476.pp for a test }
|
|
if (left.nodetype=stringconstn) and
|
|
(tstringconstnode(left).cst_type=cst_conststring) then
|
|
begin
|
|
if tstringconstnode(left).len>255 then
|
|
inserttypeconv(left,getansistringdef)
|
|
else
|
|
inserttypeconv(left,cshortstringtype);
|
|
end;
|
|
|
|
{ In p[1] p is always valid, it is not possible to
|
|
declared a shortstring or normal array that has
|
|
undefined number of elements. Dynamic array and
|
|
ansi/widestring needs to be valid }
|
|
valid:=is_dynamic_array(left.resultdef) or
|
|
is_ansistring(left.resultdef) or
|
|
is_wide_or_unicode_string(left.resultdef) or
|
|
{ implicit pointer dereference -> pointer is read }
|
|
(left.resultdef.typ = pointerdef);
|
|
if valid then
|
|
set_varstate(left,vs_read,[vsf_must_be_valid]);
|
|
{
|
|
A vecn is, just like a loadn, always part of an expression with its
|
|
own read/write and must_be_valid semantics. Therefore we don't have
|
|
to do anything else here, just like for loadn's
|
|
}
|
|
set_varstate(right,vs_read,[vsf_must_be_valid]);
|
|
if codegenerror then
|
|
exit;
|
|
|
|
{ maybe type conversion for the index value, but
|
|
do not convert range nodes }
|
|
if (right.nodetype<>rangen) then
|
|
case left.resultdef.typ of
|
|
arraydef:
|
|
begin
|
|
htype:=Tarraydef(left.resultdef).rangedef;
|
|
if ado_isvariant in Tarraydef(left.resultdef).arrayoptions then
|
|
{Variant arrays are a special array, can have negative indexes and would therefore
|
|
need s32bit. However, they should not appear in a vecn, as they are handled in
|
|
handle_variantarray in pexpr.pas. Therefore, encountering a variant array is an
|
|
internal error... }
|
|
internalerror(200707031)
|
|
{ open array and array constructor range checking is handled
|
|
below at the node level, where the validity of the index
|
|
will be checked -> use a regular type conversion to either
|
|
the signed or unsigned native int type to prevent another
|
|
range check from getting inserted here (unless the type is
|
|
larger than the int type). Exception: if it's an ordinal
|
|
constant, because then this check should be performed at
|
|
compile time }
|
|
else if is_open_array(left.resultdef) or
|
|
is_array_constructor(left.resultdef) then
|
|
begin
|
|
if is_signed(right.resultdef) and
|
|
not is_constnode(right) then
|
|
inserttypeconv(right,sinttype)
|
|
else
|
|
inserttypeconv(right,uinttype)
|
|
end
|
|
else if is_special_array(left.resultdef) then
|
|
{Arrays without a high bound (dynamic arrays, open arrays) are zero based,
|
|
convert indexes into these arrays to aword.}
|
|
inserttypeconv(right,uinttype)
|
|
{ note: <> rather than </>, because indexing e.g. an array 0..0
|
|
must not result in truncating the indexing value from 2/4/8
|
|
bytes to 1 byte (with range checking off, the full index
|
|
value must be used) }
|
|
else if (htype.typ=enumdef) and
|
|
(right.resultdef.typ=enumdef) and
|
|
(tenumdef(htype).basedef=tenumdef(right.resultdef).basedef) and
|
|
((tarraydef(left.resultdef).lowrange<>tenumdef(htype).min) or
|
|
(tarraydef(left.resultdef).highrange<>tenumdef(htype).max)) then
|
|
{Convert array indexes to low_bound..high_bound.}
|
|
inserttypeconv(right,cenumdef.create_subrange(tenumdef(right.resultdef),
|
|
asizeint(Tarraydef(left.resultdef).lowrange),
|
|
asizeint(Tarraydef(left.resultdef).highrange)
|
|
))
|
|
else if (htype.typ=orddef) and
|
|
{ right can also be a variant or another type with
|
|
overloaded assignment }
|
|
(right.resultdef.typ=orddef) and
|
|
{ don't try to create boolean types with custom ranges }
|
|
not is_boolean(right.resultdef) and
|
|
{ ordtype determines the size of the loaded value -> make
|
|
sure we don't truncate }
|
|
((Torddef(right.resultdef).ordtype<>torddef(htype).ordtype) or
|
|
(tarraydef(left.resultdef).lowrange<>torddef(htype).low) or
|
|
(tarraydef(left.resultdef).highrange<>torddef(htype).high)) then
|
|
{Convert array indexes to low_bound..high_bound.}
|
|
begin
|
|
if (right.resultdef.typ=orddef)
|
|
{$ifndef cpu64bitaddr}
|
|
{ do truncate 64 bit values on 32 bit cpus, since
|
|
a) the arrays cannot be > 32 bit anyway
|
|
b) their code generators can't directly handle 64 bit
|
|
loads
|
|
}
|
|
and not is_64bit(right.resultdef)
|
|
{$endif not cpu64bitaddr}
|
|
then
|
|
newordtyp:=Torddef(right.resultdef).ordtype
|
|
else
|
|
newordtyp:=torddef(ptrsinttype).ordtype;
|
|
inserttypeconv(right,corddef.create(newordtyp,
|
|
int64(Tarraydef(left.resultdef).lowrange),
|
|
int64(Tarraydef(left.resultdef).highrange),
|
|
true
|
|
))
|
|
end
|
|
else
|
|
inserttypeconv(right,htype)
|
|
end;
|
|
stringdef:
|
|
if is_open_string(left.resultdef) then
|
|
inserttypeconv(right,u8inttype)
|
|
else if is_shortstring(left.resultdef) then
|
|
{Convert shortstring indexes to 0..length.}
|
|
inserttypeconv(right,corddef.create(u8bit,0,int64(Tstringdef(left.resultdef).len),true))
|
|
else
|
|
{Convert indexes into dynamically allocated strings to aword.}
|
|
inserttypeconv(right,uinttype);
|
|
pointerdef:
|
|
inserttypeconv(right,tpointerdef(left.resultdef).pointer_arithmetic_int_type);
|
|
else
|
|
{Others, (are there any?) indexes to aint.}
|
|
inserttypeconv(right,sinttype);
|
|
end;
|
|
|
|
{ although we never put regular arrays or shortstrings in registers,
|
|
it's possible that another type was typecasted to a small record
|
|
that has a field of one of these types -> in that case the record
|
|
can't be a regvar either }
|
|
if ((left.resultdef.typ=arraydef) and
|
|
not is_special_array(left.resultdef)) or
|
|
((left.resultdef.typ=stringdef) and
|
|
(tstringdef(left.resultdef).stringtype in [st_shortstring,st_longstring])) then
|
|
make_not_regable(left,[ra_addr_regable]);
|
|
|
|
case left.resultdef.typ of
|
|
arraydef :
|
|
begin
|
|
{ check type of the index value }
|
|
if (compare_defs(right.resultdef,tarraydef(left.resultdef).rangedef,right.nodetype)=te_incompatible) then
|
|
IncompatibleTypes(right.resultdef,tarraydef(left.resultdef).rangedef);
|
|
if right.nodetype=rangen then
|
|
resultdef:=left.resultdef
|
|
else
|
|
resultdef:=Tarraydef(left.resultdef).elementdef;
|
|
|
|
result:=gen_array_rangecheck;
|
|
if assigned(result) then
|
|
exit;
|
|
|
|
{ in case of a bitpacked array of enums that are size 2 (due to
|
|
packenum 2) but whose values all fit in one byte, the size of
|
|
bitpacked array elements will be 1 byte while the resultdef of
|
|
will currently say it's two bytes) -> create a temp enumdef
|
|
with packenum=1 for the resultdef as subtype of the main
|
|
enumdef }
|
|
if is_enum(resultdef) and
|
|
is_packed_array(left.resultdef) and
|
|
((tarraydef(left.resultdef).elepackedbitsize div 8) <> resultdef.size) then
|
|
begin
|
|
resultdef:=cenumdef.create_subrange(tenumdef(resultdef),tenumdef(resultdef).min,tenumdef(resultdef).max);
|
|
tenumdef(resultdef).calcsavesize(1);
|
|
end
|
|
end;
|
|
pointerdef :
|
|
begin
|
|
{ are we accessing a pointer[], then convert the pointer to
|
|
an array first, in FPC this is allowed for all pointers
|
|
(except voidpointer) in delphi/tp7 it's only allowed for pchars. }
|
|
if not is_voidpointer(left.resultdef) and
|
|
(
|
|
(cs_pointermath in current_settings.localswitches) or
|
|
tpointerdef(left.resultdef).has_pointer_math or
|
|
is_pchar(left.resultdef) or
|
|
is_pwidechar(left.resultdef)
|
|
) then
|
|
begin
|
|
{ convert pointer to array }
|
|
htype:=carraydef.create_from_pointer(tpointerdef(left.resultdef));
|
|
inserttypeconv(left,htype);
|
|
if right.nodetype=rangen then
|
|
resultdef:=htype
|
|
else
|
|
resultdef:=tarraydef(htype).elementdef;
|
|
end
|
|
else
|
|
CGMessage(type_e_array_required);
|
|
end;
|
|
stringdef :
|
|
begin
|
|
case tstringdef(left.resultdef).stringtype of
|
|
st_unicodestring,
|
|
st_widestring :
|
|
begin
|
|
elementdef:=cwidechartype;
|
|
elementptrdef:=widecharpointertype;
|
|
end;
|
|
st_ansistring,
|
|
st_longstring,
|
|
st_shortstring :
|
|
begin
|
|
elementdef:=cansichartype;
|
|
elementptrdef:=charpointertype;
|
|
end;
|
|
else
|
|
internalerror(2013112902);
|
|
end;
|
|
if right.nodetype=rangen then
|
|
begin
|
|
htype:=carraydef.create_from_pointer(tpointerdef(elementptrdef));
|
|
resultdef:=htype;
|
|
end
|
|
else
|
|
begin
|
|
{ indexed access to 0 element is only allowed for shortstrings or if
|
|
zero based strings is turned on }
|
|
if (right.nodetype=ordconstn) and
|
|
(Tordconstnode(right).value.svalue=0) and
|
|
not is_shortstring(left.resultdef) and
|
|
not(cs_zerobasedstrings in current_settings.localswitches) then
|
|
CGMessage(cg_e_can_access_element_zero);
|
|
resultdef:=elementdef;
|
|
end;
|
|
end;
|
|
variantdef :
|
|
resultdef:=cvarianttype;
|
|
else
|
|
CGMessage(type_e_array_required);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure Tvecnode.mark_write;
|
|
begin
|
|
include(flags,nf_write);
|
|
{ see comment in tsubscriptnode.mark_write }
|
|
if not(is_implicit_pointer_object_type(left.resultdef)) then
|
|
left.mark_write;
|
|
end;
|
|
|
|
|
|
function tvecnode.pass_1 : tnode;
|
|
begin
|
|
result:=nil;
|
|
firstpass(left);
|
|
firstpass(right);
|
|
if codegenerror then
|
|
exit;
|
|
|
|
if (nf_callunique in flags) and
|
|
(is_ansistring(left.resultdef) or
|
|
is_unicodestring(left.resultdef) or
|
|
(is_widestring(left.resultdef) and not(tf_winlikewidestring in target_info.flags))) then
|
|
begin
|
|
left := ctypeconvnode.create_internal(ccallnode.createintern('fpc_'+tstringdef(left.resultdef).stringtypname+'_unique',
|
|
ccallparanode.create(
|
|
ctypeconvnode.create_internal(left,voidpointertype),nil)),
|
|
left.resultdef);
|
|
firstpass(left);
|
|
{ double resultdef passes somwhere else may cause this to be }
|
|
{ reset though :/ }
|
|
exclude(flags,nf_callunique);
|
|
end
|
|
else if is_widestring(left.resultdef) and (tf_winlikewidestring in target_info.flags) then
|
|
exclude(flags,nf_callunique);
|
|
|
|
{ a range node as array index can only appear in function calls, and
|
|
those convert the range node into something else in
|
|
tcallnode.gen_high_tree }
|
|
if (right.nodetype=rangen) then
|
|
CGMessagePos(right.fileinfo,parser_e_illegal_expression)
|
|
else if left.resultdef.typ=arraydef then
|
|
result:=first_arraydef
|
|
else
|
|
begin
|
|
if left.expectloc=LOC_CREFERENCE then
|
|
expectloc:=LOC_CREFERENCE
|
|
else
|
|
expectloc:=LOC_REFERENCE
|
|
end;
|
|
end;
|
|
|
|
|
|
function tvecnode.first_arraydef: tnode;
|
|
begin
|
|
result:=nil;
|
|
if (not is_packed_array(left.resultdef)) or
|
|
((tarraydef(left.resultdef).elepackedbitsize mod 8) = 0) then
|
|
if left.expectloc=LOC_CREFERENCE then
|
|
expectloc:=LOC_CREFERENCE
|
|
else
|
|
expectloc:=LOC_REFERENCE
|
|
else
|
|
if left.expectloc=LOC_CREFERENCE then
|
|
expectloc:=LOC_CSUBSETREF
|
|
else
|
|
expectloc:=LOC_SUBSETREF;
|
|
end;
|
|
|
|
function tvecnode.gen_array_rangecheck: tnode;
|
|
var
|
|
htype: tdef;
|
|
temp: ttempcreatenode;
|
|
stat: tstatementnode;
|
|
indextree: tnode;
|
|
hightree: tnode;
|
|
begin
|
|
result:=nil;
|
|
|
|
{ Range checking an array of const/open array/dynamic array is
|
|
more complicated than regular arrays, because the bounds must
|
|
be checked dynamically. Additionally, in case of array of const
|
|
and open array we need the high parameter, which must not be
|
|
made a regvar in case this is a nested rountine relative to the
|
|
array parameter -> generate te check at the node tree level
|
|
rather than in the code generator }
|
|
if (cs_check_range in current_settings.localswitches) and
|
|
(is_open_array(left.resultdef) or
|
|
is_array_of_const(left.resultdef)) and
|
|
(right.nodetype<>rangen) then
|
|
begin
|
|
{ expect to find the load node }
|
|
if get_open_const_array(left).nodetype<>loadn then
|
|
internalerror(2014040601);
|
|
{ cdecl functions don't have high() so we can not check the range }
|
|
{ (can't use current_procdef, since it may be a nested procedure) }
|
|
if not(tprocdef(tparasymtable(tparavarsym(tloadnode(get_open_const_array(left)).symtableentry).owner).defowner).proccalloption in cdecl_pocalls) then
|
|
begin
|
|
temp:=nil;
|
|
result:=internalstatements(stat);
|
|
{ can't use node_complexity here, assumes that the code has
|
|
already been firstpassed }
|
|
if not is_const(right) then
|
|
begin
|
|
temp:=ctempcreatenode.create(right.resultdef,right.resultdef.size,tt_persistent,true);
|
|
addstatement(stat,temp);
|
|
{ needed so we can typecheck its temprefnodes }
|
|
typecheckpass(tnode(temp));
|
|
addstatement(stat,cassignmentnode.create(
|
|
ctemprefnode.create(temp),right)
|
|
);
|
|
right:=ctemprefnode.create(temp);
|
|
{ right.resultdef is used below }
|
|
typecheckpass(right);
|
|
end;
|
|
{ range check will be made explicit here }
|
|
exclude(localswitches,cs_check_range);
|
|
hightree:=load_high_value_node(tparavarsym(tloadnode(
|
|
get_open_const_array(left)).symtableentry));
|
|
{ make index unsigned so we only need one comparison;
|
|
lower bound is always zero for these arrays, but
|
|
hightree can be -1 in case the array was empty ->
|
|
add 1 before comparing (ignoring overflows) }
|
|
htype:=get_unsigned_inttype(right.resultdef);
|
|
inserttypeconv_explicit(hightree,htype);
|
|
hightree:=caddnode.create(addn,hightree,genintconstnode(1));
|
|
hightree.localswitches:=hightree.localswitches-[cs_check_range,
|
|
cs_check_overflow];
|
|
indextree:=ctypeconvnode.create_explicit(right.getcopy,htype);
|
|
{ range error if index >= hightree+1 }
|
|
addstatement(stat,
|
|
cifnode.create_internal(
|
|
caddnode.create_internal(gten,indextree,hightree),
|
|
ccallnode.createintern('fpc_rangeerror',nil),
|
|
nil
|
|
)
|
|
);
|
|
if assigned(temp) then
|
|
addstatement(stat,ctempdeletenode.create_normal_temp(temp));
|
|
addstatement(stat,self.getcopy);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
{*****************************************************************************
|
|
TWITHNODE
|
|
*****************************************************************************}
|
|
|
|
constructor twithnode.create(l:tnode);
|
|
begin
|
|
inherited create(withn,l);
|
|
fileinfo:=l.fileinfo;
|
|
end;
|
|
|
|
|
|
destructor twithnode.destroy;
|
|
begin
|
|
inherited destroy;
|
|
end;
|
|
|
|
|
|
constructor twithnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
|
|
begin
|
|
inherited ppuload(t,ppufile);
|
|
end;
|
|
|
|
|
|
procedure twithnode.ppuwrite(ppufile:tcompilerppufile);
|
|
begin
|
|
inherited ppuwrite(ppufile);
|
|
end;
|
|
|
|
|
|
function twithnode.dogetcopy : tnode;
|
|
var
|
|
p : twithnode;
|
|
begin
|
|
p:=twithnode(inherited dogetcopy);
|
|
result:=p;
|
|
end;
|
|
|
|
|
|
function twithnode.pass_typecheck:tnode;
|
|
begin
|
|
result:=nil;
|
|
resultdef:=voidtype;
|
|
if assigned(left) then
|
|
typecheckpass(left);
|
|
end;
|
|
|
|
|
|
function twithnode.pass_1 : tnode;
|
|
begin
|
|
result:=nil;
|
|
expectloc:=LOC_VOID;
|
|
end;
|
|
|
|
|
|
function twithnode.docompare(p: tnode): boolean;
|
|
begin
|
|
docompare :=
|
|
inherited docompare(p);
|
|
end;
|
|
|
|
function is_big_untyped_addrnode(p: tnode): boolean;
|
|
begin
|
|
is_big_untyped_addrnode:=(p.nodetype=addrn) and
|
|
not (nf_typedaddr in p.flags) and (taddrnode(p).left.resultdef.size > 1);
|
|
end;
|
|
|
|
end.
|