ncgset.pas 41 KB

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