123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999400040014002400340044005400640074008400940104011401240134014401540164017401840194020402140224023402440254026402740284029403040314032403340344035403640374038403940404041404240434044404540464047404840494050405140524053405440554056405740584059406040614062406340644065406640674068406940704071407240734074407540764077407840794080408140824083408440854086408740884089409040914092409340944095409640974098409941004101410241034104410541064107410841094110411141124113411441154116411741184119412041214122412341244125412641274128412941304131413241334134413541364137413841394140414141424143414441454146414741484149 |
- {
- $Id$
- Copyright (c) 1998-2000 by Florian Klaempfl
- Helper routines for the i386 code generator
- 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 cgai386;
- {$i defines.inc}
- interface
- uses
- cobjects,tree,
- cpubase,cpuasm,
- symconst,symtable,aasm;
- {$define TESTGETTEMP to store const that
- are written into temps for later release PM }
- function def_opsize(p1:pdef):topsize;
- function def2def_opsize(p1,p2:pdef):topsize;
- function def_getreg(p1:pdef):tregister;
- function makereg8(r:tregister):tregister;
- function makereg16(r:tregister):tregister;
- function makereg32(r:tregister):tregister;
- procedure locflags2reg(var l:tlocation;opsize:topsize);
- procedure locjump2reg(var l:tlocation;opsize:topsize; otl, ofl: pasmlabel);
- procedure emitlab(var l : pasmlabel);
- procedure emitjmp(c : tasmcond;var l : pasmlabel);
- procedure emit_flag2reg(flag:tresflags;hregister:tregister);
- procedure emit_none(i : tasmop;s : topsize);
- procedure emit_const(i : tasmop;s : topsize;c : longint);
- procedure emit_reg(i : tasmop;s : topsize;reg : tregister);
- procedure emit_ref(i : tasmop;s : topsize;ref : preference);
- procedure emit_const_reg(i : tasmop;s : topsize;c : longint;reg : tregister);
- procedure emit_const_ref(i : tasmop;s : topsize;c : longint;ref : preference);
- procedure emit_ref_reg(i : tasmop;s : topsize;ref : preference;reg : tregister);
- procedure emit_reg_ref(i : tasmop;s : topsize;reg : tregister;ref : preference);
- procedure emit_reg_reg(i : tasmop;s : topsize;reg1,reg2 : tregister);
- procedure emit_const_reg_reg(i : tasmop;s : topsize;c : longint;reg1,reg2 : tregister);
- procedure emit_reg_reg_reg(i : tasmop;s : topsize;reg1,reg2,reg3 : tregister);
- procedure emit_sym(i : tasmop;s : topsize;op : pasmsymbol);
- procedure emit_sym_ofs(i : tasmop;s : topsize;op : pasmsymbol;ofs : longint);
- procedure emit_sym_ofs_reg(i : tasmop;s : topsize;op : pasmsymbol;ofs:longint;reg : tregister);
- procedure emit_sym_ofs_ref(i : tasmop;s : topsize;op : pasmsymbol;ofs:longint;ref : preference);
- procedure emitcall(const routine:string);
- procedure emit_mov_loc_ref(const t:tlocation;const ref:treference;siz:topsize;freetemp:boolean);
- procedure emit_mov_loc_reg(const t:tlocation;reg:tregister);
- procedure emit_mov_ref_reg64(r : treference;rl,rh : tregister);
- procedure emit_lea_loc_ref(const t:tlocation;const ref:treference;freetemp:boolean);
- procedure emit_lea_loc_reg(const t:tlocation;reg:tregister;freetemp:boolean);
- procedure emit_push_loc(const t:tlocation);
- procedure emit_push_mem_size(const t: treference; size: longint);
- { pushes qword location to the stack }
- procedure emit_pushq_loc(const t : tlocation);
- procedure release_qword_loc(const t : tlocation);
- { remove non regvar registers in loc from regs (in the format }
- { pushusedregisters uses) }
- procedure remove_non_regvars_from_loc(const t: tlocation; var regs: byte);
- { releases the registers of a location }
- procedure release_loc(const t : tlocation);
- procedure emit_pushw_loc(const t:tlocation);
- procedure emit_push_lea_loc(const t:tlocation;freetemp:boolean);
- procedure emit_to_mem(var p:ptree);
- procedure emit_to_reg16(var hr:tregister);
- procedure emit_to_reg32(var hr:tregister);
- procedure emit_mov_reg_loc(reg: TRegister; const t:tlocation);
- procedure emit_movq_reg_loc(reghigh,reglow: TRegister;t:tlocation);
- procedure copyshortstring(const dref,sref : treference;len : byte;
- loadref, del_sref: boolean);
- procedure loadansistring(p : ptree);
- procedure finalize(t : pdef;const ref : treference;is_already_ref : boolean);
- procedure incrstringref(t : pdef;const ref : treference);
- procedure decrstringref(t : pdef;const ref : treference);
- function maybe_push(needed : byte;p : ptree;isint64 : boolean) : boolean;
- procedure push_int(l : longint);
- procedure emit_push_mem(const ref : treference);
- procedure emitpushreferenceaddr(const ref : treference);
- procedure pushsetelement(p : ptree);
- procedure restore(p : ptree;isint64 : boolean);
- procedure push_value_para(p:ptree;inlined,is_cdecl:boolean;
- para_offset:longint;alignment : longint);
- {$ifdef TEMPS_NOT_PUSH}
- { does the same as restore, but uses temp. space instead of pushing }
- function maybe_push(needed : byte;p : ptree;isint64 : boolean) : boolean;
- procedure restorefromtemp(p : ptree;isint64 : boolean);
- {$endif TEMPS_NOT_PUSH}
- procedure floatload(t : tfloattype;const ref : treference);
- procedure floatstore(t : tfloattype;const ref : treference);
- procedure floatloadops(t : tfloattype;var op : tasmop;var s : topsize);
- procedure floatstoreops(t : tfloattype;var op : tasmop;var s : topsize);
- procedure maybe_loadesi;
- procedure maketojumpbool(p : ptree);
- procedure emitloadord2reg(const location:Tlocation;orddef:Porddef;destreg:Tregister;delloc:boolean);
- procedure emitoverflowcheck(p:ptree);
- procedure emitrangecheck(p:ptree;todef:pdef);
- procedure concatcopy(source,dest : treference;size : longint;delsource : boolean;loadref:boolean);
- procedure firstcomplex(p : ptree);
- procedure genentrycode(alist : paasmoutput;const proc_names:Tstringcontainer;make_global:boolean;
- stackframe:longint;
- var parasize:longint;var nostackframe:boolean;
- inlined : boolean);
- procedure genexitcode(alist : paasmoutput;parasize:longint;
- nostackframe,inlined:boolean);
- { if a unit doesn't have a explicit init/final code, }
- { we've to generate one, if the units has ansistrings }
- { in the interface or implementation }
- procedure genimplicitunitfinal(alist : paasmoutput);
- procedure genimplicitunitinit(alist : paasmoutput);
- {$ifdef test_dest_loc}
- const
- { used to avoid temporary assignments }
- dest_loc_known : boolean = false;
- in_dest_loc : boolean = false;
- dest_loc_tree : ptree = nil;
- var
- dest_loc : tlocation;
- procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
- {$endif test_dest_loc}
- implementation
- uses
- {$ifdef delphi}
- sysutils,
- {$else}
- strings,
- {$endif}
- cutils,globtype,systems,globals,verbose,fmodule,types,pbase,
- tgeni386,temp_gen,hcodegen,ppu,regvars
- {$ifdef GDB}
- ,gdb
- {$endif}
- {$ifndef NOTARGETWIN32}
- ,t_win32
- {$endif}
- ;
- {*****************************************************************************
- Helpers
- *****************************************************************************}
- function def_opsize(p1:pdef):topsize;
- begin
- case p1^.size of
- 1 : def_opsize:=S_B;
- 2 : def_opsize:=S_W;
- 4 : def_opsize:=S_L;
- else
- internalerror(130820001);
- end;
- end;
- function def2def_opsize(p1,p2:pdef):topsize;
- var
- o1 : topsize;
- begin
- case p1^.size of
- 1 : o1:=S_B;
- 2 : o1:=S_W;
- 4 : o1:=S_L;
- { I don't know if we need it (FK) }
- 8 : o1:=S_L;
- else
- internalerror(130820002);
- end;
- if assigned(p2) then
- begin
- case p2^.size of
- 1 : o1:=S_B;
- 2 : begin
- if o1=S_B then
- o1:=S_BW
- else
- o1:=S_W;
- end;
- 4,8:
- begin
- case o1 of
- S_B : o1:=S_BL;
- S_W : o1:=S_WL;
- end;
- end;
- end;
- end;
- def2def_opsize:=o1;
- end;
- function def_getreg(p1:pdef):tregister;
- begin
- case p1^.size of
- 1 : def_getreg:=reg32toreg8(getregister32);
- 2 : def_getreg:=reg32toreg16(getregister32);
- 4 : def_getreg:=getregister32;
- else
- internalerror(130820003);
- end;
- end;
- function makereg8(r:tregister):tregister;
- begin
- case r of
- R_EAX,R_EBX,R_ECX,R_EDX,R_EDI,R_ESI,R_ESP :
- makereg8:=reg32toreg8(r);
- R_AX,R_BX,R_CX,R_DX,R_DI,R_SI,R_SP :
- makereg8:=reg16toreg8(r);
- R_AL,R_BL,R_CL,R_DL :
- makereg8:=r;
- end;
- end;
- function makereg16(r:tregister):tregister;
- begin
- case r of
- R_EAX,R_EBX,R_ECX,R_EDX,R_EDI,R_ESI,R_ESP :
- makereg16:=reg32toreg16(r);
- R_AX,R_BX,R_CX,R_DX,R_DI,R_SI,R_SP :
- makereg16:=r;
- R_AL,R_BL,R_CL,R_DL :
- makereg16:=reg8toreg16(r);
- end;
- end;
- function makereg32(r:tregister):tregister;
- begin
- case r of
- R_EAX,R_EBX,R_ECX,R_EDX,R_EDI,R_ESI,R_ESP :
- makereg32:=r;
- R_AX,R_BX,R_CX,R_DX,R_DI,R_SI,R_SP :
- makereg32:=reg16toreg32(r);
- R_AL,R_BL,R_CL,R_DL :
- makereg32:=reg8toreg32(r);
- end;
- end;
- procedure locflags2reg(var l:tlocation;opsize:topsize);
- var
- hregister : tregister;
- begin
- if (l.loc=LOC_FLAGS) then
- begin
- hregister:=getregister32;
- case opsize of
- S_W : hregister:=reg32toreg16(hregister);
- S_B : hregister:=reg32toreg8(hregister);
- end;
- emit_flag2reg(l.resflags,hregister);
- l.loc:=LOC_REGISTER;
- l.register:=hregister;
- end
- else internalerror(270720001);
- end;
- procedure locjump2reg(var l:tlocation;opsize:topsize; otl, ofl: pasmlabel);
- var
- hregister : tregister;
- hl : pasmlabel;
- begin
- if l.loc = LOC_JUMP then
- begin
- hregister:=getregister32;
- case opsize of
- S_W : hregister:=reg32toreg16(hregister);
- S_B : hregister:=reg32toreg8(hregister);
- end;
- l.loc:=LOC_REGISTER;
- l.register:=hregister;
- emitlab(truelabel);
- truelabel:=otl;
- emit_const_reg(A_MOV,opsize,1,hregister);
- getlabel(hl);
- emitjmp(C_None,hl);
- emitlab(falselabel);
- falselabel:=ofl;
- emit_reg_reg(A_XOR,S_L,makereg32(hregister),
- makereg32(hregister));
- emitlab(hl);
- end
- else internalerror(270720002);
- end;
- {*****************************************************************************
- Emit Assembler
- *****************************************************************************}
- procedure emitlab(var l : pasmlabel);
- begin
- if not l^.is_set then
- exprasmlist^.concat(new(pai_label,init(l)))
- else
- internalerror(7453984);
- end;
- {$ifdef nojmpfix}
- procedure emitjmp(c : tasmcond;var l : pasmlabel);
- var
- ai : Paicpu;
- begin
- if c=C_None then
- exprasmlist^.concat(new(paicpu,op_sym(A_JMP,S_NO,l)))
- else
- begin
- ai:=new(paicpu,op_sym(A_Jcc,S_NO,l));
- ai^.SetCondition(c);
- ai^.is_jmp:=true;
- exprasmlist^.concat(ai);
- end;
- end;
- {$else nojmpfix}
- procedure emitjmp(c : tasmcond;var l : pasmlabel);
- var
- ai : Paicpu;
- begin
- if c=C_None then
- ai := new(paicpu,op_sym(A_JMP,S_NO,l))
- else
- begin
- ai:=new(paicpu,op_sym(A_Jcc,S_NO,l));
- ai^.SetCondition(c);
- end;
- ai^.is_jmp:=true;
- exprasmlist^.concat(ai);
- end;
- {$endif nojmpfix}
- procedure emit_flag2reg(flag:tresflags;hregister:tregister);
- var
- ai : paicpu;
- hreg : tregister;
- begin
- hreg:=makereg8(hregister);
- ai:=new(paicpu,op_reg(A_Setcc,S_B,hreg));
- ai^.SetCondition(flag_2_cond[flag]);
- exprasmlist^.concat(ai);
- if hreg<>hregister then
- begin
- if hregister in regset16bit then
- emit_to_reg16(hreg)
- else
- emit_to_reg32(hreg);
- end;
- end;
- procedure emit_none(i : tasmop;s : topsize);
- begin
- exprasmlist^.concat(new(paicpu,op_none(i,s)));
- end;
- procedure emit_reg(i : tasmop;s : topsize;reg : tregister);
- begin
- exprasmlist^.concat(new(paicpu,op_reg(i,s,reg)));
- end;
- procedure emit_ref(i : tasmop;s : topsize;ref : preference);
- begin
- exprasmlist^.concat(new(paicpu,op_ref(i,s,ref)));
- end;
- procedure emit_const(i : tasmop;s : topsize;c : longint);
- begin
- exprasmlist^.concat(new(paicpu,op_const(i,s,c)));
- end;
- procedure emit_const_reg(i : tasmop;s : topsize;c : longint;reg : tregister);
- begin
- exprasmlist^.concat(new(paicpu,op_const_reg(i,s,c,reg)));
- end;
- procedure emit_const_ref(i : tasmop;s : topsize;c : longint;ref : preference);
- begin
- exprasmlist^.concat(new(paicpu,op_const_ref(i,s,c,ref)));
- end;
- procedure emit_ref_reg(i : tasmop;s : topsize;ref : preference;reg : tregister);
- begin
- exprasmlist^.concat(new(paicpu,op_ref_reg(i,s,ref,reg)));
- end;
- procedure emit_reg_ref(i : tasmop;s : topsize;reg : tregister;ref : preference);
- begin
- exprasmlist^.concat(new(paicpu,op_reg_ref(i,s,reg,ref)));
- end;
- procedure emit_reg_reg(i : tasmop;s : topsize;reg1,reg2 : tregister);
- begin
- if (reg1<>reg2) or (i<>A_MOV) then
- exprasmlist^.concat(new(paicpu,op_reg_reg(i,s,reg1,reg2)));
- end;
- procedure emit_const_reg_reg(i : tasmop;s : topsize;c : longint;reg1,reg2 : tregister);
- begin
- exprasmlist^.concat(new(paicpu,op_const_reg_reg(i,s,c,reg1,reg2)));
- end;
- procedure emit_reg_reg_reg(i : tasmop;s : topsize;reg1,reg2,reg3 : tregister);
- begin
- exprasmlist^.concat(new(paicpu,op_reg_reg_reg(i,s,reg1,reg2,reg3)));
- end;
- procedure emit_sym(i : tasmop;s : topsize;op : pasmsymbol);
- begin
- exprasmlist^.concat(new(paicpu,op_sym(i,s,op)));
- end;
- procedure emit_sym_ofs(i : tasmop;s : topsize;op : pasmsymbol;ofs : longint);
- begin
- exprasmlist^.concat(new(paicpu,op_sym_ofs(i,s,op,ofs)));
- end;
- procedure emit_sym_ofs_reg(i : tasmop;s : topsize;op : pasmsymbol;ofs:longint;reg : tregister);
- begin
- exprasmlist^.concat(new(paicpu,op_sym_ofs_reg(i,s,op,ofs,reg)));
- end;
- procedure emit_sym_ofs_ref(i : tasmop;s : topsize;op : pasmsymbol;ofs:longint;ref : preference);
- begin
- exprasmlist^.concat(new(paicpu,op_sym_ofs_ref(i,s,op,ofs,ref)));
- end;
- procedure emitcall(const routine:string);
- begin
- exprasmlist^.concat(new(paicpu,op_sym(A_CALL,S_NO,newasmsymbol(routine))));
- end;
- { only usefull in startup code }
- procedure emitinsertcall(const routine:string);
- begin
- exprasmlist^.insert(new(paicpu,op_sym(A_CALL,S_NO,newasmsymbol(routine))));
- end;
- procedure emit_mov_loc_ref(const t:tlocation;const ref:treference;siz:topsize;freetemp:boolean);
- var
- hreg : tregister;
- pushedeax : boolean;
- begin
- pushedeax:=false;
- case t.loc of
- LOC_REGISTER,
- LOC_CREGISTER : begin
- exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,siz,
- t.register,newreference(ref))));
- ungetregister32(t.register); { the register is not needed anymore }
- end;
- LOC_MEM,
- LOC_REFERENCE : begin
- if t.reference.is_immediate then
- emit_const_ref(A_MOV,siz,
- t.reference.offset,newreference(ref))
- else
- begin
- case siz of
- S_B : begin
- { we can't do a getregister in the code generator }
- { without problems!!! }
- if usablereg32>0 then
- hreg:=reg32toreg8(getregister32)
- else
- begin
- emit_reg(A_PUSH,S_L,R_EAX);
- pushedeax:=true;
- hreg:=R_AL;
- end;
- end;
- S_W : hreg:=R_DI;
- S_L : hreg:=R_EDI;
- end;
- {$ifndef noAllocEdi}
- if hreg in [R_DI,R_EDI] then
- getexplicitregister32(R_EDI);
- {$endif noAllocEdi}
- emit_ref_reg(A_MOV,siz,
- newreference(t.reference),hreg);
- del_reference(t.reference);
- exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,siz,
- hreg,newreference(ref))));
- if siz=S_B then
- begin
- if pushedeax then
- emit_reg(A_POP,S_L,R_EAX)
- else
- ungetregister(hreg);
- end;
- {$ifndef noAllocEdi}
- if hreg in [R_DI,R_EDI] then
- ungetregister32(R_EDI);
- {$endif noAllocEdi}
- { we can release the registers }
- { but only AFTER the MOV! Important for the optimizer!
- (JM)}
- del_reference(ref);
- end;
- if freetemp then
- ungetiftemp(t.reference);
- end;
- else
- internalerror(330);
- end;
- end;
- procedure emit_mov_loc_reg(const t:tlocation;reg:tregister);
- begin
- case t.loc of
- LOC_REGISTER,
- LOC_CREGISTER : begin
- emit_reg_reg(A_MOV,S_L,t.register,reg);
- ungetregister32(t.register); { the register is not needed anymore }
- end;
- LOC_MEM,
- LOC_REFERENCE : begin
- if t.reference.is_immediate then
- emit_const_reg(A_MOV,S_L,
- t.reference.offset,reg)
- else
- begin
- emit_ref_reg(A_MOV,S_L,
- newreference(t.reference),reg);
- end;
- end;
- else
- internalerror(330);
- end;
- end;
- procedure emit_mov_reg_loc(reg: TRegister; const t:tlocation);
- begin
- case t.loc of
- LOC_REGISTER,
- LOC_CREGISTER : begin
- emit_reg_reg(A_MOV,RegSize(Reg),
- reg,t.register);
- end;
- LOC_MEM,
- LOC_REFERENCE : begin
- if t.reference.is_immediate then
- internalerror(334)
- else
- begin
- exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,RegSize(Reg),
- Reg,newreference(t.reference))));
- end;
- end;
- else
- internalerror(330);
- end;
- end;
- procedure emit_lea_loc_reg(const t:tlocation;reg:tregister;freetemp:boolean);
- begin
- case t.loc of
- LOC_MEM,
- LOC_REFERENCE : begin
- if t.reference.is_immediate then
- internalerror(331)
- else
- begin
- emit_ref_reg(A_LEA,S_L,
- newreference(t.reference),reg);
- end;
- if freetemp then
- ungetiftemp(t.reference);
- end;
- else
- internalerror(332);
- end;
- end;
- procedure emit_movq_reg_loc(reghigh,reglow: TRegister;t:tlocation);
- begin
- case t.loc of
- LOC_REGISTER,
- LOC_CREGISTER : begin
- emit_reg_reg(A_MOV,S_L,
- reglow,t.registerlow);
- emit_reg_reg(A_MOV,S_L,
- reghigh,t.registerhigh);
- end;
- LOC_MEM,
- LOC_REFERENCE : begin
- if t.reference.is_immediate then
- internalerror(334)
- else
- begin
- exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,
- Reglow,newreference(t.reference))));
- inc(t.reference.offset,4);
- exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,
- Reghigh,newreference(t.reference))));
- end;
- end;
- else
- internalerror(330);
- end;
- end;
- procedure emit_pushq_loc(const t : tlocation);
- var
- hr : preference;
- begin
- case t.loc of
- LOC_REGISTER,
- LOC_CREGISTER:
- begin
- exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_L,
- t.registerhigh)));
- exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_L,
- t.registerlow)));
- end;
- LOC_MEM,
- LOC_REFERENCE:
- begin
- hr:=newreference(t.reference);
- inc(hr^.offset,4);
- exprasmlist^.concat(new(paicpu,op_ref(A_PUSH,S_L,
- hr)));
- exprasmlist^.concat(new(paicpu,op_ref(A_PUSH,S_L,
- newreference(t.reference))));
- ungetiftemp(t.reference);
- end;
- else internalerror(331);
- end;
- end;
- procedure remove_non_regvars_from_loc(const t: tlocation; var regs: byte);
- begin
- case t.loc of
- LOC_REGISTER:
- { can't be a regvar, since it would be LOC_CREGISTER then }
- regs := regs and not($80 shr byte(t.register));
- LOC_MEM,LOC_REFERENCE:
- begin
- if not(cs_regalloc in aktglobalswitches) or
- (t.reference.base in usableregs) then
- regs := regs and
- not($80 shr byte(t.reference.base));
- if not(cs_regalloc in aktglobalswitches) or
- (t.reference.index in usableregs) then
- regs := regs and
- not($80 shr byte(t.reference.index));
- end;
- end;
- end;
- procedure release_loc(const t : tlocation);
- begin
- case t.loc of
- LOC_REGISTER,
- LOC_CREGISTER:
- begin
- ungetregister32(t.register);
- end;
- LOC_MEM,
- LOC_REFERENCE:
- del_reference(t.reference);
- else internalerror(332);
- end;
- end;
- procedure release_qword_loc(const t : tlocation);
- begin
- case t.loc of
- LOC_REGISTER,
- LOC_CREGISTER:
- begin
- ungetregister32(t.registerhigh);
- ungetregister32(t.registerlow);
- end;
- LOC_MEM,
- LOC_REFERENCE:
- del_reference(t.reference);
- else internalerror(331);
- end;
- end;
- procedure emit_push_loc(const t:tlocation);
- begin
- case t.loc of
- LOC_REGISTER,
- LOC_CREGISTER : begin
- exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_L,makereg32(t.register))));
- ungetregister(t.register); { the register is not needed anymore }
- end;
- LOC_MEM,
- LOC_REFERENCE : begin
- if t.reference.is_immediate then
- exprasmlist^.concat(new(paicpu,op_const(A_PUSH,S_L,t.reference.offset)))
- else
- exprasmlist^.concat(new(paicpu,op_ref(A_PUSH,S_L,newreference(t.reference))));
- del_reference(t.reference);
- ungetiftemp(t.reference);
- end;
- else
- internalerror(330);
- end;
- end;
- procedure emit_pushw_loc(const t:tlocation);
- var
- opsize : topsize;
- begin
- case t.loc of
- LOC_REGISTER,
- LOC_CREGISTER : begin
- if target_os.stackalignment=4 then
- exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_L,makereg32(t.register))))
- else
- exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_W,makereg16(t.register))));
- ungetregister(t.register); { the register is not needed anymore }
- end;
- LOC_MEM,
- LOC_REFERENCE : begin
- if target_os.stackalignment=4 then
- opsize:=S_L
- else
- opsize:=S_W;
- if t.reference.is_immediate then
- exprasmlist^.concat(new(paicpu,op_const(A_PUSH,opsize,t.reference.offset)))
- else
- exprasmlist^.concat(new(paicpu,op_ref(A_PUSH,opsize,newreference(t.reference))));
- del_reference(t.reference);
- ungetiftemp(t.reference);
- end;
- else
- internalerror(330);
- end;
- end;
- procedure emit_lea_loc_ref(const t:tlocation;const ref:treference;freetemp:boolean);
- begin
- case t.loc of
- LOC_MEM,
- LOC_REFERENCE : begin
- if t.reference.is_immediate then
- internalerror(331)
- else
- begin
- {$ifndef noAllocEdi}
- getexplicitregister32(R_EDI);
- {$endif noAllocEdi}
- emit_ref_reg(A_LEA,S_L,
- newreference(t.reference),R_EDI);
- exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,
- R_EDI,newreference(ref))));
- {$ifndef noAllocEdi}
- ungetregister32(R_EDI);
- {$endif noAllocEdi}
- end;
- { release the registers }
- del_reference(t.reference);
- if freetemp then
- ungetiftemp(t.reference);
- end;
- else
- internalerror(332);
- end;
- end;
- procedure emit_push_lea_loc(const t:tlocation;freetemp:boolean);
- begin
- case t.loc of
- LOC_MEM,
- LOC_REFERENCE : begin
- if t.reference.is_immediate then
- internalerror(331)
- else
- begin
- {$ifndef noAllocEdi}
- getexplicitregister32(R_EDI);
- {$endif noAllocEdi}
- emit_ref_reg(A_LEA,S_L,
- newreference(t.reference),R_EDI);
- exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_L,R_EDI)));
- {$ifndef noAllocEdi}
- ungetregister32(R_EDI);
- {$endif noAllocEdi}
- end;
- if freetemp then
- ungetiftemp(t.reference);
- end;
- else
- internalerror(332);
- end;
- end;
- procedure emit_push_mem_size(const t: treference; size: longint);
- var
- s: topsize;
- begin
- if t.is_immediate then
- begin
- if (size=4) or
- (target_os.stackalignment=4) then
- exprasmlist^.concat(new(paicpu,op_const(A_PUSH,S_L,t.offset)))
- else
- exprasmlist^.concat(new(paicpu,op_const(A_PUSH,S_W,t.offset)));
- end
- else
- if size < 4 then
- begin
- getexplicitregister32(R_EDI);
- case size of
- 1: s := S_BL;
- 2: s := S_WL;
- else internalerror(200008071);
- end;
- exprasmlist^.concat(new(paicpu,op_ref_reg(A_MOVZX,s,
- newreference(t),R_EDI)));
- if target_os.stackalignment=4 then
- exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_L,R_EDI)))
- else
- exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_W,R_DI)));
- ungetregister32(R_EDI);
- end
- else
- if size = 4 then
- emit_push_mem(t)
- else
- internalerror(200008072);
- end;
- procedure emit_to_mem(var p:ptree);
- var
- r : treference;
- begin
- case p^.location.loc of
- LOC_FPU : begin
- reset_reference(p^.location.reference);
- gettempofsizereference(10,p^.location.reference);
- floatstore(pfloatdef(p^.resulttype)^.typ,p^.location.reference);
- { This can't be never a l-value! (FK)
- p^.location.loc:=LOC_REFERENCE; }
- end;
- LOC_REGISTER:
- begin
- if is_64bitint(p^.resulttype) then
- begin
- gettempofsizereference(8,r);
- emit_reg_ref(A_MOV,S_L,p^.location.registerlow,
- newreference(r));
- inc(r.offset,4);
- emit_reg_ref(A_MOV,S_L,p^.location.registerhigh,
- newreference(r));
- dec(r.offset,4);
- p^.location.reference:=r;
- end
- else
- internalerror(1405001);
- end;
- LOC_MEM,
- LOC_REFERENCE : ;
- LOC_CFPUREGISTER : begin
- emit_reg(A_FLD,S_NO,correct_fpuregister(p^.location.register,fpuvaroffset));
- inc(fpuvaroffset);
- reset_reference(p^.location.reference);
- gettempofsizereference(10,p^.location.reference);
- floatstore(pfloatdef(p^.resulttype)^.typ,p^.location.reference);
- { This can't be never a l-value! (FK)
- p^.location.loc:=LOC_REFERENCE; }
- end;
- else
- internalerror(333);
- end;
- p^.location.loc:=LOC_MEM;
- end;
- procedure emit_to_reg16(var hr:tregister);
- begin
- { ranges are a little bit bug sensitive ! }
- case hr of
- R_EAX,R_EBX,R_ECX,R_EDX,R_EDI,R_ESI,R_ESP,R_EBP:
- begin
- hr:=reg32toreg16(hr);
- end;
- R_AL,R_BL,R_CL,R_DL:
- begin
- hr:=reg8toreg16(hr);
- emit_const_reg(A_AND,S_W,$ff,hr);
- end;
- R_AH,R_BH,R_CH,R_DH:
- begin
- hr:=reg8toreg16(hr);
- emit_const_reg(A_AND,S_W,$ff00,hr);
- end;
- end;
- end;
- procedure emit_to_reg32(var hr:tregister);
- begin
- { ranges are a little bit bug sensitive ! }
- case hr of
- R_AX,R_BX,R_CX,R_DX,R_DI,R_SI,R_SP,R_BP:
- begin
- hr:=reg16toreg32(hr);
- emit_const_reg(A_AND,S_L,$ffff,hr);
- end;
- R_AL,R_BL,R_CL,R_DL:
- begin
- hr:=reg8toreg32(hr);
- emit_const_reg(A_AND,S_L,$ff,hr);
- end;
- R_AH,R_BH,R_CH,R_DH:
- begin
- hr:=reg8toreg32(hr);
- emit_const_reg(A_AND,S_L,$ff00,hr);
- end;
- end;
- end;
- procedure emit_mov_ref_reg64(r : treference;rl,rh : tregister);
- var
- hr : preference;
- begin
- { if we load a 64 bit reference, we must be careful because }
- { we could overwrite the registers of the reference by }
- { accident }
- if r.base=rl then
- begin
- emit_reg_reg(A_MOV,S_L,r.base,
- R_EDI);
- r.base:=R_EDI;
- end
- else if r.index=rl then
- begin
- emit_reg_reg(A_MOV,S_L,r.index,
- R_EDI);
- r.index:=R_EDI;
- end;
- emit_ref_reg(A_MOV,S_L,
- newreference(r),rl);
- hr:=newreference(r);
- inc(hr^.offset,4);
- emit_ref_reg(A_MOV,S_L,
- hr,rh);
- end;
- {*****************************************************************************
- Emit String Functions
- *****************************************************************************}
- procedure copyshortstring(const dref,sref : treference;len : byte;
- loadref, del_sref: boolean);
- begin
- emitpushreferenceaddr(dref);
- { if it's deleted right before it's used, the optimizer can move }
- { the reg deallocations to the right places (JM) }
- if del_sref then
- del_reference(sref);
- if loadref then
- emit_push_mem(sref)
- else
- emitpushreferenceaddr(sref);
- push_int(len);
- emitcall('FPC_SHORTSTR_COPY');
- maybe_loadesi;
- end;
- procedure copylongstring(const dref,sref : treference;len : longint;loadref:boolean);
- begin
- emitpushreferenceaddr(dref);
- if loadref then
- emit_push_mem(sref)
- else
- emitpushreferenceaddr(sref);
- push_int(len);
- emitcall('FPC_LONGSTR_COPY');
- maybe_loadesi;
- end;
- procedure incrstringref(t : pdef;const ref : treference);
- var
- pushedregs : tpushed;
- begin
- pushusedregisters(pushedregs,$ff);
- emitpushreferenceaddr(ref);
- if is_ansistring(t) then
- begin
- emitcall('FPC_ANSISTR_INCR_REF');
- end
- else if is_widestring(t) then
- begin
- emitcall('FPC_WIDESTR_INCR_REF');
- end
- else internalerror(1859);
- popusedregisters(pushedregs);
- end;
- procedure decrstringref(t : pdef;const ref : treference);
- var
- pushedregs : tpushed;
- begin
- pushusedregisters(pushedregs,$ff);
- emitpushreferenceaddr(ref);
- if is_ansistring(t) then
- begin
- emitcall('FPC_ANSISTR_DECR_REF');
- end
- else if is_widestring(t) then
- begin
- emitcall('FPC_WIDESTR_DECR_REF');
- end
- else internalerror(1859);
- popusedregisters(pushedregs);
- end;
- procedure loadansistring(p : ptree);
- {
- copies an ansistring from p^.right to p^.left, we
- assume, that both sides are ansistring, firstassignement have
- to take care of that, an ansistring can't be a register variable
- }
- var
- pushed : tpushed;
- regs_to_push: byte;
- ungettemp : boolean;
- begin
- { before pushing any parameter, we have to save all used }
- { registers, but before that we have to release the }
- { registers of that node to save uneccessary pushed }
- { so be careful, if you think you can optimize that code (FK) }
- { nevertheless, this has to be changed, because otherwise the }
- { register is released before it's contents are pushed -> }
- { problems with the optimizer (JM) }
- del_reference(p^.left^.location.reference);
- ungettemp:=false;
- { Find out which registers have to be pushed (JM) }
- regs_to_push := $ff;
- remove_non_regvars_from_loc(p^.right^.location,regs_to_push);
- { And push them (JM) }
- pushusedregisters(pushed,regs_to_push);
- case p^.right^.location.loc of
- LOC_REGISTER,LOC_CREGISTER:
- begin
- exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_L,p^.right^.location.register)));
- ungetregister32(p^.right^.location.register);
- end;
- LOC_REFERENCE,LOC_MEM:
- begin
- { First release the registers because emit_push_mem may }
- { load the reference in edi before pushing and then the }
- { dealloc is too late (and optimizations are missed (JM) }
- del_reference(p^.right^.location.reference);
- { This one doesn't need extra registers (JM) }
- emit_push_mem(p^.right^.location.reference);
- ungettemp:=true;
- end;
- end;
- emitpushreferenceaddr(p^.left^.location.reference);
- del_reference(p^.left^.location.reference);
- emitcall('FPC_ANSISTR_ASSIGN');
- maybe_loadesi;
- popusedregisters(pushed);
- if ungettemp then
- ungetiftemp(p^.right^.location.reference);
- end;
- {*****************************************************************************
- Emit Push Functions
- *****************************************************************************}
- function maybe_push(needed : byte;p : ptree;isint64 : boolean) : boolean;
- var
- pushed : boolean;
- {hregister : tregister; }
- {$ifdef TEMPS_NOT_PUSH}
- href : treference;
- {$endif TEMPS_NOT_PUSH}
- begin
- if needed>usablereg32 then
- begin
- if (p^.location.loc=LOC_REGISTER) then
- begin
- if isint64 then
- begin
- {$ifdef TEMPS_NOT_PUSH}
- gettempofsizereference(href,8);
- p^.temp_offset:=href.offset;
- href.offset:=href.offset+4;
- exprasmlist^.concat(new(paicpu,op_reg(A_MOV,S_L,p^.location.registerhigh,href)));
- href.offset:=href.offset-4;
- {$else TEMPS_NOT_PUSH}
- exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_L,p^.location.registerhigh)));
- {$endif TEMPS_NOT_PUSH}
- ungetregister32(p^.location.registerhigh);
- end
- {$ifdef TEMPS_NOT_PUSH}
- else
- begin
- gettempofsizereference(href,4);
- p^.temp_offset:=href.offset;
- end
- {$endif TEMPS_NOT_PUSH}
- ;
- pushed:=true;
- {$ifdef TEMPS_NOT_PUSH}
- exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,p^.location.register,href)));
- {$else TEMPS_NOT_PUSH}
- exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_L,p^.location.register)));
- {$endif TEMPS_NOT_PUSH}
- ungetregister32(p^.location.register);
- end
- else if (p^.location.loc in [LOC_MEM,LOC_REFERENCE]) and
- ((p^.location.reference.base<>R_NO) or
- (p^.location.reference.index<>R_NO)
- ) then
- begin
- del_reference(p^.location.reference);
- {$ifndef noAllocEdi}
- getexplicitregister32(R_EDI);
- {$endif noAllocEdi}
- emit_ref_reg(A_LEA,S_L,newreference(p^.location.reference),
- R_EDI);
- {$ifdef TEMPS_NOT_PUSH}
- gettempofsizereference(href,4);
- exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,R_EDI,href)));
- p^.temp_offset:=href.offset;
- {$else TEMPS_NOT_PUSH}
- exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_L,R_EDI)));
- {$endif TEMPS_NOT_PUSH}
- {$ifndef noAllocEdi}
- ungetregister32(R_EDI);
- {$endif noAllocEdi}
- pushed:=true;
- end
- else pushed:=false;
- end
- else pushed:=false;
- maybe_push:=pushed;
- end;
- {$ifdef TEMPS_NOT_PUSH}
- function maybe_savetotemp(needed : byte;p : ptree;isint64 : boolean) : boolean;
- var
- pushed : boolean;
- href : treference;
- begin
- if needed>usablereg32 then
- begin
- if (p^.location.loc=LOC_REGISTER) then
- begin
- if isint64(p^.resulttype) then
- begin
- gettempofsizereference(href,8);
- p^.temp_offset:=href.offset;
- href.offset:=href.offset+4;
- exprasmlist^.concat(new(paicpu,op_reg(A_MOV,S_L,p^.location.registerhigh,href)));
- href.offset:=href.offset-4;
- ungetregister32(p^.location.registerhigh);
- end
- else
- begin
- gettempofsizereference(href,4);
- p^.temp_offset:=href.offset;
- end;
- pushed:=true;
- exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,p^.location.register,href)));
- ungetregister32(p^.location.register);
- end
- else if (p^.location.loc in [LOC_MEM,LOC_REFERENCE]) and
- ((p^.location.reference.base<>R_NO) or
- (p^.location.reference.index<>R_NO)
- ) then
- begin
- del_reference(p^.location.reference);
- {$ifndef noAllocEdi}
- getexplicitregister32(R_EDI);
- {$endif noAllocEdi}
- emit_ref_reg(A_LEA,S_L,newreference(p^.location.reference),
- R_EDI);
- gettempofsizereference(href,4);
- exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,R_EDI,href)));
- {$ifndef noAllocEdi}
- ungetregister32(R_EDI);
- {$endif noAllocEdi}
- p^.temp_offset:=href.offset;
- pushed:=true;
- end
- else pushed:=false;
- end
- else pushed:=false;
- maybe_push:=pushed;
- end;
- {$endif TEMPS_NOT_PUSH}
- procedure push_int(l : longint);
- begin
- if (l = 0) and
- not(aktoptprocessor in [Class386, ClassP6]) and
- not(cs_littlesize in aktglobalswitches)
- Then
- begin
- {$ifndef noAllocEdi}
- getexplicitregister32(R_EDI);
- {$endif noAllocEdi}
- emit_reg_reg(A_XOR,S_L,R_EDI,R_EDI);
- exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_L,R_EDI)));
- {$ifndef noAllocEdi}
- ungetregister32(R_EDI);
- {$endif noAllocEdi}
- end
- else
- exprasmlist^.concat(new(paicpu,op_const(A_PUSH,S_L,l)));
- end;
- procedure emit_push_mem(const ref : treference);
- begin
- if ref.is_immediate then
- push_int(ref.offset)
- else
- begin
- if not(aktoptprocessor in [Class386, ClassP6]) and
- not(cs_littlesize in aktglobalswitches)
- then
- begin
- {$ifndef noAllocEdi}
- getexplicitregister32(R_EDI);
- {$endif noAllocEdi}
- emit_ref_reg(A_MOV,S_L,newreference(ref),R_EDI);
- exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_L,R_EDI)));
- {$ifndef noAllocEdi}
- ungetregister32(R_EDI);
- {$endif noAllocEdi}
- end
- else exprasmlist^.concat(new(paicpu,op_ref(A_PUSH,S_L,newreference(ref))));
- end;
- end;
- procedure emitpushreferenceaddr(const ref : treference);
- var
- href : treference;
- begin
- { this will fail for references to other segments !!! }
- if ref.is_immediate then
- { is this right ? }
- begin
- { push_int(ref.offset)}
- gettempofsizereference(4,href);
- emit_const_ref(A_MOV,S_L,ref.offset,newreference(href));
- emitpushreferenceaddr(href);
- del_reference(href);
- end
- else
- begin
- if ref.segment<>R_NO then
- CGMessage(cg_e_cant_use_far_pointer_there);
- if (ref.base=R_NO) and (ref.index=R_NO) then
- exprasmlist^.concat(new(paicpu,op_sym_ofs(A_PUSH,S_L,ref.symbol,ref.offset)))
- else if (ref.base=R_NO) and (ref.index<>R_NO) and
- (ref.offset=0) and (ref.scalefactor=0) and (ref.symbol=nil) then
- exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_L,ref.index)))
- else if (ref.base<>R_NO) and (ref.index=R_NO) and
- (ref.offset=0) and (ref.symbol=nil) then
- exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_L,ref.base)))
- else
- begin
- {$ifndef noAllocEdi}
- getexplicitregister32(R_EDI);
- {$endif noAllocEdi}
- emit_ref_reg(A_LEA,S_L,newreference(ref),R_EDI);
- exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_L,R_EDI)));
- {$ifndef noAllocEdi}
- ungetregister32(R_EDI);
- {$endif noAllocEdi}
- end;
- end;
- end;
- procedure pushsetelement(p : ptree);
- {
- copies p a set element on the stack
- }
- var
- hr,hr16,hr32 : tregister;
- begin
- { copy the element on the stack, slightly complicated }
- if p^.treetype=ordconstn then
- begin
- if target_os.stackalignment=4 then
- exprasmlist^.concat(new(paicpu,op_const(A_PUSH,S_L,p^.value)))
- else
- exprasmlist^.concat(new(paicpu,op_const(A_PUSH,S_W,p^.value)));
- end
- else
- begin
- case p^.location.loc of
- LOC_REGISTER,
- LOC_CREGISTER :
- begin
- hr:=p^.location.register;
- case hr of
- R_EAX,R_EBX,R_ECX,R_EDX,R_EDI,R_ESI,R_ESP :
- begin
- hr16:=reg32toreg16(hr);
- hr32:=hr;
- end;
- R_AX,R_BX,R_CX,R_DX,R_DI,R_SI,R_SP :
- begin
- hr16:=hr;
- hr32:=reg16toreg32(hr);
- end;
- R_AL,R_BL,R_CL,R_DL :
- begin
- hr16:=reg8toreg16(hr);
- hr32:=reg8toreg32(hr);
- end;
- end;
- if target_os.stackalignment=4 then
- exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_L,hr32)))
- else
- exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_W,hr16)));
- ungetregister32(hr32);
- end;
- else
- begin
- { you can't push more bytes than the size of the element, }
- { because this may cross a page boundary and you'll get a }
- { sigsegv (JM) }
- emit_push_mem_size(p^.location.reference,1);
- del_reference(p^.location.reference);
- end;
- end;
- end;
- end;
- procedure restore(p : ptree;isint64 : boolean);
- var
- hregister : tregister;
- {$ifdef TEMPS_NOT_PUSH}
- href : treference;
- {$endif TEMPS_NOT_PUSH}
- begin
- hregister:=getregister32;
- {$ifdef TEMPS_NOT_PUSH}
- reset_reference(href);
- href.base:=procinfo^.frame_pointer;
- href.offset:=p^.temp_offset;
- emit_ref_reg(A_MOV,S_L,href,hregister);
- {$else TEMPS_NOT_PUSH}
- exprasmlist^.concat(new(paicpu,op_reg(A_POP,S_L,hregister)));
- {$endif TEMPS_NOT_PUSH}
- if (p^.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
- begin
- p^.location.register:=hregister;
- if isint64 then
- begin
- p^.location.registerhigh:=getregister32;
- {$ifdef TEMPS_NOT_PUSH}
- href.offset:=p^.temp_offset+4;
- emit_ref_reg(A_MOV,S_L,p^.location.registerhigh);
- { set correctly for release ! }
- href.offset:=p^.temp_offset;
- {$else TEMPS_NOT_PUSH}
- exprasmlist^.concat(new(paicpu,op_reg(A_POP,S_L,p^.location.registerhigh)));
- {$endif TEMPS_NOT_PUSH}
- end;
- end
- else
- begin
- reset_reference(p^.location.reference);
- { any reasons why this was moved into the index register ? }
- { normally usage of base register is much better (FK) }
- p^.location.reference.base:=hregister;
- { Why is this done? We can never be sure about p^.left
- because otherwise secondload fails !!!
- set_location(p^.left^.location,p^.location);}
- end;
- {$ifdef TEMPS_NOT_PUSH}
- ungetiftemp(href);
- {$endif TEMPS_NOT_PUSH}
- end;
- {$ifdef TEMPS_NOT_PUSH}
- procedure restorefromtemp(p : ptree;isint64 : boolean);
- var
- hregister : tregister;
- href : treference;
- begin
- hregister:=getregister32;
- reset_reference(href);
- href.base:=procinfo^.frame_pointer;
- href.offset:=p^.temp_offset;
- emit_ref_reg(A_MOV,S_L,href,hregister);
- if (p^.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
- begin
- p^.location.register:=hregister;
- if isint64 then
- begin
- p^.location.registerhigh:=getregister32;
- href.offset:=p^.temp_offset+4;
- emit_ref_reg(A_MOV,S_L,p^.location.registerhigh);
- { set correctly for release ! }
- href.offset:=p^.temp_offset;
- end;
- end
- else
- begin
- reset_reference(p^.location.reference);
- p^.location.reference.base:=hregister;
- { Why is this done? We can never be sure about p^.left
- because otherwise secondload fails PM
- set_location(p^.left^.location,p^.location);}
- end;
- ungetiftemp(href);
- end;
- {$endif TEMPS_NOT_PUSH}
- procedure push_value_para(p:ptree;inlined,is_cdecl:boolean;
- para_offset:longint;alignment : longint);
- var
- tempreference : treference;
- r : preference;
- opsize : topsize;
- op : tasmop;
- hreg : tregister;
- size : longint;
- hlabel : pasmlabel;
- begin
- case p^.location.loc of
- LOC_REGISTER,
- LOC_CREGISTER:
- begin
- case p^.location.register of
- R_EAX,R_EBX,R_ECX,R_EDX,R_ESI,
- R_EDI,R_ESP,R_EBP :
- begin
- if p^.resulttype^.size=8 then
- begin
- inc(pushedparasize,8);
- if inlined then
- begin
- r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
- exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,
- p^.location.registerlow,r)));
- r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize+4);
- exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,
- p^.location.registerhigh,r)));
- end
- else
- exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_L,p^.location.registerhigh)));
- ungetregister32(p^.location.registerhigh);
- exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_L,p^.location.registerlow)));
- ungetregister32(p^.location.registerlow);
- end
- else
- begin
- inc(pushedparasize,4);
- if inlined then
- begin
- r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
- exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,
- p^.location.register,r)));
- end
- else
- exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_L,p^.location.register)));
- ungetregister32(p^.location.register);
- end;
- end;
- R_AX,R_BX,R_CX,R_DX,R_SI,R_DI:
- begin
- if alignment=4 then
- begin
- opsize:=S_L;
- hreg:=reg16toreg32(p^.location.register);
- inc(pushedparasize,4);
- end
- else
- begin
- opsize:=S_W;
- hreg:=p^.location.register;
- inc(pushedparasize,2);
- end;
- if inlined then
- begin
- r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
- exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,opsize,hreg,r)));
- end
- else
- exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,opsize,hreg)));
- ungetregister32(reg16toreg32(p^.location.register));
- end;
- R_AL,R_BL,R_CL,R_DL:
- begin
- if alignment=4 then
- begin
- opsize:=S_L;
- hreg:=reg8toreg32(p^.location.register);
- inc(pushedparasize,4);
- end
- else
- begin
- opsize:=S_W;
- hreg:=reg8toreg16(p^.location.register);
- inc(pushedparasize,2);
- end;
- { we must push always 16 bit }
- if inlined then
- begin
- r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
- exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,opsize,hreg,r)));
- end
- else
- exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,opsize,hreg)));
- ungetregister32(reg8toreg32(p^.location.register));
- end;
- else internalerror(1899);
- end;
- end;
- LOC_FPU:
- begin
- size:=align(pfloatdef(p^.resulttype)^.size,alignment);
- inc(pushedparasize,size);
- if not inlined then
- emit_const_reg(A_SUB,S_L,size,R_ESP);
- {$ifdef GDB}
- if (cs_debuginfo in aktmoduleswitches) and
- (exprasmlist^.first=exprasmlist^.last) then
- exprasmlist^.concat(new(pai_force_line,init));
- {$endif GDB}
- r:=new_reference(R_ESP,0);
- floatstoreops(pfloatdef(p^.resulttype)^.typ,op,opsize);
- { this is the easiest case for inlined !! }
- if inlined then
- begin
- r^.base:=procinfo^.framepointer;
- r^.offset:=para_offset-pushedparasize;
- end;
- exprasmlist^.concat(new(paicpu,op_ref(op,opsize,r)));
- dec(fpuvaroffset);
- end;
- LOC_CFPUREGISTER:
- begin
- exprasmlist^.concat(new(paicpu,op_reg(A_FLD,S_NO,
- correct_fpuregister(p^.location.register,fpuvaroffset))));
- size:=align(pfloatdef(p^.resulttype)^.size,alignment);
- inc(pushedparasize,size);
- if not inlined then
- emit_const_reg(A_SUB,S_L,size,R_ESP);
- {$ifdef GDB}
- if (cs_debuginfo in aktmoduleswitches) and
- (exprasmlist^.first=exprasmlist^.last) then
- exprasmlist^.concat(new(pai_force_line,init));
- {$endif GDB}
- r:=new_reference(R_ESP,0);
- floatstoreops(pfloatdef(p^.resulttype)^.typ,op,opsize);
- { this is the easiest case for inlined !! }
- if inlined then
- begin
- r^.base:=procinfo^.framepointer;
- r^.offset:=para_offset-pushedparasize;
- end;
- exprasmlist^.concat(new(paicpu,op_ref(op,opsize,r)));
- end;
- LOC_REFERENCE,LOC_MEM:
- begin
- tempreference:=p^.location.reference;
- del_reference(p^.location.reference);
- case p^.resulttype^.deftype of
- enumdef,
- orddef :
- begin
- case p^.resulttype^.size of
- 8 : begin
- inc(pushedparasize,8);
- if inlined then
- begin
- {$ifndef noAllocEdi}
- getexplicitregister32(R_EDI);
- {$endif noAllocEdi}
- emit_ref_reg(A_MOV,S_L,
- newreference(tempreference),R_EDI);
- r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
- exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,R_EDI,r)));
- {$ifndef noAllocEdi}
- ungetregister32(R_EDI);
- getexplicitregister32(R_EDI);
- {$endif noAllocEdi}
- inc(tempreference.offset,4);
- emit_ref_reg(A_MOV,S_L,
- newreference(tempreference),R_EDI);
- r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize+4);
- exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,R_EDI,r)));
- {$ifndef noAllocEdi}
- ungetregister32(R_EDI);
- {$endif noAllocEdi}
- end
- else
- begin
- inc(tempreference.offset,4);
- emit_push_mem(tempreference);
- dec(tempreference.offset,4);
- emit_push_mem(tempreference);
- end;
- end;
- 4 : begin
- inc(pushedparasize,4);
- if inlined then
- begin
- {$ifndef noAllocEdi}
- getexplicitregister32(R_EDI);
- {$endif noAllocEdi}
- emit_ref_reg(A_MOV,S_L,
- newreference(tempreference),R_EDI);
- r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
- exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,R_EDI,r)));
- {$ifndef noAllocEdi}
- ungetregister32(R_EDI);
- {$endif noAllocEdi}
- end
- else
- emit_push_mem(tempreference);
- end;
- 1,2 : begin
- if alignment=4 then
- begin
- opsize:=S_L;
- hreg:=R_EDI;
- inc(pushedparasize,4);
- end
- else
- begin
- opsize:=S_W;
- hreg:=R_DI;
- inc(pushedparasize,2);
- end;
- if inlined then
- begin
- {$ifndef noAllocEdi}
- getexplicitregister32(R_EDI);
- {$endif noAllocEdi}
- emit_ref_reg(A_MOV,opsize,
- newreference(tempreference),hreg);
- r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
- exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,opsize,hreg,r)));
- {$ifndef noAllocEdi}
- ungetregister32(R_EDI);
- {$endif noAllocEdi}
- end
- else
- emit_push_mem_size(tempreference,p^.resulttype^.size);
- end;
- else
- internalerror(234231);
- end;
- end;
- floatdef :
- begin
- case pfloatdef(p^.resulttype)^.typ of
- f32bit,
- s32real :
- begin
- inc(pushedparasize,4);
- if inlined then
- begin
- {$ifndef noAllocEdi}
- getexplicitregister32(R_EDI);
- {$endif noAllocEdi}
- emit_ref_reg(A_MOV,S_L,
- newreference(tempreference),R_EDI);
- r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
- exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,R_EDI,r)));
- {$ifndef noAllocEdi}
- ungetregister32(R_EDI);
- {$endif noAllocEdi}
- end
- else
- emit_push_mem(tempreference);
- end;
- s64real,
- s64comp :
- begin
- inc(pushedparasize,4);
- inc(tempreference.offset,4);
- if inlined then
- begin
- {$ifndef noAllocEdi}
- getexplicitregister32(R_EDI);
- {$endif noAllocEdi}
- emit_ref_reg(A_MOV,S_L,
- newreference(tempreference),R_EDI);
- r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
- exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,R_EDI,r)));
- {$ifndef noAllocEdi}
- ungetregister32(R_EDI);
- {$endif noAllocEdi}
- end
- else
- emit_push_mem(tempreference);
- inc(pushedparasize,4);
- dec(tempreference.offset,4);
- if inlined then
- begin
- {$ifndef noAllocEdi}
- getexplicitregister32(R_EDI);
- {$endif noAllocEdi}
- emit_ref_reg(A_MOV,S_L,
- newreference(tempreference),R_EDI);
- r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
- exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,R_EDI,r)));
- {$ifndef noAllocEdi}
- ungetregister32(R_EDI);
- {$endif noAllocEdi}
- end
- else
- emit_push_mem(tempreference);
- end;
- s80real :
- begin
- inc(pushedparasize,4);
- if alignment=4 then
- inc(tempreference.offset,8)
- else
- inc(tempreference.offset,6);
- if inlined then
- begin
- {$ifndef noAllocEdi}
- getexplicitregister32(R_EDI);
- {$endif noAllocEdi}
- emit_ref_reg(A_MOV,S_L,
- newreference(tempreference),R_EDI);
- r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
- exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,R_EDI,r)));
- {$ifndef noAllocEdi}
- ungetregister32(R_EDI);
- {$endif noAllocEdi}
- end
- else
- emit_push_mem(tempreference);
- dec(tempreference.offset,4);
- inc(pushedparasize,4);
- if inlined then
- begin
- {$ifndef noAllocEdi}
- getexplicitregister32(R_EDI);
- {$endif noAllocEdi}
- emit_ref_reg(A_MOV,S_L,
- newreference(tempreference),R_EDI);
- r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
- exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,R_EDI,r)));
- {$ifndef noAllocEdi}
- ungetregister32(R_EDI);
- {$endif noAllocEdi}
- end
- else
- emit_push_mem(tempreference);
- if alignment=4 then
- begin
- opsize:=S_L;
- hreg:=R_EDI;
- inc(pushedparasize,4);
- dec(tempreference.offset,4);
- end
- else
- begin
- opsize:=S_W;
- hreg:=R_DI;
- inc(pushedparasize,2);
- dec(tempreference.offset,2);
- end;
- if inlined then
- begin
- {$ifndef noAllocEdi}
- getexplicitregister32(R_EDI);
- {$endif noAllocEdi}
- emit_ref_reg(A_MOV,opsize,
- newreference(tempreference),hreg);
- r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
- exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,opsize,hreg,r)));
- {$ifndef noAllocEdi}
- ungetregister32(R_EDI);
- {$endif noAllocEdi}
- end
- else
- exprasmlist^.concat(new(paicpu,op_ref(A_PUSH,opsize,
- newreference(tempreference))));
- end;
- end;
- end;
- pointerdef,
- procvardef,
- classrefdef:
- begin
- inc(pushedparasize,4);
- if inlined then
- begin
- {$ifndef noAllocEdi}
- getexplicitregister32(R_EDI);
- {$endif noAllocEdi}
- emit_ref_reg(A_MOV,S_L,
- newreference(tempreference),R_EDI);
- r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
- exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,R_EDI,r)));
- {$ifndef noAllocEdi}
- ungetregister32(R_EDI);
- {$endif noAllocEdi}
- end
- else
- emit_push_mem(tempreference);
- end;
- arraydef,
- recorddef,
- stringdef,
- setdef,
- objectdef :
- begin
- { even some structured types are 32 bit }
- if is_widestring(p^.resulttype) or
- is_ansistring(p^.resulttype) or
- is_smallset(p^.resulttype) or
- ((p^.resulttype^.deftype in [recorddef,arraydef]) and
- (
- (p^.resulttype^.deftype<>arraydef) or not
- (parraydef(p^.resulttype)^.IsConstructor or
- parraydef(p^.resulttype)^.isArrayOfConst or
- is_open_array(p^.resulttype))
- ) and
- (p^.resulttype^.size<=4)
- ) or
- ((p^.resulttype^.deftype=objectdef) and
- pobjectdef(p^.resulttype)^.is_class) then
- begin
- if (p^.resulttype^.size>2) or
- ((alignment=4) and (p^.resulttype^.size>0)) then
- begin
- inc(pushedparasize,4);
- if inlined then
- begin
- r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
- concatcopy(tempreference,r^,4,false,false);
- end
- else
- emit_push_mem(tempreference);
- end
- else
- begin
- if p^.resulttype^.size>0 then
- begin
- inc(pushedparasize,2);
- if inlined then
- begin
- r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
- concatcopy(tempreference,r^,2,false,false);
- end
- else
- exprasmlist^.concat(new(paicpu,op_ref(A_PUSH,S_W,newreference(tempreference))));
- end;
- end;
- end
- { call by value open array ? }
- else if is_cdecl then
- begin
- { push on stack }
- size:=align(p^.resulttype^.size,alignment);
- inc(pushedparasize,size);
- emit_const_reg(A_SUB,S_L,size,R_ESP);
- r:=new_reference(R_ESP,0);
- concatcopy(tempreference,r^,size,false,false);
- end
- else
- internalerror(8954);
- end;
- else
- CGMessage(cg_e_illegal_expression);
- end;
- end;
- LOC_JUMP:
- begin
- getlabel(hlabel);
- if alignment=4 then
- begin
- opsize:=S_L;
- inc(pushedparasize,4);
- end
- else
- begin
- opsize:=S_W;
- inc(pushedparasize,2);
- end;
- emitlab(truelabel);
- if inlined then
- begin
- r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
- emit_const_ref(A_MOV,opsize,1,r);
- end
- else
- exprasmlist^.concat(new(paicpu,op_const(A_PUSH,opsize,1)));
- emitjmp(C_None,hlabel);
- emitlab(falselabel);
- if inlined then
- begin
- r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
- emit_const_ref(A_MOV,opsize,0,r);
- end
- else
- exprasmlist^.concat(new(paicpu,op_const(A_PUSH,opsize,0)));
- emitlab(hlabel);
- end;
- LOC_FLAGS:
- begin
- if not(R_EAX in unused) then
- begin
- {$ifndef noAllocEdi}
- getexplicitregister32(R_EDI);
- {$endif noAllocEdi}
- emit_reg_reg(A_MOV,S_L,R_EAX,R_EDI);
- end;
- emit_flag2reg(p^.location.resflags,R_AL);
- emit_reg_reg(A_MOVZX,S_BW,R_AL,R_AX);
- if alignment=4 then
- begin
- opsize:=S_L;
- hreg:=R_EAX;
- inc(pushedparasize,4);
- end
- else
- begin
- opsize:=S_W;
- hreg:=R_AX;
- inc(pushedparasize,2);
- end;
- if inlined then
- begin
- r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
- exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,opsize,hreg,r)));
- end
- else
- exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,opsize,hreg)));
- if not(R_EAX in unused) then
- begin
- emit_reg_reg(A_MOV,S_L,R_EDI,R_EAX);
- {$ifndef noAllocEdi}
- ungetregister32(R_EDI);
- {$endif noAllocEdi}
- end;
- end;
- {$ifdef SUPPORT_MMX}
- LOC_MMXREGISTER,
- LOC_CMMXREGISTER:
- begin
- inc(pushedparasize,8); { was missing !!! (PM) }
- emit_const_reg(
- A_SUB,S_L,8,R_ESP);
- {$ifdef GDB}
- if (cs_debuginfo in aktmoduleswitches) and
- (exprasmlist^.first=exprasmlist^.last) then
- exprasmlist^.concat(new(pai_force_line,init));
- {$endif GDB}
- if inlined then
- begin
- r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
- exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOVQ,S_NO,
- p^.location.register,r)));
- end
- else
- begin
- r:=new_reference(R_ESP,0);
- exprasmlist^.concat(new(paicpu,op_reg_ref(
- A_MOVQ,S_NO,p^.location.register,r)));
- end;
- end;
- {$endif SUPPORT_MMX}
- end;
- end;
- {*****************************************************************************
- Emit Float Functions
- *****************************************************************************}
- procedure floatloadops(t : tfloattype;var op : tasmop;var s : topsize);
- begin
- case t of
- s32real : begin
- op:=A_FLD;
- s:=S_FS;
- end;
- s64real : begin
- op:=A_FLD;
- { ???? }
- s:=S_FL;
- end;
- s80real : begin
- op:=A_FLD;
- s:=S_FX;
- end;
- s64comp : begin
- op:=A_FILD;
- s:=S_IQ;
- end;
- else internalerror(17);
- end;
- end;
- procedure floatload(t : tfloattype;const ref : treference);
- var
- op : tasmop;
- s : topsize;
- begin
- floatloadops(t,op,s);
- exprasmlist^.concat(new(paicpu,op_ref(op,s,
- newreference(ref))));
- inc(fpuvaroffset);
- end;
- procedure floatstoreops(t : tfloattype;var op : tasmop;var s : topsize);
- begin
- case t of
- s32real : begin
- op:=A_FSTP;
- s:=S_FS;
- end;
- s64real : begin
- op:=A_FSTP;
- s:=S_FL;
- end;
- s80real : begin
- op:=A_FSTP;
- s:=S_FX;
- end;
- s64comp : begin
- op:=A_FISTP;
- s:=S_IQ;
- end;
- else
- internalerror(17);
- end;
- end;
- procedure floatstore(t : tfloattype;const ref : treference);
- var
- op : tasmop;
- s : topsize;
- begin
- floatstoreops(t,op,s);
- exprasmlist^.concat(new(paicpu,op_ref(op,s,
- newreference(ref))));
- dec(fpuvaroffset);
- end;
- {*****************************************************************************
- Emit Functions
- *****************************************************************************}
- procedure maketojumpbool(p : ptree);
- {
- produces jumps to true respectively false labels using boolean expressions
- }
- var
- opsize : topsize;
- storepos : tfileposinfo;
- begin
- if p^.error then
- exit;
- storepos:=aktfilepos;
- aktfilepos:=p^.fileinfo;
- if is_boolean(p^.resulttype) then
- begin
- if is_constboolnode(p) then
- begin
- if p^.value<>0 then
- emitjmp(C_None,truelabel)
- else
- emitjmp(C_None,falselabel);
- end
- else
- begin
- opsize:=def_opsize(p^.resulttype);
- case p^.location.loc of
- LOC_CREGISTER,LOC_REGISTER : begin
- emit_reg_reg(A_OR,opsize,p^.location.register,
- p^.location.register);
- ungetregister(p^.location.register);
- emitjmp(C_NZ,truelabel);
- emitjmp(C_None,falselabel);
- end;
- LOC_MEM,LOC_REFERENCE : begin
- emit_const_ref(
- A_CMP,opsize,0,newreference(p^.location.reference));
- del_reference(p^.location.reference);
- emitjmp(C_NZ,truelabel);
- emitjmp(C_None,falselabel);
- end;
- LOC_FLAGS : begin
- emitjmp(flag_2_cond[p^.location.resflags],truelabel);
- emitjmp(C_None,falselabel);
- end;
- end;
- end;
- end
- else
- CGMessage(type_e_mismatch);
- aktfilepos:=storepos;
- end;
- { produces if necessary overflowcode }
- procedure emitoverflowcheck(p:ptree);
- var
- hl : pasmlabel;
- begin
- if not(cs_check_overflow in aktlocalswitches) then
- exit;
- getlabel(hl);
- if not ((p^.resulttype^.deftype=pointerdef) or
- ((p^.resulttype^.deftype=orddef) and
- (porddef(p^.resulttype)^.typ in [u64bit,u16bit,u32bit,u8bit,uchar,
- bool8bit,bool16bit,bool32bit]))) then
- emitjmp(C_NO,hl)
- else
- emitjmp(C_NB,hl);
- emitcall('FPC_OVERFLOW');
- emitlab(hl);
- end;
- { produces range check code, while one of the operands is a 64 bit
- integer }
- procedure emitrangecheck64(p : ptree;todef : pdef);
- begin
- CGMessage(cg_w_64bit_range_check_not_supported);
- {internalerror(28699);}
- end;
- { produces if necessary rangecheckcode }
- procedure emitrangecheck(p:ptree;todef:pdef);
- {
- generate range checking code for the value at location t. The
- type used is the checked against todefs ranges. fromdef (p.resulttype)
- is the original type used at that location, when both defs are
- equal the check is also insert (needed for succ,pref,inc,dec)
- }
- var
- neglabel,
- poslabel : pasmlabel;
- href : treference;
- rstr : string;
- hreg : tregister;
- opsize : topsize;
- op : tasmop;
- fromdef : pdef;
- lto,hto,
- lfrom,hfrom : longint;
- doublebound,
- is_reg,
- popecx : boolean;
- begin
- { range checking on and range checkable value? }
- if not(cs_check_range in aktlocalswitches) or
- not(todef^.deftype in [orddef,enumdef,arraydef]) then
- exit;
- { only check when assigning to scalar, subranges are different,
- when todef=fromdef then the check is always generated }
- fromdef:=p^.resulttype;
- if is_64bitint(fromdef) or is_64bitint(todef) then
- begin
- emitrangecheck64(p,todef);
- exit;
- end;
- {we also need lto and hto when checking if we need to use doublebound!
- (JM)}
- getrange(todef,lto,hto);
- if todef<>fromdef then
- begin
- getrange(p^.resulttype,lfrom,hfrom);
- { first check for not being u32bit, then if the to is bigger than
- from }
- if (lto<hto) and (lfrom<hfrom) and
- (lto<=lfrom) and (hto>=hfrom) then
- exit;
- end;
- { generate the rangecheck code for the def where we are going to
- store the result }
- doublebound:=false;
- case todef^.deftype of
- orddef :
- begin
- porddef(todef)^.genrangecheck;
- rstr:=porddef(todef)^.getrangecheckstring;
- doublebound:=(porddef(todef)^.typ=u32bit) and (lto>hto);
- end;
- enumdef :
- begin
- penumdef(todef)^.genrangecheck;
- rstr:=penumdef(todef)^.getrangecheckstring;
- end;
- arraydef :
- begin
- parraydef(todef)^.genrangecheck;
- rstr:=parraydef(todef)^.getrangecheckstring;
- doublebound:=(lto>hto);
- end;
- end;
- { get op and opsize }
- opsize:=def2def_opsize(fromdef,u32bitdef);
- if opsize in [S_B,S_W,S_L] then
- op:=A_MOV
- else
- if is_signed(fromdef) then
- op:=A_MOVSX
- else
- op:=A_MOVZX;
- is_reg:=(p^.location.loc in [LOC_REGISTER,LOC_CREGISTER]);
- if is_reg then
- hreg:=p^.location.register;
- if not target_os.use_bound_instruction then
- begin
- { FPC_BOUNDCHECK needs to be called with
- %ecx - value
- %edi - pointer to the ranges }
- popecx:=false;
- if not(is_reg) or
- (p^.location.register<>R_ECX) then
- begin
- if not(R_ECX in unused) then
- begin
- exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_L,R_ECX)));
- popecx:=true;
- end
- else exprasmlist^.concat(new(pairegalloc,alloc(R_ECX)));
- if is_reg then
- emit_reg_reg(op,opsize,p^.location.register,R_ECX)
- else
- emit_ref_reg(op,opsize,newreference(p^.location.reference),R_ECX);
- end;
- if doublebound then
- begin
- getlabel(neglabel);
- getlabel(poslabel);
- emit_reg_reg(A_OR,S_L,R_ECX,R_ECX);
- emitjmp(C_L,neglabel);
- end;
- { insert bound instruction only }
- {$ifndef noAllocEdi}
- getexplicitregister32(R_EDI);
- {$endif noAllocEdi}
- exprasmlist^.concat(new(paicpu,op_sym_ofs_reg(A_MOV,S_L,newasmsymbol(rstr),0,R_EDI)));
- emitcall('FPC_BOUNDCHECK');
- {$ifndef noAllocEdi}
- ungetregister32(R_EDI);
- {$endif noAllocEdi}
- { u32bit needs 2 checks }
- if doublebound then
- begin
- emitjmp(C_None,poslabel);
- emitlab(neglabel);
- {$ifndef noAllocEdi}
- getexplicitregister32(R_EDI);
- {$endif noAllocEdi}
- exprasmlist^.concat(new(paicpu,op_sym_ofs_reg(A_MOV,S_L,newasmsymbol(rstr),8,R_EDI)));
- emitcall('FPC_BOUNDCHECK');
- {$ifndef noAllocEdi}
- ungetregister32(R_EDI);
- {$endif noAllocEdi}
- emitlab(poslabel);
- end;
- if popecx then
- exprasmlist^.concat(new(paicpu,op_reg(A_POP,S_L,R_ECX)))
- else exprasmlist^.concat(new(pairegalloc,dealloc(R_ECX)));
- end
- else
- begin
- reset_reference(href);
- href.symbol:=newasmsymbol(rstr);
- { load the value in a register }
- if is_reg then
- begin
- { be sure that hreg is a 32 bit reg, if not load it in %edi }
- if p^.location.register in [R_EAX..R_EDI] then
- hreg:=p^.location.register
- else
- begin
- {$ifndef noAllocEdi}
- getexplicitregister32(R_EDI);
- {$endif noAllocEdi}
- emit_reg_reg(op,opsize,p^.location.register,R_EDI);
- hreg:=R_EDI;
- end;
- end
- else
- begin
- {$ifndef noAllocEdi}
- getexplicitregister32(R_EDI);
- {$endif noAllocEdi}
- emit_ref_reg(op,opsize,newreference(p^.location.reference),R_EDI);
- hreg:=R_EDI;
- end;
- if doublebound then
- begin
- getlabel(neglabel);
- getlabel(poslabel);
- emit_reg_reg(A_TEST,S_L,hreg,hreg);
- emitjmp(C_L,neglabel);
- end;
- { insert bound instruction only }
- exprasmlist^.concat(new(paicpu,op_reg_ref(A_BOUND,S_L,hreg,newreference(href))));
- { u32bit needs 2 checks }
- if doublebound then
- begin
- href.offset:=8;
- emitjmp(C_None,poslabel);
- emitlab(neglabel);
- exprasmlist^.concat(new(paicpu,op_reg_ref(A_BOUND,S_L,hreg,newreference(href))));
- emitlab(poslabel);
- end;
- {$ifndef noAllocEdi}
- if hreg = R_EDI then
- ungetregister32(R_EDI);
- {$endif noAllocEdi}
- end;
- end;
- procedure concatcopy(source,dest : treference;size : longint;delsource,loadref : boolean);
- const
- isizes : array[0..3] of topsize=(S_L,S_B,S_W,S_B);
- ishr : array[0..3] of byte=(2,0,1,0);
- var
- ecxpushed : boolean;
- helpsize : longint;
- i : byte;
- reg8,reg32 : tregister;
- swap : boolean;
- procedure maybepushecx;
- begin
- if not(R_ECX in unused) then
- begin
- exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_L,R_ECX)));
- ecxpushed:=true;
- end
- else getexplicitregister32(R_ECX);
- end;
- begin
- {$IfNDef regallocfix}
- If delsource then
- del_reference(source);
- {$EndIf regallocfix}
- if (not loadref) and
- ((size<=8) or
- (not(cs_littlesize in aktglobalswitches ) and (size<=12))) then
- begin
- helpsize:=size shr 2;
- {$ifndef noAllocEdi}
- getexplicitregister32(R_EDI);
- {$endif noAllocEdi}
- for i:=1 to helpsize do
- begin
- emit_ref_reg(A_MOV,S_L,newreference(source),R_EDI);
- {$ifdef regallocfix}
- If (size = 4) and delsource then
- del_reference(source);
- {$endif regallocfix}
- exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,R_EDI,newreference(dest))));
- inc(source.offset,4);
- inc(dest.offset,4);
- dec(size,4);
- end;
- if size>1 then
- begin
- emit_ref_reg(A_MOV,S_W,newreference(source),R_DI);
- {$ifdef regallocfix}
- If (size = 2) and delsource then
- del_reference(source);
- {$endif regallocfix}
- exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_W,R_DI,newreference(dest))));
- inc(source.offset,2);
- inc(dest.offset,2);
- dec(size,2);
- end;
- {$ifndef noAllocEdi}
- ungetregister32(R_EDI);
- {$endif noAllocEdi}
- if size>0 then
- begin
- { and now look for an 8 bit register }
- swap:=false;
- if R_EAX in unused then reg8:=reg32toreg8(getexplicitregister32(R_EAX))
- else if R_EDX in unused then reg8:=reg32toreg8(getexplicitregister32(R_EDX))
- else if R_EBX in unused then reg8:=reg32toreg8(getexplicitregister32(R_EBX))
- else if R_ECX in unused then reg8:=reg32toreg8(getexplicitregister32(R_ECX))
- else
- begin
- swap:=true;
- { we need only to check 3 registers, because }
- { one is always not index or base }
- if (dest.base<>R_EAX) and (dest.index<>R_EAX) then
- begin
- reg8:=R_AL;
- reg32:=R_EAX;
- end
- else if (dest.base<>R_EBX) and (dest.index<>R_EBX) then
- begin
- reg8:=R_BL;
- reg32:=R_EBX;
- end
- else if (dest.base<>R_ECX) and (dest.index<>R_ECX) then
- begin
- reg8:=R_CL;
- reg32:=R_ECX;
- end;
- end;
- if swap then
- { was earlier XCHG, of course nonsense }
- begin
- {$ifndef noAllocEdi}
- getexplicitregister32(R_EDI);
- {$endif noAllocEdi}
- emit_reg_reg(A_MOV,S_L,reg32,R_EDI);
- end;
- emit_ref_reg(A_MOV,S_B,newreference(source),reg8);
- {$ifdef regallocfix}
- If delsource then
- del_reference(source);
- {$endif regallocfix}
- exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_B,reg8,newreference(dest))));
- if swap then
- begin
- emit_reg_reg(A_MOV,S_L,R_EDI,reg32);
- {$ifndef noAllocEdi}
- ungetregister32(R_EDI);
- {$endif noAllocEdi}
- end
- else
- ungetregister(reg8);
- end;
- end
- else
- begin
- {$ifndef noAllocEdi}
- getexplicitregister32(R_EDI);
- {$endif noAllocEdi}
- emit_ref_reg(A_LEA,S_L,newreference(dest),R_EDI);
- {$ifdef regallocfix}
- {is this ok?? (JM)}
- del_reference(dest);
- {$endif regallocfix}
- {$ifndef noAllocEdi}
- exprasmlist^.concat(new(pairegalloc,alloc(R_ESI)));
- {$endif noAllocEdi}
- if loadref then
- emit_ref_reg(A_MOV,S_L,newreference(source),R_ESI)
- else
- begin
- emit_ref_reg(A_LEA,S_L,newreference(source),R_ESI);
- {$ifdef regallocfix}
- if delsource then
- del_reference(source);
- {$endif regallocfix}
- end;
- exprasmlist^.concat(new(paicpu,op_none(A_CLD,S_NO)));
- ecxpushed:=false;
- if cs_littlesize in aktglobalswitches then
- begin
- maybepushecx;
- emit_const_reg(A_MOV,S_L,size,R_ECX);
- exprasmlist^.concat(new(paicpu,op_none(A_REP,S_NO)));
- exprasmlist^.concat(new(paicpu,op_none(A_MOVSB,S_NO)));
- end
- else
- begin
- helpsize:=size shr 2;
- size:=size and 3;
- if helpsize>1 then
- begin
- maybepushecx;
- emit_const_reg(A_MOV,S_L,helpsize,R_ECX);
- exprasmlist^.concat(new(paicpu,op_none(A_REP,S_NO)));
- end;
- if helpsize>0 then
- exprasmlist^.concat(new(paicpu,op_none(A_MOVSD,S_NO)));
- if size>1 then
- begin
- dec(size,2);
- exprasmlist^.concat(new(paicpu,op_none(A_MOVSW,S_NO)));
- end;
- if size=1 then
- exprasmlist^.concat(new(paicpu,op_none(A_MOVSB,S_NO)));
- end;
- {$ifndef noAllocEdi}
- ungetregister32(R_EDI);
- exprasmlist^.concat(new(pairegalloc,dealloc(R_ESI)));
- {$endif noAllocEdi}
- if ecxpushed then
- exprasmlist^.concat(new(paicpu,op_reg(A_POP,S_L,R_ECX)))
- else
- ungetregister32(R_ECX);
- { loading SELF-reference again }
- maybe_loadesi;
- end;
- if delsource then
- ungetiftemp(source);
- end;
- procedure emitloadord2reg(const location:Tlocation;orddef:Porddef;
- destreg:Tregister;delloc:boolean);
- {A lot smaller and less bug sensitive than the original unfolded loads.}
- var tai:Paicpu;
- r:Preference;
- begin
- tai := nil;
- case location.loc of
- LOC_REGISTER,LOC_CREGISTER:
- begin
- case orddef^.typ of
- u8bit:
- tai:=new(paicpu,op_reg_reg(A_MOVZX,S_BL,location.register,destreg));
- s8bit:
- tai:=new(paicpu,op_reg_reg(A_MOVSX,S_BL,location.register,destreg));
- u16bit:
- tai:=new(paicpu,op_reg_reg(A_MOVZX,S_WL,location.register,destreg));
- s16bit:
- tai:=new(paicpu,op_reg_reg(A_MOVSX,S_WL,location.register,destreg));
- u32bit,s32bit:
- if location.register <> destreg then
- tai:=new(paicpu,op_reg_reg(A_MOV,S_L,location.register,destreg));
- end;
- if delloc then
- ungetregister(location.register);
- end;
- LOC_MEM,
- LOC_REFERENCE:
- begin
- if location.reference.is_immediate then
- tai:=new(paicpu,op_const_reg(A_MOV,S_L,location.reference.offset,destreg))
- else
- begin
- r:=newreference(location.reference);
- case orddef^.typ of
- u8bit:
- tai:=new(paicpu,op_ref_reg(A_MOVZX,S_BL,r,destreg));
- s8bit:
- tai:=new(paicpu,op_ref_reg(A_MOVSX,S_BL,r,destreg));
- u16bit:
- tai:=new(paicpu,op_ref_reg(A_MOVZX,S_WL,r,destreg));
- s16bit:
- tai:=new(paicpu,op_ref_reg(A_MOVSX,S_WL,r,destreg));
- u32bit:
- tai:=new(paicpu,op_ref_reg(A_MOV,S_L,r,destreg));
- s32bit:
- tai:=new(paicpu,op_ref_reg(A_MOV,S_L,r,destreg));
- end;
- end;
- if delloc then
- del_reference(location.reference);
- end
- else
- internalerror(6);
- end;
- if assigned(tai) then
- exprasmlist^.concat(tai);
- end;
- { if necessary ESI is reloaded after a call}
- procedure maybe_loadesi;
- var
- hp : preference;
- p : pprocinfo;
- i : longint;
- begin
- if assigned(procinfo^._class) then
- begin
- {$ifndef noAllocEdi}
- exprasmlist^.concat(new(pairegalloc,alloc(R_ESI)));
- {$endif noAllocEdi}
- if lexlevel>normal_function_level then
- begin
- new(hp);
- reset_reference(hp^);
- hp^.offset:=procinfo^.framepointer_offset;
- hp^.base:=procinfo^.framepointer;
- emit_ref_reg(A_MOV,S_L,hp,R_ESI);
- p:=procinfo^.parent;
- for i:=3 to lexlevel-1 do
- begin
- new(hp);
- reset_reference(hp^);
- hp^.offset:=p^.framepointer_offset;
- hp^.base:=R_ESI;
- emit_ref_reg(A_MOV,S_L,hp,R_ESI);
- p:=p^.parent;
- end;
- new(hp);
- reset_reference(hp^);
- hp^.offset:=p^.selfpointer_offset;
- hp^.base:=R_ESI;
- emit_ref_reg(A_MOV,S_L,hp,R_ESI);
- end
- else
- begin
- new(hp);
- reset_reference(hp^);
- hp^.offset:=procinfo^.selfpointer_offset;
- hp^.base:=procinfo^.framepointer;
- emit_ref_reg(A_MOV,S_L,hp,R_ESI);
- end;
- end;
- end;
- { DO NOT RELY on the fact that the ptree is not yet swaped
- because of inlining code PM }
- procedure firstcomplex(p : ptree);
- var
- hp : ptree;
- begin
- { always calculate boolean AND and OR from left to right }
- if (p^.treetype in [orn,andn]) and
- (p^.left^.resulttype^.deftype=orddef) and
- (porddef(p^.left^.resulttype)^.typ in [bool8bit,bool16bit,bool32bit]) then
- begin
- { p^.swaped:=false}
- if p^.swaped then
- internalerror(234234);
- end
- else
- if (p^.left^.registers32<p^.right^.registers32) and
- { the following check is appropriate, because all }
- { 4 registers are rarely used and it is thereby }
- { achieved that the extra code is being dropped }
- { by exchanging not commutative operators }
- (p^.right^.registers32<=4) then
- begin
- hp:=p^.left;
- p^.left:=p^.right;
- p^.right:=hp;
- p^.swaped:=not p^.swaped;
- end;
- {else
- p^.swaped:=false; do not modify }
- end;
- {*****************************************************************************
- Entry/Exit Code Functions
- *****************************************************************************}
- procedure genprofilecode;
- var
- pl : pasmlabel;
- begin
- if (po_assembler in aktprocsym^.definition^.procoptions) then
- exit;
- case target_info.target of
- target_i386_freebsd,
- target_i386_linux:
- begin
- getaddrlabel(pl);
- emitcall('mcount');
- exprasmlist^.insert(new(paicpu,op_sym_ofs_reg(A_MOV,S_L,pl,0,R_EDX)));
- exprasmlist^.insert(new(pai_section,init(sec_code)));
- exprasmlist^.insert(new(pai_const,init_32bit(0)));
- exprasmlist^.insert(new(pai_label,init(pl)));
- exprasmlist^.insert(new(pai_align,init(4)));
- exprasmlist^.insert(new(pai_section,init(sec_data)));
- end;
- target_i386_go32v2:
- begin
- emitinsertcall('MCOUNT');
- end;
- end;
- end;
- procedure generate_interrupt_stackframe_entry;
- begin
- { save the registers of an interrupt procedure }
- exprasmlist^.insert(new(paicpu,op_reg(A_PUSH,S_L,R_EAX)));
- exprasmlist^.insert(new(paicpu,op_reg(A_PUSH,S_L,R_EBX)));
- exprasmlist^.insert(new(paicpu,op_reg(A_PUSH,S_L,R_ECX)));
- exprasmlist^.insert(new(paicpu,op_reg(A_PUSH,S_L,R_EDX)));
- exprasmlist^.insert(new(paicpu,op_reg(A_PUSH,S_L,R_ESI)));
- exprasmlist^.insert(new(paicpu,op_reg(A_PUSH,S_L,R_EDI)));
- { .... also the segment registers }
- exprasmlist^.insert(new(paicpu,op_reg(A_PUSH,S_W,R_DS)));
- exprasmlist^.insert(new(paicpu,op_reg(A_PUSH,S_W,R_ES)));
- exprasmlist^.insert(new(paicpu,op_reg(A_PUSH,S_W,R_FS)));
- exprasmlist^.insert(new(paicpu,op_reg(A_PUSH,S_W,R_GS)));
- end;
- procedure generate_interrupt_stackframe_exit;
- begin
- { restore the registers of an interrupt procedure }
- { this was all with entrycode instead of exitcode !!}
- procinfo^.aktexitcode^.concat(new(paicpu,op_reg(A_POP,S_L,R_EAX)));
- procinfo^.aktexitcode^.concat(new(paicpu,op_reg(A_POP,S_L,R_EBX)));
- procinfo^.aktexitcode^.concat(new(paicpu,op_reg(A_POP,S_L,R_ECX)));
- procinfo^.aktexitcode^.concat(new(paicpu,op_reg(A_POP,S_L,R_EDX)));
- procinfo^.aktexitcode^.concat(new(paicpu,op_reg(A_POP,S_L,R_ESI)));
- procinfo^.aktexitcode^.concat(new(paicpu,op_reg(A_POP,S_L,R_EDI)));
- { .... also the segment registers }
- procinfo^.aktexitcode^.concat(new(paicpu,op_reg(A_POP,S_W,R_DS)));
- procinfo^.aktexitcode^.concat(new(paicpu,op_reg(A_POP,S_W,R_ES)));
- procinfo^.aktexitcode^.concat(new(paicpu,op_reg(A_POP,S_W,R_FS)));
- procinfo^.aktexitcode^.concat(new(paicpu,op_reg(A_POP,S_W,R_GS)));
- { this restores the flags }
- procinfo^.aktexitcode^.concat(new(paicpu,op_none(A_IRET,S_NO)));
- end;
- { generates the code for threadvar initialisation }
- procedure initialize_threadvar(p : pnamedindexobject);{$ifndef FPC}far;{$endif}
- var
- hr : treference;
- begin
- if (psym(p)^.typ=varsym) and
- (vo_is_thread_var in pvarsym(p)^.varoptions) then
- begin
- exprasmlist^.concat(new(paicpu,op_const(A_PUSH,S_L,pvarsym(p)^.getsize)));
- reset_reference(hr);
- hr.symbol:=newasmsymbol(pvarsym(p)^.mangledname);
- emitpushreferenceaddr(hr);
- emitcall('FPC_INIT_THREADVAR');
- end;
- end;
- { initilizes data of type t }
- { if is_already_ref is true then the routines assumes }
- { that r points to the data to initialize }
- procedure initialize(t : pdef;const ref : treference;is_already_ref : boolean);
- var
- hr : treference;
- begin
- if is_ansistring(t) or
- is_widestring(t) then
- begin
- emit_const_ref(A_MOV,S_L,0,
- newreference(ref));
- end
- else
- begin
- reset_reference(hr);
- hr.symbol:=t^.get_inittable_label;
- emitpushreferenceaddr(hr);
- if is_already_ref then
- exprasmlist^.concat(new(paicpu,op_ref(A_PUSH,S_L,
- newreference(ref))))
- else
- emitpushreferenceaddr(ref);
- emitcall('FPC_INITIALIZE');
- end;
- end;
- { finalizes data of type t }
- { if is_already_ref is true then the routines assumes }
- { that r points to the data to finalizes }
- procedure finalize(t : pdef;const ref : treference;is_already_ref : boolean);
- var
- r : treference;
- begin
- if is_ansistring(t) or
- is_widestring(t) then
- begin
- decrstringref(t,ref);
- end
- else
- begin
- reset_reference(r);
- r.symbol:=t^.get_inittable_label;
- emitpushreferenceaddr(r);
- if is_already_ref then
- exprasmlist^.concat(new(paicpu,op_ref(A_PUSH,S_L,
- newreference(ref))))
- else
- emitpushreferenceaddr(ref);
- emitcall('FPC_FINALIZE');
- end;
- end;
- { generates the code for initialisation of local data }
- procedure initialize_data(p : pnamedindexobject);{$ifndef FPC}far;{$endif}
- var
- hr : treference;
- begin
- if (psym(p)^.typ=varsym) and
- assigned(pvarsym(p)^.vartype.def) and
- not((pvarsym(p)^.vartype.def^.deftype=objectdef) and
- pobjectdef(pvarsym(p)^.vartype.def)^.is_class) and
- pvarsym(p)^.vartype.def^.needs_inittable then
- begin
- if assigned(procinfo) then
- procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally;
- reset_reference(hr);
- if psym(p)^.owner^.symtabletype in [localsymtable,inlinelocalsymtable] then
- begin
- hr.base:=procinfo^.framepointer;
- hr.offset:=-pvarsym(p)^.address+pvarsym(p)^.owner^.address_fixup;
- end
- else
- begin
- hr.symbol:=newasmsymbol(pvarsym(p)^.mangledname);
- end;
- initialize(pvarsym(p)^.vartype.def,hr,false);
- end;
- end;
- { generates the code for incrementing the reference count of parameters }
- procedure incr_data(p : pnamedindexobject);{$ifndef FPC}far;{$endif}
- var
- hr : treference;
- begin
- if (psym(p)^.typ=varsym) and
- not((pvarsym(p)^.vartype.def^.deftype=objectdef) and
- pobjectdef(pvarsym(p)^.vartype.def)^.is_class) and
- pvarsym(p)^.vartype.def^.needs_inittable and
- (not assigned(pvarsym(p)^.localvarsym)) and
- ((pvarsym(p)^.varspez=vs_value) {or
- (pvarsym(p)^.varspez=vs_const) and
- not(dont_copy_const_param(pvarsym(p)^.definition))}) then
- begin
- procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally;
- reset_reference(hr);
- hr.symbol:=pvarsym(p)^.vartype.def^.get_inittable_label;
- emitpushreferenceaddr(hr);
- reset_reference(hr);
- hr.base:=procinfo^.framepointer;
- hr.offset:=pvarsym(p)^.address+procinfo^.para_offset;
- emitpushreferenceaddr(hr);
- reset_reference(hr);
- emitcall('FPC_ADDREF');
- end;
- end;
- { generates the code for finalisation of local data }
- procedure finalize_data(p : pnamedindexobject);{$ifndef FPC}far;{$endif}
- var
- hr : treference;
- begin
- if (psym(p)^.typ=varsym) and
- assigned(pvarsym(p)^.vartype.def) and
- not((pvarsym(p)^.vartype.def^.deftype=objectdef) and
- pobjectdef(pvarsym(p)^.vartype.def)^.is_class) and
- (not assigned(pvarsym(p)^.localvarsym)) and
- pvarsym(p)^.vartype.def^.needs_inittable then
- begin
- { not all kind of parameters need to be finalized }
- if (psym(p)^.owner^.symtabletype=parasymtable) and
- (pvarsym(p)^.varspez in [vs_out,vs_var,vs_const]) then
- exit;
- if assigned(procinfo) then
- procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally;
- reset_reference(hr);
- case psym(p)^.owner^.symtabletype of
- localsymtable,inlinelocalsymtable:
- begin
- hr.base:=procinfo^.framepointer;
- hr.offset:=-pvarsym(p)^.address+pvarsym(p)^.owner^.address_fixup;
- end;
- parasymtable,inlineparasymtable:
- begin
- hr.base:=procinfo^.framepointer;
- hr.offset:=pvarsym(p)^.address+procinfo^.para_offset;
- end;
- else
- hr.symbol:=newasmsymbol(pvarsym(p)^.mangledname);
- end;
- finalize(pvarsym(p)^.vartype.def,hr,false);
- end;
- end;
- { generates the code to make local copies of the value parameters }
- procedure copyvalueparas(p : pnamedindexobject);{$ifndef fpc}far;{$endif}
- var
- href1,href2 : treference;
- r : preference;
- power,len : longint;
- opsize : topsize;
- again,ok : pasmlabel;
- begin
- if (psym(p)^.typ=varsym) and
- (pvarsym(p)^.varspez=vs_value) and
- (push_addr_param(pvarsym(p)^.vartype.def)) then
- begin
- if is_open_array(pvarsym(p)^.vartype.def) or
- is_array_of_const(pvarsym(p)^.vartype.def) then
- begin
- { get stack space }
- new(r);
- reset_reference(r^);
- r^.base:=procinfo^.framepointer;
- r^.offset:=pvarsym(p)^.address+4+procinfo^.para_offset;
- {$ifndef noAllocEdi}
- getexplicitregister32(R_EDI);
- {$endif noAllocEdi}
- exprasmlist^.concat(new(paicpu,
- op_ref_reg(A_MOV,S_L,r,R_EDI)));
- exprasmlist^.concat(new(paicpu,
- op_reg(A_INC,S_L,R_EDI)));
- if (parraydef(pvarsym(p)^.vartype.def)^.elesize<>1) then
- begin
- if ispowerof2(parraydef(pvarsym(p)^.vartype.def)^.elesize, power) then
- exprasmlist^.concat(new(paicpu,
- op_const_reg(A_SHL,S_L,
- power,R_EDI)))
- else
- exprasmlist^.concat(new(paicpu,
- op_const_reg(A_IMUL,S_L,
- parraydef(pvarsym(p)^.vartype.def)^.elesize,R_EDI)));
- end;
- {$ifndef NOTARGETWIN32}
- { windows guards only a few pages for stack growing, }
- { so we have to access every page first }
- if target_os.id=os_i386_win32 then
- begin
- getlabel(again);
- getlabel(ok);
- emitlab(again);
- exprasmlist^.concat(new(paicpu,
- op_const_reg(A_CMP,S_L,winstackpagesize,R_EDI)));
- emitjmp(C_C,ok);
- exprasmlist^.concat(new(paicpu,
- op_const_reg(A_SUB,S_L,winstackpagesize-4,R_ESP)));
- exprasmlist^.concat(new(paicpu,
- op_reg(A_PUSH,S_L,R_EAX)));
- exprasmlist^.concat(new(paicpu,
- op_const_reg(A_SUB,S_L,winstackpagesize,R_EDI)));
- emitjmp(C_None,again);
- emitlab(ok);
- exprasmlist^.concat(new(paicpu,
- op_reg_reg(A_SUB,S_L,R_EDI,R_ESP)));
- {$ifndef noAllocEdi}
- ungetregister32(R_EDI);
- {$endif noAllocEdi}
- { now reload EDI }
- new(r);
- reset_reference(r^);
- r^.base:=procinfo^.framepointer;
- r^.offset:=pvarsym(p)^.address+4+procinfo^.para_offset;
- {$ifndef noAllocEdi}
- getexplicitregister32(R_EDI);
- {$endif noAllocEdi}
- exprasmlist^.concat(new(paicpu,
- op_ref_reg(A_MOV,S_L,r,R_EDI)));
- exprasmlist^.concat(new(paicpu,
- op_reg(A_INC,S_L,R_EDI)));
- if (parraydef(pvarsym(p)^.vartype.def)^.elesize<>1) then
- begin
- if ispowerof2(parraydef(pvarsym(p)^.vartype.def)^.elesize, power) then
- exprasmlist^.concat(new(paicpu,
- op_const_reg(A_SHL,S_L,
- power,R_EDI)))
- else
- exprasmlist^.concat(new(paicpu,
- op_const_reg(A_IMUL,S_L,
- parraydef(pvarsym(p)^.vartype.def)^.elesize,R_EDI)));
- end;
- end
- else
- {$endif NOTARGETWIN32}
- exprasmlist^.concat(new(paicpu,
- op_reg_reg(A_SUB,S_L,R_EDI,R_ESP)));
- { load destination }
- exprasmlist^.concat(new(paicpu,
- op_reg_reg(A_MOV,S_L,R_ESP,R_EDI)));
- { don't destroy the registers! }
- exprasmlist^.concat(new(paicpu,
- op_reg(A_PUSH,S_L,R_ECX)));
- exprasmlist^.concat(new(paicpu,
- op_reg(A_PUSH,S_L,R_ESI)));
- { load count }
- new(r);
- reset_reference(r^);
- r^.base:=procinfo^.framepointer;
- r^.offset:=pvarsym(p)^.address+4+procinfo^.para_offset;
- exprasmlist^.concat(new(paicpu,
- op_ref_reg(A_MOV,S_L,r,R_ECX)));
- { load source }
- new(r);
- reset_reference(r^);
- r^.base:=procinfo^.framepointer;
- r^.offset:=pvarsym(p)^.address+procinfo^.para_offset;
- exprasmlist^.concat(new(paicpu,
- op_ref_reg(A_MOV,S_L,r,R_ESI)));
- { scheduled .... }
- exprasmlist^.concat(new(paicpu,
- op_reg(A_INC,S_L,R_ECX)));
- { calculate size }
- len:=parraydef(pvarsym(p)^.vartype.def)^.elesize;
- opsize:=S_B;
- if (len and 3)=0 then
- begin
- opsize:=S_L;
- len:=len shr 2;
- end
- else
- if (len and 1)=0 then
- begin
- opsize:=S_W;
- len:=len shr 1;
- end;
- if ispowerof2(len, power) then
- exprasmlist^.concat(new(paicpu,
- op_const_reg(A_SHL,S_L,
- power,R_ECX)))
- else
- exprasmlist^.concat(new(paicpu,
- op_const_reg(A_IMUL,S_L,len,R_ECX)));
- exprasmlist^.concat(new(paicpu,
- op_none(A_REP,S_NO)));
- case opsize of
- S_B : exprasmlist^.concat(new(paicpu,op_none(A_MOVSB,S_NO)));
- S_W : exprasmlist^.concat(new(paicpu,op_none(A_MOVSW,S_NO)));
- S_L : exprasmlist^.concat(new(paicpu,op_none(A_MOVSD,S_NO)));
- end;
- {$ifndef noAllocEdi}
- ungetregister32(R_EDI);
- {$endif noAllocEdi}
- exprasmlist^.concat(new(paicpu,
- op_reg(A_POP,S_L,R_ESI)));
- exprasmlist^.concat(new(paicpu,
- op_reg(A_POP,S_L,R_ECX)));
- { patch the new address }
- new(r);
- reset_reference(r^);
- r^.base:=procinfo^.framepointer;
- r^.offset:=pvarsym(p)^.address+procinfo^.para_offset;
- exprasmlist^.concat(new(paicpu,
- op_reg_ref(A_MOV,S_L,R_ESP,r)));
- end
- else
- if is_shortstring(pvarsym(p)^.vartype.def) then
- begin
- reset_reference(href1);
- href1.base:=procinfo^.framepointer;
- href1.offset:=pvarsym(p)^.address+procinfo^.para_offset;
- reset_reference(href2);
- href2.base:=procinfo^.framepointer;
- href2.offset:=-pvarsym(p)^.localvarsym^.address+pvarsym(p)^.localvarsym^.owner^.address_fixup;
- copyshortstring(href2,href1,pstringdef(pvarsym(p)^.vartype.def)^.len,true,false);
- end
- else
- begin
- reset_reference(href1);
- href1.base:=procinfo^.framepointer;
- href1.offset:=pvarsym(p)^.address+procinfo^.para_offset;
- reset_reference(href2);
- href2.base:=procinfo^.framepointer;
- href2.offset:=-pvarsym(p)^.localvarsym^.address+pvarsym(p)^.localvarsym^.owner^.address_fixup;
- concatcopy(href1,href2,pvarsym(p)^.vartype.def^.size,true,true);
- end;
- end;
- end;
- procedure inittempansistrings;
- var
- hp : ptemprecord;
- r : preference;
- begin
- hp:=templist;
- while assigned(hp) do
- begin
- if hp^.temptype in [tt_ansistring,tt_freeansistring] then
- begin
- procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally;
- new(r);
- reset_reference(r^);
- r^.base:=procinfo^.framepointer;
- r^.offset:=hp^.pos;
- emit_const_ref(A_MOV,S_L,0,r);
- end;
- hp:=hp^.next;
- end;
- end;
- procedure finalizetempansistrings;
- var
- hp : ptemprecord;
- hr : treference;
- begin
- hp:=templist;
- while assigned(hp) do
- begin
- if hp^.temptype in [tt_ansistring,tt_freeansistring] then
- begin
- procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally;
- reset_reference(hr);
- hr.base:=procinfo^.framepointer;
- hr.offset:=hp^.pos;
- emitpushreferenceaddr(hr);
- emitcall('FPC_ANSISTR_DECR_REF');
- end;
- hp:=hp^.next;
- end;
- end;
- var
- ls : longint;
- procedure largest_size(p : pnamedindexobject);{$ifndef FPC}far;{$endif}
- begin
- if (psym(p)^.typ=varsym) and
- (pvarsym(p)^.getvaluesize>ls) then
- ls:=pvarsym(p)^.getvaluesize;
- end;
- procedure alignstack(alist : paasmoutput);
- begin
- {$ifdef dummy}
- if (cs_optimize in aktglobalswitches) and
- (aktoptprocessor in [classp5,classp6]) then
- begin
- ls:=0;
- aktprocsym^.definition^.localst^.foreach({$ifndef TP}@{$endif}largest_size);
- if ls>=8 then
- alist^.insert(new(paicpu,op_const_reg(A_AND,S_L,-8,R_ESP)));
- end;
- {$endif dummy}
- end;
- procedure genentrycode(alist : paasmoutput;const proc_names:Tstringcontainer;make_global:boolean;
- stackframe:longint;
- var parasize:longint;var nostackframe:boolean;
- inlined : boolean);
- {
- Generates the entry code for a procedure
- }
- var
- hs : string;
- {$ifdef GDB}
- stab_function_name : Pai_stab_function_name;
- {$endif GDB}
- hr : preference;
- p : psymtable;
- r : treference;
- oldlist,
- oldexprasmlist : paasmoutput;
- again : pasmlabel;
- i : longint;
- begin
- oldexprasmlist:=exprasmlist;
- exprasmlist:=alist;
- if (not inlined) and (aktprocsym^.definition^.proctypeoption=potype_proginit) then
- begin
- emitinsertcall('FPC_INITIALIZEUNITS');
- if target_info.target=target_I386_WIN32 then
- begin
- new(hr);
- reset_reference(hr^);
- hr^.symbol:=newasmsymbol(
- 'U_SYSWIN32_ISCONSOLE');
- if apptype=at_cui then
- exprasmlist^.insert(new(paicpu,op_const_ref(A_MOV,S_B,
- 1,hr)))
- else
- exprasmlist^.insert(new(paicpu,op_const_ref(A_MOV,S_B,
- 0,hr)));
- end;
- oldlist:=exprasmlist;
- exprasmlist:=new(paasmoutput,init);
- p:=symtablestack;
- while assigned(p) do
- begin
- p^.foreach({$ifndef TP}@{$endif}initialize_threadvar);
- p:=p^.next;
- end;
- oldlist^.insertlist(exprasmlist);
- dispose(exprasmlist,done);
- exprasmlist:=oldlist;
- end;
- {$ifdef GDB}
- if (not inlined) and (cs_debuginfo in aktmoduleswitches) then
- exprasmlist^.insert(new(pai_force_line,init));
- {$endif GDB}
- { a constructor needs a help procedure }
- if (aktprocsym^.definition^.proctypeoption=potype_constructor) then
- begin
- if procinfo^._class^.is_class then
- begin
- procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally;
- exprasmlist^.insert(new(paicpu,op_cond_sym(A_Jcc,C_Z,S_NO,faillabel)));
- emitinsertcall('FPC_NEW_CLASS');
- end
- else
- begin
- exprasmlist^.insert(new(paicpu,op_cond_sym(A_Jcc,C_Z,S_NO,faillabel)));
- emitinsertcall('FPC_HELP_CONSTRUCTOR');
- {$ifndef noAllocEdi}
- getexplicitregister32(R_EDI);
- {$endif noAllocEdi}
- exprasmlist^.insert(new(paicpu,op_const_reg(A_MOV,S_L,procinfo^._class^.vmt_offset,R_EDI)));
- end;
- end;
- { don't load ESI, does the caller }
- { we must do it for local function }
- { that can be called from a foreach }
- { of another object than self !! PM }
- if assigned(procinfo^._class) and
- (lexlevel>normal_function_level) then
- maybe_loadesi;
- { When message method contains self as a parameter,
- we must load it into ESI }
- If (po_containsself in aktprocsym^.definition^.procoptions) then
- begin
- new(hr);
- reset_reference(hr^);
- hr^.offset:=procinfo^.selfpointer_offset;
- hr^.base:=procinfo^.framepointer;
- exprasmlist^.insert(new(paicpu,op_ref_reg(A_MOV,S_L,hr,R_ESI)));
- {$ifndef noAllocEdi}
- exprasmlist^.insert(new(pairegalloc,alloc(R_ESI)));
- {$endif noAllocEdi}
- end;
- { should we save edi,esi,ebx like C ? }
- if (po_savestdregs in aktprocsym^.definition^.procoptions) then
- begin
- if (aktprocsym^.definition^.usedregisters and ($80 shr byte(R_EBX)))<>0 then
- exprasmlist^.insert(new(paicpu,op_reg(A_PUSH,S_L,R_EBX)));
- exprasmlist^.insert(new(paicpu,op_reg(A_PUSH,S_L,R_ESI)));
- exprasmlist^.insert(new(paicpu,op_reg(A_PUSH,S_L,R_EDI)));
- end;
- { for the save all registers we can simply use a pusha,popa which
- push edi,esi,ebp,esp(ignored),ebx,edx,ecx,eax }
- if (po_saveregisters in aktprocsym^.definition^.procoptions) then
- begin
- exprasmlist^.insert(new(paicpu,op_none(A_PUSHA,S_L)));
- end;
- { omit stack frame ? }
- if not inlined then
- if procinfo^.framepointer=stack_pointer then
- begin
- CGMessage(cg_d_stackframe_omited);
- nostackframe:=true;
- if (aktprocsym^.definition^.proctypeoption in [potype_unitinit,potype_proginit,potype_unitfinalize]) then
- parasize:=0
- else
- parasize:=aktprocsym^.definition^.parast^.datasize+procinfo^.para_offset-4;
- if stackframe<>0 then
- exprasmlist^.insert(new(paicpu,
- op_const_reg(A_SUB,S_L,stackframe,R_ESP)));
- end
- else
- begin
- alignstack(alist);
- if (aktprocsym^.definition^.proctypeoption in [potype_unitinit,potype_proginit,potype_unitfinalize]) then
- parasize:=0
- else
- parasize:=aktprocsym^.definition^.parast^.datasize+procinfo^.para_offset-8;
- nostackframe:=false;
- if stackframe<>0 then
- begin
- {$ifdef unused}
- if (cs_littlesize in aktglobalswitches) and (stackframe<=65535) then
- begin
- if (cs_check_stack in aktlocalswitches) and
- not(target_info.target in [target_386_freebsd,
- target_i386_linux,target_i386_win32]) then
- begin
- emitinsertcall('FPC_STACKCHECK');
- exprasmlist^.insert(new(paicpu,op_const(A_PUSH,S_L,stackframe)));
- end;
- if cs_profile in aktmoduleswitches then
- genprofilecode;
- { %edi is already saved when pocdecl is used
- if ((target_info.target=target_linux) or (target_info.target=target_freebsd)) and
- ((aktprocsym^.definition^.options and poexports)<>0) then
- exprasmlist^.insert(new(Paicpu,op_reg(A_PUSH,S_L,R_EDI))); }
- { ATTENTION:
- never use ENTER in linux !!! (or freebsd MvdV)
- the stack page fault does not support it PM }
- exprasmlist^.insert(new(paicpu,op_const_const(A_ENTER,S_NO,stackframe,0)))
- end
- else
- {$endif unused}
- begin
- { windows guards only a few pages for stack growing, }
- { so we have to access every page first }
- if (target_os.id=os_i386_win32) and
- (stackframe>=winstackpagesize) then
- begin
- if stackframe div winstackpagesize<=5 then
- begin
- exprasmlist^.insert(new(paicpu,op_const_reg(A_SUB,S_L,stackframe-4,R_ESP)));
- for i:=1 to stackframe div winstackpagesize do
- begin
- hr:=new_reference(R_ESP,stackframe-i*winstackpagesize);
- exprasmlist^.concat(new(paicpu,
- op_const_ref(A_MOV,S_L,0,hr)));
- end;
- exprasmlist^.concat(new(paicpu,
- op_reg(A_PUSH,S_L,R_EAX)));
- end
- else
- begin
- getlabel(again);
- {$ifndef noAllocEdi}
- getexplicitregister32(R_EDI);
- {$endif noAllocEdi}
- exprasmlist^.concat(new(paicpu,
- op_const_reg(A_MOV,S_L,stackframe div winstackpagesize,R_EDI)));
- emitlab(again);
- exprasmlist^.concat(new(paicpu,
- op_const_reg(A_SUB,S_L,winstackpagesize-4,R_ESP)));
- exprasmlist^.concat(new(paicpu,
- op_reg(A_PUSH,S_L,R_EAX)));
- exprasmlist^.concat(new(paicpu,
- op_reg(A_DEC,S_L,R_EDI)));
- emitjmp(C_NZ,again);
- {$ifndef noAllocEdi}
- ungetregister32(R_EDI);
- {$endif noAllocEdi}
- exprasmlist^.concat(new(paicpu,
- op_const_reg(A_SUB,S_L,stackframe mod winstackpagesize,R_ESP)));
- end
- end
- else
- exprasmlist^.insert(new(paicpu,op_const_reg(A_SUB,S_L,stackframe,R_ESP)));
- if (cs_check_stack in aktlocalswitches) and
- not(target_info.target in [target_i386_freebsd,
- target_i386_linux,target_i386_win32]) then
- begin
- emitinsertcall('FPC_STACKCHECK');
- exprasmlist^.insert(new(paicpu,op_const(A_PUSH,S_L,stackframe)));
- end;
- if cs_profile in aktmoduleswitches then
- genprofilecode;
- exprasmlist^.insert(new(paicpu,op_reg_reg(A_MOV,S_L,R_ESP,R_EBP)));
- exprasmlist^.insert(new(paicpu,op_reg(A_PUSH,S_L,R_EBP)));
- end;
- end { endif stackframe <> 0 }
- else
- begin
- if cs_profile in aktmoduleswitches then
- genprofilecode;
- exprasmlist^.insert(new(paicpu,op_reg_reg(A_MOV,S_L,R_ESP,R_EBP)));
- exprasmlist^.insert(new(paicpu,op_reg(A_PUSH,S_L,R_EBP)));
- end;
- end;
- if (po_interrupt in aktprocsym^.definition^.procoptions) then
- generate_interrupt_stackframe_entry;
- { initialize return value }
- if (procinfo^.returntype.def<>pdef(voiddef)) and
- (procinfo^.returntype.def^.needs_inittable) and
- ((procinfo^.returntype.def^.deftype<>objectdef) or
- not(pobjectdef(procinfo^.returntype.def)^.is_class)) then
- begin
- procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally;
- reset_reference(r);
- r.offset:=procinfo^.return_offset;
- r.base:=procinfo^.framepointer;
- initialize(procinfo^.returntype.def,r,ret_in_param(procinfo^.returntype.def));
- end;
- { initialisize local data like ansistrings }
- case aktprocsym^.definition^.proctypeoption of
- potype_unitinit:
- begin
- { using current_module^.globalsymtable is hopefully }
- { more robust than symtablestack and symtablestack^.next }
- psymtable(current_module^.globalsymtable)^.foreach({$ifndef TP}@{$endif}initialize_data);
- psymtable(current_module^.localsymtable)^.foreach({$ifndef TP}@{$endif}initialize_data);
- end;
- { units have seperate code for initilization and finalization }
- potype_unitfinalize: ;
- else
- aktprocsym^.definition^.localst^.foreach({$ifndef TP}@{$endif}initialize_data);
- end;
- { generate copies of call by value parameters }
- if not(po_assembler in aktprocsym^.definition^.procoptions) and
- not (pocall_cdecl in aktprocsym^.definition^.proccalloptions) then
- aktprocsym^.definition^.parast^.foreach({$ifndef TP}@{$endif}copyvalueparas);
- { add a reference to all call by value/const parameters }
- aktprocsym^.definition^.parast^.foreach({$ifndef TP}@{$endif}incr_data);
- { initialisizes temp. ansi/wide string data }
- inittempansistrings;
- { do we need an exception frame because of ansi/widestrings ? }
- if not inlined and
- ((procinfo^.flags and pi_needs_implicit_finally)<>0) and
- { but it's useless in init/final code of units }
- not(aktprocsym^.definition^.proctypeoption in [potype_unitfinalize,potype_unitinit]) then
- begin
- usedinproc:=usedinproc or ($80 shr byte(R_EAX));
- { Type of stack-frame must be pushed}
- exprasmlist^.concat(new(paicpu,op_const(A_PUSH,S_L,1)));
- emitcall('FPC_PUSHEXCEPTADDR');
- exprasmlist^.concat(new(paicpu,
- op_reg(A_PUSH,S_L,R_EAX)));
- emitcall('FPC_SETJMP');
- exprasmlist^.concat(new(paicpu,
- op_reg(A_PUSH,S_L,R_EAX)));
- exprasmlist^.concat(new(paicpu,
- op_reg_reg(A_TEST,S_L,R_EAX,R_EAX)));
- emitjmp(C_NE,aktexitlabel);
- { probably we've to reload self here }
- maybe_loadesi;
- end;
- if not inlined then
- begin
- if (cs_profile in aktmoduleswitches) or
- (aktprocsym^.definition^.owner^.symtabletype=globalsymtable) or
- (assigned(procinfo^._class) and (procinfo^._class^.owner^.symtabletype=globalsymtable)) then
- make_global:=true;
- hs:=proc_names.get;
- {$ifdef GDB}
- if (cs_debuginfo in aktmoduleswitches) and target_os.use_function_relative_addresses then
- stab_function_name := new(pai_stab_function_name,init(strpnew(hs)));
- {$EndIf GDB}
- while hs<>'' do
- begin
- if make_global then
- exprasmlist^.insert(new(pai_symbol,initname_global(hs,0)))
- else
- exprasmlist^.insert(new(pai_symbol,initname(hs,0)));
- {$ifdef GDB}
- if (cs_debuginfo in aktmoduleswitches) and
- target_os.use_function_relative_addresses then
- exprasmlist^.insert(new(pai_stab_function_name,init(strpnew(hs))));
- {$endif GDB}
- hs:=proc_names.get;
- end;
- if make_global or ((procinfo^.flags and pi_is_global) <> 0) then
- aktprocsym^.is_global := True;
- {$ifdef GDB}
- if (cs_debuginfo in aktmoduleswitches) then
- begin
- if target_os.use_function_relative_addresses then
- exprasmlist^.insert(stab_function_name);
- exprasmlist^.insert(new(pai_stabs,init(aktprocsym^.stabstring)));
- aktprocsym^.isstabwritten:=true;
- end;
- {$endif GDB}
- { Align, gprof uses 16 byte granularity }
- if (cs_profile in aktmoduleswitches) then
- exprasmlist^.insert(new(pai_align,init_op(16,$90)))
- else
- if not(cs_littlesize in aktglobalswitches) then
- exprasmlist^.insert(new(pai_align,init(16)));
- end;
- if inlined then
- load_regvars(exprasmlist,nil);
- exprasmlist:=oldexprasmlist;
- end;
- procedure handle_return_value(inlined : boolean;var uses_eax,uses_edx : boolean);
- var
- hr : preference;
- op : Tasmop;
- s : Topsize;
- begin
- uses_eax:=false;
- uses_edx:=false;
- if procinfo^.returntype.def<>pdef(voiddef) then
- begin
- {if ((procinfo^.flags and pi_operator)<>0) and
- assigned(opsym) then
- procinfo^.funcret_is_valid:=
- procinfo^.funcret_is_valid or (opsym^.refs>0);}
- if (procinfo^.funcret_state<>vs_assigned) and not inlined { and
- ((procinfo^.flags and pi_uses_asm)=0)} then
- CGMessage(sym_w_function_result_not_set);
- hr:=new_reference(procinfo^.framepointer,procinfo^.return_offset);
- if (procinfo^.returntype.def^.deftype in [orddef,enumdef]) then
- begin
- uses_eax:=true;
- case procinfo^.returntype.def^.size of
- 8:
- begin
- emit_ref_reg(A_MOV,S_L,hr,R_EAX);
- hr:=new_reference(procinfo^.framepointer,procinfo^.return_offset+4);
- emit_ref_reg(A_MOV,S_L,hr,R_EDX);
- uses_edx:=true;
- end;
- 4:
- emit_ref_reg(A_MOV,S_L,hr,R_EAX);
- 2:
- emit_ref_reg(A_MOV,S_W,hr,R_AX);
- 1:
- emit_ref_reg(A_MOV,S_B,hr,R_AL);
- end;
- end
- else
- if ret_in_acc(procinfo^.returntype.def) then
- begin
- uses_eax:=true;
- emit_ref_reg(A_MOV,S_L,hr,R_EAX);
- end
- else
- if (procinfo^.returntype.def^.deftype=floatdef) then
- begin
- floatloadops(pfloatdef(procinfo^.returntype.def)^.typ,op,s);
- exprasmlist^.concat(new(paicpu,op_ref(op,s,hr)))
- end
- else
- dispose(hr);
- end
- end;
- procedure genexitcode(alist : paasmoutput;parasize:longint;nostackframe,inlined:boolean);
- var
- {$ifdef GDB}
- mangled_length : longint;
- p : pchar;
- {$endif GDB}
- nofinal,okexitlabel,noreraiselabel,nodestroycall : pasmlabel;
- hr : treference;
- uses_eax,uses_edx,uses_esi : boolean;
- oldexprasmlist : paasmoutput;
- ai : paicpu;
- pd : pprocdef;
- begin
- oldexprasmlist:=exprasmlist;
- exprasmlist:=alist;
- if aktexitlabel^.is_used then
- exprasmlist^.insert(new(pai_label,init(aktexitlabel)));
- { call the destructor help procedure }
- if (aktprocsym^.definition^.proctypeoption=potype_destructor) and
- assigned(procinfo^._class) then
- begin
- if procinfo^._class^.is_class then
- begin
- emitinsertcall('FPC_DISPOSE_CLASS');
- end
- else
- begin
- emitinsertcall('FPC_HELP_DESTRUCTOR');
- {$ifndef noAllocEdi}
- getexplicitregister32(R_EDI);
- {$endif noAllocEdi}
- exprasmlist^.insert(new(paicpu,op_const_reg(A_MOV,S_L,procinfo^._class^.vmt_offset,R_EDI)));
- { must the object be finalized ? }
- if procinfo^._class^.needs_inittable then
- begin
- getlabel(nofinal);
- exprasmlist^.insert(new(pai_label,init(nofinal)));
- emitinsertcall('FPC_FINALIZE');
- {$ifndef noAllocEdi}
- ungetregister32(R_EDI);
- {$endif noAllocEdi}
- exprasmlist^.insert(new(paicpu,op_reg(A_PUSH,S_L,R_ESI)));
- exprasmlist^.insert(new(paicpu,op_sym(A_PUSH,S_L,procinfo^._class^.get_inittable_label)));
- ai:=new(paicpu,op_sym(A_Jcc,S_NO,nofinal));
- ai^.SetCondition(C_Z);
- exprasmlist^.insert(ai);
- reset_reference(hr);
- hr.base:=R_EBP;
- hr.offset:=8;
- exprasmlist^.insert(new(paicpu,op_const_ref(A_CMP,S_L,0,newreference(hr))));
- end;
- end;
- end;
- { finalize temporary data }
- finalizetempansistrings;
- { finalize local data like ansistrings}
- case aktprocsym^.definition^.proctypeoption of
- potype_unitfinalize:
- begin
- { using current_module^.globalsymtable is hopefully }
- { more robust than symtablestack and symtablestack^.next }
- psymtable(current_module^.globalsymtable)^.foreach({$ifndef TP}@{$endif}finalize_data);
- psymtable(current_module^.localsymtable)^.foreach({$ifndef TP}@{$endif}finalize_data);
- end;
- { units have seperate code for initialization and finalization }
- potype_unitinit: ;
- else
- aktprocsym^.definition^.localst^.foreach({$ifndef TP}@{$endif}finalize_data);
- end;
- { finalize paras data }
- if assigned(aktprocsym^.definition^.parast) then
- aktprocsym^.definition^.parast^.foreach({$ifndef TP}@{$endif}finalize_data);
- { do we need to handle exceptions because of ansi/widestrings ? }
- if not inlined and
- ((procinfo^.flags and pi_needs_implicit_finally)<>0) and
- { but it's useless in init/final code of units }
- not(aktprocsym^.definition^.proctypeoption in [potype_unitfinalize,potype_unitinit]) then
- begin
- { the exception helper routines modify all registers }
- aktprocsym^.definition^.usedregisters:=$ff;
- getlabel(noreraiselabel);
- emitcall('FPC_POPADDRSTACK');
- exprasmlist^.concat(new(paicpu,
- op_reg(A_POP,S_L,R_EAX)));
- exprasmlist^.concat(new(paicpu,
- op_reg_reg(A_TEST,S_L,R_EAX,R_EAX)));
- emitjmp(C_E,noreraiselabel);
- if (aktprocsym^.definition^.proctypeoption=potype_constructor) then
- begin
- if assigned(procinfo^._class) then
- begin
- pd:=procinfo^._class^.searchdestructor;
- if assigned(pd) then
- begin
- getlabel(nodestroycall);
- emit_const_ref(A_CMP,S_L,0,new_reference(procinfo^.framepointer,
- procinfo^.selfpointer_offset));
- emitjmp(C_E,nodestroycall);
- if procinfo^._class^.is_class then
- begin
- emit_const(A_PUSH,S_L,1);
- emit_reg(A_PUSH,S_L,R_ESI);
- end
- else
- begin
- emit_reg(A_PUSH,S_L,R_ESI);
- emit_sym(A_PUSH,S_L,newasmsymbol(procinfo^._class^.vmt_mangledname));
- end;
- if (po_virtualmethod in pd^.procoptions) then
- begin
- emit_ref_reg(A_MOV,S_L,new_reference(R_ESI,0),R_EDI);
- emit_ref(A_CALL,S_NO,new_reference(R_EDI,procinfo^._class^.vmtmethodoffset(pd^.extnumber)));
- end
- else
- emitcall(pd^.mangledname);
- { not necessary because the result is never assigned in the
- case of an exception (FK)
- emit_const_reg(A_MOV,S_L,0,R_ESI);
- emit_const_ref(A_MOV,S_L,0,new_reference(procinfo^.framepointer,8));
- }
- emitlab(nodestroycall);
- end;
- end
- end
- else
- { must be the return value finalized before reraising the exception? }
- if (procinfo^.returntype.def<>pdef(voiddef)) and
- (procinfo^.returntype.def^.needs_inittable) and
- ((procinfo^.returntype.def^.deftype<>objectdef) or
- not(pobjectdef(procinfo^.returntype.def)^.is_class)) then
- begin
- reset_reference(hr);
- hr.offset:=procinfo^.return_offset;
- hr.base:=procinfo^.framepointer;
- finalize(procinfo^.returntype.def,hr,ret_in_param(procinfo^.returntype.def));
- end;
- emitcall('FPC_RERAISE');
- emitlab(noreraiselabel);
- end;
- { call __EXIT for main program }
- if (not DLLsource) and (not inlined) and (aktprocsym^.definition^.proctypeoption=potype_proginit) then
- begin
- emitcall('FPC_DO_EXIT');
- end;
- { handle return value }
- uses_eax:=false;
- uses_edx:=false;
- uses_esi:=false;
- if not(po_assembler in aktprocsym^.definition^.procoptions) then
- if (aktprocsym^.definition^.proctypeoption<>potype_constructor) then
- handle_return_value(inlined,uses_eax,uses_edx)
- else
- begin
- { successful constructor deletes the zero flag }
- { and returns self in eax }
- { eax must be set to zero if the allocation failed !!! }
- getlabel(okexitlabel);
- emitjmp(C_NONE,okexitlabel);
- emitlab(faillabel);
- if procinfo^._class^.is_class then
- begin
- emit_ref_reg(A_MOV,S_L,new_reference(procinfo^.framepointer,8),R_ESI);
- emitcall('FPC_HELP_FAIL_CLASS');
- end
- else
- begin
- emit_ref_reg(A_MOV,S_L,new_reference(procinfo^.framepointer,12),R_ESI);
- {$ifndef noAllocEdi}
- getexplicitregister32(R_EDI);
- {$endif noAllocEdi}
- emit_const_reg(A_MOV,S_L,procinfo^._class^.vmt_offset,R_EDI);
- emitcall('FPC_HELP_FAIL');
- {$ifndef noAllocEdi}
- ungetregister32(R_EDI);
- {$endif noAllocEdi}
- end;
- emitlab(okexitlabel);
- emit_reg_reg(A_MOV,S_L,R_ESI,R_EAX);
- emit_reg_reg(A_TEST,S_L,R_ESI,R_ESI);
- uses_eax:=true;
- uses_esi:=true;
- end;
- { stabs uses the label also ! }
- if aktexit2label^.is_used or
- ((cs_debuginfo in aktmoduleswitches) and not inlined) then
- emitlab(aktexit2label);
- { gives problems for long mangled names }
- {list^.concat(new(pai_symbol,init(aktprocsym^.definition^.mangledname+'_end')));}
- { should we restore edi ? }
- { for all i386 gcc implementations }
- if (po_savestdregs in aktprocsym^.definition^.procoptions) then
- begin
- if (aktprocsym^.definition^.usedregisters and ($80 shr byte(R_EBX)))<>0 then
- exprasmlist^.concat(new(paicpu,op_reg(A_POP,S_L,R_EBX)));
- exprasmlist^.concat(new(paicpu,op_reg(A_POP,S_L,R_ESI)));
- exprasmlist^.concat(new(paicpu,op_reg(A_POP,S_L,R_EDI)));
- { here we could reset R_EBX
- but that is risky because it only works
- if genexitcode is called after genentrycode
- so lets skip this for the moment PM
- aktprocsym^.definition^.usedregisters:=
- aktprocsym^.definition^.usedregisters or not ($80 shr byte(R_EBX));
- }
- end;
- { for the save all registers we can simply use a pusha,popa which
- push edi,esi,ebp,esp(ignored),ebx,edx,ecx,eax }
- if (po_saveregisters in aktprocsym^.definition^.procoptions) then
- begin
- if uses_esi then
- exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,R_ESI,new_reference(R_ESP,4))));
- if uses_edx then
- exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,R_EDX,new_reference(R_ESP,20))));
- if uses_eax then
- exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,R_EAX,new_reference(R_ESP,28))));
- exprasmlist^.concat(new(paicpu,op_none(A_POPA,S_L)))
- end;
- if not(nostackframe) then
- begin
- if not inlined then
- exprasmlist^.concat(new(paicpu,op_none(A_LEAVE,S_NO)));
- end
- else
- begin
- if (gettempsize<>0) and not inlined then
- exprasmlist^.insert(new(paicpu,
- op_const_reg(A_ADD,S_L,gettempsize,R_ESP)));
- end;
- { parameters are limited to 65535 bytes because }
- { ret allows only imm16 }
- if (parasize>65535) and not(pocall_clearstack in aktprocsym^.definition^.proccalloptions) then
- CGMessage(cg_e_parasize_too_big);
- { at last, the return is generated }
- if not inlined then
- if (po_interrupt in aktprocsym^.definition^.procoptions) then
- begin
- if uses_esi then
- exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,R_ESI,new_reference(R_ESP,16))));
- if uses_edx then
- exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,R_EDX,new_reference(R_ESP,12))));
- if uses_eax then
- exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,R_EAX,new_reference(R_ESP,0))));
- generate_interrupt_stackframe_exit;
- end
- else
- begin
- {Routines with the poclearstack flag set use only a ret.}
- { also routines with parasize=0 }
- if (pocall_clearstack in aktprocsym^.definition^.proccalloptions) then
- begin
- {$ifndef OLD_C_STACK}
- { complex return values are removed from stack in C code PM }
- if ret_in_param(aktprocsym^.definition^.rettype.def) then
- exprasmlist^.concat(new(paicpu,op_const(A_RET,S_NO,4)))
- else
- {$endif not OLD_C_STACK}
- exprasmlist^.concat(new(paicpu,op_none(A_RET,S_NO)));
- end
- else if (parasize=0) then
- exprasmlist^.concat(new(paicpu,op_none(A_RET,S_NO)))
- else
- exprasmlist^.concat(new(paicpu,op_const(A_RET,S_NO,parasize)));
- end;
- if not inlined then
- exprasmlist^.concat(new(pai_symbol_end,initname(aktprocsym^.definition^.mangledname)));
- {$ifdef GDB}
- if (cs_debuginfo in aktmoduleswitches) and not inlined then
- begin
- aktprocsym^.concatstabto(exprasmlist);
- if assigned(procinfo^._class) then
- if (not assigned(procinfo^.parent) or
- not assigned(procinfo^.parent^._class)) then
- exprasmlist^.concat(new(pai_stabs,init(strpnew(
- '"$t:v'+procinfo^._class^.numberstring+'",'+
- tostr(N_PSYM)+',0,0,'+tostr(procinfo^.selfpointer_offset)))))
- else
- exprasmlist^.concat(new(pai_stabs,init(strpnew(
- '"$t:r*'+procinfo^._class^.numberstring+'",'+
- tostr(N_RSYM)+',0,0,'+tostr(GDB_i386index[R_ESI])))));
- { define calling EBP as pseudo local var PM }
- { this enables test if the function is a local one !! }
- if assigned(procinfo^.parent) and (lexlevel>normal_function_level) then
- exprasmlist^.concat(new(pai_stabs,init(strpnew(
- '"parent_ebp:'+voidpointerdef^.numberstring+'",'+
- tostr(N_LSYM)+',0,0,'+tostr(procinfo^.framepointer_offset)))));
- if (pdef(aktprocsym^.definition^.rettype.def) <> pdef(voiddef)) then
- begin
- if ret_in_param(aktprocsym^.definition^.rettype.def) then
- exprasmlist^.concat(new(pai_stabs,init(strpnew(
- '"'+aktprocsym^.name+':X*'+aktprocsym^.definition^.rettype.def^.numberstring+'",'+
- tostr(N_PSYM)+',0,0,'+tostr(procinfo^.return_offset)))))
- else
- exprasmlist^.concat(new(pai_stabs,init(strpnew(
- '"'+aktprocsym^.name+':X'+aktprocsym^.definition^.rettype.def^.numberstring+'",'+
- tostr(N_PSYM)+',0,0,'+tostr(procinfo^.return_offset)))));
- if (m_result in aktmodeswitches) then
- if ret_in_param(aktprocsym^.definition^.rettype.def) then
- exprasmlist^.concat(new(pai_stabs,init(strpnew(
- '"RESULT:X*'+aktprocsym^.definition^.rettype.def^.numberstring+'",'+
- tostr(N_PSYM)+',0,0,'+tostr(procinfo^.return_offset)))))
- else
- exprasmlist^.concat(new(pai_stabs,init(strpnew(
- '"RESULT:X'+aktprocsym^.definition^.rettype.def^.numberstring+'",'+
- tostr(N_PSYM)+',0,0,'+tostr(procinfo^.return_offset)))));
- end;
- mangled_length:=length(aktprocsym^.definition^.mangledname);
- getmem(p,2*mangled_length+50);
- strpcopy(p,'192,0,0,');
- strpcopy(strend(p),aktprocsym^.definition^.mangledname);
- if (target_os.use_function_relative_addresses) then
- begin
- strpcopy(strend(p),'-');
- strpcopy(strend(p),aktprocsym^.definition^.mangledname);
- end;
- exprasmlist^.concat(new(pai_stabn,init(strnew(p))));
- {list^.concat(new(pai_stabn,init(strpnew('192,0,0,'
- +aktprocsym^.definition^.mangledname))));
- p[0]:='2';p[1]:='2';p[2]:='4';
- strpcopy(strend(p),'_end');}
- strpcopy(p,'224,0,0,'+aktexit2label^.name);
- if (target_os.use_function_relative_addresses) then
- begin
- strpcopy(strend(p),'-');
- strpcopy(strend(p),aktprocsym^.definition^.mangledname);
- end;
- exprasmlist^.concatlist(withdebuglist);
- exprasmlist^.concat(new(pai_stabn,init(
- strnew(p))));
- { strpnew('224,0,0,'
- +aktprocsym^.definition^.mangledname+'_end'))));}
- freemem(p,2*mangled_length+50);
- end;
- {$endif GDB}
- if inlined then
- cleanup_regvars(exprasmlist);
- exprasmlist:=oldexprasmlist;
- end;
- procedure genimplicitunitfinal(alist : paasmoutput);
- begin
- { using current_module^.globalsymtable is hopefully }
- { more robust than symtablestack and symtablestack^.next }
- psymtable(current_module^.globalsymtable)^.foreach({$ifndef TP}@{$endif}finalize_data);
- psymtable(current_module^.localsymtable)^.foreach({$ifndef TP}@{$endif}finalize_data);
- exprasmlist^.insert(new(pai_symbol,initname_global('FINALIZE$$'+current_module^.modulename^,0)));
- exprasmlist^.insert(new(pai_symbol,initname_global(target_os.cprefix+current_module^.modulename^+'_finalize',0)));
- {$ifdef GDB}
- if (cs_debuginfo in aktmoduleswitches) and
- target_os.use_function_relative_addresses then
- exprasmlist^.insert(new(pai_stab_function_name,init(strpnew('FINALIZE$$'+current_module^.modulename^))));
- {$endif GDB}
- exprasmlist^.concat(new(paicpu,op_none(A_RET,S_NO)));
- alist^.concatlist(exprasmlist);
- end;
- procedure genimplicitunitinit(alist : paasmoutput);
- begin
- { using current_module^.globalsymtable is hopefully }
- { more robust than symtablestack and symtablestack^.next }
- psymtable(current_module^.globalsymtable)^.foreach({$ifndef TP}@{$endif}finalize_data);
- psymtable(current_module^.localsymtable)^.foreach({$ifndef TP}@{$endif}finalize_data);
- exprasmlist^.insert(new(pai_symbol,initname_global('INIT$$'+current_module^.modulename^,0)));
- exprasmlist^.insert(new(pai_symbol,initname_global(target_os.cprefix+current_module^.modulename^+'_init',0)));
- {$ifdef GDB}
- if (cs_debuginfo in aktmoduleswitches) and
- target_os.use_function_relative_addresses then
- exprasmlist^.insert(new(pai_stab_function_name,init(strpnew('INIT$$'+current_module^.modulename^))));
- {$endif GDB}
- exprasmlist^.concat(new(paicpu,op_none(A_RET,S_NO)));
- alist^.concatlist(exprasmlist);
- end;
- {$ifdef test_dest_loc}
- procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
- begin
- if (dest_loc.loc=LOC_CREGISTER) or (dest_loc.loc=LOC_REGISTER) then
- begin
- emit_reg_reg(A_MOV,s,reg,dest_loc.register);
- set_location(p^.location,dest_loc);
- in_dest_loc:=true;
- end
- else
- if (dest_loc.loc=LOC_REFERENCE) or (dest_loc.loc=LOC_MEM) then
- begin
- exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,s,reg,newreference(dest_loc.reference))));
- set_location(p^.location,dest_loc);
- in_dest_loc:=true;
- end
- else
- internalerror(20080);
- end;
- {$endif test_dest_loc}
- end.
- {
- $Log$
- Revision 1.15 2000-09-24 15:06:12 peter
- * use defines.inc
- Revision 1.14 2000/09/16 12:22:52 peter
- * freebsd support merged
- Revision 1.13 2000/08/27 16:11:49 peter
- * moved some util functions from globals,cobjects to cutils
- * splitted files into finput,fmodule
- Revision 1.12 2000/08/24 19:07:54 peter
- * don't initialize if localvarsym is set because that varsym will
- already be initialized
- * first initialize local data before copy of value para's (merged)
- Revision 1.11 2000/08/19 20:09:33 peter
- * check size after checking openarray in push_value_para (merged)
- Revision 1.10 2000/08/16 13:06:06 florian
- + support of 64 bit integer constants
- Revision 1.9 2000/08/10 18:42:03 peter
- * fixed for constants in emit_push_mem_size for go32v2 (merged)
- Revision 1.8 2000/08/07 11:29:40 jonas
- + emit_push_mem_size() which pushes a value in memory of a certain size
- * pushsetelement() and pushvaluepara() use this new procedure, because
- otherwise they could sometimes try to push data past the end of the
- heap, causing a crash
- (merged from fixes branch)
- Revision 1.7 2000/08/03 13:17:25 jonas
- + allow regvars to be used inside inlined procs, which required the
- following changes:
- + load regvars in genentrycode/free them in genexitcode (cgai386)
- * moved all regvar related code to new regvars unit
- + added pregvarinfo type to hcodegen
- + added regvarinfo field to tprocinfo (symdef/symdefh)
- * deallocate the regvars of the caller in secondprocinline before
- inlining the called procedure and reallocate them afterwards
- Revision 1.6 2000/08/02 08:05:04 jonas
- * fixed web bug1087
- * allocate R_ECX explicitely if it's used
- (merged from fixes branch)
- Revision 1.5 2000/07/27 09:25:05 jonas
- * moved locflags2reg() procedure from cg386add to cgai386
- + added locjump2reg() procedure to cgai386
- * fixed internalerror(2002) when the result of a case expression has
- LOC_JUMP
- (all merged from fixes branch)
- Revision 1.4 2000/07/21 15:14:02 jonas
- + added is_addr field for labels, if they are only used for getting the address
- (e.g. for io checks) and corresponding getaddrlabel() procedure
- Revision 1.3 2000/07/13 12:08:25 michael
- + patched to 1.1.0 with former 1.09patch from peter
- Revision 1.2 2000/07/13 11:32:37 michael
- + removed logs
- }
|