|
|
@@ -1,1225 +1,1226 @@
|
|
|
-{
|
|
|
- $Id: nld.pas,v 1.148 2005/03/28 13:36:15 florian Exp $
|
|
|
- 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
|
|
|
- tloadnode = class(tunarynode)
|
|
|
- symtableentry : tsym;
|
|
|
- symtableentryderef : tderef;
|
|
|
- symtable : tsymtable;
|
|
|
- procdef : tprocdef;
|
|
|
- procdefderef : tderef;
|
|
|
- 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 getcopy : tnode;override;
|
|
|
- function pass_1 : tnode;override;
|
|
|
- function det_resulttype:tnode;override;
|
|
|
- procedure mark_write;override;
|
|
|
- function docompare(p: tnode): boolean; override;
|
|
|
- procedure printnodedata(var t:text);override;
|
|
|
- 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 getcopy : tnode;override;
|
|
|
- function pass_1 : tnode;override;
|
|
|
- function det_resulttype: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 det_resulttype:tnode;override;
|
|
|
- end;
|
|
|
- tarrayconstructorrangenodeclass = class of tarrayconstructorrangenode;
|
|
|
-
|
|
|
- tarrayconstructornode = class(tbinarynode)
|
|
|
- constructor create(l,r : tnode);virtual;
|
|
|
- function getcopy : tnode;override;
|
|
|
- function pass_1 : tnode;override;
|
|
|
- function det_resulttype:tnode;override;
|
|
|
- function docompare(p: tnode): boolean; override;
|
|
|
- procedure force_type(tt:ttype);
|
|
|
- procedure insert_typeconvs;
|
|
|
- end;
|
|
|
- tarrayconstructornodeclass = class of tarrayconstructornode;
|
|
|
-
|
|
|
- ttypenode = class(tnode)
|
|
|
- allowed : boolean;
|
|
|
- restype : ttype;
|
|
|
- constructor create(t : ttype);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 det_resulttype: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;
|
|
|
- constructor create(def:tstoreddef;rt:trttitype);virtual;
|
|
|
- constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
|
|
|
- procedure ppuwrite(ppufile:tcompilerppufile);override;
|
|
|
- procedure buildderefimpl;override;
|
|
|
- procedure derefimpl;override;
|
|
|
- function getcopy : tnode;override;
|
|
|
- function pass_1 : tnode;override;
|
|
|
- function det_resulttype:tnode;override;
|
|
|
- function docompare(p: tnode): boolean; override;
|
|
|
- end;
|
|
|
- trttinodeclass = class of trttinode;
|
|
|
-
|
|
|
- var
|
|
|
- cloadnode : tloadnodeclass;
|
|
|
- cassignmentnode : tassignmentnodeclass;
|
|
|
- carrayconstructorrangenode : tarrayconstructorrangenodeclass;
|
|
|
- carrayconstructornode : tarrayconstructornodeclass;
|
|
|
- ctypenode : ttypenodeclass;
|
|
|
- crttinode : trttinodeclass;
|
|
|
-
|
|
|
-
|
|
|
-
|
|
|
-implementation
|
|
|
-
|
|
|
- uses
|
|
|
- cutils,verbose,globtype,globals,systems,
|
|
|
- symnot,
|
|
|
- defutil,defcmp,
|
|
|
- htypechk,pass_1,procinfo,paramgr,
|
|
|
- ncon,ninl,ncnv,nmem,ncal,nutils,
|
|
|
- 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;
|
|
|
- procdef:=nil;
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
- constructor tloadnode.create_procvar(v : tsym;d:tprocdef;st : tsymtable);
|
|
|
- begin
|
|
|
- inherited create(loadn,nil);
|
|
|
- if not assigned(v) then
|
|
|
- internalerror(200108121);
|
|
|
- symtableentry:=v;
|
|
|
- symtable:=st;
|
|
|
- procdef:=d;
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
- constructor tloadnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
|
|
|
- begin
|
|
|
- inherited ppuload(t,ppufile);
|
|
|
- ppufile.getderef(symtableentryderef);
|
|
|
- symtable:=nil;
|
|
|
- ppufile.getderef(procdefderef);
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
- procedure tloadnode.ppuwrite(ppufile:tcompilerppufile);
|
|
|
- begin
|
|
|
- inherited ppuwrite(ppufile);
|
|
|
- ppufile.putderef(symtableentryderef);
|
|
|
- ppufile.putderef(procdefderef);
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
- procedure tloadnode.buildderefimpl;
|
|
|
- begin
|
|
|
- inherited buildderefimpl;
|
|
|
- symtableentryderef.build(symtableentry);
|
|
|
- procdefderef.build(procdef);
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
- procedure tloadnode.derefimpl;
|
|
|
- begin
|
|
|
- inherited derefimpl;
|
|
|
- symtableentry:=tsym(symtableentryderef.resolve);
|
|
|
- symtable:=symtableentry.owner;
|
|
|
- procdef:=tprocdef(procdefderef.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.getcopy : tnode;
|
|
|
- var
|
|
|
- n : tloadnode;
|
|
|
-
|
|
|
- begin
|
|
|
- n:=tloadnode(inherited getcopy);
|
|
|
- n.symtable:=symtable;
|
|
|
- n.symtableentry:=symtableentry;
|
|
|
- n.procdef:=procdef;
|
|
|
- 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).vartype.def,tprocdef(symtable.defowner).proccalloption);
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
- function tloadnode.det_resulttype:tnode;
|
|
|
- begin
|
|
|
- result:=nil;
|
|
|
- case symtableentry.typ of
|
|
|
- absolutevarsym :
|
|
|
- resulttype:=tabsolutevarsym(symtableentry).vartype;
|
|
|
- constsym:
|
|
|
- begin
|
|
|
- if tconstsym(symtableentry).consttyp=constresourcestring then
|
|
|
- begin
|
|
|
- {$ifdef ansistring_bits}
|
|
|
- case aktansistring_bits of
|
|
|
- sb_16:
|
|
|
- resulttype:=cansistringtype16;
|
|
|
- sb_32:
|
|
|
- resulttype:=cansistringtype32;
|
|
|
- sb_64:
|
|
|
- resulttype:=cansistringtype64;
|
|
|
- end;
|
|
|
- {$else}
|
|
|
- resulttype:=cansistringtype
|
|
|
- {$endif}
|
|
|
- end
|
|
|
- else
|
|
|
- internalerror(22799);
|
|
|
- end;
|
|
|
- globalvarsym,
|
|
|
- paravarsym,
|
|
|
- localvarsym :
|
|
|
- begin
|
|
|
- inc(tabstractvarsym(symtableentry).refs);
|
|
|
- { Nested variable? The we need to load the framepointer of
|
|
|
- the parent procedure }
|
|
|
- if assigned(current_procinfo) then
|
|
|
- begin
|
|
|
- if (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));
|
|
|
- { reference in nested procedures, variable needs to be in memory }
|
|
|
- make_not_regable(self);
|
|
|
- end;
|
|
|
- { 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 (symtable.symtabletype=staticsymtable) and
|
|
|
- (
|
|
|
- (symtable.symtablelevel<>current_procinfo.procdef.localst.symtablelevel) or
|
|
|
- (current_procinfo.procdef.proctypeoption=potype_unitfinalize)
|
|
|
- ) then
|
|
|
- make_not_regable(self);
|
|
|
- end;
|
|
|
- { fix self type which is declared as voidpointer in the
|
|
|
- definition }
|
|
|
- if vo_is_self in tabstractvarsym(symtableentry).varoptions then
|
|
|
- begin
|
|
|
- resulttype.setdef(tprocdef(symtableentry.owner.defowner)._class);
|
|
|
- if (po_classmethod in tprocdef(symtableentry.owner.defowner).procoptions) or
|
|
|
- (po_staticmethod in tprocdef(symtableentry.owner.defowner).procoptions) then
|
|
|
- resulttype.setdef(tclassrefdef.create(resulttype))
|
|
|
- else if is_object(resulttype.def) and
|
|
|
- (nf_load_self_pointer in flags) then
|
|
|
- resulttype.setdef(tpointerdef.create(resulttype));
|
|
|
- end
|
|
|
- else if vo_is_vmt in tabstractvarsym(symtableentry).varoptions then
|
|
|
- begin
|
|
|
- resulttype.setdef(tprocdef(symtableentry.owner.defowner)._class);
|
|
|
- resulttype.setdef(tclassrefdef.create(resulttype));
|
|
|
- end
|
|
|
- else
|
|
|
- resulttype:=tabstractvarsym(symtableentry).vartype;
|
|
|
- end;
|
|
|
- typedconstsym :
|
|
|
- resulttype:=ttypedconstsym(symtableentry).typedconsttype;
|
|
|
- procsym :
|
|
|
- begin
|
|
|
- if not assigned(procdef) then
|
|
|
- begin
|
|
|
- if Tprocsym(symtableentry).procdef_count>1 then
|
|
|
- CGMessage(parser_e_no_overloaded_procvars);
|
|
|
- procdef:=tprocsym(symtableentry).first_procdef;
|
|
|
- end;
|
|
|
-
|
|
|
- { the result is a procdef, addrn and proc_to_procvar
|
|
|
- typeconvn need this as resulttype so they know
|
|
|
- that the address needs to be returned }
|
|
|
- resulttype.setdef(procdef);
|
|
|
-
|
|
|
- { process methodpointer }
|
|
|
- if assigned(left) then
|
|
|
- resulttypepass(left);
|
|
|
- end;
|
|
|
- labelsym:
|
|
|
- resulttype:=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;
|
|
|
- registersint:=0;
|
|
|
- registersfpu:=0;
|
|
|
-{$ifdef SUPPORT_MMX}
|
|
|
- registersmmx:=0;
|
|
|
-{$endif SUPPORT_MMX}
|
|
|
- if (cs_create_pic in aktmoduleswitches) 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;
|
|
|
- globalvarsym,
|
|
|
- localvarsym,
|
|
|
- paravarsym :
|
|
|
- begin
|
|
|
- if assigned(left) then
|
|
|
- firstpass(left);
|
|
|
- if not is_addr_param_load and
|
|
|
- tabstractvarsym(symtableentry).is_regvar then
|
|
|
- begin
|
|
|
- case tabstractvarsym(symtableentry).varregable of
|
|
|
- vr_intreg :
|
|
|
- expectloc:=LOC_CREGISTER;
|
|
|
- vr_fpureg :
|
|
|
- expectloc:=LOC_CFPUREGISTER;
|
|
|
- vr_mmreg :
|
|
|
- expectloc:=LOC_CMMREGISTER;
|
|
|
- end
|
|
|
- end
|
|
|
- else
|
|
|
- if (tabstractvarsym(symtableentry).varspez=vs_const) then
|
|
|
- expectloc:=LOC_CREFERENCE;
|
|
|
- { we need a register for call by reference parameters }
|
|
|
- if paramanager.push_addr_param(tabstractvarsym(symtableentry).varspez,tabstractvarsym(symtableentry).vartype.def,pocall_default) then
|
|
|
- registersint:=1;
|
|
|
- if ([vo_is_thread_var,vo_is_dll_var]*tabstractvarsym(symtableentry).varoptions)<>[] then
|
|
|
- registersint:=1;
|
|
|
- if (target_info.system=system_powerpc_darwin) and (vo_is_dll_var in 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);
|
|
|
- { count variable references }
|
|
|
- if cg.t_times>1 then
|
|
|
- inc(tabstractvarsym(symtableentry).refs,cg.t_times-1);
|
|
|
- end;
|
|
|
- typedconstsym :
|
|
|
- ;
|
|
|
- procsym :
|
|
|
- begin
|
|
|
- { method pointer ? }
|
|
|
- if assigned(left) then
|
|
|
- begin
|
|
|
- expectloc:=LOC_CREFERENCE;
|
|
|
- firstpass(left);
|
|
|
- registersint:=max(registersint,left.registersint);
|
|
|
- registersfpu:=max(registersfpu,left.registersfpu);
|
|
|
- {$ifdef SUPPORT_MMX}
|
|
|
- registersmmx:=max(registersmmx,left.registersmmx);
|
|
|
- {$endif SUPPORT_MMX}
|
|
|
- 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
|
|
|
- (procdef = tloadnode(p).procdef) 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 = ',procdef.mangledname);
|
|
|
- writeln(t,'');
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
-{*****************************************************************************
|
|
|
- TASSIGNMENTNODE
|
|
|
-*****************************************************************************}
|
|
|
-
|
|
|
- constructor tassignmentnode.create(l,r : tnode);
|
|
|
-
|
|
|
- begin
|
|
|
- inherited create(assignn,l,r);
|
|
|
- l.mark_write;
|
|
|
- assigntype:=at_normal;
|
|
|
- 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.getcopy : tnode;
|
|
|
-
|
|
|
- var
|
|
|
- n : tassignmentnode;
|
|
|
-
|
|
|
- begin
|
|
|
- n:=tassignmentnode(inherited getcopy);
|
|
|
- n.assigntype:=assigntype;
|
|
|
- getcopy:=n;
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
- function tassignmentnode.det_resulttype:tnode;
|
|
|
- var
|
|
|
- hp : tnode;
|
|
|
- useshelper : boolean;
|
|
|
- original_size : longint;
|
|
|
- begin
|
|
|
- result:=nil;
|
|
|
- resulttype:=voidtype;
|
|
|
- original_size := 0;
|
|
|
-
|
|
|
- { must be made unique }
|
|
|
- set_unique(left);
|
|
|
-
|
|
|
- resulttypepass(left);
|
|
|
-
|
|
|
- if is_ansistring(left.resulttype.def) then
|
|
|
- begin
|
|
|
- { fold <ansistring>:=<ansistring>+<char|shortstring|ansistring> }
|
|
|
- if (right.nodetype=addn) and
|
|
|
- left.isequal(tbinarynode(right).left) and
|
|
|
- { don't fold multiple concatenations else we could get trouble
|
|
|
- with multiple uses of s
|
|
|
- }
|
|
|
- (tbinarynode(right).left.nodetype<>addn) and
|
|
|
- (tbinarynode(right).right.nodetype<>addn) then
|
|
|
- begin
|
|
|
- { don't do a resulttypepass(right), since then the addnode }
|
|
|
- { may insert typeconversions that make this optimization }
|
|
|
- { opportunity quite difficult to detect (JM) }
|
|
|
- resulttypepass(tbinarynode(right).left);
|
|
|
- resulttypepass(tbinarynode(right).right);
|
|
|
- if (is_char(tbinarynode(right).right.resulttype.def) or
|
|
|
- is_shortstring(tbinarynode(right).right.resulttype.def) or
|
|
|
- is_ansistring(tbinarynode(right).right.resulttype.def)) then
|
|
|
- begin
|
|
|
- { remove property flag so it'll not trigger an error }
|
|
|
- exclude(left.flags,nf_isproperty);
|
|
|
- { generate call to helper }
|
|
|
- hp:=ccallparanode.create(tbinarynode(right).right,
|
|
|
- ccallparanode.create(left,nil));
|
|
|
- if is_char(tbinarynode(right).right.resulttype.def) then
|
|
|
- result:=ccallnode.createintern('fpc_'+Tstringdef(left.resulttype.def).stringtypname+'_append_char',hp)
|
|
|
- else if is_shortstring(tbinarynode(right).right.resulttype.def) then
|
|
|
- result:=ccallnode.createintern('fpc_'+Tstringdef(left.resulttype.def).stringtypname+'_append_shortstring',hp)
|
|
|
- else
|
|
|
- result:=ccallnode.createintern('fpc_'+Tstringdef(left.resulttype.def).stringtypname+'_append_ansistring',hp);
|
|
|
- tbinarynode(right).right:=nil;
|
|
|
- left:=nil;
|
|
|
- exit;
|
|
|
- end;
|
|
|
- end;
|
|
|
- end
|
|
|
- else
|
|
|
- if is_shortstring(left.resulttype.def) then
|
|
|
- begin
|
|
|
- { fold <shortstring>:=<shortstring>+<shortstring>,
|
|
|
- <shortstring>+<char> is handled by an optimized node }
|
|
|
- if (right.nodetype=addn) and
|
|
|
- left.isequal(tbinarynode(right).left) and
|
|
|
- { don't fold multiple concatenations else we could get trouble
|
|
|
- with multiple uses of s }
|
|
|
- (tbinarynode(right).left.nodetype<>addn) and
|
|
|
- (tbinarynode(right).right.nodetype<>addn) then
|
|
|
- begin
|
|
|
- { don't do a resulttypepass(right), since then the addnode }
|
|
|
- { may insert typeconversions that make this optimization }
|
|
|
- { opportunity quite difficult to detect (JM) }
|
|
|
- resulttypepass(tbinarynode(right).left);
|
|
|
- resulttypepass(tbinarynode(right).right);
|
|
|
- if is_shortstring(tbinarynode(right).right.resulttype.def) then
|
|
|
- begin
|
|
|
- { remove property flag so it'll not trigger an error }
|
|
|
- exclude(left.flags,nf_isproperty);
|
|
|
- { generate call to helper }
|
|
|
- hp:=ccallparanode.create(tbinarynode(right).right,
|
|
|
- ccallparanode.create(left,nil));
|
|
|
- if is_shortstring(tbinarynode(right).right.resulttype.def) then
|
|
|
- result:=ccallnode.createintern('fpc_shortstr_append_shortstr',hp);
|
|
|
- tbinarynode(right).right:=nil;
|
|
|
- left:=nil;
|
|
|
- exit;
|
|
|
- end;
|
|
|
- end;
|
|
|
- end;
|
|
|
-
|
|
|
- resulttypepass(right);
|
|
|
- set_varstate(left,vs_assigned,[]);
|
|
|
- set_varstate(right,vs_used,[vsf_must_be_valid]);
|
|
|
- if codegenerror then
|
|
|
- exit;
|
|
|
-
|
|
|
- { tp procvar support, when we don't expect a procvar
|
|
|
- then we need to call the procvar }
|
|
|
- if (left.resulttype.def.deftype<>procvardef) then
|
|
|
- maybe_call_procvar(right,true);
|
|
|
-
|
|
|
- { assignments to formaldefs and open arrays aren't allowed }
|
|
|
- if (left.resulttype.def.deftype=formaldef) or
|
|
|
- is_open_array(left.resulttype.def) then
|
|
|
- CGMessage(type_e_operator_not_allowed);
|
|
|
-
|
|
|
- { test if node can be assigned, properties are allowed }
|
|
|
- valid_for_assignment(left);
|
|
|
-
|
|
|
- { assigning nil to a dynamic array clears the array }
|
|
|
- if is_dynamic_array(left.resulttype.def) and
|
|
|
- (right.nodetype=niln) then
|
|
|
- begin
|
|
|
- hp:=ccallparanode.create(caddrnode.create_internal
|
|
|
- (crttinode.create(tstoreddef(left.resulttype.def),initrtti)),
|
|
|
- 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.resulttype.def)) 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.resulttype.def) or
|
|
|
- (right.resulttype.def.deftype=stringdef)) then
|
|
|
- inserttypeconv(right,left.resulttype);
|
|
|
- if right.resulttype.def.deftype=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.resulttype.def) and
|
|
|
- (tstringconstnode(right).len > tstringdef(left.resulttype.def).len) then
|
|
|
- cgmessage(type_w_string_too_long);
|
|
|
- inserttypeconv(right,left.resulttype);
|
|
|
- if (tstringconstnode(right).len=0) then
|
|
|
- useshelper:=false;
|
|
|
- end;
|
|
|
- { rest is done in pass 1 (JM) }
|
|
|
- if useshelper then
|
|
|
- exit;
|
|
|
- end
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- { get the size before the type conversion - check for all nodes }
|
|
|
- if assigned(right.resulttype.def) and
|
|
|
- (right.resulttype.def.deftype in [enumdef,orddef,floatdef]) and
|
|
|
- (right.nodetype in [loadn,vecn,calln]) then
|
|
|
- original_size := right.resulttype.def.size;
|
|
|
- inserttypeconv(right,left.resulttype);
|
|
|
- end;
|
|
|
-
|
|
|
- { check if the assignment may cause a range check error }
|
|
|
- { if its not explicit, and only if the values are }
|
|
|
- { ordinals, enumdef and floatdef }
|
|
|
- if (right.nodetype = typeconvn) and
|
|
|
- not (nf_explicit in ttypeconvnode(right).flags) then
|
|
|
- begin
|
|
|
- if assigned(left.resulttype.def) and
|
|
|
- (left.resulttype.def.deftype in [enumdef,orddef,floatdef]) and
|
|
|
- not is_boolean(left.resulttype.def) then
|
|
|
- begin
|
|
|
- if (original_size <> 0) and
|
|
|
- (left.resulttype.def.size < original_size) then
|
|
|
- begin
|
|
|
- if (cs_check_range in aktlocalswitches) then
|
|
|
- Message(type_w_smaller_possible_range_check)
|
|
|
- else
|
|
|
- Message(type_h_smaller_possible_range_check);
|
|
|
- end;
|
|
|
- end;
|
|
|
- end;
|
|
|
-
|
|
|
- { call helpers for interface }
|
|
|
- if is_interfacecom(left.resulttype.def) then
|
|
|
- begin
|
|
|
- hp:=ccallparanode.create(ctypeconvnode.create_internal
|
|
|
- (right,voidpointertype),
|
|
|
- ccallparanode.create(ctypeconvnode.create_internal
|
|
|
- (left,voidpointertype),nil));
|
|
|
- result:=ccallnode.createintern('fpc_intf_assign',hp);
|
|
|
- left:=nil;
|
|
|
- right:=nil;
|
|
|
- exit;
|
|
|
- end;
|
|
|
- { call helpers for variant, they can contain non ref. counted types like
|
|
|
- vararrays which must be really copied }
|
|
|
- if left.resulttype.def.deftype=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);
|
|
|
- left:=nil;
|
|
|
- right:=nil;
|
|
|
- exit;
|
|
|
- end;
|
|
|
-
|
|
|
- { check if local proc/func is assigned to procvar }
|
|
|
- if right.resulttype.def.deftype=procvardef then
|
|
|
- test_local_to_procvar(tprocvardef(right.resulttype.def),left.resulttype.def);
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
- function tassignmentnode.pass_1 : tnode;
|
|
|
- var
|
|
|
- hp: tnode;
|
|
|
- begin
|
|
|
- result:=nil;
|
|
|
- expectloc:=LOC_VOID;
|
|
|
-
|
|
|
- firstpass(left);
|
|
|
- firstpass(right);
|
|
|
- { assignment to refcounted variable -> inc/decref }
|
|
|
- if (not is_class(left.resulttype.def) and
|
|
|
- left.resulttype.def.needs_inittable) then
|
|
|
- include(current_procinfo.flags,pi_do_call);
|
|
|
-
|
|
|
- if codegenerror then
|
|
|
- exit;
|
|
|
-
|
|
|
-
|
|
|
- if (is_shortstring(left.resulttype.def)) then
|
|
|
- begin
|
|
|
- if right.resulttype.def.deftype=stringdef then
|
|
|
- begin
|
|
|
- if (right.nodetype<>stringconstn) or
|
|
|
- (tstringconstnode(right).len<>0) then
|
|
|
- begin
|
|
|
- if (cs_optimize in aktglobalswitches) and
|
|
|
- (right.nodetype in [calln,blockn]) and
|
|
|
- (left.nodetype = temprefn) and
|
|
|
- is_shortstring(right.resulttype.def) and
|
|
|
- not is_open_string(left.resulttype.def) and
|
|
|
- (tstringdef(left.resulttype.def).len = 255) then
|
|
|
- begin
|
|
|
- { the blocknode case is handled in pass_2 at the temp }
|
|
|
- { reference level (mainly for callparatemp) (JM) }
|
|
|
- if (right.nodetype = calln) then
|
|
|
- begin
|
|
|
- tcallnode(right).funcretnode := left;
|
|
|
- result := right;
|
|
|
- end
|
|
|
- else
|
|
|
- exit;
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- hp:=ccallparanode.create
|
|
|
- (right,
|
|
|
- ccallparanode.create(cinlinenode.create
|
|
|
- (in_high_x,false,left.getcopy),nil));
|
|
|
- result:=ccallnode.createinternreturn('fpc_'+tstringdef(right.resulttype.def).stringtypname+'_to_shortstr',hp,left);
|
|
|
- firstpass(result);
|
|
|
- end;
|
|
|
- left:=nil;
|
|
|
- right:=nil;
|
|
|
- exit;
|
|
|
- end;
|
|
|
- end;
|
|
|
- end;
|
|
|
-
|
|
|
- if (cs_optimize in aktglobalswitches) and
|
|
|
- (right.nodetype = calln) and
|
|
|
- { left must be a temp, since otherwise as soon as you modify the }
|
|
|
- { result, the current left node is modified and that one may }
|
|
|
- { still be an argument to the function or even accessed in the }
|
|
|
- { function }
|
|
|
- (((left.nodetype = temprefn) and
|
|
|
- paramanager.ret_in_param(right.resulttype.def,
|
|
|
- tcallnode(right).procdefinition.proccalloption)) or
|
|
|
- { there's special support for ansi/widestrings in the callnode }
|
|
|
- is_ansistring(right.resulttype.def) or
|
|
|
- is_widestring(right.resulttype.def)) then
|
|
|
- begin
|
|
|
- tcallnode(right).funcretnode := left;
|
|
|
- result := right;
|
|
|
- left := nil;
|
|
|
- right := nil;
|
|
|
- exit;
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
- registersint:=left.registersint+right.registersint;
|
|
|
- registersfpu:=max(left.registersfpu,right.registersfpu);
|
|
|
-{$ifdef SUPPORT_MMX}
|
|
|
- registersmmx:=max(left.registersmmx,right.registersmmx);
|
|
|
-{$endif SUPPORT_MMX}
|
|
|
- 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 resulttype pass.}
|
|
|
- right.resulttype.def:=nil;
|
|
|
- do_resulttypepass(right);
|
|
|
- resulttypepass(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.det_resulttype:tnode;
|
|
|
- begin
|
|
|
- result:=nil;
|
|
|
- resulttypepass(left);
|
|
|
- resulttypepass(right);
|
|
|
- set_varstate(left,vs_used,[vsf_must_be_valid]);
|
|
|
- set_varstate(right,vs_used,[vsf_must_be_valid]);
|
|
|
- if codegenerror then
|
|
|
- exit;
|
|
|
- resulttype:=left.resulttype;
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
- function tarrayconstructorrangenode.pass_1 : tnode;
|
|
|
- begin
|
|
|
- firstpass(left);
|
|
|
- firstpass(right);
|
|
|
- expectloc:=LOC_CREFERENCE;
|
|
|
- calcregisters(self,0,0,0);
|
|
|
- result:=nil;
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
-{****************************************************************************
|
|
|
- TARRAYCONSTRUCTORNODE
|
|
|
-*****************************************************************************}
|
|
|
-
|
|
|
- constructor tarrayconstructornode.create(l,r : tnode);
|
|
|
- begin
|
|
|
- inherited create(arrayconstructorn,l,r);
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
- function tarrayconstructornode.getcopy : tnode;
|
|
|
- var
|
|
|
- n : tarrayconstructornode;
|
|
|
- begin
|
|
|
- n:=tarrayconstructornode(inherited getcopy);
|
|
|
- result:=n;
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
- function tarrayconstructornode.det_resulttype:tnode;
|
|
|
- var
|
|
|
- htype : ttype;
|
|
|
- hp : tarrayconstructornode;
|
|
|
- len : longint;
|
|
|
- varia : boolean;
|
|
|
- begin
|
|
|
- result:=nil;
|
|
|
-
|
|
|
- { are we allowing array constructor? Then convert it to a set }
|
|
|
- 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 }
|
|
|
- htype.reset;
|
|
|
- len:=0;
|
|
|
- varia:=false;
|
|
|
- if assigned(left) then
|
|
|
- begin
|
|
|
- hp:=self;
|
|
|
- while assigned(hp) do
|
|
|
- begin
|
|
|
- resulttypepass(hp.left);
|
|
|
- set_varstate(hp.left,vs_used,[vsf_must_be_valid]);
|
|
|
- if (htype.def=nil) then
|
|
|
- htype:=hp.left.resulttype
|
|
|
- else
|
|
|
- begin
|
|
|
- if ((nf_novariaallowed in flags) or (not varia)) and
|
|
|
- (not equal_defs(htype.def,hp.left.resulttype.def)) then
|
|
|
- begin
|
|
|
- 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 setelementtype }
|
|
|
- if not assigned(htype.def) or
|
|
|
- varia or
|
|
|
- is_array_of_const(htype.def) or
|
|
|
- is_open_array(htype.def) then
|
|
|
- htype:=voidtype;
|
|
|
- resulttype.setdef(tarraydef.create(0,len-1,s32inttype));
|
|
|
- tarraydef(resulttype.def).setelementtype(htype);
|
|
|
- tarraydef(resulttype.def).IsConstructor:=true;
|
|
|
- tarraydef(resulttype.def).IsVariant:=varia;
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
- procedure tarrayconstructornode.force_type(tt:ttype);
|
|
|
- var
|
|
|
- hp : tarrayconstructornode;
|
|
|
- begin
|
|
|
- tarraydef(resulttype.def).setelementtype(tt);
|
|
|
- tarraydef(resulttype.def).IsConstructor:=true;
|
|
|
- tarraydef(resulttype.def).IsVariant:=false;
|
|
|
- if assigned(left) then
|
|
|
- begin
|
|
|
- hp:=self;
|
|
|
- while assigned(hp) do
|
|
|
- begin
|
|
|
- inserttypeconv(hp.left,tt);
|
|
|
- hp:=tarrayconstructornode(hp.right);
|
|
|
- end;
|
|
|
- end;
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
- procedure tarrayconstructornode.insert_typeconvs;
|
|
|
- var
|
|
|
- hp : tarrayconstructornode;
|
|
|
- dovariant : boolean;
|
|
|
- begin
|
|
|
- dovariant:=(nf_forcevaria in flags) or tarraydef(resulttype.def).isvariant;
|
|
|
- { only pass left tree, right tree contains next construct if any }
|
|
|
- if assigned(left) then
|
|
|
- begin
|
|
|
- hp:=self;
|
|
|
- while assigned(hp) do
|
|
|
- begin
|
|
|
- resulttypepass(hp.left);
|
|
|
- { Insert typeconvs for array of const }
|
|
|
- if dovariant then
|
|
|
- begin
|
|
|
- case hp.left.resulttype.def.deftype of
|
|
|
- enumdef :
|
|
|
- hp.left:=ctypeconvnode.create_internal(hp.left,s32inttype);
|
|
|
- arraydef :
|
|
|
- begin
|
|
|
- if is_chararray(hp.left.resulttype.def) then
|
|
|
- hp.left:=ctypeconvnode.create_internal(hp.left,charpointertype)
|
|
|
- else
|
|
|
- if is_widechararray(hp.left.resulttype.def) then
|
|
|
- hp.left:=ctypeconvnode.create_internal(hp.left,widecharpointertype)
|
|
|
- else
|
|
|
- CGMessagePos1(hp.left.fileinfo,type_e_wrong_type_in_array_constructor,hp.left.resulttype.def.typename);
|
|
|
- end;
|
|
|
- orddef :
|
|
|
- begin
|
|
|
- if is_integer(hp.left.resulttype.def) and
|
|
|
- not(is_64bitint(hp.left.resulttype.def)) then
|
|
|
- hp.left:=ctypeconvnode.create(hp.left,s32inttype);
|
|
|
- end;
|
|
|
- floatdef :
|
|
|
- hp.left:=ctypeconvnode.create(hp.left,pbestrealtype^);
|
|
|
- procvardef :
|
|
|
- hp.left:=ctypeconvnode.create(hp.left,voidpointertype);
|
|
|
- stringdef,
|
|
|
- variantdef,
|
|
|
- pointerdef,
|
|
|
- classrefdef,
|
|
|
- objectdef : ;
|
|
|
- else
|
|
|
- CGMessagePos1(hp.left.fileinfo,type_e_wrong_type_in_array_constructor,hp.left.resulttype.def.typename);
|
|
|
- end;
|
|
|
- end;
|
|
|
- resulttypepass(hp.left);
|
|
|
- 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 tarraydef(resulttype.def).isvariant;
|
|
|
- result:=nil;
|
|
|
- { Insert required type convs, this must be
|
|
|
- done in pass 1, because the call must be
|
|
|
- resulttypepassed 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;
|
|
|
- calcregisters(self,0,0,0);
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
- function tarrayconstructornode.docompare(p: tnode): boolean;
|
|
|
-
|
|
|
- begin
|
|
|
- docompare:=inherited docompare(p);
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
-{*****************************************************************************
|
|
|
- TTYPENODE
|
|
|
-*****************************************************************************}
|
|
|
-
|
|
|
- constructor ttypenode.create(t : ttype);
|
|
|
- begin
|
|
|
- inherited create(typen);
|
|
|
- restype:=t;
|
|
|
- allowed:=false;
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
- constructor ttypenode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
|
|
|
- begin
|
|
|
- inherited ppuload(t,ppufile);
|
|
|
- ppufile.gettype(restype);
|
|
|
- allowed:=boolean(ppufile.getbyte);
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
- procedure ttypenode.ppuwrite(ppufile:tcompilerppufile);
|
|
|
- begin
|
|
|
- inherited ppuwrite(ppufile);
|
|
|
- ppufile.puttype(restype);
|
|
|
- ppufile.putbyte(byte(allowed));
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
- procedure ttypenode.buildderefimpl;
|
|
|
- begin
|
|
|
- inherited buildderefimpl;
|
|
|
- restype.buildderef;
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
- procedure ttypenode.derefimpl;
|
|
|
- begin
|
|
|
- inherited derefimpl;
|
|
|
- restype.resolve;
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
- function ttypenode.det_resulttype:tnode;
|
|
|
- begin
|
|
|
- result:=nil;
|
|
|
- resulttype:=restype;
|
|
|
- { check if it's valid }
|
|
|
- if restype.def.deftype = 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_2.
|
|
|
- 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.docompare(p: tnode): boolean;
|
|
|
- begin
|
|
|
- docompare :=
|
|
|
- inherited docompare(p);
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
-{*****************************************************************************
|
|
|
- TRTTINODE
|
|
|
-*****************************************************************************}
|
|
|
-
|
|
|
-
|
|
|
- constructor trttinode.create(def:tstoreddef;rt:trttitype);
|
|
|
- begin
|
|
|
- inherited create(rttin);
|
|
|
- rttidef:=def;
|
|
|
- rttitype:=rt;
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
- constructor trttinode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
|
|
|
- begin
|
|
|
- inherited ppuload(t,ppufile);
|
|
|
- ppufile.getderef(rttidefderef);
|
|
|
- rttitype:=trttitype(ppufile.getbyte);
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
- procedure trttinode.ppuwrite(ppufile:tcompilerppufile);
|
|
|
- begin
|
|
|
- inherited ppuwrite(ppufile);
|
|
|
- ppufile.putderef(rttidefderef);
|
|
|
- ppufile.putbyte(byte(rttitype));
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
- procedure trttinode.buildderefimpl;
|
|
|
- begin
|
|
|
- inherited buildderefimpl;
|
|
|
- rttidefderef.build(rttidef);
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
- procedure trttinode.derefimpl;
|
|
|
- begin
|
|
|
- inherited derefimpl;
|
|
|
- rttidef:=tstoreddef(rttidefderef.resolve);
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
- function trttinode.getcopy : tnode;
|
|
|
- var
|
|
|
- n : trttinode;
|
|
|
- begin
|
|
|
- n:=trttinode(inherited getcopy);
|
|
|
- n.rttidef:=rttidef;
|
|
|
- n.rttitype:=rttitype;
|
|
|
- result:=n;
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
- function trttinode.det_resulttype:tnode;
|
|
|
- begin
|
|
|
- { rtti information will be returned as a void pointer }
|
|
|
- result:=nil;
|
|
|
- resulttype:=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;
|
|
|
-
|
|
|
-
|
|
|
-begin
|
|
|
- cloadnode:=tloadnode;
|
|
|
- cassignmentnode:=tassignmentnode;
|
|
|
- carrayconstructorrangenode:=tarrayconstructorrangenode;
|
|
|
- carrayconstructornode:=tarrayconstructornode;
|
|
|
- ctypenode:=ttypenode;
|
|
|
- crttinode:=trttinode;
|
|
|
-end.
|
|
|
-{
|
|
|
- $Log: nld.pas,v $
|
|
|
- Revision 1.148 2005/03/28 13:36:15 florian
|
|
|
- + variants are now assigned using fpc_variant_copy
|
|
|
-
|
|
|
- Revision 1.147 2005/03/25 22:20:19 peter
|
|
|
- * add hint when passing an uninitialized variable to a var parameter
|
|
|
-
|
|
|
- Revision 1.146 2005/03/18 16:41:27 peter
|
|
|
- don't check size differences for booleans
|
|
|
-
|
|
|
- Revision 1.145 2005/02/14 17:13:06 peter
|
|
|
- * truncate log
|
|
|
-
|
|
|
- Revision 1.144 2005/02/11 16:25:26 peter
|
|
|
- * fix IE with array of const in array of conts
|
|
|
-
|
|
|
- Revision 1.143 2005/01/23 17:14:21 florian
|
|
|
- + optimized code generation on sparc
|
|
|
- + some stuff for pic code on sparc added
|
|
|
-
|
|
|
-}
|
|
|
+{
|
|
|
+ $Id: nld.pas,v 1.148 2005/03/28 13:36:15 florian Exp $
|
|
|
+ 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
|
|
|
+ tloadnode = class(tunarynode)
|
|
|
+ symtableentry : tsym;
|
|
|
+ symtableentryderef : tderef;
|
|
|
+ symtable : tsymtable;
|
|
|
+ procdef : tprocdef;
|
|
|
+ procdefderef : tderef;
|
|
|
+ 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 getcopy : tnode;override;
|
|
|
+ function pass_1 : tnode;override;
|
|
|
+ function det_resulttype:tnode;override;
|
|
|
+ procedure mark_write;override;
|
|
|
+ function docompare(p: tnode): boolean; override;
|
|
|
+ procedure printnodedata(var t:text);override;
|
|
|
+ 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 getcopy : tnode;override;
|
|
|
+ function pass_1 : tnode;override;
|
|
|
+ function det_resulttype: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 det_resulttype:tnode;override;
|
|
|
+ end;
|
|
|
+ tarrayconstructorrangenodeclass = class of tarrayconstructorrangenode;
|
|
|
+
|
|
|
+ tarrayconstructornode = class(tbinarynode)
|
|
|
+ constructor create(l,r : tnode);virtual;
|
|
|
+ function getcopy : tnode;override;
|
|
|
+ function pass_1 : tnode;override;
|
|
|
+ function det_resulttype:tnode;override;
|
|
|
+ function docompare(p: tnode): boolean; override;
|
|
|
+ procedure force_type(tt:ttype);
|
|
|
+ procedure insert_typeconvs;
|
|
|
+ end;
|
|
|
+ tarrayconstructornodeclass = class of tarrayconstructornode;
|
|
|
+
|
|
|
+ ttypenode = class(tnode)
|
|
|
+ allowed : boolean;
|
|
|
+ restype : ttype;
|
|
|
+ constructor create(t : ttype);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 det_resulttype: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;
|
|
|
+ constructor create(def:tstoreddef;rt:trttitype);virtual;
|
|
|
+ constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
|
|
|
+ procedure ppuwrite(ppufile:tcompilerppufile);override;
|
|
|
+ procedure buildderefimpl;override;
|
|
|
+ procedure derefimpl;override;
|
|
|
+ function getcopy : tnode;override;
|
|
|
+ function pass_1 : tnode;override;
|
|
|
+ function det_resulttype:tnode;override;
|
|
|
+ function docompare(p: tnode): boolean; override;
|
|
|
+ end;
|
|
|
+ trttinodeclass = class of trttinode;
|
|
|
+
|
|
|
+ var
|
|
|
+ cloadnode : tloadnodeclass;
|
|
|
+ cassignmentnode : tassignmentnodeclass;
|
|
|
+ carrayconstructorrangenode : tarrayconstructorrangenodeclass;
|
|
|
+ carrayconstructornode : tarrayconstructornodeclass;
|
|
|
+ ctypenode : ttypenodeclass;
|
|
|
+ crttinode : trttinodeclass;
|
|
|
+
|
|
|
+
|
|
|
+
|
|
|
+implementation
|
|
|
+
|
|
|
+ uses
|
|
|
+ cutils,verbose,globtype,globals,systems,
|
|
|
+ symnot,
|
|
|
+ defutil,defcmp,
|
|
|
+ htypechk,pass_1,procinfo,paramgr,
|
|
|
+ ncon,ninl,ncnv,nmem,ncal,nutils,
|
|
|
+ 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;
|
|
|
+ procdef:=nil;
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
+ constructor tloadnode.create_procvar(v : tsym;d:tprocdef;st : tsymtable);
|
|
|
+ begin
|
|
|
+ inherited create(loadn,nil);
|
|
|
+ if not assigned(v) then
|
|
|
+ internalerror(200108121);
|
|
|
+ symtableentry:=v;
|
|
|
+ symtable:=st;
|
|
|
+ procdef:=d;
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
+ constructor tloadnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
|
|
|
+ begin
|
|
|
+ inherited ppuload(t,ppufile);
|
|
|
+ ppufile.getderef(symtableentryderef);
|
|
|
+ symtable:=nil;
|
|
|
+ ppufile.getderef(procdefderef);
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
+ procedure tloadnode.ppuwrite(ppufile:tcompilerppufile);
|
|
|
+ begin
|
|
|
+ inherited ppuwrite(ppufile);
|
|
|
+ ppufile.putderef(symtableentryderef);
|
|
|
+ ppufile.putderef(procdefderef);
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
+ procedure tloadnode.buildderefimpl;
|
|
|
+ begin
|
|
|
+ inherited buildderefimpl;
|
|
|
+ symtableentryderef.build(symtableentry);
|
|
|
+ procdefderef.build(procdef);
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
+ procedure tloadnode.derefimpl;
|
|
|
+ begin
|
|
|
+ inherited derefimpl;
|
|
|
+ symtableentry:=tsym(symtableentryderef.resolve);
|
|
|
+ symtable:=symtableentry.owner;
|
|
|
+ procdef:=tprocdef(procdefderef.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.getcopy : tnode;
|
|
|
+ var
|
|
|
+ n : tloadnode;
|
|
|
+
|
|
|
+ begin
|
|
|
+ n:=tloadnode(inherited getcopy);
|
|
|
+ n.symtable:=symtable;
|
|
|
+ n.symtableentry:=symtableentry;
|
|
|
+ n.procdef:=procdef;
|
|
|
+ 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).vartype.def,tprocdef(symtable.defowner).proccalloption);
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
+ function tloadnode.det_resulttype:tnode;
|
|
|
+ begin
|
|
|
+ result:=nil;
|
|
|
+ case symtableentry.typ of
|
|
|
+ absolutevarsym :
|
|
|
+ resulttype:=tabsolutevarsym(symtableentry).vartype;
|
|
|
+ constsym:
|
|
|
+ begin
|
|
|
+ if tconstsym(symtableentry).consttyp=constresourcestring then
|
|
|
+ begin
|
|
|
+ {$ifdef ansistring_bits}
|
|
|
+ case aktansistring_bits of
|
|
|
+ sb_16:
|
|
|
+ resulttype:=cansistringtype16;
|
|
|
+ sb_32:
|
|
|
+ resulttype:=cansistringtype32;
|
|
|
+ sb_64:
|
|
|
+ resulttype:=cansistringtype64;
|
|
|
+ end;
|
|
|
+ {$else}
|
|
|
+ resulttype:=cansistringtype
|
|
|
+ {$endif}
|
|
|
+ end
|
|
|
+ else
|
|
|
+ internalerror(22799);
|
|
|
+ end;
|
|
|
+ globalvarsym,
|
|
|
+ paravarsym,
|
|
|
+ localvarsym :
|
|
|
+ begin
|
|
|
+ inc(tabstractvarsym(symtableentry).refs);
|
|
|
+ { Nested variable? The we need to load the framepointer of
|
|
|
+ the parent procedure }
|
|
|
+ if assigned(current_procinfo) then
|
|
|
+ begin
|
|
|
+ if (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));
|
|
|
+ { reference in nested procedures, variable needs to be in memory }
|
|
|
+ make_not_regable(self);
|
|
|
+ end;
|
|
|
+ { 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 (symtable.symtabletype=staticsymtable) and
|
|
|
+ (
|
|
|
+ (symtable.symtablelevel<>current_procinfo.procdef.localst.symtablelevel) or
|
|
|
+ (current_procinfo.procdef.proctypeoption=potype_unitfinalize)
|
|
|
+ ) then
|
|
|
+ make_not_regable(self);
|
|
|
+ end;
|
|
|
+ { fix self type which is declared as voidpointer in the
|
|
|
+ definition }
|
|
|
+ if vo_is_self in tabstractvarsym(symtableentry).varoptions then
|
|
|
+ begin
|
|
|
+ resulttype.setdef(tprocdef(symtableentry.owner.defowner)._class);
|
|
|
+ if (po_classmethod in tprocdef(symtableentry.owner.defowner).procoptions) or
|
|
|
+ (po_staticmethod in tprocdef(symtableentry.owner.defowner).procoptions) then
|
|
|
+ resulttype.setdef(tclassrefdef.create(resulttype))
|
|
|
+ else if is_object(resulttype.def) and
|
|
|
+ (nf_load_self_pointer in flags) then
|
|
|
+ resulttype.setdef(tpointerdef.create(resulttype));
|
|
|
+ end
|
|
|
+ else if vo_is_vmt in tabstractvarsym(symtableentry).varoptions then
|
|
|
+ begin
|
|
|
+ resulttype.setdef(tprocdef(symtableentry.owner.defowner)._class);
|
|
|
+ resulttype.setdef(tclassrefdef.create(resulttype));
|
|
|
+ end
|
|
|
+ else
|
|
|
+ resulttype:=tabstractvarsym(symtableentry).vartype;
|
|
|
+ end;
|
|
|
+ typedconstsym :
|
|
|
+ resulttype:=ttypedconstsym(symtableentry).typedconsttype;
|
|
|
+ procsym :
|
|
|
+ begin
|
|
|
+ if not assigned(procdef) then
|
|
|
+ begin
|
|
|
+ if Tprocsym(symtableentry).procdef_count>1 then
|
|
|
+ CGMessage(parser_e_no_overloaded_procvars);
|
|
|
+ procdef:=tprocsym(symtableentry).first_procdef;
|
|
|
+ end;
|
|
|
+
|
|
|
+ { the result is a procdef, addrn and proc_to_procvar
|
|
|
+ typeconvn need this as resulttype so they know
|
|
|
+ that the address needs to be returned }
|
|
|
+ resulttype.setdef(procdef);
|
|
|
+
|
|
|
+ { process methodpointer }
|
|
|
+ if assigned(left) then
|
|
|
+ resulttypepass(left);
|
|
|
+ end;
|
|
|
+ labelsym:
|
|
|
+ resulttype:=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;
|
|
|
+ registersint:=0;
|
|
|
+ registersfpu:=0;
|
|
|
+{$ifdef SUPPORT_MMX}
|
|
|
+ registersmmx:=0;
|
|
|
+{$endif SUPPORT_MMX}
|
|
|
+ if (cs_create_pic in aktmoduleswitches) 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;
|
|
|
+ globalvarsym,
|
|
|
+ localvarsym,
|
|
|
+ paravarsym :
|
|
|
+ begin
|
|
|
+ if assigned(left) then
|
|
|
+ firstpass(left);
|
|
|
+ if not is_addr_param_load and
|
|
|
+ tabstractvarsym(symtableentry).is_regvar then
|
|
|
+ begin
|
|
|
+ case tabstractvarsym(symtableentry).varregable of
|
|
|
+ vr_intreg :
|
|
|
+ expectloc:=LOC_CREGISTER;
|
|
|
+ vr_fpureg :
|
|
|
+ expectloc:=LOC_CFPUREGISTER;
|
|
|
+ vr_mmreg :
|
|
|
+ expectloc:=LOC_CMMREGISTER;
|
|
|
+ end
|
|
|
+ end
|
|
|
+ else
|
|
|
+ if (tabstractvarsym(symtableentry).varspez=vs_const) then
|
|
|
+ expectloc:=LOC_CREFERENCE;
|
|
|
+ { we need a register for call by reference parameters }
|
|
|
+ if paramanager.push_addr_param(tabstractvarsym(symtableentry).varspez,tabstractvarsym(symtableentry).vartype.def,pocall_default) then
|
|
|
+ registersint:=1;
|
|
|
+ if ([vo_is_thread_var,vo_is_dll_var]*tabstractvarsym(symtableentry).varoptions)<>[] then
|
|
|
+ registersint:=1;
|
|
|
+ if (target_info.system=system_powerpc_darwin) and (vo_is_dll_var in 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);
|
|
|
+ { count variable references }
|
|
|
+ if cg.t_times>1 then
|
|
|
+ inc(tabstractvarsym(symtableentry).refs,cg.t_times-1);
|
|
|
+ end;
|
|
|
+ typedconstsym :
|
|
|
+ ;
|
|
|
+ procsym :
|
|
|
+ begin
|
|
|
+ { method pointer ? }
|
|
|
+ if assigned(left) then
|
|
|
+ begin
|
|
|
+ expectloc:=LOC_CREFERENCE;
|
|
|
+ firstpass(left);
|
|
|
+ registersint:=max(registersint,left.registersint);
|
|
|
+ registersfpu:=max(registersfpu,left.registersfpu);
|
|
|
+ {$ifdef SUPPORT_MMX}
|
|
|
+ registersmmx:=max(registersmmx,left.registersmmx);
|
|
|
+ {$endif SUPPORT_MMX}
|
|
|
+ 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
|
|
|
+ (procdef = tloadnode(p).procdef) 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 = ',procdef.mangledname);
|
|
|
+ writeln(t,'');
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
+{*****************************************************************************
|
|
|
+ TASSIGNMENTNODE
|
|
|
+*****************************************************************************}
|
|
|
+
|
|
|
+ constructor tassignmentnode.create(l,r : tnode);
|
|
|
+
|
|
|
+ begin
|
|
|
+ inherited create(assignn,l,r);
|
|
|
+ l.mark_write;
|
|
|
+ assigntype:=at_normal;
|
|
|
+ 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.getcopy : tnode;
|
|
|
+
|
|
|
+ var
|
|
|
+ n : tassignmentnode;
|
|
|
+
|
|
|
+ begin
|
|
|
+ n:=tassignmentnode(inherited getcopy);
|
|
|
+ n.assigntype:=assigntype;
|
|
|
+ getcopy:=n;
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
+ function tassignmentnode.det_resulttype:tnode;
|
|
|
+ var
|
|
|
+ hp : tnode;
|
|
|
+ useshelper : boolean;
|
|
|
+ original_size : longint;
|
|
|
+ begin
|
|
|
+ result:=nil;
|
|
|
+ resulttype:=voidtype;
|
|
|
+ original_size := 0;
|
|
|
+
|
|
|
+ { must be made unique }
|
|
|
+ set_unique(left);
|
|
|
+
|
|
|
+ resulttypepass(left);
|
|
|
+
|
|
|
+ if is_ansistring(left.resulttype.def) then
|
|
|
+ begin
|
|
|
+ { fold <ansistring>:=<ansistring>+<char|shortstring|ansistring> }
|
|
|
+ if (right.nodetype=addn) and
|
|
|
+ left.isequal(tbinarynode(right).left) and
|
|
|
+ { don't fold multiple concatenations else we could get trouble
|
|
|
+ with multiple uses of s
|
|
|
+ }
|
|
|
+ (tbinarynode(right).left.nodetype<>addn) and
|
|
|
+ (tbinarynode(right).right.nodetype<>addn) then
|
|
|
+ begin
|
|
|
+ { don't do a resulttypepass(right), since then the addnode }
|
|
|
+ { may insert typeconversions that make this optimization }
|
|
|
+ { opportunity quite difficult to detect (JM) }
|
|
|
+ resulttypepass(tbinarynode(right).left);
|
|
|
+ resulttypepass(tbinarynode(right).right);
|
|
|
+ if (is_char(tbinarynode(right).right.resulttype.def) or
|
|
|
+ is_shortstring(tbinarynode(right).right.resulttype.def) or
|
|
|
+ is_ansistring(tbinarynode(right).right.resulttype.def)) then
|
|
|
+ begin
|
|
|
+ { remove property flag so it'll not trigger an error }
|
|
|
+ exclude(left.flags,nf_isproperty);
|
|
|
+ { generate call to helper }
|
|
|
+ hp:=ccallparanode.create(tbinarynode(right).right,
|
|
|
+ ccallparanode.create(left,nil));
|
|
|
+ if is_char(tbinarynode(right).right.resulttype.def) then
|
|
|
+ result:=ccallnode.createintern('fpc_'+Tstringdef(left.resulttype.def).stringtypname+'_append_char',hp)
|
|
|
+ else if is_shortstring(tbinarynode(right).right.resulttype.def) then
|
|
|
+ result:=ccallnode.createintern('fpc_'+Tstringdef(left.resulttype.def).stringtypname+'_append_shortstring',hp)
|
|
|
+ else
|
|
|
+ result:=ccallnode.createintern('fpc_'+Tstringdef(left.resulttype.def).stringtypname+'_append_ansistring',hp);
|
|
|
+ tbinarynode(right).right:=nil;
|
|
|
+ left:=nil;
|
|
|
+ exit;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ if is_shortstring(left.resulttype.def) then
|
|
|
+ begin
|
|
|
+ { fold <shortstring>:=<shortstring>+<shortstring>,
|
|
|
+ <shortstring>+<char> is handled by an optimized node }
|
|
|
+ if (right.nodetype=addn) and
|
|
|
+ left.isequal(tbinarynode(right).left) and
|
|
|
+ { don't fold multiple concatenations else we could get trouble
|
|
|
+ with multiple uses of s }
|
|
|
+ (tbinarynode(right).left.nodetype<>addn) and
|
|
|
+ (tbinarynode(right).right.nodetype<>addn) then
|
|
|
+ begin
|
|
|
+ { don't do a resulttypepass(right), since then the addnode }
|
|
|
+ { may insert typeconversions that make this optimization }
|
|
|
+ { opportunity quite difficult to detect (JM) }
|
|
|
+ resulttypepass(tbinarynode(right).left);
|
|
|
+ resulttypepass(tbinarynode(right).right);
|
|
|
+ if is_shortstring(tbinarynode(right).right.resulttype.def) then
|
|
|
+ begin
|
|
|
+ { remove property flag so it'll not trigger an error }
|
|
|
+ exclude(left.flags,nf_isproperty);
|
|
|
+ { generate call to helper }
|
|
|
+ hp:=ccallparanode.create(tbinarynode(right).right,
|
|
|
+ ccallparanode.create(left,nil));
|
|
|
+ if is_shortstring(tbinarynode(right).right.resulttype.def) then
|
|
|
+ result:=ccallnode.createintern('fpc_shortstr_append_shortstr',hp);
|
|
|
+ tbinarynode(right).right:=nil;
|
|
|
+ left:=nil;
|
|
|
+ exit;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+
|
|
|
+ resulttypepass(right);
|
|
|
+ set_varstate(left,vs_assigned,[]);
|
|
|
+ set_varstate(right,vs_used,[vsf_must_be_valid]);
|
|
|
+ if codegenerror then
|
|
|
+ exit;
|
|
|
+
|
|
|
+ { tp procvar support, when we don't expect a procvar
|
|
|
+ then we need to call the procvar }
|
|
|
+ if (left.resulttype.def.deftype<>procvardef) then
|
|
|
+ maybe_call_procvar(right,true);
|
|
|
+
|
|
|
+ { assignments to formaldefs and open arrays aren't allowed }
|
|
|
+ if (left.resulttype.def.deftype=formaldef) or
|
|
|
+ is_open_array(left.resulttype.def) then
|
|
|
+ CGMessage(type_e_operator_not_allowed);
|
|
|
+
|
|
|
+ { test if node can be assigned, properties are allowed }
|
|
|
+ valid_for_assignment(left);
|
|
|
+
|
|
|
+ { assigning nil to a dynamic array clears the array }
|
|
|
+ if is_dynamic_array(left.resulttype.def) and
|
|
|
+ (right.nodetype=niln) then
|
|
|
+ begin
|
|
|
+ hp:=ccallparanode.create(caddrnode.create_internal
|
|
|
+ (crttinode.create(tstoreddef(left.resulttype.def),initrtti)),
|
|
|
+ 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.resulttype.def)) 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.resulttype.def) or
|
|
|
+ (right.resulttype.def.deftype=stringdef)) then
|
|
|
+ inserttypeconv(right,left.resulttype);
|
|
|
+ if right.resulttype.def.deftype=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.resulttype.def) and
|
|
|
+ (tstringconstnode(right).len > tstringdef(left.resulttype.def).len) then
|
|
|
+ cgmessage(type_w_string_too_long);
|
|
|
+ inserttypeconv(right,left.resulttype);
|
|
|
+ if (tstringconstnode(right).len=0) then
|
|
|
+ useshelper:=false;
|
|
|
+ end;
|
|
|
+ { rest is done in pass 1 (JM) }
|
|
|
+ if useshelper then
|
|
|
+ exit;
|
|
|
+ end
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ { get the size before the type conversion - check for all nodes }
|
|
|
+ if assigned(right.resulttype.def) and
|
|
|
+ (right.resulttype.def.deftype in [enumdef,orddef,floatdef]) and
|
|
|
+ (right.nodetype in [loadn,vecn,calln]) then
|
|
|
+ original_size := right.resulttype.def.size;
|
|
|
+ inserttypeconv(right,left.resulttype);
|
|
|
+ end;
|
|
|
+
|
|
|
+ { check if the assignment may cause a range check error }
|
|
|
+ { if its not explicit, and only if the values are }
|
|
|
+ { ordinals, enumdef and floatdef }
|
|
|
+ if (right.nodetype = typeconvn) and
|
|
|
+ not (nf_explicit in ttypeconvnode(right).flags) then
|
|
|
+ begin
|
|
|
+ if assigned(left.resulttype.def) and
|
|
|
+ (left.resulttype.def.deftype in [enumdef,orddef,floatdef]) and
|
|
|
+ not is_boolean(left.resulttype.def) then
|
|
|
+ begin
|
|
|
+ if (original_size <> 0) and
|
|
|
+ (left.resulttype.def.size < original_size) then
|
|
|
+ begin
|
|
|
+ if (cs_check_range in aktlocalswitches) then
|
|
|
+ Message(type_w_smaller_possible_range_check)
|
|
|
+ else
|
|
|
+ Message(type_h_smaller_possible_range_check);
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+
|
|
|
+ { call helpers for interface }
|
|
|
+ if is_interfacecom(left.resulttype.def) then
|
|
|
+ begin
|
|
|
+ hp:=ccallparanode.create(ctypeconvnode.create_internal
|
|
|
+ (right,voidpointertype),
|
|
|
+ ccallparanode.create(ctypeconvnode.create_internal
|
|
|
+ (left,voidpointertype),nil));
|
|
|
+ result:=ccallnode.createintern('fpc_intf_assign',hp);
|
|
|
+ left:=nil;
|
|
|
+ right:=nil;
|
|
|
+ exit;
|
|
|
+ end;
|
|
|
+ { call helpers for variant, they can contain non ref. counted types like
|
|
|
+ vararrays which must be really copied }
|
|
|
+ if left.resulttype.def.deftype=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);
|
|
|
+ left:=nil;
|
|
|
+ right:=nil;
|
|
|
+ exit;
|
|
|
+ end;
|
|
|
+
|
|
|
+ { check if local proc/func is assigned to procvar }
|
|
|
+ if right.resulttype.def.deftype=procvardef then
|
|
|
+ test_local_to_procvar(tprocvardef(right.resulttype.def),left.resulttype.def);
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
+ function tassignmentnode.pass_1 : tnode;
|
|
|
+ var
|
|
|
+ hp: tnode;
|
|
|
+ begin
|
|
|
+ result:=nil;
|
|
|
+ expectloc:=LOC_VOID;
|
|
|
+
|
|
|
+ firstpass(left);
|
|
|
+ firstpass(right);
|
|
|
+ { assignment to refcounted variable -> inc/decref }
|
|
|
+ if (not is_class(left.resulttype.def) and
|
|
|
+ left.resulttype.def.needs_inittable) then
|
|
|
+ include(current_procinfo.flags,pi_do_call);
|
|
|
+
|
|
|
+ if codegenerror then
|
|
|
+ exit;
|
|
|
+
|
|
|
+
|
|
|
+ if (is_shortstring(left.resulttype.def)) then
|
|
|
+ begin
|
|
|
+ if right.resulttype.def.deftype=stringdef then
|
|
|
+ begin
|
|
|
+ if (right.nodetype<>stringconstn) or
|
|
|
+ (tstringconstnode(right).len<>0) then
|
|
|
+ begin
|
|
|
+ if (cs_optimize in aktglobalswitches) and
|
|
|
+ (right.nodetype in [calln,blockn]) and
|
|
|
+ (left.nodetype = temprefn) and
|
|
|
+ is_shortstring(right.resulttype.def) and
|
|
|
+ not is_open_string(left.resulttype.def) and
|
|
|
+ (tstringdef(left.resulttype.def).len = 255) then
|
|
|
+ begin
|
|
|
+ { the blocknode case is handled in pass_2 at the temp }
|
|
|
+ { reference level (mainly for callparatemp) (JM) }
|
|
|
+ if (right.nodetype = calln) then
|
|
|
+ begin
|
|
|
+ tcallnode(right).funcretnode := left;
|
|
|
+ result := right;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ exit;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ hp:=ccallparanode.create
|
|
|
+ (right,
|
|
|
+ ccallparanode.create(cinlinenode.create
|
|
|
+ (in_high_x,false,left.getcopy),nil));
|
|
|
+ result:=ccallnode.createinternreturn('fpc_'+tstringdef(right.resulttype.def).stringtypname+'_to_shortstr',hp,left);
|
|
|
+ firstpass(result);
|
|
|
+ end;
|
|
|
+ left:=nil;
|
|
|
+ right:=nil;
|
|
|
+ exit;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+
|
|
|
+ if (cs_optimize in aktglobalswitches) and
|
|
|
+ (right.nodetype = calln) and
|
|
|
+ { left must be a temp, since otherwise as soon as you modify the }
|
|
|
+ { result, the current left node is modified and that one may }
|
|
|
+ { still be an argument to the function or even accessed in the }
|
|
|
+ { function }
|
|
|
+ (((left.nodetype = temprefn) and
|
|
|
+ paramanager.ret_in_param(right.resulttype.def,
|
|
|
+ tcallnode(right).procdefinition.proccalloption)) or
|
|
|
+ { there's special support for ansi/widestrings in the callnode }
|
|
|
+ is_ansistring(right.resulttype.def) or
|
|
|
+ is_widestring(right.resulttype.def)) then
|
|
|
+ begin
|
|
|
+ tcallnode(right).funcretnode := left;
|
|
|
+ result := right;
|
|
|
+ left := nil;
|
|
|
+ right := nil;
|
|
|
+ exit;
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
+ registersint:=left.registersint+right.registersint;
|
|
|
+ registersfpu:=max(left.registersfpu,right.registersfpu);
|
|
|
+{$ifdef SUPPORT_MMX}
|
|
|
+ registersmmx:=max(left.registersmmx,right.registersmmx);
|
|
|
+{$endif SUPPORT_MMX}
|
|
|
+ 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 resulttype pass.}
|
|
|
+ right.resulttype.def:=nil;
|
|
|
+ do_resulttypepass(right);
|
|
|
+ resulttypepass(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.det_resulttype:tnode;
|
|
|
+ begin
|
|
|
+ result:=nil;
|
|
|
+ resulttypepass(left);
|
|
|
+ resulttypepass(right);
|
|
|
+ set_varstate(left,vs_used,[vsf_must_be_valid]);
|
|
|
+ set_varstate(right,vs_used,[vsf_must_be_valid]);
|
|
|
+ if codegenerror then
|
|
|
+ exit;
|
|
|
+ resulttype:=left.resulttype;
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
+ function tarrayconstructorrangenode.pass_1 : tnode;
|
|
|
+ begin
|
|
|
+ firstpass(left);
|
|
|
+ firstpass(right);
|
|
|
+ expectloc:=LOC_CREFERENCE;
|
|
|
+ calcregisters(self,0,0,0);
|
|
|
+ result:=nil;
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
+{****************************************************************************
|
|
|
+ TARRAYCONSTRUCTORNODE
|
|
|
+*****************************************************************************}
|
|
|
+
|
|
|
+ constructor tarrayconstructornode.create(l,r : tnode);
|
|
|
+ begin
|
|
|
+ inherited create(arrayconstructorn,l,r);
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
+ function tarrayconstructornode.getcopy : tnode;
|
|
|
+ var
|
|
|
+ n : tarrayconstructornode;
|
|
|
+ begin
|
|
|
+ n:=tarrayconstructornode(inherited getcopy);
|
|
|
+ result:=n;
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
+ function tarrayconstructornode.det_resulttype:tnode;
|
|
|
+ var
|
|
|
+ htype : ttype;
|
|
|
+ hp : tarrayconstructornode;
|
|
|
+ len : longint;
|
|
|
+ varia : boolean;
|
|
|
+ begin
|
|
|
+ result:=nil;
|
|
|
+
|
|
|
+ { are we allowing array constructor? Then convert it to a set }
|
|
|
+ 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 }
|
|
|
+ htype.reset;
|
|
|
+ len:=0;
|
|
|
+ varia:=false;
|
|
|
+ if assigned(left) then
|
|
|
+ begin
|
|
|
+ hp:=self;
|
|
|
+ while assigned(hp) do
|
|
|
+ begin
|
|
|
+ resulttypepass(hp.left);
|
|
|
+ set_varstate(hp.left,vs_used,[vsf_must_be_valid]);
|
|
|
+ if (htype.def=nil) then
|
|
|
+ htype:=hp.left.resulttype
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ if ((nf_novariaallowed in flags) or (not varia)) and
|
|
|
+ (not equal_defs(htype.def,hp.left.resulttype.def)) then
|
|
|
+ begin
|
|
|
+ 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 setelementtype }
|
|
|
+ if not assigned(htype.def) or
|
|
|
+ varia or
|
|
|
+ is_array_of_const(htype.def) or
|
|
|
+ is_open_array(htype.def) then
|
|
|
+ htype:=voidtype;
|
|
|
+ resulttype.setdef(tarraydef.create(0,len-1,s32inttype));
|
|
|
+ tarraydef(resulttype.def).setelementtype(htype);
|
|
|
+ tarraydef(resulttype.def).IsConstructor:=true;
|
|
|
+ tarraydef(resulttype.def).IsVariant:=varia;
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
+ procedure tarrayconstructornode.force_type(tt:ttype);
|
|
|
+ var
|
|
|
+ hp : tarrayconstructornode;
|
|
|
+ begin
|
|
|
+ tarraydef(resulttype.def).setelementtype(tt);
|
|
|
+ tarraydef(resulttype.def).IsConstructor:=true;
|
|
|
+ tarraydef(resulttype.def).IsVariant:=false;
|
|
|
+ if assigned(left) then
|
|
|
+ begin
|
|
|
+ hp:=self;
|
|
|
+ while assigned(hp) do
|
|
|
+ begin
|
|
|
+ inserttypeconv(hp.left,tt);
|
|
|
+ hp:=tarrayconstructornode(hp.right);
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
+ procedure tarrayconstructornode.insert_typeconvs;
|
|
|
+ var
|
|
|
+ hp : tarrayconstructornode;
|
|
|
+ dovariant : boolean;
|
|
|
+ begin
|
|
|
+ dovariant:=(nf_forcevaria in flags) or tarraydef(resulttype.def).isvariant;
|
|
|
+ { only pass left tree, right tree contains next construct if any }
|
|
|
+ if assigned(left) then
|
|
|
+ begin
|
|
|
+ hp:=self;
|
|
|
+ while assigned(hp) do
|
|
|
+ begin
|
|
|
+ resulttypepass(hp.left);
|
|
|
+ { Insert typeconvs for array of const }
|
|
|
+ if dovariant then
|
|
|
+ begin
|
|
|
+ case hp.left.resulttype.def.deftype of
|
|
|
+ enumdef :
|
|
|
+ hp.left:=ctypeconvnode.create_internal(hp.left,s32inttype);
|
|
|
+ arraydef :
|
|
|
+ begin
|
|
|
+ if is_chararray(hp.left.resulttype.def) then
|
|
|
+ hp.left:=ctypeconvnode.create_internal(hp.left,charpointertype)
|
|
|
+ else
|
|
|
+ if is_widechararray(hp.left.resulttype.def) then
|
|
|
+ hp.left:=ctypeconvnode.create_internal(hp.left,widecharpointertype)
|
|
|
+ else
|
|
|
+ CGMessagePos1(hp.left.fileinfo,type_e_wrong_type_in_array_constructor,hp.left.resulttype.def.typename);
|
|
|
+ end;
|
|
|
+ orddef :
|
|
|
+ begin
|
|
|
+ if is_integer(hp.left.resulttype.def) and
|
|
|
+ not(is_64bitint(hp.left.resulttype.def)) then
|
|
|
+ hp.left:=ctypeconvnode.create(hp.left,s32inttype);
|
|
|
+ end;
|
|
|
+ floatdef :
|
|
|
+ if not(is_currency(hp.left.resulttype.def)) then
|
|
|
+ hp.left:=ctypeconvnode.create(hp.left,pbestrealtype^);
|
|
|
+ procvardef :
|
|
|
+ hp.left:=ctypeconvnode.create(hp.left,voidpointertype);
|
|
|
+ stringdef,
|
|
|
+ variantdef,
|
|
|
+ pointerdef,
|
|
|
+ classrefdef,
|
|
|
+ objectdef : ;
|
|
|
+ else
|
|
|
+ CGMessagePos1(hp.left.fileinfo,type_e_wrong_type_in_array_constructor,hp.left.resulttype.def.typename);
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ resulttypepass(hp.left);
|
|
|
+ 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 tarraydef(resulttype.def).isvariant;
|
|
|
+ result:=nil;
|
|
|
+ { Insert required type convs, this must be
|
|
|
+ done in pass 1, because the call must be
|
|
|
+ resulttypepassed 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;
|
|
|
+ calcregisters(self,0,0,0);
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
+ function tarrayconstructornode.docompare(p: tnode): boolean;
|
|
|
+
|
|
|
+ begin
|
|
|
+ docompare:=inherited docompare(p);
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
+{*****************************************************************************
|
|
|
+ TTYPENODE
|
|
|
+*****************************************************************************}
|
|
|
+
|
|
|
+ constructor ttypenode.create(t : ttype);
|
|
|
+ begin
|
|
|
+ inherited create(typen);
|
|
|
+ restype:=t;
|
|
|
+ allowed:=false;
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
+ constructor ttypenode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
|
|
|
+ begin
|
|
|
+ inherited ppuload(t,ppufile);
|
|
|
+ ppufile.gettype(restype);
|
|
|
+ allowed:=boolean(ppufile.getbyte);
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
+ procedure ttypenode.ppuwrite(ppufile:tcompilerppufile);
|
|
|
+ begin
|
|
|
+ inherited ppuwrite(ppufile);
|
|
|
+ ppufile.puttype(restype);
|
|
|
+ ppufile.putbyte(byte(allowed));
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
+ procedure ttypenode.buildderefimpl;
|
|
|
+ begin
|
|
|
+ inherited buildderefimpl;
|
|
|
+ restype.buildderef;
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
+ procedure ttypenode.derefimpl;
|
|
|
+ begin
|
|
|
+ inherited derefimpl;
|
|
|
+ restype.resolve;
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
+ function ttypenode.det_resulttype:tnode;
|
|
|
+ begin
|
|
|
+ result:=nil;
|
|
|
+ resulttype:=restype;
|
|
|
+ { check if it's valid }
|
|
|
+ if restype.def.deftype = 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_2.
|
|
|
+ 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.docompare(p: tnode): boolean;
|
|
|
+ begin
|
|
|
+ docompare :=
|
|
|
+ inherited docompare(p);
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
+{*****************************************************************************
|
|
|
+ TRTTINODE
|
|
|
+*****************************************************************************}
|
|
|
+
|
|
|
+
|
|
|
+ constructor trttinode.create(def:tstoreddef;rt:trttitype);
|
|
|
+ begin
|
|
|
+ inherited create(rttin);
|
|
|
+ rttidef:=def;
|
|
|
+ rttitype:=rt;
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
+ constructor trttinode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
|
|
|
+ begin
|
|
|
+ inherited ppuload(t,ppufile);
|
|
|
+ ppufile.getderef(rttidefderef);
|
|
|
+ rttitype:=trttitype(ppufile.getbyte);
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
+ procedure trttinode.ppuwrite(ppufile:tcompilerppufile);
|
|
|
+ begin
|
|
|
+ inherited ppuwrite(ppufile);
|
|
|
+ ppufile.putderef(rttidefderef);
|
|
|
+ ppufile.putbyte(byte(rttitype));
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
+ procedure trttinode.buildderefimpl;
|
|
|
+ begin
|
|
|
+ inherited buildderefimpl;
|
|
|
+ rttidefderef.build(rttidef);
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
+ procedure trttinode.derefimpl;
|
|
|
+ begin
|
|
|
+ inherited derefimpl;
|
|
|
+ rttidef:=tstoreddef(rttidefderef.resolve);
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
+ function trttinode.getcopy : tnode;
|
|
|
+ var
|
|
|
+ n : trttinode;
|
|
|
+ begin
|
|
|
+ n:=trttinode(inherited getcopy);
|
|
|
+ n.rttidef:=rttidef;
|
|
|
+ n.rttitype:=rttitype;
|
|
|
+ result:=n;
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
+ function trttinode.det_resulttype:tnode;
|
|
|
+ begin
|
|
|
+ { rtti information will be returned as a void pointer }
|
|
|
+ result:=nil;
|
|
|
+ resulttype:=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;
|
|
|
+
|
|
|
+
|
|
|
+begin
|
|
|
+ cloadnode:=tloadnode;
|
|
|
+ cassignmentnode:=tassignmentnode;
|
|
|
+ carrayconstructorrangenode:=tarrayconstructorrangenode;
|
|
|
+ carrayconstructornode:=tarrayconstructornode;
|
|
|
+ ctypenode:=ttypenode;
|
|
|
+ crttinode:=trttinode;
|
|
|
+end.
|
|
|
+{
|
|
|
+ $Log: nld.pas,v $
|
|
|
+ Revision 1.148 2005/03/28 13:36:15 florian
|
|
|
+ + variants are now assigned using fpc_variant_copy
|
|
|
+
|
|
|
+ Revision 1.147 2005/03/25 22:20:19 peter
|
|
|
+ * add hint when passing an uninitialized variable to a var parameter
|
|
|
+
|
|
|
+ Revision 1.146 2005/03/18 16:41:27 peter
|
|
|
+ don't check size differences for booleans
|
|
|
+
|
|
|
+ Revision 1.145 2005/02/14 17:13:06 peter
|
|
|
+ * truncate log
|
|
|
+
|
|
|
+ Revision 1.144 2005/02/11 16:25:26 peter
|
|
|
+ * fix IE with array of const in array of conts
|
|
|
+
|
|
|
+ Revision 1.143 2005/01/23 17:14:21 florian
|
|
|
+ + optimized code generation on sparc
|
|
|
+ + some stuff for pic code on sparc added
|
|
|
+
|
|
|
+}
|
florian