nadd.pas 75 KB

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