n386set.pas 44 KB

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