ncgset.pas 42 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071
  1. {
  2. $Id$
  3. Copyright (c) 1998-2002 by Florian Klaempfl and Carl Eric Codere
  4. Generate generic 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 ncgset;
  19. {$i fpcdefs.inc}
  20. interface
  21. uses
  22. node,nset,cpubase,cginfo,cgbase,cgobj,aasmbase,aasmtai,globals;
  23. type
  24. tcgsetelementnode = class(tsetelementnode)
  25. procedure pass_2;override;
  26. end;
  27. tcginnode = class(tinnode)
  28. procedure pass_2;override;
  29. protected
  30. {# Routine to test bitnumber in bitnumber register on value
  31. in value register. The __result register should be set
  32. to one if the bit is set, otherwise __result register
  33. should be set to zero.
  34. Should be overriden on processors which have specific
  35. instructions to do bit tests.
  36. }
  37. procedure emit_bit_test_reg_reg(list : taasmoutput; bitnumber : tregister;
  38. value : tregister; __result :tregister);virtual;
  39. end;
  40. tcgcasenode = class(tcasenode)
  41. {
  42. Emits the case node statement. Contrary to the intel
  43. 80x86 version, this version does not emit jump tables,
  44. because of portability problems.
  45. }
  46. procedure pass_2;override;
  47. protected
  48. procedure optimizevalues(var max_linear_list:longint;var max_dist:cardinal);virtual;
  49. function has_jumptable : boolean;virtual;
  50. procedure genjumptable(hp : pcaserecord;min_,max_ : longint); virtual;
  51. procedure genlinearlist(hp : pcaserecord); virtual;
  52. procedure genlinearcmplist(hp : pcaserecord); virtual;
  53. procedure gentreejmp(p : pcaserecord);
  54. with_sign : boolean;
  55. opsize : tcgsize;
  56. jmp_gt,jmp_lt,jmp_le : topcmp;
  57. { register with case expression }
  58. hregister,hregister2 : tregister;
  59. endlabel,elselabel : tasmlabel;
  60. { true, if we can omit the range check of the jump table }
  61. jumptable_no_range : boolean;
  62. { has the implementation jumptable support }
  63. min_label : tconstexprint;
  64. end;
  65. implementation
  66. uses
  67. globtype,systems,
  68. verbose,
  69. symconst,symdef,defbase,
  70. paramgr,
  71. pass_2,
  72. ncon,
  73. tgobj,ncgutil,regvars,rgobj;
  74. {*****************************************************************************
  75. TCGSETELEMENTNODE
  76. *****************************************************************************}
  77. procedure tcgsetelementnode.pass_2;
  78. var
  79. pushedregs : tmaybesave;
  80. begin
  81. { load first value in 32bit register }
  82. secondpass(left);
  83. if left.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
  84. location_force_reg(exprasmlist,left.location,OS_32,false);
  85. { also a second value ? }
  86. if assigned(right) then
  87. begin
  88. maybe_save(exprasmlist,right.registers32,left.location,pushedregs);
  89. secondpass(right);
  90. if codegenerror then
  91. exit;
  92. maybe_restore(exprasmlist,left.location,pushedregs);
  93. if right.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
  94. location_force_reg(exprasmlist,right.location,OS_32,false);
  95. end;
  96. { we doesn't modify the left side, we check only the type }
  97. location_copy(location,left.location);
  98. end;
  99. {*****************************************************************************
  100. *****************************************************************************}
  101. {**********************************************************************}
  102. { Description: Emit operation to do a bit test, where the bitnumber }
  103. { to test is in the bitnumber register. The value to test against is }
  104. { located in the value register. }
  105. { WARNING: Bitnumber register value is DESTROYED! }
  106. { __Result register is set to 1, if the bit is set otherwise, __Result}
  107. { is set to zero. __RESULT register is also used as scratch. }
  108. {**********************************************************************}
  109. procedure tcginnode.emit_bit_test_reg_reg(list : taasmoutput; bitnumber : tregister; value : tregister; __result :tregister);
  110. begin
  111. { first make sure that the bit number is modulo 32 }
  112. { not necessary, since if it's > 31, we have a range error -> will }
  113. { be caught when range checking is on! (JM) }
  114. { cg.a_op_const_reg(list,OP_AND,31,bitnumber); }
  115. { rotate value register "bitnumber" bits to the right }
  116. cg.a_op_reg_reg_reg(list,OP_SHR,OS_INT,bitnumber,value,__result);
  117. { extract the bit we want }
  118. cg.a_op_const_reg(list,OP_AND,1,__result);
  119. end;
  120. procedure tcginnode.pass_2;
  121. type
  122. Tsetpart=record
  123. range : boolean; {Part is a range.}
  124. start,stop : byte; {Start/stop when range; Stop=element when an element.}
  125. end;
  126. var
  127. genjumps,
  128. use_small,
  129. ranges : boolean;
  130. hr,hr2,hr3,
  131. pleftreg : tregister;
  132. href : treference;
  133. opsize : tcgsize;
  134. setparts : array[1..8] of Tsetpart;
  135. i,numparts : byte;
  136. adjustment : longint;
  137. pushedregs : tmaybesave;
  138. l,l2,l3 : tasmlabel;
  139. {$ifdef oldset}
  140. function analizeset(Aset:Pconstset;is_small:boolean):boolean;
  141. type
  142. byteset=set of byte;
  143. {$else}
  144. function analizeset(const Aset:Tconstset;is_small:boolean):boolean;
  145. {$endif}
  146. var
  147. compares,maxcompares:word;
  148. i:byte;
  149. begin
  150. analizeset:=false;
  151. ranges:=false;
  152. numparts:=0;
  153. compares:=0;
  154. { Lots of comparisions take a lot of time, so do not allow
  155. too much comparisions. 8 comparisions are, however, still
  156. smalller than emitting the set }
  157. if cs_littlesize in aktglobalswitches then
  158. maxcompares:=8
  159. else
  160. maxcompares:=5;
  161. { when smallset is possible allow only 3 compares the smallset
  162. code is for littlesize also smaller when more compares are used }
  163. if is_small then
  164. maxcompares:=3;
  165. for i:=0 to 255 do
  166. {$ifdef oldset}
  167. if i in byteset(Aset^) then
  168. {$else}
  169. if i in Aset then
  170. {$endif}
  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. ranges := true;
  191. { there's only one compare per range anymore. Only a }
  192. { sub is added, but that's much faster than a }
  193. { cmp/jcc combo so neglect its effect }
  194. { inc(compares);
  195. if compares>maxcompares then
  196. exit; }
  197. end
  198. else
  199. begin
  200. {Extend a range.}
  201. setparts[numparts].stop:=i;
  202. end;
  203. end;
  204. analizeset:=true;
  205. end;
  206. begin
  207. { We check first if we can generate jumps, this can be done
  208. because the resulttype.def is already set in firstpass }
  209. { check if we can use smallset operation using btl which is limited
  210. to 32 bits, the left side may also not contain higher values !! }
  211. use_small:=(tsetdef(right.resulttype.def).settype=smallset) and
  212. ((left.resulttype.def.deftype=orddef) and (torddef(left.resulttype.def).high<=32) or
  213. (left.resulttype.def.deftype=enumdef) and (tenumdef(left.resulttype.def).max<=32));
  214. { Can we generate jumps? Possible for all types of sets }
  215. {$ifdef oldset}
  216. genjumps:=(right.nodetype=setconstn) and
  217. analizeset(Tsetconstnode(right).value_set,use_small);
  218. {$else}
  219. genjumps:=(right.nodetype=setconstn) and
  220. analizeset(Tsetconstnode(right).value_set^,use_small);
  221. {$endif}
  222. { calculate both operators }
  223. { the complex one first }
  224. firstcomplex(self);
  225. secondpass(left);
  226. { Only process the right if we are not generating jumps }
  227. if not genjumps then
  228. begin
  229. maybe_save(exprasmlist,right.registers32,left.location,pushedregs);
  230. secondpass(right);
  231. maybe_restore(exprasmlist,left.location,pushedregs);
  232. end;
  233. if codegenerror then
  234. exit;
  235. { ofcourse not commutative }
  236. if nf_swaped in flags then
  237. swapleftright;
  238. { location is always LOC_JUMP }
  239. location_reset(location,LOC_REGISTER,OS_INT);
  240. { allocate a register for the result }
  241. location.register := rg.getregisterint(exprasmlist);
  242. if genjumps then
  243. begin
  244. { Get a label to jump to the end }
  245. objectlibrary.getlabel(l);
  246. { clear the register value, indicating result is FALSE }
  247. cg.a_load_const_reg(exprasmlist,OS_INT,0,location.register);
  248. opsize := def_cgsize(left.resulttype.def);
  249. { If register is used, use only lower 8 bits }
  250. if left.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
  251. begin
  252. { for ranges we always need a 32bit register, because then we }
  253. { use the register as base in a reference (JM) }
  254. if ranges then
  255. begin
  256. pleftreg:=rg.makeregsize(left.location.register,OS_INT);
  257. cg.a_load_reg_reg(exprasmlist,left.location.size,left.location.register,pleftreg);
  258. if opsize <> OS_INT then
  259. cg.a_op_const_reg(exprasmlist,OP_AND,255,pleftreg);
  260. opsize := OS_INT;
  261. end
  262. else
  263. { otherwise simply use the lower 8 bits (no "and" }
  264. { necessary this way) (JM) }
  265. begin
  266. pleftreg:=rg.makeregsize(left.location.register,OS_8);
  267. opsize := OS_8;
  268. end;
  269. end
  270. else
  271. begin
  272. { load the value in a register }
  273. pleftreg := cg.get_scratch_reg_int(exprasmlist);
  274. opsize := OS_INT;
  275. cg.a_load_ref_reg(exprasmlist,def_cgsize(left.resulttype.def),left.location.reference,pleftreg);
  276. end;
  277. { how much have we already substracted from the x in the }
  278. { "x in [y..z]" expression }
  279. adjustment := 0;
  280. hr := R_NO;
  281. for i:=1 to numparts do
  282. if setparts[i].range then
  283. { use fact that a <= x <= b <=> cardinal(x-a) <= cardinal(b-a) }
  284. begin
  285. { is the range different from all legal values? }
  286. if (setparts[i].stop-setparts[i].start <> 255) then
  287. begin
  288. { yes, is the lower bound <> 0? }
  289. if (setparts[i].start <> 0) then
  290. { we're going to substract from the left register, }
  291. { so in case of a LOC_CREGISTER first move the value }
  292. { to edi (not done before because now we can do the }
  293. { move and substract in one instruction with LEA) }
  294. if (left.location.loc = LOC_CREGISTER) and
  295. (hr <> pleftreg) then
  296. begin
  297. hr:=cg.get_scratch_reg_int(exprasmlist);
  298. cg.a_op_const_reg_reg(exprasmlist,OP_SUB,opsize,setparts[i].start,pleftreg,hr);
  299. pleftreg:=hr;
  300. opsize := OS_INT;
  301. end
  302. else
  303. begin
  304. { otherwise, the value is already in a register }
  305. { that can be modified }
  306. cg.a_op_const_reg(exprasmlist,OP_SUB,
  307. setparts[i].start-adjustment,pleftreg)
  308. end;
  309. { new total value substracted from x: }
  310. { adjustment + (setparts[i].start - adjustment) }
  311. adjustment := setparts[i].start;
  312. { check if result < b-a+1 (not "result <= b-a", since }
  313. { we need a carry in case the element is in the range }
  314. { (this will never overflow since we check at the }
  315. { beginning whether stop-start <> 255) }
  316. cg.a_cmp_const_reg_label(exprasmlist, opsize, OC_B,
  317. setparts[i].stop-setparts[i].start+1,pleftreg,l);
  318. end
  319. else
  320. { if setparts[i].start = 0 and setparts[i].stop = 255, }
  321. { it's always true since "in" is only allowed for bytes }
  322. begin
  323. cg.a_jmp_always(exprasmlist,l);
  324. end;
  325. end
  326. else
  327. begin
  328. { Emit code to check if left is an element }
  329. cg.a_cmp_const_reg_label(exprasmlist, opsize, OC_EQ,
  330. setparts[i].stop-adjustment,pleftreg,l);
  331. end;
  332. { To compensate for not doing a second pass }
  333. right.location.reference.symbol:=nil;
  334. objectlibrary.getlabel(l3);
  335. cg.a_jmp_always(exprasmlist,l3);
  336. { Now place the end label if IN success }
  337. cg.a_label(exprasmlist,l);
  338. { result register is 1 }
  339. cg.a_load_const_reg(exprasmlist,OS_INT,1,location.register);
  340. { in case value is not found }
  341. cg.a_label(exprasmlist,l3);
  342. case left.location.loc of
  343. LOC_CREGISTER :
  344. cg.free_scratch_reg(exprasmlist,pleftreg);
  345. LOC_REGISTER :
  346. rg.ungetregister(exprasmlist,pleftreg);
  347. else
  348. begin
  349. reference_release(exprasmlist,left.location.reference);
  350. cg.free_scratch_reg(exprasmlist,pleftreg);
  351. end;
  352. end;
  353. end
  354. else
  355. {*****************************************************************}
  356. { NO JUMP TABLE GENERATION }
  357. {*****************************************************************}
  358. begin
  359. { We will now generated code to check the set itself, no jmps,
  360. handle smallsets separate, because it allows faster checks }
  361. if use_small then
  362. begin
  363. {**************************** SMALL SET **********************}
  364. if left.nodetype=ordconstn then
  365. begin
  366. { clear the register value, indicating result is FALSE }
  367. cg.a_load_const_reg(exprasmlist,OS_INT,0,location.register);
  368. hr:=cg.get_scratch_reg_int(exprasmlist);
  369. case right.location.loc of
  370. LOC_REGISTER,
  371. LOC_CREGISTER:
  372. begin
  373. { load set value into register }
  374. cg.a_load_reg_reg(exprasmlist,OS_32,
  375. right.location.register,hr);
  376. end;
  377. LOC_REFERENCE,
  378. LOC_CREFERENCE :
  379. begin
  380. { load set value into register }
  381. cg.a_load_ref_reg(exprasmlist,OS_32,
  382. right.location.reference,hr);
  383. end;
  384. else
  385. internalerror(200203312);
  386. end;
  387. location_release(exprasmlist,right.location);
  388. { then do SHR tge register }
  389. cg.a_op_const_reg(exprasmlist,OP_SHR,
  390. tordconstnode(left).value and 31,hr);
  391. { then extract the lowest bit }
  392. cg.a_op_const_reg(exprasmlist,OP_AND,1,hr);
  393. end
  394. else
  395. begin
  396. case left.location.loc of
  397. LOC_REGISTER,
  398. LOC_CREGISTER:
  399. begin
  400. hr3:=rg.makeregsize(left.location.register,OS_INT);
  401. cg.a_load_reg_reg(exprasmlist,left.location.size,left.location.register,hr3);
  402. hr:=cg.get_scratch_reg_int(exprasmlist);
  403. cg.a_load_reg_reg(exprasmlist,OS_INT,hr3,hr);
  404. end;
  405. else
  406. begin
  407. hr:=cg.get_scratch_reg_int(exprasmlist);
  408. cg.a_load_ref_reg(exprasmlist,def_cgsize(left.resulttype.def),
  409. left.location.reference,hr);
  410. location_release(exprasmlist,left.location);
  411. end;
  412. end;
  413. case right.location.loc of
  414. LOC_REGISTER,
  415. LOC_CREGISTER :
  416. begin
  417. hr2:=right.location.register;
  418. end;
  419. LOC_CONSTANT :
  420. begin
  421. hr2:=rg.getregisterint(exprasmlist);
  422. cg.a_load_const_reg(exprasmlist,OS_32,
  423. right.location.value,hr2);
  424. end;
  425. LOC_CREFERENCE,
  426. LOC_REFERENCE :
  427. begin
  428. location_release(exprasmlist,right.location);
  429. hr2:=rg.getregisterint(exprasmlist);
  430. cg.a_load_ref_reg(exprasmlist, OS_32,
  431. right.location.reference,hr2);
  432. end;
  433. else
  434. internalerror(2002032210);
  435. end;
  436. { emit bit test operation }
  437. emit_bit_test_reg_reg(exprasmlist,hr,hr2,location.register);
  438. { free the resources }
  439. case right.location.loc of
  440. LOC_REGISTER,
  441. LOC_CREGISTER :
  442. rg.ungetregisterint(exprasmlist,right.location.register);
  443. LOC_CONSTANT ,
  444. LOC_CREFERENCE,
  445. LOC_REFERENCE :
  446. rg.ungetregisterint(exprasmlist,hr2);
  447. else
  448. internalerror(2002032210);
  449. end;
  450. { free bitnumber register }
  451. cg.free_scratch_reg(exprasmlist,hr);
  452. end;
  453. end
  454. else
  455. {************************** NOT SMALL SET ********************}
  456. begin
  457. if right.location.loc=LOC_CONSTANT then
  458. begin
  459. { this section has not been tested! }
  460. { can it actually occur currently? CEC }
  461. { yes: "if bytevar in [1,3,5,7,9,11,13,15]" (JM) }
  462. objectlibrary.getlabel(l);
  463. objectlibrary.getlabel(l2);
  464. case left.location.loc of
  465. LOC_REGISTER,
  466. LOC_CREGISTER:
  467. begin
  468. hr:=rg.makeregsize(left.location.register,OS_INT);
  469. cg.a_load_reg_reg(exprasmlist,left.location.size,left.location.register,hr);
  470. cg.a_cmp_const_reg_label(exprasmlist,OS_INT,OC_BE,31,hr,l);
  471. { reset of result register is done in routine entry }
  472. cg.a_jmp_always(exprasmlist,l2);
  473. cg.a_label(exprasmlist,l);
  474. { We have to load the value into a register because
  475. btl does not accept values only refs or regs (PFV) }
  476. hr2:=rg.getregisterint(exprasmlist);
  477. cg.a_load_const_reg(exprasmlist,OS_INT,right.location.value,hr2);
  478. end;
  479. LOC_REFERENCE,LOC_CREFERENCE:
  480. begin
  481. cg.a_cmp_const_ref_label(exprasmlist,OS_8,OC_BE,31,left.location.reference,l);
  482. cg.a_jmp_always(exprasmlist,l2);
  483. cg.a_label(exprasmlist,l);
  484. location_release(exprasmlist,left.location);
  485. hr:=rg.getregisterint(exprasmlist);
  486. cg.a_load_ref_reg(exprasmlist,OS_32,left.location.reference,hr);
  487. { We have to load the value into a register because
  488. btl does not accept values only refs or regs (PFV) }
  489. hr2:=rg.getregisterint(exprasmlist);
  490. cg.a_load_const_reg(exprasmlist,OS_INT,
  491. right.location.value,hr2);
  492. end;
  493. else
  494. internalerror(2002081002);
  495. end;
  496. { emit bit test operation }
  497. emit_bit_test_reg_reg(exprasmlist,hr,hr2,location.register);
  498. rg.ungetregisterint(exprasmlist,hr2);
  499. if not (left.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
  500. rg.ungetregisterint(exprasmlist,hr);
  501. cg.a_label(exprasmlist,l2);
  502. end { of right.location.loc=LOC_CONSTANT }
  503. { do search in a normal set which could have >32 elementsm
  504. but also used if the left side contains higher values > 32 }
  505. else if left.nodetype=ordconstn then
  506. begin
  507. { use location.register as scratch register here }
  508. inc(right.location.reference.offset,tordconstnode(left).value shr 3);
  509. cg.a_load_ref_reg(exprasmlist, OS_8, right.location.reference, location.register);
  510. location_release(exprasmlist,right.location);
  511. cg.a_op_const_reg(exprasmlist,OP_SHR, tordconstnode(left).value and 7,
  512. location.register);
  513. cg.a_op_const_reg(exprasmlist, OP_AND,1,location.register);
  514. end
  515. else
  516. begin
  517. if (left.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
  518. pleftreg:=rg.makeregsize(left.location.register,OS_INT)
  519. else
  520. pleftreg:=rg.getregisterint(exprasmlist);
  521. cg.a_load_loc_reg(exprasmlist,left.location,pleftreg);
  522. location_freetemp(exprasmlist,left.location);
  523. location_release(exprasmlist,left.location);
  524. cg.a_param_reg(exprasmlist,OS_8,pleftreg,paramanager.getintparaloc(2));
  525. cg.a_param_ref(exprasmlist,OS_ADDR,right.location.reference,paramanager.getintparaloc(1));
  526. cg.a_call_name(exprasmlist,'FPC_SET_IN_BYTE');
  527. { result of value is always one full register }
  528. cg.a_load_reg_reg(exprasmlist,OS_INT,ACCUMULATOR,location.register);
  529. { release the allocated register }
  530. if not (left.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
  531. rg.ungetregisterint(exprasmlist,pleftreg);
  532. location_release(exprasmlist,right.location);
  533. end;
  534. end;
  535. end;
  536. location_freetemp(exprasmlist,right.location);
  537. end;
  538. {*****************************************************************************
  539. TCGCASENODE
  540. *****************************************************************************}
  541. procedure tcgcasenode.optimizevalues(var max_linear_list:longint;var max_dist:cardinal);
  542. begin
  543. { no changes by default }
  544. end;
  545. function tcgcasenode.has_jumptable : boolean;
  546. begin
  547. { No jumptable support in the default implementation }
  548. has_jumptable:=false;
  549. end;
  550. procedure tcgcasenode.genjumptable(hp : pcaserecord;min_,max_ : longint);
  551. begin
  552. internalerror(200209161);
  553. end;
  554. procedure tcgcasenode.genlinearlist(hp : pcaserecord);
  555. var
  556. first : boolean;
  557. last : TConstExprInt;
  558. scratch_reg: tregister;
  559. procedure genitem(t : pcaserecord);
  560. procedure gensub(value:longint);
  561. begin
  562. { here, since the sub and cmp are separate we need
  563. to move the result before subtract to a help
  564. register.
  565. }
  566. cg.a_load_reg_reg(exprasmlist, opsize, hregister, scratch_reg);
  567. cg.a_op_const_reg(exprasmlist, OP_SUB, value, hregister);
  568. end;
  569. begin
  570. if assigned(t^.less) then
  571. genitem(t^.less);
  572. { need we to test the first value }
  573. if first and (t^._low>get_min_value(left.resulttype.def)) then
  574. begin
  575. cg.a_cmp_const_reg_label(exprasmlist,OS_INT,jmp_lt,longint(t^._low),hregister,elselabel);
  576. end;
  577. if t^._low=t^._high then
  578. begin
  579. if t^._low-last=0 then
  580. cg.a_cmp_const_reg_label(exprasmlist, OS_INT, OC_EQ,0,hregister,t^.statement)
  581. else
  582. begin
  583. gensub(longint(t^._low-last));
  584. cg.a_cmp_const_reg_label(exprasmlist, OS_INT, OC_EQ,longint(t^._low-last),scratch_reg,t^.statement);
  585. end;
  586. last:=t^._low;
  587. end
  588. else
  589. begin
  590. { it begins with the smallest label, if the value }
  591. { is even smaller then jump immediately to the }
  592. { ELSE-label }
  593. if first then
  594. begin
  595. { have we to ajust the first value ? }
  596. if (t^._low>get_min_value(left.resulttype.def)) then
  597. gensub(longint(t^._low));
  598. end
  599. else
  600. begin
  601. { if there is no unused label between the last and the }
  602. { present label then the lower limit can be checked }
  603. { immediately. else check the range in between: }
  604. gensub(longint(t^._low-last));
  605. cg.a_cmp_const_reg_label(exprasmlist, OS_INT,jmp_lt,longint(t^._low-last),scratch_reg,elselabel);
  606. end;
  607. gensub(longint(t^._high-t^._low));
  608. cg.a_cmp_const_reg_label(exprasmlist, OS_INT,jmp_le,longint(t^._high-t^._low),scratch_reg,t^.statement);
  609. last:=t^._high;
  610. end;
  611. first:=false;
  612. if assigned(t^.greater) then
  613. genitem(t^.greater);
  614. end;
  615. begin
  616. { do we need to generate cmps? }
  617. if (with_sign and (min_label<0)) then
  618. genlinearcmplist(hp)
  619. else
  620. begin
  621. last:=0;
  622. first:=true;
  623. scratch_reg := cg.get_scratch_reg_int(exprasmlist);
  624. genitem(hp);
  625. cg.free_scratch_reg(exprasmlist,scratch_reg);
  626. cg.a_jmp_always(exprasmlist,elselabel);
  627. end;
  628. end;
  629. procedure tcgcasenode.genlinearcmplist(hp : pcaserecord);
  630. var
  631. first : boolean;
  632. last : TConstExprInt;
  633. procedure genitem(t : pcaserecord);
  634. var
  635. l1 : tasmlabel;
  636. begin
  637. if assigned(t^.less) then
  638. genitem(t^.less);
  639. if t^._low=t^._high then
  640. begin
  641. if opsize in [OS_S64,OS_64] then
  642. begin
  643. objectlibrary.getlabel(l1);
  644. cg.a_cmp_const_reg_label(exprasmlist, OS_INT, OC_NE, longint(hi(int64(t^._low))),hregister2,l1);
  645. cg.a_cmp_const_reg_label(exprasmlist, OS_INT, OC_EQ, longint(lo(int64(t^._low))),hregister, t^.statement);
  646. cg.a_label(exprasmlist,l1);
  647. end
  648. else
  649. begin
  650. cg.a_cmp_const_reg_label(exprasmlist, OS_INT, OC_EQ, longint(t^._low),hregister, t^.statement);
  651. last:=t^._low;
  652. end;
  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 or (t^._low-last>1) then
  660. begin
  661. if opsize in [OS_64,OS_S64] then
  662. begin
  663. objectlibrary.getlabel(l1);
  664. cg.a_cmp_const_reg_label(exprasmlist, OS_INT, jmp_lt, longint(hi(int64(t^._low))),
  665. hregister2, elselabel);
  666. cg.a_cmp_const_reg_label(exprasmlist, OS_INT, jmp_gt, longint(hi(int64(t^._low))),
  667. hregister2, l1);
  668. { the comparisation of the low dword must be always unsigned! }
  669. cg.a_cmp_const_reg_label(exprasmlist, OS_INT, OC_B, longint(lo(int64(t^._low))), hregister, elselabel);
  670. cg.a_label(exprasmlist,l1);
  671. end
  672. else
  673. begin
  674. cg.a_cmp_const_reg_label(exprasmlist, OS_INT, jmp_lt, longint(t^._low), hregister,
  675. elselabel);
  676. end;
  677. end;
  678. if opsize in [OS_S64,OS_64] then
  679. begin
  680. objectlibrary.getlabel(l1);
  681. cg.a_cmp_const_reg_label(exprasmlist, OS_INT, jmp_lt, longint(hi(int64(t^._high))), hregister2,
  682. t^.statement);
  683. cg.a_cmp_const_reg_label(exprasmlist, OS_INT, jmp_gt, longint(hi(int64(t^._high))), hregister2,
  684. l1);
  685. cg.a_cmp_const_reg_label(exprasmlist, OS_INT, OC_BE, longint(lo(int64(t^._high))), hregister, t^.statement);
  686. cg.a_label(exprasmlist,l1);
  687. end
  688. else
  689. begin
  690. cg.a_cmp_const_reg_label(exprasmlist, OS_INT, jmp_le, longint(t^._high), hregister, t^.statement);
  691. end;
  692. last:=t^._high;
  693. end;
  694. first:=false;
  695. if assigned(t^.greater) then
  696. genitem(t^.greater);
  697. end;
  698. begin
  699. last:=0;
  700. first:=true;
  701. genitem(hp);
  702. cg.a_jmp_always(exprasmlist,elselabel);
  703. end;
  704. procedure tcgcasenode.gentreejmp(p : pcaserecord);
  705. var
  706. lesslabel,greaterlabel : tasmlabel;
  707. begin
  708. cg.a_label(exprasmlist,p^._at);
  709. { calculate labels for left and right }
  710. if (p^.less=nil) then
  711. lesslabel:=elselabel
  712. else
  713. lesslabel:=p^.less^._at;
  714. if (p^.greater=nil) then
  715. greaterlabel:=elselabel
  716. else
  717. greaterlabel:=p^.greater^._at;
  718. { calculate labels for left and right }
  719. { no range label: }
  720. if p^._low=p^._high then
  721. begin
  722. if greaterlabel=lesslabel then
  723. begin
  724. cg.a_cmp_const_reg_label(exprasmlist, OS_INT, OC_NE,p^._low,hregister, lesslabel);
  725. end
  726. else
  727. begin
  728. cg.a_cmp_const_reg_label(exprasmlist,OS_INT, jmp_lt,p^._low,hregister, lesslabel);
  729. cg.a_cmp_const_reg_label(exprasmlist,OS_INT, jmp_gt,p^._low,hregister, greaterlabel);
  730. end;
  731. cg.a_jmp_always(exprasmlist,p^.statement);
  732. end
  733. else
  734. begin
  735. cg.a_cmp_const_reg_label(exprasmlist,OS_INT,jmp_lt,p^._low, hregister, lesslabel);
  736. cg.a_cmp_const_reg_label(exprasmlist,OS_INT,jmp_gt,p^._high,hregister, greaterlabel);
  737. cg.a_jmp_always(exprasmlist,p^.statement);
  738. end;
  739. if assigned(p^.less) then
  740. gentreejmp(p^.less);
  741. if assigned(p^.greater) then
  742. gentreejmp(p^.greater);
  743. end;
  744. procedure tcgcasenode.pass_2;
  745. var
  746. lv,hv,
  747. max_label: tconstexprint;
  748. labels : longint;
  749. max_linear_list : longint;
  750. otl, ofl: tasmlabel;
  751. isjump : boolean;
  752. max_dist,
  753. dist : cardinal;
  754. hp : tnode;
  755. begin
  756. objectlibrary.getlabel(endlabel);
  757. objectlibrary.getlabel(elselabel);
  758. with_sign:=is_signed(left.resulttype.def);
  759. if with_sign then
  760. begin
  761. jmp_gt:=OC_GT;
  762. jmp_lt:=OC_LT;
  763. jmp_le:=OC_LTE;
  764. end
  765. else
  766. begin
  767. jmp_gt:=OC_A;
  768. jmp_lt:=OC_B;
  769. jmp_le:=OC_BE;
  770. end;
  771. rg.cleartempgen;
  772. { save current truelabel and falselabel }
  773. isjump:=false;
  774. if left.location.loc=LOC_JUMP then
  775. begin
  776. otl:=truelabel;
  777. objectlibrary.getlabel(truelabel);
  778. ofl:=falselabel;
  779. objectlibrary.getlabel(falselabel);
  780. isjump:=true;
  781. end;
  782. secondpass(left);
  783. { determines the size of the operand }
  784. opsize:=def_cgsize(left.resulttype.def);
  785. { copy the case expression to a register }
  786. location_force_reg(exprasmlist,left.location,opsize,false);
  787. if opsize in [OS_S64,OS_64] then
  788. begin
  789. hregister:=left.location.registerlow;
  790. hregister2:=left.location.registerhigh;
  791. end
  792. else
  793. hregister:=left.location.register;
  794. if isjump then
  795. begin
  796. truelabel:=otl;
  797. falselabel:=ofl;
  798. end;
  799. { we need the min_label always to choose between }
  800. { cmps and subs/decs }
  801. min_label:=case_get_min(nodes);
  802. load_all_regvars(exprasmlist);
  803. { now generate the jumps }
  804. if opsize in [OS_64,OS_S64] then
  805. genlinearcmplist(nodes)
  806. else
  807. begin
  808. if cs_optimize in aktglobalswitches then
  809. begin
  810. { procedures are empirically passed on }
  811. { consumption can also be calculated }
  812. { but does it pay on the different }
  813. { processors? }
  814. { moreover can the size only be appro- }
  815. { ximated as it is not known if rel8, }
  816. { rel16 or rel32 jumps are used }
  817. max_label:=case_get_max(nodes);
  818. labels:=case_count_labels(nodes);
  819. { can we omit the range check of the jump table ? }
  820. getrange(left.resulttype.def,lv,hv);
  821. jumptable_no_range:=(lv=min_label) and (hv=max_label);
  822. { hack a little bit, because the range can be greater }
  823. { than the positive range of a longint }
  824. if (min_label<0) and (max_label>0) then
  825. begin
  826. if min_label=TConstExprInt($80000000) then
  827. dist:=Cardinal(max_label)+Cardinal($80000000)
  828. else
  829. dist:=Cardinal(max_label)+Cardinal(-min_label)
  830. end
  831. else
  832. dist:=max_label-min_label;
  833. { optimize for size ? }
  834. if cs_littlesize in aktglobalswitches then
  835. begin
  836. if (has_jumptable) and
  837. not((labels<=2) or
  838. ((max_label-min_label)<0) or
  839. ((max_label-min_label)>3*labels)) then
  840. begin
  841. { if the labels less or more a continuum then }
  842. genjumptable(nodes,min_label,max_label);
  843. end
  844. else
  845. begin
  846. { a linear list is always smaller than a jump tree }
  847. genlinearlist(nodes);
  848. end;
  849. end
  850. else
  851. begin
  852. max_dist:=4*cardinal(labels);
  853. if jumptable_no_range then
  854. max_linear_list:=4
  855. else
  856. max_linear_list:=2;
  857. { allow processor specific values }
  858. optimizevalues(max_linear_list,max_dist);
  859. if (labels<=max_linear_list) then
  860. genlinearlist(nodes)
  861. else
  862. begin
  863. if (has_jumptable) and
  864. (dist<max_dist) then
  865. genjumptable(nodes,min_label,max_label)
  866. else
  867. begin
  868. if labels>16 then
  869. gentreejmp(nodes)
  870. else
  871. genlinearlist(nodes);
  872. end;
  873. end;
  874. end;
  875. end
  876. else
  877. { it's always not bad }
  878. genlinearlist(nodes);
  879. end;
  880. rg.ungetregister(exprasmlist,hregister);
  881. { now generate the instructions }
  882. hp:=right;
  883. while assigned(hp) do
  884. begin
  885. rg.cleartempgen;
  886. secondpass(tbinarynode(hp).right);
  887. { don't come back to case line }
  888. aktfilepos:=exprasmList.getlasttaifilepos^;
  889. load_all_regvars(exprasmlist);
  890. cg.a_jmp_always(exprasmlist,endlabel);
  891. hp:=tbinarynode(hp).left;
  892. end;
  893. cg.a_label(exprasmlist,elselabel);
  894. { ...and the else block }
  895. if assigned(elseblock) then
  896. begin
  897. rg.cleartempgen;
  898. secondpass(elseblock);
  899. load_all_regvars(exprasmlist);
  900. end;
  901. cg.a_label(exprasmlist,endlabel);
  902. end;
  903. begin
  904. csetelementnode:=tcgsetelementnode;
  905. cinnode:=tcginnode;
  906. ccasenode:=tcgcasenode;
  907. end.
  908. {
  909. $Log$
  910. Revision 1.19 2002-09-16 18:08:26 peter
  911. * fix last optimization in genlinearlist, detected by bug tw1066
  912. * use generic casenode.pass2 routine and override genlinearlist
  913. * add jumptable support to generic casenode, by default there is
  914. no jumptable support
  915. Revision 1.18 2002/08/15 15:11:53 carl
  916. * oldset define is now correct for all cpu's except i386
  917. * correct compilation problems because of the above
  918. Revision 1.17 2002/08/13 18:01:52 carl
  919. * rename swatoperands to swapoperands
  920. + m68k first compilable version (still needs a lot of testing):
  921. assembler generator, system information , inline
  922. assembler reader.
  923. Revision 1.16 2002/08/11 14:32:27 peter
  924. * renamed current_library to objectlibrary
  925. Revision 1.15 2002/08/11 13:24:12 peter
  926. * saving of asmsymbols in ppu supported
  927. * asmsymbollist global is removed and moved into a new class
  928. tasmlibrarydata that will hold the info of a .a file which
  929. corresponds with a single module. Added librarydata to tmodule
  930. to keep the library info stored for the module. In the future the
  931. objectfiles will also be stored to the tasmlibrarydata class
  932. * all getlabel/newasmsymbol and friends are moved to the new class
  933. Revision 1.14 2002/08/11 11:37:42 jonas
  934. * genlinear(cmp)list can now be overridden by descendents
  935. Revision 1.13 2002/08/11 06:14:40 florian
  936. * fixed powerpc compilation problems
  937. Revision 1.12 2002/08/10 17:15:12 jonas
  938. * optimizations and bugfix
  939. Revision 1.11 2002/07/28 09:24:18 carl
  940. + generic case node
  941. Revision 1.10 2002/07/23 14:31:00 daniel
  942. * Added internal error when asked to generate code for 'if expr in []'
  943. Revision 1.9 2002/07/23 12:34:30 daniel
  944. * Readded old set code. To use it define 'oldset'. Activated by default
  945. for ppc.
  946. Revision 1.8 2002/07/22 11:48:04 daniel
  947. * Sets are now internally sets.
  948. Revision 1.7 2002/07/21 16:58:20 jonas
  949. * fixed some bugs in tcginnode.pass_2() and optimized the bit test
  950. Revision 1.6 2002/07/20 11:57:54 florian
  951. * types.pas renamed to defbase.pas because D6 contains a types
  952. unit so this would conflicts if D6 programms are compiled
  953. + Willamette/SSE2 instructions to assembler added
  954. Revision 1.5 2002/07/11 14:41:28 florian
  955. * start of the new generic parameter handling
  956. Revision 1.4 2002/07/07 10:16:29 florian
  957. * problems with last commit fixed
  958. Revision 1.3 2002/07/06 20:19:25 carl
  959. + generic set handling
  960. Revision 1.2 2002/07/01 16:23:53 peter
  961. * cg64 patch
  962. * basics for currency
  963. * asnode updates for class and interface (not finished)
  964. Revision 1.1 2002/06/16 08:14:56 carl
  965. + generic sets
  966. }