cg64f32.pas 27 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774
  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 : int64;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);override;
  45. procedure a_load64_reg_reg(list : taasmoutput;regsrc,regdst : tregister64);override;
  46. procedure a_load64_const_reg(list : taasmoutput;value: int64;reg : tregister64);override;
  47. procedure a_load64_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister64);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 : int64;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 : int64;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 : int64;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 : int64;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 : int64; 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. 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. procedure swap64(var q : int64);
  91. begin
  92. q:=(int64(lo(q)) shl 32) or hi(q);
  93. end;
  94. {****************************************************************************
  95. TCG64F32
  96. ****************************************************************************}
  97. procedure tcg64f32.a_reg_alloc(list : taasmoutput;r : tregister64);
  98. begin
  99. list.concat(tai_regalloc.alloc(r.reglo));
  100. list.concat(tai_regalloc.alloc(r.reghi));
  101. end;
  102. procedure tcg64f32.a_reg_dealloc(list : taasmoutput;r : tregister64);
  103. begin
  104. list.concat(tai_regalloc.dealloc(r.reglo));
  105. list.concat(tai_regalloc.dealloc(r.reghi));
  106. end;
  107. procedure tcg64f32.a_load64_reg_ref(list : taasmoutput;reg : tregister64;const ref : treference);
  108. var
  109. tmpreg: tregister;
  110. tmpref: treference;
  111. begin
  112. if target_info.endian = endian_big then
  113. begin
  114. tmpreg:=reg.reglo;
  115. reg.reglo:=reg.reghi;
  116. reg.reghi:=tmpreg;
  117. end;
  118. cg.a_load_reg_ref(list,OS_32,OS_32,reg.reglo,ref);
  119. tmpref := ref;
  120. inc(tmpref.offset,4);
  121. cg.a_load_reg_ref(list,OS_32,OS_32,reg.reghi,tmpref);
  122. end;
  123. procedure tcg64f32.a_load64_const_ref(list : taasmoutput;value : int64;const ref : treference);
  124. var
  125. tmpref: treference;
  126. begin
  127. if target_info.endian = endian_big then
  128. swap64(value);
  129. cg.a_load_const_ref(list,OS_32,aint(lo(value)),ref);
  130. tmpref := ref;
  131. inc(tmpref.offset,4);
  132. cg.a_load_const_ref(list,OS_32,aint(hi(value)),tmpref);
  133. end;
  134. procedure tcg64f32.a_load64_ref_reg(list : taasmoutput;const ref : treference;reg : tregister64);
  135. var
  136. tmpreg: tregister;
  137. tmpref: treference;
  138. got_scratch: boolean;
  139. begin
  140. if target_info.endian = endian_big then
  141. begin
  142. tmpreg := reg.reglo;
  143. reg.reglo := reg.reghi;
  144. reg.reghi := tmpreg;
  145. end;
  146. got_scratch:=false;
  147. tmpref := ref;
  148. if (tmpref.base=reg.reglo) then
  149. begin
  150. tmpreg:=cg.getaddressregister(list);
  151. got_scratch:=true;
  152. cg.a_load_reg_reg(list,OS_ADDR,OS_ADDR,tmpref.base,tmpreg);
  153. tmpref.base:=tmpreg;
  154. end
  155. else
  156. { this works only for the i386, thus the i386 needs to override }
  157. { this method and this method must be replaced by a more generic }
  158. { implementation FK }
  159. if (tmpref.index=reg.reglo) then
  160. begin
  161. tmpreg:=cg.getaddressregister(list);
  162. got_scratch:=true;
  163. cg.a_load_reg_reg(list,OS_ADDR,OS_ADDR,tmpref.index,tmpreg);
  164. tmpref.index:=tmpreg;
  165. end;
  166. cg.a_load_ref_reg(list,OS_32,OS_32,tmpref,reg.reglo);
  167. inc(tmpref.offset,4);
  168. cg.a_load_ref_reg(list,OS_32,OS_32,tmpref,reg.reghi);
  169. if got_scratch then
  170. cg.ungetregister(list,tmpreg);
  171. end;
  172. procedure tcg64f32.a_load64_reg_reg(list : taasmoutput;regsrc,regdst : tregister64);
  173. begin
  174. cg.a_load_reg_reg(list,OS_32,OS_32,regsrc.reglo,regdst.reglo);
  175. cg.a_load_reg_reg(list,OS_32,OS_32,regsrc.reghi,regdst.reghi);
  176. end;
  177. procedure tcg64f32.a_load64_const_reg(list : taasmoutput;value : int64;reg : tregister64);
  178. begin
  179. cg.a_load_const_reg(list,OS_32,aint(lo(value)),reg.reglo);
  180. cg.a_load_const_reg(list,OS_32,aint(hi(value)),reg.reghi);
  181. end;
  182. procedure tcg64f32.a_load64_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister64);
  183. begin
  184. case l.loc of
  185. LOC_REFERENCE, LOC_CREFERENCE:
  186. a_load64_ref_reg(list,l.reference,reg);
  187. LOC_REGISTER,LOC_CREGISTER:
  188. a_load64_reg_reg(list,l.register64,reg);
  189. LOC_CONSTANT :
  190. a_load64_const_reg(list,l.value64,reg);
  191. else
  192. internalerror(200112292);
  193. end;
  194. end;
  195. procedure tcg64f32.a_load64_loc_ref(list : taasmoutput;const l : tlocation;const ref : treference);
  196. begin
  197. case l.loc of
  198. LOC_REGISTER,LOC_CREGISTER:
  199. a_load64_reg_ref(list,l.register64,ref);
  200. LOC_CONSTANT :
  201. a_load64_const_ref(list,l.value64,ref);
  202. else
  203. internalerror(200203288);
  204. end;
  205. end;
  206. procedure tcg64f32.a_load64_const_loc(list : taasmoutput;value : int64;const l : tlocation);
  207. begin
  208. case l.loc of
  209. LOC_REFERENCE, LOC_CREFERENCE:
  210. a_load64_const_ref(list,value,l.reference);
  211. LOC_REGISTER,LOC_CREGISTER:
  212. a_load64_const_reg(list,value,l.register64);
  213. else
  214. internalerror(200112293);
  215. end;
  216. end;
  217. procedure tcg64f32.a_load64_reg_loc(list : taasmoutput;reg : tregister64;const l : tlocation);
  218. begin
  219. case l.loc of
  220. LOC_REFERENCE, LOC_CREFERENCE:
  221. a_load64_reg_ref(list,reg,l.reference);
  222. LOC_REGISTER,LOC_CREGISTER:
  223. a_load64_reg_reg(list,reg,l.register64);
  224. else
  225. internalerror(200112293);
  226. end;
  227. end;
  228. procedure tcg64f32.a_load64high_reg_ref(list : taasmoutput;reg : tregister;const ref : treference);
  229. var
  230. tmpref: treference;
  231. begin
  232. if target_info.endian = endian_big then
  233. cg.a_load_reg_ref(list,OS_32,OS_32,reg,ref)
  234. else
  235. begin
  236. tmpref := ref;
  237. inc(tmpref.offset,4);
  238. cg.a_load_reg_ref(list,OS_32,OS_32,reg,tmpref)
  239. end;
  240. end;
  241. procedure tcg64f32.a_load64low_reg_ref(list : taasmoutput;reg : tregister;const ref : treference);
  242. var
  243. tmpref: treference;
  244. begin
  245. if target_info.endian = endian_little then
  246. cg.a_load_reg_ref(list,OS_32,OS_32,reg,ref)
  247. else
  248. begin
  249. tmpref := ref;
  250. inc(tmpref.offset,4);
  251. cg.a_load_reg_ref(list,OS_32,OS_32,reg,tmpref)
  252. end;
  253. end;
  254. procedure tcg64f32.a_load64high_ref_reg(list : taasmoutput;const ref : treference;reg : tregister);
  255. var
  256. tmpref: treference;
  257. begin
  258. if target_info.endian = endian_big then
  259. cg.a_load_ref_reg(list,OS_32,OS_32,ref,reg)
  260. else
  261. begin
  262. tmpref := ref;
  263. inc(tmpref.offset,4);
  264. cg.a_load_ref_reg(list,OS_32,OS_32,tmpref,reg)
  265. end;
  266. end;
  267. procedure tcg64f32.a_load64low_ref_reg(list : taasmoutput;const ref : treference;reg : tregister);
  268. var
  269. tmpref: treference;
  270. begin
  271. if target_info.endian = endian_little then
  272. cg.a_load_ref_reg(list,OS_32,OS_32,ref,reg)
  273. else
  274. begin
  275. tmpref := ref;
  276. inc(tmpref.offset,4);
  277. cg.a_load_ref_reg(list,OS_32,OS_32,tmpref,reg)
  278. end;
  279. end;
  280. procedure tcg64f32.a_load64low_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister);
  281. begin
  282. case l.loc of
  283. LOC_REFERENCE,
  284. LOC_CREFERENCE :
  285. a_load64low_ref_reg(list,l.reference,reg);
  286. LOC_REGISTER :
  287. cg.a_load_reg_reg(list,OS_32,OS_32,l.registerlow,reg);
  288. LOC_CONSTANT :
  289. cg.a_load_const_reg(list,OS_32,aint(lo(l.value64)),reg);
  290. else
  291. internalerror(200203244);
  292. end;
  293. end;
  294. procedure tcg64f32.a_load64high_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister);
  295. begin
  296. case l.loc of
  297. LOC_REFERENCE,
  298. LOC_CREFERENCE :
  299. a_load64high_ref_reg(list,l.reference,reg);
  300. LOC_REGISTER :
  301. cg.a_load_reg_reg(list,OS_32,OS_32,l.registerhigh,reg);
  302. LOC_CONSTANT :
  303. cg.a_load_const_reg(list,OS_32,hi(l.value64),reg);
  304. else
  305. internalerror(200203244);
  306. end;
  307. end;
  308. procedure tcg64f32.a_op64_const_loc(list : taasmoutput;op:TOpCG;value : int64;const l: tlocation);
  309. begin
  310. case l.loc of
  311. LOC_REFERENCE, LOC_CREFERENCE:
  312. a_op64_const_ref(list,op,value,l.reference);
  313. LOC_REGISTER,LOC_CREGISTER:
  314. a_op64_const_reg(list,op,value,l.register64);
  315. else
  316. internalerror(200203292);
  317. end;
  318. end;
  319. procedure tcg64f32.a_op64_reg_loc(list : taasmoutput;op:TOpCG;reg : tregister64;const l : tlocation);
  320. begin
  321. case l.loc of
  322. LOC_REFERENCE, LOC_CREFERENCE:
  323. a_op64_reg_ref(list,op,reg,l.reference);
  324. LOC_REGISTER,LOC_CREGISTER:
  325. a_op64_reg_reg(list,op,reg,l.register64);
  326. else
  327. internalerror(2002032422);
  328. end;
  329. end;
  330. procedure tcg64f32.a_op64_loc_reg(list : taasmoutput;op:TOpCG;const l : tlocation;reg : tregister64);
  331. begin
  332. case l.loc of
  333. LOC_REFERENCE, LOC_CREFERENCE:
  334. a_op64_ref_reg(list,op,l.reference,reg);
  335. LOC_REGISTER,LOC_CREGISTER:
  336. a_op64_reg_reg(list,op,l.register64,reg);
  337. LOC_CONSTANT :
  338. a_op64_const_reg(list,op,l.value64,reg);
  339. else
  340. internalerror(200203242);
  341. end;
  342. end;
  343. procedure tcg64f32.a_op64_ref_reg(list : taasmoutput;op:TOpCG;const ref : treference;reg : tregister64);
  344. var
  345. tempreg: tregister64;
  346. begin
  347. tempreg.reghi:=cg.getintregister(list,OS_32);
  348. tempreg.reglo:=cg.getintregister(list,OS_32);
  349. a_load64_ref_reg(list,ref,tempreg);
  350. a_op64_reg_reg(list,op,tempreg,reg);
  351. cg.ungetregister(list,tempreg.reglo);
  352. cg.ungetregister(list,tempreg.reghi);
  353. end;
  354. procedure tcg64f32.a_op64_reg_ref(list : taasmoutput;op:TOpCG;reg : tregister64; const ref: treference);
  355. var
  356. tempreg: tregister64;
  357. begin
  358. tempreg.reghi:=cg.getintregister(list,OS_32);
  359. tempreg.reglo:=cg.getintregister(list,OS_32);
  360. a_load64_ref_reg(list,ref,tempreg);
  361. a_op64_reg_reg(list,op,reg,tempreg);
  362. a_load64_reg_ref(list,tempreg,ref);
  363. cg.ungetregister(list,tempreg.reglo);
  364. cg.ungetregister(list,tempreg.reghi);
  365. end;
  366. procedure tcg64f32.a_op64_const_ref(list : taasmoutput;op:TOpCG;value : int64;const ref : treference);
  367. var
  368. tempreg: tregister64;
  369. begin
  370. tempreg.reghi:=cg.getintregister(list,OS_32);
  371. tempreg.reglo:=cg.getintregister(list,OS_32);
  372. a_load64_ref_reg(list,ref,tempreg);
  373. a_op64_const_reg(list,op,value,tempreg);
  374. a_load64_reg_ref(list,tempreg,ref);
  375. cg.ungetregister(list,tempreg.reglo);
  376. cg.ungetregister(list,tempreg.reghi);
  377. end;
  378. procedure tcg64f32.a_param64_reg(list : taasmoutput;reg : tregister64;const locpara : tparalocation);
  379. var
  380. tmplochi,tmploclo: tparalocation;
  381. begin
  382. paramanager.splitparaloc64(locpara,tmploclo,tmplochi);
  383. cg.a_param_reg(list,OS_32,reg.reghi,tmplochi);
  384. cg.a_param_reg(list,OS_32,reg.reglo,tmploclo);
  385. end;
  386. procedure tcg64f32.a_param64_const(list : taasmoutput;value : int64;const locpara : tparalocation);
  387. var
  388. tmplochi,tmploclo: tparalocation;
  389. begin
  390. paramanager.splitparaloc64(locpara,tmploclo,tmplochi);
  391. cg.a_param_const(list,OS_32,aint(hi(value)),tmplochi);
  392. cg.a_param_const(list,OS_32,aint(lo(value)),tmploclo);
  393. end;
  394. procedure tcg64f32.a_param64_ref(list : taasmoutput;const r : treference;const locpara : tparalocation);
  395. var
  396. tmprefhi,tmpreflo : treference;
  397. tmploclo,tmplochi : tparalocation;
  398. begin
  399. paramanager.splitparaloc64(locpara,tmploclo,tmplochi);
  400. tmprefhi:=r;
  401. tmpreflo:=r;
  402. if target_info.endian=endian_big then
  403. inc(tmpreflo.offset,4)
  404. else
  405. inc(tmprefhi.offset,4);
  406. cg.a_param_ref(list,OS_32,tmprefhi,tmplochi);
  407. cg.a_param_ref(list,OS_32,tmpreflo,tmploclo);
  408. end;
  409. procedure tcg64f32.a_param64_loc(list : taasmoutput;const l:tlocation;const locpara : tparalocation);
  410. begin
  411. case l.loc of
  412. LOC_REGISTER,
  413. LOC_CREGISTER :
  414. a_param64_reg(list,l.register64,locpara);
  415. LOC_CONSTANT :
  416. a_param64_const(list,l.value64,locpara);
  417. LOC_CREFERENCE,
  418. LOC_REFERENCE :
  419. a_param64_ref(list,l.reference,locpara);
  420. else
  421. internalerror(200203287);
  422. end;
  423. end;
  424. procedure tcg64f32.g_rangecheck64(list : taasmoutput;const l:tlocation;fromdef,todef:tdef);
  425. var
  426. neglabel,
  427. poslabel,
  428. endlabel: tasmlabel;
  429. hreg : tregister;
  430. hdef : torddef;
  431. opsize : tcgsize;
  432. oldregisterdef: boolean;
  433. from_signed,to_signed: boolean;
  434. got_scratch: boolean;
  435. temploc : tlocation;
  436. begin
  437. from_signed := is_signed(fromdef);
  438. to_signed := is_signed(todef);
  439. if not is_64bit(todef) then
  440. begin
  441. oldregisterdef := registerdef;
  442. registerdef := false;
  443. { get the high dword in a register }
  444. if l.loc in [LOC_REGISTER,LOC_CREGISTER] then
  445. begin
  446. hreg := l.registerhigh;
  447. got_scratch := false
  448. end
  449. else
  450. begin
  451. hreg:=cg.getintregister(list,OS_32);
  452. got_scratch := true;
  453. a_load64high_ref_reg(list,l.reference,hreg);
  454. end;
  455. objectlibrary.getlabel(poslabel);
  456. { check high dword, must be 0 (for positive numbers) }
  457. cg.a_cmp_const_reg_label(list,OS_32,OC_EQ,0,hreg,poslabel);
  458. { It can also be $ffffffff, but only for negative numbers }
  459. if from_signed and to_signed then
  460. begin
  461. objectlibrary.getlabel(neglabel);
  462. cg.a_cmp_const_reg_label(list,OS_32,OC_EQ,-1,hreg,neglabel);
  463. end;
  464. { !!! freeing of register should happen directly after compare! (JM) }
  465. if got_scratch then
  466. cg.ungetregister(list,hreg);
  467. { For all other values we have a range check error }
  468. cg.a_call_name(list,'FPC_RANGEERROR');
  469. { if the high dword = 0, the low dword can be considered a }
  470. { simple cardinal }
  471. cg.a_label(list,poslabel);
  472. hdef:=torddef.create(u32bit,0,$ffffffff);
  473. location_copy(temploc,l);
  474. temploc.size:=OS_32;
  475. if (temploc.loc in [LOC_REFERENCE,LOC_CREFERENCE]) and
  476. (target_info.endian = endian_big) then
  477. inc(temploc.reference.offset,4);
  478. cg.g_rangecheck(list,temploc,hdef,todef);
  479. hdef.free;
  480. if from_signed and to_signed then
  481. begin
  482. objectlibrary.getlabel(endlabel);
  483. cg.a_jmp_always(list,endlabel);
  484. { if the high dword = $ffffffff, then the low dword (when }
  485. { considered as a longint) must be < 0 }
  486. cg.a_label(list,neglabel);
  487. if l.loc in [LOC_REGISTER,LOC_CREGISTER] then
  488. begin
  489. hreg := l.registerlow;
  490. got_scratch := false
  491. end
  492. else
  493. begin
  494. hreg:=cg.getintregister(list,OS_32);
  495. got_scratch := true;
  496. a_load64low_ref_reg(list,l.reference,hreg);
  497. end;
  498. { get a new neglabel (JM) }
  499. objectlibrary.getlabel(neglabel);
  500. cg.a_cmp_const_reg_label(list,OS_32,OC_LT,0,hreg,neglabel);
  501. { !!! freeing of register should happen directly after compare! (JM) }
  502. if got_scratch then
  503. cg.ungetregister(list,hreg);
  504. cg.a_call_name(list,'FPC_RANGEERROR');
  505. { if we get here, the 64bit value lies between }
  506. { longint($80000000) and -1 (JM) }
  507. cg.a_label(list,neglabel);
  508. hdef:=torddef.create(s32bit,longint($80000000),-1);
  509. location_copy(temploc,l);
  510. temploc.size:=OS_32;
  511. cg.g_rangecheck(list,temploc,hdef,todef);
  512. hdef.free;
  513. cg.a_label(list,endlabel);
  514. end;
  515. registerdef := oldregisterdef;
  516. end
  517. else
  518. { todef = 64bit int }
  519. { no 64bit subranges supported, so only a small check is necessary }
  520. { if both are signed or both are unsigned, no problem! }
  521. if (from_signed xor to_signed) and
  522. { also not if the fromdef is unsigned and < 64bit, since that will }
  523. { always fit in a 64bit int (todef is 64bit) }
  524. (from_signed or
  525. (torddef(fromdef).typ = u64bit)) then
  526. begin
  527. { in all cases, there is only a problem if the higest bit is set }
  528. if l.loc in [LOC_REGISTER,LOC_CREGISTER] then
  529. begin
  530. if is_64bit(fromdef) then
  531. begin
  532. hreg := l.registerhigh;
  533. opsize := OS_32;
  534. end
  535. else
  536. begin
  537. hreg := l.register;
  538. opsize := def_cgsize(fromdef);
  539. end;
  540. got_scratch := false;
  541. end
  542. else
  543. begin
  544. hreg:=cg.getintregister(list,OS_32);
  545. got_scratch := true;
  546. opsize := def_cgsize(fromdef);
  547. if opsize in [OS_64,OS_S64] then
  548. a_load64high_ref_reg(list,l.reference,hreg)
  549. else
  550. cg.a_load_ref_reg(list,opsize,OS_32,l.reference,hreg);
  551. end;
  552. objectlibrary.getlabel(poslabel);
  553. cg.a_cmp_const_reg_label(list,opsize,OC_GTE,0,hreg,poslabel);
  554. { !!! freeing of register should happen directly after compare! (JM) }
  555. if got_scratch then
  556. cg.ungetregister(list,hreg);
  557. cg.a_call_name(list,'FPC_RANGEERROR');
  558. cg.a_label(list,poslabel);
  559. end;
  560. end;
  561. function tcg64f32.optimize64_op_const_reg(list: taasmoutput; var op: topcg; var a : int64; var reg: tregister64): boolean;
  562. var
  563. lowvalue, highvalue : longint;
  564. hreg: tregister;
  565. begin
  566. lowvalue := longint(a);
  567. highvalue:= longint(a shr 32);
  568. { assume it will be optimized out }
  569. optimize64_op_const_reg := true;
  570. case op of
  571. OP_ADD:
  572. begin
  573. if a = 0 then
  574. exit;
  575. end;
  576. OP_AND:
  577. begin
  578. if lowvalue <> -1 then
  579. cg.a_op_const_reg(list,op,OS_32,lowvalue,reg.reglo);
  580. if highvalue <> -1 then
  581. cg.a_op_const_reg(list,op,OS_32,highvalue,reg.reghi);
  582. { already emitted correctly }
  583. exit;
  584. end;
  585. OP_OR:
  586. begin
  587. if lowvalue <> 0 then
  588. cg.a_op_const_reg(list,op,OS_32,lowvalue,reg.reglo);
  589. if highvalue <> 0 then
  590. cg.a_op_const_reg(list,op,OS_32,highvalue,reg.reghi);
  591. { already emitted correctly }
  592. exit;
  593. end;
  594. OP_SUB:
  595. begin
  596. if a = 0 then
  597. exit;
  598. end;
  599. OP_XOR:
  600. begin
  601. end;
  602. OP_SHL:
  603. begin
  604. if a = 0 then
  605. exit;
  606. { simply clear low-register
  607. and shift the rest and swap
  608. registers.
  609. }
  610. if (a > 31) then
  611. begin
  612. cg.a_load_const_reg(list,OS_32,0,reg.reglo);
  613. cg.a_op_const_reg(list,OP_SHL,OS_32,a mod 32,reg.reghi);
  614. { swap the registers }
  615. hreg := reg.reghi;
  616. reg.reghi := reg.reglo;
  617. reg.reglo := hreg;
  618. exit;
  619. end;
  620. end;
  621. OP_SHR:
  622. begin
  623. if a = 0 then exit;
  624. { simply clear high-register
  625. and shift the rest and swap
  626. registers.
  627. }
  628. if (a > 31) then
  629. begin
  630. cg.a_load_const_reg(list,OS_32,0,reg.reghi);
  631. cg.a_op_const_reg(list,OP_SHL,OS_32,a mod 32,reg.reglo);
  632. { swap the registers }
  633. hreg := reg.reghi;
  634. reg.reghi := reg.reglo;
  635. reg.reglo := hreg;
  636. exit;
  637. end;
  638. end;
  639. OP_IMUL,OP_MUL:
  640. begin
  641. if a = 1 then exit;
  642. end;
  643. OP_IDIV,OP_DIV:
  644. begin
  645. if a = 1 then exit;
  646. end;
  647. else
  648. internalerror(20020817);
  649. end;
  650. optimize64_op_const_reg := false;
  651. end;
  652. end.
  653. {
  654. $Log$
  655. Revision 1.61 2004-06-20 08:55:28 florian
  656. * logs truncated
  657. Revision 1.60 2004/06/18 15:16:46 peter
  658. * remove obsolete cardinal() typecasts
  659. Revision 1.59 2004/06/17 16:55:46 peter
  660. * powerpc compiles again
  661. Revision 1.58 2004/06/16 20:07:07 florian
  662. * dwarf branch merged
  663. Revision 1.57.2.5 2004/06/13 10:51:16 florian
  664. * fixed several register allocator problems (sparc/arm)
  665. Revision 1.57.2.4 2004/06/12 17:01:01 florian
  666. * fixed compilation of arm compiler
  667. }