cg64f32.pas 26 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731
  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. current_library.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. current_library.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. current_library.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. current_library.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. current_library.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.23 2002-08-11 13:24:11 peter
  539. * saving of asmsymbols in ppu supported
  540. * asmsymbollist global is removed and moved into a new class
  541. tasmlibrarydata that will hold the info of a .a file which
  542. corresponds with a single module. Added librarydata to tmodule
  543. to keep the library info stored for the module. In the future the
  544. objectfiles will also be stored to the tasmlibrarydata class
  545. * all getlabel/newasmsymbol and friends are moved to the new class
  546. Revision 1.22 2002/07/28 15:57:15 jonas
  547. * fixed a_load64_const_reg() for big endian systems
  548. Revision 1.21 2002/07/20 11:57:52 florian
  549. * types.pas renamed to defbase.pas because D6 contains a types
  550. unit so this would conflicts if D6 programms are compiled
  551. + Willamette/SSE2 instructions to assembler added
  552. Revision 1.20 2002/07/12 10:14:26 jonas
  553. * some big-endian fixes
  554. Revision 1.19 2002/07/11 07:23:17 jonas
  555. + generic implementations of a_op64_ref_reg() and a_op64_const_ref()
  556. (only works for processors with >2 scratch registers)
  557. Revision 1.18 2002/07/10 11:12:44 jonas
  558. * fixed a_op64_const_loc()
  559. Revision 1.17 2002/07/07 09:52:32 florian
  560. * powerpc target fixed, very simple units can be compiled
  561. * some basic stuff for better callparanode handling, far from being finished
  562. Revision 1.16 2002/07/01 18:46:21 peter
  563. * internal linker
  564. * reorganized aasm layer
  565. Revision 1.15 2002/07/01 16:23:52 peter
  566. * cg64 patch
  567. * basics for currency
  568. * asnode updates for class and interface (not finished)
  569. Revision 1.14 2002/05/20 13:30:40 carl
  570. * bugfix of hdisponen (base must be set, not index)
  571. * more portability fixes
  572. Revision 1.13 2002/05/18 13:34:05 peter
  573. * readded missing revisions
  574. Revision 1.12 2002/05/16 19:46:35 carl
  575. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  576. + try to fix temp allocation (still in ifdef)
  577. + generic constructor calls
  578. + start of tassembler / tmodulebase class cleanup
  579. Revision 1.10 2002/05/12 16:53:04 peter
  580. * moved entry and exitcode to ncgutil and cgobj
  581. * foreach gets extra argument for passing local data to the
  582. iterator function
  583. * -CR checks also class typecasts at runtime by changing them
  584. into as
  585. * fixed compiler to cycle with the -CR option
  586. * fixed stabs with elf writer, finally the global variables can
  587. be watched
  588. * removed a lot of routines from cga unit and replaced them by
  589. calls to cgobj
  590. * u32bit-s32bit updates for and,or,xor nodes. When one element is
  591. u32bit then the other is typecasted also to u32bit without giving
  592. a rangecheck warning/error.
  593. * fixed pascal calling method with reversing also the high tree in
  594. the parast, detected by tcalcst3 test
  595. Revision 1.9 2002/04/25 20:16:38 peter
  596. * moved more routines from cga/n386util
  597. Revision 1.8 2002/04/21 15:28:51 carl
  598. * a_jmp_cond -> a_jmp_always
  599. Revision 1.7 2002/04/07 13:21:18 carl
  600. + more documentation
  601. Revision 1.6 2002/04/03 10:41:35 jonas
  602. + a_load64_const_loc method
  603. Revision 1.5 2002/04/02 17:11:27 peter
  604. * tlocation,treference update
  605. * LOC_CONSTANT added for better constant handling
  606. * secondadd splitted in multiple routines
  607. * location_force_reg added for loading a location to a register
  608. of a specified size
  609. * secondassignment parses now first the right and then the left node
  610. (this is compatible with Kylix). This saves a lot of push/pop especially
  611. with string operations
  612. * adapted some routines to use the new cg methods
  613. Revision 1.4 2002/03/04 19:10:11 peter
  614. * removed compiler warnings
  615. Revision 1.3 2002/01/24 12:33:52 jonas
  616. * adapted ranges of native types to int64 (e.g. high cardinal is no
  617. longer longint($ffffffff), but just $fffffff in psystem)
  618. * small additional fix in 64bit rangecheck code generation for 32 bit
  619. processors
  620. * adaption of ranges required the matching talgorithm used for selecting
  621. which overloaded procedure to call to be adapted. It should now always
  622. select the closest match for ordinal parameters.
  623. + inttostr(qword) in sysstr.inc/sysstrh.inc
  624. + abs(int64), sqr(int64), sqr(qword) in systemh.inc/generic.inc (previous
  625. fixes were required to be able to add them)
  626. * is_in_limit() moved from ncal to types unit, should always be used
  627. instead of direct comparisons of low/high values of orddefs because
  628. qword is a special case
  629. }