ncgcnv.pas 31 KB

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