cg386set.pas 33 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864
  1. {
  2. $Id$
  3. Copyright (c) 1993-98 by Florian Klaempfl
  4. Generate i386 assembler for in set/case nodes
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. unit cg386set;
  19. interface
  20. uses
  21. tree;
  22. procedure secondsetelement(var p : ptree);
  23. procedure secondin(var p : ptree);
  24. procedure secondcase(var p : ptree);
  25. implementation
  26. uses
  27. globtype,systems,
  28. cobjects,verbose,globals,
  29. symtable,aasm,types,
  30. hcodegen,temp_gen,pass_2,
  31. i386,cgai386,tgeni386;
  32. const
  33. bytes2Sxx:array[1..4] of Topsize=(S_B,S_W,S_NO,S_L);
  34. {*****************************************************************************
  35. SecondSetElement
  36. *****************************************************************************}
  37. procedure secondsetelement(var p : ptree);
  38. begin
  39. { load first value in 32bit register }
  40. secondpass(p^.left);
  41. if p^.left^.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
  42. emit_to_reg32(p^.left^.location.register);
  43. { also a second value ? }
  44. if assigned(p^.right) then
  45. begin
  46. secondpass(p^.right);
  47. if p^.right^.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
  48. emit_to_reg32(p^.right^.location.register);
  49. end;
  50. { we doesn't modify the left side, we check only the type }
  51. set_location(p^.location,p^.left^.location);
  52. end;
  53. {*****************************************************************************
  54. SecondIn
  55. *****************************************************************************}
  56. procedure secondin(var p : ptree);
  57. type
  58. Tsetpart=record
  59. range : boolean; {Part is a range.}
  60. start,stop : byte; {Start/stop when range; Stop=element when an element.}
  61. end;
  62. var
  63. use_small,
  64. pushed,
  65. ranges : boolean;
  66. hr,hr2,
  67. pleftreg : tregister;
  68. opsize : topsize;
  69. setparts : array[1..8] of Tsetpart;
  70. i,numparts : byte;
  71. {href,href2 : Treference;}
  72. l,l2 : plabel;
  73. function analizeset(Aset:pconstset;is_small:boolean):boolean;
  74. type
  75. byteset=set of byte;
  76. var
  77. compares,maxcompares:word;
  78. i:byte;
  79. begin
  80. analizeset:=false;
  81. ranges:=false;
  82. numparts:=0;
  83. compares:=0;
  84. { Lots of comparisions take a lot of time, so do not allow
  85. too much comparisions. 8 comparisions are, however, still
  86. smalller than emitting the set }
  87. if cs_littlesize in aktglobalswitches then
  88. maxcompares:=8
  89. else
  90. maxcompares:=5;
  91. { when smallset is possible allow only 3 compares the smallset
  92. code is for littlesize also smaller when more compares are used }
  93. if is_small then
  94. maxcompares:=3;
  95. for i:=0 to 255 do
  96. if i in byteset(Aset^) then
  97. begin
  98. if (numparts=0) or (i<>setparts[numparts].stop+1) then
  99. begin
  100. {Set element is a separate element.}
  101. inc(compares);
  102. if compares>maxcompares then
  103. exit;
  104. inc(numparts);
  105. setparts[numparts].range:=false;
  106. setparts[numparts].stop:=i;
  107. end
  108. else
  109. {Set element is part of a range.}
  110. if not setparts[numparts].range then
  111. begin
  112. {Transform an element into a range.}
  113. setparts[numparts].range:=true;
  114. setparts[numparts].start:=setparts[numparts].stop;
  115. setparts[numparts].stop:=i;
  116. inc(compares);
  117. if compares>maxcompares then
  118. exit;
  119. end
  120. else
  121. begin
  122. {Extend a range.}
  123. setparts[numparts].stop:=i;
  124. {A range of two elements can better
  125. be checked as two separate ones.
  126. When extending a range, our range
  127. becomes larger than two elements.}
  128. ranges:=true;
  129. end;
  130. end;
  131. analizeset:=true;
  132. end;
  133. begin
  134. { calculate both operators }
  135. { the complex one first }
  136. firstcomplex(p);
  137. secondpass(p^.left);
  138. { are too few registers free? }
  139. pushed:=maybe_push(p^.right^.registers32,p^.left);
  140. secondpass(p^.right);
  141. if pushed then
  142. restore(p^.left);
  143. if codegenerror then
  144. exit;
  145. { ofcourse not commutative }
  146. if p^.swaped then
  147. swaptree(p);
  148. { check if we can use smallset operation using btl which is limited
  149. to 32 bits, the left side may also not contain higher values !! }
  150. use_small:=(psetdef(p^.right^.resulttype)^.settype=smallset) and
  151. ((p^.left^.resulttype^.deftype=orddef) and (porddef(p^.left^.resulttype)^.high<=32) or
  152. (p^.left^.resulttype^.deftype=enumdef) and (penumdef(p^.left^.resulttype)^.max<=32));
  153. { Can we generate jumps? Possible for all types of sets }
  154. if (p^.right^.treetype=setconstn) and
  155. analizeset(p^.right^.value_set,use_small) then
  156. begin
  157. { It gives us advantage to check for the set elements
  158. separately instead of using the SET_IN_BYTE procedure.
  159. To do: Build in support for LOC_JUMP }
  160. { If register is used, use only lower 8 bits }
  161. if p^.left^.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
  162. begin
  163. pleftreg:=p^.left^.location.register;
  164. if pleftreg in [R_AX..R_DX] then
  165. begin
  166. exprasmlist^.concat(new(pai386,op_const_reg(A_AND,S_W,255,pleftreg)));
  167. opsize:=S_W;
  168. end
  169. else
  170. if pleftreg in [R_EAX..R_EDI] then
  171. begin
  172. exprasmlist^.concat(new(pai386,op_const_reg(A_AND,S_L,255,pleftreg)));
  173. opsize:=S_L;
  174. end
  175. else
  176. opsize:=S_B;
  177. end;
  178. { Get a label to jump to the end }
  179. p^.location.loc:=LOC_FLAGS;
  180. { It's better to use the zero flag when there are
  181. no ranges }
  182. if ranges then
  183. p^.location.resflags:=F_C
  184. else
  185. p^.location.resflags:=F_E;
  186. {reset_reference(href);}
  187. getlabel(l);
  188. {href.symbol:=stringdup(lab2str(l));}
  189. for i:=1 to numparts do
  190. if setparts[i].range then
  191. begin
  192. { Check if left is in a range }
  193. { Get a label to jump over the check }
  194. {reset_reference(href2);}
  195. getlabel(l2);
  196. {shouldn't it be href2 here ??
  197. href.symbol:=stringdup(lab2str(l2));}
  198. if setparts[i].start=setparts[i].stop-1 then
  199. begin
  200. case p^.left^.location.loc of
  201. LOC_REGISTER,
  202. LOC_CREGISTER : exprasmlist^.concat(new(pai386,op_const_reg(A_CMP,opsize,
  203. setparts[i].start,pleftreg)));
  204. else
  205. exprasmlist^.concat(new(pai386,op_const_ref(A_CMP,S_B,
  206. setparts[i].start,newreference(p^.left^.location.reference))));
  207. end;
  208. { Result should be in carry flag when ranges are used }
  209. if ranges then
  210. exprasmlist^.concat(new(pai386,op_none(A_STC,S_NO)));
  211. { If found, jump to end }
  212. emitl(A_JE,l);
  213. case p^.left^.location.loc of
  214. LOC_REGISTER,
  215. LOC_CREGISTER : exprasmlist^.concat(new(pai386,op_const_reg(A_CMP,opsize,
  216. setparts[i].stop,pleftreg)));
  217. else
  218. exprasmlist^.concat(new(pai386,op_const_ref(A_CMP,S_B,
  219. setparts[i].stop,newreference(p^.left^.location.reference))));
  220. end;
  221. { Result should be in carry flag when ranges are used }
  222. if ranges then
  223. exprasmlist^.concat(new(pai386,op_none(A_STC,S_NO)));
  224. { If found, jump to end }
  225. emitl(A_JE,l);
  226. end
  227. else
  228. begin
  229. if setparts[i].start<>0 then
  230. begin
  231. { We only check for the lower bound if it is > 0, because
  232. set elements lower than 0 dont exist }
  233. case p^.left^.location.loc of
  234. LOC_REGISTER,
  235. LOC_CREGISTER : exprasmlist^.concat(new(pai386,op_const_reg(A_CMP,opsize,
  236. setparts[i].start,pleftreg)));
  237. else
  238. exprasmlist^.concat(new(pai386,op_const_ref(A_CMP,S_B,
  239. setparts[i].start,newreference(p^.left^.location.reference))));
  240. end;
  241. { If lower, jump to next check }
  242. emitl(A_JB,l2);
  243. end;
  244. { We only check for the high bound if it is < 255, because
  245. set elements higher than 255 do nt exist, the its always true,
  246. so only a JMP is generated }
  247. if setparts[i].stop<>255 then
  248. begin
  249. case p^.left^.location.loc of
  250. LOC_REGISTER,
  251. LOC_CREGISTER : exprasmlist^.concat(new(pai386,op_const_reg(A_CMP,opsize,
  252. setparts[i].stop+1,pleftreg)));
  253. else
  254. exprasmlist^.concat(new(pai386,op_const_ref(A_CMP,S_B,
  255. setparts[i].stop+1,newreference(p^.left^.location.reference))));
  256. end;
  257. { If higher, element is in set }
  258. emitl(A_JB,l);
  259. end
  260. else
  261. begin
  262. exprasmlist^.concat(new(pai386,op_none(A_STC,S_NO)));
  263. emitl(A_JMP,l);
  264. end;
  265. end;
  266. { Emit the jump over label }
  267. exprasmlist^.concat(new(pai_label,init(l2)));
  268. end
  269. else
  270. begin
  271. { Emit code to check if left is an element }
  272. case p^.left^.location.loc of
  273. LOC_REGISTER,
  274. LOC_CREGISTER : exprasmlist^.concat(new(pai386,op_const_reg(A_CMP,opsize,
  275. setparts[i].stop,pleftreg)));
  276. else
  277. exprasmlist^.concat(new(pai386,op_const_ref(A_CMP,S_B,
  278. setparts[i].stop,newreference(p^.left^.location.reference))));
  279. end;
  280. { Result should be in carry flag when ranges are used }
  281. if ranges then
  282. exprasmlist^.concat(new(pai386,op_none(A_STC,S_NO)));
  283. { If found, jump to end }
  284. emitl(A_JE,l);
  285. end;
  286. if ranges then
  287. exprasmlist^.concat(new(pai386,op_none(A_CLC,S_NO)));
  288. { To compensate for not doing a second pass }
  289. stringdispose(p^.right^.location.reference.symbol);
  290. { Now place the end label }
  291. exprasmlist^.concat(new(pai_label,init(l)));
  292. case p^.left^.location.loc of
  293. LOC_REGISTER,
  294. LOC_CREGISTER : ungetregister32(pleftreg);
  295. else
  296. del_reference(p^.left^.location.reference);
  297. end;
  298. end
  299. else
  300. begin
  301. { We will now generated code to check the set itself, no jmps,
  302. handle smallsets separate, because it allows faster checks }
  303. if use_small then
  304. begin
  305. if p^.left^.treetype=ordconstn then
  306. begin
  307. p^.location.resflags:=F_NE;
  308. case p^.right^.location.loc of
  309. LOC_REGISTER,
  310. LOC_CREGISTER:
  311. begin
  312. exprasmlist^.concat(new(pai386,op_const_reg(A_TEST,S_L,
  313. 1 shl (p^.left^.value and 31),p^.right^.location.register)));
  314. ungetregister32(p^.right^.location.register);
  315. end
  316. else
  317. begin
  318. exprasmlist^.concat(new(pai386,op_const_ref(A_TEST,S_L,1 shl (p^.left^.value and 31),
  319. newreference(p^.right^.location.reference))));
  320. del_reference(p^.right^.location.reference);
  321. end;
  322. end;
  323. end
  324. else
  325. begin
  326. case p^.left^.location.loc of
  327. LOC_REGISTER,
  328. LOC_CREGISTER:
  329. begin
  330. hr:=p^.left^.location.register;
  331. emit_to_reg32(hr);
  332. end;
  333. else
  334. begin
  335. { the set element isn't never samller than a byte }
  336. { and because it's a small set we need only 5 bits }
  337. { but 8 bits are easier to load }
  338. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVZX,S_BL,
  339. newreference(p^.left^.location.reference),R_EDI)));
  340. hr:=R_EDI;
  341. del_reference(p^.left^.location.reference);
  342. end;
  343. end;
  344. case p^.right^.location.loc of
  345. LOC_REGISTER,
  346. LOC_CREGISTER : exprasmlist^.concat(new(pai386,op_reg_reg(A_BT,S_L,hr,
  347. p^.right^.location.register)));
  348. else
  349. begin
  350. del_reference(p^.right^.location.reference);
  351. if p^.right^.location.reference.isintvalue then
  352. begin
  353. { We have to load the value into a register because
  354. btl does not accept values only refs or regs (PFV) }
  355. hr2:=getregister32;
  356. exprasmlist^.concat(new(pai386,op_const_reg(A_MOV,S_L,
  357. p^.right^.location.reference.offset,hr2)));
  358. exprasmlist^.concat(new(pai386,op_reg_reg(A_BT,S_L,hr,hr2)));
  359. ungetregister32(hr2);
  360. end
  361. else
  362. exprasmlist^.concat(new(pai386,op_reg_ref(A_BT,S_L,hr,
  363. newreference(p^.right^.location.reference))));
  364. end;
  365. end;
  366. ungetregister32(hr);
  367. p^.location.loc:=LOC_FLAGS;
  368. p^.location.resflags:=F_C;
  369. end;
  370. end
  371. else
  372. begin
  373. { do search in a normal set which could have >32 elementsm
  374. but also used if the left side contains higher values > 32 }
  375. if p^.left^.treetype=ordconstn then
  376. begin
  377. p^.location.resflags:=F_NE;
  378. inc(p^.right^.location.reference.offset,p^.left^.value shr 3);
  379. exprasmlist^.concat(new(pai386,op_const_ref(A_TEST,S_B,1 shl (p^.left^.value and 7),
  380. newreference(p^.right^.location.reference))));
  381. del_reference(p^.right^.location.reference);
  382. end
  383. else
  384. begin
  385. pushsetelement(p^.left);
  386. emitpushreferenceaddr(exprasmlist,p^.right^.location.reference);
  387. del_reference(p^.right^.location.reference);
  388. { registers need not be save. that happens in SET_IN_BYTE }
  389. { (EDI is changed) }
  390. emitcall('FPC_SET_IN_BYTE',true);
  391. { ungetiftemp(p^.right^.location.reference); }
  392. p^.location.loc:=LOC_FLAGS;
  393. p^.location.resflags:=F_C;
  394. end;
  395. end;
  396. end;
  397. if (p^.right^.location.loc in [LOC_MEM,LOC_REFERENCE]) then
  398. ungetiftemp(p^.right^.location.reference);
  399. end;
  400. {*****************************************************************************
  401. SecondCase
  402. *****************************************************************************}
  403. procedure secondcase(var p : ptree);
  404. var
  405. with_sign : boolean;
  406. opsize : topsize;
  407. jmp_gt,jmp_le,jmp_lee : tasmop;
  408. hp : ptree;
  409. { register with case expression }
  410. hregister : tregister;
  411. endlabel,elselabel : plabel;
  412. { true, if we can omit the range check of the jump table }
  413. jumptable_no_range : boolean;
  414. { where to put the jump table }
  415. jumpsegment : paasmoutput;
  416. procedure gentreejmp(p : pcaserecord);
  417. var
  418. lesslabel,greaterlabel : plabel;
  419. begin
  420. emitl(A_LABEL,p^._at);
  421. { calculate labels for left and right }
  422. if (p^.less=nil) then
  423. lesslabel:=elselabel
  424. else
  425. lesslabel:=p^.less^._at;
  426. if (p^.greater=nil) then
  427. greaterlabel:=elselabel
  428. else
  429. greaterlabel:=p^.greater^._at;
  430. { calculate labels for left and right }
  431. { no range label: }
  432. if p^._low=p^._high then
  433. begin
  434. exprasmlist^.concat(new(pai386,op_const_reg(A_CMP,opsize,p^._low,hregister)));
  435. if greaterlabel=lesslabel then
  436. begin
  437. emitl(A_JNE,lesslabel);
  438. end
  439. else
  440. begin
  441. emitl(jmp_le,lesslabel);
  442. emitl(jmp_gt,greaterlabel);
  443. end;
  444. emitl(A_JMP,p^.statement);
  445. end
  446. else
  447. begin
  448. exprasmlist^.concat(new(pai386,op_const_reg(A_CMP,opsize,p^._low,hregister)));
  449. emitl(jmp_le,lesslabel);
  450. exprasmlist^.concat(new(pai386,op_const_reg(A_CMP,opsize,p^._high,hregister)));
  451. emitl(jmp_gt,greaterlabel);
  452. emitl(A_JMP,p^.statement);
  453. end;
  454. if assigned(p^.less) then
  455. gentreejmp(p^.less);
  456. if assigned(p^.greater) then
  457. gentreejmp(p^.greater);
  458. end;
  459. procedure genlinearlist(hp : pcaserecord);
  460. var
  461. first : boolean;
  462. last : longint;
  463. {helplabel : longint;}
  464. procedure genitem(t : pcaserecord);
  465. begin
  466. if assigned(t^.less) then
  467. genitem(t^.less);
  468. { need we to test the first value }
  469. if first and (t^._low>get_min_value(p^.left^.resulttype)) then
  470. begin
  471. exprasmlist^.concat(new(pai386,op_const_reg(A_CMP,opsize,t^._low,hregister)));
  472. emitl(jmp_le,elselabel);
  473. end;
  474. if t^._low=t^._high then
  475. begin
  476. if t^._low-last=1 then
  477. exprasmlist^.concat(new(pai386,op_reg(A_DEC,opsize,hregister)))
  478. else if t^._low-last=0 then
  479. exprasmlist^.concat(new(pai386,op_reg_reg(A_OR,opsize,hregister,hregister)))
  480. else
  481. exprasmlist^.concat(new(pai386,op_const_reg(A_SUB,opsize,t^._low-last,hregister)));
  482. last:=t^._low;
  483. emitl(A_JZ,t^.statement);
  484. end
  485. else
  486. begin
  487. { it begins with the smallest label, if the value }
  488. { is even smaller then jump immediately to the }
  489. { ELSE-label }
  490. if first then
  491. begin
  492. { have we to ajust the first value ? }
  493. if t^._low>get_min_value(p^.left^.resulttype) then
  494. begin
  495. if t^._low=1 then
  496. exprasmlist^.concat(new(pai386,op_reg(A_DEC,opsize,
  497. hregister)))
  498. else
  499. exprasmlist^.concat(new(pai386,op_const_reg(A_SUB,opsize,
  500. t^._low,hregister)));
  501. end;
  502. { work around: if the lower range=0 and we
  503. do the subtraction we have to take care
  504. of the sign!
  505. this isn't necessary, this is tested before now (FK)
  506. if t^._low=0 then
  507. emitl(A_JBE,elselabel)
  508. else
  509. emitl(jmp_lee,elselabel);
  510. }
  511. end
  512. else
  513. { if there is no unused label between the last and the }
  514. { present label then the lower limit can be checked }
  515. { immediately. else check the range in between: }
  516. if (t^._low-last>1) then
  517. begin
  518. exprasmlist^.concat(new(pai386,op_const_reg(A_SUB,opsize,t^._low-last,hregister)));
  519. emitl(jmp_le,elselabel);
  520. end
  521. else
  522. exprasmlist^.concat(new(pai386,op_reg(A_DEC,opsize,hregister)));
  523. exprasmlist^.concat(new(pai386,op_const_reg(A_SUB,opsize,t^._high-t^._low,hregister)));
  524. emitl(jmp_lee,t^.statement);
  525. last:=t^._high;
  526. end;
  527. first:=false;
  528. if assigned(t^.greater) then
  529. genitem(t^.greater);
  530. end;
  531. begin
  532. last:=0;
  533. first:=true;
  534. genitem(hp);
  535. emitl(A_JMP,elselabel);
  536. end;
  537. procedure genjumptable(hp : pcaserecord;min_,max_ : longint);
  538. var
  539. table : plabel;
  540. last : longint;
  541. hr : preference;
  542. procedure genitem(t : pcaserecord);
  543. var
  544. i : longint;
  545. begin
  546. if assigned(t^.less) then
  547. genitem(t^.less);
  548. { fill possible hole }
  549. for i:=last+1 to t^._low-1 do
  550. jumpsegment^.concat(new(pai_const,init_symbol(strpnew(lab2str
  551. (elselabel)))));
  552. for i:=t^._low to t^._high do
  553. jumpsegment^.concat(new(pai_const,init_symbol(strpnew(lab2str
  554. (t^.statement)))));
  555. last:=t^._high;
  556. if assigned(t^.greater) then
  557. genitem(t^.greater);
  558. end;
  559. begin
  560. if not(jumptable_no_range) then
  561. begin
  562. exprasmlist^.concat(new(pai386,op_const_reg(A_CMP,opsize,min_,hregister)));
  563. { case expr less than min_ => goto elselabel }
  564. emitl(jmp_le,elselabel);
  565. exprasmlist^.concat(new(pai386,op_const_reg(A_CMP,opsize,max_,hregister)));
  566. emitl(jmp_gt,elselabel);
  567. end;
  568. getlabel(table);
  569. { extend with sign }
  570. if opsize=S_W then
  571. begin
  572. exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_WL,hregister,
  573. reg16toreg32(hregister))));
  574. hregister:=reg16toreg32(hregister);
  575. end
  576. else if opsize=S_B then
  577. begin
  578. exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_BL,hregister,
  579. reg8toreg32(hregister))));
  580. hregister:=reg8toreg32(hregister);
  581. end;
  582. new(hr);
  583. reset_reference(hr^);
  584. hr^.symbol:=stringdup(lab2str(table));
  585. hr^.offset:=(-min_)*4;
  586. hr^.index:=hregister;
  587. hr^.scalefactor:=4;
  588. exprasmlist^.concat(new(pai386,op_ref(A_JMP,S_NO,hr)));
  589. { !!!!! generate tables
  590. if not(cs_littlesize in aktlocalswitches) then
  591. jumpsegment^.concat(new(pai386,op_const(A_ALIGN,S_NO,4)));
  592. }
  593. jumpsegment^.concat(new(pai_label,init(table)));
  594. last:=min_;
  595. genitem(hp);
  596. { !!!!!!!
  597. if not(cs_littlesize in aktlocalswitches) then
  598. exprasmlist^.concat(new(pai386,op_const(A_ALIGN,S_NO,4)));
  599. }
  600. end;
  601. var
  602. lv,hv,min_label,max_label,labels : longint;
  603. max_linear_list : longint;
  604. begin
  605. getlabel(endlabel);
  606. getlabel(elselabel);
  607. if (cs_smartlink in aktmoduleswitches) then
  608. jumpsegment:=procinfo.aktlocaldata
  609. else
  610. jumpsegment:=datasegment;
  611. with_sign:=is_signed(p^.left^.resulttype);
  612. if with_sign then
  613. begin
  614. jmp_gt:=A_JG;
  615. jmp_le:=A_JL;
  616. jmp_lee:=A_JLE;
  617. end
  618. else
  619. begin
  620. jmp_gt:=A_JA;
  621. jmp_le:=A_JB;
  622. jmp_lee:=A_JBE;
  623. end;
  624. cleartempgen;
  625. secondpass(p^.left);
  626. { determines the size of the operand }
  627. opsize:=bytes2Sxx[p^.left^.resulttype^.size];
  628. { copy the case expression to a register }
  629. case p^.left^.location.loc of
  630. LOC_REGISTER:
  631. hregister:=p^.left^.location.register;
  632. LOC_CREGISTER:
  633. begin
  634. hregister:=getregister32;
  635. case opsize of
  636. S_B : hregister:=reg32toreg8(hregister);
  637. S_W : hregister:=reg32toreg16(hregister);
  638. end;
  639. exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,opsize,
  640. p^.left^.location.register,hregister)));
  641. end;
  642. LOC_MEM,LOC_REFERENCE : begin
  643. del_reference(p^.left^.location.reference);
  644. hregister:=getregister32;
  645. case opsize of
  646. S_B : hregister:=reg32toreg8(hregister);
  647. S_W : hregister:=reg32toreg16(hregister);
  648. end;
  649. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,opsize,newreference(
  650. p^.left^.location.reference),hregister)));
  651. end;
  652. else internalerror(2002);
  653. end;
  654. { now generate the jumps }
  655. if cs_optimize in aktglobalswitches then
  656. begin
  657. { procedures are empirically passed on }
  658. { consumption can also be calculated }
  659. { but does it pay on the different }
  660. { processors? }
  661. { moreover can the size only be appro- }
  662. { ximated as it is not known if rel8, }
  663. { rel16 or rel32 jumps are used }
  664. min_label:=case_get_min(p^.nodes);
  665. max_label:=case_get_max(p^.nodes);
  666. labels:=case_count_labels(p^.nodes);
  667. { can we omit the range check of the jump table }
  668. getrange(p^.left^.resulttype,lv,hv);
  669. jumptable_no_range:=(lv=min_label) and (hv=max_label);
  670. { optimize for size ? }
  671. if cs_littlesize in aktglobalswitches then
  672. begin
  673. if (labels<=2) or ((max_label-min_label)>3*labels) then
  674. { a linear list is always smaller than a jump tree }
  675. genlinearlist(p^.nodes)
  676. else
  677. { if the labels less or more a continuum then }
  678. genjumptable(p^.nodes,min_label,max_label);
  679. end
  680. else
  681. begin
  682. if jumptable_no_range then
  683. max_linear_list:=4
  684. else
  685. max_linear_list:=2;
  686. { a jump table crashes the pipeline! }
  687. if aktoptprocessor=Class386 then
  688. inc(max_linear_list,3);
  689. if aktoptprocessor=ClassP5 then
  690. inc(max_linear_list,6);
  691. if aktoptprocessor>=ClassP6 then
  692. inc(max_linear_list,9);
  693. if (labels<=max_linear_list) then
  694. genlinearlist(p^.nodes)
  695. else
  696. begin
  697. if ((max_label-min_label)>4*labels) then
  698. begin
  699. if labels>16 then
  700. gentreejmp(p^.nodes)
  701. else
  702. genlinearlist(p^.nodes);
  703. end
  704. else
  705. genjumptable(p^.nodes,min_label,max_label);
  706. end;
  707. end;
  708. end
  709. else
  710. { it's always not bad }
  711. genlinearlist(p^.nodes);
  712. { now generate the instructions }
  713. hp:=p^.right;
  714. while assigned(hp) do
  715. begin
  716. cleartempgen;
  717. secondpass(hp^.right);
  718. { don't come back to case line }
  719. aktfilepos:=exprasmlist^.getlasttaifilepos^;
  720. emitl(A_JMP,endlabel);
  721. hp:=hp^.left;
  722. end;
  723. emitl(A_LABEL,elselabel);
  724. { ...and the else block }
  725. if assigned(p^.elseblock) then
  726. begin
  727. cleartempgen;
  728. secondpass(p^.elseblock);
  729. end;
  730. emitl(A_LABEL,endlabel);
  731. end;
  732. end.
  733. {
  734. $Log$
  735. Revision 1.20 1998-12-11 00:02:56 peter
  736. + globtype,tokens,version unit splitted from globals
  737. Revision 1.19 1998/10/09 08:56:25 pierre
  738. * several memory leaks fixed
  739. Revision 1.18 1998/10/08 17:17:14 pierre
  740. * current_module old scanner tagged as invalid if unit is recompiled
  741. + added ppheap for better info on tracegetmem of heaptrc
  742. (adds line column and file index)
  743. * several memory leaks removed ith help of heaptrc !!
  744. Revision 1.17 1998/09/17 09:42:20 peter
  745. + pass_2 for cg386
  746. * Message() -> CGMessage() for pass_1/pass_2
  747. Revision 1.16 1998/09/14 10:43:53 peter
  748. * all internal RTL functions start with FPC_
  749. Revision 1.15 1998/09/09 17:51:59 florian
  750. * the next try to fix the case problem ...
  751. Revision 1.14 1998/09/09 16:44:21 florian
  752. * I hope, the case bug is fixed now
  753. Revision 1.13 1998/09/07 18:45:54 peter
  754. * update smartlinking, uses getdatalabel
  755. * renamed ptree.value vars to value_str,value_real,value_set
  756. Revision 1.12 1998/09/05 23:51:05 florian
  757. * possible bug with too few registers in first/secondin fixed
  758. Revision 1.11 1998/09/04 08:41:41 peter
  759. * updated some error messages
  760. Revision 1.10 1998/09/03 17:08:40 pierre
  761. * better lines for stabs
  762. (no scroll back to if before else part
  763. no return to case line at jump outside case)
  764. + source lines also if not in order
  765. Revision 1.9 1998/08/28 10:54:19 peter
  766. * fixed smallset generation from elements, it has never worked before!
  767. Revision 1.8 1998/08/25 11:51:46 peter
  768. * fixed -15 seen as byte in case
  769. Revision 1.7 1998/08/19 16:07:38 jonas
  770. * changed optimizer switches + cleanup of DestroyRefs in daopt386.pas
  771. Revision 1.6 1998/08/18 09:24:39 pierre
  772. * small warning position bug fixed
  773. * support_mmx switches splitting was missing
  774. * rhide error and warning output corrected
  775. Revision 1.5 1998/08/14 18:18:40 peter
  776. + dynamic set contruction
  777. * smallsets are now working (always longint size)
  778. Revision 1.4 1998/08/10 14:49:51 peter
  779. + localswitches, moduleswitches, globalswitches splitting
  780. Revision 1.3 1998/06/25 08:48:10 florian
  781. * first version of rtti support
  782. Revision 1.2 1998/06/16 08:56:18 peter
  783. + targetcpu
  784. * cleaner pmodules for newppu
  785. Revision 1.1 1998/06/05 17:44:13 peter
  786. * splitted cgi386
  787. }