ncgcnv.pas 31 KB

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