ncgcnv.pas 34 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816
  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. cg.a_loadmm_reg_reg(current_asmdata.CurrAsmList,left.location.size,location.size,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. tmpreg: tregister;
  475. begin
  476. if tabstractprocdef(resultdef).is_addressonly then
  477. begin
  478. location_reset(location,LOC_REGISTER,def_cgsize(voidcodepointertype));
  479. { only a code pointer? (when taking the address of classtype.method
  480. we also only get a code pointer even though the resultdef is a
  481. procedure of object, and hence is_addressonly would return false)
  482. }
  483. if left.location.size = def_cgsize(voidcodepointertype) then
  484. begin
  485. case left.location.loc of
  486. LOC_REFERENCE,LOC_CREFERENCE:
  487. begin
  488. { the procedure symbol is encoded in reference.symbol -> take address }
  489. location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,voidcodepointertype);
  490. hlcg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,left.location.reference,location.register);
  491. end;
  492. else
  493. internalerror(2013031501)
  494. end;
  495. end
  496. else
  497. begin
  498. { conversion from a procedure of object/nested procvar to plain procvar }
  499. case left.location.loc of
  500. LOC_REFERENCE,LOC_CREFERENCE:
  501. begin
  502. location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,voidcodepointertype);
  503. { code field is the first one }
  504. hlcg.a_load_ref_reg(current_asmdata.CurrAsmList,voidcodepointertype,voidcodepointertype,left.location.reference,location.register);
  505. end;
  506. LOC_REGISTER,LOC_CREGISTER:
  507. begin
  508. if target_info.endian=endian_little then
  509. location.register:=left.location.register
  510. else
  511. location.register:=left.location.registerhi;
  512. end;
  513. else
  514. internalerror(2013031502)
  515. end;
  516. end;
  517. end
  518. else
  519. begin
  520. if not tabstractprocdef(left.resultdef).is_addressonly then
  521. location_copy(location,left.location)
  522. else
  523. begin
  524. { assigning a global function to a nested procvar -> create
  525. tmethodpointer record and set the "frame pointer" to nil }
  526. if not(left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
  527. internalerror(2013031503);
  528. location_reset_ref(location,LOC_REFERENCE,int_cgsize(resultdef.size),sizeof(pint));
  529. tg.gethltemp(current_asmdata.CurrAsmList,resultdef,resultdef.size,tt_normal,location.reference);
  530. tmpreg:=hlcg.getaddressregister(current_asmdata.CurrAsmList,voidcodepointertype);
  531. hlcg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,left.resultdef,voidcodepointertype,left.location.reference,tmpreg);
  532. hlcg.a_load_reg_ref(current_asmdata.CurrAsmList,voidcodepointertype,voidcodepointertype,tmpreg,location.reference);
  533. { setting the frame pointer to nil is not strictly necessary
  534. since the global procedure won't use it, but it can help with
  535. debugging }
  536. inc(location.reference.offset,voidcodepointertype.size);
  537. if (resultdef.typ=procvardef) and is_nested_pd(tprocvardef(resultdef)) then
  538. hlcg.a_load_const_ref(current_asmdata.CurrAsmList,parentfpvoidpointertype,0,location.reference)
  539. else if tabstractprocdef(resultdef).is_methodpointer then
  540. hlcg.a_load_const_ref(current_asmdata.CurrAsmList,voidpointertype,0,location.reference)
  541. else
  542. internalerror(2014052301);
  543. dec(location.reference.offset,voidcodepointertype.size);
  544. end;
  545. end;
  546. end;
  547. procedure Tcgtypeconvnode.second_nil_to_methodprocvar;
  548. begin
  549. location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
  550. location.registerhi:=hlcg.getaddressregister(current_asmdata.currasmlist,voidpointertype);
  551. hlcg.a_load_const_reg(current_asmdata.currasmlist,voidpointertype,0,location.registerhi);
  552. location.register:=hlcg.getaddressregister(current_asmdata.currasmlist,voidcodepointertype);
  553. hlcg.a_load_const_reg(current_asmdata.currasmlist,voidcodepointertype,0,location.register);
  554. end;
  555. procedure tcgtypeconvnode.second_bool_to_int;
  556. var
  557. newsize: tcgsize;
  558. begin
  559. secondpass(left);
  560. location_copy(location,left.location);
  561. newsize:=def_cgsize(resultdef);
  562. { byte(bytebool) or word(wordbool) or longint(longbool) must be }
  563. { accepted for var parameters and assignments, and must not }
  564. { change the ordinal value or value location. }
  565. { htypechk.valid_for_assign ensures that such locations with a }
  566. { size<sizeof(register) cannot be LOC_CREGISTER (they otherwise }
  567. { could be in case of a plain assignment), and LOC_REGISTER can }
  568. { never be an assignment target. The remaining LOC_REGISTER/ }
  569. { LOC_CREGISTER locations do have to be sign/zero-extended. }
  570. if not(nf_explicit in flags) or
  571. (location.loc in [LOC_FLAGS,LOC_JUMP]) or
  572. { change of size/signedness? Then we have to sign/ }
  573. { zero-extend in case of a loc_(c)register }
  574. ((newsize<>left.location.size) and
  575. ((left.resultdef.size<>resultdef.size) or
  576. not(location.loc in [LOC_REFERENCE,LOC_CREFERENCE]))) then
  577. hlcg.location_force_reg(current_asmdata.CurrAsmList,location,left.resultdef,resultdef,true)
  578. else
  579. { may differ in sign, e.g. bytebool -> byte }
  580. location.size:=newsize;
  581. end;
  582. procedure tcgtypeconvnode.second_bool_to_bool;
  583. begin
  584. { we can reuse the conversion already available
  585. in bool_to_int to resize the value. But when the
  586. size of the new boolean is smaller we need to calculate
  587. the value as is done in int_to_bool. This is needed because
  588. the bits that define the true status can be outside the limits
  589. of the new size and truncating the register can result in a 0
  590. value }
  591. if (left.expectloc in [LOC_FLAGS,LOC_JUMP]) and
  592. { a cbool must be converted to -1/0 }
  593. not is_cbool(resultdef) then
  594. begin
  595. secondpass(left);
  596. if (left.location.loc <> left.expectloc) then
  597. internalerror(2010081601);
  598. location_copy(location,left.location);
  599. end
  600. else if (resultdef.size=left.resultdef.size) and
  601. (is_cbool(resultdef)=is_cbool(left.resultdef)) then
  602. second_bool_to_int
  603. else
  604. begin
  605. if (resultdef.size<>left.resultdef.size) then
  606. { remove nf_explicit to perform full conversion if boolean sizes are different }
  607. exclude(flags, nf_explicit);
  608. second_int_to_bool;
  609. end;
  610. end;
  611. procedure tcgtypeconvnode.second_ansistring_to_pchar;
  612. var
  613. l1 : tasmlabel;
  614. hr : treference;
  615. begin
  616. location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
  617. current_asmdata.getjumplabel(l1);
  618. location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,resultdef);
  619. hlcg.a_load_loc_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,
  620. left.location,location.register);
  621. hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,resultdef,OC_NE,0,location.register,l1);
  622. { FPC_EMPTYCHAR is a widechar -> 2 bytes }
  623. reference_reset(hr,2);
  624. hr.symbol:=current_asmdata.RefAsmSymbol('FPC_EMPTYCHAR');
  625. hlcg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,cwidechartype,resultdef,hr,location.register);
  626. hlcg.a_label(current_asmdata.CurrAsmList,l1);
  627. end;
  628. procedure tcgtypeconvnode.second_class_to_intf;
  629. var
  630. l1 : tasmlabel;
  631. hd : tobjectdef;
  632. ImplIntf : TImplementedInterface;
  633. begin
  634. l1:=nil;
  635. location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
  636. case left.location.loc of
  637. LOC_CREFERENCE,
  638. LOC_REFERENCE:
  639. begin
  640. location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,resultdef);
  641. hlcg.a_load_ref_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,left.location.reference,location.register);
  642. location_freetemp(current_asmdata.CurrAsmList,left.location);
  643. end;
  644. LOC_CREGISTER:
  645. begin
  646. location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,resultdef);
  647. hlcg.a_load_reg_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,left.location.register,location.register);
  648. end;
  649. LOC_REGISTER:
  650. location.register:=left.location.register;
  651. else
  652. internalerror(121120001);
  653. end;
  654. hd:=tobjectdef(left.resultdef);
  655. while assigned(hd) do
  656. begin
  657. ImplIntf:=find_implemented_interface(hd,tobjectdef(resultdef));
  658. if assigned(ImplIntf) then
  659. begin
  660. case ImplIntf.IType of
  661. etStandard:
  662. begin
  663. current_asmdata.getjumplabel(l1);
  664. hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,resultdef,OC_EQ,0,location.register,l1);
  665. hlcg.a_op_const_reg(current_asmdata.CurrAsmList,OP_ADD,resultdef,ImplIntf.ioffset,location.register);
  666. break;
  667. end;
  668. else
  669. internalerror(200802163);
  670. end;
  671. end;
  672. hd:=hd.childof;
  673. end;
  674. if hd=nil then
  675. internalerror(2002081301);
  676. if l1=nil then
  677. internalerror(2013120101);
  678. cg.a_label(current_asmdata.CurrAsmList,l1);
  679. end;
  680. procedure tcgtypeconvnode.second_char_to_char;
  681. begin
  682. internalerror(2007081202);
  683. end;
  684. procedure tcgtypeconvnode.second_elem_to_openarray;
  685. begin
  686. { nothing special to do by default }
  687. second_nothing;
  688. end;
  689. procedure tcgtypeconvnode.second_nothing;
  690. var
  691. newsize : tcgsize;
  692. begin
  693. { we reuse the old value }
  694. location_copy(location,left.location);
  695. { Floats should never be returned as LOC_CONSTANT, do the
  696. moving to memory before the new size is set.
  697. Also when converting from a float to a non-float
  698. move to memory first to prevent
  699. invalid LOC_(C)MM/FPUREGISTER locations }
  700. if (
  701. (resultdef.typ=floatdef) and
  702. (location.loc=LOC_CONSTANT)
  703. ) or
  704. ((resultdef.typ=floatdef) xor (location.loc in [LOC_CFPUREGISTER,LOC_FPUREGISTER,LOC_CMMREGISTER,LOC_MMREGISTER])) then
  705. hlcg.location_force_mem(current_asmdata.CurrAsmList,location,left.resultdef);
  706. { but use the new size, but we don't know the size of all arrays }
  707. newsize:=def_cgsize(resultdef);
  708. location.size:=newsize;
  709. end;
  710. {$ifdef TESTOBJEXT2}
  711. procedure tcgtypeconvnode.checkobject;
  712. begin
  713. { no checking by default }
  714. end;
  715. {$endif TESTOBJEXT2}
  716. procedure tcgtypeconvnode.pass_generate_code;
  717. begin
  718. { the boolean routines can be called with LOC_JUMP and
  719. call secondpass themselves in the helper }
  720. if not(convtype in [tc_bool_2_int,tc_bool_2_bool,tc_int_2_bool]) then
  721. begin
  722. secondpass(left);
  723. if codegenerror then
  724. exit;
  725. end;
  726. second_call_helper(convtype);
  727. {$ifdef TESTOBJEXT2}
  728. { Check explicit conversions to objects pointers !! }
  729. if p^.explizit and
  730. (p^.resultdef.typ=pointerdef) and
  731. (tpointerdef(p^.resultdef).definition.typ=objectdef) and not
  732. (tobjectdef(tpointerdef(p^.resultdef).definition).isclass) and
  733. ((tobjectdef(tpointerdef(p^.resultdef).definition).options and oo_hasvmt)<>0) and
  734. (cs_check_range in current_settings.localswitches) then
  735. checkobject;
  736. {$endif TESTOBJEXT2}
  737. end;
  738. procedure tcgasnode.pass_generate_code;
  739. begin
  740. secondpass(call);
  741. location_copy(location,call.location);
  742. end;
  743. begin
  744. ctypeconvnode := tcgtypeconvnode;
  745. casnode := tcgasnode;
  746. end.