nadd.pas 108 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718
  1. {
  2. Copyright (c) 1998-2002 by Florian Klaempfl
  3. Type checking and simplification for add 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 nadd;
  18. {$i fpcdefs.inc}
  19. { define addstringopt}
  20. interface
  21. uses
  22. node,symtype;
  23. type
  24. taddnode = class(tbinopnode)
  25. private
  26. function pass_typecheck_internal:tnode;
  27. public
  28. resultrealdef : tdef;
  29. constructor create(tt : tnodetype;l,r : tnode);override;
  30. function pass_1 : tnode;override;
  31. function pass_typecheck:tnode;override;
  32. function simplify : tnode;override;
  33. {$ifdef state_tracking}
  34. function track_state_pass(exec_known:boolean):boolean;override;
  35. {$endif}
  36. protected
  37. { override the following if you want to implement }
  38. { parts explicitely in the code generator (JM) }
  39. function first_addstring: tnode; virtual;
  40. function first_addset: tnode; virtual;
  41. { only implements "muln" nodes, the rest always has to be done in }
  42. { the code generator for performance reasons (JM) }
  43. function first_add64bitint: tnode; virtual;
  44. { override and return false if you can handle 32x32->64 }
  45. { bit multiplies directly in your code generator. If }
  46. { this function is overridden to return false, you can }
  47. { get multiplies with left/right both s32bit or u32bit, }
  48. { and resultdef of the muln s64bit or u64bit }
  49. function use_generic_mul32to64: boolean; virtual;
  50. { This routine calls internal runtime library helpers
  51. for all floating point arithmetic in the case
  52. where the emulation switches is on. Otherwise
  53. returns nil, and everything must be done in
  54. the code generation phase.
  55. }
  56. function first_addfloat : tnode; virtual;
  57. private
  58. { checks whether a muln can be calculated as a 32bit }
  59. { * 32bit -> 64 bit }
  60. function try_make_mul32to64: boolean;
  61. end;
  62. taddnodeclass = class of taddnode;
  63. var
  64. { caddnode is used to create nodes of the add type }
  65. { the virtual constructor allows to assign }
  66. { another class type to caddnode => processor }
  67. { specific node types can be created }
  68. caddnode : taddnodeclass;
  69. implementation
  70. uses
  71. {$IFNDEF USE_FAKE_SYSUTILS}
  72. sysutils,
  73. {$ELSE}
  74. fksysutl,
  75. {$ENDIF}
  76. globtype,systems,constexp,
  77. cutils,verbose,globals,widestr,
  78. symconst,symdef,symsym,symtable,defutil,defcmp,
  79. cgbase,
  80. htypechk,pass_1,
  81. nld,nbas,nmat,ncnv,ncon,nset,nopt,ncal,ninl,nmem,nutils,
  82. {$ifdef state_tracking}
  83. nstate,
  84. {$endif}
  85. cpuinfo,procinfo;
  86. {*****************************************************************************
  87. TADDNODE
  88. *****************************************************************************}
  89. {$maxfpuregisters 0}
  90. function getbestreal(t1,t2 : tdef) : tdef;
  91. const
  92. floatweight : array[tfloattype] of byte =
  93. (2,3,4,0,1,5);
  94. begin
  95. if t1.typ=floatdef then
  96. begin
  97. result:=t1;
  98. if t2.typ=floatdef then
  99. begin
  100. { when a comp or currency is used, use always the
  101. best float type to calculate the result }
  102. if (tfloatdef(t2).floattype in [s64comp,s64currency]) or
  103. (tfloatdef(t2).floattype in [s64comp,s64currency]) then
  104. result:=pbestrealtype^
  105. else
  106. if floatweight[tfloatdef(t2).floattype]>floatweight[tfloatdef(t1).floattype] then
  107. result:=t2;
  108. end;
  109. end
  110. else if t2.typ=floatdef then
  111. result:=t2
  112. else internalerror(200508061);
  113. end;
  114. constructor taddnode.create(tt : tnodetype;l,r : tnode);
  115. begin
  116. inherited create(tt,l,r);
  117. end;
  118. function taddnode.simplify : tnode;
  119. var
  120. t, hp : tnode;
  121. lt,rt : tnodetype;
  122. realdef : tdef;
  123. rd,ld : tdef;
  124. rv,lv,v : tconstexprint;
  125. rvd,lvd : bestreal;
  126. ws1,ws2 : pcompilerwidestring;
  127. concatstrings : boolean;
  128. c1,c2 : array[0..1] of char;
  129. s1,s2 : pchar;
  130. l1,l2 : longint;
  131. resultset : Tconstset;
  132. b : boolean;
  133. begin
  134. result:=nil;
  135. { load easier access variables }
  136. rd:=right.resultdef;
  137. ld:=left.resultdef;
  138. rt:=right.nodetype;
  139. lt:=left.nodetype;
  140. if (nodetype = slashn) and
  141. (((rt = ordconstn) and
  142. (tordconstnode(right).value = 0)) or
  143. ((rt = realconstn) and
  144. (trealconstnode(right).value_real = 0.0))) then
  145. begin
  146. if floating_point_range_check_error then
  147. begin
  148. result:=crealconstnode.create(1,pbestrealtype^);
  149. Message(parser_e_division_by_zero);
  150. exit;
  151. end;
  152. end;
  153. { both are int constants }
  154. if (
  155. (
  156. is_constintnode(left) and
  157. is_constintnode(right)
  158. ) or
  159. (
  160. is_constboolnode(left) and
  161. is_constboolnode(right) and
  162. (nodetype in [slashn,ltn,lten,gtn,gten,equaln,unequaln,andn,xorn,orn])
  163. ) or
  164. (
  165. is_constenumnode(left) and
  166. is_constenumnode(right) and
  167. allowenumop(nodetype))
  168. ) or
  169. (
  170. (lt = pointerconstn) and
  171. is_constintnode(right) and
  172. (nodetype in [addn,subn])
  173. ) or
  174. (
  175. (lt in [pointerconstn,niln]) and
  176. (rt in [pointerconstn,niln]) and
  177. (nodetype in [ltn,lten,gtn,gten,equaln,unequaln,subn])
  178. ) then
  179. begin
  180. t:=nil;
  181. { load values }
  182. case lt of
  183. ordconstn:
  184. lv:=tordconstnode(left).value;
  185. pointerconstn:
  186. lv:=tpointerconstnode(left).value;
  187. niln:
  188. lv:=0;
  189. else
  190. internalerror(2002080202);
  191. end;
  192. case rt of
  193. ordconstn:
  194. rv:=tordconstnode(right).value;
  195. pointerconstn:
  196. rv:=tpointerconstnode(right).value;
  197. niln:
  198. rv:=0;
  199. else
  200. internalerror(2002080203);
  201. end;
  202. { type checking already took care of multiplying }
  203. { integer constants with pointeddef.size if necessary }
  204. case nodetype of
  205. addn :
  206. begin
  207. v:=lv+rv;
  208. if v.overflow then
  209. begin
  210. Message(parser_e_arithmetic_operation_overflow);
  211. { Recover }
  212. t:=genintconstnode(0)
  213. end
  214. else if (lt=pointerconstn) then
  215. t := cpointerconstnode.create(qword(v),resultdef)
  216. else
  217. if is_integer(ld) then
  218. t := genintconstnode(v)
  219. else
  220. t := cordconstnode.create(v,resultdef,(ld.typ<>enumdef));
  221. end;
  222. subn :
  223. begin
  224. v:=lv-rv;
  225. if v.overflow then
  226. begin
  227. Message(parser_e_arithmetic_operation_overflow);
  228. { Recover }
  229. t:=genintconstnode(0)
  230. end
  231. else if (lt=pointerconstn) then
  232. { pointer-pointer results in an integer }
  233. if (rt=pointerconstn) then
  234. begin
  235. if not(nf_has_pointerdiv in flags) then
  236. internalerror(2008030101);
  237. t := genintconstnode(v)
  238. end
  239. else
  240. t := cpointerconstnode.create(qword(v),resultdef)
  241. else
  242. if is_integer(ld) then
  243. t:=genintconstnode(v)
  244. else
  245. t:=cordconstnode.create(v,resultdef,(ld.typ<>enumdef));
  246. end;
  247. muln :
  248. begin
  249. v:=lv*rv;
  250. if v.overflow then
  251. begin
  252. message(parser_e_arithmetic_operation_overflow);
  253. { Recover }
  254. t:=genintconstnode(0)
  255. end
  256. else
  257. t:=genintconstnode(v)
  258. end;
  259. xorn :
  260. if is_integer(ld) then
  261. t:=genintconstnode(lv xor rv)
  262. else
  263. t:=cordconstnode.create(lv xor rv,resultdef,true);
  264. orn :
  265. if is_integer(ld) then
  266. t:=genintconstnode(lv or rv)
  267. else
  268. t:=cordconstnode.create(lv or rv,resultdef,true);
  269. andn :
  270. if is_integer(ld) then
  271. t:=genintconstnode(lv and rv)
  272. else
  273. t:=cordconstnode.create(lv and rv,resultdef,true);
  274. ltn :
  275. t:=cordconstnode.create(ord(lv<rv),booltype,true);
  276. lten :
  277. t:=cordconstnode.create(ord(lv<=rv),booltype,true);
  278. gtn :
  279. t:=cordconstnode.create(ord(lv>rv),booltype,true);
  280. gten :
  281. t:=cordconstnode.create(ord(lv>=rv),booltype,true);
  282. equaln :
  283. t:=cordconstnode.create(ord(lv=rv),booltype,true);
  284. unequaln :
  285. t:=cordconstnode.create(ord(lv<>rv),booltype,true);
  286. slashn :
  287. begin
  288. { int/int becomes a real }
  289. rvd:=rv;
  290. lvd:=lv;
  291. t:=crealconstnode.create(lvd/rvd,resultrealdef);
  292. end;
  293. else
  294. internalerror(2008022101);
  295. end;
  296. result:=t;
  297. exit;
  298. end
  299. {Match against the ranges, i.e.:
  300. var a:1..10;
  301. begin
  302. if a>0 then
  303. ... always evaluates to true. (DM)}
  304. else if is_constintnode(left) and (right.resultdef.typ=orddef) and
  305. { don't ignore type checks }
  306. is_subequal(left.resultdef,right.resultdef) then
  307. begin
  308. t:=nil;
  309. hp:=right;
  310. realdef:=hp.resultdef;
  311. while (hp.nodetype=typeconvn) and
  312. ([nf_internal,nf_explicit] * hp.flags = []) and
  313. is_in_limit(ttypeconvnode(hp).left.resultdef,realdef) do
  314. begin
  315. hp:=ttypeconvnode(hp).left;
  316. realdef:=hp.resultdef;
  317. end;
  318. lv:=Tordconstnode(left).value;
  319. with torddef(realdef) do
  320. case nodetype of
  321. ltn:
  322. if lv<low then
  323. t:=Cordconstnode.create(1,booltype,true)
  324. else if lv>=high then
  325. t:=Cordconstnode.create(0,booltype,true);
  326. lten:
  327. if lv<=low then
  328. t:=Cordconstnode.create(1,booltype,true)
  329. else if lv>high then
  330. t:=Cordconstnode.create(0,booltype,true);
  331. gtn:
  332. if lv<=low then
  333. t:=Cordconstnode.create(0,booltype,true)
  334. else if lv>high then
  335. t:=Cordconstnode.create(1,booltype,true);
  336. gten :
  337. if lv<low then
  338. t:=Cordconstnode.create(0,booltype,true)
  339. else if lv>=high then
  340. t:=Cordconstnode.create(1,booltype,true);
  341. equaln:
  342. if (lv<low) or (lv>high) then
  343. t:=Cordconstnode.create(0,booltype,true);
  344. unequaln:
  345. if (lv<low) or (lv>high) then
  346. t:=Cordconstnode.create(1,booltype,true);
  347. end;
  348. if t<>nil then
  349. begin
  350. result:=t;
  351. exit;
  352. end
  353. end
  354. else if (left.resultdef.typ=orddef) and is_constintnode(right) and
  355. { don't ignore type checks }
  356. is_subequal(left.resultdef,right.resultdef) then
  357. begin
  358. t:=nil;
  359. hp:=left;
  360. realdef:=hp.resultdef;
  361. while (hp.nodetype=typeconvn) and
  362. ([nf_internal,nf_explicit] * hp.flags = []) and
  363. is_in_limit(ttypeconvnode(hp).left.resultdef,realdef) do
  364. begin
  365. hp:=ttypeconvnode(hp).left;
  366. realdef:=hp.resultdef;
  367. end;
  368. rv:=Tordconstnode(right).value;
  369. with torddef(realdef) do
  370. case nodetype of
  371. ltn:
  372. if high<rv then
  373. t:=Cordconstnode.create(1,booltype,true)
  374. else if low>=rv then
  375. t:=Cordconstnode.create(0,booltype,true);
  376. lten:
  377. if high<=rv then
  378. t:=Cordconstnode.create(1,booltype,true)
  379. else if low>rv then
  380. t:=Cordconstnode.create(0,booltype,true);
  381. gtn:
  382. if high<=rv then
  383. t:=Cordconstnode.create(0,booltype,true)
  384. else if low>rv then
  385. t:=Cordconstnode.create(1,booltype,true);
  386. gten:
  387. if high<rv then
  388. t:=Cordconstnode.create(0,booltype,true)
  389. else if low>=rv then
  390. t:=Cordconstnode.create(1,booltype,true);
  391. equaln:
  392. if (rv<low) or (rv>high) then
  393. t:=Cordconstnode.create(0,booltype,true);
  394. unequaln:
  395. if (rv<low) or (rv>high) then
  396. t:=Cordconstnode.create(1,booltype,true);
  397. end;
  398. if t<>nil then
  399. begin
  400. result:=t;
  401. exit;
  402. end
  403. end;
  404. { Add,Sub,Mul with constant 0, 1 or -1? }
  405. if is_constintnode(right) and is_integer(left.resultdef) then
  406. begin
  407. if tordconstnode(right).value = 0 then
  408. begin
  409. case nodetype of
  410. addn,subn:
  411. result := left.getcopy;
  412. muln:
  413. result:=cordconstnode.create(0,resultdef,true);
  414. end;
  415. end
  416. else if tordconstnode(right).value = 1 then
  417. begin
  418. case nodetype of
  419. muln:
  420. result := left.getcopy;
  421. end;
  422. end
  423. {$ifdef VER2_2}
  424. else if (tordconstnode(right).value.svalue = -1) and (tordconstnode(right).value.signed) then
  425. {$else}
  426. else if tordconstnode(right).value = -1 then
  427. {$endif}
  428. begin
  429. case nodetype of
  430. muln:
  431. result := cunaryminusnode.create(left.getcopy);
  432. end;
  433. end;
  434. if assigned(result) then
  435. exit;
  436. end;
  437. if is_constintnode(left) and is_integer(right.resultdef) then
  438. begin
  439. if tordconstnode(left).value = 0 then
  440. begin
  441. case nodetype of
  442. addn:
  443. result := right.getcopy;
  444. subn:
  445. result := cunaryminusnode.create(right.getcopy);
  446. muln:
  447. result:=cordconstnode.create(0,right.resultdef,true);
  448. end;
  449. end
  450. else if tordconstnode(left).value = 1 then
  451. begin
  452. case nodetype of
  453. muln:
  454. result := right.getcopy;
  455. end;
  456. end
  457. {$ifdef VER2_2}
  458. else if (tordconstnode(left).value.svalue = -1) and (tordconstnode(left).value.signed) then
  459. {$else}
  460. else if tordconstnode(left).value = -1 then
  461. {$endif}
  462. begin
  463. case nodetype of
  464. muln:
  465. result := cunaryminusnode.create(right.getcopy);
  466. end;
  467. end;
  468. if assigned(result) then
  469. exit;
  470. end;
  471. { both real constants ? }
  472. if (lt=realconstn) and (rt=realconstn) then
  473. begin
  474. lvd:=trealconstnode(left).value_real;
  475. rvd:=trealconstnode(right).value_real;
  476. case nodetype of
  477. addn :
  478. t:=crealconstnode.create(lvd+rvd,resultrealdef);
  479. subn :
  480. t:=crealconstnode.create(lvd-rvd,resultrealdef);
  481. muln :
  482. t:=crealconstnode.create(lvd*rvd,resultrealdef);
  483. starstarn:
  484. begin
  485. if lvd<0 then
  486. begin
  487. Message(parser_e_invalid_float_operation);
  488. t:=crealconstnode.create(0,resultrealdef);
  489. end
  490. else if lvd=0 then
  491. t:=crealconstnode.create(1.0,resultrealdef)
  492. else
  493. t:=crealconstnode.create(exp(ln(lvd)*rvd),resultrealdef);
  494. end;
  495. slashn :
  496. t:=crealconstnode.create(lvd/rvd,resultrealdef);
  497. ltn :
  498. t:=cordconstnode.create(ord(lvd<rvd),booltype,true);
  499. lten :
  500. t:=cordconstnode.create(ord(lvd<=rvd),booltype,true);
  501. gtn :
  502. t:=cordconstnode.create(ord(lvd>rvd),booltype,true);
  503. gten :
  504. t:=cordconstnode.create(ord(lvd>=rvd),booltype,true);
  505. equaln :
  506. t:=cordconstnode.create(ord(lvd=rvd),booltype,true);
  507. unequaln :
  508. t:=cordconstnode.create(ord(lvd<>rvd),booltype,true);
  509. else
  510. internalerror(2008022102);
  511. end;
  512. result:=t;
  513. exit;
  514. end;
  515. { first, we handle widestrings, so we can check later for }
  516. { stringconstn only }
  517. { widechars are converted above to widestrings too }
  518. { this isn't ver y efficient, but I don't think }
  519. { that it does matter that much (FK) }
  520. if (lt=stringconstn) and (rt=stringconstn) and
  521. (tstringconstnode(left).cst_type in [cst_widestring,cst_unicodestring]) and
  522. (tstringconstnode(right).cst_type in [cst_widestring,cst_unicodestring]) then
  523. begin
  524. initwidestring(ws1);
  525. initwidestring(ws2);
  526. copywidestring(pcompilerwidestring(tstringconstnode(left).value_str),ws1);
  527. copywidestring(pcompilerwidestring(tstringconstnode(right).value_str),ws2);
  528. case nodetype of
  529. addn :
  530. begin
  531. concatwidestrings(ws1,ws2);
  532. t:=cstringconstnode.createwstr(ws1);
  533. end;
  534. ltn :
  535. t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)<0),booltype,true);
  536. lten :
  537. t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)<=0),booltype,true);
  538. gtn :
  539. t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)>0),booltype,true);
  540. gten :
  541. t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)>=0),booltype,true);
  542. equaln :
  543. t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)=0),booltype,true);
  544. unequaln :
  545. t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)<>0),booltype,true);
  546. else
  547. internalerror(2008022103);
  548. end;
  549. donewidestring(ws1);
  550. donewidestring(ws2);
  551. result:=t;
  552. exit;
  553. end;
  554. { concating strings ? }
  555. concatstrings:=false;
  556. if (lt=ordconstn) and (rt=ordconstn) and
  557. is_char(ld) and is_char(rd) then
  558. begin
  559. c1[0]:=char(int64(tordconstnode(left).value));
  560. c1[1]:=#0;
  561. l1:=1;
  562. c2[0]:=char(int64(tordconstnode(right).value));
  563. c2[1]:=#0;
  564. l2:=1;
  565. s1:=@c1[0];
  566. s2:=@c2[0];
  567. concatstrings:=true;
  568. end
  569. else if (lt=stringconstn) and (rt=ordconstn) and is_char(rd) then
  570. begin
  571. s1:=tstringconstnode(left).value_str;
  572. l1:=tstringconstnode(left).len;
  573. c2[0]:=char(int64(tordconstnode(right).value));
  574. c2[1]:=#0;
  575. s2:=@c2[0];
  576. l2:=1;
  577. concatstrings:=true;
  578. end
  579. else if (lt=ordconstn) and (rt=stringconstn) and is_char(ld) then
  580. begin
  581. c1[0]:=char(int64(tordconstnode(left).value));
  582. c1[1]:=#0;
  583. l1:=1;
  584. s1:=@c1[0];
  585. s2:=tstringconstnode(right).value_str;
  586. l2:=tstringconstnode(right).len;
  587. concatstrings:=true;
  588. end
  589. else if (lt=stringconstn) and (rt=stringconstn) then
  590. begin
  591. s1:=tstringconstnode(left).value_str;
  592. l1:=tstringconstnode(left).len;
  593. s2:=tstringconstnode(right).value_str;
  594. l2:=tstringconstnode(right).len;
  595. concatstrings:=true;
  596. end;
  597. if concatstrings then
  598. begin
  599. case nodetype of
  600. addn :
  601. t:=cstringconstnode.createpchar(concatansistrings(s1,s2,l1,l2),l1+l2);
  602. ltn :
  603. t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)<0),booltype,true);
  604. lten :
  605. t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)<=0),booltype,true);
  606. gtn :
  607. t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)>0),booltype,true);
  608. gten :
  609. t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)>=0),booltype,true);
  610. equaln :
  611. t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)=0),booltype,true);
  612. unequaln :
  613. t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)<>0),booltype,true);
  614. else
  615. internalerror(2008022104);
  616. end;
  617. result:=t;
  618. exit;
  619. end;
  620. { set constant evaluation }
  621. if (right.nodetype=setconstn) and
  622. not assigned(tsetconstnode(right).left) and
  623. (left.nodetype=setconstn) and
  624. not assigned(tsetconstnode(left).left) then
  625. begin
  626. case nodetype of
  627. addn :
  628. begin
  629. resultset:=tsetconstnode(right).value_set^ + tsetconstnode(left).value_set^;
  630. t:=csetconstnode.create(@resultset,resultdef);
  631. end;
  632. muln :
  633. begin
  634. resultset:=tsetconstnode(right).value_set^ * tsetconstnode(left).value_set^;
  635. t:=csetconstnode.create(@resultset,resultdef);
  636. end;
  637. subn :
  638. begin
  639. resultset:=tsetconstnode(left).value_set^ - tsetconstnode(right).value_set^;
  640. t:=csetconstnode.create(@resultset,resultdef);
  641. end;
  642. symdifn :
  643. begin
  644. resultset:=tsetconstnode(right).value_set^ >< tsetconstnode(left).value_set^;
  645. t:=csetconstnode.create(@resultset,resultdef);
  646. end;
  647. unequaln :
  648. begin
  649. b:=tsetconstnode(right).value_set^ <> tsetconstnode(left).value_set^;
  650. t:=cordconstnode.create(byte(b),booltype,true);
  651. end;
  652. equaln :
  653. begin
  654. b:=tsetconstnode(right).value_set^ = tsetconstnode(left).value_set^;
  655. t:=cordconstnode.create(byte(b),booltype,true);
  656. end;
  657. lten :
  658. begin
  659. b:=tsetconstnode(left).value_set^ <= tsetconstnode(right).value_set^;
  660. t:=cordconstnode.create(byte(b),booltype,true);
  661. end;
  662. gten :
  663. begin
  664. b:=tsetconstnode(left).value_set^ >= tsetconstnode(right).value_set^;
  665. t:=cordconstnode.create(byte(b),booltype,true);
  666. end;
  667. else
  668. internalerror(2008022105);
  669. end;
  670. result:=t;
  671. exit;
  672. end;
  673. end;
  674. function taddnode.pass_typecheck:tnode;
  675. begin
  676. { This function is small to keep the stack small for recursive of
  677. large + operations }
  678. typecheckpass(left);
  679. typecheckpass(right);
  680. result:=pass_typecheck_internal;
  681. end;
  682. function taddnode.pass_typecheck_internal:tnode;
  683. var
  684. hp : tnode;
  685. rd,ld,nd : tdef;
  686. hsym : tfieldvarsym;
  687. llow,lhigh,
  688. rlow,rhigh : tconstexprint;
  689. strtype : tstringtype;
  690. b : boolean;
  691. lt,rt : tnodetype;
  692. ot : tnodetype;
  693. {$ifdef state_tracking}
  694. factval : Tnode;
  695. change : boolean;
  696. {$endif}
  697. begin
  698. result:=nil;
  699. { both left and right need to be valid }
  700. set_varstate(left,vs_read,[vsf_must_be_valid]);
  701. set_varstate(right,vs_read,[vsf_must_be_valid]);
  702. if codegenerror then
  703. exit;
  704. { tp procvar support }
  705. maybe_call_procvar(left,true);
  706. maybe_call_procvar(right,true);
  707. { convert array constructors to sets, because there is no other operator
  708. possible for array constructors }
  709. if is_array_constructor(left.resultdef) then
  710. begin
  711. arrayconstructor_to_set(left);
  712. typecheckpass(left);
  713. end;
  714. if is_array_constructor(right.resultdef) then
  715. begin
  716. arrayconstructor_to_set(right);
  717. typecheckpass(right);
  718. end;
  719. { allow operator overloading }
  720. hp:=self;
  721. if isbinaryoverloaded(hp) then
  722. begin
  723. result:=hp;
  724. exit;
  725. end;
  726. { Stop checking when an error was found in the operator checking }
  727. if codegenerror then
  728. begin
  729. result:=cerrornode.create;
  730. exit;
  731. end;
  732. { Kylix allows enum+ordconstn in an enum declaration (blocktype
  733. is bt_type), we need to do the conversion here before the
  734. constant folding }
  735. if (m_delphi in current_settings.modeswitches) and
  736. (blocktype=bt_type) then
  737. begin
  738. if (left.resultdef.typ=enumdef) and
  739. (right.resultdef.typ=orddef) then
  740. begin
  741. { insert explicit typecast to default signed int }
  742. left:=ctypeconvnode.create_internal(left,sinttype);
  743. typecheckpass(left);
  744. end
  745. else
  746. if (left.resultdef.typ=orddef) and
  747. (right.resultdef.typ=enumdef) then
  748. begin
  749. { insert explicit typecast to default signed int }
  750. right:=ctypeconvnode.create_internal(right,sinttype);
  751. typecheckpass(right);
  752. end;
  753. end;
  754. { is one a real float, then both need to be floats, this
  755. need to be done before the constant folding so constant
  756. operation on a float and int are also handled }
  757. resultrealdef:=pbestrealtype^;
  758. if (right.resultdef.typ=floatdef) or (left.resultdef.typ=floatdef) then
  759. begin
  760. { when both floattypes are already equal then use that
  761. floattype for results }
  762. if (right.resultdef.typ=floatdef) and
  763. (left.resultdef.typ=floatdef) and
  764. (tfloatdef(left.resultdef).floattype=tfloatdef(right.resultdef).floattype) then
  765. resultrealdef:=left.resultdef
  766. { when there is a currency type then use currency, but
  767. only when currency is defined as float }
  768. else
  769. if (is_currency(right.resultdef) or
  770. is_currency(left.resultdef)) and
  771. ((s64currencytype.typ = floatdef) or
  772. (nodetype <> slashn)) then
  773. begin
  774. resultrealdef:=s64currencytype;
  775. inserttypeconv(right,resultrealdef);
  776. inserttypeconv(left,resultrealdef);
  777. end
  778. else
  779. begin
  780. resultrealdef:=getbestreal(left.resultdef,right.resultdef);
  781. inserttypeconv(right,resultrealdef);
  782. inserttypeconv(left,resultrealdef);
  783. end;
  784. end;
  785. { If both operands are constant and there is a unicodestring
  786. or unicodestring then convert everything to unicodestring }
  787. if is_constnode(right) and is_constnode(left) and
  788. (is_unicodestring(right.resultdef) or
  789. is_unicodestring(left.resultdef)) then
  790. begin
  791. inserttypeconv(right,cunicodestringtype);
  792. inserttypeconv(left,cunicodestringtype);
  793. end;
  794. { If both operands are constant and there is a widechar
  795. or widestring then convert everything to widestring. This
  796. allows constant folding like char+widechar }
  797. if is_constnode(right) and is_constnode(left) and
  798. (is_widestring(right.resultdef) or
  799. is_widestring(left.resultdef) or
  800. is_widechar(right.resultdef) or
  801. is_widechar(left.resultdef)) then
  802. begin
  803. inserttypeconv(right,cwidestringtype);
  804. inserttypeconv(left,cwidestringtype);
  805. end;
  806. { load easier access variables }
  807. rd:=right.resultdef;
  808. ld:=left.resultdef;
  809. rt:=right.nodetype;
  810. lt:=left.nodetype;
  811. { 4 character constant strings are compatible with orddef }
  812. { in macpas mode (become cardinals) }
  813. if (m_mac in current_settings.modeswitches) and
  814. { only allow for comparisons, additions etc are }
  815. { normally program errors }
  816. (nodetype in [ltn,lten,gtn,gten,unequaln,equaln]) and
  817. (((lt=stringconstn) and
  818. (tstringconstnode(left).len=4) and
  819. (rd.typ=orddef)) or
  820. ((rt=stringconstn) and
  821. (tstringconstnode(right).len=4) and
  822. (ld.typ=orddef))) then
  823. begin
  824. if (rt=stringconstn) then
  825. begin
  826. inserttypeconv(right,u32inttype);
  827. rt:=right.nodetype;
  828. rd:=right.resultdef;
  829. end
  830. else
  831. begin
  832. inserttypeconv(left,u32inttype);
  833. lt:=left.nodetype;
  834. ld:=left.resultdef;
  835. end;
  836. end;
  837. { but an int/int gives real/real! }
  838. if (nodetype=slashn) and not(is_vector(left.resultdef)) and not(is_vector(right.resultdef)) then
  839. begin
  840. if is_currency(left.resultdef) and
  841. is_currency(right.resultdef) then
  842. { In case of currency, converting to float means dividing by 10000 }
  843. { However, since this is already a division, both divisions by }
  844. { 10000 are eliminated when we divide the results -> we can skip }
  845. { them. }
  846. if s64currencytype.typ = floatdef then
  847. begin
  848. { there's no s64comptype or so, how do we avoid the type conversion?
  849. left.resultdef := s64comptype;
  850. right.resultdef := s64comptype; }
  851. end
  852. else
  853. begin
  854. left.resultdef := s64inttype;
  855. right.resultdef := s64inttype;
  856. end;
  857. inserttypeconv(right,resultrealdef);
  858. inserttypeconv(left,resultrealdef);
  859. end
  860. { if both are orddefs then check sub types }
  861. else if (ld.typ=orddef) and (rd.typ=orddef) then
  862. begin
  863. { set for & and | operations in macpas mode: they only work on }
  864. { booleans, and always short circuit evaluation }
  865. if (nf_short_bool in flags) then
  866. begin
  867. if not is_boolean(ld) then
  868. begin
  869. inserttypeconv(left,booltype);
  870. ld := left.resultdef;
  871. end;
  872. if not is_boolean(rd) then
  873. begin
  874. inserttypeconv(right,booltype);
  875. rd := right.resultdef;
  876. end;
  877. end;
  878. { 2 booleans? Make them equal to the largest boolean }
  879. if (is_boolean(ld) and is_boolean(rd)) or
  880. (nf_short_bool in flags) then
  881. begin
  882. if (torddef(left.resultdef).size>torddef(right.resultdef).size) or
  883. (is_cbool(left.resultdef) and not is_cbool(right.resultdef)) then
  884. begin
  885. right:=ctypeconvnode.create_internal(right,left.resultdef);
  886. ttypeconvnode(right).convtype:=tc_bool_2_bool;
  887. typecheckpass(right);
  888. end
  889. else if (torddef(left.resultdef).size<torddef(right.resultdef).size) or
  890. (not is_cbool(left.resultdef) and is_cbool(right.resultdef)) then
  891. begin
  892. left:=ctypeconvnode.create_internal(left,right.resultdef);
  893. ttypeconvnode(left).convtype:=tc_bool_2_bool;
  894. typecheckpass(left);
  895. end;
  896. case nodetype of
  897. xorn,
  898. ltn,
  899. lten,
  900. gtn,
  901. gten,
  902. andn,
  903. orn:
  904. begin
  905. end;
  906. unequaln,
  907. equaln:
  908. begin
  909. if not(cs_full_boolean_eval in current_settings.localswitches) or
  910. (nf_short_bool in flags) then
  911. begin
  912. { Remove any compares with constants }
  913. if (left.nodetype=ordconstn) then
  914. begin
  915. hp:=right;
  916. b:=(tordconstnode(left).value<>0);
  917. ot:=nodetype;
  918. left.free;
  919. left:=nil;
  920. right:=nil;
  921. if (not(b) and (ot=equaln)) or
  922. (b and (ot=unequaln)) then
  923. begin
  924. hp:=cnotnode.create(hp);
  925. end;
  926. result:=hp;
  927. exit;
  928. end;
  929. if (right.nodetype=ordconstn) then
  930. begin
  931. hp:=left;
  932. b:=(tordconstnode(right).value<>0);
  933. ot:=nodetype;
  934. right.free;
  935. right:=nil;
  936. left:=nil;
  937. if (not(b) and (ot=equaln)) or
  938. (b and (ot=unequaln)) then
  939. begin
  940. hp:=cnotnode.create(hp);
  941. end;
  942. result:=hp;
  943. exit;
  944. end;
  945. end;
  946. end;
  947. else
  948. begin
  949. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  950. result:=cnothingnode.create;
  951. exit;
  952. end;
  953. end;
  954. end
  955. { Both are chars? }
  956. else if is_char(rd) and is_char(ld) then
  957. begin
  958. if nodetype=addn then
  959. begin
  960. resultdef:=cshortstringtype;
  961. if not(is_constcharnode(left) and is_constcharnode(right)) then
  962. begin
  963. inserttypeconv(left,cshortstringtype);
  964. {$ifdef addstringopt}
  965. hp := genaddsstringcharoptnode(self);
  966. result := hp;
  967. exit;
  968. {$endif addstringopt}
  969. end
  970. end
  971. else if not(nodetype in [ltn,lten,gtn,gten,unequaln,equaln]) then
  972. begin
  973. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  974. result:=cnothingnode.create;
  975. exit;
  976. end;
  977. end
  978. { There is a widechar? }
  979. else if is_widechar(rd) or is_widechar(ld) then
  980. begin
  981. { widechar+widechar gives widestring }
  982. if nodetype=addn then
  983. begin
  984. inserttypeconv(left,cwidestringtype);
  985. if (torddef(rd).ordtype<>uwidechar) then
  986. inserttypeconv(right,cwidechartype);
  987. resultdef:=cwidestringtype;
  988. end
  989. else
  990. begin
  991. if (torddef(ld).ordtype<>uwidechar) then
  992. inserttypeconv(left,cwidechartype);
  993. if (torddef(rd).ordtype<>uwidechar) then
  994. inserttypeconv(right,cwidechartype);
  995. end;
  996. end
  997. { is there a currency type ? }
  998. else if ((torddef(rd).ordtype=scurrency) or (torddef(ld).ordtype=scurrency)) then
  999. begin
  1000. if (torddef(ld).ordtype<>scurrency) then
  1001. inserttypeconv(left,s64currencytype);
  1002. if (torddef(rd).ordtype<>scurrency) then
  1003. inserttypeconv(right,s64currencytype);
  1004. end
  1005. { "and" does't care about the sign of integers }
  1006. { "xor", "or" and compares don't need extension to native int }
  1007. { size either as long as both values are signed or unsigned }
  1008. { "xor" and "or" also don't care about the sign if the values }
  1009. { occupy an entire register }
  1010. else if is_integer(ld) and is_integer(rd) and
  1011. ((nodetype=andn) or
  1012. ((nodetype in [orn,xorn,equaln,unequaln,gtn,gten,ltn,lten]) and
  1013. not(is_signed(ld) xor is_signed(rd)))) then
  1014. begin
  1015. if (rd.size>ld.size) or
  1016. { Delphi-compatible: prefer unsigned type for "and" with equal size }
  1017. ((rd.size=ld.size) and
  1018. not is_signed(rd)) then
  1019. begin
  1020. if (rd.size=ld.size) and
  1021. is_signed(ld) then
  1022. inserttypeconv_internal(left,right.resultdef)
  1023. else
  1024. inserttypeconv(left,right.resultdef)
  1025. end
  1026. else
  1027. begin
  1028. if (rd.size=ld.size) and
  1029. is_signed(rd) then
  1030. inserttypeconv_internal(right,left.resultdef)
  1031. else
  1032. inserttypeconv(right,left.resultdef)
  1033. end
  1034. end
  1035. { is there a signed 64 bit type ? }
  1036. else if ((torddef(rd).ordtype=s64bit) or (torddef(ld).ordtype=s64bit)) then
  1037. begin
  1038. if (torddef(ld).ordtype<>s64bit) then
  1039. inserttypeconv(left,s64inttype);
  1040. if (torddef(rd).ordtype<>s64bit) then
  1041. inserttypeconv(right,s64inttype);
  1042. end
  1043. { is there a unsigned 64 bit type ? }
  1044. else if ((torddef(rd).ordtype=u64bit) or (torddef(ld).ordtype=u64bit)) then
  1045. begin
  1046. if (torddef(ld).ordtype<>u64bit) then
  1047. inserttypeconv(left,u64inttype);
  1048. if (torddef(rd).ordtype<>u64bit) then
  1049. inserttypeconv(right,u64inttype);
  1050. end
  1051. { 64 bit cpus do calculations always in 64 bit }
  1052. {$ifndef cpu64bitaddr}
  1053. { is there a cardinal? }
  1054. else if ((torddef(rd).ordtype=u32bit) or (torddef(ld).ordtype=u32bit)) then
  1055. begin
  1056. { convert positive constants to u32bit }
  1057. if (torddef(ld).ordtype<>u32bit) and
  1058. is_constintnode(left) and
  1059. (tordconstnode(left).value >= 0) then
  1060. inserttypeconv(left,u32inttype);
  1061. if (torddef(rd).ordtype<>u32bit) and
  1062. is_constintnode(right) and
  1063. (tordconstnode(right).value >= 0) then
  1064. inserttypeconv(right,u32inttype);
  1065. { when one of the operand is signed or the operation is subn then perform
  1066. the operation in 64bit, can't use rd/ld here because there
  1067. could be already typeconvs inserted.
  1068. This is compatible with the code below for other unsigned types (PFV) }
  1069. if is_signed(left.resultdef) or
  1070. is_signed(right.resultdef) or
  1071. (nodetype=subn) then
  1072. begin
  1073. if nodetype<>subn then
  1074. CGMessage(type_w_mixed_signed_unsigned);
  1075. { mark as internal in case added for a subn, so }
  1076. { ttypeconvnode.simplify can remove the 64 bit }
  1077. { typecast again if semantically correct. Even }
  1078. { if we could detect that here already, we }
  1079. { mustn't do it here because that would change }
  1080. { overload choosing behaviour etc. The code in }
  1081. { ncnv.pas is run after that is already decided }
  1082. if (not is_signed(left.resultdef) and
  1083. not is_signed(right.resultdef)) or
  1084. (nodetype in [orn,xorn]) then
  1085. include(flags,nf_internal);
  1086. inserttypeconv(left,s64inttype);
  1087. inserttypeconv(right,s64inttype);
  1088. end
  1089. else
  1090. begin
  1091. if (torddef(left.resultdef).ordtype<>u32bit) then
  1092. inserttypeconv(left,u32inttype);
  1093. if (torddef(right.resultdef).ordtype<>u32bit) then
  1094. inserttypeconv(right,u32inttype);
  1095. end;
  1096. end
  1097. {$endif cpu64bitaddr}
  1098. { generic ord conversion is sinttype }
  1099. else
  1100. begin
  1101. { if the left or right value is smaller than the normal
  1102. type sinttype and is unsigned, and the other value
  1103. is a constant < 0, the result will always be false/true
  1104. for equal / unequal nodes.
  1105. }
  1106. if (
  1107. { left : unsigned ordinal var, right : < 0 constant }
  1108. (
  1109. ((is_signed(ld)=false) and (is_constintnode(left) =false)) and
  1110. ((is_constintnode(right)) and (tordconstnode(right).value < 0))
  1111. ) or
  1112. { right : unsigned ordinal var, left : < 0 constant }
  1113. (
  1114. ((is_signed(rd)=false) and (is_constintnode(right) =false)) and
  1115. ((is_constintnode(left)) and (tordconstnode(left).value < 0))
  1116. )
  1117. ) then
  1118. begin
  1119. if nodetype = equaln then
  1120. CGMessage(type_w_signed_unsigned_always_false)
  1121. else
  1122. if nodetype = unequaln then
  1123. CGMessage(type_w_signed_unsigned_always_true)
  1124. else
  1125. if (is_constintnode(left) and (nodetype in [ltn,lten])) or
  1126. (is_constintnode(right) and (nodetype in [gtn,gten])) then
  1127. CGMessage(type_w_signed_unsigned_always_true)
  1128. else
  1129. if (is_constintnode(right) and (nodetype in [ltn,lten])) or
  1130. (is_constintnode(left) and (nodetype in [gtn,gten])) then
  1131. CGMessage(type_w_signed_unsigned_always_false);
  1132. end;
  1133. { When there is a signed type or there is a minus operation
  1134. we convert to signed int. Otherwise (both are unsigned) we keep
  1135. the result also unsigned. This is compatible with Delphi (PFV) }
  1136. if is_signed(ld) or
  1137. is_signed(rd) or
  1138. (nodetype=subn) then
  1139. begin
  1140. {$ifdef cpunodefaultint}
  1141. { for small cpus we use the smallest common type }
  1142. llow:=torddef(rd).low;
  1143. if llow<torddef(ld).low then
  1144. llow:=torddef(ld).low;
  1145. lhigh:=torddef(rd).high;
  1146. if lhigh<torddef(ld).high then
  1147. lhigh:=torddef(ld).high;
  1148. case range_to_basetype(llow,lhigh) of
  1149. s8bit:
  1150. nd:=s8inttype;
  1151. u8bit:
  1152. nd:=u8inttype;
  1153. s16bit:
  1154. nd:=s16inttype;
  1155. u16bit:
  1156. nd:=u16inttype;
  1157. s32bit:
  1158. nd:=s32inttype;
  1159. u32bit:
  1160. nd:=u32inttype;
  1161. s64bit:
  1162. nd:=s64inttype;
  1163. u64bit:
  1164. nd:=u64inttype;
  1165. else
  1166. internalerror(200802291);
  1167. end;
  1168. inserttypeconv(right,nd);
  1169. inserttypeconv(left,nd);
  1170. {$else cpunodefaultint}
  1171. inserttypeconv(right,sinttype);
  1172. inserttypeconv(left,sinttype);
  1173. {$endif cpunodefaultint}
  1174. end
  1175. else
  1176. begin
  1177. inserttypeconv(right,uinttype);
  1178. inserttypeconv(left,uinttype);
  1179. end;
  1180. end;
  1181. end
  1182. { if both are floatdefs, conversion is already done before constant folding }
  1183. else if (ld.typ=floatdef) then
  1184. begin
  1185. if not(nodetype in [addn,subn,muln,slashn,equaln,unequaln,ltn,lten,gtn,gten]) then
  1186. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  1187. end
  1188. { left side a setdef, must be before string processing,
  1189. else array constructor can be seen as array of char (PFV) }
  1190. else if (ld.typ=setdef) then
  1191. begin
  1192. if not(nodetype in [addn,subn,symdifn,muln,equaln,unequaln,lten,gten]) then
  1193. CGMessage(type_e_set_operation_unknown);
  1194. { right must either be a set or a set element }
  1195. if (rd.typ<>setdef) and
  1196. (rt<>setelementn) then
  1197. CGMessage(type_e_mismatch)
  1198. { Make operands the same setdef. If one's elementtype fits }
  1199. { entirely inside the other's, pick the one with the largest }
  1200. { range. Otherwise create a new setdef with a range which }
  1201. { can contain both. }
  1202. else if not(equal_defs(ld,rd)) then
  1203. begin
  1204. { note: ld cannot be an empty set with elementdef=nil in }
  1205. { case right is not a set, arrayconstructor_to_set takes }
  1206. { care of that }
  1207. { 1: rd is a set with an assigned elementdef, and ld is }
  1208. { either an empty set without elementdef or a set whose }
  1209. { elementdef fits in rd's elementdef -> convert to rd }
  1210. if ((rd.typ=setdef) and
  1211. assigned(tsetdef(rd).elementdef) and
  1212. (not assigned(tsetdef(ld).elementdef) or
  1213. is_in_limit(ld,rd))) then
  1214. inserttypeconv(left,rd)
  1215. { 2: rd is either an empty set without elementdef or a set }
  1216. { whose elementdef fits in ld's elementdef, or a set }
  1217. { element whose def fits in ld's elementdef -> convert }
  1218. { to ld. ld's elementdef can't be nil here, is caught }
  1219. { previous case and "note:" above }
  1220. else if ((rd.typ=setdef) and
  1221. (not assigned(tsetdef(rd).elementdef) or
  1222. is_in_limit(rd,ld))) or
  1223. ((rd.typ<>setdef) and
  1224. is_in_limit(rd,tsetdef(ld).elementdef)) then
  1225. if (rd.typ=setdef) then
  1226. inserttypeconv(right,ld)
  1227. else
  1228. inserttypeconv(right,tsetdef(ld).elementdef)
  1229. { 3: otherwise create setdef which encompasses both, taking }
  1230. { into account empty sets without elementdef }
  1231. else
  1232. begin
  1233. if assigned(tsetdef(ld).elementdef) then
  1234. begin
  1235. llow:=tsetdef(ld).setbase;
  1236. lhigh:=tsetdef(ld).setmax;
  1237. end;
  1238. if (rd.typ=setdef) then
  1239. if assigned(tsetdef(rd).elementdef) then
  1240. begin
  1241. rlow:=tsetdef(rd).setbase;
  1242. rhigh:=tsetdef(rd).setmax;
  1243. end
  1244. else
  1245. begin
  1246. { ld's elementdef must have been valid }
  1247. rlow:=llow;
  1248. rhigh:=lhigh;
  1249. end
  1250. else
  1251. getrange(rd,rlow,rhigh);
  1252. if not assigned(tsetdef(ld).elementdef) then
  1253. begin
  1254. llow:=rlow;
  1255. lhigh:=rhigh;
  1256. end;
  1257. nd:=tsetdef.create(tsetdef(ld).elementdef,min(llow,rlow),max(lhigh,rhigh));
  1258. inserttypeconv(left,nd);
  1259. if (rd.typ=setdef) then
  1260. inserttypeconv(right,nd)
  1261. else
  1262. inserttypeconv(right,tsetdef(nd).elementdef);
  1263. end;
  1264. end;
  1265. end
  1266. { pointer comparision and subtraction }
  1267. else if (
  1268. (rd.typ=pointerdef) and (ld.typ=pointerdef)
  1269. ) or
  1270. { compare/add pchar to variable (not stringconst) char arrays
  1271. by addresses like BP/Delphi }
  1272. (
  1273. (nodetype in [equaln,unequaln,subn,addn]) and
  1274. (
  1275. ((is_pchar(ld) or (lt=niln)) and is_chararray(rd) and (rt<>stringconstn)) or
  1276. ((is_pchar(rd) or (rt=niln)) and is_chararray(ld) and (lt<>stringconstn))
  1277. )
  1278. ) then
  1279. begin
  1280. { convert char array to pointer }
  1281. if is_chararray(rd) then
  1282. begin
  1283. inserttypeconv(right,charpointertype);
  1284. rd:=right.resultdef;
  1285. end
  1286. else if is_chararray(ld) then
  1287. begin
  1288. inserttypeconv(left,charpointertype);
  1289. ld:=left.resultdef;
  1290. end;
  1291. case nodetype of
  1292. equaln,unequaln :
  1293. begin
  1294. if is_voidpointer(right.resultdef) then
  1295. inserttypeconv(right,left.resultdef)
  1296. else if is_voidpointer(left.resultdef) then
  1297. inserttypeconv(left,right.resultdef)
  1298. else if not(equal_defs(ld,rd)) then
  1299. IncompatibleTypes(ld,rd);
  1300. { now that the type checking is done, convert both to charpointer, }
  1301. { because methodpointers are 8 bytes even though only the first 4 }
  1302. { bytes must be compared. This can happen here if we are in }
  1303. { TP/Delphi mode, because there @methodpointer = voidpointer (but }
  1304. { a voidpointer of 8 bytes). A conversion to voidpointer would be }
  1305. { optimized away, since the result already was a voidpointer, so }
  1306. { use a charpointer instead (JM) }
  1307. inserttypeconv_internal(left,charpointertype);
  1308. inserttypeconv_internal(right,charpointertype);
  1309. end;
  1310. ltn,lten,gtn,gten:
  1311. begin
  1312. if (cs_extsyntax in current_settings.moduleswitches) then
  1313. begin
  1314. if is_voidpointer(right.resultdef) then
  1315. inserttypeconv(right,left.resultdef)
  1316. else if is_voidpointer(left.resultdef) then
  1317. inserttypeconv(left,right.resultdef)
  1318. else if not(equal_defs(ld,rd)) then
  1319. IncompatibleTypes(ld,rd);
  1320. end
  1321. else
  1322. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  1323. end;
  1324. subn:
  1325. begin
  1326. if (cs_extsyntax in current_settings.moduleswitches) then
  1327. begin
  1328. if is_voidpointer(right.resultdef) then
  1329. begin
  1330. if is_big_untyped_addrnode(right) then
  1331. CGMessage1(type_w_untyped_arithmetic_unportable,node2opstr(nodetype));
  1332. inserttypeconv(right,left.resultdef)
  1333. end
  1334. else if is_voidpointer(left.resultdef) then
  1335. inserttypeconv(left,right.resultdef)
  1336. else if not(equal_defs(ld,rd)) then
  1337. IncompatibleTypes(ld,rd);
  1338. end
  1339. else
  1340. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  1341. if not(nf_has_pointerdiv in flags) and
  1342. (tpointerdef(rd).pointeddef.size>1) then
  1343. begin
  1344. hp:=getcopy;
  1345. include(hp.flags,nf_has_pointerdiv);
  1346. result:=cmoddivnode.create(divn,hp,cordconstnode.create(tpointerdef(rd).pointeddef.size,sinttype,false));
  1347. end;
  1348. resultdef:=sinttype;
  1349. exit;
  1350. end;
  1351. else
  1352. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  1353. end;
  1354. end
  1355. { is one of the operands a string?,
  1356. chararrays are also handled as strings (after conversion), also take
  1357. care of chararray+chararray and chararray+char.
  1358. Note: Must be done after pointerdef+pointerdef has been checked, else
  1359. pchar is converted to string }
  1360. else if (rd.typ=stringdef) or
  1361. (ld.typ=stringdef) or
  1362. { stringconstn's can be arraydefs }
  1363. (lt=stringconstn) or
  1364. (rt=stringconstn) or
  1365. ((is_pchar(rd) or is_chararray(rd) or is_char(rd) or is_open_chararray(rd) or
  1366. is_pwidechar(rd) or is_widechararray(rd) or is_widechar(rd) or is_open_widechararray(rd)) and
  1367. (is_pchar(ld) or is_chararray(ld) or is_char(ld) or is_open_chararray(ld) or
  1368. is_pwidechar(ld) or is_widechararray(ld) or is_widechar(ld) or is_open_widechararray(ld))) then
  1369. begin
  1370. if (nodetype in [addn,equaln,unequaln,lten,gten,ltn,gtn]) then
  1371. begin
  1372. { Is there a unicodestring? }
  1373. if is_unicodestring(rd) or is_unicodestring(ld) then
  1374. strtype:=st_unicodestring
  1375. else
  1376. { Is there a widestring? }
  1377. if is_widestring(rd) or is_widestring(ld) or
  1378. is_pwidechar(rd) or is_widechararray(rd) or is_widechar(rd) or is_open_widechararray(rd) or
  1379. is_pwidechar(ld) or is_widechararray(ld) or is_widechar(ld) or is_open_widechararray(ld) then
  1380. strtype:=st_widestring
  1381. else
  1382. if is_ansistring(rd) or is_ansistring(ld) or
  1383. ((cs_ansistrings in current_settings.localswitches) and
  1384. //todo: Move some of this to longstring's then they are implemented?
  1385. (
  1386. is_pchar(rd) or (is_chararray(rd) and (rd.size > 255)) or is_open_chararray(rd) or
  1387. is_pchar(ld) or (is_chararray(ld) and (ld.size > 255)) or is_open_chararray(ld)
  1388. )
  1389. ) then
  1390. strtype:=st_ansistring
  1391. else
  1392. if is_longstring(rd) or is_longstring(ld) then
  1393. strtype:=st_longstring
  1394. else
  1395. begin
  1396. { TODO: todo: add a warning/hint here if one converting a too large array}
  1397. { nodes is PChar, array [with size > 255] or OpenArrayOfChar.
  1398. Note: Delphi halts with error if "array [0..xx] of char"
  1399. is assigned to ShortString and string length is less
  1400. then array size }
  1401. strtype:= st_shortstring;
  1402. end;
  1403. // Now convert nodes to common string type
  1404. case strtype of
  1405. st_widestring :
  1406. begin
  1407. if not(is_widestring(rd)) then
  1408. inserttypeconv(right,cwidestringtype);
  1409. if not(is_widestring(ld)) then
  1410. inserttypeconv(left,cwidestringtype);
  1411. end;
  1412. st_unicodestring :
  1413. begin
  1414. if not(is_unicodestring(rd)) then
  1415. inserttypeconv(right,cunicodestringtype);
  1416. if not(is_unicodestring(ld)) then
  1417. inserttypeconv(left,cunicodestringtype);
  1418. end;
  1419. st_ansistring :
  1420. begin
  1421. if not(is_ansistring(rd)) then
  1422. inserttypeconv(right,cansistringtype);
  1423. if not(is_ansistring(ld)) then
  1424. inserttypeconv(left,cansistringtype);
  1425. end;
  1426. st_longstring :
  1427. begin
  1428. if not(is_longstring(rd)) then
  1429. inserttypeconv(right,clongstringtype);
  1430. if not(is_longstring(ld)) then
  1431. inserttypeconv(left,clongstringtype);
  1432. end;
  1433. st_shortstring :
  1434. begin
  1435. if not(is_shortstring(ld)) then
  1436. inserttypeconv(left,cshortstringtype);
  1437. { don't convert char, that can be handled by the optimized node }
  1438. if not(is_shortstring(rd) or is_char(rd)) then
  1439. inserttypeconv(right,cshortstringtype);
  1440. end;
  1441. else
  1442. internalerror(2005101);
  1443. end;
  1444. end
  1445. else
  1446. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  1447. end
  1448. { class or interface equation }
  1449. else if is_class_or_interface(rd) or is_class_or_interface(ld) then
  1450. begin
  1451. if (nodetype in [equaln,unequaln]) then
  1452. begin
  1453. if is_class_or_interface(rd) and is_class_or_interface(ld) then
  1454. begin
  1455. if tobjectdef(rd).is_related(tobjectdef(ld)) then
  1456. inserttypeconv(right,left.resultdef)
  1457. else
  1458. inserttypeconv(left,right.resultdef);
  1459. end
  1460. else if is_class_or_interface(rd) then
  1461. inserttypeconv(left,right.resultdef)
  1462. else
  1463. inserttypeconv(right,left.resultdef);
  1464. end
  1465. else
  1466. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  1467. end
  1468. else if (rd.typ=classrefdef) and (ld.typ=classrefdef) then
  1469. begin
  1470. if (nodetype in [equaln,unequaln]) then
  1471. begin
  1472. if tobjectdef(tclassrefdef(rd).pointeddef).is_related(
  1473. tobjectdef(tclassrefdef(ld).pointeddef)) then
  1474. inserttypeconv(right,left.resultdef)
  1475. else
  1476. inserttypeconv(left,right.resultdef);
  1477. end
  1478. else
  1479. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  1480. end
  1481. { allows comperasion with nil pointer }
  1482. else if is_class_or_interface(rd) or (rd.typ=classrefdef) then
  1483. begin
  1484. if (nodetype in [equaln,unequaln]) then
  1485. inserttypeconv(left,right.resultdef)
  1486. else
  1487. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  1488. end
  1489. else if is_class_or_interface(ld) or (ld.typ=classrefdef) then
  1490. begin
  1491. if (nodetype in [equaln,unequaln]) then
  1492. inserttypeconv(right,left.resultdef)
  1493. else
  1494. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  1495. end
  1496. { support procvar=nil,procvar<>nil }
  1497. else if ((ld.typ=procvardef) and (rt=niln)) or
  1498. ((rd.typ=procvardef) and (lt=niln)) then
  1499. begin
  1500. if not(nodetype in [equaln,unequaln]) then
  1501. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  1502. { find proc field in methodpointer record }
  1503. hsym:=tfieldvarsym(trecorddef(methodpointertype).symtable.Find('proc'));
  1504. if not assigned(hsym) then
  1505. internalerror(200412043);
  1506. { For methodpointers compare only tmethodpointer.proc }
  1507. if (rd.typ=procvardef) and
  1508. (not tprocvardef(rd).is_addressonly) then
  1509. begin
  1510. right:=csubscriptnode.create(
  1511. hsym,
  1512. ctypeconvnode.create_internal(right,methodpointertype));
  1513. typecheckpass(right);
  1514. end;
  1515. if (ld.typ=procvardef) and
  1516. (not tprocvardef(ld).is_addressonly) then
  1517. begin
  1518. left:=csubscriptnode.create(
  1519. hsym,
  1520. ctypeconvnode.create_internal(left,methodpointertype));
  1521. typecheckpass(left);
  1522. end;
  1523. end
  1524. { support dynamicarray=nil,dynamicarray<>nil }
  1525. else if (is_dynamic_array(ld) and (rt=niln)) or
  1526. (is_dynamic_array(rd) and (lt=niln)) or
  1527. (is_dynamic_array(ld) and is_dynamic_array(rd)) then
  1528. begin
  1529. if not(nodetype in [equaln,unequaln]) then
  1530. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  1531. end
  1532. {$ifdef SUPPORT_MMX}
  1533. { mmx support, this must be before the zero based array
  1534. check }
  1535. else if (cs_mmx in current_settings.localswitches) and
  1536. is_mmx_able_array(ld) and
  1537. is_mmx_able_array(rd) and
  1538. equal_defs(ld,rd) then
  1539. begin
  1540. case nodetype of
  1541. addn,subn,xorn,orn,andn:
  1542. ;
  1543. { mul is a little bit restricted }
  1544. muln:
  1545. if not(mmx_type(ld) in [mmxu16bit,mmxs16bit,mmxfixed16]) then
  1546. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  1547. else
  1548. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  1549. end;
  1550. end
  1551. {$endif SUPPORT_MMX}
  1552. { vector support, this must be before the zero based array
  1553. check }
  1554. else if (cs_support_vectors in current_settings.globalswitches) and
  1555. is_vector(ld) and
  1556. is_vector(rd) and
  1557. equal_defs(ld,rd) then
  1558. begin
  1559. if not(nodetype in [addn,subn,xorn,orn,andn,muln,slashn]) then
  1560. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  1561. { both defs must be equal, so taking left or right as resultdef doesn't matter }
  1562. resultdef:=left.resultdef;
  1563. end
  1564. { this is a little bit dangerous, also the left type }
  1565. { pointer to should be checked! This broke the mmx support }
  1566. else if (rd.typ=pointerdef) or
  1567. (is_zero_based_array(rd) and (rt<>stringconstn)) then
  1568. begin
  1569. if is_zero_based_array(rd) then
  1570. begin
  1571. resultdef:=tpointerdef.create(tarraydef(rd).elementdef);
  1572. inserttypeconv(right,resultdef);
  1573. end
  1574. else
  1575. resultdef:=right.resultdef;
  1576. inserttypeconv(left,sinttype);
  1577. if nodetype=addn then
  1578. begin
  1579. if not(cs_extsyntax in current_settings.moduleswitches) or
  1580. (not(is_pchar(ld)) and not(m_add_pointer in current_settings.modeswitches)) then
  1581. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  1582. if (rd.typ=pointerdef) and
  1583. (tpointerdef(rd).pointeddef.size>1) then
  1584. begin
  1585. left:=caddnode.create(muln,left,
  1586. cordconstnode.create(tpointerdef(rd).pointeddef.size,sinttype,true));
  1587. typecheckpass(left);
  1588. end;
  1589. end
  1590. else
  1591. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  1592. end
  1593. else if (ld.typ=pointerdef) or
  1594. (is_zero_based_array(ld) and (lt<>stringconstn)) then
  1595. begin
  1596. if is_zero_based_array(ld) then
  1597. begin
  1598. resultdef:=tpointerdef.create(tarraydef(ld).elementdef);
  1599. inserttypeconv(left,resultdef);
  1600. end
  1601. else
  1602. resultdef:=left.resultdef;
  1603. inserttypeconv(right,sinttype);
  1604. if nodetype in [addn,subn] then
  1605. begin
  1606. if not(cs_extsyntax in current_settings.moduleswitches) or
  1607. (not(is_pchar(ld)) and not(m_add_pointer in current_settings.modeswitches)) then
  1608. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  1609. if (ld.typ=pointerdef) then
  1610. begin
  1611. if is_big_untyped_addrnode(left) then
  1612. CGMessage1(type_w_untyped_arithmetic_unportable,node2opstr(nodetype));
  1613. if (tpointerdef(ld).pointeddef.size>1) then
  1614. begin
  1615. right:=caddnode.create(muln,right,
  1616. cordconstnode.create(tpointerdef(ld).pointeddef.size,sinttype,true));
  1617. typecheckpass(right);
  1618. end
  1619. end else
  1620. if is_zero_based_array(ld) and
  1621. (tarraydef(ld).elementdef.size>1) then
  1622. begin
  1623. right:=caddnode.create(muln,right,
  1624. cordconstnode.create(tarraydef(ld).elementdef.size,sinttype,true));
  1625. typecheckpass(right);
  1626. end;
  1627. end
  1628. else
  1629. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  1630. end
  1631. else if (rd.typ=procvardef) and
  1632. (ld.typ=procvardef) and
  1633. equal_defs(rd,ld) then
  1634. begin
  1635. if (nodetype in [equaln,unequaln]) then
  1636. begin
  1637. if tprocvardef(rd).is_addressonly then
  1638. begin
  1639. inserttypeconv_internal(right,voidpointertype);
  1640. inserttypeconv_internal(left,voidpointertype);
  1641. end
  1642. else
  1643. begin
  1644. { find proc field in methodpointer record }
  1645. hsym:=tfieldvarsym(trecorddef(methodpointertype).symtable.Find('proc'));
  1646. if not assigned(hsym) then
  1647. internalerror(200412043);
  1648. { Compare tmehodpointer(left).proc }
  1649. right:=csubscriptnode.create(
  1650. hsym,
  1651. ctypeconvnode.create_internal(right,methodpointertype));
  1652. typecheckpass(right);
  1653. left:=csubscriptnode.create(
  1654. hsym,
  1655. ctypeconvnode.create_internal(left,methodpointertype));
  1656. typecheckpass(left);
  1657. end;
  1658. end
  1659. else
  1660. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  1661. end
  1662. { enums }
  1663. else if (ld.typ=enumdef) and (rd.typ=enumdef) then
  1664. begin
  1665. if allowenumop(nodetype) then
  1666. inserttypeconv(right,left.resultdef)
  1667. else
  1668. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  1669. end
  1670. { generic conversion, this is for error recovery }
  1671. else
  1672. begin
  1673. inserttypeconv(left,sinttype);
  1674. inserttypeconv(right,sinttype);
  1675. end;
  1676. { set resultdef if not already done }
  1677. if not assigned(resultdef) then
  1678. begin
  1679. case nodetype of
  1680. ltn,lten,gtn,gten,equaln,unequaln :
  1681. resultdef:=booltype;
  1682. slashn :
  1683. resultdef:=resultrealdef;
  1684. addn:
  1685. begin
  1686. { for strings, return is always a 255 char string }
  1687. if is_shortstring(left.resultdef) then
  1688. resultdef:=cshortstringtype
  1689. else
  1690. resultdef:=left.resultdef;
  1691. end;
  1692. else
  1693. resultdef:=left.resultdef;
  1694. end;
  1695. end;
  1696. { when the result is currency we need some extra code for
  1697. multiplication and division. this should not be done when
  1698. the muln or slashn node is created internally }
  1699. if not(nf_is_currency in flags) and
  1700. is_currency(resultdef) then
  1701. begin
  1702. case nodetype of
  1703. slashn :
  1704. begin
  1705. { slashn will only work with floats }
  1706. hp:=caddnode.create(muln,getcopy,crealconstnode.create(10000.0,s64currencytype));
  1707. include(hp.flags,nf_is_currency);
  1708. result:=hp;
  1709. end;
  1710. muln :
  1711. begin
  1712. if s64currencytype.typ=floatdef then
  1713. hp:=caddnode.create(slashn,getcopy,crealconstnode.create(10000.0,s64currencytype))
  1714. else
  1715. hp:=cmoddivnode.create(divn,getcopy,cordconstnode.create(10000,s64currencytype,false));
  1716. include(hp.flags,nf_is_currency);
  1717. result:=hp
  1718. end;
  1719. end;
  1720. end;
  1721. if not codegenerror and
  1722. not assigned(result) then
  1723. result:=simplify;
  1724. end;
  1725. function taddnode.first_addstring: tnode;
  1726. const
  1727. swap_relation: array [ltn..unequaln] of Tnodetype=(gtn, gten, ltn, lten, equaln, unequaln);
  1728. var
  1729. p: tnode;
  1730. newstatement : tstatementnode;
  1731. tempnode (*,tempnode2*) : ttempcreatenode;
  1732. cmpfuncname: string;
  1733. begin
  1734. { when we get here, we are sure that both the left and the right }
  1735. { node are both strings of the same stringtype (JM) }
  1736. case nodetype of
  1737. addn:
  1738. begin
  1739. if (left.nodetype=stringconstn) and (tstringconstnode(left).len=0) then
  1740. begin
  1741. result:=right;
  1742. left.free;
  1743. left:=nil;
  1744. right:=nil;
  1745. exit;
  1746. end;
  1747. if (right.nodetype=stringconstn) and (tstringconstnode(right).len=0) then
  1748. begin
  1749. result:=left;
  1750. left:=nil;
  1751. right.free;
  1752. right:=nil;
  1753. exit;
  1754. end;
  1755. { create the call to the concat routine both strings as arguments }
  1756. if assigned(aktassignmentnode) and
  1757. (aktassignmentnode.right=self) and
  1758. (aktassignmentnode.left.resultdef=resultdef) and
  1759. valid_for_var(aktassignmentnode.left,false) then
  1760. begin
  1761. result:=ccallnode.createintern('fpc_'+
  1762. tstringdef(resultdef).stringtypname+'_concat',
  1763. ccallparanode.create(right,
  1764. ccallparanode.create(left,
  1765. ccallparanode.create(aktassignmentnode.left.getcopy,nil))));
  1766. include(aktassignmentnode.flags,nf_assign_done_in_right);
  1767. firstpass(result);
  1768. end
  1769. else
  1770. begin
  1771. result:=internalstatements(newstatement);
  1772. tempnode:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,true);
  1773. addstatement(newstatement,tempnode);
  1774. addstatement(newstatement,ccallnode.createintern('fpc_'+
  1775. tstringdef(resultdef).stringtypname+'_concat',
  1776. ccallparanode.create(right,
  1777. ccallparanode.create(left,
  1778. ccallparanode.create(ctemprefnode.create(tempnode),nil)))));
  1779. addstatement(newstatement,ctempdeletenode.create_normal_temp(tempnode));
  1780. addstatement(newstatement,ctemprefnode.create(tempnode));
  1781. end;
  1782. { we reused the arguments }
  1783. left := nil;
  1784. right := nil;
  1785. end;
  1786. ltn,lten,gtn,gten,equaln,unequaln :
  1787. begin
  1788. { generate better code for comparison with empty string, we
  1789. only need to compare the length with 0 }
  1790. if (nodetype in [equaln,unequaln,gtn,gten,ltn,lten]) and
  1791. { windows widestrings are too complicated to be handled optimized }
  1792. not(is_widestring(left.resultdef) and (target_info.system in system_windows)) and
  1793. (((left.nodetype=stringconstn) and (tstringconstnode(left).len=0)) or
  1794. ((right.nodetype=stringconstn) and (tstringconstnode(right).len=0))) then
  1795. begin
  1796. { switch so that the constant is always on the right }
  1797. if left.nodetype = stringconstn then
  1798. begin
  1799. p := left;
  1800. left := right;
  1801. right := p;
  1802. nodetype:=swap_relation[nodetype];
  1803. end;
  1804. if is_shortstring(left.resultdef) or
  1805. (nodetype in [gtn,gten,ltn,lten]) then
  1806. { compare the length with 0 }
  1807. result := caddnode.create(nodetype,
  1808. cinlinenode.create(in_length_x,false,left),
  1809. cordconstnode.create(0,s32inttype,false))
  1810. else
  1811. begin
  1812. (*
  1813. if is_widestring(left.resultdef) and
  1814. (target_info.system in system_windows) then
  1815. begin
  1816. { windows like widestrings requires that we also check the length }
  1817. result:=internalstatements(newstatement);
  1818. tempnode:=ctempcreatenode.create(voidpointertype,voidpointertype.size,tt_persistent,true);
  1819. tempnode2:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,true);
  1820. addstatement(newstatement,tempnode);
  1821. addstatement(newstatement,tempnode2);
  1822. { poor man's cse }
  1823. addstatement(newstatement,cassignmentnode.create(ctemprefnode.create(tempnode),
  1824. ctypeconvnode.create_internal(left,voidpointertype))
  1825. );
  1826. addstatement(newstatement,cassignmentnode.create(ctemprefnode.create(tempnode2),
  1827. caddnode.create(orn,
  1828. caddnode.create(nodetype,
  1829. ctemprefnode.create(tempnode),
  1830. cpointerconstnode.create(0,voidpointertype)
  1831. ),
  1832. caddnode.create(nodetype,
  1833. ctypeconvnode.create_internal(cderefnode.create(ctemprefnode.create(tempnode)),s32inttype),
  1834. cordconstnode.create(0,s32inttype,false)
  1835. )
  1836. )
  1837. ));
  1838. addstatement(newstatement,ctempdeletenode.create_normal_temp(tempnode));
  1839. addstatement(newstatement,ctempdeletenode.create_normal_temp(tempnode2));
  1840. addstatement(newstatement,ctemprefnode.create(tempnode2));
  1841. end
  1842. else
  1843. *)
  1844. begin
  1845. { compare the pointer with nil (for ansistrings etc), }
  1846. { faster than getting the length (JM) }
  1847. result:= caddnode.create(nodetype,
  1848. ctypeconvnode.create_internal(left,voidpointertype),
  1849. cpointerconstnode.create(0,voidpointertype));
  1850. end;
  1851. end;
  1852. { left is reused }
  1853. left := nil;
  1854. { right isn't }
  1855. right.free;
  1856. right := nil;
  1857. exit;
  1858. end;
  1859. { no string constant -> call compare routine }
  1860. cmpfuncname := 'fpc_'+tstringdef(left.resultdef).stringtypname+'_compare';
  1861. { for equality checks use optimized version }
  1862. if nodetype in [equaln,unequaln] then
  1863. cmpfuncname := cmpfuncname + '_equal';
  1864. result := ccallnode.createintern(cmpfuncname,
  1865. ccallparanode.create(right,ccallparanode.create(left,nil)));
  1866. { and compare its result with 0 according to the original operator }
  1867. result := caddnode.create(nodetype,result,
  1868. cordconstnode.create(0,s32inttype,false));
  1869. left := nil;
  1870. right := nil;
  1871. end;
  1872. end;
  1873. end;
  1874. function taddnode.first_addset : tnode;
  1875. procedure call_varset_helper(const n : string);
  1876. var
  1877. newstatement : tstatementnode;
  1878. temp : ttempcreatenode;
  1879. begin
  1880. { add two var sets }
  1881. result:=internalstatements(newstatement);
  1882. { create temp for result }
  1883. temp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,true);
  1884. addstatement(newstatement,temp);
  1885. addstatement(newstatement,ccallnode.createintern(n,
  1886. ccallparanode.create(cordconstnode.create(resultdef.size,sinttype,false),
  1887. ccallparanode.create(ctemprefnode.create(temp),
  1888. ccallparanode.create(right,
  1889. ccallparanode.create(left,nil)))))
  1890. );
  1891. { remove reused parts from original node }
  1892. left:=nil;
  1893. right:=nil;
  1894. { the last statement should return the value as
  1895. location and type, this is done be referencing the
  1896. temp and converting it first from a persistent temp to
  1897. normal temp }
  1898. addstatement(newstatement,ctempdeletenode.create_normal_temp(temp));
  1899. addstatement(newstatement,ctemprefnode.create(temp));
  1900. end;
  1901. var
  1902. procname: string[31];
  1903. tempn: tnode;
  1904. newstatement : tstatementnode;
  1905. temp : ttempcreatenode;
  1906. begin
  1907. result:=nil;
  1908. case nodetype of
  1909. equaln,unequaln,lten,gten:
  1910. begin
  1911. case nodetype of
  1912. equaln,unequaln:
  1913. procname := 'fpc_varset_comp_sets';
  1914. lten,gten:
  1915. begin
  1916. procname := 'fpc_varset_contains_sets';
  1917. { (left >= right) = (right <= left) }
  1918. if nodetype = gten then
  1919. begin
  1920. tempn := left;
  1921. left := right;
  1922. right := tempn;
  1923. end;
  1924. end;
  1925. end;
  1926. result := ccallnode.createinternres(procname,
  1927. ccallparanode.create(cordconstnode.create(left.resultdef.size,sinttype,false),
  1928. ccallparanode.create(right,
  1929. ccallparanode.create(left,nil))),resultdef);
  1930. { left and right are reused as parameters }
  1931. left := nil;
  1932. right := nil;
  1933. { for an unequaln, we have to negate the result of comp_sets }
  1934. if nodetype = unequaln then
  1935. result := cnotnode.create(result);
  1936. end;
  1937. addn:
  1938. begin
  1939. { optimize first loading of a set }
  1940. if (right.nodetype=setelementn) and
  1941. not(assigned(tsetelementnode(right).right)) and
  1942. is_emptyset(left) then
  1943. begin
  1944. result:=internalstatements(newstatement);
  1945. { create temp for result }
  1946. temp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,true);
  1947. addstatement(newstatement,temp);
  1948. { adjust for set base }
  1949. tsetelementnode(right).left:=caddnode.create(subn,
  1950. ctypeconvnode.create_internal(tsetelementnode(right).left,sinttype),
  1951. cordconstnode.create(tsetdef(resultdef).setbase,sinttype,false));
  1952. addstatement(newstatement,ccallnode.createintern('fpc_varset_create_element',
  1953. ccallparanode.create(ctemprefnode.create(temp),
  1954. ccallparanode.create(cordconstnode.create(resultdef.size,sinttype,false),
  1955. ccallparanode.create(tsetelementnode(right).left,nil))))
  1956. );
  1957. { the last statement should return the value as
  1958. location and type, this is done be referencing the
  1959. temp and converting it first from a persistent temp to
  1960. normal temp }
  1961. addstatement(newstatement,ctempdeletenode.create_normal_temp(temp));
  1962. addstatement(newstatement,ctemprefnode.create(temp));
  1963. tsetelementnode(right).left := nil;
  1964. end
  1965. else
  1966. begin
  1967. if right.nodetype=setelementn then
  1968. begin
  1969. result:=internalstatements(newstatement);
  1970. { create temp for result }
  1971. temp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,true);
  1972. addstatement(newstatement,temp);
  1973. { adjust for set base }
  1974. tsetelementnode(right).left:=caddnode.create(subn,
  1975. ctypeconvnode.create_internal(tsetelementnode(right).left,sinttype),
  1976. cordconstnode.create(tsetdef(resultdef).setbase,sinttype,false));
  1977. { add a range or a single element? }
  1978. if assigned(tsetelementnode(right).right) then
  1979. begin
  1980. { adjust for set base }
  1981. tsetelementnode(right).right:=caddnode.create(subn,
  1982. ctypeconvnode.create_internal(tsetelementnode(right).right,sinttype),
  1983. cordconstnode.create(tsetdef(resultdef).setbase,sinttype,false));
  1984. addstatement(newstatement,ccallnode.createintern('fpc_varset_set_range',
  1985. ccallparanode.create(cordconstnode.create(resultdef.size,sinttype,false),
  1986. ccallparanode.create(tsetelementnode(right).right,
  1987. ccallparanode.create(tsetelementnode(right).left,
  1988. ccallparanode.create(ctemprefnode.create(temp),
  1989. ccallparanode.create(left,nil))))))
  1990. );
  1991. end
  1992. else
  1993. addstatement(newstatement,ccallnode.createintern('fpc_varset_set',
  1994. ccallparanode.create(cordconstnode.create(resultdef.size,sinttype,false),
  1995. ccallparanode.create(ctypeconvnode.create_internal(tsetelementnode(right).left,sinttype),
  1996. ccallparanode.create(ctemprefnode.create(temp),
  1997. ccallparanode.create(left,nil)))))
  1998. );
  1999. { remove reused parts from original node }
  2000. tsetelementnode(right).right:=nil;
  2001. tsetelementnode(right).left:=nil;
  2002. left:=nil;
  2003. { the last statement should return the value as
  2004. location and type, this is done be referencing the
  2005. temp and converting it first from a persistent temp to
  2006. normal temp }
  2007. addstatement(newstatement,ctempdeletenode.create_normal_temp(temp));
  2008. addstatement(newstatement,ctemprefnode.create(temp));
  2009. end
  2010. else
  2011. call_varset_helper('fpc_varset_add_sets');
  2012. end
  2013. end;
  2014. subn:
  2015. call_varset_helper('fpc_varset_sub_sets');
  2016. symdifn:
  2017. call_varset_helper('fpc_varset_symdif_sets');
  2018. muln:
  2019. call_varset_helper('fpc_varset_mul_sets');
  2020. else
  2021. internalerror(200609241);
  2022. end;
  2023. end;
  2024. function taddnode.use_generic_mul32to64: boolean;
  2025. begin
  2026. result := true;
  2027. end;
  2028. function taddnode.try_make_mul32to64: boolean;
  2029. function canbe32bitint(v: tconstexprint): boolean;
  2030. begin
  2031. result := ((v >= int64(low(longint))) and (v <= int64(high(longint)))) or
  2032. ((v >= qword(low(cardinal))) and (v <= qword(high(cardinal))))
  2033. end;
  2034. var
  2035. temp: tnode;
  2036. begin
  2037. result := false;
  2038. if ((left.nodetype = typeconvn) and
  2039. is_integer(ttypeconvnode(left).left.resultdef) and
  2040. (not(torddef(ttypeconvnode(left).left.resultdef).ordtype in [u64bit,s64bit])) and
  2041. (((right.nodetype = ordconstn) and canbe32bitint(tordconstnode(right).value)) or
  2042. ((right.nodetype = typeconvn) and
  2043. is_integer(ttypeconvnode(right).left.resultdef) and
  2044. not(torddef(ttypeconvnode(right).left.resultdef).ordtype in [u64bit,s64bit])) and
  2045. ((is_signed(ttypeconvnode(left).left.resultdef) =
  2046. is_signed(ttypeconvnode(right).left.resultdef)) or
  2047. (is_signed(ttypeconvnode(left).left.resultdef) and
  2048. (torddef(ttypeconvnode(right).left.resultdef).ordtype in [u8bit,u16bit]))))) then
  2049. begin
  2050. temp := ttypeconvnode(left).left;
  2051. ttypeconvnode(left).left := nil;
  2052. left.free;
  2053. left := temp;
  2054. if (right.nodetype = typeconvn) then
  2055. begin
  2056. temp := ttypeconvnode(right).left;
  2057. ttypeconvnode(right).left := nil;
  2058. right.free;
  2059. right := temp;
  2060. end;
  2061. if (is_signed(left.resultdef)) then
  2062. begin
  2063. inserttypeconv(left,s32inttype);
  2064. inserttypeconv(right,s32inttype);
  2065. end
  2066. else
  2067. begin
  2068. inserttypeconv(left,u32inttype);
  2069. inserttypeconv(right,u32inttype);
  2070. end;
  2071. firstpass(left);
  2072. firstpass(right);
  2073. result := true;
  2074. end;
  2075. end;
  2076. function taddnode.first_add64bitint: tnode;
  2077. var
  2078. procname: string[31];
  2079. temp: tnode;
  2080. power: longint;
  2081. begin
  2082. result := nil;
  2083. { create helper calls mul }
  2084. if nodetype <> muln then
  2085. exit;
  2086. { make sure that if there is a constant, that it's on the right }
  2087. if left.nodetype = ordconstn then
  2088. begin
  2089. temp := right;
  2090. right := left;
  2091. left := temp;
  2092. end;
  2093. { can we use a shift instead of a mul? }
  2094. if not (cs_check_overflow in current_settings.localswitches) and
  2095. (right.nodetype = ordconstn) and
  2096. ispowerof2(tordconstnode(right).value,power) then
  2097. begin
  2098. tordconstnode(right).value := power;
  2099. result := cshlshrnode.create(shln,left,right);
  2100. { left and right are reused }
  2101. left := nil;
  2102. right := nil;
  2103. { return firstpassed new node }
  2104. exit;
  2105. end;
  2106. if not(use_generic_mul32to64) and
  2107. try_make_mul32to64 then
  2108. exit;
  2109. { when currency is used set the result of the
  2110. parameters to s64bit, so they are not converted }
  2111. if is_currency(resultdef) then
  2112. begin
  2113. left.resultdef:=s64inttype;
  2114. right.resultdef:=s64inttype;
  2115. end;
  2116. { otherwise, create the parameters for the helper }
  2117. right := ccallparanode.create(
  2118. cordconstnode.create(ord(cs_check_overflow in current_settings.localswitches),booltype,true),
  2119. ccallparanode.create(right,ccallparanode.create(left,nil)));
  2120. left := nil;
  2121. { only qword needs the unsigned code, the
  2122. signed code is also used for currency }
  2123. if is_signed(resultdef) then
  2124. procname := 'fpc_mul_int64'
  2125. else
  2126. procname := 'fpc_mul_qword';
  2127. result := ccallnode.createintern(procname,right);
  2128. right := nil;
  2129. end;
  2130. function taddnode.first_addfloat : tnode;
  2131. var
  2132. procname: string[31];
  2133. { do we need to reverse the result ? }
  2134. notnode : boolean;
  2135. fdef : tdef;
  2136. begin
  2137. result := nil;
  2138. notnode := false;
  2139. { In non-emulation mode, real opcodes are
  2140. emitted for floating point values.
  2141. }
  2142. if not (cs_fp_emulation in current_settings.moduleswitches) then
  2143. exit;
  2144. if not(target_info.system in system_wince) then
  2145. begin
  2146. case tfloatdef(left.resultdef).floattype of
  2147. s32real:
  2148. begin
  2149. fdef:=search_system_type('FLOAT32REC').typedef;
  2150. procname:='float32';
  2151. end;
  2152. s64real:
  2153. begin
  2154. fdef:=search_system_type('FLOAT64').typedef;
  2155. procname:='float64';
  2156. end;
  2157. {!!! not yet implemented
  2158. s128real:
  2159. }
  2160. else
  2161. internalerror(2005082601);
  2162. end;
  2163. case nodetype of
  2164. addn:
  2165. procname:=procname+'_add';
  2166. muln:
  2167. procname:=procname+'_mul';
  2168. subn:
  2169. procname:=procname+'_sub';
  2170. slashn:
  2171. procname:=procname+'_div';
  2172. ltn:
  2173. procname:=procname+'_lt';
  2174. lten:
  2175. procname:=procname+'_le';
  2176. gtn:
  2177. begin
  2178. procname:=procname+'_le';
  2179. notnode:=true;
  2180. end;
  2181. gten:
  2182. begin
  2183. procname:=procname+'_lt';
  2184. notnode:=true;
  2185. end;
  2186. equaln:
  2187. procname:=procname+'_eq';
  2188. unequaln:
  2189. begin
  2190. procname:=procname+'_eq';
  2191. notnode:=true;
  2192. end;
  2193. else
  2194. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),left.resultdef.typename,right.resultdef.typename);
  2195. end;
  2196. end
  2197. else
  2198. begin
  2199. case nodetype of
  2200. addn:
  2201. procname:='ADD';
  2202. muln:
  2203. procname:='MUL';
  2204. subn:
  2205. procname:='SUB';
  2206. slashn:
  2207. procname:='DIV';
  2208. ltn:
  2209. procname:='LT';
  2210. lten:
  2211. procname:='LE';
  2212. gtn:
  2213. procname:='GT';
  2214. gten:
  2215. procname:='GE';
  2216. equaln:
  2217. procname:='EQ';
  2218. unequaln:
  2219. procname:='NE';
  2220. else
  2221. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),left.resultdef.typename,right.resultdef.typename);
  2222. end;
  2223. case tfloatdef(left.resultdef).floattype of
  2224. s32real:
  2225. begin
  2226. procname:=procname+'S';
  2227. if nodetype in [addn,muln,subn,slashn] then
  2228. procname:=lower(procname);
  2229. end;
  2230. s64real:
  2231. procname:=procname+'D';
  2232. {!!! not yet implemented
  2233. s128real:
  2234. }
  2235. else
  2236. internalerror(2005082602);
  2237. end;
  2238. end;
  2239. { cast softfpu result? }
  2240. if not(target_info.system in system_wince) then
  2241. begin
  2242. if nodetype in [ltn,lten,gtn,gten,equaln,unequaln] then
  2243. resultdef:=booltype;
  2244. result:=ctypeconvnode.create_internal(ccallnode.createintern(procname,ccallparanode.create(
  2245. ctypeconvnode.create_internal(right,fdef),
  2246. ccallparanode.create(
  2247. ctypeconvnode.create_internal(left,fdef),nil))),resultdef);
  2248. end
  2249. else
  2250. result:=ccallnode.createintern(procname,ccallparanode.create(right,
  2251. ccallparanode.create(left,nil)));
  2252. left:=nil;
  2253. right:=nil;
  2254. { do we need to reverse the result }
  2255. if notnode then
  2256. result:=cnotnode.create(result);
  2257. end;
  2258. function taddnode.pass_1 : tnode;
  2259. var
  2260. {$ifdef addstringopt}
  2261. hp : tnode;
  2262. {$endif addstringopt}
  2263. rd,ld : tdef;
  2264. i : longint;
  2265. lt,rt : tnodetype;
  2266. begin
  2267. result:=nil;
  2268. { Can we optimize multiple string additions into a single call?
  2269. This need to be done on a complete tree to detect the multiple
  2270. add nodes and is therefor done before the subtrees are processed }
  2271. if canbemultistringadd(self) then
  2272. begin
  2273. result := genmultistringadd(self);
  2274. exit;
  2275. end;
  2276. { first do the two subtrees }
  2277. firstpass(left);
  2278. firstpass(right);
  2279. if codegenerror then
  2280. exit;
  2281. { load easier access variables }
  2282. rd:=right.resultdef;
  2283. ld:=left.resultdef;
  2284. rt:=right.nodetype;
  2285. lt:=left.nodetype;
  2286. { int/int gives real/real! }
  2287. if nodetype=slashn then
  2288. begin
  2289. {$ifdef cpufpemu}
  2290. if (current_settings.fputype=fpu_soft) or (cs_fp_emulation in current_settings.moduleswitches) then
  2291. begin
  2292. result:=first_addfloat;
  2293. if assigned(result) then
  2294. exit;
  2295. end;
  2296. {$endif cpufpemu}
  2297. expectloc:=LOC_FPUREGISTER;
  2298. end
  2299. { if both are orddefs then check sub types }
  2300. else if (ld.typ=orddef) and (rd.typ=orddef) then
  2301. begin
  2302. { optimize multiplacation by a power of 2 }
  2303. if not(cs_check_overflow in current_settings.localswitches) and
  2304. (nodetype = muln) and
  2305. (((left.nodetype = ordconstn) and
  2306. ispowerof2(tordconstnode(left).value,i)) or
  2307. ((right.nodetype = ordconstn) and
  2308. ispowerof2(tordconstnode(right).value,i))) then
  2309. begin
  2310. if left.nodetype = ordconstn then
  2311. begin
  2312. tordconstnode(left).value := i;
  2313. result := cshlshrnode.create(shln,right,left);
  2314. end
  2315. else
  2316. begin
  2317. tordconstnode(right).value := i;
  2318. result := cshlshrnode.create(shln,left,right);
  2319. end;
  2320. left := nil;
  2321. right := nil;
  2322. exit;
  2323. end;
  2324. { 2 booleans ? }
  2325. if is_boolean(ld) and is_boolean(rd) then
  2326. begin
  2327. if (not(cs_full_boolean_eval in current_settings.localswitches) or
  2328. (nf_short_bool in flags)) and
  2329. (nodetype in [andn,orn]) then
  2330. expectloc:=LOC_JUMP
  2331. else
  2332. begin
  2333. if nodetype in [ltn,lten,gtn,gten,equaln,unequaln] then
  2334. expectloc:=LOC_FLAGS
  2335. else
  2336. expectloc:=LOC_REGISTER;
  2337. end;
  2338. end
  2339. else
  2340. { Both are chars? only convert to shortstrings for addn }
  2341. if is_char(ld) then
  2342. begin
  2343. if nodetype=addn then
  2344. internalerror(200103291);
  2345. expectloc:=LOC_FLAGS;
  2346. end
  2347. {$ifndef cpu64bitaddr}
  2348. { is there a 64 bit type ? }
  2349. else if (torddef(ld).ordtype in [s64bit,u64bit,scurrency]) then
  2350. begin
  2351. result := first_add64bitint;
  2352. if assigned(result) then
  2353. exit;
  2354. if nodetype in [addn,subn,muln,andn,orn,xorn] then
  2355. expectloc:=LOC_REGISTER
  2356. else
  2357. expectloc:=LOC_JUMP;
  2358. end
  2359. {$endif cpu64bitaddr}
  2360. { is there a cardinal? }
  2361. else if (torddef(ld).ordtype=u32bit) then
  2362. begin
  2363. if nodetype in [addn,subn,muln,andn,orn,xorn] then
  2364. expectloc:=LOC_REGISTER
  2365. else
  2366. expectloc:=LOC_FLAGS;
  2367. end
  2368. { generic s32bit conversion }
  2369. else
  2370. begin
  2371. if nodetype in [addn,subn,muln,andn,orn,xorn] then
  2372. expectloc:=LOC_REGISTER
  2373. else
  2374. expectloc:=LOC_FLAGS;
  2375. end;
  2376. end
  2377. { left side a setdef, must be before string processing,
  2378. else array constructor can be seen as array of char (PFV) }
  2379. else if (ld.typ=setdef) then
  2380. begin
  2381. { small sets are handled inline by the compiler.
  2382. small set doesn't have support for adding ranges }
  2383. if is_smallset(ld) and
  2384. not(
  2385. (right.nodetype=setelementn) and
  2386. assigned(tsetelementnode(right).right)
  2387. ) then
  2388. begin
  2389. if nodetype in [ltn,lten,gtn,gten,equaln,unequaln] then
  2390. expectloc:=LOC_FLAGS
  2391. else
  2392. expectloc:=LOC_REGISTER;
  2393. end
  2394. else
  2395. begin
  2396. result := first_addset;
  2397. if assigned(result) then
  2398. exit;
  2399. expectloc:=LOC_CREFERENCE;
  2400. end;
  2401. end
  2402. { compare pchar by addresses like BP/Delphi }
  2403. else if is_pchar(ld) then
  2404. begin
  2405. if nodetype in [addn,subn,muln,andn,orn,xorn] then
  2406. expectloc:=LOC_REGISTER
  2407. else
  2408. expectloc:=LOC_FLAGS;
  2409. end
  2410. { is one of the operands a string }
  2411. else if (ld.typ=stringdef) then
  2412. begin
  2413. if is_widestring(ld) then
  2414. begin
  2415. { this is only for add, the comparisaion is handled later }
  2416. expectloc:=LOC_REGISTER;
  2417. end
  2418. else if is_unicodestring(ld) then
  2419. begin
  2420. { this is only for add, the comparisaion is handled later }
  2421. expectloc:=LOC_REGISTER;
  2422. end
  2423. else if is_ansistring(ld) then
  2424. begin
  2425. { this is only for add, the comparisaion is handled later }
  2426. expectloc:=LOC_REGISTER;
  2427. end
  2428. else if is_longstring(ld) then
  2429. begin
  2430. { this is only for add, the comparisaion is handled later }
  2431. expectloc:=LOC_REFERENCE;
  2432. end
  2433. else
  2434. begin
  2435. {$ifdef addstringopt}
  2436. { can create a call which isn't handled by callparatemp }
  2437. if canbeaddsstringcharoptnode(self) then
  2438. begin
  2439. hp := genaddsstringcharoptnode(self);
  2440. pass_1 := hp;
  2441. exit;
  2442. end
  2443. else
  2444. {$endif addstringopt}
  2445. begin
  2446. { Fix right to be shortstring }
  2447. if is_char(right.resultdef) then
  2448. begin
  2449. inserttypeconv(right,cshortstringtype);
  2450. firstpass(right);
  2451. end;
  2452. end;
  2453. {$ifdef addstringopt}
  2454. { can create a call which isn't handled by callparatemp }
  2455. if canbeaddsstringcsstringoptnode(self) then
  2456. begin
  2457. hp := genaddsstringcsstringoptnode(self);
  2458. pass_1 := hp;
  2459. exit;
  2460. end;
  2461. {$endif addstringopt}
  2462. end;
  2463. { otherwise, let addstring convert everything }
  2464. result := first_addstring;
  2465. exit;
  2466. end
  2467. { is one a real float ? }
  2468. else if (rd.typ=floatdef) or (ld.typ=floatdef) then
  2469. begin
  2470. {$ifdef cpufpemu}
  2471. if (current_settings.fputype=fpu_soft) or (cs_fp_emulation in current_settings.moduleswitches) then
  2472. begin
  2473. result:=first_addfloat;
  2474. if assigned(result) then
  2475. exit;
  2476. end;
  2477. {$endif cpufpemu}
  2478. if nodetype in [addn,subn,muln,andn,orn,xorn] then
  2479. expectloc:=LOC_FPUREGISTER
  2480. else
  2481. expectloc:=LOC_FLAGS;
  2482. end
  2483. { pointer comperation and subtraction }
  2484. else if (ld.typ=pointerdef) then
  2485. begin
  2486. if nodetype in [addn,subn,muln,andn,orn,xorn] then
  2487. expectloc:=LOC_REGISTER
  2488. else
  2489. expectloc:=LOC_FLAGS;
  2490. end
  2491. else if is_class_or_interface(ld) then
  2492. begin
  2493. expectloc:=LOC_FLAGS;
  2494. end
  2495. else if (ld.typ=classrefdef) then
  2496. begin
  2497. expectloc:=LOC_FLAGS;
  2498. end
  2499. { support procvar=nil,procvar<>nil }
  2500. else if ((ld.typ=procvardef) and (rt=niln)) or
  2501. ((rd.typ=procvardef) and (lt=niln)) then
  2502. begin
  2503. expectloc:=LOC_FLAGS;
  2504. end
  2505. {$ifdef SUPPORT_MMX}
  2506. { mmx support, this must be before the zero based array
  2507. check }
  2508. else if (cs_mmx in current_settings.localswitches) and is_mmx_able_array(ld) and
  2509. is_mmx_able_array(rd) then
  2510. begin
  2511. expectloc:=LOC_MMXREGISTER;
  2512. end
  2513. {$endif SUPPORT_MMX}
  2514. else if (rd.typ=pointerdef) or (ld.typ=pointerdef) then
  2515. begin
  2516. expectloc:=LOC_REGISTER;
  2517. end
  2518. else if (rd.typ=procvardef) and
  2519. (ld.typ=procvardef) and
  2520. equal_defs(rd,ld) then
  2521. begin
  2522. expectloc:=LOC_FLAGS;
  2523. end
  2524. else if (ld.typ=enumdef) then
  2525. begin
  2526. expectloc:=LOC_FLAGS;
  2527. end
  2528. {$ifdef SUPPORT_MMX}
  2529. else if (cs_mmx in current_settings.localswitches) and
  2530. is_mmx_able_array(ld) and
  2531. is_mmx_able_array(rd) then
  2532. begin
  2533. expectloc:=LOC_MMXREGISTER;
  2534. end
  2535. {$endif SUPPORT_MMX}
  2536. { the general solution is to convert to 32 bit int }
  2537. else
  2538. begin
  2539. expectloc:=LOC_REGISTER;
  2540. end;
  2541. end;
  2542. {$ifdef state_tracking}
  2543. function Taddnode.track_state_pass(exec_known:boolean):boolean;
  2544. var factval:Tnode;
  2545. begin
  2546. track_state_pass:=false;
  2547. if left.track_state_pass(exec_known) then
  2548. begin
  2549. track_state_pass:=true;
  2550. left.resultdef:=nil;
  2551. do_typecheckpass(left);
  2552. end;
  2553. factval:=aktstate.find_fact(left);
  2554. if factval<>nil then
  2555. begin
  2556. track_state_pass:=true;
  2557. left.destroy;
  2558. left:=factval.getcopy;
  2559. end;
  2560. if right.track_state_pass(exec_known) then
  2561. begin
  2562. track_state_pass:=true;
  2563. right.resultdef:=nil;
  2564. do_typecheckpass(right);
  2565. end;
  2566. factval:=aktstate.find_fact(right);
  2567. if factval<>nil then
  2568. begin
  2569. track_state_pass:=true;
  2570. right.destroy;
  2571. right:=factval.getcopy;
  2572. end;
  2573. end;
  2574. {$endif}
  2575. begin
  2576. caddnode:=taddnode;
  2577. end.