nmat.pas 53 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514
  1. {
  2. Copyright (c) 2000-2005 by Florian Klaempfl
  3. Type checking and register allocation for math nodes
  4. This program is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 2 of the License, or
  7. (at your option) any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software
  14. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  15. ****************************************************************************
  16. }
  17. unit nmat;
  18. {$i fpcdefs.inc}
  19. interface
  20. uses
  21. node,symtype;
  22. type
  23. TModDivNodeFlag = (
  24. mdnf_isomod
  25. );
  26. TModDivNodeFlags = set of TModDivNodeFlag;
  27. tmoddivnode = class(tbinopnode)
  28. moddivnodeflags : TModDivNodeFlags;
  29. constructor create(t:tnodetype;l,r : tnode); override;
  30. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  31. procedure ppuwrite(ppufile:tcompilerppufile);override;
  32. function pass_1 : tnode;override;
  33. function pass_typecheck:tnode;override;
  34. function simplify(forinline : boolean) : tnode;override;
  35. function dogetcopy : tnode;override;
  36. {$ifdef DEBUG_NODE_XML}
  37. procedure XMLPrintNodeInfo(var T: Text); override;
  38. {$endif DEBUG_NODE_XML}
  39. protected
  40. { override the following if you want to implement }
  41. { parts explicitely in the code generator (JM) }
  42. function use_moddiv64bitint_helper: boolean; virtual;
  43. function first_moddiv64bitint: tnode; virtual;
  44. function firstoptimize: tnode; virtual;
  45. function first_moddivint: tnode; virtual;
  46. end;
  47. tmoddivnodeclass = class of tmoddivnode;
  48. tshlshrnode = class(tbinopnode)
  49. function pass_1 : tnode;override;
  50. function pass_typecheck:tnode;override;
  51. function simplify(forinline : boolean) : tnode;override;
  52. {$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
  53. { override the following if you want to implement }
  54. { parts explicitely in the code generator (CEC)
  55. Should return nil, if everything will be handled
  56. in the code generator
  57. }
  58. function first_shlshr64bitint: tnode; virtual;
  59. {$endif not cpu64bitalu and not cpuhighleveltarget}
  60. end;
  61. tshlshrnodeclass = class of tshlshrnode;
  62. tunaryminusnode = class(tunarynode)
  63. constructor create(expr : tnode);virtual;
  64. function pass_1 : tnode;override;
  65. function pass_typecheck:tnode;override;
  66. function simplify(forinline : boolean) : tnode;override;
  67. end;
  68. tunaryminusnodeclass = class of tunaryminusnode;
  69. tunaryplusnode = class(tunarynode)
  70. constructor create(expr : tnode);virtual;
  71. function pass_1 : tnode;override;
  72. function pass_typecheck:tnode;override;
  73. end;
  74. tunaryplusnodeclass = class of tunaryplusnode;
  75. tnotnode = class(tunarynode)
  76. constructor create(expr : tnode);virtual;
  77. function pass_1 : tnode;override;
  78. function pass_typecheck:tnode;override;
  79. function simplify(forinline : boolean) : tnode;override;
  80. {$ifdef state_tracking}
  81. function track_state_pass(exec_known:boolean):boolean;override;
  82. {$endif}
  83. end;
  84. tnotnodeclass = class of tnotnode;
  85. var
  86. cmoddivnode : tmoddivnodeclass = tmoddivnode;
  87. cshlshrnode : tshlshrnodeclass = tshlshrnode;
  88. cunaryminusnode : tunaryminusnodeclass = tunaryminusnode;
  89. cunaryplusnode : tunaryplusnodeclass = tunaryplusnode;
  90. cnotnode : tnotnodeclass = tnotnode;
  91. implementation
  92. uses
  93. systems,
  94. verbose,globals,cutils,compinnr,
  95. globtype,constexp,
  96. symconst,symdef,symcpu,
  97. defcmp,defutil,
  98. htypechk,pass_1,
  99. cgbase,
  100. ncon,ncnv,ncal,nadd,nld,nbas,nflw,ninl,
  101. nutils,ppu;
  102. {****************************************************************************
  103. TMODDIVNODE
  104. ****************************************************************************}
  105. constructor tmoddivnode.create(t:tnodetype;l,r : tnode);
  106. begin
  107. inherited create(t, l, r);
  108. moddivnodeflags:=[];
  109. end;
  110. constructor tmoddivnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  111. begin
  112. inherited ppuload(t, ppufile);
  113. ppufile.getset(tppuset1(moddivnodeflags));
  114. end;
  115. procedure tmoddivnode.ppuwrite(ppufile:tcompilerppufile);
  116. begin
  117. inherited ppuwrite(ppufile);
  118. ppufile.putset(tppuset1(moddivnodeflags));
  119. end;
  120. function tmoddivnode.simplify(forinline : boolean):tnode;
  121. var
  122. rv,lv : tconstexprint;
  123. hp: tnode;
  124. begin
  125. result:=nil;
  126. if is_constintnode(right) then
  127. begin
  128. rv:=tordconstnode(right).value;
  129. if rv = 1 then
  130. begin
  131. case nodetype of
  132. modn:
  133. result := cordconstnode.create(0,left.resultdef,true);
  134. divn:
  135. result := left.getcopy;
  136. else
  137. internalerror(2019050518);
  138. end;
  139. exit;
  140. end;
  141. if rv = 0 then
  142. begin
  143. { if the node is derived from a generic const parameter
  144. then don't issue an error }
  145. if not (nf_generic_para in flags) then
  146. Message(parser_e_division_by_zero);
  147. { recover }
  148. tordconstnode(right).value := 1;
  149. end;
  150. { the following simplification is also required for correctness
  151. on x86, as its transformation of divisions by constants to
  152. multiplications and shifts does not handle -1 correctly }
  153. if (rv=-1) and
  154. (nodetype=divn) then
  155. begin
  156. result:=cunaryminusnode.create(left);
  157. left:=nil;
  158. exit;
  159. end;
  160. if (mdnf_isomod in moddivnodeflags) and
  161. (rv<=0) then
  162. begin
  163. Message(cg_e_mod_only_defined_for_pos_quotient);
  164. { recover }
  165. tordconstnode(right).value := 1;
  166. end
  167. else if (rv=-1) and
  168. (nodetype=modn) then
  169. begin
  170. result:=cordconstnode.create(0,left.resultdef,true);
  171. left:=nil;
  172. exit;
  173. end;
  174. if (nodetype=divn) and (left.nodetype=divn) and is_constintnode(tmoddivnode(left).right) and
  175. { we need a type and the types must be consistent }
  176. assigned(resultdef) and
  177. (compare_defs(resultdef,left.resultdef,nothingn)=te_exact) then
  178. begin
  179. { re-use the current node so we get the result type right }
  180. right:=caddnode.create_internal(muln,right,tmoddivnode(left).right.getcopy);
  181. hp:=tmoddivnode(left).left.getcopy;
  182. left.Free;
  183. left:=hp;
  184. Result:=getcopy;
  185. Result.resultdef:=nil;
  186. Result:=ctypeconvnode.create_internal(Result,resultdef);
  187. exit;
  188. end;
  189. { pointer subtractions generate nodes dividing pointer (constants) }
  190. if is_constintnode(left) or is_constpointernode(left) then
  191. begin
  192. { load values }
  193. lv:=get_int_value(left);
  194. rv:=get_int_value(right);
  195. case nodetype of
  196. modn:
  197. if mdnf_isomod in moddivnodeflags then
  198. begin
  199. if lv>=0 then
  200. result:=create_simplified_ord_const(lv mod rv,resultdef,forinline,false)
  201. else
  202. if ((-lv) mod rv)=0 then
  203. result:=create_simplified_ord_const((-lv) mod rv,resultdef,forinline,false)
  204. else
  205. result:=create_simplified_ord_const(rv-((-lv) mod rv),resultdef,forinline,false);
  206. end
  207. else
  208. result:=create_simplified_ord_const(lv mod rv,resultdef,forinline,false);
  209. divn:
  210. result:=create_simplified_ord_const(lv div rv,resultdef,forinline,cs_check_overflow in localswitches);
  211. else
  212. internalerror(2019050519);
  213. end;
  214. end;
  215. end;
  216. end;
  217. function tmoddivnode.dogetcopy: tnode;
  218. var
  219. n: tmoddivnode;
  220. begin
  221. n:=tmoddivnode(inherited dogetcopy);
  222. n.moddivnodeflags:=moddivnodeflags;
  223. result:=n;
  224. end;
  225. function tmoddivnode.use_moddiv64bitint_helper: boolean;
  226. begin
  227. { not with an ifdef around the call to this routine, because e.g. the
  228. Java VM has a signed 64 bit division opcode, but not an unsigned
  229. one }
  230. {$if defined(cpu64bitalu) or defined(cpuhighleveltarget)}
  231. result:=false;
  232. {$else cpu64bitalu or cpuhighleveltarget}
  233. result:=
  234. (left.resultdef.typ=orddef) and
  235. (right.resultdef.typ=orddef) and
  236. { include currency as well }
  237. (is_64bit(left.resultdef) or is_64bit(right.resultdef));
  238. {$endif cpu64bitalu or cpuhighleveltarget}
  239. end;
  240. function tmoddivnode.pass_typecheck:tnode;
  241. var
  242. else_block,
  243. hp,t : tnode;
  244. rd,ld : torddef;
  245. else_statements,
  246. statements : tstatementnode;
  247. result_data : ttempcreatenode;
  248. nd : torddef;
  249. begin
  250. result:=nil;
  251. typecheckpass(left);
  252. typecheckpass(right);
  253. { avoid any problems with type parameters later on }
  254. if is_typeparam(left.resultdef) or is_typeparam(right.resultdef) then
  255. begin
  256. resultdef:=cundefinedtype;
  257. exit;
  258. end;
  259. set_varstate(left,vs_read,[vsf_must_be_valid]);
  260. set_varstate(right,vs_read,[vsf_must_be_valid]);
  261. if codegenerror then
  262. exit;
  263. { tp procvar support }
  264. maybe_call_procvar(left,true);
  265. maybe_call_procvar(right,true);
  266. { allow operator overloading }
  267. t:=self;
  268. if isbinaryoverloaded(t,[]) then
  269. begin
  270. result:=t;
  271. exit;
  272. end;
  273. { we need 2 orddefs always }
  274. if (left.resultdef.typ<>orddef) then
  275. inserttypeconv(left,sinttype);
  276. if (right.resultdef.typ<>orddef) then
  277. inserttypeconv(right,sinttype);
  278. if codegenerror then
  279. exit;
  280. { Try only now to simply constant
  281. as otherwise you might create
  282. tconstnode with return type that are
  283. not compatible with tconst node
  284. as in bug report 21566 PM }
  285. result:=simplify(false);
  286. if assigned(result) then
  287. exit;
  288. rd:=torddef(right.resultdef);
  289. ld:=torddef(left.resultdef);
  290. { if one operand is a cardinal and the other is a positive constant, convert the }
  291. { constant to a cardinal as well so we don't have to do a 64bit division (JM) }
  292. { Do the same for qwords and positive constants as well, otherwise things like }
  293. { "qword mod 10" are evaluated with int64 as result, which is wrong if the }
  294. { "qword" was > high(int64) (JM) }
  295. { Additionally, do the same for cardinal/qwords and other positive types, but }
  296. { always in a way that a smaller type is converted to a bigger type }
  297. { (webtbs/tw8870) }
  298. if (rd.ordtype in [u8bit,u16bit,u32bit,u64bit]) and
  299. ((is_constintnode(left) and
  300. (tordconstnode(left).value >= 0) and
  301. (tordconstnode(left).value <= get_max_value(rd))) or
  302. (not is_signed(ld) and
  303. (rd.size >= ld.size))) then
  304. begin
  305. if rd.size<uinttype.size then
  306. begin
  307. inserttypeconv(left,uinttype);
  308. inserttypeconv(right,uinttype);
  309. end
  310. else
  311. inserttypeconv(left,rd);
  312. resultdef:=right.resultdef;
  313. end
  314. else if (ld.ordtype in [u8bit,u16bit,u32bit,u64bit]) and
  315. ((is_constintnode(right) and
  316. (tordconstnode(right).value >= 0) and
  317. (tordconstnode(right).value <= get_max_value(ld))) or
  318. (not is_signed(rd) and
  319. (ld.size >= rd.size))) then
  320. begin
  321. if ld.size<uinttype.size then
  322. begin
  323. inserttypeconv(left,uinttype);
  324. inserttypeconv(right,uinttype);
  325. end
  326. else
  327. inserttypeconv(right,ld);
  328. resultdef:=left.resultdef;
  329. end
  330. else
  331. { when there is one currency value, everything is done
  332. using currency }
  333. if (ld.ordtype=scurrency) or
  334. (rd.ordtype=scurrency) then
  335. begin
  336. if (ld.ordtype<>scurrency) then
  337. inserttypeconv(left,s64currencytype);
  338. if (rd.ordtype<>scurrency) then
  339. inserttypeconv(right,s64currencytype);
  340. resultdef:=left.resultdef;
  341. end
  342. else
  343. { when there is one 64bit value, everything is done
  344. in 64bit }
  345. if (is_64bitint(left.resultdef) or
  346. is_64bitint(right.resultdef)) then
  347. begin
  348. if is_signed(rd) or is_signed(ld) then
  349. begin
  350. if (ld.ordtype<>s64bit) then
  351. inserttypeconv(left,s64inttype);
  352. if (rd.ordtype<>s64bit) then
  353. inserttypeconv(right,s64inttype);
  354. end
  355. else
  356. begin
  357. if (ld.ordtype<>u64bit) then
  358. inserttypeconv(left,u64inttype);
  359. if (rd.ordtype<>u64bit) then
  360. inserttypeconv(right,u64inttype);
  361. end;
  362. resultdef:=left.resultdef;
  363. end
  364. else
  365. { is there a larger than the native int? }
  366. if is_oversizedint(ld) or is_oversizedint(rd) then
  367. begin
  368. nd:=get_common_intdef(ld,rd,false);
  369. if (ld.ordtype<>nd.ordtype) then
  370. inserttypeconv(left,nd);
  371. if (rd.ordtype<>nd.ordtype) then
  372. inserttypeconv(right,nd);
  373. resultdef:=left.resultdef;
  374. end
  375. else
  376. { when mixing unsigned and signed native ints, convert everything to a larger signed type (JM) }
  377. if (is_nativeuint(rd) and
  378. is_signed(ld)) or
  379. (is_nativeuint(ld) and
  380. is_signed(rd)) then
  381. begin
  382. CGMessage(type_h_mixed_signed_unsigned);
  383. { get a signed int, larger than the native int }
  384. nd:=get_common_intdef(torddef(sinttype),torddef(uinttype),false);
  385. if (ld.ordtype<>nd.ordtype) then
  386. inserttypeconv(left,nd);
  387. if (rd.ordtype<>nd.ordtype) then
  388. inserttypeconv(right,nd);
  389. resultdef:=left.resultdef;
  390. end
  391. else
  392. begin
  393. { Make everything always default singed int }
  394. if not(rd.ordtype in [torddef(sinttype).ordtype,torddef(uinttype).ordtype]) then
  395. inserttypeconv(right,sinttype);
  396. if not(ld.ordtype in [torddef(sinttype).ordtype,torddef(uinttype).ordtype]) then
  397. inserttypeconv(left,sinttype);
  398. resultdef:=right.resultdef;
  399. end;
  400. result:=simplify(false);
  401. if assigned(result) then
  402. exit;
  403. { when the result is currency we need some extra code for
  404. division. this should not be done when the divn node is
  405. created internally }
  406. if (nodetype=divn) and
  407. not(nf_is_currency in flags) and
  408. is_currency(resultdef) then
  409. begin
  410. hp:=caddnode.create(muln,getcopy,cordconstnode.create(10000,s64currencytype,false));
  411. include(hp.flags,nf_is_currency);
  412. result:=hp;
  413. end;
  414. if (nodetype=modn) and (mdnf_isomod in moddivnodeflags) then
  415. begin
  416. result:=internalstatements(statements);
  417. else_block:=internalstatements(else_statements);
  418. result_data:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,true);
  419. { right <=0? }
  420. addstatement(statements,cifnode.create_internal(caddnode.create_internal(lten,right.getcopy,cordconstnode.create(0,resultdef,false)),
  421. { then: result:=left mod right }
  422. ccallnode.createintern('fpc_divbyzero',nil),
  423. nil
  424. ));
  425. { prepare else block }
  426. { result:=(-left) mod right }
  427. addstatement(else_statements,cassignmentnode.create(ctemprefnode.create(result_data),cmoddivnode.create(modn,cunaryminusnode.create(left.getcopy),right.getcopy)));
  428. { result<>0? }
  429. addstatement(else_statements,cifnode.create_internal(caddnode.create_internal(unequaln,ctemprefnode.create(result_data),cordconstnode.create(0,resultdef,false)),
  430. { then: result:=right-result }
  431. cassignmentnode.create_internal(ctemprefnode.create(result_data),caddnode.create_internal(subn,right.getcopy,ctemprefnode.create(result_data))),
  432. nil
  433. ));
  434. addstatement(statements,result_data);
  435. { if left>=0 }
  436. addstatement(statements,cifnode.create_internal(caddnode.create_internal(gten,left.getcopy,cordconstnode.create(0,resultdef,false)),
  437. { then: result:=left mod right }
  438. cassignmentnode.create_internal(ctemprefnode.create(result_data),cmoddivnode.create(modn,left.getcopy,right.getcopy)),
  439. { else block }
  440. else_block
  441. ));
  442. addstatement(statements,ctempdeletenode.create_normal_temp(result_data));
  443. addstatement(statements,ctemprefnode.create(result_data));
  444. end;
  445. end;
  446. function tmoddivnode.first_moddivint: tnode;
  447. {$ifdef cpuneedsdivhelper}
  448. var
  449. procname: string[31];
  450. begin
  451. result := nil;
  452. { otherwise create a call to a helper }
  453. if nodetype = divn then
  454. procname := 'fpc_div_'
  455. else
  456. procname := 'fpc_mod_';
  457. { only qword needs the unsigned code, the
  458. signed code is also used for currency }
  459. case torddef(resultdef).ordtype of
  460. u8bit:
  461. procname := procname + 'byte';
  462. s8bit:
  463. procname := procname + 'shortint';
  464. u16bit:
  465. procname := procname + 'word';
  466. s16bit:
  467. procname := procname + 'smallint';
  468. u32bit:
  469. procname := procname + 'dword';
  470. s32bit:
  471. procname := procname + 'longint';
  472. scurrency:
  473. procname := procname + 'currency';
  474. else
  475. internalerror(2015070501);
  476. end;
  477. result := ccallnode.createintern(procname,ccallparanode.create(left,
  478. ccallparanode.create(right,nil)));
  479. left := nil;
  480. right := nil;
  481. firstpass(result);
  482. if result.resultdef.typ<>orddef then
  483. internalerror(2013031701);
  484. if resultdef.typ<>orddef then
  485. internalerror(2013031702);
  486. if torddef(result.resultdef).ordtype <> torddef(resultdef).ordtype then
  487. inserttypeconv(result,resultdef);
  488. end;
  489. {$else cpuneedsdivhelper}
  490. begin
  491. result:=nil;
  492. end;
  493. {$endif cpuneedsdiv32helper}
  494. function tmoddivnode.first_moddiv64bitint: tnode;
  495. var
  496. procname: string[31];
  497. begin
  498. result := nil;
  499. { when currency is used set the result of the
  500. parameters to s64bit, so they are not converted }
  501. if nf_is_currency in flags then
  502. begin
  503. left.resultdef:=s64inttype;
  504. right.resultdef:=s64inttype;
  505. end;
  506. { otherwise create a call to a helper }
  507. if nodetype = divn then
  508. procname := 'fpc_div_'
  509. else
  510. procname := 'fpc_mod_';
  511. { only qword needs the unsigned code, the
  512. signed code is also used for currency }
  513. if is_signed(resultdef) then
  514. procname := procname + 'int64'
  515. else
  516. procname := procname + 'qword';
  517. result := ccallnode.createintern(procname,ccallparanode.create(left,
  518. ccallparanode.create(right,nil)));
  519. left := nil;
  520. right := nil;
  521. firstpass(result);
  522. end;
  523. function tmoddivnode.firstoptimize: tnode;
  524. var
  525. power,shiftval : longint;
  526. statements : tstatementnode;
  527. temp,resulttemp : ttempcreatenode;
  528. masknode : tnode;
  529. invertsign: Boolean;
  530. begin
  531. result := nil;
  532. { divide/mod a number by a constant which is a power of 2? }
  533. if (right.nodetype = ordconstn) and
  534. isabspowerof2(tordconstnode(right).value,power) and
  535. {$if defined(cpu64bitalu) or defined(cpuhighleveltarget)}
  536. { for 64 bit, we leave the optimization to the cg }
  537. (not is_signed(resultdef)) then
  538. {$else cpu64bitalu or cpuhighleveltarget}
  539. (((nodetype=divn) and is_oversizedord(resultdef)) or
  540. (nodetype=modn) or
  541. not is_signed(resultdef)) then
  542. {$endif cpu64bitalu or cpuhighleveltarget}
  543. begin
  544. if nodetype=divn then
  545. begin
  546. if is_signed(resultdef) then
  547. begin
  548. invertsign:=tordconstnode(right).value<0;
  549. if is_64bitint(left.resultdef) then
  550. if not (cs_opt_size in current_settings.optimizerswitches) then
  551. shiftval:=63
  552. else
  553. { the shift code is a lot bigger than the call to }
  554. { the divide helper }
  555. exit
  556. else
  557. shiftval:=left.resultdef.size*8-1;
  558. result:=internalstatements(statements);
  559. temp:=ctempcreatenode.create(left.resultdef,left.resultdef.size,tt_persistent,true);
  560. resulttemp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,true);
  561. addstatement(statements,resulttemp);
  562. addstatement(statements,temp);
  563. addstatement(statements,cassignmentnode.create(ctemprefnode.create(temp),
  564. left));
  565. left:=nil;
  566. { masknode is (sar(temp,shiftval) and ((1 shl power)-1))
  567. for power=1 (i.e. division by 2), masknode is simply (temp shr shiftval)}
  568. if power=1 then
  569. masknode:=
  570. cshlshrnode.create(shrn,
  571. ctemprefnode.create(temp),
  572. cordconstnode.create(shiftval,u8inttype,false)
  573. )
  574. else
  575. masknode:=
  576. caddnode.create(andn,
  577. cinlinenode.create(in_sar_x_y,false,
  578. ccallparanode.create(cordconstnode.create(shiftval,u8inttype,false),
  579. ccallparanode.create(ctemprefnode.create(temp),nil))
  580. ),
  581. cordconstnode.create(tcgint((qword(1) shl power)-1),
  582. right.resultdef,false)
  583. );
  584. if invertsign then
  585. addstatement(statements,cassignmentnode.create(ctemprefnode.create(resulttemp),
  586. cunaryminusnode.create(
  587. cinlinenode.create(in_sar_x_y,false,
  588. ccallparanode.create(cordconstnode.create(power,u8inttype,false),
  589. ccallparanode.create(caddnode.create(addn,ctemprefnode.create(temp),
  590. masknode),nil
  591. )))))
  592. )
  593. else
  594. addstatement(statements,cassignmentnode.create(ctemprefnode.create(resulttemp),
  595. cinlinenode.create(in_sar_x_y,false,
  596. ccallparanode.create(cordconstnode.create(power,u8inttype,false),
  597. ccallparanode.create(caddnode.create(addn,ctemprefnode.create(temp),
  598. masknode),nil
  599. ))))
  600. );
  601. addstatement(statements,ctempdeletenode.create(temp));
  602. addstatement(statements,ctempdeletenode.create_normal_temp(resulttemp));
  603. addstatement(statements,ctemprefnode.create(resulttemp));
  604. right.Free;
  605. end
  606. else
  607. begin
  608. tordconstnode(right).value:=power;
  609. result:=cshlshrnode.create(shrn,left,right)
  610. end;
  611. end
  612. else if is_signed(resultdef) then { signed modulus }
  613. begin
  614. if (cs_opt_size in current_settings.optimizerswitches) then
  615. exit;
  616. shiftval:=left.resultdef.size*8-1;
  617. tordconstnode(right).value.uvalue:=qword((qword(1) shl power)-1);
  618. result:=internalstatements(statements);
  619. temp:=ctempcreatenode.create(left.resultdef,left.resultdef.size,tt_persistent,true);
  620. resulttemp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,true);
  621. addstatement(statements,resulttemp);
  622. addstatement(statements,temp);
  623. addstatement(statements,cassignmentnode.create(ctemprefnode.create(temp),left));
  624. { mask:=sar(left,sizeof(left)*8-1) and ((1 shl power)-1); }
  625. if power=1 then
  626. masknode:=
  627. cshlshrnode.create(shrn,
  628. ctemprefnode.create(temp),
  629. cordconstnode.create(shiftval,u8inttype,false)
  630. )
  631. else
  632. masknode:=
  633. caddnode.create(andn,
  634. cinlinenode.create(in_sar_x_y,false,
  635. ccallparanode.create(cordconstnode.create(shiftval,u8inttype,false),
  636. ccallparanode.create(ctemprefnode.create(temp),nil))
  637. ),
  638. cordconstnode.create(tcgint((qword(1) shl power)-1),
  639. right.resultdef,false)
  640. );
  641. addstatement(statements,cassignmentnode.create(ctemprefnode.create(resulttemp),masknode));
  642. { result:=((left+mask) and right)-mask; }
  643. addstatement(statements,cassignmentnode.create(ctemprefnode.create(resulttemp),
  644. caddnode.create(subn,
  645. caddnode.create(andn,
  646. right,
  647. caddnode.create(addn,
  648. ctemprefnode.create(temp),
  649. ctemprefnode.create(resulttemp))),
  650. ctemprefnode.create(resulttemp))
  651. ));
  652. addstatement(statements,ctempdeletenode.create(temp));
  653. addstatement(statements,ctempdeletenode.create_normal_temp(resulttemp));
  654. addstatement(statements,ctemprefnode.create(resulttemp));
  655. end
  656. else
  657. begin
  658. tordconstnode(right).value.uvalue:=qword((qword(1) shl power)-1);
  659. result := caddnode.create(andn,left,right);
  660. end;
  661. { left and right are reused }
  662. left := nil;
  663. right := nil;
  664. firstpass(result);
  665. exit;
  666. end;
  667. end;
  668. function tmoddivnode.pass_1 : tnode;
  669. begin
  670. result:=nil;
  671. firstpass(left);
  672. firstpass(right);
  673. if codegenerror then
  674. exit;
  675. { Try to optimize mod/div }
  676. result := firstoptimize;
  677. if assigned(result) then
  678. exit;
  679. { 64bit }
  680. if use_moddiv64bitint_helper then
  681. begin
  682. result := first_moddiv64bitint;
  683. if assigned(result) then
  684. exit;
  685. expectloc:=LOC_REGISTER;
  686. end
  687. else
  688. begin
  689. result := first_moddivint;
  690. if assigned(result) then
  691. exit;
  692. end;
  693. expectloc:=LOC_REGISTER;
  694. end;
  695. {$ifdef DEBUG_NODE_XML}
  696. procedure TModDivNode.XMLPrintNodeInfo(var T: Text);
  697. var
  698. i: TModDivNodeFlag;
  699. First: Boolean;
  700. begin
  701. inherited XMLPrintNodeInfo(T);
  702. First := True;
  703. for i in moddivnodeflags do
  704. begin
  705. if First then
  706. begin
  707. Write(T, ' moddivnodeflags="', i);
  708. First := False;
  709. end
  710. else
  711. Write(T, ',', i)
  712. end;
  713. if not First then
  714. Write(T, '"');
  715. end;
  716. {$endif DEBUG_NODE_XML}
  717. {****************************************************************************
  718. TSHLSHRNODE
  719. ****************************************************************************}
  720. function tshlshrnode.simplify(forinline : boolean):tnode;
  721. var
  722. lvalue, rvalue, mask : Tconstexprint;
  723. rangedef: tdef;
  724. size: longint;
  725. begin
  726. result:=nil;
  727. { constant folding }
  728. if is_constintnode(right) then
  729. begin
  730. if forinline then
  731. begin
  732. case resultdef.size of
  733. 1,2,4:
  734. rvalue:=tordconstnode(right).value and byte($1f);
  735. 8:
  736. rvalue:=tordconstnode(right).value and byte($3f);
  737. else
  738. internalerror(2013122302);
  739. end;
  740. end
  741. else
  742. rvalue:=tordconstnode(right).value;
  743. if is_constintnode(left) then
  744. begin
  745. lvalue:=tordconstnode(left).value;
  746. getrangedefmasksize(resultdef, rangedef, mask, size);
  747. { shr is an unsigned operation, so cut off upper bits }
  748. if forinline then
  749. lvalue:=lvalue and mask;
  750. case nodetype of
  751. shrn:
  752. lvalue:=lvalue shr rvalue;
  753. shln:
  754. lvalue:=lvalue shl rvalue;
  755. else
  756. internalerror(2019050517);
  757. end;
  758. { discard shifted-out bits (shl never triggers overflow/range errors) }
  759. if forinline and
  760. (nodetype=shln) then
  761. lvalue:=lvalue and mask;
  762. result:=create_simplified_ord_const(lvalue,resultdef,forinline,false);
  763. end
  764. else if rvalue=0 then
  765. begin
  766. result:=left;
  767. left:=nil;
  768. end
  769. { optimize "a shl n1 shl n2" and "a shr n1 shr n2" }
  770. else if (nodetype=left.nodetype) and is_constintnode(tshlshrnode(left).right) and
  771. { do not overflow the variable being shifted }
  772. (tordconstnode(right).value+tordconstnode(tshlshrnode(left).right).value<tshlshrnode(left).left.resultdef.size*8) then
  773. begin
  774. result:=left;
  775. left:=nil;
  776. tordconstnode(tshlshrnode(result).right).value:=tordconstnode(tshlshrnode(result).right).value+tordconstnode(right).value;
  777. end;
  778. end
  779. else if is_constintnode(left) then
  780. begin
  781. lvalue:=tordconstnode(left).value;
  782. if forinline then
  783. begin
  784. getrangedefmasksize(resultdef, rangedef, mask, size);
  785. lvalue:=lvalue and mask;
  786. end;
  787. { '0 shl x' and '0 shr x' are 0 }
  788. if (lvalue=0) and
  789. ((cs_opt_level4 in current_settings.optimizerswitches) or
  790. not might_have_sideeffects(right)) then
  791. result:=cordconstnode.create(0,resultdef,true);
  792. end;
  793. end;
  794. function tshlshrnode.pass_typecheck:tnode;
  795. var
  796. t : tnode;
  797. begin
  798. result:=nil;
  799. typecheckpass(left);
  800. typecheckpass(right);
  801. { avoid any problems with type parameters later on }
  802. if is_typeparam(left.resultdef) or is_typeparam(right.resultdef) then
  803. begin
  804. resultdef:=cundefinedtype;
  805. exit;
  806. end;
  807. set_varstate(right,vs_read,[vsf_must_be_valid]);
  808. set_varstate(left,vs_read,[vsf_must_be_valid]);
  809. if codegenerror then
  810. exit;
  811. { tp procvar support }
  812. maybe_call_procvar(left,true);
  813. maybe_call_procvar(right,true);
  814. { allow operator overloading }
  815. t:=self;
  816. if isbinaryoverloaded(t,[]) then
  817. begin
  818. result:=t;
  819. exit;
  820. end;
  821. {$ifdef SUPPORT_MMX}
  822. if (cs_mmx in current_settings.localswitches) and
  823. is_mmx_able_array(left.resultdef) and
  824. ((is_mmx_able_array(right.resultdef) and
  825. equal_defs(left.resultdef,right.resultdef)
  826. ) or is_constintnode(right)) then
  827. begin
  828. if not(mmx_type(left.resultdef) in [mmxu16bit,mmxs16bit,mmxfixed16,mmxu32bit,mmxs32bit,mmxu64bit,mmxs64bit]) then
  829. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),left.resultdef.typename,right.resultdef.typename);
  830. if not(is_mmx_able_array(right.resultdef)) then
  831. inserttypeconv(right,sinttype);
  832. end
  833. else
  834. {$endif SUPPORT_MMX}
  835. begin
  836. { calculations for ordinals < 32 bit have to be done in
  837. 32 bit for backwards compatibility. That way 'shl 33' is
  838. the same as 'shl 1'. It's ugly but compatible with delphi/tp/gcc }
  839. if (not is_64bit(left.resultdef)) and
  840. (torddef(left.resultdef).ordtype<>u32bit) then
  841. begin
  842. { keep singness of orignal type }
  843. if is_signed(left.resultdef) then
  844. begin
  845. {$if defined(cpu64bitalu) or defined(cpu32bitalu)}
  846. inserttypeconv(left,s32inttype)
  847. {$elseif defined(cpu16bitalu) or defined(cpu8bitalu)}
  848. inserttypeconv(left,get_common_intdef(torddef(left.resultdef),torddef(sinttype),true));
  849. {$else}
  850. internalerror(2013031301);
  851. {$endif}
  852. end
  853. else
  854. begin
  855. {$if defined(cpu64bitalu) or defined(cpu32bitalu)}
  856. inserttypeconv(left,u32inttype);
  857. {$elseif defined(cpu16bitalu) or defined(cpu8bitalu)}
  858. inserttypeconv(left,get_common_intdef(torddef(left.resultdef),torddef(uinttype),true));
  859. {$else}
  860. internalerror(2013031302);
  861. {$endif}
  862. end
  863. end;
  864. inserttypeconv(right,sinttype);
  865. end;
  866. resultdef:=left.resultdef;
  867. result:=simplify(false);
  868. if assigned(result) then
  869. exit;
  870. end;
  871. {$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
  872. function tshlshrnode.first_shlshr64bitint: tnode;
  873. var
  874. procname: string[31];
  875. begin
  876. result := nil;
  877. { Normally already done below, but called again,
  878. just in case it is called directly }
  879. firstpass(left);
  880. { otherwise create a call to a helper }
  881. if is_signed(left.resultdef) then
  882. procname:='int64'
  883. else
  884. procname:='qword';
  885. if nodetype = shln then
  886. procname := 'fpc_shl_'+procname
  887. else
  888. procname := 'fpc_shr_'+procname;
  889. { this order of parameters works at least for the arm,
  890. however it should work for any calling conventions (FK) }
  891. result := ccallnode.createintern(procname,ccallparanode.create(right,
  892. ccallparanode.create(left,nil)));
  893. left := nil;
  894. right := nil;
  895. firstpass(result);
  896. end;
  897. {$endif not cpu64bitalu and not cpuhighleveltarget}
  898. function tshlshrnode.pass_1 : tnode;
  899. begin
  900. result:=nil;
  901. firstpass(left);
  902. firstpass(right);
  903. if codegenerror then
  904. exit;
  905. expectloc:=LOC_REGISTER;
  906. {$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
  907. { 64 bit ints have their own shift handling }
  908. if is_64bit(left.resultdef) then
  909. result := first_shlshr64bitint;
  910. {$endif not cpu64bitalu and not cpuhighleveltarget}
  911. end;
  912. {****************************************************************************
  913. TUNARYMINUSNODE
  914. ****************************************************************************}
  915. constructor tunaryminusnode.create(expr : tnode);
  916. begin
  917. inherited create(unaryminusn,expr);
  918. end;
  919. function tunaryminusnode.simplify(forinline : boolean):tnode;
  920. begin
  921. result:=nil;
  922. { constant folding }
  923. if is_constintnode(left) then
  924. begin
  925. result:=create_simplified_ord_const(-tordconstnode(left).value,resultdef,forinline,cs_check_overflow in localswitches);
  926. exit;
  927. end;
  928. if is_constrealnode(left) then
  929. begin
  930. trealconstnode(left).value_real:=-trealconstnode(left).value_real;
  931. { Avoid integer overflow on x86_64 CPU for currency value }
  932. { i386 uses fildll/fchs/fistll instructions which never seem
  933. to raise any coprocessor flags .. }
  934. {$push}{$Q-}
  935. trealconstnode(left).value_currency:=-trealconstnode(left).value_currency;
  936. result:=left;
  937. {$pop}
  938. left:=nil;
  939. exit;
  940. end;
  941. if is_real(left.resultdef) then
  942. begin
  943. {
  944. -(left-right) => right-left
  945. As this result in -(1.0-1.0)=0.0 instead of 0.0, this is only valid in fastmath mode
  946. }
  947. if (cs_opt_fastmath in current_settings.optimizerswitches) and (left.nodetype=subn) then
  948. begin
  949. result:=caddnode.create(subn,taddnode(left).right.getcopy,taddnode(left).left.getcopy);
  950. exit;
  951. end;
  952. {
  953. -(-left*right) or -(left*-right) => right*left
  954. this operation is always valid as reals do not use a two's complement representation for negative
  955. numbers, -real means just flip the sign bit
  956. }
  957. if (left.nodetype=muln) and ((taddnode(left).left.nodetype=unaryminusn)) then
  958. begin
  959. result:=caddnode.create(muln,tunaryminusnode(taddnode(left).left).left.getcopy,taddnode(left).right.getcopy);
  960. exit;
  961. end;
  962. if (left.nodetype=muln) and ((taddnode(left).right.nodetype=unaryminusn)) then
  963. begin
  964. result:=caddnode.create(muln,taddnode(left).left.getcopy,tunaryminusnode(taddnode(left).right).left.getcopy);
  965. exit;
  966. end;
  967. {
  968. -(-left/right) or -(left/-right) => right/left
  969. this operation is always valid as reals do not use a two's complement representation for negative
  970. numbers, -real means just flip the sign bit
  971. }
  972. if (left.nodetype=slashn) and ((taddnode(left).left.nodetype=unaryminusn)) then
  973. begin
  974. result:=caddnode.create(slashn,tunaryminusnode(taddnode(left).left).left.getcopy,taddnode(left).right.getcopy);
  975. exit;
  976. end;
  977. if (left.nodetype=slashn) and ((taddnode(left).right.nodetype=unaryminusn)) then
  978. begin
  979. result:=caddnode.create(slashn,taddnode(left).left.getcopy,tunaryminusnode(taddnode(left).right).left.getcopy);
  980. exit;
  981. end;
  982. { --node => node
  983. this operation is always valid as reals do not use a two's complement representation for negative
  984. numbers, -real means just flip the sign bit
  985. }
  986. if left.nodetype=unaryminusn then
  987. begin
  988. result:=tunarynode(left).left.getcopy;
  989. exit;
  990. end;
  991. end
  992. { transform -(x+1) or -(1+x) into not(x) }
  993. else if is_integer(left.resultdef) and is_signed(left.resultdef) and (left.nodetype=addn) and ((localswitches*[cs_check_overflow,cs_check_range])=[]) then
  994. begin
  995. if is_constintnode(taddnode(left).right) and (tordconstnode(taddnode(left).right).value=1) then
  996. begin
  997. result:=cnotnode.create(taddnode(left).left.getcopy);
  998. exit;
  999. end
  1000. else if is_constintnode(taddnode(left).left) and (tordconstnode(taddnode(left).left).value=1) then
  1001. begin
  1002. result:=cnotnode.create(taddnode(left).right.getcopy);
  1003. exit;
  1004. end;
  1005. end;
  1006. end;
  1007. function tunaryminusnode.pass_typecheck : tnode;
  1008. var
  1009. t : tnode;
  1010. begin
  1011. result:=nil;
  1012. typecheckpass(left);
  1013. { avoid any problems with type parameters later on }
  1014. if is_typeparam(left.resultdef) then
  1015. begin
  1016. resultdef:=cundefinedtype;
  1017. exit;
  1018. end;
  1019. set_varstate(left,vs_read,[vsf_must_be_valid]);
  1020. if codegenerror then
  1021. exit;
  1022. result:=simplify(false);
  1023. if assigned(result) then
  1024. exit;
  1025. resultdef:=left.resultdef;
  1026. if is_currency(left.resultdef) then
  1027. begin
  1028. end
  1029. else if left.resultdef.typ=floatdef then
  1030. begin
  1031. if not(tfloatdef(left.resultdef).floattype in [s64comp,s64currency]) and
  1032. (cs_excessprecision in current_settings.localswitches) then
  1033. begin
  1034. inserttypeconv(left,pbestrealtype^);
  1035. resultdef:=left.resultdef
  1036. end;
  1037. end
  1038. {$ifdef SUPPORT_MMX}
  1039. else if (cs_mmx in current_settings.localswitches) and
  1040. is_mmx_able_array(left.resultdef) then
  1041. begin
  1042. { if saturation is on, left.resultdef isn't
  1043. "mmx able" (FK)
  1044. if (cs_mmx_saturation in current_settings.localswitches^) and
  1045. (torddef(tarraydef(resultdef).definition).typ in
  1046. [s32bit,u32bit]) then
  1047. CGMessage(type_e_mismatch);
  1048. }
  1049. end
  1050. {$endif SUPPORT_MMX}
  1051. else if is_oversizedord(left.resultdef) then
  1052. begin
  1053. if is_64bit(left.resultdef) then
  1054. inserttypeconv(left,s64inttype)
  1055. else if is_32bit(left.resultdef) then
  1056. inserttypeconv(left,s32inttype)
  1057. else if is_16bit(left.resultdef) then
  1058. inserttypeconv(left,s16inttype)
  1059. else
  1060. internalerror(2013040701);
  1061. resultdef:=left.resultdef;
  1062. end
  1063. else if (left.resultdef.typ=orddef) then
  1064. begin
  1065. inserttypeconv(left,sinttype);
  1066. resultdef:=left.resultdef
  1067. end
  1068. else
  1069. begin
  1070. { allow operator overloading }
  1071. t:=self;
  1072. if isunaryoverloaded(t,[]) then
  1073. begin
  1074. result:=t;
  1075. exit;
  1076. end;
  1077. CGMessage(type_e_mismatch);
  1078. end;
  1079. end;
  1080. { generic code }
  1081. { overridden by: }
  1082. { i386 }
  1083. function tunaryminusnode.pass_1 : tnode;
  1084. var
  1085. procname: string[31];
  1086. begin
  1087. result:=nil;
  1088. firstpass(left);
  1089. if codegenerror then
  1090. exit;
  1091. if (cs_fp_emulation in current_settings.moduleswitches) and (left.resultdef.typ=floatdef) then
  1092. begin
  1093. if not(target_info.system in systems_wince) then
  1094. begin
  1095. expectloc:=LOC_REGISTER;
  1096. exit;
  1097. end
  1098. else
  1099. begin
  1100. case tfloatdef(resultdef).floattype of
  1101. s32real:
  1102. procname:='negs';
  1103. s64real:
  1104. procname:='negd';
  1105. {!!! not yet implemented
  1106. s128real:
  1107. }
  1108. else
  1109. internalerror(2005082802);
  1110. end;
  1111. result:=ccallnode.createintern(procname,ccallparanode.create(left,nil));
  1112. end;
  1113. left:=nil;
  1114. end
  1115. else
  1116. begin
  1117. if (left.resultdef.typ=floatdef) then
  1118. expectloc:=LOC_FPUREGISTER
  1119. {$ifdef SUPPORT_MMX}
  1120. else if (cs_mmx in current_settings.localswitches) and
  1121. is_mmx_able_array(left.resultdef) then
  1122. expectloc:=LOC_MMXREGISTER
  1123. {$endif SUPPORT_MMX}
  1124. else if (left.resultdef.typ=orddef) then
  1125. expectloc:=LOC_REGISTER;
  1126. end;
  1127. end;
  1128. {****************************************************************************
  1129. TUNARYPLUSNODE
  1130. ****************************************************************************}
  1131. constructor tunaryplusnode.create(expr: tnode);
  1132. begin
  1133. inherited create(unaryplusn,expr);
  1134. end;
  1135. function tunaryplusnode.pass_1: tnode;
  1136. begin
  1137. result:=nil;
  1138. { can never happen because all the conversions happen
  1139. in pass_typecheck }
  1140. internalerror(201012250);
  1141. end;
  1142. function tunaryplusnode.pass_typecheck: tnode;
  1143. var
  1144. t:tnode;
  1145. begin
  1146. result:=nil;
  1147. typecheckpass(left);
  1148. { avoid any problems with type parameters later on }
  1149. if is_typeparam(left.resultdef) then
  1150. begin
  1151. resultdef:=cundefinedtype;
  1152. exit;
  1153. end;
  1154. set_varstate(left,vs_read,[vsf_must_be_valid]);
  1155. if codegenerror then
  1156. exit;
  1157. if is_constintnode(left) or
  1158. is_constrealnode(left) or
  1159. (left.resultdef.typ=floatdef) or
  1160. is_currency(left.resultdef)
  1161. {$ifdef SUPPORT_MMX}
  1162. or ((cs_mmx in current_settings.localswitches) and
  1163. is_mmx_able_array(left.resultdef))
  1164. {$endif SUPPORT_MMX}
  1165. then
  1166. begin
  1167. result:=left;
  1168. left:=nil;
  1169. end
  1170. else if is_oversizedord(left.resultdef) then
  1171. begin
  1172. if is_64bit(left.resultdef) then
  1173. inserttypeconv(left,s64inttype)
  1174. else if is_32bit(left.resultdef) then
  1175. inserttypeconv(left,s32inttype)
  1176. else if is_16bit(left.resultdef) then
  1177. inserttypeconv(left,s16inttype)
  1178. else
  1179. internalerror(2013040702);
  1180. result:=left;
  1181. left:=nil;
  1182. end
  1183. else if (left.resultdef.typ=orddef) then
  1184. begin
  1185. inserttypeconv(left,sinttype);
  1186. result:=left;
  1187. left:=nil;
  1188. end
  1189. else
  1190. begin
  1191. { allow operator overloading }
  1192. t:=self;
  1193. if isunaryoverloaded(t,[]) then
  1194. begin
  1195. result:=t;
  1196. exit;
  1197. end;
  1198. CGMessage(type_e_mismatch);
  1199. end;
  1200. end;
  1201. {****************************************************************************
  1202. TNOTNODE
  1203. ****************************************************************************}
  1204. const
  1205. boolean_reverse:array[ltn..unequaln] of Tnodetype=(
  1206. gten,gtn,lten,ltn,unequaln,equaln
  1207. );
  1208. constructor tnotnode.create(expr : tnode);
  1209. begin
  1210. inherited create(notn,expr);
  1211. end;
  1212. function tnotnode.simplify(forinline : boolean):tnode;
  1213. var
  1214. v : tconstexprint;
  1215. t : tnode;
  1216. def : tdef;
  1217. begin
  1218. result:=nil;
  1219. { Try optmimizing ourself away }
  1220. if left.nodetype=notn then
  1221. begin
  1222. { Double not. Remove both }
  1223. result:=Tnotnode(left).left;
  1224. tnotnode(left).left:=nil;
  1225. exit;
  1226. end;
  1227. if (left.nodetype in [ltn,lten,equaln,unequaln,gtn,gten]) then
  1228. begin
  1229. { Not of boolean expression. Turn around the operator and remove
  1230. the not. This is not allowed for sets with the gten/lten,
  1231. because there is no ltn/gtn support }
  1232. if (taddnode(left).left.resultdef.typ<>setdef) or
  1233. (left.nodetype in [equaln,unequaln]) then
  1234. begin
  1235. result:=left;
  1236. left.nodetype:=boolean_reverse[left.nodetype];
  1237. left:=nil;
  1238. exit;
  1239. end;
  1240. end;
  1241. { constant folding }
  1242. if (left.nodetype=ordconstn) and
  1243. (left.resultdef.typ=orddef) then
  1244. begin
  1245. v:=tordconstnode(left).value;
  1246. def:=left.resultdef;
  1247. if not calc_not_ordvalue(v,def) then
  1248. CGMessage(type_e_mismatch);
  1249. { not-nodes are not range checked by the code generator -> also
  1250. don't range check while inlining; the resultdef is a bit tricky
  1251. though: the node's resultdef gets changed in most cases compared
  1252. to left, but the not-operation itself is caried out in the code
  1253. generator using the size of left
  1254. }
  1255. if not(forinline) then
  1256. t:=cordconstnode.create(v,def,false)
  1257. else
  1258. begin
  1259. { cut off the value if necessary }
  1260. t:=cordconstnode.create(v,left.resultdef,false);
  1261. { now convert to node's resultdef }
  1262. inserttypeconv_explicit(t,def);
  1263. end;
  1264. result:=t;
  1265. exit;
  1266. end;
  1267. end;
  1268. function tnotnode.pass_typecheck : tnode;
  1269. var
  1270. t : tnode;
  1271. begin
  1272. result:=nil;
  1273. typecheckpass(left);
  1274. { avoid any problems with type parameters later on }
  1275. if is_typeparam(left.resultdef) then
  1276. begin
  1277. resultdef:=cundefinedtype;
  1278. exit;
  1279. end;
  1280. set_varstate(left,vs_read,[vsf_must_be_valid]);
  1281. if codegenerror then
  1282. exit;
  1283. { tp procvar support }
  1284. maybe_call_procvar(left,true);
  1285. resultdef:=left.resultdef;
  1286. result:=simplify(false);
  1287. if assigned(result) then
  1288. exit;
  1289. if is_boolean(resultdef) then
  1290. begin
  1291. end
  1292. else
  1293. {$ifdef SUPPORT_MMX}
  1294. if (cs_mmx in current_settings.localswitches) and
  1295. is_mmx_able_array(left.resultdef) then
  1296. begin
  1297. end
  1298. else
  1299. {$endif SUPPORT_MMX}
  1300. {$ifndef cpu64bitaddr}
  1301. if is_64bitint(left.resultdef) then
  1302. begin
  1303. end
  1304. else
  1305. {$endif not cpu64bitaddr}
  1306. if is_integer(left.resultdef) then
  1307. begin
  1308. end
  1309. else
  1310. begin
  1311. { allow operator overloading }
  1312. t:=self;
  1313. if isunaryoverloaded(t,[]) then
  1314. begin
  1315. result:=t;
  1316. exit;
  1317. end;
  1318. CGMessage(type_e_mismatch);
  1319. end;
  1320. end;
  1321. function tnotnode.pass_1 : tnode;
  1322. begin
  1323. result:=nil;
  1324. firstpass(left);
  1325. if codegenerror then
  1326. exit;
  1327. expectloc:=left.expectloc;
  1328. if is_boolean(resultdef) then
  1329. begin
  1330. if (expectloc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then
  1331. expectloc:=LOC_REGISTER;
  1332. { xtensa has boolean registers which are treateed as flags but they
  1333. are not used for boolean expressions }
  1334. {$if defined(cpuflags) and not(defined(xtensa))}
  1335. if left.expectloc<>LOC_JUMP then
  1336. expectloc:=LOC_FLAGS;
  1337. {$endif defined(cpuflags) and not(defined(xtensa)}
  1338. end
  1339. else
  1340. {$ifdef SUPPORT_MMX}
  1341. if (cs_mmx in current_settings.localswitches) and
  1342. is_mmx_able_array(left.resultdef) then
  1343. expectloc:=LOC_MMXREGISTER
  1344. else
  1345. {$endif SUPPORT_MMX}
  1346. {$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
  1347. if is_64bit(left.resultdef) then
  1348. begin
  1349. if (expectloc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then
  1350. expectloc:=LOC_REGISTER;
  1351. end
  1352. else
  1353. {$endif not cpu64bitalu and not cpuhighleveltarget}
  1354. if is_integer(left.resultdef) then
  1355. expectloc:=LOC_REGISTER;
  1356. end;
  1357. {$ifdef state_tracking}
  1358. function Tnotnode.track_state_pass(exec_known:boolean):boolean;
  1359. begin
  1360. track_state_pass:=true;
  1361. if left.track_state_pass(exec_known) then
  1362. begin
  1363. left.resultdef:=nil;
  1364. do_typecheckpass(left);
  1365. end;
  1366. end;
  1367. {$endif}
  1368. end.