n386set.pas 46 KB

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