ncgcnv.pas 35 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828
  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. 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. { 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,left.resultdef,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. begin
  364. location_reset_ref(location,LOC_REFERENCE,OS_NO,2);
  365. case tstringdef(resultdef).stringtype of
  366. st_shortstring :
  367. begin
  368. tg.gethltemp(current_asmdata.CurrAsmList,cshortstringtype,256,tt_normal,location.reference);
  369. hlcg.a_load_loc_ref(current_asmdata.CurrAsmList,left.resultdef,left.resultdef,left.location,
  370. location.reference);
  371. location_freetemp(current_asmdata.CurrAsmList,left.location);
  372. end;
  373. { the rest is removed in the resultdef pass and converted to compilerprocs }
  374. else
  375. internalerror(4179);
  376. end;
  377. end;
  378. procedure tcgtypeconvnode.second_real_to_real;
  379. {$ifdef x86}
  380. var
  381. tr: treference;
  382. {$endif x86}
  383. begin
  384. location_reset(location,expectloc,def_cgsize(resultdef));
  385. {$ifdef x86}
  386. { extended types in memory which should be loaded into the sse unit
  387. must be converted by the fpu first, so force them to be loaded into
  388. the fpu }
  389. if (expectloc=LOC_MMREGISTER) and
  390. (left.location.size in [OS_F80,OS_C64]) then
  391. begin
  392. if (left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) then
  393. hlcg.location_force_fpureg(current_asmdata.CurrAsmList,left.location,left.resultdef,false);
  394. { round them down to the proper precision }
  395. tg.gethltemp(current_asmdata.currasmlist,resultdef,resultdef.size,tt_normal,tr);
  396. cg.a_loadfpu_reg_ref(current_asmdata.CurrAsmList,left.location.size,location.size,left.location.register,tr);
  397. location_reset_ref(left.location,LOC_REFERENCE,location.size,tr.alignment);
  398. left.location.reference:=tr;
  399. left.resultdef:=resultdef;
  400. end;
  401. {$endif x86}
  402. { ARM VFP values are in integer registers when they are function results }
  403. if (left.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
  404. hlcg.location_force_mmregscalar(current_asmdata.CurrAsmList,left.location,left.resultdef,false);
  405. case left.location.loc of
  406. LOC_FPUREGISTER,
  407. LOC_CFPUREGISTER:
  408. begin
  409. case expectloc of
  410. LOC_FPUREGISTER:
  411. begin
  412. { on sparc a move from double -> single means from two to one register. }
  413. { On all other platforms it also needs rounding to avoid that }
  414. { single(double_regvar) = double_regvar is true in all cases }
  415. location.register:=hlcg.getfpuregister(current_asmdata.CurrAsmList,resultdef);
  416. hlcg.a_loadfpu_reg_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,left.location.register,location.register);
  417. end;
  418. LOC_MMREGISTER:
  419. begin
  420. hlcg.location_force_mmregscalar(current_asmdata.CurrAsmList,left.location,left.resultdef,false);
  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(2003012262);
  426. end;
  427. exit
  428. end;
  429. LOC_CREFERENCE,
  430. LOC_REFERENCE:
  431. begin
  432. if expectloc=LOC_MMREGISTER then
  433. begin
  434. location.register:=cg.getmmregister(current_asmdata.CurrAsmList,location.size);
  435. hlcg.a_loadmm_loc_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,left.location,location.register,mms_movescalar)
  436. end
  437. else
  438. begin
  439. hlcg.location_force_fpureg(current_asmdata.CurrAsmList,left.location,left.resultdef,false);
  440. location.register:=cg.getfpuregister(current_asmdata.CurrAsmList,location.size);
  441. hlcg.a_loadfpu_reg_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,left.location.register,location.register);
  442. end;
  443. location_freetemp(current_asmdata.CurrAsmList,left.location);
  444. end;
  445. LOC_MMREGISTER,
  446. LOC_CMMREGISTER:
  447. begin
  448. case expectloc of
  449. LOC_FPUREGISTER:
  450. begin
  451. hlcg.location_force_fpureg(current_asmdata.CurrAsmList,left.location,left.resultdef,false);
  452. location.register:=cg.getfpuregister(current_asmdata.CurrAsmList,location.size);
  453. cg.a_loadfpu_reg_reg(current_asmdata.CurrAsmList,left.location.size,location.size,left.location.register,location.register);
  454. end;
  455. LOC_MMREGISTER:
  456. begin
  457. location.register:=cg.getmmregister(current_asmdata.CurrAsmList,location.size);
  458. cg.a_loadmm_reg_reg(current_asmdata.CurrAsmList,left.location.size,location.size,left.location.register,location.register,mms_movescalar);
  459. end;
  460. else
  461. internalerror(2003012261);
  462. end;
  463. end;
  464. else
  465. internalerror(2002032215);
  466. end;
  467. end;
  468. procedure tcgtypeconvnode.second_cord_to_pointer;
  469. begin
  470. { this can't happen because constants are already processed in
  471. pass 1 }
  472. internalerror(47423985);
  473. end;
  474. procedure tcgtypeconvnode.second_proc_to_procvar;
  475. var
  476. tmpreg: tregister;
  477. begin
  478. if tabstractprocdef(resultdef).is_addressonly then
  479. begin
  480. location_reset(location,LOC_REGISTER,def_cgsize(voidcodepointertype));
  481. { only a code pointer? (when taking the address of classtype.method
  482. we also only get a code pointer even though the resultdef is a
  483. procedure of object, and hence is_addressonly would return false)
  484. }
  485. if left.location.size = def_cgsize(voidcodepointertype) then
  486. begin
  487. case left.location.loc of
  488. LOC_REFERENCE,LOC_CREFERENCE:
  489. begin
  490. { the procedure symbol is encoded in reference.symbol -> take address }
  491. location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,voidcodepointertype);
  492. hlcg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,left.resultdef,voidcodepointertype,left.location.reference,location.register);
  493. end;
  494. else
  495. internalerror(2013031501)
  496. end;
  497. end
  498. else
  499. begin
  500. { conversion from a procedure of object/nested procvar to plain procvar }
  501. case left.location.loc of
  502. LOC_REFERENCE,LOC_CREFERENCE:
  503. begin
  504. location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,voidcodepointertype);
  505. { code field is the first one }
  506. hlcg.a_load_ref_reg(current_asmdata.CurrAsmList,voidcodepointertype,voidcodepointertype,left.location.reference,location.register);
  507. end;
  508. LOC_REGISTER,LOC_CREGISTER:
  509. begin
  510. if target_info.endian=endian_little then
  511. location.register:=left.location.register
  512. else
  513. location.register:=left.location.registerhi;
  514. end;
  515. else
  516. internalerror(2013031502)
  517. end;
  518. end;
  519. end
  520. else
  521. begin
  522. if not tabstractprocdef(left.resultdef).is_addressonly then
  523. location_copy(location,left.location)
  524. else
  525. begin
  526. { assigning a global function to a nested procvar -> create
  527. tmethodpointer record and set the "frame pointer" to nil }
  528. if not(left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
  529. internalerror(2013031503);
  530. location_reset_ref(location,LOC_REFERENCE,int_cgsize(resultdef.size),sizeof(pint));
  531. tg.gethltemp(current_asmdata.CurrAsmList,resultdef,resultdef.size,tt_normal,location.reference);
  532. tmpreg:=hlcg.getaddressregister(current_asmdata.CurrAsmList,voidcodepointertype);
  533. hlcg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,left.resultdef,voidcodepointertype,left.location.reference,tmpreg);
  534. hlcg.a_load_reg_ref(current_asmdata.CurrAsmList,voidcodepointertype,voidcodepointertype,tmpreg,location.reference);
  535. { setting the frame pointer to nil is not strictly necessary
  536. since the global procedure won't use it, but it can help with
  537. debugging }
  538. inc(location.reference.offset,voidcodepointertype.size);
  539. if (resultdef.typ=procvardef) and is_nested_pd(tprocvardef(resultdef)) then
  540. hlcg.a_load_const_ref(current_asmdata.CurrAsmList,parentfpvoidpointertype,0,location.reference)
  541. else if tabstractprocdef(resultdef).is_methodpointer then
  542. hlcg.a_load_const_ref(current_asmdata.CurrAsmList,voidpointertype,0,location.reference)
  543. else
  544. internalerror(2014052301);
  545. dec(location.reference.offset,voidcodepointertype.size);
  546. end;
  547. end;
  548. end;
  549. procedure Tcgtypeconvnode.second_nil_to_methodprocvar;
  550. begin
  551. location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
  552. location.registerhi:=hlcg.getaddressregister(current_asmdata.currasmlist,voidpointertype);
  553. hlcg.a_load_const_reg(current_asmdata.currasmlist,voidpointertype,0,location.registerhi);
  554. location.register:=hlcg.getaddressregister(current_asmdata.currasmlist,voidcodepointertype);
  555. hlcg.a_load_const_reg(current_asmdata.currasmlist,voidcodepointertype,0,location.register);
  556. end;
  557. procedure tcgtypeconvnode.second_bool_to_int;
  558. var
  559. newsize: tcgsize;
  560. oldTrueLabel,oldFalseLabel : tasmlabel;
  561. begin
  562. oldTrueLabel:=current_procinfo.CurrTrueLabel;
  563. oldFalseLabel:=current_procinfo.CurrFalseLabel;
  564. current_asmdata.getjumplabel(current_procinfo.CurrTrueLabel);
  565. current_asmdata.getjumplabel(current_procinfo.CurrFalseLabel);
  566. secondpass(left);
  567. location_copy(location,left.location);
  568. newsize:=def_cgsize(resultdef);
  569. { byte(bytebool) or word(wordbool) or longint(longbool) must be }
  570. { accepted for var parameters and assignments, and must not }
  571. { change the ordinal value or value location. }
  572. { htypechk.valid_for_assign ensures that such locations with a }
  573. { size<sizeof(register) cannot be LOC_CREGISTER (they otherwise }
  574. { could be in case of a plain assignment), and LOC_REGISTER can }
  575. { never be an assignment target. The remaining LOC_REGISTER/ }
  576. { LOC_CREGISTER locations do have to be sign/zero-extended. }
  577. if not(nf_explicit in flags) or
  578. (location.loc in [LOC_FLAGS,LOC_JUMP]) or
  579. { change of size/signedness? Then we have to sign/ }
  580. { zero-extend in case of a loc_(c)register }
  581. ((newsize<>left.location.size) and
  582. ((left.resultdef.size<>resultdef.size) or
  583. not(location.loc in [LOC_REFERENCE,LOC_CREFERENCE]))) then
  584. hlcg.location_force_reg(current_asmdata.CurrAsmList,location,left.resultdef,resultdef,true)
  585. else
  586. { may differ in sign, e.g. bytebool -> byte }
  587. location.size:=newsize;
  588. current_procinfo.CurrTrueLabel:=oldTrueLabel;
  589. current_procinfo.CurrFalseLabel:=oldFalseLabel;
  590. end;
  591. procedure tcgtypeconvnode.second_bool_to_bool;
  592. begin
  593. { we can reuse the conversion already available
  594. in bool_to_int to resize the value. But when the
  595. size of the new boolean is smaller we need to calculate
  596. the value as is done in int_to_bool. This is needed because
  597. the bits that define the true status can be outside the limits
  598. of the new size and truncating the register can result in a 0
  599. value }
  600. if (left.expectloc in [LOC_FLAGS,LOC_JUMP]) and
  601. { a cbool must be converted to -1/0 }
  602. not is_cbool(resultdef) then
  603. begin
  604. secondpass(left);
  605. if (left.location.loc <> left.expectloc) then
  606. internalerror(2010081601);
  607. location_copy(location,left.location);
  608. end
  609. else if (resultdef.size=left.resultdef.size) and
  610. (is_cbool(resultdef)=is_cbool(left.resultdef)) then
  611. second_bool_to_int
  612. else
  613. begin
  614. if (resultdef.size<>left.resultdef.size) then
  615. { remove nf_explicit to perform full conversion if boolean sizes are different }
  616. exclude(flags, nf_explicit);
  617. second_int_to_bool;
  618. end;
  619. end;
  620. procedure tcgtypeconvnode.second_ansistring_to_pchar;
  621. var
  622. l1 : tasmlabel;
  623. hr : treference;
  624. begin
  625. location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
  626. current_asmdata.getjumplabel(l1);
  627. location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,resultdef);
  628. hlcg.a_load_loc_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,
  629. left.location,location.register);
  630. hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,resultdef,OC_NE,0,location.register,l1);
  631. { FPC_EMPTYCHAR is a widechar -> 2 bytes }
  632. reference_reset(hr,2);
  633. hr.symbol:=current_asmdata.RefAsmSymbol('FPC_EMPTYCHAR');
  634. hlcg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,hr,location.register);
  635. hlcg.a_label(current_asmdata.CurrAsmList,l1);
  636. end;
  637. procedure tcgtypeconvnode.second_class_to_intf;
  638. var
  639. l1 : tasmlabel;
  640. hd : tobjectdef;
  641. ImplIntf : TImplementedInterface;
  642. begin
  643. l1:=nil;
  644. location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
  645. case left.location.loc of
  646. LOC_CREFERENCE,
  647. LOC_REFERENCE:
  648. begin
  649. location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,resultdef);
  650. hlcg.a_load_ref_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,left.location.reference,location.register);
  651. location_freetemp(current_asmdata.CurrAsmList,left.location);
  652. end;
  653. LOC_CREGISTER:
  654. begin
  655. location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,resultdef);
  656. hlcg.a_load_reg_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,left.location.register,location.register);
  657. end;
  658. LOC_REGISTER:
  659. location.register:=left.location.register;
  660. else
  661. internalerror(121120001);
  662. end;
  663. hd:=tobjectdef(left.resultdef);
  664. while assigned(hd) do
  665. begin
  666. ImplIntf:=find_implemented_interface(hd,tobjectdef(resultdef));
  667. if assigned(ImplIntf) then
  668. begin
  669. case ImplIntf.IType of
  670. etStandard:
  671. begin
  672. current_asmdata.getjumplabel(l1);
  673. hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,resultdef,OC_EQ,0,location.register,l1);
  674. { todo: consider adding far pointer support to hlcg.a_op_const_reg for i8086 (i.e. perform the
  675. arithmetic operation only on the offset), then the next line can be converted to the
  676. high level code generator as well }
  677. cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_ADD,OS_ADDR,ImplIntf.ioffset,location.register);
  678. break;
  679. end;
  680. else
  681. internalerror(200802163);
  682. end;
  683. end;
  684. hd:=hd.childof;
  685. end;
  686. if hd=nil then
  687. internalerror(2002081301);
  688. if l1=nil then
  689. internalerror(2013120101);
  690. cg.a_label(current_asmdata.CurrAsmList,l1);
  691. end;
  692. procedure tcgtypeconvnode.second_char_to_char;
  693. begin
  694. internalerror(2007081202);
  695. end;
  696. procedure tcgtypeconvnode.second_elem_to_openarray;
  697. begin
  698. { nothing special to do by default }
  699. second_nothing;
  700. end;
  701. procedure tcgtypeconvnode.second_nothing;
  702. var
  703. newsize : tcgsize;
  704. begin
  705. { we reuse the old value }
  706. location_copy(location,left.location);
  707. { Floats should never be returned as LOC_CONSTANT, do the
  708. moving to memory before the new size is set.
  709. Also when converting from a float to a non-float
  710. move to memory first to prevent
  711. invalid LOC_(C)MM/FPUREGISTER locations }
  712. if (
  713. (resultdef.typ=floatdef) and
  714. (location.loc=LOC_CONSTANT)
  715. ) or
  716. ((resultdef.typ=floatdef) xor (location.loc in [LOC_CFPUREGISTER,LOC_FPUREGISTER,LOC_CMMREGISTER,LOC_MMREGISTER])) then
  717. hlcg.location_force_mem(current_asmdata.CurrAsmList,location,left.resultdef);
  718. { but use the new size, but we don't know the size of all arrays }
  719. newsize:=def_cgsize(resultdef);
  720. location.size:=newsize;
  721. end;
  722. {$ifdef TESTOBJEXT2}
  723. procedure tcgtypeconvnode.checkobject;
  724. begin
  725. { no checking by default }
  726. end;
  727. {$endif TESTOBJEXT2}
  728. procedure tcgtypeconvnode.pass_generate_code;
  729. begin
  730. { the boolean routines can be called with LOC_JUMP and
  731. call secondpass themselves in the helper }
  732. if not(convtype in [tc_bool_2_int,tc_bool_2_bool,tc_int_2_bool]) then
  733. begin
  734. secondpass(left);
  735. if codegenerror then
  736. exit;
  737. end;
  738. second_call_helper(convtype);
  739. {$ifdef TESTOBJEXT2}
  740. { Check explicit conversions to objects pointers !! }
  741. if p^.explizit and
  742. (p^.resultdef.typ=pointerdef) and
  743. (tpointerdef(p^.resultdef).definition.typ=objectdef) and not
  744. (tobjectdef(tpointerdef(p^.resultdef).definition).isclass) and
  745. ((tobjectdef(tpointerdef(p^.resultdef).definition).options and oo_hasvmt)<>0) and
  746. (cs_check_range in current_settings.localswitches) then
  747. checkobject;
  748. {$endif TESTOBJEXT2}
  749. end;
  750. procedure tcgasnode.pass_generate_code;
  751. begin
  752. secondpass(call);
  753. location_copy(location,call.location);
  754. end;
  755. begin
  756. ctypeconvnode := tcgtypeconvnode;
  757. casnode := tcgasnode;
  758. end.