cg386set.pas 35 KB

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