nadd.pas 83 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170
  1. {
  2. $Id$
  3. Copyright (c) 1998-2002 by Florian Klaempfl
  4. Type checking and register allocation for add nodes
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. unit nadd;
  19. {$i fpcdefs.inc}
  20. { define addstringopt}
  21. interface
  22. uses
  23. node;
  24. type
  25. taddnode = class(tbinopnode)
  26. constructor create(tt : tnodetype;l,r : tnode);override;
  27. function pass_1 : tnode;override;
  28. function det_resulttype:tnode;override;
  29. {$ifdef state_tracking}
  30. function track_state_pass(exec_known:boolean):boolean;override;
  31. {$endif}
  32. protected
  33. { override the following if you want to implement }
  34. { parts explicitely in the code generator (JM) }
  35. function first_addstring: tnode; virtual;
  36. function first_addset: tnode; virtual;
  37. { only implements "muln" nodes, the rest always has to be done in }
  38. { the code generator for performance reasons (JM) }
  39. function first_add64bitint: tnode; virtual;
  40. {$ifdef cpufpemu}
  41. { This routine calls internal runtime library helpers
  42. for all floating point arithmetic in the case
  43. where the emulation switches is on. Otherwise
  44. returns nil, and everything must be done in
  45. the code generation phase.
  46. }
  47. function first_addfloat : tnode; virtual;
  48. {$endif cpufpemu}
  49. end;
  50. taddnodeclass = class of taddnode;
  51. var
  52. { caddnode is used to create nodes of the add type }
  53. { the virtual constructor allows to assign }
  54. { another class type to caddnode => processor }
  55. { specific node types can be created }
  56. caddnode : taddnodeclass;
  57. implementation
  58. uses
  59. globtype,systems,
  60. cutils,verbose,globals,widestr,
  61. symconst,symtype,symdef,symsym,symtable,defutil,defcmp,
  62. cgbase,
  63. htypechk,pass_1,
  64. nbas,nmat,ncnv,ncon,nset,nopt,ncal,ninl,nmem,
  65. {$ifdef state_tracking}
  66. nstate,
  67. {$endif}
  68. cpuinfo,procinfo;
  69. {*****************************************************************************
  70. TADDNODE
  71. *****************************************************************************}
  72. {$ifdef fpc}
  73. {$maxfpuregisters 0}
  74. {$endif fpc}
  75. constructor taddnode.create(tt : tnodetype;l,r : tnode);
  76. begin
  77. inherited create(tt,l,r);
  78. end;
  79. function taddnode.det_resulttype:tnode;
  80. var
  81. hp,t : tnode;
  82. lt,rt : tnodetype;
  83. rd,ld : tdef;
  84. htype : ttype;
  85. ot : tnodetype;
  86. concatstrings : boolean;
  87. resultset : Tconstset;
  88. i : longint;
  89. b : boolean;
  90. s1,s2 : pchar;
  91. ws1,ws2 : pcompilerwidestring;
  92. l1,l2 : longint;
  93. rv,lv : tconstexprint;
  94. rvd,lvd : bestreal;
  95. resultrealtype : ttype;
  96. {$ifdef state_tracking}
  97. factval : Tnode;
  98. change : boolean;
  99. {$endif}
  100. begin
  101. result:=nil;
  102. { first do the two subtrees }
  103. resulttypepass(left);
  104. resulttypepass(right);
  105. { both left and right need to be valid }
  106. set_varstate(left,vs_used,true);
  107. set_varstate(right,vs_used,true);
  108. if codegenerror then
  109. exit;
  110. { convert array constructors to sets, because there is no other operator
  111. possible for array constructors }
  112. if is_array_constructor(left.resulttype.def) then
  113. begin
  114. arrayconstructor_to_set(left);
  115. resulttypepass(left);
  116. end;
  117. if is_array_constructor(right.resulttype.def) then
  118. begin
  119. arrayconstructor_to_set(right);
  120. resulttypepass(right);
  121. end;
  122. { allow operator overloading }
  123. hp:=self;
  124. if isbinaryoverloaded(hp) then
  125. begin
  126. result:=hp;
  127. exit;
  128. end;
  129. { Stop checking when an error was found in the operator checking }
  130. if codegenerror then
  131. begin
  132. result:=cerrornode.create;
  133. exit;
  134. end;
  135. { Kylix allows enum+ordconstn in an enum declaration (blocktype
  136. is bt_type), we need to do the conversion here before the
  137. constant folding }
  138. if (m_delphi in aktmodeswitches) and
  139. (blocktype=bt_type) then
  140. begin
  141. if (left.resulttype.def.deftype=enumdef) and
  142. (right.resulttype.def.deftype=orddef) then
  143. begin
  144. { insert explicit typecast to s32bit }
  145. left:=ctypeconvnode.create_explicit(left,s32bittype);
  146. resulttypepass(left);
  147. end
  148. else
  149. if (left.resulttype.def.deftype=orddef) and
  150. (right.resulttype.def.deftype=enumdef) then
  151. begin
  152. { insert explicit typecast to s32bit }
  153. right:=ctypeconvnode.create_explicit(right,s32bittype);
  154. resulttypepass(right);
  155. end;
  156. end;
  157. { is one a real float, then both need to be floats, this
  158. need to be done before the constant folding so constant
  159. operation on a float and int are also handled }
  160. resultrealtype:=pbestrealtype^;
  161. if (right.resulttype.def.deftype=floatdef) or (left.resulttype.def.deftype=floatdef) then
  162. begin
  163. { when both floattypes are already equal then use that
  164. floattype for results }
  165. if (right.resulttype.def.deftype=floatdef) and
  166. (left.resulttype.def.deftype=floatdef) and
  167. (tfloatdef(left.resulttype.def).typ=tfloatdef(right.resulttype.def).typ) then
  168. resultrealtype:=left.resulttype
  169. { when there is a currency type then use currency, but
  170. only when currency is defined as float }
  171. else
  172. if (s64currencytype.def.deftype=floatdef) and
  173. (is_currency(right.resulttype.def) or
  174. is_currency(left.resulttype.def)) then
  175. begin
  176. resultrealtype:=s64currencytype;
  177. inserttypeconv(right,resultrealtype);
  178. inserttypeconv(left,resultrealtype);
  179. end
  180. else
  181. begin
  182. inserttypeconv(right,resultrealtype);
  183. inserttypeconv(left,resultrealtype);
  184. end;
  185. end;
  186. { if one operand is a widechar or a widestring, both operands }
  187. { are converted to widestring. This must be done before constant }
  188. { folding to allow char+widechar etc. }
  189. if is_widestring(right.resulttype.def) or
  190. is_widestring(left.resulttype.def) or
  191. is_widechar(right.resulttype.def) or
  192. is_widechar(left.resulttype.def) then
  193. begin
  194. inserttypeconv(right,cwidestringtype);
  195. inserttypeconv(left,cwidestringtype);
  196. end;
  197. { load easier access variables }
  198. rd:=right.resulttype.def;
  199. ld:=left.resulttype.def;
  200. rt:=right.nodetype;
  201. lt:=left.nodetype;
  202. if (nodetype = slashn) and
  203. (((rt = ordconstn) and
  204. (tordconstnode(right).value = 0)) or
  205. ((rt = realconstn) and
  206. (trealconstnode(right).value_real = 0.0))) then
  207. begin
  208. if (cs_check_range in aktlocalswitches) or
  209. (cs_check_overflow in aktlocalswitches) then
  210. begin
  211. result:=crealconstnode.create(1,pbestrealtype^);
  212. Message(parser_e_division_by_zero);
  213. exit;
  214. end;
  215. end;
  216. { both are int constants }
  217. if ((is_constintnode(left) and is_constintnode(right)) or
  218. (is_constboolnode(left) and is_constboolnode(right) and
  219. (nodetype in [slashn,ltn,lten,gtn,gten,equaln,unequaln,andn,xorn,orn])) or
  220. (is_constenumnode(left) and is_constenumnode(right) and
  221. (nodetype in [equaln,unequaln,ltn,lten,gtn,gten]))) or
  222. { support pointer arithmetics on constants (JM) }
  223. ((lt = pointerconstn) and is_constintnode(right) and
  224. (nodetype in [addn,subn])) or
  225. (((lt = pointerconstn) or (lt = niln)) and
  226. ((rt = pointerconstn) or (rt = niln)) and
  227. (nodetype in [ltn,lten,gtn,gten,equaln,unequaln,subn])) then
  228. begin
  229. { when comparing/substracting pointers, make sure they are }
  230. { of the same type (JM) }
  231. if (lt = pointerconstn) and (rt = pointerconstn) then
  232. begin
  233. if not(cs_extsyntax in aktmoduleswitches) and
  234. not(nodetype in [equaln,unequaln]) then
  235. CGMessage(type_e_mismatch)
  236. else
  237. if (nodetype <> subn) and
  238. is_voidpointer(rd) then
  239. inserttypeconv(right,left.resulttype)
  240. else if (nodetype <> subn) and
  241. is_voidpointer(ld) then
  242. inserttypeconv(left,right.resulttype)
  243. else if not(equal_defs(ld,rd)) then
  244. IncompatibleTypes(ld,rd);
  245. end
  246. else if (ld.deftype=enumdef) and (rd.deftype=enumdef) then
  247. begin
  248. if not(equal_defs(ld,rd)) then
  249. inserttypeconv(right,left.resulttype);
  250. end
  251. else if (lt=ordconstn) and (rt=ordconstn) then
  252. begin
  253. { make left const type the biggest (u32bit is bigger than
  254. s32bit for or,and,xor) }
  255. if (rd.size>ld.size) or
  256. ((torddef(rd).typ=u32bit) and
  257. (torddef(ld).typ=s32bit) and
  258. (nodetype in [orn,andn,xorn])) then
  259. inserttypeconv(left,right.resulttype);
  260. end;
  261. { load values }
  262. case lt of
  263. ordconstn:
  264. lv:=tordconstnode(left).value;
  265. pointerconstn:
  266. lv:=tpointerconstnode(left).value;
  267. niln:
  268. lv:=0;
  269. else
  270. internalerror(2002080202);
  271. end;
  272. case rt of
  273. ordconstn:
  274. rv:=tordconstnode(right).value;
  275. pointerconstn:
  276. rv:=tpointerconstnode(right).value;
  277. niln:
  278. rv:=0;
  279. else
  280. internalerror(2002080203);
  281. end;
  282. if (lt = pointerconstn) and
  283. (rt <> pointerconstn) then
  284. rv := rv * tpointerdef(left.resulttype.def).pointertype.def.size;
  285. if (rt = pointerconstn) and
  286. (lt <> pointerconstn) then
  287. lv := lv * tpointerdef(right.resulttype.def).pointertype.def.size;
  288. case nodetype of
  289. addn :
  290. if (lt <> pointerconstn) then
  291. t := genintconstnode(lv+rv)
  292. else
  293. t := cpointerconstnode.create(lv+rv,left.resulttype);
  294. subn :
  295. if (lt <> pointerconstn) or (rt = pointerconstn) then
  296. t := genintconstnode(lv-rv)
  297. else
  298. t := cpointerconstnode.create(lv-rv,left.resulttype);
  299. muln :
  300. if (torddef(ld).typ <> u64bit) or
  301. (torddef(rd).typ <> u64bit) then
  302. t:=genintconstnode(lv*rv)
  303. else
  304. t:=genintconstnode(int64(qword(lv)*qword(rv)));
  305. xorn :
  306. t:=cordconstnode.create(lv xor rv,left.resulttype,true);
  307. orn :
  308. t:=cordconstnode.create(lv or rv,left.resulttype,true);
  309. andn :
  310. t:=cordconstnode.create(lv and rv,left.resulttype,true);
  311. ltn :
  312. t:=cordconstnode.create(ord(lv<rv),booltype,true);
  313. lten :
  314. t:=cordconstnode.create(ord(lv<=rv),booltype,true);
  315. gtn :
  316. t:=cordconstnode.create(ord(lv>rv),booltype,true);
  317. gten :
  318. t:=cordconstnode.create(ord(lv>=rv),booltype,true);
  319. equaln :
  320. t:=cordconstnode.create(ord(lv=rv),booltype,true);
  321. unequaln :
  322. t:=cordconstnode.create(ord(lv<>rv),booltype,true);
  323. slashn :
  324. begin
  325. { int/int becomes a real }
  326. rvd:=rv;
  327. lvd:=lv;
  328. t:=crealconstnode.create(lvd/rvd,resultrealtype);
  329. end;
  330. else
  331. begin
  332. CGMessage(type_e_mismatch);
  333. t:=cnothingnode.create;
  334. end;
  335. end;
  336. result:=t;
  337. exit;
  338. end;
  339. { both real constants ? }
  340. if (lt=realconstn) and (rt=realconstn) then
  341. begin
  342. lvd:=trealconstnode(left).value_real;
  343. rvd:=trealconstnode(right).value_real;
  344. case nodetype of
  345. addn :
  346. t:=crealconstnode.create(lvd+rvd,resultrealtype);
  347. subn :
  348. t:=crealconstnode.create(lvd-rvd,resultrealtype);
  349. muln :
  350. t:=crealconstnode.create(lvd*rvd,resultrealtype);
  351. starstarn,
  352. caretn :
  353. begin
  354. if lvd<0 then
  355. begin
  356. Message(parser_e_invalid_float_operation);
  357. t:=crealconstnode.create(0,resultrealtype);
  358. end
  359. else if lvd=0 then
  360. t:=crealconstnode.create(1.0,resultrealtype)
  361. else
  362. t:=crealconstnode.create(exp(ln(lvd)*rvd),resultrealtype);
  363. end;
  364. slashn :
  365. t:=crealconstnode.create(lvd/rvd,resultrealtype);
  366. ltn :
  367. t:=cordconstnode.create(ord(lvd<rvd),booltype,true);
  368. lten :
  369. t:=cordconstnode.create(ord(lvd<=rvd),booltype,true);
  370. gtn :
  371. t:=cordconstnode.create(ord(lvd>rvd),booltype,true);
  372. gten :
  373. t:=cordconstnode.create(ord(lvd>=rvd),booltype,true);
  374. equaln :
  375. t:=cordconstnode.create(ord(lvd=rvd),booltype,true);
  376. unequaln :
  377. t:=cordconstnode.create(ord(lvd<>rvd),booltype,true);
  378. else
  379. begin
  380. CGMessage(type_e_mismatch);
  381. t:=cnothingnode.create;
  382. end;
  383. end;
  384. result:=t;
  385. exit;
  386. end;
  387. { first, we handle widestrings, so we can check later for }
  388. { stringconstn only }
  389. { widechars are converted above to widestrings too }
  390. { this isn't veryy efficient, but I don't think }
  391. { that it does matter that much (FK) }
  392. if (lt=stringconstn) and (rt=stringconstn) and
  393. (tstringconstnode(left).st_type=st_widestring) and
  394. (tstringconstnode(right).st_type=st_widestring) then
  395. begin
  396. initwidestring(ws1);
  397. initwidestring(ws2);
  398. copywidestring(pcompilerwidestring(tstringconstnode(left).value_str),ws1);
  399. copywidestring(pcompilerwidestring(tstringconstnode(right).value_str),ws2);
  400. case nodetype of
  401. addn :
  402. begin
  403. concatwidestrings(ws1,ws2);
  404. t:=cstringconstnode.createwstr(ws1);
  405. end;
  406. ltn :
  407. t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)<0),booltype,true);
  408. lten :
  409. t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)<=0),booltype,true);
  410. gtn :
  411. t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)>0),booltype,true);
  412. gten :
  413. t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)>=0),booltype,true);
  414. equaln :
  415. t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)=0),booltype,true);
  416. unequaln :
  417. t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)<>0),booltype,true);
  418. else
  419. begin
  420. CGMessage(type_e_mismatch);
  421. t:=cnothingnode.create;
  422. end;
  423. end;
  424. donewidestring(ws1);
  425. donewidestring(ws2);
  426. result:=t;
  427. exit;
  428. end;
  429. { concating strings ? }
  430. concatstrings:=false;
  431. s1:=nil;
  432. s2:=nil;
  433. if (lt=ordconstn) and (rt=ordconstn) and
  434. is_char(ld) and is_char(rd) then
  435. begin
  436. s1:=strpnew(char(byte(tordconstnode(left).value)));
  437. s2:=strpnew(char(byte(tordconstnode(right).value)));
  438. l1:=1;
  439. l2:=1;
  440. concatstrings:=true;
  441. end
  442. else
  443. if (lt=stringconstn) and (rt=ordconstn) and is_char(rd) then
  444. begin
  445. s1:=tstringconstnode(left).getpcharcopy;
  446. l1:=tstringconstnode(left).len;
  447. s2:=strpnew(char(byte(tordconstnode(right).value)));
  448. l2:=1;
  449. concatstrings:=true;
  450. end
  451. else
  452. if (lt=ordconstn) and (rt=stringconstn) and is_char(ld) then
  453. begin
  454. s1:=strpnew(char(byte(tordconstnode(left).value)));
  455. l1:=1;
  456. s2:=tstringconstnode(right).getpcharcopy;
  457. l2:=tstringconstnode(right).len;
  458. concatstrings:=true;
  459. end
  460. else if (lt=stringconstn) and (rt=stringconstn) then
  461. begin
  462. s1:=tstringconstnode(left).getpcharcopy;
  463. l1:=tstringconstnode(left).len;
  464. s2:=tstringconstnode(right).getpcharcopy;
  465. l2:=tstringconstnode(right).len;
  466. concatstrings:=true;
  467. end;
  468. if concatstrings then
  469. begin
  470. case nodetype of
  471. addn :
  472. t:=cstringconstnode.createpchar(concatansistrings(s1,s2,l1,l2),l1+l2);
  473. ltn :
  474. t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)<0),booltype,true);
  475. lten :
  476. t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)<=0),booltype,true);
  477. gtn :
  478. t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)>0),booltype,true);
  479. gten :
  480. t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)>=0),booltype,true);
  481. equaln :
  482. t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)=0),booltype,true);
  483. unequaln :
  484. t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)<>0),booltype,true);
  485. end;
  486. ansistringdispose(s1,l1);
  487. ansistringdispose(s2,l2);
  488. result:=t;
  489. exit;
  490. end;
  491. { set constant evaluation }
  492. if (right.nodetype=setconstn) and
  493. not assigned(tsetconstnode(right).left) and
  494. (left.nodetype=setconstn) and
  495. not assigned(tsetconstnode(left).left) then
  496. begin
  497. { check if size adjusting is needed, only for left
  498. to right as the other way is checked in the typeconv }
  499. if (tsetdef(right.resulttype.def).settype=smallset) and
  500. (tsetdef(left.resulttype.def).settype<>smallset) then
  501. right.resulttype.setdef(tsetdef.create(tsetdef(right.resulttype.def).elementtype,255));
  502. { check base types }
  503. inserttypeconv(left,right.resulttype);
  504. if codegenerror then
  505. begin
  506. { recover by only returning the left part }
  507. result:=left;
  508. left:=nil;
  509. exit;
  510. end;
  511. case nodetype of
  512. addn :
  513. begin
  514. resultset:=tsetconstnode(right).value_set^ + tsetconstnode(left).value_set^;
  515. t:=csetconstnode.create(@resultset,left.resulttype);
  516. end;
  517. muln :
  518. begin
  519. resultset:=tsetconstnode(right).value_set^ * tsetconstnode(left).value_set^;
  520. t:=csetconstnode.create(@resultset,left.resulttype);
  521. end;
  522. subn :
  523. begin
  524. resultset:=tsetconstnode(left).value_set^ - tsetconstnode(right).value_set^;
  525. t:=csetconstnode.create(@resultset,left.resulttype);
  526. end;
  527. symdifn :
  528. begin
  529. resultset:=tsetconstnode(right).value_set^ >< tsetconstnode(left).value_set^;
  530. t:=csetconstnode.create(@resultset,left.resulttype);
  531. end;
  532. unequaln :
  533. begin
  534. b:=tsetconstnode(right).value_set^ <> tsetconstnode(left).value_set^;
  535. t:=cordconstnode.create(byte(b),booltype,true);
  536. end;
  537. equaln :
  538. begin
  539. b:=tsetconstnode(right).value_set^ = tsetconstnode(left).value_set^;
  540. t:=cordconstnode.create(byte(b),booltype,true);
  541. end;
  542. lten :
  543. begin
  544. b:=tsetconstnode(left).value_set^ <= tsetconstnode(right).value_set^;
  545. t:=cordconstnode.create(byte(b),booltype,true);
  546. end;
  547. gten :
  548. begin
  549. b:=tsetconstnode(left).value_set^ >= tsetconstnode(right).value_set^;
  550. t:=cordconstnode.create(byte(b),booltype,true);
  551. end;
  552. end;
  553. result:=t;
  554. exit;
  555. end;
  556. { but an int/int gives real/real! }
  557. if nodetype=slashn then
  558. begin
  559. if (left.resulttype.def.deftype <> floatdef) and
  560. (right.resulttype.def.deftype <> floatdef) then
  561. CGMessage(type_h_use_div_for_int);
  562. inserttypeconv(right,resultrealtype);
  563. inserttypeconv(left,resultrealtype);
  564. end
  565. { if both are orddefs then check sub types }
  566. else if (ld.deftype=orddef) and (rd.deftype=orddef) then
  567. begin
  568. { optimize multiplacation by a power of 2 }
  569. if not(cs_check_overflow in aktlocalswitches) and
  570. (nodetype = muln) and
  571. (((left.nodetype = ordconstn) and
  572. ispowerof2(tordconstnode(left).value,i)) or
  573. ((right.nodetype = ordconstn) and
  574. ispowerof2(tordconstnode(right).value,i))) then
  575. begin
  576. if left.nodetype = ordconstn then
  577. begin
  578. tordconstnode(left).value := i;
  579. result := cshlshrnode.create(shln,right,left);
  580. end
  581. else
  582. begin
  583. tordconstnode(right).value := i;
  584. result := cshlshrnode.create(shln,left,right);
  585. end;
  586. left := nil;
  587. right := nil;
  588. exit;
  589. end;
  590. { 2 booleans? Make them equal to the largest boolean }
  591. if is_boolean(ld) and is_boolean(rd) then
  592. begin
  593. if torddef(left.resulttype.def).size>torddef(right.resulttype.def).size then
  594. begin
  595. right:=ctypeconvnode.create_explicit(right,left.resulttype);
  596. ttypeconvnode(right).convtype:=tc_bool_2_int;
  597. resulttypepass(right);
  598. end
  599. else if torddef(left.resulttype.def).size<torddef(right.resulttype.def).size then
  600. begin
  601. left:=ctypeconvnode.create_explicit(left,right.resulttype);
  602. ttypeconvnode(left).convtype:=tc_bool_2_int;
  603. resulttypepass(left);
  604. end;
  605. case nodetype of
  606. xorn,
  607. ltn,
  608. lten,
  609. gtn,
  610. gten,
  611. andn,
  612. orn:
  613. begin
  614. end;
  615. unequaln,
  616. equaln:
  617. begin
  618. if not(cs_full_boolean_eval in aktlocalswitches) then
  619. begin
  620. { Remove any compares with constants }
  621. if (left.nodetype=ordconstn) then
  622. begin
  623. hp:=right;
  624. b:=(tordconstnode(left).value<>0);
  625. ot:=nodetype;
  626. left.free;
  627. left:=nil;
  628. right:=nil;
  629. if (not(b) and (ot=equaln)) or
  630. (b and (ot=unequaln)) then
  631. begin
  632. hp:=cnotnode.create(hp);
  633. end;
  634. result:=hp;
  635. exit;
  636. end;
  637. if (right.nodetype=ordconstn) then
  638. begin
  639. hp:=left;
  640. b:=(tordconstnode(right).value<>0);
  641. ot:=nodetype;
  642. right.free;
  643. right:=nil;
  644. left:=nil;
  645. if (not(b) and (ot=equaln)) or
  646. (b and (ot=unequaln)) then
  647. begin
  648. hp:=cnotnode.create(hp);
  649. end;
  650. result:=hp;
  651. exit;
  652. end;
  653. end;
  654. end;
  655. else
  656. CGMessage(type_e_mismatch);
  657. end;
  658. end
  659. { Both are chars? }
  660. else if is_char(rd) and is_char(ld) then
  661. begin
  662. if nodetype=addn then
  663. begin
  664. resulttype:=cshortstringtype;
  665. if not(is_constcharnode(left) and is_constcharnode(right)) then
  666. begin
  667. inserttypeconv(left,cshortstringtype);
  668. {$ifdef addstringopt}
  669. hp := genaddsstringcharoptnode(self);
  670. result := hp;
  671. exit;
  672. {$endif addstringopt}
  673. end;
  674. end;
  675. end
  676. { is there a currency type ? }
  677. else if ((torddef(rd).typ=scurrency) or (torddef(ld).typ=scurrency)) then
  678. begin
  679. if (torddef(ld).typ<>scurrency) then
  680. inserttypeconv(left,s64currencytype);
  681. if (torddef(rd).typ<>scurrency) then
  682. inserttypeconv(right,s64currencytype);
  683. end
  684. { is there a signed 64 bit type ? }
  685. else if ((torddef(rd).typ=s64bit) or (torddef(ld).typ=s64bit)) then
  686. begin
  687. if (torddef(ld).typ<>s64bit) then
  688. inserttypeconv(left,cs64bittype);
  689. if (torddef(rd).typ<>s64bit) then
  690. inserttypeconv(right,cs64bittype);
  691. end
  692. { is there a unsigned 64 bit type ? }
  693. else if ((torddef(rd).typ=u64bit) or (torddef(ld).typ=u64bit)) then
  694. begin
  695. if (torddef(ld).typ<>u64bit) then
  696. inserttypeconv(left,cu64bittype);
  697. if (torddef(rd).typ<>u64bit) then
  698. inserttypeconv(right,cu64bittype);
  699. end
  700. { is there a cardinal? }
  701. else if ((torddef(rd).typ=u32bit) or (torddef(ld).typ=u32bit)) then
  702. begin
  703. { and,or,xor work on bit patterns and don't care
  704. about the sign }
  705. if nodetype in [andn,orn,xorn] then
  706. begin
  707. inserttypeconv_explicit(left,u32bittype);
  708. inserttypeconv_explicit(right,u32bittype);
  709. end
  710. else
  711. begin
  712. if is_signed(ld) and
  713. { then rd = u32bit }
  714. { convert positive constants to u32bit }
  715. not(is_constintnode(left) and
  716. (tordconstnode(left).value >= 0)) then
  717. begin
  718. { perform the operation in 64bit }
  719. CGMessage(type_w_mixed_signed_unsigned);
  720. inserttypeconv(left,cs64bittype);
  721. inserttypeconv(right,cs64bittype);
  722. end
  723. else
  724. begin
  725. if is_signed(ld) and
  726. not(is_constintnode(left) and
  727. (tordconstnode(left).value >= 0)) then
  728. CGMessage(type_w_mixed_signed_unsigned2);
  729. inserttypeconv(left,u32bittype);
  730. if is_signed(rd) and
  731. { then ld = u32bit }
  732. { convert positive constants to u32bit }
  733. not(is_constintnode(right) and
  734. (tordconstnode(right).value >= 0)) then
  735. begin
  736. { perform the operation in 64bit }
  737. CGMessage(type_w_mixed_signed_unsigned);
  738. inserttypeconv(left,cs64bittype);
  739. inserttypeconv(right,cs64bittype);
  740. end
  741. else
  742. begin
  743. if is_signed(rd) and
  744. not(is_constintnode(right) and
  745. (tordconstnode(right).value >= 0)) then
  746. CGMessage(type_w_mixed_signed_unsigned2);
  747. inserttypeconv(right,u32bittype);
  748. end;
  749. end;
  750. end;
  751. end
  752. { generic ord conversion is s32bit }
  753. else
  754. begin
  755. { if the left or right value is smaller than the normal
  756. type s32bittype and is unsigned, and the other value
  757. is a constant < 0, the result will always be false/true
  758. for equal / unequal nodes.
  759. }
  760. if (
  761. { left : unsigned ordinal var, right : < 0 constant }
  762. (
  763. ((is_signed(ld)=false) and (is_constintnode(left) =false)) and
  764. ((is_constintnode(right)) and (tordconstnode(right).value < 0))
  765. ) or
  766. { right : unsigned ordinal var, left : < 0 constant }
  767. (
  768. ((is_signed(rd)=false) and (is_constintnode(right) =false)) and
  769. ((is_constintnode(left)) and (tordconstnode(left).value < 0))
  770. )
  771. ) then
  772. begin
  773. if nodetype = equaln then
  774. CGMessage(type_w_signed_unsigned_always_false)
  775. else
  776. if nodetype = unequaln then
  777. CGMessage(type_w_signed_unsigned_always_true)
  778. else
  779. if (is_constintnode(left) and (nodetype in [ltn,lten])) or
  780. (is_constintnode(right) and (nodetype in [gtn,gten])) then
  781. CGMessage(type_w_signed_unsigned_always_true)
  782. else
  783. if (is_constintnode(right) and (nodetype in [ltn,lten])) or
  784. (is_constintnode(left) and (nodetype in [gtn,gten])) then
  785. CGMessage(type_w_signed_unsigned_always_false);
  786. end;
  787. inserttypeconv(right,s32bittype);
  788. inserttypeconv(left,s32bittype);
  789. end;
  790. end
  791. { if both are floatdefs, conversion is already done before constant folding }
  792. else if (ld.deftype=floatdef) then
  793. begin
  794. { already converted }
  795. end
  796. { left side a setdef, must be before string processing,
  797. else array constructor can be seen as array of char (PFV) }
  798. else if (ld.deftype=setdef) then
  799. begin
  800. { trying to add a set element? }
  801. if (nodetype=addn) and (rd.deftype<>setdef) then
  802. begin
  803. if (rt=setelementn) then
  804. begin
  805. if not(equal_defs(tsetdef(ld).elementtype.def,rd)) then
  806. CGMessage(type_e_set_element_are_not_comp);
  807. end
  808. else
  809. CGMessage(type_e_mismatch)
  810. end
  811. else
  812. begin
  813. if not(nodetype in [addn,subn,symdifn,muln,equaln,unequaln,lten,gten]) then
  814. CGMessage(type_e_set_operation_unknown);
  815. { right def must be a also be set }
  816. if (rd.deftype<>setdef) or not(equal_defs(rd,ld)) then
  817. CGMessage(type_e_set_element_are_not_comp);
  818. end;
  819. { ranges require normsets }
  820. if (tsetdef(ld).settype=smallset) and
  821. (rt=setelementn) and
  822. assigned(tsetelementnode(right).right) then
  823. begin
  824. { generate a temporary normset def, it'll be destroyed
  825. when the symtable is unloaded }
  826. htype.setdef(tsetdef.create(tsetdef(ld).elementtype,255));
  827. inserttypeconv(left,htype);
  828. end;
  829. { if the right side is also a setdef then the settype must
  830. be the same as the left setdef }
  831. if (rd.deftype=setdef) and
  832. (tsetdef(ld).settype<>tsetdef(rd).settype) then
  833. begin
  834. { when right is a normset we need to typecast both
  835. to normsets }
  836. if (tsetdef(rd).settype=normset) then
  837. inserttypeconv(left,right.resulttype)
  838. else
  839. inserttypeconv(right,left.resulttype);
  840. end;
  841. end
  842. { compare pchar to char arrays by addresses like BP/Delphi }
  843. else if ((is_pchar(ld) or (lt=niln)) and is_chararray(rd)) or
  844. ((is_pchar(rd) or (rt=niln)) and is_chararray(ld)) then
  845. begin
  846. if is_chararray(rd) then
  847. inserttypeconv(right,charpointertype)
  848. else
  849. inserttypeconv(left,charpointertype);
  850. end
  851. { pointer comparision and subtraction }
  852. else if (rd.deftype=pointerdef) and (ld.deftype=pointerdef) then
  853. begin
  854. case nodetype of
  855. equaln,unequaln :
  856. begin
  857. if is_voidpointer(right.resulttype.def) then
  858. inserttypeconv(right,left.resulttype)
  859. else if is_voidpointer(left.resulttype.def) then
  860. inserttypeconv(left,right.resulttype)
  861. else if not(equal_defs(ld,rd)) then
  862. IncompatibleTypes(ld,rd);
  863. end;
  864. ltn,lten,gtn,gten:
  865. begin
  866. if (cs_extsyntax in aktmoduleswitches) then
  867. begin
  868. if is_voidpointer(right.resulttype.def) then
  869. inserttypeconv(right,left.resulttype)
  870. else if is_voidpointer(left.resulttype.def) then
  871. inserttypeconv(left,right.resulttype)
  872. else if not(equal_defs(ld,rd)) then
  873. IncompatibleTypes(ld,rd);
  874. end
  875. else
  876. CGMessage(type_e_mismatch);
  877. end;
  878. subn:
  879. begin
  880. if (cs_extsyntax in aktmoduleswitches) then
  881. begin
  882. if is_voidpointer(right.resulttype.def) then
  883. inserttypeconv(right,left.resulttype)
  884. else if is_voidpointer(left.resulttype.def) then
  885. inserttypeconv(left,right.resulttype)
  886. else if not(equal_defs(ld,rd)) then
  887. IncompatibleTypes(ld,rd);
  888. end
  889. else
  890. CGMessage(type_e_mismatch);
  891. resulttype:=s32bittype;
  892. exit;
  893. end;
  894. addn:
  895. begin
  896. if (cs_extsyntax in aktmoduleswitches) then
  897. begin
  898. if is_voidpointer(right.resulttype.def) then
  899. inserttypeconv(right,left.resulttype)
  900. else if is_voidpointer(left.resulttype.def) then
  901. inserttypeconv(left,right.resulttype)
  902. else if not(equal_defs(ld,rd)) then
  903. IncompatibleTypes(ld,rd);
  904. end
  905. else
  906. CGMessage(type_e_mismatch);
  907. resulttype:=s32bittype;
  908. exit;
  909. end;
  910. else
  911. CGMessage(type_e_mismatch);
  912. end;
  913. end
  914. { is one of the operands a string?,
  915. chararrays are also handled as strings (after conversion), also take
  916. care of chararray+chararray and chararray+char.
  917. Note: Must be done after pointerdef+pointerdef has been checked, else
  918. pchar is converted to string }
  919. else if (rd.deftype=stringdef) or (ld.deftype=stringdef) or
  920. ((is_pchar(rd) or is_chararray(rd) or is_char(rd)) and
  921. (is_pchar(ld) or is_chararray(ld) or is_char(ld))) then
  922. begin
  923. if is_widestring(rd) or is_widestring(ld) then
  924. begin
  925. if not(is_widestring(rd)) then
  926. inserttypeconv(right,cwidestringtype);
  927. if not(is_widestring(ld)) then
  928. inserttypeconv(left,cwidestringtype);
  929. end
  930. else if is_ansistring(rd) or is_ansistring(ld) then
  931. begin
  932. if not(is_ansistring(rd)) then
  933. inserttypeconv(right,cansistringtype);
  934. if not(is_ansistring(ld)) then
  935. inserttypeconv(left,cansistringtype);
  936. end
  937. else if is_longstring(rd) or is_longstring(ld) then
  938. begin
  939. if not(is_longstring(rd)) then
  940. inserttypeconv(right,clongstringtype);
  941. if not(is_longstring(ld)) then
  942. inserttypeconv(left,clongstringtype);
  943. end
  944. else
  945. begin
  946. if not(is_shortstring(ld)) then
  947. inserttypeconv(left,cshortstringtype);
  948. { don't convert char, that can be handled by the optimized node }
  949. if not(is_shortstring(rd) or is_char(rd)) then
  950. inserttypeconv(right,cshortstringtype);
  951. end;
  952. end
  953. { class or interface equation }
  954. else if is_class_or_interface(rd) or is_class_or_interface(ld) then
  955. begin
  956. if is_class_or_interface(rd) and is_class_or_interface(ld) then
  957. begin
  958. if tobjectdef(rd).is_related(tobjectdef(ld)) then
  959. inserttypeconv(right,left.resulttype)
  960. else
  961. inserttypeconv(left,right.resulttype);
  962. end
  963. else if is_class_or_interface(rd) then
  964. inserttypeconv(left,right.resulttype)
  965. else
  966. inserttypeconv(right,left.resulttype);
  967. if not(nodetype in [equaln,unequaln]) then
  968. CGMessage(type_e_mismatch);
  969. end
  970. else if (rd.deftype=classrefdef) and (ld.deftype=classrefdef) then
  971. begin
  972. if tobjectdef(tclassrefdef(rd).pointertype.def).is_related(
  973. tobjectdef(tclassrefdef(ld).pointertype.def)) then
  974. inserttypeconv(right,left.resulttype)
  975. else
  976. inserttypeconv(left,right.resulttype);
  977. if not(nodetype in [equaln,unequaln]) then
  978. CGMessage(type_e_mismatch);
  979. end
  980. { allows comperasion with nil pointer }
  981. else if is_class_or_interface(rd) or (rd.deftype=classrefdef) then
  982. begin
  983. inserttypeconv(left,right.resulttype);
  984. if not(nodetype in [equaln,unequaln]) then
  985. CGMessage(type_e_mismatch);
  986. end
  987. else if is_class_or_interface(ld) or (ld.deftype=classrefdef) then
  988. begin
  989. inserttypeconv(right,left.resulttype);
  990. if not(nodetype in [equaln,unequaln]) then
  991. CGMessage(type_e_mismatch);
  992. end
  993. { support procvar=nil,procvar<>nil }
  994. else if ((ld.deftype=procvardef) and (rt=niln)) or
  995. ((rd.deftype=procvardef) and (lt=niln)) then
  996. begin
  997. if not(nodetype in [equaln,unequaln]) then
  998. CGMessage(type_e_mismatch);
  999. end
  1000. { support dynamicarray=nil,dynamicarray<>nil }
  1001. else if (is_dynamic_array(ld) and (rt=niln)) or
  1002. (is_dynamic_array(rd) and (lt=niln)) then
  1003. begin
  1004. if not(nodetype in [equaln,unequaln]) then
  1005. CGMessage(type_e_mismatch);
  1006. end
  1007. {$ifdef SUPPORT_MMX}
  1008. { mmx support, this must be before the zero based array
  1009. check }
  1010. else if (cs_mmx in aktlocalswitches) and
  1011. is_mmx_able_array(ld) and
  1012. is_mmx_able_array(rd) and
  1013. equal_defs(ld,rd) then
  1014. begin
  1015. case nodetype of
  1016. addn,subn,xorn,orn,andn:
  1017. ;
  1018. { mul is a little bit restricted }
  1019. muln:
  1020. if not(mmx_type(ld) in [mmxu16bit,mmxs16bit,mmxfixed16]) then
  1021. CGMessage(type_e_mismatch);
  1022. else
  1023. CGMessage(type_e_mismatch);
  1024. end;
  1025. end
  1026. {$endif SUPPORT_MMX}
  1027. { this is a little bit dangerous, also the left type }
  1028. { pointer to should be checked! This broke the mmx support }
  1029. else if (rd.deftype=pointerdef) or is_zero_based_array(rd) then
  1030. begin
  1031. if is_zero_based_array(rd) then
  1032. begin
  1033. resulttype.setdef(tpointerdef.create(tarraydef(rd).elementtype));
  1034. inserttypeconv(right,resulttype);
  1035. end;
  1036. inserttypeconv(left,s32bittype);
  1037. if nodetype=addn then
  1038. begin
  1039. if not(cs_extsyntax in aktmoduleswitches) or
  1040. (not(is_pchar(ld)) and not(m_add_pointer in aktmodeswitches)) then
  1041. CGMessage(type_e_mismatch);
  1042. if (rd.deftype=pointerdef) and
  1043. (tpointerdef(rd).pointertype.def.size>1) then
  1044. left:=caddnode.create(muln,left,
  1045. cordconstnode.create(tpointerdef(rd).pointertype.def.size,s32bittype,true));
  1046. end
  1047. else
  1048. CGMessage(type_e_mismatch);
  1049. end
  1050. else if (ld.deftype=pointerdef) or is_zero_based_array(ld) then
  1051. begin
  1052. if is_zero_based_array(ld) then
  1053. begin
  1054. resulttype.setdef(tpointerdef.create(tarraydef(ld).elementtype));
  1055. inserttypeconv(left,resulttype);
  1056. end;
  1057. inserttypeconv(right,s32bittype);
  1058. if nodetype in [addn,subn] then
  1059. begin
  1060. if not(cs_extsyntax in aktmoduleswitches) or
  1061. (not(is_pchar(ld)) and not(m_add_pointer in aktmodeswitches)) then
  1062. CGMessage(type_e_mismatch);
  1063. if (ld.deftype=pointerdef) and
  1064. (tpointerdef(ld).pointertype.def.size>1) then
  1065. right:=caddnode.create(muln,right,
  1066. cordconstnode.create(tpointerdef(ld).pointertype.def.size,s32bittype,true));
  1067. end
  1068. else
  1069. CGMessage(type_e_mismatch);
  1070. end
  1071. else if (rd.deftype=procvardef) and
  1072. (ld.deftype=procvardef) and
  1073. equal_defs(rd,ld) then
  1074. begin
  1075. if not (nodetype in [equaln,unequaln]) then
  1076. CGMessage(type_e_mismatch);
  1077. { convert both to voidpointer, because methodpointers are 8 bytes }
  1078. { even though only the first 4 bytes must be compared (JM) }
  1079. inserttypeconv_explicit(left,voidpointertype);
  1080. inserttypeconv_explicit(right,voidpointertype);
  1081. end
  1082. { enums }
  1083. else if (ld.deftype=enumdef) and (rd.deftype=enumdef) then
  1084. begin
  1085. if not(equal_defs(ld,rd)) then
  1086. inserttypeconv(right,left.resulttype);
  1087. if not(nodetype in [equaln,unequaln,ltn,lten,gtn,gten]) then
  1088. CGMessage(type_e_mismatch);
  1089. end
  1090. { generic conversion, this is for error recovery }
  1091. else
  1092. begin
  1093. inserttypeconv(left,s32bittype);
  1094. inserttypeconv(right,s32bittype);
  1095. end;
  1096. { set resulttype if not already done }
  1097. if not assigned(resulttype.def) then
  1098. begin
  1099. case nodetype of
  1100. ltn,lten,gtn,gten,equaln,unequaln :
  1101. resulttype:=booltype;
  1102. slashn :
  1103. resulttype:=resultrealtype;
  1104. addn:
  1105. begin
  1106. { for strings, return is always a 255 char string }
  1107. if is_shortstring(left.resulttype.def) then
  1108. resulttype:=cshortstringtype
  1109. else
  1110. resulttype:=left.resulttype;
  1111. end;
  1112. else
  1113. resulttype:=left.resulttype;
  1114. end;
  1115. end;
  1116. { when the result is currency we need some extra code for
  1117. multiplication and division. this should not be done when
  1118. the muln or slashn node is created internally }
  1119. if not(nf_is_currency in flags) and
  1120. is_currency(resulttype.def) then
  1121. begin
  1122. case nodetype of
  1123. slashn :
  1124. begin
  1125. { slashn will only work with floats }
  1126. hp:=caddnode.create(muln,getcopy,crealconstnode.create(10000.0,s64currencytype));
  1127. include(hp.flags,nf_is_currency);
  1128. result:=hp;
  1129. end;
  1130. muln :
  1131. begin
  1132. if s64currencytype.def.deftype=floatdef then
  1133. hp:=caddnode.create(slashn,getcopy,crealconstnode.create(10000.0,s64currencytype))
  1134. else
  1135. hp:=cmoddivnode.create(divn,getcopy,cordconstnode.create(10000,s64currencytype,false));
  1136. include(hp.flags,nf_is_currency);
  1137. result:=hp
  1138. end;
  1139. end;
  1140. end;
  1141. end;
  1142. function taddnode.first_addstring: tnode;
  1143. var
  1144. p: tnode;
  1145. begin
  1146. { when we get here, we are sure that both the left and the right }
  1147. { node are both strings of the same stringtype (JM) }
  1148. case nodetype of
  1149. addn:
  1150. begin
  1151. { create the call to the concat routine both strings as arguments }
  1152. result := ccallnode.createintern('fpc_'+
  1153. tstringdef(resulttype.def).stringtypname+'_concat',
  1154. ccallparanode.create(right,ccallparanode.create(left,nil)));
  1155. { we reused the arguments }
  1156. left := nil;
  1157. right := nil;
  1158. end;
  1159. ltn,lten,gtn,gten,equaln,unequaln :
  1160. begin
  1161. { generate better code for s='' and s<>'' }
  1162. if (nodetype in [equaln,unequaln]) and
  1163. (((left.nodetype=stringconstn) and (str_length(left)=0)) or
  1164. ((right.nodetype=stringconstn) and (str_length(right)=0))) then
  1165. begin
  1166. { switch so that the constant is always on the right }
  1167. if left.nodetype = stringconstn then
  1168. begin
  1169. p := left;
  1170. left := right;
  1171. right := p;
  1172. end;
  1173. if is_shortstring(left.resulttype.def) then
  1174. { compare the length with 0 }
  1175. result := caddnode.create(nodetype,
  1176. cinlinenode.create(in_length_x,false,left),
  1177. cordconstnode.create(0,s32bittype,false))
  1178. else
  1179. begin
  1180. { compare the pointer with nil (for ansistrings etc), }
  1181. { faster than getting the length (JM) }
  1182. result:= caddnode.create(nodetype,
  1183. ctypeconvnode.create_explicit(left,voidpointertype),
  1184. cpointerconstnode.create(0,voidpointertype));
  1185. end;
  1186. { left is reused }
  1187. left := nil;
  1188. { right isn't }
  1189. right.free;
  1190. right := nil;
  1191. exit;
  1192. end;
  1193. { no string constant -> call compare routine }
  1194. result := ccallnode.createintern('fpc_'+
  1195. tstringdef(left.resulttype.def).stringtypname+'_compare',
  1196. ccallparanode.create(right,ccallparanode.create(left,nil)));
  1197. { and compare its result with 0 according to the original operator }
  1198. result := caddnode.create(nodetype,result,
  1199. cordconstnode.create(0,s32bittype,false));
  1200. left := nil;
  1201. right := nil;
  1202. end;
  1203. end;
  1204. end;
  1205. function taddnode.first_addset: tnode;
  1206. var
  1207. procname: string[31];
  1208. tempn: tnode;
  1209. paras: tcallparanode;
  1210. srsym: ttypesym;
  1211. begin
  1212. { get the sym that represents the fpc_normal_set type }
  1213. if not searchsystype('FPC_NORMAL_SET',srsym) then
  1214. internalerror(200108313);
  1215. case nodetype of
  1216. equaln,unequaln,lten,gten:
  1217. begin
  1218. case nodetype of
  1219. equaln,unequaln:
  1220. procname := 'fpc_set_comp_sets';
  1221. lten,gten:
  1222. begin
  1223. procname := 'fpc_set_contains_sets';
  1224. { (left >= right) = (right <= left) }
  1225. if nodetype = gten then
  1226. begin
  1227. tempn := left;
  1228. left := right;
  1229. right := tempn;
  1230. end;
  1231. end;
  1232. end;
  1233. { convert the arguments (explicitely) to fpc_normal_set's }
  1234. left := ctypeconvnode.create_explicit(left,srsym.restype);
  1235. right := ctypeconvnode.create_explicit(right,srsym.restype);
  1236. result := ccallnode.createintern(procname,ccallparanode.create(right,
  1237. ccallparanode.create(left,nil)));
  1238. { left and right are reused as parameters }
  1239. left := nil;
  1240. right := nil;
  1241. { for an unequaln, we have to negate the result of comp_sets }
  1242. if nodetype = unequaln then
  1243. result := cnotnode.create(result);
  1244. end;
  1245. addn:
  1246. begin
  1247. { optimize first loading of a set }
  1248. if (right.nodetype=setelementn) and
  1249. not(assigned(tsetelementnode(right).right)) and
  1250. is_emptyset(left) then
  1251. begin
  1252. { type cast the value to pass as argument to a byte, }
  1253. { since that's what the helper expects }
  1254. tsetelementnode(right).left :=
  1255. ctypeconvnode.create_explicit(tsetelementnode(right).left,u8bittype);
  1256. { set the resulttype to the actual one (otherwise it's }
  1257. { "fpc_normal_set") }
  1258. result := ccallnode.createinternres('fpc_set_create_element',
  1259. ccallparanode.create(tsetelementnode(right).left,nil),
  1260. resulttype);
  1261. { reused }
  1262. tsetelementnode(right).left := nil;
  1263. end
  1264. else
  1265. begin
  1266. if right.nodetype=setelementn then
  1267. begin
  1268. { convert the arguments to bytes, since that's what }
  1269. { the helper expects }
  1270. tsetelementnode(right).left :=
  1271. ctypeconvnode.create_explicit(tsetelementnode(right).left,
  1272. u8bittype);
  1273. { convert the original set (explicitely) to an }
  1274. { fpc_normal_set so we can pass it to the helper }
  1275. left := ctypeconvnode.create_explicit(left,srsym.restype);
  1276. { add a range or a single element? }
  1277. if assigned(tsetelementnode(right).right) then
  1278. begin
  1279. tsetelementnode(right).right :=
  1280. ctypeconvnode.create_explicit(tsetelementnode(right).right,
  1281. u8bittype);
  1282. { create the call }
  1283. result := ccallnode.createinternres('fpc_set_set_range',
  1284. ccallparanode.create(tsetelementnode(right).right,
  1285. ccallparanode.create(tsetelementnode(right).left,
  1286. ccallparanode.create(left,nil))),resulttype);
  1287. end
  1288. else
  1289. begin
  1290. result := ccallnode.createinternres('fpc_set_set_byte',
  1291. ccallparanode.create(tsetelementnode(right).left,
  1292. ccallparanode.create(left,nil)),resulttype);
  1293. end;
  1294. { remove reused parts from original node }
  1295. tsetelementnode(right).right := nil;
  1296. tsetelementnode(right).left := nil;
  1297. left := nil;
  1298. end
  1299. else
  1300. begin
  1301. { add two sets }
  1302. { convert the sets to fpc_normal_set's }
  1303. result := ccallnode.createinternres('fpc_set_add_sets',
  1304. ccallparanode.create(
  1305. ctypeconvnode.create_explicit(right,srsym.restype),
  1306. ccallparanode.create(
  1307. ctypeconvnode.create_explicit(left,srsym.restype),nil)),resulttype);
  1308. { remove reused parts from original node }
  1309. left := nil;
  1310. right := nil;
  1311. end;
  1312. end
  1313. end;
  1314. subn,symdifn,muln:
  1315. begin
  1316. { convert the sets to fpc_normal_set's }
  1317. paras := ccallparanode.create(ctypeconvnode.create_explicit(right,srsym.restype),
  1318. ccallparanode.create(ctypeconvnode.create_explicit(left,srsym.restype),nil));
  1319. case nodetype of
  1320. subn:
  1321. result := ccallnode.createinternres('fpc_set_sub_sets',
  1322. paras,resulttype);
  1323. symdifn:
  1324. result := ccallnode.createinternres('fpc_set_symdif_sets',
  1325. paras,resulttype);
  1326. muln:
  1327. result := ccallnode.createinternres('fpc_set_mul_sets',
  1328. paras,resulttype);
  1329. end;
  1330. { remove reused parts from original node }
  1331. left := nil;
  1332. right := nil;
  1333. end;
  1334. else
  1335. internalerror(200108311);
  1336. end;
  1337. end;
  1338. function taddnode.first_add64bitint: tnode;
  1339. var
  1340. procname: string[31];
  1341. temp: tnode;
  1342. power: longint;
  1343. begin
  1344. result := nil;
  1345. { create helper calls mul }
  1346. if nodetype <> muln then
  1347. exit;
  1348. { make sure that if there is a constant, that it's on the right }
  1349. if left.nodetype = ordconstn then
  1350. begin
  1351. temp := right;
  1352. right := left;
  1353. left := temp;
  1354. end;
  1355. { can we use a shift instead of a mul? }
  1356. if not (cs_check_overflow in aktlocalswitches) and
  1357. (right.nodetype = ordconstn) and
  1358. ispowerof2(tordconstnode(right).value,power) then
  1359. begin
  1360. tordconstnode(right).value := power;
  1361. result := cshlshrnode.create(shln,left,right);
  1362. { left and right are reused }
  1363. left := nil;
  1364. right := nil;
  1365. { return firstpassed new node }
  1366. exit;
  1367. end;
  1368. { when currency is used set the result of the
  1369. parameters to s64bit, so they are not converted }
  1370. if is_currency(resulttype.def) then
  1371. begin
  1372. left.resulttype:=cs64bittype;
  1373. right.resulttype:=cs64bittype;
  1374. end;
  1375. { otherwise, create the parameters for the helper }
  1376. right := ccallparanode.create(
  1377. cordconstnode.create(ord(cs_check_overflow in aktlocalswitches),booltype,true),
  1378. ccallparanode.create(right,ccallparanode.create(left,nil)));
  1379. left := nil;
  1380. { only qword needs the unsigned code, the
  1381. signed code is also used for currency }
  1382. if is_signed(resulttype.def) then
  1383. procname := 'fpc_mul_int64'
  1384. else
  1385. procname := 'fpc_mul_qword';
  1386. result := ccallnode.createintern(procname,right);
  1387. right := nil;
  1388. end;
  1389. {$ifdef cpufpemu}
  1390. function taddnode.first_addfloat: tnode;
  1391. var
  1392. procname: string[31];
  1393. temp: tnode;
  1394. power: longint;
  1395. { do we need to reverse the result ? }
  1396. notnode : boolean;
  1397. begin
  1398. result := nil;
  1399. notnode := false;
  1400. { In non-emulation mode, real opcodes are
  1401. emitted for floating point values.
  1402. }
  1403. if not (cs_fp_emulation in aktmoduleswitches) then
  1404. exit;
  1405. case nodetype of
  1406. addn : procname := 'fpc_single_add';
  1407. muln : procname := 'fpc_single_mul';
  1408. subn : procname := 'fpc_single_sub';
  1409. slashn : procname := 'fpc_single_div';
  1410. ltn : procname := 'fpc_single_lt';
  1411. lten: procname := 'fpc_single_le';
  1412. gtn:
  1413. begin
  1414. procname := 'fpc_single_le';
  1415. notnode := true;
  1416. end;
  1417. gten:
  1418. begin
  1419. procname := 'fpc_single_lt';
  1420. notnode := true;
  1421. end;
  1422. equaln: procname := 'fpc_single_eq';
  1423. unequaln :
  1424. begin
  1425. procname := 'fpc_single_eq';
  1426. notnode := true;
  1427. end;
  1428. else
  1429. CGMessage(type_e_mismatch);
  1430. end;
  1431. { convert the arguments (explicitely) to fpc_normal_set's }
  1432. result := ccallnode.createintern(procname,ccallparanode.create(right,
  1433. ccallparanode.create(left,nil)));
  1434. left:=nil;
  1435. right:=nil;
  1436. { do we need to reverse the result }
  1437. if notnode then
  1438. result := cnotnode.create(result);
  1439. end;
  1440. {$endif cpufpemu}
  1441. function taddnode.pass_1 : tnode;
  1442. var
  1443. {$ifdef addstringopt}
  1444. hp : tnode;
  1445. {$endif addstringopt}
  1446. lt,rt : tnodetype;
  1447. rd,ld : tdef;
  1448. begin
  1449. result:=nil;
  1450. { first do the two subtrees }
  1451. firstpass(left);
  1452. firstpass(right);
  1453. if codegenerror then
  1454. exit;
  1455. { load easier access variables }
  1456. rd:=right.resulttype.def;
  1457. ld:=left.resulttype.def;
  1458. rt:=right.nodetype;
  1459. lt:=left.nodetype;
  1460. { int/int gives real/real! }
  1461. if nodetype=slashn then
  1462. begin
  1463. {$ifdef cpufpemu}
  1464. result := first_addfloat;
  1465. if assigned(result) then
  1466. exit;
  1467. {$endif cpufpemu}
  1468. expectloc:=LOC_FPUREGISTER;
  1469. { maybe we need an integer register to save }
  1470. { a reference }
  1471. if ((left.expectloc<>LOC_FPUREGISTER) or
  1472. (right.expectloc<>LOC_FPUREGISTER)) and
  1473. (left.registers32=right.registers32) then
  1474. calcregisters(self,1,1,0)
  1475. else
  1476. calcregisters(self,0,1,0);
  1477. { an add node always first loads both the left and the }
  1478. { right in the fpu before doing the calculation. However, }
  1479. { calcregisters(0,2,0) will overestimate the number of }
  1480. { necessary registers (it will make it 3 in case one of }
  1481. { the operands is already in the fpu) (JM) }
  1482. if ((left.expectloc<>LOC_FPUREGISTER) or
  1483. (right.expectloc<>LOC_FPUREGISTER)) and
  1484. (registersfpu < 2) then
  1485. inc(registersfpu);
  1486. end
  1487. { if both are orddefs then check sub types }
  1488. else if (ld.deftype=orddef) and (rd.deftype=orddef) then
  1489. begin
  1490. { 2 booleans ? }
  1491. if is_boolean(ld) and is_boolean(rd) then
  1492. begin
  1493. if not(cs_full_boolean_eval in aktlocalswitches) and
  1494. (nodetype in [andn,orn]) then
  1495. begin
  1496. expectloc:=LOC_JUMP;
  1497. calcregisters(self,0,0,0);
  1498. end
  1499. else
  1500. begin
  1501. expectloc:=LOC_FLAGS;
  1502. if (left.expectloc in [LOC_JUMP,LOC_FLAGS]) and
  1503. (left.expectloc in [LOC_JUMP,LOC_FLAGS]) then
  1504. calcregisters(self,2,0,0)
  1505. else
  1506. calcregisters(self,1,0,0);
  1507. end;
  1508. end
  1509. else
  1510. { Both are chars? only convert to shortstrings for addn }
  1511. if is_char(ld) then
  1512. begin
  1513. if nodetype=addn then
  1514. internalerror(200103291);
  1515. expectloc:=LOC_FLAGS;
  1516. calcregisters(self,1,0,0);
  1517. end
  1518. { is there a 64 bit type ? }
  1519. else if (torddef(ld).typ in [s64bit,u64bit,scurrency]) then
  1520. begin
  1521. result := first_add64bitint;
  1522. if assigned(result) then
  1523. exit;
  1524. if nodetype in [addn,subn,muln,andn,orn,xorn] then
  1525. expectloc:=LOC_REGISTER
  1526. else
  1527. expectloc:=LOC_JUMP;
  1528. calcregisters(self,2,0,0)
  1529. end
  1530. { is there a cardinal? }
  1531. else if (torddef(ld).typ=u32bit) then
  1532. begin
  1533. if nodetype in [addn,subn,muln,andn,orn,xorn] then
  1534. expectloc:=LOC_REGISTER
  1535. else
  1536. expectloc:=LOC_FLAGS;
  1537. calcregisters(self,1,0,0);
  1538. { for unsigned mul we need an extra register }
  1539. if nodetype=muln then
  1540. inc(registers32);
  1541. end
  1542. { generic s32bit conversion }
  1543. else
  1544. begin
  1545. if nodetype in [addn,subn,muln,andn,orn,xorn] then
  1546. expectloc:=LOC_REGISTER
  1547. else
  1548. expectloc:=LOC_FLAGS;
  1549. calcregisters(self,1,0,0);
  1550. end;
  1551. end
  1552. { left side a setdef, must be before string processing,
  1553. else array constructor can be seen as array of char (PFV) }
  1554. else if (ld.deftype=setdef) then
  1555. begin
  1556. if tsetdef(ld).settype=smallset then
  1557. begin
  1558. if nodetype in [ltn,lten,gtn,gten,equaln,unequaln] then
  1559. expectloc:=LOC_FLAGS
  1560. else
  1561. expectloc:=LOC_REGISTER;
  1562. { are we adding set elements ? }
  1563. if right.nodetype=setelementn then
  1564. calcregisters(self,2,0,0)
  1565. else
  1566. calcregisters(self,1,0,0);
  1567. end
  1568. else
  1569. {$ifdef i386}
  1570. if cs_mmx in aktlocalswitches then
  1571. begin
  1572. expectloc:=LOC_MMXREGISTER;
  1573. calcregisters(self,0,0,4);
  1574. end
  1575. else
  1576. {$endif}
  1577. begin
  1578. result := first_addset;
  1579. if assigned(result) then
  1580. exit;
  1581. expectloc:=LOC_CREFERENCE;
  1582. calcregisters(self,0,0,0);
  1583. { here we call SET... }
  1584. include(current_procinfo.flags,pi_do_call);
  1585. end;
  1586. end
  1587. { compare pchar by addresses like BP/Delphi }
  1588. else if is_pchar(ld) then
  1589. begin
  1590. if nodetype in [addn,subn,muln,andn,orn,xorn] then
  1591. expectloc:=LOC_REGISTER
  1592. else
  1593. expectloc:=LOC_FLAGS;
  1594. calcregisters(self,1,0,0);
  1595. end
  1596. { is one of the operands a string }
  1597. else if (ld.deftype=stringdef) then
  1598. begin
  1599. if is_widestring(ld) then
  1600. begin
  1601. { this is only for add, the comparisaion is handled later }
  1602. expectloc:=LOC_REGISTER;
  1603. end
  1604. else if is_ansistring(ld) then
  1605. begin
  1606. { this is only for add, the comparisaion is handled later }
  1607. expectloc:=LOC_REGISTER;
  1608. end
  1609. else if is_longstring(ld) then
  1610. begin
  1611. { this is only for add, the comparisaion is handled later }
  1612. expectloc:=LOC_REFERENCE;
  1613. end
  1614. else
  1615. begin
  1616. {$ifdef addstringopt}
  1617. { can create a call which isn't handled by callparatemp }
  1618. if canbeaddsstringcharoptnode(self) then
  1619. begin
  1620. hp := genaddsstringcharoptnode(self);
  1621. pass_1 := hp;
  1622. exit;
  1623. end
  1624. else
  1625. {$endif addstringopt}
  1626. begin
  1627. { Fix right to be shortstring }
  1628. if is_char(right.resulttype.def) then
  1629. begin
  1630. inserttypeconv(right,cshortstringtype);
  1631. firstpass(right);
  1632. end;
  1633. end;
  1634. {$ifdef addstringopt}
  1635. { can create a call which isn't handled by callparatemp }
  1636. if canbeaddsstringcsstringoptnode(self) then
  1637. begin
  1638. hp := genaddsstringcsstringoptnode(self);
  1639. pass_1 := hp;
  1640. exit;
  1641. end;
  1642. {$endif addstringopt}
  1643. end;
  1644. { otherwise, let addstring convert everything }
  1645. result := first_addstring;
  1646. exit;
  1647. end
  1648. { is one a real float ? }
  1649. else if (rd.deftype=floatdef) or (ld.deftype=floatdef) then
  1650. begin
  1651. {$ifdef cpufpemu}
  1652. result := first_addfloat;
  1653. if assigned(result) then
  1654. exit;
  1655. {$endif cpufpemu}
  1656. if nodetype in [addn,subn,muln,andn,orn,xorn] then
  1657. expectloc:=LOC_FPUREGISTER
  1658. else
  1659. expectloc:=LOC_FLAGS;
  1660. calcregisters(self,0,1,0);
  1661. { an add node always first loads both the left and the }
  1662. { right in the fpu before doing the calculation. However, }
  1663. { calcregisters(0,2,0) will overestimate the number of }
  1664. { necessary registers (it will make it 3 in case one of }
  1665. { the operands is already in the fpu) (JM) }
  1666. if ((left.expectloc<>LOC_FPUREGISTER) or
  1667. (right.expectloc<>LOC_FPUREGISTER)) and
  1668. (registersfpu < 2) then
  1669. inc(registersfpu);
  1670. end
  1671. { pointer comperation and subtraction }
  1672. else if (ld.deftype=pointerdef) then
  1673. begin
  1674. if nodetype in [addn,subn,muln,andn,orn,xorn] then
  1675. expectloc:=LOC_REGISTER
  1676. else
  1677. expectloc:=LOC_FLAGS;
  1678. calcregisters(self,1,0,0);
  1679. end
  1680. else if is_class_or_interface(ld) then
  1681. begin
  1682. expectloc:=LOC_FLAGS;
  1683. calcregisters(self,1,0,0);
  1684. end
  1685. else if (ld.deftype=classrefdef) then
  1686. begin
  1687. expectloc:=LOC_FLAGS;
  1688. calcregisters(self,1,0,0);
  1689. end
  1690. { support procvar=nil,procvar<>nil }
  1691. else if ((ld.deftype=procvardef) and (rt=niln)) or
  1692. ((rd.deftype=procvardef) and (lt=niln)) then
  1693. begin
  1694. expectloc:=LOC_FLAGS;
  1695. calcregisters(self,1,0,0);
  1696. end
  1697. {$ifdef SUPPORT_MMX}
  1698. { mmx support, this must be before the zero based array
  1699. check }
  1700. else if (cs_mmx in aktlocalswitches) and is_mmx_able_array(ld) and
  1701. is_mmx_able_array(rd) then
  1702. begin
  1703. expectloc:=LOC_MMXREGISTER;
  1704. calcregisters(self,0,0,1);
  1705. end
  1706. {$endif SUPPORT_MMX}
  1707. else if (rd.deftype=pointerdef) or (ld.deftype=pointerdef) then
  1708. begin
  1709. expectloc:=LOC_REGISTER;
  1710. calcregisters(self,1,0,0);
  1711. end
  1712. else if (rd.deftype=procvardef) and
  1713. (ld.deftype=procvardef) and
  1714. equal_defs(rd,ld) then
  1715. begin
  1716. expectloc:=LOC_FLAGS;
  1717. calcregisters(self,1,0,0);
  1718. end
  1719. else if (ld.deftype=enumdef) then
  1720. begin
  1721. expectloc:=LOC_FLAGS;
  1722. calcregisters(self,1,0,0);
  1723. end
  1724. {$ifdef SUPPORT_MMX}
  1725. else if (cs_mmx in aktlocalswitches) and
  1726. is_mmx_able_array(ld) and
  1727. is_mmx_able_array(rd) then
  1728. begin
  1729. expectloc:=LOC_MMXREGISTER;
  1730. calcregisters(self,0,0,1);
  1731. end
  1732. {$endif SUPPORT_MMX}
  1733. { the general solution is to convert to 32 bit int }
  1734. else
  1735. begin
  1736. expectloc:=LOC_REGISTER;
  1737. calcregisters(self,1,0,0);
  1738. end;
  1739. end;
  1740. {$ifdef state_tracking}
  1741. function Taddnode.track_state_pass(exec_known:boolean):boolean;
  1742. var factval:Tnode;
  1743. begin
  1744. track_state_pass:=false;
  1745. if left.track_state_pass(exec_known) then
  1746. begin
  1747. track_state_pass:=true;
  1748. left.resulttype.def:=nil;
  1749. do_resulttypepass(left);
  1750. end;
  1751. factval:=aktstate.find_fact(left);
  1752. if factval<>nil then
  1753. begin
  1754. track_state_pass:=true;
  1755. left.destroy;
  1756. left:=factval.getcopy;
  1757. end;
  1758. if right.track_state_pass(exec_known) then
  1759. begin
  1760. track_state_pass:=true;
  1761. right.resulttype.def:=nil;
  1762. do_resulttypepass(right);
  1763. end;
  1764. factval:=aktstate.find_fact(right);
  1765. if factval<>nil then
  1766. begin
  1767. track_state_pass:=true;
  1768. right.destroy;
  1769. right:=factval.getcopy;
  1770. end;
  1771. end;
  1772. {$endif}
  1773. begin
  1774. caddnode:=taddnode;
  1775. end.
  1776. {
  1777. $Log$
  1778. Revision 1.104 2003-12-31 20:47:02 jonas
  1779. * properly fixed assigned() mess (by handling it separately in ncginl)
  1780. -> all assigned()-related tests in the test suite work again
  1781. Revision 1.103 2003/12/30 16:30:50 jonas
  1782. * fixed previous commit for tp and delphi modes
  1783. Revision 1.102 2003/12/29 22:33:08 jonas
  1784. * fixed methodpointer comparing in a generic way (typecast both left and
  1785. right explicitly to voidpointer), instead of relying on strange
  1786. behvaiour or n386addnode.pass_2 (if size of def = 8, only use the first
  1787. 4 bytes instead of internalerror-ing or so)
  1788. Revision 1.101 2003/12/21 11:28:41 daniel
  1789. * Some work to allow mmx instructions to be used for 32 byte sets
  1790. Revision 1.100 2003/12/09 21:17:04 jonas
  1791. + support for evaluating qword constant expressions (both arguments have
  1792. to be a qword, constants have to be explicitly typecasted to qword)
  1793. Revision 1.99 2003/10/28 15:35:18 peter
  1794. * compare longint-cardinal also makes types wider
  1795. Revision 1.98 2003/10/21 18:16:13 peter
  1796. * IncompatibleTypes() added that will include unit names when
  1797. the typenames are the same
  1798. Revision 1.97 2003/10/08 19:19:45 peter
  1799. * set_varstate cleanup
  1800. Revision 1.96 2003/10/01 20:34:48 peter
  1801. * procinfo unit contains tprocinfo
  1802. * cginfo renamed to cgbase
  1803. * moved cgmessage to verbose
  1804. * fixed ppc and sparc compiles
  1805. Revision 1.95 2003/09/06 16:47:24 florian
  1806. + support of NaN and Inf in the compiler as values of real constants
  1807. Revision 1.94 2003/09/03 15:55:00 peter
  1808. * NEWRA branch merged
  1809. Revision 1.93.2.1 2003/08/31 21:07:44 daniel
  1810. * callparatemp ripped
  1811. Revision 1.93 2003/06/05 20:05:55 peter
  1812. * removed changesettype because that will change the definition
  1813. of the setdef forever and can result in a different between
  1814. original interface and current implementation definition
  1815. Revision 1.92 2003/06/03 21:04:43 peter
  1816. * widen cardinal+signed operations
  1817. Revision 1.91 2003/05/26 21:15:18 peter
  1818. * disable string node optimizations for the moment
  1819. Revision 1.90 2003/05/26 19:38:28 peter
  1820. * generic fpc_shorstr_concat
  1821. + fpc_shortstr_append_shortstr optimization
  1822. Revision 1.89 2003/05/24 21:12:57 florian
  1823. * if something doesn't work with callparatemp, the define callparatemp
  1824. should be used because other processors with reigster calling conventions
  1825. depend on this as well
  1826. Revision 1.88 2003/05/23 22:57:38 jonas
  1827. - disable addoptnodes for powerpc, because they can generate calls in
  1828. pass_2, so -dcallparatemp can't detect them as nested calls
  1829. Revision 1.87 2003/04/27 11:21:32 peter
  1830. * aktprocdef renamed to current_procdef
  1831. * procinfo renamed to current_procinfo
  1832. * procinfo will now be stored in current_module so it can be
  1833. cleaned up properly
  1834. * gen_main_procsym changed to create_main_proc and release_main_proc
  1835. to also generate a tprocinfo structure
  1836. * fixed unit implicit initfinal
  1837. Revision 1.86 2003/04/26 09:12:55 peter
  1838. * add string returns in LOC_REFERENCE
  1839. Revision 1.85 2003/04/24 22:29:57 florian
  1840. * fixed a lot of PowerPC related stuff
  1841. Revision 1.84 2003/04/23 20:16:04 peter
  1842. + added currency support based on int64
  1843. + is_64bit for use in cg units instead of is_64bitint
  1844. * removed cgmessage from n386add, replace with internalerrors
  1845. Revision 1.83 2003/04/23 10:10:07 peter
  1846. * expectloc fixes
  1847. Revision 1.82 2003/04/22 23:50:22 peter
  1848. * firstpass uses expectloc
  1849. * checks if there are differences between the expectloc and
  1850. location.loc from secondpass in EXTDEBUG
  1851. Revision 1.81 2003/02/15 22:20:14 carl
  1852. * bugfix for generic calls to FPU emulation code
  1853. Revision 1.80 2003/02/12 22:10:07 carl
  1854. * load_frame_pointer is now generic
  1855. * change fpu emulation routine names
  1856. Revision 1.79 2003/01/02 22:19:54 peter
  1857. * support pchar-char operations converting to string first
  1858. * support chararray-nil
  1859. Revision 1.78 2002/12/11 22:41:03 peter
  1860. * stop processing assignment node when the binaryoverload generates
  1861. a codegenerror
  1862. Revision 1.77 2002/12/06 16:56:57 peter
  1863. * only compile cs_fp_emulation support when cpufpuemu is defined
  1864. * define cpufpuemu for m68k only
  1865. Revision 1.76 2002/11/30 21:32:24 carl
  1866. + Add loading of softfpu in emulation mode
  1867. + Correct routine call for softfpu
  1868. * Extended type must also be defined even with softfpu
  1869. Revision 1.75 2002/11/27 13:11:38 peter
  1870. * more currency fixes, taddcurr runs now successfull
  1871. Revision 1.74 2002/11/27 11:28:40 peter
  1872. * when both flaottypes are the same then handle the addnode using
  1873. that floattype instead of bestrealtype
  1874. Revision 1.73 2002/11/25 18:43:32 carl
  1875. - removed the invalid if <> checking (Delphi is strange on this)
  1876. + implemented abstract warning on instance creation of class with
  1877. abstract methods.
  1878. * some error message cleanups
  1879. Revision 1.72 2002/11/25 17:43:17 peter
  1880. * splitted defbase in defutil,symutil,defcmp
  1881. * merged isconvertable and is_equal into compare_defs(_ext)
  1882. * made operator search faster by walking the list only once
  1883. Revision 1.71 2002/11/23 22:50:06 carl
  1884. * some small speed optimizations
  1885. + added several new warnings/hints
  1886. Revision 1.70 2002/11/16 14:20:22 peter
  1887. * fix tbs0417
  1888. Revision 1.69 2002/11/15 01:58:50 peter
  1889. * merged changes from 1.0.7 up to 04-11
  1890. - -V option for generating bug report tracing
  1891. - more tracing for option parsing
  1892. - errors for cdecl and high()
  1893. - win32 import stabs
  1894. - win32 records<=8 are returned in eax:edx (turned off by default)
  1895. - heaptrc update
  1896. - more info for temp management in .s file with EXTDEBUG
  1897. Revision 1.68 2002/10/08 16:50:43 jonas
  1898. * fixed web bug 2136
  1899. Revision 1.67 2002/10/05 00:47:03 peter
  1900. * support dynamicarray<>nil
  1901. Revision 1.66 2002/10/04 21:19:28 jonas
  1902. * fixed web bug 2139: checking for division by zero fixed
  1903. Revision 1.65 2002/09/07 15:25:02 peter
  1904. * old logs removed and tabs fixed
  1905. Revision 1.64 2002/09/07 12:16:05 carl
  1906. * second part bug report 1996 fix, testrange in cordconstnode
  1907. only called if option is set (also make parsing a tiny faster)
  1908. Revision 1.63 2002/09/04 19:32:56 jonas
  1909. * changed some ctypeconvnode/toggleflag(nf_explizit) combo's to
  1910. ctypeconvnode.create_explicit() statements
  1911. Revision 1.62 2002/08/17 09:23:34 florian
  1912. * first part of current_procinfo rewrite
  1913. Revision 1.61 2002/08/15 15:15:55 carl
  1914. * jmpbuf size allocation for exceptions is now cpu specific (as it should)
  1915. * more generic nodes for maths
  1916. * several fixes for better m68k support
  1917. Revision 1.60 2002/08/12 15:08:39 carl
  1918. + stab register indexes for powerpc (moved from gdb to cpubase)
  1919. + tprocessor enumeration moved to cpuinfo
  1920. + linker in target_info is now a class
  1921. * many many updates for m68k (will soon start to compile)
  1922. - removed some ifdef or correct them for correct cpu
  1923. Revision 1.59 2002/08/02 07:44:30 jonas
  1924. * made assigned() handling generic
  1925. * add nodes now can also evaluate constant expressions at compile time
  1926. that contain nil nodes
  1927. Revision 1.58 2002/07/26 11:17:52 jonas
  1928. * the optimization of converting a multiplication with a power of two to
  1929. a shl is moved from n386add/secondpass to nadd/resulttypepass
  1930. Revision 1.57 2002/07/23 13:08:16 jonas
  1931. * fixed constant set evaluation of new set handling for non-commutative
  1932. operators
  1933. Revision 1.56 2002/07/23 12:34:29 daniel
  1934. * Readded old set code. To use it define 'oldset'. Activated by default
  1935. for ppc.
  1936. Revision 1.55 2002/07/22 11:48:04 daniel
  1937. * Sets are now internally sets.
  1938. Revision 1.54 2002/07/20 11:57:53 florian
  1939. * types.pas renamed to defbase.pas because D6 contains a types
  1940. unit so this would conflicts if D6 programms are compiled
  1941. + Willamette/SSE2 instructions to assembler added
  1942. Revision 1.53 2002/07/19 11:41:34 daniel
  1943. * State tracker work
  1944. * The whilen and repeatn are now completely unified into whilerepeatn. This
  1945. allows the state tracker to change while nodes automatically into
  1946. repeat nodes.
  1947. * Resulttypepass improvements to the notn. 'not not a' is optimized away and
  1948. 'not(a>b)' is optimized into 'a<=b'.
  1949. * Resulttypepass improvements to the whilerepeatn. 'while not a' is optimized
  1950. by removing the notn and later switchting the true and falselabels. The
  1951. same is done with 'repeat until not a'.
  1952. Revision 1.52 2002/07/14 18:00:43 daniel
  1953. + Added the beginning of a state tracker. This will track the values of
  1954. variables through procedures and optimize things away.
  1955. Revision 1.51 2002/05/18 13:34:08 peter
  1956. * readded missing revisions
  1957. Revision 1.50 2002/05/16 19:46:37 carl
  1958. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  1959. + try to fix temp allocation (still in ifdef)
  1960. + generic constructor calls
  1961. + start of tassembler / tmodulebase class cleanup
  1962. Revision 1.48 2002/05/13 19:54:36 peter
  1963. * removed n386ld and n386util units
  1964. * maybe_save/maybe_restore added instead of the old maybe_push
  1965. Revision 1.47 2002/05/12 16:53:06 peter
  1966. * moved entry and exitcode to ncgutil and cgobj
  1967. * foreach gets extra argument for passing local data to the
  1968. iterator function
  1969. * -CR checks also class typecasts at runtime by changing them
  1970. into as
  1971. * fixed compiler to cycle with the -CR option
  1972. * fixed stabs with elf writer, finally the global variables can
  1973. be watched
  1974. * removed a lot of routines from cga unit and replaced them by
  1975. calls to cgobj
  1976. * u32bit-s32bit updates for and,or,xor nodes. When one element is
  1977. u32bit then the other is typecasted also to u32bit without giving
  1978. a rangecheck warning/error.
  1979. * fixed pascal calling method with reversing also the high tree in
  1980. the parast, detected by tcalcst3 test
  1981. Revision 1.46 2002/04/23 19:16:34 peter
  1982. * add pinline unit that inserts compiler supported functions using
  1983. one or more statements
  1984. * moved finalize and setlength from ninl to pinline
  1985. Revision 1.45 2002/04/04 19:05:56 peter
  1986. * removed unused units
  1987. * use tlocation.size in cg.a_*loc*() routines
  1988. Revision 1.44 2002/04/02 17:11:28 peter
  1989. * tlocation,treference update
  1990. * LOC_CONSTANT added for better constant handling
  1991. * secondadd splitted in multiple routines
  1992. * location_force_reg added for loading a location to a register
  1993. of a specified size
  1994. * secondassignment parses now first the right and then the left node
  1995. (this is compatible with Kylix). This saves a lot of push/pop especially
  1996. with string operations
  1997. * adapted some routines to use the new cg methods
  1998. }