cg64f32.pas 34 KB

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