ncgset.pas 36 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931
  1. {
  2. $Id$
  3. Copyright (c) 1998-2002 by Florian Klaempfl and Carl Eric Codere
  4. Generate generic assembler for in set/case labels
  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 ncgset;
  19. {$i fpcdefs.inc}
  20. interface
  21. uses
  22. globtype,globals,
  23. node,nset,cpubase,cgbase,cgobj,aasmbase,aasmtai;
  24. type
  25. tcgsetelementnode = class(tsetelementnode)
  26. procedure pass_2;override;
  27. end;
  28. tcginnode = class(tinnode)
  29. procedure pass_2;override;
  30. protected
  31. {# Routine to test bitnumber in bitnumber register on value
  32. in value register. The __result register should be set
  33. to one if the bit is set, otherwise __result register
  34. should be set to zero.
  35. Should be overriden on processors which have specific
  36. instructions to do bit tests.
  37. }
  38. procedure emit_bit_test_reg_reg(list : taasmoutput;
  39. bitsize: tcgsize; bitnumber,value : tregister;
  40. ressize: tcgsize; res :tregister);virtual;
  41. end;
  42. tcgcasenode = class(tcasenode)
  43. {
  44. Emits the case node statement. Contrary to the intel
  45. 80x86 version, this version does not emit jump tables,
  46. because of portability problems.
  47. }
  48. procedure pass_2;override;
  49. protected
  50. with_sign : boolean;
  51. opsize : tcgsize;
  52. jmp_gt,jmp_lt,jmp_le : topcmp;
  53. { register with case expression }
  54. hregister,hregister2 : tregister;
  55. endlabel,elselabel : tasmlabel;
  56. { true, if we can omit the range check of the jump table }
  57. jumptable_no_range : boolean;
  58. { has the implementation jumptable support }
  59. min_label : tconstexprint;
  60. function blocklabel(id:longint):tasmlabel;
  61. procedure optimizevalues(var max_linear_list:aint;var max_dist:aword);virtual;
  62. function has_jumptable : boolean;virtual;
  63. procedure genjumptable(hp : pcaselabel;min_,max_ : aint); virtual;
  64. procedure genlinearlist(hp : pcaselabel); virtual;
  65. procedure genlinearcmplist(hp : pcaselabel); virtual;
  66. end;
  67. implementation
  68. uses
  69. systems,
  70. verbose,
  71. symconst,symdef,defutil,
  72. paramgr,
  73. pass_2,tgobj,
  74. nbas,ncon,nflw,
  75. ncgutil,regvars,
  76. cgutils;
  77. {*****************************************************************************
  78. TCGSETELEMENTNODE
  79. *****************************************************************************}
  80. procedure tcgsetelementnode.pass_2;
  81. begin
  82. { load first value in 32bit register }
  83. secondpass(left);
  84. if left.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
  85. location_force_reg(exprasmlist,left.location,OS_32,false);
  86. { also a second value ? }
  87. if assigned(right) then
  88. begin
  89. secondpass(right);
  90. if codegenerror then
  91. exit;
  92. if right.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
  93. location_force_reg(exprasmlist,right.location,OS_32,false);
  94. end;
  95. { we doesn't modify the left side, we check only the type }
  96. location_copy(location,left.location);
  97. end;
  98. {*****************************************************************************
  99. *****************************************************************************}
  100. {**********************************************************************}
  101. { Description: Emit operation to do a bit test, where the bitnumber }
  102. { to test is in the bitnumber register. The value to test against is }
  103. { located in the value register. }
  104. { WARNING: Bitnumber register value is DESTROYED! }
  105. { __Result register is set to 1, if the bit is set otherwise, __Result}
  106. { is set to zero. __RESULT register is also used as scratch. }
  107. {**********************************************************************}
  108. procedure tcginnode.emit_bit_test_reg_reg(list : taasmoutput;
  109. bitsize: tcgsize; bitnumber,value : tregister;
  110. ressize: tcgsize; res :tregister);
  111. begin
  112. { first make sure that the bit number is modulo 32 }
  113. { not necessary, since if it's > 31, we have a range error -> will }
  114. { be caught when range checking is on! (JM) }
  115. { cg.a_op_const_reg(list,OP_AND,31,bitnumber); }
  116. if bitsize<>ressize then
  117. begin
  118. { FIX ME! We're not allowed to modify the value register here! }
  119. { shift value register "bitnumber" bits to the right }
  120. cg.a_op_reg_reg(list,OP_SHR,bitsize,bitnumber,value);
  121. { extract the bit we want }
  122. cg.a_op_const_reg(list,OP_AND,bitsize,1,value);
  123. cg.a_load_reg_reg(list,bitsize,ressize,value,res);
  124. end
  125. else
  126. begin
  127. { rotate value register "bitnumber" bits to the right }
  128. cg.a_op_reg_reg_reg(list,OP_SHR,bitsize,bitnumber,value,res);
  129. { extract the bit we want }
  130. cg.a_op_const_reg(list,OP_AND,bitsize,1,res);
  131. end;
  132. end;
  133. procedure tcginnode.pass_2;
  134. type
  135. Tsetpart=record
  136. range : boolean; {Part is a range.}
  137. start,stop : byte; {Start/stop when range; Stop=element when an element.}
  138. end;
  139. var
  140. l,l3 : tasmlabel;
  141. adjustment : aint;
  142. href : treference;
  143. hr,hr2,
  144. pleftreg : tregister;
  145. setparts : array[1..8] of Tsetpart;
  146. opsize : tcgsize;
  147. genjumps,
  148. use_small : boolean;
  149. i,numparts : byte;
  150. function analizeset(const Aset:Tconstset;is_small:boolean):boolean;
  151. var
  152. compares,maxcompares:word;
  153. i:byte;
  154. begin
  155. analizeset:=false;
  156. numparts:=0;
  157. compares:=0;
  158. { Lots of comparisions take a lot of time, so do not allow
  159. too much comparisions. 8 comparisions are, however, still
  160. smalller than emitting the set }
  161. if cs_littlesize in aktglobalswitches then
  162. maxcompares:=8
  163. else
  164. maxcompares:=5;
  165. { when smallset is possible allow only 3 compares the smallset
  166. code is for littlesize also smaller when more compares are used }
  167. if is_small then
  168. maxcompares:=3;
  169. for i:=0 to 255 do
  170. if i in Aset then
  171. begin
  172. if (numparts=0) or (i<>setparts[numparts].stop+1) then
  173. begin
  174. {Set element is a separate element.}
  175. inc(compares);
  176. if compares>maxcompares then
  177. exit;
  178. inc(numparts);
  179. setparts[numparts].range:=false;
  180. setparts[numparts].stop:=i;
  181. end
  182. else
  183. {Set element is part of a range.}
  184. if not setparts[numparts].range then
  185. begin
  186. {Transform an element into a range.}
  187. setparts[numparts].range:=true;
  188. setparts[numparts].start:=setparts[numparts].stop;
  189. setparts[numparts].stop:=i;
  190. { there's only one compare per range anymore. Only a }
  191. { sub is added, but that's much faster than a }
  192. { cmp/jcc combo so neglect its effect }
  193. { inc(compares);
  194. if compares>maxcompares then
  195. exit; }
  196. end
  197. else
  198. begin
  199. {Extend a range.}
  200. setparts[numparts].stop:=i;
  201. end;
  202. end;
  203. analizeset:=true;
  204. end;
  205. begin
  206. { We check first if we can generate jumps, this can be done
  207. because the resulttype.def is already set in firstpass }
  208. { check if we can use smallset operation using btl which is limited
  209. to 32 bits, the left side may also not contain higher values !! }
  210. use_small:=(tsetdef(right.resulttype.def).settype=smallset) and
  211. ((left.resulttype.def.deftype=orddef) and (torddef(left.resulttype.def).high<=32) or
  212. (left.resulttype.def.deftype=enumdef) and (tenumdef(left.resulttype.def).max<=32));
  213. { Can we generate jumps? Possible for all types of sets }
  214. genjumps:=(right.nodetype=setconstn) and
  215. analizeset(Tsetconstnode(right).value_set^,use_small);
  216. opsize:=OS_32;
  217. { calculate both operators }
  218. { the complex one first }
  219. firstcomplex(self);
  220. secondpass(left);
  221. { Only process the right if we are not generating jumps }
  222. if not genjumps then
  223. secondpass(right);
  224. if codegenerror then
  225. exit;
  226. { ofcourse not commutative }
  227. if nf_swaped in flags then
  228. swapleftright;
  229. { location is always LOC_JUMP }
  230. location_reset(location,LOC_REGISTER,def_cgsize(resulttype.def));
  231. if genjumps then
  232. begin
  233. { allocate a register for the result }
  234. location.register := cg.getintregister(exprasmlist,location.size);
  235. { Get a label to jump to the end }
  236. objectlibrary.getlabel(l);
  237. { clear the register value, indicating result is FALSE }
  238. cg.a_load_const_reg(exprasmlist,location.size,0,location.register);
  239. { If register is used, use only lower 8 bits }
  240. location_force_reg(exprasmlist,left.location,opsize,false);
  241. pleftreg := left.location.register;
  242. { how much have we already substracted from the x in the }
  243. { "x in [y..z]" expression }
  244. adjustment := 0;
  245. hr:=NR_NO;
  246. for i:=1 to numparts do
  247. if setparts[i].range then
  248. { use fact that a <= x <= b <=> aword(x-a) <= aword(b-a) }
  249. begin
  250. { is the range different from all legal values? }
  251. if (setparts[i].stop-setparts[i].start <> 255) then
  252. begin
  253. { yes, is the lower bound <> 0? }
  254. if (setparts[i].start <> 0) then
  255. { we're going to substract from the left register, }
  256. { so in case of a LOC_CREGISTER first move the value }
  257. { to edi (not done before because now we can do the }
  258. { move and substract in one instruction with LEA) }
  259. if (left.location.loc = LOC_CREGISTER) and
  260. (hr<>pleftreg) then
  261. begin
  262. cg.a_op_const_reg(exprasmlist,OP_SUB,opsize,setparts[i].start,pleftreg);
  263. hr:=cg.getintregister(exprasmlist,opsize);
  264. cg.a_load_reg_reg(exprasmlist,opsize,opsize,pleftreg,hr);
  265. pleftreg:=hr;
  266. end
  267. else
  268. begin
  269. { otherwise, the value is already in a register }
  270. { that can be modified }
  271. cg.a_op_const_reg(exprasmlist,OP_SUB,opsize,
  272. setparts[i].start-adjustment,pleftreg)
  273. end;
  274. { new total value substracted from x: }
  275. { adjustment + (setparts[i].start - adjustment) }
  276. adjustment := setparts[i].start;
  277. { check if result < b-a+1 (not "result <= b-a", since }
  278. { we need a carry in case the element is in the range }
  279. { (this will never overflow since we check at the }
  280. { beginning whether stop-start <> 255) }
  281. cg.a_cmp_const_reg_label(exprasmlist, opsize, OC_B,
  282. setparts[i].stop-setparts[i].start+1,pleftreg,l);
  283. end
  284. else
  285. { if setparts[i].start = 0 and setparts[i].stop = 255, }
  286. { it's always true since "in" is only allowed for bytes }
  287. begin
  288. cg.a_jmp_always(exprasmlist,l);
  289. end;
  290. end
  291. else
  292. begin
  293. { Emit code to check if left is an element }
  294. cg.a_cmp_const_reg_label(exprasmlist, opsize, OC_EQ,
  295. setparts[i].stop-adjustment,pleftreg,l);
  296. end;
  297. { To compensate for not doing a second pass }
  298. right.location.reference.symbol:=nil;
  299. objectlibrary.getlabel(l3);
  300. cg.a_jmp_always(exprasmlist,l3);
  301. { Now place the end label if IN success }
  302. cg.a_label(exprasmlist,l);
  303. { result register is 1 }
  304. cg.a_load_const_reg(exprasmlist,location.size,1,location.register);
  305. { in case value is not found }
  306. cg.a_label(exprasmlist,l3);
  307. end
  308. else
  309. {*****************************************************************}
  310. { NO JUMP TABLE GENERATION }
  311. {*****************************************************************}
  312. begin
  313. { We will now generated code to check the set itself, no jmps,
  314. handle smallsets separate, because it allows faster checks }
  315. if use_small then
  316. begin
  317. {**************************** SMALL SET **********************}
  318. if left.nodetype=ordconstn then
  319. begin
  320. location_force_reg(exprasmlist,right.location,opsize,true);
  321. location.register:=cg.getintregister(exprasmlist,location.size);
  322. { first SHR the register }
  323. cg.a_op_const_reg_reg(exprasmlist,OP_SHR,opsize,tordconstnode(left).value and 31,right.location.register,location.register);
  324. { then extract the lowest bit }
  325. cg.a_op_const_reg(exprasmlist,OP_AND,opsize,1,location.register);
  326. end
  327. else
  328. begin
  329. location_force_reg(exprasmlist,left.location,opsize,false);
  330. location_force_reg(exprasmlist,right.location,opsize,false);
  331. { allocate a register for the result }
  332. location.register:=cg.getintregister(exprasmlist,location.size);
  333. { emit bit test operation }
  334. emit_bit_test_reg_reg(exprasmlist,left.location.size,left.location.register,
  335. right.location.register,location.size,location.register);
  336. end;
  337. end
  338. else
  339. {************************** NOT SMALL SET ********************}
  340. begin
  341. if right.location.loc=LOC_CONSTANT then
  342. begin
  343. { can it actually occur currently? CEC }
  344. { yes: "if bytevar in [1,3,5,7,9,11,13,15]" (JM) }
  345. { note: this code assumes that left in [0..255], which is a valid }
  346. { assumption (other cases will be caught by range checking) (JM) }
  347. { load left in register }
  348. location_force_reg(exprasmlist,left.location,opsize,true);
  349. if left.location.loc = LOC_CREGISTER then
  350. hr := cg.getintregister(exprasmlist,opsize)
  351. else
  352. hr := left.location.register;
  353. { load right in register }
  354. hr2:=cg.getintregister(exprasmlist,opsize);
  355. cg.a_load_const_reg(exprasmlist,opsize,right.location.value,hr2);
  356. { emit bit test operation }
  357. emit_bit_test_reg_reg(exprasmlist,left.location.size,left.location.register,hr2,opsize,hr2);
  358. { if left > 31 then hr := 0 else hr := $ffffffff }
  359. cg.a_op_const_reg_reg(exprasmlist,OP_SUB,opsize,32,left.location.register,hr);
  360. cg.a_op_const_reg(exprasmlist,OP_SAR,opsize,31,hr);
  361. { if left > 31, then result := 0 else result := result of bit test }
  362. cg.a_op_reg_reg(exprasmlist,OP_AND,opsize,hr,hr2);
  363. { allocate a register for the result }
  364. location.register := cg.getintregister(exprasmlist,location.size);
  365. cg.a_load_reg_reg(exprasmlist,opsize,location.size,hr2,location.register);
  366. end { of right.location.loc=LOC_CONSTANT }
  367. { do search in a normal set which could have >32 elementsm
  368. but also used if the left side contains higher values > 32 }
  369. else if left.nodetype=ordconstn then
  370. begin
  371. { use location.register as scratch register here }
  372. if (target_info.endian = endian_little) then
  373. inc(right.location.reference.offset,tordconstnode(left).value shr 3)
  374. else
  375. { adjust for endianess differences }
  376. inc(right.location.reference.offset,(tordconstnode(left).value shr 3) xor 3);
  377. { allocate a register for the result }
  378. location.register := cg.getintregister(exprasmlist,location.size);
  379. cg.a_load_ref_reg(exprasmlist,OS_8,location.size,right.location.reference, location.register);
  380. cg.a_op_const_reg(exprasmlist,OP_SHR,location.size,tordconstnode(left).value and 7,
  381. location.register);
  382. cg.a_op_const_reg(exprasmlist,OP_AND,location.size,1,location.register);
  383. end
  384. else
  385. begin
  386. location_force_reg(exprasmlist,left.location,OS_INT,true);
  387. pleftreg := left.location.register;
  388. location_freetemp(exprasmlist,left.location);
  389. hr := cg.getaddressregister(exprasmlist);
  390. cg.a_op_const_reg_reg(exprasmlist,OP_SHR,OS_INT,5,pleftreg,hr);
  391. cg.a_op_const_reg(exprasmlist,OP_SHL,OS_INT,2,hr);
  392. href := right.location.reference;
  393. if (href.base = NR_NO) then
  394. href.base := hr
  395. else if (right.location.reference.index = NR_NO) then
  396. href.index := hr
  397. else
  398. begin
  399. hr2 := cg.getaddressregister(exprasmlist);
  400. cg.a_loadaddr_ref_reg(exprasmlist,href, hr2);
  401. reference_reset_base(href,hr2,0);
  402. href.index := hr;
  403. end;
  404. { allocate a register for the result }
  405. location.register := cg.getintregister(exprasmlist,opsize);
  406. cg.a_load_ref_reg(exprasmlist,opsize,opsize,href,location.register);
  407. hr := cg.getintregister(exprasmlist,opsize);
  408. cg.a_op_const_reg_reg(exprasmlist,OP_AND,opsize,31,pleftreg,hr);
  409. cg.a_op_reg_reg(exprasmlist,OP_SHR,opsize,hr,location.register);
  410. cg.a_op_const_reg(exprasmlist,OP_AND,opsize,1,location.register);
  411. end;
  412. end;
  413. end;
  414. location_freetemp(exprasmlist,right.location);
  415. end;
  416. {*****************************************************************************
  417. TCGCASENODE
  418. *****************************************************************************}
  419. function tcgcasenode.blocklabel(id:longint):tasmlabel;
  420. begin
  421. if not assigned(blocks[id]) then
  422. internalerror(200411301);
  423. result:=pcaseblock(blocks[id])^.blocklabel;
  424. end;
  425. procedure tcgcasenode.optimizevalues(var max_linear_list:aint;var max_dist:aword);
  426. begin
  427. { no changes by default }
  428. end;
  429. function tcgcasenode.has_jumptable : boolean;
  430. begin
  431. { No jumptable support in the default implementation }
  432. has_jumptable:=false;
  433. end;
  434. procedure tcgcasenode.genjumptable(hp : pcaselabel;min_,max_ : aint);
  435. begin
  436. internalerror(200209161);
  437. end;
  438. procedure tcgcasenode.genlinearlist(hp : pcaselabel);
  439. var
  440. first : boolean;
  441. last : TConstExprInt;
  442. scratch_reg: tregister;
  443. procedure genitem(t : pcaselabel);
  444. procedure gensub(value:aint);
  445. begin
  446. { here, since the sub and cmp are separate we need
  447. to move the result before subtract to a help
  448. register.
  449. }
  450. cg.a_load_reg_reg(exprasmlist, opsize, opsize, hregister, scratch_reg);
  451. cg.a_op_const_reg(exprasmlist, OP_SUB, opsize, value, hregister);
  452. end;
  453. begin
  454. if assigned(t^.less) then
  455. genitem(t^.less);
  456. { need we to test the first value }
  457. if first and (t^._low>get_min_value(left.resulttype.def)) then
  458. cg.a_cmp_const_reg_label(exprasmlist,opsize,jmp_lt,aint(t^._low),hregister,elselabel);
  459. if t^._low=t^._high then
  460. begin
  461. if t^._low-last=0 then
  462. cg.a_cmp_const_reg_label(exprasmlist, opsize, OC_EQ,0,hregister,blocklabel(t^.blockid))
  463. else
  464. begin
  465. gensub(aint(t^._low-last));
  466. cg.a_cmp_const_reg_label(exprasmlist, opsize, OC_EQ,aint(t^._low-last),scratch_reg,blocklabel(t^.blockid));
  467. end;
  468. last:=t^._low;
  469. end
  470. else
  471. begin
  472. { it begins with the smallest label, if the value }
  473. { is even smaller then jump immediately to the }
  474. { ELSE-label }
  475. if first then
  476. begin
  477. { have we to ajust the first value ? }
  478. if (t^._low>get_min_value(left.resulttype.def)) then
  479. gensub(aint(t^._low));
  480. end
  481. else
  482. begin
  483. { if there is no unused label between the last and the }
  484. { present label then the lower limit can be checked }
  485. { immediately. else check the range in between: }
  486. gensub(aint(t^._low-last));
  487. cg.a_cmp_const_reg_label(exprasmlist, opsize,jmp_lt,aint(t^._low-last),scratch_reg,elselabel);
  488. end;
  489. gensub(aint(t^._high-t^._low));
  490. cg.a_cmp_const_reg_label(exprasmlist, opsize,jmp_le,aint(t^._high-t^._low),scratch_reg,blocklabel(t^.blockid));
  491. last:=t^._high;
  492. end;
  493. first:=false;
  494. if assigned(t^.greater) then
  495. genitem(t^.greater);
  496. end;
  497. begin
  498. { do we need to generate cmps? }
  499. if (with_sign and (min_label<0)) then
  500. genlinearcmplist(hp)
  501. else
  502. begin
  503. last:=0;
  504. first:=true;
  505. scratch_reg:=cg.getintregister(exprasmlist,opsize);
  506. genitem(hp);
  507. cg.a_jmp_always(exprasmlist,elselabel);
  508. end;
  509. end;
  510. procedure tcgcasenode.genlinearcmplist(hp : pcaselabel);
  511. var
  512. last : TConstExprInt;
  513. lastwasrange: boolean;
  514. procedure genitem(t : pcaselabel);
  515. {$ifndef cpu64bit}
  516. var
  517. l1 : tasmlabel;
  518. {$endif cpu64bit}
  519. begin
  520. if assigned(t^.less) then
  521. genitem(t^.less);
  522. if t^._low=t^._high then
  523. begin
  524. {$ifndef cpu64bit}
  525. if opsize in [OS_S64,OS_64] then
  526. begin
  527. objectlibrary.getlabel(l1);
  528. cg.a_cmp_const_reg_label(exprasmlist, OS_32, OC_NE, aint(hi(int64(t^._low))),hregister2,l1);
  529. cg.a_cmp_const_reg_label(exprasmlist, OS_32, OC_EQ, aint(lo(int64(t^._low))),hregister, blocklabel(t^.blockid));
  530. cg.a_label(exprasmlist,l1);
  531. end
  532. else
  533. {$endif cpu64bit}
  534. begin
  535. cg.a_cmp_const_reg_label(exprasmlist, opsize, OC_EQ, aint(t^._low),hregister, blocklabel(t^.blockid));
  536. end;
  537. { Reset last here, because we've only checked for one value and need to compare
  538. for the next range both the lower and upper bound }
  539. lastwasrange := false;
  540. end
  541. else
  542. begin
  543. { it begins with the smallest label, if the value }
  544. { is even smaller then jump immediately to the }
  545. { ELSE-label }
  546. if not lastwasrange or (t^._low-last>1) then
  547. begin
  548. {$ifndef cpu64bit}
  549. if opsize in [OS_64,OS_S64] then
  550. begin
  551. objectlibrary.getlabel(l1);
  552. cg.a_cmp_const_reg_label(exprasmlist, OS_32, jmp_lt, aint(hi(int64(t^._low))),
  553. hregister2, elselabel);
  554. cg.a_cmp_const_reg_label(exprasmlist, OS_32, jmp_gt, aint(hi(int64(t^._low))),
  555. hregister2, l1);
  556. { the comparisation of the low dword must be always unsigned! }
  557. cg.a_cmp_const_reg_label(exprasmlist, OS_32, OC_B, aint(lo(int64(t^._low))), hregister, elselabel);
  558. cg.a_label(exprasmlist,l1);
  559. end
  560. else
  561. {$endif cpu64bit}
  562. begin
  563. cg.a_cmp_const_reg_label(exprasmlist, opsize, jmp_lt, aint(t^._low), hregister,
  564. elselabel);
  565. end;
  566. end;
  567. {$ifndef cpu64bit}
  568. if opsize in [OS_S64,OS_64] then
  569. begin
  570. objectlibrary.getlabel(l1);
  571. cg.a_cmp_const_reg_label(exprasmlist, OS_32, jmp_lt, aint(hi(int64(t^._high))), hregister2,
  572. blocklabel(t^.blockid));
  573. cg.a_cmp_const_reg_label(exprasmlist, OS_32, jmp_gt, aint(hi(int64(t^._high))), hregister2,
  574. l1);
  575. cg.a_cmp_const_reg_label(exprasmlist, OS_32, OC_BE, aint(lo(int64(t^._high))), hregister, blocklabel(t^.blockid));
  576. cg.a_label(exprasmlist,l1);
  577. end
  578. else
  579. {$endif cpu64bit}
  580. begin
  581. cg.a_cmp_const_reg_label(exprasmlist, opsize, jmp_le, aint(t^._high), hregister, blocklabel(t^.blockid));
  582. end;
  583. last:=t^._high;
  584. lastwasrange := true;
  585. end;
  586. if assigned(t^.greater) then
  587. genitem(t^.greater);
  588. end;
  589. begin
  590. last:=0;
  591. lastwasrange:=false;
  592. genitem(hp);
  593. cg.a_jmp_always(exprasmlist,elselabel);
  594. end;
  595. procedure ReLabel(var p:tasmsymbol);
  596. begin
  597. if p.defbind = AB_LOCAL then
  598. begin
  599. if not assigned(p.altsymbol) then
  600. objectlibrary.GenerateAltSymbol(p);
  601. p:=p.altsymbol;
  602. p.increfs;
  603. end;
  604. end;
  605. procedure tcgcasenode.pass_2;
  606. var
  607. i : longint;
  608. lv,hv,
  609. max_label: tconstexprint;
  610. labelcnt : aint;
  611. max_linear_list : aint;
  612. otl, ofl: tasmlabel;
  613. isjump : boolean;
  614. max_dist,
  615. dist : aword;
  616. begin
  617. location_reset(location,LOC_VOID,OS_NO);
  618. { Allocate labels }
  619. objectlibrary.getlabel(endlabel);
  620. objectlibrary.getlabel(elselabel);
  621. for i:=0 to blocks.count-1 do
  622. objectlibrary.getlabel(pcaseblock(blocks[i])^.blocklabel);
  623. with_sign:=is_signed(left.resulttype.def);
  624. if with_sign then
  625. begin
  626. jmp_gt:=OC_GT;
  627. jmp_lt:=OC_LT;
  628. jmp_le:=OC_LTE;
  629. end
  630. else
  631. begin
  632. jmp_gt:=OC_A;
  633. jmp_lt:=OC_B;
  634. jmp_le:=OC_BE;
  635. end;
  636. { save current truelabel and falselabel }
  637. isjump:=false;
  638. if left.location.loc=LOC_JUMP then
  639. begin
  640. otl:=truelabel;
  641. objectlibrary.getlabel(truelabel);
  642. ofl:=falselabel;
  643. objectlibrary.getlabel(falselabel);
  644. isjump:=true;
  645. end;
  646. secondpass(left);
  647. { determines the size of the operand }
  648. opsize:=def_cgsize(left.resulttype.def);
  649. { copy the case expression to a register }
  650. location_force_reg(exprasmlist,left.location,opsize,false);
  651. {$ifndef cpu64bit}
  652. if opsize in [OS_S64,OS_64] then
  653. begin
  654. hregister:=left.location.register64.reglo;
  655. hregister2:=left.location.register64.reghi;
  656. end
  657. else
  658. {$endif cpu64bit}
  659. hregister:=left.location.register;
  660. if isjump then
  661. begin
  662. truelabel:=otl;
  663. falselabel:=ofl;
  664. end;
  665. { we need the min_label always to choose between }
  666. { cmps and subs/decs }
  667. min_label:=case_get_min(labels);
  668. { Generate the jumps }
  669. {$ifdef OLDREGVARS}
  670. load_all_regvars(exprasmlist);
  671. {$endif OLDREGVARS}
  672. {$ifndef cpu64bit}
  673. if opsize in [OS_64,OS_S64] then
  674. genlinearcmplist(labels)
  675. else
  676. {$endif cpu64bit}
  677. begin
  678. if cs_optimize in aktglobalswitches then
  679. begin
  680. { procedures are empirically passed on }
  681. { consumption can also be calculated }
  682. { but does it pay on the different }
  683. { processors? }
  684. { moreover can the size only be appro- }
  685. { ximated as it is not known if rel8, }
  686. { rel16 or rel32 jumps are used }
  687. max_label:=case_get_max(labels);
  688. labelcnt:=case_count_labels(labels);
  689. { can we omit the range check of the jump table ? }
  690. getrange(left.resulttype.def,lv,hv);
  691. jumptable_no_range:=(lv=min_label) and (hv=max_label);
  692. { hack a little bit, because the range can be greater }
  693. { than the positive range of a aint }
  694. if (min_label<0) and (max_label>0) then
  695. begin
  696. if min_label=TConstExprInt(low(aint)) then
  697. dist:=aword(max_label)+aword(low(aint))
  698. else
  699. dist:=aword(max_label)+aword(-min_label)
  700. end
  701. else
  702. dist:=max_label-min_label;
  703. { optimize for size ? }
  704. if cs_littlesize in aktglobalswitches then
  705. begin
  706. if has_jumptable and
  707. not((labelcnt<=2) or
  708. ((max_label-min_label)<0) or
  709. ((max_label-min_label)>3*labelcnt)) then
  710. begin
  711. { if the labels less or more a continuum then }
  712. genjumptable(labels,min_label,max_label);
  713. end
  714. else
  715. begin
  716. { a linear list is always smaller than a jump tree }
  717. genlinearlist(labels);
  718. end;
  719. end
  720. else
  721. begin
  722. max_dist:=4*labelcnt;
  723. if jumptable_no_range then
  724. max_linear_list:=4
  725. else
  726. max_linear_list:=2;
  727. { allow processor specific values }
  728. optimizevalues(max_linear_list,max_dist);
  729. if (labelcnt<=max_linear_list) then
  730. genlinearlist(labels)
  731. else
  732. begin
  733. if (has_jumptable) and
  734. (dist<max_dist) and
  735. (min_label>=low(aint)) and
  736. (max_label<=high(aint)) then
  737. genjumptable(labels,min_label,max_label)
  738. else
  739. genlinearlist(labels);
  740. end;
  741. end;
  742. end
  743. else
  744. { it's always not bad }
  745. genlinearlist(labels);
  746. end;
  747. { generate the instruction blocks }
  748. for i:=0 to blocks.count-1 do
  749. begin
  750. cg.a_label(exprasmlist,pcaseblock(blocks[i])^.blocklabel);
  751. secondpass(pcaseblock(blocks[i])^.statement);
  752. { don't come back to case line }
  753. aktfilepos:=exprasmList.getlasttaifilepos^;
  754. {$ifdef OLDREGVARS}
  755. load_all_regvars(exprasmlist);
  756. {$endif OLDREGVARS}
  757. cg.a_jmp_always(exprasmlist,endlabel);
  758. end;
  759. { ...and the else block }
  760. cg.a_label(exprasmlist,elselabel);
  761. if assigned(elseblock) then
  762. begin
  763. secondpass(elseblock);
  764. {$ifdef OLDREGVARS}
  765. load_all_regvars(exprasmlist);
  766. {$endif OLDREGVARS}
  767. end;
  768. cg.a_label(exprasmlist,endlabel);
  769. { Reset labels }
  770. for i:=0 to blocks.count-1 do
  771. pcaseblock(blocks[i])^.blocklabel:=nil;
  772. end;
  773. begin
  774. csetelementnode:=tcgsetelementnode;
  775. cinnode:=tcginnode;
  776. ccasenode:=tcgcasenode;
  777. end.
  778. {
  779. $Log$
  780. Revision 1.73 2004-12-11 01:04:26 jonas
  781. * fixed regvar problem due to emit_bit_test() changing a register that
  782. was allowed to be a LOC_CREGISTER
  783. Revision 1.72 2004/12/05 12:28:11 peter
  784. * procvar handling for tp procvar mode fixed
  785. * proc to procvar moved from addrnode to typeconvnode
  786. * inlininginfo is now allocated only for inline routines that
  787. can be inlined, introduced a new flag po_has_inlining_info
  788. Revision 1.71 2004/11/30 18:13:39 jonas
  789. * patch from Peter to fix inlining of case statements
  790. Revision 1.70 2004/10/31 21:45:03 peter
  791. * generic tlocation
  792. * move tlocation to cgutils
  793. Revision 1.69 2004/10/30 22:01:11 florian
  794. * jmp table code generation for case statement on sparc
  795. Revision 1.68 2004/09/25 14:23:54 peter
  796. * ungetregister is now only used for cpuregisters, renamed to
  797. ungetcpuregister
  798. * renamed (get|unget)explicitregister(s) to ..cpuregister
  799. * removed location-release/reference_release
  800. Revision 1.67 2004/08/25 11:51:31 jonas
  801. * fixed rare case bug (see tests/test/tb0478.pp)
  802. Revision 1.66 2004/08/16 21:00:15 peter
  803. * range checks fixed
  804. Revision 1.65 2004/07/22 10:07:09 jonas
  805. * fixed relabeling (nextaltnr was never increased)
  806. * fixed inlining of case statements at the node level
  807. Revision 1.64 2004/07/04 12:38:55 jonas
  808. * fixed regvar bug in tcginnode.pass_2
  809. Revision 1.63 2004/06/20 08:55:29 florian
  810. * logs truncated
  811. Revision 1.62 2004/06/16 20:07:08 florian
  812. * dwarf branch merged
  813. Revision 1.61 2004/05/30 21:18:22 jonas
  814. * some optimizations and associated fixes for better regvar code
  815. Revision 1.60.2.5 2004/05/02 16:49:12 peter
  816. * 64 bit fixes
  817. Revision 1.60.2.4 2004/05/02 14:09:54 peter
  818. * fix case 64bit issues
  819. Revision 1.60.2.3 2004/05/01 16:02:09 peter
  820. * POINTER_SIZE replaced with sizeof(aint)
  821. * aint,aword,tconst*int moved to globtype
  822. }