nadd.pas 75 KB

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