1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263 |
- {
- $Id$
- Copyright (c) 1998-2002 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,cpuinfo,
- globtype,
- cpubase,cgbase,parabase,
- aasmbase,aasmtai,aasmcpu,
- symconst,symbase,symdef,symsym,symtype,symtable
- {$ifndef cpu64bit}
- ,cg64f32
- {$endif cpu64bit}
- ;
- type
- tloadregvars = (lr_dont_load_regvars, lr_load_regvars);
- procedure firstcomplex(p : tbinarynode);
- procedure maketojumpbool(list:TAAsmoutput; p : tnode; loadregvars: tloadregvars);
- // procedure remove_non_regvars_from_loc(const t: tlocation; var regs:Tsuperregisterset);
- procedure location_force_reg(list:TAAsmoutput;var l:tlocation;dst_size:TCGSize;maybeconst:boolean);
- procedure location_force_fpureg(list:TAAsmoutput;var l: tlocation;maybeconst:boolean);
- procedure location_force_mem(list:TAAsmoutput;var l:tlocation);
- procedure location_force_mmregscalar(list:TAAsmoutput;var l: tlocation;maybeconst:boolean);
- function maybe_pushfpu(list:taasmoutput;needed : byte;var l:tlocation) : boolean;
- procedure gen_proc_symbol(list:Taasmoutput);
- procedure gen_proc_symbol_end(list:Taasmoutput);
- procedure gen_proc_entry_code(list:Taasmoutput);
- procedure gen_proc_exit_code(list:Taasmoutput);
- procedure gen_save_used_regs(list:TAAsmoutput);
- procedure gen_restore_used_regs(list:TAAsmoutput;const funcretparaloc:tcgpara);
- procedure gen_initialize_code(list:TAAsmoutput);
- procedure gen_finalize_code(list:TAAsmoutput);
- procedure gen_entry_code(list:TAAsmoutput);
- procedure gen_exit_code(list:TAAsmoutput);
- procedure gen_load_para_value(list:TAAsmoutput);
- procedure gen_load_return_value(list:TAAsmoutput);
- {#
- Allocate the buffers for exception management and setjmp environment.
- Return a pointer to these buffers, send them to the utility routine
- so they are registered, and then call setjmp.
- Then compare the result of setjmp with 0, and if not equal
- to zero, then jump to exceptlabel.
- Also store the result of setjmp to a temporary space by calling g_save_exception_reason
- It is to note that this routine may be called *after* the stackframe of a
- routine has been called, therefore on machines where the stack cannot
- be modified, all temps should be allocated on the heap instead of the
- stack.
- }
- const
- EXCEPT_BUF_SIZE = 3*sizeof(aint);
- type
- texceptiontemps=record
- jmpbuf,
- envbuf,
- reasonbuf : treference;
- end;
- procedure get_exception_temps(list:taasmoutput;var t:texceptiontemps);
- procedure unget_exception_temps(list:taasmoutput;const t:texceptiontemps);
- procedure new_exception(list:TAAsmoutput;const t:texceptiontemps;a:aint;exceptlabel:tasmlabel);
- procedure free_exception(list:TAAsmoutput;const t:texceptiontemps;a:aint;endexceptlabel:tasmlabel;onlyfree:boolean);
- procedure insertconstdata(sym : ttypedconstsym);
- procedure insertbssdata(sym : tvarsym);
- procedure gen_alloc_symtable(list:TAAsmoutput;st:tsymtable);
- procedure gen_free_symtable(list:TAAsmoutput;st:tsymtable);
- procedure gen_alloc_inline_parast(list:TAAsmoutput;pd:tprocdef);
- procedure gen_alloc_inline_funcret(list:TAAsmoutput;pd:tprocdef);
- { rtti and init/final }
- procedure generate_rtti(p:Ttypesym);
- procedure generate_inittable(p:tsym);
- implementation
- uses
- {$ifdef Delphi}
- Sysutils,
- {$else}
- strings,
- {$endif}
- cutils,cclasses,
- globals,systems,verbose,
- ppu,defutil,
- procinfo,paramgr,fmodule,
- regvars,dwarf,
- {$ifdef GDB}
- gdb,
- {$endif GDB}
- pass_1,pass_2,
- ncon,nld,nutils,
- tgobj,cgutils,cgobj;
- {*****************************************************************************
- 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
- is_boolean(p.left.resulttype.def) then
- begin
- 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.registersint<p.right.registersint)
- )
- ) 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
- {$ifdef OLDREGVARS}
- if loadregvars = lr_load_regvars then
- load_all_regvars(list);
- {$endif OLDREGVARS}
- 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
- {$ifdef OLDREGVARS}
- if (p.location.loc = LOC_CREGISTER) then
- load_regvar_reg(list,p.location.register);
- {$endif OLDREGVARS}
- cg.a_cmp_const_loc_label(list,opsize,OC_NE,0,p.location,truelabel);
- cg.a_jmp_always(list,falselabel);
- end;
- LOC_JUMP:
- ;
- {$ifdef cpuflags}
- LOC_FLAGS :
- begin
- cg.a_jmp_flags(list,p.location.resflags,truelabel);
- cg.a_jmp_always(list,falselabel);
- end;
- {$endif cpuflags}
- else
- begin
- printnode(output,p);
- internalerror(200308241);
- end;
- end;
- end;
- end
- else
- internalerror(200112305);
- aktfilepos:=storepos;
- end;
- (*
- This code needs fixing. It is not safe to use rgint; on the m68000 it
- would be rgaddr.
- procedure remove_non_regvars_from_loc(const t: tlocation; var regs:Tsuperregisterset);
- begin
- case t.loc of
- LOC_REGISTER:
- begin
- { can't be a regvar, since it would be LOC_CREGISTER then }
- exclude(regs,getsupreg(t.register));
- if t.registerhigh<>NR_NO then
- exclude(regs,getsupreg(t.registerhigh));
- end;
- LOC_CREFERENCE,LOC_REFERENCE:
- begin
- if not(cs_regvars in aktglobalswitches) or
- (getsupreg(t.reference.base) in cg.rgint.usableregs) then
- exclude(regs,getsupreg(t.reference.base));
- if not(cs_regvars in aktglobalswitches) or
- (getsupreg(t.reference.index) in cg.rgint.usableregs) then
- exclude(regs,getsupreg(t.reference.index));
- end;
- end;
- end;
- *)
- {*****************************************************************************
- EXCEPTION MANAGEMENT
- *****************************************************************************}
- procedure get_exception_temps(list:taasmoutput;var t:texceptiontemps);
- begin
- tg.GetTemp(list,EXCEPT_BUF_SIZE,tt_persistent,t.envbuf);
- tg.GetTemp(list,JMP_BUF_SIZE,tt_persistent,t.jmpbuf);
- tg.GetTemp(list,sizeof(aint),tt_persistent,t.reasonbuf);
- end;
- procedure unget_exception_temps(list:taasmoutput;const t:texceptiontemps);
- begin
- tg.Ungettemp(list,t.jmpbuf);
- tg.ungettemp(list,t.envbuf);
- tg.ungettemp(list,t.reasonbuf);
- end;
- procedure new_exception(list:TAAsmoutput;const t:texceptiontemps;a:aint;exceptlabel:tasmlabel);
- var
- paraloc1,paraloc2,paraloc3 : tcgpara;
- begin
- paraloc1.init;
- paraloc2.init;
- paraloc3.init;
- paramanager.getintparaloc(pocall_default,1,paraloc1);
- paramanager.getintparaloc(pocall_default,2,paraloc2);
- paramanager.getintparaloc(pocall_default,3,paraloc3);
- paramanager.allocparaloc(list,paraloc3);
- cg.a_paramaddr_ref(list,t.envbuf,paraloc3);
- paramanager.allocparaloc(list,paraloc2);
- cg.a_paramaddr_ref(list,t.jmpbuf,paraloc2);
- { push type of exceptionframe }
- paramanager.allocparaloc(list,paraloc1);
- cg.a_param_const(list,OS_S32,1,paraloc1);
- paramanager.freeparaloc(list,paraloc3);
- paramanager.freeparaloc(list,paraloc2);
- paramanager.freeparaloc(list,paraloc1);
- cg.alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
- cg.a_call_name(list,'FPC_PUSHEXCEPTADDR');
- cg.dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
- paramanager.getintparaloc(pocall_default,1,paraloc1);
- paramanager.allocparaloc(list,paraloc1);
- cg.a_param_reg(list,OS_ADDR,NR_FUNCTION_RESULT_REG,paraloc1);
- paramanager.freeparaloc(list,paraloc1);
- cg.alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
- cg.a_call_name(list,'FPC_SETJMP');
- cg.dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
- cg.g_exception_reason_save(list, t.reasonbuf);
- cg.a_cmp_const_reg_label(list,OS_S32,OC_NE,0,cg.makeregsize(list,NR_FUNCTION_RESULT_REG,OS_S32),exceptlabel);
- paraloc1.done;
- paraloc2.done;
- paraloc3.done;
- end;
- procedure free_exception(list:TAAsmoutput;const t:texceptiontemps;a:aint;endexceptlabel:tasmlabel;onlyfree:boolean);
- begin
- cg.alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
- cg.a_call_name(list,'FPC_POPADDRSTACK');
- cg.dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
- if not onlyfree then
- begin
- cg.g_exception_reason_load(list, t.reasonbuf);
- cg.a_cmp_const_reg_label(list,OS_INT,OC_EQ,a,NR_FUNCTION_RESULT_REG,endexceptlabel);
- end;
- end;
- {*****************************************************************************
- TLocation
- *****************************************************************************}
- {$ifndef cpu64bit}
- { 32-bit version }
- procedure location_force_reg(list:TAAsmoutput;var l:tlocation;dst_size:TCGSize;maybeconst:boolean);
- var
- hregister,
- hregisterhi : tregister;
- hreg64 : tregister64;
- hl : tasmlabel;
- oldloc : tlocation;
- const_location: boolean;
- begin
- oldloc:=l;
- if dst_size=OS_NO then
- internalerror(200309144);
- { 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
- begin
- hregister:=cg.makeregsize(list,l.registerlow,OS_32);
- cg.a_load_reg_reg(list,l.size,OS_32,l.registerlow,hregister);
- end
- else
- hregister:=cg.getintregister(list,OS_INT);
- { load value in low register }
- case l.loc of
- LOC_FLAGS :
- cg.g_flags2reg(list,OS_INT,l.resflags,hregister);
- LOC_JUMP :
- begin
- cg.a_label(list,truelabel);
- cg.a_load_const_reg(list,OS_INT,1,hregister);
- objectlibrary.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,OS_INT,l,hregister);
- end;
- { reset hi part, take care of the signed bit of the current value }
- hregisterhi:=cg.getintregister(list,OS_INT);
- if (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,aint($ffffffff),hregisterhi)
- else
- cg.a_load_const_reg(list,OS_32,0,hregisterhi);
- end
- else
- begin
- cg.a_op_const_reg_reg(list,OP_SAR,OS_32,31,hregister,
- 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:=cg.getintregister(list,OS_INT);
- hregisterhi:=cg.getintregister(list,OS_INT);
- end;
- hreg64.reglo:=hregister;
- hreg64.reghi:=hregisterhi;
- { load value in new register }
- cg64.a_load64_loc_reg(list,l,hreg64);
- location_reset(l,LOC_REGISTER,dst_size);
- l.registerlow:=hregister;
- l.registerhigh:=hregisterhi;
- end;
- end
- else
- begin
- {Do not bother to recycle the existing register. The register
- allocator eliminates unnecessary moves, so it's not needed
- and trying to recycle registers can cause problems because
- the registers changes size and may need aditional constraints.
- Not if it's about LOC_CREGISTER's (JM)
- }
- const_location :=
- (maybeconst) and
- (l.loc = LOC_CREGISTER) and
- (TCGSize2Size[l.size] = TCGSize2Size[dst_size]) and
- ((l.size = dst_size) or
- (TCGSize2Size[l.size] = TCGSize2Size[OS_INT]));
- if not const_location then
- hregister:=cg.getintregister(list,dst_size)
- else
- hregister := l.register;
- { load value in new register }
- case l.loc of
- LOC_FLAGS :
- cg.g_flags2reg(list,dst_size,l.resflags,hregister);
- LOC_JUMP :
- begin
- cg.a_label(list,truelabel);
- cg.a_load_const_reg(list,dst_size,1,hregister);
- objectlibrary.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:=cg.makeregsize(list,l.register,dst_size);
- { for big endian systems, the reference's offset must }
- { be increased in this case, since they have the }
- { MSB first in memory and e.g. byte(word_var) should }
- { return the second byte in this case (JM) }
- if (target_info.endian = ENDIAN_BIG) and
- (l.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
- inc(l.reference.offset,TCGSize2Size[l.size]-TCGSize2Size[dst_size]);
- {$ifdef x86}
- l.size:=dst_size;
- {$endif x86}
- end;
- cg.a_load_loc_reg(list,dst_size,l,hregister);
- {$ifndef x86}
- if (TCGSize2Size[dst_size]<TCGSize2Size[l.size]) then
- l.size:=dst_size;
- {$endif not x86}
- end;
- end;
- if not const_location then
- location_reset(l,LOC_REGISTER,dst_size)
- else
- location_reset(l,LOC_CREGISTER,dst_size);
- l.register:=hregister;
- end;
- { Release temp when it was a reference }
- if oldloc.loc=LOC_REFERENCE then
- location_freetemp(list,oldloc);
- end;
- {$else cpu64bit}
- { 64-bit version }
- procedure location_force_reg(list:TAAsmoutput;var l:tlocation;dst_size:TCGSize;maybeconst:boolean);
- var
- hregister : tregister;
- hl : tasmlabel;
- oldloc : tlocation;
- begin
- oldloc:=l;
- hregister:=cg.getintregister(list,dst_size);
- { load value in new register }
- case l.loc of
- LOC_FLAGS :
- cg.g_flags2reg(list,dst_size,l.resflags,hregister);
- LOC_JUMP :
- begin
- cg.a_label(list,truelabel);
- cg.a_load_const_reg(list,dst_size,1,hregister);
- objectlibrary.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:=cg.makeregsize(list,l.register,dst_size);
- { for big endian systems, the reference's offset must }
- { be increased in this case, since they have the }
- { MSB first in memory and e.g. byte(word_var) should }
- { return the second byte in this case (JM) }
- if (target_info.endian = ENDIAN_BIG) and
- (l.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
- inc(l.reference.offset,TCGSize2Size[l.size]-TCGSize2Size[dst_size]);
- {$ifdef x86}
- l.size:=dst_size;
- {$endif x86}
- end;
- cg.a_load_loc_reg(list,dst_size,l,hregister);
- {$ifndef x86}
- if (TCGSize2Size[dst_size]<TCGSize2Size[l.size]) then
- l.size:=dst_size;
- {$endif not x86}
- end;
- end;
- if (l.loc <> LOC_CREGISTER) or
- not maybeconst then
- location_reset(l,LOC_REGISTER,dst_size)
- else
- location_reset(l,LOC_CREGISTER,dst_size);
- l.register:=hregister;
- { Release temp when it was a reference }
- if oldloc.loc=LOC_REFERENCE then
- location_freetemp(list,oldloc);
- end;
- {$endif cpu64bit}
- procedure location_force_fpureg(list:TAAsmoutput;var l: tlocation;maybeconst:boolean);
- var
- reg : tregister;
- href : treference;
- begin
- if (l.loc<>LOC_FPUREGISTER) and
- ((l.loc<>LOC_CFPUREGISTER) or (not maybeconst)) then
- begin
- { if it's in an mm register, store to memory first }
- if (l.loc in [LOC_MMREGISTER,LOC_CMMREGISTER]) then
- begin
- tg.GetTemp(list,tcgsize2size[l.size],tt_normal,href);
- cg.a_loadmm_reg_ref(list,l.size,l.size,l.register,href,mms_movescalar);
- location_reset(l,LOC_REFERENCE,l.size);
- l.reference:=href;
- end;
- reg:=cg.getfpuregister(list,l.size);
- cg.a_loadfpu_loc_reg(list,l,reg);
- location_freetemp(list,l);
- location_reset(l,LOC_FPUREGISTER,l.size);
- l.register:=reg;
- end;
- end;
- procedure location_force_mmregscalar(list:TAAsmoutput;var l: tlocation;maybeconst:boolean);
- var
- reg : tregister;
- href : treference;
- begin
- if (l.loc<>LOC_MMREGISTER) and
- ((l.loc<>LOC_CMMREGISTER) or (not maybeconst)) then
- begin
- { if it's in an fpu register, store to memory first }
- if (l.loc in [LOC_FPUREGISTER,LOC_CFPUREGISTER]) then
- begin
- tg.GetTemp(list,tcgsize2size[l.size],tt_normal,href);
- cg.a_loadfpu_reg_ref(list,l.size,l.register,href);
- location_reset(l,LOC_REFERENCE,l.size);
- l.reference:=href;
- end;
- reg:=cg.getmmregister(list,l.size);
- cg.a_loadmm_loc_reg(list,l.size,l,reg,mms_movescalar);
- location_freetemp(list,l);
- location_reset(l,LOC_MMREGISTER,l.size);
- l.register:=reg;
- end;
- end;
- procedure location_force_mem(list:TAAsmoutput;var l:tlocation);
- var
- r : treference;
- begin
- case l.loc of
- LOC_FPUREGISTER,
- LOC_CFPUREGISTER :
- begin
- tg.GetTemp(list,TCGSize2Size[l.size],tt_normal,r);
- cg.a_loadfpu_reg_ref(list,l.size,l.register,r);
- location_reset(l,LOC_REFERENCE,l.size);
- l.reference:=r;
- end;
- LOC_MMREGISTER,
- LOC_CMMREGISTER:
- begin
- tg.GetTemp(list,TCGSize2Size[l.size],tt_normal,r);
- cg.a_loadmm_reg_ref(list,l.size,l.size,l.register,r,mms_movescalar);
- location_reset(l,LOC_REFERENCE,l.size);
- l.reference:=r;
- end;
- LOC_CONSTANT,
- LOC_REGISTER,
- LOC_CREGISTER :
- begin
- tg.GetTemp(list,TCGSize2Size[l.size],tt_normal,r);
- {$ifndef cpu64bit}
- if l.size in [OS_64,OS_S64] then
- cg64.a_load64_loc_ref(list,l,r)
- else
- {$endif cpu64bit}
- cg.a_load_loc_ref(list,l.size,l,r);
- location_reset(l,LOC_REFERENCE,l.size);
- l.reference:=r;
- end;
- LOC_CREFERENCE,
- LOC_REFERENCE : ;
- else
- internalerror(200203219);
- end;
- end;
- {*****************************************************************************
- Maybe_Save
- *****************************************************************************}
- function maybe_pushfpu(list:taasmoutput;needed : byte;var l:tlocation) : boolean;
- begin
- {$ifdef i386}
- if (needed>=maxfpuregs) and
- (l.loc = LOC_FPUREGISTER) then
- begin
- location_force_mem(list,l);
- maybe_pushfpu:=true;
- end
- else
- maybe_pushfpu:=false;
- {$else i386}
- maybe_pushfpu:=false;
- {$endif i386}
- end;
- {****************************************************************************
- Init/Finalize Code
- ****************************************************************************}
- procedure copyvalueparas(p : tnamedindexitem;arg:pointer);
- var
- href1 : treference;
- list:TAAsmoutput;
- hsym : tvarsym;
- l : longint;
- loadref : boolean;
- localcopyloc : tlocation;
- begin
- list:=taasmoutput(arg);
- if (tsym(p).typ=varsym) and
- (tvarsym(p).varspez=vs_value) and
- (paramanager.push_addr_param(tvarsym(p).varspez,tvarsym(p).vartype.def,current_procinfo.procdef.proccalloption)) then
- begin
- loadref:=true;
- case tvarsym(p).localloc.loc of
- LOC_REGISTER :
- begin
- reference_reset_base(href1,tvarsym(p).localloc.register,0);
- loadref:=false;
- end;
- LOC_REFERENCE :
- href1:=tvarsym(p).localloc.reference;
- else
- internalerror(200309181);
- end;
- if is_open_array(tvarsym(p).vartype.def) or
- is_array_of_const(tvarsym(p).vartype.def) then
- begin
- { cdecl functions don't have a high pointer so it is not possible to generate
- a local copy }
- if not(current_procinfo.procdef.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
- begin
- hsym:=tvarsym(tsym(p).owner.search('high'+p.name));
- if not assigned(hsym) then
- internalerror(200306061);
- case hsym.localloc.loc of
- LOC_REFERENCE :
- begin
- { this code is only executed before the code for the body and the entry/exit code is generated
- so we're allowed to include pi_do_call here; after pass1 is run, this isn't allowed anymore
- }
- include(current_procinfo.flags,pi_do_call);
- cg.g_copyvaluepara_openarray(list,href1,hsym.localloc.reference,tarraydef(tvarsym(p).vartype.def).elesize)
- end
- else
- internalerror(200309182);
- end;
- end;
- end
- else
- begin
- if tvarsym(p).localloc.loc<>LOC_REFERENCE then
- internalerror(200309183);
- { Allocate space for the local copy }
- l:=tvarsym(p).getvaluesize;
- localcopyloc.loc:=LOC_REFERENCE;
- localcopyloc.size:=int_cgsize(l);
- tg.GetLocal(list,l,tvarsym(p).vartype.def,localcopyloc.reference);
- { Copy data }
- if is_shortstring(tvarsym(p).vartype.def) then
- begin
- { this code is only executed before the code for the body and the entry/exit code is generated
- so we're allowed to include pi_do_call here; after pass1 is run, this isn't allowed anymore
- }
- include(current_procinfo.flags,pi_do_call);
- cg.g_copyshortstring(list,href1,localcopyloc.reference,tstringdef(tvarsym(p).vartype.def).len,loadref)
- end
- else
- cg.g_concatcopy(list,href1,localcopyloc.reference,tvarsym(p).vartype.def.size,loadref);
- { update localloc of varsym }
- tg.Ungetlocal(list,tvarsym(p).localloc.reference);
- tvarsym(p).localloc:=localcopyloc;
- end;
- end;
- end;
- { generates the code for initialisation of local data }
- procedure initialize_data(p : tnamedindexitem;arg:pointer);
- var
- oldexprasmlist : TAAsmoutput;
- hp : tnode;
- begin
- if (tsym(p).typ=varsym) and
- (tvarsym(p).refs>0) and
- not(is_class(tvarsym(p).vartype.def)) and
- tvarsym(p).vartype.def.needs_inittable then
- begin
- oldexprasmlist:=exprasmlist;
- exprasmlist:=taasmoutput(arg);
- hp:=initialize_data_node(cloadnode.create(tsym(p),tsym(p).owner));
- firstpass(hp);
- secondpass(hp);
- hp.free;
- exprasmlist:=oldexprasmlist;
- end;
- end;
- procedure finalize_sym(asmlist:taasmoutput;sym:tsym);
- var
- hp : tnode;
- oldexprasmlist : TAAsmoutput;
- begin
- include(current_procinfo.flags,pi_needs_implicit_finally);
- oldexprasmlist:=exprasmlist;
- exprasmlist:=asmlist;
- hp:=finalize_data_node(cloadnode.create(sym,sym.owner));
- firstpass(hp);
- secondpass(hp);
- hp.free;
- exprasmlist:=oldexprasmlist;
- end;
- { generates the code for finalisation of local variables }
- procedure finalize_local_vars(p : tnamedindexitem;arg:pointer);
- begin
- case tsym(p).typ of
- varsym :
- begin
- if (tvarsym(p).refs>0) and
- not(vo_is_funcret in tvarsym(p).varoptions) and
- not(is_class(tvarsym(p).vartype.def)) and
- tvarsym(p).vartype.def.needs_inittable then
- finalize_sym(taasmoutput(arg),tsym(p));
- end;
- end;
- end;
- { generates the code for finalisation of local typedconsts }
- procedure finalize_local_typedconst(p : tnamedindexitem;arg:pointer);
- var
- i : longint;
- pd : tprocdef;
- begin
- case tsym(p).typ of
- typedconstsym :
- begin
- if ttypedconstsym(p).is_writable and
- ttypedconstsym(p).typedconsttype.def.needs_inittable then
- finalize_sym(taasmoutput(arg),tsym(p));
- end;
- procsym :
- begin
- for i:=1 to tprocsym(p).procdef_count do
- begin
- pd:=tprocsym(p).procdef[i];
- if assigned(pd.localst) and
- (pd.procsym=tprocsym(p)) and
- (pd.localst.symtabletype<>staticsymtable) then
- pd.localst.foreach_static(@finalize_local_typedconst,arg);
- end;
- end;
- end;
- end;
- { generates the code for finalization of static symtable and
- all local (static) typedconsts }
- procedure finalize_static_data(p : tnamedindexitem;arg:pointer);
- var
- i : longint;
- pd : tprocdef;
- begin
- case tsym(p).typ of
- varsym :
- begin
- if (tvarsym(p).refs>0) and
- not(vo_is_funcret in tvarsym(p).varoptions) and
- not(is_class(tvarsym(p).vartype.def)) and
- tvarsym(p).vartype.def.needs_inittable then
- finalize_sym(taasmoutput(arg),tsym(p));
- end;
- typedconstsym :
- begin
- if ttypedconstsym(p).is_writable and
- ttypedconstsym(p).typedconsttype.def.needs_inittable then
- finalize_sym(taasmoutput(arg),tsym(p));
- end;
- procsym :
- begin
- for i:=1 to tprocsym(p).procdef_count do
- begin
- pd:=tprocsym(p).procdef[i];
- if assigned(pd.localst) and
- (pd.procsym=tprocsym(p)) and
- (pd.localst.symtabletype<>staticsymtable) then
- pd.localst.foreach_static(@finalize_local_typedconst,arg);
- end;
- end;
- 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
- if tvarsym(p).localloc.loc<>LOC_REFERENCE then
- internalerror(200309187);
- cg.g_incrrefcount(list,tvarsym(p).vartype.def,tvarsym(p).localloc.reference,is_open_array(tvarsym(p).vartype.def));
- end;
- vs_out :
- begin
- case tvarsym(p).localloc.loc of
- LOC_REFERENCE :
- href:=tvarsym(p).localloc.reference;
- else
- internalerror(2003091810);
- end;
- tmpreg:=cg.getaddressregister(list);
- cg.a_load_ref_reg(list,OS_ADDR,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
- 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
- include(current_procinfo.flags,pi_needs_implicit_finally);
- if tvarsym(p).localloc.loc<>LOC_REFERENCE then
- internalerror(200309188);
- cg.g_decrrefcount(list,tvarsym(p).vartype.def,tvarsym(p).localloc.reference,is_open_array(tvarsym(p).vartype.def));
- end;
- end
- else if (tsym(p).typ=varsym) and
- (tvarsym(p).varspez=vs_value) and
- (is_open_array(tvarsym(p).vartype.def) or
- is_array_of_const(tvarsym(p).vartype.def)) then
- begin
- { cdecl functions don't have a high pointer so it is not possible to generate
- a local copy }
- if not(current_procinfo.procdef.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
- cg.g_releasevaluepara_openarray(list,tvarsym(p).localloc.reference);
- 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 assigned(hp^.def) and
- hp^.def.needs_inittable then
- begin
- reference_reset_base(href,current_procinfo.framepointer,hp^.pos);
- cg.g_initialize(list,hp^.def,href,false);
- end;
- hp:=hp^.next;
- end;
- end;
- procedure finalizetempvariables(list:taasmoutput);
- var
- hp : ptemprecord;
- href : treference;
- begin
- hp:=tg.templist;
- while assigned(hp) do
- begin
- if assigned(hp^.def) and
- hp^.def.needs_inittable then
- begin
- include(current_procinfo.flags,pi_needs_implicit_finally);
- reference_reset_base(href,current_procinfo.framepointer,hp^.pos);
- cg.g_finalize(list,hp^.def,href,false);
- end;
- hp:=hp^.next;
- end;
- end;
- procedure gen_load_return_value(list:TAAsmoutput);
- var
- {$ifndef cpu64bit}
- href : treference;
- {$endif cpu64bit}
- ressym : tvarsym;
- resloc,
- restmploc : tlocation;
- hreg : tregister;
- funcretloc : pcgparalocation;
- begin
- { Is the loading needed? }
- if is_void(current_procinfo.procdef.rettype.def) or
- (
- (po_assembler in current_procinfo.procdef.procoptions) and
- (not(assigned(current_procinfo.procdef.funcretsym)) or
- (tvarsym(current_procinfo.procdef.funcretsym).refs=0))
- ) then
- exit;
- funcretloc:=current_procinfo.procdef.funcret_paraloc[calleeside].location;
- if not assigned(funcretloc) then
- internalerror(200408202);
- { constructors return self }
- if (current_procinfo.procdef.proctypeoption=potype_constructor) then
- ressym:=tvarsym(current_procinfo.procdef.parast.search('self'))
- else
- ressym:=tvarsym(current_procinfo.procdef.funcretsym);
- if (ressym.refs>0) then
- begin
- {$ifdef OLDREGVARS}
- case ressym.localloc.loc of
- LOC_CFPUREGISTER,
- LOC_FPUREGISTER:
- begin
- location_reset(restmploc,LOC_CFPUREGISTER,funcretloc^.size);
- restmploc.register:=ressym.localloc.register;
- end;
- LOC_CREGISTER,
- LOC_REGISTER:
- begin
- location_reset(restmploc,LOC_CREGISTER,funcretloc^.size);
- restmploc.register:=ressym.localloc.register;
- end;
- LOC_MMREGISTER:
- begin
- location_reset(restmploc,LOC_CMMREGISTER,funcretloc^.size);
- restmploc.register:=ressym.localloc.register;
- end;
- LOC_REFERENCE:
- begin
- location_reset(restmploc,LOC_REFERENCE,funcretloc^.size);
- restmploc.reference:=ressym.localloc.reference;
- end;
- else
- internalerror(200309184);
- end;
- {$else}
- restmploc:=ressym.localloc;
- {$endif}
- { Here, we return the function result. In most architectures, the value is
- passed into the FUNCTION_RETURN_REG, but in a windowed architecure like sparc a
- function returns in a register and the caller receives it in an other one }
- case funcretloc^.loc of
- LOC_REGISTER:
- begin
- {$ifndef cpu64bit}
- if current_procinfo.procdef.funcret_paraloc[calleeside].size in [OS_64,OS_S64] then
- begin
- current_procinfo.procdef.funcret_paraloc[calleeside].get_location(resloc);
- if resloc.loc<>LOC_REGISTER then
- internalerror(200409141);
- { Load low and high register separate to generate better register
- allocation info }
- if getsupreg(resloc.registerlow)<first_int_imreg then
- begin
- cg.getcpuregister(list,resloc.registerlow);
- cg.ungetcpuregister(list,resloc.registerlow);
- { for the optimizer }
- cg.a_reg_alloc(list,resloc.registerlow);
- end;
- case restmploc.loc of
- LOC_REFERENCE :
- begin
- href:=restmploc.reference;
- if target_info.endian=ENDIAN_BIG then
- inc(href.offset,4);
- cg.a_load_ref_reg(list,OS_32,OS_32,href,resloc.registerlow);
- end;
- LOC_CREGISTER :
- cg.a_load_reg_reg(list,OS_32,OS_32,restmploc.registerlow,resloc.registerlow);
- else
- internalerror(200409203);
- end;
- if getsupreg(resloc.registerhigh)<first_int_imreg then
- begin
- cg.getcpuregister(list,resloc.registerhigh);
- cg.ungetcpuregister(list,resloc.registerhigh);
- { for the optimizer }
- cg.a_reg_alloc(list,resloc.registerhigh);
- end;
- case restmploc.loc of
- LOC_REFERENCE :
- begin
- href:=restmploc.reference;
- if target_info.endian=ENDIAN_LITTLE then
- inc(href.offset,4);
- cg.a_load_ref_reg(list,OS_32,OS_32,href,resloc.registerhigh);
- end;
- LOC_CREGISTER :
- cg.a_load_reg_reg(list,OS_32,OS_32,restmploc.registerhigh,resloc.registerhigh);
- else
- internalerror(200409204);
- end;
- end
- else
- {$endif cpu64bit}
- begin
- hreg:=cg.makeregsize(list,funcretloc^.register,restmploc.size);
- if getsupreg(funcretloc^.register)<first_int_imreg then
- begin
- cg.getcpuregister(list,funcretloc^.register);
- cg.ungetcpuregister(list,hreg);
- { for the optimizer }
- cg.a_reg_alloc(list,funcretloc^.register);
- end;
- cg.a_load_loc_reg(list,restmploc.size,restmploc,hreg);
- end;
- end;
- LOC_FPUREGISTER:
- begin
- if getsupreg(funcretloc^.register)<first_fpu_imreg then
- begin
- cg.getcpuregister(list,funcretloc^.register);
- cg.ungetcpuregister(list,funcretloc^.register);
- end;
- cg.a_loadfpu_loc_reg(list,restmploc,funcretloc^.register);
- end;
- LOC_MMREGISTER:
- begin
- if getsupreg(funcretloc^.register)<first_mm_imreg then
- begin
- cg.getcpuregister(list,funcretloc^.register);
- cg.ungetcpuregister(list,funcretloc^.register);
- end;
- cg.a_loadmm_loc_reg(list,restmploc.size,restmploc,funcretloc^.register,mms_movescalar);
- end;
- LOC_INVALID,
- LOC_REFERENCE:
- ;
- else
- internalerror(200405025);
- end;
- end;
- end;
- procedure gen_load_para_value(list:TAAsmoutput);
- procedure get_para(const paraloc:TCGParaLocation);
- begin
- case paraloc.loc of
- LOC_REGISTER :
- begin
- if getsupreg(paraloc.register)<first_int_imreg then
- cg.getcpuregister(list,paraloc.register);
- end;
- LOC_MMREGISTER :
- begin
- if getsupreg(paraloc.register)<first_mm_imreg then
- cg.getcpuregister(list,paraloc.register);
- end;
- LOC_FPUREGISTER :
- begin
- if getsupreg(paraloc.register)<first_fpu_imreg then
- cg.getcpuregister(list,paraloc.register);
- end;
- end;
- end;
- procedure unget_para(const paraloc:TCGParaLocation);
- begin
- case paraloc.loc of
- LOC_REGISTER :
- begin
- if getsupreg(paraloc.register)<first_int_imreg then
- cg.ungetcpuregister(list,paraloc.register);
- end;
- LOC_MMREGISTER :
- begin
- if getsupreg(paraloc.register)<first_mm_imreg then
- cg.ungetcpuregister(list,paraloc.register);
- end;
- LOC_FPUREGISTER :
- begin
- if getsupreg(paraloc.register)<first_fpu_imreg then
- cg.ungetcpuregister(list,paraloc.register);
- end;
- end;
- end;
- procedure gen_load_ref(const paraloc:TCGParaLocation;const ref:treference);
- var
- href : treference;
- begin
- case paraloc.loc of
- LOC_REGISTER :
- cg.a_load_reg_ref(list,paraloc.size,paraloc.size,paraloc.register,ref);
- LOC_MMREGISTER :
- cg.a_loadmm_reg_ref(list,paraloc.size,paraloc.size,paraloc.register,ref,mms_movescalar);
- LOC_FPUREGISTER :
- cg.a_loadfpu_reg_ref(list,paraloc.size,paraloc.register,ref);
- LOC_REFERENCE :
- begin
- reference_reset_base(href,paraloc.reference.index,paraloc.reference.offset);
- { use concatcopy, because it can also be a float which fails when
- load_ref_ref is used. Don't copy data when the references are equal }
- if not((href.base=ref.base) and (href.offset=ref.offset)) then
- cg.g_concatcopy(list,href,ref,tcgsize2size[paraloc.size],false);
- end;
- else
- internalerror(2002081302);
- end;
- end;
- procedure gen_load_reg(const paraloc:TCGParaLocation;reg:tregister);
- var
- href : treference;
- begin
- case paraloc.loc of
- LOC_REGISTER :
- cg.a_load_reg_reg(list,paraloc.size,paraloc.size,paraloc.register,reg);
- LOC_MMREGISTER :
- cg.a_loadmm_reg_reg(list,paraloc.size,paraloc.size,paraloc.register,reg,mms_movescalar);
- LOC_FPUREGISTER :
- cg.a_loadfpu_reg_reg(list,paraloc.size,paraloc.register,reg);
- LOC_REFERENCE :
- begin
- reference_reset_base(href,paraloc.reference.index,paraloc.reference.offset);
- cg.a_load_ref_reg(list,paraloc.size,paraloc.size,href,reg);
- end;
- else
- internalerror(2002081302);
- end;
- end;
- var
- hp : tparaitem;
- paraloc : pcgparalocation;
- href : treference;
- begin
- if (po_assembler in current_procinfo.procdef.procoptions) then
- exit;
- { Allocate registers used by parameters }
- hp:=tparaitem(current_procinfo.procdef.para.first);
- while assigned(hp) do
- begin
- paraloc:=hp.paraloc[calleeside].location;
- while assigned(paraloc) do
- begin
- if paraloc^.loc in [LOC_REGISTER,LOC_FPUREGISTER,LOC_MMREGISTER] then
- get_para(paraloc^);
- paraloc:=paraloc^.next;
- end;
- hp:=tparaitem(hp.next);
- end;
- { Copy parameters to local references/registers }
- hp:=tparaitem(current_procinfo.procdef.para.first);
- while assigned(hp) do
- begin
- paraloc:=hp.paraloc[calleeside].location;
- if not assigned(paraloc) then
- internalerror(200408203);
- case tvarsym(hp.parasym).localloc.loc of
- LOC_REFERENCE :
- begin
- href:=tvarsym(hp.parasym).localloc.reference;
- while assigned(paraloc) do
- begin
- unget_para(paraloc^);
- gen_load_ref(paraloc^,href);
- inc(href.offset,TCGSize2Size[paraloc^.size]);
- paraloc:=paraloc^.next;
- end;
- end;
- LOC_CREGISTER,
- LOC_CMMREGISTER,
- LOC_CFPUREGISTER :
- begin
- href:=tvarsym(hp.parasym).localloc.reference;
- {$ifndef cpu64bit}
- if tvarsym(hp.parasym).localloc.size in [OS_64,OS_S64] then
- begin
- { First 32bits }
- unget_para(paraloc^);
- if (target_info.endian=ENDIAN_BIG) then
- gen_load_reg(paraloc^,tvarsym(hp.parasym).localloc.registerhigh)
- else
- gen_load_reg(paraloc^,tvarsym(hp.parasym).localloc.registerlow);
- { Second 32bits }
- if not assigned(paraloc^.next) then
- internalerror(200410104);
- unget_para(paraloc^);
- if (target_info.endian=ENDIAN_BIG) then
- gen_load_reg(paraloc^,tvarsym(hp.parasym).localloc.registerlow)
- else
- gen_load_reg(paraloc^,tvarsym(hp.parasym).localloc.registerhigh);
- end
- else
- {$endif cpu64bit}
- begin
- unget_para(paraloc^);
- gen_load_reg(paraloc^,tvarsym(hp.parasym).localloc.register);
- if assigned(paraloc^.next) then
- internalerror(200410105);
- end;
- end;
- end;
- hp:=tparaitem(hp.next);
- end;
- { generate copies of call by value parameters, must be done before
- the initialization and body is parsed because the refcounts are
- incremented using the local copies }
- current_procinfo.procdef.parast.foreach_static({$ifndef TP}@{$endif}copyvalueparas,list);
- end;
- procedure gen_initialize_code(list:TAAsmoutput);
- begin
- { initialize local data like ansistrings }
- case current_procinfo.procdef.proctypeoption of
- potype_unitinit:
- begin
- { this is also used for initialization of variables in a
- program which does not have a globalsymtable }
- if assigned(current_module.globalsymtable) then
- 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: ;
- { program init/final is generated in separate procedure }
- potype_proginit: ;
- else
- current_procinfo.procdef.localst.foreach_static({$ifndef TP}@{$endif}initialize_data,list);
- end;
- { initialisizes temp. ansi/wide string data }
- inittempvariables(list);
- { initialize ansi/widesstring para's }
- current_procinfo.procdef.parast.foreach_static({$ifndef TP}@{$endif}init_paras,list);
- {$ifdef OLDREGVARS}
- load_regvars(list,nil);
- {$endif OLDREGVARS}
- end;
- procedure gen_finalize_code(list:TAAsmoutput);
- begin
- {$ifdef OLDREGVARS}
- cleanup_regvars(list);
- {$endif OLDREGVARS}
- { finalize temporary data }
- finalizetempvariables(list);
- { finalize local data like ansistrings}
- case current_procinfo.procdef.proctypeoption of
- potype_unitfinalize:
- begin
- { this is also used for initialization of variables in a
- program which does not have a globalsymtable }
- if assigned(current_module.globalsymtable) then
- tsymtable(current_module.globalsymtable).foreach_static({$ifndef TP}@{$endif}finalize_static_data,list);
- tsymtable(current_module.localsymtable).foreach_static({$ifndef TP}@{$endif}finalize_static_data,list);
- end;
- { units/progs have separate code for initialization and finalization }
- potype_unitinit: ;
- { program init/final is generated in separate procedure }
- potype_proginit: ;
- else
- current_procinfo.procdef.localst.foreach_static({$ifndef TP}@{$endif}finalize_local_vars,list);
- end;
- { finalize paras data }
- if assigned(current_procinfo.procdef.parast) then
- current_procinfo.procdef.parast.foreach_static({$ifndef TP}@{$endif}final_paras,list);
- end;
- procedure gen_entry_code(list:TAAsmoutput);
- var
- href : treference;
- paraloc1,
- paraloc2 : tcgpara;
- hp : tused_unit;
- begin
- paraloc1.init;
- paraloc2.init;
- { the actual profile code can clobber some registers,
- therefore if the context must be saved, do it before
- the actual call to the profile code
- }
- if (cs_profile in aktmoduleswitches) and
- not(po_assembler in current_procinfo.procdef.procoptions) then
- begin
- { non-win32 can call mcout even in main }
- if not (target_info.system in [system_i386_win32,system_i386_wdosx]) or
- not (current_procinfo.procdef.proctypeoption=potype_proginit) then
- begin
- cg.alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_cdecl));
- cg.g_profilecode(list);
- cg.dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_cdecl));
- end;
- end;
- { call startup helpers from main program }
- if (current_procinfo.procdef.proctypeoption=potype_proginit) then
- begin
- { initialize profiling for win32 }
- if (target_info.system in [system_i386_win32,system_i386_wdosx]) and
- (cs_profile in aktmoduleswitches) then
- begin
- reference_reset_symbol(href,objectlibrary.newasmsymbol('etext',AB_EXTERNAL,AT_DATA),0);
- paramanager.getintparaloc(pocall_default,1,paraloc1);
- paramanager.getintparaloc(pocall_default,2,paraloc2);
- paramanager.allocparaloc(list,paraloc2);
- cg.a_paramaddr_ref(list,href,paraloc2);
- reference_reset_symbol(href,objectlibrary.newasmsymbol('__image_base__',AB_EXTERNAL,AT_DATA),0);
- paramanager.allocparaloc(list,paraloc1);
- cg.a_paramaddr_ref(list,href,paraloc1);
- paramanager.freeparaloc(list,paraloc2);
- paramanager.freeparaloc(list,paraloc1);
- cg.alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_cdecl));
- cg.a_call_name(list,'_monstartup');
- cg.dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_cdecl));
- end;
- { initialize units }
- cg.alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
- cg.a_call_name(list,'FPC_INITIALIZEUNITS');
- cg.dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
- {$ifdef GDB}
- if (cs_debuginfo in aktmoduleswitches) then
- if target_info.system <> system_powerpc_macos then
- begin
- { include reference to all debuginfo sections of used units }
- hp:=tused_unit(usedunits.first);
- while assigned(hp) do
- begin
- If (hp.u.flags and uf_has_debuginfo)=uf_has_debuginfo then
- current_procinfo.aktlocaldata.concat(Tai_const.Createname(make_mangledname('DEBUGINFO',hp.u.globalsymtable,''),AT_DATA,0));
- hp:=tused_unit(hp.next);
- end;
- { include reference to debuginfo for this program }
- current_procinfo.aktlocaldata.concat(Tai_const.Createname(make_mangledname('DEBUGINFO',current_module.localsymtable,''),AT_DATA,0));
- end;
- {$endif GDB}
- end;
- {$ifdef GDB}
- if (cs_debuginfo in aktmoduleswitches) then
- list.concat(Tai_force_line.Create);
- {$endif GDB}
- {$ifdef OLDREGVARS}
- load_regvars(list,nil);
- {$endif OLDREGVARS}
- paraloc1.done;
- paraloc2.done;
- end;
- procedure gen_exit_code(list:TAAsmoutput);
- begin
- { call __EXIT for main program }
- if (not DLLsource) and
- (current_procinfo.procdef.proctypeoption=potype_proginit) then
- cg.a_call_name(list,'FPC_DO_EXIT');
- end;
- {****************************************************************************
- Entry/Exit
- ****************************************************************************}
- procedure gen_proc_symbol(list:Taasmoutput);
- var
- hs : string;
- begin
- { add symbol entry point as well as debug information }
- { will be inserted in front of the rest of this list. }
- { Insert alignment and assembler names }
- { Align, gprof uses 16 byte granularity }
- if (cs_profile in aktmoduleswitches) then
- list.concat(Tai_align.create(16))
- else
- list.concat(Tai_align.create(aktalignment.procalign));
- {$ifdef GDB}
- if (cs_debuginfo in aktmoduleswitches) then
- begin
- if (po_public in current_procinfo.procdef.procoptions) then
- Tprocsym(current_procinfo.procdef.procsym).is_global:=true;
- current_procinfo.procdef.concatstabto(list);
- Tprocsym(current_procinfo.procdef.procsym).isstabwritten:=true;
- end;
- {$endif GDB}
- repeat
- hs:=current_procinfo.procdef.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 (cs_profile in aktmoduleswitches) or
- (po_public in current_procinfo.procdef.procoptions) then
- list.concat(Tai_symbol.createname_global(hs,AT_FUNCTION,0))
- else
- list.concat(Tai_symbol.createname(hs,AT_FUNCTION,0));
- until false;
- end;
- procedure gen_proc_symbol_end(list:Taasmoutput);
- {$ifdef GDB}
- var
- stabsendlabel : tasmlabel;
- mangled_length : longint;
- p : pchar;
- {$endif GDB}
- begin
- list.concat(Tai_symbol_end.Createname(current_procinfo.procdef.mangledname));
- {$ifdef GDB}
- if (cs_debuginfo in aktmoduleswitches) then
- begin
- objectlibrary.getlabel(stabsendlabel);
- cg.a_label(list,stabsendlabel);
- { define calling EBP as pseudo local var PM }
- { this enables test if the function is a local one !! }
- {if assigned(current_procinfo.parent) and
- (current_procinfo.procdef.parast.symtablelevel>normal_function_level) then
- list.concat(Tai_stabs.Create(strpnew(
- '"parent_ebp:'+tstoreddef(voidpointertype.def).numberstring+'",'+
- tostr(N_LSYM)+',0,0,'+tostr(current_procinfo.parent_framepointer_offset)))); }
- if assigned(current_procinfo.procdef.funcretsym) and
- (tvarsym(current_procinfo.procdef.funcretsym).refs>0) then
- begin
- if tvarsym(current_procinfo.procdef.funcretsym).localloc.loc=LOC_REFERENCE then
- begin
- {$warning Need to add gdb support for ret in param register calling}
- if paramanager.ret_in_param(current_procinfo.procdef.rettype.def,current_procinfo.procdef.proccalloption) then
- begin
- list.concat(Tai_stabs.Create(strpnew(
- '"'+current_procinfo.procdef.procsym.name+':X*'+tstoreddef(current_procinfo.procdef.rettype.def).numberstring+'",'+
- tostr(N_tsym)+',0,0,'+tostr(tvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset))));
- if (m_result in aktmodeswitches) then
- list.concat(Tai_stabs.Create(strpnew(
- '"RESULT:X*'+tstoreddef(current_procinfo.procdef.rettype.def).numberstring+'",'+
- tostr(N_tsym)+',0,0,'+tostr(tvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset))))
- end
- else
- begin
- list.concat(Tai_stabs.Create(strpnew(
- '"'+current_procinfo.procdef.procsym.name+':X'+tstoreddef(current_procinfo.procdef.rettype.def).numberstring+'",'+
- tostr(N_tsym)+',0,0,'+tostr(tvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset))));
- if (m_result in aktmodeswitches) then
- list.concat(Tai_stabs.Create(strpnew(
- '"RESULT:X'+tstoreddef(current_procinfo.procdef.rettype.def).numberstring+'",'+
- tostr(N_tsym)+',0,0,'+tostr(tvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset))));
- end;
- end;
- end;
- mangled_length:=length(current_procinfo.procdef.mangledname);
- getmem(p,2*mangled_length+50);
- strpcopy(p,'192,0,0,');
- strpcopy(strend(p),current_procinfo.procdef.mangledname);
- if (target_info.use_function_relative_addresses) then
- begin
- strpcopy(strend(p),'-');
- strpcopy(strend(p),current_procinfo.procdef.mangledname);
- end;
- list.concat(Tai_stabn.Create(strnew(p)));
- {List.concat(Tai_stabn.Create(strpnew('192,0,0,'
- +current_procinfo.procdef.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),current_procinfo.procdef.mangledname);
- end;
- list.concatlist(withdebuglist);
- list.concat(Tai_stabn.Create(strnew(p)));
- { strpnew('224,0,0,'
- +current_procinfo.procdef.mangledname+'_end'))));}
- freemem(p,2*mangled_length+50);
- end;
- {$endif GDB}
- end;
- procedure gen_proc_entry_code(list:Taasmoutput);
- var
- hitemp,
- lotemp,
- stackframe : longint;
- check : boolean;
- paraloc1 : tcgpara;
- href : treference;
- begin
- paraloc1.init;
- { generate call frame marker for dwarf call frame info }
- dwarfcfi.start_frame(list);
- { allocate temp for saving the argument used when
- stack checking uses a register for pushing the stackframe size }
- check:=(cs_check_stack in aktlocalswitches) and (current_procinfo.procdef.proctypeoption<>potype_proginit);
- if check then
- begin
- { Allocate tempspace to store register parameter than
- is destroyed when calling stackchecking code }
- paramanager.getintparaloc(pocall_default,1,paraloc1);
- if paraloc1.location^.loc=LOC_REGISTER then
- tg.GetTemp(list,sizeof(aint),tt_normal,href);
- end;
- { Calculate size of stackframe }
- stackframe:=current_procinfo.calc_stackframe_size;
- { All temps are know, write offsets used for information }
- if (cs_asm_source in aktglobalswitches) then
- begin
- if tg.direction>0 then
- begin
- lotemp:=current_procinfo.tempstart;
- hitemp:=tg.lasttemp;
- end
- else
- begin
- lotemp:=tg.lasttemp;
- hitemp:=current_procinfo.tempstart;
- end;
- list.concat(Tai_comment.Create(strpnew('Temps allocated between '+std_regname(current_procinfo.framepointer)+
- tostr_with_plus(lotemp)+' and '+std_regname(current_procinfo.framepointer)+tostr_with_plus(hitemp))));
- end;
- { generate target specific proc entry code }
- cg.g_proc_entry(list,stackframe,(po_nostackframe in current_procinfo.procdef.procoptions));
- { Add stack checking code? }
- if check then
- begin
- { The tempspace to store original register is already
- allocated above before the stackframe size is calculated. }
- if paraloc1.location^.loc=LOC_REGISTER then
- cg.a_load_reg_ref(list,OS_INT,OS_INT,paraloc1.location^.register,href);
- paramanager.allocparaloc(list,paraloc1);
- cg.a_param_const(list,OS_INT,stackframe,paraloc1);
- paramanager.freeparaloc(list,paraloc1);
- cg.alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
- cg.a_call_name(list,'FPC_STACKCHECK');
- cg.dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
- if paraloc1.location^.loc=LOC_REGISTER then
- begin
- cg.a_load_ref_reg(list,OS_INT,OS_INT,href,paraloc1.location^.register);
- tg.UnGetTemp(list,href);
- end;
- end;
- paraloc1.done;
- end;
- procedure gen_proc_exit_code(list:Taasmoutput);
- var
- parasize : longint;
- begin
- { c style clearstack does not need to remove parameters from the stack, only the
- return value when it was pushed by arguments }
- if current_procinfo.procdef.proccalloption in clearstack_pocalls then
- begin
- parasize:=0;
- if paramanager.ret_in_param(current_procinfo.procdef.rettype.def,current_procinfo.procdef.proccalloption) then
- inc(parasize,sizeof(aint));
- end
- else
- parasize:=current_procinfo.para_stack_size;
- { generate target specific proc exit code }
- cg.g_proc_exit(list,parasize,(po_nostackframe in current_procinfo.procdef.procoptions));
- { release return registers, needed for optimizer }
- paramanager.freeparaloc(list,current_procinfo.procdef.funcret_paraloc[calleeside]);
- { end of frame marker for call frame info }
- dwarfcfi.end_frame(list);
- end;
- procedure gen_save_used_regs(list:TAAsmoutput);
- begin
- { Pure assembler routines need to save the registers themselves }
- if (po_assembler in current_procinfo.procdef.procoptions) then
- exit;
- { 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 current_procinfo.procdef.procoptions) then
- cg.g_save_all_registers(list)
- else
- if current_procinfo.procdef.proccalloption in savestdregs_pocalls then
- cg.g_save_standard_registers(list);
- end;
- procedure gen_restore_used_regs(list:TAAsmoutput;const funcretparaloc:tcgpara);
- begin
- { Pure assembler routines need to save the registers themselves }
- if (po_assembler in current_procinfo.procdef.procoptions) then
- exit;
- { 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 current_procinfo.procdef.procoptions) then
- cg.g_restore_all_registers(list,funcretparaloc)
- else
- if current_procinfo.procdef.proccalloption in savestdregs_pocalls then
- cg.g_restore_standard_registers(list);
- end;
- {****************************************************************************
- Const Data
- ****************************************************************************}
- procedure insertconstdata(sym : ttypedconstsym);
- { this does not affect the local stack space, since all
- typed constansts and initialized variables are always
- put in the .data / .rodata section
- }
- var
- storefilepos : tfileposinfo;
- curconstsegment : taasmoutput;
- l : longint;
- begin
- storefilepos:=aktfilepos;
- aktfilepos:=sym.fileinfo;
- if sym.is_writable then
- curconstsegment:=datasegment
- else
- curconstsegment:=consts;
- l:=sym.getsize;
- { insert cut for smartlinking or alignment }
- maybe_new_object_file(curconstSegment);
- new_section(curconstSegment,sec_rodata,lower(sym.mangledname),const_align(l));
- if (sym.owner.symtabletype=globalsymtable) or
- maybe_smartlink_symbol or
- (assigned(current_procinfo) and
- (current_procinfo.procdef.proccalloption=pocall_inline)) or
- DLLSource then
- curconstSegment.concat(Tai_symbol.Createname_global(sym.mangledname,AT_DATA,l))
- else
- curconstSegment.concat(Tai_symbol.Createname(sym.mangledname,AT_DATA,l));
- aktfilepos:=storefilepos;
- end;
- procedure insertbssdata(sym : tvarsym);
- var
- l,varalign : longint;
- storefilepos : tfileposinfo;
- begin
- storefilepos:=aktfilepos;
- aktfilepos:=sym.fileinfo;
- l:=sym.getvaluesize;
- if (vo_is_thread_var in sym.varoptions) then
- inc(l,sizeof(aint));
- varalign:=var_align(l);
- maybe_new_object_file(bssSegment);
- new_section(bssSegment,sec_bss,lower(sym.mangledname),varalign);
- if (sym.owner.symtabletype=globalsymtable) or
- maybe_smartlink_symbol or
- DLLSource or
- (assigned(current_procinfo) and
- (current_procinfo.procdef.proccalloption=pocall_inline)) or
- (vo_is_exported in sym.varoptions) or
- (vo_is_C_var in sym.varoptions) then
- bssSegment.concat(Tai_datablock.Create_global(sym.mangledname,l))
- else
- bssSegment.concat(Tai_datablock.Create(sym.mangledname,l));
- aktfilepos:=storefilepos;
- end;
- procedure gen_alloc_symtable(list:TAAsmoutput;st:tsymtable);
- function getregvar(v:tvarregable;size:tcgsize):tregister;
- begin
- case v of
- vr_intreg :
- result:=cg.getintregister(list,size);
- vr_fpureg :
- result:=cg.getfpuregister(list,size);
- vr_mmreg :
- result:=cg.getmmregister(list,size);
- end;
- end;
- var
- sym : tsym;
- isaddr : boolean;
- cgsize : tcgsize;
- begin
- sym:=tsym(st.symindex.first);
- while assigned(sym) do
- begin
- if (sym.typ=varsym) then
- begin
- with tvarsym(sym) do
- begin
- { Parameters passed to assembler procedures need to be kept
- in the original location }
- if (st.symtabletype=parasymtable) and
- (po_assembler in current_procinfo.procdef.procoptions) then
- begin
- paraitem.paraloc[calleeside].get_location(localloc);
- end
- else
- begin
- isaddr:=(st.symtabletype=parasymtable) and
- paramanager.push_addr_param(varspez,vartype.def,current_procinfo.procdef.proccalloption);
- if isaddr then
- cgsize:=OS_ADDR
- else
- cgsize:=def_cgsize(vartype.def);
- {$ifndef OLDREGVARS}
- { When there is assembler code we can't use regvars }
- if (cs_regvars in aktglobalswitches) and
- not(pi_has_assembler_block in current_procinfo.flags) and
- not(pi_uses_exceptions in current_procinfo.flags) and
- (varregable<>vr_none) then
- begin
- localloc.loc:=LOC_CREGISTER;
- localloc.size:=cgsize;
- {$ifndef cpu64bit}
- if cgsize in [OS_64,OS_S64] then
- begin
- localloc.registerlow:=getregvar(varregable,OS_32);
- localloc.registerhigh:=getregvar(varregable,OS_32);
- end
- else
- {$endif cpu64bit}
- localloc.register:=getregvar(varregable,cgsize);
- end
- else
- {$endif NOT OLDREGVARS}
- begin
- localloc.loc:=LOC_REFERENCE;
- localloc.size:=cgsize;
- case st.symtabletype of
- parasymtable :
- begin
- { Reuse the parameter location for values to are at a single location on the stack }
- if (paraitem.paraloc[calleeside].is_simple_reference) then
- begin
- reference_reset_base(localloc.reference,paraitem.paraloc[calleeside].location^.reference.index,
- paraitem.paraloc[calleeside].location^.reference.offset);
- end
- else
- begin
- if isaddr then
- tg.GetLocal(list,sizeof(aint),voidpointertype.def,localloc.reference)
- else
- tg.GetLocal(list,getvaluesize,vartype.def,localloc.reference);
- end;
- end;
- localsymtable,
- stt_exceptsymtable :
- begin
- tg.GetLocal(list,getvaluesize,vartype.def,localloc.reference);
- end;
- staticsymtable :
- begin
- { PIC, DLL and Threadvar need extra code and are handled in ncgld }
- if not(cs_create_pic in aktmoduleswitches) and
- not(vo_is_dll_var in varoptions) and
- not(vo_is_thread_var in varoptions) then
- reference_reset_symbol(localloc.reference,objectlibrary.newasmsymbol(mangledname,AB_EXTERNAL,AT_DATA),0);
- end;
- else
- internalerror(200410103);
- end;
- end;
- end;
- if cs_asm_source in aktglobalswitches then
- begin
- case localloc.loc of
- LOC_REGISTER,
- LOC_CREGISTER :
- begin
- if (cs_no_regalloc in aktglobalswitches) then
- list.concat(Tai_comment.Create(strpnew('Var '+realname+' located in register '+
- std_regname(localloc.register))))
- else
- list.concat(Tai_comment.Create(strpnew('Var '+realname+' located in register')));
- end;
- LOC_REFERENCE :
- begin
- if not assigned(localloc.reference.symbol) then
- list.concat(Tai_comment.Create(strpnew('Var '+realname+' located at '+
- std_regname(localloc.reference.base)+tostr_with_plus(localloc.reference.offset))));
- end;
- end;
- end;
- end;
- end;
- sym:=tsym(sym.indexnext);
- end;
- end;
- procedure gen_free_symtable(list:TAAsmoutput;st:tsymtable);
- var
- sym : tsym;
- begin
- sym:=tsym(st.symindex.first);
- while assigned(sym) do
- begin
- if (sym.typ=varsym) then
- begin
- with tvarsym(sym) do
- begin
- { Note: We need to keep the data available in memory
- for the sub procedures that can access local data
- in the parent procedures }
- case localloc.loc of
- LOC_CREGISTER :
- cg.a_reg_sync(list,localloc.register);
- LOC_REFERENCE :
- begin
- case st.symtabletype of
- localsymtable,
- parasymtable,
- stt_exceptsymtable :
- tg.Ungetlocal(list,localloc.reference);
- end;
- end;
- end;
- end;
- end;
- sym:=tsym(sym.indexnext);
- end;
- end;
- procedure gen_alloc_inline_parast(list:TAAsmoutput;pd:tprocdef);
- var
- sym : tsym;
- calleeparaloc,
- callerparaloc : pcgparalocation;
- begin
- if (po_assembler in pd.procoptions) then
- exit;
- sym:=tsym(pd.parast.symindex.first);
- while assigned(sym) do
- begin
- if sym.typ=varsym then
- begin
- with tvarsym(sym) do
- begin
- { for localloc <> LOC_REFERENCE, we need regvar support inside inlined procedures }
- localloc.loc:=LOC_REFERENCE;
- localloc.size:=int_cgsize(paramanager.push_size(varspez,vartype.def,pocall_inline));
- tg.GetLocal(list,tcgsize2size[localloc.size],vartype.def,localloc.reference);
- calleeparaloc:=paraitem.paraloc[calleeside].location;
- callerparaloc:=paraitem.paraloc[callerside].location;
- while assigned(calleeparaloc) do
- begin
- if not assigned(callerparaloc) then
- internalerror(200408281);
- if calleeparaloc^.loc<>callerparaloc^.loc then
- internalerror(200408282);
- case calleeparaloc^.loc of
- LOC_FPUREGISTER:
- begin
- calleeparaloc^.register:=cg.getfpuregister(list,calleeparaloc^.size);
- callerparaloc^.register:=calleeparaloc^.register;
- end;
- LOC_REGISTER:
- begin
- calleeparaloc^.register:=cg.getintregister(list,calleeparaloc^.size);
- callerparaloc^.register:=calleeparaloc^.register;
- end;
- LOC_MMREGISTER:
- begin
- calleeparaloc^.register:=cg.getmmregister(list,calleeparaloc^.size);
- callerparaloc^.register:=calleeparaloc^.register;
- end;
- LOC_REFERENCE:
- begin
- calleeparaloc^.reference.offset := localloc.reference.offset;
- calleeparaloc^.reference.index := localloc.reference.base;
- callerparaloc^.reference.offset := localloc.reference.offset;
- callerparaloc^.reference.index := localloc.reference.base;
- end;
- end;
- calleeparaloc:=calleeparaloc^.next;
- callerparaloc:=callerparaloc^.next;
- end;
- if cs_asm_source in aktglobalswitches then
- begin
- case localloc.loc of
- LOC_REFERENCE :
- list.concat(Tai_comment.Create(strpnew('Para '+realname+' allocated at '+
- std_regname(localloc.reference.base)+tostr_with_plus(localloc.reference.offset))));
- end;
- end;
- end;
- end;
- sym:=tsym(sym.indexnext);
- end;
- end;
- procedure gen_alloc_inline_funcret(list:TAAsmoutput;pd:tprocdef);
- var
- calleeparaloc,
- callerparaloc : pcgparalocation;
- begin
- if not assigned(pd.funcretsym) or
- (po_assembler in pd.procoptions) then
- exit;
- { for localloc <> LOC_REFERENCE, we need regvar support inside inlined procedures }
- with tvarsym(pd.funcretsym) do
- begin
- localloc.loc:=LOC_REFERENCE;
- localloc.size:=int_cgsize(paramanager.push_size(varspez,vartype.def,pocall_inline));
- tg.GetLocal(list,tcgsize2size[localloc.size],vartype.def,localloc.reference);
- calleeparaloc:=pd.funcret_paraloc[calleeside].location;
- callerparaloc:=pd.funcret_paraloc[callerside].location;
- while assigned(calleeparaloc) do
- begin
- if not assigned(callerparaloc) then
- internalerror(200408281);
- if calleeparaloc^.loc<>callerparaloc^.loc then
- internalerror(200408282);
- case calleeparaloc^.loc of
- LOC_FPUREGISTER:
- begin
- calleeparaloc^.register:=cg.getfpuregister(list,calleeparaloc^.size);
- callerparaloc^.register:=calleeparaloc^.register;
- end;
- LOC_REGISTER:
- begin
- calleeparaloc^.register:=cg.getintregister(list,calleeparaloc^.size);
- callerparaloc^.register:=calleeparaloc^.register;
- end;
- LOC_MMREGISTER:
- begin
- calleeparaloc^.register:=cg.getmmregister(list,calleeparaloc^.size);
- callerparaloc^.register:=calleeparaloc^.register;
- end;
- LOC_REFERENCE:
- begin
- calleeparaloc^.reference.offset := localloc.reference.offset;
- calleeparaloc^.reference.index := localloc.reference.base;
- callerparaloc^.reference.offset := localloc.reference.offset;
- callerparaloc^.reference.index := localloc.reference.base;
- end;
- end;
- calleeparaloc:=calleeparaloc^.next;
- callerparaloc:=callerparaloc^.next;
- end;
- if cs_asm_source in aktglobalswitches then
- begin
- case localloc.loc of
- LOC_REFERENCE :
- list.concat(Tai_comment.Create(strpnew('Funcret '+realname+' allocated at '+
- std_regname(localloc.reference.base)+tostr_with_plus(localloc.reference.offset))));
- end;
- end;
- end;
- end;
- { persistent rtti generation }
- procedure generate_rtti(p:Ttypesym);
- var
- rsym : trttisym;
- def : tstoreddef;
- begin
- { rtti can only be generated for classes that are always typesyms }
- def:=tstoreddef(ttypesym(p).restype.def);
- { there is an error, skip rtti info }
- if (def.deftype=errordef) or (Errorcount>0) then
- exit;
- { only create rtti once for each definition }
- if not(df_has_rttitable in def.defoptions) then
- begin
- { definition should be in the same symtable as the symbol }
- if p.owner<>def.owner then
- internalerror(200108262);
- { create rttisym }
- rsym:=trttisym.create(p.name,fullrtti);
- p.owner.insert(rsym);
- { register rttisym in definition }
- include(def.defoptions,df_has_rttitable);
- def.rttitablesym:=rsym;
- { write rtti data }
- def.write_child_rtti_data(fullrtti);
- maybe_new_object_file(rttilist);
- new_section(rttilist,sec_rodata,rsym.get_label.name,const_align(sizeof(aint)));
- rttiList.concat(Tai_symbol.Create_global(rsym.get_label,0));
- def.write_rtti_data(fullrtti);
- rttiList.concat(Tai_symbol_end.Create(rsym.get_label));
- end;
- end;
- { persistent init table generation }
- procedure generate_inittable(p:tsym);
- var
- rsym : trttisym;
- def : tstoreddef;
- begin
- { anonymous types are also allowed for records that can be varsym }
- case p.typ of
- typesym :
- def:=tstoreddef(ttypesym(p).restype.def);
- varsym :
- def:=tstoreddef(tvarsym(p).vartype.def);
- else
- internalerror(200108263);
- end;
- { only create inittable once for each definition }
- if not(df_has_inittable in def.defoptions) then
- begin
- { definition should be in the same symtable as the symbol }
- if p.owner<>def.owner then
- internalerror(200108264);
- { create rttisym }
- rsym:=trttisym.create(p.name,initrtti);
- p.owner.insert(rsym);
- { register rttisym in definition }
- include(def.defoptions,df_has_inittable);
- def.inittablesym:=rsym;
- { write inittable data }
- def.write_child_rtti_data(initrtti);
- maybe_new_object_file(rttilist);
- new_section(rttilist,sec_rodata,rsym.get_label.name,const_align(sizeof(aint)));
- rttiList.concat(Tai_symbol.Create_global(rsym.get_label,0));
- def.write_rtti_data(initrtti);
- rttiList.concat(Tai_symbol_end.Create(rsym.get_label));
- end;
- end;
- end.
- {
- $Log$
- Revision 1.223 2004-10-10 20:22:53 peter
- * symtable allocation rewritten
- * loading of parameters to local temps/regs cleanup
- * regvar support for parameters
- * regvar support for staticsymtable (main body)
- Revision 1.222 2004/10/09 10:51:13 olle
- * Refs to DEBUGINFO_<x> is now not inserted for target MacOS
- Revision 1.221 2004/10/08 20:52:07 florian
- * fixed storage of parameters passed by ref.
- Revision 1.220 2004/10/08 17:09:43 peter
- * tvarsym.varregable added, split vo_regable from varoptions
- Revision 1.219 2004/09/27 15:14:08 peter
- * fix compile for oldregvars
- Revision 1.218 2004/09/26 17:45:30 peter
- * simple regvar support, not yet finished
- Revision 1.217 2004/09/25 14:23:54 peter
- * ungetregister is now only used for cpuregisters, renamed to
- ungetcpuregister
- * renamed (get|unget)explicitregister(s) to ..cpuregister
- * removed location-release/reference_release
- Revision 1.216 2004/09/21 17:25:12 peter
- * paraloc branch merged
- Revision 1.215 2004/09/14 16:33:46 peter
- * release localsymtables when module is compiled
- Revision 1.214 2004/09/13 20:30:05 peter
- * finalize all (also procedure local) typedconst at unit finalization
- Revision 1.213.4.3 2004/09/20 20:46:34 peter
- * register allocation optimized for 64bit loading of parameters
- and return values
- Revision 1.213.4.2 2004/09/17 17:19:26 peter
- * fixed 64 bit unaryminus for sparc
- * fixed 64 bit inlining
- * signness of not operation
- Revision 1.213.4.1 2004/08/31 20:43:06 peter
- * paraloc patch
- Revision 1.213 2004/08/23 11:00:06 michael
- + Patch from Peter to fix debuginfo in constructor.
- Revision 1.212 2004/07/17 13:14:17 jonas
- * don't finalize typed consts (fixes bug3212, but causes memory leak;
- they should be finalized at the end of the module)
- Revision 1.211 2004/07/09 23:41:04 jonas
- * support register parameters for inlined procedures + some inline
- cleanups
- Revision 1.210 2004/07/04 12:24:59 jonas
- * fixed one regvar problem, but regvars are still broken since the dwarf
- merge...
- Revision 1.209 2004/06/29 20:57:21 peter
- * fixed size of exceptbuf
- Revision 1.208 2004/06/20 08:55:29 florian
- * logs truncated
- Revision 1.207 2004/06/16 20:07:08 florian
- * dwarf branch merged
- Revision 1.206 2004/06/01 20:39:33 jonas
- * fixed bug regarding parameters on the ppc (they were allocated twice
- under some circumstances and not at all in others)
- Revision 1.205 2004/05/30 21:41:15 jonas
- * more regvar optimizations in location_force_reg
- Revision 1.204 2004/05/30 21:18:22 jonas
- * some optimizations and associated fixes for better regvar code
- Revision 1.203 2004/05/28 21:14:13 peter
- * first load para's to temps before calling entry code (profile
- }
|