nppccnv.pas 13 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344
  1. {
  2. Copyright (c) 1998-2002 by Florian Klaempfl
  3. Generate PowerPC assembler for type converting nodes
  4. This program is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 2 of the License, or
  7. (at your option) any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software
  14. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  15. ****************************************************************************
  16. }
  17. unit nppccnv;
  18. {$i fpcdefs.inc}
  19. interface
  20. uses
  21. node,ncnv,ncgcnv,defcmp;
  22. type
  23. tppctypeconvnode = class(tcgtypeconvnode)
  24. protected
  25. { procedure second_int_to_int;override; }
  26. { procedure second_string_to_string;override; }
  27. { procedure second_cstring_to_pchar;override; }
  28. { procedure second_string_to_chararray;override; }
  29. { procedure second_array_to_pointer;override; }
  30. function first_int_to_real: tnode; override;
  31. { procedure second_pointer_to_array;override; }
  32. { procedure second_chararray_to_string;override; }
  33. { procedure second_char_to_string;override; }
  34. procedure second_int_to_real;override;
  35. procedure second_real_to_real;override;
  36. { procedure second_cord_to_pointer;override; }
  37. { procedure second_proc_to_procvar;override; }
  38. { procedure second_bool_to_int;override; }
  39. procedure second_int_to_bool;override;
  40. { procedure second_load_smallset;override; }
  41. { procedure second_ansistring_to_pchar;override; }
  42. { procedure second_pchar_to_string;override; }
  43. { procedure second_class_to_intf;override; }
  44. { procedure second_char_to_char;override; }
  45. end;
  46. implementation
  47. uses
  48. verbose,globtype,globals,systems,
  49. symconst,symdef,aasmbase,aasmtai,
  50. defutil,
  51. cgbase,cgutils,pass_1,pass_2,
  52. ncon,ncal,
  53. ncgutil,
  54. cpubase,aasmcpu,
  55. rgobj,tgobj,cgobj;
  56. {*****************************************************************************
  57. FirstTypeConv
  58. *****************************************************************************}
  59. function tppctypeconvnode.first_int_to_real: tnode;
  60. var
  61. fname: string[19];
  62. begin
  63. { converting a 64bit integer to a float requires a helper }
  64. if is_64bitint(left.resulttype.def) or
  65. is_currency(left.resulttype.def) then
  66. begin
  67. { hack to avoid double division by 10000, as it's }
  68. { already done by resulttypepass.resulttype_int_to_real }
  69. if is_currency(left.resulttype.def) then
  70. left.resulttype := s64inttype;
  71. if is_signed(left.resulttype.def) then
  72. fname := 'fpc_int64_to_double'
  73. else
  74. fname := 'fpc_qword_to_double';
  75. result := ccallnode.createintern(fname,ccallparanode.create(
  76. left,nil));
  77. left:=nil;
  78. firstpass(result);
  79. exit;
  80. end
  81. else
  82. { other integers are supposed to be 32 bit }
  83. begin
  84. if is_signed(left.resulttype.def) then
  85. inserttypeconv(left,s32inttype)
  86. else
  87. inserttypeconv(left,u32inttype);
  88. firstpass(left);
  89. end;
  90. result := nil;
  91. if registersfpu<1 then
  92. registersfpu:=1;
  93. expectloc:=LOC_FPUREGISTER;
  94. end;
  95. {*****************************************************************************
  96. SecondTypeConv
  97. *****************************************************************************}
  98. procedure tppctypeconvnode.second_int_to_real;
  99. type
  100. tdummyarray = packed array[0..7] of byte;
  101. {$ifdef VER1_0}
  102. var
  103. dummy1, dummy2: int64;
  104. {$else VER1_0}
  105. const
  106. dummy1: int64 = $4330000080000000;
  107. dummy2: int64 = $4330000000000000;
  108. {$endif VER1_0}
  109. var
  110. tempconst: trealconstnode;
  111. ref: treference;
  112. valuereg, tempreg, leftreg, tmpfpureg: tregister;
  113. size: tcgsize;
  114. signed : boolean;
  115. begin
  116. {$ifdef VER1_0}
  117. dummy1 := (int64(1) shl 31) or (int64($43300000) shl 32);
  118. dummy2 := int64($43300000) shl 32;
  119. {$endif VER1_0}
  120. location_reset(location,LOC_FPUREGISTER,def_cgsize(resulttype.def));
  121. { the code here comes from the PowerPC Compiler Writer's Guide }
  122. { * longint to double }
  123. { addis R0,R0,0x4330 # R0 = 0x43300000 }
  124. { stw R0,disp(R1) # store upper half }
  125. { xoris R3,R3,0x8000 # flip sign bit }
  126. { stw R3,disp+4(R1) # store lower half }
  127. { lfd FR1,disp(R1) # float load double of value }
  128. { fsub FR1,FR1,FR2 # subtract 0x4330000080000000 }
  129. { * cardinal to double }
  130. { addis R0,R0,0x4330 # R0 = 0x43300000 }
  131. { stw R0,disp(R1) # store upper half }
  132. { stw R3,disp+4(R1) # store lower half }
  133. { lfd FR1,disp(R1) # float load double of value }
  134. { fsub FR1,FR1,FR2 # subtract 0x4330000000000000 }
  135. tg.Gettemp(exprasmlist,8,tt_normal,ref);
  136. signed := is_signed(left.resulttype.def);
  137. { we need a certain constant for the conversion, so create it here }
  138. if signed then
  139. tempconst :=
  140. crealconstnode.create(double(tdummyarray(dummy1)),
  141. pbestrealtype^)
  142. else
  143. tempconst :=
  144. crealconstnode.create(double(tdummyarray(dummy2)),
  145. pbestrealtype^);
  146. resulttypepass(tempconst);
  147. firstpass(tempconst);
  148. secondpass(tempconst);
  149. if (tempconst.location.loc <> LOC_CREFERENCE) or
  150. { has to be handled by a helper }
  151. is_64bitint(left.resulttype.def) then
  152. internalerror(200110011);
  153. case left.location.loc of
  154. LOC_REGISTER:
  155. begin
  156. leftreg := left.location.register;
  157. valuereg := leftreg;
  158. end;
  159. LOC_CREGISTER:
  160. begin
  161. leftreg := left.location.register;
  162. if signed then
  163. valuereg := cg.getintregister(exprasmlist,OS_INT)
  164. else
  165. valuereg := leftreg;
  166. end;
  167. LOC_REFERENCE,LOC_CREFERENCE:
  168. begin
  169. leftreg := cg.getintregister(exprasmlist,OS_INT);
  170. valuereg := leftreg;
  171. if signed then
  172. size := OS_S32
  173. else
  174. size := OS_32;
  175. cg.a_load_ref_reg(exprasmlist,def_cgsize(left.resulttype.def),
  176. size,left.location.reference,leftreg);
  177. end
  178. else
  179. internalerror(200110012);
  180. end;
  181. tempreg := cg.getintregister(exprasmlist,OS_INT);
  182. exprasmlist.concat(taicpu.op_reg_const(A_LIS,tempreg,$4330));
  183. cg.a_load_reg_ref(exprasmlist,OS_32,OS_32,tempreg,ref);
  184. if signed then
  185. exprasmlist.concat(taicpu.op_reg_reg_const(A_XORIS,valuereg,
  186. { xoris expects a unsigned 16 bit int (FK) }
  187. leftreg,$8000));
  188. inc(ref.offset,4);
  189. cg.a_load_reg_ref(exprasmlist,OS_32,OS_32,valuereg,ref);
  190. dec(ref.offset,4);
  191. tmpfpureg := cg.getfpuregister(exprasmlist,OS_F64);
  192. cg.a_loadfpu_ref_reg(exprasmlist,OS_F64,tempconst.location.reference,
  193. tmpfpureg);
  194. tempconst.free;
  195. location.register := cg.getfpuregister(exprasmlist,OS_F64);
  196. cg.a_loadfpu_ref_reg(exprasmlist,OS_F64,ref,location.register);
  197. tg.ungetiftemp(exprasmlist,ref);
  198. exprasmlist.concat(taicpu.op_reg_reg_reg(A_FSUB,location.register,
  199. location.register,tmpfpureg));
  200. { work around bug in some PowerPC processors }
  201. if (tfloatdef(resulttype.def).typ = s32real) then
  202. exprasmlist.concat(taicpu.op_reg_reg(A_FRSP,location.register,
  203. location.register));
  204. end;
  205. procedure tppctypeconvnode.second_real_to_real;
  206. begin
  207. inherited second_real_to_real;
  208. { work around bug in some powerpc processors where doubles aren't }
  209. { properly converted to singles }
  210. if (tfloatdef(left.resulttype.def).typ = s64real) and
  211. (tfloatdef(resulttype.def).typ = s32real) then
  212. exprasmlist.concat(taicpu.op_reg_reg(A_FRSP,location.register,
  213. location.register));
  214. end;
  215. procedure tppctypeconvnode.second_int_to_bool;
  216. var
  217. hreg1,
  218. hreg2 : tregister;
  219. href : treference;
  220. resflags : tresflags;
  221. opsize : tcgsize;
  222. hlabel, oldtruelabel, oldfalselabel : tasmlabel;
  223. begin
  224. oldtruelabel:=truelabel;
  225. oldfalselabel:=falselabel;
  226. objectlibrary.getlabel(truelabel);
  227. objectlibrary.getlabel(falselabel);
  228. secondpass(left);
  229. if codegenerror then
  230. exit;
  231. { byte(boolean) or word(wordbool) or longint(longbool) must }
  232. { be accepted for var parameters }
  233. if (nf_explicit in flags) and
  234. (left.resulttype.def.size=resulttype.def.size) and
  235. (left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then
  236. begin
  237. truelabel:=oldtruelabel;
  238. falselabel:=oldfalselabel;
  239. location_copy(location,left.location);
  240. exit;
  241. end;
  242. location_reset(location,LOC_REGISTER,def_cgsize(resulttype.def));
  243. opsize := def_cgsize(left.resulttype.def);
  244. case left.location.loc of
  245. LOC_CREFERENCE,LOC_REFERENCE,LOC_REGISTER,LOC_CREGISTER :
  246. begin
  247. if left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE] then
  248. begin
  249. hreg1:=cg.getintregister(exprasmlist,OS_INT);
  250. if left.location.size in [OS_64,OS_S64] then
  251. begin
  252. cg.a_load_ref_reg(exprasmlist,OS_INT,OS_INT,left.location.reference,hreg1);
  253. hreg2:=cg.getintregister(exprasmlist,OS_INT);
  254. href:=left.location.reference;
  255. inc(href.offset,4);
  256. cg.a_load_ref_reg(exprasmlist,OS_INT,OS_INT,href,hreg2);
  257. cg.a_op_reg_reg_reg(exprasmlist,OP_OR,OS_32,hreg1,hreg2,hreg1);
  258. end
  259. else
  260. cg.a_load_ref_reg(exprasmlist,opsize,opsize,left.location.reference,hreg1);
  261. end
  262. else
  263. begin
  264. if left.location.size in [OS_64,OS_S64] then
  265. begin
  266. hreg1:=cg.getintregister(exprasmlist,OS_32);
  267. cg.a_op_reg_reg_reg(exprasmlist,OP_OR,OS_32,left.location.register64.reghi,left.location.register64.reglo,hreg1);
  268. end
  269. else
  270. hreg1 := left.location.register;
  271. end;
  272. hreg2 := cg.getintregister(exprasmlist,OS_INT);
  273. exprasmlist.concat(taicpu.op_reg_reg_const(A_SUBIC,hreg2,hreg1,1));
  274. exprasmlist.concat(taicpu.op_reg_reg_reg(A_SUBFE,hreg1,hreg2,hreg1));
  275. end;
  276. LOC_FLAGS :
  277. begin
  278. hreg1:=cg.getintregister(exprasmlist,OS_INT);
  279. resflags:=left.location.resflags;
  280. cg.g_flags2reg(exprasmlist,location.size,resflags,hreg1);
  281. end;
  282. LOC_JUMP :
  283. begin
  284. hreg1:=cg.getintregister(exprasmlist,OS_INT);
  285. objectlibrary.getlabel(hlabel);
  286. cg.a_label(exprasmlist,truelabel);
  287. cg.a_load_const_reg(exprasmlist,OS_INT,1,hreg1);
  288. cg.a_jmp_always(exprasmlist,hlabel);
  289. cg.a_label(exprasmlist,falselabel);
  290. cg.a_load_const_reg(exprasmlist,OS_INT,0,hreg1);
  291. cg.a_label(exprasmlist,hlabel);
  292. end;
  293. else
  294. internalerror(10062);
  295. end;
  296. location.register := hreg1;
  297. truelabel:=oldtruelabel;
  298. falselabel:=oldfalselabel;
  299. end;
  300. begin
  301. ctypeconvnode:=tppctypeconvnode;
  302. end.