nadd.pas 103 KB

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