n386set.pas 42 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130
  1. {
  2. $Id$
  3. Copyright (c) 1998-2000 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 n386set;
  19. {$i defines.inc}
  20. interface
  21. uses
  22. node,nset;
  23. type
  24. ti386setelementnode = class(tsetelementnode)
  25. procedure pass_2;override;
  26. end;
  27. ti386innode = class(tinnode)
  28. procedure pass_2;override;
  29. end;
  30. ti386casenode = class(tcasenode)
  31. procedure pass_2;override;
  32. end;
  33. implementation
  34. uses
  35. globtype,systems,cpuinfo,
  36. verbose,globals,
  37. symconst,symdef,aasm,types,
  38. hcodegen,temp_gen,pass_2,
  39. ncon,
  40. cpubase,
  41. cgai386,tgcpu,n386util,regvars;
  42. const
  43. bytes2Sxx:array[1..8] of Topsize=(S_B,S_W,S_NO,S_L,S_NO,S_NO,S_NO,S_Q);
  44. {*****************************************************************************
  45. TI386SETELEMENTNODE
  46. *****************************************************************************}
  47. procedure ti386setelementnode.pass_2;
  48. begin
  49. { load first value in 32bit register }
  50. secondpass(left);
  51. if left.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
  52. emit_to_reg32(left.location.register);
  53. { also a second value ? }
  54. if assigned(right) then
  55. begin
  56. secondpass(right);
  57. if right.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
  58. emit_to_reg32(right.location.register);
  59. end;
  60. { we doesn't modify the left side, we check only the type }
  61. set_location(location,left.location);
  62. end;
  63. {*****************************************************************************
  64. TI386INNODE
  65. *****************************************************************************}
  66. procedure ti386innode.pass_2;
  67. type
  68. Tsetpart=record
  69. range : boolean; {Part is a range.}
  70. start,stop : byte; {Start/stop when range; Stop=element when an element.}
  71. end;
  72. var
  73. genjumps,
  74. use_small,
  75. pushed,
  76. ranges : boolean;
  77. hr,hr2,
  78. pleftreg : tregister;
  79. opsize : topsize;
  80. setparts : array[1..8] of Tsetpart;
  81. i,numparts : byte;
  82. adjustment : longint;
  83. {href,href2 : Treference;}
  84. l,l2 : tasmlabel;
  85. {$ifdef CORRECT_SET_IN_FPC}
  86. AM : tasmop;
  87. {$endif CORRECT_SET_IN_FPC}
  88. function analizeset(Aset:pconstset;is_small:boolean):boolean;
  89. type
  90. byteset=set of byte;
  91. var
  92. compares,maxcompares:word;
  93. i:byte;
  94. begin
  95. analizeset:=false;
  96. ranges:=false;
  97. numparts:=0;
  98. compares:=0;
  99. { Lots of comparisions take a lot of time, so do not allow
  100. too much comparisions. 8 comparisions are, however, still
  101. smalller than emitting the set }
  102. if cs_littlesize in aktglobalswitches then
  103. maxcompares:=8
  104. else
  105. maxcompares:=5;
  106. { when smallset is possible allow only 3 compares the smallset
  107. code is for littlesize also smaller when more compares are used }
  108. if is_small then
  109. maxcompares:=3;
  110. for i:=0 to 255 do
  111. if i in byteset(Aset^) then
  112. begin
  113. if (numparts=0) or (i<>setparts[numparts].stop+1) then
  114. begin
  115. {Set element is a separate element.}
  116. inc(compares);
  117. if compares>maxcompares then
  118. exit;
  119. inc(numparts);
  120. setparts[numparts].range:=false;
  121. setparts[numparts].stop:=i;
  122. end
  123. else
  124. {Set element is part of a range.}
  125. if not setparts[numparts].range then
  126. begin
  127. {Transform an element into a range.}
  128. setparts[numparts].range:=true;
  129. setparts[numparts].start:=setparts[numparts].stop;
  130. setparts[numparts].stop:=i;
  131. ranges := true;
  132. { there's only one compare per range anymore. Only a }
  133. { sub is added, but that's much faster than a }
  134. { cmp/jcc combo so neglect its effect }
  135. { inc(compares);
  136. if compares>maxcompares then
  137. exit; }
  138. end
  139. else
  140. begin
  141. {Extend a range.}
  142. setparts[numparts].stop:=i;
  143. end;
  144. end;
  145. analizeset:=true;
  146. end;
  147. begin
  148. { We check first if we can generate jumps, this can be done
  149. because the resulttype.def is already set in firstpass }
  150. { check if we can use smallset operation using btl which is limited
  151. to 32 bits, the left side may also not contain higher values !! }
  152. use_small:=(tsetdef(right.resulttype.def).settype=smallset) and
  153. ((left.resulttype.def.deftype=orddef) and (torddef(left.resulttype.def).high<=32) or
  154. (left.resulttype.def.deftype=enumdef) and (tenumdef(left.resulttype.def).max<=32));
  155. { Can we generate jumps? Possible for all types of sets }
  156. genjumps:=(right.nodetype=setconstn) and
  157. analizeset(tsetconstnode(right).value_set,use_small);
  158. { calculate both operators }
  159. { the complex one first }
  160. firstcomplex(self);
  161. secondpass(left);
  162. { Only process the right if we are not generating jumps }
  163. if not genjumps then
  164. begin
  165. pushed:=maybe_push(right.registers32,left,false);
  166. secondpass(right);
  167. if pushed then
  168. restore(left,false);
  169. end;
  170. if codegenerror then
  171. exit;
  172. { ofcourse not commutative }
  173. if nf_swaped in flags then
  174. swapleftright;
  175. if genjumps then
  176. begin
  177. { It gives us advantage to check for the set elements
  178. separately instead of using the SET_IN_BYTE procedure.
  179. To do: Build in support for LOC_JUMP }
  180. opsize := def_opsize(left.resulttype.def);
  181. { If register is used, use only lower 8 bits }
  182. if left.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
  183. begin
  184. pleftreg:=left.location.register;
  185. { for ranges we always need a 32bit register, because then we }
  186. { use the register as base in a reference (JM) }
  187. if ranges then
  188. begin
  189. pleftreg := makereg32(pleftreg);
  190. if opsize <> S_L then
  191. emit_const_reg(A_AND,S_L,255,pleftreg);
  192. opsize := S_L;
  193. end
  194. else
  195. { otherwise simply use the lower 8 bits (no "and" }
  196. { necessary this way) (JM) }
  197. begin
  198. pleftreg := makereg8(pleftreg);
  199. opsize := S_B;
  200. end;
  201. end
  202. else
  203. begin
  204. { load the value in a register }
  205. pleftreg := getexplicitregister32(R_EDI);
  206. opsize := S_L;
  207. emit_ref_reg(A_MOVZX,S_BL,newreference(left.location.reference),
  208. pleftreg);
  209. end;
  210. { Get a label to jump to the end }
  211. location.loc:=LOC_FLAGS;
  212. { It's better to use the zero flag when there are
  213. no ranges }
  214. if ranges then
  215. location.resflags:=F_C
  216. else
  217. location.resflags:=F_E;
  218. getlabel(l);
  219. { how much have we already substracted from the x in the }
  220. { "x in [y..z]" expression }
  221. adjustment := 0;
  222. for i:=1 to numparts do
  223. if setparts[i].range then
  224. { use fact that a <= x <= b <=> cardinal(x-a) <= cardinal(b-a) }
  225. begin
  226. { is the range different from all legal values? }
  227. if (setparts[i].stop-setparts[i].start <> 255) then
  228. begin
  229. { yes, is the lower bound <> 0? }
  230. if (setparts[i].start <> 0) then
  231. { we're going to substract from the left register, }
  232. { so in case of a LOC_CREGISTER first move the value }
  233. { to edi (not done before because now we can do the }
  234. { move and substract in one instruction with LEA) }
  235. if (pleftreg <> R_EDI) and
  236. (left.location.loc = LOC_CREGISTER) then
  237. begin
  238. ungetregister(pleftreg);
  239. getexplicitregister32(R_EDI);
  240. emit_ref_reg(A_LEA,S_L,
  241. new_reference(pleftreg,-setparts[i].start),R_EDI);
  242. { only now change pleftreg since previous value is }
  243. { still used in previous instruction }
  244. pleftreg := R_EDI;
  245. opsize := S_L;
  246. end
  247. else
  248. begin
  249. { otherwise, the value is already in a register }
  250. { that can be modified }
  251. if setparts[i].start-adjustment <> 1 then
  252. emit_const_reg(A_SUB,opsize,
  253. setparts[i].start-adjustment,pleftreg)
  254. else emit_reg(A_DEC,opsize,pleftreg);
  255. end;
  256. { new total value substracted from x: }
  257. { adjustment + (setparts[i].start - adjustment) }
  258. adjustment := setparts[i].start;
  259. { check if result < b-a+1 (not "result <= b-a", since }
  260. { we need a carry in case the element is in the range }
  261. { (this will never overflow since we check at the }
  262. { beginning whether stop-start <> 255) }
  263. emit_const_reg(A_CMP,opsize,
  264. setparts[i].stop-setparts[i].start+1,pleftreg);
  265. { use C_C instead of C_B: the meaning is the same, but }
  266. { then the optimizer can easier trace the jump to its }
  267. { final destination since the resultflag of this node }
  268. { is set to the carryflag }
  269. emitjmp(C_C,l);
  270. end
  271. else
  272. { if setparts[i].start = 0 and setparts[i].stop = 255, }
  273. { it's always true since "in" is only allowed for bytes }
  274. begin
  275. emit_none(A_STC,S_NO);
  276. emitjmp(C_NONE,l);
  277. end;
  278. end
  279. else
  280. begin
  281. { Emit code to check if left is an element }
  282. emit_const_reg(A_CMP,opsize,setparts[i].stop-adjustment,
  283. pleftreg);
  284. { Result should be in carry flag when ranges are used }
  285. if ranges then
  286. emit_none(A_STC,S_NO);
  287. { If found, jump to end }
  288. emitjmp(C_E,l);
  289. end;
  290. if ranges and
  291. { if the last one was a range, the carry flag is already }
  292. { set appropriately }
  293. not(setparts[numparts].range) then
  294. emit_none(A_CLC,S_NO);
  295. { To compensate for not doing a second pass }
  296. right.location.reference.symbol:=nil;
  297. { Now place the end label }
  298. emitlab(l);
  299. case left.location.loc of
  300. LOC_REGISTER,
  301. LOC_CREGISTER : ungetregister(pleftreg);
  302. else
  303. begin
  304. del_reference(left.location.reference);
  305. ungetregister(R_EDI);
  306. end
  307. end
  308. end
  309. else
  310. begin
  311. { We will now generated code to check the set itself, no jmps,
  312. handle smallsets separate, because it allows faster checks }
  313. if use_small then
  314. begin
  315. if left.nodetype=ordconstn then
  316. begin
  317. location.resflags:=F_NE;
  318. case right.location.loc of
  319. LOC_REGISTER,
  320. LOC_CREGISTER:
  321. begin
  322. emit_const_reg(A_TEST,S_L,
  323. 1 shl (tordconstnode(left).value and 31),right.location.register);
  324. ungetregister32(right.location.register);
  325. end
  326. else
  327. begin
  328. emit_const_ref(A_TEST,S_L,1 shl (tordconstnode(left).value and 31),
  329. newreference(right.location.reference));
  330. del_reference(right.location.reference);
  331. end;
  332. end;
  333. end
  334. else
  335. begin
  336. case left.location.loc of
  337. LOC_REGISTER,
  338. LOC_CREGISTER:
  339. begin
  340. hr:=left.location.register;
  341. emit_to_reg32(hr);
  342. end;
  343. else
  344. begin
  345. { the set element isn't never samller than a byte }
  346. { and because it's a small set we need only 5 bits }
  347. { but 8 bits are easier to load }
  348. getexplicitregister32(R_EDI);
  349. emit_ref_reg(A_MOVZX,S_BL,
  350. newreference(left.location.reference),R_EDI);
  351. hr:=R_EDI;
  352. del_reference(left.location.reference);
  353. end;
  354. end;
  355. case right.location.loc of
  356. LOC_REGISTER,
  357. LOC_CREGISTER :
  358. begin
  359. emit_reg_reg(A_BT,S_L,hr,
  360. right.location.register);
  361. ungetregister32(right.location.register);
  362. end
  363. else
  364. begin
  365. del_reference(right.location.reference);
  366. if right.location.reference.is_immediate then
  367. begin
  368. { We have to load the value into a register because
  369. btl does not accept values only refs or regs (PFV) }
  370. hr2:=getregister32;
  371. emit_const_reg(A_MOV,S_L,
  372. right.location.reference.offset,hr2);
  373. emit_reg_reg(A_BT,S_L,hr,hr2);
  374. ungetregister32(hr2);
  375. end
  376. else
  377. emit_reg_ref(A_BT,S_L,hr,
  378. newreference(right.location.reference));
  379. end;
  380. end;
  381. { simply to indicate EDI is deallocated here too (JM) }
  382. ungetregister32(hr);
  383. location.loc:=LOC_FLAGS;
  384. location.resflags:=F_C;
  385. end;
  386. end
  387. else
  388. begin
  389. if right.location.reference.is_immediate then
  390. begin
  391. location.resflags:=F_C;
  392. getlabel(l);
  393. getlabel(l2);
  394. { Is this treated in firstpass ?? }
  395. if left.nodetype=ordconstn then
  396. begin
  397. hr:=getregister32;
  398. left.location.loc:=LOC_REGISTER;
  399. left.location.register:=hr;
  400. emit_const_reg(A_MOV,S_L,
  401. tordconstnode(left).value,hr);
  402. end;
  403. case left.location.loc of
  404. LOC_REGISTER,
  405. LOC_CREGISTER:
  406. begin
  407. hr:=left.location.register;
  408. emit_to_reg32(hr);
  409. emit_const_reg(A_CMP,S_L,31,hr);
  410. emitjmp(C_NA,l);
  411. { reset carry flag }
  412. emit_none(A_CLC,S_NO);
  413. emitjmp(C_NONE,l2);
  414. emitlab(l);
  415. { We have to load the value into a register because
  416. btl does not accept values only refs or regs (PFV) }
  417. hr2:=getregister32;
  418. emit_const_reg(A_MOV,S_L,right.location.reference.offset,hr2);
  419. emit_reg_reg(A_BT,S_L,hr,hr2);
  420. ungetregister32(hr2);
  421. end;
  422. else
  423. begin
  424. {$ifdef CORRECT_SET_IN_FPC}
  425. if m_tp in aktmodeswitches then
  426. begin
  427. {***WARNING only correct if
  428. reference is 32 bits (PM) *****}
  429. emit_const_ref(A_CMP,S_L,
  430. 31,newreference(left.location.reference));
  431. end
  432. else
  433. {$endif CORRECT_SET_IN_FPC}
  434. begin
  435. emit_const_ref(A_CMP,S_B,
  436. 31,newreference(left.location.reference));
  437. end;
  438. emitjmp(C_NA,l);
  439. { reset carry flag }
  440. emit_none(A_CLC,S_NO);
  441. emitjmp(C_NONE,l2);
  442. emitlab(l);
  443. del_reference(left.location.reference);
  444. hr:=getregister32;
  445. emit_ref_reg(A_MOV,S_L,
  446. newreference(left.location.reference),hr);
  447. { We have to load the value into a register because
  448. btl does not accept values only refs or regs (PFV) }
  449. hr2:=getregister32;
  450. emit_const_reg(A_MOV,S_L,
  451. right.location.reference.offset,hr2);
  452. emit_reg_reg(A_BT,S_L,hr,hr2);
  453. ungetregister32(hr2);
  454. end;
  455. end;
  456. emitlab(l2);
  457. end { of right.location.reference.is_immediate }
  458. { do search in a normal set which could have >32 elementsm
  459. but also used if the left side contains higher values > 32 }
  460. else if left.nodetype=ordconstn then
  461. begin
  462. location.resflags:=F_NE;
  463. inc(right.location.reference.offset,tordconstnode(left).value shr 3);
  464. emit_const_ref(A_TEST,S_B,1 shl (tordconstnode(left).value and 7),
  465. newreference(right.location.reference));
  466. del_reference(right.location.reference);
  467. end
  468. else
  469. begin
  470. pushsetelement(left);
  471. emitpushreferenceaddr(right.location.reference);
  472. del_reference(right.location.reference);
  473. { registers need not be save. that happens in SET_IN_BYTE }
  474. { (EDI is changed) }
  475. emitcall('FPC_SET_IN_BYTE');
  476. { ungetiftemp(right.location.reference); }
  477. location.loc:=LOC_FLAGS;
  478. location.resflags:=F_C;
  479. end;
  480. end;
  481. end;
  482. if (right.location.loc in [LOC_MEM,LOC_REFERENCE]) then
  483. ungetiftemp(right.location.reference);
  484. end;
  485. {*****************************************************************************
  486. TI386CASENODE
  487. *****************************************************************************}
  488. procedure ti386casenode.pass_2;
  489. var
  490. with_sign : boolean;
  491. opsize : topsize;
  492. jmp_gt,jmp_le,jmp_lee : tasmcond;
  493. hp : tnode;
  494. { register with case expression }
  495. hregister,hregister2 : tregister;
  496. endlabel,elselabel : tasmlabel;
  497. { true, if we can omit the range check of the jump table }
  498. jumptable_no_range : boolean;
  499. { where to put the jump table }
  500. jumpsegment : TAAsmoutput;
  501. min_label : TConstExprInt;
  502. procedure gentreejmp(p : pcaserecord);
  503. var
  504. lesslabel,greaterlabel : tasmlabel;
  505. begin
  506. emitlab(p^._at);
  507. { calculate labels for left and right }
  508. if (p^.less=nil) then
  509. lesslabel:=elselabel
  510. else
  511. lesslabel:=p^.less^._at;
  512. if (p^.greater=nil) then
  513. greaterlabel:=elselabel
  514. else
  515. greaterlabel:=p^.greater^._at;
  516. { calculate labels for left and right }
  517. { no range label: }
  518. if p^._low=p^._high then
  519. begin
  520. emit_const_reg(A_CMP,opsize,p^._low,hregister);
  521. if greaterlabel=lesslabel then
  522. emitjmp(C_NE,lesslabel)
  523. else
  524. begin
  525. emitjmp(jmp_le,lesslabel);
  526. emitjmp(jmp_gt,greaterlabel);
  527. end;
  528. emitjmp(C_None,p^.statement);
  529. end
  530. else
  531. begin
  532. emit_const_reg(A_CMP,opsize,p^._low,hregister);
  533. emitjmp(jmp_le,lesslabel);
  534. emit_const_reg(A_CMP,opsize,p^._high,hregister);
  535. emitjmp(jmp_gt,greaterlabel);
  536. emitjmp(C_None,p^.statement);
  537. end;
  538. if assigned(p^.less) then
  539. gentreejmp(p^.less);
  540. if assigned(p^.greater) then
  541. gentreejmp(p^.greater);
  542. end;
  543. procedure genlinearcmplist(hp : pcaserecord);
  544. var
  545. first : boolean;
  546. last : TConstExprInt;
  547. procedure genitem(t : pcaserecord);
  548. var
  549. l1 : tasmlabel;
  550. begin
  551. if assigned(t^.less) then
  552. genitem(t^.less);
  553. if t^._low=t^._high then
  554. begin
  555. if opsize=S_Q then
  556. begin
  557. getlabel(l1);
  558. emit_const_reg(A_CMP,S_L,longint(hi(int64(t^._low))),hregister2);
  559. emitjmp(C_NZ,l1);
  560. emit_const_reg(A_CMP,S_L,longint(lo(int64(t^._low))),hregister);
  561. emitjmp(C_Z,t^.statement);
  562. emitlab(l1);
  563. end
  564. else
  565. begin
  566. emit_const_reg(A_CMP,opsize,longint(t^._low),hregister);
  567. emitjmp(C_Z,t^.statement);
  568. last:=t^._low;
  569. end;
  570. end
  571. else
  572. begin
  573. { if there is no unused label between the last and the }
  574. { present label then the lower limit can be checked }
  575. { immediately. else check the range in between: }
  576. if first or (t^._low-last>1) then
  577. begin
  578. if opsize=S_Q then
  579. begin
  580. getlabel(l1);
  581. emit_const_reg(A_CMP,S_L,longint(hi(int64(t^._low))),hregister2);
  582. emitjmp(jmp_le,elselabel);
  583. emitjmp(jmp_gt,l1);
  584. emit_const_reg(A_CMP,S_L,longint(lo(int64(t^._low))),hregister);
  585. { the comparisation of the low dword must be always unsigned! }
  586. emitjmp(C_B,elselabel);
  587. emitlab(l1);
  588. end
  589. else
  590. begin
  591. emit_const_reg(A_CMP,opsize,longint(t^._low),hregister);
  592. emitjmp(jmp_le,elselabel);
  593. end;
  594. end;
  595. if opsize=S_Q then
  596. begin
  597. getlabel(l1);
  598. emit_const_reg(A_CMP,S_L,longint(hi(int64(t^._high))),hregister2);
  599. emitjmp(jmp_le,t^.statement);
  600. emitjmp(jmp_gt,l1);
  601. emit_const_reg(A_CMP,S_L,longint(lo(int64(t^._high))),hregister);
  602. { the comparisation of the low dword must be always unsigned! }
  603. emitjmp(C_BE,t^.statement);
  604. emitlab(l1);
  605. end
  606. else
  607. begin
  608. emit_const_reg(A_CMP,opsize,longint(t^._high),hregister);
  609. emitjmp(jmp_lee,t^.statement);
  610. end;
  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 genlinearlist(hp : pcaserecord);
  624. var
  625. first : boolean;
  626. last : TConstExprInt;
  627. {helplabel : longint;}
  628. procedure genitem(t : pcaserecord);
  629. procedure gensub(value:longint);
  630. begin
  631. if value=1 then
  632. emit_reg(A_DEC,opsize,hregister)
  633. else
  634. emit_const_reg(A_SUB,opsize,value,hregister);
  635. end;
  636. begin
  637. if assigned(t^.less) then
  638. genitem(t^.less);
  639. { need we to test the first value }
  640. if first and (t^._low>get_min_value(left.resulttype.def)) then
  641. begin
  642. emit_const_reg(A_CMP,opsize,longint(t^._low),hregister);
  643. emitjmp(jmp_le,elselabel);
  644. end;
  645. if t^._low=t^._high then
  646. begin
  647. if t^._low-last=0 then
  648. emit_reg_reg(A_OR,opsize,hregister,hregister)
  649. else
  650. gensub(longint(t^._low-last));
  651. last:=t^._low;
  652. emitjmp(C_Z,t^.statement);
  653. end
  654. else
  655. begin
  656. { it begins with the smallest label, if the value }
  657. { is even smaller then jump immediately to the }
  658. { ELSE-label }
  659. if first then
  660. begin
  661. { have we to ajust the first value ? }
  662. if (t^._low>get_min_value(left.resulttype.def)) then
  663. gensub(t^._low);
  664. end
  665. else
  666. begin
  667. { if there is no unused label between the last and the }
  668. { present label then the lower limit can be checked }
  669. { immediately. else check the range in between: }
  670. { note: you can't use gensub() here because dec doesn't }
  671. { change the carry flag (needed for jmp_lxx) (JM) }
  672. emit_const_reg(A_SUB,opsize,longint(t^._low-last),hregister);
  673. emitjmp(jmp_le,elselabel);
  674. end;
  675. emit_const_reg(A_SUB,opsize,longint(t^._high-t^._low),hregister);
  676. emitjmp(jmp_lee,t^.statement);
  677. last:=t^._high;
  678. end;
  679. first:=false;
  680. if assigned(t^.greater) then
  681. genitem(t^.greater);
  682. end;
  683. begin
  684. { do we need to generate cmps? }
  685. if (with_sign and (min_label<0)) then
  686. genlinearcmplist(hp)
  687. else
  688. begin
  689. last:=0;
  690. first:=true;
  691. genitem(hp);
  692. emitjmp(C_None,elselabel);
  693. end;
  694. end;
  695. procedure genjumptable(hp : pcaserecord;min_,max_ : longint);
  696. var
  697. table : tasmlabel;
  698. last : TConstExprInt;
  699. hr : preference;
  700. procedure genitem(t : pcaserecord);
  701. var
  702. i : longint;
  703. begin
  704. if assigned(t^.less) then
  705. genitem(t^.less);
  706. { fill possible hole }
  707. for i:=last+1 to t^._low-1 do
  708. jumpSegment.concat(Tai_const_symbol.Create(elselabel));
  709. for i:=t^._low to t^._high do
  710. jumpSegment.concat(Tai_const_symbol.Create(t^.statement));
  711. last:=t^._high;
  712. if assigned(t^.greater) then
  713. genitem(t^.greater);
  714. end;
  715. begin
  716. if not(jumptable_no_range) then
  717. begin
  718. emit_const_reg(A_CMP,opsize,longint(min_),hregister);
  719. { case expr less than min_ => goto elselabel }
  720. emitjmp(jmp_le,elselabel);
  721. emit_const_reg(A_CMP,opsize,longint(max_),hregister);
  722. emitjmp(jmp_gt,elselabel);
  723. end;
  724. getlabel(table);
  725. { extend with sign }
  726. if opsize=S_W then
  727. begin
  728. if with_sign then
  729. emit_reg_reg(A_MOVSX,S_WL,hregister,
  730. reg16toreg32(hregister))
  731. else
  732. emit_reg_reg(A_MOVZX,S_WL,hregister,
  733. reg16toreg32(hregister));
  734. hregister:=reg16toreg32(hregister);
  735. end
  736. else if opsize=S_B then
  737. begin
  738. if with_sign then
  739. emit_reg_reg(A_MOVSX,S_BL,hregister,
  740. reg8toreg32(hregister))
  741. else
  742. emit_reg_reg(A_MOVZX,S_BL,hregister,
  743. reg8toreg32(hregister));
  744. hregister:=reg8toreg32(hregister);
  745. end;
  746. new(hr);
  747. reset_reference(hr^);
  748. hr^.symbol:=table;
  749. hr^.offset:=(-longint(min_))*4;
  750. hr^.index:=hregister;
  751. hr^.scalefactor:=4;
  752. emit_ref(A_JMP,S_NO,hr);
  753. { !!!!! generate tables
  754. if not(cs_littlesize in aktlocalswitches) then
  755. jumpSegment.concat(Taicpu.Op_const(A_ALIGN,S_NO,4));
  756. }
  757. jumpSegment.concat(Tai_label.Create(table));
  758. last:=min_;
  759. genitem(hp);
  760. { !!!!!!!
  761. if not(cs_littlesize in aktlocalswitches) then
  762. emit_const(A_ALIGN,S_NO,4);
  763. }
  764. end;
  765. var
  766. max_label: tconstexprint;
  767. lv,hv,labels : longint;
  768. max_linear_list : longint;
  769. otl, ofl: tasmlabel;
  770. {$ifdef Delphi}
  771. dist : cardinal;
  772. {$else Delphi}
  773. dist : dword;
  774. {$endif Delphi}
  775. hr : preference;
  776. begin
  777. getlabel(endlabel);
  778. getlabel(elselabel);
  779. if (cs_create_smart in aktmoduleswitches) then
  780. jumpsegment:=procinfo^.aktlocaldata
  781. else
  782. jumpsegment:=datasegment;
  783. with_sign:=is_signed(left.resulttype.def);
  784. if with_sign then
  785. begin
  786. jmp_gt:=C_G;
  787. jmp_le:=C_L;
  788. jmp_lee:=C_LE;
  789. end
  790. else
  791. begin
  792. jmp_gt:=C_A;
  793. jmp_le:=C_B;
  794. jmp_lee:=C_BE;
  795. end;
  796. cleartempgen;
  797. { save current truelabel and falselabel (they are restored in }
  798. { locjump2reg) (JM) }
  799. if left.location.loc=LOC_JUMP then
  800. begin
  801. otl:=truelabel;
  802. getlabel(truelabel);
  803. ofl:=falselabel;
  804. getlabel(falselabel);
  805. end;
  806. secondpass(left);
  807. { determines the size of the operand }
  808. opsize:=bytes2Sxx[left.resulttype.def.size];
  809. { copy the case expression to a register }
  810. case left.location.loc of
  811. LOC_REGISTER:
  812. begin
  813. if opsize=S_Q then
  814. begin
  815. hregister:=left.location.registerlow;
  816. hregister2:=left.location.registerhigh;
  817. end
  818. else
  819. hregister:=left.location.register;
  820. end;
  821. LOC_FLAGS :
  822. begin
  823. locflags2reg(left.location,opsize);
  824. hregister := left.location.register;
  825. end;
  826. LOC_JUMP:
  827. begin
  828. locjump2reg(left.location,opsize,otl,ofl);
  829. hregister := left.location.register;
  830. end;
  831. LOC_CREGISTER:
  832. begin
  833. hregister:=getregister32;
  834. case opsize of
  835. S_B:
  836. hregister:=reg32toreg8(hregister);
  837. S_W:
  838. hregister:=reg32toreg16(hregister);
  839. S_Q:
  840. hregister2:=R_EDI;
  841. end;
  842. if opsize=S_Q then
  843. begin
  844. emit_reg_reg(A_MOV,S_L,left.location.registerlow,hregister);
  845. hr:=newreference(left.location.reference);
  846. inc(hr^.offset,4);
  847. emit_reg_reg(A_MOV,S_L,left.location.registerhigh,hregister2);
  848. end
  849. else
  850. emit_reg_reg(A_MOV,opsize,
  851. left.location.register,hregister);
  852. end;
  853. LOC_MEM,LOC_REFERENCE:
  854. begin
  855. del_reference(left.location.reference);
  856. hregister:=getregister32;
  857. case opsize of
  858. S_B:
  859. hregister:=reg32toreg8(hregister);
  860. S_W:
  861. hregister:=reg32toreg16(hregister);
  862. S_Q:
  863. hregister2:=R_EDI;
  864. end;
  865. if opsize=S_Q then
  866. begin
  867. emit_ref_reg(A_MOV,S_L,newreference(
  868. left.location.reference),hregister);
  869. hr:=newreference(left.location.reference);
  870. inc(hr^.offset,4);
  871. emit_ref_reg(A_MOV,S_L,hr,hregister2);
  872. end
  873. else
  874. emit_ref_reg(A_MOV,opsize,newreference(
  875. left.location.reference),hregister);
  876. end;
  877. else internalerror(2002);
  878. end;
  879. { we need the min_label always to choose between }
  880. { cmps and subs/decs }
  881. min_label:=case_get_min(nodes);
  882. load_all_regvars(exprasmlist);
  883. { now generate the jumps }
  884. if opsize=S_Q then
  885. genlinearcmplist(nodes)
  886. else
  887. begin
  888. if cs_optimize in aktglobalswitches then
  889. begin
  890. { procedures are empirically passed on }
  891. { consumption can also be calculated }
  892. { but does it pay on the different }
  893. { processors? }
  894. { moreover can the size only be appro- }
  895. { ximated as it is not known if rel8, }
  896. { rel16 or rel32 jumps are used }
  897. max_label:=case_get_max(nodes);
  898. labels:=case_count_labels(nodes);
  899. { can we omit the range check of the jump table ? }
  900. getrange(left.resulttype.def,lv,hv);
  901. jumptable_no_range:=(lv=min_label) and (hv=max_label);
  902. { hack a little bit, because the range can be greater }
  903. { than the positive range of a longint }
  904. if (min_label<0) and (max_label>0) then
  905. begin
  906. {$ifdef Delphi}
  907. if min_label=longint($80000000) then
  908. dist:=Cardinal(max_label)+Cardinal($80000000)
  909. else
  910. dist:=Cardinal(max_label)+Cardinal(-min_label)
  911. {$else Delphi}
  912. if min_label=$80000000 then
  913. dist:=dword(max_label)+dword($80000000)
  914. else
  915. dist:=dword(max_label)+dword(-min_label)
  916. {$endif Delphi}
  917. end
  918. else
  919. dist:=max_label-min_label;
  920. { optimize for size ? }
  921. if cs_littlesize in aktglobalswitches then
  922. begin
  923. if (labels<=2) or
  924. ((max_label-min_label)<0) or
  925. ((max_label-min_label)>3*labels) then
  926. { a linear list is always smaller than a jump tree }
  927. genlinearlist(nodes)
  928. else
  929. { if the labels less or more a continuum then }
  930. genjumptable(nodes,min_label,max_label);
  931. end
  932. else
  933. begin
  934. if jumptable_no_range then
  935. max_linear_list:=4
  936. else
  937. max_linear_list:=2;
  938. { a jump table crashes the pipeline! }
  939. if aktoptprocessor=Class386 then
  940. inc(max_linear_list,3);
  941. if aktoptprocessor=ClassP5 then
  942. inc(max_linear_list,6);
  943. if aktoptprocessor>=ClassP6 then
  944. inc(max_linear_list,9);
  945. if (labels<=max_linear_list) then
  946. genlinearlist(nodes)
  947. else
  948. begin
  949. if (dist>4*cardinal(labels)) then
  950. begin
  951. if labels>16 then
  952. gentreejmp(nodes)
  953. else
  954. genlinearlist(nodes);
  955. end
  956. else
  957. genjumptable(nodes,min_label,max_label);
  958. end;
  959. end;
  960. end
  961. else
  962. { it's always not bad }
  963. genlinearlist(nodes);
  964. end;
  965. ungetregister(hregister);
  966. { now generate the instructions }
  967. hp:=right;
  968. while assigned(hp) do
  969. begin
  970. cleartempgen;
  971. secondpass(tbinarynode(hp).right);
  972. { don't come back to case line }
  973. aktfilepos:=exprasmList.getlasttaifilepos^;
  974. load_all_regvars(exprasmlist);
  975. emitjmp(C_None,endlabel);
  976. hp:=tbinarynode(hp).left;
  977. end;
  978. emitlab(elselabel);
  979. { ...and the else block }
  980. if assigned(elseblock) then
  981. begin
  982. cleartempgen;
  983. secondpass(elseblock);
  984. load_all_regvars(exprasmlist);
  985. end;
  986. emitlab(endlabel);
  987. end;
  988. begin
  989. csetelementnode:=ti386setelementnode;
  990. cinnode:=ti386innode;
  991. ccasenode:=ti386casenode;
  992. end.
  993. {
  994. $Log$
  995. Revision 1.14 2001-04-13 01:22:19 peter
  996. * symtable change to classes
  997. * range check generation and errors fixed, make cycle DEBUG=1 works
  998. * memory leaks fixed
  999. Revision 1.13 2001/04/06 14:09:34 jonas
  1000. * fixed bug in ti386innode.pass_2 code and made it simpler/faster
  1001. Revision 1.12 2001/04/02 21:20:38 peter
  1002. * resulttype rewrite
  1003. Revision 1.11 2001/02/11 12:14:56 jonas
  1004. * simplified and optimized code generated for in-statements
  1005. Revision 1.10 2000/12/25 00:07:33 peter
  1006. + new tlinkedlist class (merge of old tstringqueue,tcontainer and
  1007. tlinkedlist objects)
  1008. Revision 1.9 2000/12/18 17:45:32 jonas
  1009. * int64 case fixes
  1010. * explicit longint type casts for constants used in assembler code
  1011. generation s,ice they can be cardinals too (or even int64's in case of
  1012. range check errors)
  1013. Revision 1.8 2000/12/16 15:58:18 jonas
  1014. * removed warnings about possible range check errors
  1015. Revision 1.7 2000/12/05 11:44:34 jonas
  1016. + new integer regvar handling, should be much more efficient
  1017. Revision 1.6 2000/11/29 00:30:49 florian
  1018. * unused units removed from uses clause
  1019. * some changes for widestrings
  1020. Revision 1.5 2000/11/17 14:09:00 jonas
  1021. * fixed webbug 1222 ("merged")
  1022. Revision 1.4 2000/11/13 14:44:36 jonas
  1023. * fixes so no more range errors with improved range checking code
  1024. Revision 1.3 2000/10/31 22:02:57 peter
  1025. * symtable splitted, no real code changes
  1026. Revision 1.2 2000/10/26 15:53:27 jonas
  1027. * fixed web bug1192 (changed an ungetregister32 to ungetregister)
  1028. ("merged" from fixes)
  1029. Revision 1.1 2000/10/15 09:33:32 peter
  1030. * moved n386*.pas to i386/ cpu_target dir
  1031. Revision 1.4 2000/10/14 10:14:49 peter
  1032. * moehrendorf oct 2000 rewrite
  1033. Revision 1.3 2000/09/30 16:08:45 peter
  1034. * more cg11 updates
  1035. Revision 1.2 2000/09/24 20:17:44 florian
  1036. * more conversion work done
  1037. Revision 1.1 2000/09/24 19:38:39 florian
  1038. * initial implementation
  1039. }