1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618 |
- {
- Id: ncgcal.pas,v 1.10 2002/08/17 09:23:35 florian Exp $
- Copyright (c) 1998-2002 by Florian Klaempfl
- Generate i386 assembler for in call 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 bymethodpointer
- 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 ncgcal;
- {$i fpcdefs.inc}
- interface
- { $define AnsiStrRef}
- uses
- cpubase,
- globtype,
- symdef,node,ncal;
- type
- tcgcallparanode = class(tcallparanode)
- procedure secondcallparan(push_from_left_to_right:boolean;calloption:tproccalloption;
- para_alignment,para_offset : longint);override;
- end;
- tcgcallnode = class(tcallnode)
- private
- function push_self_and_vmt(needvmtreg:boolean):tregister;
- protected
- funcretref : treference;
- refcountedtemp : treference;
- procedure handle_return_value(inlined:boolean);
- {# This routine is used to push the current frame pointer
- on the stack. This is used in nested routines where the
- value of the frame pointer is always pushed as an extra
- parameter.
- The default handling is the standard handling used on
- most stack based machines, where the frame pointer is
- the first invisible parameter.
- }
- function align_parasize(parasize,para_alignment:longint):longint;virtual;
- procedure pop_parasize(pop_size:longint);virtual;
- procedure push_framepointer;virtual;
- procedure extra_interrupt_code;virtual;
- public
- procedure pass_2;override;
- end;
- tcgprocinlinenode = class(tprocinlinenode)
- procedure pass_2;override;
- end;
- implementation
- uses
- systems,
- cutils,verbose,globals,
- symconst,symbase,symsym,symtable,defutil,paramgr,
- {$ifdef GDB}
- {$ifdef delphi}
- sysutils,
- {$else}
- strings,
- {$endif}
- gdb,
- {$endif GDB}
- cginfo,cgbase,pass_2,
- cpuinfo,cpupi,aasmbase,aasmtai,aasmcpu,
- nbas,nmem,nld,ncnv,
- {$ifdef i386}
- cga,
- {$endif i386}
- cg64f32,ncgutil,cgobj,tgobj,regvars,rgobj,rgcpu,cgcpu;
- {*****************************************************************************
- TCGCALLPARANODE
- *****************************************************************************}
- procedure tcgcallparanode.secondcallparan(push_from_left_to_right:boolean;calloption:tproccalloption;para_alignment,para_offset : longint);
- var
- otlabel,oflabel : tasmlabel;
- tempdeftype : tdeftype;
- tmpreg : tregister;
- href : treference;
- begin
- { set default para_alignment to target_info.stackalignment }
- if para_alignment=0 then
- para_alignment:=aktalignment.paraalign;
- { push from left to right if specified }
- if push_from_left_to_right and assigned(right) then
- begin
- if (nf_varargs_para in flags) then
- tcallparanode(right).secondcallparan(push_from_left_to_right,
- calloption,para_alignment,para_offset)
- else
- tcallparanode(right).secondcallparan(push_from_left_to_right,
- calloption,para_alignment,para_offset);
- end;
- otlabel:=truelabel;
- oflabel:=falselabel;
- objectlibrary.getlabel(truelabel);
- objectlibrary.getlabel(falselabel);
- secondpass(left);
- { handle varargs first, because defcoll is not valid }
- if (nf_varargs_para in flags) then
- begin
- if paramanager.push_addr_param(left.resulttype.def,calloption) then
- begin
- inc(pushedparasize,POINTER_SIZE);
- cg.a_paramaddr_ref(exprasmlist,left.location.reference,paraitem.paraloc);
- location_release(exprasmlist,left.location);
- end
- else
- push_value_para(exprasmlist,left,calloption,para_offset,para_alignment,paraitem.paraloc);
- end
- { filter array constructor with c styled args }
- else if is_array_constructor(left.resulttype.def) and (nf_cargs in left.flags) then
- begin
- { nothing, everything is already pushed }
- end
- { in codegen.handleread.. paraitem.data is set to nil }
- else if assigned(paraitem.paratype.def) and
- (paraitem.paratype.def.deftype=formaldef) then
- begin
- { allow passing of a constant to a const formaldef }
- if (paraitem.paratyp=vs_const) and
- (left.location.loc=LOC_CONSTANT) then
- location_force_mem(exprasmlist,left.location);
- { allow @var }
- inc(pushedparasize,POINTER_SIZE);
- if (left.nodetype=addrn) and
- (not(nf_procvarload in left.flags)) then
- begin
- if calloption=pocall_inline then
- begin
- reference_reset_base(href,procinfo.framepointer,para_offset-pushedparasize);
- cg.a_load_loc_ref(exprasmlist,left.location,href);
- end
- else
- cg.a_param_loc(exprasmlist,left.location,paraitem.paraloc);
- location_release(exprasmlist,left.location);
- end
- else
- begin
- if not(left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) then
- begin
- CGMessage(type_e_mismatch)
- end
- else
- begin
- if calloption=pocall_inline then
- begin
- tmpreg:=cg.get_scratch_reg_address(exprasmlist);
- cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,tmpreg);
- reference_reset_base(href,procinfo.framepointer,para_offset-pushedparasize);
- cg.a_load_reg_ref(exprasmlist,OS_ADDR,tmpreg,href);
- cg.free_scratch_reg(exprasmlist,tmpreg);
- end
- else
- cg.a_paramaddr_ref(exprasmlist,left.location.reference,paraitem.paraloc);
- location_release(exprasmlist,left.location);
- end;
- end;
- end
- { handle call by reference parameter }
- else if (paraitem.paratyp in [vs_var,vs_out]) then
- begin
- if (left.location.loc<>LOC_REFERENCE) then
- begin
- { passing self to a var parameter is allowed in
- TP and delphi }
- if not((left.location.loc=LOC_CREFERENCE) and
- (left.nodetype=selfn)) then
- internalerror(200106041);
- end;
- if (paraitem.paratyp=vs_out) and
- assigned(paraitem.paratype.def) and
- not is_class(paraitem.paratype.def) and
- paraitem.paratype.def.needs_inittable then
- cg.g_finalize(exprasmlist,paraitem.paratype.def,left.location.reference,false);
- inc(pushedparasize,POINTER_SIZE);
- if calloption=pocall_inline then
- begin
- tmpreg:=cg.get_scratch_reg_address(exprasmlist);
- cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,tmpreg);
- reference_reset_base(href,procinfo.framepointer,para_offset-pushedparasize);
- cg.a_load_reg_ref(exprasmlist,OS_ADDR,tmpreg,href);
- cg.free_scratch_reg(exprasmlist,tmpreg);
- end
- else
- cg.a_paramaddr_ref(exprasmlist,left.location.reference,paraitem.paraloc);
- location_release(exprasmlist,left.location);
- end
- else
- begin
- tempdeftype:=resulttype.def.deftype;
- if tempdeftype=filedef then
- CGMessage(cg_e_file_must_call_by_reference);
- { open array must always push the address, this is needed to
- also push addr of small open arrays and with cdecl functions (PFV) }
- if (
- assigned(paraitem.paratype.def) and
- (is_open_array(paraitem.paratype.def) or
- is_array_of_const(paraitem.paratype.def))
- ) or
- (
- paramanager.push_addr_param(resulttype.def,calloption)
- ) then
- begin
- if not(left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) then
- begin
- { allow passing nil to a procvardef (methodpointer) }
- if (left.nodetype=typeconvn) and
- (left.resulttype.def.deftype=procvardef) and
- (ttypeconvnode(left).left.nodetype=niln) then
- begin
- tg.GetTemp(exprasmlist,tcgsize2size[left.location.size],tt_normal,href);
- if not (left.location.size in [OS_64,OS_S64]) then
- cg.a_load_loc_ref(exprasmlist,left.location,href)
- else
- cg64.a_load64_loc_ref(exprasmlist,left.location,href);
- location_reset(left.location,LOC_REFERENCE,left.location.size);
- left.location.reference:=href;
- end
- else
- internalerror(200204011);
- end;
- inc(pushedparasize,POINTER_SIZE);
- if calloption=pocall_inline then
- begin
- tmpreg:=cg.get_scratch_reg_address(exprasmlist);
- cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,tmpreg);
- reference_reset_base(href,procinfo.framepointer,para_offset-pushedparasize);
- cg.a_load_reg_ref(exprasmlist,OS_ADDR,tmpreg,href);
- cg.free_scratch_reg(exprasmlist,tmpreg);
- end
- else
- cg.a_paramaddr_ref(exprasmlist,left.location.reference,paraitem.paraloc);
- location_release(exprasmlist,left.location);
- end
- else
- begin
- push_value_para(exprasmlist,left,calloption,
- para_offset,para_alignment,paraitem.paraloc);
- end;
- end;
- truelabel:=otlabel;
- falselabel:=oflabel;
- { push from right to left }
- if not push_from_left_to_right and assigned(right) then
- begin
- if (nf_varargs_para in flags) then
- tcallparanode(right).secondcallparan(push_from_left_to_right,
- calloption,para_alignment,para_offset)
- else
- tcallparanode(right).secondcallparan(push_from_left_to_right,
- calloption,para_alignment,para_offset);
- end;
- end;
- {*****************************************************************************
- TCGCALLNODE
- *****************************************************************************}
- procedure tcgcallnode.extra_interrupt_code;
- begin
- end;
- function tcgcallnode.align_parasize(parasize,para_alignment:longint):longint;
- begin
- result:=0;
- end;
- procedure tcgcallnode.pop_parasize(pop_size:longint);
- begin
- end;
- function tcgcallnode.push_self_and_vmt(needvmtreg:boolean):tregister;
- var
- href : treference;
- vmtloc,selfloc : tlocation;
- self_is_vmt,
- vmtrefaddr,
- selfrefaddr : boolean;
- procedure selfloc_to_register;
- var
- hregister : tregister;
- begin
- case selfloc.loc of
- LOC_REGISTER :
- hregister:=selfloc.register;
- LOC_CREFERENCE,
- LOC_REFERENCE :
- begin
- hregister:=rg.getaddressregister(exprasmlist);
- if selfrefaddr then
- begin
- cg.a_loadaddr_ref_reg(exprasmlist,selfloc.reference,hregister);
- selfrefaddr:=false;
- end
- else
- cg.a_load_ref_reg(exprasmlist,OS_ADDR,selfloc.reference,hregister);
- reference_release(exprasmlist,selfloc.reference);
- end;
- else
- internalerror(200303269);
- end;
- location_reset(selfloc,LOC_REGISTER,OS_ADDR);
- selfloc.register:=hregister;
- end;
- begin
- result.enum:=R_INTREGISTER;
- result.number:=NR_NO;
- location_reset(vmtloc,LOC_CONSTANT,OS_ADDR);
- location_reset(selfloc,LOC_CONSTANT,OS_ADDR);
- vmtrefaddr:=false;
- selfrefaddr:=false;
- self_is_vmt:=false;
- { generate fake methodpointer node for withsymtable }
- if (symtableproc.symtabletype=withsymtable) then
- begin
- methodpointer:=cnothingnode.create;
- methodpointer.resulttype:=twithnode(twithsymtable(symtableproc).withnode).left.resulttype;
- end;
- if assigned(methodpointer) then
- begin
- case methodpointer.nodetype of
- typen:
- begin
- if (sp_static in symtableprocentry.symoptions) then
- begin
- self_is_vmt:=true;
- if (oo_has_vmt in tobjectdef(methodpointer.resulttype.def).objectoptions) then
- begin
- location_reset(vmtloc,LOC_REFERENCE,OS_NO);
- reference_reset_symbol(vmtloc.reference,objectlibrary.newasmsymboldata(tobjectdef(methodpointer.resulttype.def).vmt_mangledname),0);
- vmtrefaddr:=true;
- end;
- end
- else
- begin
- { normal member call, load self. Not for classes
- when we call the constructor }
- if not(
- is_class(methodpointer.resulttype.def) and
- (procdefinition.proctypeoption=potype_constructor) and
- (aktprocdef.proctypeoption<>potype_constructor)
- ) then
- begin
- location_reset(selfloc,LOC_REGISTER,OS_ADDR);
- selfloc.register:=cg.g_load_self(exprasmlist);
- end;
- end;
- if (procdefinition.proctypeoption in [potype_constructor,potype_destructor]) then
- begin
- if is_object(methodpointer.resulttype.def) then
- begin
- { object }
- { if an inherited con- or destructor should be }
- { called in a con- or destructor then a warning }
- { will be made }
- { con- and destructors need a pointer to the vmt }
- if not(aktprocdef.proctypeoption in
- [potype_constructor,potype_destructor]) then
- CGMessage(cg_w_member_cd_call_from_method);
- { reset self when calling constructor from destructor }
- if (procdefinition.proctypeoption=potype_constructor) and
- assigned(aktprocdef) and
- (aktprocdef.proctypeoption=potype_destructor) then
- begin
- location_release(exprasmlist,selfloc);
- location_reset(selfloc,LOC_CONSTANT,OS_ADDR);
- end;
- end;
- end;
- end;
- hnewn:
- begin
- { constructor with extended syntax called from new }
- { vmt }
- location_reset(vmtloc,LOC_REFERENCE,OS_ADDR);
- reference_reset_symbol(vmtloc.reference,objectlibrary.newasmsymboldata(tobjectdef(methodpointer.resulttype.def).vmt_mangledname),0);
- vmtrefaddr:=true;
- end;
- hdisposen:
- begin
- { destructor with extended syntax called from dispose }
- { hdisposen always deliver LOC_REFERENCE }
- secondpass(methodpointer);
- { vmt }
- location_reset(vmtloc,LOC_REFERENCE,OS_ADDR);
- reference_reset_symbol(vmtloc.reference,objectlibrary.newasmsymboldata(tobjectdef(methodpointer.resulttype.def).vmt_mangledname),0);
- vmtrefaddr:=true;
- { self, load in register first when it requires a virtual call }
- location_reset(selfloc,LOC_REFERENCE,OS_ADDR);
- selfloc.reference:=methodpointer.location.reference;
- selfrefaddr:=true;
- end;
- else
- begin
- { call to an instance member }
- if (symtableproc.symtabletype<>withsymtable) then
- begin
- secondpass(methodpointer);
- case methodpointer.location.loc of
- LOC_CREGISTER,
- LOC_REGISTER:
- begin
- location_reset(selfloc,LOC_REGISTER,OS_ADDR);
- selfloc.register:=methodpointer.location.register;
- end;
- LOC_CREFERENCE,
- LOC_REFERENCE :
- begin
- location_reset(selfloc,LOC_REFERENCE,OS_ADDR);
- selfloc.reference:=methodpointer.location.reference;
- if (methodpointer.resulttype.def.deftype<>classrefdef) and
- not(is_class_or_interface(methodpointer.resulttype.def)) then
- selfrefaddr:=true;
- end;
- else
- internalerror(200303212);
- end;
- end
- else
- begin
- location_reset(selfloc,LOC_REFERENCE,OS_ADDR);
- selfloc.reference:=twithnode(twithsymtable(symtableproc).withnode).withreference;
- if (nf_islocal in twithnode(twithsymtable(symtableproc).withnode).flags) and
- (twithsymtable(symtableproc).direct_with) and
- not(is_class_or_interface(twithnode(twithsymtable(symtableproc).withnode).left.resulttype.def)) then
- selfrefaddr:=true;
- end;
- if (po_staticmethod in procdefinition.procoptions) or
- (po_classmethod in procdefinition.procoptions) then
- begin
- self_is_vmt:=true;
- { classref are already loaded with VMT }
- if (methodpointer.resulttype.def.deftype=classrefdef) then
- location_copy(vmtloc,selfloc)
- else
- begin
- if (oo_has_vmt in tprocdef(procdefinition)._class.objectoptions) then
- begin
- { load VMT from passed self }
- selfloc_to_register;
- cg.g_maybe_testself(exprasmlist,selfloc.register);
- location_copy(vmtloc,selfloc);
- reference_reset_base(href,vmtloc.register,tprocdef(procdefinition)._class.vmt_offset);
- cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,vmtloc.register);
- end;
- end;
- { reset self }
- location_reset(selfloc,LOC_CONSTANT,OS_ADDR);
- end;
- if (procdefinition.proctypeoption in [potype_constructor,potype_destructor]) then
- begin
- { constructor call via classreference => allocate memory }
- if (methodpointer.resulttype.def.deftype=classrefdef) then
- begin
- if (procdefinition.proctypeoption=potype_constructor) and
- is_class(tclassrefdef(methodpointer.resulttype.def).pointertype.def) then
- begin
- self_is_vmt:=true;
- { vmt load from provided methodpointer that
- was already loaded in selfloc }
- location_copy(vmtloc,selfloc);
- { reset self }
- location_reset(selfloc,LOC_CONSTANT,OS_ADDR);
- end;
- end
- else
- { class }
- if is_class(methodpointer.resulttype.def) then
- begin
- { destructor: release instance, flag(vmt)=1
- constructor: direct call, do nothing, leave vmt=0 }
- if (procdefinition.proctypeoption=potype_destructor) then
- begin
- { flag 1 for destructor: remove data }
- location_reset(vmtloc,LOC_CONSTANT,OS_ADDR);
- vmtloc.value:=1;
- end;
- end
- else
- { object }
- begin
- { destructor: direct call, no dispose, vmt=0
- constructor: initialize object, load vmt }
- if (procdefinition.proctypeoption=potype_constructor) then
- begin
- { vmt }
- location_reset(vmtloc,LOC_REFERENCE,OS_ADDR);
- reference_reset_symbol(vmtloc.reference,objectlibrary.newasmsymboldata(
- tobjectdef(methodpointer.resulttype.def).vmt_mangledname),0);
- vmtrefaddr:=true;
- end;
- end;
- end;
- end;
- end;
- end
- else
- { No methodpointer }
- begin
- if (po_staticmethod in procdefinition.procoptions) or
- (po_classmethod in procdefinition.procoptions) then
- begin
- self_is_vmt:=true;
- { Load VMT from self? }
- if (
- (po_classmethod in procdefinition.procoptions) and
- not(assigned(aktprocdef) and
- (po_classmethod in aktprocdef.procoptions))
- ) or
- (
- (po_staticmethod in procdefinition.procoptions) and
- not(assigned(aktprocdef) and
- (po_staticmethod in aktprocdef.procoptions))
- ) then
- begin
- if (oo_has_vmt in tprocdef(procdefinition)._class.objectoptions) then
- begin
- { load vmt from self passed to the current method }
- location_reset(vmtloc,LOC_REGISTER,OS_ADDR);
- vmtloc.register:=cg.g_load_self(exprasmlist);
- cg.g_maybe_testself(exprasmlist,vmtloc.register);
- reference_reset_base(href,vmtloc.register,tprocdef(procdefinition)._class.vmt_offset);
- cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,vmtloc.register);
- end;
- end
- else
- begin
- { self is already VMT }
- location_reset(vmtloc,LOC_REGISTER,OS_ADDR);
- vmtloc.register:=cg.g_load_self(exprasmlist);
- end;
- end
- else
- begin
- { member call, load self }
- location_reset(selfloc,LOC_REGISTER,OS_ADDR);
- selfloc.register:=cg.g_load_self(exprasmlist);
- end;
- end;
- { Do we need to push the VMT as self for
- class methods and static methods? }
- if self_is_vmt then
- begin
- location_release(exprasmlist,selfloc);
- location_copy(selfloc,vmtloc);
- selfrefaddr:=vmtrefaddr;
- end;
- { when we need the vmt in a register then we already
- load self in a register so it can generate optimized code }
- if needvmtreg then
- selfloc_to_register;
- { constructor/destructor need vmt }
- if (procdefinition.proctypeoption in [potype_constructor,potype_destructor]) then
- begin
- if vmtrefaddr then
- cg.a_paramaddr_ref(exprasmlist,vmtloc.reference,paramanager.getintparaloc(2))
- else
- cg.a_param_loc(exprasmlist,vmtloc,paramanager.getintparaloc(2));
- end;
- if not self_is_vmt then
- location_release(exprasmlist,vmtloc);
- { push self }
- if selfrefaddr then
- cg.a_paramaddr_ref(exprasmlist,selfloc.reference,paramanager.getintparaloc(1))
- else
- cg.a_param_loc(exprasmlist,selfloc,paramanager.getintparaloc(1));
- if needvmtreg then
- begin
- { self should already be loaded in a register }
- if selfloc.register.number=NR_NO then
- internalerror(2003032611);
- { load vmt from self, this is already done
- for static/class methods }
- if not self_is_vmt then
- begin
- cg.g_maybe_testself(exprasmlist,selfloc.register);
- { this is one point where we need vmt_offset (PM) }
- reference_reset_base(href,selfloc.register,tprocdef(procdefinition)._class.vmt_offset);
- cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,selfloc.register);
- end;
- result:=selfloc.register;
- end
- else
- location_release(exprasmlist,selfloc);
- end;
- procedure tcgcallnode.push_framepointer;
- var
- href : treference;
- hregister : tregister;
- i : integer;
- begin
- { this routine is itself not nested }
- if lexlevel=(tprocdef(procdefinition).parast.symtablelevel) then
- begin
- reference_reset_base(href,procinfo.framepointer,procinfo.framepointer_offset);
- cg.a_param_ref(exprasmlist,OS_ADDR,href,paramanager.getintparaloc(1));
- end
- { one nesting level }
- else if (lexlevel=(tprocdef(procdefinition).parast.symtablelevel)-1) then
- begin
- cg.a_param_reg(exprasmlist,OS_ADDR,procinfo.framepointer,paramanager.getintparaloc(1));
- end
- { very complex nesting level ... }
- else if (lexlevel>(tprocdef(procdefinition).parast.symtablelevel)) then
- begin
- hregister:=rg.getaddressregister(exprasmlist);
- reference_reset_base(href,procinfo.framepointer,procinfo.framepointer_offset);
- cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,hregister);
- for i:=(tprocdef(procdefinition).parast.symtablelevel) to lexlevel-1 do
- begin
- reference_reset_base(href,hregister,procinfo.framepointer_offset);
- cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,hregister);
- end;
- cg.a_param_reg(exprasmlist,OS_ADDR,hregister,paramanager.getintparaloc(1));
- rg.ungetaddressregister(exprasmlist,hregister);
- end;
- end;
- procedure tcgcallnode.handle_return_value(inlined:boolean);
- var
- cgsize : tcgsize;
- r,hregister : tregister;
- nr:Tnewregister;
- begin
- { structured results are easy to handle.... }
- { needed also when result_no_used !! }
- if paramanager.ret_in_param(resulttype.def,procdefinition.proccalloption) then
- begin
- location_reset(location,LOC_CREFERENCE,def_cgsize(resulttype.def));
- location.reference.symbol:=nil;
- location.reference:=funcretref;
- end
- else
- { ansi/widestrings must be registered, so we can dispose them }
- if is_ansistring(resulttype.def) or
- is_widestring(resulttype.def) then
- begin
- location_reset(location,LOC_CREFERENCE,OS_ADDR);
- location.reference:=refcountedtemp;
- r.enum:=accumulator;
- cg.a_reg_alloc(exprasmlist,r);
- cg.a_load_reg_ref(exprasmlist,OS_ADDR,r,location.reference);
- cg.a_reg_dealloc(exprasmlist,r);
- end
- else
- { we have only to handle the result if it is used }
- if (nf_return_value_used in flags) then
- begin
- case resulttype.def.deftype of
- enumdef,
- orddef :
- begin
- cgsize:=def_cgsize(resulttype.def);
- { an object constructor is a function with pointer result }
- if (inlined or (right=nil)) and
- (procdefinition.proctypeoption=potype_constructor) then
- cgsize:=OS_ADDR;
- if cgsize<>OS_NO then
- begin
- location_reset(location,LOC_REGISTER,cgsize);
- {$ifndef cpu64bit}
- if cgsize in [OS_64,OS_S64] then
- begin
- {Move the function result to free registers, preferably the
- accumulator/accumulatorhigh, so no move is necessary.}
- r.enum:=R_INTREGISTER;
- r.number:=NR_ACCUMULATOR;
- hregister.enum:=R_INTREGISTER;
- hregister.number:=NR_ACCUMULATORHIGH;
- cg.a_reg_alloc(exprasmlist,r);
- cg.a_reg_alloc(exprasmlist,hregister);
- if RS_ACCUMULATOR in rg.unusedregsint then
- location.registerlow:=rg.getexplicitregisterint(exprasmlist,NR_ACCUMULATOR)
- else
- location.registerlow:=rg.getregisterint(exprasmlist,OS_INT);
- if RS_ACCUMULATORHIGH in rg.unusedregsint then
- location.registerhigh:=rg.getexplicitregisterint(exprasmlist,NR_ACCUMULATORHIGH)
- else
- location.registerhigh:=rg.getregisterint(exprasmlist,OS_INT);
- cg64.a_load64_reg_reg(exprasmlist,joinreg64(r,hregister),
- location.register64);
- end
- else
- {$endif cpu64bit}
- begin
- {Move the function result to a free register, preferably the
- accumulator, so no move is necessary.}
- nr:=RS_ACCUMULATOR shl 8 or cgsize2subreg(cgsize);
- r.enum:=R_INTREGISTER;
- r.number:=nr;
- cg.a_reg_alloc(exprasmlist,r);
- if RS_ACCUMULATOR in rg.unusedregsint then
- location.register:=rg.getexplicitregisterint(exprasmlist,nr)
- else
- location.register:=rg.getregisterint(exprasmlist,cgsize);
- cg.a_load_reg_reg(exprasmlist,cgsize,cgsize,r,location.register);
- end;
- end;
- end;
- floatdef :
- begin
- location_reset(location,LOC_FPUREGISTER,def_cgsize(resulttype.def));
- {$ifdef cpufpemu}
- if cs_fp_emulation in aktmoduleswitches then
- location.register.enum := accumulator
- else
- {$endif cpufpemu}
- location.register.enum:=FPU_RESULT_REG;
- {$ifdef x86}
- inc(trgcpu(rg).fpuvaroffset);
- {$endif x86}
- end;
- {$ifdef TEST_WIN32_RECORDS}
- recorddef :
- begin
- if (target_info.system=system_i386_win32) then
- begin
- location_reset(location,LOC_REFERENCE,def_cgsize(resulttype.def));
- tg.GetTemp(exprasmlist,resulttype.size,tt_normal,location);
- {$ifndef cpu64bit}
- if cgsize in [OS_64,OS_S64] then
- cg64.a_load64_reg_loc(exprasmlist,joinreg64(accumulator,accumulatorhigh),location)
- else
- {$endif cpu64bit}
- cg.a_load_reg_loc(exprasmlist,accumulator,location);
- end
- else
- internalerror(200211141);
- end;
- {$endif TEST_WIN32_RECORDS}
- else
- begin
- location_reset(location,LOC_REGISTER,OS_INT);
- if RS_ACCUMULATOR in rg.unusedregsint then
- location.register:=rg.getexplicitregisterint(exprasmlist,NR_ACCUMULATOR)
- else
- location.register:=rg.getregisterint(exprasmlist,OS_INT);
- r.enum:=R_INTREGISTER;
- r.number:=NR_ACCUMULATOR;
- cg.a_load_reg_reg(exprasmlist,OS_INT,OS_INT,r,location.register);
- end;
- end;
- end;
- end;
- procedure tcgcallnode.pass_2;
- var
- regs_to_push_int : Tsupregset;
- regs_to_push_other : tregisterset;
- unusedstate: pointer;
- pushed : tpushedsaved;
- pushedint : tpushedsavedint;
- hregister : tregister;
- oldpushedparasize : longint;
- { adress returned from an I/O-error }
- iolabel : tasmlabel;
- { help reference pointer }
- href : treference;
- hp : tnode;
- pp : tbinarynode;
- params : tnode;
- virtual_vmt_call,
- inlined : boolean;
- inlinecode : tprocinlinenode;
- store_parast_fixup,
- para_alignment,
- para_offset : longint;
- pop_size : longint;
- returnref,
- pararef : treference;
- accreg,
- vmtreg : tregister;
- begin
- iolabel:=nil;
- inlinecode:=nil;
- inlined:=false;
- rg.saveunusedstate(unusedstate);
- { if we allocate the temp. location for ansi- or widestrings }
- { already here, we avoid later a push/pop }
- if is_widestring(resulttype.def) then
- begin
- tg.GetTemp(exprasmlist,pointer_size,tt_widestring,refcountedtemp);
- cg.g_decrrefcount(exprasmlist,resulttype.def,refcountedtemp);
- end
- else if is_ansistring(resulttype.def) then
- begin
- tg.GetTemp(exprasmlist,pointer_size,tt_ansistring,refcountedtemp);
- cg.g_decrrefcount(exprasmlist,resulttype.def,refcountedtemp);
- end;
- if (procdefinition.proccalloption in [pocall_cdecl,pocall_cppdecl,pocall_stdcall]) then
- para_alignment:=4
- else
- para_alignment:=aktalignment.paraalign;
- if not assigned(procdefinition) then
- exit;
- if assigned(left) then
- params:=left
- else
- params := nil;
- if (procdefinition.proccalloption=pocall_inline) then
- begin
- inlined:=true;
- inlinecode:=tprocinlinenode(right);
- right:=nil;
- { set it to the same lexical level as the local symtable, becuase
- the para's are stored there }
- tprocdef(procdefinition).parast.symtablelevel:=aktprocdef.localst.symtablelevel;
- if assigned(params) then
- begin
- inlinecode.para_size:=tprocdef(procdefinition).para_size(para_alignment);
- tg.GetTemp(exprasmlist,inlinecode.para_size,tt_persistant,pararef);
- inlinecode.para_offset:=pararef.offset;
- end;
- store_parast_fixup:=tprocdef(procdefinition).parast.address_fixup;
- tprocdef(procdefinition).parast.address_fixup:=inlinecode.para_offset;
- {$ifdef extdebug}
- Comment(V_debug,
- 'inlined parasymtable is at offset '
- +tostr(tprocdef(procdefinition).parast.address_fixup));
- exprasmList.concat(tai_comment.Create(
- strpnew('inlined parasymtable is at offset '
- +tostr(tprocdef(procdefinition).parast.address_fixup))));
- {$endif extdebug}
- end;
- { proc variables destroy all registers }
- if (inlined or
- (right=nil)) and
- { virtual methods too }
- not(po_virtualmethod in procdefinition.procoptions) then
- begin
- if (cs_check_io in aktlocalswitches) and
- (po_iocheck in procdefinition.procoptions) and
- not(po_iocheck in aktprocdef.procoptions) then
- begin
- objectlibrary.getaddrlabel(iolabel);
- cg.a_label(exprasmlist,iolabel);
- end
- else
- iolabel:=nil;
- { save all used registers and possible registers
- used for the return value }
- regs_to_push_int := tprocdef(procdefinition).usedintregisters;
- regs_to_push_other := tprocdef(procdefinition).usedotherregisters;
- if (not is_void(resulttype.def)) and
- (not paramanager.ret_in_param(resulttype.def,procdefinition.proccalloption)) then
- begin
- include(regs_to_push_int,RS_ACCUMULATOR);
- {$ifndef cpu64bit}
- if resulttype.def.size>sizeof(aword) then
- include(regs_to_push_int,RS_ACCUMULATORHIGH);
- {$endif cpu64bit}
- end;
- rg.saveusedintregisters(exprasmlist,pushedint,regs_to_push_int);
- rg.saveusedotherregisters(exprasmlist,pushed,regs_to_push_other);
- { give used registers through }
- rg.usedintinproc:=rg.usedintinproc + tprocdef(procdefinition).usedintregisters;
- rg.usedinproc:=rg.usedinproc + tprocdef(procdefinition).usedotherregisters;
- end
- else
- begin
- regs_to_push_int := all_intregisters;
- regs_to_push_other := all_registers;
- rg.saveusedintregisters(exprasmlist,pushedint,regs_to_push_int);
- rg.saveusedotherregisters(exprasmlist,pushed,regs_to_push_other);
- rg.usedinproc:=all_registers;
- { no IO check for methods and procedure variables }
- iolabel:=nil;
- end;
- { Initialize for pushing the parameters }
- oldpushedparasize:=pushedparasize;
- pushedparasize:=0;
- pop_size:=0;
- { Align stack if required }
- if not inlined then
- pop_size:=align_parasize(oldpushedparasize,para_alignment);
- { Push parameters }
- if assigned(params) then
- begin
- { be found elsewhere }
- if inlined then
- para_offset:=tprocdef(procdefinition).parast.address_fixup+
- tprocdef(procdefinition).parast.datasize
- else
- para_offset:=0;
- if not(inlined) and
- assigned(right) then
- tcallparanode(params).secondcallparan(
- (po_leftright in procdefinition.procoptions),procdefinition.proccalloption,
- para_alignment,para_offset)
- else
- tcallparanode(params).secondcallparan(
- (po_leftright in procdefinition.procoptions),procdefinition.proccalloption,
- para_alignment,para_offset);
- end;
- { Allocate return value for inlined routines }
- if inlined and
- (resulttype.def.size>0) then
- begin
- tg.GetTemp(exprasmlist,Align(resulttype.def.size,aktalignment.paraalign),tt_persistant,returnref);
- inlinecode.retoffset:=returnref.offset;
- end;
- { Allocate return value when returned in argument }
- if paramanager.ret_in_param(resulttype.def,procdefinition.proccalloption) then
- begin
- if assigned(funcretrefnode) then
- begin
- secondpass(funcretrefnode);
- if codegenerror then
- exit;
- if (funcretrefnode.location.loc<>LOC_REFERENCE) then
- internalerror(200204246);
- funcretref:=funcretrefnode.location.reference;
- end
- else
- begin
- if inlined then
- begin
- tg.GetTemp(exprasmlist,resulttype.def.size,tt_persistant,funcretref);
- {$ifdef extdebug}
- Comment(V_debug,'function return value is at offset '
- +tostr(funcretref.offset));
- exprasmlist.concat(tai_comment.create(
- strpnew('function return value is at offset '
- +tostr(funcretref.offset))));
- {$endif extdebug}
- end
- else
- tg.GetTemp(exprasmlist,resulttype.def.size,tt_normal,funcretref);
- end;
- { This must not be counted for C code,
- complex return address is removed from stack
- by function itself ! }
- if inlined then
- begin
- hregister:=cg.get_scratch_reg_address(exprasmlist);
- cg.a_loadaddr_ref_reg(exprasmlist,funcretref,hregister);
- reference_reset_base(href,procinfo.framepointer,inlinecode.retoffset);
- cg.a_load_reg_ref(exprasmlist,OS_ADDR,hregister,href);
- cg.free_scratch_reg(exprasmlist,hregister);
- end
- else
- cg.a_paramaddr_ref(exprasmlist,funcretref,paramanager.getfuncretparaloc(procdefinition));
- end;
- { procedure variable or normal function call ? }
- if inlined or
- (right=nil) then
- begin
- { Virtual function call through VMT? }
- vmtreg.enum:=R_INTREGISTER;
- vmtreg.number:=NR_NO;
- virtual_vmt_call:=(po_virtualmethod in procdefinition.procoptions) and
- not(assigned(methodpointer) and
- (methodpointer.nodetype=typen));
- { push self/vmt for methods }
- if assigned(symtableproc) and
- (symtableproc.symtabletype in [withsymtable,objectsymtable]) then
- vmtreg:=push_self_and_vmt(virtual_vmt_call);
- { push base pointer ?}
- { never when inlining, since if necessary, the base pointer }
- { can/will be gottten from the current procedure's symtable }
- { (JM)}
- if not inlined then
- if (lexlevel>=normal_function_level) and assigned(tprocdef(procdefinition).parast) and
- ((tprocdef(procdefinition).parast.symtablelevel)>normal_function_level) then
- push_framepointer;
- rg.saveintregvars(exprasmlist,regs_to_push_int);
- rg.saveotherregvars(exprasmlist,regs_to_push_other);
- if virtual_vmt_call then
- begin
- { virtual methods require an index }
- if tprocdef(procdefinition).extnumber=-1 then
- internalerror(200304021);
- { VMT should already be loaded in a register }
- if vmtreg.number=NR_NO then
- internalerror(200304022);
- { test validity of VMT }
- if not(is_interface(tprocdef(procdefinition)._class)) and
- not(is_cppclass(tprocdef(procdefinition)._class)) then
- cg.g_maybe_testvmt(exprasmlist,vmtreg,tprocdef(procdefinition)._class);
- { call method }
- reference_reset_base(href,vmtreg,
- tprocdef(procdefinition)._class.vmtmethodoffset(tprocdef(procdefinition).extnumber));
- cg.a_call_ref(exprasmlist,href);
- { release self }
- rg.ungetregisterint(exprasmlist,vmtreg);
- end
- else
- begin
- if not inlined then
- begin
- { Calling interrupt from the same code requires some
- extra code }
- if (po_interrupt in procdefinition.procoptions) then
- extra_interrupt_code;
- cg.a_call_name(exprasmlist,tprocdef(procdefinition).mangledname);
- end
- else { inlined proc }
- begin
- { process the inlinecode }
- secondpass(tnode(inlinecode));
- { free the args }
- if tprocdef(procdefinition).parast.datasize>0 then
- tg.UnGetTemp(exprasmlist,pararef);
- end;
- end;
- end
- else
- { now procedure variable case }
- begin
- secondpass(right);
- { Calling interrupt from the same code requires some
- extra code }
- if (po_interrupt in procdefinition.procoptions) then
- extra_interrupt_code;
- if (po_methodpointer in procdefinition.procoptions) then
- begin
- { push self, but not if it's already explicitly pushed }
- if not(po_containsself in procdefinition.procoptions) then
- begin
- { push self }
- href:=right.location.reference;
- inc(href.offset,POINTER_SIZE);
- cg.a_param_ref(exprasmlist,OS_ADDR,href,paramanager.getintparaloc(1));
- end;
- rg.saveintregvars(exprasmlist,ALL_INTREGISTERS);
- rg.saveotherregvars(exprasmlist,ALL_REGISTERS);
- cg.a_call_ref(exprasmlist,right.location.reference);
- reference_release(exprasmlist,right.location.reference);
- tg.Ungetiftemp(exprasmlist,right.location.reference);
- end
- else
- begin
- rg.saveintregvars(exprasmlist,ALL_INTREGISTERS);
- rg.saveotherregvars(exprasmlist,ALL_REGISTERS);
- cg.a_call_loc(exprasmlist,right.location);
- location_release(exprasmlist,right.location);
- location_freetemp(exprasmlist,right.location);
- end;
- end;
- { Need to remove the parameters from the stack? }
- if (not inlined) and (po_clearstack in procdefinition.procoptions) then
- begin
- { the old pop_size was already included in pushedparasize }
- pop_size:=pushedparasize;
- end;
- { Remove parameters/alignment from the stack }
- if pop_size>0 then
- pop_parasize(pop_size);
- {$ifdef powerpc}
- { this calculation must be done in pass_1 anyway, so don't worry }
- if tppcprocinfo(procinfo).maxpushedparasize<pushedparasize then
- tppcprocinfo(procinfo).maxpushedparasize:=pushedparasize;
- {$endif powerpc}
- { Restore }
- pushedparasize:=oldpushedparasize;
- rg.restoreunusedstate(unusedstate);
- {$ifdef TEMPREGDEBUG}
- testregisters32;
- {$endif TEMPREGDEBUG}
- { Called an inherited constructor? Then
- we need to check the result }
- if (inlined or (right=nil)) and
- (procdefinition.proctypeoption=potype_constructor) and
- assigned(methodpointer) and
- (methodpointer.nodetype=typen) and
- (aktprocdef.proctypeoption=potype_constructor) then
- begin
- accreg.enum:=R_INTREGISTER;
- accreg.number:=NR_ACCUMULATOR;
- cg.a_reg_alloc(exprasmlist,accreg);
- cg.a_cmp_const_reg_label(exprasmlist,OS_ADDR,OC_EQ,0,accreg,faillabel);
- cg.a_reg_dealloc(exprasmlist,accreg);
- end;
- { handle function results }
- if (not is_void(resulttype.def)) then
- handle_return_value(inlined);
- { perhaps i/o check ? }
- if iolabel<>nil then
- begin
- reference_reset_symbol(href,iolabel,0);
- cg.a_paramaddr_ref(exprasmlist,href,paramanager.getintparaloc(1));
- cg.a_call_name(exprasmlist,'FPC_IOCHECK');
- end;
- { restore registers }
- rg.restoreusedotherregisters(exprasmlist,pushed);
- rg.restoreusedintregisters(exprasmlist,pushedint);
- { Release temps from parameters }
- pp:=tbinarynode(params);
- while assigned(pp) do
- begin
- if assigned(pp.left) then
- begin
- location_freetemp(exprasmlist,pp.left.location);
- { process also all nodes of an array of const }
- if pp.left.nodetype=arrayconstructorn then
- begin
- if assigned(tarrayconstructornode(pp.left).left) then
- begin
- hp:=pp.left;
- while assigned(hp) do
- begin
- location_freetemp(exprasmlist,tarrayconstructornode(hp).left.location);
- hp:=tarrayconstructornode(hp).right;
- end;
- end;
- end;
- end;
- pp:=tbinarynode(pp.right);
- end;
- if inlined then
- begin
- if (resulttype.def.size>0) then
- tg.UnGetTemp(exprasmlist,returnref);
- tprocdef(procdefinition).parast.address_fixup:=store_parast_fixup;
- right:=inlinecode;
- { from now on the result can be freed normally }
- if paramanager.ret_in_param(resulttype.def,procdefinition.proccalloption) then
- tg.ChangeTempType(exprasmlist,funcretref,tt_normal);
- end;
- { if return value is not used }
- if (not(nf_return_value_used in flags)) and (not is_void(resulttype.def)) then
- begin
- if location.loc in [LOC_CREFERENCE,LOC_REFERENCE] then
- begin
- { data which must be finalized ? }
- if (resulttype.def.needs_inittable) then
- cg.g_finalize(exprasmlist,resulttype.def,location.reference,false);
- { release unused temp }
- tg.ungetiftemp(exprasmlist,location.reference)
- end
- else if location.loc=LOC_FPUREGISTER then
- begin
- {$ifdef x86}
- { release FPU stack }
- accreg.enum:=FPU_RESULT_REG;
- emit_reg(A_FSTP,S_NO,accreg);
- {
- dec(trgcpu(rg).fpuvaroffset);
- do NOT decrement as the increment before
- is not called for unused results PM }
- {$endif x86}
- end;
- end;
- end;
- {*****************************************************************************
- TCGPROCINLINENODE
- *****************************************************************************}
- procedure tcgprocinlinenode.pass_2;
- var st : tsymtable;
- oldprocdef : tprocdef;
- ps, i : longint;
- oldprocinfo : tprocinfo;
- oldinlining_procedure,
- nostackframe,make_global : boolean;
- inlineentrycode,inlineexitcode : TAAsmoutput;
- oldexitlabel,oldexit2label,oldquickexitlabel:tasmlabel;
- oldregstate: pointer;
- localsref : treference;
- {$ifdef GDB}
- startlabel,endlabel : tasmlabel;
- pp : pchar;
- mangled_length : longint;
- {$endif GDB}
- begin
- { deallocate the registers used for the current procedure's regvars }
- if assigned(aktprocdef.regvarinfo) then
- begin
- with pregvarinfo(aktprocdef.regvarinfo)^ do
- for i := 1 to maxvarregs do
- if assigned(regvars[i]) then
- store_regvar(exprasmlist,regvars[i].reg);
- rg.saveStateForInline(oldregstate);
- { make sure the register allocator knows what the regvars in the }
- { inlined code block are (JM) }
- rg.resetusableregisters;
- rg.clearregistercount;
- rg.cleartempgen;
- if assigned(inlineprocdef.regvarinfo) then
- with pregvarinfo(inlineprocdef.regvarinfo)^ do
- for i := 1 to maxvarregs do
- if assigned(regvars[i]) then
- begin
- {Fix me!!}
- {tmpreg:=rg.makeregsize(regvars[i].reg,OS_INT);
- rg.makeregvar(tmpreg);}
- internalerror(200301232);
- end;
- end;
- oldinlining_procedure:=inlining_procedure;
- oldexitlabel:=aktexitlabel;
- oldexit2label:=aktexit2label;
- oldquickexitlabel:=quickexitlabel;
- oldprocdef:=aktprocdef;
- oldprocinfo:=procinfo;
- objectlibrary.getlabel(aktexitlabel);
- objectlibrary.getlabel(aktexit2label);
- { we're inlining a procedure }
- inlining_procedure:=true;
- aktprocdef:=inlineprocdef;
- { clone procinfo, but not the asmlists }
- procinfo:=tprocinfo(cprocinfo.newinstance);
- move(pointer(oldprocinfo)^,pointer(procinfo)^,cprocinfo.InstanceSize);
- procinfo.aktentrycode:=nil;
- procinfo.aktexitcode:=nil;
- procinfo.aktproccode:=nil;
- procinfo.aktlocaldata:=nil;
- { set new procinfo }
- procinfo.return_offset:=retoffset;
- procinfo.para_offset:=para_offset;
- procinfo.no_fast_exit:=false;
- { arg space has been filled by the parent secondcall }
- st:=aktprocdef.localst;
- { set it to the same lexical level }
- st.symtablelevel:=oldprocdef.localst.symtablelevel;
- if st.datasize>0 then
- begin
- tg.GetTemp(exprasmlist,st.datasize,tt_persistant,localsref);
- st.address_fixup:=localsref.offset+st.datasize;
- {$ifdef extdebug}
- Comment(V_debug,'local symtable is at offset '+tostr(st.address_fixup));
- exprasmList.concat(tai_comment.Create(strpnew(
- 'local symtable is at offset '+tostr(st.address_fixup))));
- {$endif extdebug}
- end;
- exprasmList.concat(Tai_Marker.Create(InlineStart));
- {$ifdef extdebug}
- exprasmList.concat(tai_comment.Create(strpnew('Start of inlined proc')));
- {$endif extdebug}
- {$ifdef GDB}
- if (cs_debuginfo in aktmoduleswitches) then
- begin
- objectlibrary.getaddrlabel(startlabel);
- objectlibrary.getaddrlabel(endlabel);
- cg.a_label(exprasmlist,startlabel);
- inlineprocdef.localst.symtabletype:=inlinelocalsymtable;
- inlineprocdef.parast.symtabletype:=inlineparasymtable;
- { Here we must include the para and local symtable info }
- inlineprocdef.concatstabto(withdebuglist);
- { set it back for safety }
- inlineprocdef.localst.symtabletype:=localsymtable;
- inlineprocdef.parast.symtabletype:=parasymtable;
- mangled_length:=length(oldprocdef.mangledname);
- getmem(pp,mangled_length+50);
- strpcopy(pp,'192,0,0,'+startlabel.name);
- if (target_info.use_function_relative_addresses) then
- begin
- strpcopy(strend(pp),'-');
- strpcopy(strend(pp),oldprocdef.mangledname);
- end;
- withdebugList.concat(Tai_stabn.Create(strnew(pp)));
- end;
- {$endif GDB}
- { takes care of local data initialization }
- inlineentrycode:=TAAsmoutput.Create;
- inlineexitcode:=TAAsmoutput.Create;
- ps:=para_size;
- make_global:=false; { to avoid warning }
- genentrycode(inlineentrycode,make_global,0,ps,nostackframe,true);
- if po_assembler in aktprocdef.procoptions then
- inlineentrycode.insert(Tai_marker.Create(asmblockstart));
- exprasmList.concatlist(inlineentrycode);
- secondpass(inlinetree);
- genexitcode(inlineexitcode,0,false,true);
- if po_assembler in aktprocdef.procoptions then
- inlineexitcode.concat(Tai_marker.Create(asmblockend));
- exprasmList.concatlist(inlineexitcode);
- inlineentrycode.free;
- inlineexitcode.free;
- {$ifdef extdebug}
- exprasmList.concat(tai_comment.Create(strpnew('End of inlined proc')));
- {$endif extdebug}
- exprasmList.concat(Tai_Marker.Create(InlineEnd));
- {we can free the local data now, reset also the fixup address }
- if st.datasize>0 then
- begin
- tg.UnGetTemp(exprasmlist,localsref);
- st.address_fixup:=0;
- end;
- { restore procinfo }
- procinfo.free;
- procinfo:=oldprocinfo;
- {$ifdef GDB}
- if (cs_debuginfo in aktmoduleswitches) then
- begin
- cg.a_label(exprasmlist,endlabel);
- strpcopy(pp,'224,0,0,'+endlabel.name);
- if (target_info.use_function_relative_addresses) then
- begin
- strpcopy(strend(pp),'-');
- strpcopy(strend(pp),oldprocdef.mangledname);
- end;
- withdebugList.concat(Tai_stabn.Create(strnew(pp)));
- freemem(pp,mangled_length+50);
- end;
- {$endif GDB}
- { restore }
- aktprocdef:=oldprocdef;
- aktexitlabel:=oldexitlabel;
- aktexit2label:=oldexit2label;
- quickexitlabel:=oldquickexitlabel;
- inlining_procedure:=oldinlining_procedure;
- { reallocate the registers used for the current procedure's regvars, }
- { since they may have been used and then deallocated in the inlined }
- { procedure (JM) }
- if assigned(aktprocdef.regvarinfo) then
- begin
- rg.restoreStateAfterInline(oldregstate);
- end;
- end;
- begin
- ccallparanode:=tcgcallparanode;
- ccallnode:=tcgcallnode;
- cprocinlinenode:=tcgprocinlinenode;
- end.
- {
- $Log$
- Revision 1.47 2003-04-22 09:49:44 peter
- * do not load self when calling a non-inherited class constructor
- Revision 1.46 2003/04/21 20:03:32 peter
- * forgot to copy vmtrefaddr to selfrefaddr when self=vmt
- Revision 1.45 2003/04/21 13:53:16 jonas
- - removed copying of all paras when secondpassing a callnode (this used
- to be necessary for inlinign support, but currently the whole inlined
- procedure is already copied in advance). Note that the compiler crashes
- when compiling ucomplex with -dTEST_INLINE (also after fixing the
- syntax errors), but that was also the case before this change.
- Revision 1.44 2003/04/10 17:57:52 peter
- * vs_hidden released
- Revision 1.43 2003/04/06 21:11:23 olle
- * changed newasmsymbol to newasmsymboldata for data symbols
- Revision 1.42 2003/04/04 15:38:56 peter
- * moved generic code from n386cal to ncgcal, i386 now also
- uses the generic ncgcal
- Revision 1.41 2003/03/28 19:16:56 peter
- * generic constructor working for i386
- * remove fixed self register
- * esi added as address register for i386
- Revision 1.40 2003/03/06 11:35:50 daniel
- * Fixed internalerror 7843 issue
- Revision 1.39 2003/02/19 22:00:14 daniel
- * Code generator converted to new register notation
- - Horribily outdated todo.txt removed
- Revision 1.38 2003/02/15 22:17:38 carl
- * bugfix of FPU emulation code
- Revision 1.37 2003/02/12 22:10:07 carl
- * load_frame_pointer is now generic
- * change fpu emulation routine names
- Revision 1.36 2003/01/30 21:46:57 peter
- * self fixes for static methods (merged)
- Revision 1.35 2003/01/22 20:45:15 mazen
- * making math code in RTL compiling.
- *NB : This does NOT mean necessary that it will generate correct code!
- Revision 1.34 2003/01/17 12:03:45 daniel
- * Optalign conditional code adapted to record Tregister
- Revision 1.33 2003/01/08 18:43:56 daniel
- * Tregister changed into a record
- Revision 1.32 2002/12/15 22:50:00 florian
- + some stuff for the new hidden parameter handling added
- Revision 1.31 2002/12/15 21:30:12 florian
- * tcallnode.paraitem introduced, all references to defcoll removed
- Revision 1.30 2002/11/27 20:04:39 peter
- * cdecl array of const fixes
- Revision 1.29 2002/11/25 17:43:17 peter
- * splitted defbase in defutil,symutil,defcmp
- * merged isconvertable and is_equal into compare_defs(_ext)
- * made operator search faster by walking the list only once
- Revision 1.28 2002/11/18 17:31:54 peter
- * pass proccalloption to ret_in_xxx and push_xxx functions
- Revision 1.27 2002/11/16 15:34:30 florian
- * generic location for float results
- Revision 1.26 2002/11/15 01:58:51 peter
- * merged changes from 1.0.7 up to 04-11
- - -V option for generating bug report tracing
- - more tracing for option parsing
- - errors for cdecl and high()
- - win32 import stabs
- - win32 records<=8 are returned in eax:edx (turned off by default)
- - heaptrc update
- - more info for temp management in .s file with EXTDEBUG
- Revision 1.25 2002/10/05 12:43:25 carl
- * fixes for Delphi 6 compilation
- (warning : Some features do not work under Delphi)
- Revision 1.24 2002/09/30 07:00:45 florian
- * fixes to common code to get the alpha compiler compiled applied
- Revision 1.23 2002/09/17 18:54:02 jonas
- * a_load_reg_reg() now has two size parameters: source and dest. This
- allows some optimizations on architectures that don't encode the
- register size in the register name.
- Revision 1.22 2002/09/07 15:25:02 peter
- * old logs removed and tabs fixed
- Revision 1.21 2002/09/07 11:50:02 jonas
- * fixed small regalloction info bug
- Revision 1.20 2002/09/02 11:25:20 florian
- * fixed generic procedure variable calling
- Revision 1.19 2002/09/01 21:04:48 florian
- * several powerpc related stuff fixed
- Revision 1.18 2002/09/01 18:43:27 peter
- * include accumulator in regs_to_push list
- Revision 1.17 2002/09/01 12:13:00 peter
- * use a_call_reg
- * ungetiftemp for procvar of object temp
- Revision 1.16 2002/08/25 19:25:18 peter
- * sym.insert_in_data removed
- * symtable.insertvardata/insertconstdata added
- * removed insert_in_data call from symtable.insert, it needs to be
- called separatly. This allows to deref the address calculation
- * procedures now calculate the parast addresses after the procedure
- directives are parsed. This fixes the cdecl parast problem
- * push_addr_param has an extra argument that specifies if cdecl is used
- or not
- Revision 1.15 2002/08/23 16:14:48 peter
- * tempgen cleanup
- * tt_noreuse temp type added that will be used in genentrycode
- Revision 1.14 2002/08/20 16:55:38 peter
- * don't write (stabs)line info when inlining a procedure
- Revision 1.13 2002/08/19 19:36:42 peter
- * More fixes for cross unit inlining, all tnodes are now implemented
- * Moved pocall_internconst to po_internconst because it is not a
- calling type at all and it conflicted when inlining of these small
- functions was requested
- Revision 1.12 2002/08/18 20:06:23 peter
- * inlining is now also allowed in interface
- * renamed write/load to ppuwrite/ppuload
- * tnode storing in ppu
- * nld,ncon,nbas are already updated for storing in ppu
- Revision 1.11 2002/08/17 22:09:44 florian
- * result type handling in tcgcal.pass_2 overhauled
- * better tnode.dowrite
- * some ppc stuff fixed
- Revision 1.10 2002/08/17 09:23:35 florian
- * first part of procinfo rewrite
- Revision 1.9 2002/08/13 21:40:55 florian
- * more fixes for ppc calling conventions
- Revision 1.8 2002/08/13 18:01:51 carl
- * rename swatoperands to swapoperands
- + m68k first compilable version (still needs a lot of testing):
- assembler generator, system information , inline
- assembler reader.
- Revision 1.7 2002/08/12 15:08:39 carl
- + stab register indexes for powerpc (moved from gdb to cpubase)
- + tprocessor enumeration moved to cpuinfo
- + linker in target_info is now a class
- * many many updates for m68k (will soon start to compile)
- - removed some ifdef or correct them for correct cpu
- Revision 1.6 2002/08/11 14:32:26 peter
- * renamed current_library to objectlibrary
- Revision 1.5 2002/08/11 13:24:11 peter
- * saving of asmsymbols in ppu supported
- * asmsymbollist global is removed and moved into a new class
- tasmlibrarydata that will hold the info of a .a file which
- corresponds with a single module. Added librarydata to tmodule
- to keep the library info stored for the module. In the future the
- objectfiles will also be stored to the tasmlibrarydata class
- * all getlabel/newasmsymbol and friends are moved to the new class
- Revision 1.4 2002/08/06 20:55:20 florian
- * first part of ppc calling conventions fix
- Revision 1.3 2002/07/20 11:57:53 florian
- * types.pas renamed to defbase.pas because D6 contains a types
- unit so this would conflicts if D6 programms are compiled
- + Willamette/SSE2 instructions to assembler added
- Revision 1.2 2002/07/13 19:38:43 florian
- * some more generic calling stuff fixed
- }
|