cg386add.pas 56 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266
  1. {
  2. $Id$
  3. Copyright (c) 1993-98 by Florian Klaempfl
  4. Generate i386 assembler for in add node
  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 cg386add;
  19. interface
  20. uses
  21. tree;
  22. procedure secondadd(var p : ptree);
  23. implementation
  24. uses
  25. cobjects,verbose,globals,
  26. symtable,aasm,i386,types,
  27. cgi386,cgai386,temp_gen,tgeni386,hcodegen;
  28. {*****************************************************************************
  29. Helpers
  30. *****************************************************************************}
  31. procedure SetResultLocation(cmpop,unsigned:boolean;var p :ptree);
  32. var
  33. flags : tresflags;
  34. begin
  35. { remove temporary location if not a set or string }
  36. if (p^.left^.resulttype^.deftype<>stringdef) and
  37. ((p^.left^.resulttype^.deftype<>setdef) or (psetdef(p^.left^.resulttype)^.settype=smallset)) and
  38. (p^.left^.location.loc in [LOC_MEM,LOC_REFERENCE]) then
  39. ungetiftemp(p^.left^.location.reference);
  40. if (p^.right^.resulttype^.deftype<>stringdef) and
  41. ((p^.right^.resulttype^.deftype<>setdef) or (psetdef(p^.right^.resulttype)^.settype=smallset)) and
  42. (p^.right^.location.loc in [LOC_MEM,LOC_REFERENCE]) then
  43. ungetiftemp(p^.right^.location.reference);
  44. { in case of comparison operation the put result in the flags }
  45. if cmpop then
  46. begin
  47. if not(unsigned) then
  48. begin
  49. if p^.swaped then
  50. case p^.treetype of
  51. equaln : flags:=F_E;
  52. unequaln : flags:=F_NE;
  53. ltn : flags:=F_G;
  54. lten : flags:=F_GE;
  55. gtn : flags:=F_L;
  56. gten : flags:=F_LE;
  57. end
  58. else
  59. case p^.treetype of
  60. equaln : flags:=F_E;
  61. unequaln : flags:=F_NE;
  62. ltn : flags:=F_L;
  63. lten : flags:=F_LE;
  64. gtn : flags:=F_G;
  65. gten : flags:=F_GE;
  66. end;
  67. end
  68. else
  69. begin
  70. if p^.swaped then
  71. case p^.treetype of
  72. equaln : flags:=F_E;
  73. unequaln : flags:=F_NE;
  74. ltn : flags:=F_A;
  75. lten : flags:=F_AE;
  76. gtn : flags:=F_B;
  77. gten : flags:=F_BE;
  78. end
  79. else
  80. case p^.treetype of
  81. equaln : flags:=F_E;
  82. unequaln : flags:=F_NE;
  83. ltn : flags:=F_B;
  84. lten : flags:=F_BE;
  85. gtn : flags:=F_A;
  86. gten : flags:=F_AE;
  87. end;
  88. end;
  89. p^.location.loc:=LOC_FLAGS;
  90. p^.location.resflags:=flags;
  91. end;
  92. end;
  93. {*****************************************************************************
  94. Addstring
  95. *****************************************************************************}
  96. procedure addstring(var p : ptree);
  97. var
  98. pushedregs : tpushed;
  99. href : treference;
  100. pushed,
  101. cmpop : boolean;
  102. begin
  103. { string operations are not commutative }
  104. if p^.swaped then
  105. swaptree(p);
  106. {$ifdef UseAnsiString}
  107. if is_ansistring(p^.left^.resulttype) then
  108. begin
  109. case p^.treetype of
  110. addn :
  111. begin
  112. { we do not need destination anymore }
  113. del_reference(p^.left^.location.reference);
  114. del_reference(p^.right^.location.reference);
  115. { concatansistring(p); }
  116. end;
  117. ltn,lten,gtn,gten,
  118. equaln,unequaln :
  119. begin
  120. pushusedregisters(pushedregs,$ff);
  121. secondpass(p^.left);
  122. del_reference(p^.left^.location.reference);
  123. emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
  124. secondpass(p^.right);
  125. del_reference(p^.right^.location.reference);
  126. emitpushreferenceaddr(exprasmlist,p^.right^.location.reference);
  127. emitcall('ANSISTRCMP',true);
  128. maybe_loadesi;
  129. popusedregisters(pushedregs);
  130. end;
  131. end;
  132. end
  133. else
  134. {$endif UseAnsiString}
  135. case p^.treetype of
  136. addn :
  137. begin
  138. cmpop:=false;
  139. secondpass(p^.left);
  140. { if str_concat is set in expr
  141. s:=s+ ... no need to create a temp string (PM) }
  142. if (p^.left^.treetype<>addn) and not (p^.use_strconcat) then
  143. begin
  144. { can only reference be }
  145. { string in register would be funny }
  146. { therefore produce a temporary string }
  147. { release the registers }
  148. del_reference(p^.left^.location.reference);
  149. gettempofsizereference(256,href);
  150. copystring(href,p^.left^.location.reference,255);
  151. ungetiftemp(p^.left^.location.reference);
  152. { does not hurt: }
  153. p^.left^.location.loc:=LOC_MEM;
  154. p^.left^.location.reference:=href;
  155. end;
  156. secondpass(p^.right);
  157. { on the right we do not need the register anymore too }
  158. del_reference(p^.right^.location.reference);
  159. { if p^.right^.resulttype^.deftype=orddef then
  160. begin
  161. pushusedregisters(pushedregs,$ff);
  162. exprasmlist^.concat(new(pai386,op_ref_reg(
  163. A_LEA,S_L,newreference(p^.left^.location.reference),R_EDI)));
  164. exprasmlist^.concat(new(pai386,op_reg_reg(
  165. A_XOR,S_L,R_EBX,R_EBX)));
  166. reset_reference(href);
  167. href.base:=R_EDI;
  168. exprasmlist^.concat(new(pai386,op_ref_reg(
  169. A_MOV,S_B,newreference(href),R_BL)));
  170. exprasmlist^.concat(new(pai386,op_reg(
  171. A_INC,S_L,R_EBX)));
  172. exprasmlist^.concat(new(pai386,op_reg_ref(
  173. A_MOV,S_B,R_BL,newreference(href))));
  174. href.index:=R_EBX;
  175. if p^.right^.treetype=ordconstn then
  176. exprasmlist^.concat(new(pai386,op_const_ref(
  177. A_MOV,S_L,p^.right^.value,newreference(href))))
  178. else
  179. begin
  180. if p^.right^.location.loc in [LOC_CREGISTER,LOC_REGISTER] then
  181. exprasmlist^.concat(new(pai386,op_reg_ref(
  182. A_MOV,S_B,p^.right^.location.register,newreference(href))))
  183. else
  184. begin
  185. exprasmlist^.concat(new(pai386,op_ref_reg(
  186. A_MOV,S_L,newreference(p^.right^.location.reference),R_EAX)));
  187. exprasmlist^.concat(new(pai386,op_reg_ref(
  188. A_MOV,S_B,R_AL,newreference(href))));
  189. end;
  190. end;
  191. popusedregisters(pushedregs);
  192. end
  193. else }
  194. begin
  195. if p^.use_strconcat then
  196. pushusedregisters(pushedregs,pstringdef(p^.left^.resulttype)^.len)
  197. else
  198. pushusedregisters(pushedregs,$ff);
  199. emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
  200. emitpushreferenceaddr(exprasmlist,p^.right^.location.reference);
  201. emitcall('STRCONCAT',true);
  202. maybe_loadesi;
  203. popusedregisters(pushedregs);
  204. end;
  205. set_location(p^.location,p^.left^.location);
  206. ungetiftemp(p^.right^.location.reference);
  207. end;
  208. ltn,lten,gtn,gten,
  209. equaln,unequaln :
  210. begin
  211. cmpop:=true;
  212. { generate better code for s='' and s<>'' }
  213. if (p^.treetype in [equaln,unequaln]) and
  214. (((p^.left^.treetype=stringconstn) and (p^.left^.values^='')) or
  215. ((p^.right^.treetype=stringconstn) and (p^.right^.values^=''))) then
  216. begin
  217. secondpass(p^.left);
  218. { are too few registers free? }
  219. pushed:=maybe_push(p^.right^.registers32,p);
  220. secondpass(p^.right);
  221. if pushed then restore(p);
  222. del_reference(p^.right^.location.reference);
  223. del_reference(p^.left^.location.reference);
  224. { only one node can be stringconstn }
  225. { else pass 1 would have evaluted }
  226. { this node }
  227. if p^.left^.treetype=stringconstn then
  228. exprasmlist^.concat(new(pai386,op_const_ref(
  229. A_CMP,S_B,0,newreference(p^.right^.location.reference))))
  230. else
  231. exprasmlist^.concat(new(pai386,op_const_ref(
  232. A_CMP,S_B,0,newreference(p^.left^.location.reference))));
  233. end
  234. else
  235. begin
  236. pushusedregisters(pushedregs,$ff);
  237. secondpass(p^.left);
  238. del_reference(p^.left^.location.reference);
  239. emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
  240. secondpass(p^.right);
  241. del_reference(p^.right^.location.reference);
  242. emitpushreferenceaddr(exprasmlist,p^.right^.location.reference);
  243. emitcall('STRCMP',true);
  244. maybe_loadesi;
  245. popusedregisters(pushedregs);
  246. end;
  247. ungetiftemp(p^.left^.location.reference);
  248. ungetiftemp(p^.right^.location.reference);
  249. end;
  250. else Message(sym_e_type_mismatch);
  251. end;
  252. SetResultLocation(cmpop,true,p);
  253. end;
  254. {*****************************************************************************
  255. Addset
  256. *****************************************************************************}
  257. procedure addset(var p : ptree);
  258. var
  259. right_small,
  260. cmpop,
  261. pushed : boolean;
  262. href2,
  263. href : treference;
  264. swapp : ptree;
  265. pushedregs : tpushed;
  266. begin
  267. cmpop:=false;
  268. { not commutative }
  269. if p^.swaped then
  270. swaptree(p);
  271. secondpass(p^.left);
  272. { are too few registers free? }
  273. pushed:=maybe_push(p^.right^.registers32,p);
  274. secondpass(p^.right);
  275. if codegenerror then
  276. exit;
  277. if pushed then
  278. restore(p);
  279. set_location(p^.location,p^.left^.location);
  280. right_small:=(p^.right^.resulttype^.deftype=setdef) and (psetdef(p^.right^.resulttype)^.settype=smallset);
  281. { handle operations }
  282. case p^.treetype of
  283. equaln,
  284. unequaln : begin
  285. cmpop:=true;
  286. del_reference(p^.left^.location.reference);
  287. del_reference(p^.right^.location.reference);
  288. pushusedregisters(pushedregs,$ff);
  289. emitpushreferenceaddr(exprasmlist,p^.right^.location.reference);
  290. emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
  291. emitcall('SET_COMP_SETS',true);
  292. maybe_loadesi;
  293. popusedregisters(pushedregs);
  294. ungetiftemp(p^.left^.location.reference);
  295. ungetiftemp(p^.right^.location.reference);
  296. end;
  297. addn : begin
  298. { add can be an other SET or Range or Element ! }
  299. del_reference(p^.left^.location.reference);
  300. del_reference(p^.right^.location.reference);
  301. pushusedregisters(pushedregs,$ff);
  302. href.symbol:=nil;
  303. gettempofsizereference(32,href);
  304. case p^.right^.treetype of
  305. setelen : begin
  306. concatcopy(p^.left^.location.reference,href,32,false);
  307. pushsetelement(p^.right^.left);
  308. emitpushreferenceaddr(exprasmlist,href);
  309. emitcall('SET_SET_BYTE',true);
  310. end;
  311. rangen : begin
  312. concatcopy(p^.left^.location.reference,href,32,false);
  313. pushsetelement(p^.right^.right);
  314. pushsetelement(p^.right^.left);
  315. emitpushreferenceaddr(exprasmlist,href);
  316. emitcall('SET_SET_RANGE',true);
  317. end;
  318. else
  319. begin
  320. { must be an other set }
  321. emitpushreferenceaddr(exprasmlist,href);
  322. emitpushreferenceaddr(exprasmlist,p^.right^.location.reference);
  323. emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
  324. emitcall('SET_ADD_SETS',true);
  325. end;
  326. end;
  327. maybe_loadesi;
  328. popusedregisters(pushedregs);
  329. ungetiftemp(p^.left^.location.reference);
  330. ungetiftemp(p^.right^.location.reference);
  331. p^.location.loc:=LOC_MEM;
  332. stringdispose(p^.location.reference.symbol);
  333. p^.location.reference:=href;
  334. end;
  335. subn,
  336. symdifn,
  337. muln : begin
  338. if p^.right^.treetype in [rangen,setelen] then
  339. internalerror(45362);
  340. del_reference(p^.left^.location.reference);
  341. del_reference(p^.right^.location.reference);
  342. href.symbol:=nil;
  343. pushusedregisters(pushedregs,$ff);
  344. gettempofsizereference(32,href);
  345. emitpushreferenceaddr(exprasmlist,href);
  346. emitpushreferenceaddr(exprasmlist,p^.right^.location.reference);
  347. emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
  348. case p^.treetype of
  349. subn : emitcall('SET_SUB_SETS',true);
  350. symdifn : emitcall('SET_SYMDIF_SETS',true);
  351. muln : emitcall('SET_MUL_SETS',true);
  352. end;
  353. maybe_loadesi;
  354. popusedregisters(pushedregs);
  355. ungetiftemp(p^.left^.location.reference);
  356. ungetiftemp(p^.right^.location.reference);
  357. p^.location.loc:=LOC_MEM;
  358. stringdispose(p^.location.reference.symbol);
  359. p^.location.reference:=href;
  360. end;
  361. else
  362. Message(sym_e_type_mismatch);
  363. end;
  364. SetResultLocation(cmpop,true,p);
  365. end;
  366. {*****************************************************************************
  367. SecondAdd
  368. *****************************************************************************}
  369. procedure secondadd(var p : ptree);
  370. { is also being used for xor, and "mul", "sub, or and comparative }
  371. { operators }
  372. label do_normal;
  373. var
  374. swapp : ptree;
  375. hregister : tregister;
  376. pushed,mboverflow,cmpop : boolean;
  377. op : tasmop;
  378. pushedregs : tpushed;
  379. flags : tresflags;
  380. otl,ofl : plabel;
  381. power : longint;
  382. href : treference;
  383. opsize : topsize;
  384. hl4: plabel;
  385. { true, if unsigned types are compared }
  386. unsigned : boolean;
  387. { is_in_dest if the result is put directly into }
  388. { the resulting refernce or varregister }
  389. { true, if a small set is handled with the longint code }
  390. is_set : boolean;
  391. is_in_dest : boolean;
  392. { true, if for sets subtractions the extra not should generated }
  393. extra_not : boolean;
  394. {$ifdef SUPPORT_MMX}
  395. mmxbase : tmmxtype;
  396. {$endif SUPPORT_MMX}
  397. begin
  398. { to make it more readable, string and set (not smallset!) have their
  399. own procedures }
  400. case p^.left^.resulttype^.deftype of
  401. stringdef : begin
  402. addstring(p);
  403. exit;
  404. end;
  405. setdef : begin
  406. { not for smallsets }
  407. if not(psetdef(p^.left^.resulttype)^.settype=smallset) then
  408. begin
  409. addset(p);
  410. exit;
  411. end;
  412. end;
  413. end;
  414. unsigned:=false;
  415. is_in_dest:=false;
  416. extra_not:=false;
  417. opsize:=S_L;
  418. { calculate the operator which is more difficult }
  419. firstcomplex(p);
  420. { handling boolean expressions extra: }
  421. if ((p^.left^.resulttype^.deftype=orddef) and
  422. (porddef(p^.left^.resulttype)^.typ in [bool8bit,bool16bit,bool32bit])) or
  423. ((p^.right^.resulttype^.deftype=orddef) and
  424. (porddef(p^.right^.resulttype)^.typ in [bool8bit,bool16bit,bool32bit])) then
  425. begin
  426. if (porddef(p^.left^.resulttype)^.typ=bool8bit) or
  427. (porddef(p^.right^.resulttype)^.typ=bool8bit) then
  428. opsize:=S_B
  429. else
  430. if (porddef(p^.left^.resulttype)^.typ=bool16bit) or
  431. (porddef(p^.right^.resulttype)^.typ=bool16bit) then
  432. opsize:=S_W
  433. else
  434. opsize:=S_L;
  435. case p^.treetype of
  436. andn,
  437. orn : begin
  438. p^.location.loc:=LOC_JUMP;
  439. cmpop:=false;
  440. case p^.treetype of
  441. andn : begin
  442. otl:=truelabel;
  443. getlabel(truelabel);
  444. secondpass(p^.left);
  445. maketojumpbool(p^.left);
  446. emitl(A_LABEL,truelabel);
  447. truelabel:=otl;
  448. end;
  449. orn : begin
  450. ofl:=falselabel;
  451. getlabel(falselabel);
  452. secondpass(p^.left);
  453. maketojumpbool(p^.left);
  454. emitl(A_LABEL,falselabel);
  455. falselabel:=ofl;
  456. end;
  457. else
  458. Message(sym_e_type_mismatch);
  459. end;
  460. secondpass(p^.right);
  461. maketojumpbool(p^.right);
  462. end;
  463. unequaln,
  464. equaln,xorn : begin
  465. if p^.left^.treetype=ordconstn then
  466. swaptree(p);
  467. secondpass(p^.left);
  468. p^.location:=p^.left^.location;
  469. { are enough registers free ? }
  470. pushed:=maybe_push(p^.right^.registers32,p);
  471. secondpass(p^.right);
  472. if pushed then restore(p);
  473. goto do_normal;
  474. end
  475. else
  476. Message(sym_e_type_mismatch);
  477. end
  478. end
  479. else
  480. begin
  481. { in case of constant put it to the left }
  482. if p^.left^.treetype=ordconstn then
  483. swaptree(p);
  484. secondpass(p^.left);
  485. { this will be complicated as
  486. a lot of code below assumes that
  487. p^.location and p^.left^.location are the same }
  488. {$ifdef test_dest_loc}
  489. if dest_loc_known and (dest_loc_tree=p) and
  490. ((dest_loc.loc=LOC_REGISTER) or (dest_loc.loc=LOC_CREGISTER)) then
  491. begin
  492. set_location(p^.location,dest_loc);
  493. in_dest_loc:=true;
  494. is_in_dest:=true;
  495. end
  496. else
  497. {$endif test_dest_loc}
  498. set_location(p^.location,p^.left^.location);
  499. { are too few registers free? }
  500. pushed:=maybe_push(p^.right^.registers32,p);
  501. secondpass(p^.right);
  502. if pushed then
  503. restore(p);
  504. if (p^.left^.resulttype^.deftype=pointerdef) or
  505. (p^.right^.resulttype^.deftype=pointerdef) or
  506. ((p^.right^.resulttype^.deftype=objectdef) and
  507. pobjectdef(p^.right^.resulttype)^.isclass and
  508. (p^.left^.resulttype^.deftype=objectdef) and
  509. pobjectdef(p^.left^.resulttype)^.isclass
  510. ) or
  511. (p^.left^.resulttype^.deftype=classrefdef) or
  512. (p^.left^.resulttype^.deftype=procvardef) or
  513. (p^.left^.resulttype^.deftype=enumdef) or
  514. ((p^.left^.resulttype^.deftype=orddef) and
  515. (porddef(p^.left^.resulttype)^.typ=s32bit)) or
  516. ((p^.right^.resulttype^.deftype=orddef) and
  517. (porddef(p^.right^.resulttype)^.typ=s32bit)) or
  518. ((p^.left^.resulttype^.deftype=orddef) and
  519. (porddef(p^.left^.resulttype)^.typ=u32bit)) or
  520. ((p^.right^.resulttype^.deftype=orddef) and
  521. (porddef(p^.right^.resulttype)^.typ=u32bit)) or
  522. { as well as small sets }
  523. ((p^.left^.resulttype^.deftype=setdef) and
  524. (psetdef(p^.left^.resulttype)^.settype=smallset)
  525. ) then
  526. begin
  527. do_normal:
  528. mboverflow:=false;
  529. cmpop:=false;
  530. if (p^.left^.resulttype^.deftype=pointerdef) or
  531. (p^.right^.resulttype^.deftype=pointerdef) or
  532. ((p^.left^.resulttype^.deftype=orddef) and
  533. (porddef(p^.left^.resulttype)^.typ=u32bit)) or
  534. ((p^.right^.resulttype^.deftype=orddef) and
  535. (porddef(p^.right^.resulttype)^.typ=u32bit)) then
  536. unsigned:=true;
  537. is_set:=p^.resulttype^.deftype=setdef;
  538. case p^.treetype of
  539. addn : begin
  540. if is_set then
  541. begin
  542. op:=A_OR;
  543. mboverflow:=false;
  544. unsigned:=false;
  545. end
  546. else
  547. begin
  548. op:=A_ADD;
  549. mboverflow:=true;
  550. end;
  551. end;
  552. symdifn : begin
  553. { the symetric diff is only for sets }
  554. if is_set then
  555. begin
  556. op:=A_XOR;
  557. mboverflow:=false;
  558. unsigned:=false;
  559. end
  560. else
  561. begin
  562. Message(sym_e_type_mismatch);
  563. end;
  564. end;
  565. muln : begin
  566. if is_set then
  567. begin
  568. op:=A_AND;
  569. mboverflow:=false;
  570. unsigned:=false;
  571. end
  572. else
  573. begin
  574. if unsigned then
  575. op:=A_MUL
  576. else
  577. op:=A_IMUL;
  578. mboverflow:=true;
  579. end;
  580. end;
  581. subn : begin
  582. if is_set then
  583. begin
  584. op:=A_AND;
  585. mboverflow:=false;
  586. unsigned:=false;
  587. extra_not:=true;
  588. end
  589. else
  590. begin
  591. op:=A_SUB;
  592. mboverflow:=true;
  593. end;
  594. end;
  595. ltn,lten,gtn,gten,
  596. equaln,unequaln :
  597. begin
  598. op:=A_CMP;
  599. cmpop:=true;
  600. end;
  601. xorn : op:=A_XOR;
  602. orn : op:=A_OR;
  603. andn : op:=A_AND;
  604. else Message(sym_e_type_mismatch);
  605. end;
  606. { left and right no register? }
  607. { then one must be demanded }
  608. if (p^.left^.location.loc<>LOC_REGISTER) and
  609. (p^.right^.location.loc<>LOC_REGISTER) then
  610. begin
  611. { register variable ? }
  612. if (p^.left^.location.loc=LOC_CREGISTER) then
  613. begin
  614. { it is OK if this is the destination }
  615. if is_in_dest then
  616. begin
  617. hregister:=p^.location.register;
  618. emit_reg_reg(A_MOV,opsize,p^.left^.location.register,
  619. hregister);
  620. end
  621. else
  622. if cmpop then
  623. begin
  624. { do not disturb the register }
  625. hregister:=p^.location.register;
  626. end
  627. else
  628. begin
  629. case opsize of
  630. S_L : hregister:=getregister32;
  631. S_B : hregister:=reg32toreg8(getregister32);
  632. end;
  633. emit_reg_reg(A_MOV,opsize,p^.left^.location.register,
  634. hregister);
  635. end
  636. end
  637. else
  638. begin
  639. del_reference(p^.left^.location.reference);
  640. if is_in_dest then
  641. begin
  642. hregister:=p^.location.register;
  643. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,opsize,
  644. newreference(p^.left^.location.reference),hregister)));
  645. end
  646. else
  647. begin
  648. { first give free, then demand new register }
  649. case opsize of
  650. S_L : hregister:=getregister32;
  651. S_W : hregister:=reg32toreg16(getregister32);
  652. S_B : hregister:=reg32toreg8(getregister32);
  653. end;
  654. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,opsize,
  655. newreference(p^.left^.location.reference),hregister)));
  656. end;
  657. end;
  658. p^.location.loc:=LOC_REGISTER;
  659. p^.location.register:=hregister;
  660. end
  661. else
  662. { if on the right the register then swap }
  663. if (p^.right^.location.loc=LOC_REGISTER) then
  664. begin
  665. swap_location(p^.location,p^.right^.location);
  666. { newly swapped also set swapped flag }
  667. p^.swaped:=not(p^.swaped);
  668. end;
  669. { at this point, p^.location.loc should be LOC_REGISTER }
  670. { and p^.location.register should be a valid register }
  671. { containing the left result }
  672. if p^.right^.location.loc<>LOC_REGISTER then
  673. begin
  674. if (p^.treetype=subn) and p^.swaped then
  675. begin
  676. if p^.right^.location.loc=LOC_CREGISTER then
  677. begin
  678. if extra_not then
  679. exprasmlist^.concat(new(pai386,op_reg(A_NOT,opsize,p^.location.register)));
  680. emit_reg_reg(A_MOV,opsize,p^.right^.location.register,R_EDI);
  681. emit_reg_reg(op,opsize,p^.location.register,R_EDI);
  682. emit_reg_reg(A_MOV,opsize,R_EDI,p^.location.register);
  683. end
  684. else
  685. begin
  686. if extra_not then
  687. exprasmlist^.concat(new(pai386,op_reg(A_NOT,opsize,p^.location.register)));
  688. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,opsize,
  689. newreference(p^.right^.location.reference),R_EDI)));
  690. exprasmlist^.concat(new(pai386,op_reg_reg(op,opsize,p^.location.register,R_EDI)));
  691. exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,opsize,R_EDI,p^.location.register)));
  692. del_reference(p^.right^.location.reference);
  693. end;
  694. end
  695. else
  696. begin
  697. if (p^.right^.treetype=ordconstn) and
  698. (op=A_CMP) and
  699. (p^.right^.value=0) then
  700. begin
  701. exprasmlist^.concat(new(pai386,op_reg_reg(A_TEST,opsize,p^.location.register,
  702. p^.location.register)));
  703. end
  704. else if (p^.right^.treetype=ordconstn) and
  705. (op=A_ADD) and
  706. (p^.right^.value=1) then
  707. begin
  708. exprasmlist^.concat(new(pai386,op_reg(A_INC,opsize,
  709. p^.location.register)));
  710. end
  711. else if (p^.right^.treetype=ordconstn) and
  712. (op=A_SUB) and
  713. (p^.right^.value=1) then
  714. begin
  715. exprasmlist^.concat(new(pai386,op_reg(A_DEC,opsize,
  716. p^.location.register)));
  717. end
  718. else if (p^.right^.treetype=ordconstn) and
  719. (op=A_IMUL) and
  720. (ispowerof2(p^.right^.value,power)) then
  721. begin
  722. exprasmlist^.concat(new(pai386,op_const_reg(A_SHL,opsize,power,
  723. p^.location.register)));
  724. end
  725. else
  726. begin
  727. if (p^.right^.location.loc=LOC_CREGISTER) then
  728. begin
  729. if extra_not then
  730. begin
  731. emit_reg_reg(A_MOV,S_L,p^.right^.location.register,R_EDI);
  732. exprasmlist^.concat(new(pai386,op_reg(A_NOT,S_L,R_EDI)));
  733. emit_reg_reg(A_AND,S_L,R_EDI,
  734. p^.location.register);
  735. end
  736. else
  737. begin
  738. emit_reg_reg(op,opsize,p^.right^.location.register,
  739. p^.location.register);
  740. end;
  741. end
  742. else
  743. begin
  744. if extra_not then
  745. begin
  746. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(
  747. p^.right^.location.reference),R_EDI)));
  748. exprasmlist^.concat(new(pai386,op_reg(A_NOT,S_L,R_EDI)));
  749. emit_reg_reg(A_AND,S_L,R_EDI,
  750. p^.location.register);
  751. end
  752. else
  753. begin
  754. exprasmlist^.concat(new(pai386,op_ref_reg(op,opsize,newreference(
  755. p^.right^.location.reference),p^.location.register)));
  756. end;
  757. del_reference(p^.right^.location.reference);
  758. end;
  759. end;
  760. end;
  761. end
  762. else
  763. begin
  764. { when swapped another result register }
  765. if (p^.treetype=subn) and p^.swaped then
  766. begin
  767. if extra_not then
  768. exprasmlist^.concat(new(pai386,op_reg(A_NOT,S_L,p^.location.register)));
  769. exprasmlist^.concat(new(pai386,op_reg_reg(op,opsize,
  770. p^.location.register,p^.right^.location.register)));
  771. swap_location(p^.location,p^.right^.location);
  772. { newly swapped also set swapped flag }
  773. { just to maintain ordering }
  774. p^.swaped:=not(p^.swaped);
  775. end
  776. else
  777. begin
  778. if extra_not then
  779. exprasmlist^.concat(new(pai386,op_reg(A_NOT,S_L,p^.right^.location.register)));
  780. exprasmlist^.concat(new(pai386,op_reg_reg(op,opsize,
  781. p^.right^.location.register,
  782. p^.location.register)));
  783. end;
  784. case opsize of
  785. S_L : ungetregister32(p^.right^.location.register);
  786. S_B : ungetregister32(reg8toreg32(p^.right^.location.register));
  787. end;
  788. end;
  789. if cmpop then
  790. case opsize of
  791. S_L : ungetregister32(p^.location.register);
  792. S_B : ungetregister32(reg8toreg32(p^.location.register));
  793. end;
  794. { only in case of overflow operations }
  795. { produce overflow code }
  796. if mboverflow then
  797. { we must put it here directly, because sign of operation }
  798. { is in unsigned VAR!! }
  799. begin
  800. if cs_check_overflow in aktlocalswitches then
  801. begin
  802. getlabel(hl4);
  803. if unsigned then
  804. emitl(A_JNB,hl4)
  805. else
  806. emitl(A_JNO,hl4);
  807. emitcall('RE_OVERFLOW',true);
  808. emitl(A_LABEL,hl4);
  809. end;
  810. end;
  811. end
  812. else if ((p^.left^.resulttype^.deftype=orddef) and
  813. (porddef(p^.left^.resulttype)^.typ=uchar)) then
  814. begin
  815. case p^.treetype of
  816. ltn,lten,gtn,gten,
  817. equaln,unequaln :
  818. cmpop:=true;
  819. else Message(sym_e_type_mismatch);
  820. end;
  821. unsigned:=true;
  822. { left and right no register? }
  823. { the one must be demanded }
  824. if (p^.location.loc<>LOC_REGISTER) and
  825. (p^.right^.location.loc<>LOC_REGISTER) then
  826. begin
  827. if p^.location.loc=LOC_CREGISTER then
  828. begin
  829. if cmpop then
  830. { do not disturb register }
  831. hregister:=p^.location.register
  832. else
  833. begin
  834. hregister:=reg32toreg8(getregister32);
  835. emit_reg_reg(A_MOV,S_B,p^.location.register,
  836. hregister);
  837. end;
  838. end
  839. else
  840. begin
  841. del_reference(p^.location.reference);
  842. { first give free then demand new register }
  843. hregister:=reg32toreg8(getregister32);
  844. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_B,newreference(p^.location.reference),
  845. hregister)));
  846. end;
  847. p^.location.loc:=LOC_REGISTER;
  848. p^.location.register:=hregister;
  849. end;
  850. { now p always a register }
  851. if (p^.right^.location.loc=LOC_REGISTER) and
  852. (p^.location.loc<>LOC_REGISTER) then
  853. begin
  854. swap_location(p^.location,p^.right^.location);
  855. { newly swapped also set swapped flag }
  856. p^.swaped:=not(p^.swaped);
  857. end;
  858. if p^.right^.location.loc<>LOC_REGISTER then
  859. begin
  860. if p^.right^.location.loc=LOC_CREGISTER then
  861. begin
  862. emit_reg_reg(A_CMP,S_B,
  863. p^.right^.location.register,p^.location.register);
  864. end
  865. else
  866. begin
  867. exprasmlist^.concat(new(pai386,op_ref_reg(A_CMP,S_B,newreference(
  868. p^.right^.location.reference),p^.location.register)));
  869. del_reference(p^.right^.location.reference);
  870. end;
  871. end
  872. else
  873. begin
  874. emit_reg_reg(A_CMP,S_B,p^.right^.location.register,
  875. p^.location.register);
  876. ungetregister32(reg8toreg32(p^.right^.location.register));
  877. end;
  878. ungetregister32(reg8toreg32(p^.location.register));
  879. end
  880. else if (p^.left^.resulttype^.deftype=floatdef) and
  881. (pfloatdef(p^.left^.resulttype)^.typ<>f32bit) then
  882. begin
  883. { real constants to the left }
  884. if p^.left^.treetype=realconstn then
  885. swaptree(p);
  886. cmpop:=false;
  887. case p^.treetype of
  888. addn : op:=A_FADDP;
  889. muln : op:=A_FMULP;
  890. subn : op:=A_FSUBP;
  891. slashn : op:=A_FDIVP;
  892. ltn,lten,gtn,gten,
  893. equaln,unequaln : begin
  894. op:=A_FCOMPP;
  895. cmpop:=true;
  896. end;
  897. else Message(sym_e_type_mismatch);
  898. end;
  899. if (p^.right^.location.loc<>LOC_FPU) then
  900. begin
  901. floatload(pfloatdef(p^.right^.resulttype)^.typ,p^.right^.location.reference);
  902. if (p^.left^.location.loc<>LOC_FPU) then
  903. floatload(pfloatdef(p^.left^.resulttype)^.typ,p^.left^.location.reference)
  904. { left was on the stack => swap }
  905. else
  906. p^.swaped:=not(p^.swaped);
  907. { releases the right reference }
  908. del_reference(p^.right^.location.reference);
  909. end
  910. { the nominator in st0 }
  911. else if (p^.left^.location.loc<>LOC_FPU) then
  912. floatload(pfloatdef(p^.left^.resulttype)^.typ,p^.left^.location.reference)
  913. { fpu operands are always in the wrong order on the stack }
  914. else
  915. p^.swaped:=not(p^.swaped);
  916. { releases the left reference }
  917. if (p^.left^.location.loc<>LOC_FPU) then
  918. del_reference(p^.left^.location.reference);
  919. { if we swaped the tree nodes, then use the reverse operator }
  920. if p^.swaped then
  921. begin
  922. if (p^.treetype=slashn) then
  923. op:=A_FDIVRP
  924. else if (p^.treetype=subn) then
  925. op:=A_FSUBRP;
  926. end;
  927. { to avoid the pentium bug
  928. if (op=FDIVP) and (opt_processors=pentium) then
  929. exprasmlist^.concat(new(pai386,op_CALL,S_NO,'EMUL_FDIVP')
  930. else
  931. }
  932. { the Intel assemblers want operands }
  933. if op<>A_FCOMPP then
  934. exprasmlist^.concat(new(pai386,op_reg_reg(op,S_NO,R_ST,R_ST1)))
  935. else
  936. exprasmlist^.concat(new(pai386,op_none(op,S_NO)));
  937. { on comparison load flags }
  938. if cmpop then
  939. begin
  940. if not(R_EAX in unused) then
  941. emit_reg_reg(A_MOV,S_L,R_EAX,R_EDI);
  942. exprasmlist^.concat(new(pai386,op_reg(A_FNSTSW,S_NO,R_AX)));
  943. exprasmlist^.concat(new(pai386,op_none(A_SAHF,S_NO)));
  944. if not(R_EAX in unused) then
  945. emit_reg_reg(A_MOV,S_L,R_EDI,R_EAX);
  946. if p^.swaped then
  947. case p^.treetype of
  948. equaln : flags:=F_E;
  949. unequaln : flags:=F_NE;
  950. ltn : flags:=F_A;
  951. lten : flags:=F_AE;
  952. gtn : flags:=F_B;
  953. gten : flags:=F_BE;
  954. end
  955. else
  956. case p^.treetype of
  957. equaln : flags:=F_E;
  958. unequaln : flags:=F_NE;
  959. ltn : flags:=F_B;
  960. lten : flags:=F_BE;
  961. gtn : flags:=F_A;
  962. gten : flags:=F_AE;
  963. end;
  964. p^.location.loc:=LOC_FLAGS;
  965. p^.location.resflags:=flags;
  966. cmpop:=false;
  967. end
  968. else
  969. p^.location.loc:=LOC_FPU;
  970. end
  971. {$ifdef SUPPORT_MMX}
  972. else if is_mmx_able_array(p^.left^.resulttype) then
  973. begin
  974. cmpop:=false;
  975. mmxbase:=mmx_type(p^.left^.resulttype);
  976. case p^.treetype of
  977. addn : begin
  978. if (cs_mmx_saturation in aktlocalswitches) then
  979. begin
  980. case mmxbase of
  981. mmxs8bit:
  982. op:=A_PADDSB;
  983. mmxu8bit:
  984. op:=A_PADDUSB;
  985. mmxs16bit,mmxfixed16:
  986. op:=A_PADDSB;
  987. mmxu16bit:
  988. op:=A_PADDUSW;
  989. end;
  990. end
  991. else
  992. begin
  993. case mmxbase of
  994. mmxs8bit,mmxu8bit:
  995. op:=A_PADDB;
  996. mmxs16bit,mmxu16bit,mmxfixed16:
  997. op:=A_PADDW;
  998. mmxs32bit,mmxu32bit:
  999. op:=A_PADDD;
  1000. end;
  1001. end;
  1002. end;
  1003. muln : begin
  1004. case mmxbase of
  1005. mmxs16bit,mmxu16bit:
  1006. op:=A_PMULLW;
  1007. mmxfixed16:
  1008. op:=A_PMULHW;
  1009. end;
  1010. end;
  1011. subn : begin
  1012. if (cs_mmx_saturation in aktlocalswitches) then
  1013. begin
  1014. case mmxbase of
  1015. mmxs8bit:
  1016. op:=A_PSUBSB;
  1017. mmxu8bit:
  1018. op:=A_PSUBUSB;
  1019. mmxs16bit,mmxfixed16:
  1020. op:=A_PSUBSB;
  1021. mmxu16bit:
  1022. op:=A_PSUBUSW;
  1023. end;
  1024. end
  1025. else
  1026. begin
  1027. case mmxbase of
  1028. mmxs8bit,mmxu8bit:
  1029. op:=A_PSUBB;
  1030. mmxs16bit,mmxu16bit,mmxfixed16:
  1031. op:=A_PSUBW;
  1032. mmxs32bit,mmxu32bit:
  1033. op:=A_PSUBD;
  1034. end;
  1035. end;
  1036. end;
  1037. {
  1038. ltn,lten,gtn,gten,
  1039. equaln,unequaln :
  1040. begin
  1041. op:=A_CMP;
  1042. cmpop:=true;
  1043. end;
  1044. }
  1045. xorn:
  1046. op:=A_PXOR;
  1047. orn:
  1048. op:=A_POR;
  1049. andn:
  1050. op:=A_PAND;
  1051. else Message(sym_e_type_mismatch);
  1052. end;
  1053. { left and right no register? }
  1054. { then one must be demanded }
  1055. if (p^.left^.location.loc<>LOC_MMXREGISTER) and
  1056. (p^.right^.location.loc<>LOC_MMXREGISTER) then
  1057. begin
  1058. { register variable ? }
  1059. if (p^.left^.location.loc=LOC_CMMXREGISTER) then
  1060. begin
  1061. { it is OK if this is the destination }
  1062. if is_in_dest then
  1063. begin
  1064. hregister:=p^.location.register;
  1065. emit_reg_reg(A_MOVQ,S_NO,p^.left^.location.register,
  1066. hregister);
  1067. end
  1068. else
  1069. begin
  1070. hregister:=getregistermmx;
  1071. emit_reg_reg(A_MOVQ,S_NO,p^.left^.location.register,
  1072. hregister);
  1073. end
  1074. end
  1075. else
  1076. begin
  1077. del_reference(p^.left^.location.reference);
  1078. if is_in_dest then
  1079. begin
  1080. hregister:=p^.location.register;
  1081. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVQ,S_NO,
  1082. newreference(p^.left^.location.reference),hregister)));
  1083. end
  1084. else
  1085. begin
  1086. hregister:=getregistermmx;
  1087. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVQ,S_NO,
  1088. newreference(p^.left^.location.reference),hregister)));
  1089. end;
  1090. end;
  1091. p^.location.loc:=LOC_MMXREGISTER;
  1092. p^.location.register:=hregister;
  1093. end
  1094. else
  1095. { if on the right the register then swap }
  1096. if (p^.right^.location.loc=LOC_MMXREGISTER) then
  1097. begin
  1098. swap_location(p^.location,p^.right^.location);
  1099. { newly swapped also set swapped flag }
  1100. p^.swaped:=not(p^.swaped);
  1101. end;
  1102. { at this point, p^.location.loc should be LOC_MMXREGISTER }
  1103. { and p^.location.register should be a valid register }
  1104. { containing the left result }
  1105. if p^.right^.location.loc<>LOC_MMXREGISTER then
  1106. begin
  1107. if (p^.treetype=subn) and p^.swaped then
  1108. begin
  1109. if p^.right^.location.loc=LOC_CMMXREGISTER then
  1110. begin
  1111. emit_reg_reg(A_MOVQ,S_NO,p^.right^.location.register,R_MM7);
  1112. emit_reg_reg(op,S_NO,p^.location.register,R_EDI);
  1113. emit_reg_reg(A_MOVQ,S_NO,R_MM7,p^.location.register);
  1114. end
  1115. else
  1116. begin
  1117. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVQ,S_NO,
  1118. newreference(p^.right^.location.reference),R_MM7)));
  1119. exprasmlist^.concat(new(pai386,op_reg_reg(op,S_NO,p^.location.register,
  1120. R_MM7)));
  1121. exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVQ,S_NO,
  1122. R_MM7,p^.location.register)));
  1123. del_reference(p^.right^.location.reference);
  1124. end;
  1125. end
  1126. else
  1127. begin
  1128. if (p^.right^.location.loc=LOC_CREGISTER) then
  1129. begin
  1130. emit_reg_reg(op,S_NO,p^.right^.location.register,
  1131. p^.location.register);
  1132. end
  1133. else
  1134. begin
  1135. exprasmlist^.concat(new(pai386,op_ref_reg(op,S_NO,newreference(
  1136. p^.right^.location.reference),p^.location.register)));
  1137. del_reference(p^.right^.location.reference);
  1138. end;
  1139. end;
  1140. end
  1141. else
  1142. begin
  1143. { when swapped another result register }
  1144. if (p^.treetype=subn) and p^.swaped then
  1145. begin
  1146. exprasmlist^.concat(new(pai386,op_reg_reg(op,S_NO,
  1147. p^.location.register,p^.right^.location.register)));
  1148. swap_location(p^.location,p^.right^.location);
  1149. { newly swapped also set swapped flag }
  1150. { just to maintain ordering }
  1151. p^.swaped:=not(p^.swaped);
  1152. end
  1153. else
  1154. begin
  1155. exprasmlist^.concat(new(pai386,op_reg_reg(op,S_NO,
  1156. p^.right^.location.register,
  1157. p^.location.register)));
  1158. end;
  1159. ungetregistermmx(p^.right^.location.register);
  1160. end;
  1161. end
  1162. {$endif SUPPORT_MMX}
  1163. else Message(sym_e_type_mismatch);
  1164. end;
  1165. SetResultLocation(cmpop,unsigned,p);
  1166. end;
  1167. end.
  1168. {
  1169. $Log$
  1170. Revision 1.7 1998-08-19 14:56:59 peter
  1171. * forgot to removed some unused code in addset for set<>set
  1172. Revision 1.6 1998/08/18 09:24:35 pierre
  1173. * small warning position bug fixed
  1174. * support_mmx switches splitting was missing
  1175. * rhide error and warning output corrected
  1176. Revision 1.5 1998/08/14 18:18:37 peter
  1177. + dynamic set contruction
  1178. * smallsets are now working (always longint size)
  1179. Revision 1.4 1998/08/10 14:49:42 peter
  1180. + localswitches, moduleswitches, globalswitches splitting
  1181. Revision 1.3 1998/06/25 08:48:04 florian
  1182. * first version of rtti support
  1183. Revision 1.2 1998/06/08 13:13:28 pierre
  1184. + temporary variables now in temp_gen.pas unit
  1185. because it is processor independent
  1186. * mppc68k.bat modified to undefine i386 and support_mmx
  1187. (which are defaults for i386)
  1188. Revision 1.1 1998/06/05 17:44:10 peter
  1189. * splitted cgi386
  1190. }