n386cnv.pas 54 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543
  1. {
  2. $Id$
  3. Copyright (c) 1998-2000 by Florian Klaempfl
  4. Generate i386 assembler for type converting nodes
  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 n386cnv;
  19. {$i defines.inc}
  20. interface
  21. uses
  22. node,ncnv,types;
  23. type
  24. ti386typeconvnode = class(ttypeconvnode)
  25. procedure second_int_to_int;virtual;
  26. procedure second_string_to_string;virtual;
  27. procedure second_cstring_to_pchar;virtual;
  28. procedure second_string_to_chararray;virtual;
  29. procedure second_array_to_pointer;virtual;
  30. procedure second_pointer_to_array;virtual;
  31. procedure second_chararray_to_string;virtual;
  32. procedure second_char_to_string;virtual;
  33. procedure second_int_to_real;virtual;
  34. procedure second_real_to_fix;virtual;
  35. procedure second_real_to_real;virtual;
  36. procedure second_fix_to_real;virtual;
  37. procedure second_cord_to_pointer;virtual;
  38. procedure second_int_to_fix;virtual;
  39. procedure second_proc_to_procvar;virtual;
  40. procedure second_bool_to_int;virtual;
  41. procedure second_int_to_bool;virtual;
  42. procedure second_load_smallset;virtual;
  43. procedure second_ansistring_to_pchar;virtual;
  44. procedure second_pchar_to_string;virtual;
  45. procedure second_class_to_intf;virtual;
  46. procedure second_nothing;virtual;
  47. procedure pass_2;override;
  48. procedure second_call_helper(c : tconverttype);
  49. end;
  50. ti386asnode = class(tasnode)
  51. procedure pass_2;override;
  52. end;
  53. ti386isnode = class(tisnode)
  54. procedure pass_2;override;
  55. end;
  56. implementation
  57. uses
  58. verbose,globals,systems,
  59. symconst,symdef,aasm,
  60. hcodegen,temp_gen,pass_2,
  61. ncon,ncal,
  62. cpubase,cpuasm,
  63. cgai386,tgcpu,n386util;
  64. {*****************************************************************************
  65. SecondTypeConv
  66. *****************************************************************************}
  67. procedure ti386typeconvnode.second_int_to_int;
  68. var
  69. op : tasmop;
  70. opsize : topsize;
  71. hregister,
  72. hregister2 : tregister;
  73. l : pasmlabel;
  74. begin
  75. { insert range check if not explicit conversion }
  76. if not(nf_explizit in flags) then
  77. emitrangecheck(left,resulttype);
  78. { is the result size smaller ? }
  79. if resulttype^.size<left.resulttype^.size then
  80. begin
  81. { only need to set the new size of a register }
  82. if (left.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
  83. begin
  84. case resulttype^.size of
  85. 1 : location.register:=makereg8(left.location.register);
  86. 2 : location.register:=makereg16(left.location.register);
  87. 4 : location.register:=makereg32(left.location.register);
  88. end;
  89. { we can release the upper register }
  90. if is_64bitint(left.resulttype) then
  91. ungetregister32(left.location.registerhigh);
  92. end;
  93. end
  94. { is the result size bigger ? }
  95. else if resulttype^.size>left.resulttype^.size then
  96. begin
  97. { remove reference }
  98. if not(left.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
  99. begin
  100. del_reference(left.location.reference);
  101. { we can do this here as we need no temp inside }
  102. ungetiftemp(left.location.reference);
  103. end;
  104. { get op and opsize, handle separate for constants, because
  105. movz doesn't support constant values }
  106. if (left.location.loc=LOC_MEM) and (left.location.reference.is_immediate) then
  107. begin
  108. if is_64bitint(resulttype) then
  109. opsize:=S_L
  110. else
  111. opsize:=def_opsize(resulttype);
  112. op:=A_MOV;
  113. end
  114. else
  115. begin
  116. opsize:=def2def_opsize(left.resulttype,resulttype);
  117. if opsize in [S_B,S_W,S_L] then
  118. op:=A_MOV
  119. else
  120. if is_signed(left.resulttype) then
  121. op:=A_MOVSX
  122. else
  123. op:=A_MOVZX;
  124. end;
  125. { load the register we need }
  126. if left.location.loc<>LOC_REGISTER then
  127. hregister:=getregister32
  128. else
  129. hregister:=left.location.register;
  130. { set the correct register size and location }
  131. clear_location(location);
  132. location.loc:=LOC_REGISTER;
  133. { do we need a second register for a 64 bit type ? }
  134. if is_64bitint(resulttype) then
  135. begin
  136. hregister2:=getregister32;
  137. location.registerhigh:=hregister2;
  138. end;
  139. case resulttype^.size of
  140. 1:
  141. location.register:=makereg8(hregister);
  142. 2:
  143. location.register:=makereg16(hregister);
  144. 4,8:
  145. location.register:=makereg32(hregister);
  146. end;
  147. { insert the assembler code }
  148. if left.location.loc in [LOC_CREGISTER,LOC_REGISTER] then
  149. emit_reg_reg(op,opsize,left.location.register,location.register)
  150. else
  151. emit_ref_reg(op,opsize,
  152. newreference(left.location.reference),location.register);
  153. { do we need a sign extension for int64? }
  154. if is_64bitint(resulttype) then
  155. { special case for constants (JM) }
  156. if is_constintnode(left) then
  157. begin
  158. if tordconstnode(left).value >= 0 then
  159. emit_reg_reg(A_XOR,S_L,
  160. hregister2,hregister2)
  161. else
  162. emit_const_reg(A_MOV,S_L,longint($ffffffff),hregister2);
  163. end
  164. else
  165. begin
  166. emit_reg_reg(A_XOR,S_L,
  167. hregister2,hregister2);
  168. if (porddef(resulttype)^.typ=s64bit) and
  169. is_signed(left.resulttype) then
  170. begin
  171. getlabel(l);
  172. emit_const_reg(A_TEST,S_L,longint($80000000),makereg32(hregister));
  173. emitjmp(C_Z,l);
  174. emit_reg(A_NOT,S_L,
  175. hregister2);
  176. emitlab(l);
  177. end;
  178. end;
  179. end;
  180. end;
  181. procedure ti386typeconvnode.second_string_to_string;
  182. var
  183. pushed : tpushed;
  184. regs_to_push: byte;
  185. begin
  186. { does anybody know a better solution than this big case statement ? }
  187. { ok, a proc table would do the job }
  188. case pstringdef(resulttype)^.string_typ of
  189. st_shortstring:
  190. case pstringdef(left.resulttype)^.string_typ of
  191. st_shortstring:
  192. begin
  193. gettempofsizereference(resulttype^.size,location.reference);
  194. copyshortstring(location.reference,left.location.reference,
  195. pstringdef(resulttype)^.len,false,true);
  196. { done by copyshortstring now (JM) }
  197. { del_reference(left.location.reference); }
  198. ungetiftemp(left.location.reference);
  199. end;
  200. st_longstring:
  201. begin
  202. {!!!!!!!}
  203. internalerror(8888);
  204. end;
  205. st_ansistring:
  206. begin
  207. gettempofsizereference(resulttype^.size,location.reference);
  208. loadansi2short(left,self);
  209. { this is done in secondtypeconv (FK)
  210. removetemps(exprasmlist,temptoremove);
  211. destroys:=true;
  212. }
  213. end;
  214. st_widestring:
  215. begin
  216. {!!!!!!!}
  217. internalerror(8888);
  218. end;
  219. end;
  220. st_longstring:
  221. case pstringdef(left.resulttype)^.string_typ of
  222. st_shortstring:
  223. begin
  224. {!!!!!!!}
  225. internalerror(8888);
  226. end;
  227. st_ansistring:
  228. begin
  229. {!!!!!!!}
  230. internalerror(8888);
  231. end;
  232. st_widestring:
  233. begin
  234. {!!!!!!!}
  235. internalerror(8888);
  236. end;
  237. end;
  238. st_ansistring:
  239. case pstringdef(left.resulttype)^.string_typ of
  240. st_shortstring:
  241. begin
  242. clear_location(location);
  243. location.loc:=LOC_REFERENCE;
  244. gettempansistringreference(location.reference);
  245. decrstringref(cansistringdef,location.reference);
  246. { We don't need the source regs anymore (JM) }
  247. regs_to_push := $ff;
  248. remove_non_regvars_from_loc(left.location,regs_to_push);
  249. pushusedregisters(pushed,regs_to_push);
  250. release_loc(left.location);
  251. emit_push_lea_loc(left.location,true);
  252. emit_push_lea_loc(location,false);
  253. saveregvars(regs_to_push);
  254. emitcall('FPC_SHORTSTR_TO_ANSISTR');
  255. maybe_loadesi;
  256. popusedregisters(pushed);
  257. end;
  258. st_longstring:
  259. begin
  260. {!!!!!!!}
  261. internalerror(8888);
  262. end;
  263. st_widestring:
  264. begin
  265. {!!!!!!!}
  266. internalerror(8888);
  267. end;
  268. end;
  269. st_widestring:
  270. case pstringdef(left.resulttype)^.string_typ of
  271. st_shortstring:
  272. begin
  273. {!!!!!!!}
  274. internalerror(8888);
  275. end;
  276. st_longstring:
  277. begin
  278. {!!!!!!!}
  279. internalerror(8888);
  280. end;
  281. st_ansistring:
  282. begin
  283. {!!!!!!!}
  284. internalerror(8888);
  285. end;
  286. st_widestring:
  287. begin
  288. {!!!!!!!}
  289. internalerror(8888);
  290. end;
  291. end;
  292. end;
  293. end;
  294. procedure ti386typeconvnode.second_cstring_to_pchar;
  295. var
  296. hr : preference;
  297. begin
  298. clear_location(location);
  299. location.loc:=LOC_REGISTER;
  300. location.register:=getregister32;
  301. case pstringdef(left.resulttype)^.string_typ of
  302. st_shortstring :
  303. begin
  304. inc(left.location.reference.offset);
  305. emit_ref_reg(A_LEA,S_L,newreference(left.location.reference),
  306. location.register);
  307. end;
  308. st_ansistring :
  309. begin
  310. if (left.nodetype=stringconstn) and
  311. (str_length(left)=0) then
  312. begin
  313. new(hr);
  314. reset_reference(hr^);
  315. hr^.symbol:=newasmsymbol('FPC_EMPTYCHAR');
  316. emit_ref_reg(A_LEA,S_L,hr,location.register);
  317. end
  318. else
  319. emit_ref_reg(A_MOV,S_L,newreference(left.location.reference),
  320. location.register);
  321. end;
  322. st_longstring:
  323. begin
  324. {!!!!!!!}
  325. internalerror(8888);
  326. end;
  327. st_widestring:
  328. begin
  329. {!!!!!!!}
  330. internalerror(8888);
  331. end;
  332. end;
  333. end;
  334. procedure ti386typeconvnode.second_string_to_chararray;
  335. var
  336. pushedregs: tpushed;
  337. //l1 : pasmlabel;
  338. //hr : preference;
  339. arrsize, strtype: longint;
  340. regstopush: byte;
  341. begin
  342. with parraydef(resulttype)^ do
  343. arrsize := highrange-lowrange+1;
  344. if (left.nodetype = stringconstn) and
  345. { left.length+1 since there's always a terminating #0 character (JM) }
  346. (tstringconstnode(left).len+1 >= arrsize) and
  347. (pstringdef(left.resulttype)^.string_typ=st_shortstring) then
  348. begin
  349. inc(location.reference.offset);
  350. exit;
  351. end;
  352. clear_location(location);
  353. location.loc := LOC_REFERENCE;
  354. gettempofsizereference(arrsize,location.reference);
  355. regstopush := $ff;
  356. remove_non_regvars_from_loc(left.location,regstopush);
  357. pushusedregisters(pushedregs,regstopush);
  358. emit_push_lea_loc(location,false);
  359. case pstringdef(left.resulttype)^.string_typ of
  360. st_shortstring :
  361. begin
  362. { 0 means shortstring }
  363. strtype := 0;
  364. del_reference(left.location.reference);
  365. emit_push_lea_loc(left.location,true);
  366. ungetiftemp(left.location.reference);
  367. end;
  368. st_ansistring :
  369. begin
  370. { 1 means ansistring }
  371. strtype := 1;
  372. case left.location.loc of
  373. LOC_CREGISTER,LOC_REGISTER:
  374. begin
  375. ungetregister(left.location.register);
  376. emit_push_loc(left.location);
  377. end;
  378. LOC_MEM,LOC_REFERENCE:
  379. begin
  380. del_reference(left.location.reference);
  381. emit_push_loc(left.location);
  382. ungetiftemp(left.location.reference);
  383. end;
  384. end;
  385. end;
  386. st_longstring:
  387. begin
  388. {!!!!!!!}
  389. { 2 means longstring, but still needs support in FPC_STR_TO_CHARARRAY,
  390. which is in i386.inc and/or generic.inc (JM) }
  391. strtype := 2;
  392. internalerror(8888);
  393. end;
  394. st_widestring:
  395. begin
  396. {!!!!!!!}
  397. { 3 means widestring, but still needs support in FPC_STR_TO_CHARARRAY,
  398. which is in i386.inc and/or generic.inc (JM) }
  399. strtype := 3;
  400. internalerror(8888);
  401. end;
  402. end;
  403. push_int(arrsize);
  404. push_int(strtype);
  405. saveregvars(regstopush);
  406. emitcall('FPC_STR_TO_CHARARRAY');
  407. popusedregisters(pushedregs);
  408. end;
  409. procedure ti386typeconvnode.second_array_to_pointer;
  410. begin
  411. del_reference(left.location.reference);
  412. clear_location(location);
  413. location.loc:=LOC_REGISTER;
  414. location.register:=getregister32;
  415. emit_ref_reg(A_LEA,S_L,newreference(left.location.reference),
  416. location.register);
  417. end;
  418. procedure ti386typeconvnode.second_pointer_to_array;
  419. begin
  420. clear_location(location);
  421. location.loc:=LOC_REFERENCE;
  422. reset_reference(location.reference);
  423. case left.location.loc of
  424. LOC_REGISTER :
  425. location.reference.base:=left.location.register;
  426. LOC_CREGISTER :
  427. begin
  428. location.reference.base:=getregister32;
  429. emit_reg_reg(A_MOV,S_L,left.location.register,location.reference.base);
  430. end
  431. else
  432. begin
  433. del_reference(left.location.reference);
  434. location.reference.base:=getregister32;
  435. emit_ref_reg(A_MOV,S_L,newreference(left.location.reference),
  436. location.reference.base);
  437. end;
  438. end;
  439. end;
  440. { generates the code for the type conversion from an array of char }
  441. { to a string }
  442. procedure ti386typeconvnode.second_chararray_to_string;
  443. var
  444. pushed : tpushed;
  445. regstopush: byte;
  446. l : longint;
  447. begin
  448. { calc the length of the array }
  449. l:=parraydef(left.resulttype)^.highrange-parraydef(left.resulttype)^.lowrange+1;
  450. { this is a type conversion which copies the data, so we can't }
  451. { return a reference }
  452. clear_location(location);
  453. location.loc:=LOC_MEM;
  454. case pstringdef(resulttype)^.string_typ of
  455. st_shortstring :
  456. begin
  457. if l>255 then
  458. begin
  459. CGMessage(type_e_mismatch);
  460. l:=255;
  461. end;
  462. gettempofsizereference(resulttype^.size,location.reference);
  463. { we've also to release the registers ... }
  464. { Yes, but before pushusedregisters since that one resets unused! }
  465. { This caused web bug 1073 (JM) }
  466. regstopush := $ff;
  467. remove_non_regvars_from_loc(left.location,regstopush);
  468. pushusedregisters(pushed,regstopush);
  469. if l>=resulttype^.size then
  470. push_int(resulttype^.size-1)
  471. else
  472. push_int(l);
  473. { ... here only the temp. location is released }
  474. emit_push_lea_loc(left.location,true);
  475. del_reference(left.location.reference);
  476. emitpushreferenceaddr(location.reference);
  477. saveregvars(regstopush);
  478. emitcall('FPC_CHARARRAY_TO_SHORTSTR');
  479. maybe_loadesi;
  480. popusedregisters(pushed);
  481. end;
  482. st_ansistring :
  483. begin
  484. gettempansistringreference(location.reference);
  485. decrstringref(cansistringdef,location.reference);
  486. regstopush := $ff;
  487. remove_non_regvars_from_loc(left.location,regstopush);
  488. pushusedregisters(pushed,regstopush);
  489. push_int(l);
  490. emitpushreferenceaddr(left.location.reference);
  491. release_loc(left.location);
  492. emitpushreferenceaddr(location.reference);
  493. saveregvars(regstopush);
  494. emitcall('FPC_CHARARRAY_TO_ANSISTR');
  495. popusedregisters(pushed);
  496. maybe_loadesi;
  497. end;
  498. st_longstring:
  499. begin
  500. {!!!!!!!}
  501. internalerror(8888);
  502. end;
  503. st_widestring:
  504. begin
  505. {!!!!!!!}
  506. internalerror(8888);
  507. end;
  508. end;
  509. end;
  510. procedure ti386typeconvnode.second_char_to_string;
  511. var
  512. pushed : tpushed;
  513. begin
  514. clear_location(location);
  515. location.loc:=LOC_MEM;
  516. case pstringdef(resulttype)^.string_typ of
  517. st_shortstring :
  518. begin
  519. gettempofsizereference(256,location.reference);
  520. loadshortstring(left,self);
  521. end;
  522. st_ansistring :
  523. begin
  524. gettempansistringreference(location.reference);
  525. decrstringref(cansistringdef,location.reference);
  526. release_loc(left.location);
  527. pushusedregisters(pushed,$ff);
  528. emit_pushw_loc(left.location);
  529. emitpushreferenceaddr(location.reference);
  530. saveregvars($ff);
  531. emitcall('FPC_CHAR_TO_ANSISTR');
  532. popusedregisters(pushed);
  533. maybe_loadesi;
  534. end;
  535. else
  536. internalerror(4179);
  537. end;
  538. end;
  539. procedure ti386typeconvnode.second_int_to_real;
  540. var
  541. r : preference;
  542. hregister : tregister;
  543. l1,l2 : pasmlabel;
  544. begin
  545. { for u32bit a solution is to push $0 and to load a comp }
  546. { does this first, it destroys maybe EDI }
  547. hregister:=R_EDI;
  548. if porddef(left.resulttype)^.typ=u32bit then
  549. push_int(0);
  550. if (left.location.loc=LOC_REGISTER) or
  551. (left.location.loc=LOC_CREGISTER) then
  552. begin
  553. {$ifndef noAllocEdi}
  554. if not (porddef(left.resulttype)^.typ in [u32bit,s32bit,u64bit,s64bit]) then
  555. getexplicitregister32(R_EDI);
  556. {$endif noAllocEdi}
  557. case porddef(left.resulttype)^.typ of
  558. s8bit : emit_reg_reg(A_MOVSX,S_BL,left.location.register,R_EDI);
  559. u8bit : emit_reg_reg(A_MOVZX,S_BL,left.location.register,R_EDI);
  560. s16bit : emit_reg_reg(A_MOVSX,S_WL,left.location.register,R_EDI);
  561. u16bit : emit_reg_reg(A_MOVZX,S_WL,left.location.register,R_EDI);
  562. u32bit,s32bit:
  563. hregister:=left.location.register;
  564. u64bit,s64bit:
  565. begin
  566. emit_reg(A_PUSH,S_L,left.location.registerhigh);
  567. hregister:=left.location.registerlow;
  568. end;
  569. end;
  570. ungetregister(left.location.register);
  571. end
  572. else
  573. begin
  574. r:=newreference(left.location.reference);
  575. {$ifndef noAllocEdi}
  576. getexplicitregister32(R_EDI);
  577. {$endif noAllocEdi}
  578. case porddef(left.resulttype)^.typ of
  579. s8bit:
  580. emit_ref_reg(A_MOVSX,S_BL,r,R_EDI);
  581. u8bit:
  582. emit_ref_reg(A_MOVZX,S_BL,r,R_EDI);
  583. s16bit:
  584. emit_ref_reg(A_MOVSX,S_WL,r,R_EDI);
  585. u16bit:
  586. emit_ref_reg(A_MOVZX,S_WL,r,R_EDI);
  587. u32bit,s32bit:
  588. emit_ref_reg(A_MOV,S_L,r,R_EDI);
  589. u64bit,s64bit:
  590. begin
  591. inc(r^.offset,4);
  592. emit_ref_reg(A_MOV,S_L,r,R_EDI);
  593. emit_reg(A_PUSH,S_L,R_EDI);
  594. r:=newreference(left.location.reference);
  595. emit_ref_reg(A_MOV,S_L,r,R_EDI);
  596. end;
  597. end;
  598. del_reference(left.location.reference);
  599. ungetiftemp(left.location.reference);
  600. end;
  601. { for 64 bit integers, the high dword is already pushed }
  602. emit_reg(A_PUSH,S_L,hregister);
  603. {$ifndef noAllocEdi}
  604. if hregister = R_EDI then
  605. ungetregister32(R_EDI);
  606. {$endif noAllocEdi}
  607. r:=new_reference(R_ESP,0);
  608. case porddef(left.resulttype)^.typ of
  609. u32bit:
  610. begin
  611. emit_ref(A_FILD,S_IQ,r);
  612. emit_const_reg(A_ADD,S_L,8,R_ESP);
  613. end;
  614. s64bit:
  615. begin
  616. emit_ref(A_FILD,S_IQ,r);
  617. emit_const_reg(A_ADD,S_L,8,R_ESP);
  618. end;
  619. u64bit:
  620. begin
  621. { unsigned 64 bit ints are harder to handle: }
  622. { we load bits 0..62 and then check bit 63: }
  623. { if it is 1 then we add $80000000 000000000 }
  624. { as double }
  625. inc(r^.offset,4);
  626. {$ifndef noAllocEdi}
  627. getexplicitregister32(R_EDI);
  628. {$endif noAllocEdi}
  629. emit_ref_reg(A_MOV,S_L,r,R_EDI);
  630. r:=new_reference(R_ESP,4);
  631. emit_const_ref(A_AND,S_L,$7fffffff,r);
  632. emit_const_reg(A_TEST,S_L,longint($80000000),R_EDI);
  633. {$ifndef noAllocEdi}
  634. ungetregister32(R_EDI);
  635. {$endif noAllocEdi}
  636. r:=new_reference(R_ESP,0);
  637. emit_ref(A_FILD,S_IQ,r);
  638. getdatalabel(l1);
  639. getlabel(l2);
  640. emitjmp(C_Z,l2);
  641. Consts.concat(Tai_label.Create(l1));
  642. { I got this constant from a test progtram (FK) }
  643. Consts.concat(Tai_const.Create_32bit(0));
  644. Consts.concat(Tai_const.Create_32bit(1138753536));
  645. r:=new_reference(R_NO,0);
  646. r^.symbol:=l1;
  647. emit_ref(A_FADD,S_FL,r);
  648. emitlab(l2);
  649. emit_const_reg(A_ADD,S_L,8,R_ESP);
  650. end
  651. else
  652. begin
  653. emit_ref(A_FILD,S_IL,r);
  654. {$ifndef noAllocEdi}
  655. getexplicitregister32(R_EDI);
  656. {$endif noAllocEdi}
  657. emit_reg(A_POP,S_L,R_EDI);
  658. {$ifndef noAllocEdi}
  659. ungetregister32(R_EDI);
  660. {$endif noAllocEdi}
  661. end;
  662. end;
  663. inc(fpuvaroffset);
  664. clear_location(location);
  665. location.loc:=LOC_FPU;
  666. end;
  667. procedure ti386typeconvnode.second_real_to_fix;
  668. var
  669. rreg : tregister;
  670. ref : treference;
  671. begin
  672. { real must be on fpu stack }
  673. if (left.location.loc<>LOC_FPU) then
  674. emit_ref(A_FLD,S_FL,newreference(left.location.reference));
  675. push_int($1f3f);
  676. push_int(65536);
  677. reset_reference(ref);
  678. ref.base:=R_ESP;
  679. emit_ref(A_FIMUL,S_IL,newreference(ref));
  680. ref.offset:=4;
  681. emit_ref(A_FSTCW,S_NO,newreference(ref));
  682. ref.offset:=6;
  683. emit_ref(A_FLDCW,S_NO,newreference(ref));
  684. ref.offset:=0;
  685. emit_ref(A_FISTP,S_IL,newreference(ref));
  686. ref.offset:=4;
  687. emit_ref(A_FLDCW,S_NO,newreference(ref));
  688. rreg:=getregister32;
  689. emit_reg(A_POP,S_L,rreg);
  690. { better than an add on all processors }
  691. {$ifndef noAllocEdi}
  692. getexplicitregister32(R_EDI);
  693. {$endif noAllocEdi}
  694. emit_reg(A_POP,S_L,R_EDI);
  695. {$ifndef noAllocEdi}
  696. ungetregister32(R_EDI);
  697. {$endif noAllocEdi}
  698. clear_location(location);
  699. location.loc:=LOC_REGISTER;
  700. location.register:=rreg;
  701. inc(fpuvaroffset);
  702. end;
  703. procedure ti386typeconvnode.second_real_to_real;
  704. begin
  705. case left.location.loc of
  706. LOC_FPU : ;
  707. LOC_CFPUREGISTER:
  708. begin
  709. location:=left.location;
  710. exit;
  711. end;
  712. LOC_MEM,
  713. LOC_REFERENCE:
  714. begin
  715. floatload(pfloatdef(left.resulttype)^.typ,
  716. left.location.reference);
  717. { we have to free the reference }
  718. del_reference(left.location.reference);
  719. end;
  720. end;
  721. clear_location(location);
  722. location.loc:=LOC_FPU;
  723. end;
  724. procedure ti386typeconvnode.second_fix_to_real;
  725. var
  726. popeax,popebx,popecx,popedx : boolean;
  727. startreg : tregister;
  728. hl : pasmlabel;
  729. r : treference;
  730. begin
  731. if (left.location.loc=LOC_REGISTER) or
  732. (left.location.loc=LOC_CREGISTER) then
  733. begin
  734. startreg:=left.location.register;
  735. ungetregister(startreg);
  736. popeax:=(startreg<>R_EAX) and not (R_EAX in unused);
  737. if popeax then
  738. emit_reg(A_PUSH,S_L,R_EAX);
  739. { mov eax,eax is removed by emit_reg_reg }
  740. emit_reg_reg(A_MOV,S_L,startreg,R_EAX);
  741. end
  742. else
  743. begin
  744. emit_ref_reg(A_MOV,S_L,newreference(
  745. left.location.reference),R_EAX);
  746. del_reference(left.location.reference);
  747. startreg:=R_NO;
  748. end;
  749. popebx:=(startreg<>R_EBX) and not (R_EBX in unused);
  750. if popebx then
  751. emit_reg(A_PUSH,S_L,R_EBX);
  752. popecx:=(startreg<>R_ECX) and not (R_ECX in unused);
  753. if popecx then
  754. emit_reg(A_PUSH,S_L,R_ECX);
  755. popedx:=(startreg<>R_EDX) and not (R_EDX in unused);
  756. if popedx then
  757. emit_reg(A_PUSH,S_L,R_EDX);
  758. emit_none(A_CDQ,S_NO);
  759. emit_reg_reg(A_XOR,S_L,R_EDX,R_EAX);
  760. emit_reg_reg(A_MOV,S_L,R_EAX,R_EBX);
  761. emit_reg_reg(A_SUB,S_L,R_EDX,R_EAX);
  762. getlabel(hl);
  763. emitjmp(C_Z,hl);
  764. emit_const_reg(A_RCL,S_L,1,R_EBX);
  765. emit_reg_reg(A_BSR,S_L,R_EAX,R_EDX);
  766. emit_const_reg(A_MOV,S_B,32,R_CL);
  767. emit_reg_reg(A_SUB,S_B,R_DL,R_CL);
  768. emit_reg_reg(A_SHL,S_L,R_CL,R_EAX);
  769. emit_const_reg(A_ADD,S_W,1007,R_DX);
  770. emit_const_reg(A_SHL,S_W,5,R_DX);
  771. emit_const_reg_reg(A_SHLD,S_W,11,R_DX,R_BX);
  772. emit_const_reg_reg(A_SHLD,S_L,20,R_EAX,R_EBX);
  773. emit_const_reg(A_SHL,S_L,20,R_EAX);
  774. emitlab(hl);
  775. { better than an add on all processors }
  776. emit_reg(A_PUSH,S_L,R_EBX);
  777. emit_reg(A_PUSH,S_L,R_EAX);
  778. reset_reference(r);
  779. r.base:=R_ESP;
  780. emit_ref(A_FLD,S_FL,newreference(r));
  781. emit_const_reg(A_ADD,S_L,8,R_ESP);
  782. if popedx then
  783. emit_reg(A_POP,S_L,R_EDX);
  784. if popecx then
  785. emit_reg(A_POP,S_L,R_ECX);
  786. if popebx then
  787. emit_reg(A_POP,S_L,R_EBX);
  788. if popeax then
  789. emit_reg(A_POP,S_L,R_EAX);
  790. clear_location(location);
  791. location.loc:=LOC_FPU;
  792. end;
  793. procedure ti386typeconvnode.second_cord_to_pointer;
  794. begin
  795. { this can't happend, because constants are already processed in
  796. pass 1 }
  797. internalerror(47423985);
  798. end;
  799. procedure ti386typeconvnode.second_int_to_fix;
  800. var
  801. hregister : tregister;
  802. begin
  803. if (left.location.loc=LOC_REGISTER) then
  804. hregister:=left.location.register
  805. else if (left.location.loc=LOC_CREGISTER) then
  806. hregister:=getregister32
  807. else
  808. begin
  809. del_reference(left.location.reference);
  810. hregister:=getregister32;
  811. case porddef(left.resulttype)^.typ of
  812. s8bit : emit_ref_reg(A_MOVSX,S_BL,newreference(left.location.reference),
  813. hregister);
  814. u8bit : emit_ref_reg(A_MOVZX,S_BL,newreference(left.location.reference),
  815. hregister);
  816. s16bit : emit_ref_reg(A_MOVSX,S_WL,newreference(left.location.reference),
  817. hregister);
  818. u16bit : emit_ref_reg(A_MOVZX,S_WL,newreference(left.location.reference),
  819. hregister);
  820. u32bit,s32bit : emit_ref_reg(A_MOV,S_L,newreference(left.location.reference),
  821. hregister);
  822. {!!!! u32bit }
  823. end;
  824. end;
  825. emit_const_reg(A_SHL,S_L,16,hregister);
  826. clear_location(location);
  827. location.loc:=LOC_REGISTER;
  828. location.register:=hregister;
  829. end;
  830. procedure ti386typeconvnode.second_proc_to_procvar;
  831. begin
  832. { method pointer ? }
  833. if assigned(tcallnode(left).left) then
  834. begin
  835. set_location(location,left.location);
  836. end
  837. else
  838. begin
  839. clear_location(location);
  840. location.loc:=LOC_REGISTER;
  841. location.register:=getregister32;
  842. del_reference(left.location.reference);
  843. emit_ref_reg(A_LEA,S_L,
  844. newreference(left.location.reference),location.register);
  845. end;
  846. end;
  847. procedure ti386typeconvnode.second_bool_to_int;
  848. var
  849. oldtruelabel,oldfalselabel,hlabel : pasmlabel;
  850. hregister : tregister;
  851. newsize,
  852. opsize : topsize;
  853. op : tasmop;
  854. begin
  855. oldtruelabel:=truelabel;
  856. oldfalselabel:=falselabel;
  857. getlabel(truelabel);
  858. getlabel(falselabel);
  859. secondpass(left);
  860. { byte(boolean) or word(wordbool) or longint(longbool) must
  861. be accepted for var parameters }
  862. if (nf_explizit in flags) and
  863. (left.resulttype^.size=resulttype^.size) and
  864. (left.location.loc in [LOC_REFERENCE,LOC_MEM,LOC_CREGISTER]) then
  865. begin
  866. set_location(location,left.location);
  867. truelabel:=oldtruelabel;
  868. falselabel:=oldfalselabel;
  869. exit;
  870. end;
  871. clear_location(location);
  872. location.loc:=LOC_REGISTER;
  873. del_reference(left.location.reference);
  874. case left.resulttype^.size of
  875. 1 : begin
  876. case resulttype^.size of
  877. 1 : opsize:=S_B;
  878. 2 : opsize:=S_BW;
  879. 4 : opsize:=S_BL;
  880. end;
  881. end;
  882. 2 : begin
  883. case resulttype^.size of
  884. 1 : begin
  885. if left.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
  886. left.location.register:=reg16toreg8(left.location.register);
  887. opsize:=S_B;
  888. end;
  889. 2 : opsize:=S_W;
  890. 4 : opsize:=S_WL;
  891. end;
  892. end;
  893. 4 : begin
  894. case resulttype^.size of
  895. 1 : begin
  896. if left.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
  897. left.location.register:=reg32toreg8(left.location.register);
  898. opsize:=S_B;
  899. end;
  900. 2 : begin
  901. if left.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
  902. left.location.register:=reg32toreg16(left.location.register);
  903. opsize:=S_W;
  904. end;
  905. 4 : opsize:=S_L;
  906. end;
  907. end;
  908. end;
  909. if opsize in [S_B,S_W,S_L] then
  910. op:=A_MOV
  911. else
  912. if is_signed(resulttype) then
  913. op:=A_MOVSX
  914. else
  915. op:=A_MOVZX;
  916. hregister:=getregister32;
  917. case resulttype^.size of
  918. 1 : begin
  919. location.register:=reg32toreg8(hregister);
  920. newsize:=S_B;
  921. end;
  922. 2 : begin
  923. location.register:=reg32toreg16(hregister);
  924. newsize:=S_W;
  925. end;
  926. 4 : begin
  927. location.register:=hregister;
  928. newsize:=S_L;
  929. end;
  930. else
  931. internalerror(10060);
  932. end;
  933. case left.location.loc of
  934. LOC_MEM,
  935. LOC_REFERENCE : emit_ref_reg(op,opsize,
  936. newreference(left.location.reference),location.register);
  937. LOC_REGISTER,
  938. LOC_CREGISTER : begin
  939. { remove things like movb %al,%al }
  940. if left.location.register<>location.register then
  941. emit_reg_reg(op,opsize,
  942. left.location.register,location.register);
  943. end;
  944. LOC_FLAGS : begin
  945. emit_flag2reg(left.location.resflags,location.register);
  946. end;
  947. LOC_JUMP : begin
  948. getlabel(hlabel);
  949. emitlab(truelabel);
  950. emit_const_reg(A_MOV,newsize,1,location.register);
  951. emitjmp(C_None,hlabel);
  952. emitlab(falselabel);
  953. emit_reg_reg(A_XOR,newsize,location.register,
  954. location.register);
  955. emitlab(hlabel);
  956. end;
  957. else
  958. internalerror(10061);
  959. end;
  960. truelabel:=oldtruelabel;
  961. falselabel:=oldfalselabel;
  962. end;
  963. procedure ti386typeconvnode.second_int_to_bool;
  964. var
  965. hregister : tregister;
  966. resflags : tresflags;
  967. opsize : topsize;
  968. begin
  969. clear_location(location);
  970. { byte(boolean) or word(wordbool) or longint(longbool) must
  971. be accepted for var parameters }
  972. if (nf_explizit in flags) and
  973. (left.resulttype^.size=resulttype^.size) and
  974. (left.location.loc in [LOC_REFERENCE,LOC_MEM,LOC_CREGISTER]) then
  975. begin
  976. set_location(location,left.location);
  977. exit;
  978. end;
  979. location.loc:=LOC_REGISTER;
  980. del_reference(left.location.reference);
  981. opsize:=def_opsize(left.resulttype);
  982. case left.location.loc of
  983. LOC_MEM,LOC_REFERENCE :
  984. begin
  985. hregister:=def_getreg(left.resulttype);
  986. emit_ref_reg(A_MOV,opsize,
  987. newreference(left.location.reference),hregister);
  988. emit_reg_reg(A_OR,opsize,hregister,hregister);
  989. resflags:=F_NE;
  990. end;
  991. LOC_FLAGS :
  992. begin
  993. hregister:=getregister32;
  994. resflags:=left.location.resflags;
  995. end;
  996. LOC_REGISTER,LOC_CREGISTER :
  997. begin
  998. hregister:=left.location.register;
  999. emit_reg_reg(A_OR,opsize,hregister,hregister);
  1000. resflags:=F_NE;
  1001. end;
  1002. else
  1003. internalerror(10062);
  1004. end;
  1005. case resulttype^.size of
  1006. 1 : location.register:=makereg8(hregister);
  1007. 2 : location.register:=makereg16(hregister);
  1008. 4 : location.register:=makereg32(hregister);
  1009. else
  1010. internalerror(10064);
  1011. end;
  1012. emit_flag2reg(resflags,location.register);
  1013. end;
  1014. procedure ti386typeconvnode.second_load_smallset;
  1015. var
  1016. href : treference;
  1017. pushedregs : tpushed;
  1018. begin
  1019. href.symbol:=nil;
  1020. pushusedregisters(pushedregs,$ff);
  1021. gettempofsizereference(32,href);
  1022. emit_push_mem_size(left.location.reference,4);
  1023. emitpushreferenceaddr(href);
  1024. saveregvars($ff);
  1025. emitcall('FPC_SET_LOAD_SMALL');
  1026. maybe_loadesi;
  1027. popusedregisters(pushedregs);
  1028. clear_location(location);
  1029. location.loc:=LOC_MEM;
  1030. location.reference:=href;
  1031. end;
  1032. procedure ti386typeconvnode.second_ansistring_to_pchar;
  1033. var
  1034. l1 : pasmlabel;
  1035. hr : preference;
  1036. begin
  1037. clear_location(location);
  1038. location.loc:=LOC_REGISTER;
  1039. getlabel(l1);
  1040. case left.location.loc of
  1041. LOC_CREGISTER,LOC_REGISTER:
  1042. location.register:=left.location.register;
  1043. LOC_MEM,LOC_REFERENCE:
  1044. begin
  1045. location.register:=getregister32;
  1046. emit_ref_reg(A_MOV,S_L,newreference(left.location.reference),
  1047. location.register);
  1048. del_reference(left.location.reference);
  1049. end;
  1050. end;
  1051. emit_const_reg(A_CMP,S_L,0,location.register);
  1052. emitjmp(C_NZ,l1);
  1053. new(hr);
  1054. reset_reference(hr^);
  1055. hr^.symbol:=newasmsymbol('FPC_EMPTYCHAR');
  1056. emit_ref_reg(A_LEA,S_L,hr,location.register);
  1057. emitlab(l1);
  1058. end;
  1059. procedure ti386typeconvnode.second_pchar_to_string;
  1060. var
  1061. pushed : tpushed;
  1062. regs_to_push: byte;
  1063. begin
  1064. case pstringdef(resulttype)^.string_typ of
  1065. st_shortstring:
  1066. begin
  1067. location.loc:=LOC_REFERENCE;
  1068. gettempofsizereference(resulttype^.size,location.reference);
  1069. pushusedregisters(pushed,$ff);
  1070. case left.location.loc of
  1071. LOC_REGISTER,LOC_CREGISTER:
  1072. begin
  1073. emit_reg(A_PUSH,S_L,left.location.register);
  1074. ungetregister32(left.location.register);
  1075. end;
  1076. LOC_REFERENCE,LOC_MEM:
  1077. begin
  1078. { Now release the registers (see cgai386.pas: }
  1079. { loadansistring for more info on the order) (JM) }
  1080. del_reference(left.location.reference);
  1081. emit_push_mem(left.location.reference);
  1082. end;
  1083. end;
  1084. emitpushreferenceaddr(location.reference);
  1085. saveregvars($ff);
  1086. emitcall('FPC_PCHAR_TO_SHORTSTR');
  1087. maybe_loadesi;
  1088. popusedregisters(pushed);
  1089. end;
  1090. st_ansistring:
  1091. begin
  1092. location.loc:=LOC_REFERENCE;
  1093. gettempansistringreference(location.reference);
  1094. decrstringref(cansistringdef,location.reference);
  1095. { Find out which regs have to be pushed (JM) }
  1096. regs_to_push := $ff;
  1097. remove_non_regvars_from_loc(left.location,regs_to_push);
  1098. pushusedregisters(pushed,regs_to_push);
  1099. case left.location.loc of
  1100. LOC_REFERENCE,LOC_MEM:
  1101. begin
  1102. { Now release the registers (see cgai386.pas: }
  1103. { loadansistring for more info on the order) (JM) }
  1104. del_reference(left.location.reference);
  1105. emit_push_mem(left.location.reference);
  1106. end;
  1107. LOC_REGISTER,LOC_CREGISTER:
  1108. begin
  1109. { Now release the registers (see cgai386.pas: }
  1110. { loadansistring for more info on the order) (JM) }
  1111. emit_reg(A_PUSH,S_L,left.location.register);
  1112. ungetregister32(left.location.register);
  1113. end;
  1114. end;
  1115. emitpushreferenceaddr(location.reference);
  1116. saveregvars(regs_to_push);
  1117. emitcall('FPC_PCHAR_TO_ANSISTR');
  1118. maybe_loadesi;
  1119. popusedregisters(pushed);
  1120. end;
  1121. else
  1122. begin
  1123. internalerror(12121);
  1124. end;
  1125. end;
  1126. end;
  1127. procedure ti386typeconvnode.second_class_to_intf;
  1128. var
  1129. hreg : tregister;
  1130. l1 : pasmlabel;
  1131. begin
  1132. case left.location.loc of
  1133. LOC_MEM,
  1134. LOC_REFERENCE:
  1135. begin
  1136. del_reference(left.location.reference);
  1137. hreg:=getregister32;
  1138. exprasmList.concat(Taicpu.Op_ref_reg(
  1139. A_MOV,S_L,newreference(left.location.reference),hreg));
  1140. end;
  1141. LOC_CREGISTER:
  1142. begin
  1143. hreg:=getregister32;
  1144. exprasmList.concat(Taicpu.Op_reg_reg(
  1145. A_MOV,S_L,left.location.register,hreg));
  1146. end;
  1147. LOC_REGISTER:
  1148. hreg:=left.location.register;
  1149. else internalerror(121120001);
  1150. end;
  1151. emit_reg_reg(A_TEST,S_L,hreg,hreg);
  1152. getlabel(l1);
  1153. emitjmp(C_Z,l1);
  1154. emit_const_reg(A_ADD,S_L,pobjectdef(left.resulttype)^.implementedinterfaces^.ioffsets(
  1155. pobjectdef(left.resulttype)^.implementedinterfaces^.searchintf(resulttype))^,hreg);
  1156. emitlab(l1);
  1157. location.loc:=LOC_REGISTER;
  1158. location.register:=hreg;
  1159. end;
  1160. procedure ti386typeconvnode.second_nothing;
  1161. begin
  1162. end;
  1163. {****************************************************************************
  1164. TI386TYPECONVNODE
  1165. ****************************************************************************}
  1166. procedure ti386typeconvnode.second_call_helper(c : tconverttype);
  1167. const
  1168. secondconvert : array[tconverttype] of pointer = (
  1169. @ti386typeconvnode.second_nothing, {equal}
  1170. @ti386typeconvnode.second_nothing, {not_possible}
  1171. @ti386typeconvnode.second_string_to_string,
  1172. @ti386typeconvnode.second_char_to_string,
  1173. @ti386typeconvnode.second_pchar_to_string,
  1174. @ti386typeconvnode.second_nothing, {cchar_to_pchar}
  1175. @ti386typeconvnode.second_cstring_to_pchar,
  1176. @ti386typeconvnode.second_ansistring_to_pchar,
  1177. @ti386typeconvnode.second_string_to_chararray,
  1178. @ti386typeconvnode.second_chararray_to_string,
  1179. @ti386typeconvnode.second_array_to_pointer,
  1180. @ti386typeconvnode.second_pointer_to_array,
  1181. @ti386typeconvnode.second_int_to_int,
  1182. @ti386typeconvnode.second_int_to_bool,
  1183. @ti386typeconvnode.second_bool_to_int, { bool_to_bool }
  1184. @ti386typeconvnode.second_bool_to_int,
  1185. @ti386typeconvnode.second_real_to_real,
  1186. @ti386typeconvnode.second_int_to_real,
  1187. @ti386typeconvnode.second_int_to_fix,
  1188. @ti386typeconvnode.second_real_to_fix,
  1189. @ti386typeconvnode.second_fix_to_real,
  1190. @ti386typeconvnode.second_proc_to_procvar,
  1191. @ti386typeconvnode.second_nothing, {arrayconstructor_to_set}
  1192. @ti386typeconvnode.second_load_smallset,
  1193. @ti386typeconvnode.second_cord_to_pointer,
  1194. @ti386typeconvnode.second_nothing, { interface 2 string }
  1195. @ti386typeconvnode.second_nothing, { interface 2 guid }
  1196. @ti386typeconvnode.second_class_to_intf
  1197. );
  1198. type
  1199. tprocedureofobject = procedure of object;
  1200. var
  1201. r : packed record
  1202. proc : pointer;
  1203. obj : pointer;
  1204. end;
  1205. begin
  1206. { this is a little bit dirty but it works }
  1207. { and should be quite portable too }
  1208. r.proc:=secondconvert[c];
  1209. r.obj:=self;
  1210. tprocedureofobject(r){$ifdef FPC}();{$endif FPC}
  1211. end;
  1212. procedure ti386typeconvnode.pass_2;
  1213. {$ifdef TESTOBJEXT2}
  1214. var
  1215. r : preference;
  1216. nillabel : plabel;
  1217. {$endif TESTOBJEXT2}
  1218. begin
  1219. { this isn't good coding, I think tc_bool_2_int, shouldn't be }
  1220. { type conversion (FK) }
  1221. if not(convtype in [tc_bool_2_int,tc_bool_2_bool]) then
  1222. begin
  1223. secondpass(left);
  1224. set_location(location,left.location);
  1225. if codegenerror then
  1226. exit;
  1227. end;
  1228. second_call_helper(convtype);
  1229. {$ifdef TESTOBJEXT2}
  1230. { Check explicit conversions to objects pointers !! }
  1231. if p^.explizit and
  1232. (p^.resulttype^.deftype=pointerdef) and
  1233. (ppointerdef(p^.resulttype)^.definition^.deftype=objectdef) and not
  1234. (pobjectdef(ppointerdef(p^.resulttype)^.definition)^.isclass) and
  1235. ((pobjectdef(ppointerdef(p^.resulttype)^.definition)^.options and oo_hasvmt)<>0) and
  1236. (cs_check_range in aktlocalswitches) then
  1237. begin
  1238. new(r);
  1239. reset_reference(r^);
  1240. if p^.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
  1241. r^.base:=p^.location.register
  1242. else
  1243. begin
  1244. {$ifndef noAllocEdi}
  1245. getexplicitregister32(R_EDI);
  1246. {$endif noAllocEdi}
  1247. emit_mov_loc_reg(p^.location,R_EDI);
  1248. r^.base:=R_EDI;
  1249. end;
  1250. { NIL must be accepted !! }
  1251. emit_reg_reg(A_OR,S_L,r^.base,r^.base);
  1252. {$ifndef noAllocEdi}
  1253. ungetregister32(R_EDI);
  1254. {$endif noAllocEdi}
  1255. getlabel(nillabel);
  1256. emitjmp(C_E,nillabel);
  1257. { this is one point where we need vmt_offset (PM) }
  1258. r^.offset:= pobjectdef(ppointerdef(p^.resulttype)^.definition)^.vmt_offset;
  1259. {$ifndef noAllocEdi}
  1260. getexplicitregister32(R_EDI);
  1261. {$endif noAllocEdi}
  1262. emit_ref_reg(A_MOV,S_L,r,R_EDI);
  1263. emit_sym(A_PUSH,S_L,
  1264. newasmsymbol(pobjectdef(ppointerdef(p^.resulttype)^.definition)^.vmt_mangledname));
  1265. emit_reg(A_PUSH,S_L,R_EDI);
  1266. {$ifndef noAllocEdi}
  1267. ungetregister32(R_EDI);
  1268. {$endif noAllocEdi}
  1269. emitcall('FPC_CHECK_OBJECT_EXT');
  1270. emitlab(nillabel);
  1271. end;
  1272. {$endif TESTOBJEXT2}
  1273. end;
  1274. {*****************************************************************************
  1275. TI386ISNODE
  1276. *****************************************************************************}
  1277. procedure ti386isnode.pass_2;
  1278. var
  1279. pushed : tpushed;
  1280. begin
  1281. { save all used registers }
  1282. pushusedregisters(pushed,$ff);
  1283. secondpass(left);
  1284. clear_location(location);
  1285. location.loc:=LOC_FLAGS;
  1286. location.resflags:=F_NE;
  1287. { push instance to check: }
  1288. case left.location.loc of
  1289. LOC_REGISTER,LOC_CREGISTER:
  1290. begin
  1291. emit_reg(A_PUSH,
  1292. S_L,left.location.register);
  1293. ungetregister32(left.location.register);
  1294. end;
  1295. LOC_MEM,LOC_REFERENCE:
  1296. begin
  1297. emit_ref(A_PUSH,
  1298. S_L,newreference(left.location.reference));
  1299. del_reference(left.location.reference);
  1300. end;
  1301. else internalerror(100);
  1302. end;
  1303. { generate type checking }
  1304. secondpass(right);
  1305. case right.location.loc of
  1306. LOC_REGISTER,LOC_CREGISTER:
  1307. begin
  1308. emit_reg(A_PUSH,
  1309. S_L,right.location.register);
  1310. ungetregister32(right.location.register);
  1311. end;
  1312. LOC_MEM,LOC_REFERENCE:
  1313. begin
  1314. emit_ref(A_PUSH,
  1315. S_L,newreference(right.location.reference));
  1316. del_reference(right.location.reference);
  1317. end;
  1318. else internalerror(100);
  1319. end;
  1320. saveregvars($ff);
  1321. emitcall('FPC_DO_IS');
  1322. emit_reg_reg(A_OR,S_B,R_AL,R_AL);
  1323. popusedregisters(pushed);
  1324. maybe_loadesi;
  1325. end;
  1326. {*****************************************************************************
  1327. TI386ASNODE
  1328. *****************************************************************************}
  1329. procedure ti386asnode.pass_2;
  1330. var
  1331. pushed : tpushed;
  1332. begin
  1333. secondpass(left);
  1334. { save all used registers }
  1335. pushusedregisters(pushed,$ff);
  1336. { push instance to check: }
  1337. case left.location.loc of
  1338. LOC_REGISTER,LOC_CREGISTER:
  1339. emit_reg(A_PUSH,
  1340. S_L,left.location.register);
  1341. LOC_MEM,LOC_REFERENCE:
  1342. emit_ref(A_PUSH,
  1343. S_L,newreference(left.location.reference));
  1344. else internalerror(100);
  1345. end;
  1346. { we doesn't modifiy the left side, we check only the type }
  1347. set_location(location,left.location);
  1348. { generate type checking }
  1349. secondpass(right);
  1350. case right.location.loc of
  1351. LOC_REGISTER,LOC_CREGISTER:
  1352. begin
  1353. emit_reg(A_PUSH,
  1354. S_L,right.location.register);
  1355. ungetregister32(right.location.register);
  1356. end;
  1357. LOC_MEM,LOC_REFERENCE:
  1358. begin
  1359. emit_ref(A_PUSH,
  1360. S_L,newreference(right.location.reference));
  1361. del_reference(right.location.reference);
  1362. end;
  1363. else internalerror(100);
  1364. end;
  1365. saveregvars($ff);
  1366. emitcall('FPC_DO_AS');
  1367. { restore register, this restores automatically the }
  1368. { result }
  1369. popusedregisters(pushed);
  1370. maybe_loadesi;
  1371. end;
  1372. begin
  1373. ctypeconvnode:=ti386typeconvnode;
  1374. cisnode:=ti386isnode;
  1375. casnode:=ti386asnode;
  1376. end.
  1377. {
  1378. $Log$
  1379. Revision 1.11 2000-12-25 00:07:32 peter
  1380. + new tlinkedlist class (merge of old tstringqueue,tcontainer and
  1381. tlinkedlist objects)
  1382. Revision 1.10 2000/12/07 17:19:46 jonas
  1383. * new constant handling: from now on, hex constants >$7fffffff are
  1384. parsed as unsigned constants (otherwise, $80000000 got sign extended
  1385. and became $ffffffff80000000), all constants in the longint range
  1386. become longints, all constants >$7fffffff and <=cardinal($ffffffff)
  1387. are cardinals and the rest are int64's.
  1388. * added lots of longint typecast to prevent range check errors in the
  1389. compiler and rtl
  1390. * type casts of symbolic ordinal constants are now preserved
  1391. * fixed bug where the original resulttype wasn't restored correctly
  1392. after doing a 64bit rangecheck
  1393. Revision 1.9 2000/12/05 11:44:33 jonas
  1394. + new integer regvar handling, should be much more efficient
  1395. Revision 1.8 2000/11/29 00:30:46 florian
  1396. * unused units removed from uses clause
  1397. * some changes for widestrings
  1398. Revision 1.7 2000/11/16 15:27:48 jonas
  1399. * fixed web bug 1242
  1400. Revision 1.6 2000/11/13 11:30:56 florian
  1401. * some bugs with interfaces and NIL fixed
  1402. Revision 1.5 2000/11/12 23:24:14 florian
  1403. * interfaces are basically running
  1404. Revision 1.4 2000/11/11 16:00:10 jonas
  1405. * optimize converting of 8/16/32 bit constants to 64bit ones
  1406. Revision 1.3 2000/11/04 14:25:23 florian
  1407. + merged Attila's changes for interfaces, not tested yet
  1408. Revision 1.2 2000/10/31 22:02:56 peter
  1409. * symtable splitted, no real code changes
  1410. Revision 1.1 2000/10/15 09:33:31 peter
  1411. * moved n386*.pas to i386/ cpu_target dir
  1412. Revision 1.1 2000/10/14 10:14:48 peter
  1413. * moehrendorf oct 2000 rewrite
  1414. }