cg64f32.pas 26 KB

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