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