cgai386.pas 143 KB

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