nadd.pas 114 KB

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