cgai386.pas 157 KB

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