ncgutil.pas 86 KB

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