cg386set.pas 40 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040
  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. {$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. exprasmlist^.concat(new(pai386,op_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. exprasmlist^.concat(new(pai386,op_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 : exprasmlist^.concat(new(pai386,op_const_reg(A_CMP,opsize,
  209. setparts[i].start,pleftreg)));
  210. else
  211. exprasmlist^.concat(new(pai386,op_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. exprasmlist^.concat(new(pai386,op_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 : exprasmlist^.concat(new(pai386,op_const_reg(A_CMP,opsize,
  222. setparts[i].stop,pleftreg)));
  223. else
  224. exprasmlist^.concat(new(pai386,op_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. exprasmlist^.concat(new(pai386,op_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 : exprasmlist^.concat(new(pai386,op_const_reg(A_CMP,opsize,
  242. setparts[i].start,pleftreg)));
  243. else
  244. exprasmlist^.concat(new(pai386,op_const_ref(A_CMP,S_B,
  245. setparts[i].start,newreference(p^.left^.location.reference))));
  246. end;
  247. { If lower, jump to next check }
  248. emitjmp(C_B,l2);
  249. end;
  250. { We only check for the high bound if it is < 255, because
  251. set elements higher than 255 do nt exist, the its always true,
  252. so only a JMP is generated }
  253. if setparts[i].stop<>255 then
  254. begin
  255. case p^.left^.location.loc of
  256. LOC_REGISTER,
  257. LOC_CREGISTER : exprasmlist^.concat(new(pai386,op_const_reg(A_CMP,opsize,
  258. setparts[i].stop+1,pleftreg)));
  259. else
  260. exprasmlist^.concat(new(pai386,op_const_ref(A_CMP,S_B,
  261. setparts[i].stop+1,newreference(p^.left^.location.reference))));
  262. end;
  263. { If higher, element is in set }
  264. emitjmp(C_B,l);
  265. end
  266. else
  267. begin
  268. exprasmlist^.concat(new(pai386,op_none(A_STC,S_NO)));
  269. emitjmp(C_None,l);
  270. end;
  271. end;
  272. { Emit the jump over label }
  273. emitlab(l2);
  274. end
  275. else
  276. begin
  277. { Emit code to check if left is an element }
  278. case p^.left^.location.loc of
  279. LOC_REGISTER,
  280. LOC_CREGISTER : exprasmlist^.concat(new(pai386,op_const_reg(A_CMP,opsize,
  281. setparts[i].stop,pleftreg)));
  282. else
  283. exprasmlist^.concat(new(pai386,op_const_ref(A_CMP,S_B,
  284. setparts[i].stop,newreference(p^.left^.location.reference))));
  285. end;
  286. { Result should be in carry flag when ranges are used }
  287. if ranges then
  288. exprasmlist^.concat(new(pai386,op_none(A_STC,S_NO)));
  289. { If found, jump to end }
  290. emitjmp(C_E,l);
  291. end;
  292. if ranges then
  293. exprasmlist^.concat(new(pai386,op_none(A_CLC,S_NO)));
  294. { To compensate for not doing a second pass }
  295. p^.right^.location.reference.symbol:=nil;
  296. { Now place the end label }
  297. emitlab(l);
  298. case p^.left^.location.loc of
  299. LOC_REGISTER,
  300. LOC_CREGISTER : ungetregister32(pleftreg);
  301. else
  302. del_reference(p^.left^.location.reference);
  303. end;
  304. end
  305. else
  306. begin
  307. { We will now generated code to check the set itself, no jmps,
  308. handle smallsets separate, because it allows faster checks }
  309. if use_small then
  310. begin
  311. if p^.left^.treetype=ordconstn then
  312. begin
  313. p^.location.resflags:=F_NE;
  314. case p^.right^.location.loc of
  315. LOC_REGISTER,
  316. LOC_CREGISTER:
  317. begin
  318. exprasmlist^.concat(new(pai386,op_const_reg(A_TEST,S_L,
  319. 1 shl (p^.left^.value and 31),p^.right^.location.register)));
  320. ungetregister32(p^.right^.location.register);
  321. end
  322. else
  323. begin
  324. exprasmlist^.concat(new(pai386,op_const_ref(A_TEST,S_L,1 shl (p^.left^.value and 31),
  325. newreference(p^.right^.location.reference))));
  326. del_reference(p^.right^.location.reference);
  327. end;
  328. end;
  329. end
  330. else
  331. begin
  332. case p^.left^.location.loc of
  333. LOC_REGISTER,
  334. LOC_CREGISTER:
  335. begin
  336. hr:=p^.left^.location.register;
  337. emit_to_reg32(hr);
  338. end;
  339. else
  340. begin
  341. { the set element isn't never samller than a byte }
  342. { and because it's a small set we need only 5 bits }
  343. { but 8 bits are easier to load }
  344. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVZX,S_BL,
  345. newreference(p^.left^.location.reference),R_EDI)));
  346. hr:=R_EDI;
  347. del_reference(p^.left^.location.reference);
  348. end;
  349. end;
  350. case p^.right^.location.loc of
  351. LOC_REGISTER,
  352. LOC_CREGISTER : exprasmlist^.concat(new(pai386,op_reg_reg(A_BT,S_L,hr,
  353. p^.right^.location.register)));
  354. else
  355. begin
  356. del_reference(p^.right^.location.reference);
  357. if p^.right^.location.reference.is_immediate then
  358. begin
  359. { We have to load the value into a register because
  360. btl does not accept values only refs or regs (PFV) }
  361. hr2:=getregister32;
  362. exprasmlist^.concat(new(pai386,op_const_reg(A_MOV,S_L,
  363. p^.right^.location.reference.offset,hr2)));
  364. exprasmlist^.concat(new(pai386,op_reg_reg(A_BT,S_L,hr,hr2)));
  365. ungetregister32(hr2);
  366. end
  367. else
  368. exprasmlist^.concat(new(pai386,op_reg_ref(A_BT,S_L,hr,
  369. newreference(p^.right^.location.reference))));
  370. end;
  371. end;
  372. ungetregister32(hr);
  373. p^.location.loc:=LOC_FLAGS;
  374. p^.location.resflags:=F_C;
  375. end;
  376. end
  377. else
  378. begin
  379. if p^.right^.location.reference.is_immediate then
  380. begin
  381. p^.location.resflags:=F_C;
  382. getlabel(l);
  383. getlabel(l2);
  384. { Is this treated in firstpass ?? }
  385. if p^.left^.treetype=ordconstn then
  386. begin
  387. hr:=getregister32;
  388. p^.left^.location.loc:=LOC_REGISTER;
  389. p^.left^.location.register:=hr;
  390. exprasmlist^.concat(new(pai386,op_const_reg(A_MOV,S_L,
  391. p^.left^.value,hr)));
  392. end;
  393. case p^.left^.location.loc of
  394. LOC_REGISTER,
  395. LOC_CREGISTER:
  396. begin
  397. hr:=regtoreg32(p^.left^.location.register);
  398. {$ifdef CORRECT_SET_IN_FPC}
  399. if m_tp in aktmodeswitches then
  400. begin
  401. if is_signed(p^.left^.resulttype) then
  402. AM:=A_MOVSX
  403. else
  404. AM:=A_MOVZX;
  405. if p^.left^.location.register in [R_AX,R_DI] then
  406. exprasmlist^.concat(new(pai386,op_reg_reg(AM,S_WL,
  407. p^.left^.location.register,hr)))
  408. else if p^.left^.location.register in [R_AL,R_DH] then
  409. exprasmlist^.concat(new(pai386,op_reg_reg(AM,S_BL,
  410. p^.left^.location.register,hr)));
  411. end
  412. else
  413. {$endif CORRECT_SET_IN_FPC}
  414. begin
  415. exprasmlist^.concat(new(pai386,op_const_reg(A_AND,S_L,
  416. 255,hr)));
  417. end;
  418. exprasmlist^.concat(new(pai386,op_const_reg(A_CMP,S_L,
  419. 31,hr)));
  420. emitjmp(C_NA,l);
  421. { reset carry flag }
  422. exprasmlist^.concat(new(pai386,op_none(A_CLC,S_NO)));
  423. emitjmp(C_NONE,l2);
  424. emitlab(l);
  425. { We have to load the value into a register because
  426. btl does not accept values only refs or regs (PFV) }
  427. hr2:=getregister32;
  428. exprasmlist^.concat(new(pai386,op_const_reg(A_MOV,S_L,
  429. p^.right^.location.reference.offset,hr2)));
  430. exprasmlist^.concat(new(pai386,op_reg_reg(A_BT,S_L,hr,hr2)));
  431. ungetregister32(hr2);
  432. end;
  433. else
  434. begin
  435. {$ifdef CORRECT_SET_IN_FPC}
  436. if m_tp in aktmodeswitches then
  437. begin
  438. {***WARNING only correct if
  439. reference is 32 bits (PM) *****}
  440. exprasmlist^.concat(new(pai386,op_const_ref(A_CMP,S_L,
  441. 31,newreference(p^.left^.location.reference))));
  442. end
  443. else
  444. {$endif CORRECT_SET_IN_FPC}
  445. begin
  446. exprasmlist^.concat(new(pai386,op_const_ref(A_CMP,S_B,
  447. 31,newreference(p^.left^.location.reference))));
  448. end;
  449. emitjmp(C_NA,l);
  450. { reset carry flag }
  451. exprasmlist^.concat(new(pai386,op_none(A_CLC,S_NO)));
  452. emitjmp(C_NONE,l2);
  453. emitlab(l);
  454. hr:=getregister32;
  455. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
  456. newreference(p^.left^.location.reference),hr)));
  457. { We have to load the value into a register because
  458. btl does not accept values only refs or regs (PFV) }
  459. hr2:=getregister32;
  460. exprasmlist^.concat(new(pai386,op_const_reg(A_MOV,S_L,
  461. p^.right^.location.reference.offset,hr2)));
  462. exprasmlist^.concat(new(pai386,op_reg_reg(A_BT,S_L,hr,hr2)));
  463. ungetregister32(hr2);
  464. del_reference(p^.left^.location.reference);
  465. end;
  466. emitlab(l2);
  467. end;
  468. end { of p^.right^.location.reference.is_immediate }
  469. { do search in a normal set which could have >32 elementsm
  470. but also used if the left side contains higher values > 32 }
  471. else if p^.left^.treetype=ordconstn then
  472. begin
  473. p^.location.resflags:=F_NE;
  474. inc(p^.right^.location.reference.offset,p^.left^.value shr 3);
  475. exprasmlist^.concat(new(pai386,op_const_ref(A_TEST,S_B,1 shl (p^.left^.value and 7),
  476. newreference(p^.right^.location.reference))));
  477. del_reference(p^.right^.location.reference);
  478. end
  479. else
  480. begin
  481. pushsetelement(p^.left);
  482. emitpushreferenceaddr(p^.right^.location.reference);
  483. del_reference(p^.right^.location.reference);
  484. { registers need not be save. that happens in SET_IN_BYTE }
  485. { (EDI is changed) }
  486. emitcall('FPC_SET_IN_BYTE');
  487. { ungetiftemp(p^.right^.location.reference); }
  488. p^.location.loc:=LOC_FLAGS;
  489. p^.location.resflags:=F_C;
  490. end;
  491. end;
  492. end;
  493. if (p^.right^.location.loc in [LOC_MEM,LOC_REFERENCE]) then
  494. ungetiftemp(p^.right^.location.reference);
  495. end;
  496. {*****************************************************************************
  497. SecondCase
  498. *****************************************************************************}
  499. procedure secondcase(var p : ptree);
  500. var
  501. with_sign : boolean;
  502. opsize : topsize;
  503. jmp_gt,jmp_le,jmp_lee : tasmcond;
  504. hp : ptree;
  505. { register with case expression }
  506. hregister : tregister;
  507. endlabel,elselabel : pasmlabel;
  508. { true, if we can omit the range check of the jump table }
  509. jumptable_no_range : boolean;
  510. { where to put the jump table }
  511. jumpsegment : paasmoutput;
  512. procedure gentreejmp(p : pcaserecord);
  513. var
  514. lesslabel,greaterlabel : pasmlabel;
  515. begin
  516. emitlab(p^._at);
  517. { calculate labels for left and right }
  518. if (p^.less=nil) then
  519. lesslabel:=elselabel
  520. else
  521. lesslabel:=p^.less^._at;
  522. if (p^.greater=nil) then
  523. greaterlabel:=elselabel
  524. else
  525. greaterlabel:=p^.greater^._at;
  526. { calculate labels for left and right }
  527. { no range label: }
  528. if p^._low=p^._high then
  529. begin
  530. exprasmlist^.concat(new(pai386,op_const_reg(A_CMP,opsize,p^._low,hregister)));
  531. if greaterlabel=lesslabel then
  532. emitjmp(C_NE,lesslabel)
  533. else
  534. begin
  535. emitjmp(jmp_le,lesslabel);
  536. emitjmp(jmp_gt,greaterlabel);
  537. end;
  538. emitjmp(C_None,p^.statement);
  539. end
  540. else
  541. begin
  542. exprasmlist^.concat(new(pai386,op_const_reg(A_CMP,opsize,p^._low,hregister)));
  543. emitjmp(jmp_le,lesslabel);
  544. exprasmlist^.concat(new(pai386,op_const_reg(A_CMP,opsize,p^._high,hregister)));
  545. emitjmp(jmp_gt,greaterlabel);
  546. emitjmp(C_None,p^.statement);
  547. end;
  548. if assigned(p^.less) then
  549. gentreejmp(p^.less);
  550. if assigned(p^.greater) then
  551. gentreejmp(p^.greater);
  552. end;
  553. procedure genlinearlist(hp : pcaserecord);
  554. var
  555. first : boolean;
  556. last : longint;
  557. {helplabel : longint;}
  558. procedure genitem(t : pcaserecord);
  559. begin
  560. if assigned(t^.less) then
  561. genitem(t^.less);
  562. { need we to test the first value }
  563. if first and (t^._low>get_min_value(p^.left^.resulttype)) then
  564. begin
  565. exprasmlist^.concat(new(pai386,op_const_reg(A_CMP,opsize,t^._low,hregister)));
  566. emitjmp(jmp_le,elselabel);
  567. end;
  568. if t^._low=t^._high then
  569. begin
  570. if t^._low-last=1 then
  571. exprasmlist^.concat(new(pai386,op_reg(A_DEC,opsize,hregister)))
  572. else if t^._low-last=0 then
  573. exprasmlist^.concat(new(pai386,op_reg_reg(A_OR,opsize,hregister,hregister)))
  574. else
  575. exprasmlist^.concat(new(pai386,op_const_reg(A_SUB,opsize,t^._low-last,hregister)));
  576. last:=t^._low;
  577. emitjmp(C_Z,t^.statement);
  578. end
  579. else
  580. begin
  581. { it begins with the smallest label, if the value }
  582. { is even smaller then jump immediately to the }
  583. { ELSE-label }
  584. if first then
  585. begin
  586. { have we to ajust the first value ? }
  587. if t^._low>get_min_value(p^.left^.resulttype) then
  588. begin
  589. if t^._low=1 then
  590. exprasmlist^.concat(new(pai386,op_reg(A_DEC,opsize,
  591. hregister)))
  592. else
  593. exprasmlist^.concat(new(pai386,op_const_reg(A_SUB,opsize,
  594. t^._low,hregister)));
  595. end;
  596. end
  597. else
  598. { if there is no unused label between the last and the }
  599. { present label then the lower limit can be checked }
  600. { immediately. else check the range in between: }
  601. if (t^._low-last>1) then
  602. begin
  603. exprasmlist^.concat(new(pai386,op_const_reg(A_SUB,opsize,t^._low-last,hregister)));
  604. emitjmp(jmp_le,elselabel);
  605. end
  606. else
  607. exprasmlist^.concat(new(pai386,op_reg(A_DEC,opsize,hregister)));
  608. exprasmlist^.concat(new(pai386,op_const_reg(A_SUB,opsize,t^._high-t^._low,hregister)));
  609. emitjmp(jmp_lee,t^.statement);
  610. last:=t^._high;
  611. end;
  612. first:=false;
  613. if assigned(t^.greater) then
  614. genitem(t^.greater);
  615. end;
  616. begin
  617. last:=0;
  618. first:=true;
  619. genitem(hp);
  620. emitjmp(C_None,elselabel);
  621. end;
  622. procedure genjumptable(hp : pcaserecord;min_,max_ : longint);
  623. var
  624. table : pasmlabel;
  625. last : longint;
  626. hr : preference;
  627. procedure genitem(t : pcaserecord);
  628. var
  629. i : longint;
  630. begin
  631. if assigned(t^.less) then
  632. genitem(t^.less);
  633. { fill possible hole }
  634. for i:=last+1 to t^._low-1 do
  635. jumpsegment^.concat(new(pai_const_symbol,init(elselabel)));
  636. for i:=t^._low to t^._high do
  637. jumpsegment^.concat(new(pai_const_symbol,init(t^.statement)));
  638. last:=t^._high;
  639. if assigned(t^.greater) then
  640. genitem(t^.greater);
  641. end;
  642. begin
  643. if not(jumptable_no_range) then
  644. begin
  645. exprasmlist^.concat(new(pai386,op_const_reg(A_CMP,opsize,min_,hregister)));
  646. { case expr less than min_ => goto elselabel }
  647. emitjmp(jmp_le,elselabel);
  648. exprasmlist^.concat(new(pai386,op_const_reg(A_CMP,opsize,max_,hregister)));
  649. emitjmp(jmp_gt,elselabel);
  650. end;
  651. getlabel(table);
  652. { extend with sign }
  653. if opsize=S_W then
  654. begin
  655. exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_WL,hregister,
  656. reg16toreg32(hregister))));
  657. hregister:=reg16toreg32(hregister);
  658. end
  659. else if opsize=S_B then
  660. begin
  661. exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_BL,hregister,
  662. reg8toreg32(hregister))));
  663. hregister:=reg8toreg32(hregister);
  664. end;
  665. new(hr);
  666. reset_reference(hr^);
  667. hr^.symbol:=table;
  668. hr^.offset:=(-min_)*4;
  669. hr^.index:=hregister;
  670. hr^.scalefactor:=4;
  671. exprasmlist^.concat(new(pai386,op_ref(A_JMP,S_NO,hr)));
  672. { !!!!! generate tables
  673. if not(cs_littlesize in aktlocalswitches) then
  674. jumpsegment^.concat(new(pai386,op_const(A_ALIGN,S_NO,4)));
  675. }
  676. jumpsegment^.concat(new(pai_label,init(table)));
  677. last:=min_;
  678. genitem(hp);
  679. { !!!!!!!
  680. if not(cs_littlesize in aktlocalswitches) then
  681. exprasmlist^.concat(new(pai386,op_const(A_ALIGN,S_NO,4)));
  682. }
  683. end;
  684. var
  685. lv,hv,min_label,max_label,labels : longint;
  686. max_linear_list : longint;
  687. {$ifdef Delphi}
  688. dist : cardinal;
  689. {$else Delphi}
  690. dist : dword;
  691. {$endif Delphi}
  692. begin
  693. getlabel(endlabel);
  694. getlabel(elselabel);
  695. if (cs_smartlink in aktmoduleswitches) then
  696. jumpsegment:=procinfo.aktlocaldata
  697. else
  698. jumpsegment:=datasegment;
  699. with_sign:=is_signed(p^.left^.resulttype);
  700. if with_sign then
  701. begin
  702. jmp_gt:=C_G;
  703. jmp_le:=C_L;
  704. jmp_lee:=C_LE;
  705. end
  706. else
  707. begin
  708. jmp_gt:=C_A;
  709. jmp_le:=C_B;
  710. jmp_lee:=C_BE;
  711. end;
  712. cleartempgen;
  713. secondpass(p^.left);
  714. { determines the size of the operand }
  715. opsize:=bytes2Sxx[p^.left^.resulttype^.size];
  716. { copy the case expression to a register }
  717. case p^.left^.location.loc of
  718. LOC_REGISTER:
  719. hregister:=p^.left^.location.register;
  720. LOC_FLAGS :
  721. begin
  722. hregister:=getregister32;
  723. case opsize of
  724. S_B : hregister:=reg32toreg8(hregister);
  725. S_W : hregister:=reg32toreg16(hregister);
  726. end;
  727. emit_flag2reg(p^.left^.location.resflags,hregister);
  728. end;
  729. LOC_CREGISTER:
  730. begin
  731. hregister:=getregister32;
  732. case opsize of
  733. S_B : hregister:=reg32toreg8(hregister);
  734. S_W : hregister:=reg32toreg16(hregister);
  735. end;
  736. exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,opsize,
  737. p^.left^.location.register,hregister)));
  738. end;
  739. LOC_MEM,LOC_REFERENCE : begin
  740. del_reference(p^.left^.location.reference);
  741. hregister:=getregister32;
  742. case opsize of
  743. S_B : hregister:=reg32toreg8(hregister);
  744. S_W : hregister:=reg32toreg16(hregister);
  745. end;
  746. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,opsize,newreference(
  747. p^.left^.location.reference),hregister)));
  748. end;
  749. else internalerror(2002);
  750. end;
  751. { now generate the jumps }
  752. if cs_optimize in aktglobalswitches then
  753. begin
  754. { procedures are empirically passed on }
  755. { consumption can also be calculated }
  756. { but does it pay on the different }
  757. { processors? }
  758. { moreover can the size only be appro- }
  759. { ximated as it is not known if rel8, }
  760. { rel16 or rel32 jumps are used }
  761. min_label:=case_get_min(p^.nodes);
  762. max_label:=case_get_max(p^.nodes);
  763. labels:=case_count_labels(p^.nodes);
  764. { can we omit the range check of the jump table ? }
  765. getrange(p^.left^.resulttype,lv,hv);
  766. jumptable_no_range:=(lv=min_label) and (hv=max_label);
  767. { hack a little bit, because the range can be greater }
  768. { than the positive range of a longint }
  769. if (min_label<0) and (max_label>0) then
  770. begin
  771. {$ifdef Delphi}
  772. if min_label=$80000000 then
  773. dist:=Cardinal(max_label)+Cardinal($80000000)
  774. else
  775. dist:=Cardinal(max_label)+Cardinal(-min_label)
  776. {$else Delphi}
  777. if min_label=$80000000 then
  778. dist:=dword(max_label)+dword($80000000)
  779. else
  780. dist:=dword(max_label)+dword(-min_label)
  781. {$endif Delphi}
  782. end
  783. else
  784. dist:=max_label-min_label;
  785. { optimize for size ? }
  786. if cs_littlesize in aktglobalswitches then
  787. begin
  788. if (labels<=2) or
  789. ((max_label-min_label)<0) or
  790. ((max_label-min_label)>3*labels) then
  791. { a linear list is always smaller than a jump tree }
  792. genlinearlist(p^.nodes)
  793. else
  794. { if the labels less or more a continuum then }
  795. genjumptable(p^.nodes,min_label,max_label);
  796. end
  797. else
  798. begin
  799. if jumptable_no_range then
  800. max_linear_list:=4
  801. else
  802. max_linear_list:=2;
  803. { a jump table crashes the pipeline! }
  804. if aktoptprocessor=Class386 then
  805. inc(max_linear_list,3);
  806. if aktoptprocessor=ClassP5 then
  807. inc(max_linear_list,6);
  808. if aktoptprocessor>=ClassP6 then
  809. inc(max_linear_list,9);
  810. if (labels<=max_linear_list) then
  811. genlinearlist(p^.nodes)
  812. else
  813. begin
  814. if (dist>4*labels) then
  815. begin
  816. if labels>16 then
  817. gentreejmp(p^.nodes)
  818. else
  819. genlinearlist(p^.nodes);
  820. end
  821. else
  822. genjumptable(p^.nodes,min_label,max_label);
  823. end;
  824. end;
  825. end
  826. else
  827. { it's always not bad }
  828. genlinearlist(p^.nodes);
  829. {$IfDef regallocfix}
  830. ungetregister(hregister);
  831. {$EndIf regallocfix}
  832. { now generate the instructions }
  833. hp:=p^.right;
  834. while assigned(hp) do
  835. begin
  836. cleartempgen;
  837. secondpass(hp^.right);
  838. { don't come back to case line }
  839. aktfilepos:=exprasmlist^.getlasttaifilepos^;
  840. emitjmp(C_None,endlabel);
  841. hp:=hp^.left;
  842. end;
  843. emitlab(elselabel);
  844. { ...and the else block }
  845. if assigned(p^.elseblock) then
  846. begin
  847. cleartempgen;
  848. secondpass(p^.elseblock);
  849. end;
  850. emitlab(endlabel);
  851. end;
  852. end.
  853. {
  854. $Log$
  855. Revision 1.34 1999-06-08 15:27:24 pierre
  856. * fix for bug0258
  857. Revision 1.33 1999/06/02 10:11:48 florian
  858. * make cycle fixed i.e. compilation with 0.99.10
  859. * some fixes for qword
  860. * start of register calling conventions
  861. Revision 1.32 1999/05/27 19:44:19 peter
  862. * removed oldasm
  863. * plabel -> pasmlabel
  864. * -a switches to source writing automaticly
  865. * assembler readers OOPed
  866. * asmsymbol automaticly external
  867. * jumptables and other label fixes for asm readers
  868. Revision 1.31 1999/05/21 13:54:54 peter
  869. * NEWLAB for label as symbol
  870. Revision 1.30 1999/05/05 08:09:24 michael
  871. * Changed longword to cardinal
  872. Revision 1.29 1999/05/04 21:44:34 florian
  873. * changes to compile it with Delphi 4.0
  874. Revision 1.28 1999/05/01 13:24:15 peter
  875. * merged nasm compiler
  876. * old asm moved to oldasm/
  877. Revision 1.27 1999/04/16 13:42:30 jonas
  878. * more regalloc fixes (still not complete)
  879. Revision 1.26 1999/04/09 08:36:36 peter
  880. * fix also for -Og
  881. Revision 1.25 1999/04/08 20:59:37 florian
  882. * fixed problem with default properties which are a class
  883. * case bug (from the mailing list with -O2) fixed, the
  884. distance of the case labels can be greater than the positive
  885. range of a longint => it is now a dword for fpc
  886. Revision 1.24 1999/03/02 18:21:35 peter
  887. + flags support for add and case
  888. Revision 1.23 1999/02/25 21:02:31 peter
  889. * ag386bin updates
  890. + coff writer
  891. Revision 1.22 1999/02/22 02:15:16 peter
  892. * updates for ag386bin
  893. Revision 1.21 1999/02/17 10:12:59 peter
  894. * removed memory leak when jumps are generated
  895. Revision 1.20 1998/12/11 00:02:56 peter
  896. + globtype,tokens,version unit splitted from globals
  897. Revision 1.19 1998/10/09 08:56:25 pierre
  898. * several memory leaks fixed
  899. Revision 1.18 1998/10/08 17:17:14 pierre
  900. * current_module old scanner tagged as invalid if unit is recompiled
  901. + added ppheap for better info on tracegetmem of heaptrc
  902. (adds line column and file index)
  903. * several memory leaks removed ith help of heaptrc !!
  904. Revision 1.17 1998/09/17 09:42:20 peter
  905. + pass_2 for cg386
  906. * Message() -> CGMessage() for pass_1/pass_2
  907. Revision 1.16 1998/09/14 10:43:53 peter
  908. * all internal RTL functions start with FPC_
  909. Revision 1.15 1998/09/09 17:51:59 florian
  910. * the next try to fix the case problem ...
  911. Revision 1.14 1998/09/09 16:44:21 florian
  912. * I hope, the case bug is fixed now
  913. Revision 1.13 1998/09/07 18:45:54 peter
  914. * update smartlinking, uses getdatalabel
  915. * renamed ptree.value vars to value_str,value_real,value_set
  916. Revision 1.12 1998/09/05 23:51:05 florian
  917. * possible bug with too few registers in first/secondin fixed
  918. Revision 1.11 1998/09/04 08:41:41 peter
  919. * updated some error messages
  920. Revision 1.10 1998/09/03 17:08:40 pierre
  921. * better lines for stabs
  922. (no scroll back to if before else part
  923. no return to case line at jump outside case)
  924. + source lines also if not in order
  925. Revision 1.9 1998/08/28 10:54:19 peter
  926. * fixed smallset generation from elements, it has never worked before!
  927. Revision 1.8 1998/08/25 11:51:46 peter
  928. * fixed -15 seen as byte in case
  929. Revision 1.7 1998/08/19 16:07:38 jonas
  930. * changed optimizer switches + cleanup of DestroyRefs in daopt386.pas
  931. Revision 1.6 1998/08/18 09:24:39 pierre
  932. * small warning position bug fixed
  933. * support_mmx switches splitting was missing
  934. * rhide error and warning output corrected
  935. Revision 1.5 1998/08/14 18:18:40 peter
  936. + dynamic set contruction
  937. * smallsets are now working (always longint size)
  938. Revision 1.4 1998/08/10 14:49:51 peter
  939. + localswitches, moduleswitches, globalswitches splitting
  940. Revision 1.3 1998/06/25 08:48:10 florian
  941. * first version of rtti support
  942. Revision 1.2 1998/06/16 08:56:18 peter
  943. + targetcpu
  944. * cleaner pmodules for newppu
  945. Revision 1.1 1998/06/05 17:44:13 peter
  946. * splitted cgi386
  947. }