123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704 |
- {
- $Id$
- Copyright (c) 1998-2000 by Florian Klaempfl
- Helper routines for all code generators
- 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 ncgutil;
- {$i fpcdefs.inc}
- interface
- uses
- node,
- cginfo,cpubase,aasm,
- rgobj;
- type
- tloadregvars = (lr_dont_load_regvars, lr_load_regvars);
- tmaybesave = record
- saved : boolean;
- ref : treference;
- end;
- procedure firstcomplex(p : tbinarynode);
- procedure maketojumpbool(list:TAAsmoutput; p : tnode; loadregvars: tloadregvars);
- procedure remove_non_regvars_from_loc(const t: tlocation; var regs: tregisterset);
- procedure location_force_reg(list: TAAsmoutput;var l:tlocation;dst_size:TCGSize;maybeconst:boolean);
- procedure location_force_mem(list: TAAsmoutput;var l:tlocation);
- procedure maybe_save(list:taasmoutput;needed:integer;var l:tlocation;var s:tmaybesave);
- procedure maybe_restore(list:taasmoutput;var l:tlocation;const s:tmaybesave);
- function maybe_pushfpu(list:taasmoutput;needed : byte;var l:tlocation) : boolean;
- procedure push_value_para(p:tnode;inlined,is_cdecl:boolean;
- para_offset:longint;alignment : longint);
- procedure genentrycode(list : TAAsmoutput;
- make_global:boolean;
- stackframe:longint;
- var parasize:longint;var nostackframe:boolean;
- inlined : boolean);
- procedure genexitcode(list : TAAsmoutput;parasize:longint;nostackframe,inlined:boolean);
- procedure genimplicitunitinit(list : TAAsmoutput);
- procedure genimplicitunitfinal(list : TAAsmoutput);
- implementation
- uses
- {$ifdef Delphi}
- Sysutils,
- {$else}
- strings,
- {$endif}
- cutils,cclasses,globtype,globals,systems,verbose,
- symbase,symconst,symtype,symsym,symdef,symtable,types,
- fmodule,
- cgbase,regvars,tainst,cpuasm,
- {$ifdef GDB}
- gdb,
- {$endif GDB}
- ncon,
- tgobj,cpuinfo,cgobj,cgcpu,cg64f32;
- {*****************************************************************************
- Misc Helpers
- *****************************************************************************}
- { DO NOT RELY on the fact that the tnode is not yet swaped
- because of inlining code PM }
- procedure firstcomplex(p : tbinarynode);
- var
- hp : tnode;
- begin
- { always calculate boolean AND and OR from left to right }
- if (p.nodetype in [orn,andn]) and
- (p.left.resulttype.def.deftype=orddef) and
- (torddef(p.left.resulttype.def).typ in [bool8bit,bool16bit,bool32bit]) then
- begin
- { p.swaped:=false}
- if nf_swaped in p.flags then
- internalerror(234234);
- end
- else
- if (((p.location.loc=LOC_FPUREGISTER) and
- (p.right.registersfpu > p.left.registersfpu)) or
- ((((p.left.registersfpu = 0) and
- (p.right.registersfpu = 0)) or
- (p.location.loc<>LOC_FPUREGISTER)) and
- (p.left.registers32<p.right.registers32))) and
- { the following check is appropriate, because all }
- { 4 registers are rarely used and it is thereby }
- { achieved that the extra code is being dropped }
- { by exchanging not commutative operators }
- (p.right.registers32<=c_countusableregsint) then
- begin
- hp:=p.left;
- p.left:=p.right;
- p.right:=hp;
- if nf_swaped in p.flags then
- exclude(p.flags,nf_swaped)
- else
- include(p.flags,nf_swaped);
- end;
- end;
- procedure maketojumpbool(list:TAAsmoutput; p : tnode; loadregvars: tloadregvars);
- {
- produces jumps to true respectively false labels using boolean expressions
- depending on whether the loading of regvars is currently being
- synchronized manually (such as in an if-node) or automatically (most of
- the other cases where this procedure is called), loadregvars can be
- "lr_load_regvars" or "lr_dont_load_regvars"
- }
- var
- opsize : tcgsize;
- storepos : tfileposinfo;
- begin
- if nf_error in p.flags then
- exit;
- storepos:=aktfilepos;
- aktfilepos:=p.fileinfo;
- if is_boolean(p.resulttype.def) then
- begin
- if loadregvars = lr_load_regvars then
- load_all_regvars(list);
- if is_constboolnode(p) then
- begin
- if tordconstnode(p).value<>0 then
- cg.a_jmp_always(list,truelabel)
- else
- cg.a_jmp_always(list,falselabel)
- end
- else
- begin
- opsize:=def_cgsize(p.resulttype.def);
- case p.location.loc of
- LOC_CREGISTER,LOC_REGISTER,LOC_CREFERENCE,LOC_REFERENCE :
- begin
- if (p.location.loc = LOC_CREGISTER) then
- load_regvar_reg(list,p.location.register);
- cg.a_cmp_const_loc_label(list,opsize,OC_NE,
- 0,p.location,truelabel);
- { !!! should happen right after cmp (JM) }
- location_release(list,p.location);
- cg.a_jmp_always(list,falselabel);
- end;
- LOC_FLAGS :
- begin
- cg.a_jmp_flags(list,p.location.resflags,
- truelabel);
- cg.a_jmp_always(list,falselabel);
- end;
- end;
- end;
- end
- else
- internalerror(200112305);
- aktfilepos:=storepos;
- end;
- procedure remove_non_regvars_from_loc(const t: tlocation; var regs: tregisterset);
- begin
- case t.loc of
- LOC_REGISTER:
- begin
- { can't be a regvar, since it would be LOC_CREGISTER then }
- exclude(regs,t.register);
- if t.registerhigh <> R_NO then
- exclude(regs,t.registerhigh);
- end;
- LOC_CREFERENCE,LOC_REFERENCE:
- begin
- if not(cs_regalloc in aktglobalswitches) or
- (t.reference.base in rg.usableregsint) then
- exclude(regs,t.reference.base);
- if not(cs_regalloc in aktglobalswitches) or
- (t.reference.index in rg.usableregsint) then
- exclude(regs,t.reference.index);
- end;
- end;
- end;
- {*****************************************************************************
- TLocation
- *****************************************************************************}
- { 32-bit version }
- procedure location_force_reg32(list: TAAsmoutput;var l:tlocation;dst_size:TCGSize;maybeconst:boolean);
- var
- hregister,
- hregisterhi : tregister;
- hl : tasmlabel;
- begin
- { handle transformations to 64bit separate }
- if dst_size in [OS_64,OS_S64] then
- begin
- if not (l.size in [OS_64,OS_S64]) then
- begin
- { load a smaller size to OS_64 }
- if l.loc=LOC_REGISTER then
- hregister:=rg.makeregsize(l.registerlow,OS_INT)
- else
- hregister:=rg.getregisterint(list);
- { load value in low register }
- case l.loc of
- LOC_FLAGS :
- cg.g_flags2reg(list,l.resflags,hregister);
- LOC_JUMP :
- begin
- cg.a_label(list,truelabel);
- cg.a_load_const_reg(list,OS_INT,1,hregister);
- getlabel(hl);
- cg.a_jmp_always(list,hl);
- cg.a_label(list,falselabel);
- cg.a_load_const_reg(list,OS_INT,0,hregister);
- cg.a_label(list,hl);
- end;
- else
- cg.a_load_loc_reg(list,l,hregister);
- end;
- { reset hi part, take care of the signed bit of the current value }
- hregisterhi:=rg.getregisterint(list);
- if (dst_size=OS_S64) and
- (l.size in [OS_S8,OS_S16,OS_S32]) then
- begin
- if l.loc=LOC_CONSTANT then
- begin
- if (longint(l.value)<0) then
- cg.a_load_const_reg(list,OS_32,$ffffffff,hregisterhi)
- else
- cg.a_load_const_reg(list,OS_32,0,hregisterhi);
- end
- else
- begin
- cg.a_load_reg_reg(list,OS_32,hregister,hregisterhi);
- cg.a_op_const_reg(list,OP_SAR,31,hregisterhi);
- end;
- end
- else
- cg.a_load_const_reg(list,OS_32,0,hregisterhi);
- location_reset(l,LOC_REGISTER,dst_size);
- l.registerlow:=hregister;
- l.registerhigh:=hregisterhi;
- end
- else
- begin
- { 64bit to 64bit }
- if (l.loc=LOC_REGISTER) or
- ((l.loc=LOC_CREGISTER) and maybeconst) then
- begin
- hregister:=l.registerlow;
- hregisterhi:=l.registerhigh;
- end
- else
- begin
- hregister:=rg.getregisterint(list);
- hregisterhi:=rg.getregisterint(list);
- end;
- { load value in new register }
- tcg64f32(cg).a_load64_loc_reg(list,l,hregister,hregisterhi);
- location_reset(l,LOC_REGISTER,dst_size);
- l.registerlow:=hregister;
- l.registerhigh:=hregisterhi;
- end;
- end
- else
- begin
- { transformations to 32bit or smaller }
- if l.loc=LOC_REGISTER then
- begin
- { if the previous was 64bit release the high register }
- if l.size in [OS_64,OS_S64] then
- begin
- rg.ungetregisterint(list,l.registerhigh);
- l.registerhigh:=R_NO;
- end;
- hregister:=l.register;
- end
- else
- begin
- { get new register }
- if (l.loc=LOC_CREGISTER) and
- maybeconst and
- (TCGSize2Size[dst_size]=TCGSize2Size[l.size]) then
- hregister:=l.register
- else
- hregister:=rg.getregisterint(list);
- end;
- hregister:=rg.makeregsize(hregister,dst_size);
- { load value in new register }
- case l.loc of
- LOC_FLAGS :
- cg.g_flags2reg(list,l.resflags,hregister);
- LOC_JUMP :
- begin
- cg.a_label(list,truelabel);
- cg.a_load_const_reg(list,dst_size,1,hregister);
- getlabel(hl);
- cg.a_jmp_always(list,hl);
- cg.a_label(list,falselabel);
- cg.a_load_const_reg(list,dst_size,0,hregister);
- cg.a_label(list,hl);
- end;
- else
- begin
- { load_loc_reg can only handle size >= l.size, when the
- new size is smaller then we need to adjust the size
- of the orignal and maybe recalculate l.register for i386 }
- if (TCGSize2Size[dst_size]<TCGSize2Size[l.size]) then
- begin
- if (l.loc in [LOC_REGISTER,LOC_CREGISTER]) then
- l.register:=rg.makeregsize(l.register,dst_size);
- l.size:=dst_size;
- end;
- cg.a_load_loc_reg(list,l,hregister);
- end;
- end;
- location_reset(l,LOC_REGISTER,dst_size);
- l.register:=hregister;
- end;
- end;
- { 64-bit version }
- procedure location_force_reg64(list: TAAsmoutput;var l:tlocation;dst_size:TCGSize;maybeconst:boolean);
- var
- hregister : tregister;
- hl : tasmlabel;
- begin
- { handle transformations to 64bit separate }
- if dst_size in [OS_64,OS_S64] then
- begin
- { load a smaller size to OS_64 }
- if l.loc=LOC_REGISTER then
- hregister:=rg.makeregsize(l.register,OS_INT)
- else
- hregister:=rg.getregisterint(list);
- { load value in low register }
- case l.loc of
- LOC_FLAGS :
- cg.g_flags2reg(list,l.resflags,hregister);
- LOC_JUMP :
- begin
- cg.a_label(list,truelabel);
- cg.a_load_const_reg(list,OS_INT,1,hregister);
- getlabel(hl);
- cg.a_jmp_always(list,hl);
- cg.a_label(list,falselabel);
- cg.a_load_const_reg(list,OS_INT,0,hregister);
- cg.a_label(list,hl);
- end;
- else
- cg.a_load_loc_reg(list,l,hregister);
- end;
- location_reset(l,LOC_REGISTER,dst_size);
- l.register:=hregister;
- end
- else
- begin
- { transformations to 32bit or smaller }
- if l.loc=LOC_REGISTER then
- begin
- hregister:=l.register;
- end
- else
- begin
- { get new register }
- if (l.loc=LOC_CREGISTER) and
- maybeconst and
- (TCGSize2Size[dst_size]=TCGSize2Size[l.size]) then
- hregister:=l.register
- else
- hregister:=rg.getregisterint(list);
- end;
- hregister:=rg.makeregsize(hregister,dst_size);
- { load value in new register }
- case l.loc of
- LOC_FLAGS :
- cg.g_flags2reg(list,l.resflags,hregister);
- LOC_JUMP :
- begin
- cg.a_label(list,truelabel);
- cg.a_load_const_reg(list,dst_size,1,hregister);
- getlabel(hl);
- cg.a_jmp_always(list,hl);
- cg.a_label(list,falselabel);
- cg.a_load_const_reg(list,dst_size,0,hregister);
- cg.a_label(list,hl);
- end;
- else
- begin
- { load_loc_reg can only handle size >= l.size, when the
- new size is smaller then we need to adjust the size
- of the orignal and maybe recalculate l.register for i386 }
- if (TCGSize2Size[dst_size]<TCGSize2Size[l.size]) then
- begin
- if (l.loc in [LOC_REGISTER,LOC_CREGISTER]) then
- l.register:=rg.makeregsize(l.register,dst_size);
- l.size:=dst_size;
- end;
- cg.a_load_loc_reg(list,l,hregister);
- end;
- end;
- location_reset(l,LOC_REGISTER,dst_size);
- l.register:=hregister;
- end;
- end;
- procedure location_force_reg(list: TAAsmoutput;var l:tlocation;dst_size:TCGSize;maybeconst:boolean);
- begin
- { release previous location before demanding a new register }
- if (l.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
- begin
- location_freetemp(list,l);
- location_release(list,l);
- end;
- if sizeof(aword) < 8 then
- location_force_reg32(list, l, dst_size, maybeconst)
- else
- location_force_reg64(list, l, dst_size, maybeconst);
- end;
- procedure location_force_mem(list: TAAsmoutput;var l:tlocation);
- var
- r : treference;
- begin
- case l.loc of
- LOC_FPUREGISTER,
- LOC_CFPUREGISTER :
- begin
- tg.gettempofsizereference(list,TCGSize2Size[l.size],r);
- cg.a_loadfpu_reg_ref(list,l.size,l.register,r);
- location_reset(l,LOC_REFERENCE,l.size);
- l.reference:=r;
- end;
- LOC_CONSTANT,
- LOC_REGISTER,
- LOC_CREGISTER :
- begin
- tg.gettempofsizereference(list,TCGSize2Size[l.size],r);
- if l.size in [OS_64,OS_S64] then
- tcg64f32(cg).a_load64_loc_ref(list,l,r)
- else
- cg.a_load_loc_ref(list,l,r);
- location_reset(l,LOC_REFERENCE,l.size);
- l.reference:=r;
- end;
- LOC_CREFERENCE,
- LOC_REFERENCE : ;
- else
- internalerror(200203219);
- end;
- end;
- {*****************************************************************************
- Maybe_Save
- *****************************************************************************}
- procedure maybe_save(list:taasmoutput;needed:integer;var l:tlocation;var s:tmaybesave);
- begin
- s.saved:=false;
- if l.loc=LOC_CREGISTER then
- begin
- s.saved:=true;
- exit;
- end;
- if needed>rg.countunusedregsint then
- begin
- case l.loc of
- LOC_REGISTER :
- begin
- if l.size in [OS_64,OS_S64] then
- begin
- tg.gettempofsizereference(exprasmlist,8,s.ref);
- tcg64f32(cg).a_load64_reg_ref(exprasmlist,l.registerlow,l.registerhigh,s.ref);
- end
- else
- begin
- tg.gettempofsizereference(exprasmlist,TCGSize2Size[l.size],s.ref);
- cg.a_load_reg_ref(exprasmlist,l.size,l.register,s.ref);
- end;
- location_release(exprasmlist,l);
- s.saved:=true;
- end;
- LOC_REFERENCE,
- LOC_CREFERENCE :
- begin
- if ((l.reference.base<>R_NO) or
- (l.reference.index<>R_NO)) then
- begin
- { load address into a single base register }
- cg.a_loadaddr_ref_reg(list,l.reference,l.reference.base);
- { save base register }
- tg.gettempofsizereference(exprasmlist,TCGSize2Size[OS_ADDR],s.ref);
- cg.a_load_reg_ref(exprasmlist,OS_ADDR,l.reference.base,s.ref);
- { release }
- location_release(exprasmlist,l);
- s.saved:=true;
- end;
- end;
- end;
- end;
- end;
- procedure maybe_restore(list:taasmoutput;var l:tlocation;const s:tmaybesave);
- begin
- if not s.saved then
- exit;
- if l.loc=LOC_CREGISTER then
- begin
- load_regvar_reg(list,l.register);
- exit;
- end;
- case l.loc of
- LOC_REGISTER :
- begin
- if l.size in [OS_64,OS_S64] then
- begin
- l.registerlow:=rg.getregisterint(exprasmlist);
- l.registerhigh:=rg.getregisterint(exprasmlist);
- tcg64f32(cg).a_load64_ref_reg(exprasmlist,s.ref,l.registerlow,l.registerhigh);
- end
- else
- begin
- l.register:=rg.getregisterint(exprasmlist);
- cg.a_load_ref_reg(exprasmlist,OS_INT,s.ref,l.register);
- end;
- end;
- LOC_CREFERENCE,
- LOC_REFERENCE :
- begin
- reference_reset(l.reference);
- l.reference.base:=rg.getaddressregister(exprasmlist);
- cg.a_load_ref_reg(exprasmlist,OS_ADDR,s.ref,l.reference.base);
- end;
- end;
- tg.ungetiftemp(exprasmlist,s.ref);
- end;
- function maybe_pushfpu(list:taasmoutput;needed : byte;var l:tlocation) : boolean;
- begin
- if needed>=maxfpuregs then
- begin
- if l.loc = LOC_FPUREGISTER then
- begin
- location_force_mem(list,l);
- maybe_pushfpu:=true;
- end
- else
- maybe_pushfpu:=false;
- end
- else
- maybe_pushfpu:=false;
- end;
- {*****************************************************************************
- Push Value Para
- *****************************************************************************}
- procedure push_value_para(p:tnode;inlined,is_cdecl:boolean;
- para_offset:longint;alignment : longint);
- var
- tempreference : treference;
- href : treference;
- hreg : tregister;
- sizetopush,
- size : longint;
- cgsize : tcgsize;
- begin
- { Move flags and jump in register to make it less complex }
- if p.location.loc in [LOC_FLAGS,LOC_JUMP] then
- location_force_reg(exprasmlist,p.location,def_cgsize(p.resulttype.def),false);
- { Handle Floating point types differently }
- if p.resulttype.def.deftype=floatdef then
- begin
- case p.location.loc of
- LOC_FPUREGISTER,
- LOC_CFPUREGISTER:
- begin
- size:=align(tfloatdef(p.resulttype.def).size,alignment);
- inc(pushedparasize,size);
- if not inlined then
- cg.a_op_const_reg(exprasmlist,OP_SUB,size,STACK_POINTER_REG);
- {$ifdef GDB}
- if (cs_debuginfo in aktmoduleswitches) and
- (exprasmList.first=exprasmList.last) then
- exprasmList.concat(Tai_force_line.Create);
- {$endif GDB}
- { this is the easiest case for inlined !! }
- if inlined then
- reference_reset_base(href,procinfo^.framepointer,para_offset-pushedparasize)
- else
- reference_reset_base(href,stack_pointer_reg,0);
- cg.a_loadfpu_reg_ref(exprasmlist,
- def_cgsize(p.resulttype.def),p.location.register,href);
- end;
- LOC_REFERENCE,
- LOC_CREFERENCE :
- begin
- sizetopush:=align(p.resulttype.def.size,alignment);
- tempreference:=p.location.reference;
- inc(tempreference.offset,sizetopush);
- while (sizetopush>0) do
- begin
- if sizetopush>=4 then
- begin
- cgsize:=OS_32;
- inc(pushedparasize,4);
- dec(tempreference.offset,4);
- dec(sizetopush,4);
- end
- else
- begin
- cgsize:=OS_16;
- inc(pushedparasize,2);
- dec(tempreference.offset,2);
- dec(sizetopush,2);
- end;
- if inlined then
- begin
- reference_reset_base(href,procinfo^.framepointer,para_offset-pushedparasize);
- cg.a_load_ref_ref(exprasmlist,cgsize,tempreference,href);
- end
- else
- cg.a_param_ref(exprasmlist,cgsize,tempreference,-1);
- end;
- end;
- else
- internalerror(200204243);
- end;
- end
- else
- begin
- { call by value open array ? }
- if is_cdecl and
- push_addr_param(p.resulttype.def) then
- begin
- if not (p.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
- internalerror(200204241);
- { push on stack }
- size:=align(p.resulttype.def.size,alignment);
- inc(pushedparasize,size);
- cg.a_op_const_reg(exprasmlist,OP_SUB,size,STACK_POINTER_REG);
- reference_reset_base(href,STACK_POINTER_REG,0);
- cg.g_concatcopy(exprasmlist,p.location.reference,href,size,false,false);
- end
- else
- begin
- case p.location.loc of
- LOC_CONSTANT,
- LOC_REGISTER,
- LOC_CREGISTER,
- LOC_REFERENCE,
- LOC_CREFERENCE :
- begin
- cgsize:=def_cgsize(p.resulttype.def);
- if cgsize in [OS_64,OS_S64] then
- begin
- inc(pushedparasize,8);
- if inlined then
- begin
- reference_reset_base(href,procinfo^.framepointer,para_offset-pushedparasize);
- tcg64f32(cg).a_load64_loc_ref(exprasmlist,p.location,href);
- end
- else
- tcg64f32(cg).a_param64_loc(exprasmlist,p.location,-1);
- end
- else
- begin
- case cgsize of
- OS_8,OS_S8 :
- begin
- if alignment=4 then
- cgsize:=OS_32
- else
- cgsize:=OS_16;
- end;
- OS_16,OS_S16 :
- begin
- if alignment=4 then
- cgsize:=OS_32;
- end;
- end;
- { update register to use to match alignment }
- if p.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
- begin
- hreg:=p.location.register;
- p.location.register:=rg.makeregsize(p.location.register,cgsize);
- end;
- inc(pushedparasize,alignment);
- if inlined then
- begin
- reference_reset_base(href,procinfo^.framepointer,para_offset-pushedparasize);
- cg.a_load_loc_ref(exprasmlist,p.location,href);
- end
- else
- cg.a_param_loc(exprasmlist,p.location,-1);
- { restore old register }
- if p.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
- p.location.register:=hreg;
- end;
- location_release(exprasmlist,p.location);
- end;
- {$ifdef SUPPORT_MMX}
- LOC_MMXREGISTER,
- LOC_CMMXREGISTER:
- begin
- inc(pushedparasize,8);
- if inlined then
- begin
- reference_reset_base(href,procinfo^.framepointer,para_offset-pushedparasize);
- cg.a_loadmm_reg_ref(exprasmlist,p.location.register,href);
- end
- else
- cg.a_parammm_reg(exprasmlist,p.location.register);
- end;
- {$endif SUPPORT_MMX}
- else
- internalerror(200204241);
- end;
- end;
- end;
- end;
- {****************************************************************************
- Entry/Exit Code
- ****************************************************************************}
- procedure copyvalueparas(p : tnamedindexitem;arg:pointer);
- var
- href1,href2 : treference;
- list : taasmoutput;
- begin
- list:=taasmoutput(arg);
- if (tsym(p).typ=varsym) and
- (tvarsym(p).varspez=vs_value) and
- (push_addr_param(tvarsym(p).vartype.def)) then
- begin
- reference_reset_base(href1,procinfo^.framepointer,tvarsym(p).address+procinfo^.para_offset);
- if is_open_array(tvarsym(p).vartype.def) or
- is_array_of_const(tvarsym(p).vartype.def) then
- cg.g_copyvaluepara_openarray(list,href1,tarraydef(tvarsym(p).vartype.def).elesize)
- else
- begin
- reference_reset_base(href2,procinfo^.framepointer,-tvarsym(p).localvarsym.address+tvarsym(p).localvarsym.owner.address_fixup);
- if is_shortstring(tvarsym(p).vartype.def) then
- cg.g_copyshortstring(list,href1,href2,tstringdef(tvarsym(p).vartype.def).len,false,true)
- else
- cg.g_concatcopy(list,href1,href2,tvarsym(p).vartype.def.size,true,true);
- end;
- end;
- end;
- procedure initialize_threadvar(p : tnamedindexitem;arg:pointer);
- var
- href : treference;
- list : taasmoutput;
- begin
- list:=taasmoutput(arg);
- if (tsym(p).typ=varsym) and
- (vo_is_thread_var in tvarsym(p).varoptions) then
- begin
- cg.a_param_const(list,OS_INT,tvarsym(p).getsize,2);
- reference_reset_symbol(href,newasmsymbol(tvarsym(p).mangledname),0);
- cg.a_paramaddr_ref(list,href,2);
- rg.saveregvars(list,all_registers);
- cg.a_call_name(list,'FPC_INIT_THREADVAR');
- end;
- end;
- { generates the code for initialisation of local data }
- procedure initialize_data(p : tnamedindexitem;arg:pointer);
- var
- href : treference;
- list : taasmoutput;
- begin
- list:=taasmoutput(arg);
- if (tsym(p).typ=varsym) and
- assigned(tvarsym(p).vartype.def) and
- not(is_class(tvarsym(p).vartype.def)) and
- tvarsym(p).vartype.def.needs_inittable then
- begin
- if assigned(procinfo) then
- procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally;
- if tsym(p).owner.symtabletype in [localsymtable,inlinelocalsymtable] then
- reference_reset_base(href,procinfo^.framepointer,-tvarsym(p).address+tvarsym(p).owner.address_fixup)
- else
- reference_reset_symbol(href,newasmsymbol(tvarsym(p).mangledname),0);
- cg.g_initialize(list,tvarsym(p).vartype.def,href,false);
- end;
- end;
- { generates the code for finalisation of local data }
- procedure finalize_data(p : tnamedindexitem;arg:pointer);
- var
- href : treference;
- list : taasmoutput;
- begin
- list:=taasmoutput(arg);
- if (tsym(p).typ=varsym) and
- assigned(tvarsym(p).vartype.def) and
- not(is_class(tvarsym(p).vartype.def)) and
- tvarsym(p).vartype.def.needs_inittable then
- begin
- if tsym(p).owner.symtabletype in [localsymtable,inlinelocalsymtable] then
- reference_reset_base(href,procinfo^.framepointer,-tvarsym(p).address+tvarsym(p).owner.address_fixup)
- else
- reference_reset_symbol(href,newasmsymbol(tvarsym(p).mangledname),0);
- cg.g_finalize(list,tvarsym(p).vartype.def,href,false);
- end;
- end;
- { generates the code for incrementing the reference count of parameters and
- initialize out parameters }
- procedure init_paras(p : tnamedindexitem;arg:pointer);
- var
- href : treference;
- tmpreg : tregister;
- list : taasmoutput;
- begin
- list:=taasmoutput(arg);
- if (tsym(p).typ=varsym) and
- not is_class(tvarsym(p).vartype.def) and
- tvarsym(p).vartype.def.needs_inittable then
- begin
- case tvarsym(p).varspez of
- vs_value :
- begin
- procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally;
- if assigned(tvarsym(p).localvarsym) then
- reference_reset_base(href,procinfo^.framepointer,
- -tvarsym(p).localvarsym.address+tvarsym(p).localvarsym.owner.address_fixup)
- else
- reference_reset_base(href,procinfo^.framepointer,tvarsym(p).address+procinfo^.para_offset);
- cg.g_incrrefcount(list,tvarsym(p).vartype.def,href);
- end;
- vs_out :
- begin
- reference_reset_base(href,procinfo^.framepointer,tvarsym(p).address+procinfo^.para_offset);
- tmpreg:=cg.get_scratch_reg(list);
- cg.a_load_ref_reg(list,OS_ADDR,href,tmpreg);
- reference_reset_base(href,tmpreg,0);
- cg.g_initialize(list,tvarsym(p).vartype.def,href,false);
- end;
- end;
- end;
- end;
- { generates the code for decrementing the reference count of parameters }
- procedure final_paras(p : tnamedindexitem;arg:pointer);
- var
- href : treference;
- list : taasmoutput;
- begin
- list:=taasmoutput(arg);
- if (tsym(p).typ=varsym) and
- not is_class(tvarsym(p).vartype.def) and
- tvarsym(p).vartype.def.needs_inittable then
- begin
- if (tvarsym(p).varspez=vs_value) then
- begin
- if assigned(tvarsym(p).localvarsym) then
- reference_reset_base(href,procinfo^.framepointer,
- -tvarsym(p).localvarsym.address+tvarsym(p).localvarsym.owner.address_fixup)
- else
- reference_reset_base(href,procinfo^.framepointer,tvarsym(p).address+procinfo^.para_offset);
- cg.g_decrrefcount(list,tvarsym(p).vartype.def,href);
- end;
- end;
- end;
- { Initialize temp ansi/widestrings,interfaces }
- procedure inittempvariables(list:taasmoutput);
- var
- hp : ptemprecord;
- href : treference;
- begin
- hp:=tg.templist;
- while assigned(hp) do
- begin
- if hp^.temptype in [tt_ansistring,tt_freeansistring,
- tt_widestring,tt_freewidestring,
- tt_interfacecom] then
- begin
- procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally;
- reference_reset_base(href,procinfo^.framepointer,hp^.pos);
- cg.a_load_const_ref(list,OS_ADDR,0,href);
- end;
- hp:=hp^.next;
- end;
- end;
- procedure finalizetempvariables(list:taasmoutput);
- var
- hp : ptemprecord;
- href : treference;
- begin
- hp:=tg.templist;
- while assigned(hp) do
- begin
- case hp^.temptype of
- tt_ansistring,
- tt_freeansistring :
- begin
- reference_reset_base(href,procinfo^.framepointer,hp^.pos);
- cg.a_paramaddr_ref(list,href,1);
- cg.a_call_name(list,'FPC_ANSISTR_DECR_REF');
- end;
- tt_widestring,
- tt_freewidestring :
- begin
- reference_reset_base(href,procinfo^.framepointer,hp^.pos);
- cg.a_paramaddr_ref(list,href,1);
- cg.a_call_name(list,'FPC_WIDESTR_DECR_REF');
- end;
- tt_interfacecom :
- begin
- reference_reset_base(href,procinfo^.framepointer,hp^.pos);
- cg.a_paramaddr_ref(list,href,1);
- cg.a_call_name(list,'FPC_INTF_DECR_REF');
- end;
- end;
- hp:=hp^.next;
- end;
- end;
- procedure handle_return_value(list:TAAsmoutput; inlined : boolean;var uses_acc,uses_acchi : boolean);
- var
- href : treference;
- hreg : tregister;
- cgsize : TCGSize;
- begin
- if not is_void(aktprocdef.rettype.def) then
- begin
- if (tfuncretsym(aktprocdef.funcretsym).funcretstate<>vs_assigned) and
- (not inlined) then
- CGMessage(sym_w_function_result_not_set);
- reference_reset_base(href,procinfo^.framepointer,procinfo^.return_offset);
- cgsize:=def_cgsize(aktprocdef.rettype.def);
- case aktprocdef.rettype.def.deftype of
- orddef,
- enumdef :
- begin
- uses_acc:=true;
- cg.a_reg_alloc(list,accumulator);
- if cgsize in [OS_64,OS_S64] then
- begin
- uses_acchi:=true;
- cg.a_reg_alloc(list,accumulatorhigh);
- tcg64f32(cg).a_load64_ref_reg(list,href,accumulator,accumulatorhigh);
- end
- else
- begin
- hreg:=rg.makeregsize(accumulator,cgsize);
- cg.a_load_ref_reg(list,cgsize,href,hreg);
- end;
- end;
- floatdef :
- begin
- cg.a_loadfpu_ref_reg(list,cgsize,href,fpuresultreg);
- end;
- else
- begin
- if ret_in_acc(aktprocdef.rettype.def) then
- begin
- uses_acc:=true;
- cg.a_reg_alloc(list,accumulator);
- cg.a_load_ref_reg(list,cgsize,href,accumulator);
- end
- end;
- end;
- end;
- end;
- procedure handle_fast_exit_return_value(list:TAAsmoutput);
- var
- href : treference;
- hreg : tregister;
- cgsize : TCGSize;
- begin
- if not is_void(aktprocdef.rettype.def) then
- begin
- reference_reset_base(href,procinfo^.framepointer,procinfo^.return_offset);
- cgsize:=def_cgsize(aktprocdef.rettype.def);
- case aktprocdef.rettype.def.deftype of
- orddef,
- enumdef :
- begin
- if cgsize in [OS_64,OS_S64] then
- tcg64f32(cg).a_load64_reg_ref(list,accumulator,accumulatorhigh,href)
- else
- begin
- hreg:=rg.makeregsize(accumulator,cgsize);
- cg.a_load_reg_ref(list,cgsize,hreg,href);
- end;
- end;
- floatdef :
- begin
- cg.a_loadfpu_reg_ref(list,cgsize,fpuresultreg,href);
- end;
- else
- begin
- if ret_in_acc(aktprocdef.rettype.def) then
- cg.a_load_reg_ref(list,cgsize,accumulator,href);
- end;
- end;
- end;
- end;
- procedure genentrycode(list : TAAsmoutput;
- make_global:boolean;
- stackframe:longint;
- var parasize:longint;var nostackframe:boolean;
- inlined : boolean);
- var
- hs : string;
- href : treference;
- p : tsymtable;
- tempbuf : treference;
- tmpreg : tregister;
- begin
- { Insert alignment and assembler names }
- if not inlined then
- begin
- { Align, gprof uses 16 byte granularity }
- if (cs_profile in aktmoduleswitches) then
- list.concat(Tai_align.Create_op(16,$90))
- else
- list.concat(Tai_align.Create(aktalignment.procalign));
- if (cs_profile in aktmoduleswitches) or
- (aktprocdef.owner.symtabletype=globalsymtable) or
- (assigned(procinfo^._class) and (procinfo^._class.owner.symtabletype=globalsymtable)) then
- make_global:=true;
- if make_global or ((procinfo^.flags and pi_is_global) <> 0) then
- aktprocsym.is_global := True;
- {$ifdef GDB}
- if (cs_debuginfo in aktmoduleswitches) then
- begin
- aktprocdef.concatstabto(list);
- aktprocsym.isstabwritten:=true;
- end;
- {$endif GDB}
- repeat
- hs:=aktprocdef.aliasnames.getfirst;
- if hs='' then
- break;
- {$ifdef GDB}
- if (cs_debuginfo in aktmoduleswitches) and
- target_info.use_function_relative_addresses then
- list.concat(Tai_stab_function_name.Create(strpnew(hs)));
- {$endif GDB}
- if make_global then
- list.concat(Tai_symbol.Createname_global(hs,0))
- else
- list.concat(Tai_symbol.Createname(hs,0));
- until false;
- { omit stack frame ? }
- if (procinfo^.framepointer=STACK_POINTER_REG) then
- begin
- CGMessage(cg_d_stackframe_omited);
- nostackframe:=true;
- if (aktprocdef.proctypeoption in [potype_unitinit,potype_proginit,potype_unitfinalize]) then
- parasize:=0
- else
- parasize:=aktprocdef.parast.datasize+procinfo^.para_offset-4;
- if stackframe<>0 then
- cg.a_op_const_reg(list,OP_SUB,stackframe,procinfo^.framepointer);
- end
- else
- begin
- nostackframe:=false;
- if (aktprocdef.proctypeoption in [potype_unitinit,potype_proginit,potype_unitfinalize]) then
- parasize:=0
- else
- parasize:=aktprocdef.parast.datasize+procinfo^.para_offset-target_info.first_parm_offset;
- if (po_interrupt in aktprocdef.procoptions) then
- cg.g_interrupt_stackframe_entry(list);
- cg.g_stackframe_entry(list,stackframe);
- if (cs_check_stack in aktlocalswitches) then
- cg.g_stackcheck(list,stackframe);
- end;
- if (cs_profile in aktmoduleswitches) and
- not(po_assembler in aktprocdef.procoptions) then
- cg.g_profilecode(list);
- end;
- { for the save all registers we can simply use a pusha,popa which
- push edi,esi,ebp,esp(ignored),ebx,edx,ecx,eax }
- if (po_saveregisters in aktprocdef.procoptions) then
- cg.g_save_all_registers(list)
- else
- { should we save edi,esi,ebx like C ? }
- if (po_savestdregs in aktprocdef.procoptions) then
- cg.g_save_standard_registers(list);
- { a constructor needs a help procedure }
- if (aktprocdef.proctypeoption=potype_constructor) then
- cg.g_call_constructor_helper(list);
- { don't load ESI, does the caller }
- { we must do it for local function }
- { that can be called from a foreach_static }
- { of another object than self !! PM }
- if assigned(procinfo^._class) and { !!!!! shouldn't we load ESI always? }
- (lexlevel>normal_function_level) then
- cg.g_maybe_loadself(list);
- { When message method contains self as a parameter,
- we must load it into ESI }
- If (po_containsself in aktprocdef.procoptions) then
- begin
- list.concat(Tairegalloc.Alloc(self_pointer_reg));
- reference_reset_base(href,procinfo^.framepointer,procinfo^.selfpointer_offset);
- cg.a_load_ref_reg(list,OS_ADDR,href,self_pointer_reg);
- end;
- { initialize return value }
- if (not is_void(aktprocdef.rettype.def)) and
- (aktprocdef.rettype.def.needs_inittable) then
- begin
- procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally;
- reference_reset_base(href,procinfo^.framepointer,procinfo^.return_offset);
- cg.g_initialize(list,aktprocdef.rettype.def,href,ret_in_param(aktprocdef.rettype.def));
- end;
- { initialisize local data like ansistrings }
- case aktprocdef.proctypeoption of
- potype_unitinit:
- begin
- { using current_module.globalsymtable is hopefully }
- { more robust than symtablestack and symtablestack.next }
- tsymtable(current_module.globalsymtable).foreach_static({$ifndef TP}@{$endif}initialize_data,list);
- tsymtable(current_module.localsymtable).foreach_static({$ifndef TP}@{$endif}initialize_data,list);
- end;
- { units have seperate code for initilization and finalization }
- potype_unitfinalize: ;
- else
- aktprocdef.localst.foreach_static({$ifndef TP}@{$endif}initialize_data,list);
- end;
- { initialisizes temp. ansi/wide string data }
- inittempvariables(list);
- { generate copies of call by value parameters }
- if not(po_assembler in aktprocdef.procoptions) and
- not(aktprocdef.proccalloption in [pocall_cdecl,pocall_cppdecl,pocall_palmossyscall,pocall_system]) then
- aktprocdef.parast.foreach_static({$ifndef TP}@{$endif}copyvalueparas,list);
- if assigned( aktprocdef.parast) then
- aktprocdef.parast.foreach_static({$ifndef TP}@{$endif}init_paras,list);
- if (not inlined) then
- begin
- { call startup helpers from main program }
- if (aktprocdef.proctypeoption=potype_proginit) then
- begin
- { initialize profiling for win32 }
- if (target_info.target in [target_I386_WIN32,target_I386_wdosx]) and
- (cs_profile in aktmoduleswitches) then
- cg.a_call_name(list,'__monstartup');
- { add local threadvars in units (only if needed because not all platforms
- have threadvar support) }
- if have_local_threadvars then
- cg.a_call_name(list,'FPC_INITIALIZELOCALTHREADVARS');
- { add global threadvars }
- p:=symtablestack;
- while assigned(p) do
- begin
- p.foreach_static({$ifndef TP}@{$endif}initialize_threadvar,list);
- p:=p.next;
- end;
- { initialize units }
- cg.a_call_name(list,'FPC_INITIALIZEUNITS');
- end;
- { do we need an exception frame because of ansi/widestrings/interfaces ? }
- if ((procinfo^.flags and pi_needs_implicit_finally)<>0) and
- { but it's useless in init/final code of units }
- not(aktprocdef.proctypeoption in [potype_unitfinalize,potype_unitinit]) then
- begin
- include(rg.usedinproc,accumulator);
- { allocate exception frame buffer }
- cg.a_op_const_reg(list,OP_SUB,36,STACK_POINTER_REG);
- tmpreg:=rg.getaddressregister(list);
- cg.a_load_reg_reg(list,OS_ADDR,STACK_POINTER_REG,tmpreg);
- reference_reset_base(tempbuf,tmpreg,0);
- cg.g_push_exception(list,tempbuf,1,aktexitlabel);
- reference_release(list,tempbuf);
- { probably we've to reload self here }
- cg.g_maybe_loadself(list);
- end;
- {$ifdef GDB}
- if (cs_debuginfo in aktmoduleswitches) then
- list.concat(Tai_force_line.Create);
- {$endif GDB}
- end;
- if inlined then
- load_regvars(list,nil);
- end;
- procedure genexitcode(list : TAAsmoutput;parasize:longint;nostackframe,inlined:boolean);
- var
- {$ifdef GDB}
- stabsendlabel : tasmlabel;
- mangled_length : longint;
- p : pchar;
- st : string[2];
- {$endif GDB}
- okexitlabel,
- noreraiselabel,nodestroycall : tasmlabel;
- tmpreg : tregister;
- href : treference;
- usesacc,
- usesacchi,
- usesself : boolean;
- pd : tprocdef;
- begin
- if aktexit2label.is_used and
- ((procinfo^.flags and (pi_needs_implicit_finally or pi_uses_exceptions)) <> 0) then
- begin
- cg.a_jmp_always(list,aktexitlabel);
- cg.a_label(list,aktexit2label);
- handle_fast_exit_return_value(list);
- end;
- if aktexitlabel.is_used then
- list.concat(Tai_label.Create(aktexitlabel));
- cleanup_regvars(list);
- { call the destructor help procedure }
- if (aktprocdef.proctypeoption=potype_destructor) and
- assigned(procinfo^._class) then
- cg.g_call_destructor_helper(list);
- { finalize temporary data }
- finalizetempvariables(list);
- { finalize local data like ansistrings}
- case aktprocdef.proctypeoption of
- potype_unitfinalize:
- begin
- { using current_module.globalsymtable is hopefully }
- { more robust than symtablestack and symtablestack.next }
- tsymtable(current_module.globalsymtable).foreach_static({$ifndef TP}@{$endif}finalize_data,list);
- tsymtable(current_module.localsymtable).foreach_static({$ifndef TP}@{$endif}finalize_data,list);
- end;
- { units have seperate code for initialization and finalization }
- potype_unitinit: ;
- else
- aktprocdef.localst.foreach_static({$ifndef TP}@{$endif}finalize_data,list);
- end;
- { finalize paras data }
- if assigned(aktprocdef.parast) then
- aktprocdef.parast.foreach_static({$ifndef TP}@{$endif}final_paras,list);
- { do we need to handle exceptions because of ansi/widestrings ? }
- if not inlined and
- ((procinfo^.flags and pi_needs_implicit_finally)<>0) and
- { but it's useless in init/final code of units }
- not(aktprocdef.proctypeoption in [potype_unitfinalize,potype_unitinit]) then
- begin
- { the exception helper routines modify all registers }
- aktprocdef.usedregisters:=all_registers;
- getlabel(noreraiselabel);
- cg.g_pop_exception(list,noreraiselabel);
- if (aktprocdef.proctypeoption=potype_constructor) then
- begin
- if assigned(procinfo^._class) then
- begin
- pd:=procinfo^._class.searchdestructor;
- if assigned(pd) then
- begin
- getlabel(nodestroycall);
- reference_reset_base(href,procinfo^.framepointer,procinfo^.selfpointer_offset);
- cg.a_cmp_const_ref_label(list,OS_ADDR,OC_EQ,0,href,nodestroycall);
- if is_class(procinfo^._class) then
- begin
- cg.a_param_const(list,OS_INT,1,2);
- cg.a_param_reg(list,OS_ADDR,self_pointer_reg,1);
- end
- else if is_object(procinfo^._class) then
- begin
- cg.a_param_reg(list,OS_ADDR,self_pointer_reg,2);
- reference_reset_symbol(href,newasmsymbol(procinfo^._class.vmt_mangledname),0);
- cg.a_paramaddr_ref(list,href,1);
- end
- else
- Internalerror(200006164);
- if (po_virtualmethod in pd.procoptions) then
- begin
- reference_reset_base(href,self_pointer_reg,0);
- tmpreg:=cg.get_scratch_reg(list);
- cg.a_load_ref_reg(list,OS_ADDR,href,tmpreg);
- reference_reset_base(href,tmpreg,procinfo^._class.vmtmethodoffset(pd.extnumber));
- cg.free_scratch_reg(list,tmpreg);
- cg.a_call_ref(list,href);
- end
- else
- cg.a_call_name(list,pd.mangledname);
- { not necessary because the result is never assigned in the
- case of an exception (FK) }
- cg.a_label(list,nodestroycall);
- end;
- end
- end
- else
- begin
- { no constructor }
- { must be the return value finalized before reraising the exception? }
- if (not is_void(aktprocdef.rettype.def)) and
- (aktprocdef.rettype.def.needs_inittable) and
- ((aktprocdef.rettype.def.deftype<>objectdef) or
- not is_class(aktprocdef.rettype.def)) then
- begin
- reference_reset_base(href,procinfo^.framepointer,procinfo^.return_offset);
- cg.g_finalize(list,aktprocdef.rettype.def,href,ret_in_param(aktprocdef.rettype.def));
- end;
- end;
- cg.a_call_name(list,'FPC_RERAISE');
- cg.a_label(list,noreraiselabel);
- end;
- { call __EXIT for main program }
- if (not DLLsource) and
- (not inlined) and
- (aktprocdef.proctypeoption=potype_proginit) then
- cg.a_call_name(list,'FPC_DO_EXIT');
- { handle return value, this is not done for assembler routines when
- they didn't reference the result variable }
- usesacc:=false;
- usesacchi:=false;
- usesself:=false;
- if not(po_assembler in aktprocdef.procoptions) or
- (assigned(aktprocdef.funcretsym) and
- (tfuncretsym(aktprocdef.funcretsym).refcount>1)) then
- begin
- if (aktprocdef.proctypeoption<>potype_constructor) then
- handle_return_value(list,inlined,usesacc,usesacchi)
- else
- begin
- { successful constructor deletes the zero flag }
- { and returns self in eax }
- { eax must be set to zero if the allocation failed !!! }
- getlabel(okexitlabel);
- cg.a_jmp_always(list,okexitlabel);
- cg.a_label(list,faillabel);
- cg.g_call_fail_helper(list);
- cg.a_label(list,okexitlabel);
- { for classes this is done after the call to }
- { AfterConstruction }
- if is_object(procinfo^._class) then
- begin
- cg.a_reg_alloc(list,accumulator);
- cg.a_load_reg_reg(list,OS_ADDR,self_pointer_reg,accumulator);
- usesacc:=true;
- end;
- {$ifdef i386}
- list.concat(taicpu.op_reg_reg(A_TEST,S_L,R_ESI,R_ESI));
- {$else}
- {$warning constructor returns in flags for i386}
- {$endif i386}
- usesself:=true;
- end;
- end;
- if aktexit2label.is_used and not aktexit2label.is_set then
- cg.a_label(list,aktexit2label);
- {$ifdef GDB}
- if ((cs_debuginfo in aktmoduleswitches) and not inlined) then
- begin
- getlabel(stabsendlabel);
- cg.a_label(list,stabsendlabel);
- end;
- {$endif GDB}
- { for the save all registers we can simply use a pusha,popa which
- push edi,esi,ebp,esp(ignored),ebx,edx,ecx,eax }
- if (po_saveregisters in aktprocdef.procoptions) then
- cg.g_restore_all_registers(list,usesself,usesacc,usesacchi)
- else
- { should we restore edi ? }
- if (po_savestdregs in aktprocdef.procoptions) then
- cg.g_restore_standard_registers(list);
- { remove stackframe }
- if not inlined then
- begin
- if (not nostackframe) then
- cg.g_restore_frame_pointer(list)
- else
- if (tg.gettempsize<>0) then
- cg.a_op_const_reg(list,OP_ADD,tg.gettempsize,STACK_POINTER_REG);
- end;
- { at last, the return is generated }
- if not inlined then
- begin
- if (po_interrupt in aktprocdef.procoptions) then
- cg.g_interrupt_stackframe_exit(list,usesself,usesacc,usesacchi)
- else
- cg.g_return_from_proc(list,parasize);
- end;
- if not inlined then
- list.concat(Tai_symbol_end.Createname(aktprocdef.mangledname));
- {$ifdef GDB}
- if (cs_debuginfo in aktmoduleswitches) and not inlined then
- begin
- if assigned(procinfo^._class) then
- if (not assigned(procinfo^.parent) or
- not assigned(procinfo^.parent^._class)) then
- begin
- if (po_classmethod in aktprocdef.procoptions) or
- ((po_virtualmethod in aktprocdef.procoptions) and
- (potype_constructor=aktprocdef.proctypeoption)) or
- (po_staticmethod in aktprocdef.procoptions) then
- begin
- list.concat(Tai_stabs.Create(strpnew(
- '"pvmt:p'+tstoreddef(pvmttype.def).numberstring+'",'+
- tostr(N_tsym)+',0,0,'+tostr(procinfo^.selfpointer_offset))));
- end
- else
- begin
- if not(is_class(procinfo^._class)) then
- st:='v'
- else
- st:='p';
- list.concat(Tai_stabs.Create(strpnew(
- '"$t:'+st+procinfo^._class.numberstring+'",'+
- tostr(N_tsym)+',0,0,'+tostr(procinfo^.selfpointer_offset))));
- end;
- end
- else
- begin
- if not is_class(procinfo^._class) then
- st:='*'
- else
- st:='';
- list.concat(Tai_stabs.Create(strpnew(
- '"$t:r'+st+procinfo^._class.numberstring+'",'+
- tostr(N_RSYM)+',0,0,'+tostr(GDB_i386index[SELF_POINTER_REG]))));
- end;
- { define calling EBP as pseudo local var PM }
- { this enables test if the function is a local one !! }
- if assigned(procinfo^.parent) and (lexlevel>normal_function_level) then
- list.concat(Tai_stabs.Create(strpnew(
- '"parent_ebp:'+tstoreddef(voidpointertype.def).numberstring+'",'+
- tostr(N_LSYM)+',0,0,'+tostr(procinfo^.framepointer_offset))));
- if (not is_void(aktprocdef.rettype.def)) then
- begin
- if ret_in_param(aktprocdef.rettype.def) then
- list.concat(Tai_stabs.Create(strpnew(
- '"'+aktprocsym.name+':X*'+tstoreddef(aktprocdef.rettype.def).numberstring+'",'+
- tostr(N_tsym)+',0,0,'+tostr(procinfo^.return_offset))))
- else
- list.concat(Tai_stabs.Create(strpnew(
- '"'+aktprocsym.name+':X'+tstoreddef(aktprocdef.rettype.def).numberstring+'",'+
- tostr(N_tsym)+',0,0,'+tostr(procinfo^.return_offset))));
- if (m_result in aktmodeswitches) then
- if ret_in_param(aktprocdef.rettype.def) then
- list.concat(Tai_stabs.Create(strpnew(
- '"RESULT:X*'+tstoreddef(aktprocdef.rettype.def).numberstring+'",'+
- tostr(N_tsym)+',0,0,'+tostr(procinfo^.return_offset))))
- else
- list.concat(Tai_stabs.Create(strpnew(
- '"RESULT:X'+tstoreddef(aktprocdef.rettype.def).numberstring+'",'+
- tostr(N_tsym)+',0,0,'+tostr(procinfo^.return_offset))));
- end;
- mangled_length:=length(aktprocdef.mangledname);
- getmem(p,2*mangled_length+50);
- strpcopy(p,'192,0,0,');
- strpcopy(strend(p),aktprocdef.mangledname);
- if (target_info.use_function_relative_addresses) then
- begin
- strpcopy(strend(p),'-');
- strpcopy(strend(p),aktprocdef.mangledname);
- end;
- list.concat(Tai_stabn.Create(strnew(p)));
- {List.concat(Tai_stabn.Create(strpnew('192,0,0,'
- +aktprocdef.mangledname))));
- p[0]:='2';p[1]:='2';p[2]:='4';
- strpcopy(strend(p),'_end');}
- strpcopy(p,'224,0,0,'+stabsendlabel.name);
- if (target_info.use_function_relative_addresses) then
- begin
- strpcopy(strend(p),'-');
- strpcopy(strend(p),aktprocdef.mangledname);
- end;
- list.concatlist(withdebuglist);
- list.concat(Tai_stabn.Create(strnew(p)));
- { strpnew('224,0,0,'
- +aktprocdef.mangledname+'_end'))));}
- freemem(p,2*mangled_length+50);
- end;
- {$endif GDB}
- if inlined then
- cleanup_regvars(list);
- end;
- procedure genimplicitunitinit(list : TAAsmoutput);
- begin
- { using current_module.globalsymtable is hopefully }
- { more robust than symtablestack and symtablestack.next }
- tsymtable(current_module.globalsymtable).foreach_static({$ifdef FPCPROCVAR}@{$endif}finalize_data,list);
- tsymtable(current_module.localsymtable).foreach_static({$ifdef FPCPROCVAR}@{$endif}finalize_data,list);
- list.insert(Tai_symbol.Createname_global('INIT$$'+current_module.modulename^,0));
- list.insert(Tai_symbol.Createname_global(target_info.cprefix+current_module.modulename^+'_init',0));
- {$ifdef GDB}
- if (cs_debuginfo in aktmoduleswitches) and
- target_info.use_function_relative_addresses then
- list.insert(Tai_stab_function_name.Create(strpnew('INIT$$'+current_module.modulename^)));
- {$endif GDB}
- cg.g_return_from_proc(list,0);
- end;
- procedure genimplicitunitfinal(list : TAAsmoutput);
- begin
- { using current_module.globalsymtable is hopefully }
- { more robust than symtablestack and symtablestack.next }
- tsymtable(current_module.globalsymtable).foreach_static({$ifdef FPCPROCVAR}@{$endif}finalize_data,list);
- tsymtable(current_module.localsymtable).foreach_static({$ifdef FPCPROCVAR}@{$endif}finalize_data,list);
- list.insert(Tai_symbol.Createname_global('FINALIZE$$'+current_module.modulename^,0));
- list.insert(Tai_symbol.Createname_global(target_info.cprefix+current_module.modulename^+'_finalize',0));
- {$ifdef GDB}
- if (cs_debuginfo in aktmoduleswitches) and
- target_info.use_function_relative_addresses then
- list.insert(Tai_stab_function_name.Create(strpnew('FINALIZE$$'+current_module.modulename^)));
- {$endif GDB}
- cg.g_return_from_proc(list,0);
- end;
- end.
- {
- $Log$
- Revision 1.15 2002-05-16 19:46:37 carl
- + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
- + try to fix temp allocation (still in ifdef)
- + generic constructor calls
- + start of tassembler / tmodulebase class cleanup
- Revision 1.13 2002/05/13 19:54:37 peter
- * removed n386ld and n386util units
- * maybe_save/maybe_restore added instead of the old maybe_push
- Revision 1.12 2002/05/12 19:58:36 carl
- * some small portability fixes
- Revision 1.11 2002/05/12 16:53:07 peter
- * moved entry and exitcode to ncgutil and cgobj
- * foreach gets extra argument for passing local data to the
- iterator function
- * -CR checks also class typecasts at runtime by changing them
- into as
- * fixed compiler to cycle with the -CR option
- * fixed stabs with elf writer, finally the global variables can
- be watched
- * removed a lot of routines from cga unit and replaced them by
- calls to cgobj
- * u32bit-s32bit updates for and,or,xor nodes. When one element is
- u32bit then the other is typecasted also to u32bit without giving
- a rangecheck warning/error.
- * fixed pascal calling method with reversing also the high tree in
- the parast, detected by tcalcst3 test
- Revision 1.10 2002/04/21 19:02:03 peter
- * removed newn and disposen nodes, the code is now directly
- inlined from pexpr
- * -an option that will write the secondpass nodes to the .s file, this
- requires EXTDEBUG define to actually write the info
- * fixed various internal errors and crashes due recent code changes
- Revision 1.9 2002/04/21 15:24:38 carl
- + a_jmp_cond -> a_jmp_always (a_jmp_cond is NOT portable)
- + changeregsize -> rg.makeregsize
- Revision 1.8 2002/04/19 15:39:34 peter
- * removed some more routines from cga
- * moved location_force_reg/mem to ncgutil
- * moved arrayconstructnode secondpass to ncgld
- Revision 1.7 2002/04/15 18:58:47 carl
- + target_info.size_of_pointer -> pointer_Size
- Revision 1.6 2002/04/06 18:10:42 jonas
- * several powerpc-related additions and fixes
- Revision 1.5 2002/04/04 19:05:57 peter
- * removed unused units
- * use tlocation.size in cg.a_*loc*() routines
- Revision 1.4 2002/04/02 17:11:28 peter
- * tlocation,treference update
- * LOC_CONSTANT added for better constant handling
- * secondadd splitted in multiple routines
- * location_force_reg added for loading a location to a register
- of a specified size
- * secondassignment parses now first the right and then the left node
- (this is compatible with Kylix). This saves a lot of push/pop especially
- with string operations
- * adapted some routines to use the new cg methods
- Revision 1.3 2002/03/31 20:26:34 jonas
- + a_loadfpu_* and a_loadmm_* methods in tcg
- * register allocation is now handled by a class and is mostly processor
- independent (+rgobj.pas and i386/rgcpu.pas)
- * temp allocation is now handled by a class (+tgobj.pas, -i386\tgcpu.pas)
- * some small improvements and fixes to the optimizer
- * some register allocation fixes
- * some fpuvaroffset fixes in the unary minus node
- * push/popusedregisters is now called rg.save/restoreusedregisters and
- (for i386) uses temps instead of push/pop's when using -Op3 (that code is
- also better optimizable)
- * fixed and optimized register saving/restoring for new/dispose nodes
- * LOC_FPU locations now also require their "register" field to be set to
- R_ST, not R_ST0 (the latter is used for LOC_CFPUREGISTER locations only)
- - list field removed of the tnode class because it's not used currently
- and can cause hard-to-find bugs
- Revision 1.2 2002/03/04 19:10:11 peter
- * removed compiler warnings
- Revision 1.1 2001/12/30 17:24:48 jonas
- * range checking is now processor independent (part in cgobj,
- part in cg64f32) and should work correctly again (it needed
- some changes after the changes of the low and high of
- tordef's to int64)
- * maketojumpbool() is now processor independent (in ncgutil)
- * getregister32 is now called getregisterint
- }
|