ncgutil.pas 88 KB

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