ncgcnv.pas 35 KB

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