cg386set.pas 37 KB

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