cgai386.pas 158 KB

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