cg64f32.pas 36 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020
  1. {
  2. $Id$
  3. Copyright (c) 1998-2002 by Florian Klaempfl
  4. Member of the Free Pascal development team
  5. This unit implements the code generation for 64 bit int
  6. arithmethics on 32 bit processors
  7. This program is free software; you can redistribute it and/or modify
  8. it under the terms of the GNU General Public License as published by
  9. the Free Software Foundation; either version 2 of the License, or
  10. (at your option) any later version.
  11. This program is distributed in the hope that it will be useful,
  12. but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  14. GNU General Public License for more details.
  15. You should have received a copy of the GNU General Public License
  16. along with this program; if not, write to the Free Software
  17. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  18. ****************************************************************************
  19. }
  20. {# This unit implements the code generation for 64 bit int arithmethics on
  21. 32 bit processors.
  22. }
  23. unit cg64f32;
  24. {$i fpcdefs.inc}
  25. interface
  26. uses
  27. aasmbase,aasmtai,aasmcpu,
  28. cpuinfo, cpubase,cpupara,
  29. cginfo, cgobj,
  30. node,symtype
  31. {$ifdef delphi}
  32. ,dmisc
  33. {$endif}
  34. ;
  35. type
  36. {# Defines all the methods required on 32-bit processors
  37. to handle 64-bit integers.
  38. }
  39. tcg64f32 = class(tcg64)
  40. procedure a_reg_alloc(list : taasmoutput;r : tregister64);override;
  41. procedure a_reg_dealloc(list : taasmoutput;r : tregister64);override;
  42. procedure a_load64_const_ref(list : taasmoutput;value : qword;const ref : treference);override;
  43. procedure a_load64_reg_ref(list : taasmoutput;reg : tregister64;const ref : treference);override;
  44. procedure a_load64_ref_reg(list : taasmoutput;const ref : treference;reg : tregister64{$ifdef newra};delete:boolean{$endif});override;
  45. procedure a_load64_reg_reg(list : taasmoutput;regsrc,regdst : tregister64{$ifdef newra};delete:boolean{$endif});override;
  46. procedure a_load64_const_reg(list : taasmoutput;value: qword;reg : tregister64);override;
  47. procedure a_load64_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister64{$ifdef newra};delete: boolean{$endif});override;
  48. procedure a_load64_loc_ref(list : taasmoutput;const l : tlocation;const ref : treference);override;
  49. procedure a_load64_const_loc(list : taasmoutput;value : qword;const l : tlocation);override;
  50. procedure a_load64_reg_loc(list : taasmoutput;reg : tregister64;const l : tlocation);override;
  51. procedure a_load64high_reg_ref(list : taasmoutput;reg : tregister;const ref : treference);override;
  52. procedure a_load64low_reg_ref(list : taasmoutput;reg : tregister;const ref : treference);override;
  53. procedure a_load64high_ref_reg(list : taasmoutput;const ref : treference;reg : tregister);override;
  54. procedure a_load64low_ref_reg(list : taasmoutput;const ref : treference;reg : tregister);override;
  55. procedure a_load64high_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister);override;
  56. procedure a_load64low_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister);override;
  57. procedure a_op64_ref_reg(list : taasmoutput;op:TOpCG;const ref : treference;reg : tregister64);override;
  58. procedure a_op64_reg_ref(list : taasmoutput;op:TOpCG;reg : tregister64; const ref: treference);override;
  59. procedure a_op64_const_loc(list : taasmoutput;op:TOpCG;value : qword;const l: tlocation);override;
  60. procedure a_op64_reg_loc(list : taasmoutput;op:TOpCG;reg : tregister64;const l : tlocation);override;
  61. procedure a_op64_loc_reg(list : taasmoutput;op:TOpCG;const l : tlocation;reg : tregister64);override;
  62. procedure a_op64_const_ref(list : taasmoutput;op:TOpCG;value : qword;const ref : treference);override;
  63. procedure a_param64_reg(list : taasmoutput;reg : tregister64;const locpara : tparalocation);override;
  64. procedure a_param64_const(list : taasmoutput;value : qword;const locpara : tparalocation);override;
  65. procedure a_param64_ref(list : taasmoutput;const r : treference;const locpara : tparalocation);override;
  66. procedure a_param64_loc(list : taasmoutput;const l : tlocation;const locpara : tparalocation);override;
  67. {# This routine tries to optimize the a_op64_const_reg operation, by
  68. removing superfluous opcodes. Returns TRUE if normal processing
  69. must continue in op64_const_reg, otherwise, everything is processed
  70. entirely in this routine, by emitting the appropriate 32-bit opcodes.
  71. }
  72. function optimize64_op_const_reg(list: taasmoutput; var op: topcg; var a : qword; var reg: tregister64): boolean;override;
  73. procedure g_rangecheck64(list: taasmoutput; const l:tlocation;fromdef,todef: tdef); override;
  74. end;
  75. {# Creates a tregister64 record from 2 32 Bit registers. }
  76. function joinreg64(reglo,reghi : tregister) : tregister64;
  77. implementation
  78. uses
  79. globtype,globals,systems,
  80. cgbase,
  81. verbose,
  82. symbase,symconst,symdef,defutil,rgobj,tgobj,paramgr;
  83. {****************************************************************************
  84. Helpers
  85. ****************************************************************************}
  86. function joinreg64(reglo,reghi : tregister) : tregister64;
  87. begin
  88. result.reglo:=reglo;
  89. result.reghi:=reghi;
  90. end;
  91. {****************************************************************************
  92. TCG64F32
  93. ****************************************************************************}
  94. procedure tcg64f32.a_reg_alloc(list : taasmoutput;r : tregister64);
  95. begin
  96. list.concat(tai_regalloc.alloc(r.reglo));
  97. list.concat(tai_regalloc.alloc(r.reghi));
  98. end;
  99. procedure tcg64f32.a_reg_dealloc(list : taasmoutput;r : tregister64);
  100. begin
  101. list.concat(tai_regalloc.dealloc(r.reglo));
  102. list.concat(tai_regalloc.dealloc(r.reghi));
  103. end;
  104. procedure tcg64f32.a_load64_reg_ref(list : taasmoutput;reg : tregister64;const ref : treference);
  105. var
  106. tmpreg: tregister;
  107. tmpref: treference;
  108. begin
  109. if target_info.endian = endian_big then
  110. begin
  111. tmpreg:=reg.reglo;
  112. reg.reglo:=reg.reghi;
  113. reg.reghi:=tmpreg;
  114. end;
  115. cg.a_load_reg_ref(list,OS_32,OS_32,reg.reglo,ref);
  116. tmpref := ref;
  117. inc(tmpref.offset,4);
  118. cg.a_load_reg_ref(list,OS_32,OS_32,reg.reghi,tmpref);
  119. end;
  120. procedure tcg64f32.a_load64_const_ref(list : taasmoutput;value : qword;const ref : treference);
  121. var
  122. tmpref: treference;
  123. begin
  124. if target_info.endian = endian_big then
  125. swap_qword(value);
  126. cg.a_load_const_ref(list,OS_32,lo(value),ref);
  127. tmpref := ref;
  128. inc(tmpref.offset,4);
  129. cg.a_load_const_ref(list,OS_32,hi(value),tmpref);
  130. end;
  131. procedure tcg64f32.a_load64_ref_reg(list : taasmoutput;const ref : treference;reg : tregister64{$ifdef newra};delete:boolean{$endif});
  132. var
  133. tmpreg: tregister;
  134. tmpref: treference;
  135. got_scratch: boolean;
  136. begin
  137. if target_info.endian = endian_big then
  138. begin
  139. tmpreg := reg.reglo;
  140. reg.reglo := reg.reghi;
  141. reg.reghi := tmpreg;
  142. end;
  143. got_scratch:=false;
  144. tmpref := ref;
  145. if (tmpref.base.number=reg.reglo.number) then
  146. begin
  147. {$ifdef newra}
  148. tmpreg:=rg.getaddressregister(list);
  149. {$else}
  150. tmpreg := cg.get_scratch_reg_address(list);
  151. {$endif}
  152. got_scratch:=true;
  153. cg.a_load_reg_reg(list,OS_ADDR,OS_ADDR,tmpref.base,tmpreg);
  154. tmpref.base:=tmpreg;
  155. end
  156. else
  157. { this works only for the i386, thus the i386 needs to override }
  158. { this method and this method must be replaced by a more generic }
  159. { implementation FK }
  160. if (tmpref.index.number=reg.reglo.number) then
  161. begin
  162. {$ifdef newra}
  163. tmpreg:=rg.getaddressregister(list);
  164. {$else}
  165. tmpreg:=cg.get_scratch_reg_address(list);
  166. {$endif}
  167. got_scratch:=true;
  168. cg.a_load_reg_reg(list,OS_ADDR,OS_ADDR,tmpref.index,tmpreg);
  169. tmpref.index:=tmpreg;
  170. end;
  171. cg.a_load_ref_reg(list,OS_32,OS_32,tmpref,reg.reglo);
  172. inc(tmpref.offset,4);
  173. {$ifdef newra}
  174. if delete then
  175. begin
  176. tg.ungetiftemp(list,tmpref);
  177. reference_release(list,tmpref);
  178. end;
  179. {$endif}
  180. cg.a_load_ref_reg(list,OS_32,OS_32,tmpref,reg.reghi);
  181. {$ifdef newra}
  182. if got_scratch then
  183. rg.ungetregisterint(list,tmpreg);
  184. {$else}
  185. if got_scratch then
  186. cg.free_scratch_reg(list,tmpreg);
  187. {$endif}
  188. end;
  189. procedure tcg64f32.a_load64_reg_reg(list : taasmoutput;regsrc,regdst : tregister64{$ifdef newra};delete:boolean{$endif});
  190. begin
  191. {$ifdef newra}
  192. if delete then
  193. rg.ungetregisterint(list,regsrc.reglo);
  194. {$endif}
  195. cg.a_load_reg_reg(list,OS_32,OS_32,regsrc.reglo,regdst.reglo);
  196. {$ifdef newra}
  197. if delete then
  198. rg.ungetregisterint(list,regsrc.reghi);
  199. {$endif}
  200. cg.a_load_reg_reg(list,OS_32,OS_32,regsrc.reghi,regdst.reghi);
  201. end;
  202. procedure tcg64f32.a_load64_const_reg(list : taasmoutput;value : qword;reg : tregister64);
  203. begin
  204. cg.a_load_const_reg(list,OS_32,lo(value),reg.reglo);
  205. cg.a_load_const_reg(list,OS_32,hi(value),reg.reghi);
  206. end;
  207. procedure tcg64f32.a_load64_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister64{$ifdef newra};delete :boolean{$endif});
  208. begin
  209. case l.loc of
  210. LOC_REFERENCE, LOC_CREFERENCE:
  211. a_load64_ref_reg(list,l.reference,reg{$ifdef newra},delete{$endif});
  212. LOC_REGISTER,LOC_CREGISTER:
  213. a_load64_reg_reg(list,l.register64,reg{$ifdef newra},delete{$endif});
  214. LOC_CONSTANT :
  215. a_load64_const_reg(list,l.valueqword,reg);
  216. else
  217. internalerror(200112292);
  218. end;
  219. end;
  220. procedure tcg64f32.a_load64_loc_ref(list : taasmoutput;const l : tlocation;const ref : treference);
  221. begin
  222. case l.loc of
  223. LOC_REGISTER,LOC_CREGISTER:
  224. a_load64_reg_ref(list,l.reg64,ref);
  225. LOC_CONSTANT :
  226. a_load64_const_ref(list,l.valueqword,ref);
  227. else
  228. internalerror(200203288);
  229. end;
  230. end;
  231. procedure tcg64f32.a_load64_const_loc(list : taasmoutput;value : qword;const l : tlocation);
  232. begin
  233. case l.loc of
  234. LOC_REFERENCE, LOC_CREFERENCE:
  235. a_load64_const_ref(list,value,l.reference);
  236. LOC_REGISTER,LOC_CREGISTER:
  237. a_load64_const_reg(list,value,l.reg64);
  238. else
  239. internalerror(200112293);
  240. end;
  241. end;
  242. procedure tcg64f32.a_load64_reg_loc(list : taasmoutput;reg : tregister64;const l : tlocation);
  243. begin
  244. case l.loc of
  245. LOC_REFERENCE, LOC_CREFERENCE:
  246. a_load64_reg_ref(list,reg,l.reference);
  247. LOC_REGISTER,LOC_CREGISTER:
  248. a_load64_reg_reg(list,reg,l.register64{$ifdef newra},false{$endif});
  249. else
  250. internalerror(200112293);
  251. end;
  252. end;
  253. procedure tcg64f32.a_load64high_reg_ref(list : taasmoutput;reg : tregister;const ref : treference);
  254. var
  255. tmpref: treference;
  256. begin
  257. if target_info.endian = endian_big then
  258. cg.a_load_reg_ref(list,OS_32,OS_32,reg,ref)
  259. else
  260. begin
  261. tmpref := ref;
  262. inc(tmpref.offset,4);
  263. cg.a_load_reg_ref(list,OS_32,OS_32,reg,tmpref)
  264. end;
  265. end;
  266. procedure tcg64f32.a_load64low_reg_ref(list : taasmoutput;reg : tregister;const ref : treference);
  267. var
  268. tmpref: treference;
  269. begin
  270. if target_info.endian = endian_little then
  271. cg.a_load_reg_ref(list,OS_32,OS_32,reg,ref)
  272. else
  273. begin
  274. tmpref := ref;
  275. inc(tmpref.offset,4);
  276. cg.a_load_reg_ref(list,OS_32,OS_32,reg,tmpref)
  277. end;
  278. end;
  279. procedure tcg64f32.a_load64high_ref_reg(list : taasmoutput;const ref : treference;reg : tregister);
  280. var
  281. tmpref: treference;
  282. begin
  283. if target_info.endian = endian_big then
  284. cg.a_load_ref_reg(list,OS_32,OS_32,ref,reg)
  285. else
  286. begin
  287. tmpref := ref;
  288. inc(tmpref.offset,4);
  289. cg.a_load_ref_reg(list,OS_32,OS_32,tmpref,reg)
  290. end;
  291. end;
  292. procedure tcg64f32.a_load64low_ref_reg(list : taasmoutput;const ref : treference;reg : tregister);
  293. var
  294. tmpref: treference;
  295. begin
  296. if target_info.endian = endian_little then
  297. cg.a_load_ref_reg(list,OS_32,OS_32,ref,reg)
  298. else
  299. begin
  300. tmpref := ref;
  301. inc(tmpref.offset,4);
  302. cg.a_load_ref_reg(list,OS_32,OS_32,tmpref,reg)
  303. end;
  304. end;
  305. procedure tcg64f32.a_load64low_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister);
  306. begin
  307. case l.loc of
  308. LOC_REFERENCE,
  309. LOC_CREFERENCE :
  310. a_load64low_ref_reg(list,l.reference,reg);
  311. LOC_REGISTER :
  312. cg.a_load_reg_reg(list,OS_32,OS_32,l.registerlow,reg);
  313. LOC_CONSTANT :
  314. cg.a_load_const_reg(list,OS_32,lo(l.valueqword),reg);
  315. else
  316. internalerror(200203244);
  317. end;
  318. end;
  319. procedure tcg64f32.a_load64high_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister);
  320. begin
  321. case l.loc of
  322. LOC_REFERENCE,
  323. LOC_CREFERENCE :
  324. a_load64high_ref_reg(list,l.reference,reg);
  325. LOC_REGISTER :
  326. cg.a_load_reg_reg(list,OS_32,OS_32,l.registerhigh,reg);
  327. LOC_CONSTANT :
  328. cg.a_load_const_reg(list,OS_32,hi(l.valueqword),reg);
  329. else
  330. internalerror(200203244);
  331. end;
  332. end;
  333. procedure tcg64f32.a_op64_const_loc(list : taasmoutput;op:TOpCG;value : qword;const l: tlocation);
  334. begin
  335. case l.loc of
  336. LOC_REFERENCE, LOC_CREFERENCE:
  337. a_op64_const_ref(list,op,value,l.reference);
  338. LOC_REGISTER,LOC_CREGISTER:
  339. a_op64_const_reg(list,op,value,l.register64);
  340. else
  341. internalerror(200203292);
  342. end;
  343. end;
  344. procedure tcg64f32.a_op64_reg_loc(list : taasmoutput;op:TOpCG;reg : tregister64;const l : tlocation);
  345. begin
  346. case l.loc of
  347. LOC_REFERENCE, LOC_CREFERENCE:
  348. a_op64_reg_ref(list,op,reg,l.reference);
  349. LOC_REGISTER,LOC_CREGISTER:
  350. a_op64_reg_reg(list,op,reg,l.register64);
  351. else
  352. internalerror(2002032422);
  353. end;
  354. end;
  355. procedure tcg64f32.a_op64_loc_reg(list : taasmoutput;op:TOpCG;const l : tlocation;reg : tregister64);
  356. begin
  357. case l.loc of
  358. LOC_REFERENCE, LOC_CREFERENCE:
  359. a_op64_ref_reg(list,op,l.reference,reg);
  360. LOC_REGISTER,LOC_CREGISTER:
  361. a_op64_reg_reg(list,op,l.register64,reg);
  362. LOC_CONSTANT :
  363. a_op64_const_reg(list,op,l.valueqword,reg);
  364. else
  365. internalerror(200203242);
  366. end;
  367. end;
  368. procedure tcg64f32.a_op64_ref_reg(list : taasmoutput;op:TOpCG;const ref : treference;reg : tregister64);
  369. var
  370. tempreg: tregister64;
  371. begin
  372. {$ifdef newra}
  373. tempreg.reghi:=rg.getregisterint(list,OS_INT);
  374. tempreg.reglo:=rg.getregisterint(list,OS_INT);
  375. {$else}
  376. tempreg.reghi := cg.get_scratch_reg_int(list,OS_INT);
  377. tempreg.reglo := cg.get_scratch_reg_int(list,OS_INT);
  378. {$endif}
  379. a_load64_ref_reg(list,ref,tempreg{$ifdef newra},false{$endif});
  380. a_op64_reg_reg(list,op,tempreg,reg);
  381. {$ifdef newra}
  382. rg.ungetregisterint(list,tempreg.reglo);
  383. rg.ungetregisterint(list,tempreg.reghi);
  384. {$else}
  385. cg.free_scratch_reg(list,tempreg.reglo);
  386. cg.free_scratch_reg(list,tempreg.reghi);
  387. {$endif}
  388. end;
  389. procedure tcg64f32.a_op64_reg_ref(list : taasmoutput;op:TOpCG;reg : tregister64; const ref: treference);
  390. var
  391. tempreg: tregister64;
  392. begin
  393. {$ifdef newra}
  394. tempreg.reghi:=rg.getregisterint(list,OS_INT);
  395. tempreg.reglo:=rg.getregisterint(list,OS_INT);
  396. {$else}
  397. tempreg.reghi := cg.get_scratch_reg_int(list,OS_INT);
  398. tempreg.reglo := cg.get_scratch_reg_int(list,OS_INT);
  399. {$endif}
  400. a_load64_ref_reg(list,ref,tempreg{$ifdef newra},false{$endif});
  401. a_op64_reg_reg(list,op,reg,tempreg);
  402. a_load64_reg_ref(list,tempreg,ref);
  403. {$ifdef newra}
  404. rg.ungetregisterint(list,tempreg.reglo);
  405. rg.ungetregisterint(list,tempreg.reghi);
  406. {$else}
  407. cg.free_scratch_reg(list,tempreg.reglo);
  408. cg.free_scratch_reg(list,tempreg.reghi);
  409. {$endif}
  410. end;
  411. procedure tcg64f32.a_op64_const_ref(list : taasmoutput;op:TOpCG;value : qword;const ref : treference);
  412. var
  413. tempreg: tregister64;
  414. begin
  415. {$ifdef newra}
  416. tempreg.reghi:=rg.getregisterint(list,OS_INT);
  417. tempreg.reglo:=rg.getregisterint(list,OS_INT);
  418. {$else}
  419. tempreg.reghi := cg.get_scratch_reg_int(list,OS_INT);
  420. tempreg.reglo := cg.get_scratch_reg_int(list,OS_INT);
  421. {$endif}
  422. a_load64_ref_reg(list,ref,tempreg{$ifdef newra},false{$endif});
  423. a_op64_const_reg(list,op,value,tempreg);
  424. a_load64_reg_ref(list,tempreg,ref);
  425. {$ifdef newra}
  426. rg.ungetregisterint(list,tempreg.reglo);
  427. rg.ungetregisterint(list,tempreg.reghi);
  428. {$else}
  429. cg.free_scratch_reg(list,tempreg.reglo);
  430. cg.free_scratch_reg(list,tempreg.reghi);
  431. {$endif}
  432. end;
  433. procedure tcg64f32.a_param64_reg(list : taasmoutput;reg : tregister64;const locpara : tparalocation);
  434. var
  435. tmplochi,tmploclo: tparalocation;
  436. begin
  437. paramanager.splitparaloc64(locpara,tmploclo,tmplochi);
  438. cg.a_param_reg(list,OS_32,reg.reghi,tmplochi);
  439. cg.a_param_reg(list,OS_32,reg.reglo,tmploclo);
  440. end;
  441. procedure tcg64f32.a_param64_const(list : taasmoutput;value : qword;const locpara : tparalocation);
  442. var
  443. tmplochi,tmploclo: tparalocation;
  444. begin
  445. paramanager.splitparaloc64(locpara,tmploclo,tmplochi);
  446. cg.a_param_const(list,OS_32,hi(value),tmplochi);
  447. cg.a_param_const(list,OS_32,lo(value),tmploclo);
  448. end;
  449. procedure tcg64f32.a_param64_ref(list : taasmoutput;const r : treference;const locpara : tparalocation);
  450. var
  451. tmprefhi,tmpreflo : treference;
  452. tmploclo,tmplochi : tparalocation;
  453. begin
  454. paramanager.splitparaloc64(locpara,tmploclo,tmplochi);
  455. tmprefhi:=r;
  456. tmpreflo:=r;
  457. if target_info.endian=endian_big then
  458. inc(tmpreflo.offset,4)
  459. else
  460. inc(tmprefhi.offset,4);
  461. cg.a_param_ref(list,OS_32,tmprefhi,tmplochi);
  462. cg.a_param_ref(list,OS_32,tmpreflo,tmploclo);
  463. end;
  464. procedure tcg64f32.a_param64_loc(list : taasmoutput;const l:tlocation;const locpara : tparalocation);
  465. begin
  466. case l.loc of
  467. LOC_REGISTER,
  468. LOC_CREGISTER :
  469. a_param64_reg(list,l.register64,locpara);
  470. LOC_CONSTANT :
  471. a_param64_const(list,l.valueqword,locpara);
  472. LOC_CREFERENCE,
  473. LOC_REFERENCE :
  474. a_param64_ref(list,l.reference,locpara);
  475. else
  476. internalerror(200203287);
  477. end;
  478. end;
  479. procedure tcg64f32.g_rangecheck64(list : taasmoutput;const l:tlocation;fromdef,todef:tdef);
  480. var
  481. neglabel,
  482. poslabel,
  483. endlabel: tasmlabel;
  484. hreg : tregister;
  485. hdef : torddef;
  486. opsize : tcgsize;
  487. oldregisterdef: boolean;
  488. from_signed,to_signed: boolean;
  489. got_scratch: boolean;
  490. temploc : tlocation;
  491. begin
  492. from_signed := is_signed(fromdef);
  493. to_signed := is_signed(todef);
  494. if not is_64bit(todef) then
  495. begin
  496. oldregisterdef := registerdef;
  497. registerdef := false;
  498. { get the high dword in a register }
  499. if l.loc in [LOC_REGISTER,LOC_CREGISTER] then
  500. begin
  501. hreg := l.registerhigh;
  502. got_scratch := false
  503. end
  504. else
  505. begin
  506. {$ifdef newra}
  507. hreg:=rg.getregisterint(list,OS_INT);
  508. {$else}
  509. hreg := cg.get_scratch_reg_int(list,OS_INT);
  510. {$endif}
  511. got_scratch := true;
  512. a_load64high_ref_reg(list,l.reference,hreg);
  513. end;
  514. objectlibrary.getlabel(poslabel);
  515. { check high dword, must be 0 (for positive numbers) }
  516. cg.a_cmp_const_reg_label(list,OS_32,OC_EQ,0,hreg,poslabel);
  517. { It can also be $ffffffff, but only for negative numbers }
  518. if from_signed and to_signed then
  519. begin
  520. objectlibrary.getlabel(neglabel);
  521. cg.a_cmp_const_reg_label(list,OS_32,OC_EQ,aword(-1),hreg,neglabel);
  522. end;
  523. { !!! freeing of register should happen directly after compare! (JM) }
  524. {$ifdef newra}
  525. if got_scratch then
  526. rg.ungetregisterint(list,hreg);
  527. {$else}
  528. if got_scratch then
  529. cg.free_scratch_reg(list,hreg);
  530. {$endif}
  531. { For all other values we have a range check error }
  532. cg.a_call_name(list,'FPC_RANGEERROR');
  533. { if the high dword = 0, the low dword can be considered a }
  534. { simple cardinal }
  535. cg.a_label(list,poslabel);
  536. hdef:=torddef.create(u32bit,0,cardinal($ffffffff));
  537. { no use in calling just "g_rangecheck" since that one will }
  538. { simply call the inherited method too (JM) }
  539. location_copy(temploc,l);
  540. temploc.size:=OS_32;
  541. cg.g_rangecheck(list,temploc,hdef,todef);
  542. hdef.free;
  543. if from_signed and to_signed then
  544. begin
  545. objectlibrary.getlabel(endlabel);
  546. cg.a_jmp_always(list,endlabel);
  547. { if the high dword = $ffffffff, then the low dword (when }
  548. { considered as a longint) must be < 0 }
  549. cg.a_label(list,neglabel);
  550. if l.loc in [LOC_REGISTER,LOC_CREGISTER] then
  551. begin
  552. hreg := l.registerlow;
  553. got_scratch := false
  554. end
  555. else
  556. begin
  557. {$ifdef newra}
  558. hreg:=rg.getregisterint(list,OS_INT);
  559. {$else}
  560. hreg := cg.get_scratch_reg_int(list,OS_INT);
  561. {$endif}
  562. got_scratch := true;
  563. a_load64low_ref_reg(list,l.reference,hreg);
  564. end;
  565. { get a new neglabel (JM) }
  566. objectlibrary.getlabel(neglabel);
  567. cg.a_cmp_const_reg_label(list,OS_32,OC_LT,0,hreg,neglabel);
  568. { !!! freeing of register should happen directly after compare! (JM) }
  569. {$ifdef newra}
  570. if got_scratch then
  571. rg.ungetregisterint(list,hreg);
  572. {$else}
  573. if got_scratch then
  574. cg.free_scratch_reg(list,hreg);
  575. {$endif}
  576. cg.a_call_name(list,'FPC_RANGEERROR');
  577. { if we get here, the 64bit value lies between }
  578. { longint($80000000) and -1 (JM) }
  579. cg.a_label(list,neglabel);
  580. hdef:=torddef.create(s32bit,longint($80000000),-1);
  581. location_copy(temploc,l);
  582. temploc.size:=OS_32;
  583. cg.g_rangecheck(list,temploc,hdef,todef);
  584. hdef.free;
  585. cg.a_label(list,endlabel);
  586. end;
  587. registerdef := oldregisterdef;
  588. end
  589. else
  590. { todef = 64bit int }
  591. { no 64bit subranges supported, so only a small check is necessary }
  592. { if both are signed or both are unsigned, no problem! }
  593. if (from_signed xor to_signed) and
  594. { also not if the fromdef is unsigned and < 64bit, since that will }
  595. { always fit in a 64bit int (todef is 64bit) }
  596. (from_signed or
  597. (torddef(fromdef).typ = u64bit)) then
  598. begin
  599. { in all cases, there is only a problem if the higest bit is set }
  600. if l.loc in [LOC_REGISTER,LOC_CREGISTER] then
  601. begin
  602. if is_64bit(fromdef) then
  603. begin
  604. hreg := l.registerhigh;
  605. opsize := OS_32;
  606. end
  607. else
  608. begin
  609. hreg := l.register;
  610. opsize := def_cgsize(fromdef);
  611. end;
  612. got_scratch := false;
  613. end
  614. else
  615. begin
  616. {$ifdef newra}
  617. hreg:=rg.getregisterint(list,OS_INT);
  618. {$else}
  619. hreg := cg.get_scratch_reg_int(list,OS_INT);
  620. {$endif}
  621. got_scratch := true;
  622. opsize := def_cgsize(fromdef);
  623. if opsize in [OS_64,OS_S64] then
  624. a_load64high_ref_reg(list,l.reference,hreg)
  625. else
  626. cg.a_load_ref_reg(list,opsize,OS_INT,l.reference,hreg);
  627. end;
  628. objectlibrary.getlabel(poslabel);
  629. cg.a_cmp_const_reg_label(list,opsize,OC_GTE,0,hreg,poslabel);
  630. { !!! freeing of register should happen directly after compare! (JM) }
  631. {$ifdef newra}
  632. if got_scratch then
  633. rg.ungetregisterint(list,hreg);
  634. {$else}
  635. if got_scratch then
  636. cg.free_scratch_reg(list,hreg);
  637. {$endif}
  638. cg.a_call_name(list,'FPC_RANGEERROR');
  639. cg.a_label(list,poslabel);
  640. end;
  641. end;
  642. function tcg64f32.optimize64_op_const_reg(list: taasmoutput; var op: topcg; var a : qword; var reg: tregister64): boolean;
  643. var
  644. lowvalue, highvalue : cardinal;
  645. hreg: tregister;
  646. begin
  647. lowvalue := cardinal(a);
  648. highvalue:= a shr 32;
  649. { assume it will be optimized out }
  650. optimize64_op_const_reg := true;
  651. case op of
  652. OP_ADD:
  653. begin
  654. if a = 0 then
  655. exit;
  656. end;
  657. OP_AND:
  658. begin
  659. if lowvalue <> high(cardinal) then
  660. cg.a_op_const_reg(list,op,OS_32,lowvalue,reg.reglo);
  661. if highvalue <> high(cardinal) then
  662. cg.a_op_const_reg(list,op,OS_32,highvalue,reg.reghi);
  663. { already emitted correctly }
  664. exit;
  665. end;
  666. OP_OR:
  667. begin
  668. if lowvalue <> 0 then
  669. cg.a_op_const_reg(list,op,OS_32,lowvalue,reg.reglo);
  670. if highvalue <> 0 then
  671. cg.a_op_const_reg(list,op,OS_32,highvalue,reg.reghi);
  672. { already emitted correctly }
  673. exit;
  674. end;
  675. OP_SUB:
  676. begin
  677. if a = 0 then
  678. exit;
  679. end;
  680. OP_XOR:
  681. begin
  682. end;
  683. OP_SHL:
  684. begin
  685. if a = 0 then
  686. exit;
  687. { simply clear low-register
  688. and shift the rest and swap
  689. registers.
  690. }
  691. if (a > 31) then
  692. begin
  693. cg.a_load_const_reg(list,OS_32,0,reg.reglo);
  694. cg.a_op_const_reg(list,OP_SHL,OS_32,a mod 32,reg.reghi);
  695. { swap the registers }
  696. hreg := reg.reghi;
  697. reg.reghi := reg.reglo;
  698. reg.reglo := hreg;
  699. exit;
  700. end;
  701. end;
  702. OP_SHR:
  703. begin
  704. if a = 0 then exit;
  705. { simply clear high-register
  706. and shift the rest and swap
  707. registers.
  708. }
  709. if (a > 31) then
  710. begin
  711. cg.a_load_const_reg(list,OS_32,0,reg.reghi);
  712. cg.a_op_const_reg(list,OP_SHL,OS_32,a mod 32,reg.reglo);
  713. { swap the registers }
  714. hreg := reg.reghi;
  715. reg.reghi := reg.reglo;
  716. reg.reglo := hreg;
  717. exit;
  718. end;
  719. end;
  720. OP_IMUL,OP_MUL:
  721. begin
  722. if a = 1 then exit;
  723. end;
  724. OP_IDIV,OP_DIV:
  725. begin
  726. if a = 1 then exit;
  727. end;
  728. else
  729. internalerror(20020817);
  730. end;
  731. optimize64_op_const_reg := false;
  732. end;
  733. (*
  734. procedure int64f32_assignment_int64_reg(p : passignmentnode);
  735. begin
  736. end;
  737. begin
  738. p2_assignment:=@int64f32_assignement_int64;
  739. *)
  740. end.
  741. {
  742. $Log$
  743. Revision 1.48 2003-07-02 22:18:04 peter
  744. * paraloc splitted in callerparaloc,calleeparaloc
  745. * sparc calling convention updates
  746. Revision 1.47 2003/06/03 21:11:09 peter
  747. * cg.a_load_* get a from and to size specifier
  748. * makeregsize only accepts newregister
  749. * i386 uses generic tcgnotnode,tcgunaryminus
  750. Revision 1.46 2003/06/03 13:01:59 daniel
  751. * Register allocator finished
  752. Revision 1.45 2003/06/01 21:38:06 peter
  753. * getregisterfpu size parameter added
  754. * op_const_reg size parameter added
  755. * sparc updates
  756. Revision 1.44 2003/05/14 19:31:37 jonas
  757. * fixed a_param64_reg
  758. Revision 1.43 2003/04/27 14:48:09 jonas
  759. * fixed Florian's quick hack :)
  760. * fixed small bug 64bit range checking code
  761. Revision 1.42 2003/04/27 09:10:49 florian
  762. * quick fix for param64 for intel
  763. Revision 1.41 2003/04/27 08:23:51 florian
  764. * fixed parameter passing for 64 bit ints
  765. Revision 1.40 2003/04/23 20:16:03 peter
  766. + added currency support based on int64
  767. + is_64bit for use in cg units instead of is_64bitint
  768. * removed cgmessage from n386add, replace with internalerrors
  769. Revision 1.39 2003/04/22 10:09:34 daniel
  770. + Implemented the actual register allocator
  771. + Scratch registers unavailable when new register allocator used
  772. + maybe_save/maybe_restore unavailable when new register allocator used
  773. Revision 1.38 2003/04/07 08:52:58 jonas
  774. * fixed compiling error
  775. Revision 1.37 2003/04/07 08:45:09 jonas
  776. + generic a_op64_reg_ref implementation
  777. Revision 1.36 2003/03/28 19:16:56 peter
  778. * generic constructor working for i386
  779. * remove fixed self register
  780. * esi added as address register for i386
  781. Revision 1.35 2003/02/19 22:00:14 daniel
  782. * Code generator converted to new register notation
  783. - Horribily outdated todo.txt removed
  784. Revision 1.34 2003/01/08 18:43:56 daniel
  785. * Tregister changed into a record
  786. Revision 1.33 2003/01/05 13:36:53 florian
  787. * x86-64 compiles
  788. + very basic support for float128 type (x86-64 only)
  789. Revision 1.32 2002/11/25 17:43:16 peter
  790. * splitted defbase in defutil,symutil,defcmp
  791. * merged isconvertable and is_equal into compare_defs(_ext)
  792. * made operator search faster by walking the list only once
  793. Revision 1.31 2002/10/05 12:43:23 carl
  794. * fixes for Delphi 6 compilation
  795. (warning : Some features do not work under Delphi)
  796. Revision 1.30 2002/09/17 18:54:01 jonas
  797. * a_load_reg_reg() now has two size parameters: source and dest. This
  798. allows some optimizations on architectures that don't encode the
  799. register size in the register name.
  800. Revision 1.29 2002/09/10 21:24:38 jonas
  801. * fixed a_param64_ref
  802. Revision 1.28 2002/09/07 15:25:00 peter
  803. * old logs removed and tabs fixed
  804. Revision 1.27 2002/08/19 18:17:47 carl
  805. + optimize64_op_const_reg implemented (optimizes 64-bit constant opcodes)
  806. * more fixes to m68k for 64-bit operations
  807. Revision 1.26 2002/08/17 22:09:43 florian
  808. * result type handling in tcgcal.pass_2 overhauled
  809. * better tnode.dowrite
  810. * some ppc stuff fixed
  811. Revision 1.25 2002/08/14 18:41:47 jonas
  812. - remove valuelow/valuehigh fields from tlocation, because they depend
  813. on the endianess of the host operating system -> difficult to get
  814. right. Use lo/hi(location.valueqword) instead (remember to use
  815. valueqword and not value!!)
  816. Revision 1.24 2002/08/11 14:32:26 peter
  817. * renamed current_library to objectlibrary
  818. Revision 1.23 2002/08/11 13:24:11 peter
  819. * saving of asmsymbols in ppu supported
  820. * asmsymbollist global is removed and moved into a new class
  821. tasmlibrarydata that will hold the info of a .a file which
  822. corresponds with a single module. Added librarydata to tmodule
  823. to keep the library info stored for the module. In the future the
  824. objectfiles will also be stored to the tasmlibrarydata class
  825. * all getlabel/newasmsymbol and friends are moved to the new class
  826. Revision 1.22 2002/07/28 15:57:15 jonas
  827. * fixed a_load64_const_reg() for big endian systems
  828. Revision 1.21 2002/07/20 11:57:52 florian
  829. * types.pas renamed to defbase.pas because D6 contains a types
  830. unit so this would conflicts if D6 programms are compiled
  831. + Willamette/SSE2 instructions to assembler added
  832. Revision 1.20 2002/07/12 10:14:26 jonas
  833. * some big-endian fixes
  834. Revision 1.19 2002/07/11 07:23:17 jonas
  835. + generic implementations of a_op64_ref_reg() and a_op64_const_ref()
  836. (only works for processors with >2 scratch registers)
  837. Revision 1.18 2002/07/10 11:12:44 jonas
  838. * fixed a_op64_const_loc()
  839. Revision 1.17 2002/07/07 09:52:32 florian
  840. * powerpc target fixed, very simple units can be compiled
  841. * some basic stuff for better callparanode handling, far from being finished
  842. Revision 1.16 2002/07/01 18:46:21 peter
  843. * internal linker
  844. * reorganized aasm layer
  845. Revision 1.15 2002/07/01 16:23:52 peter
  846. * cg64 patch
  847. * basics for currency
  848. * asnode updates for class and interface (not finished)
  849. Revision 1.14 2002/05/20 13:30:40 carl
  850. * bugfix of hdisponen (base must be set, not index)
  851. * more portability fixes
  852. Revision 1.13 2002/05/18 13:34:05 peter
  853. * readded missing revisions
  854. Revision 1.12 2002/05/16 19:46:35 carl
  855. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  856. + try to fix temp allocation (still in ifdef)
  857. + generic constructor calls
  858. + start of tassembler / tmodulebase class cleanup
  859. Revision 1.10 2002/05/12 16:53:04 peter
  860. * moved entry and exitcode to ncgutil and cgobj
  861. * foreach gets extra argument for passing local data to the
  862. iterator function
  863. * -CR checks also class typecasts at runtime by changing them
  864. into as
  865. * fixed compiler to cycle with the -CR option
  866. * fixed stabs with elf writer, finally the global variables can
  867. be watched
  868. * removed a lot of routines from cga unit and replaced them by
  869. calls to cgobj
  870. * u32bit-s32bit updates for and,or,xor nodes. When one element is
  871. u32bit then the other is typecasted also to u32bit without giving
  872. a rangecheck warning/error.
  873. * fixed pascal calling method with reversing also the high tree in
  874. the parast, detected by tcalcst3 test
  875. Revision 1.9 2002/04/25 20:16:38 peter
  876. * moved more routines from cga/n386util
  877. Revision 1.8 2002/04/21 15:28:51 carl
  878. * a_jmp_cond -> a_jmp_always
  879. Revision 1.7 2002/04/07 13:21:18 carl
  880. + more documentation
  881. }