ncgcnv.pas 35 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836
  1. {
  2. Copyright (c) 2000-2002 by Florian Klaempfl
  3. Generate assembler for nodes that handle type conversions which are
  4. the same for all (most) processors
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. unit ncgcnv;
  19. {$i fpcdefs.inc}
  20. interface
  21. uses
  22. node,ncnv,defutil,defcmp;
  23. type
  24. { tcgtypeconvnode }
  25. tcgtypeconvnode = class(ttypeconvnode)
  26. protected
  27. {$ifdef cpuflags}
  28. { CPUs without flags need a specific implementation of int -> bool }
  29. procedure second_int_to_bool;override;
  30. {$endif cpuflags}
  31. procedure second_int_to_int;override;
  32. procedure second_cstring_to_pchar;override;
  33. procedure second_cstring_to_int;override;
  34. procedure second_string_to_chararray;override;
  35. procedure second_array_to_pointer;override;
  36. procedure second_pointer_to_array;override;
  37. procedure second_char_to_string;override;
  38. procedure second_real_to_real;override;
  39. procedure second_cord_to_pointer;override;
  40. procedure second_proc_to_procvar;override;
  41. procedure second_nil_to_methodprocvar;override;
  42. procedure second_bool_to_int;override;
  43. procedure second_bool_to_bool;override;
  44. procedure second_ansistring_to_pchar;override;
  45. procedure second_class_to_intf;override;
  46. procedure second_char_to_char;override;
  47. procedure second_elem_to_openarray;override;
  48. procedure second_nothing;override;
  49. public
  50. procedure pass_generate_code;override;
  51. end;
  52. tcgasnode = class(tasnode)
  53. procedure pass_generate_code;override;
  54. end;
  55. implementation
  56. uses
  57. cutils,verbose,globtype,globals,
  58. aasmbase,aasmtai,aasmdata,aasmcpu,symconst,symdef,paramgr,
  59. nutils,ncon,ncal,
  60. cpubase,systems,
  61. procinfo,pass_2,
  62. cgbase,
  63. cgutils,cgobj,hlcgobj,
  64. ncgutil,
  65. tgobj
  66. ;
  67. procedure tcgtypeconvnode.second_int_to_int;
  68. var
  69. orgsize,
  70. newsize : tcgsize;
  71. ressize,
  72. leftsize : longint;
  73. begin
  74. newsize:=def_cgsize(resultdef);
  75. { insert range check if not explicit conversion }
  76. if not(nf_explicit in flags) then
  77. hlcg.g_rangecheck(current_asmdata.CurrAsmList,left.location,left.resultdef,resultdef);
  78. { is the result size smaller? when typecasting from void
  79. we always reuse the current location, because there is
  80. nothing that we can load in a register }
  81. ressize := resultdef.size;
  82. leftsize := left.resultdef.size;
  83. if ((ressize<>leftsize) or
  84. is_bitpacked_access(left)) and
  85. not is_void(left.resultdef) then
  86. begin
  87. location_copy(location,left.location);
  88. { reuse a loc_reference when the newsize is smaller than
  89. than the original, else load it to a register }
  90. if (location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) and
  91. (ressize<leftsize) then
  92. begin
  93. hlcg.g_ptrtypecast_ref(current_asmdata.CurrAsmList,cpointerdef.getreusable(left.resultdef),cpointerdef.getreusable(resultdef),location.reference);
  94. location.size:=newsize;
  95. if (target_info.endian = ENDIAN_BIG) then
  96. begin
  97. inc(location.reference.offset,leftsize-ressize);
  98. location.reference.alignment:=newalignment(location.reference.alignment,leftsize-ressize);
  99. end;
  100. end
  101. {$if not defined(cpu16bitalu) and not defined(cpu8bitalu) and not defined(m68k) and not defined(cpuhighleveltarget)}
  102. { FIXME: reg_cgsize incorrectly identifies m68k as "without subregisters" }
  103. { On targets without 8/16 bit register components, 8/16-bit operations
  104. always adjust high bits of result, see 'maybeadjustresult' method in
  105. respective cgcpu.pas. Therefore 8/16-bit locations are valid as larger
  106. ones (except signed->unsigned, which still needs high bits cleared). }
  107. else if (left.location.loc in [LOC_REGISTER,LOC_CREGISTER]) and
  108. (tcgsize2size[(reg_cgsize(left.location.register))]=sizeof(aint)) and
  109. (ressize>leftsize) and
  110. (newsize in [OS_32,OS_S32,OS_16,OS_S16]) and
  111. (not is_signed(left.resultdef) or is_signed(resultdef)) then
  112. location.size:=newsize
  113. {$endif}
  114. else
  115. hlcg.location_force_reg(current_asmdata.CurrAsmList,location,left.resultdef,resultdef,false);
  116. end
  117. else
  118. begin
  119. { no special loading is required, reuse current location }
  120. { that's not true, if you go from signed to unsiged or }
  121. { vice versa, you need sign extension/removal if the }
  122. { value is already in a register (at least for archs }
  123. { which don't have 8bit register components etc) (JM) }
  124. location_copy(location,left.location);
  125. location.size:=newsize;
  126. orgsize := def_cgsize(left.resultdef);
  127. if (ressize < sizeof(aint)) and
  128. (location.loc in [LOC_REGISTER,LOC_CREGISTER]) and
  129. (orgsize <> newsize) then
  130. begin
  131. location.register := cg.getintregister(current_asmdata.CurrAsmList,newsize);
  132. location.loc := LOC_REGISTER;
  133. hlcg.a_load_reg_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,left.location.register,location.register);
  134. end
  135. else if location.loc in [LOC_REFERENCE,LOC_CREFERENCE] then
  136. hlcg.g_ptrtypecast_ref(current_asmdata.CurrAsmList,cpointerdef.getreusable(left.resultdef),cpointerdef.getreusable(resultdef),location.reference)
  137. {$ifdef cpuhighleveltarget}
  138. { high level targets require the types to be correct in all cases }
  139. else if left.resultdef<>resultdef then
  140. hlcg.location_force_reg(current_asmdata.CurrAsmList,location,left.resultdef,resultdef,false);
  141. {$endif cpuhighleveltarget}
  142. end;
  143. end;
  144. {$ifdef cpuflags}
  145. procedure tcgtypeconvnode.second_int_to_bool;
  146. var
  147. hregister : tregister;
  148. href : treference;
  149. resflags : tresflags;
  150. hlabel : tasmlabel;
  151. newsize : tcgsize;
  152. begin
  153. secondpass(left);
  154. if codegenerror then
  155. exit;
  156. { Explicit typecasts from any ordinal type to a boolean type }
  157. { must not change the ordinal value }
  158. if (nf_explicit in flags) and
  159. not(left.location.loc in [LOC_FLAGS,LOC_JUMP]) then
  160. begin
  161. { overriding methods must be able to know in advance whether this
  162. code path will be taken by checking expectloc, so they can call
  163. the inherited method in that case }
  164. if left.expectloc in [LOC_FLAGS,LOC_JUMP] then
  165. internalerror(2014122901);
  166. location_copy(location,left.location);
  167. newsize:=def_cgsize(resultdef);
  168. { change of size? change sign only if location is LOC_(C)REGISTER? Then we have to sign/zero-extend }
  169. if (tcgsize2size[newsize]<>tcgsize2size[left.location.size]) or
  170. ((newsize<>left.location.size) and (location.loc in [LOC_REGISTER,LOC_CREGISTER])) then
  171. hlcg.location_force_reg(current_asmdata.CurrAsmList,location,left.resultdef,resultdef,true)
  172. else
  173. location.size:=newsize;
  174. exit;
  175. end;
  176. { though ppc/ppc64 doesn't use the generic code, we need to ifdef here
  177. because the code is included into the powerpc compilers }
  178. {$if defined(POWERPC) or defined(POWERPC64)}
  179. resflags.cr := RS_CR0;
  180. resflags.flag:=F_NE;
  181. {$elseif defined(mips)}
  182. resflags.reg1:=NR_NO;
  183. resflags.reg2:=NR_NO;
  184. resflags.cond:=OC_NONE;
  185. {$else}
  186. { Load left node into flag F_NE/F_E }
  187. resflags:=F_NE;
  188. {$endif defined(POWERPC) or defined(POWERPC64)}
  189. case left.location.loc of
  190. LOC_CREFERENCE,
  191. LOC_REFERENCE :
  192. begin
  193. if left.location.size in [OS_64,OS_S64] then
  194. begin
  195. hregister:=cg.getintregister(current_asmdata.CurrAsmList,OS_32);
  196. cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_32,OS_32,left.location.reference,hregister);
  197. href:=left.location.reference;
  198. inc(href.offset,4);
  199. cg.a_op_ref_reg(current_asmdata.CurrAsmList,OP_OR,OS_32,href,hregister);
  200. end
  201. else
  202. begin
  203. hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,true);
  204. cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_OR,left.location.size,left.location.register,left.location.register);
  205. end;
  206. end;
  207. LOC_FLAGS :
  208. begin
  209. resflags:=left.location.resflags;
  210. end;
  211. LOC_REGISTER,LOC_CREGISTER :
  212. begin
  213. {$ifndef cpu64bitalu}
  214. if left.location.size in [OS_64,OS_S64] then
  215. begin
  216. hregister:=cg.getintregister(current_asmdata.CurrAsmList,OS_32);
  217. cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_32,OS_32,left.location.register64.reglo,hregister);
  218. cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_OR,OS_32,left.location.register64.reghi,hregister);
  219. end
  220. else
  221. {$endif cpu64bitalu}
  222. begin
  223. cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_OR,left.location.size,left.location.register,left.location.register);
  224. end;
  225. end;
  226. LOC_JUMP :
  227. begin
  228. hregister:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
  229. current_asmdata.getjumplabel(hlabel);
  230. cg.a_label(current_asmdata.CurrAsmList,left.location.truelabel);
  231. cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT,1,hregister);
  232. cg.a_jmp_always(current_asmdata.CurrAsmList,hlabel);
  233. cg.a_label(current_asmdata.CurrAsmList,left.location.falselabel);
  234. cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT,0,hregister);
  235. cg.a_label(current_asmdata.CurrAsmList,hlabel);
  236. cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_OR,OS_INT,hregister,hregister);
  237. end;
  238. else
  239. internalerror(200311301);
  240. end;
  241. { load flags to register }
  242. location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
  243. location.register:=cg.getintregister(current_asmdata.CurrAsmList,location.size);
  244. cg.g_flags2reg(current_asmdata.CurrAsmList,location.size,resflags,location.register);
  245. cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_DEFAULTFLAGS);
  246. if (is_cbool(resultdef)) then
  247. cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_NEG,location.size,location.register,location.register);
  248. end;
  249. {$endif cpuflags}
  250. procedure tcgtypeconvnode.second_cstring_to_pchar;
  251. var
  252. hr : treference;
  253. begin
  254. if left.nodetype<>stringconstn then
  255. internalerror(200601131);
  256. if not is_pchar(resultdef) and not is_pwidechar(resultdef) then
  257. internalerror(2014032802);
  258. location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
  259. case tstringconstnode(left).cst_type of
  260. cst_conststring :
  261. begin
  262. location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,resultdef);
  263. hlcg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,left.location.reference,location.register);
  264. end;
  265. cst_shortstring :
  266. begin
  267. inc(left.location.reference.offset);
  268. location.reference.alignment:=1;
  269. location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,resultdef);
  270. hlcg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,left.location.reference,location.register);
  271. end;
  272. cst_widestring,
  273. cst_unicodestring,
  274. cst_ansistring :
  275. begin
  276. if tstringconstnode(left).len=0 then
  277. begin
  278. { FPC_EMPTYCHAR is a widechar -> 2 bytes }
  279. reference_reset(hr,2);
  280. hr.symbol:=current_asmdata.RefAsmSymbol('FPC_EMPTYCHAR',AT_DATA);
  281. location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,resultdef);
  282. hlcg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,cwidechartype,resultdef,hr,location.register);
  283. end
  284. else
  285. begin
  286. location_copy(location,left.location);
  287. end;
  288. end;
  289. cst_longstring:
  290. begin
  291. {!!!!!!!}
  292. internalerror(8888);
  293. end;
  294. else
  295. internalerror(200808241);
  296. end;
  297. end;
  298. procedure tcgtypeconvnode.second_cstring_to_int;
  299. begin
  300. { this can't happen because constants are already processed in
  301. pass 1 }
  302. internalerror(200510013);
  303. end;
  304. procedure tcgtypeconvnode.second_string_to_chararray;
  305. begin
  306. if is_chararray(left.resultdef) then
  307. begin
  308. location_copy(location,left.location);
  309. exit;
  310. end;
  311. { should be handled already in resultdef pass (JM) }
  312. internalerror(200108292);
  313. end;
  314. procedure tcgtypeconvnode.second_array_to_pointer;
  315. begin
  316. location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
  317. location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,resultdef);
  318. hlcg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,left.location.reference,location.register);
  319. end;
  320. procedure tcgtypeconvnode.second_pointer_to_array;
  321. begin
  322. { assume natural alignment }
  323. location_reset_ref(location,LOC_REFERENCE,OS_NO,resultdef.alignment);
  324. case left.location.loc of
  325. LOC_CREGISTER,
  326. LOC_REGISTER :
  327. begin
  328. {$ifdef cpu_uses_separate_address_registers}
  329. if getregtype(left.location.register)<>R_ADDRESSREGISTER then
  330. begin
  331. location.reference.base:=cg.getaddressregister(current_asmdata.CurrAsmList);
  332. cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,
  333. left.location.register,location.reference.base);
  334. end
  335. else
  336. {$endif}
  337. hlcg.reference_reset_base(location.reference,left.resultdef,left.location.register,0,location.reference.alignment);
  338. end;
  339. LOC_REFERENCE,
  340. LOC_CREFERENCE,
  341. { tricky type casting of parameters can cause these locations, see tb0593.pp on x86_64-linux }
  342. LOC_SUBSETREG,
  343. LOC_CSUBSETREG,
  344. LOC_SUBSETREF,
  345. LOC_CSUBSETREF:
  346. begin
  347. hlcg.reference_reset_base(location.reference,left.resultdef,
  348. hlcg.getaddressregister(current_asmdata.CurrAsmList,left.resultdef),0,location.reference.alignment);
  349. hlcg.a_load_loc_reg(current_asmdata.CurrAsmList,left.resultdef,left.resultdef,left.location,
  350. location.reference.base);
  351. if left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE] then
  352. location_freetemp(current_asmdata.CurrAsmList,left.location);
  353. end;
  354. LOC_CONSTANT:
  355. begin
  356. location.reference.offset:=left.location.value;
  357. end
  358. else
  359. internalerror(2002032216);
  360. end;
  361. end;
  362. procedure tcgtypeconvnode.second_char_to_string;
  363. var
  364. tmpref: treference;
  365. begin
  366. location_reset_ref(location,LOC_REFERENCE,OS_NO,2);
  367. case tstringdef(resultdef).stringtype of
  368. st_shortstring :
  369. begin
  370. tg.gethltemp(current_asmdata.CurrAsmList,cshortstringtype,256,tt_normal,location.reference);
  371. tmpref:=location.reference;
  372. hlcg.g_ptrtypecast_ref(current_asmdata.CurrAsmList,
  373. cpointerdef.getreusable(cshortstringtype),
  374. cpointerdef.getreusable(left.resultdef),tmpref);
  375. hlcg.a_load_loc_ref(current_asmdata.CurrAsmList,left.resultdef,left.resultdef,left.location,
  376. tmpref);
  377. location_freetemp(current_asmdata.CurrAsmList,left.location);
  378. end;
  379. { the rest is removed in the resultdef pass and converted to compilerprocs }
  380. else
  381. internalerror(4179);
  382. end;
  383. end;
  384. procedure tcgtypeconvnode.second_real_to_real;
  385. {$ifdef x86}
  386. var
  387. tr: treference;
  388. {$endif x86}
  389. begin
  390. location_reset(location,expectloc,def_cgsize(resultdef));
  391. {$ifdef x86}
  392. { extended types in memory which should be loaded into the sse unit
  393. must be converted by the fpu first, so force them to be loaded into
  394. the fpu }
  395. if (expectloc=LOC_MMREGISTER) and
  396. (left.location.size in [OS_F80,OS_C64]) then
  397. begin
  398. if (left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) then
  399. hlcg.location_force_fpureg(current_asmdata.CurrAsmList,left.location,left.resultdef,false);
  400. { round them down to the proper precision }
  401. tg.gethltemp(current_asmdata.currasmlist,resultdef,resultdef.size,tt_normal,tr);
  402. hlcg.a_loadfpu_reg_ref(current_asmdata.CurrAsmList,left.resultdef,resultdef,left.location.register,tr);
  403. location_reset_ref(left.location,LOC_REFERENCE,location.size,tr.alignment);
  404. left.location.reference:=tr;
  405. left.resultdef:=resultdef;
  406. end;
  407. {$endif x86}
  408. { ARM VFP values are in integer registers when they are function results }
  409. if (left.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
  410. hlcg.location_force_mmregscalar(current_asmdata.CurrAsmList,left.location,left.resultdef,false);
  411. case left.location.loc of
  412. LOC_FPUREGISTER,
  413. LOC_CFPUREGISTER:
  414. begin
  415. case expectloc of
  416. LOC_FPUREGISTER:
  417. begin
  418. { on sparc a move from double -> single means from two to one register. }
  419. { On all other platforms it also needs rounding to avoid that }
  420. { single(double_regvar) = double_regvar is true in all cases }
  421. location.register:=hlcg.getfpuregister(current_asmdata.CurrAsmList,resultdef);
  422. hlcg.a_loadfpu_reg_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,left.location.register,location.register);
  423. end;
  424. LOC_MMREGISTER:
  425. begin
  426. hlcg.location_force_mmregscalar(current_asmdata.CurrAsmList,left.location,left.resultdef,false);
  427. location.register:=cg.getmmregister(current_asmdata.CurrAsmList,location.size);
  428. hlcg.a_loadmm_reg_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,left.location.register,location.register,mms_movescalar);
  429. end
  430. else
  431. internalerror(2003012262);
  432. end;
  433. exit
  434. end;
  435. LOC_CREFERENCE,
  436. LOC_REFERENCE:
  437. begin
  438. if expectloc=LOC_MMREGISTER then
  439. begin
  440. location.register:=cg.getmmregister(current_asmdata.CurrAsmList,location.size);
  441. hlcg.a_loadmm_loc_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,left.location,location.register,mms_movescalar)
  442. end
  443. else
  444. begin
  445. hlcg.location_force_fpureg(current_asmdata.CurrAsmList,left.location,left.resultdef,false);
  446. location.register:=cg.getfpuregister(current_asmdata.CurrAsmList,location.size);
  447. hlcg.a_loadfpu_reg_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,left.location.register,location.register);
  448. end;
  449. location_freetemp(current_asmdata.CurrAsmList,left.location);
  450. end;
  451. LOC_MMREGISTER,
  452. LOC_CMMREGISTER:
  453. begin
  454. case expectloc of
  455. LOC_FPUREGISTER:
  456. begin
  457. hlcg.location_force_fpureg(current_asmdata.CurrAsmList,left.location,left.resultdef,false);
  458. location.register:=cg.getfpuregister(current_asmdata.CurrAsmList,location.size);
  459. hlcg.a_loadfpu_reg_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,left.location.register,location.register);
  460. end;
  461. LOC_MMREGISTER:
  462. begin
  463. location.register:=hlcg.getmmregister(current_asmdata.CurrAsmList,resultdef);
  464. hlcg.a_loadmm_reg_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,left.location.register,location.register,mms_movescalar);
  465. end;
  466. else
  467. internalerror(2003012261);
  468. end;
  469. end;
  470. else
  471. internalerror(2002032215);
  472. end;
  473. end;
  474. procedure tcgtypeconvnode.second_cord_to_pointer;
  475. begin
  476. { this can't happen because constants are already processed in
  477. pass 1 }
  478. internalerror(47423985);
  479. end;
  480. procedure tcgtypeconvnode.second_proc_to_procvar;
  481. var
  482. href: treference;
  483. tmpreg: tregister;
  484. procvarrectype: trecorddef;
  485. procvarselfname: TIDString;
  486. begin
  487. if tabstractprocdef(resultdef).is_addressonly then
  488. begin
  489. location_reset(location,LOC_REGISTER,def_cgsize(voidcodepointertype));
  490. { only a code pointer? (when taking the address of classtype.method
  491. we also only get a code pointer even though the resultdef is a
  492. procedure of object, and hence is_addressonly would return false)
  493. }
  494. if left.location.size = def_cgsize(voidcodepointertype) then
  495. begin
  496. case left.location.loc of
  497. LOC_REFERENCE,LOC_CREFERENCE:
  498. begin
  499. { the procedure symbol is encoded in reference.symbol -> take address }
  500. location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,voidcodepointertype);
  501. hlcg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,left.location.reference,location.register);
  502. end;
  503. else
  504. internalerror(2013031501)
  505. end;
  506. end
  507. else
  508. begin
  509. { conversion from a procedure of object/nested procvar to plain procvar }
  510. case left.location.loc of
  511. LOC_REFERENCE,LOC_CREFERENCE:
  512. begin
  513. location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,resultdef);
  514. { code field is the first one }
  515. hlcg.g_ptrtypecast_ref(current_asmdata.CurrAsmList,left.resultdef,resultdef,left.location.reference);
  516. hlcg.a_load_ref_reg(current_asmdata.CurrAsmList,resultdef,resultdef,left.location.reference,location.register);
  517. end;
  518. LOC_REGISTER,LOC_CREGISTER:
  519. begin
  520. if target_info.endian=endian_little then
  521. location.register:=left.location.register
  522. else
  523. location.register:=left.location.registerhi;
  524. end;
  525. else
  526. internalerror(2013031502)
  527. end;
  528. end;
  529. end
  530. else
  531. begin
  532. if not tabstractprocdef(left.resultdef).is_addressonly then
  533. location_copy(location,left.location)
  534. else
  535. begin
  536. { assigning a global function to a nested procvar -> create
  537. tmethodpointer record and set the "frame pointer" to nil }
  538. if not(left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
  539. internalerror(2013031503);
  540. location_reset_ref(location,LOC_REFERENCE,int_cgsize(resultdef.size),sizeof(pint));
  541. tg.gethltemp(current_asmdata.CurrAsmList,resultdef,resultdef.size,tt_normal,location.reference);
  542. href:=location.reference;
  543. if is_nested_pd(tabstractprocdef(resultdef)) then
  544. begin
  545. procvarrectype:=trecorddef(nestedprocpointertype);
  546. procvarselfname:='parentfp';
  547. end
  548. else
  549. begin
  550. procvarrectype:=trecorddef(methodpointertype);
  551. procvarselfname:='self';
  552. end;
  553. hlcg.g_ptrtypecast_ref(current_asmdata.CurrAsmList,cpointerdef.getreusable(resultdef),cpointerdef.getreusable(procvarrectype),href);
  554. tmpreg:=hlcg.getaddressregister(current_asmdata.CurrAsmList,voidcodepointertype);
  555. hlcg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,tprocdef(left.resultdef),voidcodepointertype,left.location.reference,tmpreg);
  556. hlcg.g_load_reg_field_by_name(current_asmdata.CurrAsmList,voidcodepointertype,trecorddef(procvarrectype),tmpreg,'proc',href);
  557. { setting the frame pointer to nil is not strictly necessary
  558. since the global procedure won't use it, but it can help with
  559. debugging }
  560. hlcg.g_load_const_field_by_name(current_asmdata.CurrAsmList,trecorddef(procvarrectype),0,procvarselfname,href);
  561. end;
  562. end;
  563. end;
  564. procedure Tcgtypeconvnode.second_nil_to_methodprocvar;
  565. begin
  566. location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
  567. location.registerhi:=hlcg.getaddressregister(current_asmdata.currasmlist,voidpointertype);
  568. hlcg.a_load_const_reg(current_asmdata.currasmlist,voidpointertype,0,location.registerhi);
  569. location.register:=hlcg.getaddressregister(current_asmdata.currasmlist,voidcodepointertype);
  570. hlcg.a_load_const_reg(current_asmdata.currasmlist,voidcodepointertype,0,location.register);
  571. end;
  572. procedure tcgtypeconvnode.second_bool_to_int;
  573. var
  574. newsize: tcgsize;
  575. begin
  576. secondpass(left);
  577. location_copy(location,left.location);
  578. newsize:=def_cgsize(resultdef);
  579. { byte(bytebool) or word(wordbool) or longint(longbool) must be }
  580. { accepted for var parameters and assignments, and must not }
  581. { change the ordinal value or value location. }
  582. { htypechk.valid_for_assign ensures that such locations with a }
  583. { size<sizeof(register) cannot be LOC_CREGISTER (they otherwise }
  584. { could be in case of a plain assignment), and LOC_REGISTER can }
  585. { never be an assignment target. The remaining LOC_REGISTER/ }
  586. { LOC_CREGISTER locations do have to be sign/zero-extended. }
  587. if not(nf_explicit in flags) or
  588. (location.loc in [LOC_FLAGS,LOC_JUMP]) or
  589. { change of size/signedness? Then we have to sign/ }
  590. { zero-extend in case of a loc_(c)register }
  591. ((newsize<>left.location.size) and
  592. ((left.resultdef.size<>resultdef.size) or
  593. not(location.loc in [LOC_REFERENCE,LOC_CREFERENCE]))) then
  594. hlcg.location_force_reg(current_asmdata.CurrAsmList,location,left.resultdef,resultdef,true)
  595. else
  596. { may differ in sign, e.g. bytebool -> byte }
  597. location.size:=newsize;
  598. end;
  599. procedure tcgtypeconvnode.second_bool_to_bool;
  600. begin
  601. { we can reuse the conversion already available
  602. in bool_to_int to resize the value. But when the
  603. size of the new boolean is smaller we need to calculate
  604. the value as is done in int_to_bool. This is needed because
  605. the bits that define the true status can be outside the limits
  606. of the new size and truncating the register can result in a 0
  607. value }
  608. if (left.expectloc in [LOC_FLAGS,LOC_JUMP]) and
  609. { a cbool must be converted to -1/0 }
  610. not is_cbool(resultdef) then
  611. begin
  612. secondpass(left);
  613. if (left.location.loc <> left.expectloc) then
  614. internalerror(2010081601);
  615. location_copy(location,left.location);
  616. end
  617. else if (resultdef.size=left.resultdef.size) and
  618. (is_cbool(resultdef)=is_cbool(left.resultdef)) then
  619. second_bool_to_int
  620. else
  621. begin
  622. if (resultdef.size<>left.resultdef.size) then
  623. { remove nf_explicit to perform full conversion if boolean sizes are different }
  624. exclude(flags, nf_explicit);
  625. second_int_to_bool;
  626. end;
  627. end;
  628. procedure tcgtypeconvnode.second_ansistring_to_pchar;
  629. var
  630. l1 : tasmlabel;
  631. hr : treference;
  632. begin
  633. location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
  634. current_asmdata.getjumplabel(l1);
  635. location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,resultdef);
  636. hlcg.a_load_loc_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,
  637. left.location,location.register);
  638. hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,resultdef,OC_NE,0,location.register,l1);
  639. { FPC_EMPTYCHAR is a widechar -> 2 bytes }
  640. reference_reset(hr,2);
  641. hr.symbol:=current_asmdata.RefAsmSymbol('FPC_EMPTYCHAR',AT_DATA);
  642. hlcg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,cwidechartype,resultdef,hr,location.register);
  643. hlcg.a_label(current_asmdata.CurrAsmList,l1);
  644. end;
  645. procedure tcgtypeconvnode.second_class_to_intf;
  646. var
  647. l1 : tasmlabel;
  648. hd : tobjectdef;
  649. ImplIntf : TImplementedInterface;
  650. begin
  651. l1:=nil;
  652. location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
  653. case left.location.loc of
  654. LOC_CREFERENCE,
  655. LOC_REFERENCE:
  656. begin
  657. location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,resultdef);
  658. hlcg.a_load_ref_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,left.location.reference,location.register);
  659. location_freetemp(current_asmdata.CurrAsmList,left.location);
  660. end;
  661. LOC_CREGISTER:
  662. begin
  663. location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,resultdef);
  664. hlcg.a_load_reg_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,left.location.register,location.register);
  665. end;
  666. LOC_REGISTER:
  667. begin
  668. location.register:=left.location.register;
  669. hlcg.g_ptrtypecast_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,location.register);
  670. end
  671. else
  672. internalerror(121120001);
  673. end;
  674. hd:=tobjectdef(left.resultdef);
  675. while assigned(hd) do
  676. begin
  677. ImplIntf:=find_implemented_interface(hd,tobjectdef(resultdef));
  678. if assigned(ImplIntf) then
  679. begin
  680. case ImplIntf.IType of
  681. etStandard:
  682. begin
  683. current_asmdata.getjumplabel(l1);
  684. hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,resultdef,OC_EQ,0,location.register,l1);
  685. hlcg.a_op_const_reg(current_asmdata.CurrAsmList,OP_ADD,resultdef,ImplIntf.ioffset,location.register);
  686. break;
  687. end;
  688. else
  689. internalerror(200802163);
  690. end;
  691. end;
  692. hd:=hd.childof;
  693. end;
  694. if hd=nil then
  695. internalerror(2002081301);
  696. if l1=nil then
  697. internalerror(2013120101);
  698. cg.a_label(current_asmdata.CurrAsmList,l1);
  699. end;
  700. procedure tcgtypeconvnode.second_char_to_char;
  701. begin
  702. internalerror(2007081202);
  703. end;
  704. procedure tcgtypeconvnode.second_elem_to_openarray;
  705. begin
  706. { nothing special to do by default }
  707. second_nothing;
  708. end;
  709. procedure tcgtypeconvnode.second_nothing;
  710. var
  711. newsize : tcgsize;
  712. begin
  713. { we reuse the old value }
  714. location_copy(location,left.location);
  715. { Floats should never be returned as LOC_CONSTANT, do the
  716. moving to memory before the new size is set.
  717. Also when converting from a float to a non-float
  718. move to memory first to prevent
  719. invalid LOC_(C)MM/FPUREGISTER locations }
  720. if (
  721. (resultdef.typ=floatdef) and
  722. (location.loc=LOC_CONSTANT)
  723. ) or
  724. ((resultdef.typ=floatdef) xor (location.loc in [LOC_CFPUREGISTER,LOC_FPUREGISTER,LOC_CMMREGISTER,LOC_MMREGISTER])) then
  725. hlcg.location_force_mem(current_asmdata.CurrAsmList,location,left.resultdef);
  726. { but use the new size, but we don't know the size of all arrays }
  727. newsize:=def_cgsize(resultdef);
  728. location.size:=newsize;
  729. end;
  730. {$ifdef TESTOBJEXT2}
  731. procedure tcgtypeconvnode.checkobject;
  732. begin
  733. { no checking by default }
  734. end;
  735. {$endif TESTOBJEXT2}
  736. procedure tcgtypeconvnode.pass_generate_code;
  737. begin
  738. { the boolean routines can be called with LOC_JUMP and
  739. call secondpass themselves in the helper }
  740. if not(convtype in [tc_bool_2_int,tc_bool_2_bool,tc_int_2_bool]) then
  741. begin
  742. secondpass(left);
  743. if codegenerror then
  744. exit;
  745. end;
  746. second_call_helper(convtype);
  747. {$ifdef TESTOBJEXT2}
  748. { Check explicit conversions to objects pointers !! }
  749. if p^.explizit and
  750. (p^.resultdef.typ=pointerdef) and
  751. (tpointerdef(p^.resultdef).definition.typ=objectdef) and not
  752. (tobjectdef(tpointerdef(p^.resultdef).definition).isclass) and
  753. ((tobjectdef(tpointerdef(p^.resultdef).definition).options and oo_hasvmt)<>0) and
  754. (cs_check_range in current_settings.localswitches) then
  755. checkobject;
  756. {$endif TESTOBJEXT2}
  757. end;
  758. procedure tcgasnode.pass_generate_code;
  759. begin
  760. secondpass(call);
  761. location_copy(location,call.location);
  762. end;
  763. begin
  764. ctypeconvnode := tcgtypeconvnode;
  765. casnode := tcgasnode;
  766. end.