cg386cnv.pas 52 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333
  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('R_'+tostr(porddef(p1)^.rangenr));
  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('R_'+tostr(porddef(p1)^.rangenr+1));
  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('R_'+tostr(porddef(hp^.resulttype)^.rangenr));
  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('R_'+tostr(porddef(p^.resulttype)^.rangenr));
  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('R_'+tostr(porddef(p^.resulttype)^.rangenr));
  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. p^.location.loc:=LOC_REGISTER;
  364. p^.location.register:=hregister;
  365. maybe_rangechecking(p,p^.left^.resulttype,p^.resulttype);
  366. end;
  367. procedure second_string_string(p,hp : ptree;convtyp : tconverttype);
  368. {$ifdef UseAnsiString}
  369. var
  370. pushed : tpushed;
  371. {$endif UseAnsiString}
  372. begin
  373. {$ifdef UseAnsiString}
  374. { does anybody know a better solution than this big case statement ? }
  375. { ok, a proc table would do the job }
  376. case pstringdef(p^.resulttype)^.string_typ of
  377. st_shortstring:
  378. case pstringdef(p^.left^.resulttype)^.string_typ of
  379. st_shortstring:
  380. begin
  381. stringdispose(p^.location.reference.symbol);
  382. gettempofsizereference(p^.resulttype^.size,p^.location.reference);
  383. del_reference(p^.left^.location.reference);
  384. copystring(p^.location.reference,p^.left^.location.reference,pstringdef(p^.resulttype)^.len);
  385. ungetiftemp(p^.left^.location.reference);
  386. end;
  387. st_longstring:
  388. begin
  389. {!!!!!!!}
  390. internalerror(8888);
  391. end;
  392. st_ansistring:
  393. begin
  394. gettempofsizereference(p^.resulttype^.size,p^.location.reference);
  395. loadansi2short(p^.left,p);
  396. end;
  397. st_widestring:
  398. begin
  399. {!!!!!!!}
  400. internalerror(8888);
  401. end;
  402. end;
  403. st_longstring:
  404. case pstringdef(p^.left)^.string_typ of
  405. st_shortstring:
  406. begin
  407. {!!!!!!!}
  408. internalerror(8888);
  409. end;
  410. st_ansistring:
  411. begin
  412. {!!!!!!!}
  413. internalerror(8888);
  414. end;
  415. st_widestring:
  416. begin
  417. {!!!!!!!}
  418. internalerror(8888);
  419. end;
  420. end;
  421. st_ansistring:
  422. case pstringdef(p^.left)^.string_typ of
  423. st_shortstring:
  424. begin
  425. pushusedregisters(pushed,$ff);
  426. push_int(p^.resulttype^.size-1);
  427. gettempofsizereference(p^.resulttype^.size,p^.location.reference);
  428. emitpushreferenceaddr(exprasmlist,p^.location.reference);
  429. case p^.right^.location.loc of
  430. LOC_REGISTER,LOC_CREGISTER:
  431. begin
  432. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,p^.right^.location.register)));
  433. ungetregister32(p^.left^.location.register);
  434. end;
  435. LOC_REFERENCE,LOC_MEM:
  436. begin
  437. emit_push_mem(p^.left^.location.reference);
  438. del_reference(p^.left^.location.reference);
  439. end;
  440. end;
  441. emitcall('FPC_ANSI_TO_SHORTSTRING',true);
  442. maybe_loadesi;
  443. popusedregisters(pushed);
  444. end;
  445. st_longstring:
  446. begin
  447. {!!!!!!!}
  448. internalerror(8888);
  449. end;
  450. st_widestring:
  451. begin
  452. {!!!!!!!}
  453. internalerror(8888);
  454. end;
  455. end;
  456. st_widestring:
  457. case pstringdef(p^.left)^.string_typ of
  458. st_shortstring:
  459. begin
  460. {!!!!!!!}
  461. internalerror(8888);
  462. end;
  463. st_longstring:
  464. begin
  465. {!!!!!!!}
  466. internalerror(8888);
  467. end;
  468. st_ansistring:
  469. begin
  470. {!!!!!!!}
  471. internalerror(8888);
  472. end;
  473. st_widestring:
  474. begin
  475. {!!!!!!!}
  476. internalerror(8888);
  477. end;
  478. end;
  479. end;
  480. {$ifdef dummy}
  481. if is_ansistring(p^.resulttype) and not is_ansistring(p^.left^.resulttype) then
  482. begin
  483. { call shortstring to ansistring conversion }
  484. { result is in register }
  485. del_reference(p^.left^.location.reference);
  486. {!!!!
  487. copyshortstringtoansistring(p^.location,p^.left^.location.reference,pstringdef(p^.resulttype)^.len);
  488. }
  489. ungetiftemp(p^.left^.location.reference);
  490. end
  491. else if not is_ansistring(p^.resulttype) and is_ansistring(p^.left^.resulttype) then
  492. begin
  493. { call ansistring to shortstring conversion }
  494. { result is in mem }
  495. stringdispose(p^.location.reference.symbol);
  496. gettempofsizereference(p^.resulttype^.size,p^.location.reference);
  497. if p^.left^.location.loc in [LOC_MEM,LOC_REFERENCE] then
  498. del_reference(p^.left^.location.reference);
  499. copyansistringtoshortstring(p^.location.reference,p^.left^.location.reference,pstringdef(p^.resulttype)^.len);
  500. ungetiftemp(p^.left^.location.reference);
  501. end
  502. else
  503. {$endif dummy}
  504. {$else UseAnsiString}
  505. begin
  506. stringdispose(p^.location.reference.symbol);
  507. gettempofsizereference(p^.resulttype^.size,p^.location.reference);
  508. del_reference(p^.left^.location.reference);
  509. copystring(p^.location.reference,p^.left^.location.reference,pstringdef(p^.resulttype)^.len);
  510. ungetiftemp(p^.left^.location.reference);
  511. end;
  512. {$endif UseAnsiString}
  513. end;
  514. procedure second_cstring_charpointer(p,hp : ptree;convtyp : tconverttype);
  515. begin
  516. p^.location.loc:=LOC_REGISTER;
  517. p^.location.register:=getregister32;
  518. inc(p^.left^.location.reference.offset);
  519. exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,newreference(p^.left^.location.reference),
  520. p^.location.register)));
  521. end;
  522. procedure second_string_chararray(p,hp : ptree;convtyp : tconverttype);
  523. begin
  524. inc(p^.location.reference.offset);
  525. end;
  526. procedure second_array_to_pointer(p,hp : ptree;convtyp : tconverttype);
  527. begin
  528. del_reference(p^.left^.location.reference);
  529. p^.location.loc:=LOC_REGISTER;
  530. p^.location.register:=getregister32;
  531. exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,newreference(p^.left^.location.reference),
  532. p^.location.register)));
  533. end;
  534. procedure second_pointer_to_array(p,hp : ptree;convtyp : tconverttype);
  535. begin
  536. p^.location.loc:=LOC_REFERENCE;
  537. clear_reference(p^.location.reference);
  538. if p^.left^.location.loc=LOC_REGISTER then
  539. p^.location.reference.base:=p^.left^.location.register
  540. else
  541. begin
  542. if p^.left^.location.loc=LOC_CREGISTER then
  543. begin
  544. p^.location.reference.base:=getregister32;
  545. emit_reg_reg(A_MOV,S_L,p^.left^.location.register,
  546. p^.location.reference.base);
  547. end
  548. else
  549. begin
  550. del_reference(p^.left^.location.reference);
  551. p^.location.reference.base:=getregister32;
  552. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(p^.left^.location.reference),
  553. p^.location.reference.base)));
  554. end;
  555. end;
  556. end;
  557. { generates the code for the type conversion from an array of char }
  558. { to a string }
  559. procedure second_chararray_to_string(p,hp : ptree;convtyp : tconverttype);
  560. var
  561. l : longint;
  562. begin
  563. { this is a type conversion which copies the data, so we can't }
  564. { return a reference }
  565. p^.location.loc:=LOC_MEM;
  566. { first get the memory for the string }
  567. stringdispose(p^.location.reference.symbol);
  568. gettempofsizereference(256,p^.location.reference);
  569. { calc the length of the array }
  570. l:=parraydef(p^.left^.resulttype)^.highrange-
  571. parraydef(p^.left^.resulttype)^.lowrange+1;
  572. if l>255 then
  573. CGMessage(type_e_mismatch);
  574. { write the length }
  575. exprasmlist^.concat(new(pai386,op_const_ref(A_MOV,S_B,l,
  576. newreference(p^.location.reference))));
  577. { copy to first char of string }
  578. inc(p^.location.reference.offset);
  579. { generates the copy code }
  580. { and we need the source never }
  581. concatcopy(p^.left^.location.reference,p^.location.reference,l,true);
  582. { correct the string location }
  583. dec(p^.location.reference.offset);
  584. end;
  585. procedure second_char_to_string(p,hp : ptree;convtyp : tconverttype);
  586. begin
  587. stringdispose(p^.location.reference.symbol);
  588. gettempofsizereference(256,p^.location.reference);
  589. { call loadstring with correct left and right }
  590. p^.right:=p^.left;
  591. p^.left:=p;
  592. loadstring(p);
  593. p^.left:=nil; { reset left tree, which is empty }
  594. end;
  595. procedure second_int_real(p,hp : ptree;convtyp : tconverttype);
  596. var
  597. r : preference;
  598. hregister : tregister;
  599. begin
  600. { for u32bit a solution is to push $0 and to load a comp }
  601. { does this first, it destroys maybe EDI }
  602. hregister:=R_EDI;
  603. if porddef(p^.left^.resulttype)^.typ=u32bit then
  604. push_int(0);
  605. if (p^.left^.location.loc=LOC_REGISTER) or
  606. (p^.left^.location.loc=LOC_CREGISTER) then
  607. begin
  608. case porddef(p^.left^.resulttype)^.typ of
  609. s8bit : exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVSX,S_BL,p^.left^.location.register,R_EDI)));
  610. u8bit : exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_BL,p^.left^.location.register,R_EDI)));
  611. s16bit : exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVSX,S_WL,p^.left^.location.register,R_EDI)));
  612. u16bit : exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_WL,p^.left^.location.register,R_EDI)));
  613. u32bit,s32bit:
  614. hregister:=p^.left^.location.register
  615. end;
  616. ungetregister(p^.left^.location.register);
  617. end
  618. else
  619. begin
  620. r:=newreference(p^.left^.location.reference);
  621. case porddef(p^.left^.resulttype)^.typ of
  622. s8bit : exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVSX,S_BL,r,R_EDI)));
  623. u8bit : exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVZX,S_BL,r,R_EDI)));
  624. s16bit : exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVSX,S_WL,r,R_EDI)));
  625. u16bit : exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVZX,S_WL,r,R_EDI)));
  626. u32bit,s32bit : exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_EDI)));
  627. end;
  628. del_reference(p^.left^.location.reference);
  629. ungetiftemp(p^.left^.location.reference);
  630. end;
  631. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,hregister)));
  632. r:=new_reference(R_ESP,0);
  633. if porddef(p^.left^.resulttype)^.typ=u32bit then
  634. exprasmlist^.concat(new(pai386,op_ref(A_FILD,S_IQ,r)))
  635. else
  636. exprasmlist^.concat(new(pai386,op_ref(A_FILD,S_IL,r)));
  637. { better than an add on all processors }
  638. if porddef(p^.left^.resulttype)^.typ=u32bit then
  639. exprasmlist^.concat(new(pai386,op_const_reg(A_ADD,S_L,8,R_ESP)))
  640. else
  641. exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EDI)));
  642. p^.location.loc:=LOC_FPU;
  643. end;
  644. procedure second_real_fix(p,hp : ptree;convtyp : tconverttype);
  645. var
  646. {hs : string;}
  647. rreg : tregister;
  648. ref : treference;
  649. begin
  650. { real must be on fpu stack }
  651. if (p^.left^.location.loc<>LOC_FPU) then
  652. exprasmlist^.concat(new(pai386,op_ref(A_FLD,S_FL,newreference(p^.left^.location.reference))));
  653. push_int($1f3f);
  654. push_int(65536);
  655. reset_reference(ref);
  656. ref.base:=R_ESP;
  657. exprasmlist^.concat(new(pai386,op_ref(A_FIMUL,S_IL,newreference(ref))));
  658. ref.offset:=4;
  659. exprasmlist^.concat(new(pai386,op_ref(A_FSTCW,S_L,newreference(ref))));
  660. ref.offset:=6;
  661. exprasmlist^.concat(new(pai386,op_ref(A_FLDCW,S_L,newreference(ref))));
  662. ref.offset:=0;
  663. exprasmlist^.concat(new(pai386,op_ref(A_FISTP,S_IL,newreference(ref))));
  664. ref.offset:=4;
  665. exprasmlist^.concat(new(pai386,op_ref(A_FLDCW,S_L,newreference(ref))));
  666. rreg:=getregister32;
  667. exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,rreg)));
  668. { better than an add on all processors }
  669. exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EDI)));
  670. p^.location.loc:=LOC_REGISTER;
  671. p^.location.register:=rreg;
  672. end;
  673. procedure second_float_float(p,hp : ptree;convtyp : tconverttype);
  674. begin
  675. case p^.left^.location.loc of
  676. LOC_FPU : ;
  677. LOC_MEM,
  678. LOC_REFERENCE:
  679. begin
  680. floatload(pfloatdef(p^.left^.resulttype)^.typ,
  681. p^.left^.location.reference);
  682. { we have to free the reference }
  683. del_reference(p^.left^.location.reference);
  684. end;
  685. end;
  686. p^.location.loc:=LOC_FPU;
  687. end;
  688. procedure second_fix_real(p,hp : ptree;convtyp : tconverttype);
  689. var popeax,popebx,popecx,popedx : boolean;
  690. startreg : tregister;
  691. hl : plabel;
  692. r : treference;
  693. begin
  694. if (p^.left^.location.loc=LOC_REGISTER) or
  695. (p^.left^.location.loc=LOC_CREGISTER) then
  696. begin
  697. startreg:=p^.left^.location.register;
  698. ungetregister(startreg);
  699. popeax:=(startreg<>R_EAX) and not (R_EAX in unused);
  700. if popeax then
  701. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_EAX)));
  702. { mov eax,eax is removed by emit_reg_reg }
  703. emit_reg_reg(A_MOV,S_L,startreg,R_EAX);
  704. end
  705. else
  706. begin
  707. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(
  708. p^.left^.location.reference),R_EAX)));
  709. del_reference(p^.left^.location.reference);
  710. startreg:=R_NO;
  711. end;
  712. popebx:=(startreg<>R_EBX) and not (R_EBX in unused);
  713. if popebx then
  714. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_EBX)));
  715. popecx:=(startreg<>R_ECX) and not (R_ECX in unused);
  716. if popecx then
  717. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ECX)));
  718. popedx:=(startreg<>R_EDX) and not (R_EDX in unused);
  719. if popedx then
  720. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_EDX)));
  721. exprasmlist^.concat(new(pai386,op_none(A_CDQ,S_NO)));
  722. emit_reg_reg(A_XOR,S_L,R_EDX,R_EAX);
  723. emit_reg_reg(A_MOV,S_L,R_EAX,R_EBX);
  724. emit_reg_reg(A_SUB,S_L,R_EDX,R_EAX);
  725. getlabel(hl);
  726. emitl(A_JZ,hl);
  727. exprasmlist^.concat(new(pai386,op_const_reg(A_RCL,S_L,1,R_EBX)));
  728. emit_reg_reg(A_BSR,S_L,R_EAX,R_EDX);
  729. exprasmlist^.concat(new(pai386,op_const_reg(A_MOV,S_B,32,R_CL)));
  730. emit_reg_reg(A_SUB,S_B,R_DL,R_CL);
  731. emit_reg_reg(A_SHL,S_L,R_CL,R_EAX);
  732. exprasmlist^.concat(new(pai386,op_const_reg(A_ADD,S_W,1007,R_DX)));
  733. exprasmlist^.concat(new(pai386,op_const_reg(A_SHL,S_W,5,R_DX)));
  734. exprasmlist^.concat(new(pai386,op_const_reg_reg(A_SHLD,S_W,11,R_DX,R_BX)));
  735. exprasmlist^.concat(new(pai386,op_const_reg_reg(A_SHLD,S_W,20,R_EAX,R_EBX)));
  736. exprasmlist^.concat(new(pai386,op_const_reg(A_SHL,S_L,20,R_EAX)));
  737. emitl(A_LABEL,hl);
  738. { better than an add on all processors }
  739. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_EBX)));
  740. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_EAX)));
  741. reset_reference(r);
  742. r.base:=R_ESP;
  743. exprasmlist^.concat(new(pai386,op_ref(A_FLD,S_FL,newreference(r))));
  744. exprasmlist^.concat(new(pai386,op_const_reg(A_ADD,S_L,8,R_ESP)));
  745. if popedx then
  746. exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EDX)));
  747. if popecx then
  748. exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_ECX)));
  749. if popebx then
  750. exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EBX)));
  751. if popeax then
  752. exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EAX)));
  753. p^.location.loc:=LOC_FPU;
  754. end;
  755. procedure second_int_fix(p,hp : ptree;convtyp : tconverttype);
  756. var
  757. {hs : string;}
  758. hregister : tregister;
  759. begin
  760. if (p^.left^.location.loc=LOC_REGISTER) then
  761. hregister:=p^.left^.location.register
  762. else if (p^.left^.location.loc=LOC_CREGISTER) then
  763. hregister:=getregister32
  764. else
  765. begin
  766. del_reference(p^.left^.location.reference);
  767. hregister:=getregister32;
  768. case porddef(p^.left^.resulttype)^.typ of
  769. s8bit : exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVSX,S_BL,newreference(p^.left^.location.reference),
  770. hregister)));
  771. u8bit : exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVZX,S_BL,newreference(p^.left^.location.reference),
  772. hregister)));
  773. s16bit : exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVSX,S_WL,newreference(p^.left^.location.reference),
  774. hregister)));
  775. u16bit : exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVZX,S_WL,newreference(p^.left^.location.reference),
  776. hregister)));
  777. u32bit,s32bit : exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(p^.left^.location.reference),
  778. hregister)));
  779. {!!!! u32bit }
  780. end;
  781. end;
  782. exprasmlist^.concat(new(pai386,op_const_reg(A_SHL,S_L,16,hregister)));
  783. p^.location.loc:=LOC_REGISTER;
  784. p^.location.register:=hregister;
  785. end;
  786. procedure second_proc_to_procvar(p,hp : ptree;convtyp : tconverttype);
  787. begin
  788. p^.location.loc:=LOC_REGISTER;
  789. del_reference(hp^.location.reference);
  790. p^.location.register:=getregister32;
  791. exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
  792. newreference(hp^.location.reference),p^.location.register)));
  793. end;
  794. procedure second_bool_to_int(p,hp : ptree;convtyp : tconverttype);
  795. var
  796. oldtruelabel,oldfalselabel,hlabel : plabel;
  797. hregister : tregister;
  798. newsize,
  799. opsize : topsize;
  800. op : tasmop;
  801. begin
  802. oldtruelabel:=truelabel;
  803. oldfalselabel:=falselabel;
  804. getlabel(truelabel);
  805. getlabel(falselabel);
  806. secondpass(hp);
  807. p^.location.loc:=LOC_REGISTER;
  808. del_reference(hp^.location.reference);
  809. hregister:=getregister32;
  810. case porddef(hp^.resulttype)^.typ of
  811. bool8bit : begin
  812. case porddef(p^.resulttype)^.typ of
  813. u8bit,s8bit,
  814. bool8bit : opsize:=S_B;
  815. u16bit,s16bit,
  816. bool16bit : opsize:=S_BW;
  817. u32bit,s32bit,
  818. bool32bit : opsize:=S_BL;
  819. end;
  820. end;
  821. bool16bit : begin
  822. case porddef(p^.resulttype)^.typ of
  823. u8bit,s8bit,
  824. bool8bit : opsize:=S_B;
  825. u16bit,s16bit,
  826. bool16bit : opsize:=S_W;
  827. u32bit,s32bit,
  828. bool32bit : opsize:=S_WL;
  829. end;
  830. end;
  831. bool32bit : begin
  832. case porddef(p^.resulttype)^.typ of
  833. u8bit,s8bit,
  834. bool8bit : opsize:=S_B;
  835. u16bit,s16bit,
  836. bool16bit : opsize:=S_W;
  837. u32bit,s32bit,
  838. bool32bit : opsize:=S_L;
  839. end;
  840. end;
  841. end;
  842. if opsize in [S_B,S_W,S_L] then
  843. op:=A_MOV
  844. else
  845. if (porddef(p^.resulttype)^.typ in [s8bit,s16bit,s32bit]) then
  846. op:=A_MOVSX
  847. else
  848. op:=A_MOVZX;
  849. case porddef(p^.resulttype)^.typ of
  850. bool8bit,u8bit,s8bit : begin
  851. p^.location.register:=reg32toreg8(hregister);
  852. newsize:=S_B;
  853. end;
  854. bool16bit,u16bit,s16bit : begin
  855. p^.location.register:=reg32toreg16(hregister);
  856. newsize:=S_W;
  857. end;
  858. bool32bit,u32bit,s32bit : begin
  859. p^.location.register:=hregister;
  860. newsize:=S_L;
  861. end;
  862. else
  863. internalerror(10060);
  864. end;
  865. case hp^.location.loc of
  866. LOC_MEM,
  867. LOC_REFERENCE : exprasmlist^.concat(new(pai386,op_ref_reg(op,opsize,
  868. newreference(hp^.location.reference),p^.location.register)));
  869. LOC_REGISTER,
  870. LOC_CREGISTER : exprasmlist^.concat(new(pai386,op_reg_reg(op,opsize,
  871. hp^.location.register,p^.location.register)));
  872. LOC_FLAGS : begin
  873. hregister:=reg32toreg8(hregister);
  874. exprasmlist^.concat(new(pai386,op_reg(flag_2_set[hp^.location.resflags],S_B,hregister)));
  875. case porddef(p^.resulttype)^.typ of
  876. bool16bit,
  877. u16bit,s16bit : exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_BW,hregister,p^.location.register)));
  878. bool32bit,
  879. u32bit,s32bit : exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_BL,hregister,p^.location.register)));
  880. end;
  881. end;
  882. LOC_JUMP : begin
  883. getlabel(hlabel);
  884. emitl(A_LABEL,truelabel);
  885. exprasmlist^.concat(new(pai386,op_const_reg(A_MOV,newsize,1,hregister)));
  886. emitl(A_JMP,hlabel);
  887. emitl(A_LABEL,falselabel);
  888. exprasmlist^.concat(new(pai386,op_reg_reg(A_XOR,newsize,hregister,hregister)));
  889. emitl(A_LABEL,hlabel);
  890. end;
  891. else
  892. internalerror(10061);
  893. end;
  894. truelabel:=oldtruelabel;
  895. falselabel:=oldfalselabel;
  896. end;
  897. procedure second_int_to_bool(p,hp : ptree;convtyp : tconverttype);
  898. var
  899. hregister : tregister;
  900. begin
  901. p^.location.loc:=LOC_REGISTER;
  902. del_reference(hp^.location.reference);
  903. case hp^.location.loc of
  904. LOC_MEM,LOC_REFERENCE :
  905. begin
  906. hregister:=getregister32;
  907. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
  908. newreference(hp^.location.reference),hregister)));
  909. end;
  910. LOC_REGISTER,LOC_CREGISTER :
  911. begin
  912. hregister:=hp^.location.register;
  913. end;
  914. else
  915. internalerror(10062);
  916. end;
  917. exprasmlist^.concat(new(pai386,op_reg_reg(A_OR,S_L,hregister,hregister)));
  918. hregister:=reg32toreg8(hregister);
  919. exprasmlist^.concat(new(pai386,op_reg(flag_2_set[hp^.location.resflags],S_B,hregister)));
  920. case porddef(p^.resulttype)^.typ of
  921. bool8bit : p^.location.register:=hregister;
  922. bool16bit : begin
  923. p^.location.register:=reg8toreg16(hregister);
  924. exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_BW,hregister,p^.location.register)));
  925. end;
  926. bool32bit : begin
  927. p^.location.register:=reg16toreg32(hregister);
  928. exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_BL,hregister,p^.location.register)));
  929. end;
  930. else
  931. internalerror(10064);
  932. end;
  933. end;
  934. procedure second_load_smallset(p,hp : ptree;convtyp : tconverttype);
  935. var
  936. href : treference;
  937. pushedregs : tpushed;
  938. begin
  939. href.symbol:=nil;
  940. pushusedregisters(pushedregs,$ff);
  941. gettempofsizereference(32,href);
  942. emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
  943. emitpushreferenceaddr(exprasmlist,href);
  944. emitcall('FPC_SET_LOAD_SMALL',true);
  945. maybe_loadesi;
  946. popusedregisters(pushedregs);
  947. p^.location.loc:=LOC_MEM;
  948. stringdispose(p^.location.reference.symbol);
  949. p^.location.reference:=href;
  950. end;
  951. procedure second_ansistring_to_pchar(p,hp : ptree;convtyp : tconverttype);
  952. var
  953. l1,l2 : plabel;
  954. hr : preference;
  955. begin
  956. p^.location.loc:=LOC_REGISTER;
  957. getlabel(l1);
  958. getlabel(l2);
  959. case hp^.location.loc of
  960. LOC_CREGISTER,LOC_REGISTER:
  961. exprasmlist^.concat(new(pai386,op_const_reg(A_CMP,S_L,0,
  962. hp^.location.register)));
  963. LOC_MEM,LOC_REFERENCE:
  964. begin
  965. exprasmlist^.concat(new(pai386,op_const_ref(A_CMP,S_L,0,
  966. newreference(hp^.location.reference))));
  967. del_reference(hp^.location.reference);
  968. p^.location.register:=getregister32;
  969. end;
  970. end;
  971. emitl(A_JZ,l1);
  972. if hp^.location.loc in [LOC_MEM,LOC_REFERENCE] then
  973. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(
  974. hp^.location.reference),
  975. p^.location.register)));
  976. emitl(A_JMP,l2);
  977. emitl(A_LABEL,l1);
  978. new(hr);
  979. reset_reference(hr^);
  980. hr^.symbol:=stringdup('FPC_EMPTYCHAR');
  981. exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,hr,
  982. p^.location.register)));
  983. emitl(A_LABEL,l2);
  984. end;
  985. procedure second_pchar_to_ansistring(p,hp : ptree;convtyp : tconverttype);
  986. begin
  987. p^.location.loc:=LOC_REGISTER;
  988. internalerror(12121);
  989. end;
  990. procedure second_nothing(p,hp : ptree;convtyp : tconverttype);
  991. begin
  992. end;
  993. {****************************************************************************
  994. SecondTypeConv
  995. ****************************************************************************}
  996. procedure secondtypeconv(var p : ptree);
  997. const
  998. secondconvert : array[tconverttype] of
  999. tsecondconvproc = (second_nothing,second_nothing,
  1000. second_bigger,second_only_rangecheck,
  1001. second_bigger,second_bigger,second_bigger,
  1002. second_smaller,second_smaller,
  1003. second_smaller,second_string_string,
  1004. second_cstring_charpointer,second_string_chararray,
  1005. second_array_to_pointer,second_pointer_to_array,
  1006. second_char_to_string,second_bigger,
  1007. second_bigger,second_bigger,
  1008. second_smaller,second_smaller,
  1009. second_smaller,second_smaller,
  1010. second_bigger,second_smaller,
  1011. second_only_rangecheck,second_bigger,
  1012. second_bigger,second_bigger,
  1013. second_bigger,second_only_rangecheck,
  1014. second_smaller,second_smaller,
  1015. second_smaller,second_smaller,
  1016. second_bool_to_int,second_int_to_bool,
  1017. second_int_real,second_real_fix,
  1018. second_fix_real,second_int_fix,second_float_float,
  1019. second_chararray_to_string,
  1020. second_proc_to_procvar,
  1021. { is constant char to pchar, is done by firstpass }
  1022. second_nothing,
  1023. second_load_smallset,
  1024. second_ansistring_to_pchar,
  1025. second_pchar_to_ansistring);
  1026. begin
  1027. { this isn't good coding, I think tc_bool_2_int, shouldn't be }
  1028. { type conversion (FK) }
  1029. { this is necessary, because second_bool_byte, have to change }
  1030. { true- and false label before calling secondpass }
  1031. if p^.convtyp<>tc_bool_2_int then
  1032. begin
  1033. secondpass(p^.left);
  1034. set_location(p^.location,p^.left^.location);
  1035. if codegenerror then
  1036. exit;
  1037. end;
  1038. if not(p^.convtyp in [tc_equal,tc_not_possible]) then
  1039. {the second argument only is for maybe_range_checking !}
  1040. secondconvert[p^.convtyp](p,p^.left,p^.convtyp)
  1041. end;
  1042. {*****************************************************************************
  1043. SecondIs
  1044. *****************************************************************************}
  1045. procedure secondis(var p : ptree);
  1046. var
  1047. pushed : tpushed;
  1048. begin
  1049. { save all used registers }
  1050. pushusedregisters(pushed,$ff);
  1051. secondpass(p^.left);
  1052. p^.location.loc:=LOC_FLAGS;
  1053. p^.location.resflags:=F_NE;
  1054. { push instance to check: }
  1055. case p^.left^.location.loc of
  1056. LOC_REGISTER,LOC_CREGISTER:
  1057. begin
  1058. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,
  1059. S_L,p^.left^.location.register)));
  1060. ungetregister32(p^.left^.location.register);
  1061. end;
  1062. LOC_MEM,LOC_REFERENCE:
  1063. begin
  1064. exprasmlist^.concat(new(pai386,op_ref(A_PUSH,
  1065. S_L,newreference(p^.left^.location.reference))));
  1066. del_reference(p^.left^.location.reference);
  1067. end;
  1068. else internalerror(100);
  1069. end;
  1070. { generate type checking }
  1071. secondpass(p^.right);
  1072. case p^.right^.location.loc of
  1073. LOC_REGISTER,LOC_CREGISTER:
  1074. begin
  1075. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,
  1076. S_L,p^.right^.location.register)));
  1077. ungetregister32(p^.right^.location.register);
  1078. end;
  1079. LOC_MEM,LOC_REFERENCE:
  1080. begin
  1081. exprasmlist^.concat(new(pai386,op_ref(A_PUSH,
  1082. S_L,newreference(p^.right^.location.reference))));
  1083. del_reference(p^.right^.location.reference);
  1084. end;
  1085. else internalerror(100);
  1086. end;
  1087. emitcall('FPC_DO_IS',true);
  1088. exprasmlist^.concat(new(pai386,op_reg_reg(A_OR,S_B,R_AL,R_AL)));
  1089. popusedregisters(pushed);
  1090. end;
  1091. {*****************************************************************************
  1092. SecondAs
  1093. *****************************************************************************}
  1094. procedure secondas(var p : ptree);
  1095. var
  1096. pushed : tpushed;
  1097. begin
  1098. secondpass(p^.left);
  1099. { save all used registers }
  1100. pushusedregisters(pushed,$ff);
  1101. { push instance to check: }
  1102. case p^.left^.location.loc of
  1103. LOC_REGISTER,LOC_CREGISTER:
  1104. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,
  1105. S_L,p^.left^.location.register)));
  1106. LOC_MEM,LOC_REFERENCE:
  1107. exprasmlist^.concat(new(pai386,op_ref(A_PUSH,
  1108. S_L,newreference(p^.left^.location.reference))));
  1109. else internalerror(100);
  1110. end;
  1111. { we doesn't modifiy the left side, we check only the type }
  1112. set_location(p^.location,p^.left^.location);
  1113. { generate type checking }
  1114. secondpass(p^.right);
  1115. case p^.right^.location.loc of
  1116. LOC_REGISTER,LOC_CREGISTER:
  1117. begin
  1118. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,
  1119. S_L,p^.right^.location.register)));
  1120. ungetregister32(p^.right^.location.register);
  1121. end;
  1122. LOC_MEM,LOC_REFERENCE:
  1123. begin
  1124. exprasmlist^.concat(new(pai386,op_ref(A_PUSH,
  1125. S_L,newreference(p^.right^.location.reference))));
  1126. del_reference(p^.right^.location.reference);
  1127. end;
  1128. else internalerror(100);
  1129. end;
  1130. emitcall('FPC_DO_AS',true);
  1131. { restore register, this restores automatically the }
  1132. { result }
  1133. popusedregisters(pushed);
  1134. end;
  1135. end.
  1136. {
  1137. $Log$
  1138. Revision 1.21 1998-09-20 17:46:47 florian
  1139. * some things regarding ansistrings fixed
  1140. Revision 1.20 1998/09/17 09:42:12 peter
  1141. + pass_2 for cg386
  1142. * Message() -> CGMessage() for pass_1/pass_2
  1143. Revision 1.19 1998/09/14 10:43:46 peter
  1144. * all internal RTL functions start with FPC_
  1145. Revision 1.18 1998/09/11 12:29:40 pierre
  1146. * removed explicit range_checking as it is buggy
  1147. Revision 1.17.2.1 1998/09/11 12:08:54 pierre
  1148. * removed explicit range_check was buggy
  1149. Revision 1.17 1998/09/04 08:41:38 peter
  1150. * updated some error CGMessages
  1151. Revision 1.16 1998/09/03 17:39:03 florian
  1152. + better code for type conversation longint/dword to real type
  1153. Revision 1.15 1998/09/03 16:24:50 florian
  1154. * bug of type conversation from dword to real fixed
  1155. * bug fix of Jonas applied
  1156. Revision 1.14 1998/08/28 12:51:39 florian
  1157. + ansistring to pchar type cast fixed
  1158. Revision 1.13 1998/08/28 10:56:56 peter
  1159. * removed warnings
  1160. Revision 1.12 1998/08/14 18:18:38 peter
  1161. + dynamic set contruction
  1162. * smallsets are now working (always longint size)
  1163. Revision 1.11 1998/08/10 23:59:59 peter
  1164. * fixed dup log
  1165. Revision 1.10 1998/08/10 14:49:47 peter
  1166. + localswitches, moduleswitches, globalswitches splitting
  1167. Revision 1.9 1998/08/05 16:00:09 florian
  1168. * some fixes for ansi strings
  1169. Revision 1.8 1998/07/18 22:54:24 florian
  1170. * some ansi/wide/longstring support fixed:
  1171. o parameter passing
  1172. o returning as result from functions
  1173. Revision 1.7 1998/06/12 13:10:34 peter
  1174. * small internalerror nr change
  1175. Revision 1.6 1998/06/12 10:43:12 michael
  1176. Fixed ansistrings : is_ansistring not found
  1177. Revision 1.5 1998/06/08 13:13:30 pierre
  1178. + temporary variables now in temp_gen.pas unit
  1179. because it is processor independent
  1180. * mppc68k.bat modified to undefine i386 and support_mmx
  1181. (which are defaults for i386)
  1182. Revision 1.4 1998/06/05 17:44:10 peter
  1183. * splitted cgi386
  1184. Revision 1.3 1998/06/03 22:48:50 peter
  1185. + wordbool,longbool
  1186. * rename bis,von -> high,low
  1187. * moved some systemunit loading/creating to psystem.pas
  1188. Revision 1.2 1998/06/02 10:52:10 peter
  1189. * fixed second_bool_to_int with bool8bit return
  1190. Revision 1.1 1998/06/01 16:50:18 peter
  1191. + boolean -> ord conversion
  1192. * fixed ord -> boolean conversion
  1193. }