cg68kset.pas 37 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842
  1. {
  2. $Id$
  3. Copyright (c) 1993-98 by Florian Klaempfl
  4. Generate m68k 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 cg68kset;
  19. interface
  20. uses
  21. tree;
  22. procedure secondsetelement(var p : ptree);
  23. procedure secondin(var p : ptree);
  24. procedure secondcase(var p : ptree);
  25. implementation
  26. uses
  27. cobjects,verbose,globals,systems,
  28. symtable,aasm,types,
  29. hcodegen,temp_gen,pass_2,
  30. m68k,cga68k,tgen68k;
  31. const
  32. bytes2Sxx:array[1..4] of Topsize=(S_B,S_W,S_NO,S_L);
  33. {*****************************************************************************
  34. SecondSetElement
  35. *****************************************************************************}
  36. procedure secondsetelement(var p : ptree);
  37. begin
  38. { load first value in 32bit register }
  39. secondpass(p^.left);
  40. if p^.left^.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
  41. emit_to_reg32(p^.left^.location.register);
  42. { also a second value ? }
  43. if assigned(p^.right) then
  44. begin
  45. secondpass(p^.right);
  46. if p^.right^.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
  47. emit_to_reg32(p^.right^.location.register);
  48. end;
  49. { we doesn't modify the left side, we check only the type }
  50. set_location(p^.location,p^.left^.location);
  51. end;
  52. {*****************************************************************************
  53. SecondIn
  54. *****************************************************************************}
  55. { could be built into secondadd but it }
  56. { should be easy to read }
  57. procedure secondin(var p : ptree);
  58. type Tsetpart=record
  59. range:boolean; {Part is a range.}
  60. start,stop:byte; {Start/stop when range; Stop=element
  61. when an element.}
  62. end;
  63. var
  64. pushed,ranges : boolean;
  65. hr : tregister;
  66. setparts:array[1..8] of Tsetpart;
  67. i,numparts:byte;
  68. {href,href2:Treference;}
  69. l,l2 : plabel;
  70. hl,hl1 : plabel;
  71. hl2, hl3: plabel;
  72. opsize : topsize;
  73. function swaplongint(l : longint): longint;
  74. var
  75. w1: word;
  76. w2: word;
  77. begin
  78. w1:=l and $ffff;
  79. w2:=l shr 16;
  80. l:=swap(w2)+(longint(swap(w1)) shl 16);
  81. swaplongint:=l;
  82. end;
  83. function analizeset(Aset:Pconstset):boolean;
  84. type byteset=set of byte;
  85. tlongset = array[0..7] of longint;
  86. var compares,maxcompares:word;
  87. someset : tlongset;
  88. i:byte;
  89. begin
  90. analizeset:=false;
  91. ranges:=false;
  92. numparts:=0;
  93. compares:=0;
  94. {Lots of comparisions take a lot of time, so do not allow
  95. too much comparisions. 8 comparisions are, however, still
  96. smalller than emitting the set.}
  97. maxcompares:=5;
  98. if cs_littlesize in aktglobalswitches then
  99. maxcompares:=8;
  100. move(ASet^,someset,32);
  101. { On Big endian machines sets are stored }
  102. { as INTEL Little-endian format, therefore }
  103. { we must convert it to the correct format }
  104. {$IFDEF BIG_ENDIAN}
  105. for I:=0 to 7 do
  106. someset[i]:=swaplongint(someset[i]);
  107. {$ENDIF}
  108. for i:=0 to 255 do
  109. if i in byteset(someset) then
  110. begin
  111. if (numparts=0) or
  112. (i<>setparts[numparts].stop+1) then
  113. begin
  114. {Set element is a separate element.}
  115. inc(compares);
  116. if compares>maxcompares then
  117. exit;
  118. inc(numparts);
  119. setparts[numparts].range:=false;
  120. setparts[numparts].stop:=i;
  121. end
  122. else
  123. {Set element is part of a range.}
  124. if not setparts[numparts].range then
  125. begin
  126. {Transform an element into a range.}
  127. setparts[numparts].range:=true;
  128. setparts[numparts].start:=
  129. setparts[numparts].stop;
  130. setparts[numparts].stop:=i;
  131. inc(compares);
  132. if compares>maxcompares then
  133. exit;
  134. end
  135. else
  136. begin
  137. {Extend a range.}
  138. setparts[numparts].stop:=i;
  139. {A range of two elements can better
  140. be checked as two separate ones.
  141. When extending a range, our range
  142. becomes larger than two elements.}
  143. ranges:=true;
  144. end;
  145. end;
  146. analizeset:=true;
  147. end; { end analizeset }
  148. begin
  149. if psetdef(p^.right^.resulttype)^.settype=smallset then
  150. begin
  151. if p^.left^.treetype=ordconstn then
  152. begin
  153. { only compulsory }
  154. secondpass(p^.left);
  155. secondpass(p^.right);
  156. if codegenerror then
  157. exit;
  158. p^.location.resflags:=F_NE;
  159. { Because of the Endian of the m68k, we have to consider this as a }
  160. { normal set and load it byte per byte, otherwise we will never get }
  161. { the correct result. }
  162. case p^.right^.location.loc of
  163. LOC_REGISTER,LOC_CREGISTER :
  164. begin
  165. emit_reg_reg(A_MOVE,S_L,p^.right^.location.register,R_D1);
  166. exprasmlist^.concat(new(pai68k,
  167. op_const_reg(A_AND,S_L, 1 shl (p^.left^.value and 31),R_D1)));
  168. end;
  169. else
  170. begin
  171. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(
  172. p^.right^.location.reference),R_D1)));
  173. exprasmlist^.concat(new(pai68k,op_const_reg(
  174. A_AND,S_L,1 shl (p^.left^.value and 31) ,R_D1)));
  175. end;
  176. end;
  177. del_reference(p^.right^.location.reference);
  178. end
  179. else
  180. begin
  181. { calculate both operators }
  182. { the complex one first }
  183. firstcomplex(p);
  184. secondpass(p^.left);
  185. { are too few registers free? }
  186. pushed:=maybe_push(p^.right^.registers32,p^.left);
  187. secondpass(p^.right);
  188. if pushed then
  189. restore(p^.left);
  190. { of course not commutative }
  191. if p^.swaped then
  192. swaptree(p);
  193. { load index into register }
  194. case p^.left^.location.loc of
  195. LOC_REGISTER,
  196. LOC_CREGISTER :
  197. hr:=p^.left^.location.register;
  198. else
  199. begin
  200. { Small sets are always 32 bit values, there is no }
  201. { way they can be anything else, so no problems here}
  202. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
  203. newreference(p^.left^.location.reference),R_D1)));
  204. hr:=R_D1;
  205. del_reference(p^.left^.location.reference);
  206. end;
  207. end;
  208. case p^.right^.location.loc of
  209. LOC_REGISTER,
  210. LOC_CREGISTER : exprasmlist^.concat(new(pai68k, op_reg_reg(A_BTST,S_L,hr,p^.right^.location.register)));
  211. else
  212. begin
  213. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(p^.right^.location.reference),
  214. R_D0)));
  215. exprasmlist^.concat(new(pai68k,op_reg_reg(A_BTST,S_L,hr,R_D0)));
  216. del_reference(p^.right^.location.reference);
  217. end;
  218. end;
  219. { support carry routines }
  220. { sets the carry flags according to the result of BTST }
  221. { i.e the Z flag. }
  222. getlabel(hl);
  223. emitl(A_BNE,hl);
  224. { leave all bits unchanged except Carry = 0 }
  225. exprasmlist^.concat(new(pai68k, op_const_reg(A_AND, S_B, $FE, R_CCR)));
  226. getlabel(hl1);
  227. emitl(A_BRA,hl1);
  228. emitl(A_LABEL, hl);
  229. { set carry to 1 }
  230. exprasmlist^.concat(new(pai68k, op_const_reg(A_OR, S_B, $01, R_CCR)));
  231. emitl(A_LABEL, hl1);
  232. { end support carry routines }
  233. p^.location.loc:=LOC_FLAGS;
  234. p^.location.resflags:=F_C;
  235. end;
  236. end
  237. else { //// NOT a small set //// }
  238. begin
  239. if p^.left^.treetype=ordconstn then
  240. begin
  241. { only compulsory }
  242. secondpass(p^.left);
  243. secondpass(p^.right);
  244. if codegenerror then
  245. exit;
  246. p^.location.resflags:=F_NE;
  247. inc(p^.right^.location.reference.offset,(p^.left^.value div 32)*4);
  248. exprasmlist^.concat(new(pai68k, op_ref_reg(A_MOVE, S_L,
  249. newreference(p^.right^.location.reference), R_D1)));
  250. exprasmlist^.concat(new(pai68k, op_const_reg(A_AND, S_L,
  251. 1 shl (p^.left^.value mod 32),R_D1)));
  252. del_reference(p^.right^.location.reference);
  253. end
  254. else
  255. begin
  256. if (p^.right^.treetype=setconstn) and
  257. analizeset(p^.right^.value_set) then
  258. begin
  259. {It gives us advantage to check for the set elements
  260. separately instead of using the SET_IN_BYTE procedure.
  261. To do: Build in support for LOC_JUMP.}
  262. secondpass(p^.left);
  263. {We won't do a second pass on p^.right, because
  264. this will emit the constant set.}
  265. case p^.left^.location.loc of
  266. LOC_REGISTER,
  267. LOC_CREGISTER :
  268. exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,
  269. 255,p^.left^.location.register)));
  270. else
  271. Begin
  272. { Because of the m68k endian, then we must LOAD normally the }
  273. { value into a register first, all depending on the source }
  274. { size! }
  275. opsize:=S_NO;
  276. case integer(p^.left^.resulttype^.savesize) of
  277. 1 : opsize:=S_B;
  278. 2 : opsize:=S_W;
  279. 4 : opsize:=S_L;
  280. else
  281. internalerror(19);
  282. end;
  283. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,opsize,
  284. newreference(p^.left^.location.reference),R_D0)));
  285. exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,
  286. 255,R_D0)));
  287. end;
  288. end;
  289. {Get a label to jump to the end.}
  290. p^.location.loc:=LOC_FLAGS;
  291. {It's better to use the zero flag when there are no ranges.}
  292. if ranges then
  293. p^.location.resflags:=F_C
  294. else
  295. p^.location.resflags:=F_E;
  296. {href.symbol := nil;
  297. clear_reference(href);}
  298. getlabel(l);
  299. {href.symbol:=stringdup(lab2str(l));}
  300. for i:=1 to numparts do
  301. if setparts[i].range then
  302. begin
  303. {Check if left is in a range.}
  304. {Get a label to jump over the check.}
  305. {href2.symbol := nil;
  306. clear_reference(href2);}
  307. getlabel(l2);
  308. {href.symbol:=stringdup(lab2str(l2));}
  309. if setparts[i].start=setparts[i].stop-1 then
  310. begin
  311. case p^.left^.location.loc of
  312. LOC_REGISTER,
  313. LOC_CREGISTER :
  314. exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
  315. setparts[i].start,p^.left^.location.register)));
  316. else
  317. exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
  318. setparts[i].start,R_D0)));
  319. { exprasmlist^.concat(new(pai68k,op_const_ref(A_CMP,S_B,
  320. setparts[i].start,newreference(p^.left^.location.reference))));}
  321. end;
  322. {Result should be in carry flag when ranges are used.}
  323. { Here the m68k does not affect any flag except the }
  324. { flag which is OR'ed }
  325. if ranges then
  326. exprasmlist^.concat(new(pai68k,op_const_reg(A_OR,S_B,$01,R_CCR)));
  327. {If found, jump to end.}
  328. emitl(A_BEQ,l);
  329. case p^.left^.location.loc of
  330. LOC_REGISTER,
  331. LOC_CREGISTER :
  332. exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
  333. setparts[i].stop,p^.left^.location.register)));
  334. else
  335. exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
  336. setparts[i].stop,R_D0)));
  337. { exprasmlist^.concat(new(pai68k,op_const_ref(A_CMP,S_B,
  338. setparts[i].stop,newreference(p^.left^.location.reference))));}
  339. end;
  340. {Result should be in carry flag when ranges are used.}
  341. { Here the m68k does not affect any flag except the }
  342. { flag which is OR'ed }
  343. if ranges then
  344. exprasmlist^.concat(new(pai68k,op_const_reg(A_OR,S_B,$01,R_CCR)));
  345. {If found, jump to end.}
  346. emitl(A_BEQ,l);
  347. end
  348. else
  349. begin
  350. if setparts[i].start<>0 then
  351. begin
  352. {We only check for the lower bound if it is > 0, because
  353. set elements lower than 0 do nt exist.}
  354. case p^.left^.location.loc of
  355. LOC_REGISTER,
  356. LOC_CREGISTER :
  357. exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
  358. setparts[i].start,p^.left^.location.register)));
  359. else
  360. exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
  361. setparts[i].start,R_D0)));
  362. { exprasmlist^.concat(new(pai68k,op_const_ref(A_CMP,S_B,
  363. setparts[i].start,newreference(p^.left^.location.reference)))); }
  364. end;
  365. {If lower, jump to next check.}
  366. emitl(A_BCS,l2);
  367. end;
  368. if setparts[i].stop<>255 then
  369. begin
  370. {We only check for the high bound if it is < 255, because
  371. set elements higher than 255 do nt exist.}
  372. case p^.left^.location.loc of
  373. LOC_REGISTER,
  374. LOC_CREGISTER :
  375. exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
  376. setparts[i].stop+1,p^.left^.location.register)));
  377. else
  378. exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
  379. setparts[i].stop+1,R_D0)));
  380. { exprasmlist^.concat(new(pai68k,op_const_ref(A_CMP,S_B,
  381. setparts[i].stop+1,newreference(p^.left^.location.reference))));}
  382. end; { end case }
  383. {If higher, element is in set.}
  384. emitl(A_BCS,l);
  385. end
  386. else
  387. begin
  388. exprasmlist^.concat(new(pai68k,op_const_reg(A_OR,S_B,$01,R_CCR)));
  389. emitl(A_JMP,l);
  390. end;
  391. end;
  392. {Emit the jump over label.}
  393. exprasmlist^.concat(new(pai_label,init(l2)));
  394. end
  395. else
  396. begin
  397. {Emit code to check if left is an element.}
  398. case p^.left^.location.loc of
  399. LOC_REGISTER,
  400. LOC_CREGISTER :
  401. exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
  402. setparts[i].stop,p^.left^.location.register)));
  403. else
  404. { exprasmlist^.concat(new(pai68k,op_const_ref(A_CMP,S_B,
  405. setparts[i].stop,newreference(p^.left^.location.reference))));}
  406. exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
  407. setparts[i].stop,R_D0)));
  408. end;
  409. {Result should be in carry flag when ranges are used.}
  410. if ranges then
  411. exprasmlist^.concat(new(pai68k, op_const_reg(A_OR,S_B,$01,R_CCR)));
  412. {If found, jump to end.}
  413. emitl(A_BEQ,l);
  414. end;
  415. if ranges then
  416. { clear carry flag }
  417. exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_B,$FE,R_CCR)));
  418. {To compensate for not doing a second pass.}
  419. stringdispose(p^.right^.location.reference.symbol);
  420. {Now place the end label.}
  421. exprasmlist^.concat(new(pai_label,init(l)));
  422. end
  423. else
  424. begin
  425. { calculate both operators }
  426. { the complex one first }
  427. firstcomplex(p);
  428. secondpass(p^.left);
  429. set_location(p^.location,p^.left^.location);
  430. { are too few registers free? }
  431. pushed:=maybe_push(p^.right^.registers32,p);
  432. secondpass(p^.right);
  433. if pushed then restore(p);
  434. { of course not commutative }
  435. if p^.swaped then
  436. swaptree(p);
  437. { SET_IN_BYTE is an inline assembler procedure instead }
  438. { of a normal procedure, which is *MUCH* faster }
  439. { Parameters are passed by registers, and FLAGS are set }
  440. { according to the result. }
  441. { a0 = address of set }
  442. { d0.b = value to compare with }
  443. { CARRY SET IF FOUND ON EXIT }
  444. loadsetelement(p^.left);
  445. exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,
  446. newreference(p^.right^.location.reference),R_A0)));;
  447. { emitpushreferenceaddr(p^.right^.location.reference);}
  448. del_reference(p^.right^.location.reference);
  449. emitcall('FPC_SET_IN_BYTE',true);
  450. { ungetiftemp(p^.right^.location.reference); }
  451. p^.location.loc:=LOC_FLAGS;
  452. p^.location.resflags:=F_C;
  453. end;
  454. end;
  455. end;
  456. end;
  457. {*****************************************************************************
  458. SecondCase
  459. *****************************************************************************}
  460. procedure secondcase(var p : ptree);
  461. var
  462. with_sign : boolean;
  463. opsize : topsize;
  464. jmp_gt,jmp_le,jmp_lee : tasmop;
  465. hp : ptree;
  466. { register with case expression }
  467. hregister : tregister;
  468. endlabel,elselabel : plabel;
  469. { true, if we can omit the range check of the jump table }
  470. jumptable_no_range : boolean;
  471. procedure gentreejmp(p : pcaserecord);
  472. var
  473. lesslabel,greaterlabel : plabel;
  474. begin
  475. emitl(A_LABEL,p^._at);
  476. { calculate labels for left and right }
  477. if (p^.less=nil) then
  478. lesslabel:=elselabel
  479. else
  480. lesslabel:=p^.less^._at;
  481. if (p^.greater=nil) then
  482. greaterlabel:=elselabel
  483. else
  484. greaterlabel:=p^.greater^._at;
  485. { calculate labels for left and right }
  486. { no range label: }
  487. if p^._low=p^._high then
  488. begin
  489. exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,opsize,p^._low,hregister)));
  490. if greaterlabel=lesslabel then
  491. begin
  492. emitl(A_BNE,lesslabel);
  493. end
  494. else
  495. begin
  496. emitl(jmp_le,lesslabel);
  497. emitl(jmp_gt,greaterlabel);
  498. end;
  499. emitl(A_JMP,p^.statement);
  500. end
  501. else
  502. begin
  503. exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,opsize,p^._low,hregister)));
  504. emitl(jmp_le,lesslabel);
  505. exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,opsize,p^._high,hregister)));
  506. emitl(jmp_gt,greaterlabel);
  507. emitl(A_JMP,p^.statement);
  508. end;
  509. if assigned(p^.less) then
  510. gentreejmp(p^.less);
  511. if assigned(p^.greater) then
  512. gentreejmp(p^.greater);
  513. end;
  514. procedure genlinearlist(hp : pcaserecord);
  515. var
  516. first : boolean;
  517. last : longint;
  518. procedure genitem(t : pcaserecord);
  519. begin
  520. if assigned(t^.less) then
  521. genitem(t^.less);
  522. if t^._low=t^._high then
  523. begin
  524. if (t^._low-last > 0) and (t^._low-last < 9) then
  525. exprasmlist^.concat(new(pai68k,op_const_reg(A_SUBQ,opsize,t^._low-last,hregister)))
  526. else
  527. if (t^._low-last = 0) then
  528. exprasmlist^.concat(new(pai68k,op_reg(A_TST,opsize,hregister)))
  529. else
  530. exprasmlist^.concat(new(pai68k,op_const_reg(A_SUB,opsize,t^._low-last,hregister)));
  531. last:=t^._low;
  532. emitl(A_BEQ,t^.statement);
  533. end
  534. else
  535. begin
  536. { it begins with the smallest label, if the value }
  537. { is even smaller then jump immediately to the }
  538. { ELSE-label }
  539. if first then
  540. begin
  541. if (t^._low-1 > 0) and (t^._low < 9) then
  542. exprasmlist^.concat(new(pai68k,op_const_reg(A_SUBQ,opsize,t^._low-1,hregister)))
  543. else
  544. if t^._low-1=0 then
  545. exprasmlist^.concat(new(pai68k,op_reg(A_TST,opsize,hregister)))
  546. else
  547. exprasmlist^.concat(new(pai68k,op_const_reg(A_SUB,opsize,t^._low-1,hregister)));
  548. if t^._low = 0 then
  549. emitl(A_BLE,elselabel)
  550. else
  551. emitl(jmp_lee,elselabel);
  552. end
  553. { if there is no unused label between the last and the }
  554. { present label then the lower limit can be checked }
  555. { immediately. else check the range in between: }
  556. else if (t^._low-last>1)then
  557. begin
  558. if ((t^._low-last-1) > 0) and ((t^._low-last-1) < 9) then
  559. exprasmlist^.concat(new(pai68k,op_const_reg(A_SUBQ,opsize,t^._low-last-1,hregister)))
  560. else
  561. exprasmlist^.concat(new(pai68k,op_const_reg(A_SUB,opsize,t^._low-last-1,hregister)));
  562. emitl(jmp_lee,elselabel);
  563. end;
  564. exprasmlist^.concat(new(pai68k,op_const_reg(A_SUB,opsize,t^._high-t^._low+1,hregister)));
  565. emitl(jmp_lee,t^.statement);
  566. last:=t^._high;
  567. end;
  568. first:=false;
  569. if assigned(t^.greater) then
  570. genitem(t^.greater);
  571. end;
  572. var
  573. hr : tregister;
  574. begin
  575. { case register is modified by the list evalution }
  576. if (p^.left^.location.loc=LOC_CREGISTER) then
  577. begin
  578. hr:=getregister32;
  579. end;
  580. last:=0;
  581. first:=true;
  582. genitem(hp);
  583. emitl(A_JMP,elselabel);
  584. end;
  585. procedure genjumptable(hp : pcaserecord;min_,max_ : longint);
  586. var
  587. table : plabel;
  588. last : longint;
  589. hr : preference;
  590. procedure genitem(t : pcaserecord);
  591. var
  592. i : longint;
  593. begin
  594. if assigned(t^.less) then
  595. genitem(t^.less);
  596. { fill possible hole }
  597. for i:=last+1 to t^._low-1 do
  598. datasegment^.concat(new(pai_const,init_symbol(strpnew(lab2str
  599. (elselabel)))));
  600. for i:=t^._low to t^._high do
  601. datasegment^.concat(new(pai_const,init_symbol(strpnew(lab2str
  602. (t^.statement)))));
  603. last:=t^._high;
  604. if assigned(t^.greater) then
  605. genitem(t^.greater);
  606. end;
  607. begin
  608. if not(jumptable_no_range) then
  609. begin
  610. exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,opsize,min_,hregister)));
  611. { case expr less than min_ => goto elselabel }
  612. emitl(jmp_le,elselabel);
  613. exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,opsize,max_,hregister)));
  614. emitl(jmp_gt,elselabel);
  615. end;
  616. getlabel(table);
  617. { extend with sign }
  618. if opsize=S_W then
  619. begin
  620. { word to long - unsigned }
  621. exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,$ffff,hregister)));
  622. end
  623. else if opsize=S_B then
  624. begin
  625. { byte to long - unsigned }
  626. exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,$ff,hregister)));
  627. end;
  628. new(hr);
  629. reset_reference(hr^);
  630. hr^.symbol:=stringdup(lab2str(table));
  631. hr^.offset:=(-min_)*4;
  632. { add scalefactor *4 to index }
  633. exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_L,2,hregister)));
  634. { hr^.scalefactor:=4; }
  635. hr^.base:=getaddressreg;
  636. emit_reg_reg(A_MOVE,S_L,hregister,hr^.base);
  637. exprasmlist^.concat(new(pai68k,op_ref(A_JMP,S_NO,hr)));
  638. { if not(cs_littlesize in aktglobalswitches^ ) then
  639. datasegment^.concat(new(pai68k,op_const(A_ALIGN,S_NO,4))); }
  640. datasegment^.concat(new(pai_label,init(table)));
  641. last:=min_;
  642. genitem(hp);
  643. if hr^.base <> R_NO then ungetregister(hr^.base);
  644. { !!!!!!!
  645. if not(cs_littlesize in aktglobalswitches^ ) then
  646. exprasmlist^.concat(new(pai68k,op_const(A_ALIGN,S_NO,4)));
  647. }
  648. end;
  649. var
  650. lv,hv,min_label,max_label,labels : longint;
  651. max_linear_list : longint;
  652. begin
  653. getlabel(endlabel);
  654. getlabel(elselabel);
  655. with_sign:=is_signed(p^.left^.resulttype);
  656. if with_sign then
  657. begin
  658. jmp_gt:=A_BGT;
  659. jmp_le:=A_BLT;
  660. jmp_lee:=A_BLE;
  661. end
  662. else
  663. begin
  664. jmp_gt:=A_BHI;
  665. jmp_le:=A_BCS;
  666. jmp_lee:=A_BLS;
  667. end;
  668. cleartempgen;
  669. secondpass(p^.left);
  670. { determines the size of the operand }
  671. { determines the size of the operand }
  672. opsize:=bytes2Sxx[p^.left^.resulttype^.size];
  673. { copy the case expression to a register }
  674. { copy the case expression to a register }
  675. case p^.left^.location.loc of
  676. LOC_REGISTER,
  677. LOC_CREGISTER : hregister:=p^.left^.location.register;
  678. LOC_MEM,LOC_REFERENCE : begin
  679. del_reference(p^.left^.location.reference);
  680. hregister:=getregister32;
  681. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,opsize,newreference(
  682. p^.left^.location.reference),hregister)));
  683. end;
  684. else internalerror(2002);
  685. end;
  686. { now generate the jumps }
  687. if cs_optimize in aktglobalswitches then
  688. begin
  689. { procedures are empirically passed on }
  690. { consumption can also be calculated }
  691. { but does it pay on the different }
  692. { processors? }
  693. { moreover can the size only be appro- }
  694. { ximated as it is not known if rel8, }
  695. { rel16 or rel32 jumps are used }
  696. min_label:=case_get_min(p^.nodes);
  697. max_label:=case_get_max(p^.nodes);
  698. labels:=case_count_labels(p^.nodes);
  699. { can we omit the range check of the jump table }
  700. getrange(p^.left^.resulttype,lv,hv);
  701. jumptable_no_range:=(lv=min_label) and (hv=max_label);
  702. { optimize for size ? }
  703. if cs_littlesize in aktglobalswitches then
  704. begin
  705. if (labels<=2) or ((max_label-min_label)>3*labels) then
  706. { a linear list is always smaller than a jump tree }
  707. genlinearlist(p^.nodes)
  708. else
  709. { if the labels less or more a continuum then }
  710. genjumptable(p^.nodes,min_label,max_label);
  711. end
  712. else
  713. begin
  714. if jumptable_no_range then
  715. max_linear_list:=4
  716. else
  717. max_linear_list:=2;
  718. if (labels<=max_linear_list) then
  719. genlinearlist(p^.nodes)
  720. else
  721. begin
  722. if ((max_label-min_label)>4*labels) then
  723. begin
  724. if labels>16 then
  725. gentreejmp(p^.nodes)
  726. else
  727. genlinearlist(p^.nodes);
  728. end
  729. else
  730. genjumptable(p^.nodes,min_label,max_label);
  731. end;
  732. end;
  733. end
  734. else
  735. { it's always not bad }
  736. genlinearlist(p^.nodes);
  737. { now generate the instructions }
  738. hp:=p^.right;
  739. while assigned(hp) do
  740. begin
  741. cleartempgen;
  742. secondpass(hp^.right);
  743. emitl(A_JMP,endlabel);
  744. hp:=hp^.left;
  745. end;
  746. emitl(A_LABEL,elselabel);
  747. { ... and the else block }
  748. if assigned(p^.elseblock) then
  749. begin
  750. cleartempgen;
  751. secondpass(p^.elseblock);
  752. end;
  753. emitl(A_LABEL,endlabel);
  754. end;
  755. end.
  756. {
  757. $Log$
  758. Revision 1.6 1998-10-13 16:50:11 pierre
  759. * undid some changes of Peter that made the compiler wrong
  760. for m68k (I had to reinsert some ifdefs)
  761. * removed several memory leaks under m68k
  762. * removed the meory leaks for assembler readers
  763. * cross compiling shoud work again better
  764. ( crosscompiling sysamiga works
  765. but as68k still complain about some code !)
  766. Revision 1.5 1998/09/17 09:42:29 peter
  767. + pass_2 for cg386
  768. * Message() -> CGMessage() for pass_1/pass_2
  769. Revision 1.4 1998/09/14 10:44:03 peter
  770. * all internal RTL functions start with FPC_
  771. Revision 1.3 1998/09/07 18:45:59 peter
  772. * update smartlinking, uses getdatalabel
  773. * renamed ptree.value vars to value_str,value_real,value_set
  774. Revision 1.2 1998/09/04 08:41:49 peter
  775. * updated some error CGMessages
  776. Revision 1.1 1998/09/01 09:07:09 peter
  777. * m68k fixes, splitted cg68k like cgi386
  778. }