|
|
@@ -0,0 +1,696 @@
|
|
|
+{
|
|
|
+ $Id$
|
|
|
+ Copyright (c) 2000 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;
|
|
|
+interface
|
|
|
+
|
|
|
+ uses
|
|
|
+ node,symtable;
|
|
|
+
|
|
|
+ type
|
|
|
+ tloadnode = class(tunarynode)
|
|
|
+ symtableentry : psym;
|
|
|
+ symtable : psymtable;
|
|
|
+ constructor create(v : pvarsym;st : psymtable);virtual;
|
|
|
+ function getcopy : tnode;override;
|
|
|
+ function pass_1 : tnode;override;
|
|
|
+ end;
|
|
|
+
|
|
|
+ { different assignment types }
|
|
|
+ tassigntyp = (at_normal,at_plus,at_minus,at_star,at_slash);
|
|
|
+
|
|
|
+ tassignmentnode = class(tbinarynode)
|
|
|
+ assigntyp : tassigntyp;
|
|
|
+ constructor create(l,r : tnode);virtual;
|
|
|
+ function getcopy : tnode;override;
|
|
|
+ function pass_1 : tnode;override;
|
|
|
+ end;
|
|
|
+
|
|
|
+ tfuncretnode = class(tnode)
|
|
|
+ funcretprocinfo : pointer;
|
|
|
+{$IFDEF NEWST}
|
|
|
+ retsym : Psym;
|
|
|
+{$ELSE}
|
|
|
+ rettype : ttype;
|
|
|
+{$ENDIF}
|
|
|
+ constructor create;virtual;
|
|
|
+ function getcopy : tnode;override;
|
|
|
+ function pass_1 : tnode;override;
|
|
|
+ end;
|
|
|
+
|
|
|
+ tarrayconstructorrangenode = class(tbinarynode)
|
|
|
+ constructor create(l,r : tnode);virtual;
|
|
|
+ function pass_1 : tnode;override;
|
|
|
+ end;
|
|
|
+
|
|
|
+ tarrayconstructnode = class(tbinarynode)
|
|
|
+ constructdef : pdef;
|
|
|
+ constructor create(l,r : tnode);virtual;
|
|
|
+ function getcopy : tnode;
|
|
|
+ function pass_1 : tnode;override;
|
|
|
+ end;
|
|
|
+
|
|
|
+ ttypenode = class(tnode)
|
|
|
+ typenodetype : pdef;
|
|
|
+ typenodesym:ptypesym
|
|
|
+ constructor create(t : pdef;sym:ptypesym);virtual;
|
|
|
+ function getcopy : tnode;override;
|
|
|
+ function pass_1 : tnode;override;
|
|
|
+ end;
|
|
|
+
|
|
|
+ var
|
|
|
+ cloadnode : class of tloadnode;
|
|
|
+ cassignmentnode : class of tassignmentnode;
|
|
|
+ cfuncretnode : class of tfuncretnode;
|
|
|
+ carrayconstructorrangenode : class of tarrayconstructorrangenode;
|
|
|
+ carrayconstructnode : class of tarrayconstructnode;
|
|
|
+ ctypenode : class of ttypenode;
|
|
|
+
|
|
|
+ function gentypenode(t : pdef;sym:ptypesym) : ttypenode;
|
|
|
+
|
|
|
+implementation
|
|
|
+
|
|
|
+ uses
|
|
|
+ cutils,cobjects,verbose,globtype,globals,systems,
|
|
|
+ symconst,aasm,types,
|
|
|
+ htypechk,pass_1,
|
|
|
+ ncnv,cpubase
|
|
|
+{$ifdef newcg}
|
|
|
+ ,cgbase
|
|
|
+ ,tgobj
|
|
|
+ ,tgcpu
|
|
|
+{$else newcg}
|
|
|
+ ,hcodegen
|
|
|
+{$ifdef i386}
|
|
|
+ ,tgeni386
|
|
|
+{$endif}
|
|
|
+{$endif newcg}
|
|
|
+ ;
|
|
|
+
|
|
|
+ function genloadnode(v : pvarsym;st : psymtable) : tloadnode;
|
|
|
+
|
|
|
+ begin
|
|
|
+ genloadnode:=cloadnode.create(v,st);
|
|
|
+ end;
|
|
|
+
|
|
|
+ function gentypenode(t : pdef;sym:ptypesym) : ttypenode;
|
|
|
+ begin
|
|
|
+ gentypenode:=ctypenode.create(t,sym);
|
|
|
+ end;
|
|
|
+
|
|
|
+{*****************************************************************************
|
|
|
+ TLOADNODE
|
|
|
+*****************************************************************************}
|
|
|
+
|
|
|
+ constructor tloadnode.create(v : pvarsym;st : psymtable);
|
|
|
+
|
|
|
+ begin
|
|
|
+ inherited create(loadn,nil);
|
|
|
+ symtableentry:=v;
|
|
|
+ symtable:=st;
|
|
|
+ end;
|
|
|
+
|
|
|
+ function tloadnode.getcopy : tnode;
|
|
|
+
|
|
|
+ var
|
|
|
+ n : tloadnode;
|
|
|
+
|
|
|
+ begin
|
|
|
+ n:=tloadnode(inherited getcopy);
|
|
|
+ n.symtable:=symtable;
|
|
|
+ n.symtableentry:=symtableentry;
|
|
|
+ end;
|
|
|
+
|
|
|
+ function tloadnode.pass_1 : tnode;
|
|
|
+ var
|
|
|
+ p1 : tnode;
|
|
|
+ begin
|
|
|
+ if (symtable^.symtabletype=withsymtable) and
|
|
|
+ (pwithsymtable(symtable)^.direct_with) and
|
|
|
+ (symtableentry^.typ=varsym) then
|
|
|
+ begin
|
|
|
+ p1:=getcopy(ptree(pwithsymtable(symtable)^.withrefnode));
|
|
|
+ p1:=gensubscriptnode(pvarsym(symtableentry),p1);
|
|
|
+ putnode(p);
|
|
|
+ p:=p1;
|
|
|
+ firstpass(p);
|
|
|
+ exit;
|
|
|
+ end;
|
|
|
+
|
|
|
+ location.loc:=LOC_REFERENCE;
|
|
|
+ registers32:=0;
|
|
|
+ registersfpu:=0;
|
|
|
+{$ifdef SUPPORT_MMX}
|
|
|
+ registersmmx:=0;
|
|
|
+{$endif SUPPORT_MMX}
|
|
|
+ { handle first absolute as it will replace the symtableentry }
|
|
|
+ if symtableentry^.typ=absolutesym then
|
|
|
+ begin
|
|
|
+ resulttype:=pabsolutesym(symtableentry)^.vartype.def;
|
|
|
+ { replace the symtableentry when it points to a var, else
|
|
|
+ we are finished }
|
|
|
+ if pabsolutesym(symtableentry)^.abstyp=tovar then
|
|
|
+ begin
|
|
|
+ symtableentry:=pabsolutesym(symtableentry)^.ref;
|
|
|
+ symtable:=symtableentry^.owner;
|
|
|
+ is_absolute:=true;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ exit;
|
|
|
+ end;
|
|
|
+ case symtableentry^.typ of
|
|
|
+ funcretsym :
|
|
|
+ begin
|
|
|
+ p1:=genzeronode(funcretn);
|
|
|
+ p1.funcretprocinfo:=pprocinfo(pfuncretsym(symtableentry)^.funcretprocinfo);
|
|
|
+ p1.rettype:=pfuncretsym(symtableentry)^.rettype;
|
|
|
+ firstpass(p1);
|
|
|
+ { if it's refered as absolute then we need to have the
|
|
|
+ type of the absolute instead of the function return,
|
|
|
+ the function return is then also assigned }
|
|
|
+ if is_absolute then
|
|
|
+ begin
|
|
|
+ pprocinfo(p1.funcretprocinfo)^.funcret_state:=vs_assigned;
|
|
|
+ p1.resulttype:=resulttype;
|
|
|
+ end;
|
|
|
+ putnode(p);
|
|
|
+ p:=p1;
|
|
|
+ end;
|
|
|
+ constsym:
|
|
|
+ begin
|
|
|
+ if pconstsym(symtableentry)^.consttyp=constresourcestring then
|
|
|
+ begin
|
|
|
+ resulttype:=cansistringdef;
|
|
|
+ { we use ansistrings so no fast exit here }
|
|
|
+ if assigned(procinfo) then
|
|
|
+ procinfo^.no_fast_exit:=true;
|
|
|
+ location.loc:=LOC_MEM;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ internalerror(22799);
|
|
|
+ end;
|
|
|
+ varsym :
|
|
|
+ begin
|
|
|
+ { if it's refered by absolute then it's used }
|
|
|
+ if is_absolute then
|
|
|
+ pvarsym(symtableentry)^.varstate:=vs_used
|
|
|
+ else
|
|
|
+ if (resulttype=nil) then
|
|
|
+ resulttype:=pvarsym(symtableentry)^.vartype.def;
|
|
|
+ if (symtable^.symtabletype in [parasymtable,localsymtable]) and
|
|
|
+ (lexlevel>symtable^.symtablelevel) then
|
|
|
+ begin
|
|
|
+ { if the variable is in an other stackframe then we need
|
|
|
+ a register to dereference }
|
|
|
+ if (symtable^.symtablelevel)>0 then
|
|
|
+ begin
|
|
|
+ registers32:=1;
|
|
|
+ { further, the variable can't be put into a register }
|
|
|
+ pvarsym(symtableentry)^.varoptions:=
|
|
|
+ pvarsym(symtableentry)^.varoptions-[vo_fpuregable,vo_regable];
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ if (pvarsym(symtableentry)^.varspez=vs_const) then
|
|
|
+ location.loc:=LOC_MEM;
|
|
|
+ { we need a register for call by reference parameters }
|
|
|
+ if (pvarsym(symtableentry)^.varspez in [vs_var,vs_out]) or
|
|
|
+ ((pvarsym(symtableentry)^.varspez=vs_const) and
|
|
|
+ push_addr_param(pvarsym(symtableentry)^.vartype.def)) or
|
|
|
+ { call by value open arrays are also indirect addressed }
|
|
|
+ is_open_array(pvarsym(symtableentry)^.vartype.def) then
|
|
|
+ registers32:=1;
|
|
|
+ if symtable^.symtabletype=withsymtable then
|
|
|
+ inc(registers32);
|
|
|
+
|
|
|
+ if ([vo_is_thread_var,vo_is_dll_var]*pvarsym(symtableentry)^.varoptions)<>[] then
|
|
|
+ registers32:=1;
|
|
|
+ { a class variable is a pointer !!!
|
|
|
+ yes, but we have to resolve the reference in an
|
|
|
+ appropriate tree node (FK)
|
|
|
+
|
|
|
+ if (pvarsym(symtableentry)^.definition^.deftype=objectdef) and
|
|
|
+ ((pobjectdef(pvarsym(symtableentry)^.definition)^.options and oo_is_class)<>0) then
|
|
|
+ registers32:=1;
|
|
|
+ }
|
|
|
+
|
|
|
+ { count variable references }
|
|
|
+
|
|
|
+ { this will create problem with local var set by
|
|
|
+ under_procedures
|
|
|
+ if (assigned(pvarsym(symtableentry)^.owner) and assigned(aktprocsym)
|
|
|
+ and ((pvarsym(symtableentry)^.owner = aktprocsym^.definition^.localst)
|
|
|
+ or (pvarsym(symtableentry)^.owner = aktprocsym^.definition^.localst))) then }
|
|
|
+ if t_times<1 then
|
|
|
+ inc(pvarsym(symtableentry)^.refs)
|
|
|
+ else
|
|
|
+ inc(pvarsym(symtableentry)^.refs,t_times);
|
|
|
+ end;
|
|
|
+ typedconstsym :
|
|
|
+ if not is_absolute then
|
|
|
+ resulttype:=ptypedconstsym(symtableentry)^.typedconsttype.def;
|
|
|
+ procsym :
|
|
|
+ begin
|
|
|
+ if assigned(pprocsym(symtableentry)^.definition^.nextoverloaded) then
|
|
|
+ CGMessage(parser_e_no_overloaded_procvars);
|
|
|
+ resulttype:=pprocsym(symtableentry)^.definition;
|
|
|
+ { if the owner of the procsym is a object, }
|
|
|
+ { left must be set, if left isn't set }
|
|
|
+ { it can be only self }
|
|
|
+ { this code is only used in TP procvar mode }
|
|
|
+ if (m_tp_procvar in aktmodeswitches) and
|
|
|
+ not(assigned(left)) and
|
|
|
+ (pprocsym(symtableentry)^.owner^.symtabletype=objectsymtable) then
|
|
|
+ left:=genselfnode(pobjectdef(symtableentry^.owner^.defowner));
|
|
|
+ { method pointer ? }
|
|
|
+ if assigned(left) then
|
|
|
+ begin
|
|
|
+ firstpass(left);
|
|
|
+ registers32:=max(registers32,left.registers32);
|
|
|
+ registersfpu:=max(registersfpu,left.registersfpu);
|
|
|
+ {$ifdef SUPPORT_MMX}
|
|
|
+ registersmmx:=max(registersmmx,left.registersmmx);
|
|
|
+ {$endif SUPPORT_MMX}
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ else
|
|
|
+ internalerror(3);
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
+{*****************************************************************************
|
|
|
+ TASSIGNMENTNODE
|
|
|
+*****************************************************************************}
|
|
|
+
|
|
|
+ constructor tassignmentnode.create(l,r : tnode);
|
|
|
+
|
|
|
+ begin
|
|
|
+ inherited create(assignn,l,r);
|
|
|
+ assigntype:=at_normal;
|
|
|
+ end;
|
|
|
+
|
|
|
+ function tassignmentnode.getcopy : tnode;
|
|
|
+
|
|
|
+ var
|
|
|
+ n : tassignmentnode;
|
|
|
+
|
|
|
+ begin
|
|
|
+ n:=tassignmentnode(inherited getcopy);
|
|
|
+ n.assigntype:=assigntype;
|
|
|
+ getcopy:=n;
|
|
|
+ end;
|
|
|
+
|
|
|
+ function tassignmentnode.pass_1 : tnode;
|
|
|
+{$ifdef newoptimizations2}
|
|
|
+ var
|
|
|
+ hp : tnode;
|
|
|
+{$endif newoptimizations2}
|
|
|
+ begin
|
|
|
+ { must be made unique }
|
|
|
+ set_unique(left);
|
|
|
+
|
|
|
+ { set we the function result? }
|
|
|
+ set_funcret_is_valid(left);
|
|
|
+
|
|
|
+ firstpass(left);
|
|
|
+ set_varstate(left,false);
|
|
|
+ if codegenerror then
|
|
|
+ exit;
|
|
|
+
|
|
|
+ { assignements to open arrays aren't allowed }
|
|
|
+ if is_open_array(left.resulttype) then
|
|
|
+ CGMessage(type_e_mismatch);
|
|
|
+
|
|
|
+ { test if we can avoid copying string to temp
|
|
|
+ as in s:=s+...; (PM) }
|
|
|
+{$ifdef dummyi386}
|
|
|
+ if ((right.treetype=addn) or (right.treetype=subn)) and
|
|
|
+ equal_trees(left,right.left) and
|
|
|
+ (ret_in_acc(left.resulttype)) and
|
|
|
+ (not cs_rangechecking in aktmoduleswitches^) then
|
|
|
+ begin
|
|
|
+ disposetree(right.left);
|
|
|
+ hp:=right;
|
|
|
+ right:=right.right;
|
|
|
+ if hp.treetype=addn then
|
|
|
+ assigntyp:=at_plus
|
|
|
+ else
|
|
|
+ assigntyp:=at_minus;
|
|
|
+ putnode(hp);
|
|
|
+ end;
|
|
|
+ if assigntyp<>at_normal then
|
|
|
+ begin
|
|
|
+ { for fpu type there is no faster way }
|
|
|
+ if is_fpu(left.resulttype) then
|
|
|
+ case assigntyp of
|
|
|
+ at_plus : right:=gennode(addn,getcopy(left),right);
|
|
|
+ at_minus : right:=gennode(subn,getcopy(left),right);
|
|
|
+ at_star : right:=gennode(muln,getcopy(left),right);
|
|
|
+ at_slash : right:=gennode(slashn,getcopy(left),right);
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+{$endif i386}
|
|
|
+ firstpass(right);
|
|
|
+ set_varstate(right,true);
|
|
|
+ if codegenerror then
|
|
|
+ exit;
|
|
|
+
|
|
|
+ { some string functions don't need conversion, so treat them separatly }
|
|
|
+ if is_shortstring(left.resulttype) and (assigned(right.resulttype)) then
|
|
|
+ begin
|
|
|
+ if not (is_shortstring(right.resulttype) or
|
|
|
+ is_ansistring(right.resulttype) or
|
|
|
+ is_char(right.resulttype)) then
|
|
|
+ begin
|
|
|
+ right:=gentypeconvnode(right,left.resulttype);
|
|
|
+ firstpass(right);
|
|
|
+ if codegenerror then
|
|
|
+ exit;
|
|
|
+ end;
|
|
|
+ { we call STRCOPY }
|
|
|
+ procinfo^.flags:=procinfo^.flags or pi_do_call;
|
|
|
+ { test for s:=s+anything ... }
|
|
|
+ { the problem is for
|
|
|
+ s:=s+s+s;
|
|
|
+ this is broken here !! }
|
|
|
+{$ifdef newoptimizations2}
|
|
|
+ { the above is fixed now, but still problem with s := s + f(); if }
|
|
|
+ { f modifies s (bad programming, so only enable if uncertain }
|
|
|
+ { optimizations are on) (JM) }
|
|
|
+ if (cs_UncertainOpts in aktglobalswitches) then
|
|
|
+ begin
|
|
|
+ hp := right;
|
|
|
+ while hp.treetype=addn do hp:=hp.left;
|
|
|
+ if equal_trees(left,hp) and
|
|
|
+ not multiple_uses(left,right) then
|
|
|
+ begin
|
|
|
+ concat_string:=true;
|
|
|
+ hp:=right;
|
|
|
+ while hp.treetype=addn do
|
|
|
+ begin
|
|
|
+ hp.use_strconcat:=true;
|
|
|
+ hp:=hp.left;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+{$endif newoptimizations2}
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ right:=gentypeconvnode(right,left.resulttype);
|
|
|
+ firstpass(right);
|
|
|
+ if codegenerror then
|
|
|
+ exit;
|
|
|
+ end;
|
|
|
+
|
|
|
+ { test if node can be assigned, properties are allowed }
|
|
|
+ valid_for_assign(left,true);
|
|
|
+
|
|
|
+ { check if local proc/func is assigned to procvar }
|
|
|
+ if right.resulttype^.deftype=procvardef then
|
|
|
+ test_local_to_procvar(pprocvardef(right.resulttype),left.resulttype);
|
|
|
+
|
|
|
+ resulttype:=voiddef;
|
|
|
+ {
|
|
|
+ registers32:=max(left.registers32,right.registers32);
|
|
|
+ registersfpu:=max(left.registersfpu,right.registersfpu);
|
|
|
+ }
|
|
|
+ registers32:=left.registers32+right.registers32;
|
|
|
+ registersfpu:=max(left.registersfpu,right.registersfpu);
|
|
|
+{$ifdef SUPPORT_MMX}
|
|
|
+ registersmmx:=max(left.registersmmx,right.registersmmx);
|
|
|
+{$endif SUPPORT_MMX}
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
+{*****************************************************************************
|
|
|
+ TFUNCRETNODE
|
|
|
+*****************************************************************************}
|
|
|
+
|
|
|
+ constructor tfuncretnode.create;
|
|
|
+
|
|
|
+ begin
|
|
|
+ inherited create(tfuncretn);
|
|
|
+ funcretprocinfo:=nil;
|
|
|
+ n.rettype:=nil;
|
|
|
+ end;
|
|
|
+
|
|
|
+ function tfuncretnode.getcopy : tnode;
|
|
|
+
|
|
|
+ var
|
|
|
+ n : tfuncretnode;
|
|
|
+
|
|
|
+ begin
|
|
|
+ n:=tfuncretnode(inherited getcopy);
|
|
|
+ n.funcretprocinfo:=funcretprocinfo;
|
|
|
+{$ifdef NEWST}
|
|
|
+ n.retsym:=retsym;
|
|
|
+{$else NEWST}
|
|
|
+ n.rettype:=rettype;
|
|
|
+{$endif NEWST}
|
|
|
+ getcopy:=n;
|
|
|
+ end;
|
|
|
+
|
|
|
+ function tfuncretnode.pass_1 : tnode;
|
|
|
+ begin
|
|
|
+ resulttype:=rettype.def;
|
|
|
+ location.loc:=LOC_REFERENCE;
|
|
|
+ if ret_in_param(rettype.def) or
|
|
|
+ (procinfo<>pprocinfo(funcretprocinfo)) then
|
|
|
+ registers32:=1;
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
+{*****************************************************************************
|
|
|
+ TARRAYCONSTRUCTRANGENODE
|
|
|
+*****************************************************************************}
|
|
|
+
|
|
|
+ constructor tarrayconstructrangenode.create(l,r : tnode);
|
|
|
+
|
|
|
+ begin
|
|
|
+ inherited create(arrayconstructn,l,r);
|
|
|
+ end;
|
|
|
+
|
|
|
+ function tarrayconstructrangenode.pass_1 : tnode;
|
|
|
+ begin
|
|
|
+ firstpass(left);
|
|
|
+ left.set_varstate(true);
|
|
|
+ firstpass(right);
|
|
|
+ right.set_varstate(true);
|
|
|
+ calcregisters(p,0,0,0);
|
|
|
+ resulttype:=left.resulttype;
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
+{****************************************************************************
|
|
|
+ TARRAYCONSTRUCTNODE
|
|
|
+*****************************************************************************}
|
|
|
+
|
|
|
+ constructor tarrayconstrucnode.create(l,r : tnode);
|
|
|
+
|
|
|
+ begin
|
|
|
+ inherited create(arrayconstructnode,l,r);
|
|
|
+ constructdef:=nil;
|
|
|
+ end;
|
|
|
+
|
|
|
+ function tarrayconstrucnode.getcopy : tnode;
|
|
|
+
|
|
|
+ var
|
|
|
+ n : tarrayconstructnode;
|
|
|
+
|
|
|
+ begin
|
|
|
+ n:=tarrayconstructnode(inherited getcopy);
|
|
|
+ n.constructdef:=constructdef;
|
|
|
+ end;
|
|
|
+
|
|
|
+ function tarrayconstructnode.pass_1 : tnode;
|
|
|
+ var
|
|
|
+ pd : pdef;
|
|
|
+ thp,
|
|
|
+ chp,
|
|
|
+ hp : tnode;
|
|
|
+ len : longint;
|
|
|
+ varia : boolean;
|
|
|
+ begin
|
|
|
+ { are we allowing array constructor? Then convert it to a set }
|
|
|
+ if not allow_array_constructor then
|
|
|
+ begin
|
|
|
+ arrayconstructor_to_set(p);
|
|
|
+ firstpass(p);
|
|
|
+ exit;
|
|
|
+ end;
|
|
|
+ { only pass left tree, right tree contains next construct if any }
|
|
|
+ pd:=constructdef;
|
|
|
+ len:=0;
|
|
|
+ varia:=false;
|
|
|
+ if assigned(left) then
|
|
|
+ begin
|
|
|
+ hp:=p;
|
|
|
+ while assigned(hp) do
|
|
|
+ begin
|
|
|
+ firstpass(hp.left);
|
|
|
+ hp.left.set_varstate(true);
|
|
|
+ if (not get_para_resulttype) and (not novariaallowed) then
|
|
|
+ begin
|
|
|
+ case hp.left.resulttype^.deftype of
|
|
|
+ enumdef :
|
|
|
+ begin
|
|
|
+ hp.left:=gentypeconvnode(hp.left,s32bitdef);
|
|
|
+ firstpass(hp.left);
|
|
|
+ end;
|
|
|
+ orddef :
|
|
|
+ begin
|
|
|
+ if is_integer(hp.left.resulttype) and
|
|
|
+ not(is_64bitint(hp.left.resulttype)) then
|
|
|
+ begin
|
|
|
+ hp.left:=gentypeconvnode(hp.left,s32bitdef);
|
|
|
+ firstpass(hp.left);
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ floatdef :
|
|
|
+ begin
|
|
|
+ hp.left:=gentypeconvnode(hp.left,bestrealdef^);
|
|
|
+ firstpass(hp.left);
|
|
|
+ end;
|
|
|
+ stringdef :
|
|
|
+ begin
|
|
|
+ if cargs then
|
|
|
+ begin
|
|
|
+ hp.left:=gentypeconvnode(hp.left,charpointerdef);
|
|
|
+ firstpass(hp.left);
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ procvardef :
|
|
|
+ begin
|
|
|
+ hp.left:=gentypeconvnode(hp.left,voidpointerdef);
|
|
|
+ firstpass(hp.left);
|
|
|
+ end;
|
|
|
+ pointerdef,
|
|
|
+ classrefdef,
|
|
|
+ objectdef : ;
|
|
|
+ else
|
|
|
+ CGMessagePos1(hp.left.fileinfo,type_e_wrong_type_in_array_constructor,hp.left.resulttype^.typename);
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ if (pd=nil) then
|
|
|
+ pd:=hp.left.resulttype
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ if ((novariaallowed) or (not varia)) and
|
|
|
+ (not is_equal(pd,hp.left.resulttype)) then
|
|
|
+ begin
|
|
|
+ { if both should be equal try inserting a conversion }
|
|
|
+ if novariaallowed then
|
|
|
+ begin
|
|
|
+ hp.left:=gentypeconvnode(hp.left,pd);
|
|
|
+ firstpass(hp.left);
|
|
|
+ end;
|
|
|
+ varia:=true;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ inc(len);
|
|
|
+ hp:=hp.right;
|
|
|
+ end;
|
|
|
+ { swap the tree for cargs }
|
|
|
+ if cargs and (not cargswap) then
|
|
|
+ begin
|
|
|
+ chp:=nil;
|
|
|
+ hp:=p;
|
|
|
+ while assigned(hp) do
|
|
|
+ begin
|
|
|
+ thp:=hp.right;
|
|
|
+ hp.right:=chp;
|
|
|
+ chp:=hp;
|
|
|
+ hp:=thp;
|
|
|
+ end;
|
|
|
+ p:=chp;
|
|
|
+ cargs:=true;
|
|
|
+ cargswap:=true;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ calcregisters(p,0,0,0);
|
|
|
+ { looks a little bit dangerous to me }
|
|
|
+ { len-1 gives problems with is_open_array if len=0, }
|
|
|
+ { is_open_array checks now for isconstructor (FK) }
|
|
|
+ { if no type is set then we set the type to voiddef to overcome a
|
|
|
+ 0 addressing }
|
|
|
+ if not assigned(pd) then
|
|
|
+ pd:=voiddef;
|
|
|
+ { skip if already done ! (PM) }
|
|
|
+ if not assigned(resulttype) or
|
|
|
+ (resulttype^.deftype<>arraydef) or
|
|
|
+ not parraydef(resulttype)^.IsConstructor or
|
|
|
+ (parraydef(resulttype)^.lowrange<>0) or
|
|
|
+ (parraydef(resulttype)^.highrange<>len-1) then
|
|
|
+ resulttype:=new(parraydef,init(0,len-1,s32bitdef));
|
|
|
+ parraydef(resulttype)^.elementtype.def:=pd;
|
|
|
+ parraydef(resulttype)^.IsConstructor:=true;
|
|
|
+ parraydef(resulttype)^.IsVariant:=varia;
|
|
|
+ location.loc:=LOC_MEM;
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
+{*****************************************************************************
|
|
|
+ TTYPENODE
|
|
|
+*****************************************************************************}
|
|
|
+
|
|
|
+ constructor ttypenode.create(t : pdef;sym:ptypesym);
|
|
|
+
|
|
|
+ begin
|
|
|
+ inherited create(typen);
|
|
|
+ resulttype:=generrordef;
|
|
|
+ typenodetype:=t;
|
|
|
+ typenodesym:=sym;
|
|
|
+ end;
|
|
|
+
|
|
|
+ function ttypenode.getcopy : tnode;
|
|
|
+
|
|
|
+ var
|
|
|
+ n : ttypenode;
|
|
|
+
|
|
|
+ begin
|
|
|
+ n:=ttypenode(inherited getcopy);
|
|
|
+ n.typenodetype:=typenodetype;
|
|
|
+ n.typenodesym:=typenodesym;
|
|
|
+ end;
|
|
|
+
|
|
|
+ function ttypenode.pass_1 : tnode;
|
|
|
+ begin
|
|
|
+ pass_1:=nil;
|
|
|
+ { do nothing, resulttype is already set }
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
+begin
|
|
|
+ cloadnode:=tloadnode;
|
|
|
+ cassignmentnode:=tassignmentnode;
|
|
|
+ cfuncretnode:=tfuncretnode;
|
|
|
+ carrayconstructorrangenode:=tarrayconstructorrangenode;
|
|
|
+ carrayconstructnode:=tarrayconstructnode;
|
|
|
+ ctypenode:=ttypenode;
|
|
|
+end.
|
|
|
+{
|
|
|
+ $Log$
|
|
|
+ Revision 1.1 2000-09-25 14:55:05 florian
|
|
|
+ * initial revision
|
|
|
+
|
|
|
+}
|
florian