ncgcnv.pas 30 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758
  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. procedure second_int_to_int;override;
  27. procedure second_cstring_to_pchar;override;
  28. procedure second_cstring_to_int;override;
  29. procedure second_string_to_chararray;override;
  30. procedure second_array_to_pointer;override;
  31. procedure second_pointer_to_array;override;
  32. procedure second_char_to_string;override;
  33. procedure second_real_to_real;override;
  34. procedure second_cord_to_pointer;override;
  35. procedure second_proc_to_procvar;override;
  36. procedure second_nil_to_methodprocvar;override;
  37. procedure second_bool_to_int;override;
  38. procedure second_bool_to_bool;override;
  39. procedure second_ansistring_to_pchar;override;
  40. procedure second_class_to_intf;override;
  41. procedure second_char_to_char;override;
  42. procedure second_nothing;override;
  43. procedure pass_generate_code;override;
  44. {$ifdef cpuflags}
  45. { CPUs without flags need a specific implementation of int -> bool }
  46. procedure second_int_to_bool;override;
  47. {$endif cpuflags}
  48. end;
  49. tcgasnode = class(tasnode)
  50. procedure pass_generate_code;override;
  51. end;
  52. implementation
  53. uses
  54. cutils,verbose,globtype,globals,
  55. aasmbase,aasmtai,aasmdata,aasmcpu,symconst,symdef,paramgr,
  56. nutils,ncon,ncal,
  57. cpubase,systems,
  58. procinfo,pass_2,
  59. cgbase,
  60. cgutils,cgobj,
  61. ncgutil,
  62. tgobj
  63. ;
  64. procedure tcgtypeconvnode.second_int_to_int;
  65. var
  66. orgsize,
  67. newsize : tcgsize;
  68. ressize,
  69. leftsize : longint;
  70. begin
  71. newsize:=def_cgsize(resultdef);
  72. { insert range check if not explicit conversion }
  73. if not(nf_explicit in flags) then
  74. cg.g_rangecheck(current_asmdata.CurrAsmList,left.location,left.resultdef,resultdef);
  75. { is the result size smaller? when typecasting from void
  76. we always reuse the current location, because there is
  77. nothing that we can load in a register }
  78. ressize := resultdef.size;
  79. leftsize := left.resultdef.size;
  80. if ((ressize<>leftsize) or
  81. is_bitpacked_access(left)) and
  82. not is_void(left.resultdef) then
  83. begin
  84. location_copy(location,left.location);
  85. { reuse a loc_reference when the newsize is smaller than
  86. than the original, else load it to a register }
  87. if (location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) and
  88. (ressize<leftsize) then
  89. begin
  90. location.size:=newsize;
  91. if (target_info.endian = ENDIAN_BIG) then
  92. begin
  93. inc(location.reference.offset,leftsize-ressize);
  94. location.reference.alignment:=newalignment(location.reference.alignment,leftsize-ressize);
  95. end;
  96. end
  97. else
  98. location_force_reg(current_asmdata.CurrAsmList,location,newsize,false);
  99. end
  100. else
  101. begin
  102. { no special loading is required, reuse current location }
  103. { that's not true, if you go from signed to unsiged or }
  104. { vice versa, you need sign extension/removal if the }
  105. { value is already in a register (at least for archs }
  106. { which don't have 8bit register components etc) (JM) }
  107. location_copy(location,left.location);
  108. location.size:=newsize;
  109. orgsize := def_cgsize(left.resultdef);
  110. if (ressize < sizeof(aint)) and
  111. (location.loc in [LOC_REGISTER,LOC_CREGISTER]) and
  112. (orgsize <> newsize) then
  113. begin
  114. location.register := cg.getintregister(current_asmdata.CurrAsmList,newsize);
  115. location.loc := LOC_REGISTER;
  116. cg.a_load_reg_reg(current_asmdata.CurrAsmList,orgsize,newsize,left.location.register,location.register);
  117. end;
  118. end;
  119. end;
  120. {$ifdef cpuflags}
  121. procedure tcgtypeconvnode.second_int_to_bool;
  122. var
  123. hregister : tregister;
  124. href : treference;
  125. resflags : tresflags;
  126. hlabel,oldTrueLabel,oldFalseLabel : tasmlabel;
  127. newsize : tcgsize;
  128. begin
  129. oldTrueLabel:=current_procinfo.CurrTrueLabel;
  130. oldFalseLabel:=current_procinfo.CurrFalseLabel;
  131. current_asmdata.getjumplabel(current_procinfo.CurrTrueLabel);
  132. current_asmdata.getjumplabel(current_procinfo.CurrFalseLabel);
  133. secondpass(left);
  134. if codegenerror then
  135. exit;
  136. { Explicit typecasts from any ordinal type to a boolean type }
  137. { must not change the ordinal value }
  138. if (nf_explicit in flags) and
  139. not(left.location.loc in [LOC_FLAGS,LOC_JUMP]) then
  140. begin
  141. location_copy(location,left.location);
  142. newsize:=def_cgsize(resultdef);
  143. { change of size? change sign only if location is LOC_(C)REGISTER? Then we have to sign/zero-extend }
  144. if (tcgsize2size[newsize]<>tcgsize2size[left.location.size]) or
  145. ((newsize<>left.location.size) and (location.loc in [LOC_REGISTER,LOC_CREGISTER])) then
  146. location_force_reg(current_asmdata.CurrAsmList,location,newsize,true)
  147. else
  148. location.size:=newsize;
  149. current_procinfo.CurrTrueLabel:=oldTrueLabel;
  150. current_procinfo.CurrFalseLabel:=oldFalseLabel;
  151. exit;
  152. end;
  153. { though ppc/ppc64 doesn't use the generic code, we need to ifdef here
  154. because the code is included into the powerpc compilers }
  155. {$if defined(POWERPC) or defined(POWERPC64)}
  156. resflags.cr := RS_CR0;
  157. resflags.flag:=F_NE;
  158. {$else defined(POWERPC) or defined(POWERPC64)}
  159. { Load left node into flag F_NE/F_E }
  160. resflags:=F_NE;
  161. {$endif defined(POWERPC) or defined(POWERPC64)}
  162. case left.location.loc of
  163. LOC_CREFERENCE,
  164. LOC_REFERENCE :
  165. begin
  166. if left.location.size in [OS_64,OS_S64] then
  167. begin
  168. hregister:=cg.getintregister(current_asmdata.CurrAsmList,OS_32);
  169. cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_32,OS_32,left.location.reference,hregister);
  170. href:=left.location.reference;
  171. inc(href.offset,4);
  172. cg.a_op_ref_reg(current_asmdata.CurrAsmList,OP_OR,OS_32,href,hregister);
  173. end
  174. else
  175. begin
  176. location_force_reg(current_asmdata.CurrAsmList,left.location,left.location.size,true);
  177. cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_OR,left.location.size,left.location.register,left.location.register);
  178. end;
  179. end;
  180. LOC_FLAGS :
  181. begin
  182. resflags:=left.location.resflags;
  183. end;
  184. LOC_REGISTER,LOC_CREGISTER :
  185. begin
  186. {$ifndef cpu64bitalu}
  187. if left.location.size in [OS_64,OS_S64] then
  188. begin
  189. hregister:=cg.getintregister(current_asmdata.CurrAsmList,OS_32);
  190. cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_32,OS_32,left.location.register64.reglo,hregister);
  191. cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_OR,OS_32,left.location.register64.reghi,hregister);
  192. end
  193. else
  194. {$endif cpu64bitalu}
  195. begin
  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_JUMP :
  200. begin
  201. hregister:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
  202. current_asmdata.getjumplabel(hlabel);
  203. cg.a_label(current_asmdata.CurrAsmList,current_procinfo.CurrTrueLabel);
  204. cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT,1,hregister);
  205. cg.a_jmp_always(current_asmdata.CurrAsmList,hlabel);
  206. cg.a_label(current_asmdata.CurrAsmList,current_procinfo.CurrFalseLabel);
  207. cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT,0,hregister);
  208. cg.a_label(current_asmdata.CurrAsmList,hlabel);
  209. cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_OR,OS_INT,hregister,hregister);
  210. end;
  211. else
  212. internalerror(200311301);
  213. end;
  214. { load flags to register }
  215. location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
  216. location.register:=cg.getintregister(current_asmdata.CurrAsmList,location.size);
  217. cg.g_flags2reg(current_asmdata.CurrAsmList,location.size,resflags,location.register);
  218. if (is_cbool(resultdef)) then
  219. cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_NEG,location.size,location.register,location.register);
  220. current_procinfo.CurrTrueLabel:=oldTrueLabel;
  221. current_procinfo.CurrFalseLabel:=oldFalseLabel;
  222. end;
  223. {$endif cpuflags}
  224. procedure tcgtypeconvnode.second_cstring_to_pchar;
  225. var
  226. hr : treference;
  227. begin
  228. if left.nodetype<>stringconstn then
  229. internalerror(200601131);
  230. location_reset(location,LOC_REGISTER,OS_ADDR);
  231. case tstringconstnode(left).cst_type of
  232. cst_conststring :
  233. begin
  234. location.register:=cg.getaddressregister(current_asmdata.CurrAsmList);
  235. cg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,left.location.reference,location.register);
  236. end;
  237. cst_shortstring :
  238. begin
  239. inc(left.location.reference.offset);
  240. location.reference.alignment:=1;
  241. location.register:=cg.getaddressregister(current_asmdata.CurrAsmList);
  242. cg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,left.location.reference,location.register);
  243. end;
  244. cst_widestring,
  245. cst_unicodestring,
  246. cst_ansistring :
  247. begin
  248. if tstringconstnode(left).len=0 then
  249. begin
  250. { FPC_EMPTYCHAR is a widechar -> 2 bytes }
  251. reference_reset(hr,2);
  252. hr.symbol:=current_asmdata.RefAsmSymbol('FPC_EMPTYCHAR');
  253. location.register:=cg.getaddressregister(current_asmdata.CurrAsmList);
  254. cg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,hr,location.register);
  255. end
  256. else
  257. begin
  258. location_copy(location,left.location);
  259. end;
  260. end;
  261. cst_longstring:
  262. begin
  263. {!!!!!!!}
  264. internalerror(8888);
  265. end;
  266. else
  267. internalerror(200808241);
  268. end;
  269. end;
  270. procedure tcgtypeconvnode.second_cstring_to_int;
  271. begin
  272. { this can't happen because constants are already processed in
  273. pass 1 }
  274. internalerror(200510013);
  275. end;
  276. procedure tcgtypeconvnode.second_string_to_chararray;
  277. begin
  278. if is_chararray(left.resultdef) then
  279. begin
  280. location_copy(location,left.location);
  281. exit;
  282. end;
  283. { should be handled already in resultdef pass (JM) }
  284. internalerror(200108292);
  285. end;
  286. procedure tcgtypeconvnode.second_array_to_pointer;
  287. begin
  288. location_reset(location,LOC_REGISTER,OS_ADDR);
  289. location.register:=cg.getaddressregister(current_asmdata.CurrAsmList);
  290. cg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,left.location.reference,location.register);
  291. end;
  292. procedure tcgtypeconvnode.second_pointer_to_array;
  293. begin
  294. { assume natural alignment }
  295. location_reset_ref(location,LOC_REFERENCE,OS_NO,resultdef.alignment);
  296. case left.location.loc of
  297. LOC_CREGISTER,
  298. LOC_REGISTER :
  299. begin
  300. {$ifdef cpu_uses_separate_address_registers}
  301. if getregtype(left.location.register)<>R_ADDRESSREGISTER then
  302. begin
  303. location.reference.base:=rg.getaddressregister(current_asmdata.CurrAsmList);
  304. cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,
  305. left.location.register,location.reference.base);
  306. end
  307. else
  308. {$endif}
  309. location.reference.base := left.location.register;
  310. end;
  311. LOC_REFERENCE,
  312. LOC_CREFERENCE :
  313. begin
  314. location.reference.base:=cg.getaddressregister(current_asmdata.CurrAsmList);
  315. cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,left.location.reference,
  316. location.reference.base);
  317. location_freetemp(current_asmdata.CurrAsmList,left.location);
  318. end;
  319. else
  320. internalerror(2002032216);
  321. end;
  322. end;
  323. procedure tcgtypeconvnode.second_char_to_string;
  324. begin
  325. location_reset_ref(location,LOC_REFERENCE,OS_NO,2);
  326. case tstringdef(resultdef).stringtype of
  327. st_shortstring :
  328. begin
  329. tg.GetTemp(current_asmdata.CurrAsmList,256,2,tt_normal,location.reference);
  330. cg.a_load_loc_ref(current_asmdata.CurrAsmList,left.location.size,left.location,
  331. location.reference);
  332. location_freetemp(current_asmdata.CurrAsmList,left.location);
  333. end;
  334. { the rest is removed in the resultdef pass and converted to compilerprocs }
  335. else
  336. internalerror(4179);
  337. end;
  338. end;
  339. procedure tcgtypeconvnode.second_real_to_real;
  340. {$ifdef x86}
  341. var
  342. tr: treference;
  343. {$endif x86}
  344. begin
  345. location_reset(location,expectloc,def_cgsize(resultdef));
  346. {$ifdef x86}
  347. { extended types in memory which should be loaded into the sse unit
  348. must be converted by the fpu first, so force them to be loaded into
  349. the fpu }
  350. if (expectloc=LOC_MMREGISTER) and
  351. (left.location.size in [OS_F80,OS_C64]) then
  352. begin
  353. if (left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) then
  354. location_force_fpureg(current_asmdata.CurrAsmList,left.location,false);
  355. { round them down to the proper precision }
  356. tg.gettemp(current_asmdata.currasmlist,resultdef.size,resultdef.alignment,tt_normal,tr);
  357. cg.a_loadfpu_reg_ref(current_asmdata.CurrAsmList,left.location.size,location.size,left.location.register,tr);
  358. location_reset_ref(left.location,LOC_REFERENCE,location.size,tr.alignment);
  359. left.location.reference:=tr;
  360. end;
  361. {$endif x86}
  362. { ARM VFP values are in integer registers when they are function results }
  363. if (left.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
  364. location_force_mmregscalar(current_asmdata.CurrAsmList,left.location,false);
  365. case left.location.loc of
  366. LOC_FPUREGISTER,
  367. LOC_CFPUREGISTER:
  368. begin
  369. case expectloc of
  370. LOC_FPUREGISTER:
  371. begin
  372. { on sparc a move from double -> single means from two to one register. }
  373. { On all other platforms it also needs rounding to avoid that }
  374. { single(double_regvar) = double_regvar is true in all cases }
  375. location.register:=cg.getfpuregister(current_asmdata.CurrAsmList,location.size);
  376. cg.a_loadfpu_reg_reg(current_asmdata.CurrAsmList,left.location.size,location.size,left.location.register,location.register);
  377. end;
  378. LOC_MMREGISTER:
  379. begin
  380. location_force_mmregscalar(current_asmdata.CurrAsmList,left.location,false);
  381. location.register:=cg.getmmregister(current_asmdata.CurrAsmList,location.size);
  382. cg.a_loadmm_reg_reg(current_asmdata.CurrAsmList,left.location.size,location.size,left.location.register,location.register,mms_movescalar);
  383. end
  384. else
  385. internalerror(2003012262);
  386. end;
  387. exit
  388. end;
  389. LOC_CREFERENCE,
  390. LOC_REFERENCE:
  391. begin
  392. if expectloc=LOC_MMREGISTER then
  393. begin
  394. location.register:=cg.getmmregister(current_asmdata.CurrAsmList,location.size);
  395. cg.a_loadmm_loc_reg(current_asmdata.CurrAsmList,location.size,left.location,location.register,mms_movescalar)
  396. end
  397. else
  398. begin
  399. location_force_fpureg(current_asmdata.CurrAsmList,left.location,false);
  400. location.register:=cg.getfpuregister(current_asmdata.CurrAsmList,location.size);
  401. cg.a_loadfpu_reg_reg(current_asmdata.CurrAsmList,left.location.size,location.size,left.location.register,location.register);
  402. end;
  403. location_freetemp(current_asmdata.CurrAsmList,left.location);
  404. end;
  405. LOC_MMREGISTER,
  406. LOC_CMMREGISTER:
  407. begin
  408. case expectloc of
  409. LOC_FPUREGISTER:
  410. begin
  411. location_force_fpureg(current_asmdata.CurrAsmList,left.location,false);
  412. location.register:=cg.getfpuregister(current_asmdata.CurrAsmList,location.size);
  413. cg.a_loadfpu_reg_reg(current_asmdata.CurrAsmList,left.location.size,location.size,left.location.register,location.register);
  414. end;
  415. LOC_MMREGISTER:
  416. begin
  417. location.register:=cg.getmmregister(current_asmdata.CurrAsmList,location.size);
  418. cg.a_loadmm_reg_reg(current_asmdata.CurrAsmList,left.location.size,location.size,left.location.register,location.register,mms_movescalar);
  419. end;
  420. else
  421. internalerror(2003012261);
  422. end;
  423. end;
  424. else
  425. internalerror(2002032215);
  426. end;
  427. end;
  428. procedure tcgtypeconvnode.second_cord_to_pointer;
  429. begin
  430. { this can't happen because constants are already processed in
  431. pass 1 }
  432. internalerror(47423985);
  433. end;
  434. procedure tcgtypeconvnode.second_proc_to_procvar;
  435. var
  436. tmpreg: tregister;
  437. begin
  438. if tabstractprocdef(resultdef).is_addressonly then
  439. begin
  440. location_reset(location,LOC_REGISTER,OS_ADDR);
  441. location.register:=cg.getaddressregister(current_asmdata.CurrAsmList);
  442. cg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,left.location.reference,location.register);
  443. end
  444. else
  445. begin
  446. if not tabstractprocdef(left.resultdef).is_addressonly then
  447. location_copy(location,left.location)
  448. else
  449. begin
  450. { assigning a global function to a nested procvar -> create
  451. tmethodpointer record and set the "frame pointer" to nil }
  452. location_reset_ref(location,LOC_REFERENCE,int_cgsize(sizeof(pint)*2),sizeof(pint));
  453. tg.gettemp(current_asmdata.CurrAsmList,resultdef.size,sizeof(pint),tt_normal,location.reference);
  454. tmpreg:=cg.getaddressregister(current_asmdata.CurrAsmList);
  455. cg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,left.location.reference,tmpreg);
  456. cg.a_load_reg_ref(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,tmpreg,location.reference);
  457. { setting the frame pointer to nil is not strictly necessary
  458. since the global procedure won't use it, but it can help with
  459. debugging }
  460. inc(location.reference.offset,sizeof(pint));
  461. cg.a_load_const_ref(current_asmdata.CurrAsmList,OS_ADDR,0,location.reference);
  462. dec(location.reference.offset,sizeof(pint));
  463. end;
  464. end;
  465. end;
  466. procedure Tcgtypeconvnode.second_nil_to_methodprocvar;
  467. var r:Treference;
  468. begin
  469. tg.gettemp(current_asmdata.currasmlist,2*sizeof(puint),sizeof(puint),tt_normal,r);
  470. location_reset_ref(location,LOC_REFERENCE,def_cgsize(resultdef),0);
  471. location.reference:=r;
  472. cg.a_load_const_ref(current_asmdata.currasmlist,OS_ADDR,0,r);
  473. inc(r.offset,sizeof(puint));
  474. cg.a_load_const_ref(current_asmdata.currasmlist,OS_ADDR,0,r);
  475. end;
  476. procedure tcgtypeconvnode.second_bool_to_int;
  477. var
  478. newsize: tcgsize;
  479. oldTrueLabel,oldFalseLabel : tasmlabel;
  480. begin
  481. oldTrueLabel:=current_procinfo.CurrTrueLabel;
  482. oldFalseLabel:=current_procinfo.CurrFalseLabel;
  483. current_asmdata.getjumplabel(current_procinfo.CurrTrueLabel);
  484. current_asmdata.getjumplabel(current_procinfo.CurrFalseLabel);
  485. secondpass(left);
  486. location_copy(location,left.location);
  487. newsize:=def_cgsize(resultdef);
  488. { byte(bytebool) or word(wordbool) or longint(longbool) must be }
  489. { accepted for var parameters and assignments, and must not }
  490. { change the ordinal value or value location. }
  491. { htypechk.valid_for_assign ensures that such locations with a }
  492. { size<sizeof(register) cannot be LOC_CREGISTER (they otherwise }
  493. { could be in case of a plain assignment), and LOC_REGISTER can }
  494. { never be an assignment target. The remaining LOC_REGISTER/ }
  495. { LOC_CREGISTER locations do have to be sign/zero-extended. }
  496. if not(nf_explicit in flags) or
  497. (location.loc in [LOC_FLAGS,LOC_JUMP]) or
  498. { change of size/signedness? Then we have to sign/ }
  499. { zero-extend in case of a loc_(c)register }
  500. ((newsize<>left.location.size) and
  501. ((left.resultdef.size<>resultdef.size) or
  502. not(location.loc in [LOC_REFERENCE,LOC_CREFERENCE]))) then
  503. location_force_reg(current_asmdata.CurrAsmList,location,newsize,true)
  504. else
  505. { may differ in sign, e.g. bytebool -> byte }
  506. location.size:=newsize;
  507. current_procinfo.CurrTrueLabel:=oldTrueLabel;
  508. current_procinfo.CurrFalseLabel:=oldFalseLabel;
  509. end;
  510. procedure tcgtypeconvnode.second_bool_to_bool;
  511. begin
  512. { we can reuse the conversion already available
  513. in bool_to_int to resize the value. But when the
  514. size of the new boolean is smaller we need to calculate
  515. the value as is done in int_to_bool. This is needed because
  516. the bits that define the true status can be outside the limits
  517. of the new size and truncating the register can result in a 0
  518. value }
  519. if (left.expectloc in [LOC_FLAGS,LOC_JUMP]) and
  520. { a cbool must be converted to -1/0 }
  521. not is_cbool(resultdef) then
  522. begin
  523. secondpass(left);
  524. if (left.location.loc <> left.expectloc) then
  525. internalerror(2010081601);
  526. location_copy(location,left.location);
  527. end
  528. else if (resultdef.size=left.resultdef.size) and
  529. (is_cbool(resultdef)=is_cbool(left.resultdef)) then
  530. second_bool_to_int
  531. else
  532. begin
  533. if (resultdef.size<>left.resultdef.size) then
  534. { remove nf_explicit to perform full conversion if boolean sizes are different }
  535. exclude(flags, nf_explicit);
  536. second_int_to_bool;
  537. end;
  538. end;
  539. procedure tcgtypeconvnode.second_ansistring_to_pchar;
  540. var
  541. l1 : tasmlabel;
  542. hr : treference;
  543. begin
  544. location_reset(location,LOC_REGISTER,OS_ADDR);
  545. current_asmdata.getjumplabel(l1);
  546. case left.location.loc of
  547. LOC_CREGISTER,LOC_REGISTER:
  548. begin
  549. {$ifdef cpu_uses_separate_address_registers}
  550. if getregtype(left.location.register)<>R_ADDRESSREGISTER then
  551. begin
  552. location.register:=cg.getaddressregister(current_asmdata.CurrAsmList);
  553. cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,
  554. left.location.register,location.register);
  555. end
  556. else
  557. {$endif}
  558. location.register := left.location.register;
  559. end;
  560. LOC_CREFERENCE,LOC_REFERENCE:
  561. begin
  562. location.register:=cg.getaddressregister(current_asmdata.CurrAsmList);
  563. cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,left.location.reference,location.register);
  564. end;
  565. else
  566. internalerror(2002032214);
  567. end;
  568. cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_ADDR,OC_NE,0,location.register,l1);
  569. { FPC_EMPTYCHAR is a widechar -> 2 bytes }
  570. reference_reset(hr,2);
  571. hr.symbol:=current_asmdata.RefAsmSymbol('FPC_EMPTYCHAR');
  572. cg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,hr,location.register);
  573. cg.a_label(current_asmdata.CurrAsmList,l1);
  574. end;
  575. procedure tcgtypeconvnode.second_class_to_intf;
  576. var
  577. l1 : tasmlabel;
  578. hd : tobjectdef;
  579. ImplIntf : TImplementedInterface;
  580. begin
  581. location_reset(location,LOC_REGISTER,OS_ADDR);
  582. case left.location.loc of
  583. LOC_CREFERENCE,
  584. LOC_REFERENCE:
  585. begin
  586. location.register:=cg.getaddressregister(current_asmdata.CurrAsmList);
  587. cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,left.location.reference,location.register);
  588. location_freetemp(current_asmdata.CurrAsmList,left.location);
  589. end;
  590. LOC_CREGISTER:
  591. begin
  592. location.register:=cg.getaddressregister(current_asmdata.CurrAsmList);
  593. cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,left.location.register,location.register);
  594. end;
  595. LOC_REGISTER:
  596. location.register:=left.location.register;
  597. else
  598. internalerror(121120001);
  599. end;
  600. hd:=tobjectdef(left.resultdef);
  601. while assigned(hd) do
  602. begin
  603. ImplIntf:=hd.find_implemented_interface(tobjectdef(resultdef));
  604. if assigned(ImplIntf) then
  605. begin
  606. case ImplIntf.IType of
  607. etStandard:
  608. begin
  609. current_asmdata.getjumplabel(l1);
  610. cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_ADDR,OC_EQ,0,location.register,l1);
  611. cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_ADD,OS_ADDR,ImplIntf.ioffset,location.register);
  612. break;
  613. end;
  614. else
  615. internalerror(200802163);
  616. end;
  617. end;
  618. hd:=hd.childof;
  619. end;
  620. if hd=nil then
  621. internalerror(2002081301);
  622. cg.a_label(current_asmdata.CurrAsmList,l1);
  623. end;
  624. procedure tcgtypeconvnode.second_char_to_char;
  625. begin
  626. internalerror(2007081202);
  627. end;
  628. procedure tcgtypeconvnode.second_nothing;
  629. var
  630. newsize : tcgsize;
  631. begin
  632. { we reuse the old value }
  633. location_copy(location,left.location);
  634. { Floats should never be returned as LOC_CONSTANT, do the
  635. moving to memory before the new size is set.
  636. Also when converting from a float to a non-float
  637. or the other way round, move to memory first to prevent
  638. invalid LOC_FPUREGISTER locations }
  639. if (
  640. (resultdef.typ=floatdef) and
  641. (location.loc=LOC_CONSTANT)
  642. ) or
  643. (
  644. (left.resultdef.typ=floatdef) xor
  645. (resultdef.typ=floatdef)
  646. ) then
  647. location_force_mem(current_asmdata.CurrAsmList,location);
  648. { but use the new size, but we don't know the size of all arrays }
  649. newsize:=def_cgsize(resultdef);
  650. location.size:=newsize;
  651. end;
  652. {$ifdef TESTOBJEXT2}
  653. procedure tcgtypeconvnode.checkobject;
  654. begin
  655. { no checking by default }
  656. end;
  657. {$endif TESTOBJEXT2}
  658. procedure tcgtypeconvnode.pass_generate_code;
  659. begin
  660. { the boolean routines can be called with LOC_JUMP and
  661. call secondpass themselves in the helper }
  662. if not(convtype in [tc_bool_2_int,tc_bool_2_bool,tc_int_2_bool]) then
  663. begin
  664. secondpass(left);
  665. if codegenerror then
  666. exit;
  667. end;
  668. second_call_helper(convtype);
  669. {$ifdef TESTOBJEXT2}
  670. { Check explicit conversions to objects pointers !! }
  671. if p^.explizit and
  672. (p^.resultdef.typ=pointerdef) and
  673. (tpointerdef(p^.resultdef).definition.typ=objectdef) and not
  674. (tobjectdef(tpointerdef(p^.resultdef).definition).isclass) and
  675. ((tobjectdef(tpointerdef(p^.resultdef).definition).options and oo_hasvmt)<>0) and
  676. (cs_check_range in current_settings.localswitches) then
  677. checkobject;
  678. {$endif TESTOBJEXT2}
  679. end;
  680. procedure tcgasnode.pass_generate_code;
  681. begin
  682. secondpass(call);
  683. location_copy(location,call.location);
  684. end;
  685. begin
  686. ctypeconvnode := tcgtypeconvnode;
  687. casnode := tcgasnode;
  688. end.