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. 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. 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. 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. 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. 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. 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.22 2002-07-28 15:57:15 jonas
  539. * fixed a_load64_const_reg() for big endian systems
  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. }