cg64f32.pas 27 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734
  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,
  29. cginfo, cgobj,
  30. node,symtype;
  31. type
  32. {# Defines all the methods required on 32-bit processors
  33. to handle 64-bit integers.
  34. }
  35. tcg64f32 = class(tcg64)
  36. procedure a_load64_const_ref(list : taasmoutput;value : qword;const ref : treference);override;
  37. procedure a_load64_reg_ref(list : taasmoutput;reg : tregister64;const ref : treference);override;
  38. procedure a_load64_ref_reg(list : taasmoutput;const ref : treference;reg : tregister64);override;
  39. procedure a_load64_reg_reg(list : taasmoutput;regsrc,regdst : tregister64);override;
  40. procedure a_load64_const_reg(list : taasmoutput;value: qword;reg : tregister64);override;
  41. procedure a_load64_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister64);override;
  42. procedure a_load64_loc_ref(list : taasmoutput;const l : tlocation;const ref : treference);override;
  43. procedure a_load64_const_loc(list : taasmoutput;value : qword;const l : tlocation);override;
  44. procedure a_load64_reg_loc(list : taasmoutput;reg : tregister64;const l : tlocation);override;
  45. procedure a_load64high_reg_ref(list : taasmoutput;reg : tregister;const ref : treference);override;
  46. procedure a_load64low_reg_ref(list : taasmoutput;reg : tregister;const ref : treference);override;
  47. procedure a_load64high_ref_reg(list : taasmoutput;const ref : treference;reg : tregister);override;
  48. procedure a_load64low_ref_reg(list : taasmoutput;const ref : treference;reg : tregister);override;
  49. procedure a_load64high_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister);override;
  50. procedure a_load64low_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister);override;
  51. procedure a_op64_const_loc(list : taasmoutput;op:TOpCG;value : qword;const l: tlocation);override;
  52. procedure a_op64_reg_loc(list : taasmoutput;op:TOpCG;reg : tregister64;const l : tlocation);override;
  53. procedure a_op64_loc_reg(list : taasmoutput;op:TOpCG;const l : tlocation;reg : tregister64);override;
  54. procedure a_op64_ref_reg(list : taasmoutput;op:TOpCG;const ref : treference;reg : tregister64);override;
  55. procedure a_op64_const_ref(list : taasmoutput;op:TOpCG;value : qword;const ref : treference);override;
  56. procedure a_param64_reg(list : taasmoutput;reg : tregister64;const locpara : tparalocation);override;
  57. procedure a_param64_const(list : taasmoutput;value : qword;const locpara : tparalocation);override;
  58. procedure a_param64_ref(list : taasmoutput;const r : treference;const locpara : tparalocation);override;
  59. procedure a_param64_loc(list : taasmoutput;const l : tlocation;const locpara : tparalocation);override;
  60. procedure g_rangecheck64(list: taasmoutput; const p: tnode;
  61. const todef: tdef); override;
  62. end;
  63. {# Creates a tregister64 record from 2 32 Bit registers. }
  64. function joinreg64(reglo,reghi : tregister) : tregister64;
  65. implementation
  66. uses
  67. globtype,globals,systems,
  68. cgbase,
  69. verbose,
  70. symbase,symconst,symdef,defbase;
  71. function joinreg64(reglo,reghi : tregister) : tregister64;
  72. begin
  73. result.reglo:=reglo;
  74. result.reghi:=reghi;
  75. end;
  76. procedure tcg64f32.a_load64_reg_ref(list : taasmoutput;reg : tregister64;const ref : treference);
  77. var
  78. tmpreg: tregister;
  79. tmpref: treference;
  80. begin
  81. if target_info.endian = endian_big then
  82. begin
  83. tmpreg:=reg.reglo;
  84. reg.reglo:=reg.reghi;
  85. reg.reghi:=tmpreg;
  86. end;
  87. cg.a_load_reg_ref(list,OS_32,reg.reglo,ref);
  88. tmpref := ref;
  89. inc(tmpref.offset,4);
  90. cg.a_load_reg_ref(list,OS_32,reg.reghi,tmpref);
  91. end;
  92. procedure tcg64f32.a_load64_const_ref(list : taasmoutput;value : qword;const ref : treference);
  93. var
  94. tmpvalue : DWord;
  95. tmpref: treference;
  96. begin
  97. if target_info.endian = endian_big then
  98. swap_qword(value);
  99. cg.a_load_const_ref(list,OS_32,lo(value),ref);
  100. tmpref := ref;
  101. inc(tmpref.offset,4);
  102. cg.a_load_const_ref(list,OS_32,hi(value),tmpref);
  103. end;
  104. procedure tcg64f32.a_load64_ref_reg(list : taasmoutput;const ref : treference;reg : tregister64);
  105. var
  106. tmpreg: tregister;
  107. tmpref: treference;
  108. got_scratch: boolean;
  109. begin
  110. if target_info.endian = endian_big then
  111. begin
  112. tmpreg := reg.reglo;
  113. reg.reglo := reg.reghi;
  114. reg.reghi := tmpreg;
  115. end;
  116. got_scratch:=false;
  117. tmpref := ref;
  118. if (tmpref.base=reg.reglo) then
  119. begin
  120. tmpreg := cg.get_scratch_reg_int(list);
  121. got_scratch:=true;
  122. cg.a_load_reg_reg(list,OS_ADDR,tmpref.base,tmpreg);
  123. tmpref.base:=tmpreg;
  124. end
  125. else
  126. { this works only for the i386, thus the i386 needs to override }
  127. { this method and this method must be replaced by a more generic }
  128. { implementation FK }
  129. if (tmpref.index=reg.reglo) then
  130. begin
  131. tmpreg:=cg.get_scratch_reg_int(list);
  132. got_scratch:=true;
  133. cg.a_load_reg_reg(list,OS_ADDR,tmpref.index,tmpreg);
  134. tmpref.index:=tmpreg;
  135. end;
  136. cg.a_load_ref_reg(list,OS_32,tmpref,reg.reglo);
  137. inc(tmpref.offset,4);
  138. cg.a_load_ref_reg(list,OS_32,tmpref,reg.reghi);
  139. if got_scratch then
  140. cg.free_scratch_reg(list,tmpreg);
  141. end;
  142. procedure tcg64f32.a_load64_reg_reg(list : taasmoutput;regsrc,regdst : tregister64);
  143. begin
  144. cg.a_load_reg_reg(list,OS_32,regsrc.reglo,regdst.reglo);
  145. cg.a_load_reg_reg(list,OS_32,regsrc.reghi,regdst.reghi);
  146. end;
  147. procedure tcg64f32.a_load64_const_reg(list : taasmoutput;value : qword;reg : tregister64);
  148. begin
  149. cg.a_load_const_reg(list,OS_32,lo(value),reg.reglo);
  150. cg.a_load_const_reg(list,OS_32,hi(value),reg.reghi);
  151. end;
  152. procedure tcg64f32.a_load64_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister64);
  153. begin
  154. case l.loc of
  155. LOC_REFERENCE, LOC_CREFERENCE:
  156. a_load64_ref_reg(list,l.reference,reg);
  157. LOC_REGISTER,LOC_CREGISTER:
  158. a_load64_reg_reg(list,l.register64,reg);
  159. LOC_CONSTANT :
  160. a_load64_const_reg(list,l.valueqword,reg);
  161. else
  162. internalerror(200112292);
  163. end;
  164. end;
  165. procedure tcg64f32.a_load64_loc_ref(list : taasmoutput;const l : tlocation;const ref : treference);
  166. begin
  167. case l.loc of
  168. LOC_REGISTER,LOC_CREGISTER:
  169. a_load64_reg_ref(list,l.reg64,ref);
  170. LOC_CONSTANT :
  171. a_load64_const_ref(list,l.valueqword,ref);
  172. else
  173. internalerror(200203288);
  174. end;
  175. end;
  176. procedure tcg64f32.a_load64_const_loc(list : taasmoutput;value : qword;const l : tlocation);
  177. begin
  178. case l.loc of
  179. LOC_REFERENCE, LOC_CREFERENCE:
  180. a_load64_const_ref(list,value,l.reference);
  181. LOC_REGISTER,LOC_CREGISTER:
  182. a_load64_const_reg(list,value,l.reg64);
  183. else
  184. internalerror(200112293);
  185. end;
  186. end;
  187. procedure tcg64f32.a_load64_reg_loc(list : taasmoutput;reg : tregister64;const l : tlocation);
  188. begin
  189. case l.loc of
  190. LOC_REFERENCE, LOC_CREFERENCE:
  191. a_load64_reg_ref(list,reg,l.reference);
  192. LOC_REGISTER,LOC_CREGISTER:
  193. a_load64_reg_reg(list,reg,l.register64);
  194. else
  195. internalerror(200112293);
  196. end;
  197. end;
  198. procedure tcg64f32.a_load64high_reg_ref(list : taasmoutput;reg : tregister;const ref : treference);
  199. var
  200. tmpref: treference;
  201. begin
  202. if target_info.endian = endian_big then
  203. cg.a_load_reg_ref(list,OS_32,reg,ref)
  204. else
  205. begin
  206. tmpref := ref;
  207. inc(tmpref.offset,4);
  208. cg.a_load_reg_ref(list,OS_32,reg,tmpref)
  209. end;
  210. end;
  211. procedure tcg64f32.a_load64low_reg_ref(list : taasmoutput;reg : tregister;const ref : treference);
  212. var
  213. tmpref: treference;
  214. begin
  215. if target_info.endian = endian_little then
  216. cg.a_load_reg_ref(list,OS_32,reg,ref)
  217. else
  218. begin
  219. tmpref := ref;
  220. inc(tmpref.offset,4);
  221. cg.a_load_reg_ref(list,OS_32,reg,tmpref)
  222. end;
  223. end;
  224. procedure tcg64f32.a_load64high_ref_reg(list : taasmoutput;const ref : treference;reg : tregister);
  225. var
  226. tmpref: treference;
  227. begin
  228. if target_info.endian = endian_big then
  229. cg.a_load_ref_reg(list,OS_32,ref,reg)
  230. else
  231. begin
  232. tmpref := ref;
  233. inc(tmpref.offset,4);
  234. cg.a_load_ref_reg(list,OS_32,tmpref,reg)
  235. end;
  236. end;
  237. procedure tcg64f32.a_load64low_ref_reg(list : taasmoutput;const ref : treference;reg : tregister);
  238. var
  239. tmpref: treference;
  240. begin
  241. if target_info.endian = endian_little then
  242. cg.a_load_ref_reg(list,OS_32,ref,reg)
  243. else
  244. begin
  245. tmpref := ref;
  246. inc(tmpref.offset,4);
  247. cg.a_load_ref_reg(list,OS_32,tmpref,reg)
  248. end;
  249. end;
  250. procedure tcg64f32.a_load64low_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister);
  251. begin
  252. case l.loc of
  253. LOC_REFERENCE,
  254. LOC_CREFERENCE :
  255. a_load64low_ref_reg(list,l.reference,reg);
  256. LOC_REGISTER :
  257. cg.a_load_reg_reg(list,OS_32,l.registerlow,reg);
  258. LOC_CONSTANT :
  259. cg.a_load_const_reg(list,OS_32,l.valuelow,reg);
  260. else
  261. internalerror(200203244);
  262. end;
  263. end;
  264. procedure tcg64f32.a_load64high_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister);
  265. begin
  266. case l.loc of
  267. LOC_REFERENCE,
  268. LOC_CREFERENCE :
  269. a_load64high_ref_reg(list,l.reference,reg);
  270. LOC_REGISTER :
  271. cg.a_load_reg_reg(list,OS_32,l.registerhigh,reg);
  272. LOC_CONSTANT :
  273. cg.a_load_const_reg(list,OS_32,l.valuehigh,reg);
  274. else
  275. internalerror(200203244);
  276. end;
  277. end;
  278. procedure tcg64f32.a_op64_const_loc(list : taasmoutput;op:TOpCG;value : qword;const l: tlocation);
  279. begin
  280. case l.loc of
  281. LOC_REFERENCE, LOC_CREFERENCE:
  282. a_op64_const_ref(list,op,value,l.reference);
  283. LOC_REGISTER,LOC_CREGISTER:
  284. a_op64_const_reg(list,op,value,l.register64);
  285. else
  286. internalerror(200203292);
  287. end;
  288. end;
  289. procedure tcg64f32.a_op64_reg_loc(list : taasmoutput;op:TOpCG;reg : tregister64;const l : tlocation);
  290. begin
  291. case l.loc of
  292. LOC_REFERENCE, LOC_CREFERENCE:
  293. a_op64_reg_ref(list,op,reg,l.reference);
  294. LOC_REGISTER,LOC_CREGISTER:
  295. a_op64_reg_reg(list,op,reg,l.register64);
  296. else
  297. internalerror(2002032422);
  298. end;
  299. end;
  300. procedure tcg64f32.a_op64_loc_reg(list : taasmoutput;op:TOpCG;const l : tlocation;reg : tregister64);
  301. begin
  302. case l.loc of
  303. LOC_REFERENCE, LOC_CREFERENCE:
  304. a_op64_ref_reg(list,op,l.reference,reg);
  305. LOC_REGISTER,LOC_CREGISTER:
  306. a_op64_reg_reg(list,op,l.register64,reg);
  307. LOC_CONSTANT :
  308. a_op64_const_reg(list,op,l.valueqword,reg);
  309. else
  310. internalerror(200203242);
  311. end;
  312. end;
  313. procedure tcg64f32.a_op64_ref_reg(list : taasmoutput;op:TOpCG;const ref : treference;reg : tregister64);
  314. var
  315. tempreg: tregister64;
  316. begin
  317. tempreg.reghi := cg.get_scratch_reg_int(list);
  318. tempreg.reglo := cg.get_scratch_reg_int(list);
  319. a_load64_ref_reg(list,ref,tempreg);
  320. a_op64_reg_reg(list,op,tempreg,reg);
  321. cg.free_scratch_reg(list,tempreg.reglo);
  322. cg.free_scratch_reg(list,tempreg.reghi);
  323. end;
  324. procedure tcg64f32.a_op64_const_ref(list : taasmoutput;op:TOpCG;value : qword;const ref : treference);
  325. var
  326. tempreg: tregister64;
  327. begin
  328. tempreg.reghi := cg.get_scratch_reg_int(list);
  329. tempreg.reglo := cg.get_scratch_reg_int(list);
  330. a_load64_ref_reg(list,ref,tempreg);
  331. a_op64_const_reg(list,op,value,tempreg);
  332. a_load64_reg_ref(list,tempreg,ref);
  333. cg.free_scratch_reg(list,tempreg.reglo);
  334. cg.free_scratch_reg(list,tempreg.reghi);
  335. end;
  336. procedure tcg64f32.a_param64_reg(list : taasmoutput;reg : tregister64;const locpara : tparalocation);
  337. begin
  338. {$warning FIX ME}
  339. cg.a_param_reg(list,OS_32,reg.reghi,locpara);
  340. { the nr+1 needs definitivly a fix FK }
  341. { maybe the parameter numbering needs }
  342. { to take care of this on 32 Bit }
  343. { systems FK }
  344. cg.a_param_reg(list,OS_32,reg.reglo,locpara);
  345. end;
  346. procedure tcg64f32.a_param64_const(list : taasmoutput;value : qword;const locpara : tparalocation);
  347. begin
  348. {$warning FIX ME}
  349. if target_info.endian = endian_big then
  350. swap_qword(value);
  351. cg.a_param_const(list,OS_32,hi(value),locpara);
  352. { the nr+1 needs definitivly a fix FK }
  353. { maybe the parameter numbering needs }
  354. { to take care of this on 32 Bit }
  355. { systems FK }
  356. cg.a_param_const(list,OS_32,lo(value),locpara);
  357. end;
  358. procedure tcg64f32.a_param64_ref(list : taasmoutput;const r : treference;const locpara : tparalocation);
  359. var
  360. tmpref: treference;
  361. begin
  362. {$warning FIX ME}
  363. tmpref := r;
  364. inc(tmpref.offset,4);
  365. cg.a_param_ref(list,OS_32,tmpref,locpara);
  366. { the nr+1 needs definitivly a fix FK }
  367. { maybe the parameter numbering needs }
  368. { to take care of this on 32 Bit }
  369. { systems FK }
  370. cg.a_param_ref(list,OS_32,r,locpara);
  371. end;
  372. procedure tcg64f32.a_param64_loc(list : taasmoutput;const l:tlocation;const locpara : tparalocation);
  373. begin
  374. {$warning FIX ME}
  375. case l.loc of
  376. LOC_REGISTER,
  377. LOC_CREGISTER :
  378. a_param64_reg(list,l.register64,locpara);
  379. LOC_CONSTANT :
  380. a_param64_const(list,l.valueqword,locpara);
  381. LOC_CREFERENCE,
  382. LOC_REFERENCE :
  383. a_param64_ref(list,l.reference,locpara);
  384. else
  385. internalerror(200203287);
  386. end;
  387. end;
  388. procedure tcg64f32.g_rangecheck64(list : taasmoutput;const p : tnode;const todef : tdef);
  389. var
  390. neglabel,
  391. poslabel,
  392. endlabel: tasmlabel;
  393. hreg : tregister;
  394. hdef : torddef;
  395. fromdef : tdef;
  396. opsize : tcgsize;
  397. oldregisterdef: boolean;
  398. from_signed,to_signed: boolean;
  399. got_scratch: boolean;
  400. begin
  401. fromdef:=p.resulttype.def;
  402. from_signed := is_signed(fromdef);
  403. to_signed := is_signed(todef);
  404. if not is_64bitint(todef) then
  405. begin
  406. oldregisterdef := registerdef;
  407. registerdef := false;
  408. { get the high dword in a register }
  409. if p.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
  410. begin
  411. hreg := p.location.registerhigh;
  412. got_scratch := false
  413. end
  414. else
  415. begin
  416. hreg := cg.get_scratch_reg_int(list);
  417. got_scratch := true;
  418. a_load64high_ref_reg(list,p.location.reference,hreg);
  419. end;
  420. objectlibrary.getlabel(poslabel);
  421. { check high dword, must be 0 (for positive numbers) }
  422. cg.a_cmp_const_reg_label(list,OS_32,OC_EQ,0,hreg,poslabel);
  423. { It can also be $ffffffff, but only for negative numbers }
  424. if from_signed and to_signed then
  425. begin
  426. objectlibrary.getlabel(neglabel);
  427. cg.a_cmp_const_reg_label(list,OS_32,OC_EQ,aword(-1),hreg,neglabel);
  428. end;
  429. { !!! freeing of register should happen directly after compare! (JM) }
  430. if got_scratch then
  431. cg.free_scratch_reg(list,hreg);
  432. { For all other values we have a range check error }
  433. cg.a_call_name(list,'FPC_RANGEERROR');
  434. { if the high dword = 0, the low dword can be considered a }
  435. { simple cardinal }
  436. cg.a_label(list,poslabel);
  437. hdef:=torddef.create(u32bit,0,cardinal($ffffffff));
  438. { the real p.resulttype.def is already saved in fromdef }
  439. p.resulttype.def := hdef;
  440. { no use in calling just "g_rangecheck" since that one will }
  441. { simply call the inherited method too (JM) }
  442. cg.g_rangecheck(list,p,todef);
  443. hdef.free;
  444. { restore original resulttype.def }
  445. p.resulttype.def := todef;
  446. if from_signed and to_signed then
  447. begin
  448. objectlibrary.getlabel(endlabel);
  449. cg.a_jmp_always(list,endlabel);
  450. { if the high dword = $ffffffff, then the low dword (when }
  451. { considered as a longint) must be < 0 }
  452. cg.a_label(list,neglabel);
  453. if p.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
  454. begin
  455. hreg := p.location.registerlow;
  456. got_scratch := false
  457. end
  458. else
  459. begin
  460. hreg := cg.get_scratch_reg_int(list);
  461. got_scratch := true;
  462. a_load64low_ref_reg(list,p.location.reference,hreg);
  463. end;
  464. { get a new neglabel (JM) }
  465. objectlibrary.getlabel(neglabel);
  466. cg.a_cmp_const_reg_label(list,OS_32,OC_LT,0,hreg,neglabel);
  467. { !!! freeing of register should happen directly after compare! (JM) }
  468. if got_scratch then
  469. cg.free_scratch_reg(list,hreg);
  470. cg.a_call_name(list,'FPC_RANGEERROR');
  471. { if we get here, the 64bit value lies between }
  472. { longint($80000000) and -1 (JM) }
  473. cg.a_label(list,neglabel);
  474. hdef:=torddef.create(s32bit,longint($80000000),-1);
  475. p.resulttype.def := hdef;
  476. cg.g_rangecheck(list,p,todef);
  477. hdef.free;
  478. cg.a_label(list,endlabel);
  479. end;
  480. registerdef := oldregisterdef;
  481. p.resulttype.def := fromdef;
  482. { restore p's resulttype.def }
  483. end
  484. else
  485. { todef = 64bit int }
  486. { no 64bit subranges supported, so only a small check is necessary }
  487. { if both are signed or both are unsigned, no problem! }
  488. if (from_signed xor to_signed) and
  489. { also not if the fromdef is unsigned and < 64bit, since that will }
  490. { always fit in a 64bit int (todef is 64bit) }
  491. (from_signed or
  492. (torddef(fromdef).typ = u64bit)) then
  493. begin
  494. { in all cases, there is only a problem if the higest bit is set }
  495. if p.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
  496. begin
  497. if is_64bitint(fromdef) then
  498. begin
  499. hreg := p.location.registerhigh;
  500. opsize := OS_32;
  501. end
  502. else
  503. begin
  504. hreg := p.location.register;
  505. opsize := def_cgsize(p.resulttype.def);
  506. end;
  507. got_scratch := false;
  508. end
  509. else
  510. begin
  511. hreg := cg.get_scratch_reg_int(list);
  512. got_scratch := true;
  513. opsize := def_cgsize(p.resulttype.def);
  514. if opsize in [OS_64,OS_S64] then
  515. a_load64high_ref_reg(list,p.location.reference,hreg)
  516. else
  517. cg.a_load_ref_reg(list,opsize,p.location.reference,hreg);
  518. end;
  519. objectlibrary.getlabel(poslabel);
  520. cg.a_cmp_const_reg_label(list,opsize,OC_GTE,0,hreg,poslabel);
  521. { !!! freeing of register should happen directly after compare! (JM) }
  522. if got_scratch then
  523. cg.free_scratch_reg(list,hreg);
  524. cg.a_call_name(list,'FPC_RANGEERROR');
  525. cg.a_label(list,poslabel);
  526. end;
  527. end;
  528. (*
  529. procedure int64f32_assignment_int64_reg(p : passignmentnode);
  530. begin
  531. end;
  532. begin
  533. p2_assignment:=@int64f32_assignement_int64;
  534. *)
  535. end.
  536. {
  537. $Log$
  538. Revision 1.24 2002-08-11 14:32:26 peter
  539. * renamed current_library to objectlibrary
  540. Revision 1.23 2002/08/11 13:24:11 peter
  541. * saving of asmsymbols in ppu supported
  542. * asmsymbollist global is removed and moved into a new class
  543. tasmlibrarydata that will hold the info of a .a file which
  544. corresponds with a single module. Added librarydata to tmodule
  545. to keep the library info stored for the module. In the future the
  546. objectfiles will also be stored to the tasmlibrarydata class
  547. * all getlabel/newasmsymbol and friends are moved to the new class
  548. Revision 1.22 2002/07/28 15:57:15 jonas
  549. * fixed a_load64_const_reg() for big endian systems
  550. Revision 1.21 2002/07/20 11:57:52 florian
  551. * types.pas renamed to defbase.pas because D6 contains a types
  552. unit so this would conflicts if D6 programms are compiled
  553. + Willamette/SSE2 instructions to assembler added
  554. Revision 1.20 2002/07/12 10:14:26 jonas
  555. * some big-endian fixes
  556. Revision 1.19 2002/07/11 07:23:17 jonas
  557. + generic implementations of a_op64_ref_reg() and a_op64_const_ref()
  558. (only works for processors with >2 scratch registers)
  559. Revision 1.18 2002/07/10 11:12:44 jonas
  560. * fixed a_op64_const_loc()
  561. Revision 1.17 2002/07/07 09:52:32 florian
  562. * powerpc target fixed, very simple units can be compiled
  563. * some basic stuff for better callparanode handling, far from being finished
  564. Revision 1.16 2002/07/01 18:46:21 peter
  565. * internal linker
  566. * reorganized aasm layer
  567. Revision 1.15 2002/07/01 16:23:52 peter
  568. * cg64 patch
  569. * basics for currency
  570. * asnode updates for class and interface (not finished)
  571. Revision 1.14 2002/05/20 13:30:40 carl
  572. * bugfix of hdisponen (base must be set, not index)
  573. * more portability fixes
  574. Revision 1.13 2002/05/18 13:34:05 peter
  575. * readded missing revisions
  576. Revision 1.12 2002/05/16 19:46:35 carl
  577. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  578. + try to fix temp allocation (still in ifdef)
  579. + generic constructor calls
  580. + start of tassembler / tmodulebase class cleanup
  581. Revision 1.10 2002/05/12 16:53:04 peter
  582. * moved entry and exitcode to ncgutil and cgobj
  583. * foreach gets extra argument for passing local data to the
  584. iterator function
  585. * -CR checks also class typecasts at runtime by changing them
  586. into as
  587. * fixed compiler to cycle with the -CR option
  588. * fixed stabs with elf writer, finally the global variables can
  589. be watched
  590. * removed a lot of routines from cga unit and replaced them by
  591. calls to cgobj
  592. * u32bit-s32bit updates for and,or,xor nodes. When one element is
  593. u32bit then the other is typecasted also to u32bit without giving
  594. a rangecheck warning/error.
  595. * fixed pascal calling method with reversing also the high tree in
  596. the parast, detected by tcalcst3 test
  597. Revision 1.9 2002/04/25 20:16:38 peter
  598. * moved more routines from cga/n386util
  599. Revision 1.8 2002/04/21 15:28:51 carl
  600. * a_jmp_cond -> a_jmp_always
  601. Revision 1.7 2002/04/07 13:21:18 carl
  602. + more documentation
  603. Revision 1.6 2002/04/03 10:41:35 jonas
  604. + a_load64_const_loc method
  605. Revision 1.5 2002/04/02 17:11:27 peter
  606. * tlocation,treference update
  607. * LOC_CONSTANT added for better constant handling
  608. * secondadd splitted in multiple routines
  609. * location_force_reg added for loading a location to a register
  610. of a specified size
  611. * secondassignment parses now first the right and then the left node
  612. (this is compatible with Kylix). This saves a lot of push/pop especially
  613. with string operations
  614. * adapted some routines to use the new cg methods
  615. Revision 1.4 2002/03/04 19:10:11 peter
  616. * removed compiler warnings
  617. Revision 1.3 2002/01/24 12:33:52 jonas
  618. * adapted ranges of native types to int64 (e.g. high cardinal is no
  619. longer longint($ffffffff), but just $fffffff in psystem)
  620. * small additional fix in 64bit rangecheck code generation for 32 bit
  621. processors
  622. * adaption of ranges required the matching talgorithm used for selecting
  623. which overloaded procedure to call to be adapted. It should now always
  624. select the closest match for ordinal parameters.
  625. + inttostr(qword) in sysstr.inc/sysstrh.inc
  626. + abs(int64), sqr(int64), sqr(qword) in systemh.inc/generic.inc (previous
  627. fixes were required to be able to add them)
  628. * is_in_limit() moved from ncal to types unit, should always be used
  629. instead of direct comparisons of low/high values of orddefs because
  630. qword is a special case
  631. }