nadd.pas 94 KB

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