12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360 |
- {
- $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,cgutils,
- 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);
- { Retrieve the location of the data pointed to in location l, when the location is
- a register it is expected to contain the address of the data }
- procedure location_get_data_ref(list:TAAsmoutput;const l:tlocation;var ref:treference;loadref: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_stack_check_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;exceptlabel:tasmlabel);
- procedure free_exception(list:TAAsmoutput;const t:texceptiontemps;a:aint;endexceptlabel:tasmlabel;onlyfree:boolean);
- procedure insertconstdata(sym : ttypedconstsym);
- procedure insertbssdata(sym : tglobalvarsym);
- 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
- strings,
- 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,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.register64.reghi<>NR_NO then
- exclude(regs,getsupreg(t.register64.reghi));
- 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;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.register64.reglo,OS_32);
- cg.a_load_reg_reg(list,l.size,OS_32,l.register64.reglo,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.register64.reglo:=hregister;
- l.register64.reghi:=hregisterhi;
- end
- else
- begin
- { 64bit to 64bit }
- if (l.loc=LOC_REGISTER) or
- ((l.loc=LOC_CREGISTER) and maybeconst) then
- begin
- hregister:=l.register64.reglo;
- hregisterhi:=l.register64.reghi;
- 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.register64.reglo:=hregister;
- l.register64.reghi:=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;
- procedure location_get_data_ref(list:TAAsmoutput;const l:tlocation;var ref:treference;loadref:boolean);
- begin
- case l.loc of
- LOC_REGISTER,
- LOC_CREGISTER :
- begin
- if not loadref then
- internalerror(200410231);
- reference_reset_base(ref,l.register,0);
- end;
- LOC_REFERENCE,
- LOC_CREFERENCE :
- begin
- if loadref then
- begin
- reference_reset_base(ref,cg.getaddressregister(list),0);
- cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,l.reference,ref.base);
- end
- else
- ref:=l.reference;
- end;
- else
- internalerror(200309181);
- 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
- href : treference;
- hreg : tregister;
- list : TAAsmoutput;
- hsym : tparavarsym;
- l : longint;
- localcopyloc : tlocation;
- begin
- list:=taasmoutput(arg);
- if (tsym(p).typ=paravarsym) and
- (tparavarsym(p).varspez=vs_value) and
- (paramanager.push_addr_param(tparavarsym(p).varspez,tparavarsym(p).vartype.def,current_procinfo.procdef.proccalloption)) then
- begin
- location_get_data_ref(list,tparavarsym(p).localloc,href,true);
- if is_open_array(tparavarsym(p).vartype.def) or
- is_array_of_const(tparavarsym(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:=tparavarsym(tsym(p).owner.search('high'+p.name));
- if not assigned(hsym) then
- internalerror(200306061);
- hreg:=cg.getaddressregister(list);
- cg.g_copyvaluepara_openarray(list,href,hsym.localloc,tarraydef(tparavarsym(p).vartype.def).elesize,hreg);
- cg.a_load_reg_loc(list,OS_ADDR,hreg,tparavarsym(p).localloc);
- end;
- end
- else
- begin
- { Allocate space for the local copy }
- l:=tparavarsym(p).getsize;
- localcopyloc.loc:=LOC_REFERENCE;
- localcopyloc.size:=int_cgsize(l);
- tg.GetLocal(list,l,tparavarsym(p).vartype.def,localcopyloc.reference);
- { Copy data }
- if is_shortstring(tparavarsym(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,href,localcopyloc.reference,tstringdef(tparavarsym(p).vartype.def).len)
- end
- else
- cg.g_concatcopy(list,href,localcopyloc.reference,tparavarsym(p).vartype.def.size);
- { update localloc of varsym }
- tg.Ungetlocal(list,tparavarsym(p).localloc.reference);
- tparavarsym(p).localloc:=localcopyloc;
- end;
- end;
- end;
- { initializes the regvars from staticsymtable with 0 }
- procedure initialize_regvars(p : tnamedindexitem;arg:pointer);
- begin
- if (tsym(p).typ=globalvarsym) then
- begin
- case tglobalvarsym(p).localloc.loc of
- LOC_CREGISTER :
- cg.a_load_const_reg(taasmoutput(arg),reg_cgsize(tglobalvarsym(p).localloc.register),0,
- tglobalvarsym(p).localloc.register);
- LOC_REFERENCE : ;
- else
- internalerror(200410124);
- 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 in [globalvarsym,localvarsym]) and
- (tabstractvarsym(p).refs>0) and
- not(is_class(tabstractvarsym(p).vartype.def)) and
- tabstractvarsym(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
- if (tsym(p).typ=localvarsym) and
- (tlocalvarsym(p).refs>0) and
- not(vo_is_funcret in tlocalvarsym(p).varoptions) and
- not(is_class(tlocalvarsym(p).vartype.def)) and
- tlocalvarsym(p).vartype.def.needs_inittable then
- finalize_sym(taasmoutput(arg),tsym(p));
- 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
- globalvarsym :
- begin
- if (tglobalvarsym(p).refs>0) and
- not(vo_is_funcret in tglobalvarsym(p).varoptions) and
- not(is_class(tglobalvarsym(p).vartype.def)) and
- tglobalvarsym(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=paravarsym) and
- not is_class_or_interface(tparavarsym(p).vartype.def) and
- tparavarsym(p).vartype.def.needs_inittable then
- begin
- case tparavarsym(p).varspez of
- vs_value :
- begin
- location_get_data_ref(list,tparavarsym(p).localloc,href,is_open_array(tparavarsym(p).vartype.def));
- cg.g_incrrefcount(list,tparavarsym(p).vartype.def,href);
- end;
- vs_out :
- begin
- tmpreg:=cg.getaddressregister(list);
- cg.a_load_loc_reg(list,OS_ADDR,tparavarsym(p).localloc,tmpreg);
- reference_reset_base(href,tmpreg,0);
- cg.g_initialize(list,tparavarsym(p).vartype.def,href);
- end;
- end;
- end;
- end;
- { generates the code for decrementing the reference count of parameters }
- procedure final_paras(p : tnamedindexitem;arg:pointer);
- var
- list : TAAsmoutput;
- href : treference;
- begin
- if not(tsym(p).typ=paravarsym) then
- exit;
- list:=taasmoutput(arg);
- if not is_class_or_interface(tparavarsym(p).vartype.def) and
- tparavarsym(p).vartype.def.needs_inittable then
- begin
- location_get_data_ref(list,tparavarsym(p).localloc,href,is_open_array(tparavarsym(p).vartype.def));
- if (tparavarsym(p).varspez=vs_value) then
- begin
- include(current_procinfo.flags,pi_needs_implicit_finally);
- location_get_data_ref(list,tparavarsym(p).localloc,href,is_open_array(tparavarsym(p).vartype.def));
- cg.g_decrrefcount(list,tparavarsym(p).vartype.def,href);
- end;
- end
- else
- if (tparavarsym(p).varspez=vs_value) and
- (is_open_array(tparavarsym(p).vartype.def) or
- is_array_of_const(tparavarsym(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,tparavarsym(p).localloc);
- 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);
- 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);
- end;
- hp:=hp^.next;
- end;
- end;
- procedure gen_load_return_value(list:TAAsmoutput);
- var
- {$ifndef cpu64bit}
- href : treference;
- {$endif cpu64bit}
- ressym : tabstractnormalvarsym;
- 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
- (tabstractvarsym(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:=tabstractnormalvarsym(current_procinfo.procdef.parast.search('self'))
- else
- ressym:=tabstractnormalvarsym(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.register64.reglo)<first_int_imreg then
- begin
- cg.getcpuregister(list,resloc.register64.reglo);
- cg.ungetcpuregister(list,resloc.register64.reglo);
- { for the optimizer }
- cg.a_reg_alloc(list,resloc.register64.reglo);
- 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.register64.reglo);
- end;
- LOC_CREGISTER :
- cg.a_load_reg_reg(list,OS_32,OS_32,restmploc.register64.reglo,resloc.register64.reglo);
- else
- internalerror(200409203);
- end;
- if getsupreg(resloc.register64.reghi)<first_int_imreg then
- begin
- cg.getcpuregister(list,resloc.register64.reghi);
- cg.ungetcpuregister(list,resloc.register64.reghi);
- { for the optimizer }
- cg.a_reg_alloc(list,resloc.register64.reghi);
- 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.register64.reghi);
- end;
- LOC_CREGISTER :
- cg.a_load_reg_reg(list,OS_32,OS_32,restmploc.register64.reghi,resloc.register64.reghi);
- 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]);
- 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);
- case getregtype(reg) of
- R_INTREGISTER :
- cg.a_load_ref_reg(list,paraloc.size,paraloc.size,href,reg);
- R_FPUREGISTER :
- cg.a_loadfpu_ref_reg(list,paraloc.size,href,reg);
- R_MMREGISTER :
- cg.a_loadmm_ref_reg(list,paraloc.size,paraloc.size,href,reg,mms_movescalar);
- else
- internalerror(2004101012);
- end;
- end;
- else
- internalerror(2002081302);
- end;
- end;
- var
- i : integer;
- currpara : tparavarsym;
- paraloc : pcgparalocation;
- {$ifdef sparc}
- tempref,
- {$endif sparc}
- href : treference;
- begin
- if (po_assembler in current_procinfo.procdef.procoptions) then
- exit;
- { Allocate registers used by parameters }
- for i:=0 to current_procinfo.procdef.paras.count-1 do
- begin
- currpara:=tparavarsym(current_procinfo.procdef.paras[i]);
- paraloc:=currpara.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;
- end;
- { Copy parameters to local references/registers }
- for i:=0 to current_procinfo.procdef.paras.count-1 do
- begin
- currpara:=tparavarsym(current_procinfo.procdef.paras[i]);
- paraloc:=currpara.paraloc[calleeside].location;
- if not assigned(paraloc) then
- internalerror(200408203);
- case currpara.localloc.loc of
- LOC_REFERENCE :
- begin
- href:=currpara.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 :
- begin
- {$ifndef cpu64bit}
- if currpara.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^,currpara.localloc.register64.reghi)
- else
- gen_load_reg(paraloc^,currpara.localloc.register64.reglo);
- { Second 32bits }
- if not assigned(paraloc^.next) then
- internalerror(200410104);
- unget_para(paraloc^);
- if (target_info.endian=ENDIAN_BIG) then
- gen_load_reg(paraloc^,currpara.localloc.register64.reglo)
- else
- gen_load_reg(paraloc^,currpara.localloc.register64.reghi);
- end
- else
- {$endif cpu64bit}
- begin
- unget_para(paraloc^);
- gen_load_reg(paraloc^,currpara.localloc.register);
- if assigned(paraloc^.next) then
- internalerror(200410105);
- end;
- end;
- LOC_CFPUREGISTER :
- begin
- {$ifdef sparc}
- { Sparc passes floats in int registers, when loading to fpu register
- we need a temp }
- tg.GetTemp(list,TCGSize2Size[currpara.localloc.size],tt_normal,tempref);
- href:=tempref;
- while assigned(paraloc) do
- begin
- unget_para(paraloc^);
- gen_load_ref(paraloc^,href);
- inc(href.offset,TCGSize2Size[paraloc^.size]);
- paraloc:=paraloc^.next;
- end;
- cg.a_loadfpu_ref_reg(list,currpara.localloc.size,tempref,currpara.localloc.register);
- tg.UnGetTemp(list,tempref);
- {$else sparc}
- unget_para(paraloc^);
- gen_load_reg(paraloc^,currpara.localloc.register);
- if assigned(paraloc^.next) then
- internalerror(200410109);
- {$endif sparc}
- end;
- LOC_CMMREGISTER :
- begin
- unget_para(paraloc^);
- gen_load_reg(paraloc^,currpara.localloc.register);
- if assigned(paraloc^.next) then
- internalerror(200410108);
- end;
- end;
- 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);
- tsymtable(current_module.localsymtable).foreach_static({$ifndef TP}@{$endif}initialize_regvars,list);
- end;
- { units have seperate code for initilization and finalization }
- potype_unitfinalize: ;
- { program init/final is generated in separate procedure }
- potype_proginit:
- begin
- tsymtable(current_module.localsymtable).foreach_static({$ifndef TP}@{$endif}initialize_regvars,list);
- end;
- 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
- (tabstractnormalvarsym(current_procinfo.procdef.funcretsym).refs>0) then
- begin
- if tabstractnormalvarsym(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(tabstractnormalvarsym(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(tabstractnormalvarsym(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(tabstractnormalvarsym(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(tabstractnormalvarsym(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 : longint;
- begin
- { generate call frame marker for dwarf call frame info }
- dwarfcfi.start_frame(list);
- { 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,current_procinfo.calc_stackframe_size,(po_nostackframe in current_procinfo.procdef.procoptions));
- 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_stack_check_code(list:Taasmoutput);
- var
- paraloc1 : tcgpara;
- begin
- paraloc1.init;
- paramanager.getintparaloc(pocall_default,1,paraloc1);
- paramanager.allocparaloc(list,paraloc1);
- cg.a_param_const(list,OS_INT,current_procinfo.calc_stackframe_size,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));
- paraloc1.done;
- 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;
- { oldfpccall expects all registers to be destroyed }
- if current_procinfo.procdef.proccalloption<>pocall_oldfpccall 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;
- { oldfpccall expects all registers to be destroyed }
- if current_procinfo.procdef.proccalloption<>pocall_oldfpccall 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));
- {$ifdef GDB}
- if (cs_debuginfo in aktmoduleswitches) then
- sym.concatstabto(curconstSegment);
- {$endif GDB}
- 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 : tglobalvarsym);
- var
- l,varalign : longint;
- storefilepos : tfileposinfo;
- begin
- storefilepos:=aktfilepos;
- aktfilepos:=sym.fileinfo;
- l:=sym.getsize;
- 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);
- {$ifdef GDB}
- if (cs_debuginfo in aktmoduleswitches) then
- sym.concatstabto(bssSegment);
- {$endif GDB}
- 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);
- var
- sym : tsym;
- isaddr : boolean;
- cgsize : tcgsize;
- begin
- sym:=tsym(st.symindex.first);
- while assigned(sym) do
- begin
- if (sym.typ in [globalvarsym,localvarsym,paravarsym]) then
- begin
- with tabstractnormalvarsym(sym) do
- begin
- { Parameters passed to assembler procedures need to be kept
- in the original location }
- if (sym.typ=paravarsym) and
- (po_assembler in current_procinfo.procdef.procoptions) then
- begin
- tparavarsym(sym).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 is_regvar then
- begin
- localloc.size:=cgsize;
- case varregable of
- vr_intreg :
- begin
- localloc.loc:=LOC_CREGISTER;
- {$ifndef cpu64bit}
- if cgsize in [OS_64,OS_S64] then
- begin
- localloc.register64.reglo:=cg.getintregister(list,OS_32);
- localloc.register64.reghi:=cg.getintregister(list,OS_32);
- end
- else
- {$endif cpu64bit}
- localloc.register:=cg.getintregister(list,cgsize);
- end;
- vr_fpureg :
- begin
- localloc.loc:=LOC_CFPUREGISTER;
- localloc.register:=cg.getfpuregister(list,cgsize);
- end;
- vr_mmreg :
- begin
- localloc.loc:=LOC_CMMREGISTER;
- localloc.register:=cg.getmmregister(list,cgsize);
- end;
- else
- internalerror(2004101010);
- end;
- { Allocate register already, to prevent first allocation to be
- inside a loop }
- cg.a_reg_sync(list,localloc.register);
- 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 (tparavarsym(sym).paraloc[calleeside].is_simple_reference) then
- begin
- reference_reset_base(localloc.reference,tparavarsym(sym).paraloc[calleeside].location^.reference.index,
- tparavarsym(sym).paraloc[calleeside].location^.reference.offset);
- end
- else
- begin
- if isaddr then
- tg.GetLocal(list,sizeof(aint),voidpointertype.def,localloc.reference)
- else
- tg.GetLocal(list,getsize,vartype.def,localloc.reference);
- end;
- end;
- localsymtable,
- stt_exceptsymtable :
- begin
- tg.GetLocal(list,getsize,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 in [globalvarsym,localvarsym,paravarsym]) then
- begin
- with tabstractnormalvarsym(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=paravarsym then
- begin
- with tparavarsym(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:=paraloc[calleeside].location;
- callerparaloc:=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 tabstractnormalvarsym(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);
- globalvarsym,
- localvarsym,
- paravarsym :
- def:=tstoreddef(tabstractvarsym(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.241 2004-11-15 23:35:31 peter
- * tparaitem removed, use tparavarsym instead
- * parameter order is now calculated from paranr value in tparavarsym
- Revision 1.240 2004/11/11 19:31:33 peter
- * fixed compile of powerpc,sparc,arm
- Revision 1.239 2004/11/09 17:26:47 peter
- * fixed wrong typecasts
- Revision 1.238 2004/11/08 22:09:59 peter
- * tvarsym splitted
- Revision 1.237 2004/11/08 20:23:29 florian
- * fixed open arrays when using register variables
- Revision 1.236 2004/11/04 17:12:24 peter
- forgot if cs_debuginfo
- Revision 1.235 2004/11/04 17:09:54 peter
- fixed debuginfo for variables in staticsymtable
- Revision 1.234 2004/10/31 21:45:03 peter
- * generic tlocation
- * move tlocation to cgutils
- Revision 1.233 2004/10/28 18:29:44 olle
- * reverted, for macos only, last change.
- Revision 1.232 2004/10/26 15:03:31 peter
- * localloc of staticsymtable needs a AT_NONE since it is a reference
- Revision 1.231 2004/10/24 20:01:08 peter
- * remove saveregister calling convention
- Revision 1.230 2004/10/24 11:44:28 peter
- * small regvar fixes
- * loadref parameter removed from concatcopy,incrrefcount,etc
- Revision 1.229 2004/10/15 09:14:17 mazen
- - remove $IFDEF DELPHI and related code
- - remove $IFDEF FPCPROCVAR and related code
- Revision 1.228 2004/10/14 17:54:06 peter
- * add reg_sync when regvars are allocated to fix first use in
- loop
- Revision 1.227 2004/10/13 21:12:51 peter
- * -Or fixes for open array
- Revision 1.226 2004/10/11 15:48:15 peter
- * small regvar for para fixes
- * function tvarsym.is_regvar added
- * tvarsym.getvaluesize removed, use getsize instead
- Revision 1.225 2004/10/10 21:08:55 peter
- * parameter regvar fixes
- Revision 1.224 2004/10/10 20:51:46 peter
- * fixed sparc compile
- * fixed float regvar loading
- 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
- }
|