ncgutil.pas 81 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031
  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. { generates the code for initialisation of local data }
  860. procedure initialize_data(p : tnamedindexitem;arg:pointer);
  861. var
  862. href : treference;
  863. list : taasmoutput;
  864. begin
  865. list:=taasmoutput(arg);
  866. if (tsym(p).typ=varsym) and
  867. not(vo_is_local_copy in tvarsym(p).varoptions) and
  868. assigned(tvarsym(p).vartype.def) and
  869. not(is_class(tvarsym(p).vartype.def)) and
  870. tvarsym(p).vartype.def.needs_inittable then
  871. begin
  872. if assigned(procinfo) and
  873. (cs_implicit_exceptions in aktmoduleswitches) then
  874. procinfo.flags:=procinfo.flags or pi_needs_implicit_finally;
  875. if tsym(p).owner.symtabletype in [localsymtable,inlinelocalsymtable] then
  876. reference_reset_base(href,procinfo.framepointer,-tvarsym(p).address+tvarsym(p).owner.address_fixup)
  877. else
  878. reference_reset_symbol(href,objectlibrary.newasmsymbol(tvarsym(p).mangledname),0);
  879. cg.g_initialize(list,tvarsym(p).vartype.def,href,false);
  880. end;
  881. end;
  882. { generates the code for finalisation of local data }
  883. procedure finalize_data(p : tnamedindexitem;arg:pointer);
  884. var
  885. href : treference;
  886. list : taasmoutput;
  887. begin
  888. list:=taasmoutput(arg);
  889. case tsym(p).typ of
  890. varsym :
  891. begin
  892. if not(vo_is_local_copy in tvarsym(p).varoptions) and
  893. assigned(tvarsym(p).vartype.def) and
  894. not(is_class(tvarsym(p).vartype.def)) and
  895. tvarsym(p).vartype.def.needs_inittable then
  896. begin
  897. if tsym(p).owner.symtabletype in [localsymtable,inlinelocalsymtable] then
  898. reference_reset_base(href,procinfo.framepointer,-tvarsym(p).address+tvarsym(p).owner.address_fixup)
  899. else
  900. reference_reset_symbol(href,objectlibrary.newasmsymbol(tvarsym(p).mangledname),0);
  901. cg.g_finalize(list,tvarsym(p).vartype.def,href,false);
  902. end;
  903. end;
  904. typedconstsym :
  905. begin
  906. if ttypedconstsym(p).is_writable and
  907. ttypedconstsym(p).typedconsttype.def.needs_inittable then
  908. begin
  909. reference_reset_symbol(href,objectlibrary.newasmsymbol(ttypedconstsym(p).mangledname),0);
  910. cg.g_finalize(list,ttypedconstsym(p).typedconsttype.def,href,false);
  911. end;
  912. end;
  913. end;
  914. end;
  915. { generates the code for incrementing the reference count of parameters and
  916. initialize out parameters }
  917. procedure init_paras(p : tnamedindexitem;arg:pointer);
  918. var
  919. href : treference;
  920. tmpreg : tregister;
  921. list : taasmoutput;
  922. begin
  923. list:=taasmoutput(arg);
  924. if (tsym(p).typ=varsym) and
  925. not is_class(tvarsym(p).vartype.def) and
  926. tvarsym(p).vartype.def.needs_inittable then
  927. begin
  928. case tvarsym(p).varspez of
  929. vs_value :
  930. begin
  931. if (cs_implicit_exceptions in aktmoduleswitches) then
  932. procinfo.flags:=procinfo.flags or pi_needs_implicit_finally;
  933. if assigned(tvarsym(p).localvarsym) then
  934. reference_reset_base(href,procinfo.framepointer,
  935. -tvarsym(p).localvarsym.address+tvarsym(p).localvarsym.owner.address_fixup)
  936. else
  937. reference_reset_base(href,procinfo.framepointer,tvarsym(p).address+procinfo.para_offset);
  938. cg.g_incrrefcount(list,tvarsym(p).vartype.def,href);
  939. end;
  940. vs_out :
  941. begin
  942. reference_reset_base(href,procinfo.framepointer,tvarsym(p).address+procinfo.para_offset);
  943. tmpreg:=cg.get_scratch_reg_address(list);
  944. cg.a_load_ref_reg(list,OS_ADDR,href,tmpreg);
  945. reference_reset_base(href,tmpreg,0);
  946. cg.g_initialize(list,tvarsym(p).vartype.def,href,false);
  947. cg.free_scratch_reg(list,tmpreg);
  948. end;
  949. end;
  950. end;
  951. end;
  952. { generates the code for decrementing the reference count of parameters }
  953. procedure final_paras(p : tnamedindexitem;arg:pointer);
  954. var
  955. href : treference;
  956. list : taasmoutput;
  957. begin
  958. list:=taasmoutput(arg);
  959. if (tsym(p).typ=varsym) and
  960. not is_class(tvarsym(p).vartype.def) and
  961. tvarsym(p).vartype.def.needs_inittable then
  962. begin
  963. if (tvarsym(p).varspez=vs_value) then
  964. begin
  965. if assigned(tvarsym(p).localvarsym) then
  966. reference_reset_base(href,procinfo.framepointer,
  967. -tvarsym(p).localvarsym.address+tvarsym(p).localvarsym.owner.address_fixup)
  968. else
  969. reference_reset_base(href,procinfo.framepointer,tvarsym(p).address+procinfo.para_offset);
  970. cg.g_decrrefcount(list,tvarsym(p).vartype.def,href);
  971. end;
  972. end;
  973. end;
  974. { Initialize temp ansi/widestrings,interfaces }
  975. procedure inittempvariables(list:taasmoutput);
  976. var
  977. hp : ptemprecord;
  978. href : treference;
  979. begin
  980. hp:=tg.templist;
  981. while assigned(hp) do
  982. begin
  983. if hp^.temptype in [tt_ansistring,tt_freeansistring,
  984. tt_widestring,tt_freewidestring,
  985. tt_interfacecom,tt_freeinterfacecom] then
  986. begin
  987. if (cs_implicit_exceptions in aktmoduleswitches) then
  988. procinfo.flags:=procinfo.flags or pi_needs_implicit_finally;
  989. reference_reset_base(href,procinfo.framepointer,hp^.pos);
  990. cg.a_load_const_ref(list,OS_ADDR,0,href);
  991. end;
  992. hp:=hp^.next;
  993. end;
  994. end;
  995. procedure finalizetempvariables(list:taasmoutput);
  996. var
  997. hp : ptemprecord;
  998. href : treference;
  999. begin
  1000. hp:=tg.templist;
  1001. while assigned(hp) do
  1002. begin
  1003. case hp^.temptype of
  1004. tt_ansistring,
  1005. tt_freeansistring :
  1006. begin
  1007. reference_reset_base(href,procinfo.framepointer,hp^.pos);
  1008. cg.a_paramaddr_ref(list,href,paramanager.getintparaloc(1));
  1009. cg.a_call_name(list,'FPC_ANSISTR_DECR_REF');
  1010. end;
  1011. tt_widestring,
  1012. tt_freewidestring :
  1013. begin
  1014. reference_reset_base(href,procinfo.framepointer,hp^.pos);
  1015. cg.a_paramaddr_ref(list,href,paramanager.getintparaloc(2));
  1016. cg.a_call_name(list,'FPC_WIDESTR_DECR_REF');
  1017. end;
  1018. tt_interfacecom :
  1019. begin
  1020. reference_reset_base(href,procinfo.framepointer,hp^.pos);
  1021. cg.a_paramaddr_ref(list,href,paramanager.getintparaloc(2));
  1022. cg.a_call_name(list,'FPC_INTF_DECR_REF');
  1023. end;
  1024. end;
  1025. hp:=hp^.next;
  1026. end;
  1027. end;
  1028. procedure handle_return_value(list:TAAsmoutput; inlined : boolean;var uses_acc,uses_acchi,uses_fpu : boolean);
  1029. var
  1030. href : treference;
  1031. hreg : tregister;
  1032. cgsize : TCGSize;
  1033. begin
  1034. if not is_void(aktprocdef.rettype.def) then
  1035. begin
  1036. if (tfuncretsym(aktprocdef.funcretsym).funcretstate<>vs_assigned) and
  1037. (not inlined) then
  1038. CGMessage(sym_w_function_result_not_set);
  1039. reference_reset_base(href,procinfo.framepointer,procinfo.return_offset);
  1040. cgsize:=def_cgsize(aktprocdef.rettype.def);
  1041. case aktprocdef.rettype.def.deftype of
  1042. orddef,
  1043. enumdef :
  1044. begin
  1045. uses_acc:=true;
  1046. {$WARNING accumulator was replaced by return_result_reg}
  1047. {Here, we return the function result. In most architectures, the value is
  1048. passed into the accumulator, but in a windowed architecure like sparc a
  1049. function returns in a register and the caller receives it in an other one}
  1050. cg.a_reg_alloc(list,return_result_reg);
  1051. {$ifndef cpu64bit}
  1052. if cgsize in [OS_64,OS_S64] then
  1053. begin
  1054. uses_acchi:=true;
  1055. cg.a_reg_alloc(list,accumulatorhigh);
  1056. cg64.a_load64_ref_reg(list,href,joinreg64(accumulator,accumulatorhigh));
  1057. end
  1058. else
  1059. {$endif cpu64bit}
  1060. begin
  1061. {$WARNING accumulator was replaced by return_result_reg}
  1062. {Here, we return the function result. In most architectures, the value is
  1063. passed into the accumulator, but in a windowed architecure like sparc a
  1064. function returns in a register and the caller receives it in an other one}
  1065. hreg:=rg.makeregsize(return_result_reg,cgsize);
  1066. cg.a_load_ref_reg(list,cgsize,href,hreg);
  1067. end;
  1068. end;
  1069. floatdef :
  1070. begin
  1071. uses_fpu := true;
  1072. cg.a_loadfpu_ref_reg(list,cgsize,href,FPU_RESULT_REG);
  1073. end;
  1074. else
  1075. begin
  1076. if paramanager.ret_in_acc(aktprocdef.rettype.def) then
  1077. begin
  1078. uses_acc:=true;
  1079. cg.a_reg_alloc(list,accumulator);
  1080. {$ifndef cpu64bit}
  1081. { Win32 can return records in EAX:EDX }
  1082. if cgsize in [OS_64,OS_S64] then
  1083. begin
  1084. uses_acchi:=true;
  1085. cg.a_reg_alloc(list,accumulatorhigh);
  1086. cg64.a_load64_ref_reg(list,href,joinreg64(accumulator,accumulatorhigh));
  1087. end
  1088. else
  1089. {$endif cpu64bit}
  1090. cg.a_load_ref_reg(list,cgsize,href,accumulator);
  1091. end
  1092. end;
  1093. end;
  1094. end;
  1095. end;
  1096. procedure handle_fast_exit_return_value(list:TAAsmoutput);
  1097. var
  1098. href : treference;
  1099. hreg : tregister;
  1100. cgsize : TCGSize;
  1101. begin
  1102. if not is_void(aktprocdef.rettype.def) then
  1103. begin
  1104. reference_reset_base(href,procinfo.framepointer,procinfo.return_offset);
  1105. cgsize:=def_cgsize(aktprocdef.rettype.def);
  1106. case aktprocdef.rettype.def.deftype of
  1107. orddef,
  1108. enumdef :
  1109. begin
  1110. {$ifndef cpu64bit}
  1111. if cgsize in [OS_64,OS_S64] then
  1112. cg64.a_load64_reg_ref(list,joinreg64(accumulator,accumulatorhigh),href)
  1113. else
  1114. {$endif cpu64bit}
  1115. begin
  1116. hreg:=rg.makeregsize(accumulator,cgsize);
  1117. cg.a_load_reg_ref(list,cgsize,hreg,href);
  1118. end;
  1119. end;
  1120. floatdef :
  1121. begin
  1122. cg.a_loadfpu_reg_ref(list,cgsize,FPU_RESULT_REG,href);
  1123. end;
  1124. else
  1125. begin
  1126. if paramanager.ret_in_acc(aktprocdef.rettype.def) then
  1127. cg.a_load_reg_ref(list,cgsize,accumulator,href);
  1128. end;
  1129. end;
  1130. end;
  1131. end;
  1132. procedure genentrycode(list : TAAsmoutput;
  1133. make_global:boolean;
  1134. stackframe:longint;
  1135. var parasize:longint;var nostackframe:boolean;
  1136. inlined : boolean);
  1137. var
  1138. hs : string;
  1139. href : treference;
  1140. p : tsymtable;
  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)) 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));
  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));
  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) 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) 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.61 2002-11-17 17:49:08 mazen
  1736. + 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
  1737. Revision 1.60 2002/11/17 16:31:56 carl
  1738. * memory optimization (3-4%) : cleanup of tai fields,
  1739. cleanup of tdef and tsym fields.
  1740. * make it work for m68k
  1741. Revision 1.59 2002/11/15 01:58:51 peter
  1742. * merged changes from 1.0.7 up to 04-11
  1743. - -V option for generating bug report tracing
  1744. - more tracing for option parsing
  1745. - errors for cdecl and high()
  1746. - win32 import stabs
  1747. - win32 records<=8 are returned in eax:edx (turned off by default)
  1748. - heaptrc update
  1749. - more info for temp management in .s file with EXTDEBUG
  1750. Revision 1.58 2002/11/10 19:07:45 mazen
  1751. * SPARC calling mechanism almost OK (as in GCC./mppcsparc )
  1752. Revision 1.57 2002/11/03 20:22:40 mazen
  1753. * parameter handling updated
  1754. Revision 1.56 2002/10/16 19:01:43 peter
  1755. + $IMPLICITEXCEPTIONS switch to turn on/off generation of the
  1756. implicit exception frames for procedures with initialized variables
  1757. and for constructors. The default is on for compatibility
  1758. Revision 1.55 2002/10/14 19:42:33 peter
  1759. * only use init tables for threadvars
  1760. Revision 1.54 2002/10/06 19:41:30 peter
  1761. * Add finalization of typed consts
  1762. * Finalization of globals in the main program
  1763. Revision 1.53 2002/10/05 15:18:42 carl
  1764. * fix heap leaks
  1765. Revision 1.52 2002/09/30 07:00:46 florian
  1766. * fixes to common code to get the alpha compiler compiled applied
  1767. Revision 1.51 2002/09/22 14:02:35 carl
  1768. * stack checking cannot be called before system unit is initialized
  1769. * MC68020 define
  1770. Revision 1.50 2002/09/17 18:54:03 jonas
  1771. * a_load_reg_reg() now has two size parameters: source and dest. This
  1772. allows some optimizations on architectures that don't encode the
  1773. register size in the register name.
  1774. Revision 1.49 2002/09/10 21:48:30 florian
  1775. * improved handling of procedures with register calling conventions
  1776. Revision 1.48 2002/09/07 15:25:03 peter
  1777. * old logs removed and tabs fixed
  1778. Revision 1.47 2002/09/02 18:44:48 peter
  1779. * fixed (not) pushing of empty parameters
  1780. * fixed implicit initialization/finalization generation
  1781. * fixed/optimized local copy of value arguments init/final
  1782. Revision 1.46 2002/09/01 19:27:34 peter
  1783. * use index register when available for generating a reference with
  1784. only a signle register. Using the base register could possibly
  1785. destroy the framepointer
  1786. Revision 1.45 2002/09/01 18:50:20 peter
  1787. * fixed maybe_save that did not support a reference with only
  1788. a index register. It now also updates the location with the new
  1789. base register only
  1790. Revision 1.44 2002/09/01 14:42:41 peter
  1791. * removevaluepara added to fix the stackpointer so restoring of
  1792. saved registers works
  1793. Revision 1.43 2002/08/25 19:25:18 peter
  1794. * sym.insert_in_data removed
  1795. * symtable.insertvardata/insertconstdata added
  1796. * removed insert_in_data call from symtable.insert, it needs to be
  1797. called separatly. This allows to deref the address calculation
  1798. * procedures now calculate the parast addresses after the procedure
  1799. directives are parsed. This fixes the cdecl parast problem
  1800. * push_addr_param has an extra argument that specifies if cdecl is used
  1801. or not
  1802. Revision 1.42 2002/08/24 18:38:26 peter
  1803. * really use tt_noreuse for exception frame buffers
  1804. Revision 1.41 2002/08/23 16:14:49 peter
  1805. * tempgen cleanup
  1806. * tt_noreuse temp type added that will be used in genentrycode
  1807. Revision 1.40 2002/08/18 10:42:37 florian
  1808. * remaining assembler writer bugs fixed, the errors in the
  1809. system unit are inline assembler problems
  1810. Revision 1.39 2002/08/17 09:23:36 florian
  1811. * first part of procinfo rewrite
  1812. Revision 1.38 2002/08/16 14:24:57 carl
  1813. * issameref() to test if two references are the same (then emit no opcodes)
  1814. + ret_in_reg to replace ret_in_acc
  1815. (fix some register allocation bugs at the same time)
  1816. + save_std_register now has an extra parameter which is the
  1817. usedinproc registers
  1818. Revision 1.37 2002/08/15 15:15:55 carl
  1819. * jmpbuf size allocation for exceptions is now cpu specific (as it should)
  1820. * more generic nodes for maths
  1821. * several fixes for better m68k support
  1822. Revision 1.36 2002/08/14 19:25:09 carl
  1823. * fix Florian's last commit for m68k compilation
  1824. Revision 1.35 2002/08/13 21:40:56 florian
  1825. * more fixes for ppc calling conventions
  1826. Revision 1.34 2002/08/12 15:08:39 carl
  1827. + stab register indexes for powerpc (moved from gdb to cpubase)
  1828. + tprocessor enumeration moved to cpuinfo
  1829. + linker in target_info is now a class
  1830. * many many updates for m68k (will soon start to compile)
  1831. - removed some ifdef or correct them for correct cpu
  1832. Revision 1.33 2002/08/11 14:32:27 peter
  1833. * renamed current_library to objectlibrary
  1834. Revision 1.32 2002/08/11 13:24:12 peter
  1835. * saving of asmsymbols in ppu supported
  1836. * asmsymbollist global is removed and moved into a new class
  1837. tasmlibrarydata that will hold the info of a .a file which
  1838. corresponds with a single module. Added librarydata to tmodule
  1839. to keep the library info stored for the module. In the future the
  1840. objectfiles will also be stored to the tasmlibrarydata class
  1841. * all getlabel/newasmsymbol and friends are moved to the new class
  1842. Revision 1.31 2002/08/09 19:16:57 carl
  1843. * stack allocation is now done separately (at the end) of genentrycode
  1844. so temps. can be allocated before.
  1845. * fix generic exception handling
  1846. Revision 1.30 2002/08/06 20:55:21 florian
  1847. * first part of ppc calling conventions fix
  1848. Revision 1.29 2002/08/04 19:09:22 carl
  1849. + added generic exception support (still does not work!)
  1850. + more documentation
  1851. Revision 1.28 2002/07/29 21:23:42 florian
  1852. * more fixes for the ppc
  1853. + wrappers for the tcnvnode.first_* stuff introduced
  1854. }