nadd.pas 74 KB

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