ncgcnv.pas 36 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839
  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 OS_S8->OS_16 which still needs high 16 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 ((newsize=OS_16) and (def_cgsize(left.resultdef)=OS_S8)) 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. cg.a_load_reg_reg(current_asmdata.CurrAsmList,orgsize,newsize,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. location_copy(location,left.location);
  158. newsize:=def_cgsize(resultdef);
  159. { change of size? change sign only if location is LOC_(C)REGISTER? Then we have to sign/zero-extend }
  160. if (tcgsize2size[newsize]<>tcgsize2size[left.location.size]) or
  161. ((newsize<>left.location.size) and (location.loc in [LOC_REGISTER,LOC_CREGISTER])) then
  162. hlcg.location_force_reg(current_asmdata.CurrAsmList,location,left.resultdef,resultdef,true)
  163. else
  164. location.size:=newsize;
  165. current_procinfo.CurrTrueLabel:=oldTrueLabel;
  166. current_procinfo.CurrFalseLabel:=oldFalseLabel;
  167. exit;
  168. end;
  169. { though ppc/ppc64 doesn't use the generic code, we need to ifdef here
  170. because the code is included into the powerpc compilers }
  171. {$if defined(POWERPC) or defined(POWERPC64)}
  172. resflags.cr := RS_CR0;
  173. resflags.flag:=F_NE;
  174. {$elseif defined(mips)}
  175. resflags.reg1:=NR_NO;
  176. resflags.reg2:=NR_NO;
  177. resflags.cond:=OC_NONE;
  178. {$else}
  179. { Load left node into flag F_NE/F_E }
  180. resflags:=F_NE;
  181. {$endif defined(POWERPC) or defined(POWERPC64)}
  182. case left.location.loc of
  183. LOC_CREFERENCE,
  184. LOC_REFERENCE :
  185. begin
  186. if left.location.size in [OS_64,OS_S64] then
  187. begin
  188. hregister:=cg.getintregister(current_asmdata.CurrAsmList,OS_32);
  189. cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_32,OS_32,left.location.reference,hregister);
  190. href:=left.location.reference;
  191. inc(href.offset,4);
  192. cg.a_op_ref_reg(current_asmdata.CurrAsmList,OP_OR,OS_32,href,hregister);
  193. end
  194. else
  195. begin
  196. hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,true);
  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_FLAGS :
  201. begin
  202. resflags:=left.location.resflags;
  203. end;
  204. LOC_REGISTER,LOC_CREGISTER :
  205. begin
  206. {$ifndef cpu64bitalu}
  207. if left.location.size in [OS_64,OS_S64] then
  208. begin
  209. hregister:=cg.getintregister(current_asmdata.CurrAsmList,OS_32);
  210. cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_32,OS_32,left.location.register64.reglo,hregister);
  211. cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_OR,OS_32,left.location.register64.reghi,hregister);
  212. end
  213. else
  214. {$endif cpu64bitalu}
  215. begin
  216. cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_OR,left.location.size,left.location.register,left.location.register);
  217. end;
  218. end;
  219. LOC_JUMP :
  220. begin
  221. hregister:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
  222. current_asmdata.getjumplabel(hlabel);
  223. cg.a_label(current_asmdata.CurrAsmList,current_procinfo.CurrTrueLabel);
  224. cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT,1,hregister);
  225. cg.a_jmp_always(current_asmdata.CurrAsmList,hlabel);
  226. cg.a_label(current_asmdata.CurrAsmList,current_procinfo.CurrFalseLabel);
  227. cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT,0,hregister);
  228. cg.a_label(current_asmdata.CurrAsmList,hlabel);
  229. cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_OR,OS_INT,hregister,hregister);
  230. end;
  231. else
  232. internalerror(200311301);
  233. end;
  234. { load flags to register }
  235. location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
  236. location.register:=cg.getintregister(current_asmdata.CurrAsmList,location.size);
  237. cg.g_flags2reg(current_asmdata.CurrAsmList,location.size,resflags,location.register);
  238. cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_DEFAULTFLAGS);
  239. if (is_cbool(resultdef)) then
  240. cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_NEG,location.size,location.register,location.register);
  241. current_procinfo.CurrTrueLabel:=oldTrueLabel;
  242. current_procinfo.CurrFalseLabel:=oldFalseLabel;
  243. end;
  244. {$endif cpuflags}
  245. procedure tcgtypeconvnode.second_cstring_to_pchar;
  246. var
  247. hr : treference;
  248. begin
  249. if left.nodetype<>stringconstn then
  250. internalerror(200601131);
  251. if not is_pchar(resultdef) and not is_pwidechar(resultdef) then
  252. internalerror(2014032802);
  253. location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
  254. case tstringconstnode(left).cst_type of
  255. cst_conststring :
  256. begin
  257. location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,resultdef);
  258. hlcg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,left.location.reference,location.register);
  259. end;
  260. cst_shortstring :
  261. begin
  262. inc(left.location.reference.offset);
  263. location.reference.alignment:=1;
  264. location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,resultdef);
  265. hlcg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,left.location.reference,location.register);
  266. end;
  267. cst_widestring,
  268. cst_unicodestring,
  269. cst_ansistring :
  270. begin
  271. if tstringconstnode(left).len=0 then
  272. begin
  273. { FPC_EMPTYCHAR is a widechar -> 2 bytes }
  274. reference_reset(hr,2);
  275. location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,resultdef);
  276. if tf_supports_packages in target_info.flags then
  277. begin
  278. hr.symbol:=current_asmdata.RefAsmSymbol('FPC_EMPTYCHAR'+indirect_suffix);
  279. hlcg.a_load_ref_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,hr,location.register);
  280. end
  281. else
  282. begin
  283. hr.symbol:=current_asmdata.RefAsmSymbol('FPC_EMPTYCHAR');
  284. hlcg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,hr,location.register);
  285. end;
  286. end
  287. else
  288. begin
  289. location_copy(location,left.location);
  290. end;
  291. end;
  292. cst_longstring:
  293. begin
  294. {!!!!!!!}
  295. internalerror(8888);
  296. end;
  297. else
  298. internalerror(200808241);
  299. end;
  300. end;
  301. procedure tcgtypeconvnode.second_cstring_to_int;
  302. begin
  303. { this can't happen because constants are already processed in
  304. pass 1 }
  305. internalerror(200510013);
  306. end;
  307. procedure tcgtypeconvnode.second_string_to_chararray;
  308. begin
  309. if is_chararray(left.resultdef) then
  310. begin
  311. location_copy(location,left.location);
  312. exit;
  313. end;
  314. { should be handled already in resultdef pass (JM) }
  315. internalerror(200108292);
  316. end;
  317. procedure tcgtypeconvnode.second_array_to_pointer;
  318. begin
  319. location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
  320. location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,resultdef);
  321. hlcg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,left.location.reference,location.register);
  322. end;
  323. procedure tcgtypeconvnode.second_pointer_to_array;
  324. begin
  325. { assume natural alignment }
  326. location_reset_ref(location,LOC_REFERENCE,OS_NO,resultdef.alignment);
  327. case left.location.loc of
  328. LOC_CREGISTER,
  329. LOC_REGISTER :
  330. begin
  331. {$ifdef cpu_uses_separate_address_registers}
  332. if getregtype(left.location.register)<>R_ADDRESSREGISTER then
  333. begin
  334. location.reference.base:=rg.getaddressregister(current_asmdata.CurrAsmList);
  335. cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,
  336. left.location.register,location.reference.base);
  337. end
  338. else
  339. {$endif}
  340. hlcg.reference_reset_base(location.reference,left.resultdef,left.location.register,0,location.reference.alignment);
  341. end;
  342. LOC_REFERENCE,
  343. LOC_CREFERENCE,
  344. { tricky type casting of parameters can cause these locations, see tb0593.pp on x86_64-linux }
  345. LOC_SUBSETREG,
  346. LOC_CSUBSETREG,
  347. LOC_SUBSETREF,
  348. LOC_CSUBSETREF:
  349. begin
  350. hlcg.reference_reset_base(location.reference,left.resultdef,
  351. hlcg.getaddressregister(current_asmdata.CurrAsmList,left.resultdef),0,location.reference.alignment);
  352. hlcg.a_load_loc_reg(current_asmdata.CurrAsmList,left.resultdef,left.resultdef,left.location,
  353. location.reference.base);
  354. if left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE] then
  355. location_freetemp(current_asmdata.CurrAsmList,left.location);
  356. end;
  357. LOC_CONSTANT:
  358. begin
  359. location.reference.offset:=left.location.value;
  360. end
  361. else
  362. internalerror(2002032216);
  363. end;
  364. end;
  365. procedure tcgtypeconvnode.second_char_to_string;
  366. begin
  367. location_reset_ref(location,LOC_REFERENCE,OS_NO,2);
  368. case tstringdef(resultdef).stringtype of
  369. st_shortstring :
  370. begin
  371. tg.gethltemp(current_asmdata.CurrAsmList,cshortstringtype,256,tt_normal,location.reference);
  372. hlcg.a_load_loc_ref(current_asmdata.CurrAsmList,left.resultdef,left.resultdef,left.location,
  373. location.reference);
  374. location_freetemp(current_asmdata.CurrAsmList,left.location);
  375. end;
  376. { the rest is removed in the resultdef pass and converted to compilerprocs }
  377. else
  378. internalerror(4179);
  379. end;
  380. end;
  381. procedure tcgtypeconvnode.second_real_to_real;
  382. {$ifdef x86}
  383. var
  384. tr: treference;
  385. {$endif x86}
  386. begin
  387. location_reset(location,expectloc,def_cgsize(resultdef));
  388. {$ifdef x86}
  389. { extended types in memory which should be loaded into the sse unit
  390. must be converted by the fpu first, so force them to be loaded into
  391. the fpu }
  392. if (expectloc=LOC_MMREGISTER) and
  393. (left.location.size in [OS_F80,OS_C64]) then
  394. begin
  395. if (left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) then
  396. hlcg.location_force_fpureg(current_asmdata.CurrAsmList,left.location,left.resultdef,false);
  397. { round them down to the proper precision }
  398. tg.gethltemp(current_asmdata.currasmlist,resultdef,resultdef.size,tt_normal,tr);
  399. cg.a_loadfpu_reg_ref(current_asmdata.CurrAsmList,left.location.size,location.size,left.location.register,tr);
  400. location_reset_ref(left.location,LOC_REFERENCE,location.size,tr.alignment);
  401. left.location.reference:=tr;
  402. left.resultdef:=resultdef;
  403. end;
  404. {$endif x86}
  405. { ARM VFP values are in integer registers when they are function results }
  406. if (left.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
  407. hlcg.location_force_mmregscalar(current_asmdata.CurrAsmList,left.location,left.resultdef,false);
  408. case left.location.loc of
  409. LOC_FPUREGISTER,
  410. LOC_CFPUREGISTER:
  411. begin
  412. case expectloc of
  413. LOC_FPUREGISTER:
  414. begin
  415. { on sparc a move from double -> single means from two to one register. }
  416. { On all other platforms it also needs rounding to avoid that }
  417. { single(double_regvar) = double_regvar is true in all cases }
  418. location.register:=hlcg.getfpuregister(current_asmdata.CurrAsmList,resultdef);
  419. hlcg.a_loadfpu_reg_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,left.location.register,location.register);
  420. end;
  421. LOC_MMREGISTER:
  422. begin
  423. hlcg.location_force_mmregscalar(current_asmdata.CurrAsmList,left.location,left.resultdef,false);
  424. location.register:=cg.getmmregister(current_asmdata.CurrAsmList,location.size);
  425. cg.a_loadmm_reg_reg(current_asmdata.CurrAsmList,left.location.size,location.size,left.location.register,location.register,mms_movescalar);
  426. end
  427. else
  428. internalerror(2003012262);
  429. end;
  430. exit
  431. end;
  432. LOC_CREFERENCE,
  433. LOC_REFERENCE:
  434. begin
  435. if expectloc=LOC_MMREGISTER then
  436. begin
  437. location.register:=cg.getmmregister(current_asmdata.CurrAsmList,location.size);
  438. hlcg.a_loadmm_loc_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,left.location,location.register,mms_movescalar)
  439. end
  440. else
  441. begin
  442. hlcg.location_force_fpureg(current_asmdata.CurrAsmList,left.location,left.resultdef,false);
  443. location.register:=cg.getfpuregister(current_asmdata.CurrAsmList,location.size);
  444. hlcg.a_loadfpu_reg_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,left.location.register,location.register);
  445. end;
  446. location_freetemp(current_asmdata.CurrAsmList,left.location);
  447. end;
  448. LOC_MMREGISTER,
  449. LOC_CMMREGISTER:
  450. begin
  451. case expectloc of
  452. LOC_FPUREGISTER:
  453. begin
  454. hlcg.location_force_fpureg(current_asmdata.CurrAsmList,left.location,left.resultdef,false);
  455. location.register:=cg.getfpuregister(current_asmdata.CurrAsmList,location.size);
  456. cg.a_loadfpu_reg_reg(current_asmdata.CurrAsmList,left.location.size,location.size,left.location.register,location.register);
  457. end;
  458. LOC_MMREGISTER:
  459. begin
  460. location.register:=cg.getmmregister(current_asmdata.CurrAsmList,location.size);
  461. cg.a_loadmm_reg_reg(current_asmdata.CurrAsmList,left.location.size,location.size,left.location.register,location.register,mms_movescalar);
  462. end;
  463. else
  464. internalerror(2003012261);
  465. end;
  466. end;
  467. else
  468. internalerror(2002032215);
  469. end;
  470. end;
  471. procedure tcgtypeconvnode.second_cord_to_pointer;
  472. begin
  473. { this can't happen because constants are already processed in
  474. pass 1 }
  475. internalerror(47423985);
  476. end;
  477. procedure tcgtypeconvnode.second_proc_to_procvar;
  478. var
  479. tmpreg: tregister;
  480. begin
  481. if tabstractprocdef(resultdef).is_addressonly then
  482. begin
  483. location_reset(location,LOC_REGISTER,def_cgsize(voidcodepointertype));
  484. { only a code pointer? (when taking the address of classtype.method
  485. we also only get a code pointer even though the resultdef is a
  486. procedure of object, and hence is_addressonly would return false)
  487. }
  488. if left.location.size = def_cgsize(voidcodepointertype) then
  489. begin
  490. case left.location.loc of
  491. LOC_REFERENCE,LOC_CREFERENCE:
  492. begin
  493. { the procedure symbol is encoded in reference.symbol -> take address }
  494. location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,voidcodepointertype);
  495. hlcg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,left.resultdef,voidcodepointertype,left.location.reference,location.register);
  496. end;
  497. else
  498. internalerror(2013031501)
  499. end;
  500. end
  501. else
  502. begin
  503. { conversion from a procedure of object/nested procvar to plain procvar }
  504. case left.location.loc of
  505. LOC_REFERENCE,LOC_CREFERENCE:
  506. begin
  507. location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,voidcodepointertype);
  508. { code field is the first one }
  509. hlcg.a_load_ref_reg(current_asmdata.CurrAsmList,voidcodepointertype,voidcodepointertype,left.location.reference,location.register);
  510. end;
  511. LOC_REGISTER,LOC_CREGISTER:
  512. begin
  513. if target_info.endian=endian_little then
  514. location.register:=left.location.register
  515. else
  516. location.register:=left.location.registerhi;
  517. end;
  518. else
  519. internalerror(2013031502)
  520. end;
  521. end;
  522. end
  523. else
  524. begin
  525. if not tabstractprocdef(left.resultdef).is_addressonly then
  526. location_copy(location,left.location)
  527. else
  528. begin
  529. { assigning a global function to a nested procvar -> create
  530. tmethodpointer record and set the "frame pointer" to nil }
  531. if not(left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
  532. internalerror(2013031503);
  533. location_reset_ref(location,LOC_REFERENCE,int_cgsize(resultdef.size),sizeof(pint));
  534. tg.gethltemp(current_asmdata.CurrAsmList,resultdef,resultdef.size,tt_normal,location.reference);
  535. tmpreg:=hlcg.getaddressregister(current_asmdata.CurrAsmList,voidcodepointertype);
  536. hlcg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,left.resultdef,voidcodepointertype,left.location.reference,tmpreg);
  537. hlcg.a_load_reg_ref(current_asmdata.CurrAsmList,voidcodepointertype,voidcodepointertype,tmpreg,location.reference);
  538. { setting the frame pointer to nil is not strictly necessary
  539. since the global procedure won't use it, but it can help with
  540. debugging }
  541. inc(location.reference.offset,voidcodepointertype.size);
  542. if (resultdef.typ=procvardef) and is_nested_pd(tprocvardef(resultdef)) then
  543. hlcg.a_load_const_ref(current_asmdata.CurrAsmList,parentfpvoidpointertype,0,location.reference)
  544. else if tabstractprocdef(resultdef).is_methodpointer then
  545. hlcg.a_load_const_ref(current_asmdata.CurrAsmList,voidpointertype,0,location.reference)
  546. else
  547. internalerror(2014052301);
  548. dec(location.reference.offset,voidcodepointertype.size);
  549. end;
  550. end;
  551. end;
  552. procedure Tcgtypeconvnode.second_nil_to_methodprocvar;
  553. begin
  554. location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
  555. location.registerhi:=hlcg.getaddressregister(current_asmdata.currasmlist,voidpointertype);
  556. hlcg.a_load_const_reg(current_asmdata.currasmlist,voidpointertype,0,location.registerhi);
  557. location.register:=hlcg.getaddressregister(current_asmdata.currasmlist,voidcodepointertype);
  558. hlcg.a_load_const_reg(current_asmdata.currasmlist,voidcodepointertype,0,location.register);
  559. end;
  560. procedure tcgtypeconvnode.second_bool_to_int;
  561. var
  562. newsize: tcgsize;
  563. oldTrueLabel,oldFalseLabel : tasmlabel;
  564. begin
  565. oldTrueLabel:=current_procinfo.CurrTrueLabel;
  566. oldFalseLabel:=current_procinfo.CurrFalseLabel;
  567. current_asmdata.getjumplabel(current_procinfo.CurrTrueLabel);
  568. current_asmdata.getjumplabel(current_procinfo.CurrFalseLabel);
  569. secondpass(left);
  570. location_copy(location,left.location);
  571. newsize:=def_cgsize(resultdef);
  572. { byte(bytebool) or word(wordbool) or longint(longbool) must be }
  573. { accepted for var parameters and assignments, and must not }
  574. { change the ordinal value or value location. }
  575. { htypechk.valid_for_assign ensures that such locations with a }
  576. { size<sizeof(register) cannot be LOC_CREGISTER (they otherwise }
  577. { could be in case of a plain assignment), and LOC_REGISTER can }
  578. { never be an assignment target. The remaining LOC_REGISTER/ }
  579. { LOC_CREGISTER locations do have to be sign/zero-extended. }
  580. if not(nf_explicit in flags) or
  581. (location.loc in [LOC_FLAGS,LOC_JUMP]) or
  582. { change of size/signedness? Then we have to sign/ }
  583. { zero-extend in case of a loc_(c)register }
  584. ((newsize<>left.location.size) and
  585. ((left.resultdef.size<>resultdef.size) or
  586. not(location.loc in [LOC_REFERENCE,LOC_CREFERENCE]))) then
  587. hlcg.location_force_reg(current_asmdata.CurrAsmList,location,left.resultdef,resultdef,true)
  588. else
  589. { may differ in sign, e.g. bytebool -> byte }
  590. location.size:=newsize;
  591. current_procinfo.CurrTrueLabel:=oldTrueLabel;
  592. current_procinfo.CurrFalseLabel:=oldFalseLabel;
  593. end;
  594. procedure tcgtypeconvnode.second_bool_to_bool;
  595. begin
  596. { we can reuse the conversion already available
  597. in bool_to_int to resize the value. But when the
  598. size of the new boolean is smaller we need to calculate
  599. the value as is done in int_to_bool. This is needed because
  600. the bits that define the true status can be outside the limits
  601. of the new size and truncating the register can result in a 0
  602. value }
  603. if (left.expectloc in [LOC_FLAGS,LOC_JUMP]) and
  604. { a cbool must be converted to -1/0 }
  605. not is_cbool(resultdef) then
  606. begin
  607. secondpass(left);
  608. if (left.location.loc <> left.expectloc) then
  609. internalerror(2010081601);
  610. location_copy(location,left.location);
  611. end
  612. else if (resultdef.size=left.resultdef.size) and
  613. (is_cbool(resultdef)=is_cbool(left.resultdef)) then
  614. second_bool_to_int
  615. else
  616. begin
  617. if (resultdef.size<>left.resultdef.size) then
  618. { remove nf_explicit to perform full conversion if boolean sizes are different }
  619. exclude(flags, nf_explicit);
  620. second_int_to_bool;
  621. end;
  622. end;
  623. procedure tcgtypeconvnode.second_ansistring_to_pchar;
  624. var
  625. l1 : tasmlabel;
  626. hr : treference;
  627. begin
  628. location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
  629. current_asmdata.getjumplabel(l1);
  630. location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,resultdef);
  631. hlcg.a_load_loc_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,
  632. left.location,location.register);
  633. hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,resultdef,OC_NE,0,location.register,l1);
  634. { FPC_EMPTYCHAR is a widechar -> 2 bytes }
  635. reference_reset(hr,2);
  636. if tf_supports_packages in target_info.flags then
  637. begin
  638. hr.symbol:=current_asmdata.RefAsmSymbol('FPC_EMPTYCHAR'+indirect_suffix);
  639. hlcg.a_load_ref_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,hr,location.register);
  640. end
  641. else
  642. begin
  643. hr.symbol:=current_asmdata.RefAsmSymbol('FPC_EMPTYCHAR');
  644. hlcg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,hr,location.register);
  645. end;
  646. hlcg.a_label(current_asmdata.CurrAsmList,l1);
  647. end;
  648. procedure tcgtypeconvnode.second_class_to_intf;
  649. var
  650. l1 : tasmlabel;
  651. hd : tobjectdef;
  652. ImplIntf : TImplementedInterface;
  653. begin
  654. l1:=nil;
  655. location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
  656. case left.location.loc of
  657. LOC_CREFERENCE,
  658. LOC_REFERENCE:
  659. begin
  660. location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,resultdef);
  661. hlcg.a_load_ref_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,left.location.reference,location.register);
  662. location_freetemp(current_asmdata.CurrAsmList,left.location);
  663. end;
  664. LOC_CREGISTER:
  665. begin
  666. location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,resultdef);
  667. hlcg.a_load_reg_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,left.location.register,location.register);
  668. end;
  669. LOC_REGISTER:
  670. location.register:=left.location.register;
  671. else
  672. internalerror(121120001);
  673. end;
  674. hd:=tobjectdef(left.resultdef);
  675. while assigned(hd) do
  676. begin
  677. ImplIntf:=find_implemented_interface(hd,tobjectdef(resultdef));
  678. if assigned(ImplIntf) then
  679. begin
  680. case ImplIntf.IType of
  681. etStandard:
  682. begin
  683. current_asmdata.getjumplabel(l1);
  684. hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,resultdef,OC_EQ,0,location.register,l1);
  685. { todo: consider adding far pointer support to hlcg.a_op_const_reg for i8086 (i.e. perform the
  686. arithmetic operation only on the offset), then the next line can be converted to the
  687. high level code generator as well }
  688. cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_ADD,OS_ADDR,ImplIntf.ioffset,location.register);
  689. break;
  690. end;
  691. else
  692. internalerror(200802163);
  693. end;
  694. end;
  695. hd:=hd.childof;
  696. end;
  697. if hd=nil then
  698. internalerror(2002081301);
  699. if l1=nil then
  700. internalerror(2013120101);
  701. cg.a_label(current_asmdata.CurrAsmList,l1);
  702. end;
  703. procedure tcgtypeconvnode.second_char_to_char;
  704. begin
  705. internalerror(2007081202);
  706. end;
  707. procedure tcgtypeconvnode.second_elem_to_openarray;
  708. begin
  709. { nothing special to do by default }
  710. second_nothing;
  711. end;
  712. procedure tcgtypeconvnode.second_nothing;
  713. var
  714. newsize : tcgsize;
  715. begin
  716. { we reuse the old value }
  717. location_copy(location,left.location);
  718. { Floats should never be returned as LOC_CONSTANT, do the
  719. moving to memory before the new size is set.
  720. Also when converting from a float to a non-float
  721. move to memory first to prevent
  722. invalid LOC_(C)MM/FPUREGISTER locations }
  723. if (
  724. (resultdef.typ=floatdef) and
  725. (location.loc=LOC_CONSTANT)
  726. ) or
  727. ((resultdef.typ=floatdef) xor (location.loc in [LOC_CFPUREGISTER,LOC_FPUREGISTER,LOC_CMMREGISTER,LOC_MMREGISTER])) then
  728. hlcg.location_force_mem(current_asmdata.CurrAsmList,location,left.resultdef);
  729. { but use the new size, but we don't know the size of all arrays }
  730. newsize:=def_cgsize(resultdef);
  731. location.size:=newsize;
  732. end;
  733. {$ifdef TESTOBJEXT2}
  734. procedure tcgtypeconvnode.checkobject;
  735. begin
  736. { no checking by default }
  737. end;
  738. {$endif TESTOBJEXT2}
  739. procedure tcgtypeconvnode.pass_generate_code;
  740. begin
  741. { the boolean routines can be called with LOC_JUMP and
  742. call secondpass themselves in the helper }
  743. if not(convtype in [tc_bool_2_int,tc_bool_2_bool,tc_int_2_bool]) then
  744. begin
  745. secondpass(left);
  746. if codegenerror then
  747. exit;
  748. end;
  749. second_call_helper(convtype);
  750. {$ifdef TESTOBJEXT2}
  751. { Check explicit conversions to objects pointers !! }
  752. if p^.explizit and
  753. (p^.resultdef.typ=pointerdef) and
  754. (tpointerdef(p^.resultdef).definition.typ=objectdef) and not
  755. (tobjectdef(tpointerdef(p^.resultdef).definition).isclass) and
  756. ((tobjectdef(tpointerdef(p^.resultdef).definition).options and oo_hasvmt)<>0) and
  757. (cs_check_range in current_settings.localswitches) then
  758. checkobject;
  759. {$endif TESTOBJEXT2}
  760. end;
  761. procedure tcgasnode.pass_generate_code;
  762. begin
  763. secondpass(call);
  764. location_copy(location,call.location);
  765. end;
  766. begin
  767. ctypeconvnode := tcgtypeconvnode;
  768. casnode := tcgasnode;
  769. end.