ncgutil.pas 79 KB

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