cg386cnv.pas 55 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423
  1. {
  2. $Id$
  3. Copyright (c) 1993-98 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. {$ifdef TP}
  19. {$E+,F+,N+,D+,L+,Y+}
  20. {$endif}
  21. unit cg386cnv;
  22. interface
  23. uses
  24. tree;
  25. procedure secondtypeconv(var p : ptree);
  26. procedure secondas(var p : ptree);
  27. procedure secondis(var p : ptree);
  28. implementation
  29. uses
  30. cobjects,verbose,globals,systems,
  31. symtable,aasm,types,
  32. hcodegen,temp_gen,pass_2,
  33. i386,cgai386,tgeni386;
  34. {*****************************************************************************
  35. SecondTypeConv
  36. *****************************************************************************}
  37. procedure maybe_rangechecking(p : ptree;p2,p1 : pdef);
  38. {
  39. produces if necessary rangecheckcode
  40. }
  41. var
  42. hp : preference;
  43. hregister : tregister;
  44. neglabel,poslabel : plabel;
  45. is_register : boolean;
  46. begin
  47. { convert from p2 to p1 }
  48. { range check from enums is not made yet !!}
  49. { and its probably not easy }
  50. if (p1^.deftype<>orddef) or (p2^.deftype<>orddef) then
  51. exit;
  52. { range checking is different for u32bit }
  53. { lets try to generate it allways }
  54. if (cs_check_range in aktlocalswitches) and
  55. { with $R+ explicit type conversations in TP aren't range checked! }
  56. (not(p^.explizit) {or not(cs_tp_compatible in aktmoduleswitches)}) and
  57. ((porddef(p1)^.low>porddef(p2)^.low) or
  58. (porddef(p1)^.high<porddef(p2)^.high) or
  59. (porddef(p1)^.typ=u32bit) or
  60. (porddef(p2)^.typ=u32bit)) then
  61. begin
  62. porddef(p1)^.genrangecheck;
  63. is_register:=(p^.left^.location.loc=LOC_REGISTER) or
  64. (p^.left^.location.loc=LOC_CREGISTER);
  65. if porddef(p2)^.typ=u8bit then
  66. begin
  67. if is_register then
  68. exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_BL,p^.left^.location.register,R_EDI)))
  69. else
  70. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVZX,S_BL,newreference(p^.left^.location.reference),R_EDI)));
  71. hregister:=R_EDI;
  72. end
  73. else if porddef(p2)^.typ=s8bit then
  74. begin
  75. if is_register then
  76. exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVSX,S_BL,p^.left^.location.register,R_EDI)))
  77. else
  78. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVSX,S_BL,newreference(p^.left^.location.reference),R_EDI)));
  79. hregister:=R_EDI;
  80. end
  81. { rangechecking for u32bit ?? !!!!!!}
  82. { lets try }
  83. else if (porddef(p2)^.typ=s32bit) or (porddef(p2)^.typ=u32bit) then
  84. begin
  85. if is_register then
  86. hregister:=p^.location.register
  87. else
  88. begin
  89. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(p^.left^.location.reference),R_EDI)));
  90. hregister:=R_EDI;
  91. end;
  92. end
  93. else if porddef(p2)^.typ=u16bit then
  94. begin
  95. if is_register then
  96. exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_WL,p^.left^.location.register,R_EDI)))
  97. else
  98. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVZX,S_WL,newreference(p^.left^.location.reference),R_EDI)));
  99. hregister:=R_EDI;
  100. end
  101. else if porddef(p2)^.typ=s16bit then
  102. begin
  103. if is_register then
  104. exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVSX,S_WL,p^.left^.location.register,R_EDI)))
  105. else
  106. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVSX,S_WL,newreference(p^.left^.location.reference),R_EDI)));
  107. hregister:=R_EDI;
  108. end
  109. else internalerror(6);
  110. hp:=new_reference(R_NO,0);
  111. hp^.symbol:=stringdup(porddef(p1)^.getrangecheckstring);
  112. if porddef(p1)^.low>porddef(p1)^.high then
  113. begin
  114. getlabel(neglabel);
  115. getlabel(poslabel);
  116. exprasmlist^.concat(new(pai386,op_reg_reg(A_OR,S_L,hregister,hregister)));
  117. emitl(A_JL,neglabel);
  118. end;
  119. exprasmlist^.concat(new(pai386,op_reg_ref(A_BOUND,S_L,hregister,hp)));
  120. if porddef(p1)^.low>porddef(p1)^.high then
  121. begin
  122. hp:=new_reference(R_NO,0);
  123. hp^.symbol:=stringdup(porddef(p1)^.getrangecheckstring);
  124. emitl(A_JMP,poslabel);
  125. emitl(A_LABEL,neglabel);
  126. exprasmlist^.concat(new(pai386,op_reg_ref(A_BOUND,S_L,hregister,hp)));
  127. emitl(A_LABEL,poslabel);
  128. end;
  129. end;
  130. end;
  131. type
  132. tsecondconvproc = procedure(p,hp : ptree;convtyp : tconverttype);
  133. procedure second_only_rangecheck(p,hp : ptree;convtyp : tconverttype);
  134. begin
  135. maybe_rangechecking(p,hp^.resulttype,p^.resulttype);
  136. end;
  137. procedure second_smaller(p,hp : ptree;convtyp : tconverttype);
  138. var
  139. hregister,destregister : tregister;
  140. ref : boolean;
  141. hpp : preference;
  142. begin
  143. ref:=false;
  144. { problems with enums !! }
  145. if (cs_check_range in aktlocalswitches) and
  146. { with $R+ explicit type conversations in TP aren't range checked! }
  147. (not(p^.explizit) {or not(cs_tp_compatible in aktmoduleswitches)}) and
  148. (p^.resulttype^.deftype=orddef) and
  149. (hp^.resulttype^.deftype=orddef) then
  150. begin
  151. if porddef(hp^.resulttype)^.typ=u32bit then
  152. begin
  153. { when doing range checking for u32bit, we have some trouble }
  154. { because BOUND assumes signed values }
  155. { first, we check if the values is greater than 2^31: }
  156. { the u32bit rangenr contains the appropriate rangenr }
  157. porddef(hp^.resulttype)^.genrangecheck;
  158. hregister:=R_EDI;
  159. if (p^.location.loc=LOC_REGISTER) or
  160. (p^.location.loc=LOC_CREGISTER) then
  161. hregister:=p^.location.register
  162. else
  163. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
  164. newreference(p^.location.reference),R_EDI)));
  165. hpp:=new_reference(R_NO,0);
  166. hpp^.symbol:=stringdup(porddef(hp^.resulttype)^.getrangecheckstring);
  167. exprasmlist^.concat(new(pai386,op_reg_ref(A_BOUND,S_L,hregister,hpp)));
  168. { then we do a normal range check }
  169. porddef(p^.resulttype)^.genrangecheck;
  170. hpp:=new_reference(R_NO,0);
  171. hpp^.symbol:=stringdup(porddef(p^.resulttype)^.getrangecheckstring);
  172. exprasmlist^.concat(new(pai386,op_reg_ref(A_BOUND,S_L,hregister,hpp)));
  173. end
  174. else
  175. if ((porddef(p^.resulttype)^.low>porddef(hp^.resulttype)^.low) or
  176. (porddef(p^.resulttype)^.high<porddef(hp^.resulttype)^.high)) then
  177. begin
  178. porddef(p^.resulttype)^.genrangecheck;
  179. { per default the var is copied to EDI }
  180. hregister:=R_EDI;
  181. if porddef(hp^.resulttype)^.typ=s32bit then
  182. begin
  183. if (p^.location.loc=LOC_REGISTER) or
  184. (p^.location.loc=LOC_CREGISTER) then
  185. hregister:=p^.location.register
  186. else
  187. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(p^.location.reference),R_EDI)));
  188. end
  189. else if porddef(hp^.resulttype)^.typ=u16bit then
  190. begin
  191. if (p^.location.loc=LOC_REGISTER) or
  192. (p^.location.loc=LOC_CREGISTER) then
  193. exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_WL,p^.location.register,R_EDI)))
  194. else
  195. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVZX,S_WL,newreference(p^.location.reference),R_EDI)));
  196. end
  197. else if porddef(hp^.resulttype)^.typ=s16bit then
  198. begin
  199. if (p^.location.loc=LOC_REGISTER) or
  200. (p^.location.loc=LOC_CREGISTER) then
  201. exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVSX,S_WL,p^.location.register,R_EDI)))
  202. else
  203. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVSX,S_WL,newreference(p^.location.reference),R_EDI)));
  204. end
  205. else internalerror(6);
  206. hpp:=new_reference(R_NO,0);
  207. hpp^.symbol:=stringdup(porddef(p^.resulttype)^.getrangecheckstring);
  208. exprasmlist^.concat(new(pai386,op_reg_ref(A_BOUND,S_L,hregister,hpp)));
  209. (*
  210. if (p^.location.loc=LOC_REGISTER) or
  211. (p^.location.loc=LOC_CREGISTER) then
  212. begin
  213. destregister:=p^.left^.location.register;
  214. case convtyp of
  215. tc_s32bit_2_s8bit,
  216. tc_s32bit_2_u8bit:
  217. destregister:=reg32toreg8(destregister);
  218. tc_s32bit_2_s16bit,
  219. tc_s32bit_2_u16bit:
  220. destregister:=reg32toreg16(destregister);
  221. { this was false because destregister is allways a 32bitreg }
  222. tc_s16bit_2_s8bit,
  223. tc_s16bit_2_u8bit,
  224. tc_u16bit_2_s8bit,
  225. tc_u16bit_2_u8bit:
  226. destregister:=reg32toreg8(destregister);
  227. end;
  228. p^.location.register:=destregister;
  229. exit;
  230. *)
  231. end;
  232. end;
  233. { p^.location.loc is already set! }
  234. if (p^.location.loc=LOC_REGISTER) or
  235. (p^.location.loc=LOC_CREGISTER) then
  236. begin
  237. destregister:=p^.left^.location.register;
  238. case convtyp of
  239. tc_s32bit_2_s8bit,
  240. tc_s32bit_2_u8bit:
  241. destregister:=reg32toreg8(destregister);
  242. tc_s32bit_2_s16bit,
  243. tc_s32bit_2_u16bit:
  244. destregister:=reg32toreg16(destregister);
  245. tc_s16bit_2_s8bit,
  246. tc_s16bit_2_u8bit,
  247. tc_u16bit_2_s8bit,
  248. tc_u16bit_2_u8bit:
  249. destregister:=reg16toreg8(destregister);
  250. end;
  251. p^.location.register:=destregister;
  252. end;
  253. end;
  254. procedure second_bigger(p,hp : ptree;convtyp : tconverttype);
  255. var
  256. hregister : tregister;
  257. opsize : topsize;
  258. op : tasmop;
  259. is_register : boolean;
  260. begin
  261. is_register:=p^.left^.location.loc=LOC_REGISTER;
  262. if not(is_register) and (p^.left^.location.loc<>LOC_CREGISTER) then
  263. begin
  264. del_reference(p^.left^.location.reference);
  265. { we can do this here as we need no temp inside second_bigger }
  266. ungetiftemp(p^.left^.location.reference);
  267. end;
  268. { this is wrong !!!
  269. gives me movl (%eax),%eax
  270. for the length(string !!!
  271. use only for constant values }
  272. {Constant cannot be loaded into registers using MOVZX!}
  273. if (p^.left^.location.loc<>LOC_MEM) or (not p^.left^.location.reference.isintvalue) then
  274. case convtyp of
  275. tc_u8bit_2_s32bit,tc_u8bit_2_u32bit :
  276. begin
  277. if is_register then
  278. hregister:=reg8toreg32(p^.left^.location.register)
  279. else hregister:=getregister32;
  280. op:=A_MOVZX;
  281. opsize:=S_BL;
  282. end;
  283. { here what do we do for negative values ? }
  284. tc_s8bit_2_s32bit,tc_s8bit_2_u32bit :
  285. begin
  286. if is_register then
  287. hregister:=reg8toreg32(p^.left^.location.register)
  288. else hregister:=getregister32;
  289. op:=A_MOVSX;
  290. opsize:=S_BL;
  291. end;
  292. tc_u16bit_2_s32bit,tc_u16bit_2_u32bit :
  293. begin
  294. if is_register then
  295. hregister:=reg16toreg32(p^.left^.location.register)
  296. else hregister:=getregister32;
  297. op:=A_MOVZX;
  298. opsize:=S_WL;
  299. end;
  300. tc_s16bit_2_s32bit,tc_s16bit_2_u32bit :
  301. begin
  302. if is_register then
  303. hregister:=reg16toreg32(p^.left^.location.register)
  304. else hregister:=getregister32;
  305. op:=A_MOVSX;
  306. opsize:=S_WL;
  307. end;
  308. tc_s8bit_2_u16bit,
  309. tc_u8bit_2_s16bit,
  310. tc_u8bit_2_u16bit :
  311. begin
  312. if is_register then
  313. hregister:=reg8toreg16(p^.left^.location.register)
  314. else hregister:=reg32toreg16(getregister32);
  315. op:=A_MOVZX;
  316. opsize:=S_BW;
  317. end;
  318. tc_s8bit_2_s16bit :
  319. begin
  320. if is_register then
  321. hregister:=reg8toreg16(p^.left^.location.register)
  322. else hregister:=reg32toreg16(getregister32);
  323. op:=A_MOVSX;
  324. opsize:=S_BW;
  325. end;
  326. end
  327. else
  328. case convtyp of
  329. tc_u8bit_2_s32bit,
  330. tc_s8bit_2_s32bit,
  331. tc_u16bit_2_s32bit,
  332. tc_s16bit_2_s32bit,
  333. tc_u8bit_2_u32bit,
  334. tc_s8bit_2_u32bit,
  335. tc_u16bit_2_u32bit,
  336. tc_s16bit_2_u32bit:
  337. begin
  338. hregister:=getregister32;
  339. op:=A_MOV;
  340. opsize:=S_L;
  341. end;
  342. tc_s8bit_2_u16bit,
  343. tc_s8bit_2_s16bit,
  344. tc_u8bit_2_s16bit,
  345. tc_u8bit_2_u16bit:
  346. begin
  347. hregister:=reg32toreg16(getregister32);
  348. op:=A_MOV;
  349. opsize:=S_W;
  350. end;
  351. end;
  352. if is_register then
  353. begin
  354. emit_reg_reg(op,opsize,p^.left^.location.register,hregister);
  355. end
  356. else
  357. begin
  358. if p^.left^.location.loc=LOC_CREGISTER then
  359. emit_reg_reg(op,opsize,p^.left^.location.register,hregister)
  360. else exprasmlist^.concat(new(pai386,op_ref_reg(op,opsize,
  361. newreference(p^.left^.location.reference),hregister)));
  362. end;
  363. clear_location(p^.location);
  364. p^.location.loc:=LOC_REGISTER;
  365. p^.location.register:=hregister;
  366. maybe_rangechecking(p,p^.left^.resulttype,p^.resulttype);
  367. end;
  368. procedure second_string_string(p,hp : ptree;convtyp : tconverttype);
  369. var
  370. pushed : tpushed;
  371. begin
  372. { does anybody know a better solution than this big case statement ? }
  373. { ok, a proc table would do the job }
  374. case pstringdef(p^.resulttype)^.string_typ of
  375. st_shortstring:
  376. case pstringdef(p^.left^.resulttype)^.string_typ of
  377. st_shortstring:
  378. begin
  379. stringdispose(p^.location.reference.symbol);
  380. gettempofsizereference(p^.resulttype^.size,p^.location.reference);
  381. del_reference(p^.left^.location.reference);
  382. copyshortstring(p^.location.reference,p^.left^.location.reference,pstringdef(p^.resulttype)^.len,false);
  383. ungetiftemp(p^.left^.location.reference);
  384. end;
  385. st_longstring:
  386. begin
  387. {!!!!!!!}
  388. internalerror(8888);
  389. end;
  390. st_ansistring:
  391. begin
  392. gettempofsizereference(p^.resulttype^.size,p^.location.reference);
  393. loadansi2short(p^.left,p);
  394. end;
  395. st_widestring:
  396. begin
  397. {!!!!!!!}
  398. internalerror(8888);
  399. end;
  400. end;
  401. st_longstring:
  402. case pstringdef(p^.left^.resulttype)^.string_typ of
  403. st_shortstring:
  404. begin
  405. {!!!!!!!}
  406. internalerror(8888);
  407. end;
  408. st_ansistring:
  409. begin
  410. {!!!!!!!}
  411. internalerror(8888);
  412. end;
  413. st_widestring:
  414. begin
  415. {!!!!!!!}
  416. internalerror(8888);
  417. end;
  418. end;
  419. st_ansistring:
  420. case pstringdef(p^.left^.resulttype)^.string_typ of
  421. st_shortstring:
  422. begin
  423. gettempofsizereference(p^.resulttype^.size,p^.location.reference);
  424. exprasmlist^.concat(new(pai386,op_const_ref(A_MOV,S_L,0,newreference(p^.location.reference))));
  425. pushusedregisters(pushed,$ff);
  426. emit_push_lea_loc(p^.left^.location);
  427. emit_push_lea_loc(p^.location);
  428. emitcall('FPC_SHORTSTR_TO_ANSISTR',true);
  429. maybe_loadesi;
  430. popusedregisters(pushed);
  431. end;
  432. st_longstring:
  433. begin
  434. {!!!!!!!}
  435. internalerror(8888);
  436. end;
  437. st_widestring:
  438. begin
  439. {!!!!!!!}
  440. internalerror(8888);
  441. end;
  442. end;
  443. st_widestring:
  444. case pstringdef(p^.left^.resulttype)^.string_typ of
  445. st_shortstring:
  446. begin
  447. {!!!!!!!}
  448. internalerror(8888);
  449. end;
  450. st_longstring:
  451. begin
  452. {!!!!!!!}
  453. internalerror(8888);
  454. end;
  455. st_ansistring:
  456. begin
  457. {!!!!!!!}
  458. internalerror(8888);
  459. end;
  460. st_widestring:
  461. begin
  462. {!!!!!!!}
  463. internalerror(8888);
  464. end;
  465. end;
  466. end;
  467. end;
  468. procedure second_cstring_charpointer(p,hp : ptree;convtyp : tconverttype);
  469. begin
  470. clear_location(p^.location);
  471. p^.location.loc:=LOC_REGISTER;
  472. p^.location.register:=getregister32;
  473. inc(p^.left^.location.reference.offset);
  474. exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,newreference(p^.left^.location.reference),
  475. p^.location.register)));
  476. end;
  477. procedure second_string_chararray(p,hp : ptree;convtyp : tconverttype);
  478. begin
  479. inc(p^.location.reference.offset);
  480. end;
  481. procedure second_array_to_pointer(p,hp : ptree;convtyp : tconverttype);
  482. begin
  483. del_reference(p^.left^.location.reference);
  484. clear_location(p^.location);
  485. p^.location.loc:=LOC_REGISTER;
  486. p^.location.register:=getregister32;
  487. exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,newreference(p^.left^.location.reference),
  488. p^.location.register)));
  489. end;
  490. procedure second_pointer_to_array(p,hp : ptree;convtyp : tconverttype);
  491. begin
  492. clear_location(p^.location);
  493. p^.location.loc:=LOC_REFERENCE;
  494. clear_reference(p^.location.reference);
  495. if p^.left^.location.loc=LOC_REGISTER then
  496. p^.location.reference.base:=p^.left^.location.register
  497. else
  498. begin
  499. if p^.left^.location.loc=LOC_CREGISTER then
  500. begin
  501. p^.location.reference.base:=getregister32;
  502. emit_reg_reg(A_MOV,S_L,p^.left^.location.register,
  503. p^.location.reference.base);
  504. end
  505. else
  506. begin
  507. del_reference(p^.left^.location.reference);
  508. p^.location.reference.base:=getregister32;
  509. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(p^.left^.location.reference),
  510. p^.location.reference.base)));
  511. end;
  512. end;
  513. end;
  514. { generates the code for the type conversion from an array of char }
  515. { to a string }
  516. procedure second_chararray_to_string(p,hp : ptree;convtyp : tconverttype);
  517. var
  518. l : longint;
  519. begin
  520. { this is a type conversion which copies the data, so we can't }
  521. { return a reference }
  522. clear_location(p^.location);
  523. p^.location.loc:=LOC_MEM;
  524. { first get the memory for the string }
  525. gettempofsizereference(256,p^.location.reference);
  526. { calc the length of the array }
  527. l:=parraydef(p^.left^.resulttype)^.highrange-
  528. parraydef(p^.left^.resulttype)^.lowrange+1;
  529. if l>255 then
  530. CGMessage(type_e_mismatch);
  531. { write the length }
  532. exprasmlist^.concat(new(pai386,op_const_ref(A_MOV,S_B,l,
  533. newreference(p^.location.reference))));
  534. { copy to first char of string }
  535. inc(p^.location.reference.offset);
  536. { generates the copy code }
  537. { and we need the source never }
  538. concatcopy(p^.left^.location.reference,p^.location.reference,l,true,false);
  539. { correct the string location }
  540. dec(p^.location.reference.offset);
  541. end;
  542. procedure second_char_to_string(p,hp : ptree;convtyp : tconverttype);
  543. var
  544. pushed : tpushed;
  545. begin
  546. clear_location(p^.location);
  547. p^.location.loc:=LOC_MEM;
  548. case pstringdef(p^.resulttype)^.string_typ of
  549. st_shortstring :
  550. begin
  551. gettempofsizereference(256,p^.location.reference);
  552. { call loadstring with correct left and right }
  553. p^.right:=p^.left;
  554. p^.left:=p;
  555. loadshortstring(p);
  556. p^.left:=nil; { reset left tree, which is empty }
  557. { p^.right is not disposed for typeconv !! PM }
  558. disposetree(p^.right);
  559. p^.right:=nil;
  560. end;
  561. st_ansistring :
  562. begin
  563. gettempofsizereference(4,p^.location.reference);
  564. {temptoremove^.concat(new(ptemptodestroy,init(p^.location.reference,p^.resulttype)));}
  565. exprasmlist^.concat(new(pai386,op_const_ref(A_MOV,S_L,0,newreference(p^.location.reference))));
  566. pushusedregisters(pushed,$ff);
  567. emit_pushw_loc(p^.left^.location);
  568. emitpushreferenceaddr(exprasmlist,p^.location.reference);
  569. emitcall('FPC_CHAR_TO_ANSISTR',true);
  570. popusedregisters(pushed);
  571. maybe_loadesi;
  572. end;
  573. else
  574. internalerror(4179);
  575. end;
  576. end;
  577. procedure second_int_real(p,hp : ptree;convtyp : tconverttype);
  578. var
  579. r : preference;
  580. hregister : tregister;
  581. begin
  582. { for u32bit a solution is to push $0 and to load a comp }
  583. { does this first, it destroys maybe EDI }
  584. hregister:=R_EDI;
  585. if porddef(p^.left^.resulttype)^.typ=u32bit then
  586. push_int(0);
  587. if (p^.left^.location.loc=LOC_REGISTER) or
  588. (p^.left^.location.loc=LOC_CREGISTER) then
  589. begin
  590. case porddef(p^.left^.resulttype)^.typ of
  591. s8bit : exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVSX,S_BL,p^.left^.location.register,R_EDI)));
  592. u8bit : exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_BL,p^.left^.location.register,R_EDI)));
  593. s16bit : exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVSX,S_WL,p^.left^.location.register,R_EDI)));
  594. u16bit : exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_WL,p^.left^.location.register,R_EDI)));
  595. u32bit,s32bit:
  596. hregister:=p^.left^.location.register
  597. end;
  598. ungetregister(p^.left^.location.register);
  599. end
  600. else
  601. begin
  602. r:=newreference(p^.left^.location.reference);
  603. case porddef(p^.left^.resulttype)^.typ of
  604. s8bit : exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVSX,S_BL,r,R_EDI)));
  605. u8bit : exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVZX,S_BL,r,R_EDI)));
  606. s16bit : exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVSX,S_WL,r,R_EDI)));
  607. u16bit : exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVZX,S_WL,r,R_EDI)));
  608. u32bit,s32bit : exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_EDI)));
  609. end;
  610. del_reference(p^.left^.location.reference);
  611. ungetiftemp(p^.left^.location.reference);
  612. end;
  613. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,hregister)));
  614. r:=new_reference(R_ESP,0);
  615. if porddef(p^.left^.resulttype)^.typ=u32bit then
  616. exprasmlist^.concat(new(pai386,op_ref(A_FILD,S_IQ,r)))
  617. else
  618. exprasmlist^.concat(new(pai386,op_ref(A_FILD,S_IL,r)));
  619. { better than an add on all processors }
  620. if porddef(p^.left^.resulttype)^.typ=u32bit then
  621. exprasmlist^.concat(new(pai386,op_const_reg(A_ADD,S_L,8,R_ESP)))
  622. else
  623. exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EDI)));
  624. clear_location(p^.location);
  625. p^.location.loc:=LOC_FPU;
  626. end;
  627. procedure second_real_fix(p,hp : ptree;convtyp : tconverttype);
  628. var
  629. rreg : tregister;
  630. ref : treference;
  631. begin
  632. { real must be on fpu stack }
  633. if (p^.left^.location.loc<>LOC_FPU) then
  634. exprasmlist^.concat(new(pai386,op_ref(A_FLD,S_FL,newreference(p^.left^.location.reference))));
  635. push_int($1f3f);
  636. push_int(65536);
  637. reset_reference(ref);
  638. ref.base:=R_ESP;
  639. exprasmlist^.concat(new(pai386,op_ref(A_FIMUL,S_IL,newreference(ref))));
  640. ref.offset:=4;
  641. exprasmlist^.concat(new(pai386,op_ref(A_FSTCW,S_NO,newreference(ref))));
  642. ref.offset:=6;
  643. exprasmlist^.concat(new(pai386,op_ref(A_FLDCW,S_NO,newreference(ref))));
  644. ref.offset:=0;
  645. exprasmlist^.concat(new(pai386,op_ref(A_FISTP,S_IL,newreference(ref))));
  646. ref.offset:=4;
  647. exprasmlist^.concat(new(pai386,op_ref(A_FLDCW,S_NO,newreference(ref))));
  648. rreg:=getregister32;
  649. exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,rreg)));
  650. { better than an add on all processors }
  651. exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EDI)));
  652. clear_location(p^.location);
  653. p^.location.loc:=LOC_REGISTER;
  654. p^.location.register:=rreg;
  655. end;
  656. procedure second_float_float(p,hp : ptree;convtyp : tconverttype);
  657. begin
  658. case p^.left^.location.loc of
  659. LOC_FPU : ;
  660. LOC_MEM,
  661. LOC_REFERENCE:
  662. begin
  663. floatload(pfloatdef(p^.left^.resulttype)^.typ,
  664. p^.left^.location.reference);
  665. { we have to free the reference }
  666. del_reference(p^.left^.location.reference);
  667. end;
  668. end;
  669. clear_location(p^.location);
  670. p^.location.loc:=LOC_FPU;
  671. end;
  672. procedure second_fix_real(p,hp : ptree;convtyp : tconverttype);
  673. var
  674. popeax,popebx,popecx,popedx : boolean;
  675. startreg : tregister;
  676. hl : plabel;
  677. r : treference;
  678. begin
  679. if (p^.left^.location.loc=LOC_REGISTER) or
  680. (p^.left^.location.loc=LOC_CREGISTER) then
  681. begin
  682. startreg:=p^.left^.location.register;
  683. ungetregister(startreg);
  684. popeax:=(startreg<>R_EAX) and not (R_EAX in unused);
  685. if popeax then
  686. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_EAX)));
  687. { mov eax,eax is removed by emit_reg_reg }
  688. emit_reg_reg(A_MOV,S_L,startreg,R_EAX);
  689. end
  690. else
  691. begin
  692. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(
  693. p^.left^.location.reference),R_EAX)));
  694. del_reference(p^.left^.location.reference);
  695. startreg:=R_NO;
  696. end;
  697. popebx:=(startreg<>R_EBX) and not (R_EBX in unused);
  698. if popebx then
  699. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_EBX)));
  700. popecx:=(startreg<>R_ECX) and not (R_ECX in unused);
  701. if popecx then
  702. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ECX)));
  703. popedx:=(startreg<>R_EDX) and not (R_EDX in unused);
  704. if popedx then
  705. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_EDX)));
  706. exprasmlist^.concat(new(pai386,op_none(A_CDQ,S_NO)));
  707. emit_reg_reg(A_XOR,S_L,R_EDX,R_EAX);
  708. emit_reg_reg(A_MOV,S_L,R_EAX,R_EBX);
  709. emit_reg_reg(A_SUB,S_L,R_EDX,R_EAX);
  710. getlabel(hl);
  711. emitl(A_JZ,hl);
  712. exprasmlist^.concat(new(pai386,op_const_reg(A_RCL,S_L,1,R_EBX)));
  713. emit_reg_reg(A_BSR,S_L,R_EAX,R_EDX);
  714. exprasmlist^.concat(new(pai386,op_const_reg(A_MOV,S_B,32,R_CL)));
  715. emit_reg_reg(A_SUB,S_B,R_DL,R_CL);
  716. emit_reg_reg(A_SHL,S_L,R_CL,R_EAX);
  717. exprasmlist^.concat(new(pai386,op_const_reg(A_ADD,S_W,1007,R_DX)));
  718. exprasmlist^.concat(new(pai386,op_const_reg(A_SHL,S_W,5,R_DX)));
  719. exprasmlist^.concat(new(pai386,op_const_reg_reg(A_SHLD,S_W,11,R_DX,R_BX)));
  720. exprasmlist^.concat(new(pai386,op_const_reg_reg(A_SHLD,S_W,20,R_EAX,R_EBX)));
  721. exprasmlist^.concat(new(pai386,op_const_reg(A_SHL,S_L,20,R_EAX)));
  722. emitl(A_LABEL,hl);
  723. { better than an add on all processors }
  724. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_EBX)));
  725. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_EAX)));
  726. reset_reference(r);
  727. r.base:=R_ESP;
  728. exprasmlist^.concat(new(pai386,op_ref(A_FLD,S_FL,newreference(r))));
  729. exprasmlist^.concat(new(pai386,op_const_reg(A_ADD,S_L,8,R_ESP)));
  730. if popedx then
  731. exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EDX)));
  732. if popecx then
  733. exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_ECX)));
  734. if popebx then
  735. exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EBX)));
  736. if popeax then
  737. exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EAX)));
  738. clear_location(p^.location);
  739. p^.location.loc:=LOC_FPU;
  740. end;
  741. procedure second_int_fix(p,hp : ptree;convtyp : tconverttype);
  742. var
  743. hregister : tregister;
  744. begin
  745. if (p^.left^.location.loc=LOC_REGISTER) then
  746. hregister:=p^.left^.location.register
  747. else if (p^.left^.location.loc=LOC_CREGISTER) then
  748. hregister:=getregister32
  749. else
  750. begin
  751. del_reference(p^.left^.location.reference);
  752. hregister:=getregister32;
  753. case porddef(p^.left^.resulttype)^.typ of
  754. s8bit : exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVSX,S_BL,newreference(p^.left^.location.reference),
  755. hregister)));
  756. u8bit : exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVZX,S_BL,newreference(p^.left^.location.reference),
  757. hregister)));
  758. s16bit : exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVSX,S_WL,newreference(p^.left^.location.reference),
  759. hregister)));
  760. u16bit : exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVZX,S_WL,newreference(p^.left^.location.reference),
  761. hregister)));
  762. u32bit,s32bit : exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(p^.left^.location.reference),
  763. hregister)));
  764. {!!!! u32bit }
  765. end;
  766. end;
  767. exprasmlist^.concat(new(pai386,op_const_reg(A_SHL,S_L,16,hregister)));
  768. clear_location(p^.location);
  769. p^.location.loc:=LOC_REGISTER;
  770. p^.location.register:=hregister;
  771. end;
  772. procedure second_proc_to_procvar(p,hp : ptree;convtyp : tconverttype);
  773. begin
  774. clear_location(p^.location);
  775. p^.location.loc:=LOC_REGISTER;
  776. del_reference(hp^.location.reference);
  777. p^.location.register:=getregister32;
  778. exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
  779. newreference(hp^.location.reference),p^.location.register)));
  780. end;
  781. procedure second_bool_to_int(p,hp : ptree;convtyp : tconverttype);
  782. var
  783. oldtruelabel,oldfalselabel,hlabel : plabel;
  784. hregister : tregister;
  785. newsize,
  786. opsize : topsize;
  787. op : tasmop;
  788. begin
  789. oldtruelabel:=truelabel;
  790. oldfalselabel:=falselabel;
  791. getlabel(truelabel);
  792. getlabel(falselabel);
  793. secondpass(hp);
  794. clear_location(p^.location);
  795. p^.location.loc:=LOC_REGISTER;
  796. del_reference(hp^.location.reference);
  797. case hp^.resulttype^.size of
  798. 1 : begin
  799. case p^.resulttype^.size of
  800. 1 : opsize:=S_B;
  801. 2 : opsize:=S_BW;
  802. 4 : opsize:=S_BL;
  803. end;
  804. end;
  805. 2 : begin
  806. case p^.resulttype^.size of
  807. 1 : begin
  808. if hp^.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
  809. hp^.location.register:=reg16toreg8(hp^.location.register);
  810. opsize:=S_B;
  811. end;
  812. 2 : opsize:=S_W;
  813. 4 : opsize:=S_WL;
  814. end;
  815. end;
  816. 4 : begin
  817. case p^.resulttype^.size of
  818. 1 : begin
  819. if hp^.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
  820. hp^.location.register:=reg32toreg8(hp^.location.register);
  821. opsize:=S_B;
  822. end;
  823. 2 : begin
  824. if hp^.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
  825. hp^.location.register:=reg32toreg16(hp^.location.register);
  826. opsize:=S_W;
  827. end;
  828. 4 : opsize:=S_L;
  829. end;
  830. end;
  831. end;
  832. if opsize in [S_B,S_W,S_L] then
  833. op:=A_MOV
  834. else
  835. if is_signed(p^.resulttype) then
  836. op:=A_MOVSX
  837. else
  838. op:=A_MOVZX;
  839. hregister:=getregister32;
  840. case p^.resulttype^.size of
  841. 1 : begin
  842. p^.location.register:=reg32toreg8(hregister);
  843. newsize:=S_B;
  844. end;
  845. 2 : begin
  846. p^.location.register:=reg32toreg16(hregister);
  847. newsize:=S_W;
  848. end;
  849. 4 : begin
  850. p^.location.register:=hregister;
  851. newsize:=S_L;
  852. end;
  853. else
  854. internalerror(10060);
  855. end;
  856. case hp^.location.loc of
  857. LOC_MEM,
  858. LOC_REFERENCE : exprasmlist^.concat(new(pai386,op_ref_reg(op,opsize,
  859. newreference(hp^.location.reference),p^.location.register)));
  860. LOC_REGISTER,
  861. LOC_CREGISTER : begin
  862. { remove things like movb %al,%al }
  863. if hp^.location.register<>p^.location.register then
  864. exprasmlist^.concat(new(pai386,op_reg_reg(op,opsize,
  865. hp^.location.register,p^.location.register)));
  866. end;
  867. LOC_FLAGS : begin
  868. hregister:=reg32toreg8(hregister);
  869. exprasmlist^.concat(new(pai386,op_reg(flag_2_set[hp^.location.resflags],S_B,hregister)));
  870. case p^.resulttype^.size of
  871. 2 : exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_BW,hregister,p^.location.register)));
  872. 4 : exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_BL,hregister,p^.location.register)));
  873. end;
  874. end;
  875. LOC_JUMP : begin
  876. getlabel(hlabel);
  877. emitl(A_LABEL,truelabel);
  878. exprasmlist^.concat(new(pai386,op_const_reg(A_MOV,newsize,1,hregister)));
  879. emitl(A_JMP,hlabel);
  880. emitl(A_LABEL,falselabel);
  881. exprasmlist^.concat(new(pai386,op_reg_reg(A_XOR,newsize,hregister,hregister)));
  882. emitl(A_LABEL,hlabel);
  883. end;
  884. else
  885. internalerror(10061);
  886. end;
  887. freelabel(truelabel);
  888. freelabel(falselabel);
  889. truelabel:=oldtruelabel;
  890. falselabel:=oldfalselabel;
  891. end;
  892. procedure second_int_to_bool(p,hp : ptree;convtyp : tconverttype);
  893. var
  894. hregister : tregister;
  895. begin
  896. clear_location(p^.location);
  897. p^.location.loc:=LOC_REGISTER;
  898. del_reference(hp^.location.reference);
  899. case hp^.location.loc of
  900. LOC_MEM,LOC_REFERENCE :
  901. begin
  902. hregister:=getregister32;
  903. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
  904. newreference(hp^.location.reference),hregister)));
  905. end;
  906. LOC_REGISTER,LOC_CREGISTER :
  907. begin
  908. hregister:=hp^.location.register;
  909. end;
  910. else
  911. internalerror(10062);
  912. end;
  913. exprasmlist^.concat(new(pai386,op_reg_reg(A_OR,S_L,hregister,hregister)));
  914. hregister:=reg32toreg8(hregister);
  915. exprasmlist^.concat(new(pai386,op_reg(flag_2_set[hp^.location.resflags],S_B,hregister)));
  916. case p^.resulttype^.size of
  917. 1 : p^.location.register:=hregister;
  918. 2 : begin
  919. p^.location.register:=reg8toreg16(hregister);
  920. exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_BW,hregister,p^.location.register)));
  921. end;
  922. 4 : begin
  923. p^.location.register:=reg8toreg32(hregister);
  924. exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_BL,hregister,p^.location.register)));
  925. end;
  926. else
  927. internalerror(10064);
  928. end;
  929. end;
  930. procedure second_load_smallset(p,hp : ptree;convtyp : tconverttype);
  931. var
  932. href : treference;
  933. pushedregs : tpushed;
  934. begin
  935. href.symbol:=nil;
  936. pushusedregisters(pushedregs,$ff);
  937. gettempofsizereference(32,href);
  938. emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
  939. emitpushreferenceaddr(exprasmlist,href);
  940. emitcall('FPC_SET_LOAD_SMALL',true);
  941. maybe_loadesi;
  942. popusedregisters(pushedregs);
  943. clear_location(p^.location);
  944. p^.location.loc:=LOC_MEM;
  945. p^.location.reference:=href;
  946. end;
  947. procedure second_ansistring_to_pchar(p,hp : ptree;convtyp : tconverttype);
  948. var
  949. l1,l2 : plabel;
  950. hr : preference;
  951. begin
  952. clear_location(p^.location);
  953. p^.location.loc:=LOC_REGISTER;
  954. getlabel(l1);
  955. getlabel(l2);
  956. case hp^.location.loc of
  957. LOC_CREGISTER,LOC_REGISTER:
  958. exprasmlist^.concat(new(pai386,op_const_reg(A_CMP,S_L,0,
  959. hp^.location.register)));
  960. LOC_MEM,LOC_REFERENCE:
  961. begin
  962. exprasmlist^.concat(new(pai386,op_const_ref(A_CMP,S_L,0,
  963. newreference(hp^.location.reference))));
  964. del_reference(hp^.location.reference);
  965. p^.location.register:=getregister32;
  966. end;
  967. end;
  968. emitl(A_JZ,l1);
  969. if hp^.location.loc in [LOC_MEM,LOC_REFERENCE] then
  970. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(
  971. hp^.location.reference),
  972. p^.location.register)));
  973. emitl(A_JMP,l2);
  974. emitl(A_LABEL,l1);
  975. new(hr);
  976. reset_reference(hr^);
  977. hr^.symbol:=stringdup('FPC_EMPTYCHAR');
  978. exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,hr,
  979. p^.location.register)));
  980. emitl(A_LABEL,l2);
  981. end;
  982. procedure second_pchar_to_string(p,hp : ptree;convtyp : tconverttype);
  983. var
  984. pushed : tpushed;
  985. begin
  986. case pstringdef(p^.resulttype)^.string_typ of
  987. st_shortstring:
  988. begin
  989. pushusedregisters(pushed,$ff);
  990. stringdispose(p^.location.reference.symbol);
  991. gettempofsizereference(p^.resulttype^.size,p^.location.reference);
  992. case p^.left^.location.loc of
  993. LOC_REGISTER,LOC_CREGISTER:
  994. begin
  995. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,p^.left^.location.register)));
  996. ungetregister32(p^.left^.location.register);
  997. end;
  998. LOC_REFERENCE,LOC_MEM:
  999. begin
  1000. emit_push_mem(p^.left^.location.reference);
  1001. del_reference(p^.left^.location.reference);
  1002. end;
  1003. end;
  1004. emitpushreferenceaddr(exprasmlist,p^.location.reference);
  1005. emitcall('FPC_PCHAR_TO_SHORTSTR',true);
  1006. maybe_loadesi;
  1007. popusedregisters(pushed);
  1008. end;
  1009. st_ansistring:
  1010. begin
  1011. stringdispose(p^.location.reference.symbol);
  1012. gettempofsizereference(p^.resulttype^.size,p^.location.reference);
  1013. case p^.left^.location.loc of
  1014. LOC_REGISTER,LOC_CREGISTER:
  1015. begin
  1016. ungetregister32(p^.left^.location.register);
  1017. pushusedregisters(pushed,$ff);
  1018. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,p^.left^.location.register)));
  1019. end;
  1020. LOC_REFERENCE,LOC_MEM:
  1021. begin
  1022. del_reference(p^.left^.location.reference);
  1023. pushusedregisters(pushed,$ff);
  1024. emit_push_mem(p^.left^.location.reference);
  1025. end;
  1026. end;
  1027. emitpushreferenceaddr(exprasmlist,p^.location.reference);
  1028. emitcall('FPC_PCHAR_TO_ANSISTR',true);
  1029. maybe_loadesi;
  1030. popusedregisters(pushed);
  1031. end;
  1032. else
  1033. begin
  1034. clear_location(p^.location);
  1035. p^.location.loc:=LOC_REGISTER;
  1036. internalerror(12121);
  1037. end;
  1038. end;
  1039. end;
  1040. procedure second_nothing(p,hp : ptree;convtyp : tconverttype);
  1041. begin
  1042. end;
  1043. {****************************************************************************
  1044. SecondTypeConv
  1045. ****************************************************************************}
  1046. procedure secondtypeconv(var p : ptree);
  1047. const
  1048. secondconvert : array[tconverttype] of
  1049. tsecondconvproc = (second_nothing,second_nothing,
  1050. second_bigger,second_only_rangecheck,
  1051. second_bigger,second_bigger,second_bigger,
  1052. second_smaller,second_smaller,
  1053. second_smaller,second_string_string,
  1054. second_cstring_charpointer,second_string_chararray,
  1055. second_array_to_pointer,second_pointer_to_array,
  1056. second_char_to_string,second_bigger,
  1057. second_bigger,second_bigger,
  1058. second_smaller,second_smaller,
  1059. second_smaller,second_smaller,
  1060. second_bigger,second_smaller,
  1061. second_only_rangecheck,second_bigger,
  1062. second_bigger,second_bigger,
  1063. second_bigger,second_only_rangecheck,
  1064. second_smaller,second_smaller,
  1065. second_smaller,second_smaller,
  1066. second_bool_to_int,second_int_to_bool,
  1067. second_int_real,second_real_fix,
  1068. second_fix_real,second_int_fix,second_float_float,
  1069. second_chararray_to_string,
  1070. second_proc_to_procvar,
  1071. { is constant char to pchar, is done by firstpass }
  1072. second_nothing,
  1073. second_load_smallset,
  1074. second_ansistring_to_pchar,
  1075. second_pchar_to_string,
  1076. second_nothing);
  1077. begin
  1078. { this isn't good coding, I think tc_bool_2_int, shouldn't be }
  1079. { type conversion (FK) }
  1080. { this is necessary, because second_bool_byte, have to change }
  1081. { true- and false label before calling secondpass }
  1082. if p^.convtyp<>tc_bool_2_int then
  1083. begin
  1084. secondpass(p^.left);
  1085. set_location(p^.location,p^.left^.location);
  1086. if codegenerror then
  1087. exit;
  1088. end;
  1089. if not(p^.convtyp in [tc_equal,tc_not_possible]) then
  1090. {the second argument only is for maybe_range_checking !}
  1091. secondconvert[p^.convtyp](p,p^.left,p^.convtyp)
  1092. end;
  1093. {*****************************************************************************
  1094. SecondIs
  1095. *****************************************************************************}
  1096. procedure secondis(var p : ptree);
  1097. var
  1098. pushed : tpushed;
  1099. begin
  1100. { save all used registers }
  1101. pushusedregisters(pushed,$ff);
  1102. secondpass(p^.left);
  1103. clear_location(p^.location);
  1104. p^.location.loc:=LOC_FLAGS;
  1105. p^.location.resflags:=F_NE;
  1106. { push instance to check: }
  1107. case p^.left^.location.loc of
  1108. LOC_REGISTER,LOC_CREGISTER:
  1109. begin
  1110. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,
  1111. S_L,p^.left^.location.register)));
  1112. ungetregister32(p^.left^.location.register);
  1113. end;
  1114. LOC_MEM,LOC_REFERENCE:
  1115. begin
  1116. exprasmlist^.concat(new(pai386,op_ref(A_PUSH,
  1117. S_L,newreference(p^.left^.location.reference))));
  1118. del_reference(p^.left^.location.reference);
  1119. end;
  1120. else internalerror(100);
  1121. end;
  1122. { generate type checking }
  1123. secondpass(p^.right);
  1124. case p^.right^.location.loc of
  1125. LOC_REGISTER,LOC_CREGISTER:
  1126. begin
  1127. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,
  1128. S_L,p^.right^.location.register)));
  1129. ungetregister32(p^.right^.location.register);
  1130. end;
  1131. LOC_MEM,LOC_REFERENCE:
  1132. begin
  1133. exprasmlist^.concat(new(pai386,op_ref(A_PUSH,
  1134. S_L,newreference(p^.right^.location.reference))));
  1135. del_reference(p^.right^.location.reference);
  1136. end;
  1137. else internalerror(100);
  1138. end;
  1139. emitcall('FPC_DO_IS',true);
  1140. exprasmlist^.concat(new(pai386,op_reg_reg(A_OR,S_B,R_AL,R_AL)));
  1141. popusedregisters(pushed);
  1142. end;
  1143. {*****************************************************************************
  1144. SecondAs
  1145. *****************************************************************************}
  1146. procedure secondas(var p : ptree);
  1147. var
  1148. pushed : tpushed;
  1149. begin
  1150. secondpass(p^.left);
  1151. { save all used registers }
  1152. pushusedregisters(pushed,$ff);
  1153. { push instance to check: }
  1154. case p^.left^.location.loc of
  1155. LOC_REGISTER,LOC_CREGISTER:
  1156. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,
  1157. S_L,p^.left^.location.register)));
  1158. LOC_MEM,LOC_REFERENCE:
  1159. exprasmlist^.concat(new(pai386,op_ref(A_PUSH,
  1160. S_L,newreference(p^.left^.location.reference))));
  1161. else internalerror(100);
  1162. end;
  1163. { we doesn't modifiy the left side, we check only the type }
  1164. set_location(p^.location,p^.left^.location);
  1165. { generate type checking }
  1166. secondpass(p^.right);
  1167. case p^.right^.location.loc of
  1168. LOC_REGISTER,LOC_CREGISTER:
  1169. begin
  1170. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,
  1171. S_L,p^.right^.location.register)));
  1172. ungetregister32(p^.right^.location.register);
  1173. end;
  1174. LOC_MEM,LOC_REFERENCE:
  1175. begin
  1176. exprasmlist^.concat(new(pai386,op_ref(A_PUSH,
  1177. S_L,newreference(p^.right^.location.reference))));
  1178. del_reference(p^.right^.location.reference);
  1179. end;
  1180. else internalerror(100);
  1181. end;
  1182. emitcall('FPC_DO_AS',true);
  1183. { restore register, this restores automatically the }
  1184. { result }
  1185. popusedregisters(pushed);
  1186. end;
  1187. end.
  1188. {
  1189. $Log$
  1190. Revision 1.34 1998-11-18 15:44:08 peter
  1191. * VALUEPARA for tp7 compatible value parameters
  1192. Revision 1.33 1998/11/17 00:36:39 peter
  1193. * more ansistring fixes
  1194. Revision 1.32 1998/11/16 15:35:38 peter
  1195. * rename laod/copystring -> load/copyshortstring
  1196. * fixed int-bool cnv bug
  1197. + char-ansistring conversion
  1198. Revision 1.31 1998/11/05 12:02:30 peter
  1199. * released useansistring
  1200. * removed -Sv, its now available in fpc modes
  1201. Revision 1.30 1998/10/27 11:12:45 peter
  1202. * fixed char_to_string which did not set the .loc
  1203. Revision 1.29 1998/10/26 15:18:41 peter
  1204. * fixed fldcw,fstcw for as 2.9.1
  1205. Revision 1.28 1998/10/08 17:17:11 pierre
  1206. * current_module old scanner tagged as invalid if unit is recompiled
  1207. + added ppheap for better info on tracegetmem of heaptrc
  1208. (adds line column and file index)
  1209. * several memory leaks removed ith help of heaptrc !!
  1210. Revision 1.27 1998/10/06 17:16:40 pierre
  1211. * some memory leaks fixed (thanks to Peter for heaptrc !)
  1212. Revision 1.26 1998/10/02 07:20:35 florian
  1213. * range checking in units doesn't work if the units are smartlinked, fixed
  1214. Revision 1.25 1998/09/30 12:14:24 peter
  1215. * fixed boolean(longbool) conversion
  1216. Revision 1.24 1998/09/27 10:16:22 florian
  1217. * type casts pchar<->ansistring fixed
  1218. * ansistring[..] calls does now an unique call
  1219. Revision 1.23 1998/09/23 12:03:51 peter
  1220. * overloading fix for array of const
  1221. Revision 1.22 1998/09/22 15:34:09 peter
  1222. + pchar -> string conversion
  1223. Revision 1.21 1998/09/20 17:46:47 florian
  1224. * some things regarding ansistrings fixed
  1225. Revision 1.20 1998/09/17 09:42:12 peter
  1226. + pass_2 for cg386
  1227. * Message() -> CGMessage() for pass_1/pass_2
  1228. Revision 1.19 1998/09/14 10:43:46 peter
  1229. * all internal RTL functions start with FPC_
  1230. Revision 1.18 1998/09/11 12:29:40 pierre
  1231. * removed explicit range_checking as it is buggy
  1232. Revision 1.17.2.1 1998/09/11 12:08:54 pierre
  1233. * removed explicit range_check was buggy
  1234. Revision 1.17 1998/09/04 08:41:38 peter
  1235. * updated some error CGMessages
  1236. Revision 1.16 1998/09/03 17:39:03 florian
  1237. + better code for type conversation longint/dword to real type
  1238. Revision 1.15 1998/09/03 16:24:50 florian
  1239. * bug of type conversation from dword to real fixed
  1240. * bug fix of Jonas applied
  1241. Revision 1.14 1998/08/28 12:51:39 florian
  1242. + ansistring to pchar type cast fixed
  1243. Revision 1.13 1998/08/28 10:56:56 peter
  1244. * removed warnings
  1245. Revision 1.12 1998/08/14 18:18:38 peter
  1246. + dynamic set contruction
  1247. * smallsets are now working (always longint size)
  1248. Revision 1.11 1998/08/10 23:59:59 peter
  1249. * fixed dup log
  1250. Revision 1.10 1998/08/10 14:49:47 peter
  1251. + localswitches, moduleswitches, globalswitches splitting
  1252. Revision 1.9 1998/08/05 16:00:09 florian
  1253. * some fixes for ansi strings
  1254. Revision 1.8 1998/07/18 22:54:24 florian
  1255. * some ansi/wide/longstring support fixed:
  1256. o parameter passing
  1257. o returning as result from functions
  1258. Revision 1.7 1998/06/12 13:10:34 peter
  1259. * small internalerror nr change
  1260. Revision 1.6 1998/06/12 10:43:12 michael
  1261. Fixed ansistrings : is_ansistring not found
  1262. Revision 1.5 1998/06/08 13:13:30 pierre
  1263. + temporary variables now in temp_gen.pas unit
  1264. because it is processor independent
  1265. * mppc68k.bat modified to undefine i386 and support_mmx
  1266. (which are defaults for i386)
  1267. Revision 1.4 1998/06/05 17:44:10 peter
  1268. * splitted cgi386
  1269. Revision 1.3 1998/06/03 22:48:50 peter
  1270. + wordbool,longbool
  1271. * rename bis,von -> high,low
  1272. * moved some systemunit loading/creating to psystem.pas
  1273. Revision 1.2 1998/06/02 10:52:10 peter
  1274. * fixed second_bool_to_int with bool8bit return
  1275. Revision 1.1 1998/06/01 16:50:18 peter
  1276. + boolean -> ord conversion
  1277. * fixed ord -> boolean conversion
  1278. }