ncgset.pas 40 KB

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