nadd.pas 109 KB

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