cgai386.pas 157 KB

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