mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-06-15 17:58:39 +02:00
963a4d7b23
This change became necessary of the following reasons:
- Records don't support inheritance, thus for "record helpers" some creativity would have been necessary to implement them; with the new implementation this is more easily
- the new approach allows for easy checks regarding virtual methods and their overrides which would have been more complicated in the old variant
- if someone feels the need the types of helpers (object, interface) can be added rather easily
- unnecessary things like VMT generation can be disabled now
details:
- msg*:
* moved some messages from parser to type
* adjusted a message ("class helper" => "helper")
- symdef.pas:
* renamed "helperparent" to "extendeddef" and changed its type from "tobjectdef" to "tabstractrecorddef", so records can be extended as well (somewhen in the near future)
* removed "finish_class_helper" method as it isn't necessary (luckily I haven't yet adjusted the ObjC variant)
* changed name of "is_objectpascal_classhelper" to "is_objectpascal_helper" to reflect that this function applies to all helper types
* tobjectdef.create: ImplementedInterfaces isn't created for odt_helper anymore
* tobjectdef.alignment: for helpers it's the same as for classes although this shouldn't be used anywhere...
* tobjectdef.vmtmethodoffset: set to 0 for helpers to be sure...
* tobjectdef.needs_inittable: not needed for helpers (no fields allowed)
* is_objectpascal_helper: only needs check for "odt_helper" object type
- symconst.pas:
* changed odt_classhelper to more general odt_helper
* added new type "thelpertype" which is used to check that "(record|class) helper" corresponds with the given extended type (as Delphi XE checks this as well this strict solution can be kept for modes Delphi and ObjFPC)
- symtable.pas:
* extended "searchsym_in_class" with the possibility to disable the search for helper methods (needed for inherited) => this implies changing all occurences of "searchsym_in_class" with a "true" except some special locations
* renamed "search_objectpascal_classhelper" to "search_objectpascal_helper"
* searchsym_in_class:
** when an extended method is defined with "overload" it can be that a same named method of the extended class might be called (sadly this means that this search was unnecessary...)
** contextclassh is the def of the helper in the case of an inherited call inside the helper's implementation
** when methods inside a helper are searched, it must be searched in the extended type first
- ptype.pas:
* single_type is used to parse the parent of a helper as well, so allow a helper if the stoParseClassParent is given (needs check in pdecobj.pas/parse_class_parents for normal classes)
* read_named_type: currently the only case when something <> ht_none is passed to the modified parse_objdec (see below) is when the combination "class helper" is encountered ("record helper" will be another one)
- pinline.pas: adjustment for extended "searchsym_in_class"
- pexpr.pas:
* adjustments regarding "searchsym_in_class" and "is_objectpascal_helper"
* factor/factor_read_id: moved the check for "TSomeClassType.SomeMethod" outside of the "is_class" check
* factor:
** in case of an inherited we need to search inside the extended type first (Note: this needs to be extended to find methods in the helper parent if no method is found in the extended type)
** we also need to disable the search for helper methods when searching for an inherited method (Note: it might be better to introduce a enum to decide whether a helper method should search before or after the methods of the extended type or even never)
- pdecsub.pas:
* insert_self_and_vmt_para: in a helper the type of Self is of the extended type
* pd_abstract, pd_final: more nice error message
* pd_override, pd_message, pd_reintroduce: adjusted checks because now "is_class" is no longer true for helpers
* proc_direcdata: allowed "abstract" for helpers (only to produce a more nice error message)
* parse_proc_direc: adjustment because of "is_objectpascal_helper"
- pdecobj.pas:
* adjustments regarding "is_objectpascal_helper"
* adjusted object_dec to take the type of the helper (class, record) as a parameter to be able to check whether the correct extended type was given
* struct_property_dec: properties are allowed in helpers
* parse_object_options: nothing to be parsed for helpers (at least I hope so ^^)
* parse_parent_classes:
** the parent of a helper is now parsed as a normal parent, the extended type is parsed in an extra procedure
** check for "sealed" no longer needed
** added check that the parsed parent of a helper is indeed a helper
** allow to parse the closing ")" of the helper's parent
* parse_extended_class:
** new procedure that parses the type which is extended
** it checks that the extended type is a class for "class helper" and a record for "record helper"
** it checks that a helper extends the same class or a subclass for class helpers
** it checks that a helper extends the same record for record helpers
* parse_object_members:
** "type", "const", "var" is allowed in helpers
** don't exclude flags regarding virtual methods, they are needed for the checks in mode Delphi (this implies that VMT loading must be disabled for helpers)
* object_dec:
** don't change "odt_helper" to "odt_class", but still include the "oo_is_classhelper" flag
** allow the parsing of object options (there are none)
** parse the extended type for helpers
- pdecl.pas
* adjustment because of extension of object_dec
* types_dec: remove the call to finish_classhelper
- objcdef.pas
* objcaddencodedtype, objcdochecktype: add references to helpers as implicit pointers although that should not be used in any way...
- nld.pas
* tloadnode.pass_typecheck: self is a reference to the extended type
- nflw.pas
* create_for_in_loop: adjustment because of changed procedure and inheritance type
- ncgrtti.pas
* TRTTIWriter.write_rtti_data: disable for helpers for now (I need to check what Delphi does here)
- ncgld.pas
* tcgloadnode.pass_generate_code: virtual methods of helpers are treated as normal methods
- ncgcal.pas
* tcgcallnode.pass_generate_code: virtual methods of helpers are treated as normal methods
- ncal.pas
* tcallnode.pass_typecheck: adjust for extension of tcallcandidates constructor
- htypechk.pas
* tcallcandidates declaration: extend some methods to (dis)allow the search for helper methods (needed for inherited)
* tcallcandidates.collect_overloads_in_struct:
** search first in helpers for methods and stop if none carries the "overload" flag
** move the addition of the procsyms to an extra nested procedure because it's used for helper methods and normal struct methods
git-svn-id: branches/svenbarth/classhelpers@16947 -
1193 lines
42 KiB
ObjectPascal
1193 lines
42 KiB
ObjectPascal
{
|
|
Copyright (c) 2000-2002 by Florian Klaempfl
|
|
|
|
Type checking and register allocation for load/assignment 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 nld;
|
|
|
|
{$i fpcdefs.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
node,
|
|
{$ifdef state_tracking}
|
|
nstate,
|
|
{$endif}
|
|
symconst,symbase,symtype,symsym,symdef;
|
|
|
|
type
|
|
Trttidatatype=(rdt_normal,rdt_ord2str,rdt_str2ord);
|
|
|
|
tloadnode = class(tunarynode)
|
|
protected
|
|
fprocdef : tprocdef;
|
|
fprocdefderef : tderef;
|
|
public
|
|
symtableentry : tsym;
|
|
symtableentryderef : tderef;
|
|
symtable : TSymtable;
|
|
constructor create(v : tsym;st : TSymtable);virtual;
|
|
constructor create_procvar(v : tsym;d:tprocdef;st : TSymtable);virtual;
|
|
constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
|
|
procedure ppuwrite(ppufile:tcompilerppufile);override;
|
|
procedure buildderefimpl;override;
|
|
procedure derefimpl;override;
|
|
procedure set_mp(p:tnode);
|
|
function is_addr_param_load:boolean;
|
|
function dogetcopy : tnode;override;
|
|
function pass_1 : tnode;override;
|
|
function pass_typecheck:tnode;override;
|
|
procedure mark_write;override;
|
|
function docompare(p: tnode): boolean; override;
|
|
procedure printnodedata(var t:text);override;
|
|
procedure setprocdef(p : tprocdef);
|
|
property procdef: tprocdef read fprocdef write setprocdef;
|
|
end;
|
|
tloadnodeclass = class of tloadnode;
|
|
|
|
{ different assignment types }
|
|
tassigntype = (at_normal,at_plus,at_minus,at_star,at_slash);
|
|
|
|
tassignmentnode = class(tbinarynode)
|
|
assigntype : tassigntype;
|
|
constructor create(l,r : tnode);virtual;
|
|
constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
|
|
procedure ppuwrite(ppufile:tcompilerppufile);override;
|
|
function dogetcopy : tnode;override;
|
|
function pass_1 : tnode;override;
|
|
function pass_typecheck:tnode;override;
|
|
function simplify(forinline : boolean) : tnode;override;
|
|
{$ifdef state_tracking}
|
|
function track_state_pass(exec_known:boolean):boolean;override;
|
|
{$endif state_tracking}
|
|
function docompare(p: tnode): boolean; override;
|
|
end;
|
|
tassignmentnodeclass = class of tassignmentnode;
|
|
|
|
tarrayconstructorrangenode = class(tbinarynode)
|
|
constructor create(l,r : tnode);virtual;
|
|
function pass_1 : tnode;override;
|
|
function pass_typecheck:tnode;override;
|
|
end;
|
|
tarrayconstructorrangenodeclass = class of tarrayconstructorrangenode;
|
|
|
|
tarrayconstructornode = class(tbinarynode)
|
|
constructor create(l,r : tnode);virtual;
|
|
function dogetcopy : tnode;override;
|
|
function pass_1 : tnode;override;
|
|
function pass_typecheck:tnode;override;
|
|
function docompare(p: tnode): boolean; override;
|
|
procedure force_type(def:tdef);
|
|
procedure insert_typeconvs;
|
|
end;
|
|
tarrayconstructornodeclass = class of tarrayconstructornode;
|
|
|
|
ttypenode = class(tnode)
|
|
allowed : boolean;
|
|
typedef : tdef;
|
|
typedefderef : tderef;
|
|
constructor create(def:tdef);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 dogetcopy : tnode;override;
|
|
function docompare(p: tnode): boolean; override;
|
|
end;
|
|
ttypenodeclass = class of ttypenode;
|
|
|
|
trttinode = class(tnode)
|
|
l1,l2 : longint;
|
|
rttitype : trttitype;
|
|
rttidef : tstoreddef;
|
|
rttidefderef : tderef;
|
|
rttidatatype : Trttidatatype;
|
|
constructor create(def:tstoreddef;rt:trttitype;dt:Trttidatatype);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 pass_typecheck:tnode;override;
|
|
function docompare(p: tnode): boolean; override;
|
|
end;
|
|
trttinodeclass = class of trttinode;
|
|
|
|
var
|
|
cloadnode : tloadnodeclass = tloadnode;
|
|
cassignmentnode : tassignmentnodeclass = tassignmentnode;
|
|
carrayconstructorrangenode : tarrayconstructorrangenodeclass = tarrayconstructorrangenode;
|
|
carrayconstructornode : tarrayconstructornodeclass = tarrayconstructornode;
|
|
ctypenode : ttypenodeclass = ttypenode;
|
|
crttinode : trttinodeclass = trttinode;
|
|
|
|
{ Current assignment node }
|
|
aktassignmentnode : tassignmentnode;
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
cutils,verbose,globtype,globals,systems,
|
|
symnot,
|
|
defutil,defcmp,
|
|
htypechk,pass_1,procinfo,paramgr,
|
|
cpuinfo,
|
|
ncon,ninl,ncnv,nmem,ncal,nutils,nbas,
|
|
cgobj,cgbase
|
|
;
|
|
|
|
{*****************************************************************************
|
|
TLOADNODE
|
|
*****************************************************************************}
|
|
|
|
constructor tloadnode.create(v : tsym;st : TSymtable);
|
|
begin
|
|
inherited create(loadn,nil);
|
|
if not assigned(v) then
|
|
internalerror(200108121);
|
|
symtableentry:=v;
|
|
symtable:=st;
|
|
fprocdef:=nil;
|
|
end;
|
|
|
|
|
|
constructor tloadnode.create_procvar(v : tsym;d:tprocdef;st : TSymtable);
|
|
begin
|
|
inherited create(loadn,nil);
|
|
if not assigned(v) then
|
|
internalerror(200108122);
|
|
symtableentry:=v;
|
|
symtable:=st;
|
|
fprocdef:=d;
|
|
end;
|
|
|
|
|
|
constructor tloadnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
|
|
begin
|
|
inherited ppuload(t,ppufile);
|
|
ppufile.getderef(symtableentryderef);
|
|
symtable:=nil;
|
|
ppufile.getderef(fprocdefderef);
|
|
end;
|
|
|
|
|
|
procedure tloadnode.ppuwrite(ppufile:tcompilerppufile);
|
|
begin
|
|
inherited ppuwrite(ppufile);
|
|
ppufile.putderef(symtableentryderef);
|
|
ppufile.putderef(fprocdefderef);
|
|
end;
|
|
|
|
|
|
procedure tloadnode.buildderefimpl;
|
|
begin
|
|
inherited buildderefimpl;
|
|
symtableentryderef.build(symtableentry);
|
|
fprocdefderef.build(fprocdef);
|
|
end;
|
|
|
|
|
|
procedure tloadnode.derefimpl;
|
|
begin
|
|
inherited derefimpl;
|
|
symtableentry:=tsym(symtableentryderef.resolve);
|
|
symtable:=symtableentry.owner;
|
|
fprocdef:=tprocdef(fprocdefderef.resolve);
|
|
end;
|
|
|
|
|
|
procedure tloadnode.set_mp(p:tnode);
|
|
begin
|
|
{ typen nodes should not be set }
|
|
if p.nodetype=typen then
|
|
internalerror(200301042);
|
|
left:=p;
|
|
end;
|
|
|
|
|
|
function tloadnode.dogetcopy : tnode;
|
|
var
|
|
n : tloadnode;
|
|
|
|
begin
|
|
n:=tloadnode(inherited dogetcopy);
|
|
n.symtable:=symtable;
|
|
n.symtableentry:=symtableentry;
|
|
n.fprocdef:=fprocdef;
|
|
result:=n;
|
|
end;
|
|
|
|
|
|
function tloadnode.is_addr_param_load:boolean;
|
|
begin
|
|
result:=(symtable.symtabletype=parasymtable) and
|
|
(symtableentry.typ=paravarsym) and
|
|
not(vo_has_local_copy in tparavarsym(symtableentry).varoptions) and
|
|
not(nf_load_self_pointer in flags) and
|
|
paramanager.push_addr_param(tparavarsym(symtableentry).varspez,tparavarsym(symtableentry).vardef,tprocdef(symtable.defowner).proccalloption);
|
|
end;
|
|
|
|
|
|
function tloadnode.pass_typecheck:tnode;
|
|
begin
|
|
result:=nil;
|
|
case symtableentry.typ of
|
|
absolutevarsym :
|
|
resultdef:=tabsolutevarsym(symtableentry).vardef;
|
|
constsym:
|
|
begin
|
|
if tconstsym(symtableentry).consttyp=constresourcestring then
|
|
resultdef:=cansistringtype
|
|
else
|
|
internalerror(22799);
|
|
end;
|
|
staticvarsym :
|
|
begin
|
|
tabstractvarsym(symtableentry).IncRefCountBy(1);
|
|
{ static variables referenced in procedures or from finalization,
|
|
variable needs to be in memory.
|
|
It is too hard and the benefit is too small to detect whether a
|
|
variable is only used in the finalization to add support for it (PFV) }
|
|
if assigned(current_procinfo) and
|
|
(symtable.symtabletype=staticsymtable) and
|
|
(
|
|
(symtable.symtablelevel<>current_procinfo.procdef.localst.symtablelevel) or
|
|
(current_procinfo.procdef.proctypeoption=potype_unitfinalize)
|
|
) then
|
|
make_not_regable(self,[ra_addr_taken]);
|
|
resultdef:=tabstractvarsym(symtableentry).vardef;
|
|
end;
|
|
paravarsym,
|
|
localvarsym :
|
|
begin
|
|
tabstractvarsym(symtableentry).IncRefCountBy(1);
|
|
{ Nested variable? The we need to load the framepointer of
|
|
the parent procedure }
|
|
if assigned(current_procinfo) and
|
|
(symtable.symtabletype in [localsymtable,parasymtable]) and
|
|
(symtable.symtablelevel<>current_procinfo.procdef.parast.symtablelevel) then
|
|
begin
|
|
if assigned(left) then
|
|
internalerror(200309289);
|
|
left:=cloadparentfpnode.create(tprocdef(symtable.defowner));
|
|
{ we can't inline the referenced parent procedure }
|
|
exclude(tprocdef(symtable.defowner).procoptions,po_inline);
|
|
{ reference in nested procedures, variable needs to be in memory }
|
|
{ and behaves as if its address escapes its parent block }
|
|
make_not_regable(self,[ra_addr_taken]);
|
|
end;
|
|
{ fix self type which is declared as voidpointer in the
|
|
definition }
|
|
if vo_is_self in tabstractvarsym(symtableentry).varoptions then
|
|
begin
|
|
resultdef:=tprocdef(symtableentry.owner.defowner).struct;
|
|
if is_objectpascal_helper(resultdef) then
|
|
resultdef:=tobjectdef(resultdef).extendeddef;
|
|
if (po_classmethod in tprocdef(symtableentry.owner.defowner).procoptions) or
|
|
(po_staticmethod in tprocdef(symtableentry.owner.defowner).procoptions) then
|
|
resultdef:=tclassrefdef.create(resultdef)
|
|
else if (is_object(resultdef) or is_record(resultdef)) and
|
|
(nf_load_self_pointer in flags) then
|
|
resultdef:=tpointerdef.create(resultdef);
|
|
end
|
|
else if vo_is_vmt in tabstractvarsym(symtableentry).varoptions then
|
|
begin
|
|
resultdef:=tprocdef(symtableentry.owner.defowner).struct;
|
|
resultdef:=tclassrefdef.create(resultdef);
|
|
end
|
|
else
|
|
resultdef:=tabstractvarsym(symtableentry).vardef;
|
|
end;
|
|
procsym :
|
|
begin
|
|
{ Return the first procdef. In case of overloaded
|
|
procdefs the matching procdef will be choosen
|
|
when the expected procvardef is known, see get_information
|
|
in htypechk.pas (PFV) }
|
|
if not assigned(fprocdef) then
|
|
fprocdef:=tprocdef(tprocsym(symtableentry).ProcdefList[0])
|
|
else if po_kylixlocal in fprocdef.procoptions then
|
|
CGMessage(type_e_cant_take_address_of_local_subroutine);
|
|
|
|
{ the result is a fprocdef, addrn and proc_to_procvar
|
|
typeconvn need this as resultdef so they know
|
|
that the address needs to be returned }
|
|
resultdef:=fprocdef;
|
|
|
|
{ process methodpointer/framepointer }
|
|
if assigned(left) then
|
|
typecheckpass(left);
|
|
end;
|
|
labelsym:
|
|
resultdef:=voidtype;
|
|
else
|
|
internalerror(200104141);
|
|
end;
|
|
end;
|
|
|
|
procedure Tloadnode.mark_write;
|
|
|
|
begin
|
|
include(flags,nf_write);
|
|
end;
|
|
|
|
function tloadnode.pass_1 : tnode;
|
|
begin
|
|
result:=nil;
|
|
expectloc:=LOC_REFERENCE;
|
|
if (cs_create_pic in current_settings.moduleswitches) and
|
|
not(symtableentry.typ in [paravarsym,localvarsym]) then
|
|
include(current_procinfo.flags,pi_needs_got);
|
|
|
|
case symtableentry.typ of
|
|
absolutevarsym :
|
|
;
|
|
constsym:
|
|
begin
|
|
if tconstsym(symtableentry).consttyp=constresourcestring then
|
|
expectloc:=LOC_CREFERENCE;
|
|
end;
|
|
staticvarsym,
|
|
localvarsym,
|
|
paravarsym :
|
|
begin
|
|
if assigned(left) then
|
|
firstpass(left);
|
|
if not is_addr_param_load and
|
|
tabstractvarsym(symtableentry).is_regvar(is_addr_param_load) then
|
|
expectloc:=tvarregable2tcgloc[tabstractvarsym(symtableentry).varregable]
|
|
else
|
|
if (tabstractvarsym(symtableentry).varspez=vs_const) then
|
|
expectloc:=LOC_CREFERENCE;
|
|
if (target_info.system=system_powerpc_darwin) and
|
|
([vo_is_dll_var,vo_is_external] * tabstractvarsym(symtableentry).varoptions <> []) then
|
|
include(current_procinfo.flags,pi_needs_got);
|
|
{ call to get address of threadvar }
|
|
if (vo_is_thread_var in tabstractvarsym(symtableentry).varoptions) then
|
|
include(current_procinfo.flags,pi_do_call);
|
|
if nf_write in flags then
|
|
Tabstractvarsym(symtableentry).trigger_notifications(vn_onwrite)
|
|
else
|
|
Tabstractvarsym(symtableentry).trigger_notifications(vn_onread);
|
|
end;
|
|
procsym :
|
|
begin
|
|
{ initialise left for nested procs if necessary }
|
|
if (m_nested_procvars in current_settings.modeswitches) then
|
|
setprocdef(fprocdef);
|
|
{ method pointer or nested proc ? }
|
|
if assigned(left) then
|
|
begin
|
|
expectloc:=LOC_CREFERENCE;
|
|
firstpass(left);
|
|
end;
|
|
end;
|
|
labelsym :
|
|
;
|
|
else
|
|
internalerror(200104143);
|
|
end;
|
|
end;
|
|
|
|
|
|
function tloadnode.docompare(p: tnode): boolean;
|
|
begin
|
|
docompare :=
|
|
inherited docompare(p) and
|
|
(symtableentry = tloadnode(p).symtableentry) and
|
|
(fprocdef = tloadnode(p).fprocdef) and
|
|
(symtable = tloadnode(p).symtable);
|
|
end;
|
|
|
|
|
|
procedure tloadnode.printnodedata(var t:text);
|
|
begin
|
|
inherited printnodedata(t);
|
|
write(t,printnodeindention,'symbol = ',symtableentry.name);
|
|
if symtableentry.typ=procsym then
|
|
write(t,printnodeindention,'procdef = ',fprocdef.mangledname);
|
|
writeln(t,'');
|
|
end;
|
|
|
|
|
|
procedure tloadnode.setprocdef(p : tprocdef);
|
|
begin
|
|
fprocdef:=p;
|
|
resultdef:=p;
|
|
{ nested procedure? }
|
|
if assigned(p) and
|
|
is_nested_pd(p) then
|
|
begin
|
|
if not(m_nested_procvars in current_settings.modeswitches) then
|
|
CGMessage(type_e_cant_take_address_of_local_subroutine)
|
|
else
|
|
begin
|
|
{ parent frame pointer pointer as "self" }
|
|
left.free;
|
|
left:=cloadparentfpnode.create(tprocdef(p.owner.defowner));
|
|
end;
|
|
end
|
|
{ we should never go from nested to non-nested }
|
|
else if assigned(left) and
|
|
(left.nodetype=loadparentfpn) then
|
|
internalerror(2010072201);
|
|
end;
|
|
|
|
{*****************************************************************************
|
|
TASSIGNMENTNODE
|
|
*****************************************************************************}
|
|
|
|
constructor tassignmentnode.create(l,r : tnode);
|
|
|
|
begin
|
|
inherited create(assignn,l,r);
|
|
l.mark_write;
|
|
assigntype:=at_normal;
|
|
if r.nodetype = typeconvn then
|
|
ttypeconvnode(r).warn_pointer_to_signed:=false;
|
|
end;
|
|
|
|
|
|
constructor tassignmentnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
|
|
begin
|
|
inherited ppuload(t,ppufile);
|
|
assigntype:=tassigntype(ppufile.getbyte);
|
|
end;
|
|
|
|
|
|
procedure tassignmentnode.ppuwrite(ppufile:tcompilerppufile);
|
|
begin
|
|
inherited ppuwrite(ppufile);
|
|
ppufile.putbyte(byte(assigntype));
|
|
end;
|
|
|
|
|
|
function tassignmentnode.dogetcopy : tnode;
|
|
|
|
var
|
|
n : tassignmentnode;
|
|
|
|
begin
|
|
n:=tassignmentnode(inherited dogetcopy);
|
|
n.assigntype:=assigntype;
|
|
result:=n;
|
|
end;
|
|
|
|
|
|
function tassignmentnode.simplify(forinline : boolean) : tnode;
|
|
begin
|
|
result:=nil;
|
|
{ assignment nodes can perform several floating point }
|
|
{ type conversions directly, so no typeconversions }
|
|
{ are inserted in those cases. When inlining, a }
|
|
{ variable may be replaced by a constant which can be }
|
|
{ converted at compile time, so check for this case }
|
|
if is_real(left.resultdef) and
|
|
is_real(right.resultdef) and
|
|
is_constrealnode(right) and
|
|
not equal_defs(right.resultdef,left.resultdef) then
|
|
inserttypeconv(right,left.resultdef);
|
|
end;
|
|
|
|
|
|
function tassignmentnode.pass_typecheck:tnode;
|
|
var
|
|
hp : tnode;
|
|
useshelper : boolean;
|
|
begin
|
|
result:=nil;
|
|
resultdef:=voidtype;
|
|
|
|
{ must be made unique }
|
|
set_unique(left);
|
|
|
|
typecheckpass(left);
|
|
typecheckpass(right);
|
|
set_varstate(right,vs_read,[vsf_must_be_valid]);
|
|
set_varstate(left,vs_written,[]);
|
|
if codegenerror then
|
|
exit;
|
|
|
|
{ tp procvar support, when we don't expect a procvar
|
|
then we need to call the procvar }
|
|
if (left.resultdef.typ<>procvardef) then
|
|
maybe_call_procvar(right,true);
|
|
|
|
{ assignments to formaldefs and open arrays aren't allowed }
|
|
if (left.resultdef.typ=formaldef) or
|
|
is_open_array(left.resultdef) then
|
|
CGMessage(type_e_assignment_not_allowed);
|
|
|
|
{ test if node can be assigned, properties are allowed }
|
|
valid_for_assignment(left,true);
|
|
|
|
{ assigning nil to a dynamic array clears the array }
|
|
if is_dynamic_array(left.resultdef) and
|
|
(right.nodetype=niln) then
|
|
begin
|
|
{ remove property flag to avoid errors, see comments for }
|
|
{ tf_winlikewidestring assignments below }
|
|
exclude(left.flags,nf_isproperty);
|
|
hp:=ccallparanode.create(caddrnode.create_internal
|
|
(crttinode.create(tstoreddef(left.resultdef),initrtti,rdt_normal)),
|
|
ccallparanode.create(ctypeconvnode.create_internal(left,voidpointertype),nil));
|
|
result := ccallnode.createintern('fpc_dynarray_clear',hp);
|
|
left:=nil;
|
|
exit;
|
|
end;
|
|
|
|
{ shortstring helpers can do the conversion directly,
|
|
so treat them separatly }
|
|
if (is_shortstring(left.resultdef)) then
|
|
begin
|
|
{ insert typeconv, except for chars that are handled in
|
|
secondpass and except for ansi/wide string that can
|
|
be converted immediatly }
|
|
if not(is_char(right.resultdef) or
|
|
(right.resultdef.typ=stringdef)) then
|
|
inserttypeconv(right,left.resultdef);
|
|
if right.resultdef.typ=stringdef then
|
|
begin
|
|
useshelper:=true;
|
|
{ convert constant strings to shortstrings. But
|
|
skip empty constant strings, that will be handled
|
|
in secondpass }
|
|
if (right.nodetype=stringconstn) then
|
|
begin
|
|
{ verify if range fits within shortstring }
|
|
{ just emit a warning, delphi gives an }
|
|
{ error, only if the type definition of }
|
|
{ of the string is less < 255 characters }
|
|
if not is_open_string(left.resultdef) and
|
|
(tstringconstnode(right).len > tstringdef(left.resultdef).len) then
|
|
cgmessage(type_w_string_too_long);
|
|
inserttypeconv(right,left.resultdef);
|
|
if (right.nodetype=stringconstn) and
|
|
(tstringconstnode(right).len=0) then
|
|
useshelper:=false;
|
|
end;
|
|
{ rest is done in pass 1 (JM) }
|
|
if useshelper then
|
|
exit;
|
|
end
|
|
end
|
|
{ floating point assignments can also perform the conversion directly }
|
|
else if is_real(left.resultdef) and is_real(right.resultdef) and
|
|
not is_constrealnode(right)
|
|
{$ifdef cpufpemu}
|
|
{ the emulator can't do this obviously }
|
|
and not(current_settings.fputype in [fpu_libgcc,fpu_soft])
|
|
{$endif cpufpemu}
|
|
|
|
{$ifdef x86}
|
|
{ the assignment node code can't convert a double in an }
|
|
{ sse register to an extended value in memory more }
|
|
{ efficiently than a type conversion node, so don't }
|
|
{ bother implementing support for that }
|
|
and (use_vectorfpu(left.resultdef) or not(use_vectorfpu(right.resultdef)))
|
|
{$endif}
|
|
|
|
{$ifdef arm}
|
|
{ the assignment node code can't convert a single in
|
|
an interger register to a double in an mmregister or
|
|
vice versa }
|
|
and (use_vectorfpu(left.resultdef) and
|
|
use_vectorfpu(right.resultdef) and
|
|
(tfloatdef(left.resultdef).floattype=tfloatdef(right.resultdef).floattype))
|
|
{$endif}
|
|
then
|
|
begin
|
|
check_ranges(fileinfo,right,left.resultdef);
|
|
end
|
|
else
|
|
begin
|
|
{ check if the assignment may cause a range check error }
|
|
check_ranges(fileinfo,right,left.resultdef);
|
|
inserttypeconv(right,left.resultdef);
|
|
end;
|
|
|
|
{ call helpers for interface }
|
|
if is_interfacecom_or_dispinterface(left.resultdef) then
|
|
begin
|
|
{ Normal interface assignments are handled by the generic refcount incr/decr }
|
|
if not right.resultdef.is_related(left.resultdef) then
|
|
begin
|
|
{ remove property flag to avoid errors, see comments for }
|
|
{ tf_winlikewidestring assignments below }
|
|
exclude(left.flags,nf_isproperty);
|
|
hp:=
|
|
ccallparanode.create(
|
|
cguidconstnode.create(tobjectdef(left.resultdef).iidguid^),
|
|
ccallparanode.create(
|
|
ctypeconvnode.create_internal(right,voidpointertype),
|
|
ccallparanode.create(
|
|
ctypeconvnode.create_internal(left,voidpointertype),
|
|
nil)));
|
|
result:=ccallnode.createintern('fpc_intf_assign_by_iid',hp);
|
|
left:=nil;
|
|
right:=nil;
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
{ check if local proc/func is assigned to procvar }
|
|
if right.resultdef.typ=procvardef then
|
|
test_local_to_procvar(tprocvardef(right.resultdef),left.resultdef);
|
|
end;
|
|
|
|
|
|
function tassignmentnode.pass_1 : tnode;
|
|
var
|
|
hp: tnode;
|
|
oldassignmentnode : tassignmentnode;
|
|
begin
|
|
result:=nil;
|
|
expectloc:=LOC_VOID;
|
|
|
|
firstpass(left);
|
|
|
|
{ Optimize the reuse of the destination of the assingment in left.
|
|
Allow the use of the left inside the tree generated on the right.
|
|
This is especially useful for string routines where the destination
|
|
is pushed as a parameter. Using the final destination of left directly
|
|
save a temp allocation and copy of data (PFV) }
|
|
oldassignmentnode:=aktassignmentnode;
|
|
aktassignmentnode:=self;
|
|
firstpass(right);
|
|
aktassignmentnode:=oldassignmentnode;
|
|
if nf_assign_done_in_right in flags then
|
|
begin
|
|
result:=right;
|
|
right:=nil;
|
|
exit;
|
|
end;
|
|
|
|
if codegenerror then
|
|
exit;
|
|
|
|
{ assignment to refcounted variable -> inc/decref }
|
|
if is_managed_type(left.resultdef) then
|
|
include(current_procinfo.flags,pi_do_call);
|
|
|
|
if (is_shortstring(left.resultdef)) then
|
|
begin
|
|
if right.resultdef.typ=stringdef then
|
|
begin
|
|
if (right.nodetype<>stringconstn) or
|
|
(tstringconstnode(right).len<>0) then
|
|
begin
|
|
{ remove property flag to avoid errors, see comments for }
|
|
{ tf_winlikewidestring assignments below }
|
|
exclude(left.flags, nf_isproperty);
|
|
hp:=ccallparanode.create
|
|
(right,
|
|
ccallparanode.create(left,nil));
|
|
result:=ccallnode.createintern('fpc_'+tstringdef(right.resultdef).stringtypname+'_to_shortstr',hp);
|
|
firstpass(result);
|
|
left:=nil;
|
|
right:=nil;
|
|
exit;
|
|
end;
|
|
end;
|
|
end
|
|
{ call helpers for composite types containing automated types }
|
|
else if is_managed_type(left.resultdef) and
|
|
(left.resultdef.typ in [arraydef,objectdef,recorddef]) and
|
|
not is_interfacecom_or_dispinterface(left.resultdef) and
|
|
not is_dynamic_array(left.resultdef) then
|
|
begin
|
|
hp:=ccallparanode.create(caddrnode.create_internal(
|
|
crttinode.create(tstoreddef(left.resultdef),initrtti,rdt_normal)),
|
|
ccallparanode.create(ctypeconvnode.create_internal(
|
|
caddrnode.create_internal(left),voidpointertype),
|
|
ccallparanode.create(ctypeconvnode.create_internal(
|
|
caddrnode.create_internal(right),voidpointertype),
|
|
nil)));
|
|
result:=ccallnode.createintern('fpc_copy_proc',hp);
|
|
firstpass(result);
|
|
left:=nil;
|
|
right:=nil;
|
|
exit;
|
|
end
|
|
{ call helpers for variant, they can contain non ref. counted types like
|
|
vararrays which must be really copied }
|
|
else if left.resultdef.typ=variantdef then
|
|
begin
|
|
hp:=ccallparanode.create(ctypeconvnode.create_internal(
|
|
caddrnode.create_internal(right),voidpointertype),
|
|
ccallparanode.create(ctypeconvnode.create_internal(
|
|
caddrnode.create_internal(left),voidpointertype),
|
|
nil));
|
|
result:=ccallnode.createintern('fpc_variant_copy',hp);
|
|
firstpass(result);
|
|
left:=nil;
|
|
right:=nil;
|
|
exit;
|
|
end
|
|
{ call helpers for windows widestrings, they aren't ref. counted }
|
|
else if (tf_winlikewidestring in target_info.flags) and is_widestring(left.resultdef) then
|
|
begin
|
|
{ The first argument of fpc_widestr_assign is a var parameter. Properties cannot }
|
|
{ be passed to var or out parameters, because in that case setters/getters are not }
|
|
{ used. Further, if we would allow it in case there are no getters or setters, you }
|
|
{ would need source changes in case these are introduced later on, thus defeating }
|
|
{ part of the transparency advantages of properties. In this particular case, }
|
|
{ however: }
|
|
{ a) if there is a setter, this code will not be used since then the assignment }
|
|
{ will be converted to a procedure call }
|
|
{ b) the getter is irrelevant, because fpc_widestr_assign must always decrease }
|
|
{ the refcount of the field to which we are writing }
|
|
{ c) source code changes are not required if a setter is added/removed, because }
|
|
{ this transformation is handled at compile time }
|
|
{ -> we can remove the nf_isproperty flag (if any) from left, so that in case it }
|
|
{ is a property which refers to a field without a setter call, we will not get }
|
|
{ an error about trying to pass a property as a var parameter }
|
|
exclude(left.flags,nf_isproperty);
|
|
hp:=ccallparanode.create(ctypeconvnode.create_internal(right,voidpointertype),
|
|
ccallparanode.create(ctypeconvnode.create_internal(left,voidpointertype),
|
|
nil));
|
|
result:=ccallnode.createintern('fpc_widestr_assign',hp);
|
|
firstpass(result);
|
|
left:=nil;
|
|
right:=nil;
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
|
|
function tassignmentnode.docompare(p: tnode): boolean;
|
|
begin
|
|
docompare :=
|
|
inherited docompare(p) and
|
|
(assigntype = tassignmentnode(p).assigntype);
|
|
end;
|
|
|
|
{$ifdef state_tracking}
|
|
function Tassignmentnode.track_state_pass(exec_known:boolean):boolean;
|
|
|
|
var se:Tstate_entry;
|
|
|
|
begin
|
|
track_state_pass:=false;
|
|
if exec_known then
|
|
begin
|
|
track_state_pass:=right.track_state_pass(exec_known);
|
|
{Force a new resultdef pass.}
|
|
right.resultdef:=nil;
|
|
do_typecheckpass(right);
|
|
typecheckpass(right);
|
|
aktstate.store_fact(left.getcopy,right.getcopy);
|
|
end
|
|
else
|
|
aktstate.delete_fact(left);
|
|
end;
|
|
{$endif}
|
|
|
|
|
|
{*****************************************************************************
|
|
TARRAYCONSTRUCTORRANGENODE
|
|
*****************************************************************************}
|
|
|
|
constructor tarrayconstructorrangenode.create(l,r : tnode);
|
|
|
|
begin
|
|
inherited create(arrayconstructorrangen,l,r);
|
|
end;
|
|
|
|
function tarrayconstructorrangenode.pass_typecheck:tnode;
|
|
begin
|
|
result:=nil;
|
|
typecheckpass(left);
|
|
typecheckpass(right);
|
|
set_varstate(left,vs_read,[vsf_must_be_valid]);
|
|
set_varstate(right,vs_read,[vsf_must_be_valid]);
|
|
if codegenerror then
|
|
exit;
|
|
resultdef:=left.resultdef;
|
|
end;
|
|
|
|
|
|
function tarrayconstructorrangenode.pass_1 : tnode;
|
|
begin
|
|
result:=nil;
|
|
CGMessage(parser_e_illegal_expression);
|
|
end;
|
|
|
|
|
|
{****************************************************************************
|
|
TARRAYCONSTRUCTORNODE
|
|
*****************************************************************************}
|
|
|
|
constructor tarrayconstructornode.create(l,r : tnode);
|
|
begin
|
|
inherited create(arrayconstructorn,l,r);
|
|
end;
|
|
|
|
|
|
function tarrayconstructornode.dogetcopy : tnode;
|
|
var
|
|
n : tarrayconstructornode;
|
|
begin
|
|
n:=tarrayconstructornode(inherited dogetcopy);
|
|
result:=n;
|
|
end;
|
|
|
|
|
|
function tarrayconstructornode.pass_typecheck:tnode;
|
|
var
|
|
hdef : tdef;
|
|
hp : tarrayconstructornode;
|
|
len : longint;
|
|
varia : boolean;
|
|
eq : tequaltype;
|
|
hnodetype : tnodetype;
|
|
begin
|
|
result:=nil;
|
|
|
|
{ are we allowing array constructor? Then convert it to a set.
|
|
Do this only if we didn't convert the arrayconstructor yet. This
|
|
is needed for the cases where the resultdef is forced for a second
|
|
run }
|
|
if not(allow_array_constructor) then
|
|
begin
|
|
hp:=tarrayconstructornode(getcopy);
|
|
arrayconstructor_to_set(tnode(hp));
|
|
result:=hp;
|
|
exit;
|
|
end;
|
|
|
|
{ only pass left tree, right tree contains next construct if any }
|
|
hdef:=nil;
|
|
hnodetype:=errorn;
|
|
len:=0;
|
|
varia:=false;
|
|
if assigned(left) then
|
|
begin
|
|
hp:=self;
|
|
while assigned(hp) do
|
|
begin
|
|
typecheckpass(hp.left);
|
|
set_varstate(hp.left,vs_read,[vsf_must_be_valid]);
|
|
if (hdef=nil) then
|
|
begin
|
|
hdef:=hp.left.resultdef;
|
|
hnodetype:=hp.left.nodetype;
|
|
end
|
|
else
|
|
begin
|
|
{ If we got a niln we don't know the type yet and need to take the
|
|
type of the next array element.
|
|
This is to handle things like [nil,tclass,tclass], see also tw8371 (PFV) }
|
|
if hnodetype=niln then
|
|
begin
|
|
eq:=compare_defs(hp.left.resultdef,hdef,hnodetype);
|
|
if eq>te_incompatible then
|
|
begin
|
|
hdef:=hp.left.resultdef;
|
|
hnodetype:=hp.left.nodetype;
|
|
end;
|
|
end
|
|
else
|
|
eq:=compare_defs(hdef,hp.left.resultdef,hp.left.nodetype);
|
|
if (not varia) and (eq<te_equal) then
|
|
begin
|
|
{ If both are integers we need to take the type that can hold both
|
|
defs }
|
|
if is_integer(hdef) and is_integer(hp.left.resultdef) then
|
|
begin
|
|
if is_in_limit(hdef,hp.left.resultdef) then
|
|
hdef:=hp.left.resultdef;
|
|
end
|
|
else
|
|
if (nf_novariaallowed in flags) then
|
|
varia:=true;
|
|
end;
|
|
end;
|
|
inc(len);
|
|
hp:=tarrayconstructornode(hp.right);
|
|
end;
|
|
end;
|
|
{ Set the type of empty or varia arrays to void. Also
|
|
do this if the type is array of const/open array
|
|
because those can't be used with setelementdef }
|
|
if not assigned(hdef) or
|
|
varia or
|
|
is_array_of_const(hdef) or
|
|
is_open_array(hdef) then
|
|
hdef:=voidtype;
|
|
resultdef:=tarraydef.create(0,len-1,s32inttype);
|
|
tarraydef(resultdef).elementdef:=hdef;
|
|
include(tarraydef(resultdef).arrayoptions,ado_IsConstructor);
|
|
if varia then
|
|
include(tarraydef(resultdef).arrayoptions,ado_IsVariant);
|
|
end;
|
|
|
|
|
|
procedure tarrayconstructornode.force_type(def:tdef);
|
|
var
|
|
hp : tarrayconstructornode;
|
|
begin
|
|
tarraydef(resultdef).elementdef:=def;
|
|
include(tarraydef(resultdef).arrayoptions,ado_IsConstructor);
|
|
exclude(tarraydef(resultdef).arrayoptions,ado_IsVariant);
|
|
if assigned(left) then
|
|
begin
|
|
hp:=self;
|
|
while assigned(hp) do
|
|
begin
|
|
inserttypeconv(hp.left,def);
|
|
hp:=tarrayconstructornode(hp.right);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure tarrayconstructornode.insert_typeconvs;
|
|
var
|
|
hp : tarrayconstructornode;
|
|
dovariant : boolean;
|
|
begin
|
|
dovariant:=(nf_forcevaria in flags) or (ado_isvariant in tarraydef(resultdef).arrayoptions);
|
|
{ only pass left tree, right tree contains next construct if any }
|
|
if assigned(left) then
|
|
begin
|
|
hp:=self;
|
|
while assigned(hp) do
|
|
begin
|
|
typecheckpass(hp.left);
|
|
{ Insert typeconvs for array of const }
|
|
if dovariant then
|
|
{ at this time C varargs are no longer an arrayconstructornode }
|
|
insert_varargstypeconv(hp.left,false);
|
|
hp:=tarrayconstructornode(hp.right);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
function tarrayconstructornode.pass_1 : tnode;
|
|
var
|
|
hp : tarrayconstructornode;
|
|
do_variant:boolean;
|
|
begin
|
|
do_variant:=(nf_forcevaria in flags) or (ado_isvariant in tarraydef(resultdef).arrayoptions);
|
|
result:=nil;
|
|
{ Insert required type convs, this must be
|
|
done in pass 1, because the call must be
|
|
typecheckpassed already }
|
|
if assigned(left) then
|
|
begin
|
|
insert_typeconvs;
|
|
{ call firstpass for all nodes }
|
|
hp:=self;
|
|
while assigned(hp) do
|
|
begin
|
|
if hp.left<>nil then
|
|
begin
|
|
{This check is pessimistic; a call will happen depending
|
|
on the location in which the elements will be found in
|
|
pass 2.}
|
|
if not do_variant then
|
|
include(current_procinfo.flags,pi_do_call);
|
|
firstpass(hp.left);
|
|
end;
|
|
hp:=tarrayconstructornode(hp.right);
|
|
end;
|
|
end;
|
|
expectloc:=LOC_CREFERENCE;
|
|
end;
|
|
|
|
|
|
function tarrayconstructornode.docompare(p: tnode): boolean;
|
|
begin
|
|
docompare:=inherited docompare(p);
|
|
end;
|
|
|
|
|
|
{*****************************************************************************
|
|
TTYPENODE
|
|
*****************************************************************************}
|
|
|
|
constructor ttypenode.create(def:tdef);
|
|
begin
|
|
inherited create(typen);
|
|
typedef:=def;
|
|
allowed:=false;
|
|
end;
|
|
|
|
|
|
constructor ttypenode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
|
|
begin
|
|
inherited ppuload(t,ppufile);
|
|
ppufile.getderef(typedefderef);
|
|
allowed:=boolean(ppufile.getbyte);
|
|
end;
|
|
|
|
|
|
procedure ttypenode.ppuwrite(ppufile:tcompilerppufile);
|
|
begin
|
|
inherited ppuwrite(ppufile);
|
|
ppufile.putderef(typedefderef);
|
|
ppufile.putbyte(byte(allowed));
|
|
end;
|
|
|
|
|
|
procedure ttypenode.buildderefimpl;
|
|
begin
|
|
inherited buildderefimpl;
|
|
typedefderef.build(typedef);
|
|
end;
|
|
|
|
|
|
procedure ttypenode.derefimpl;
|
|
begin
|
|
inherited derefimpl;
|
|
typedef:=tdef(typedefderef.resolve);
|
|
end;
|
|
|
|
|
|
function ttypenode.pass_typecheck:tnode;
|
|
begin
|
|
result:=nil;
|
|
resultdef:=typedef;
|
|
{ check if it's valid }
|
|
if typedef.typ = errordef then
|
|
CGMessage(parser_e_illegal_expression);
|
|
end;
|
|
|
|
|
|
function ttypenode.pass_1 : tnode;
|
|
begin
|
|
result:=nil;
|
|
expectloc:=LOC_VOID;
|
|
{ a typenode can't generate code, so we give here
|
|
an error. Else it'll be an abstract error in pass_generate_code.
|
|
Only when the allowed flag is set we don't generate
|
|
an error }
|
|
if not allowed then
|
|
Message(parser_e_no_type_not_allowed_here);
|
|
end;
|
|
|
|
|
|
function ttypenode.dogetcopy : tnode;
|
|
var
|
|
n : ttypenode;
|
|
begin
|
|
n:=ttypenode(inherited dogetcopy);
|
|
n.allowed:=allowed;
|
|
n.typedef:=typedef;
|
|
result:=n;
|
|
end;
|
|
|
|
|
|
function ttypenode.docompare(p: tnode): boolean;
|
|
begin
|
|
docompare :=
|
|
inherited docompare(p);
|
|
end;
|
|
|
|
|
|
{*****************************************************************************
|
|
TRTTINODE
|
|
*****************************************************************************}
|
|
|
|
|
|
constructor trttinode.create(def:tstoreddef;rt:trttitype;dt:Trttidatatype);
|
|
begin
|
|
inherited create(rttin);
|
|
rttidef:=def;
|
|
rttitype:=rt;
|
|
rttidatatype:=dt;
|
|
end;
|
|
|
|
|
|
constructor trttinode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
|
|
begin
|
|
inherited ppuload(t,ppufile);
|
|
ppufile.getderef(rttidefderef);
|
|
rttitype:=trttitype(ppufile.getbyte);
|
|
rttidatatype:=trttidatatype(ppufile.getbyte);
|
|
end;
|
|
|
|
|
|
procedure trttinode.ppuwrite(ppufile:tcompilerppufile);
|
|
begin
|
|
inherited ppuwrite(ppufile);
|
|
ppufile.putderef(rttidefderef);
|
|
ppufile.putbyte(byte(rttitype));
|
|
ppufile.putbyte(byte(rttidatatype));
|
|
end;
|
|
|
|
|
|
procedure trttinode.buildderefimpl;
|
|
begin
|
|
inherited buildderefimpl;
|
|
rttidefderef.build(rttidef);
|
|
end;
|
|
|
|
|
|
procedure trttinode.derefimpl;
|
|
begin
|
|
inherited derefimpl;
|
|
rttidef:=tstoreddef(rttidefderef.resolve);
|
|
end;
|
|
|
|
|
|
function trttinode.dogetcopy : tnode;
|
|
var
|
|
n : trttinode;
|
|
begin
|
|
n:=trttinode(inherited dogetcopy);
|
|
n.rttidef:=rttidef;
|
|
n.rttitype:=rttitype;
|
|
n.rttidatatype:=rttidatatype;
|
|
result:=n;
|
|
end;
|
|
|
|
|
|
function trttinode.pass_typecheck:tnode;
|
|
begin
|
|
{ rtti information will be returned as a void pointer }
|
|
result:=nil;
|
|
resultdef:=voidpointertype;
|
|
end;
|
|
|
|
|
|
function trttinode.pass_1 : tnode;
|
|
begin
|
|
result:=nil;
|
|
expectloc:=LOC_CREFERENCE;
|
|
end;
|
|
|
|
|
|
function trttinode.docompare(p: tnode): boolean;
|
|
begin
|
|
docompare :=
|
|
inherited docompare(p) and
|
|
(rttidef = trttinode(p).rttidef) and
|
|
(rttitype = trttinode(p).rttitype);
|
|
end;
|
|
|
|
end.
|