ncgcnv.pas 38 KB

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