123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905 |
- {
- $Id$
- Copyright (c) 2000 by Florian Klaempfl
- Type checking and register allocation for memory related nodes
- This program is free software; you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2 of the License, or
- (at your option) any later version.
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
- ****************************************************************************
- }
- unit nmem;
- {$i defines.inc}
- interface
- uses
- node,
- symtype,symdef,symsym,symtable,
- cpubase;
- type
- tloadvmtnode = class(tunarynode)
- constructor create(l : tnode);virtual;
- function pass_1 : tnode;override;
- end;
- thnewnode = class(tnode)
- constructor create;virtual;
- function pass_1 : tnode;override;
- end;
- tnewnode = class(tunarynode)
- constructor create(l : tnode);virtual;
- function pass_1 : tnode;override;
- end;
- thdisposenode = class(tunarynode)
- constructor create(l : tnode);virtual;
- function pass_1 : tnode;override;
- end;
- tsimplenewdisposenode = class(tunarynode)
- constructor create(n : tnodetype;l : tnode);
- function pass_1 : tnode;override;
- end;
- taddrnode = class(tunarynode)
- constructor create(l : tnode);virtual;
- function pass_1 : tnode;override;
- end;
- tdoubleaddrnode = class(tunarynode)
- constructor create(l : tnode);virtual;
- function pass_1 : tnode;override;
- end;
- tderefnode = class(tunarynode)
- constructor create(l : tnode);virtual;
- function pass_1 : tnode;override;
- end;
- tsubscriptnode = class(tunarynode)
- vs : pvarsym;
- constructor create(varsym : psym;l : tnode);virtual;
- function getcopy : tnode;override;
- function pass_1 : tnode;override;
- end;
- tvecnode = class(tbinarynode)
- constructor create(l,r : tnode);virtual;
- function pass_1 : tnode;override;
- end;
- tselfnode = class(tnode)
- constructor create(_class : pdef);virtual;
- function pass_1 : tnode;override;
- end;
- twithnode = class(tbinarynode)
- withsymtable : pwithsymtable;
- tablecount : longint;
- withreference:preference;
- constructor create(symtable : pwithsymtable;l,r : tnode;count : longint);virtual;
- destructor destroy;override;
- function getcopy : tnode;override;
- function pass_1 : tnode;override;
- end;
- function gensubscriptnode(varsym : pvarsym;l : tnode) : tsubscriptnode;
- function genselfnode(_class : pdef) : tselfnode;
- function genwithnode(symtable:pwithsymtable;l,r : tnode;count : longint) : twithnode;
- var
- cloadvmtnode : class of tloadvmtnode;
- chnewnode : class of thnewnode;
- cnewnode : class of tnewnode;
- chdisposenode : class of thdisposenode;
- csimplenewdisposenode : class of tsimplenewdisposenode;
- caddrnode : class of taddrnode;
- cdoubleaddrnode : class of tdoubleaddrnode;
- cderefnode : class of tderefnode;
- csubscriptnode : class of tsubscriptnode;
- cvecnode : class of tvecnode;
- cselfnode : class of tselfnode;
- cwithnode : class of twithnode;
- implementation
- uses
- globtype,systems,
- cutils,cobjects,verbose,globals,
- symconst,symbase,aasm,types,
- htypechk,pass_1,ncal,nld,ncon,ncnv
- {$ifdef newcg}
- ,cgbase
- {$else newcg}
- ,hcodegen
- {$endif newcg}
- ;
- function genselfnode(_class : pdef) : tselfnode;
- begin
- genselfnode:=cselfnode.create(_class);
- end;
- function genwithnode(symtable : pwithsymtable;l,r : tnode;count : longint) : twithnode;
- begin
- genwithnode:=cwithnode.create(symtable,l,r,count);
- end;
- function gensubscriptnode(varsym : pvarsym;l : tnode) : tsubscriptnode;
- begin
- gensubscriptnode:=csubscriptnode.create(varsym,l);
- end;
- {*****************************************************************************
- TLOADVMTNODE
- *****************************************************************************}
- constructor tloadvmtnode.create(l : tnode);
- begin
- inherited create(loadvmtn,l);
- end;
- function tloadvmtnode.pass_1 : tnode;
- begin
- pass_1:=nil;
- registers32:=1;
- location.loc:=LOC_REGISTER;
- end;
- {*****************************************************************************
- THNEWNODE
- *****************************************************************************}
- constructor thnewnode.create;
- begin
- inherited create(hnewn);
- end;
- function thnewnode.pass_1 : tnode;
- begin
- pass_1:=nil;
- end;
- {*****************************************************************************
- TNEWNODE
- *****************************************************************************}
- constructor tnewnode.create(l : tnode);
- begin
- inherited create(newn,l);
- end;
- function tnewnode.pass_1 : tnode;
- begin
- pass_1:=nil;
- if assigned(left) then
- firstpass(left);
- if codegenerror then
- exit;
- if assigned(left) then
- begin
- registers32:=left.registers32;
- registersfpu:=left.registersfpu;
- {$ifdef SUPPORT_MMX}
- registersmmx:=left.registersmmx;
- {$endif SUPPORT_MMX}
- end;
- { result type is already set }
- procinfo^.flags:=procinfo^.flags or pi_do_call;
- if assigned(left) then
- location.loc:=LOC_REGISTER
- else
- location.loc:=LOC_REFERENCE;
- end;
- {*****************************************************************************
- THDISPOSENODE
- *****************************************************************************}
- constructor thdisposenode.create(l : tnode);
- begin
- inherited create(hdisposen,l);
- end;
- function thdisposenode.pass_1 : tnode;
- begin
- pass_1:=nil;
- firstpass(left);
- if codegenerror then
- exit;
- registers32:=left.registers32;
- registersfpu:=left.registersfpu;
- {$ifdef SUPPORT_MMX}
- registersmmx:=left.registersmmx;
- {$endif SUPPORT_MMX}
- if registers32<1 then
- registers32:=1;
- {
- if left.location.loc<>LOC_REFERENCE then
- CGMessage(cg_e_illegal_expression);
- }
- if left.location.loc=LOC_CREGISTER then
- inc(registers32);
- location.loc:=LOC_REFERENCE;
- resulttype:=ppointerdef(left.resulttype)^.pointertype.def;
- end;
- {*****************************************************************************
- TSIMPLENEWDISPOSENODE
- *****************************************************************************}
- constructor tsimplenewdisposenode.create(n : tnodetype;l : tnode);
- begin
- inherited create(n,l);
- end;
- function tsimplenewdisposenode.pass_1 : tnode;
- begin
- pass_1:=nil;
- { this cannot be in a register !! }
- make_not_regable(left);
- firstpass(left);
- if codegenerror then
- exit;
- { check the type }
- if left.resulttype=nil then
- left.resulttype:=generrordef;
- if (left.resulttype^.deftype<>pointerdef) then
- CGMessage1(type_e_pointer_type_expected,left.resulttype^.typename);
- if (left.location.loc<>LOC_REFERENCE) {and
- (left.location.loc<>LOC_CREGISTER)} then
- CGMessage(cg_e_illegal_expression);
- registers32:=left.registers32;
- registersfpu:=left.registersfpu;
- {$ifdef SUPPORT_MMX}
- registersmmx:=left.registersmmx;
- {$endif SUPPORT_MMX}
- resulttype:=voiddef;
- procinfo^.flags:=procinfo^.flags or pi_do_call;
- end;
- {*****************************************************************************
- TADDRNODE
- *****************************************************************************}
- constructor taddrnode.create(l : tnode);
- begin
- inherited create(addrn,l);
- end;
- function taddrnode.pass_1 : tnode;
- var
- hp : tnode;
- hp2 : pparaitem;
- hp3 : pabstractprocdef;
- begin
- pass_1:=nil;
- make_not_regable(left);
- if not(assigned(resulttype)) then
- begin
- { tp @procvar support (type of @procvar is a void pointer)
- Note: we need to leave the addrn in the tree,
- else we can't see the difference between @procvar and procvar.
- we set the procvarload flag so a secondpass does nothing for
- this node (PFV) }
- if (m_tp_procvar in aktmodeswitches) then
- begin
- hp:=left;
- case hp.nodetype of
- calln :
- begin
- { is it a procvar? }
- hp:=tcallnode(hp).right;
- if assigned(hp) then
- begin
- { remove calln node }
- tcallnode(left).right:=nil;
- left.free;
- left:=hp;
- firstpass(hp);
- include(flags,nf_procvarload);
- end;
- end;
- loadn,
- subscriptn,
- typeconvn,
- vecn,
- derefn :
- begin
- firstpass(hp);
- if codegenerror then
- exit;
- if hp.resulttype^.deftype=procvardef then
- include(flags,nf_procvarload);
- end;
- end;
- end;
- if nf_procvarload in flags then
- begin
- registers32:=left.registers32;
- registersfpu:=left.registersfpu;
- {$ifdef SUPPORT_MMX}
- registersmmx:=left.registersmmx;
- {$endif SUPPORT_MMX}
- if registers32<1 then
- registers32:=1;
- location.loc:=left.location.loc;
- resulttype:=voidpointerdef;
- exit;
- end;
- { proc 2 procvar ? }
- if left.nodetype=calln then
- begin
- { generate a methodcallnode or proccallnode }
- { we shouldn't convert things like @tcollection.load }
- if (tcallnode(left).symtableprocentry^.owner^.symtabletype=objectsymtable) and
- not(assigned(tcallnode(left).methodpointer) and (tcallnode(left).methodpointer.nodetype=typen)) then
- begin
- hp:=genloadmethodcallnode(pprocsym(tcallnode(left).symtableprocentry),tcallnode(left).symtableproc,
- tcallnode(left).methodpointer.getcopy);
- firstpass(hp);
- pass_1:=hp;
- exit;
- end
- else
- hp:=genloadcallnode(pprocsym(tcallnode(left).symtableprocentry),
- tcallnode(left).symtableproc);
- { result is a procedure variable }
- { No, to be TP compatible, you must return a pointer to
- the procedure that is stored in the procvar.}
- if not(m_tp_procvar in aktmodeswitches) then
- begin
- resulttype:=new(pprocvardef,init);
- { it could also be a procvar, not only pprocsym ! }
- if tcallnode(left).symtableprocentry^.typ=varsym then
- hp3:=pabstractprocdef(pvarsym(tcallnode(left).symtableprocentry)^.vartype.def)
- else
- hp3:=pabstractprocdef(pprocsym(tcallnode(left).symtableprocentry)^.definition);
- pprocvardef(resulttype)^.proctypeoption:=hp3^.proctypeoption;
- pprocvardef(resulttype)^.proccalloptions:=hp3^.proccalloptions;
- pprocvardef(resulttype)^.procoptions:=hp3^.procoptions;
- pprocvardef(resulttype)^.rettype:=hp3^.rettype;
- pprocvardef(resulttype)^.symtablelevel:=hp3^.symtablelevel;
- { method ? then set the methodpointer flag }
- if (hp3^.owner^.symtabletype=objectsymtable) and
- is_class(pdef(hp3^.owner^.defowner)) then
- include(pprocvardef(resulttype)^.procoptions,po_methodpointer);
- { we need to process the parameters reverse so they are inserted
- in the correct right2left order (PFV) }
- hp2:=pparaitem(hp3^.para^.last);
- while assigned(hp2) do
- begin
- pprocvardef(resulttype)^.concatpara(hp2^.paratype,hp2^.paratyp,hp2^.defaultvalue);
- hp2:=pparaitem(hp2^.previous);
- end;
- end
- else
- resulttype:=voidpointerdef;
- left.free;
- left:=hp;
- end
- else
- begin
- firstpass(left);
- { what are we getting the address from an absolute sym? }
- hp:=left;
- while assigned(hp) and (hp.nodetype in [vecn,derefn,subscriptn]) do
- hp:=tunarynode(hp).left;
- if assigned(hp) and (hp.nodetype=loadn) and
- ((tloadnode(hp).symtableentry^.typ=absolutesym) and
- pabsolutesym(tloadnode(hp).symtableentry)^.absseg) then
- begin
- if not(cs_typed_addresses in aktlocalswitches) then
- resulttype:=voidfarpointerdef
- else
- resulttype:=new(ppointerdef,initfardef(left.resulttype));
- end
- else
- begin
- if not(cs_typed_addresses in aktlocalswitches) then
- resulttype:=voidpointerdef
- else
- resulttype:=new(ppointerdef,initdef(left.resulttype));
- end;
- end;
- end;
- firstpass(left);
- { this is like the function addr }
- inc(parsing_para_level);
- set_varstate(left,false);
- dec(parsing_para_level);
- if codegenerror then
- exit;
- { don't allow constants }
- if is_constnode(left) then
- begin
- aktfilepos:=left.fileinfo;
- CGMessage(type_e_no_addr_of_constant);
- end
- else
- begin
- { we should allow loc_mem for @string }
- if not(left.location.loc in [LOC_MEM,LOC_REFERENCE]) then
- begin
- aktfilepos:=left.fileinfo;
- CGMessage(cg_e_illegal_expression);
- end;
- end;
- registers32:=left.registers32;
- registersfpu:=left.registersfpu;
- {$ifdef SUPPORT_MMX}
- registersmmx:=left.registersmmx;
- {$endif SUPPORT_MMX}
- if registers32<1 then
- registers32:=1;
- { is this right for object of methods ?? }
- location.loc:=LOC_REGISTER;
- end;
- {*****************************************************************************
- TDOUBLEADDRNODE
- *****************************************************************************}
- constructor tdoubleaddrnode.create(l : tnode);
- begin
- inherited create(doubleaddrn,l);
- end;
- function tdoubleaddrnode.pass_1 : tnode;
- begin
- pass_1:=nil;
- make_not_regable(left);
- firstpass(left);
- inc(parsing_para_level);
- set_varstate(left,false);
- dec(parsing_para_level);
- if resulttype=nil then
- resulttype:=voidpointerdef;
- if codegenerror then
- exit;
- if (left.resulttype^.deftype)<>procvardef then
- CGMessage(cg_e_illegal_expression);
- if (left.location.loc<>LOC_REFERENCE) then
- CGMessage(cg_e_illegal_expression);
- registers32:=left.registers32;
- registersfpu:=left.registersfpu;
- {$ifdef SUPPORT_MMX}
- registersmmx:=left.registersmmx;
- {$endif SUPPORT_MMX}
- if registers32<1 then
- registers32:=1;
- location.loc:=LOC_REGISTER;
- end;
- {*****************************************************************************
- TDEREFNODE
- *****************************************************************************}
- constructor tderefnode.create(l : tnode);
- begin
- inherited create(derefn,l);
- end;
- function tderefnode.pass_1 : tnode;
- begin
- pass_1:=nil;
- firstpass(left);
- set_varstate(left,true);
- if codegenerror then
- begin
- resulttype:=generrordef;
- exit;
- end;
- registers32:=max(left.registers32,1);
- registersfpu:=left.registersfpu;
- {$ifdef SUPPORT_MMX}
- registersmmx:=left.registersmmx;
- {$endif SUPPORT_MMX}
- if left.resulttype^.deftype<>pointerdef then
- CGMessage(cg_e_invalid_qualifier);
- resulttype:=ppointerdef(left.resulttype)^.pointertype.def;
- location.loc:=LOC_REFERENCE;
- end;
- {*****************************************************************************
- TSUBSCRIPTNODE
- *****************************************************************************}
- constructor tsubscriptnode.create(varsym : psym;l : tnode);
- begin
- inherited create(subscriptn,l);
- { vs should be changed to psym! }
- vs:=pvarsym(varsym);
- end;
- function tsubscriptnode.getcopy : tnode;
- var
- p : tsubscriptnode;
- begin
- p:=tsubscriptnode(inherited getcopy);
- p.vs:=vs;
- getcopy:=p;
- end;
- function tsubscriptnode.pass_1 : tnode;
- begin
- pass_1:=nil;
- firstpass(left);
- if codegenerror then
- begin
- resulttype:=generrordef;
- exit;
- end;
- resulttype:=vs^.vartype.def;
- registers32:=left.registers32;
- registersfpu:=left.registersfpu;
- {$ifdef SUPPORT_MMX}
- registersmmx:=left.registersmmx;
- {$endif SUPPORT_MMX}
- { classes must be dereferenced implicit }
- if is_class_or_interface(left.resulttype) then
- begin
- if registers32=0 then
- registers32:=1;
- location.loc:=LOC_REFERENCE;
- end
- else
- begin
- if (left.location.loc<>LOC_MEM) and
- (left.location.loc<>LOC_REFERENCE) then
- CGMessage(cg_e_illegal_expression);
- set_location(location,left.location);
- end;
- end;
- {*****************************************************************************
- TVECNODE
- *****************************************************************************}
- constructor tvecnode.create(l,r : tnode);
- begin
- inherited create(vecn,l,r);
- end;
- function tvecnode.pass_1 : tnode;
- var
- harr : pdef;
- ct : tconverttype;
- {$ifdef consteval}
- tcsym : ptypedconstsym;
- {$endif}
- begin
- pass_1:=nil;
- firstpass(left);
- firstpass(right);
- if codegenerror then
- exit;
- { range check only for arrays }
- if (left.resulttype^.deftype=arraydef) then
- begin
- if (isconvertable(right.resulttype,parraydef(left.resulttype)^.rangetype.def,
- ct,nil,ordconstn,false)=0) and
- not(is_equal(right.resulttype,parraydef(left.resulttype)^.rangetype.def)) then
- CGMessage(type_e_mismatch);
- end;
- { Never convert a boolean or a char !}
- { maybe type conversion }
- if (right.resulttype^.deftype<>enumdef) and
- not(is_char(right.resulttype)) and
- not(is_boolean(right.resulttype)) then
- begin
- right:=gentypeconvnode(right,s32bitdef);
- firstpass(right);
- if codegenerror then
- exit;
- end;
- { are we accessing a pointer[], then convert the pointer to
- an array first, in FPC this is allowed for all pointers in
- delphi/tp7 it's only allowed for pchars }
- if (left.resulttype^.deftype=pointerdef) and
- ((m_fpc in aktmodeswitches) or
- is_pchar(left.resulttype)) then
- begin
- { convert pointer to array }
- harr:=new(parraydef,init(0,$7fffffff,s32bitdef));
- parraydef(harr)^.elementtype.def:=ppointerdef(left.resulttype)^.pointertype.def;
- left:=gentypeconvnode(left,harr);
- firstpass(left);
- if codegenerror then
- exit;
- resulttype:=parraydef(harr)^.elementtype.def
- end;
- { determine return type }
- if not assigned(resulttype) then
- if left.resulttype^.deftype=arraydef then
- resulttype:=parraydef(left.resulttype)^.elementtype.def
- else if left.resulttype^.deftype=stringdef then
- begin
- { indexed access to strings }
- case pstringdef(left.resulttype)^.string_typ of
- {
- st_widestring : resulttype:=cwchardef;
- }
- st_ansistring : resulttype:=cchardef;
- st_longstring : resulttype:=cchardef;
- st_shortstring : resulttype:=cchardef;
- end;
- end
- else
- CGMessage(type_e_array_required);
- { the register calculation is easy if a const index is used }
- if right.nodetype=ordconstn then
- begin
- {$ifdef consteval}
- { constant evaluation }
- if (left.nodetype=loadn) and
- (left.symtableentry^.typ=typedconstsym) then
- begin
- tcsym:=ptypedconstsym(left.symtableentry);
- if tcsym^.defintion^.typ=stringdef then
- begin
- end;
- end;
- {$endif}
- registers32:=left.registers32;
- { for ansi/wide strings, we need at least one register }
- if is_ansistring(left.resulttype) or
- is_widestring(left.resulttype) or
- { ... as well as for dynamic arrays }
- is_dynamic_array(left.resulttype) then
- registers32:=max(registers32,1);
- end
- else
- begin
- { this rules are suboptimal, but they should give }
- { good results }
- registers32:=max(left.registers32,right.registers32);
- { for ansi/wide strings, we need at least one register }
- if is_ansistring(left.resulttype) or
- is_widestring(left.resulttype) or
- { ... as well as for dynamic arrays }
- is_dynamic_array(left.resulttype) then
- registers32:=max(registers32,1);
- { need we an extra register when doing the restore ? }
- if (left.registers32<=right.registers32) and
- { only if the node needs less than 3 registers }
- { two for the right node and one for the }
- { left address }
- (registers32<3) then
- inc(registers32);
- { need we an extra register for the index ? }
- if (right.location.loc<>LOC_REGISTER)
- { only if the right node doesn't need a register }
- and (right.registers32<1) then
- inc(registers32);
- { not correct, but what works better ?
- if left.registers32>0 then
- registers32:=max(registers32,2)
- else
- min. one register
- registers32:=max(registers32,1);
- }
- end;
- registersfpu:=max(left.registersfpu,right.registersfpu);
- {$ifdef SUPPORT_MMX}
- registersmmx:=max(left.registersmmx,right.registersmmx);
- {$endif SUPPORT_MMX}
- if left.location.loc in [LOC_CREGISTER,LOC_REFERENCE] then
- location.loc:=LOC_REFERENCE
- else
- location.loc:=LOC_MEM;
- end;
- {*****************************************************************************
- TSELFNODE
- *****************************************************************************}
- constructor tselfnode.create(_class : pdef);
- begin
- inherited create(selfn);
- resulttype:=_class;
- end;
- function tselfnode.pass_1 : tnode;
- begin
- pass_1:=nil;
- if (resulttype^.deftype=classrefdef) or
- is_class(resulttype) then
- location.loc:=LOC_CREGISTER
- else
- location.loc:=LOC_REFERENCE;
- end;
- {*****************************************************************************
- TWITHNODE
- *****************************************************************************}
- constructor twithnode.create(symtable : pwithsymtable;l,r : tnode;count : longint);
- begin
- inherited create(withn,l,r);
- withsymtable:=symtable;
- tablecount:=count;
- withreference:=nil;
- set_file_line(l);
- end;
- destructor twithnode.destroy;
- var
- symt : psymtable;
- i : longint;
- begin
- symt:=withsymtable;
- for i:=1 to tablecount do
- begin
- if assigned(symt) then
- begin
- withsymtable:=pwithsymtable(symt^.next);
- dispose(symt,done);
- end;
- symt:=withsymtable;
- end;
- inherited destroy;
- end;
- function twithnode.getcopy : tnode;
- var
- p : twithnode;
- begin
- p:=twithnode(inherited getcopy);
- p.withsymtable:=withsymtable;
- p.tablecount:=tablecount;
- p.withreference:=withreference;
- result:=p;
- end;
- function twithnode.pass_1 : tnode;
- var
- symtable : pwithsymtable;
- i : longint;
- begin
- pass_1:=nil;
- if assigned(left) and assigned(right) then
- begin
- firstpass(left);
- unset_varstate(left);
- set_varstate(left,true);
- if codegenerror then
- exit;
- symtable:=withsymtable;
- for i:=1 to tablecount do
- begin
- if (left.nodetype=loadn) and
- (tloadnode(left).symtable=aktprocsym^.definition^.localst) then
- symtable^.direct_with:=true;
- symtable^.withnode:=self;
- symtable:=pwithsymtable(symtable^.next);
- end;
- firstpass(right);
- if codegenerror then
- exit;
- left_right_max;
- resulttype:=voiddef;
- end
- else
- begin
- { optimization }
- pass_1:=nil;
- end;
- end;
- end.
- {
- $Log$
- Revision 1.10 2000-11-04 14:25:20 florian
- + merged Attila's changes for interfaces, not tested yet
- Revision 1.9 2000/10/31 22:02:49 peter
- * symtable splitted, no real code changes
- Revision 1.8 2000/10/21 18:16:11 florian
- * a lot of changes:
- - basic dyn. array support
- - basic C++ support
- - some work for interfaces done
- ....
- Revision 1.7 2000/10/14 21:52:55 peter
- * fixed memory leaks
- Revision 1.6 2000/10/14 10:14:51 peter
- * moehrendorf oct 2000 rewrite
- Revision 1.5 2000/10/01 19:48:24 peter
- * lot of compile updates for cg11
- Revision 1.4 2000/09/28 19:49:52 florian
- *** empty log message ***
- Revision 1.3 2000/09/25 15:37:14 florian
- * more fixes
- Revision 1.2 2000/09/25 15:05:25 florian
- * some updates
- Revision 1.1 2000/09/25 09:58:22 florian
- * first revision for testing purpose
- }
|