ncgcnv.pas 35 KB

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