ncgutil.pas 82 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042
  1. {
  2. $Id$
  3. Copyright (c) 1998-2002 by Florian Klaempfl
  4. Helper routines for all code generators
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. unit ncgutil;
  19. {$i fpcdefs.inc}
  20. interface
  21. uses
  22. node,cpuinfo,
  23. globtype,
  24. cpubase,cpupara,
  25. aasmbase,aasmtai,aasmcpu,
  26. cginfo,symbase,symdef,symtype,
  27. {$ifndef cpu64bit}
  28. cg64f32,
  29. {$endif cpu64bit}
  30. rgobj;
  31. type
  32. tloadregvars = (lr_dont_load_regvars, lr_load_regvars);
  33. tmaybesave = record
  34. saved : boolean;
  35. ref : treference;
  36. end;
  37. procedure firstcomplex(p : tbinarynode);
  38. procedure maketojumpbool(list:TAAsmoutput; p : tnode; loadregvars: tloadregvars);
  39. procedure remove_non_regvars_from_loc(const t: tlocation; var regs: tregisterset);
  40. procedure location_force_reg(list: TAAsmoutput;var l:tlocation;dst_size:TCGSize;maybeconst:boolean);
  41. procedure location_force_mem(list: TAAsmoutput;var l:tlocation);
  42. procedure maybe_save(list:taasmoutput;needed:integer;var l:tlocation;var s:tmaybesave);
  43. procedure maybe_restore(list:taasmoutput;var l:tlocation;const s:tmaybesave);
  44. function maybe_pushfpu(list:taasmoutput;needed : byte;var l:tlocation) : boolean;
  45. procedure push_value_para(p:tnode;calloption:tproccalloption;
  46. para_offset:longint;alignment : longint;
  47. const locpara : tparalocation);
  48. procedure genentrycode(list : TAAsmoutput;
  49. make_global:boolean;
  50. stackframe:longint;
  51. var parasize:longint;var nostackframe:boolean;
  52. inlined : boolean);
  53. procedure genexitcode(list : TAAsmoutput;parasize:longint;nostackframe,inlined:boolean);
  54. procedure genimplicitunitinit(list : TAAsmoutput);
  55. procedure genimplicitunitfinal(list : TAAsmoutput);
  56. {#
  57. Allocate the buffers for exception management and setjmp environment.
  58. Return a pointer to these buffers, send them to the utility routine
  59. so they are registered, and then call setjmp.
  60. Then compare the result of setjmp with 0, and if not equal
  61. to zero, then jump to exceptlabel.
  62. Also store the result of setjmp to a temporary space by calling g_save_exception_reason
  63. It is to note that this routine may be called *after* the stackframe of a
  64. routine has been called, therefore on machines where the stack cannot
  65. be modified, all temps should be allocated on the heap instead of the
  66. stack.
  67. }
  68. procedure new_exception(list : taasmoutput;const jmpbuf,envbuf, href : treference;
  69. a : aword; exceptlabel : tasmlabel);
  70. procedure free_exception(list : taasmoutput;const jmpbuf, envbuf, href : treference;
  71. a : aword ; endexceptlabel : tasmlabel; onlyfree : boolean);
  72. implementation
  73. uses
  74. {$ifdef Delphi}
  75. Sysutils,
  76. {$else}
  77. strings,
  78. {$endif}
  79. cutils,cclasses,
  80. globals,systems,verbose,
  81. symconst,symsym,symtable,defutil,
  82. paramgr,fmodule,
  83. cgbase,regvars,
  84. {$ifdef GDB}
  85. gdb,
  86. {$endif GDB}
  87. ncon,
  88. tgobj,cgobj,cgcpu;
  89. {*****************************************************************************
  90. Misc Helpers
  91. *****************************************************************************}
  92. { DO NOT RELY on the fact that the tnode is not yet swaped
  93. because of inlining code PM }
  94. procedure firstcomplex(p : tbinarynode);
  95. var
  96. hp : tnode;
  97. begin
  98. { always calculate boolean AND and OR from left to right }
  99. if (p.nodetype in [orn,andn]) and
  100. is_boolean(p.left.resulttype.def) then
  101. begin
  102. if nf_swaped in p.flags then
  103. internalerror(234234);
  104. end
  105. else
  106. if (
  107. (p.location.loc=LOC_FPUREGISTER) and
  108. (p.right.registersfpu > p.left.registersfpu)
  109. ) or
  110. (
  111. (
  112. (
  113. ((p.left.registersfpu = 0) and (p.right.registersfpu = 0)) or
  114. (p.location.loc<>LOC_FPUREGISTER)
  115. ) and
  116. (p.left.registers32<p.right.registers32)
  117. ) and
  118. { the following check is appropriate, because all }
  119. { 4 registers are rarely used and it is thereby }
  120. { achieved that the extra code is being dropped }
  121. { by exchanging not commutative operators }
  122. (p.right.registers32<=c_countusableregsint)
  123. ) then
  124. begin
  125. hp:=p.left;
  126. p.left:=p.right;
  127. p.right:=hp;
  128. if nf_swaped in p.flags then
  129. exclude(p.flags,nf_swaped)
  130. else
  131. include(p.flags,nf_swaped);
  132. end;
  133. end;
  134. procedure maketojumpbool(list:TAAsmoutput; p : tnode; loadregvars: tloadregvars);
  135. {
  136. produces jumps to true respectively false labels using boolean expressions
  137. depending on whether the loading of regvars is currently being
  138. synchronized manually (such as in an if-node) or automatically (most of
  139. the other cases where this procedure is called), loadregvars can be
  140. "lr_load_regvars" or "lr_dont_load_regvars"
  141. }
  142. var
  143. opsize : tcgsize;
  144. storepos : tfileposinfo;
  145. begin
  146. if nf_error in p.flags then
  147. exit;
  148. storepos:=aktfilepos;
  149. aktfilepos:=p.fileinfo;
  150. if is_boolean(p.resulttype.def) then
  151. begin
  152. if loadregvars = lr_load_regvars then
  153. load_all_regvars(list);
  154. if is_constboolnode(p) then
  155. begin
  156. if tordconstnode(p).value<>0 then
  157. cg.a_jmp_always(list,truelabel)
  158. else
  159. cg.a_jmp_always(list,falselabel)
  160. end
  161. else
  162. begin
  163. opsize:=def_cgsize(p.resulttype.def);
  164. case p.location.loc of
  165. LOC_CREGISTER,LOC_REGISTER,LOC_CREFERENCE,LOC_REFERENCE :
  166. begin
  167. if (p.location.loc = LOC_CREGISTER) then
  168. load_regvar_reg(list,p.location.register);
  169. cg.a_cmp_const_loc_label(list,opsize,OC_NE,
  170. 0,p.location,truelabel);
  171. { !!! should happen right after cmp (JM) }
  172. location_release(list,p.location);
  173. cg.a_jmp_always(list,falselabel);
  174. end;
  175. {$ifdef cpuflags}
  176. LOC_FLAGS :
  177. begin
  178. cg.a_jmp_flags(list,p.location.resflags,
  179. truelabel);
  180. cg.a_jmp_always(list,falselabel);
  181. end;
  182. {$endif cpuflags}
  183. end;
  184. end;
  185. end
  186. else
  187. internalerror(200112305);
  188. aktfilepos:=storepos;
  189. end;
  190. procedure remove_non_regvars_from_loc(const t: tlocation; var regs: tregisterset);
  191. begin
  192. case t.loc of
  193. LOC_REGISTER:
  194. begin
  195. { can't be a regvar, since it would be LOC_CREGISTER then }
  196. exclude(regs,t.register);
  197. if t.registerhigh <> R_NO then
  198. exclude(regs,t.registerhigh);
  199. end;
  200. LOC_CREFERENCE,LOC_REFERENCE:
  201. begin
  202. if not(cs_regalloc in aktglobalswitches) or
  203. (t.reference.base in rg.usableregsint) then
  204. exclude(regs,t.reference.base);
  205. if not(cs_regalloc in aktglobalswitches) or
  206. (t.reference.index in rg.usableregsint) then
  207. exclude(regs,t.reference.index);
  208. end;
  209. end;
  210. end;
  211. {*****************************************************************************
  212. EXCEPTION MANAGEMENT
  213. *****************************************************************************}
  214. procedure new_exception(list : taasmoutput;const jmpbuf,envbuf, href : treference;
  215. a : aword; exceptlabel : tasmlabel);
  216. begin
  217. cg.a_paramaddr_ref(list,envbuf,paramanager.getintparaloc(3));
  218. cg.a_paramaddr_ref(list,jmpbuf,paramanager.getintparaloc(2));
  219. { push type of exceptionframe }
  220. cg.a_param_const(list,OS_S32,1,paramanager.getintparaloc(1));
  221. cg.a_call_name(list,'FPC_PUSHEXCEPTADDR');
  222. cg.a_param_reg(list,OS_ADDR,accumulator,paramanager.getintparaloc(1));
  223. cg.a_call_name(list,'FPC_SETJMP');
  224. cg.g_exception_reason_save(list, href);
  225. cg.a_cmp_const_reg_label(list,OS_S32,OC_NE,0,accumulator,exceptlabel);
  226. end;
  227. procedure free_exception(list : taasmoutput;const jmpbuf, envbuf, href : treference;
  228. a : aword ; endexceptlabel : tasmlabel; onlyfree : boolean);
  229. begin
  230. cg.a_call_name(list,'FPC_POPADDRSTACK');
  231. if not onlyfree then
  232. begin
  233. cg.g_exception_reason_load(list, href);
  234. cg.a_cmp_const_reg_label(list,OS_S32,OC_EQ,a,accumulator,endexceptlabel);
  235. end;
  236. end;
  237. {*****************************************************************************
  238. TLocation
  239. *****************************************************************************}
  240. {$ifndef cpu64bit}
  241. { 32-bit version }
  242. procedure location_force(list: TAAsmoutput;var l:tlocation;dst_size:TCGSize;maybeconst:boolean);
  243. var
  244. hregister,
  245. hregisterhi : tregister;
  246. hreg64 : tregister64;
  247. hl : tasmlabel;
  248. begin
  249. { handle transformations to 64bit separate }
  250. if dst_size in [OS_64,OS_S64] then
  251. begin
  252. if not (l.size in [OS_64,OS_S64]) then
  253. begin
  254. { load a smaller size to OS_64 }
  255. if l.loc=LOC_REGISTER then
  256. begin
  257. hregister:=rg.makeregsize(l.registerlow,OS_INT);
  258. cg.a_load_reg_reg(list,l.size,OS_32,l.registerlow,hregister);
  259. end
  260. else
  261. hregister:=rg.getregisterint(list);
  262. { load value in low register }
  263. case l.loc of
  264. LOC_FLAGS :
  265. cg.g_flags2reg(list,OS_INT,l.resflags,hregister);
  266. LOC_JUMP :
  267. begin
  268. cg.a_label(list,truelabel);
  269. cg.a_load_const_reg(list,OS_INT,1,hregister);
  270. objectlibrary.getlabel(hl);
  271. cg.a_jmp_always(list,hl);
  272. cg.a_label(list,falselabel);
  273. cg.a_load_const_reg(list,OS_INT,0,hregister);
  274. cg.a_label(list,hl);
  275. end;
  276. else
  277. cg.a_load_loc_reg(list,l,hregister);
  278. end;
  279. { reset hi part, take care of the signed bit of the current value }
  280. hregisterhi:=rg.getregisterint(list);
  281. if (dst_size=OS_S64) and
  282. (l.size in [OS_S8,OS_S16,OS_S32]) then
  283. begin
  284. if l.loc=LOC_CONSTANT then
  285. begin
  286. if (longint(l.value)<0) then
  287. cg.a_load_const_reg(list,OS_32,$ffffffff,hregisterhi)
  288. else
  289. cg.a_load_const_reg(list,OS_32,0,hregisterhi);
  290. end
  291. else
  292. begin
  293. cg.a_op_const_reg_reg(list,OP_SAR,OS_32,31,hregister,
  294. hregisterhi);
  295. end;
  296. end
  297. else
  298. cg.a_load_const_reg(list,OS_32,0,hregisterhi);
  299. location_reset(l,LOC_REGISTER,dst_size);
  300. l.registerlow:=hregister;
  301. l.registerhigh:=hregisterhi;
  302. end
  303. else
  304. begin
  305. { 64bit to 64bit }
  306. if (l.loc=LOC_REGISTER) or
  307. ((l.loc=LOC_CREGISTER) and maybeconst) then
  308. begin
  309. hregister:=l.registerlow;
  310. hregisterhi:=l.registerhigh;
  311. end
  312. else
  313. begin
  314. hregister:=rg.getregisterint(list);
  315. hregisterhi:=rg.getregisterint(list);
  316. end;
  317. hreg64.reglo:=hregister;
  318. hreg64.reghi:=hregisterhi;
  319. { load value in new register }
  320. cg64.a_load64_loc_reg(list,l,hreg64);
  321. location_reset(l,LOC_REGISTER,dst_size);
  322. l.registerlow:=hregister;
  323. l.registerhigh:=hregisterhi;
  324. end;
  325. end
  326. else
  327. begin
  328. { transformations to 32bit or smaller }
  329. if l.loc=LOC_REGISTER then
  330. begin
  331. { if the previous was 64bit release the high register }
  332. if l.size in [OS_64,OS_S64] then
  333. begin
  334. rg.ungetregisterint(list,l.registerhigh);
  335. l.registerhigh:=R_NO;
  336. end;
  337. hregister:=l.register;
  338. end
  339. else
  340. begin
  341. { get new register }
  342. if (l.loc=LOC_CREGISTER) and
  343. maybeconst and
  344. (TCGSize2Size[dst_size]=TCGSize2Size[l.size]) then
  345. hregister:=l.register
  346. else
  347. hregister:=rg.getregisterint(list);
  348. end;
  349. hregister:=rg.makeregsize(hregister,dst_size);
  350. { load value in new register }
  351. case l.loc of
  352. LOC_FLAGS :
  353. cg.g_flags2reg(list,dst_size,l.resflags,hregister);
  354. LOC_JUMP :
  355. begin
  356. cg.a_label(list,truelabel);
  357. cg.a_load_const_reg(list,dst_size,1,hregister);
  358. objectlibrary.getlabel(hl);
  359. cg.a_jmp_always(list,hl);
  360. cg.a_label(list,falselabel);
  361. cg.a_load_const_reg(list,dst_size,0,hregister);
  362. cg.a_label(list,hl);
  363. end;
  364. else
  365. begin
  366. { load_loc_reg can only handle size >= l.size, when the
  367. new size is smaller then we need to adjust the size
  368. of the orignal and maybe recalculate l.register for i386 }
  369. if (TCGSize2Size[dst_size]<TCGSize2Size[l.size]) then
  370. begin
  371. if (l.loc in [LOC_REGISTER,LOC_CREGISTER]) then
  372. l.register:=rg.makeregsize(l.register,dst_size);
  373. { for big endian systems, the reference's offset must }
  374. { be increased in this case, since they have the }
  375. { MSB first in memory and e.g. byte(word_var) should }
  376. { return the second byte in this case (JM) }
  377. if (target_info.endian = ENDIAN_BIG) and
  378. (l.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
  379. inc(l.reference.offset,TCGSize2Size[l.size]-TCGSize2Size[dst_size]);
  380. l.size:=dst_size;
  381. end;
  382. cg.a_load_loc_reg(list,l,hregister);
  383. end;
  384. end;
  385. location_reset(l,LOC_REGISTER,dst_size);
  386. l.register:=hregister;
  387. end;
  388. end;
  389. {$else cpu64bit}
  390. { 64-bit version }
  391. procedure location_force(list: TAAsmoutput;var l:tlocation;dst_size:TCGSize;maybeconst:boolean);
  392. var
  393. hregister : tregister;
  394. hl : tasmlabel;
  395. begin
  396. { handle transformations to 64bit separate }
  397. if dst_size in [OS_64,OS_S64] then
  398. begin
  399. { load a smaller size to OS_64 }
  400. if l.loc=LOC_REGISTER then
  401. hregister:=rg.makeregsize(l.register,OS_INT)
  402. else
  403. hregister:=rg.getregisterint(list);
  404. { load value in low register }
  405. case l.loc of
  406. {$ifdef cpuflags}
  407. LOC_FLAGS :
  408. cg.g_flags2reg(list,OS_INT,l.resflags,hregister);
  409. {$endif cpuflags}
  410. LOC_JUMP :
  411. begin
  412. cg.a_label(list,truelabel);
  413. cg.a_load_const_reg(list,OS_INT,1,hregister);
  414. objectlibrary.getlabel(hl);
  415. cg.a_jmp_always(list,hl);
  416. cg.a_label(list,falselabel);
  417. cg.a_load_const_reg(list,OS_INT,0,hregister);
  418. cg.a_label(list,hl);
  419. end;
  420. else
  421. cg.a_load_loc_reg(list,l,hregister);
  422. end;
  423. location_reset(l,LOC_REGISTER,dst_size);
  424. l.register:=hregister;
  425. end
  426. else
  427. begin
  428. { transformations to 32bit or smaller }
  429. if l.loc=LOC_REGISTER then
  430. begin
  431. hregister:=l.register;
  432. end
  433. else
  434. begin
  435. { get new register }
  436. if (l.loc=LOC_CREGISTER) and
  437. maybeconst and
  438. (TCGSize2Size[dst_size]=TCGSize2Size[l.size]) then
  439. hregister:=l.register
  440. else
  441. hregister:=rg.getregisterint(list);
  442. end;
  443. hregister:=rg.makeregsize(hregister,dst_size);
  444. { load value in new register }
  445. case l.loc of
  446. {$ifdef cpuflags}
  447. LOC_FLAGS :
  448. cg.g_flags2reg(list,dst_size,l.resflags,hregister);
  449. {$endif cpuflags}
  450. LOC_JUMP :
  451. begin
  452. cg.a_label(list,truelabel);
  453. cg.a_load_const_reg(list,dst_size,1,hregister);
  454. objectlibrary.getlabel(hl);
  455. cg.a_jmp_always(list,hl);
  456. cg.a_label(list,falselabel);
  457. cg.a_load_const_reg(list,dst_size,0,hregister);
  458. cg.a_label(list,hl);
  459. end;
  460. else
  461. begin
  462. { load_loc_reg can only handle size >= l.size, when the
  463. new size is smaller then we need to adjust the size
  464. of the orignal and maybe recalculate l.register for i386 }
  465. if (TCGSize2Size[dst_size]<TCGSize2Size[l.size]) then
  466. begin
  467. if (l.loc in [LOC_REGISTER,LOC_CREGISTER]) then
  468. l.register:=rg.makeregsize(l.register,dst_size);
  469. { for big endian systems, the reference's offset must }
  470. { be increased in this case, since they have the }
  471. { MSB first in memory and e.g. byte(word_var) should }
  472. { return the second byte in this case (JM) }
  473. if (target_info.endian = ENDIAN_BIG) and
  474. (l.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
  475. inc(l.reference.offset,TCGSize2Size[l.size]-TCGSize2Size[dst_size]);
  476. l.size:=dst_size;
  477. end;
  478. cg.a_load_loc_reg(list,l,hregister);
  479. end;
  480. end;
  481. location_reset(l,LOC_REGISTER,dst_size);
  482. l.register:=hregister;
  483. end;
  484. end;
  485. {$endif cpu64bit}
  486. procedure location_force_reg(list: TAAsmoutput;var l:tlocation;dst_size:TCGSize;maybeconst:boolean);
  487. begin
  488. { release previous location before demanding a new register }
  489. if (l.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
  490. begin
  491. location_freetemp(list,l);
  492. location_release(list,l);
  493. end;
  494. location_force(list, l, dst_size, maybeconst)
  495. end;
  496. procedure location_force_mem(list: TAAsmoutput;var l:tlocation);
  497. var
  498. r : treference;
  499. begin
  500. case l.loc of
  501. LOC_FPUREGISTER,
  502. LOC_CFPUREGISTER :
  503. begin
  504. tg.GetTemp(list,TCGSize2Size[l.size],tt_normal,r);
  505. cg.a_loadfpu_reg_ref(list,l.size,l.register,r);
  506. location_reset(l,LOC_REFERENCE,l.size);
  507. l.reference:=r;
  508. end;
  509. LOC_CONSTANT,
  510. LOC_REGISTER,
  511. LOC_CREGISTER :
  512. begin
  513. tg.GetTemp(list,TCGSize2Size[l.size],tt_normal,r);
  514. if l.size in [OS_64,OS_S64] then
  515. cg64.a_load64_loc_ref(list,l,r)
  516. else
  517. cg.a_load_loc_ref(list,l,r);
  518. location_reset(l,LOC_REFERENCE,l.size);
  519. l.reference:=r;
  520. end;
  521. LOC_CREFERENCE,
  522. LOC_REFERENCE : ;
  523. else
  524. internalerror(200203219);
  525. end;
  526. end;
  527. {*****************************************************************************
  528. Maybe_Save
  529. *****************************************************************************}
  530. procedure maybe_save(list:taasmoutput;needed:integer;var l:tlocation;var s:tmaybesave);
  531. begin
  532. s.saved:=false;
  533. if l.loc=LOC_CREGISTER then
  534. begin
  535. s.saved:=true;
  536. exit;
  537. end;
  538. if needed>rg.countunusedregsint then
  539. begin
  540. case l.loc of
  541. LOC_REGISTER :
  542. begin
  543. {$ifndef cpu64bit}
  544. if l.size in [OS_64,OS_S64] then
  545. begin
  546. tg.GetTemp(exprasmlist,8,tt_normal,s.ref);
  547. cg64.a_load64_reg_ref(exprasmlist,joinreg64(l.registerlow,l.registerhigh),s.ref);
  548. end
  549. else
  550. {$endif cpu64bit}
  551. begin
  552. tg.GetTemp(exprasmlist,TCGSize2Size[l.size],tt_normal,s.ref);
  553. cg.a_load_reg_ref(exprasmlist,l.size,l.register,s.ref);
  554. end;
  555. location_release(exprasmlist,l);
  556. s.saved:=true;
  557. end;
  558. LOC_REFERENCE,
  559. LOC_CREFERENCE :
  560. begin
  561. if ((l.reference.base<>R_NO) or
  562. (l.reference.index<>R_NO)) then
  563. begin
  564. { load address into a single base register }
  565. if l.reference.index<>R_NO then
  566. begin
  567. cg.a_loadaddr_ref_reg(list,l.reference,l.reference.index);
  568. rg.ungetregister(list,l.reference.base);
  569. reference_reset_base(l.reference,l.reference.index,0);
  570. end
  571. else
  572. begin
  573. cg.a_loadaddr_ref_reg(list,l.reference,l.reference.base);
  574. rg.ungetregister(list,l.reference.index);
  575. reference_reset_base(l.reference,l.reference.base,0);
  576. end;
  577. { save base register }
  578. tg.GetTemp(exprasmlist,TCGSize2Size[OS_ADDR],tt_normal,s.ref);
  579. cg.a_load_reg_ref(exprasmlist,OS_ADDR,l.reference.base,s.ref);
  580. { release }
  581. location_release(exprasmlist,l);
  582. s.saved:=true;
  583. end;
  584. end;
  585. end;
  586. end;
  587. end;
  588. procedure maybe_restore(list:taasmoutput;var l:tlocation;const s:tmaybesave);
  589. begin
  590. if not s.saved then
  591. exit;
  592. if l.loc=LOC_CREGISTER then
  593. begin
  594. load_regvar_reg(list,l.register);
  595. exit;
  596. end;
  597. case l.loc of
  598. LOC_REGISTER :
  599. begin
  600. {$ifndef cpu64bit}
  601. if l.size in [OS_64,OS_S64] then
  602. begin
  603. l.registerlow:=rg.getregisterint(exprasmlist);
  604. l.registerhigh:=rg.getregisterint(exprasmlist);
  605. cg64.a_load64_ref_reg(exprasmlist,s.ref,joinreg64(l.registerlow,l.registerhigh));
  606. end
  607. else
  608. {$endif cpu64bit}
  609. begin
  610. l.register:=rg.getregisterint(exprasmlist);
  611. cg.a_load_ref_reg(exprasmlist,OS_INT,s.ref,l.register);
  612. end;
  613. end;
  614. LOC_CREFERENCE,
  615. LOC_REFERENCE :
  616. begin
  617. reference_reset(l.reference);
  618. l.reference.base:=rg.getaddressregister(exprasmlist);
  619. cg.a_load_ref_reg(exprasmlist,OS_ADDR,s.ref,l.reference.base);
  620. end;
  621. end;
  622. tg.ungetiftemp(exprasmlist,s.ref);
  623. end;
  624. function maybe_pushfpu(list:taasmoutput;needed : byte;var l:tlocation) : boolean;
  625. begin
  626. if (needed>=maxfpuregs) and
  627. (l.loc = LOC_FPUREGISTER) then
  628. begin
  629. location_force_mem(list,l);
  630. maybe_pushfpu:=true;
  631. end
  632. else
  633. maybe_pushfpu:=false;
  634. end;
  635. {*****************************************************************************
  636. Push Value Para
  637. *****************************************************************************}
  638. procedure push_value_para(p:tnode;calloption:tproccalloption;
  639. para_offset:longint;alignment : longint;
  640. const locpara : tparalocation);
  641. var
  642. tempreference : treference;
  643. href : treference;
  644. hreg : tregister;
  645. sizetopush,
  646. size : longint;
  647. cgsize : tcgsize;
  648. begin
  649. { we've nothing to push when the size of the parameter is 0 }
  650. if p.resulttype.def.size=0 then
  651. exit;
  652. { Move flags and jump in register to make it less complex }
  653. if p.location.loc in [LOC_FLAGS,LOC_JUMP] then
  654. location_force_reg(exprasmlist,p.location,def_cgsize(p.resulttype.def),false);
  655. { Handle Floating point types differently }
  656. if p.resulttype.def.deftype=floatdef then
  657. begin
  658. case p.location.loc of
  659. LOC_FPUREGISTER,
  660. LOC_CFPUREGISTER:
  661. begin
  662. size:=align(tfloatdef(p.resulttype.def).size,alignment);
  663. inc(pushedparasize,size);
  664. if calloption<>pocall_inline then
  665. cg.a_op_const_reg(exprasmlist,OP_SUB,size,STACK_POINTER_REG);
  666. {$ifdef GDB}
  667. if (cs_debuginfo in aktmoduleswitches) and
  668. (exprasmList.first=exprasmList.last) then
  669. exprasmList.concat(Tai_force_line.Create);
  670. {$endif GDB}
  671. { this is the easiest case for inlined !! }
  672. if calloption=pocall_inline then
  673. reference_reset_base(href,procinfo.framepointer,para_offset-pushedparasize)
  674. else
  675. reference_reset_base(href,stack_pointer_reg,0);
  676. cg.a_loadfpu_reg_ref(exprasmlist,
  677. def_cgsize(p.resulttype.def),p.location.register,href);
  678. end;
  679. LOC_REFERENCE,
  680. LOC_CREFERENCE :
  681. begin
  682. sizetopush:=align(p.resulttype.def.size,alignment);
  683. tempreference:=p.location.reference;
  684. inc(tempreference.offset,sizetopush);
  685. while (sizetopush>0) do
  686. begin
  687. if sizetopush>=4 then
  688. begin
  689. cgsize:=OS_32;
  690. inc(pushedparasize,4);
  691. dec(tempreference.offset,4);
  692. dec(sizetopush,4);
  693. end
  694. else
  695. begin
  696. cgsize:=OS_16;
  697. inc(pushedparasize,2);
  698. dec(tempreference.offset,2);
  699. dec(sizetopush,2);
  700. end;
  701. if calloption=pocall_inline then
  702. begin
  703. reference_reset_base(href,procinfo.framepointer,para_offset-pushedparasize);
  704. cg.a_load_ref_ref(exprasmlist,cgsize,tempreference,href);
  705. end
  706. else
  707. cg.a_param_ref(exprasmlist,cgsize,tempreference,locpara);
  708. end;
  709. end;
  710. else
  711. internalerror(200204243);
  712. end;
  713. end
  714. else
  715. begin
  716. { copy the value on the stack or use normal parameter push? }
  717. if paramanager.copy_value_on_stack(p.resulttype.def,calloption) then
  718. begin
  719. if not (p.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
  720. internalerror(200204241);
  721. { push on stack }
  722. size:=align(p.resulttype.def.size,alignment);
  723. inc(pushedparasize,size);
  724. cg.a_op_const_reg(exprasmlist,OP_SUB,size,STACK_POINTER_REG);
  725. reference_reset_base(href,STACK_POINTER_REG,0);
  726. cg.g_concatcopy(exprasmlist,p.location.reference,href,size,false,false);
  727. end
  728. else
  729. begin
  730. case p.location.loc of
  731. LOC_CONSTANT,
  732. LOC_REGISTER,
  733. LOC_CREGISTER,
  734. LOC_REFERENCE,
  735. LOC_CREFERENCE :
  736. begin
  737. cgsize:=def_cgsize(p.resulttype.def);
  738. if cgsize in [OS_64,OS_S64] then
  739. begin
  740. inc(pushedparasize,8);
  741. if calloption=pocall_inline then
  742. begin
  743. reference_reset_base(href,procinfo.framepointer,para_offset-pushedparasize);
  744. if p.location.loc in [LOC_REFERENCE,LOC_CREFERENCE] then
  745. begin
  746. size:=align(p.resulttype.def.size,alignment);
  747. cg.g_concatcopy(exprasmlist,p.location.reference,href,size,false,false)
  748. end
  749. else
  750. cg64.a_load64_loc_ref(exprasmlist,p.location,href);
  751. end
  752. else
  753. cg64.a_param64_loc(exprasmlist,p.location,locpara);
  754. end
  755. else
  756. begin
  757. case cgsize of
  758. OS_8,OS_S8 :
  759. begin
  760. if alignment=4 then
  761. cgsize:=OS_32
  762. else
  763. cgsize:=OS_16;
  764. end;
  765. OS_16,OS_S16 :
  766. begin
  767. if alignment=4 then
  768. cgsize:=OS_32;
  769. end;
  770. end;
  771. { update register to use to match alignment }
  772. if p.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
  773. begin
  774. hreg:=p.location.register;
  775. p.location.register:=rg.makeregsize(p.location.register,cgsize);
  776. end;
  777. inc(pushedparasize,alignment);
  778. if calloption=pocall_inline then
  779. begin
  780. reference_reset_base(href,procinfo.framepointer,para_offset-pushedparasize);
  781. if p.location.loc in [LOC_REFERENCE,LOC_CREFERENCE] then
  782. begin
  783. size:=align(p.resulttype.def.size,alignment);
  784. cg.g_concatcopy(exprasmlist,p.location.reference,href,size,false,false)
  785. end
  786. else
  787. cg.a_load_loc_ref(exprasmlist,p.location,href);
  788. end
  789. else
  790. cg.a_param_loc(exprasmlist,p.location,locpara);
  791. { restore old register }
  792. if p.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
  793. p.location.register:=hreg;
  794. end;
  795. location_release(exprasmlist,p.location);
  796. end;
  797. {$ifdef SUPPORT_MMX}
  798. LOC_MMXREGISTER,
  799. LOC_CMMXREGISTER:
  800. begin
  801. inc(pushedparasize,8);
  802. if calloption=pocall_inline then
  803. begin
  804. reference_reset_base(href,procinfo.framepointer,para_offset-pushedparasize);
  805. cg.a_loadmm_reg_ref(exprasmlist,p.location.register,href);
  806. end
  807. else
  808. cg.a_parammm_reg(exprasmlist,p.location.register);
  809. end;
  810. {$endif SUPPORT_MMX}
  811. else
  812. internalerror(200204241);
  813. end;
  814. end;
  815. end;
  816. end;
  817. {****************************************************************************
  818. Entry/Exit Code
  819. ****************************************************************************}
  820. procedure copyvalueparas(p : tnamedindexitem;arg:pointer);
  821. var
  822. href1,href2 : treference;
  823. list : taasmoutput;
  824. begin
  825. list:=taasmoutput(arg);
  826. if (tsym(p).typ=varsym) and
  827. (tvarsym(p).varspez=vs_value) and
  828. (paramanager.push_addr_param(tvarsym(p).vartype.def,procinfo.procdef.proccalloption)) then
  829. begin
  830. reference_reset_base(href1,procinfo.framepointer,tvarsym(p).address+procinfo.para_offset);
  831. if is_open_array(tvarsym(p).vartype.def) or
  832. is_array_of_const(tvarsym(p).vartype.def) then
  833. cg.g_copyvaluepara_openarray(list,href1,tarraydef(tvarsym(p).vartype.def).elesize)
  834. else
  835. begin
  836. reference_reset_base(href2,procinfo.framepointer,-tvarsym(p).localvarsym.address+tvarsym(p).localvarsym.owner.address_fixup);
  837. if is_shortstring(tvarsym(p).vartype.def) then
  838. cg.g_copyshortstring(list,href1,href2,tstringdef(tvarsym(p).vartype.def).len,false,true)
  839. else
  840. cg.g_concatcopy(list,href1,href2,tvarsym(p).vartype.def.size,true,true);
  841. end;
  842. end;
  843. end;
  844. procedure removevalueparas(p : tnamedindexitem;arg:pointer);
  845. var
  846. href1 : treference;
  847. list : taasmoutput;
  848. begin
  849. list:=taasmoutput(arg);
  850. if (tsym(p).typ=varsym) and
  851. (tvarsym(p).varspez=vs_value) and
  852. (is_open_array(tvarsym(p).vartype.def) or
  853. is_array_of_const(tvarsym(p).vartype.def)) and
  854. (paramanager.push_addr_param(tvarsym(p).vartype.def,procinfo.procdef.proccalloption)) then
  855. begin
  856. reference_reset_base(href1,procinfo.framepointer,tvarsym(p).address+procinfo.para_offset);
  857. cg.g_removevaluepara_openarray(list,href1,tarraydef(tvarsym(p).vartype.def).elesize);
  858. end;
  859. end;
  860. { generates the code for initialisation of local data }
  861. procedure initialize_data(p : tnamedindexitem;arg:pointer);
  862. var
  863. href : treference;
  864. list : taasmoutput;
  865. begin
  866. list:=taasmoutput(arg);
  867. if (tsym(p).typ=varsym) and
  868. not(vo_is_local_copy in tvarsym(p).varoptions) and
  869. assigned(tvarsym(p).vartype.def) and
  870. not(is_class(tvarsym(p).vartype.def)) and
  871. tvarsym(p).vartype.def.needs_inittable then
  872. begin
  873. if assigned(procinfo) and
  874. (cs_implicit_exceptions in aktmoduleswitches) then
  875. procinfo.flags:=procinfo.flags or pi_needs_implicit_finally;
  876. if tsym(p).owner.symtabletype in [localsymtable,inlinelocalsymtable] then
  877. reference_reset_base(href,procinfo.framepointer,-tvarsym(p).address+tvarsym(p).owner.address_fixup)
  878. else
  879. reference_reset_symbol(href,objectlibrary.newasmsymbol(tvarsym(p).mangledname),0);
  880. cg.g_initialize(list,tvarsym(p).vartype.def,href,false);
  881. end;
  882. end;
  883. { generates the code for finalisation of local data }
  884. procedure finalize_data(p : tnamedindexitem;arg:pointer);
  885. var
  886. href : treference;
  887. list : taasmoutput;
  888. begin
  889. list:=taasmoutput(arg);
  890. case tsym(p).typ of
  891. varsym :
  892. begin
  893. if not(vo_is_local_copy in tvarsym(p).varoptions) and
  894. assigned(tvarsym(p).vartype.def) and
  895. not(is_class(tvarsym(p).vartype.def)) and
  896. tvarsym(p).vartype.def.needs_inittable then
  897. begin
  898. if tsym(p).owner.symtabletype in [localsymtable,inlinelocalsymtable] then
  899. reference_reset_base(href,procinfo.framepointer,-tvarsym(p).address+tvarsym(p).owner.address_fixup)
  900. else
  901. reference_reset_symbol(href,objectlibrary.newasmsymbol(tvarsym(p).mangledname),0);
  902. cg.g_finalize(list,tvarsym(p).vartype.def,href,false);
  903. end;
  904. end;
  905. typedconstsym :
  906. begin
  907. if ttypedconstsym(p).is_writable and
  908. ttypedconstsym(p).typedconsttype.def.needs_inittable then
  909. begin
  910. reference_reset_symbol(href,objectlibrary.newasmsymbol(ttypedconstsym(p).mangledname),0);
  911. cg.g_finalize(list,ttypedconstsym(p).typedconsttype.def,href,false);
  912. end;
  913. end;
  914. end;
  915. end;
  916. { generates the code for incrementing the reference count of parameters and
  917. initialize out parameters }
  918. procedure init_paras(p : tnamedindexitem;arg:pointer);
  919. var
  920. href : treference;
  921. tmpreg : tregister;
  922. list : taasmoutput;
  923. begin
  924. list:=taasmoutput(arg);
  925. if (tsym(p).typ=varsym) and
  926. not is_class(tvarsym(p).vartype.def) and
  927. tvarsym(p).vartype.def.needs_inittable then
  928. begin
  929. case tvarsym(p).varspez of
  930. vs_value :
  931. begin
  932. if (cs_implicit_exceptions in aktmoduleswitches) then
  933. procinfo.flags:=procinfo.flags or pi_needs_implicit_finally;
  934. if assigned(tvarsym(p).localvarsym) then
  935. reference_reset_base(href,procinfo.framepointer,
  936. -tvarsym(p).localvarsym.address+tvarsym(p).localvarsym.owner.address_fixup)
  937. else
  938. reference_reset_base(href,procinfo.framepointer,tvarsym(p).address+procinfo.para_offset);
  939. cg.g_incrrefcount(list,tvarsym(p).vartype.def,href);
  940. end;
  941. vs_out :
  942. begin
  943. reference_reset_base(href,procinfo.framepointer,tvarsym(p).address+procinfo.para_offset);
  944. tmpreg:=cg.get_scratch_reg_address(list);
  945. cg.a_load_ref_reg(list,OS_ADDR,href,tmpreg);
  946. reference_reset_base(href,tmpreg,0);
  947. cg.g_initialize(list,tvarsym(p).vartype.def,href,false);
  948. cg.free_scratch_reg(list,tmpreg);
  949. end;
  950. end;
  951. end;
  952. end;
  953. { generates the code for decrementing the reference count of parameters }
  954. procedure final_paras(p : tnamedindexitem;arg:pointer);
  955. var
  956. href : treference;
  957. list : taasmoutput;
  958. begin
  959. list:=taasmoutput(arg);
  960. if (tsym(p).typ=varsym) and
  961. not is_class(tvarsym(p).vartype.def) and
  962. tvarsym(p).vartype.def.needs_inittable then
  963. begin
  964. if (tvarsym(p).varspez=vs_value) then
  965. begin
  966. if assigned(tvarsym(p).localvarsym) then
  967. reference_reset_base(href,procinfo.framepointer,
  968. -tvarsym(p).localvarsym.address+tvarsym(p).localvarsym.owner.address_fixup)
  969. else
  970. reference_reset_base(href,procinfo.framepointer,tvarsym(p).address+procinfo.para_offset);
  971. cg.g_decrrefcount(list,tvarsym(p).vartype.def,href);
  972. end;
  973. end;
  974. end;
  975. { Initialize temp ansi/widestrings,interfaces }
  976. procedure inittempvariables(list:taasmoutput);
  977. var
  978. hp : ptemprecord;
  979. href : treference;
  980. begin
  981. hp:=tg.templist;
  982. while assigned(hp) do
  983. begin
  984. if hp^.temptype in [tt_ansistring,tt_freeansistring,
  985. tt_widestring,tt_freewidestring,
  986. tt_interfacecom,tt_freeinterfacecom] then
  987. begin
  988. if (cs_implicit_exceptions in aktmoduleswitches) then
  989. procinfo.flags:=procinfo.flags or pi_needs_implicit_finally;
  990. reference_reset_base(href,procinfo.framepointer,hp^.pos);
  991. cg.a_load_const_ref(list,OS_ADDR,0,href);
  992. end;
  993. hp:=hp^.next;
  994. end;
  995. end;
  996. procedure finalizetempvariables(list:taasmoutput);
  997. var
  998. hp : ptemprecord;
  999. href : treference;
  1000. begin
  1001. hp:=tg.templist;
  1002. while assigned(hp) do
  1003. begin
  1004. case hp^.temptype of
  1005. tt_ansistring,
  1006. tt_freeansistring :
  1007. begin
  1008. reference_reset_base(href,procinfo.framepointer,hp^.pos);
  1009. cg.a_paramaddr_ref(list,href,paramanager.getintparaloc(1));
  1010. cg.a_call_name(list,'FPC_ANSISTR_DECR_REF');
  1011. end;
  1012. tt_widestring,
  1013. tt_freewidestring :
  1014. begin
  1015. reference_reset_base(href,procinfo.framepointer,hp^.pos);
  1016. cg.a_paramaddr_ref(list,href,paramanager.getintparaloc(2));
  1017. cg.a_call_name(list,'FPC_WIDESTR_DECR_REF');
  1018. end;
  1019. tt_interfacecom :
  1020. begin
  1021. reference_reset_base(href,procinfo.framepointer,hp^.pos);
  1022. cg.a_paramaddr_ref(list,href,paramanager.getintparaloc(2));
  1023. cg.a_call_name(list,'FPC_INTF_DECR_REF');
  1024. end;
  1025. end;
  1026. hp:=hp^.next;
  1027. end;
  1028. end;
  1029. procedure handle_return_value(list:TAAsmoutput; inlined : boolean;var uses_acc,uses_acchi,uses_fpu : boolean);
  1030. var
  1031. href : treference;
  1032. hreg : tregister;
  1033. cgsize : TCGSize;
  1034. begin
  1035. if not is_void(aktprocdef.rettype.def) then
  1036. begin
  1037. if (tfuncretsym(aktprocdef.funcretsym).funcretstate<>vs_assigned) and
  1038. (not inlined) then
  1039. CGMessage(sym_w_function_result_not_set);
  1040. reference_reset_base(href,procinfo.framepointer,procinfo.return_offset);
  1041. cgsize:=def_cgsize(aktprocdef.rettype.def);
  1042. case aktprocdef.rettype.def.deftype of
  1043. orddef,
  1044. enumdef :
  1045. begin
  1046. uses_acc:=true;
  1047. {$WARNING accumulator was replaced by return_result_reg}
  1048. {Here, we return the function result. In most architectures, the value is
  1049. passed into the accumulator, but in a windowed architecure like sparc a
  1050. function returns in a register and the caller receives it in an other one}
  1051. cg.a_reg_alloc(list,return_result_reg);
  1052. {$ifndef cpu64bit}
  1053. if cgsize in [OS_64,OS_S64] then
  1054. begin
  1055. uses_acchi:=true;
  1056. cg.a_reg_alloc(list,accumulatorhigh);
  1057. cg64.a_load64_ref_reg(list,href,joinreg64(accumulator,accumulatorhigh));
  1058. end
  1059. else
  1060. {$endif cpu64bit}
  1061. begin
  1062. {$WARNING accumulator was replaced by return_result_reg}
  1063. {Here, we return the function result. In most architectures, the value is
  1064. passed into the accumulator, but in a windowed architecure like sparc a
  1065. function returns in a register and the caller receives it in an other one}
  1066. hreg:=rg.makeregsize(return_result_reg,cgsize);
  1067. cg.a_load_ref_reg(list,cgsize,href,hreg);
  1068. end;
  1069. end;
  1070. floatdef :
  1071. begin
  1072. uses_fpu := true;
  1073. cg.a_loadfpu_ref_reg(list,cgsize,href,FPU_RESULT_REG);
  1074. end;
  1075. else
  1076. begin
  1077. if paramanager.ret_in_acc(aktprocdef.rettype.def,aktprocdef.proccalloption) then
  1078. begin
  1079. uses_acc:=true;
  1080. cg.a_reg_alloc(list,accumulator);
  1081. {$ifndef cpu64bit}
  1082. { Win32 can return records in EAX:EDX }
  1083. if cgsize in [OS_64,OS_S64] then
  1084. begin
  1085. uses_acchi:=true;
  1086. cg.a_reg_alloc(list,accumulatorhigh);
  1087. cg64.a_load64_ref_reg(list,href,joinreg64(accumulator,accumulatorhigh));
  1088. end
  1089. else
  1090. {$endif cpu64bit}
  1091. cg.a_load_ref_reg(list,cgsize,href,accumulator);
  1092. end
  1093. end;
  1094. end;
  1095. end;
  1096. end;
  1097. procedure handle_fast_exit_return_value(list:TAAsmoutput);
  1098. var
  1099. href : treference;
  1100. hreg : tregister;
  1101. cgsize : TCGSize;
  1102. begin
  1103. if not is_void(aktprocdef.rettype.def) then
  1104. begin
  1105. reference_reset_base(href,procinfo.framepointer,procinfo.return_offset);
  1106. cgsize:=def_cgsize(aktprocdef.rettype.def);
  1107. case aktprocdef.rettype.def.deftype of
  1108. orddef,
  1109. enumdef :
  1110. begin
  1111. {$ifndef cpu64bit}
  1112. if cgsize in [OS_64,OS_S64] then
  1113. cg64.a_load64_reg_ref(list,joinreg64(accumulator,accumulatorhigh),href)
  1114. else
  1115. {$endif cpu64bit}
  1116. begin
  1117. hreg:=rg.makeregsize(accumulator,cgsize);
  1118. cg.a_load_reg_ref(list,cgsize,hreg,href);
  1119. end;
  1120. end;
  1121. floatdef :
  1122. begin
  1123. cg.a_loadfpu_reg_ref(list,cgsize,FPU_RESULT_REG,href);
  1124. end;
  1125. else
  1126. begin
  1127. if paramanager.ret_in_acc(aktprocdef.rettype.def,aktprocdef.proccalloption) then
  1128. cg.a_load_reg_ref(list,cgsize,accumulator,href);
  1129. end;
  1130. end;
  1131. end;
  1132. end;
  1133. procedure genentrycode(list : TAAsmoutput;
  1134. make_global:boolean;
  1135. stackframe:longint;
  1136. var parasize:longint;var nostackframe:boolean;
  1137. inlined : boolean);
  1138. var
  1139. hs : string;
  1140. href : treference;
  1141. stackalloclist : taasmoutput;
  1142. hp : tparaitem;
  1143. paraloc : tparalocation;
  1144. begin
  1145. if not inlined then
  1146. stackalloclist:=taasmoutput.Create;
  1147. { the actual stack allocation code, symbol entry point and
  1148. gdb stabs information is generated AFTER the rest of this
  1149. code, since temp. allocation might occur before - carl
  1150. }
  1151. if (cs_profile in aktmoduleswitches) and
  1152. not(po_assembler in aktprocdef.procoptions) and not(inlined) then
  1153. cg.g_profilecode(list);
  1154. { for the save all registers we can simply use a pusha,popa which
  1155. push edi,esi,ebp,esp(ignored),ebx,edx,ecx,eax }
  1156. if (po_saveregisters in aktprocdef.procoptions) then
  1157. cg.g_save_all_registers(list)
  1158. else
  1159. { should we save edi,esi,ebx like C ? }
  1160. if (po_savestdregs in aktprocdef.procoptions) then
  1161. cg.g_save_standard_registers(list,aktprocdef.usedregisters);
  1162. { a constructor needs a help procedure }
  1163. if (aktprocdef.proctypeoption=potype_constructor) then
  1164. cg.g_call_constructor_helper(list);
  1165. { don't load ESI, does the caller }
  1166. { we must do it for local function }
  1167. { that can be called from a foreach_static }
  1168. { of another object than self !! PM }
  1169. if assigned(procinfo._class) and { !!!!! shouldn't we load ESI always? }
  1170. (lexlevel>normal_function_level) then
  1171. cg.g_maybe_loadself(list);
  1172. { When message method contains self as a parameter,
  1173. we must load it into ESI }
  1174. If (po_containsself in aktprocdef.procoptions) then
  1175. begin
  1176. list.concat(tai_regalloc.Alloc(self_pointer_reg));
  1177. reference_reset_base(href,procinfo.framepointer,procinfo.selfpointer_offset);
  1178. cg.a_load_ref_reg(list,OS_ADDR,href,self_pointer_reg);
  1179. end;
  1180. if not is_void(aktprocdef.rettype.def) then
  1181. begin
  1182. { for now the pointer to the result can't be a register }
  1183. if not(paramanager.ret_in_reg(aktprocdef.rettype.def,aktprocdef.proccalloption)) then
  1184. begin
  1185. paraloc:=paramanager.getfuncretparaloc(aktprocdef);
  1186. reference_reset_base(href,procinfo.framepointer,procinfo.return_offset);
  1187. case paraloc.loc of
  1188. LOC_CREGISTER,
  1189. LOC_REGISTER:
  1190. if not(paraloc.size in [OS_64,OS_S64]) then
  1191. cg.a_load_reg_ref(list,paraloc.size,paraloc.register,href)
  1192. else
  1193. cg64.a_load64_reg_ref(list,paraloc.register64,href);
  1194. LOC_CFPUREGISTER,
  1195. LOC_FPUREGISTER:
  1196. cg.a_load_reg_ref(list,paraloc.size,paraloc.register,href);
  1197. LOC_CMMREGISTER,
  1198. LOC_MMREGISTER:
  1199. cg.a_loadmm_reg_ref(list,paraloc.register,href);
  1200. end;
  1201. end;
  1202. { initialize return value }
  1203. if (aktprocdef.rettype.def.needs_inittable) then
  1204. begin
  1205. if (cs_implicit_exceptions in aktmoduleswitches) then
  1206. procinfo.flags:=procinfo.flags or pi_needs_implicit_finally;
  1207. reference_reset_base(href,procinfo.framepointer,procinfo.return_offset);
  1208. cg.g_initialize(list,aktprocdef.rettype.def,href,paramanager.ret_in_param(aktprocdef.rettype.def,aktprocdef.proccalloption));
  1209. end;
  1210. end;
  1211. { initialisize local data like ansistrings }
  1212. case aktprocdef.proctypeoption of
  1213. potype_unitinit:
  1214. begin
  1215. { using current_module.globalsymtable is hopefully }
  1216. { more robust than symtablestack and symtablestack.next }
  1217. tsymtable(current_module.globalsymtable).foreach_static({$ifndef TP}@{$endif}initialize_data,list);
  1218. tsymtable(current_module.localsymtable).foreach_static({$ifndef TP}@{$endif}initialize_data,list);
  1219. end;
  1220. { units have seperate code for initilization and finalization }
  1221. potype_unitfinalize: ;
  1222. { program init/final is generated in separate procedure }
  1223. potype_proginit: ;
  1224. else
  1225. aktprocdef.localst.foreach_static({$ifndef TP}@{$endif}initialize_data,list);
  1226. end;
  1227. { initialisizes temp. ansi/wide string data }
  1228. inittempvariables(list);
  1229. { generate copies of call by value parameters }
  1230. if not(po_assembler in aktprocdef.procoptions) and
  1231. not(aktprocdef.proccalloption in [pocall_cdecl,pocall_cppdecl,pocall_palmossyscall,pocall_system]) then
  1232. aktprocdef.parast.foreach_static({$ifndef TP}@{$endif}copyvalueparas,list);
  1233. if assigned(aktprocdef.parast) then
  1234. begin
  1235. aktprocdef.parast.foreach_static({$ifndef TP}@{$endif}init_paras,list);
  1236. { move register parameters which aren't regable into memory }
  1237. { we do this after init_paras because it saves some code in init_paras if parameters are in register }
  1238. { instead in memory }
  1239. hp:=tparaitem(procinfo.procdef.para.first);
  1240. while assigned(hp) do
  1241. begin
  1242. if (tvarsym(hp.parasym).reg<>R_NO) then
  1243. case hp.paraloc.loc of
  1244. LOC_CREGISTER,
  1245. LOC_REGISTER:
  1246. // if not(hp.paraloc.size in [OS_S64,OS_64]) then
  1247. cg.a_load_reg_reg(list,hp.paraloc.size,OS_32,hp.paraloc.register,tvarsym(hp.parasym).reg);
  1248. // else
  1249. // cg64.a_load64_reg_reg(list,hp.paraloc.register64,tvarsym(hp.parasym).reg);
  1250. LOC_CFPUREGISTER,
  1251. LOC_FPUREGISTER:
  1252. cg.a_loadfpu_reg_reg(list,hp.paraloc.register,tvarsym(hp.parasym).reg);
  1253. end
  1254. else if (hp.paraloc.loc in [LOC_REGISTER,LOC_FPUREGISTER,LOC_MMREGISTER,
  1255. LOC_CREGISTER,LOC_CFPUREGISTER,LOC_CMMREGISTER]) and
  1256. (tvarsym(hp.parasym).reg=R_NO) then
  1257. begin
  1258. reference_reset_base(href,procinfo.framepointer,tvarsym(hp.parasym).address+
  1259. tvarsym(hp.parasym).owner.address_fixup);
  1260. case hp.paraloc.loc of
  1261. LOC_CREGISTER,
  1262. LOC_REGISTER:
  1263. if not(hp.paraloc.size in [OS_S64,OS_64]) then
  1264. cg.a_load_reg_ref(list,hp.paraloc.size,hp.paraloc.register,href)
  1265. else
  1266. cg64.a_load64_reg_ref(list,hp.paraloc.register64,href);
  1267. LOC_FPUREGISTER,
  1268. LOC_CFPUREGISTER:
  1269. cg.a_loadfpu_reg_ref(list,hp.paraloc.size,hp.paraloc.register,href);
  1270. else
  1271. internalerror(2002081302);
  1272. end;
  1273. end;
  1274. hp:=tparaitem(hp.next);
  1275. end;
  1276. end;
  1277. if (not inlined) then
  1278. begin
  1279. { call startup helpers from main program }
  1280. if (aktprocdef.proctypeoption=potype_proginit) then
  1281. begin
  1282. { initialize profiling for win32 }
  1283. if (target_info.system in [system_i386_win32,system_i386_wdosx]) and
  1284. (cs_profile in aktmoduleswitches) then
  1285. begin
  1286. reference_reset_symbol(href,objectlibrary.newasmsymbol('etext'),0);
  1287. cg.a_paramaddr_ref(list,href,paraloc);
  1288. reference_reset_symbol(href,objectlibrary.newasmsymbol('__image_base__'),0);
  1289. cg.a_paramaddr_ref(list,href,paraloc);
  1290. cg.a_call_name(list,'monstartup');
  1291. end;
  1292. { initialize units }
  1293. cg.a_call_name(list,'FPC_INITIALIZEUNITS');
  1294. end;
  1295. { do we need an exception frame because of ansi/widestrings/interfaces ? }
  1296. if ((procinfo.flags and pi_needs_implicit_finally)<>0) and
  1297. { but it's useless in init/final code of units }
  1298. not(aktprocdef.proctypeoption in [potype_unitfinalize,potype_unitinit]) then
  1299. begin
  1300. include(rg.usedinproc,accumulator);
  1301. tg.GetTemp(list,JMP_BUF_SIZE,tt_noreuse,procinfo.exception_jmp_ref);
  1302. tg.GetTemp(list,12,tt_noreuse,procinfo.exception_env_ref);
  1303. tg.GetTemp(list,sizeof(aword),tt_noreuse,procinfo.exception_result_ref);
  1304. new_exception(list,procinfo.exception_jmp_ref,
  1305. procinfo.exception_env_ref,
  1306. procinfo.exception_result_ref,1,aktexitlabel);
  1307. { probably we've to reload self here }
  1308. cg.g_maybe_loadself(list);
  1309. end;
  1310. {$ifdef GDB}
  1311. if (cs_debuginfo in aktmoduleswitches) then
  1312. list.concat(Tai_force_line.Create);
  1313. {$endif GDB}
  1314. end;
  1315. if inlined then
  1316. load_regvars(list,nil);
  1317. {************************* Stack allocation **************************}
  1318. { and symbol entry point as well as debug information }
  1319. { will be inserted in front of the rest of this list. }
  1320. { Insert alignment and assembler names }
  1321. if not inlined then
  1322. begin
  1323. { Align, gprof uses 16 byte granularity }
  1324. if (cs_profile in aktmoduleswitches) then
  1325. stackalloclist.concat(Tai_align.Create(16))
  1326. else
  1327. stackalloclist.concat(Tai_align.Create(aktalignment.procalign));
  1328. if (cs_profile in aktmoduleswitches) or
  1329. (aktprocdef.owner.symtabletype=globalsymtable) or
  1330. (assigned(procinfo._class) and (procinfo._class.owner.symtabletype=globalsymtable)) then
  1331. make_global:=true;
  1332. if make_global or ((procinfo.flags and pi_is_global) <> 0) then
  1333. aktprocsym.is_global := True;
  1334. {$ifdef GDB}
  1335. if (cs_debuginfo in aktmoduleswitches) then
  1336. begin
  1337. aktprocdef.concatstabto(stackalloclist);
  1338. aktprocsym.isstabwritten:=true;
  1339. end;
  1340. {$endif GDB}
  1341. repeat
  1342. hs:=aktprocdef.aliasnames.getfirst;
  1343. if hs='' then
  1344. break;
  1345. {$ifdef GDB}
  1346. if (cs_debuginfo in aktmoduleswitches) and
  1347. target_info.use_function_relative_addresses then
  1348. stackalloclist.concat(Tai_stab_function_name.Create(strpnew(hs)));
  1349. {$endif GDB}
  1350. if make_global then
  1351. stackalloclist.concat(Tai_symbol.Createname_global(hs,0))
  1352. else
  1353. stackalloclist.concat(Tai_symbol.Createname(hs,0));
  1354. until false;
  1355. stackframe:=stackframe+tg.gettempsize;
  1356. {$ifndef powerpc}
  1357. { at least for the ppc this applies always, so this code isn't usable (FK) }
  1358. { omit stack frame ? }
  1359. if (procinfo.framepointer=STACK_POINTER_REG) then
  1360. begin
  1361. CGMessage(cg_d_stackframe_omited);
  1362. nostackframe:=true;
  1363. if (aktprocdef.proctypeoption in [potype_unitinit,potype_proginit,potype_unitfinalize]) then
  1364. parasize:=0
  1365. else
  1366. parasize:=aktprocdef.parast.datasize+procinfo.para_offset-4;
  1367. if stackframe<>0 then
  1368. cg.a_op_const_reg(stackalloclist,OP_SUB,stackframe,procinfo.framepointer);
  1369. end
  1370. else
  1371. {$endif powerpc}
  1372. begin
  1373. nostackframe:=false;
  1374. if (aktprocdef.proctypeoption in [potype_unitinit,potype_proginit,potype_unitfinalize]) then
  1375. parasize:=0
  1376. else
  1377. parasize:=aktprocdef.parast.datasize+procinfo.para_offset-target_info.first_parm_offset;
  1378. if (po_interrupt in aktprocdef.procoptions) then
  1379. cg.g_interrupt_stackframe_entry(stackalloclist);
  1380. cg.g_stackframe_entry(stackalloclist,stackframe);
  1381. { never call stack checking before the standard system unit
  1382. has not been initialized
  1383. }
  1384. if (cs_check_stack in aktlocalswitches) and (aktprocdef.proctypeoption<>potype_proginit) then
  1385. cg.g_stackcheck(stackalloclist,stackframe);
  1386. end;
  1387. list.insertlist(stackalloclist);
  1388. stackalloclist.free;
  1389. end;
  1390. {************************* End Stack allocation **************************}
  1391. end;
  1392. procedure genexitcode(list : TAAsmoutput;parasize:longint;nostackframe,inlined:boolean);
  1393. var
  1394. {$ifdef GDB}
  1395. stabsendlabel : tasmlabel;
  1396. mangled_length : longint;
  1397. p : pchar;
  1398. st : string[2];
  1399. {$endif GDB}
  1400. okexitlabel,
  1401. noreraiselabel,nodestroycall : tasmlabel;
  1402. tmpreg : tregister;
  1403. href : treference;
  1404. usesacc,
  1405. usesacchi,
  1406. usesself,usesfpu : boolean;
  1407. pd : tprocdef;
  1408. begin
  1409. if aktexit2label.is_used and
  1410. ((procinfo.flags and (pi_needs_implicit_finally or pi_uses_exceptions)) <> 0) then
  1411. begin
  1412. cg.a_jmp_always(list,aktexitlabel);
  1413. cg.a_label(list,aktexit2label);
  1414. handle_fast_exit_return_value(list);
  1415. end;
  1416. if aktexitlabel.is_used then
  1417. list.concat(Tai_label.Create(aktexitlabel));
  1418. cleanup_regvars(list);
  1419. { call the destructor help procedure }
  1420. if (aktprocdef.proctypeoption=potype_destructor) and
  1421. assigned(procinfo._class) then
  1422. cg.g_call_destructor_helper(list);
  1423. { finalize temporary data }
  1424. finalizetempvariables(list);
  1425. { finalize local data like ansistrings}
  1426. case aktprocdef.proctypeoption of
  1427. potype_unitfinalize:
  1428. begin
  1429. { using current_module.globalsymtable is hopefully }
  1430. { more robust than symtablestack and symtablestack.next }
  1431. tsymtable(current_module.globalsymtable).foreach_static({$ifndef TP}@{$endif}finalize_data,list);
  1432. tsymtable(current_module.localsymtable).foreach_static({$ifndef TP}@{$endif}finalize_data,list);
  1433. end;
  1434. { units/progs have separate code for initialization and finalization }
  1435. potype_unitinit: ;
  1436. { program init/final is generated in separate procedure }
  1437. potype_proginit: ;
  1438. else
  1439. aktprocdef.localst.foreach_static({$ifndef TP}@{$endif}finalize_data,list);
  1440. end;
  1441. { finalize paras data }
  1442. if assigned(aktprocdef.parast) then
  1443. aktprocdef.parast.foreach_static({$ifndef TP}@{$endif}final_paras,list);
  1444. { do we need to handle exceptions because of ansi/widestrings ? }
  1445. if not inlined and
  1446. ((procinfo.flags and pi_needs_implicit_finally)<>0) and
  1447. { but it's useless in init/final code of units }
  1448. not(aktprocdef.proctypeoption in [potype_unitfinalize,potype_unitinit]) then
  1449. begin
  1450. { the exception helper routines modify all registers }
  1451. aktprocdef.usedregisters:=all_registers;
  1452. objectlibrary.getlabel(noreraiselabel);
  1453. free_exception(list,
  1454. procinfo.exception_jmp_ref,
  1455. procinfo.exception_env_ref,
  1456. procinfo.exception_result_ref,0,
  1457. noreraiselabel,false);
  1458. tg.Ungettemp(list,procinfo.exception_jmp_ref);
  1459. tg.Ungettemp(list,procinfo.exception_env_ref);
  1460. tg.Ungettemp(list,procinfo.exception_result_ref);
  1461. if (aktprocdef.proctypeoption=potype_constructor) then
  1462. begin
  1463. if assigned(procinfo._class) then
  1464. begin
  1465. pd:=procinfo._class.searchdestructor;
  1466. if assigned(pd) then
  1467. begin
  1468. objectlibrary.getlabel(nodestroycall);
  1469. reference_reset_base(href,procinfo.framepointer,procinfo.selfpointer_offset);
  1470. cg.a_cmp_const_ref_label(list,OS_ADDR,OC_EQ,0,href,nodestroycall);
  1471. if is_class(procinfo._class) then
  1472. begin
  1473. cg.a_param_const(list,OS_INT,1,paramanager.getintparaloc(2));
  1474. cg.a_param_reg(list,OS_ADDR,self_pointer_reg,paramanager.getintparaloc(1));
  1475. end
  1476. else if is_object(procinfo._class) then
  1477. begin
  1478. cg.a_param_reg(list,OS_ADDR,self_pointer_reg,paramanager.getintparaloc(2));
  1479. reference_reset_symbol(href,objectlibrary.newasmsymbol(procinfo._class.vmt_mangledname),0);
  1480. cg.a_paramaddr_ref(list,href,paramanager.getintparaloc(1));
  1481. end
  1482. else
  1483. Internalerror(200006164);
  1484. if (po_virtualmethod in pd.procoptions) then
  1485. begin
  1486. reference_reset_base(href,self_pointer_reg,0);
  1487. tmpreg:=cg.get_scratch_reg_address(list);
  1488. cg.a_load_ref_reg(list,OS_ADDR,href,tmpreg);
  1489. reference_reset_base(href,tmpreg,procinfo._class.vmtmethodoffset(pd.extnumber));
  1490. cg.free_scratch_reg(list,tmpreg);
  1491. cg.a_call_ref(list,href);
  1492. end
  1493. else
  1494. cg.a_call_name(list,pd.mangledname);
  1495. { not necessary because the result is never assigned in the
  1496. case of an exception (FK) }
  1497. cg.a_label(list,nodestroycall);
  1498. end;
  1499. end
  1500. end
  1501. else
  1502. begin
  1503. { no constructor }
  1504. { must be the return value finalized before reraising the exception? }
  1505. if (not is_void(aktprocdef.rettype.def)) and
  1506. (aktprocdef.rettype.def.needs_inittable) and
  1507. ((aktprocdef.rettype.def.deftype<>objectdef) or
  1508. not is_class(aktprocdef.rettype.def)) then
  1509. begin
  1510. reference_reset_base(href,procinfo.framepointer,procinfo.return_offset);
  1511. cg.g_finalize(list,aktprocdef.rettype.def,href,paramanager.ret_in_param(aktprocdef.rettype.def,aktprocdef.proccalloption));
  1512. end;
  1513. end;
  1514. cg.a_call_name(list,'FPC_RERAISE');
  1515. cg.a_label(list,noreraiselabel);
  1516. end;
  1517. { call __EXIT for main program }
  1518. if (not DLLsource) and
  1519. (not inlined) and
  1520. (aktprocdef.proctypeoption=potype_proginit) then
  1521. begin
  1522. {if (target_info.system=system_i386_win32) and
  1523. (cs_profile in aktmoduleswitches) then
  1524. cg.a_call_name(list,'__mcleanup'); }
  1525. cg.a_call_name(list,'FPC_DO_EXIT');
  1526. end;
  1527. { handle return value, this is not done for assembler routines when
  1528. they didn't reference the result variable }
  1529. usesacc:=false;
  1530. usesacchi:=false;
  1531. usesself:=false;
  1532. if not(po_assembler in aktprocdef.procoptions) or
  1533. (assigned(aktprocdef.funcretsym) and
  1534. (tfuncretsym(aktprocdef.funcretsym).refcount>1)) then
  1535. begin
  1536. if (aktprocdef.proctypeoption<>potype_constructor) then
  1537. handle_return_value(list,inlined,usesacc,usesacchi,usesfpu)
  1538. else
  1539. begin
  1540. { successful constructor deletes the zero flag }
  1541. { and returns self in eax }
  1542. { eax must be set to zero if the allocation failed !!! }
  1543. objectlibrary.getlabel(okexitlabel);
  1544. cg.a_jmp_always(list,okexitlabel);
  1545. cg.a_label(list,faillabel);
  1546. cg.g_call_fail_helper(list);
  1547. cg.a_label(list,okexitlabel);
  1548. { for classes this is done after the call to }
  1549. { AfterConstruction }
  1550. if is_object(procinfo._class) then
  1551. begin
  1552. cg.a_reg_alloc(list,accumulator);
  1553. cg.a_load_reg_reg(list,OS_ADDR,OS_ADDR,self_pointer_reg,accumulator);
  1554. usesacc:=true;
  1555. end;
  1556. {$ifdef i386}
  1557. list.concat(taicpu.op_reg_reg(A_TEST,S_L,R_ESI,R_ESI));
  1558. {$else}
  1559. {$warning constructor returns in flags for i386}
  1560. {$endif i386}
  1561. usesself:=true;
  1562. end;
  1563. end;
  1564. if aktexit2label.is_used and not aktexit2label.is_set then
  1565. cg.a_label(list,aktexit2label);
  1566. {$ifdef GDB}
  1567. if ((cs_debuginfo in aktmoduleswitches) and not inlined) then
  1568. begin
  1569. objectlibrary.getlabel(stabsendlabel);
  1570. cg.a_label(list,stabsendlabel);
  1571. end;
  1572. {$endif GDB}
  1573. { remove copies of call by value parameters when there are also
  1574. registers saved on the stack }
  1575. if ((po_saveregisters in aktprocdef.procoptions) or
  1576. (po_savestdregs in aktprocdef.procoptions)) and
  1577. not(po_assembler in aktprocdef.procoptions) and
  1578. not(aktprocdef.proccalloption in [pocall_cdecl,pocall_cppdecl,pocall_palmossyscall,pocall_system]) then
  1579. aktprocdef.parast.foreach_static({$ifndef TP}@{$endif}removevalueparas,list);
  1580. { for the save all registers we can simply use a pusha,popa which
  1581. push edi,esi,ebp,esp(ignored),ebx,edx,ecx,eax }
  1582. if (po_saveregisters in aktprocdef.procoptions) then
  1583. cg.g_restore_all_registers(list,usesself,usesacc,usesacchi)
  1584. else
  1585. { should we restore edi ? }
  1586. if (po_savestdregs in aktprocdef.procoptions) then
  1587. cg.g_restore_standard_registers(list,aktprocdef.usedregisters);
  1588. { remove stackframe }
  1589. if not inlined then
  1590. begin
  1591. if (not nostackframe) then
  1592. cg.g_restore_frame_pointer(list)
  1593. else
  1594. if (tg.gettempsize<>0) then
  1595. cg.a_op_const_reg(list,OP_ADD,tg.gettempsize,STACK_POINTER_REG);
  1596. end;
  1597. { at last, the return is generated }
  1598. if not inlined then
  1599. begin
  1600. if (po_interrupt in aktprocdef.procoptions) then
  1601. cg.g_interrupt_stackframe_exit(list,usesself,usesacc,usesacchi)
  1602. else
  1603. cg.g_return_from_proc(list,parasize);
  1604. end;
  1605. if not inlined then
  1606. list.concat(Tai_symbol_end.Createname(aktprocdef.mangledname));
  1607. {$ifdef GDB}
  1608. if (cs_debuginfo in aktmoduleswitches) and not inlined then
  1609. begin
  1610. if assigned(procinfo._class) then
  1611. if (not assigned(procinfo.parent) or
  1612. not assigned(procinfo.parent._class)) then
  1613. begin
  1614. if (po_classmethod in aktprocdef.procoptions) or
  1615. ((po_virtualmethod in aktprocdef.procoptions) and
  1616. (potype_constructor=aktprocdef.proctypeoption)) or
  1617. (po_staticmethod in aktprocdef.procoptions) then
  1618. begin
  1619. list.concat(Tai_stabs.Create(strpnew(
  1620. '"pvmt:p'+tstoreddef(pvmttype.def).numberstring+'",'+
  1621. tostr(N_tsym)+',0,0,'+tostr(procinfo.selfpointer_offset))));
  1622. end
  1623. else
  1624. begin
  1625. if not(is_class(procinfo._class)) then
  1626. st:='v'
  1627. else
  1628. st:='p';
  1629. list.concat(Tai_stabs.Create(strpnew(
  1630. '"$t:'+st+procinfo._class.numberstring+'",'+
  1631. tostr(N_tsym)+',0,0,'+tostr(procinfo.selfpointer_offset))));
  1632. end;
  1633. end
  1634. else
  1635. begin
  1636. if not is_class(procinfo._class) then
  1637. st:='*'
  1638. else
  1639. st:='';
  1640. list.concat(Tai_stabs.Create(strpnew(
  1641. '"$t:r'+st+procinfo._class.numberstring+'",'+
  1642. tostr(N_RSYM)+',0,0,'+tostr(stab_regindex[SELF_POINTER_REG]))));
  1643. end;
  1644. { define calling EBP as pseudo local var PM }
  1645. { this enables test if the function is a local one !! }
  1646. if assigned(procinfo.parent) and (lexlevel>normal_function_level) then
  1647. list.concat(Tai_stabs.Create(strpnew(
  1648. '"parent_ebp:'+tstoreddef(voidpointertype.def).numberstring+'",'+
  1649. tostr(N_LSYM)+',0,0,'+tostr(procinfo.framepointer_offset))));
  1650. if (not is_void(aktprocdef.rettype.def)) then
  1651. begin
  1652. if paramanager.ret_in_param(aktprocdef.rettype.def,aktprocdef.proccalloption) then
  1653. list.concat(Tai_stabs.Create(strpnew(
  1654. '"'+aktprocsym.name+':X*'+tstoreddef(aktprocdef.rettype.def).numberstring+'",'+
  1655. tostr(N_tsym)+',0,0,'+tostr(procinfo.return_offset))))
  1656. else
  1657. list.concat(Tai_stabs.Create(strpnew(
  1658. '"'+aktprocsym.name+':X'+tstoreddef(aktprocdef.rettype.def).numberstring+'",'+
  1659. tostr(N_tsym)+',0,0,'+tostr(procinfo.return_offset))));
  1660. if (m_result in aktmodeswitches) then
  1661. if paramanager.ret_in_param(aktprocdef.rettype.def,aktprocdef.proccalloption) then
  1662. list.concat(Tai_stabs.Create(strpnew(
  1663. '"RESULT:X*'+tstoreddef(aktprocdef.rettype.def).numberstring+'",'+
  1664. tostr(N_tsym)+',0,0,'+tostr(procinfo.return_offset))))
  1665. else
  1666. list.concat(Tai_stabs.Create(strpnew(
  1667. '"RESULT:X'+tstoreddef(aktprocdef.rettype.def).numberstring+'",'+
  1668. tostr(N_tsym)+',0,0,'+tostr(procinfo.return_offset))));
  1669. end;
  1670. mangled_length:=length(aktprocdef.mangledname);
  1671. getmem(p,2*mangled_length+50);
  1672. strpcopy(p,'192,0,0,');
  1673. strpcopy(strend(p),aktprocdef.mangledname);
  1674. if (target_info.use_function_relative_addresses) then
  1675. begin
  1676. strpcopy(strend(p),'-');
  1677. strpcopy(strend(p),aktprocdef.mangledname);
  1678. end;
  1679. list.concat(Tai_stabn.Create(strnew(p)));
  1680. {List.concat(Tai_stabn.Create(strpnew('192,0,0,'
  1681. +aktprocdef.mangledname))));
  1682. p[0]:='2';p[1]:='2';p[2]:='4';
  1683. strpcopy(strend(p),'_end');}
  1684. strpcopy(p,'224,0,0,'+stabsendlabel.name);
  1685. if (target_info.use_function_relative_addresses) then
  1686. begin
  1687. strpcopy(strend(p),'-');
  1688. strpcopy(strend(p),aktprocdef.mangledname);
  1689. end;
  1690. list.concatlist(withdebuglist);
  1691. list.concat(Tai_stabn.Create(strnew(p)));
  1692. { strpnew('224,0,0,'
  1693. +aktprocdef.mangledname+'_end'))));}
  1694. freemem(p,2*mangled_length+50);
  1695. end;
  1696. {$endif GDB}
  1697. if inlined then
  1698. cleanup_regvars(list);
  1699. end;
  1700. procedure genimplicitunitinit(list : TAAsmoutput);
  1701. begin
  1702. {$ifdef GDB}
  1703. if (cs_debuginfo in aktmoduleswitches) and
  1704. target_info.use_function_relative_addresses then
  1705. list.concat(Tai_stab_function_name.Create(strpnew('INIT$$'+current_module.modulename^)));
  1706. {$endif GDB}
  1707. list.concat(Tai_symbol.Createname_global('INIT$$'+current_module.modulename^,0));
  1708. list.concat(Tai_symbol.Createname_global(target_info.cprefix+current_module.modulename^+'_init',0));
  1709. { using current_module.globalsymtable is hopefully }
  1710. { more robust than symtablestack and symtablestack.next }
  1711. if assigned(current_module.globalsymtable) then
  1712. tsymtable(current_module.globalsymtable).foreach_static({$ifdef FPCPROCVAR}@{$endif}finalize_data,list);
  1713. tsymtable(current_module.localsymtable).foreach_static({$ifdef FPCPROCVAR}@{$endif}finalize_data,list);
  1714. cg.g_return_from_proc(list,0);
  1715. end;
  1716. procedure genimplicitunitfinal(list : TAAsmoutput);
  1717. begin
  1718. {$ifdef GDB}
  1719. if (cs_debuginfo in aktmoduleswitches) and
  1720. target_info.use_function_relative_addresses then
  1721. list.concat(Tai_stab_function_name.Create(strpnew('FINALIZE$$'+current_module.modulename^)));
  1722. {$endif GDB}
  1723. list.concat(Tai_symbol.Createname_global('FINALIZE$$'+current_module.modulename^,0));
  1724. list.concat(Tai_symbol.Createname_global(target_info.cprefix+current_module.modulename^+'_finalize',0));
  1725. { using current_module.globalsymtable is hopefully }
  1726. { more robust than symtablestack and symtablestack.next }
  1727. if assigned(current_module.globalsymtable) then
  1728. tsymtable(current_module.globalsymtable).foreach_static({$ifdef FPCPROCVAR}@{$endif}finalize_data,list);
  1729. tsymtable(current_module.localsymtable).foreach_static({$ifdef FPCPROCVAR}@{$endif}finalize_data,list);
  1730. cg.g_return_from_proc(list,0);
  1731. end;
  1732. end.
  1733. {
  1734. $Log$
  1735. Revision 1.64 2002-11-27 02:33:19 peter
  1736. * copy_value_on_stack method added for cdecl record passing
  1737. Revision 1.63 2002/11/25 17:43:18 peter
  1738. * splitted defbase in defutil,symutil,defcmp
  1739. * merged isconvertable and is_equal into compare_defs(_ext)
  1740. * made operator search faster by walking the list only once
  1741. Revision 1.62 2002/11/18 17:31:55 peter
  1742. * pass proccalloption to ret_in_xxx and push_xxx functions
  1743. Revision 1.61 2002/11/17 17:49:08 mazen
  1744. + return_result_reg and function_result_reg are now used, in all plateforms, to pass functions result between called function and its caller. See the explanation of each one
  1745. Revision 1.60 2002/11/17 16:31:56 carl
  1746. * memory optimization (3-4%) : cleanup of tai fields,
  1747. cleanup of tdef and tsym fields.
  1748. * make it work for m68k
  1749. Revision 1.59 2002/11/15 01:58:51 peter
  1750. * merged changes from 1.0.7 up to 04-11
  1751. - -V option for generating bug report tracing
  1752. - more tracing for option parsing
  1753. - errors for cdecl and high()
  1754. - win32 import stabs
  1755. - win32 records<=8 are returned in eax:edx (turned off by default)
  1756. - heaptrc update
  1757. - more info for temp management in .s file with EXTDEBUG
  1758. Revision 1.58 2002/11/10 19:07:45 mazen
  1759. * SPARC calling mechanism almost OK (as in GCC./mppcsparc )
  1760. Revision 1.57 2002/11/03 20:22:40 mazen
  1761. * parameter handling updated
  1762. Revision 1.56 2002/10/16 19:01:43 peter
  1763. + $IMPLICITEXCEPTIONS switch to turn on/off generation of the
  1764. implicit exception frames for procedures with initialized variables
  1765. and for constructors. The default is on for compatibility
  1766. Revision 1.55 2002/10/14 19:42:33 peter
  1767. * only use init tables for threadvars
  1768. Revision 1.54 2002/10/06 19:41:30 peter
  1769. * Add finalization of typed consts
  1770. * Finalization of globals in the main program
  1771. Revision 1.53 2002/10/05 15:18:42 carl
  1772. * fix heap leaks
  1773. Revision 1.52 2002/09/30 07:00:46 florian
  1774. * fixes to common code to get the alpha compiler compiled applied
  1775. Revision 1.51 2002/09/22 14:02:35 carl
  1776. * stack checking cannot be called before system unit is initialized
  1777. * MC68020 define
  1778. Revision 1.50 2002/09/17 18:54:03 jonas
  1779. * a_load_reg_reg() now has two size parameters: source and dest. This
  1780. allows some optimizations on architectures that don't encode the
  1781. register size in the register name.
  1782. Revision 1.49 2002/09/10 21:48:30 florian
  1783. * improved handling of procedures with register calling conventions
  1784. Revision 1.48 2002/09/07 15:25:03 peter
  1785. * old logs removed and tabs fixed
  1786. Revision 1.47 2002/09/02 18:44:48 peter
  1787. * fixed (not) pushing of empty parameters
  1788. * fixed implicit initialization/finalization generation
  1789. * fixed/optimized local copy of value arguments init/final
  1790. Revision 1.46 2002/09/01 19:27:34 peter
  1791. * use index register when available for generating a reference with
  1792. only a signle register. Using the base register could possibly
  1793. destroy the framepointer
  1794. Revision 1.45 2002/09/01 18:50:20 peter
  1795. * fixed maybe_save that did not support a reference with only
  1796. a index register. It now also updates the location with the new
  1797. base register only
  1798. Revision 1.44 2002/09/01 14:42:41 peter
  1799. * removevaluepara added to fix the stackpointer so restoring of
  1800. saved registers works
  1801. Revision 1.43 2002/08/25 19:25:18 peter
  1802. * sym.insert_in_data removed
  1803. * symtable.insertvardata/insertconstdata added
  1804. * removed insert_in_data call from symtable.insert, it needs to be
  1805. called separatly. This allows to deref the address calculation
  1806. * procedures now calculate the parast addresses after the procedure
  1807. directives are parsed. This fixes the cdecl parast problem
  1808. * push_addr_param has an extra argument that specifies if cdecl is used
  1809. or not
  1810. Revision 1.42 2002/08/24 18:38:26 peter
  1811. * really use tt_noreuse for exception frame buffers
  1812. Revision 1.41 2002/08/23 16:14:49 peter
  1813. * tempgen cleanup
  1814. * tt_noreuse temp type added that will be used in genentrycode
  1815. Revision 1.40 2002/08/18 10:42:37 florian
  1816. * remaining assembler writer bugs fixed, the errors in the
  1817. system unit are inline assembler problems
  1818. Revision 1.39 2002/08/17 09:23:36 florian
  1819. * first part of procinfo rewrite
  1820. Revision 1.38 2002/08/16 14:24:57 carl
  1821. * issameref() to test if two references are the same (then emit no opcodes)
  1822. + ret_in_reg to replace ret_in_acc
  1823. (fix some register allocation bugs at the same time)
  1824. + save_std_register now has an extra parameter which is the
  1825. usedinproc registers
  1826. Revision 1.37 2002/08/15 15:15:55 carl
  1827. * jmpbuf size allocation for exceptions is now cpu specific (as it should)
  1828. * more generic nodes for maths
  1829. * several fixes for better m68k support
  1830. Revision 1.36 2002/08/14 19:25:09 carl
  1831. * fix Florian's last commit for m68k compilation
  1832. Revision 1.35 2002/08/13 21:40:56 florian
  1833. * more fixes for ppc calling conventions
  1834. Revision 1.34 2002/08/12 15:08:39 carl
  1835. + stab register indexes for powerpc (moved from gdb to cpubase)
  1836. + tprocessor enumeration moved to cpuinfo
  1837. + linker in target_info is now a class
  1838. * many many updates for m68k (will soon start to compile)
  1839. - removed some ifdef or correct them for correct cpu
  1840. Revision 1.33 2002/08/11 14:32:27 peter
  1841. * renamed current_library to objectlibrary
  1842. Revision 1.32 2002/08/11 13:24:12 peter
  1843. * saving of asmsymbols in ppu supported
  1844. * asmsymbollist global is removed and moved into a new class
  1845. tasmlibrarydata that will hold the info of a .a file which
  1846. corresponds with a single module. Added librarydata to tmodule
  1847. to keep the library info stored for the module. In the future the
  1848. objectfiles will also be stored to the tasmlibrarydata class
  1849. * all getlabel/newasmsymbol and friends are moved to the new class
  1850. Revision 1.31 2002/08/09 19:16:57 carl
  1851. * stack allocation is now done separately (at the end) of genentrycode
  1852. so temps. can be allocated before.
  1853. * fix generic exception handling
  1854. Revision 1.30 2002/08/06 20:55:21 florian
  1855. * first part of ppc calling conventions fix
  1856. Revision 1.29 2002/08/04 19:09:22 carl
  1857. + added generic exception support (still does not work!)
  1858. + more documentation
  1859. Revision 1.28 2002/07/29 21:23:42 florian
  1860. * more fixes for the ppc
  1861. + wrappers for the tcnvnode.first_* stuff introduced
  1862. }