cg64f32.pas 26 KB

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