cg386cnv.pas 54 KB

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