cgai386.pas 158 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999400040014002400340044005400640074008400940104011401240134014401540164017401840194020402140224023402440254026402740284029403040314032403340344035403640374038403940404041404240434044404540464047404840494050405140524053405440554056405740584059406040614062406340644065406640674068406940704071407240734074407540764077407840794080408140824083408440854086408740884089409040914092409340944095409640974098409941004101410241034104410541064107410841094110411141124113411441154116411741184119412041214122412341244125412641274128412941304131413241334134413541364137413841394140414141424143414441454146414741484149
  1. {
  2. $Id$
  3. Copyright (c) 1998-2000 by Florian Klaempfl
  4. Helper routines for the i386 code generator
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. unit cgai386;
  19. {$i defines.inc}
  20. interface
  21. uses
  22. cobjects,tree,
  23. cpubase,cpuasm,
  24. symconst,symtable,aasm;
  25. {$define TESTGETTEMP to store const that
  26. are written into temps for later release PM }
  27. function def_opsize(p1:pdef):topsize;
  28. function def2def_opsize(p1,p2:pdef):topsize;
  29. function def_getreg(p1:pdef):tregister;
  30. function makereg8(r:tregister):tregister;
  31. function makereg16(r:tregister):tregister;
  32. function makereg32(r:tregister):tregister;
  33. procedure locflags2reg(var l:tlocation;opsize:topsize);
  34. procedure locjump2reg(var l:tlocation;opsize:topsize; otl, ofl: pasmlabel);
  35. procedure emitlab(var l : pasmlabel);
  36. procedure emitjmp(c : tasmcond;var l : pasmlabel);
  37. procedure emit_flag2reg(flag:tresflags;hregister:tregister);
  38. procedure emit_none(i : tasmop;s : topsize);
  39. procedure emit_const(i : tasmop;s : topsize;c : longint);
  40. procedure emit_reg(i : tasmop;s : topsize;reg : tregister);
  41. procedure emit_ref(i : tasmop;s : topsize;ref : preference);
  42. procedure emit_const_reg(i : tasmop;s : topsize;c : longint;reg : tregister);
  43. procedure emit_const_ref(i : tasmop;s : topsize;c : longint;ref : preference);
  44. procedure emit_ref_reg(i : tasmop;s : topsize;ref : preference;reg : tregister);
  45. procedure emit_reg_ref(i : tasmop;s : topsize;reg : tregister;ref : preference);
  46. procedure emit_reg_reg(i : tasmop;s : topsize;reg1,reg2 : tregister);
  47. procedure emit_const_reg_reg(i : tasmop;s : topsize;c : longint;reg1,reg2 : tregister);
  48. procedure emit_reg_reg_reg(i : tasmop;s : topsize;reg1,reg2,reg3 : tregister);
  49. procedure emit_sym(i : tasmop;s : topsize;op : pasmsymbol);
  50. procedure emit_sym_ofs(i : tasmop;s : topsize;op : pasmsymbol;ofs : longint);
  51. procedure emit_sym_ofs_reg(i : tasmop;s : topsize;op : pasmsymbol;ofs:longint;reg : tregister);
  52. procedure emit_sym_ofs_ref(i : tasmop;s : topsize;op : pasmsymbol;ofs:longint;ref : preference);
  53. procedure emitcall(const routine:string);
  54. procedure emit_mov_loc_ref(const t:tlocation;const ref:treference;siz:topsize;freetemp:boolean);
  55. procedure emit_mov_loc_reg(const t:tlocation;reg:tregister);
  56. procedure emit_mov_ref_reg64(r : treference;rl,rh : tregister);
  57. procedure emit_lea_loc_ref(const t:tlocation;const ref:treference;freetemp:boolean);
  58. procedure emit_lea_loc_reg(const t:tlocation;reg:tregister;freetemp:boolean);
  59. procedure emit_push_loc(const t:tlocation);
  60. procedure emit_push_mem_size(const t: treference; size: longint);
  61. { pushes qword location to the stack }
  62. procedure emit_pushq_loc(const t : tlocation);
  63. procedure release_qword_loc(const t : tlocation);
  64. { remove non regvar registers in loc from regs (in the format }
  65. { pushusedregisters uses) }
  66. procedure remove_non_regvars_from_loc(const t: tlocation; var regs: byte);
  67. { releases the registers of a location }
  68. procedure release_loc(const t : tlocation);
  69. procedure emit_pushw_loc(const t:tlocation);
  70. procedure emit_push_lea_loc(const t:tlocation;freetemp:boolean);
  71. procedure emit_to_mem(var p:ptree);
  72. procedure emit_to_reg16(var hr:tregister);
  73. procedure emit_to_reg32(var hr:tregister);
  74. procedure emit_mov_reg_loc(reg: TRegister; const t:tlocation);
  75. procedure emit_movq_reg_loc(reghigh,reglow: TRegister;t:tlocation);
  76. procedure copyshortstring(const dref,sref : treference;len : byte;
  77. loadref, del_sref: boolean);
  78. procedure loadansistring(p : ptree);
  79. procedure finalize(t : pdef;const ref : treference;is_already_ref : boolean);
  80. procedure incrstringref(t : pdef;const ref : treference);
  81. procedure decrstringref(t : pdef;const ref : treference);
  82. function maybe_push(needed : byte;p : ptree;isint64 : boolean) : boolean;
  83. procedure push_int(l : longint);
  84. procedure emit_push_mem(const ref : treference);
  85. procedure emitpushreferenceaddr(const ref : treference);
  86. procedure pushsetelement(p : ptree);
  87. procedure restore(p : ptree;isint64 : boolean);
  88. procedure push_value_para(p:ptree;inlined,is_cdecl:boolean;
  89. para_offset:longint;alignment : longint);
  90. {$ifdef TEMPS_NOT_PUSH}
  91. { does the same as restore, but uses temp. space instead of pushing }
  92. function maybe_push(needed : byte;p : ptree;isint64 : boolean) : boolean;
  93. procedure restorefromtemp(p : ptree;isint64 : boolean);
  94. {$endif TEMPS_NOT_PUSH}
  95. procedure floatload(t : tfloattype;const ref : treference);
  96. procedure floatstore(t : tfloattype;const ref : treference);
  97. procedure floatloadops(t : tfloattype;var op : tasmop;var s : topsize);
  98. procedure floatstoreops(t : tfloattype;var op : tasmop;var s : topsize);
  99. procedure maybe_loadesi;
  100. procedure maketojumpbool(p : ptree);
  101. procedure emitloadord2reg(const location:Tlocation;orddef:Porddef;destreg:Tregister;delloc:boolean);
  102. procedure emitoverflowcheck(p:ptree);
  103. procedure emitrangecheck(p:ptree;todef:pdef);
  104. procedure concatcopy(source,dest : treference;size : longint;delsource : boolean;loadref:boolean);
  105. procedure firstcomplex(p : ptree);
  106. procedure genentrycode(alist : paasmoutput;const proc_names:Tstringcontainer;make_global:boolean;
  107. stackframe:longint;
  108. var parasize:longint;var nostackframe:boolean;
  109. inlined : boolean);
  110. procedure genexitcode(alist : paasmoutput;parasize:longint;
  111. nostackframe,inlined:boolean);
  112. { if a unit doesn't have a explicit init/final code, }
  113. { we've to generate one, if the units has ansistrings }
  114. { in the interface or implementation }
  115. procedure genimplicitunitfinal(alist : paasmoutput);
  116. procedure genimplicitunitinit(alist : paasmoutput);
  117. {$ifdef test_dest_loc}
  118. const
  119. { used to avoid temporary assignments }
  120. dest_loc_known : boolean = false;
  121. in_dest_loc : boolean = false;
  122. dest_loc_tree : ptree = nil;
  123. var
  124. dest_loc : tlocation;
  125. procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
  126. {$endif test_dest_loc}
  127. implementation
  128. uses
  129. {$ifdef delphi}
  130. sysutils,
  131. {$else}
  132. strings,
  133. {$endif}
  134. cutils,globtype,systems,globals,verbose,fmodule,types,pbase,
  135. tgeni386,temp_gen,hcodegen,ppu,regvars
  136. {$ifdef GDB}
  137. ,gdb
  138. {$endif}
  139. {$ifndef NOTARGETWIN32}
  140. ,t_win32
  141. {$endif}
  142. ;
  143. {*****************************************************************************
  144. Helpers
  145. *****************************************************************************}
  146. function def_opsize(p1:pdef):topsize;
  147. begin
  148. case p1^.size of
  149. 1 : def_opsize:=S_B;
  150. 2 : def_opsize:=S_W;
  151. 4 : def_opsize:=S_L;
  152. else
  153. internalerror(130820001);
  154. end;
  155. end;
  156. function def2def_opsize(p1,p2:pdef):topsize;
  157. var
  158. o1 : topsize;
  159. begin
  160. case p1^.size of
  161. 1 : o1:=S_B;
  162. 2 : o1:=S_W;
  163. 4 : o1:=S_L;
  164. { I don't know if we need it (FK) }
  165. 8 : o1:=S_L;
  166. else
  167. internalerror(130820002);
  168. end;
  169. if assigned(p2) then
  170. begin
  171. case p2^.size of
  172. 1 : o1:=S_B;
  173. 2 : begin
  174. if o1=S_B then
  175. o1:=S_BW
  176. else
  177. o1:=S_W;
  178. end;
  179. 4,8:
  180. begin
  181. case o1 of
  182. S_B : o1:=S_BL;
  183. S_W : o1:=S_WL;
  184. end;
  185. end;
  186. end;
  187. end;
  188. def2def_opsize:=o1;
  189. end;
  190. function def_getreg(p1:pdef):tregister;
  191. begin
  192. case p1^.size of
  193. 1 : def_getreg:=reg32toreg8(getregister32);
  194. 2 : def_getreg:=reg32toreg16(getregister32);
  195. 4 : def_getreg:=getregister32;
  196. else
  197. internalerror(130820003);
  198. end;
  199. end;
  200. function makereg8(r:tregister):tregister;
  201. begin
  202. case r of
  203. R_EAX,R_EBX,R_ECX,R_EDX,R_EDI,R_ESI,R_ESP :
  204. makereg8:=reg32toreg8(r);
  205. R_AX,R_BX,R_CX,R_DX,R_DI,R_SI,R_SP :
  206. makereg8:=reg16toreg8(r);
  207. R_AL,R_BL,R_CL,R_DL :
  208. makereg8:=r;
  209. end;
  210. end;
  211. function makereg16(r:tregister):tregister;
  212. begin
  213. case r of
  214. R_EAX,R_EBX,R_ECX,R_EDX,R_EDI,R_ESI,R_ESP :
  215. makereg16:=reg32toreg16(r);
  216. R_AX,R_BX,R_CX,R_DX,R_DI,R_SI,R_SP :
  217. makereg16:=r;
  218. R_AL,R_BL,R_CL,R_DL :
  219. makereg16:=reg8toreg16(r);
  220. end;
  221. end;
  222. function makereg32(r:tregister):tregister;
  223. begin
  224. case r of
  225. R_EAX,R_EBX,R_ECX,R_EDX,R_EDI,R_ESI,R_ESP :
  226. makereg32:=r;
  227. R_AX,R_BX,R_CX,R_DX,R_DI,R_SI,R_SP :
  228. makereg32:=reg16toreg32(r);
  229. R_AL,R_BL,R_CL,R_DL :
  230. makereg32:=reg8toreg32(r);
  231. end;
  232. end;
  233. procedure locflags2reg(var l:tlocation;opsize:topsize);
  234. var
  235. hregister : tregister;
  236. begin
  237. if (l.loc=LOC_FLAGS) then
  238. begin
  239. hregister:=getregister32;
  240. case opsize of
  241. S_W : hregister:=reg32toreg16(hregister);
  242. S_B : hregister:=reg32toreg8(hregister);
  243. end;
  244. emit_flag2reg(l.resflags,hregister);
  245. l.loc:=LOC_REGISTER;
  246. l.register:=hregister;
  247. end
  248. else internalerror(270720001);
  249. end;
  250. procedure locjump2reg(var l:tlocation;opsize:topsize; otl, ofl: pasmlabel);
  251. var
  252. hregister : tregister;
  253. hl : pasmlabel;
  254. begin
  255. if l.loc = LOC_JUMP then
  256. begin
  257. hregister:=getregister32;
  258. case opsize of
  259. S_W : hregister:=reg32toreg16(hregister);
  260. S_B : hregister:=reg32toreg8(hregister);
  261. end;
  262. l.loc:=LOC_REGISTER;
  263. l.register:=hregister;
  264. emitlab(truelabel);
  265. truelabel:=otl;
  266. emit_const_reg(A_MOV,opsize,1,hregister);
  267. getlabel(hl);
  268. emitjmp(C_None,hl);
  269. emitlab(falselabel);
  270. falselabel:=ofl;
  271. emit_reg_reg(A_XOR,S_L,makereg32(hregister),
  272. makereg32(hregister));
  273. emitlab(hl);
  274. end
  275. else internalerror(270720002);
  276. end;
  277. {*****************************************************************************
  278. Emit Assembler
  279. *****************************************************************************}
  280. procedure emitlab(var l : pasmlabel);
  281. begin
  282. if not l^.is_set then
  283. exprasmlist^.concat(new(pai_label,init(l)))
  284. else
  285. internalerror(7453984);
  286. end;
  287. {$ifdef nojmpfix}
  288. procedure emitjmp(c : tasmcond;var l : pasmlabel);
  289. var
  290. ai : Paicpu;
  291. begin
  292. if c=C_None then
  293. exprasmlist^.concat(new(paicpu,op_sym(A_JMP,S_NO,l)))
  294. else
  295. begin
  296. ai:=new(paicpu,op_sym(A_Jcc,S_NO,l));
  297. ai^.SetCondition(c);
  298. ai^.is_jmp:=true;
  299. exprasmlist^.concat(ai);
  300. end;
  301. end;
  302. {$else nojmpfix}
  303. procedure emitjmp(c : tasmcond;var l : pasmlabel);
  304. var
  305. ai : Paicpu;
  306. begin
  307. if c=C_None then
  308. ai := new(paicpu,op_sym(A_JMP,S_NO,l))
  309. else
  310. begin
  311. ai:=new(paicpu,op_sym(A_Jcc,S_NO,l));
  312. ai^.SetCondition(c);
  313. end;
  314. ai^.is_jmp:=true;
  315. exprasmlist^.concat(ai);
  316. end;
  317. {$endif nojmpfix}
  318. procedure emit_flag2reg(flag:tresflags;hregister:tregister);
  319. var
  320. ai : paicpu;
  321. hreg : tregister;
  322. begin
  323. hreg:=makereg8(hregister);
  324. ai:=new(paicpu,op_reg(A_Setcc,S_B,hreg));
  325. ai^.SetCondition(flag_2_cond[flag]);
  326. exprasmlist^.concat(ai);
  327. if hreg<>hregister then
  328. begin
  329. if hregister in regset16bit then
  330. emit_to_reg16(hreg)
  331. else
  332. emit_to_reg32(hreg);
  333. end;
  334. end;
  335. procedure emit_none(i : tasmop;s : topsize);
  336. begin
  337. exprasmlist^.concat(new(paicpu,op_none(i,s)));
  338. end;
  339. procedure emit_reg(i : tasmop;s : topsize;reg : tregister);
  340. begin
  341. exprasmlist^.concat(new(paicpu,op_reg(i,s,reg)));
  342. end;
  343. procedure emit_ref(i : tasmop;s : topsize;ref : preference);
  344. begin
  345. exprasmlist^.concat(new(paicpu,op_ref(i,s,ref)));
  346. end;
  347. procedure emit_const(i : tasmop;s : topsize;c : longint);
  348. begin
  349. exprasmlist^.concat(new(paicpu,op_const(i,s,c)));
  350. end;
  351. procedure emit_const_reg(i : tasmop;s : topsize;c : longint;reg : tregister);
  352. begin
  353. exprasmlist^.concat(new(paicpu,op_const_reg(i,s,c,reg)));
  354. end;
  355. procedure emit_const_ref(i : tasmop;s : topsize;c : longint;ref : preference);
  356. begin
  357. exprasmlist^.concat(new(paicpu,op_const_ref(i,s,c,ref)));
  358. end;
  359. procedure emit_ref_reg(i : tasmop;s : topsize;ref : preference;reg : tregister);
  360. begin
  361. exprasmlist^.concat(new(paicpu,op_ref_reg(i,s,ref,reg)));
  362. end;
  363. procedure emit_reg_ref(i : tasmop;s : topsize;reg : tregister;ref : preference);
  364. begin
  365. exprasmlist^.concat(new(paicpu,op_reg_ref(i,s,reg,ref)));
  366. end;
  367. procedure emit_reg_reg(i : tasmop;s : topsize;reg1,reg2 : tregister);
  368. begin
  369. if (reg1<>reg2) or (i<>A_MOV) then
  370. exprasmlist^.concat(new(paicpu,op_reg_reg(i,s,reg1,reg2)));
  371. end;
  372. procedure emit_const_reg_reg(i : tasmop;s : topsize;c : longint;reg1,reg2 : tregister);
  373. begin
  374. exprasmlist^.concat(new(paicpu,op_const_reg_reg(i,s,c,reg1,reg2)));
  375. end;
  376. procedure emit_reg_reg_reg(i : tasmop;s : topsize;reg1,reg2,reg3 : tregister);
  377. begin
  378. exprasmlist^.concat(new(paicpu,op_reg_reg_reg(i,s,reg1,reg2,reg3)));
  379. end;
  380. procedure emit_sym(i : tasmop;s : topsize;op : pasmsymbol);
  381. begin
  382. exprasmlist^.concat(new(paicpu,op_sym(i,s,op)));
  383. end;
  384. procedure emit_sym_ofs(i : tasmop;s : topsize;op : pasmsymbol;ofs : longint);
  385. begin
  386. exprasmlist^.concat(new(paicpu,op_sym_ofs(i,s,op,ofs)));
  387. end;
  388. procedure emit_sym_ofs_reg(i : tasmop;s : topsize;op : pasmsymbol;ofs:longint;reg : tregister);
  389. begin
  390. exprasmlist^.concat(new(paicpu,op_sym_ofs_reg(i,s,op,ofs,reg)));
  391. end;
  392. procedure emit_sym_ofs_ref(i : tasmop;s : topsize;op : pasmsymbol;ofs:longint;ref : preference);
  393. begin
  394. exprasmlist^.concat(new(paicpu,op_sym_ofs_ref(i,s,op,ofs,ref)));
  395. end;
  396. procedure emitcall(const routine:string);
  397. begin
  398. exprasmlist^.concat(new(paicpu,op_sym(A_CALL,S_NO,newasmsymbol(routine))));
  399. end;
  400. { only usefull in startup code }
  401. procedure emitinsertcall(const routine:string);
  402. begin
  403. exprasmlist^.insert(new(paicpu,op_sym(A_CALL,S_NO,newasmsymbol(routine))));
  404. end;
  405. procedure emit_mov_loc_ref(const t:tlocation;const ref:treference;siz:topsize;freetemp:boolean);
  406. var
  407. hreg : tregister;
  408. pushedeax : boolean;
  409. begin
  410. pushedeax:=false;
  411. case t.loc of
  412. LOC_REGISTER,
  413. LOC_CREGISTER : begin
  414. exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,siz,
  415. t.register,newreference(ref))));
  416. ungetregister32(t.register); { the register is not needed anymore }
  417. end;
  418. LOC_MEM,
  419. LOC_REFERENCE : begin
  420. if t.reference.is_immediate then
  421. emit_const_ref(A_MOV,siz,
  422. t.reference.offset,newreference(ref))
  423. else
  424. begin
  425. case siz of
  426. S_B : begin
  427. { we can't do a getregister in the code generator }
  428. { without problems!!! }
  429. if usablereg32>0 then
  430. hreg:=reg32toreg8(getregister32)
  431. else
  432. begin
  433. emit_reg(A_PUSH,S_L,R_EAX);
  434. pushedeax:=true;
  435. hreg:=R_AL;
  436. end;
  437. end;
  438. S_W : hreg:=R_DI;
  439. S_L : hreg:=R_EDI;
  440. end;
  441. {$ifndef noAllocEdi}
  442. if hreg in [R_DI,R_EDI] then
  443. getexplicitregister32(R_EDI);
  444. {$endif noAllocEdi}
  445. emit_ref_reg(A_MOV,siz,
  446. newreference(t.reference),hreg);
  447. del_reference(t.reference);
  448. exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,siz,
  449. hreg,newreference(ref))));
  450. if siz=S_B then
  451. begin
  452. if pushedeax then
  453. emit_reg(A_POP,S_L,R_EAX)
  454. else
  455. ungetregister(hreg);
  456. end;
  457. {$ifndef noAllocEdi}
  458. if hreg in [R_DI,R_EDI] then
  459. ungetregister32(R_EDI);
  460. {$endif noAllocEdi}
  461. { we can release the registers }
  462. { but only AFTER the MOV! Important for the optimizer!
  463. (JM)}
  464. del_reference(ref);
  465. end;
  466. if freetemp then
  467. ungetiftemp(t.reference);
  468. end;
  469. else
  470. internalerror(330);
  471. end;
  472. end;
  473. procedure emit_mov_loc_reg(const t:tlocation;reg:tregister);
  474. begin
  475. case t.loc of
  476. LOC_REGISTER,
  477. LOC_CREGISTER : begin
  478. emit_reg_reg(A_MOV,S_L,t.register,reg);
  479. ungetregister32(t.register); { the register is not needed anymore }
  480. end;
  481. LOC_MEM,
  482. LOC_REFERENCE : begin
  483. if t.reference.is_immediate then
  484. emit_const_reg(A_MOV,S_L,
  485. t.reference.offset,reg)
  486. else
  487. begin
  488. emit_ref_reg(A_MOV,S_L,
  489. newreference(t.reference),reg);
  490. end;
  491. end;
  492. else
  493. internalerror(330);
  494. end;
  495. end;
  496. procedure emit_mov_reg_loc(reg: TRegister; const t:tlocation);
  497. begin
  498. case t.loc of
  499. LOC_REGISTER,
  500. LOC_CREGISTER : begin
  501. emit_reg_reg(A_MOV,RegSize(Reg),
  502. reg,t.register);
  503. end;
  504. LOC_MEM,
  505. LOC_REFERENCE : begin
  506. if t.reference.is_immediate then
  507. internalerror(334)
  508. else
  509. begin
  510. exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,RegSize(Reg),
  511. Reg,newreference(t.reference))));
  512. end;
  513. end;
  514. else
  515. internalerror(330);
  516. end;
  517. end;
  518. procedure emit_lea_loc_reg(const t:tlocation;reg:tregister;freetemp:boolean);
  519. begin
  520. case t.loc of
  521. LOC_MEM,
  522. LOC_REFERENCE : begin
  523. if t.reference.is_immediate then
  524. internalerror(331)
  525. else
  526. begin
  527. emit_ref_reg(A_LEA,S_L,
  528. newreference(t.reference),reg);
  529. end;
  530. if freetemp then
  531. ungetiftemp(t.reference);
  532. end;
  533. else
  534. internalerror(332);
  535. end;
  536. end;
  537. procedure emit_movq_reg_loc(reghigh,reglow: TRegister;t:tlocation);
  538. begin
  539. case t.loc of
  540. LOC_REGISTER,
  541. LOC_CREGISTER : begin
  542. emit_reg_reg(A_MOV,S_L,
  543. reglow,t.registerlow);
  544. emit_reg_reg(A_MOV,S_L,
  545. reghigh,t.registerhigh);
  546. end;
  547. LOC_MEM,
  548. LOC_REFERENCE : begin
  549. if t.reference.is_immediate then
  550. internalerror(334)
  551. else
  552. begin
  553. exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,
  554. Reglow,newreference(t.reference))));
  555. inc(t.reference.offset,4);
  556. exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,
  557. Reghigh,newreference(t.reference))));
  558. end;
  559. end;
  560. else
  561. internalerror(330);
  562. end;
  563. end;
  564. procedure emit_pushq_loc(const t : tlocation);
  565. var
  566. hr : preference;
  567. begin
  568. case t.loc of
  569. LOC_REGISTER,
  570. LOC_CREGISTER:
  571. begin
  572. exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_L,
  573. t.registerhigh)));
  574. exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_L,
  575. t.registerlow)));
  576. end;
  577. LOC_MEM,
  578. LOC_REFERENCE:
  579. begin
  580. hr:=newreference(t.reference);
  581. inc(hr^.offset,4);
  582. exprasmlist^.concat(new(paicpu,op_ref(A_PUSH,S_L,
  583. hr)));
  584. exprasmlist^.concat(new(paicpu,op_ref(A_PUSH,S_L,
  585. newreference(t.reference))));
  586. ungetiftemp(t.reference);
  587. end;
  588. else internalerror(331);
  589. end;
  590. end;
  591. procedure remove_non_regvars_from_loc(const t: tlocation; var regs: byte);
  592. begin
  593. case t.loc of
  594. LOC_REGISTER:
  595. { can't be a regvar, since it would be LOC_CREGISTER then }
  596. regs := regs and not($80 shr byte(t.register));
  597. LOC_MEM,LOC_REFERENCE:
  598. begin
  599. if not(cs_regalloc in aktglobalswitches) or
  600. (t.reference.base in usableregs) then
  601. regs := regs and
  602. not($80 shr byte(t.reference.base));
  603. if not(cs_regalloc in aktglobalswitches) or
  604. (t.reference.index in usableregs) then
  605. regs := regs and
  606. not($80 shr byte(t.reference.index));
  607. end;
  608. end;
  609. end;
  610. procedure release_loc(const t : tlocation);
  611. begin
  612. case t.loc of
  613. LOC_REGISTER,
  614. LOC_CREGISTER:
  615. begin
  616. ungetregister32(t.register);
  617. end;
  618. LOC_MEM,
  619. LOC_REFERENCE:
  620. del_reference(t.reference);
  621. else internalerror(332);
  622. end;
  623. end;
  624. procedure release_qword_loc(const t : tlocation);
  625. begin
  626. case t.loc of
  627. LOC_REGISTER,
  628. LOC_CREGISTER:
  629. begin
  630. ungetregister32(t.registerhigh);
  631. ungetregister32(t.registerlow);
  632. end;
  633. LOC_MEM,
  634. LOC_REFERENCE:
  635. del_reference(t.reference);
  636. else internalerror(331);
  637. end;
  638. end;
  639. procedure emit_push_loc(const t:tlocation);
  640. begin
  641. case t.loc of
  642. LOC_REGISTER,
  643. LOC_CREGISTER : begin
  644. exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_L,makereg32(t.register))));
  645. ungetregister(t.register); { the register is not needed anymore }
  646. end;
  647. LOC_MEM,
  648. LOC_REFERENCE : begin
  649. if t.reference.is_immediate then
  650. exprasmlist^.concat(new(paicpu,op_const(A_PUSH,S_L,t.reference.offset)))
  651. else
  652. exprasmlist^.concat(new(paicpu,op_ref(A_PUSH,S_L,newreference(t.reference))));
  653. del_reference(t.reference);
  654. ungetiftemp(t.reference);
  655. end;
  656. else
  657. internalerror(330);
  658. end;
  659. end;
  660. procedure emit_pushw_loc(const t:tlocation);
  661. var
  662. opsize : topsize;
  663. begin
  664. case t.loc of
  665. LOC_REGISTER,
  666. LOC_CREGISTER : begin
  667. if target_os.stackalignment=4 then
  668. exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_L,makereg32(t.register))))
  669. else
  670. exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_W,makereg16(t.register))));
  671. ungetregister(t.register); { the register is not needed anymore }
  672. end;
  673. LOC_MEM,
  674. LOC_REFERENCE : begin
  675. if target_os.stackalignment=4 then
  676. opsize:=S_L
  677. else
  678. opsize:=S_W;
  679. if t.reference.is_immediate then
  680. exprasmlist^.concat(new(paicpu,op_const(A_PUSH,opsize,t.reference.offset)))
  681. else
  682. exprasmlist^.concat(new(paicpu,op_ref(A_PUSH,opsize,newreference(t.reference))));
  683. del_reference(t.reference);
  684. ungetiftemp(t.reference);
  685. end;
  686. else
  687. internalerror(330);
  688. end;
  689. end;
  690. procedure emit_lea_loc_ref(const t:tlocation;const ref:treference;freetemp:boolean);
  691. begin
  692. case t.loc of
  693. LOC_MEM,
  694. LOC_REFERENCE : begin
  695. if t.reference.is_immediate then
  696. internalerror(331)
  697. else
  698. begin
  699. {$ifndef noAllocEdi}
  700. getexplicitregister32(R_EDI);
  701. {$endif noAllocEdi}
  702. emit_ref_reg(A_LEA,S_L,
  703. newreference(t.reference),R_EDI);
  704. exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,
  705. R_EDI,newreference(ref))));
  706. {$ifndef noAllocEdi}
  707. ungetregister32(R_EDI);
  708. {$endif noAllocEdi}
  709. end;
  710. { release the registers }
  711. del_reference(t.reference);
  712. if freetemp then
  713. ungetiftemp(t.reference);
  714. end;
  715. else
  716. internalerror(332);
  717. end;
  718. end;
  719. procedure emit_push_lea_loc(const t:tlocation;freetemp:boolean);
  720. begin
  721. case t.loc of
  722. LOC_MEM,
  723. LOC_REFERENCE : begin
  724. if t.reference.is_immediate then
  725. internalerror(331)
  726. else
  727. begin
  728. {$ifndef noAllocEdi}
  729. getexplicitregister32(R_EDI);
  730. {$endif noAllocEdi}
  731. emit_ref_reg(A_LEA,S_L,
  732. newreference(t.reference),R_EDI);
  733. exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_L,R_EDI)));
  734. {$ifndef noAllocEdi}
  735. ungetregister32(R_EDI);
  736. {$endif noAllocEdi}
  737. end;
  738. if freetemp then
  739. ungetiftemp(t.reference);
  740. end;
  741. else
  742. internalerror(332);
  743. end;
  744. end;
  745. procedure emit_push_mem_size(const t: treference; size: longint);
  746. var
  747. s: topsize;
  748. begin
  749. if t.is_immediate then
  750. begin
  751. if (size=4) or
  752. (target_os.stackalignment=4) then
  753. exprasmlist^.concat(new(paicpu,op_const(A_PUSH,S_L,t.offset)))
  754. else
  755. exprasmlist^.concat(new(paicpu,op_const(A_PUSH,S_W,t.offset)));
  756. end
  757. else
  758. if size < 4 then
  759. begin
  760. getexplicitregister32(R_EDI);
  761. case size of
  762. 1: s := S_BL;
  763. 2: s := S_WL;
  764. else internalerror(200008071);
  765. end;
  766. exprasmlist^.concat(new(paicpu,op_ref_reg(A_MOVZX,s,
  767. newreference(t),R_EDI)));
  768. if target_os.stackalignment=4 then
  769. exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_L,R_EDI)))
  770. else
  771. exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_W,R_DI)));
  772. ungetregister32(R_EDI);
  773. end
  774. else
  775. if size = 4 then
  776. emit_push_mem(t)
  777. else
  778. internalerror(200008072);
  779. end;
  780. procedure emit_to_mem(var p:ptree);
  781. var
  782. r : treference;
  783. begin
  784. case p^.location.loc of
  785. LOC_FPU : begin
  786. reset_reference(p^.location.reference);
  787. gettempofsizereference(10,p^.location.reference);
  788. floatstore(pfloatdef(p^.resulttype)^.typ,p^.location.reference);
  789. { This can't be never a l-value! (FK)
  790. p^.location.loc:=LOC_REFERENCE; }
  791. end;
  792. LOC_REGISTER:
  793. begin
  794. if is_64bitint(p^.resulttype) then
  795. begin
  796. gettempofsizereference(8,r);
  797. emit_reg_ref(A_MOV,S_L,p^.location.registerlow,
  798. newreference(r));
  799. inc(r.offset,4);
  800. emit_reg_ref(A_MOV,S_L,p^.location.registerhigh,
  801. newreference(r));
  802. dec(r.offset,4);
  803. p^.location.reference:=r;
  804. end
  805. else
  806. internalerror(1405001);
  807. end;
  808. LOC_MEM,
  809. LOC_REFERENCE : ;
  810. LOC_CFPUREGISTER : begin
  811. emit_reg(A_FLD,S_NO,correct_fpuregister(p^.location.register,fpuvaroffset));
  812. inc(fpuvaroffset);
  813. reset_reference(p^.location.reference);
  814. gettempofsizereference(10,p^.location.reference);
  815. floatstore(pfloatdef(p^.resulttype)^.typ,p^.location.reference);
  816. { This can't be never a l-value! (FK)
  817. p^.location.loc:=LOC_REFERENCE; }
  818. end;
  819. else
  820. internalerror(333);
  821. end;
  822. p^.location.loc:=LOC_MEM;
  823. end;
  824. procedure emit_to_reg16(var hr:tregister);
  825. begin
  826. { ranges are a little bit bug sensitive ! }
  827. case hr of
  828. R_EAX,R_EBX,R_ECX,R_EDX,R_EDI,R_ESI,R_ESP,R_EBP:
  829. begin
  830. hr:=reg32toreg16(hr);
  831. end;
  832. R_AL,R_BL,R_CL,R_DL:
  833. begin
  834. hr:=reg8toreg16(hr);
  835. emit_const_reg(A_AND,S_W,$ff,hr);
  836. end;
  837. R_AH,R_BH,R_CH,R_DH:
  838. begin
  839. hr:=reg8toreg16(hr);
  840. emit_const_reg(A_AND,S_W,$ff00,hr);
  841. end;
  842. end;
  843. end;
  844. procedure emit_to_reg32(var hr:tregister);
  845. begin
  846. { ranges are a little bit bug sensitive ! }
  847. case hr of
  848. R_AX,R_BX,R_CX,R_DX,R_DI,R_SI,R_SP,R_BP:
  849. begin
  850. hr:=reg16toreg32(hr);
  851. emit_const_reg(A_AND,S_L,$ffff,hr);
  852. end;
  853. R_AL,R_BL,R_CL,R_DL:
  854. begin
  855. hr:=reg8toreg32(hr);
  856. emit_const_reg(A_AND,S_L,$ff,hr);
  857. end;
  858. R_AH,R_BH,R_CH,R_DH:
  859. begin
  860. hr:=reg8toreg32(hr);
  861. emit_const_reg(A_AND,S_L,$ff00,hr);
  862. end;
  863. end;
  864. end;
  865. procedure emit_mov_ref_reg64(r : treference;rl,rh : tregister);
  866. var
  867. hr : preference;
  868. begin
  869. { if we load a 64 bit reference, we must be careful because }
  870. { we could overwrite the registers of the reference by }
  871. { accident }
  872. if r.base=rl then
  873. begin
  874. emit_reg_reg(A_MOV,S_L,r.base,
  875. R_EDI);
  876. r.base:=R_EDI;
  877. end
  878. else if r.index=rl then
  879. begin
  880. emit_reg_reg(A_MOV,S_L,r.index,
  881. R_EDI);
  882. r.index:=R_EDI;
  883. end;
  884. emit_ref_reg(A_MOV,S_L,
  885. newreference(r),rl);
  886. hr:=newreference(r);
  887. inc(hr^.offset,4);
  888. emit_ref_reg(A_MOV,S_L,
  889. hr,rh);
  890. end;
  891. {*****************************************************************************
  892. Emit String Functions
  893. *****************************************************************************}
  894. procedure copyshortstring(const dref,sref : treference;len : byte;
  895. loadref, del_sref: boolean);
  896. begin
  897. emitpushreferenceaddr(dref);
  898. { if it's deleted right before it's used, the optimizer can move }
  899. { the reg deallocations to the right places (JM) }
  900. if del_sref then
  901. del_reference(sref);
  902. if loadref then
  903. emit_push_mem(sref)
  904. else
  905. emitpushreferenceaddr(sref);
  906. push_int(len);
  907. emitcall('FPC_SHORTSTR_COPY');
  908. maybe_loadesi;
  909. end;
  910. procedure copylongstring(const dref,sref : treference;len : longint;loadref:boolean);
  911. begin
  912. emitpushreferenceaddr(dref);
  913. if loadref then
  914. emit_push_mem(sref)
  915. else
  916. emitpushreferenceaddr(sref);
  917. push_int(len);
  918. emitcall('FPC_LONGSTR_COPY');
  919. maybe_loadesi;
  920. end;
  921. procedure incrstringref(t : pdef;const ref : treference);
  922. var
  923. pushedregs : tpushed;
  924. begin
  925. pushusedregisters(pushedregs,$ff);
  926. emitpushreferenceaddr(ref);
  927. if is_ansistring(t) then
  928. begin
  929. emitcall('FPC_ANSISTR_INCR_REF');
  930. end
  931. else if is_widestring(t) then
  932. begin
  933. emitcall('FPC_WIDESTR_INCR_REF');
  934. end
  935. else internalerror(1859);
  936. popusedregisters(pushedregs);
  937. end;
  938. procedure decrstringref(t : pdef;const ref : treference);
  939. var
  940. pushedregs : tpushed;
  941. begin
  942. pushusedregisters(pushedregs,$ff);
  943. emitpushreferenceaddr(ref);
  944. if is_ansistring(t) then
  945. begin
  946. emitcall('FPC_ANSISTR_DECR_REF');
  947. end
  948. else if is_widestring(t) then
  949. begin
  950. emitcall('FPC_WIDESTR_DECR_REF');
  951. end
  952. else internalerror(1859);
  953. popusedregisters(pushedregs);
  954. end;
  955. procedure loadansistring(p : ptree);
  956. {
  957. copies an ansistring from p^.right to p^.left, we
  958. assume, that both sides are ansistring, firstassignement have
  959. to take care of that, an ansistring can't be a register variable
  960. }
  961. var
  962. pushed : tpushed;
  963. regs_to_push: byte;
  964. ungettemp : boolean;
  965. begin
  966. { before pushing any parameter, we have to save all used }
  967. { registers, but before that we have to release the }
  968. { registers of that node to save uneccessary pushed }
  969. { so be careful, if you think you can optimize that code (FK) }
  970. { nevertheless, this has to be changed, because otherwise the }
  971. { register is released before it's contents are pushed -> }
  972. { problems with the optimizer (JM) }
  973. del_reference(p^.left^.location.reference);
  974. ungettemp:=false;
  975. { Find out which registers have to be pushed (JM) }
  976. regs_to_push := $ff;
  977. remove_non_regvars_from_loc(p^.right^.location,regs_to_push);
  978. { And push them (JM) }
  979. pushusedregisters(pushed,regs_to_push);
  980. case p^.right^.location.loc of
  981. LOC_REGISTER,LOC_CREGISTER:
  982. begin
  983. exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_L,p^.right^.location.register)));
  984. ungetregister32(p^.right^.location.register);
  985. end;
  986. LOC_REFERENCE,LOC_MEM:
  987. begin
  988. { First release the registers because emit_push_mem may }
  989. { load the reference in edi before pushing and then the }
  990. { dealloc is too late (and optimizations are missed (JM) }
  991. del_reference(p^.right^.location.reference);
  992. { This one doesn't need extra registers (JM) }
  993. emit_push_mem(p^.right^.location.reference);
  994. ungettemp:=true;
  995. end;
  996. end;
  997. emitpushreferenceaddr(p^.left^.location.reference);
  998. del_reference(p^.left^.location.reference);
  999. emitcall('FPC_ANSISTR_ASSIGN');
  1000. maybe_loadesi;
  1001. popusedregisters(pushed);
  1002. if ungettemp then
  1003. ungetiftemp(p^.right^.location.reference);
  1004. end;
  1005. {*****************************************************************************
  1006. Emit Push Functions
  1007. *****************************************************************************}
  1008. function maybe_push(needed : byte;p : ptree;isint64 : boolean) : boolean;
  1009. var
  1010. pushed : boolean;
  1011. {hregister : tregister; }
  1012. {$ifdef TEMPS_NOT_PUSH}
  1013. href : treference;
  1014. {$endif TEMPS_NOT_PUSH}
  1015. begin
  1016. if needed>usablereg32 then
  1017. begin
  1018. if (p^.location.loc=LOC_REGISTER) then
  1019. begin
  1020. if isint64 then
  1021. begin
  1022. {$ifdef TEMPS_NOT_PUSH}
  1023. gettempofsizereference(href,8);
  1024. p^.temp_offset:=href.offset;
  1025. href.offset:=href.offset+4;
  1026. exprasmlist^.concat(new(paicpu,op_reg(A_MOV,S_L,p^.location.registerhigh,href)));
  1027. href.offset:=href.offset-4;
  1028. {$else TEMPS_NOT_PUSH}
  1029. exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_L,p^.location.registerhigh)));
  1030. {$endif TEMPS_NOT_PUSH}
  1031. ungetregister32(p^.location.registerhigh);
  1032. end
  1033. {$ifdef TEMPS_NOT_PUSH}
  1034. else
  1035. begin
  1036. gettempofsizereference(href,4);
  1037. p^.temp_offset:=href.offset;
  1038. end
  1039. {$endif TEMPS_NOT_PUSH}
  1040. ;
  1041. pushed:=true;
  1042. {$ifdef TEMPS_NOT_PUSH}
  1043. exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,p^.location.register,href)));
  1044. {$else TEMPS_NOT_PUSH}
  1045. exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_L,p^.location.register)));
  1046. {$endif TEMPS_NOT_PUSH}
  1047. ungetregister32(p^.location.register);
  1048. end
  1049. else if (p^.location.loc in [LOC_MEM,LOC_REFERENCE]) and
  1050. ((p^.location.reference.base<>R_NO) or
  1051. (p^.location.reference.index<>R_NO)
  1052. ) then
  1053. begin
  1054. del_reference(p^.location.reference);
  1055. {$ifndef noAllocEdi}
  1056. getexplicitregister32(R_EDI);
  1057. {$endif noAllocEdi}
  1058. emit_ref_reg(A_LEA,S_L,newreference(p^.location.reference),
  1059. R_EDI);
  1060. {$ifdef TEMPS_NOT_PUSH}
  1061. gettempofsizereference(href,4);
  1062. exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,R_EDI,href)));
  1063. p^.temp_offset:=href.offset;
  1064. {$else TEMPS_NOT_PUSH}
  1065. exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_L,R_EDI)));
  1066. {$endif TEMPS_NOT_PUSH}
  1067. {$ifndef noAllocEdi}
  1068. ungetregister32(R_EDI);
  1069. {$endif noAllocEdi}
  1070. pushed:=true;
  1071. end
  1072. else pushed:=false;
  1073. end
  1074. else pushed:=false;
  1075. maybe_push:=pushed;
  1076. end;
  1077. {$ifdef TEMPS_NOT_PUSH}
  1078. function maybe_savetotemp(needed : byte;p : ptree;isint64 : boolean) : boolean;
  1079. var
  1080. pushed : boolean;
  1081. href : treference;
  1082. begin
  1083. if needed>usablereg32 then
  1084. begin
  1085. if (p^.location.loc=LOC_REGISTER) then
  1086. begin
  1087. if isint64(p^.resulttype) then
  1088. begin
  1089. gettempofsizereference(href,8);
  1090. p^.temp_offset:=href.offset;
  1091. href.offset:=href.offset+4;
  1092. exprasmlist^.concat(new(paicpu,op_reg(A_MOV,S_L,p^.location.registerhigh,href)));
  1093. href.offset:=href.offset-4;
  1094. ungetregister32(p^.location.registerhigh);
  1095. end
  1096. else
  1097. begin
  1098. gettempofsizereference(href,4);
  1099. p^.temp_offset:=href.offset;
  1100. end;
  1101. pushed:=true;
  1102. exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,p^.location.register,href)));
  1103. ungetregister32(p^.location.register);
  1104. end
  1105. else if (p^.location.loc in [LOC_MEM,LOC_REFERENCE]) and
  1106. ((p^.location.reference.base<>R_NO) or
  1107. (p^.location.reference.index<>R_NO)
  1108. ) then
  1109. begin
  1110. del_reference(p^.location.reference);
  1111. {$ifndef noAllocEdi}
  1112. getexplicitregister32(R_EDI);
  1113. {$endif noAllocEdi}
  1114. emit_ref_reg(A_LEA,S_L,newreference(p^.location.reference),
  1115. R_EDI);
  1116. gettempofsizereference(href,4);
  1117. exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,R_EDI,href)));
  1118. {$ifndef noAllocEdi}
  1119. ungetregister32(R_EDI);
  1120. {$endif noAllocEdi}
  1121. p^.temp_offset:=href.offset;
  1122. pushed:=true;
  1123. end
  1124. else pushed:=false;
  1125. end
  1126. else pushed:=false;
  1127. maybe_push:=pushed;
  1128. end;
  1129. {$endif TEMPS_NOT_PUSH}
  1130. procedure push_int(l : longint);
  1131. begin
  1132. if (l = 0) and
  1133. not(aktoptprocessor in [Class386, ClassP6]) and
  1134. not(cs_littlesize in aktglobalswitches)
  1135. Then
  1136. begin
  1137. {$ifndef noAllocEdi}
  1138. getexplicitregister32(R_EDI);
  1139. {$endif noAllocEdi}
  1140. emit_reg_reg(A_XOR,S_L,R_EDI,R_EDI);
  1141. exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_L,R_EDI)));
  1142. {$ifndef noAllocEdi}
  1143. ungetregister32(R_EDI);
  1144. {$endif noAllocEdi}
  1145. end
  1146. else
  1147. exprasmlist^.concat(new(paicpu,op_const(A_PUSH,S_L,l)));
  1148. end;
  1149. procedure emit_push_mem(const ref : treference);
  1150. begin
  1151. if ref.is_immediate then
  1152. push_int(ref.offset)
  1153. else
  1154. begin
  1155. if not(aktoptprocessor in [Class386, ClassP6]) and
  1156. not(cs_littlesize in aktglobalswitches)
  1157. then
  1158. begin
  1159. {$ifndef noAllocEdi}
  1160. getexplicitregister32(R_EDI);
  1161. {$endif noAllocEdi}
  1162. emit_ref_reg(A_MOV,S_L,newreference(ref),R_EDI);
  1163. exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_L,R_EDI)));
  1164. {$ifndef noAllocEdi}
  1165. ungetregister32(R_EDI);
  1166. {$endif noAllocEdi}
  1167. end
  1168. else exprasmlist^.concat(new(paicpu,op_ref(A_PUSH,S_L,newreference(ref))));
  1169. end;
  1170. end;
  1171. procedure emitpushreferenceaddr(const ref : treference);
  1172. var
  1173. href : treference;
  1174. begin
  1175. { this will fail for references to other segments !!! }
  1176. if ref.is_immediate then
  1177. { is this right ? }
  1178. begin
  1179. { push_int(ref.offset)}
  1180. gettempofsizereference(4,href);
  1181. emit_const_ref(A_MOV,S_L,ref.offset,newreference(href));
  1182. emitpushreferenceaddr(href);
  1183. del_reference(href);
  1184. end
  1185. else
  1186. begin
  1187. if ref.segment<>R_NO then
  1188. CGMessage(cg_e_cant_use_far_pointer_there);
  1189. if (ref.base=R_NO) and (ref.index=R_NO) then
  1190. exprasmlist^.concat(new(paicpu,op_sym_ofs(A_PUSH,S_L,ref.symbol,ref.offset)))
  1191. else if (ref.base=R_NO) and (ref.index<>R_NO) and
  1192. (ref.offset=0) and (ref.scalefactor=0) and (ref.symbol=nil) then
  1193. exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_L,ref.index)))
  1194. else if (ref.base<>R_NO) and (ref.index=R_NO) and
  1195. (ref.offset=0) and (ref.symbol=nil) then
  1196. exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_L,ref.base)))
  1197. else
  1198. begin
  1199. {$ifndef noAllocEdi}
  1200. getexplicitregister32(R_EDI);
  1201. {$endif noAllocEdi}
  1202. emit_ref_reg(A_LEA,S_L,newreference(ref),R_EDI);
  1203. exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_L,R_EDI)));
  1204. {$ifndef noAllocEdi}
  1205. ungetregister32(R_EDI);
  1206. {$endif noAllocEdi}
  1207. end;
  1208. end;
  1209. end;
  1210. procedure pushsetelement(p : ptree);
  1211. {
  1212. copies p a set element on the stack
  1213. }
  1214. var
  1215. hr,hr16,hr32 : tregister;
  1216. begin
  1217. { copy the element on the stack, slightly complicated }
  1218. if p^.treetype=ordconstn then
  1219. begin
  1220. if target_os.stackalignment=4 then
  1221. exprasmlist^.concat(new(paicpu,op_const(A_PUSH,S_L,p^.value)))
  1222. else
  1223. exprasmlist^.concat(new(paicpu,op_const(A_PUSH,S_W,p^.value)));
  1224. end
  1225. else
  1226. begin
  1227. case p^.location.loc of
  1228. LOC_REGISTER,
  1229. LOC_CREGISTER :
  1230. begin
  1231. hr:=p^.location.register;
  1232. case hr of
  1233. R_EAX,R_EBX,R_ECX,R_EDX,R_EDI,R_ESI,R_ESP :
  1234. begin
  1235. hr16:=reg32toreg16(hr);
  1236. hr32:=hr;
  1237. end;
  1238. R_AX,R_BX,R_CX,R_DX,R_DI,R_SI,R_SP :
  1239. begin
  1240. hr16:=hr;
  1241. hr32:=reg16toreg32(hr);
  1242. end;
  1243. R_AL,R_BL,R_CL,R_DL :
  1244. begin
  1245. hr16:=reg8toreg16(hr);
  1246. hr32:=reg8toreg32(hr);
  1247. end;
  1248. end;
  1249. if target_os.stackalignment=4 then
  1250. exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_L,hr32)))
  1251. else
  1252. exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_W,hr16)));
  1253. ungetregister32(hr32);
  1254. end;
  1255. else
  1256. begin
  1257. { you can't push more bytes than the size of the element, }
  1258. { because this may cross a page boundary and you'll get a }
  1259. { sigsegv (JM) }
  1260. emit_push_mem_size(p^.location.reference,1);
  1261. del_reference(p^.location.reference);
  1262. end;
  1263. end;
  1264. end;
  1265. end;
  1266. procedure restore(p : ptree;isint64 : boolean);
  1267. var
  1268. hregister : tregister;
  1269. {$ifdef TEMPS_NOT_PUSH}
  1270. href : treference;
  1271. {$endif TEMPS_NOT_PUSH}
  1272. begin
  1273. hregister:=getregister32;
  1274. {$ifdef TEMPS_NOT_PUSH}
  1275. reset_reference(href);
  1276. href.base:=procinfo^.frame_pointer;
  1277. href.offset:=p^.temp_offset;
  1278. emit_ref_reg(A_MOV,S_L,href,hregister);
  1279. {$else TEMPS_NOT_PUSH}
  1280. exprasmlist^.concat(new(paicpu,op_reg(A_POP,S_L,hregister)));
  1281. {$endif TEMPS_NOT_PUSH}
  1282. if (p^.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
  1283. begin
  1284. p^.location.register:=hregister;
  1285. if isint64 then
  1286. begin
  1287. p^.location.registerhigh:=getregister32;
  1288. {$ifdef TEMPS_NOT_PUSH}
  1289. href.offset:=p^.temp_offset+4;
  1290. emit_ref_reg(A_MOV,S_L,p^.location.registerhigh);
  1291. { set correctly for release ! }
  1292. href.offset:=p^.temp_offset;
  1293. {$else TEMPS_NOT_PUSH}
  1294. exprasmlist^.concat(new(paicpu,op_reg(A_POP,S_L,p^.location.registerhigh)));
  1295. {$endif TEMPS_NOT_PUSH}
  1296. end;
  1297. end
  1298. else
  1299. begin
  1300. reset_reference(p^.location.reference);
  1301. { any reasons why this was moved into the index register ? }
  1302. { normally usage of base register is much better (FK) }
  1303. p^.location.reference.base:=hregister;
  1304. { Why is this done? We can never be sure about p^.left
  1305. because otherwise secondload fails !!!
  1306. set_location(p^.left^.location,p^.location);}
  1307. end;
  1308. {$ifdef TEMPS_NOT_PUSH}
  1309. ungetiftemp(href);
  1310. {$endif TEMPS_NOT_PUSH}
  1311. end;
  1312. {$ifdef TEMPS_NOT_PUSH}
  1313. procedure restorefromtemp(p : ptree;isint64 : boolean);
  1314. var
  1315. hregister : tregister;
  1316. href : treference;
  1317. begin
  1318. hregister:=getregister32;
  1319. reset_reference(href);
  1320. href.base:=procinfo^.frame_pointer;
  1321. href.offset:=p^.temp_offset;
  1322. emit_ref_reg(A_MOV,S_L,href,hregister);
  1323. if (p^.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
  1324. begin
  1325. p^.location.register:=hregister;
  1326. if isint64 then
  1327. begin
  1328. p^.location.registerhigh:=getregister32;
  1329. href.offset:=p^.temp_offset+4;
  1330. emit_ref_reg(A_MOV,S_L,p^.location.registerhigh);
  1331. { set correctly for release ! }
  1332. href.offset:=p^.temp_offset;
  1333. end;
  1334. end
  1335. else
  1336. begin
  1337. reset_reference(p^.location.reference);
  1338. p^.location.reference.base:=hregister;
  1339. { Why is this done? We can never be sure about p^.left
  1340. because otherwise secondload fails PM
  1341. set_location(p^.left^.location,p^.location);}
  1342. end;
  1343. ungetiftemp(href);
  1344. end;
  1345. {$endif TEMPS_NOT_PUSH}
  1346. procedure push_value_para(p:ptree;inlined,is_cdecl:boolean;
  1347. para_offset:longint;alignment : longint);
  1348. var
  1349. tempreference : treference;
  1350. r : preference;
  1351. opsize : topsize;
  1352. op : tasmop;
  1353. hreg : tregister;
  1354. size : longint;
  1355. hlabel : pasmlabel;
  1356. begin
  1357. case p^.location.loc of
  1358. LOC_REGISTER,
  1359. LOC_CREGISTER:
  1360. begin
  1361. case p^.location.register of
  1362. R_EAX,R_EBX,R_ECX,R_EDX,R_ESI,
  1363. R_EDI,R_ESP,R_EBP :
  1364. begin
  1365. if p^.resulttype^.size=8 then
  1366. begin
  1367. inc(pushedparasize,8);
  1368. if inlined then
  1369. begin
  1370. r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
  1371. exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,
  1372. p^.location.registerlow,r)));
  1373. r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize+4);
  1374. exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,
  1375. p^.location.registerhigh,r)));
  1376. end
  1377. else
  1378. exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_L,p^.location.registerhigh)));
  1379. ungetregister32(p^.location.registerhigh);
  1380. exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_L,p^.location.registerlow)));
  1381. ungetregister32(p^.location.registerlow);
  1382. end
  1383. else
  1384. begin
  1385. inc(pushedparasize,4);
  1386. if inlined then
  1387. begin
  1388. r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
  1389. exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,
  1390. p^.location.register,r)));
  1391. end
  1392. else
  1393. exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_L,p^.location.register)));
  1394. ungetregister32(p^.location.register);
  1395. end;
  1396. end;
  1397. R_AX,R_BX,R_CX,R_DX,R_SI,R_DI:
  1398. begin
  1399. if alignment=4 then
  1400. begin
  1401. opsize:=S_L;
  1402. hreg:=reg16toreg32(p^.location.register);
  1403. inc(pushedparasize,4);
  1404. end
  1405. else
  1406. begin
  1407. opsize:=S_W;
  1408. hreg:=p^.location.register;
  1409. inc(pushedparasize,2);
  1410. end;
  1411. if inlined then
  1412. begin
  1413. r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
  1414. exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,opsize,hreg,r)));
  1415. end
  1416. else
  1417. exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,opsize,hreg)));
  1418. ungetregister32(reg16toreg32(p^.location.register));
  1419. end;
  1420. R_AL,R_BL,R_CL,R_DL:
  1421. begin
  1422. if alignment=4 then
  1423. begin
  1424. opsize:=S_L;
  1425. hreg:=reg8toreg32(p^.location.register);
  1426. inc(pushedparasize,4);
  1427. end
  1428. else
  1429. begin
  1430. opsize:=S_W;
  1431. hreg:=reg8toreg16(p^.location.register);
  1432. inc(pushedparasize,2);
  1433. end;
  1434. { we must push always 16 bit }
  1435. if inlined then
  1436. begin
  1437. r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
  1438. exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,opsize,hreg,r)));
  1439. end
  1440. else
  1441. exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,opsize,hreg)));
  1442. ungetregister32(reg8toreg32(p^.location.register));
  1443. end;
  1444. else internalerror(1899);
  1445. end;
  1446. end;
  1447. LOC_FPU:
  1448. begin
  1449. size:=align(pfloatdef(p^.resulttype)^.size,alignment);
  1450. inc(pushedparasize,size);
  1451. if not inlined then
  1452. emit_const_reg(A_SUB,S_L,size,R_ESP);
  1453. {$ifdef GDB}
  1454. if (cs_debuginfo in aktmoduleswitches) and
  1455. (exprasmlist^.first=exprasmlist^.last) then
  1456. exprasmlist^.concat(new(pai_force_line,init));
  1457. {$endif GDB}
  1458. r:=new_reference(R_ESP,0);
  1459. floatstoreops(pfloatdef(p^.resulttype)^.typ,op,opsize);
  1460. { this is the easiest case for inlined !! }
  1461. if inlined then
  1462. begin
  1463. r^.base:=procinfo^.framepointer;
  1464. r^.offset:=para_offset-pushedparasize;
  1465. end;
  1466. exprasmlist^.concat(new(paicpu,op_ref(op,opsize,r)));
  1467. dec(fpuvaroffset);
  1468. end;
  1469. LOC_CFPUREGISTER:
  1470. begin
  1471. exprasmlist^.concat(new(paicpu,op_reg(A_FLD,S_NO,
  1472. correct_fpuregister(p^.location.register,fpuvaroffset))));
  1473. size:=align(pfloatdef(p^.resulttype)^.size,alignment);
  1474. inc(pushedparasize,size);
  1475. if not inlined then
  1476. emit_const_reg(A_SUB,S_L,size,R_ESP);
  1477. {$ifdef GDB}
  1478. if (cs_debuginfo in aktmoduleswitches) and
  1479. (exprasmlist^.first=exprasmlist^.last) then
  1480. exprasmlist^.concat(new(pai_force_line,init));
  1481. {$endif GDB}
  1482. r:=new_reference(R_ESP,0);
  1483. floatstoreops(pfloatdef(p^.resulttype)^.typ,op,opsize);
  1484. { this is the easiest case for inlined !! }
  1485. if inlined then
  1486. begin
  1487. r^.base:=procinfo^.framepointer;
  1488. r^.offset:=para_offset-pushedparasize;
  1489. end;
  1490. exprasmlist^.concat(new(paicpu,op_ref(op,opsize,r)));
  1491. end;
  1492. LOC_REFERENCE,LOC_MEM:
  1493. begin
  1494. tempreference:=p^.location.reference;
  1495. del_reference(p^.location.reference);
  1496. case p^.resulttype^.deftype of
  1497. enumdef,
  1498. orddef :
  1499. begin
  1500. case p^.resulttype^.size of
  1501. 8 : begin
  1502. inc(pushedparasize,8);
  1503. if inlined then
  1504. begin
  1505. {$ifndef noAllocEdi}
  1506. getexplicitregister32(R_EDI);
  1507. {$endif noAllocEdi}
  1508. emit_ref_reg(A_MOV,S_L,
  1509. newreference(tempreference),R_EDI);
  1510. r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
  1511. exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,R_EDI,r)));
  1512. {$ifndef noAllocEdi}
  1513. ungetregister32(R_EDI);
  1514. getexplicitregister32(R_EDI);
  1515. {$endif noAllocEdi}
  1516. inc(tempreference.offset,4);
  1517. emit_ref_reg(A_MOV,S_L,
  1518. newreference(tempreference),R_EDI);
  1519. r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize+4);
  1520. exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,R_EDI,r)));
  1521. {$ifndef noAllocEdi}
  1522. ungetregister32(R_EDI);
  1523. {$endif noAllocEdi}
  1524. end
  1525. else
  1526. begin
  1527. inc(tempreference.offset,4);
  1528. emit_push_mem(tempreference);
  1529. dec(tempreference.offset,4);
  1530. emit_push_mem(tempreference);
  1531. end;
  1532. end;
  1533. 4 : begin
  1534. inc(pushedparasize,4);
  1535. if inlined then
  1536. begin
  1537. {$ifndef noAllocEdi}
  1538. getexplicitregister32(R_EDI);
  1539. {$endif noAllocEdi}
  1540. emit_ref_reg(A_MOV,S_L,
  1541. newreference(tempreference),R_EDI);
  1542. r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
  1543. exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,R_EDI,r)));
  1544. {$ifndef noAllocEdi}
  1545. ungetregister32(R_EDI);
  1546. {$endif noAllocEdi}
  1547. end
  1548. else
  1549. emit_push_mem(tempreference);
  1550. end;
  1551. 1,2 : begin
  1552. if alignment=4 then
  1553. begin
  1554. opsize:=S_L;
  1555. hreg:=R_EDI;
  1556. inc(pushedparasize,4);
  1557. end
  1558. else
  1559. begin
  1560. opsize:=S_W;
  1561. hreg:=R_DI;
  1562. inc(pushedparasize,2);
  1563. end;
  1564. if inlined then
  1565. begin
  1566. {$ifndef noAllocEdi}
  1567. getexplicitregister32(R_EDI);
  1568. {$endif noAllocEdi}
  1569. emit_ref_reg(A_MOV,opsize,
  1570. newreference(tempreference),hreg);
  1571. r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
  1572. exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,opsize,hreg,r)));
  1573. {$ifndef noAllocEdi}
  1574. ungetregister32(R_EDI);
  1575. {$endif noAllocEdi}
  1576. end
  1577. else
  1578. emit_push_mem_size(tempreference,p^.resulttype^.size);
  1579. end;
  1580. else
  1581. internalerror(234231);
  1582. end;
  1583. end;
  1584. floatdef :
  1585. begin
  1586. case pfloatdef(p^.resulttype)^.typ of
  1587. f32bit,
  1588. s32real :
  1589. begin
  1590. inc(pushedparasize,4);
  1591. if inlined then
  1592. begin
  1593. {$ifndef noAllocEdi}
  1594. getexplicitregister32(R_EDI);
  1595. {$endif noAllocEdi}
  1596. emit_ref_reg(A_MOV,S_L,
  1597. newreference(tempreference),R_EDI);
  1598. r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
  1599. exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,R_EDI,r)));
  1600. {$ifndef noAllocEdi}
  1601. ungetregister32(R_EDI);
  1602. {$endif noAllocEdi}
  1603. end
  1604. else
  1605. emit_push_mem(tempreference);
  1606. end;
  1607. s64real,
  1608. s64comp :
  1609. begin
  1610. inc(pushedparasize,4);
  1611. inc(tempreference.offset,4);
  1612. if inlined then
  1613. begin
  1614. {$ifndef noAllocEdi}
  1615. getexplicitregister32(R_EDI);
  1616. {$endif noAllocEdi}
  1617. emit_ref_reg(A_MOV,S_L,
  1618. newreference(tempreference),R_EDI);
  1619. r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
  1620. exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,R_EDI,r)));
  1621. {$ifndef noAllocEdi}
  1622. ungetregister32(R_EDI);
  1623. {$endif noAllocEdi}
  1624. end
  1625. else
  1626. emit_push_mem(tempreference);
  1627. inc(pushedparasize,4);
  1628. dec(tempreference.offset,4);
  1629. if inlined then
  1630. begin
  1631. {$ifndef noAllocEdi}
  1632. getexplicitregister32(R_EDI);
  1633. {$endif noAllocEdi}
  1634. emit_ref_reg(A_MOV,S_L,
  1635. newreference(tempreference),R_EDI);
  1636. r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
  1637. exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,R_EDI,r)));
  1638. {$ifndef noAllocEdi}
  1639. ungetregister32(R_EDI);
  1640. {$endif noAllocEdi}
  1641. end
  1642. else
  1643. emit_push_mem(tempreference);
  1644. end;
  1645. s80real :
  1646. begin
  1647. inc(pushedparasize,4);
  1648. if alignment=4 then
  1649. inc(tempreference.offset,8)
  1650. else
  1651. inc(tempreference.offset,6);
  1652. if inlined then
  1653. begin
  1654. {$ifndef noAllocEdi}
  1655. getexplicitregister32(R_EDI);
  1656. {$endif noAllocEdi}
  1657. emit_ref_reg(A_MOV,S_L,
  1658. newreference(tempreference),R_EDI);
  1659. r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
  1660. exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,R_EDI,r)));
  1661. {$ifndef noAllocEdi}
  1662. ungetregister32(R_EDI);
  1663. {$endif noAllocEdi}
  1664. end
  1665. else
  1666. emit_push_mem(tempreference);
  1667. dec(tempreference.offset,4);
  1668. inc(pushedparasize,4);
  1669. if inlined then
  1670. begin
  1671. {$ifndef noAllocEdi}
  1672. getexplicitregister32(R_EDI);
  1673. {$endif noAllocEdi}
  1674. emit_ref_reg(A_MOV,S_L,
  1675. newreference(tempreference),R_EDI);
  1676. r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
  1677. exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,R_EDI,r)));
  1678. {$ifndef noAllocEdi}
  1679. ungetregister32(R_EDI);
  1680. {$endif noAllocEdi}
  1681. end
  1682. else
  1683. emit_push_mem(tempreference);
  1684. if alignment=4 then
  1685. begin
  1686. opsize:=S_L;
  1687. hreg:=R_EDI;
  1688. inc(pushedparasize,4);
  1689. dec(tempreference.offset,4);
  1690. end
  1691. else
  1692. begin
  1693. opsize:=S_W;
  1694. hreg:=R_DI;
  1695. inc(pushedparasize,2);
  1696. dec(tempreference.offset,2);
  1697. end;
  1698. if inlined then
  1699. begin
  1700. {$ifndef noAllocEdi}
  1701. getexplicitregister32(R_EDI);
  1702. {$endif noAllocEdi}
  1703. emit_ref_reg(A_MOV,opsize,
  1704. newreference(tempreference),hreg);
  1705. r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
  1706. exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,opsize,hreg,r)));
  1707. {$ifndef noAllocEdi}
  1708. ungetregister32(R_EDI);
  1709. {$endif noAllocEdi}
  1710. end
  1711. else
  1712. exprasmlist^.concat(new(paicpu,op_ref(A_PUSH,opsize,
  1713. newreference(tempreference))));
  1714. end;
  1715. end;
  1716. end;
  1717. pointerdef,
  1718. procvardef,
  1719. classrefdef:
  1720. begin
  1721. inc(pushedparasize,4);
  1722. if inlined then
  1723. begin
  1724. {$ifndef noAllocEdi}
  1725. getexplicitregister32(R_EDI);
  1726. {$endif noAllocEdi}
  1727. emit_ref_reg(A_MOV,S_L,
  1728. newreference(tempreference),R_EDI);
  1729. r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
  1730. exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,R_EDI,r)));
  1731. {$ifndef noAllocEdi}
  1732. ungetregister32(R_EDI);
  1733. {$endif noAllocEdi}
  1734. end
  1735. else
  1736. emit_push_mem(tempreference);
  1737. end;
  1738. arraydef,
  1739. recorddef,
  1740. stringdef,
  1741. setdef,
  1742. objectdef :
  1743. begin
  1744. { even some structured types are 32 bit }
  1745. if is_widestring(p^.resulttype) or
  1746. is_ansistring(p^.resulttype) or
  1747. is_smallset(p^.resulttype) or
  1748. ((p^.resulttype^.deftype in [recorddef,arraydef]) and
  1749. (
  1750. (p^.resulttype^.deftype<>arraydef) or not
  1751. (parraydef(p^.resulttype)^.IsConstructor or
  1752. parraydef(p^.resulttype)^.isArrayOfConst or
  1753. is_open_array(p^.resulttype))
  1754. ) and
  1755. (p^.resulttype^.size<=4)
  1756. ) or
  1757. ((p^.resulttype^.deftype=objectdef) and
  1758. pobjectdef(p^.resulttype)^.is_class) then
  1759. begin
  1760. if (p^.resulttype^.size>2) or
  1761. ((alignment=4) and (p^.resulttype^.size>0)) then
  1762. begin
  1763. inc(pushedparasize,4);
  1764. if inlined then
  1765. begin
  1766. r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
  1767. concatcopy(tempreference,r^,4,false,false);
  1768. end
  1769. else
  1770. emit_push_mem(tempreference);
  1771. end
  1772. else
  1773. begin
  1774. if p^.resulttype^.size>0 then
  1775. begin
  1776. inc(pushedparasize,2);
  1777. if inlined then
  1778. begin
  1779. r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
  1780. concatcopy(tempreference,r^,2,false,false);
  1781. end
  1782. else
  1783. exprasmlist^.concat(new(paicpu,op_ref(A_PUSH,S_W,newreference(tempreference))));
  1784. end;
  1785. end;
  1786. end
  1787. { call by value open array ? }
  1788. else if is_cdecl then
  1789. begin
  1790. { push on stack }
  1791. size:=align(p^.resulttype^.size,alignment);
  1792. inc(pushedparasize,size);
  1793. emit_const_reg(A_SUB,S_L,size,R_ESP);
  1794. r:=new_reference(R_ESP,0);
  1795. concatcopy(tempreference,r^,size,false,false);
  1796. end
  1797. else
  1798. internalerror(8954);
  1799. end;
  1800. else
  1801. CGMessage(cg_e_illegal_expression);
  1802. end;
  1803. end;
  1804. LOC_JUMP:
  1805. begin
  1806. getlabel(hlabel);
  1807. if alignment=4 then
  1808. begin
  1809. opsize:=S_L;
  1810. inc(pushedparasize,4);
  1811. end
  1812. else
  1813. begin
  1814. opsize:=S_W;
  1815. inc(pushedparasize,2);
  1816. end;
  1817. emitlab(truelabel);
  1818. if inlined then
  1819. begin
  1820. r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
  1821. emit_const_ref(A_MOV,opsize,1,r);
  1822. end
  1823. else
  1824. exprasmlist^.concat(new(paicpu,op_const(A_PUSH,opsize,1)));
  1825. emitjmp(C_None,hlabel);
  1826. emitlab(falselabel);
  1827. if inlined then
  1828. begin
  1829. r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
  1830. emit_const_ref(A_MOV,opsize,0,r);
  1831. end
  1832. else
  1833. exprasmlist^.concat(new(paicpu,op_const(A_PUSH,opsize,0)));
  1834. emitlab(hlabel);
  1835. end;
  1836. LOC_FLAGS:
  1837. begin
  1838. if not(R_EAX in unused) then
  1839. begin
  1840. {$ifndef noAllocEdi}
  1841. getexplicitregister32(R_EDI);
  1842. {$endif noAllocEdi}
  1843. emit_reg_reg(A_MOV,S_L,R_EAX,R_EDI);
  1844. end;
  1845. emit_flag2reg(p^.location.resflags,R_AL);
  1846. emit_reg_reg(A_MOVZX,S_BW,R_AL,R_AX);
  1847. if alignment=4 then
  1848. begin
  1849. opsize:=S_L;
  1850. hreg:=R_EAX;
  1851. inc(pushedparasize,4);
  1852. end
  1853. else
  1854. begin
  1855. opsize:=S_W;
  1856. hreg:=R_AX;
  1857. inc(pushedparasize,2);
  1858. end;
  1859. if inlined then
  1860. begin
  1861. r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
  1862. exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,opsize,hreg,r)));
  1863. end
  1864. else
  1865. exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,opsize,hreg)));
  1866. if not(R_EAX in unused) then
  1867. begin
  1868. emit_reg_reg(A_MOV,S_L,R_EDI,R_EAX);
  1869. {$ifndef noAllocEdi}
  1870. ungetregister32(R_EDI);
  1871. {$endif noAllocEdi}
  1872. end;
  1873. end;
  1874. {$ifdef SUPPORT_MMX}
  1875. LOC_MMXREGISTER,
  1876. LOC_CMMXREGISTER:
  1877. begin
  1878. inc(pushedparasize,8); { was missing !!! (PM) }
  1879. emit_const_reg(
  1880. A_SUB,S_L,8,R_ESP);
  1881. {$ifdef GDB}
  1882. if (cs_debuginfo in aktmoduleswitches) and
  1883. (exprasmlist^.first=exprasmlist^.last) then
  1884. exprasmlist^.concat(new(pai_force_line,init));
  1885. {$endif GDB}
  1886. if inlined then
  1887. begin
  1888. r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
  1889. exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOVQ,S_NO,
  1890. p^.location.register,r)));
  1891. end
  1892. else
  1893. begin
  1894. r:=new_reference(R_ESP,0);
  1895. exprasmlist^.concat(new(paicpu,op_reg_ref(
  1896. A_MOVQ,S_NO,p^.location.register,r)));
  1897. end;
  1898. end;
  1899. {$endif SUPPORT_MMX}
  1900. end;
  1901. end;
  1902. {*****************************************************************************
  1903. Emit Float Functions
  1904. *****************************************************************************}
  1905. procedure floatloadops(t : tfloattype;var op : tasmop;var s : topsize);
  1906. begin
  1907. case t of
  1908. s32real : begin
  1909. op:=A_FLD;
  1910. s:=S_FS;
  1911. end;
  1912. s64real : begin
  1913. op:=A_FLD;
  1914. { ???? }
  1915. s:=S_FL;
  1916. end;
  1917. s80real : begin
  1918. op:=A_FLD;
  1919. s:=S_FX;
  1920. end;
  1921. s64comp : begin
  1922. op:=A_FILD;
  1923. s:=S_IQ;
  1924. end;
  1925. else internalerror(17);
  1926. end;
  1927. end;
  1928. procedure floatload(t : tfloattype;const ref : treference);
  1929. var
  1930. op : tasmop;
  1931. s : topsize;
  1932. begin
  1933. floatloadops(t,op,s);
  1934. exprasmlist^.concat(new(paicpu,op_ref(op,s,
  1935. newreference(ref))));
  1936. inc(fpuvaroffset);
  1937. end;
  1938. procedure floatstoreops(t : tfloattype;var op : tasmop;var s : topsize);
  1939. begin
  1940. case t of
  1941. s32real : begin
  1942. op:=A_FSTP;
  1943. s:=S_FS;
  1944. end;
  1945. s64real : begin
  1946. op:=A_FSTP;
  1947. s:=S_FL;
  1948. end;
  1949. s80real : begin
  1950. op:=A_FSTP;
  1951. s:=S_FX;
  1952. end;
  1953. s64comp : begin
  1954. op:=A_FISTP;
  1955. s:=S_IQ;
  1956. end;
  1957. else
  1958. internalerror(17);
  1959. end;
  1960. end;
  1961. procedure floatstore(t : tfloattype;const ref : treference);
  1962. var
  1963. op : tasmop;
  1964. s : topsize;
  1965. begin
  1966. floatstoreops(t,op,s);
  1967. exprasmlist^.concat(new(paicpu,op_ref(op,s,
  1968. newreference(ref))));
  1969. dec(fpuvaroffset);
  1970. end;
  1971. {*****************************************************************************
  1972. Emit Functions
  1973. *****************************************************************************}
  1974. procedure maketojumpbool(p : ptree);
  1975. {
  1976. produces jumps to true respectively false labels using boolean expressions
  1977. }
  1978. var
  1979. opsize : topsize;
  1980. storepos : tfileposinfo;
  1981. begin
  1982. if p^.error then
  1983. exit;
  1984. storepos:=aktfilepos;
  1985. aktfilepos:=p^.fileinfo;
  1986. if is_boolean(p^.resulttype) then
  1987. begin
  1988. if is_constboolnode(p) then
  1989. begin
  1990. if p^.value<>0 then
  1991. emitjmp(C_None,truelabel)
  1992. else
  1993. emitjmp(C_None,falselabel);
  1994. end
  1995. else
  1996. begin
  1997. opsize:=def_opsize(p^.resulttype);
  1998. case p^.location.loc of
  1999. LOC_CREGISTER,LOC_REGISTER : begin
  2000. emit_reg_reg(A_OR,opsize,p^.location.register,
  2001. p^.location.register);
  2002. ungetregister(p^.location.register);
  2003. emitjmp(C_NZ,truelabel);
  2004. emitjmp(C_None,falselabel);
  2005. end;
  2006. LOC_MEM,LOC_REFERENCE : begin
  2007. emit_const_ref(
  2008. A_CMP,opsize,0,newreference(p^.location.reference));
  2009. del_reference(p^.location.reference);
  2010. emitjmp(C_NZ,truelabel);
  2011. emitjmp(C_None,falselabel);
  2012. end;
  2013. LOC_FLAGS : begin
  2014. emitjmp(flag_2_cond[p^.location.resflags],truelabel);
  2015. emitjmp(C_None,falselabel);
  2016. end;
  2017. end;
  2018. end;
  2019. end
  2020. else
  2021. CGMessage(type_e_mismatch);
  2022. aktfilepos:=storepos;
  2023. end;
  2024. { produces if necessary overflowcode }
  2025. procedure emitoverflowcheck(p:ptree);
  2026. var
  2027. hl : pasmlabel;
  2028. begin
  2029. if not(cs_check_overflow in aktlocalswitches) then
  2030. exit;
  2031. getlabel(hl);
  2032. if not ((p^.resulttype^.deftype=pointerdef) or
  2033. ((p^.resulttype^.deftype=orddef) and
  2034. (porddef(p^.resulttype)^.typ in [u64bit,u16bit,u32bit,u8bit,uchar,
  2035. bool8bit,bool16bit,bool32bit]))) then
  2036. emitjmp(C_NO,hl)
  2037. else
  2038. emitjmp(C_NB,hl);
  2039. emitcall('FPC_OVERFLOW');
  2040. emitlab(hl);
  2041. end;
  2042. { produces range check code, while one of the operands is a 64 bit
  2043. integer }
  2044. procedure emitrangecheck64(p : ptree;todef : pdef);
  2045. begin
  2046. CGMessage(cg_w_64bit_range_check_not_supported);
  2047. {internalerror(28699);}
  2048. end;
  2049. { produces if necessary rangecheckcode }
  2050. procedure emitrangecheck(p:ptree;todef:pdef);
  2051. {
  2052. generate range checking code for the value at location t. The
  2053. type used is the checked against todefs ranges. fromdef (p.resulttype)
  2054. is the original type used at that location, when both defs are
  2055. equal the check is also insert (needed for succ,pref,inc,dec)
  2056. }
  2057. var
  2058. neglabel,
  2059. poslabel : pasmlabel;
  2060. href : treference;
  2061. rstr : string;
  2062. hreg : tregister;
  2063. opsize : topsize;
  2064. op : tasmop;
  2065. fromdef : pdef;
  2066. lto,hto,
  2067. lfrom,hfrom : longint;
  2068. doublebound,
  2069. is_reg,
  2070. popecx : boolean;
  2071. begin
  2072. { range checking on and range checkable value? }
  2073. if not(cs_check_range in aktlocalswitches) or
  2074. not(todef^.deftype in [orddef,enumdef,arraydef]) then
  2075. exit;
  2076. { only check when assigning to scalar, subranges are different,
  2077. when todef=fromdef then the check is always generated }
  2078. fromdef:=p^.resulttype;
  2079. if is_64bitint(fromdef) or is_64bitint(todef) then
  2080. begin
  2081. emitrangecheck64(p,todef);
  2082. exit;
  2083. end;
  2084. {we also need lto and hto when checking if we need to use doublebound!
  2085. (JM)}
  2086. getrange(todef,lto,hto);
  2087. if todef<>fromdef then
  2088. begin
  2089. getrange(p^.resulttype,lfrom,hfrom);
  2090. { first check for not being u32bit, then if the to is bigger than
  2091. from }
  2092. if (lto<hto) and (lfrom<hfrom) and
  2093. (lto<=lfrom) and (hto>=hfrom) then
  2094. exit;
  2095. end;
  2096. { generate the rangecheck code for the def where we are going to
  2097. store the result }
  2098. doublebound:=false;
  2099. case todef^.deftype of
  2100. orddef :
  2101. begin
  2102. porddef(todef)^.genrangecheck;
  2103. rstr:=porddef(todef)^.getrangecheckstring;
  2104. doublebound:=(porddef(todef)^.typ=u32bit) and (lto>hto);
  2105. end;
  2106. enumdef :
  2107. begin
  2108. penumdef(todef)^.genrangecheck;
  2109. rstr:=penumdef(todef)^.getrangecheckstring;
  2110. end;
  2111. arraydef :
  2112. begin
  2113. parraydef(todef)^.genrangecheck;
  2114. rstr:=parraydef(todef)^.getrangecheckstring;
  2115. doublebound:=(lto>hto);
  2116. end;
  2117. end;
  2118. { get op and opsize }
  2119. opsize:=def2def_opsize(fromdef,u32bitdef);
  2120. if opsize in [S_B,S_W,S_L] then
  2121. op:=A_MOV
  2122. else
  2123. if is_signed(fromdef) then
  2124. op:=A_MOVSX
  2125. else
  2126. op:=A_MOVZX;
  2127. is_reg:=(p^.location.loc in [LOC_REGISTER,LOC_CREGISTER]);
  2128. if is_reg then
  2129. hreg:=p^.location.register;
  2130. if not target_os.use_bound_instruction then
  2131. begin
  2132. { FPC_BOUNDCHECK needs to be called with
  2133. %ecx - value
  2134. %edi - pointer to the ranges }
  2135. popecx:=false;
  2136. if not(is_reg) or
  2137. (p^.location.register<>R_ECX) then
  2138. begin
  2139. if not(R_ECX in unused) then
  2140. begin
  2141. exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_L,R_ECX)));
  2142. popecx:=true;
  2143. end
  2144. else exprasmlist^.concat(new(pairegalloc,alloc(R_ECX)));
  2145. if is_reg then
  2146. emit_reg_reg(op,opsize,p^.location.register,R_ECX)
  2147. else
  2148. emit_ref_reg(op,opsize,newreference(p^.location.reference),R_ECX);
  2149. end;
  2150. if doublebound then
  2151. begin
  2152. getlabel(neglabel);
  2153. getlabel(poslabel);
  2154. emit_reg_reg(A_OR,S_L,R_ECX,R_ECX);
  2155. emitjmp(C_L,neglabel);
  2156. end;
  2157. { insert bound instruction only }
  2158. {$ifndef noAllocEdi}
  2159. getexplicitregister32(R_EDI);
  2160. {$endif noAllocEdi}
  2161. exprasmlist^.concat(new(paicpu,op_sym_ofs_reg(A_MOV,S_L,newasmsymbol(rstr),0,R_EDI)));
  2162. emitcall('FPC_BOUNDCHECK');
  2163. {$ifndef noAllocEdi}
  2164. ungetregister32(R_EDI);
  2165. {$endif noAllocEdi}
  2166. { u32bit needs 2 checks }
  2167. if doublebound then
  2168. begin
  2169. emitjmp(C_None,poslabel);
  2170. emitlab(neglabel);
  2171. {$ifndef noAllocEdi}
  2172. getexplicitregister32(R_EDI);
  2173. {$endif noAllocEdi}
  2174. exprasmlist^.concat(new(paicpu,op_sym_ofs_reg(A_MOV,S_L,newasmsymbol(rstr),8,R_EDI)));
  2175. emitcall('FPC_BOUNDCHECK');
  2176. {$ifndef noAllocEdi}
  2177. ungetregister32(R_EDI);
  2178. {$endif noAllocEdi}
  2179. emitlab(poslabel);
  2180. end;
  2181. if popecx then
  2182. exprasmlist^.concat(new(paicpu,op_reg(A_POP,S_L,R_ECX)))
  2183. else exprasmlist^.concat(new(pairegalloc,dealloc(R_ECX)));
  2184. end
  2185. else
  2186. begin
  2187. reset_reference(href);
  2188. href.symbol:=newasmsymbol(rstr);
  2189. { load the value in a register }
  2190. if is_reg then
  2191. begin
  2192. { be sure that hreg is a 32 bit reg, if not load it in %edi }
  2193. if p^.location.register in [R_EAX..R_EDI] then
  2194. hreg:=p^.location.register
  2195. else
  2196. begin
  2197. {$ifndef noAllocEdi}
  2198. getexplicitregister32(R_EDI);
  2199. {$endif noAllocEdi}
  2200. emit_reg_reg(op,opsize,p^.location.register,R_EDI);
  2201. hreg:=R_EDI;
  2202. end;
  2203. end
  2204. else
  2205. begin
  2206. {$ifndef noAllocEdi}
  2207. getexplicitregister32(R_EDI);
  2208. {$endif noAllocEdi}
  2209. emit_ref_reg(op,opsize,newreference(p^.location.reference),R_EDI);
  2210. hreg:=R_EDI;
  2211. end;
  2212. if doublebound then
  2213. begin
  2214. getlabel(neglabel);
  2215. getlabel(poslabel);
  2216. emit_reg_reg(A_TEST,S_L,hreg,hreg);
  2217. emitjmp(C_L,neglabel);
  2218. end;
  2219. { insert bound instruction only }
  2220. exprasmlist^.concat(new(paicpu,op_reg_ref(A_BOUND,S_L,hreg,newreference(href))));
  2221. { u32bit needs 2 checks }
  2222. if doublebound then
  2223. begin
  2224. href.offset:=8;
  2225. emitjmp(C_None,poslabel);
  2226. emitlab(neglabel);
  2227. exprasmlist^.concat(new(paicpu,op_reg_ref(A_BOUND,S_L,hreg,newreference(href))));
  2228. emitlab(poslabel);
  2229. end;
  2230. {$ifndef noAllocEdi}
  2231. if hreg = R_EDI then
  2232. ungetregister32(R_EDI);
  2233. {$endif noAllocEdi}
  2234. end;
  2235. end;
  2236. procedure concatcopy(source,dest : treference;size : longint;delsource,loadref : boolean);
  2237. const
  2238. isizes : array[0..3] of topsize=(S_L,S_B,S_W,S_B);
  2239. ishr : array[0..3] of byte=(2,0,1,0);
  2240. var
  2241. ecxpushed : boolean;
  2242. helpsize : longint;
  2243. i : byte;
  2244. reg8,reg32 : tregister;
  2245. swap : boolean;
  2246. procedure maybepushecx;
  2247. begin
  2248. if not(R_ECX in unused) then
  2249. begin
  2250. exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_L,R_ECX)));
  2251. ecxpushed:=true;
  2252. end
  2253. else getexplicitregister32(R_ECX);
  2254. end;
  2255. begin
  2256. {$IfNDef regallocfix}
  2257. If delsource then
  2258. del_reference(source);
  2259. {$EndIf regallocfix}
  2260. if (not loadref) and
  2261. ((size<=8) or
  2262. (not(cs_littlesize in aktglobalswitches ) and (size<=12))) then
  2263. begin
  2264. helpsize:=size shr 2;
  2265. {$ifndef noAllocEdi}
  2266. getexplicitregister32(R_EDI);
  2267. {$endif noAllocEdi}
  2268. for i:=1 to helpsize do
  2269. begin
  2270. emit_ref_reg(A_MOV,S_L,newreference(source),R_EDI);
  2271. {$ifdef regallocfix}
  2272. If (size = 4) and delsource then
  2273. del_reference(source);
  2274. {$endif regallocfix}
  2275. exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,R_EDI,newreference(dest))));
  2276. inc(source.offset,4);
  2277. inc(dest.offset,4);
  2278. dec(size,4);
  2279. end;
  2280. if size>1 then
  2281. begin
  2282. emit_ref_reg(A_MOV,S_W,newreference(source),R_DI);
  2283. {$ifdef regallocfix}
  2284. If (size = 2) and delsource then
  2285. del_reference(source);
  2286. {$endif regallocfix}
  2287. exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_W,R_DI,newreference(dest))));
  2288. inc(source.offset,2);
  2289. inc(dest.offset,2);
  2290. dec(size,2);
  2291. end;
  2292. {$ifndef noAllocEdi}
  2293. ungetregister32(R_EDI);
  2294. {$endif noAllocEdi}
  2295. if size>0 then
  2296. begin
  2297. { and now look for an 8 bit register }
  2298. swap:=false;
  2299. if R_EAX in unused then reg8:=reg32toreg8(getexplicitregister32(R_EAX))
  2300. else if R_EDX in unused then reg8:=reg32toreg8(getexplicitregister32(R_EDX))
  2301. else if R_EBX in unused then reg8:=reg32toreg8(getexplicitregister32(R_EBX))
  2302. else if R_ECX in unused then reg8:=reg32toreg8(getexplicitregister32(R_ECX))
  2303. else
  2304. begin
  2305. swap:=true;
  2306. { we need only to check 3 registers, because }
  2307. { one is always not index or base }
  2308. if (dest.base<>R_EAX) and (dest.index<>R_EAX) then
  2309. begin
  2310. reg8:=R_AL;
  2311. reg32:=R_EAX;
  2312. end
  2313. else if (dest.base<>R_EBX) and (dest.index<>R_EBX) then
  2314. begin
  2315. reg8:=R_BL;
  2316. reg32:=R_EBX;
  2317. end
  2318. else if (dest.base<>R_ECX) and (dest.index<>R_ECX) then
  2319. begin
  2320. reg8:=R_CL;
  2321. reg32:=R_ECX;
  2322. end;
  2323. end;
  2324. if swap then
  2325. { was earlier XCHG, of course nonsense }
  2326. begin
  2327. {$ifndef noAllocEdi}
  2328. getexplicitregister32(R_EDI);
  2329. {$endif noAllocEdi}
  2330. emit_reg_reg(A_MOV,S_L,reg32,R_EDI);
  2331. end;
  2332. emit_ref_reg(A_MOV,S_B,newreference(source),reg8);
  2333. {$ifdef regallocfix}
  2334. If delsource then
  2335. del_reference(source);
  2336. {$endif regallocfix}
  2337. exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_B,reg8,newreference(dest))));
  2338. if swap then
  2339. begin
  2340. emit_reg_reg(A_MOV,S_L,R_EDI,reg32);
  2341. {$ifndef noAllocEdi}
  2342. ungetregister32(R_EDI);
  2343. {$endif noAllocEdi}
  2344. end
  2345. else
  2346. ungetregister(reg8);
  2347. end;
  2348. end
  2349. else
  2350. begin
  2351. {$ifndef noAllocEdi}
  2352. getexplicitregister32(R_EDI);
  2353. {$endif noAllocEdi}
  2354. emit_ref_reg(A_LEA,S_L,newreference(dest),R_EDI);
  2355. {$ifdef regallocfix}
  2356. {is this ok?? (JM)}
  2357. del_reference(dest);
  2358. {$endif regallocfix}
  2359. {$ifndef noAllocEdi}
  2360. exprasmlist^.concat(new(pairegalloc,alloc(R_ESI)));
  2361. {$endif noAllocEdi}
  2362. if loadref then
  2363. emit_ref_reg(A_MOV,S_L,newreference(source),R_ESI)
  2364. else
  2365. begin
  2366. emit_ref_reg(A_LEA,S_L,newreference(source),R_ESI);
  2367. {$ifdef regallocfix}
  2368. if delsource then
  2369. del_reference(source);
  2370. {$endif regallocfix}
  2371. end;
  2372. exprasmlist^.concat(new(paicpu,op_none(A_CLD,S_NO)));
  2373. ecxpushed:=false;
  2374. if cs_littlesize in aktglobalswitches then
  2375. begin
  2376. maybepushecx;
  2377. emit_const_reg(A_MOV,S_L,size,R_ECX);
  2378. exprasmlist^.concat(new(paicpu,op_none(A_REP,S_NO)));
  2379. exprasmlist^.concat(new(paicpu,op_none(A_MOVSB,S_NO)));
  2380. end
  2381. else
  2382. begin
  2383. helpsize:=size shr 2;
  2384. size:=size and 3;
  2385. if helpsize>1 then
  2386. begin
  2387. maybepushecx;
  2388. emit_const_reg(A_MOV,S_L,helpsize,R_ECX);
  2389. exprasmlist^.concat(new(paicpu,op_none(A_REP,S_NO)));
  2390. end;
  2391. if helpsize>0 then
  2392. exprasmlist^.concat(new(paicpu,op_none(A_MOVSD,S_NO)));
  2393. if size>1 then
  2394. begin
  2395. dec(size,2);
  2396. exprasmlist^.concat(new(paicpu,op_none(A_MOVSW,S_NO)));
  2397. end;
  2398. if size=1 then
  2399. exprasmlist^.concat(new(paicpu,op_none(A_MOVSB,S_NO)));
  2400. end;
  2401. {$ifndef noAllocEdi}
  2402. ungetregister32(R_EDI);
  2403. exprasmlist^.concat(new(pairegalloc,dealloc(R_ESI)));
  2404. {$endif noAllocEdi}
  2405. if ecxpushed then
  2406. exprasmlist^.concat(new(paicpu,op_reg(A_POP,S_L,R_ECX)))
  2407. else
  2408. ungetregister32(R_ECX);
  2409. { loading SELF-reference again }
  2410. maybe_loadesi;
  2411. end;
  2412. if delsource then
  2413. ungetiftemp(source);
  2414. end;
  2415. procedure emitloadord2reg(const location:Tlocation;orddef:Porddef;
  2416. destreg:Tregister;delloc:boolean);
  2417. {A lot smaller and less bug sensitive than the original unfolded loads.}
  2418. var tai:Paicpu;
  2419. r:Preference;
  2420. begin
  2421. tai := nil;
  2422. case location.loc of
  2423. LOC_REGISTER,LOC_CREGISTER:
  2424. begin
  2425. case orddef^.typ of
  2426. u8bit:
  2427. tai:=new(paicpu,op_reg_reg(A_MOVZX,S_BL,location.register,destreg));
  2428. s8bit:
  2429. tai:=new(paicpu,op_reg_reg(A_MOVSX,S_BL,location.register,destreg));
  2430. u16bit:
  2431. tai:=new(paicpu,op_reg_reg(A_MOVZX,S_WL,location.register,destreg));
  2432. s16bit:
  2433. tai:=new(paicpu,op_reg_reg(A_MOVSX,S_WL,location.register,destreg));
  2434. u32bit,s32bit:
  2435. if location.register <> destreg then
  2436. tai:=new(paicpu,op_reg_reg(A_MOV,S_L,location.register,destreg));
  2437. end;
  2438. if delloc then
  2439. ungetregister(location.register);
  2440. end;
  2441. LOC_MEM,
  2442. LOC_REFERENCE:
  2443. begin
  2444. if location.reference.is_immediate then
  2445. tai:=new(paicpu,op_const_reg(A_MOV,S_L,location.reference.offset,destreg))
  2446. else
  2447. begin
  2448. r:=newreference(location.reference);
  2449. case orddef^.typ of
  2450. u8bit:
  2451. tai:=new(paicpu,op_ref_reg(A_MOVZX,S_BL,r,destreg));
  2452. s8bit:
  2453. tai:=new(paicpu,op_ref_reg(A_MOVSX,S_BL,r,destreg));
  2454. u16bit:
  2455. tai:=new(paicpu,op_ref_reg(A_MOVZX,S_WL,r,destreg));
  2456. s16bit:
  2457. tai:=new(paicpu,op_ref_reg(A_MOVSX,S_WL,r,destreg));
  2458. u32bit:
  2459. tai:=new(paicpu,op_ref_reg(A_MOV,S_L,r,destreg));
  2460. s32bit:
  2461. tai:=new(paicpu,op_ref_reg(A_MOV,S_L,r,destreg));
  2462. end;
  2463. end;
  2464. if delloc then
  2465. del_reference(location.reference);
  2466. end
  2467. else
  2468. internalerror(6);
  2469. end;
  2470. if assigned(tai) then
  2471. exprasmlist^.concat(tai);
  2472. end;
  2473. { if necessary ESI is reloaded after a call}
  2474. procedure maybe_loadesi;
  2475. var
  2476. hp : preference;
  2477. p : pprocinfo;
  2478. i : longint;
  2479. begin
  2480. if assigned(procinfo^._class) then
  2481. begin
  2482. {$ifndef noAllocEdi}
  2483. exprasmlist^.concat(new(pairegalloc,alloc(R_ESI)));
  2484. {$endif noAllocEdi}
  2485. if lexlevel>normal_function_level then
  2486. begin
  2487. new(hp);
  2488. reset_reference(hp^);
  2489. hp^.offset:=procinfo^.framepointer_offset;
  2490. hp^.base:=procinfo^.framepointer;
  2491. emit_ref_reg(A_MOV,S_L,hp,R_ESI);
  2492. p:=procinfo^.parent;
  2493. for i:=3 to lexlevel-1 do
  2494. begin
  2495. new(hp);
  2496. reset_reference(hp^);
  2497. hp^.offset:=p^.framepointer_offset;
  2498. hp^.base:=R_ESI;
  2499. emit_ref_reg(A_MOV,S_L,hp,R_ESI);
  2500. p:=p^.parent;
  2501. end;
  2502. new(hp);
  2503. reset_reference(hp^);
  2504. hp^.offset:=p^.selfpointer_offset;
  2505. hp^.base:=R_ESI;
  2506. emit_ref_reg(A_MOV,S_L,hp,R_ESI);
  2507. end
  2508. else
  2509. begin
  2510. new(hp);
  2511. reset_reference(hp^);
  2512. hp^.offset:=procinfo^.selfpointer_offset;
  2513. hp^.base:=procinfo^.framepointer;
  2514. emit_ref_reg(A_MOV,S_L,hp,R_ESI);
  2515. end;
  2516. end;
  2517. end;
  2518. { DO NOT RELY on the fact that the ptree is not yet swaped
  2519. because of inlining code PM }
  2520. procedure firstcomplex(p : ptree);
  2521. var
  2522. hp : ptree;
  2523. begin
  2524. { always calculate boolean AND and OR from left to right }
  2525. if (p^.treetype in [orn,andn]) and
  2526. (p^.left^.resulttype^.deftype=orddef) and
  2527. (porddef(p^.left^.resulttype)^.typ in [bool8bit,bool16bit,bool32bit]) then
  2528. begin
  2529. { p^.swaped:=false}
  2530. if p^.swaped then
  2531. internalerror(234234);
  2532. end
  2533. else
  2534. if (p^.left^.registers32<p^.right^.registers32) and
  2535. { the following check is appropriate, because all }
  2536. { 4 registers are rarely used and it is thereby }
  2537. { achieved that the extra code is being dropped }
  2538. { by exchanging not commutative operators }
  2539. (p^.right^.registers32<=4) then
  2540. begin
  2541. hp:=p^.left;
  2542. p^.left:=p^.right;
  2543. p^.right:=hp;
  2544. p^.swaped:=not p^.swaped;
  2545. end;
  2546. {else
  2547. p^.swaped:=false; do not modify }
  2548. end;
  2549. {*****************************************************************************
  2550. Entry/Exit Code Functions
  2551. *****************************************************************************}
  2552. procedure genprofilecode;
  2553. var
  2554. pl : pasmlabel;
  2555. begin
  2556. if (po_assembler in aktprocsym^.definition^.procoptions) then
  2557. exit;
  2558. case target_info.target of
  2559. target_i386_freebsd,
  2560. target_i386_linux:
  2561. begin
  2562. getaddrlabel(pl);
  2563. emitcall('mcount');
  2564. exprasmlist^.insert(new(paicpu,op_sym_ofs_reg(A_MOV,S_L,pl,0,R_EDX)));
  2565. exprasmlist^.insert(new(pai_section,init(sec_code)));
  2566. exprasmlist^.insert(new(pai_const,init_32bit(0)));
  2567. exprasmlist^.insert(new(pai_label,init(pl)));
  2568. exprasmlist^.insert(new(pai_align,init(4)));
  2569. exprasmlist^.insert(new(pai_section,init(sec_data)));
  2570. end;
  2571. target_i386_go32v2:
  2572. begin
  2573. emitinsertcall('MCOUNT');
  2574. end;
  2575. end;
  2576. end;
  2577. procedure generate_interrupt_stackframe_entry;
  2578. begin
  2579. { save the registers of an interrupt procedure }
  2580. exprasmlist^.insert(new(paicpu,op_reg(A_PUSH,S_L,R_EAX)));
  2581. exprasmlist^.insert(new(paicpu,op_reg(A_PUSH,S_L,R_EBX)));
  2582. exprasmlist^.insert(new(paicpu,op_reg(A_PUSH,S_L,R_ECX)));
  2583. exprasmlist^.insert(new(paicpu,op_reg(A_PUSH,S_L,R_EDX)));
  2584. exprasmlist^.insert(new(paicpu,op_reg(A_PUSH,S_L,R_ESI)));
  2585. exprasmlist^.insert(new(paicpu,op_reg(A_PUSH,S_L,R_EDI)));
  2586. { .... also the segment registers }
  2587. exprasmlist^.insert(new(paicpu,op_reg(A_PUSH,S_W,R_DS)));
  2588. exprasmlist^.insert(new(paicpu,op_reg(A_PUSH,S_W,R_ES)));
  2589. exprasmlist^.insert(new(paicpu,op_reg(A_PUSH,S_W,R_FS)));
  2590. exprasmlist^.insert(new(paicpu,op_reg(A_PUSH,S_W,R_GS)));
  2591. end;
  2592. procedure generate_interrupt_stackframe_exit;
  2593. begin
  2594. { restore the registers of an interrupt procedure }
  2595. { this was all with entrycode instead of exitcode !!}
  2596. procinfo^.aktexitcode^.concat(new(paicpu,op_reg(A_POP,S_L,R_EAX)));
  2597. procinfo^.aktexitcode^.concat(new(paicpu,op_reg(A_POP,S_L,R_EBX)));
  2598. procinfo^.aktexitcode^.concat(new(paicpu,op_reg(A_POP,S_L,R_ECX)));
  2599. procinfo^.aktexitcode^.concat(new(paicpu,op_reg(A_POP,S_L,R_EDX)));
  2600. procinfo^.aktexitcode^.concat(new(paicpu,op_reg(A_POP,S_L,R_ESI)));
  2601. procinfo^.aktexitcode^.concat(new(paicpu,op_reg(A_POP,S_L,R_EDI)));
  2602. { .... also the segment registers }
  2603. procinfo^.aktexitcode^.concat(new(paicpu,op_reg(A_POP,S_W,R_DS)));
  2604. procinfo^.aktexitcode^.concat(new(paicpu,op_reg(A_POP,S_W,R_ES)));
  2605. procinfo^.aktexitcode^.concat(new(paicpu,op_reg(A_POP,S_W,R_FS)));
  2606. procinfo^.aktexitcode^.concat(new(paicpu,op_reg(A_POP,S_W,R_GS)));
  2607. { this restores the flags }
  2608. procinfo^.aktexitcode^.concat(new(paicpu,op_none(A_IRET,S_NO)));
  2609. end;
  2610. { generates the code for threadvar initialisation }
  2611. procedure initialize_threadvar(p : pnamedindexobject);{$ifndef FPC}far;{$endif}
  2612. var
  2613. hr : treference;
  2614. begin
  2615. if (psym(p)^.typ=varsym) and
  2616. (vo_is_thread_var in pvarsym(p)^.varoptions) then
  2617. begin
  2618. exprasmlist^.concat(new(paicpu,op_const(A_PUSH,S_L,pvarsym(p)^.getsize)));
  2619. reset_reference(hr);
  2620. hr.symbol:=newasmsymbol(pvarsym(p)^.mangledname);
  2621. emitpushreferenceaddr(hr);
  2622. emitcall('FPC_INIT_THREADVAR');
  2623. end;
  2624. end;
  2625. { initilizes data of type t }
  2626. { if is_already_ref is true then the routines assumes }
  2627. { that r points to the data to initialize }
  2628. procedure initialize(t : pdef;const ref : treference;is_already_ref : boolean);
  2629. var
  2630. hr : treference;
  2631. begin
  2632. if is_ansistring(t) or
  2633. is_widestring(t) then
  2634. begin
  2635. emit_const_ref(A_MOV,S_L,0,
  2636. newreference(ref));
  2637. end
  2638. else
  2639. begin
  2640. reset_reference(hr);
  2641. hr.symbol:=t^.get_inittable_label;
  2642. emitpushreferenceaddr(hr);
  2643. if is_already_ref then
  2644. exprasmlist^.concat(new(paicpu,op_ref(A_PUSH,S_L,
  2645. newreference(ref))))
  2646. else
  2647. emitpushreferenceaddr(ref);
  2648. emitcall('FPC_INITIALIZE');
  2649. end;
  2650. end;
  2651. { finalizes data of type t }
  2652. { if is_already_ref is true then the routines assumes }
  2653. { that r points to the data to finalizes }
  2654. procedure finalize(t : pdef;const ref : treference;is_already_ref : boolean);
  2655. var
  2656. r : treference;
  2657. begin
  2658. if is_ansistring(t) or
  2659. is_widestring(t) then
  2660. begin
  2661. decrstringref(t,ref);
  2662. end
  2663. else
  2664. begin
  2665. reset_reference(r);
  2666. r.symbol:=t^.get_inittable_label;
  2667. emitpushreferenceaddr(r);
  2668. if is_already_ref then
  2669. exprasmlist^.concat(new(paicpu,op_ref(A_PUSH,S_L,
  2670. newreference(ref))))
  2671. else
  2672. emitpushreferenceaddr(ref);
  2673. emitcall('FPC_FINALIZE');
  2674. end;
  2675. end;
  2676. { generates the code for initialisation of local data }
  2677. procedure initialize_data(p : pnamedindexobject);{$ifndef FPC}far;{$endif}
  2678. var
  2679. hr : treference;
  2680. begin
  2681. if (psym(p)^.typ=varsym) and
  2682. assigned(pvarsym(p)^.vartype.def) and
  2683. not((pvarsym(p)^.vartype.def^.deftype=objectdef) and
  2684. pobjectdef(pvarsym(p)^.vartype.def)^.is_class) and
  2685. pvarsym(p)^.vartype.def^.needs_inittable then
  2686. begin
  2687. if assigned(procinfo) then
  2688. procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally;
  2689. reset_reference(hr);
  2690. if psym(p)^.owner^.symtabletype in [localsymtable,inlinelocalsymtable] then
  2691. begin
  2692. hr.base:=procinfo^.framepointer;
  2693. hr.offset:=-pvarsym(p)^.address+pvarsym(p)^.owner^.address_fixup;
  2694. end
  2695. else
  2696. begin
  2697. hr.symbol:=newasmsymbol(pvarsym(p)^.mangledname);
  2698. end;
  2699. initialize(pvarsym(p)^.vartype.def,hr,false);
  2700. end;
  2701. end;
  2702. { generates the code for incrementing the reference count of parameters }
  2703. procedure incr_data(p : pnamedindexobject);{$ifndef FPC}far;{$endif}
  2704. var
  2705. hr : treference;
  2706. begin
  2707. if (psym(p)^.typ=varsym) and
  2708. not((pvarsym(p)^.vartype.def^.deftype=objectdef) and
  2709. pobjectdef(pvarsym(p)^.vartype.def)^.is_class) and
  2710. pvarsym(p)^.vartype.def^.needs_inittable and
  2711. (not assigned(pvarsym(p)^.localvarsym)) and
  2712. ((pvarsym(p)^.varspez=vs_value) {or
  2713. (pvarsym(p)^.varspez=vs_const) and
  2714. not(dont_copy_const_param(pvarsym(p)^.definition))}) then
  2715. begin
  2716. procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally;
  2717. reset_reference(hr);
  2718. hr.symbol:=pvarsym(p)^.vartype.def^.get_inittable_label;
  2719. emitpushreferenceaddr(hr);
  2720. reset_reference(hr);
  2721. hr.base:=procinfo^.framepointer;
  2722. hr.offset:=pvarsym(p)^.address+procinfo^.para_offset;
  2723. emitpushreferenceaddr(hr);
  2724. reset_reference(hr);
  2725. emitcall('FPC_ADDREF');
  2726. end;
  2727. end;
  2728. { generates the code for finalisation of local data }
  2729. procedure finalize_data(p : pnamedindexobject);{$ifndef FPC}far;{$endif}
  2730. var
  2731. hr : treference;
  2732. begin
  2733. if (psym(p)^.typ=varsym) and
  2734. assigned(pvarsym(p)^.vartype.def) and
  2735. not((pvarsym(p)^.vartype.def^.deftype=objectdef) and
  2736. pobjectdef(pvarsym(p)^.vartype.def)^.is_class) and
  2737. (not assigned(pvarsym(p)^.localvarsym)) and
  2738. pvarsym(p)^.vartype.def^.needs_inittable then
  2739. begin
  2740. { not all kind of parameters need to be finalized }
  2741. if (psym(p)^.owner^.symtabletype=parasymtable) and
  2742. (pvarsym(p)^.varspez in [vs_out,vs_var,vs_const]) then
  2743. exit;
  2744. if assigned(procinfo) then
  2745. procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally;
  2746. reset_reference(hr);
  2747. case psym(p)^.owner^.symtabletype of
  2748. localsymtable,inlinelocalsymtable:
  2749. begin
  2750. hr.base:=procinfo^.framepointer;
  2751. hr.offset:=-pvarsym(p)^.address+pvarsym(p)^.owner^.address_fixup;
  2752. end;
  2753. parasymtable,inlineparasymtable:
  2754. begin
  2755. hr.base:=procinfo^.framepointer;
  2756. hr.offset:=pvarsym(p)^.address+procinfo^.para_offset;
  2757. end;
  2758. else
  2759. hr.symbol:=newasmsymbol(pvarsym(p)^.mangledname);
  2760. end;
  2761. finalize(pvarsym(p)^.vartype.def,hr,false);
  2762. end;
  2763. end;
  2764. { generates the code to make local copies of the value parameters }
  2765. procedure copyvalueparas(p : pnamedindexobject);{$ifndef fpc}far;{$endif}
  2766. var
  2767. href1,href2 : treference;
  2768. r : preference;
  2769. power,len : longint;
  2770. opsize : topsize;
  2771. again,ok : pasmlabel;
  2772. begin
  2773. if (psym(p)^.typ=varsym) and
  2774. (pvarsym(p)^.varspez=vs_value) and
  2775. (push_addr_param(pvarsym(p)^.vartype.def)) then
  2776. begin
  2777. if is_open_array(pvarsym(p)^.vartype.def) or
  2778. is_array_of_const(pvarsym(p)^.vartype.def) then
  2779. begin
  2780. { get stack space }
  2781. new(r);
  2782. reset_reference(r^);
  2783. r^.base:=procinfo^.framepointer;
  2784. r^.offset:=pvarsym(p)^.address+4+procinfo^.para_offset;
  2785. {$ifndef noAllocEdi}
  2786. getexplicitregister32(R_EDI);
  2787. {$endif noAllocEdi}
  2788. exprasmlist^.concat(new(paicpu,
  2789. op_ref_reg(A_MOV,S_L,r,R_EDI)));
  2790. exprasmlist^.concat(new(paicpu,
  2791. op_reg(A_INC,S_L,R_EDI)));
  2792. if (parraydef(pvarsym(p)^.vartype.def)^.elesize<>1) then
  2793. begin
  2794. if ispowerof2(parraydef(pvarsym(p)^.vartype.def)^.elesize, power) then
  2795. exprasmlist^.concat(new(paicpu,
  2796. op_const_reg(A_SHL,S_L,
  2797. power,R_EDI)))
  2798. else
  2799. exprasmlist^.concat(new(paicpu,
  2800. op_const_reg(A_IMUL,S_L,
  2801. parraydef(pvarsym(p)^.vartype.def)^.elesize,R_EDI)));
  2802. end;
  2803. {$ifndef NOTARGETWIN32}
  2804. { windows guards only a few pages for stack growing, }
  2805. { so we have to access every page first }
  2806. if target_os.id=os_i386_win32 then
  2807. begin
  2808. getlabel(again);
  2809. getlabel(ok);
  2810. emitlab(again);
  2811. exprasmlist^.concat(new(paicpu,
  2812. op_const_reg(A_CMP,S_L,winstackpagesize,R_EDI)));
  2813. emitjmp(C_C,ok);
  2814. exprasmlist^.concat(new(paicpu,
  2815. op_const_reg(A_SUB,S_L,winstackpagesize-4,R_ESP)));
  2816. exprasmlist^.concat(new(paicpu,
  2817. op_reg(A_PUSH,S_L,R_EAX)));
  2818. exprasmlist^.concat(new(paicpu,
  2819. op_const_reg(A_SUB,S_L,winstackpagesize,R_EDI)));
  2820. emitjmp(C_None,again);
  2821. emitlab(ok);
  2822. exprasmlist^.concat(new(paicpu,
  2823. op_reg_reg(A_SUB,S_L,R_EDI,R_ESP)));
  2824. {$ifndef noAllocEdi}
  2825. ungetregister32(R_EDI);
  2826. {$endif noAllocEdi}
  2827. { now reload EDI }
  2828. new(r);
  2829. reset_reference(r^);
  2830. r^.base:=procinfo^.framepointer;
  2831. r^.offset:=pvarsym(p)^.address+4+procinfo^.para_offset;
  2832. {$ifndef noAllocEdi}
  2833. getexplicitregister32(R_EDI);
  2834. {$endif noAllocEdi}
  2835. exprasmlist^.concat(new(paicpu,
  2836. op_ref_reg(A_MOV,S_L,r,R_EDI)));
  2837. exprasmlist^.concat(new(paicpu,
  2838. op_reg(A_INC,S_L,R_EDI)));
  2839. if (parraydef(pvarsym(p)^.vartype.def)^.elesize<>1) then
  2840. begin
  2841. if ispowerof2(parraydef(pvarsym(p)^.vartype.def)^.elesize, power) then
  2842. exprasmlist^.concat(new(paicpu,
  2843. op_const_reg(A_SHL,S_L,
  2844. power,R_EDI)))
  2845. else
  2846. exprasmlist^.concat(new(paicpu,
  2847. op_const_reg(A_IMUL,S_L,
  2848. parraydef(pvarsym(p)^.vartype.def)^.elesize,R_EDI)));
  2849. end;
  2850. end
  2851. else
  2852. {$endif NOTARGETWIN32}
  2853. exprasmlist^.concat(new(paicpu,
  2854. op_reg_reg(A_SUB,S_L,R_EDI,R_ESP)));
  2855. { load destination }
  2856. exprasmlist^.concat(new(paicpu,
  2857. op_reg_reg(A_MOV,S_L,R_ESP,R_EDI)));
  2858. { don't destroy the registers! }
  2859. exprasmlist^.concat(new(paicpu,
  2860. op_reg(A_PUSH,S_L,R_ECX)));
  2861. exprasmlist^.concat(new(paicpu,
  2862. op_reg(A_PUSH,S_L,R_ESI)));
  2863. { load count }
  2864. new(r);
  2865. reset_reference(r^);
  2866. r^.base:=procinfo^.framepointer;
  2867. r^.offset:=pvarsym(p)^.address+4+procinfo^.para_offset;
  2868. exprasmlist^.concat(new(paicpu,
  2869. op_ref_reg(A_MOV,S_L,r,R_ECX)));
  2870. { load source }
  2871. new(r);
  2872. reset_reference(r^);
  2873. r^.base:=procinfo^.framepointer;
  2874. r^.offset:=pvarsym(p)^.address+procinfo^.para_offset;
  2875. exprasmlist^.concat(new(paicpu,
  2876. op_ref_reg(A_MOV,S_L,r,R_ESI)));
  2877. { scheduled .... }
  2878. exprasmlist^.concat(new(paicpu,
  2879. op_reg(A_INC,S_L,R_ECX)));
  2880. { calculate size }
  2881. len:=parraydef(pvarsym(p)^.vartype.def)^.elesize;
  2882. opsize:=S_B;
  2883. if (len and 3)=0 then
  2884. begin
  2885. opsize:=S_L;
  2886. len:=len shr 2;
  2887. end
  2888. else
  2889. if (len and 1)=0 then
  2890. begin
  2891. opsize:=S_W;
  2892. len:=len shr 1;
  2893. end;
  2894. if ispowerof2(len, power) then
  2895. exprasmlist^.concat(new(paicpu,
  2896. op_const_reg(A_SHL,S_L,
  2897. power,R_ECX)))
  2898. else
  2899. exprasmlist^.concat(new(paicpu,
  2900. op_const_reg(A_IMUL,S_L,len,R_ECX)));
  2901. exprasmlist^.concat(new(paicpu,
  2902. op_none(A_REP,S_NO)));
  2903. case opsize of
  2904. S_B : exprasmlist^.concat(new(paicpu,op_none(A_MOVSB,S_NO)));
  2905. S_W : exprasmlist^.concat(new(paicpu,op_none(A_MOVSW,S_NO)));
  2906. S_L : exprasmlist^.concat(new(paicpu,op_none(A_MOVSD,S_NO)));
  2907. end;
  2908. {$ifndef noAllocEdi}
  2909. ungetregister32(R_EDI);
  2910. {$endif noAllocEdi}
  2911. exprasmlist^.concat(new(paicpu,
  2912. op_reg(A_POP,S_L,R_ESI)));
  2913. exprasmlist^.concat(new(paicpu,
  2914. op_reg(A_POP,S_L,R_ECX)));
  2915. { patch the new address }
  2916. new(r);
  2917. reset_reference(r^);
  2918. r^.base:=procinfo^.framepointer;
  2919. r^.offset:=pvarsym(p)^.address+procinfo^.para_offset;
  2920. exprasmlist^.concat(new(paicpu,
  2921. op_reg_ref(A_MOV,S_L,R_ESP,r)));
  2922. end
  2923. else
  2924. if is_shortstring(pvarsym(p)^.vartype.def) then
  2925. begin
  2926. reset_reference(href1);
  2927. href1.base:=procinfo^.framepointer;
  2928. href1.offset:=pvarsym(p)^.address+procinfo^.para_offset;
  2929. reset_reference(href2);
  2930. href2.base:=procinfo^.framepointer;
  2931. href2.offset:=-pvarsym(p)^.localvarsym^.address+pvarsym(p)^.localvarsym^.owner^.address_fixup;
  2932. copyshortstring(href2,href1,pstringdef(pvarsym(p)^.vartype.def)^.len,true,false);
  2933. end
  2934. else
  2935. begin
  2936. reset_reference(href1);
  2937. href1.base:=procinfo^.framepointer;
  2938. href1.offset:=pvarsym(p)^.address+procinfo^.para_offset;
  2939. reset_reference(href2);
  2940. href2.base:=procinfo^.framepointer;
  2941. href2.offset:=-pvarsym(p)^.localvarsym^.address+pvarsym(p)^.localvarsym^.owner^.address_fixup;
  2942. concatcopy(href1,href2,pvarsym(p)^.vartype.def^.size,true,true);
  2943. end;
  2944. end;
  2945. end;
  2946. procedure inittempansistrings;
  2947. var
  2948. hp : ptemprecord;
  2949. r : preference;
  2950. begin
  2951. hp:=templist;
  2952. while assigned(hp) do
  2953. begin
  2954. if hp^.temptype in [tt_ansistring,tt_freeansistring] then
  2955. begin
  2956. procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally;
  2957. new(r);
  2958. reset_reference(r^);
  2959. r^.base:=procinfo^.framepointer;
  2960. r^.offset:=hp^.pos;
  2961. emit_const_ref(A_MOV,S_L,0,r);
  2962. end;
  2963. hp:=hp^.next;
  2964. end;
  2965. end;
  2966. procedure finalizetempansistrings;
  2967. var
  2968. hp : ptemprecord;
  2969. hr : treference;
  2970. begin
  2971. hp:=templist;
  2972. while assigned(hp) do
  2973. begin
  2974. if hp^.temptype in [tt_ansistring,tt_freeansistring] then
  2975. begin
  2976. procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally;
  2977. reset_reference(hr);
  2978. hr.base:=procinfo^.framepointer;
  2979. hr.offset:=hp^.pos;
  2980. emitpushreferenceaddr(hr);
  2981. emitcall('FPC_ANSISTR_DECR_REF');
  2982. end;
  2983. hp:=hp^.next;
  2984. end;
  2985. end;
  2986. var
  2987. ls : longint;
  2988. procedure largest_size(p : pnamedindexobject);{$ifndef FPC}far;{$endif}
  2989. begin
  2990. if (psym(p)^.typ=varsym) and
  2991. (pvarsym(p)^.getvaluesize>ls) then
  2992. ls:=pvarsym(p)^.getvaluesize;
  2993. end;
  2994. procedure alignstack(alist : paasmoutput);
  2995. begin
  2996. {$ifdef dummy}
  2997. if (cs_optimize in aktglobalswitches) and
  2998. (aktoptprocessor in [classp5,classp6]) then
  2999. begin
  3000. ls:=0;
  3001. aktprocsym^.definition^.localst^.foreach({$ifndef TP}@{$endif}largest_size);
  3002. if ls>=8 then
  3003. alist^.insert(new(paicpu,op_const_reg(A_AND,S_L,-8,R_ESP)));
  3004. end;
  3005. {$endif dummy}
  3006. end;
  3007. procedure genentrycode(alist : paasmoutput;const proc_names:Tstringcontainer;make_global:boolean;
  3008. stackframe:longint;
  3009. var parasize:longint;var nostackframe:boolean;
  3010. inlined : boolean);
  3011. {
  3012. Generates the entry code for a procedure
  3013. }
  3014. var
  3015. hs : string;
  3016. {$ifdef GDB}
  3017. stab_function_name : Pai_stab_function_name;
  3018. {$endif GDB}
  3019. hr : preference;
  3020. p : psymtable;
  3021. r : treference;
  3022. oldlist,
  3023. oldexprasmlist : paasmoutput;
  3024. again : pasmlabel;
  3025. i : longint;
  3026. begin
  3027. oldexprasmlist:=exprasmlist;
  3028. exprasmlist:=alist;
  3029. if (not inlined) and (aktprocsym^.definition^.proctypeoption=potype_proginit) then
  3030. begin
  3031. emitinsertcall('FPC_INITIALIZEUNITS');
  3032. if target_info.target=target_I386_WIN32 then
  3033. begin
  3034. new(hr);
  3035. reset_reference(hr^);
  3036. hr^.symbol:=newasmsymbol(
  3037. 'U_SYSWIN32_ISCONSOLE');
  3038. if apptype=at_cui then
  3039. exprasmlist^.insert(new(paicpu,op_const_ref(A_MOV,S_B,
  3040. 1,hr)))
  3041. else
  3042. exprasmlist^.insert(new(paicpu,op_const_ref(A_MOV,S_B,
  3043. 0,hr)));
  3044. end;
  3045. oldlist:=exprasmlist;
  3046. exprasmlist:=new(paasmoutput,init);
  3047. p:=symtablestack;
  3048. while assigned(p) do
  3049. begin
  3050. p^.foreach({$ifndef TP}@{$endif}initialize_threadvar);
  3051. p:=p^.next;
  3052. end;
  3053. oldlist^.insertlist(exprasmlist);
  3054. dispose(exprasmlist,done);
  3055. exprasmlist:=oldlist;
  3056. end;
  3057. {$ifdef GDB}
  3058. if (not inlined) and (cs_debuginfo in aktmoduleswitches) then
  3059. exprasmlist^.insert(new(pai_force_line,init));
  3060. {$endif GDB}
  3061. { a constructor needs a help procedure }
  3062. if (aktprocsym^.definition^.proctypeoption=potype_constructor) then
  3063. begin
  3064. if procinfo^._class^.is_class then
  3065. begin
  3066. procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally;
  3067. exprasmlist^.insert(new(paicpu,op_cond_sym(A_Jcc,C_Z,S_NO,faillabel)));
  3068. emitinsertcall('FPC_NEW_CLASS');
  3069. end
  3070. else
  3071. begin
  3072. exprasmlist^.insert(new(paicpu,op_cond_sym(A_Jcc,C_Z,S_NO,faillabel)));
  3073. emitinsertcall('FPC_HELP_CONSTRUCTOR');
  3074. {$ifndef noAllocEdi}
  3075. getexplicitregister32(R_EDI);
  3076. {$endif noAllocEdi}
  3077. exprasmlist^.insert(new(paicpu,op_const_reg(A_MOV,S_L,procinfo^._class^.vmt_offset,R_EDI)));
  3078. end;
  3079. end;
  3080. { don't load ESI, does the caller }
  3081. { we must do it for local function }
  3082. { that can be called from a foreach }
  3083. { of another object than self !! PM }
  3084. if assigned(procinfo^._class) and
  3085. (lexlevel>normal_function_level) then
  3086. maybe_loadesi;
  3087. { When message method contains self as a parameter,
  3088. we must load it into ESI }
  3089. If (po_containsself in aktprocsym^.definition^.procoptions) then
  3090. begin
  3091. new(hr);
  3092. reset_reference(hr^);
  3093. hr^.offset:=procinfo^.selfpointer_offset;
  3094. hr^.base:=procinfo^.framepointer;
  3095. exprasmlist^.insert(new(paicpu,op_ref_reg(A_MOV,S_L,hr,R_ESI)));
  3096. {$ifndef noAllocEdi}
  3097. exprasmlist^.insert(new(pairegalloc,alloc(R_ESI)));
  3098. {$endif noAllocEdi}
  3099. end;
  3100. { should we save edi,esi,ebx like C ? }
  3101. if (po_savestdregs in aktprocsym^.definition^.procoptions) then
  3102. begin
  3103. if (aktprocsym^.definition^.usedregisters and ($80 shr byte(R_EBX)))<>0 then
  3104. exprasmlist^.insert(new(paicpu,op_reg(A_PUSH,S_L,R_EBX)));
  3105. exprasmlist^.insert(new(paicpu,op_reg(A_PUSH,S_L,R_ESI)));
  3106. exprasmlist^.insert(new(paicpu,op_reg(A_PUSH,S_L,R_EDI)));
  3107. end;
  3108. { for the save all registers we can simply use a pusha,popa which
  3109. push edi,esi,ebp,esp(ignored),ebx,edx,ecx,eax }
  3110. if (po_saveregisters in aktprocsym^.definition^.procoptions) then
  3111. begin
  3112. exprasmlist^.insert(new(paicpu,op_none(A_PUSHA,S_L)));
  3113. end;
  3114. { omit stack frame ? }
  3115. if not inlined then
  3116. if procinfo^.framepointer=stack_pointer then
  3117. begin
  3118. CGMessage(cg_d_stackframe_omited);
  3119. nostackframe:=true;
  3120. if (aktprocsym^.definition^.proctypeoption in [potype_unitinit,potype_proginit,potype_unitfinalize]) then
  3121. parasize:=0
  3122. else
  3123. parasize:=aktprocsym^.definition^.parast^.datasize+procinfo^.para_offset-4;
  3124. if stackframe<>0 then
  3125. exprasmlist^.insert(new(paicpu,
  3126. op_const_reg(A_SUB,S_L,stackframe,R_ESP)));
  3127. end
  3128. else
  3129. begin
  3130. alignstack(alist);
  3131. if (aktprocsym^.definition^.proctypeoption in [potype_unitinit,potype_proginit,potype_unitfinalize]) then
  3132. parasize:=0
  3133. else
  3134. parasize:=aktprocsym^.definition^.parast^.datasize+procinfo^.para_offset-8;
  3135. nostackframe:=false;
  3136. if stackframe<>0 then
  3137. begin
  3138. {$ifdef unused}
  3139. if (cs_littlesize in aktglobalswitches) and (stackframe<=65535) then
  3140. begin
  3141. if (cs_check_stack in aktlocalswitches) and
  3142. not(target_info.target in [target_386_freebsd,
  3143. target_i386_linux,target_i386_win32]) then
  3144. begin
  3145. emitinsertcall('FPC_STACKCHECK');
  3146. exprasmlist^.insert(new(paicpu,op_const(A_PUSH,S_L,stackframe)));
  3147. end;
  3148. if cs_profile in aktmoduleswitches then
  3149. genprofilecode;
  3150. { %edi is already saved when pocdecl is used
  3151. if ((target_info.target=target_linux) or (target_info.target=target_freebsd)) and
  3152. ((aktprocsym^.definition^.options and poexports)<>0) then
  3153. exprasmlist^.insert(new(Paicpu,op_reg(A_PUSH,S_L,R_EDI))); }
  3154. { ATTENTION:
  3155. never use ENTER in linux !!! (or freebsd MvdV)
  3156. the stack page fault does not support it PM }
  3157. exprasmlist^.insert(new(paicpu,op_const_const(A_ENTER,S_NO,stackframe,0)))
  3158. end
  3159. else
  3160. {$endif unused}
  3161. begin
  3162. { windows guards only a few pages for stack growing, }
  3163. { so we have to access every page first }
  3164. if (target_os.id=os_i386_win32) and
  3165. (stackframe>=winstackpagesize) then
  3166. begin
  3167. if stackframe div winstackpagesize<=5 then
  3168. begin
  3169. exprasmlist^.insert(new(paicpu,op_const_reg(A_SUB,S_L,stackframe-4,R_ESP)));
  3170. for i:=1 to stackframe div winstackpagesize do
  3171. begin
  3172. hr:=new_reference(R_ESP,stackframe-i*winstackpagesize);
  3173. exprasmlist^.concat(new(paicpu,
  3174. op_const_ref(A_MOV,S_L,0,hr)));
  3175. end;
  3176. exprasmlist^.concat(new(paicpu,
  3177. op_reg(A_PUSH,S_L,R_EAX)));
  3178. end
  3179. else
  3180. begin
  3181. getlabel(again);
  3182. {$ifndef noAllocEdi}
  3183. getexplicitregister32(R_EDI);
  3184. {$endif noAllocEdi}
  3185. exprasmlist^.concat(new(paicpu,
  3186. op_const_reg(A_MOV,S_L,stackframe div winstackpagesize,R_EDI)));
  3187. emitlab(again);
  3188. exprasmlist^.concat(new(paicpu,
  3189. op_const_reg(A_SUB,S_L,winstackpagesize-4,R_ESP)));
  3190. exprasmlist^.concat(new(paicpu,
  3191. op_reg(A_PUSH,S_L,R_EAX)));
  3192. exprasmlist^.concat(new(paicpu,
  3193. op_reg(A_DEC,S_L,R_EDI)));
  3194. emitjmp(C_NZ,again);
  3195. {$ifndef noAllocEdi}
  3196. ungetregister32(R_EDI);
  3197. {$endif noAllocEdi}
  3198. exprasmlist^.concat(new(paicpu,
  3199. op_const_reg(A_SUB,S_L,stackframe mod winstackpagesize,R_ESP)));
  3200. end
  3201. end
  3202. else
  3203. exprasmlist^.insert(new(paicpu,op_const_reg(A_SUB,S_L,stackframe,R_ESP)));
  3204. if (cs_check_stack in aktlocalswitches) and
  3205. not(target_info.target in [target_i386_freebsd,
  3206. target_i386_linux,target_i386_win32]) then
  3207. begin
  3208. emitinsertcall('FPC_STACKCHECK');
  3209. exprasmlist^.insert(new(paicpu,op_const(A_PUSH,S_L,stackframe)));
  3210. end;
  3211. if cs_profile in aktmoduleswitches then
  3212. genprofilecode;
  3213. exprasmlist^.insert(new(paicpu,op_reg_reg(A_MOV,S_L,R_ESP,R_EBP)));
  3214. exprasmlist^.insert(new(paicpu,op_reg(A_PUSH,S_L,R_EBP)));
  3215. end;
  3216. end { endif stackframe <> 0 }
  3217. else
  3218. begin
  3219. if cs_profile in aktmoduleswitches then
  3220. genprofilecode;
  3221. exprasmlist^.insert(new(paicpu,op_reg_reg(A_MOV,S_L,R_ESP,R_EBP)));
  3222. exprasmlist^.insert(new(paicpu,op_reg(A_PUSH,S_L,R_EBP)));
  3223. end;
  3224. end;
  3225. if (po_interrupt in aktprocsym^.definition^.procoptions) then
  3226. generate_interrupt_stackframe_entry;
  3227. { initialize return value }
  3228. if (procinfo^.returntype.def<>pdef(voiddef)) and
  3229. (procinfo^.returntype.def^.needs_inittable) and
  3230. ((procinfo^.returntype.def^.deftype<>objectdef) or
  3231. not(pobjectdef(procinfo^.returntype.def)^.is_class)) then
  3232. begin
  3233. procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally;
  3234. reset_reference(r);
  3235. r.offset:=procinfo^.return_offset;
  3236. r.base:=procinfo^.framepointer;
  3237. initialize(procinfo^.returntype.def,r,ret_in_param(procinfo^.returntype.def));
  3238. end;
  3239. { initialisize local data like ansistrings }
  3240. case aktprocsym^.definition^.proctypeoption of
  3241. potype_unitinit:
  3242. begin
  3243. { using current_module^.globalsymtable is hopefully }
  3244. { more robust than symtablestack and symtablestack^.next }
  3245. psymtable(current_module^.globalsymtable)^.foreach({$ifndef TP}@{$endif}initialize_data);
  3246. psymtable(current_module^.localsymtable)^.foreach({$ifndef TP}@{$endif}initialize_data);
  3247. end;
  3248. { units have seperate code for initilization and finalization }
  3249. potype_unitfinalize: ;
  3250. else
  3251. aktprocsym^.definition^.localst^.foreach({$ifndef TP}@{$endif}initialize_data);
  3252. end;
  3253. { generate copies of call by value parameters }
  3254. if not(po_assembler in aktprocsym^.definition^.procoptions) and
  3255. not (pocall_cdecl in aktprocsym^.definition^.proccalloptions) then
  3256. aktprocsym^.definition^.parast^.foreach({$ifndef TP}@{$endif}copyvalueparas);
  3257. { add a reference to all call by value/const parameters }
  3258. aktprocsym^.definition^.parast^.foreach({$ifndef TP}@{$endif}incr_data);
  3259. { initialisizes temp. ansi/wide string data }
  3260. inittempansistrings;
  3261. { do we need an exception frame because of ansi/widestrings ? }
  3262. if not inlined and
  3263. ((procinfo^.flags and pi_needs_implicit_finally)<>0) and
  3264. { but it's useless in init/final code of units }
  3265. not(aktprocsym^.definition^.proctypeoption in [potype_unitfinalize,potype_unitinit]) then
  3266. begin
  3267. usedinproc:=usedinproc or ($80 shr byte(R_EAX));
  3268. { Type of stack-frame must be pushed}
  3269. exprasmlist^.concat(new(paicpu,op_const(A_PUSH,S_L,1)));
  3270. emitcall('FPC_PUSHEXCEPTADDR');
  3271. exprasmlist^.concat(new(paicpu,
  3272. op_reg(A_PUSH,S_L,R_EAX)));
  3273. emitcall('FPC_SETJMP');
  3274. exprasmlist^.concat(new(paicpu,
  3275. op_reg(A_PUSH,S_L,R_EAX)));
  3276. exprasmlist^.concat(new(paicpu,
  3277. op_reg_reg(A_TEST,S_L,R_EAX,R_EAX)));
  3278. emitjmp(C_NE,aktexitlabel);
  3279. { probably we've to reload self here }
  3280. maybe_loadesi;
  3281. end;
  3282. if not inlined then
  3283. begin
  3284. if (cs_profile in aktmoduleswitches) or
  3285. (aktprocsym^.definition^.owner^.symtabletype=globalsymtable) or
  3286. (assigned(procinfo^._class) and (procinfo^._class^.owner^.symtabletype=globalsymtable)) then
  3287. make_global:=true;
  3288. hs:=proc_names.get;
  3289. {$ifdef GDB}
  3290. if (cs_debuginfo in aktmoduleswitches) and target_os.use_function_relative_addresses then
  3291. stab_function_name := new(pai_stab_function_name,init(strpnew(hs)));
  3292. {$EndIf GDB}
  3293. while hs<>'' do
  3294. begin
  3295. if make_global then
  3296. exprasmlist^.insert(new(pai_symbol,initname_global(hs,0)))
  3297. else
  3298. exprasmlist^.insert(new(pai_symbol,initname(hs,0)));
  3299. {$ifdef GDB}
  3300. if (cs_debuginfo in aktmoduleswitches) and
  3301. target_os.use_function_relative_addresses then
  3302. exprasmlist^.insert(new(pai_stab_function_name,init(strpnew(hs))));
  3303. {$endif GDB}
  3304. hs:=proc_names.get;
  3305. end;
  3306. if make_global or ((procinfo^.flags and pi_is_global) <> 0) then
  3307. aktprocsym^.is_global := True;
  3308. {$ifdef GDB}
  3309. if (cs_debuginfo in aktmoduleswitches) then
  3310. begin
  3311. if target_os.use_function_relative_addresses then
  3312. exprasmlist^.insert(stab_function_name);
  3313. exprasmlist^.insert(new(pai_stabs,init(aktprocsym^.stabstring)));
  3314. aktprocsym^.isstabwritten:=true;
  3315. end;
  3316. {$endif GDB}
  3317. { Align, gprof uses 16 byte granularity }
  3318. if (cs_profile in aktmoduleswitches) then
  3319. exprasmlist^.insert(new(pai_align,init_op(16,$90)))
  3320. else
  3321. if not(cs_littlesize in aktglobalswitches) then
  3322. exprasmlist^.insert(new(pai_align,init(16)));
  3323. end;
  3324. if inlined then
  3325. load_regvars(exprasmlist,nil);
  3326. exprasmlist:=oldexprasmlist;
  3327. end;
  3328. procedure handle_return_value(inlined : boolean;var uses_eax,uses_edx : boolean);
  3329. var
  3330. hr : preference;
  3331. op : Tasmop;
  3332. s : Topsize;
  3333. begin
  3334. uses_eax:=false;
  3335. uses_edx:=false;
  3336. if procinfo^.returntype.def<>pdef(voiddef) then
  3337. begin
  3338. {if ((procinfo^.flags and pi_operator)<>0) and
  3339. assigned(opsym) then
  3340. procinfo^.funcret_is_valid:=
  3341. procinfo^.funcret_is_valid or (opsym^.refs>0);}
  3342. if (procinfo^.funcret_state<>vs_assigned) and not inlined { and
  3343. ((procinfo^.flags and pi_uses_asm)=0)} then
  3344. CGMessage(sym_w_function_result_not_set);
  3345. hr:=new_reference(procinfo^.framepointer,procinfo^.return_offset);
  3346. if (procinfo^.returntype.def^.deftype in [orddef,enumdef]) then
  3347. begin
  3348. uses_eax:=true;
  3349. case procinfo^.returntype.def^.size of
  3350. 8:
  3351. begin
  3352. emit_ref_reg(A_MOV,S_L,hr,R_EAX);
  3353. hr:=new_reference(procinfo^.framepointer,procinfo^.return_offset+4);
  3354. emit_ref_reg(A_MOV,S_L,hr,R_EDX);
  3355. uses_edx:=true;
  3356. end;
  3357. 4:
  3358. emit_ref_reg(A_MOV,S_L,hr,R_EAX);
  3359. 2:
  3360. emit_ref_reg(A_MOV,S_W,hr,R_AX);
  3361. 1:
  3362. emit_ref_reg(A_MOV,S_B,hr,R_AL);
  3363. end;
  3364. end
  3365. else
  3366. if ret_in_acc(procinfo^.returntype.def) then
  3367. begin
  3368. uses_eax:=true;
  3369. emit_ref_reg(A_MOV,S_L,hr,R_EAX);
  3370. end
  3371. else
  3372. if (procinfo^.returntype.def^.deftype=floatdef) then
  3373. begin
  3374. floatloadops(pfloatdef(procinfo^.returntype.def)^.typ,op,s);
  3375. exprasmlist^.concat(new(paicpu,op_ref(op,s,hr)))
  3376. end
  3377. else
  3378. dispose(hr);
  3379. end
  3380. end;
  3381. procedure genexitcode(alist : paasmoutput;parasize:longint;nostackframe,inlined:boolean);
  3382. var
  3383. {$ifdef GDB}
  3384. mangled_length : longint;
  3385. p : pchar;
  3386. {$endif GDB}
  3387. nofinal,okexitlabel,noreraiselabel,nodestroycall : pasmlabel;
  3388. hr : treference;
  3389. uses_eax,uses_edx,uses_esi : boolean;
  3390. oldexprasmlist : paasmoutput;
  3391. ai : paicpu;
  3392. pd : pprocdef;
  3393. begin
  3394. oldexprasmlist:=exprasmlist;
  3395. exprasmlist:=alist;
  3396. if aktexitlabel^.is_used then
  3397. exprasmlist^.insert(new(pai_label,init(aktexitlabel)));
  3398. { call the destructor help procedure }
  3399. if (aktprocsym^.definition^.proctypeoption=potype_destructor) and
  3400. assigned(procinfo^._class) then
  3401. begin
  3402. if procinfo^._class^.is_class then
  3403. begin
  3404. emitinsertcall('FPC_DISPOSE_CLASS');
  3405. end
  3406. else
  3407. begin
  3408. emitinsertcall('FPC_HELP_DESTRUCTOR');
  3409. {$ifndef noAllocEdi}
  3410. getexplicitregister32(R_EDI);
  3411. {$endif noAllocEdi}
  3412. exprasmlist^.insert(new(paicpu,op_const_reg(A_MOV,S_L,procinfo^._class^.vmt_offset,R_EDI)));
  3413. { must the object be finalized ? }
  3414. if procinfo^._class^.needs_inittable then
  3415. begin
  3416. getlabel(nofinal);
  3417. exprasmlist^.insert(new(pai_label,init(nofinal)));
  3418. emitinsertcall('FPC_FINALIZE');
  3419. {$ifndef noAllocEdi}
  3420. ungetregister32(R_EDI);
  3421. {$endif noAllocEdi}
  3422. exprasmlist^.insert(new(paicpu,op_reg(A_PUSH,S_L,R_ESI)));
  3423. exprasmlist^.insert(new(paicpu,op_sym(A_PUSH,S_L,procinfo^._class^.get_inittable_label)));
  3424. ai:=new(paicpu,op_sym(A_Jcc,S_NO,nofinal));
  3425. ai^.SetCondition(C_Z);
  3426. exprasmlist^.insert(ai);
  3427. reset_reference(hr);
  3428. hr.base:=R_EBP;
  3429. hr.offset:=8;
  3430. exprasmlist^.insert(new(paicpu,op_const_ref(A_CMP,S_L,0,newreference(hr))));
  3431. end;
  3432. end;
  3433. end;
  3434. { finalize temporary data }
  3435. finalizetempansistrings;
  3436. { finalize local data like ansistrings}
  3437. case aktprocsym^.definition^.proctypeoption of
  3438. potype_unitfinalize:
  3439. begin
  3440. { using current_module^.globalsymtable is hopefully }
  3441. { more robust than symtablestack and symtablestack^.next }
  3442. psymtable(current_module^.globalsymtable)^.foreach({$ifndef TP}@{$endif}finalize_data);
  3443. psymtable(current_module^.localsymtable)^.foreach({$ifndef TP}@{$endif}finalize_data);
  3444. end;
  3445. { units have seperate code for initialization and finalization }
  3446. potype_unitinit: ;
  3447. else
  3448. aktprocsym^.definition^.localst^.foreach({$ifndef TP}@{$endif}finalize_data);
  3449. end;
  3450. { finalize paras data }
  3451. if assigned(aktprocsym^.definition^.parast) then
  3452. aktprocsym^.definition^.parast^.foreach({$ifndef TP}@{$endif}finalize_data);
  3453. { do we need to handle exceptions because of ansi/widestrings ? }
  3454. if not inlined and
  3455. ((procinfo^.flags and pi_needs_implicit_finally)<>0) and
  3456. { but it's useless in init/final code of units }
  3457. not(aktprocsym^.definition^.proctypeoption in [potype_unitfinalize,potype_unitinit]) then
  3458. begin
  3459. { the exception helper routines modify all registers }
  3460. aktprocsym^.definition^.usedregisters:=$ff;
  3461. getlabel(noreraiselabel);
  3462. emitcall('FPC_POPADDRSTACK');
  3463. exprasmlist^.concat(new(paicpu,
  3464. op_reg(A_POP,S_L,R_EAX)));
  3465. exprasmlist^.concat(new(paicpu,
  3466. op_reg_reg(A_TEST,S_L,R_EAX,R_EAX)));
  3467. emitjmp(C_E,noreraiselabel);
  3468. if (aktprocsym^.definition^.proctypeoption=potype_constructor) then
  3469. begin
  3470. if assigned(procinfo^._class) then
  3471. begin
  3472. pd:=procinfo^._class^.searchdestructor;
  3473. if assigned(pd) then
  3474. begin
  3475. getlabel(nodestroycall);
  3476. emit_const_ref(A_CMP,S_L,0,new_reference(procinfo^.framepointer,
  3477. procinfo^.selfpointer_offset));
  3478. emitjmp(C_E,nodestroycall);
  3479. if procinfo^._class^.is_class then
  3480. begin
  3481. emit_const(A_PUSH,S_L,1);
  3482. emit_reg(A_PUSH,S_L,R_ESI);
  3483. end
  3484. else
  3485. begin
  3486. emit_reg(A_PUSH,S_L,R_ESI);
  3487. emit_sym(A_PUSH,S_L,newasmsymbol(procinfo^._class^.vmt_mangledname));
  3488. end;
  3489. if (po_virtualmethod in pd^.procoptions) then
  3490. begin
  3491. emit_ref_reg(A_MOV,S_L,new_reference(R_ESI,0),R_EDI);
  3492. emit_ref(A_CALL,S_NO,new_reference(R_EDI,procinfo^._class^.vmtmethodoffset(pd^.extnumber)));
  3493. end
  3494. else
  3495. emitcall(pd^.mangledname);
  3496. { not necessary because the result is never assigned in the
  3497. case of an exception (FK)
  3498. emit_const_reg(A_MOV,S_L,0,R_ESI);
  3499. emit_const_ref(A_MOV,S_L,0,new_reference(procinfo^.framepointer,8));
  3500. }
  3501. emitlab(nodestroycall);
  3502. end;
  3503. end
  3504. end
  3505. else
  3506. { must be the return value finalized before reraising the exception? }
  3507. if (procinfo^.returntype.def<>pdef(voiddef)) and
  3508. (procinfo^.returntype.def^.needs_inittable) and
  3509. ((procinfo^.returntype.def^.deftype<>objectdef) or
  3510. not(pobjectdef(procinfo^.returntype.def)^.is_class)) then
  3511. begin
  3512. reset_reference(hr);
  3513. hr.offset:=procinfo^.return_offset;
  3514. hr.base:=procinfo^.framepointer;
  3515. finalize(procinfo^.returntype.def,hr,ret_in_param(procinfo^.returntype.def));
  3516. end;
  3517. emitcall('FPC_RERAISE');
  3518. emitlab(noreraiselabel);
  3519. end;
  3520. { call __EXIT for main program }
  3521. if (not DLLsource) and (not inlined) and (aktprocsym^.definition^.proctypeoption=potype_proginit) then
  3522. begin
  3523. emitcall('FPC_DO_EXIT');
  3524. end;
  3525. { handle return value }
  3526. uses_eax:=false;
  3527. uses_edx:=false;
  3528. uses_esi:=false;
  3529. if not(po_assembler in aktprocsym^.definition^.procoptions) then
  3530. if (aktprocsym^.definition^.proctypeoption<>potype_constructor) then
  3531. handle_return_value(inlined,uses_eax,uses_edx)
  3532. else
  3533. begin
  3534. { successful constructor deletes the zero flag }
  3535. { and returns self in eax }
  3536. { eax must be set to zero if the allocation failed !!! }
  3537. getlabel(okexitlabel);
  3538. emitjmp(C_NONE,okexitlabel);
  3539. emitlab(faillabel);
  3540. if procinfo^._class^.is_class then
  3541. begin
  3542. emit_ref_reg(A_MOV,S_L,new_reference(procinfo^.framepointer,8),R_ESI);
  3543. emitcall('FPC_HELP_FAIL_CLASS');
  3544. end
  3545. else
  3546. begin
  3547. emit_ref_reg(A_MOV,S_L,new_reference(procinfo^.framepointer,12),R_ESI);
  3548. {$ifndef noAllocEdi}
  3549. getexplicitregister32(R_EDI);
  3550. {$endif noAllocEdi}
  3551. emit_const_reg(A_MOV,S_L,procinfo^._class^.vmt_offset,R_EDI);
  3552. emitcall('FPC_HELP_FAIL');
  3553. {$ifndef noAllocEdi}
  3554. ungetregister32(R_EDI);
  3555. {$endif noAllocEdi}
  3556. end;
  3557. emitlab(okexitlabel);
  3558. emit_reg_reg(A_MOV,S_L,R_ESI,R_EAX);
  3559. emit_reg_reg(A_TEST,S_L,R_ESI,R_ESI);
  3560. uses_eax:=true;
  3561. uses_esi:=true;
  3562. end;
  3563. { stabs uses the label also ! }
  3564. if aktexit2label^.is_used or
  3565. ((cs_debuginfo in aktmoduleswitches) and not inlined) then
  3566. emitlab(aktexit2label);
  3567. { gives problems for long mangled names }
  3568. {list^.concat(new(pai_symbol,init(aktprocsym^.definition^.mangledname+'_end')));}
  3569. { should we restore edi ? }
  3570. { for all i386 gcc implementations }
  3571. if (po_savestdregs in aktprocsym^.definition^.procoptions) then
  3572. begin
  3573. if (aktprocsym^.definition^.usedregisters and ($80 shr byte(R_EBX)))<>0 then
  3574. exprasmlist^.concat(new(paicpu,op_reg(A_POP,S_L,R_EBX)));
  3575. exprasmlist^.concat(new(paicpu,op_reg(A_POP,S_L,R_ESI)));
  3576. exprasmlist^.concat(new(paicpu,op_reg(A_POP,S_L,R_EDI)));
  3577. { here we could reset R_EBX
  3578. but that is risky because it only works
  3579. if genexitcode is called after genentrycode
  3580. so lets skip this for the moment PM
  3581. aktprocsym^.definition^.usedregisters:=
  3582. aktprocsym^.definition^.usedregisters or not ($80 shr byte(R_EBX));
  3583. }
  3584. end;
  3585. { for the save all registers we can simply use a pusha,popa which
  3586. push edi,esi,ebp,esp(ignored),ebx,edx,ecx,eax }
  3587. if (po_saveregisters in aktprocsym^.definition^.procoptions) then
  3588. begin
  3589. if uses_esi then
  3590. exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,R_ESI,new_reference(R_ESP,4))));
  3591. if uses_edx then
  3592. exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,R_EDX,new_reference(R_ESP,20))));
  3593. if uses_eax then
  3594. exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,R_EAX,new_reference(R_ESP,28))));
  3595. exprasmlist^.concat(new(paicpu,op_none(A_POPA,S_L)))
  3596. end;
  3597. if not(nostackframe) then
  3598. begin
  3599. if not inlined then
  3600. exprasmlist^.concat(new(paicpu,op_none(A_LEAVE,S_NO)));
  3601. end
  3602. else
  3603. begin
  3604. if (gettempsize<>0) and not inlined then
  3605. exprasmlist^.insert(new(paicpu,
  3606. op_const_reg(A_ADD,S_L,gettempsize,R_ESP)));
  3607. end;
  3608. { parameters are limited to 65535 bytes because }
  3609. { ret allows only imm16 }
  3610. if (parasize>65535) and not(pocall_clearstack in aktprocsym^.definition^.proccalloptions) then
  3611. CGMessage(cg_e_parasize_too_big);
  3612. { at last, the return is generated }
  3613. if not inlined then
  3614. if (po_interrupt in aktprocsym^.definition^.procoptions) then
  3615. begin
  3616. if uses_esi then
  3617. exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,R_ESI,new_reference(R_ESP,16))));
  3618. if uses_edx then
  3619. exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,R_EDX,new_reference(R_ESP,12))));
  3620. if uses_eax then
  3621. exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,R_EAX,new_reference(R_ESP,0))));
  3622. generate_interrupt_stackframe_exit;
  3623. end
  3624. else
  3625. begin
  3626. {Routines with the poclearstack flag set use only a ret.}
  3627. { also routines with parasize=0 }
  3628. if (pocall_clearstack in aktprocsym^.definition^.proccalloptions) then
  3629. begin
  3630. {$ifndef OLD_C_STACK}
  3631. { complex return values are removed from stack in C code PM }
  3632. if ret_in_param(aktprocsym^.definition^.rettype.def) then
  3633. exprasmlist^.concat(new(paicpu,op_const(A_RET,S_NO,4)))
  3634. else
  3635. {$endif not OLD_C_STACK}
  3636. exprasmlist^.concat(new(paicpu,op_none(A_RET,S_NO)));
  3637. end
  3638. else if (parasize=0) then
  3639. exprasmlist^.concat(new(paicpu,op_none(A_RET,S_NO)))
  3640. else
  3641. exprasmlist^.concat(new(paicpu,op_const(A_RET,S_NO,parasize)));
  3642. end;
  3643. if not inlined then
  3644. exprasmlist^.concat(new(pai_symbol_end,initname(aktprocsym^.definition^.mangledname)));
  3645. {$ifdef GDB}
  3646. if (cs_debuginfo in aktmoduleswitches) and not inlined then
  3647. begin
  3648. aktprocsym^.concatstabto(exprasmlist);
  3649. if assigned(procinfo^._class) then
  3650. if (not assigned(procinfo^.parent) or
  3651. not assigned(procinfo^.parent^._class)) then
  3652. exprasmlist^.concat(new(pai_stabs,init(strpnew(
  3653. '"$t:v'+procinfo^._class^.numberstring+'",'+
  3654. tostr(N_PSYM)+',0,0,'+tostr(procinfo^.selfpointer_offset)))))
  3655. else
  3656. exprasmlist^.concat(new(pai_stabs,init(strpnew(
  3657. '"$t:r*'+procinfo^._class^.numberstring+'",'+
  3658. tostr(N_RSYM)+',0,0,'+tostr(GDB_i386index[R_ESI])))));
  3659. { define calling EBP as pseudo local var PM }
  3660. { this enables test if the function is a local one !! }
  3661. if assigned(procinfo^.parent) and (lexlevel>normal_function_level) then
  3662. exprasmlist^.concat(new(pai_stabs,init(strpnew(
  3663. '"parent_ebp:'+voidpointerdef^.numberstring+'",'+
  3664. tostr(N_LSYM)+',0,0,'+tostr(procinfo^.framepointer_offset)))));
  3665. if (pdef(aktprocsym^.definition^.rettype.def) <> pdef(voiddef)) then
  3666. begin
  3667. if ret_in_param(aktprocsym^.definition^.rettype.def) then
  3668. exprasmlist^.concat(new(pai_stabs,init(strpnew(
  3669. '"'+aktprocsym^.name+':X*'+aktprocsym^.definition^.rettype.def^.numberstring+'",'+
  3670. tostr(N_PSYM)+',0,0,'+tostr(procinfo^.return_offset)))))
  3671. else
  3672. exprasmlist^.concat(new(pai_stabs,init(strpnew(
  3673. '"'+aktprocsym^.name+':X'+aktprocsym^.definition^.rettype.def^.numberstring+'",'+
  3674. tostr(N_PSYM)+',0,0,'+tostr(procinfo^.return_offset)))));
  3675. if (m_result in aktmodeswitches) then
  3676. if ret_in_param(aktprocsym^.definition^.rettype.def) then
  3677. exprasmlist^.concat(new(pai_stabs,init(strpnew(
  3678. '"RESULT:X*'+aktprocsym^.definition^.rettype.def^.numberstring+'",'+
  3679. tostr(N_PSYM)+',0,0,'+tostr(procinfo^.return_offset)))))
  3680. else
  3681. exprasmlist^.concat(new(pai_stabs,init(strpnew(
  3682. '"RESULT:X'+aktprocsym^.definition^.rettype.def^.numberstring+'",'+
  3683. tostr(N_PSYM)+',0,0,'+tostr(procinfo^.return_offset)))));
  3684. end;
  3685. mangled_length:=length(aktprocsym^.definition^.mangledname);
  3686. getmem(p,2*mangled_length+50);
  3687. strpcopy(p,'192,0,0,');
  3688. strpcopy(strend(p),aktprocsym^.definition^.mangledname);
  3689. if (target_os.use_function_relative_addresses) then
  3690. begin
  3691. strpcopy(strend(p),'-');
  3692. strpcopy(strend(p),aktprocsym^.definition^.mangledname);
  3693. end;
  3694. exprasmlist^.concat(new(pai_stabn,init(strnew(p))));
  3695. {list^.concat(new(pai_stabn,init(strpnew('192,0,0,'
  3696. +aktprocsym^.definition^.mangledname))));
  3697. p[0]:='2';p[1]:='2';p[2]:='4';
  3698. strpcopy(strend(p),'_end');}
  3699. strpcopy(p,'224,0,0,'+aktexit2label^.name);
  3700. if (target_os.use_function_relative_addresses) then
  3701. begin
  3702. strpcopy(strend(p),'-');
  3703. strpcopy(strend(p),aktprocsym^.definition^.mangledname);
  3704. end;
  3705. exprasmlist^.concatlist(withdebuglist);
  3706. exprasmlist^.concat(new(pai_stabn,init(
  3707. strnew(p))));
  3708. { strpnew('224,0,0,'
  3709. +aktprocsym^.definition^.mangledname+'_end'))));}
  3710. freemem(p,2*mangled_length+50);
  3711. end;
  3712. {$endif GDB}
  3713. if inlined then
  3714. cleanup_regvars(exprasmlist);
  3715. exprasmlist:=oldexprasmlist;
  3716. end;
  3717. procedure genimplicitunitfinal(alist : paasmoutput);
  3718. begin
  3719. { using current_module^.globalsymtable is hopefully }
  3720. { more robust than symtablestack and symtablestack^.next }
  3721. psymtable(current_module^.globalsymtable)^.foreach({$ifndef TP}@{$endif}finalize_data);
  3722. psymtable(current_module^.localsymtable)^.foreach({$ifndef TP}@{$endif}finalize_data);
  3723. exprasmlist^.insert(new(pai_symbol,initname_global('FINALIZE$$'+current_module^.modulename^,0)));
  3724. exprasmlist^.insert(new(pai_symbol,initname_global(target_os.cprefix+current_module^.modulename^+'_finalize',0)));
  3725. {$ifdef GDB}
  3726. if (cs_debuginfo in aktmoduleswitches) and
  3727. target_os.use_function_relative_addresses then
  3728. exprasmlist^.insert(new(pai_stab_function_name,init(strpnew('FINALIZE$$'+current_module^.modulename^))));
  3729. {$endif GDB}
  3730. exprasmlist^.concat(new(paicpu,op_none(A_RET,S_NO)));
  3731. alist^.concatlist(exprasmlist);
  3732. end;
  3733. procedure genimplicitunitinit(alist : paasmoutput);
  3734. begin
  3735. { using current_module^.globalsymtable is hopefully }
  3736. { more robust than symtablestack and symtablestack^.next }
  3737. psymtable(current_module^.globalsymtable)^.foreach({$ifndef TP}@{$endif}finalize_data);
  3738. psymtable(current_module^.localsymtable)^.foreach({$ifndef TP}@{$endif}finalize_data);
  3739. exprasmlist^.insert(new(pai_symbol,initname_global('INIT$$'+current_module^.modulename^,0)));
  3740. exprasmlist^.insert(new(pai_symbol,initname_global(target_os.cprefix+current_module^.modulename^+'_init',0)));
  3741. {$ifdef GDB}
  3742. if (cs_debuginfo in aktmoduleswitches) and
  3743. target_os.use_function_relative_addresses then
  3744. exprasmlist^.insert(new(pai_stab_function_name,init(strpnew('INIT$$'+current_module^.modulename^))));
  3745. {$endif GDB}
  3746. exprasmlist^.concat(new(paicpu,op_none(A_RET,S_NO)));
  3747. alist^.concatlist(exprasmlist);
  3748. end;
  3749. {$ifdef test_dest_loc}
  3750. procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
  3751. begin
  3752. if (dest_loc.loc=LOC_CREGISTER) or (dest_loc.loc=LOC_REGISTER) then
  3753. begin
  3754. emit_reg_reg(A_MOV,s,reg,dest_loc.register);
  3755. set_location(p^.location,dest_loc);
  3756. in_dest_loc:=true;
  3757. end
  3758. else
  3759. if (dest_loc.loc=LOC_REFERENCE) or (dest_loc.loc=LOC_MEM) then
  3760. begin
  3761. exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,s,reg,newreference(dest_loc.reference))));
  3762. set_location(p^.location,dest_loc);
  3763. in_dest_loc:=true;
  3764. end
  3765. else
  3766. internalerror(20080);
  3767. end;
  3768. {$endif test_dest_loc}
  3769. end.
  3770. {
  3771. $Log$
  3772. Revision 1.15 2000-09-24 15:06:12 peter
  3773. * use defines.inc
  3774. Revision 1.14 2000/09/16 12:22:52 peter
  3775. * freebsd support merged
  3776. Revision 1.13 2000/08/27 16:11:49 peter
  3777. * moved some util functions from globals,cobjects to cutils
  3778. * splitted files into finput,fmodule
  3779. Revision 1.12 2000/08/24 19:07:54 peter
  3780. * don't initialize if localvarsym is set because that varsym will
  3781. already be initialized
  3782. * first initialize local data before copy of value para's (merged)
  3783. Revision 1.11 2000/08/19 20:09:33 peter
  3784. * check size after checking openarray in push_value_para (merged)
  3785. Revision 1.10 2000/08/16 13:06:06 florian
  3786. + support of 64 bit integer constants
  3787. Revision 1.9 2000/08/10 18:42:03 peter
  3788. * fixed for constants in emit_push_mem_size for go32v2 (merged)
  3789. Revision 1.8 2000/08/07 11:29:40 jonas
  3790. + emit_push_mem_size() which pushes a value in memory of a certain size
  3791. * pushsetelement() and pushvaluepara() use this new procedure, because
  3792. otherwise they could sometimes try to push data past the end of the
  3793. heap, causing a crash
  3794. (merged from fixes branch)
  3795. Revision 1.7 2000/08/03 13:17:25 jonas
  3796. + allow regvars to be used inside inlined procs, which required the
  3797. following changes:
  3798. + load regvars in genentrycode/free them in genexitcode (cgai386)
  3799. * moved all regvar related code to new regvars unit
  3800. + added pregvarinfo type to hcodegen
  3801. + added regvarinfo field to tprocinfo (symdef/symdefh)
  3802. * deallocate the regvars of the caller in secondprocinline before
  3803. inlining the called procedure and reallocate them afterwards
  3804. Revision 1.6 2000/08/02 08:05:04 jonas
  3805. * fixed web bug1087
  3806. * allocate R_ECX explicitely if it's used
  3807. (merged from fixes branch)
  3808. Revision 1.5 2000/07/27 09:25:05 jonas
  3809. * moved locflags2reg() procedure from cg386add to cgai386
  3810. + added locjump2reg() procedure to cgai386
  3811. * fixed internalerror(2002) when the result of a case expression has
  3812. LOC_JUMP
  3813. (all merged from fixes branch)
  3814. Revision 1.4 2000/07/21 15:14:02 jonas
  3815. + added is_addr field for labels, if they are only used for getting the address
  3816. (e.g. for io checks) and corresponding getaddrlabel() procedure
  3817. Revision 1.3 2000/07/13 12:08:25 michael
  3818. + patched to 1.1.0 with former 1.09patch from peter
  3819. Revision 1.2 2000/07/13 11:32:37 michael
  3820. + removed logs
  3821. }