ncal.pas 96 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671
  1. {
  2. $Id$
  3. Copyright (c) 1998-2002 by Florian Klaempfl
  4. This file implements the node for sub procedure calling.
  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 ncal;
  19. {$i fpcdefs.inc}
  20. interface
  21. uses
  22. cutils,cclasses,
  23. globtype,cpuinfo,
  24. paramgr,
  25. node,nbas,
  26. {$ifdef state_tracking}
  27. nstate,
  28. {$endif state_tracking}
  29. symbase,symtype,symsym,symdef,symtable;
  30. type
  31. tcallnodeflags = (
  32. cnf_restypeset
  33. );
  34. tcallnodeflagset = set of tcallnodeflags;
  35. tcallnode = class(tbinarynode)
  36. private
  37. { number of parameters passed from the source, this does not include the hidden parameters }
  38. paralength : smallint;
  39. paravisible : boolean;
  40. function gen_self_tree_methodpointer:tnode;
  41. function gen_self_tree:tnode;
  42. function gen_vmt_tree:tnode;
  43. procedure bind_paraitem;
  44. { function return node, this is used to pass the data for a
  45. ret_in_param return value }
  46. _funcretnode : tnode;
  47. procedure setfuncretnode(const returnnode: tnode);
  48. procedure convert_carg_array_of_const;
  49. procedure order_parameters;
  50. public
  51. { the symbol containing the definition of the procedure }
  52. { to call }
  53. symtableprocentry : tprocsym;
  54. symtableprocentryderef : tderef;
  55. { symtable where the entry was found, needed for with support }
  56. symtableproc : tsymtable;
  57. { the definition of the procedure to call }
  58. procdefinition : tabstractprocdef;
  59. procdefinitionderef : tderef;
  60. { tree that contains the pointer to the object for this method }
  61. methodpointer : tnode;
  62. { inline function body }
  63. inlinecode : tnode;
  64. { varargs tparaitems }
  65. varargsparas : tvarargspara;
  66. { node that specifies where the result should be put for calls }
  67. { that return their result in a parameter }
  68. property funcretnode: tnode read _funcretnode write setfuncretnode;
  69. { separately specified resulttype for some compilerprocs (e.g. }
  70. { you can't have a function with an "array of char" resulttype }
  71. { the RTL) (JM) }
  72. restype: ttype;
  73. callnodeflags : tcallnodeflagset;
  74. { only the processor specific nodes need to override this }
  75. { constructor }
  76. constructor create(l:tnode; v : tprocsym;st : tsymtable; mp : tnode);virtual;
  77. constructor create_def(l:tnode;def:tprocdef;mp:tnode);virtual;
  78. constructor create_procvar(l,r:tnode);
  79. constructor createintern(const name: string; params: tnode);
  80. constructor createinternres(const name: string; params: tnode; const res: ttype);
  81. constructor createinternreturn(const name: string; params: tnode; returnnode : tnode);
  82. destructor destroy;override;
  83. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  84. procedure ppuwrite(ppufile:tcompilerppufile);override;
  85. procedure buildderefimpl;override;
  86. procedure derefimpl;override;
  87. function getcopy : tnode;override;
  88. { Goes through all symbols in a class and subclasses and calls
  89. verify abstract for each .
  90. }
  91. procedure verifyabstractcalls;
  92. { called for each definition in a class and verifies if a method
  93. is abstract or not, if it is abstract, give out a warning
  94. }
  95. procedure verifyabstract(p : tnamedindexitem;arg:pointer);
  96. procedure insertintolist(l : tnodelist);override;
  97. function pass_1 : tnode;override;
  98. function det_resulttype:tnode;override;
  99. {$ifdef state_tracking}
  100. function track_state_pass(exec_known:boolean):boolean;override;
  101. {$endif state_tracking}
  102. function docompare(p: tnode): boolean; override;
  103. procedure printnodedata(var t:text);override;
  104. function para_count:longint;
  105. private
  106. AbstractMethodsList : TStringList;
  107. end;
  108. tcallnodeclass = class of tcallnode;
  109. tcallparaflags = (
  110. { flags used by tcallparanode }
  111. cpf_is_colon_para
  112. );
  113. tcallparanode = class(tbinarynode)
  114. public
  115. callparaflags : set of tcallparaflags;
  116. paraitem : tparaitem;
  117. used_by_callnode : boolean;
  118. { only the processor specific nodes need to override this }
  119. { constructor }
  120. constructor create(expr,next : tnode);virtual;
  121. destructor destroy;override;
  122. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  123. procedure ppuwrite(ppufile:tcompilerppufile);override;
  124. function getcopy : tnode;override;
  125. procedure insertintolist(l : tnodelist);override;
  126. procedure get_paratype;
  127. procedure insert_typeconv(do_count : boolean);
  128. procedure det_registers;
  129. procedure firstcallparan;
  130. procedure secondcallparan;virtual;abstract;
  131. function docompare(p: tnode): boolean; override;
  132. procedure printnodetree(var t:text);override;
  133. end;
  134. tcallparanodeclass = class of tcallparanode;
  135. function reverseparameters(p: tcallparanode): tcallparanode;
  136. var
  137. ccallnode : tcallnodeclass;
  138. ccallparanode : tcallparanodeclass;
  139. { Current callnode, this is needed for having a link
  140. between the callparanodes and the callnode they belong to }
  141. aktcallnode : tcallnode;
  142. implementation
  143. uses
  144. systems,
  145. verbose,globals,
  146. symconst,defutil,defcmp,
  147. htypechk,pass_1,
  148. ncnv,nld,ninl,nadd,ncon,nmem,nutils,
  149. procinfo,
  150. cgbase
  151. ;
  152. type
  153. tobjectinfoitem = class(tlinkedlistitem)
  154. objinfo : tobjectdef;
  155. constructor create(def : tobjectdef);
  156. end;
  157. {****************************************************************************
  158. HELPERS
  159. ****************************************************************************}
  160. function reverseparameters(p: tcallparanode): tcallparanode;
  161. var
  162. hp1, hp2: tcallparanode;
  163. begin
  164. hp1:=nil;
  165. while assigned(p) do
  166. begin
  167. { pull out }
  168. hp2:=p;
  169. p:=tcallparanode(p.right);
  170. { pull in }
  171. hp2.right:=hp1;
  172. hp1:=hp2;
  173. end;
  174. reverseparameters:=hp1;
  175. end;
  176. function gen_high_tree(p:tnode;openstring:boolean):tnode;
  177. var
  178. temp: tnode;
  179. len : integer;
  180. loadconst : boolean;
  181. hightree : tnode;
  182. begin
  183. len:=-1;
  184. loadconst:=true;
  185. hightree:=nil;
  186. case p.resulttype.def.deftype of
  187. arraydef :
  188. begin
  189. { handle via a normal inline in_high_x node }
  190. loadconst := false;
  191. hightree := geninlinenode(in_high_x,false,p.getcopy);
  192. { only substract low(array) if it's <> 0 }
  193. temp := geninlinenode(in_low_x,false,p.getcopy);
  194. resulttypepass(temp);
  195. if (temp.nodetype <> ordconstn) or
  196. (tordconstnode(temp).value <> 0) then
  197. hightree := caddnode.create(subn,hightree,temp)
  198. else
  199. temp.free;
  200. end;
  201. stringdef :
  202. begin
  203. if openstring then
  204. begin
  205. { handle via a normal inline in_high_x node }
  206. loadconst := false;
  207. hightree := geninlinenode(in_high_x,false,p.getcopy);
  208. end
  209. else
  210. begin
  211. { passing a string to an array of char }
  212. if (p.nodetype=stringconstn) then
  213. begin
  214. len:=str_length(p);
  215. if len>0 then
  216. dec(len);
  217. end
  218. else
  219. begin
  220. hightree:=caddnode.create(subn,geninlinenode(in_length_x,false,p.getcopy),
  221. cordconstnode.create(1,s32inttype,false));
  222. loadconst:=false;
  223. end;
  224. end;
  225. end;
  226. else
  227. len:=0;
  228. end;
  229. if loadconst then
  230. hightree:=cordconstnode.create(len,s32inttype,true)
  231. else
  232. begin
  233. if not assigned(hightree) then
  234. internalerror(200304071);
  235. { Need to use explicit, because it can also be a enum }
  236. hightree:=ctypeconvnode.create_explicit(hightree,s32inttype);
  237. end;
  238. result:=hightree;
  239. end;
  240. {****************************************************************************
  241. TOBJECTINFOITEM
  242. ****************************************************************************}
  243. constructor tobjectinfoitem.create(def : tobjectdef);
  244. begin
  245. inherited create;
  246. objinfo := def;
  247. end;
  248. {****************************************************************************
  249. TCALLPARANODE
  250. ****************************************************************************}
  251. constructor tcallparanode.create(expr,next : tnode);
  252. begin
  253. inherited create(callparan,expr,next);
  254. if not assigned(expr) then
  255. internalerror(200305091);
  256. expr.set_file_line(self);
  257. callparaflags:=[];
  258. end;
  259. destructor tcallparanode.destroy;
  260. begin
  261. { When the node is used by callnode then
  262. we don't destroy left, the callnode takes care of it }
  263. if used_by_callnode then
  264. left:=nil;
  265. inherited destroy;
  266. end;
  267. constructor tcallparanode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  268. begin
  269. inherited ppuload(t,ppufile);
  270. ppufile.getsmallset(callparaflags);
  271. end;
  272. procedure tcallparanode.ppuwrite(ppufile:tcompilerppufile);
  273. begin
  274. inherited ppuwrite(ppufile);
  275. ppufile.putsmallset(callparaflags);
  276. end;
  277. function tcallparanode.getcopy : tnode;
  278. var
  279. n : tcallparanode;
  280. begin
  281. n:=tcallparanode(inherited getcopy);
  282. n.callparaflags:=callparaflags;
  283. n.paraitem:=paraitem;
  284. result:=n;
  285. end;
  286. procedure tcallparanode.insertintolist(l : tnodelist);
  287. begin
  288. end;
  289. procedure tcallparanode.get_paratype;
  290. var
  291. old_array_constructor : boolean;
  292. begin
  293. inc(parsing_para_level);
  294. if assigned(right) then
  295. tcallparanode(right).get_paratype;
  296. old_array_constructor:=allow_array_constructor;
  297. allow_array_constructor:=true;
  298. resulttypepass(left);
  299. allow_array_constructor:=old_array_constructor;
  300. if codegenerror then
  301. resulttype:=generrortype
  302. else
  303. resulttype:=left.resulttype;
  304. dec(parsing_para_level);
  305. end;
  306. procedure tcallparanode.insert_typeconv(do_count : boolean);
  307. var
  308. oldtype : ttype;
  309. {$ifdef extdebug}
  310. store_count_ref : boolean;
  311. {$endif def extdebug}
  312. begin
  313. inc(parsing_para_level);
  314. {$ifdef extdebug}
  315. if do_count then
  316. begin
  317. store_count_ref:=count_ref;
  318. count_ref:=true;
  319. end;
  320. {$endif def extdebug}
  321. { Be sure to have the resulttype }
  322. if not assigned(left.resulttype.def) then
  323. resulttypepass(left);
  324. if (left.nodetype<>nothingn) then
  325. begin
  326. { Convert tp procvars, this is needs to be done
  327. here to make the change permanent. in the overload
  328. choosing the changes are only made temporary }
  329. if (left.resulttype.def.deftype=procvardef) and
  330. (paraitem.paratype.def.deftype<>procvardef) then
  331. begin
  332. if maybe_call_procvar(left,true) then
  333. resulttype:=left.resulttype;
  334. end;
  335. { Handle varargs and hidden paras directly, no typeconvs or }
  336. { typechecking needed }
  337. if (nf_varargs_para in flags) then
  338. begin
  339. { convert pascal to C types }
  340. case left.resulttype.def.deftype of
  341. stringdef :
  342. inserttypeconv(left,charpointertype);
  343. floatdef :
  344. inserttypeconv(left,s64floattype);
  345. end;
  346. set_varstate(left,vs_used,true);
  347. resulttype:=left.resulttype;
  348. end
  349. else
  350. if (paraitem.is_hidden) then
  351. begin
  352. set_varstate(left,vs_used,true);
  353. resulttype:=left.resulttype;
  354. end
  355. else
  356. begin
  357. { Do we need arrayconstructor -> set conversion, then insert
  358. it here before the arrayconstructor node breaks the tree
  359. with its conversions of enum->ord }
  360. if (left.nodetype=arrayconstructorn) and
  361. (paraitem.paratype.def.deftype=setdef) then
  362. inserttypeconv(left,paraitem.paratype);
  363. { set some settings needed for arrayconstructor }
  364. if is_array_constructor(left.resulttype.def) then
  365. begin
  366. if is_array_of_const(paraitem.paratype.def) then
  367. begin
  368. { force variant array }
  369. include(left.flags,nf_forcevaria);
  370. end
  371. else
  372. begin
  373. include(left.flags,nf_novariaallowed);
  374. { now that the resultting type is know we can insert the required
  375. typeconvs for the array constructor }
  376. tarrayconstructornode(left).force_type(tarraydef(paraitem.paratype.def).elementtype);
  377. end;
  378. end;
  379. { check if local proc/func is assigned to procvar }
  380. if left.resulttype.def.deftype=procvardef then
  381. test_local_to_procvar(tprocvardef(left.resulttype.def),paraitem.paratype.def);
  382. { test conversions }
  383. if not(is_shortstring(left.resulttype.def) and
  384. is_shortstring(paraitem.paratype.def)) and
  385. (paraitem.paratype.def.deftype<>formaldef) then
  386. begin
  387. { Process open parameters }
  388. if paramanager.push_high_param(paraitem.paratyp,paraitem.paratype.def,aktcallnode.procdefinition.proccalloption) then
  389. begin
  390. { insert type conv but hold the ranges of the array }
  391. oldtype:=left.resulttype;
  392. inserttypeconv(left,paraitem.paratype);
  393. left.resulttype:=oldtype;
  394. end
  395. else
  396. begin
  397. { for ordinals, floats and enums, verify if we might cause
  398. some range-check errors. }
  399. if (paraitem.paratype.def.deftype in [enumdef,orddef,floatdef]) and
  400. (left.resulttype.def.deftype in [enumdef,orddef,floatdef]) and
  401. (left.nodetype in [vecn,loadn,calln]) then
  402. begin
  403. if (left.resulttype.def.size>paraitem.paratype.def.size) then
  404. begin
  405. if (cs_check_range in aktlocalswitches) then
  406. Message(type_w_smaller_possible_range_check)
  407. else
  408. Message(type_h_smaller_possible_range_check);
  409. end;
  410. end;
  411. inserttypeconv(left,paraitem.paratype);
  412. end;
  413. if codegenerror then
  414. begin
  415. dec(parsing_para_level);
  416. exit;
  417. end;
  418. end;
  419. { check var strings }
  420. if (cs_strict_var_strings in aktlocalswitches) and
  421. is_shortstring(left.resulttype.def) and
  422. is_shortstring(paraitem.paratype.def) and
  423. (paraitem.paratyp in [vs_out,vs_var]) and
  424. not(is_open_string(paraitem.paratype.def)) and
  425. not(equal_defs(left.resulttype.def,paraitem.paratype.def)) then
  426. begin
  427. aktfilepos:=left.fileinfo;
  428. CGMessage(type_e_strict_var_string_violation);
  429. end;
  430. { Handle formal parameters separate }
  431. if (paraitem.paratype.def.deftype=formaldef) then
  432. begin
  433. { load procvar if a procedure is passed }
  434. if (m_tp_procvar in aktmodeswitches) and
  435. (left.nodetype=calln) and
  436. (is_void(left.resulttype.def)) then
  437. load_procvar_from_calln(left);
  438. case paraitem.paratyp of
  439. vs_var,
  440. vs_out :
  441. begin
  442. if not valid_for_formal_var(left) then
  443. CGMessagePos(left.fileinfo,parser_e_illegal_parameter_list);
  444. end;
  445. vs_const :
  446. begin
  447. if not valid_for_formal_const(left) then
  448. CGMessagePos(left.fileinfo,parser_e_illegal_parameter_list);
  449. end;
  450. end;
  451. end
  452. else
  453. begin
  454. { check if the argument is allowed }
  455. if (paraitem.paratyp in [vs_out,vs_var]) then
  456. valid_for_var(left);
  457. end;
  458. if paraitem.paratyp in [vs_var,vs_const] then
  459. begin
  460. { Causes problems with const ansistrings if also }
  461. { done for vs_const (JM) }
  462. if paraitem.paratyp = vs_var then
  463. set_unique(left);
  464. make_not_regable(left);
  465. end;
  466. { ansistrings out paramaters doesn't need to be }
  467. { unique, they are finalized }
  468. if paraitem.paratyp=vs_out then
  469. make_not_regable(left);
  470. if do_count then
  471. begin
  472. if paraitem.paratyp in [vs_var,vs_out] then
  473. set_varstate(left,vs_used,false)
  474. else
  475. set_varstate(left,vs_used,true);
  476. end;
  477. { must only be done after typeconv PM }
  478. resulttype:=paraitem.paratype;
  479. end;
  480. end;
  481. { process next node }
  482. if assigned(right) then
  483. tcallparanode(right).insert_typeconv(do_count);
  484. dec(parsing_para_level);
  485. {$ifdef extdebug}
  486. if do_count then
  487. count_ref:=store_count_ref;
  488. {$endif def extdebug}
  489. end;
  490. procedure tcallparanode.det_registers;
  491. begin
  492. if assigned(right) then
  493. begin
  494. tcallparanode(right).det_registers;
  495. registersint:=right.registersint;
  496. registersfpu:=right.registersfpu;
  497. {$ifdef SUPPORT_MMX}
  498. registersmmx:=right.registersmmx;
  499. {$endif}
  500. end;
  501. firstpass(left);
  502. if left.registersint>registersint then
  503. registersint:=left.registersint;
  504. if left.registersfpu>registersfpu then
  505. registersfpu:=left.registersfpu;
  506. {$ifdef SUPPORT_MMX}
  507. if left.registersmmx>registersmmx then
  508. registersmmx:=left.registersmmx;
  509. {$endif SUPPORT_MMX}
  510. end;
  511. procedure tcallparanode.firstcallparan;
  512. begin
  513. if not assigned(left.resulttype.def) then
  514. get_paratype;
  515. det_registers;
  516. end;
  517. function tcallparanode.docompare(p: tnode): boolean;
  518. begin
  519. docompare :=
  520. inherited docompare(p) and
  521. (callparaflags = tcallparanode(p).callparaflags)
  522. ;
  523. end;
  524. procedure tcallparanode.printnodetree(var t:text);
  525. begin
  526. printnodelist(t);
  527. end;
  528. {****************************************************************************
  529. TCALLNODE
  530. ****************************************************************************}
  531. constructor tcallnode.create(l:tnode;v : tprocsym;st : tsymtable; mp : tnode);
  532. begin
  533. inherited create(calln,l,nil);
  534. symtableprocentry:=v;
  535. symtableproc:=st;
  536. include(flags,nf_return_value_used);
  537. methodpointer:=mp;
  538. procdefinition:=nil;
  539. callnodeflags:=[];
  540. _funcretnode:=nil;
  541. inlinecode:=nil;
  542. paralength:=-1;
  543. varargsparas:=nil;
  544. end;
  545. constructor tcallnode.create_def(l:tnode;def:tprocdef;mp:tnode);
  546. begin
  547. inherited create(calln,l,nil);
  548. symtableprocentry:=nil;
  549. symtableproc:=nil;
  550. include(flags,nf_return_value_used);
  551. methodpointer:=mp;
  552. procdefinition:=def;
  553. callnodeflags:=[];
  554. _funcretnode:=nil;
  555. inlinecode:=nil;
  556. paralength:=-1;
  557. varargsparas:=nil;
  558. end;
  559. constructor tcallnode.create_procvar(l,r:tnode);
  560. begin
  561. inherited create(calln,l,r);
  562. symtableprocentry:=nil;
  563. symtableproc:=nil;
  564. include(flags,nf_return_value_used);
  565. methodpointer:=nil;
  566. procdefinition:=nil;
  567. callnodeflags:=[];
  568. _funcretnode:=nil;
  569. inlinecode:=nil;
  570. paralength:=-1;
  571. varargsparas:=nil;
  572. end;
  573. constructor tcallnode.createintern(const name: string; params: tnode);
  574. var
  575. srsym: tsym;
  576. symowner: tsymtable;
  577. begin
  578. if not (cs_compilesystem in aktmoduleswitches) then
  579. begin
  580. srsym := searchsymonlyin(systemunit,name);
  581. symowner := systemunit;
  582. end
  583. else
  584. begin
  585. searchsym(name,srsym,symowner);
  586. if not assigned(srsym) then
  587. searchsym(upper(name),srsym,symowner);
  588. end;
  589. if not assigned(srsym) or
  590. (srsym.typ <> procsym) then
  591. begin
  592. {$ifdef EXTDEBUG}
  593. Comment(V_Error,'unknown compilerproc '+name);
  594. {$endif EXTDEBUG}
  595. internalerror(200107271);
  596. end;
  597. self.create(params,tprocsym(srsym),symowner,nil);
  598. end;
  599. constructor tcallnode.createinternres(const name: string; params: tnode; const res: ttype);
  600. begin
  601. self.createintern(name,params);
  602. restype := res;
  603. include(callnodeflags,cnf_restypeset);
  604. { both the normal and specified resulttype either have to be returned via a }
  605. { parameter or not, but no mixing (JM) }
  606. if paramanager.ret_in_param(restype.def,pocall_compilerproc) xor
  607. paramanager.ret_in_param(symtableprocentry.first_procdef.rettype.def,symtableprocentry.first_procdef.proccalloption) then
  608. internalerror(200108291);
  609. end;
  610. constructor tcallnode.createinternreturn(const name: string; params: tnode; returnnode : tnode);
  611. begin
  612. self.createintern(name,params);
  613. _funcretnode:=returnnode;
  614. if not paramanager.ret_in_param(symtableprocentry.first_procdef.rettype.def,symtableprocentry.first_procdef.proccalloption) then
  615. internalerror(200204247);
  616. end;
  617. procedure tcallnode.setfuncretnode(const returnnode: tnode);
  618. var
  619. para: tcallparanode;
  620. begin
  621. if assigned(_funcretnode) then
  622. _funcretnode.free;
  623. _funcretnode := returnnode;
  624. { if the resulttype pass hasn't occurred yet, that one will do }
  625. { everything }
  626. if assigned(resulttype.def) then
  627. begin
  628. { these are returned as values, but we can optimize their loading }
  629. { as well }
  630. if is_ansistring(resulttype.def) or
  631. is_widestring(resulttype.def) then
  632. exit;
  633. para := tcallparanode(left);
  634. while assigned(para) do
  635. begin
  636. if para.paraitem.is_hidden and
  637. (vo_is_funcret in tvarsym(para.paraitem.parasym).varoptions) then
  638. begin
  639. para.left.free;
  640. para.left := _funcretnode.getcopy;
  641. exit;
  642. end;
  643. para := tcallparanode(para.right);
  644. end;
  645. { no hidden resultpara found, error! }
  646. internalerror(200306087);
  647. end;
  648. end;
  649. destructor tcallnode.destroy;
  650. begin
  651. methodpointer.free;
  652. _funcretnode.free;
  653. inlinecode.free;
  654. if assigned(varargsparas) then
  655. varargsparas.free;
  656. inherited destroy;
  657. end;
  658. constructor tcallnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  659. begin
  660. inherited ppuload(t,ppufile);
  661. ppufile.getderef(symtableprocentryderef);
  662. {$ifdef fpc}
  663. {$warning FIXME: No withsymtable support}
  664. {$endif}
  665. symtableproc:=nil;
  666. ppufile.getderef(procdefinitionderef);
  667. ppufile.getsmallset(callnodeflags);
  668. methodpointer:=ppuloadnode(ppufile);
  669. _funcretnode:=ppuloadnode(ppufile);
  670. inlinecode:=ppuloadnode(ppufile);
  671. end;
  672. procedure tcallnode.ppuwrite(ppufile:tcompilerppufile);
  673. begin
  674. inherited ppuwrite(ppufile);
  675. ppufile.putderef(symtableprocentryderef);
  676. ppufile.putderef(procdefinitionderef);
  677. ppufile.putsmallset(callnodeflags);
  678. ppuwritenode(ppufile,methodpointer);
  679. ppuwritenode(ppufile,_funcretnode);
  680. ppuwritenode(ppufile,inlinecode);
  681. end;
  682. procedure tcallnode.buildderefimpl;
  683. begin
  684. inherited buildderefimpl;
  685. symtableprocentryderef.build(symtableprocentry);
  686. procdefinitionderef.build(procdefinition);
  687. if assigned(methodpointer) then
  688. methodpointer.buildderefimpl;
  689. if assigned(_funcretnode) then
  690. _funcretnode.buildderefimpl;
  691. if assigned(inlinecode) then
  692. inlinecode.buildderefimpl;
  693. end;
  694. procedure tcallnode.derefimpl;
  695. var
  696. pt : tcallparanode;
  697. currpara : tparaitem;
  698. begin
  699. inherited derefimpl;
  700. symtableprocentry:=tprocsym(symtableprocentryderef.resolve);
  701. symtableproc:=symtableprocentry.owner;
  702. procdefinition:=tprocdef(procdefinitionderef.resolve);
  703. if assigned(methodpointer) then
  704. methodpointer.derefimpl;
  705. if assigned(_funcretnode) then
  706. _funcretnode.derefimpl;
  707. if assigned(inlinecode) then
  708. inlinecode.derefimpl;
  709. { Connect paraitems }
  710. pt:=tcallparanode(left);
  711. while assigned(pt) and
  712. (nf_varargs_para in pt.flags) do
  713. pt:=tcallparanode(pt.right);
  714. currpara:=tparaitem(procdefinition.Para.last);
  715. while assigned(currpara) do
  716. begin
  717. if not assigned(pt) then
  718. internalerror(200311077);
  719. pt.paraitem:=currpara;
  720. pt:=tcallparanode(pt.right);
  721. currpara:=tparaitem(currpara.previous);
  722. end;
  723. if assigned(currpara) or assigned(pt) then
  724. internalerror(200311078);
  725. end;
  726. function tcallnode.getcopy : tnode;
  727. var
  728. n : tcallnode;
  729. hp : tparaitem;
  730. begin
  731. n:=tcallnode(inherited getcopy);
  732. n.symtableprocentry:=symtableprocentry;
  733. n.symtableproc:=symtableproc;
  734. n.procdefinition:=procdefinition;
  735. n.restype := restype;
  736. n.callnodeflags := callnodeflags;
  737. if assigned(methodpointer) then
  738. n.methodpointer:=methodpointer.getcopy
  739. else
  740. n.methodpointer:=nil;
  741. if assigned(_funcretnode) then
  742. n._funcretnode:=_funcretnode.getcopy
  743. else
  744. n._funcretnode:=nil;
  745. if assigned(inlinecode) then
  746. n.inlinecode:=inlinecode.getcopy
  747. else
  748. n.inlinecode:=nil;
  749. if assigned(varargsparas) then
  750. begin
  751. n.varargsparas:=tvarargspara.create;
  752. hp:=tparaitem(varargsparas.first);
  753. while assigned(hp) do
  754. begin
  755. n.varargsparas.concat(hp.getcopy);
  756. hp:=tparaitem(hp.next);
  757. end;
  758. end
  759. else
  760. n.varargsparas:=nil;
  761. result:=n;
  762. end;
  763. procedure tcallnode.insertintolist(l : tnodelist);
  764. begin
  765. end;
  766. procedure tcallnode.convert_carg_array_of_const;
  767. var
  768. hp : tarrayconstructornode;
  769. oldleft : tcallparanode;
  770. begin
  771. oldleft:=tcallparanode(left);
  772. if oldleft.left.nodetype<>arrayconstructorn then
  773. begin
  774. CGMessage1(type_e_wrong_type_in_array_constructor,oldleft.left.resulttype.def.typename);
  775. exit;
  776. end;
  777. { Get arrayconstructor node and insert typeconvs }
  778. hp:=tarrayconstructornode(oldleft.left);
  779. hp.insert_typeconvs;
  780. { Add c args parameters }
  781. { It could be an empty set }
  782. if assigned(hp) and
  783. assigned(hp.left) then
  784. begin
  785. while assigned(hp) do
  786. begin
  787. left:=ccallparanode.create(hp.left,left);
  788. { set callparanode resulttype and flags }
  789. left.resulttype:=hp.left.resulttype;
  790. include(left.flags,nf_varargs_para);
  791. hp.left:=nil;
  792. hp:=tarrayconstructornode(hp.right);
  793. end;
  794. end;
  795. { Remove value of old array of const parameter, but keep it
  796. in the list because it is required for bind_paraitem.
  797. Generate a nothign to keep callparanoed.left valid }
  798. oldleft.left.free;
  799. oldleft.left:=cnothingnode.create;
  800. end;
  801. procedure tcallnode.verifyabstract(p : tnamedindexitem;arg:pointer);
  802. var
  803. hp : tprocdef;
  804. j: integer;
  805. begin
  806. if (tsym(p).typ=procsym) then
  807. begin
  808. for j:=1 to tprocsym(p).procdef_count do
  809. begin
  810. { index starts at 1 }
  811. hp:=tprocsym(p).procdef[j];
  812. { If this is an abstract method insert into the list }
  813. if (po_abstractmethod in hp.procoptions) then
  814. AbstractMethodsList.Insert(hp.procsym.name)
  815. else
  816. { If this symbol is already in the list, and it is
  817. an overriding method or dynamic, then remove it from the list
  818. }
  819. begin
  820. { symbol was found }
  821. if AbstractMethodsList.Find(hp.procsym.name) <> nil then
  822. begin
  823. if po_overridingmethod in hp.procoptions then
  824. AbstractMethodsList.Remove(hp.procsym.name);
  825. end;
  826. end;
  827. end;
  828. end;
  829. end;
  830. procedure tcallnode.verifyabstractcalls;
  831. var
  832. objectdf : tobjectdef;
  833. parents : tlinkedlist;
  834. objectinfo : tobjectinfoitem;
  835. stritem : tstringlistitem;
  836. begin
  837. objectdf := nil;
  838. { verify if trying to create an instance of a class which contains
  839. non-implemented abstract methods }
  840. { first verify this class type, no class than exit }
  841. { also, this checking can only be done if the constructor is directly
  842. called, indirect constructor calls cannot be checked.
  843. }
  844. if assigned(methodpointer) then
  845. begin
  846. if (methodpointer.resulttype.def.deftype = objectdef) then
  847. objectdf:=tobjectdef(methodpointer.resulttype.def)
  848. else
  849. if (methodpointer.resulttype.def.deftype = classrefdef) and
  850. (tclassrefdef(methodpointer.resulttype.def).pointertype.def.deftype = objectdef) and
  851. (methodpointer.nodetype in [typen,loadvmtaddrn]) then
  852. objectdf:=tobjectdef(tclassrefdef(methodpointer.resulttype.def).pointertype.def);
  853. end;
  854. if not assigned(objectdf) then
  855. exit;
  856. parents := tlinkedlist.create;
  857. AbstractMethodsList := tstringlist.create;
  858. { insert all parents in this class : the first item in the
  859. list will be the base parent of the class .
  860. }
  861. while assigned(objectdf) do
  862. begin
  863. objectinfo:=tobjectinfoitem.create(objectdf);
  864. parents.insert(objectinfo);
  865. objectdf := objectdf.childof;
  866. end;
  867. { now all parents are in the correct order
  868. insert all abstract methods in the list, and remove
  869. those which are overriden by parent classes.
  870. }
  871. objectinfo:=tobjectinfoitem(parents.first);
  872. while assigned(objectinfo) do
  873. begin
  874. objectdf := objectinfo.objinfo;
  875. if assigned(objectdf.symtable) then
  876. objectdf.symtable.foreach({$ifdef FPCPROCVAR}@{$endif}verifyabstract,nil);
  877. objectinfo:=tobjectinfoitem(objectinfo.next);
  878. end;
  879. if assigned(parents) then
  880. parents.free;
  881. { Finally give out a warning for each abstract method still in the list }
  882. stritem := tstringlistitem(AbstractMethodsList.first);
  883. if assigned(stritem) then
  884. Message1(type_w_instance_with_abstract,objectdf.objname^);
  885. while assigned(stritem) do
  886. begin
  887. if assigned(stritem.fpstr) then
  888. Message1(sym_h_param_list,stritem.str);
  889. stritem := tstringlistitem(stritem.next);
  890. end;
  891. if assigned(AbstractMethodsList) then
  892. AbstractMethodsList.Free;
  893. end;
  894. function tcallnode.gen_self_tree_methodpointer:tnode;
  895. var
  896. hsym : tvarsym;
  897. begin
  898. { find self field in methodpointer record }
  899. hsym:=tvarsym(trecorddef(methodpointertype.def).symtable.search('self'));
  900. if not assigned(hsym) then
  901. internalerror(200305251);
  902. { Load tmehodpointer(right).self }
  903. result:=csubscriptnode.create(
  904. hsym,
  905. ctypeconvnode.create_explicit(right.getcopy,methodpointertype));
  906. end;
  907. function tcallnode.gen_self_tree:tnode;
  908. var
  909. selftree : tnode;
  910. begin
  911. selftree:=nil;
  912. { inherited }
  913. if (nf_inherited in flags) then
  914. selftree:=load_self_node
  915. else
  916. { constructors }
  917. if (procdefinition.proctypeoption=potype_constructor) then
  918. begin
  919. { push 0 as self when allocation is needed }
  920. if (methodpointer.resulttype.def.deftype=classrefdef) or
  921. (nf_new_call in flags) then
  922. selftree:=cpointerconstnode.create(0,voidpointertype)
  923. else
  924. begin
  925. if methodpointer.nodetype=typen then
  926. selftree:=load_self_node
  927. else
  928. selftree:=methodpointer.getcopy;
  929. end;
  930. end
  931. else
  932. { Calling a static/class method }
  933. if (po_classmethod in procdefinition.procoptions) or
  934. (po_staticmethod in procdefinition.procoptions) then
  935. begin
  936. if (procdefinition.deftype<>procdef) then
  937. internalerror(200305062);
  938. if (oo_has_vmt in tprocdef(procdefinition)._class.objectoptions) then
  939. begin
  940. { we only need the vmt, loading self is not required and there is no
  941. need to check for typen, because that will always get the
  942. loadvmtaddrnode added }
  943. selftree:=methodpointer.getcopy;
  944. if methodpointer.resulttype.def.deftype<>classrefdef then
  945. selftree:=cloadvmtaddrnode.create(selftree);
  946. end
  947. else
  948. selftree:=cpointerconstnode.create(0,voidpointertype);
  949. end
  950. else
  951. begin
  952. if methodpointer.nodetype=typen then
  953. selftree:=load_self_node
  954. else
  955. selftree:=methodpointer.getcopy;
  956. end;
  957. result:=selftree;
  958. end;
  959. function tcallnode.gen_vmt_tree:tnode;
  960. var
  961. vmttree : tnode;
  962. begin
  963. vmttree:=nil;
  964. if not(procdefinition.proctypeoption in [potype_constructor,potype_destructor]) then
  965. internalerror(200305051);
  966. { inherited call, no create/destroy }
  967. if (nf_inherited in flags) then
  968. vmttree:=cpointerconstnode.create(0,voidpointertype)
  969. else
  970. { do not create/destroy when called from member function
  971. without specifying self explicit }
  972. if (nf_member_call in flags) then
  973. begin
  974. if (methodpointer.resulttype.def.deftype=classrefdef) and
  975. (procdefinition.proctypeoption=potype_constructor) then
  976. vmttree:=methodpointer.getcopy
  977. else
  978. vmttree:=cpointerconstnode.create(0,voidpointertype);
  979. end
  980. else
  981. { constructor with extended syntax called from new }
  982. if (nf_new_call in flags) then
  983. vmttree:=cloadvmtaddrnode.create(ctypenode.create(methodpointer.resulttype))
  984. else
  985. { destructor with extended syntax called from dispose }
  986. if (nf_dispose_call in flags) then
  987. vmttree:=cloadvmtaddrnode.create(methodpointer.getcopy)
  988. else
  989. if (methodpointer.resulttype.def.deftype=classrefdef) then
  990. begin
  991. { constructor call via classreference => allocate memory }
  992. if (procdefinition.proctypeoption=potype_constructor) and
  993. is_class(tclassrefdef(methodpointer.resulttype.def).pointertype.def) then
  994. begin
  995. vmttree:=methodpointer.getcopy;
  996. { Only a typenode can be passed when it is called with <class of xx>.create }
  997. if vmttree.nodetype=typen then
  998. vmttree:=cloadvmtaddrnode.create(vmttree);
  999. end
  1000. else
  1001. vmttree:=cpointerconstnode.create(0,voidpointertype);
  1002. end
  1003. else
  1004. { class }
  1005. if is_class(methodpointer.resulttype.def) then
  1006. begin
  1007. { destructor: release instance, flag(vmt)=1
  1008. constructor: direct call, do nothing, leave vmt=0 }
  1009. if (procdefinition.proctypeoption=potype_destructor) then
  1010. vmttree:=cpointerconstnode.create(1,voidpointertype)
  1011. else
  1012. vmttree:=cpointerconstnode.create(0,voidpointertype);
  1013. end
  1014. else
  1015. { object }
  1016. begin
  1017. { destructor: direct call, no dispose, vmt=0
  1018. constructor: initialize object, load vmt }
  1019. if (procdefinition.proctypeoption=potype_constructor) then
  1020. { old styled inherited call? }
  1021. if (methodpointer.nodetype=typen) then
  1022. vmttree:=cpointerconstnode.create(0,voidpointertype)
  1023. else
  1024. vmttree:=cloadvmtaddrnode.create(ctypenode.create(methodpointer.resulttype))
  1025. else
  1026. vmttree:=cpointerconstnode.create(0,voidpointertype);
  1027. end;
  1028. result:=vmttree;
  1029. end;
  1030. procedure tcallnode.bind_paraitem;
  1031. var
  1032. i : integer;
  1033. pt : tcallparanode;
  1034. oldppt : ^tcallparanode;
  1035. varargspara,
  1036. currpara : tparaitem;
  1037. used_by_callnode : boolean;
  1038. hiddentree : tnode;
  1039. newstatement : tstatementnode;
  1040. temp : ttempcreatenode;
  1041. begin
  1042. pt:=tcallparanode(left);
  1043. oldppt:=@left;
  1044. { flag all callparanodes that belong to the varargs }
  1045. i:=paralength;
  1046. while (i>procdefinition.maxparacount) do
  1047. begin
  1048. include(pt.flags,nf_varargs_para);
  1049. oldppt:[email protected];
  1050. pt:=tcallparanode(pt.right);
  1051. dec(i);
  1052. end;
  1053. { skip varargs that are inserted by array of const }
  1054. while assigned(pt) and
  1055. (nf_varargs_para in pt.flags) do
  1056. pt:=tcallparanode(pt.right);
  1057. { process normal parameters and insert hidden parameters }
  1058. currpara:=tparaitem(procdefinition.Para.last);
  1059. while assigned(currpara) do
  1060. begin
  1061. if currpara.is_hidden then
  1062. begin
  1063. { generate hidden tree }
  1064. used_by_callnode:=false;
  1065. hiddentree:=nil;
  1066. if (vo_is_funcret in tvarsym(currpara.parasym).varoptions) then
  1067. begin
  1068. { Generate funcretnode if not specified }
  1069. if assigned(funcretnode) then
  1070. begin
  1071. hiddentree:=funcretnode.getcopy;
  1072. end
  1073. else
  1074. begin
  1075. hiddentree:=internalstatements(newstatement);
  1076. { need to use resulttype instead of procdefinition.rettype,
  1077. because they can be different }
  1078. temp:=ctempcreatenode.create(resulttype,resulttype.def.size,tt_persistent);
  1079. addstatement(newstatement,temp);
  1080. addstatement(newstatement,ctempdeletenode.create_normal_temp(temp));
  1081. addstatement(newstatement,ctemprefnode.create(temp));
  1082. end;
  1083. end
  1084. else
  1085. if vo_is_high_value in tvarsym(currpara.parasym).varoptions then
  1086. begin
  1087. if not assigned(pt) then
  1088. internalerror(200304082);
  1089. { we need the information of the next parameter }
  1090. hiddentree:=gen_high_tree(pt.left,is_open_string(tparaitem(currpara.previous).paratype.def));
  1091. end
  1092. else
  1093. if vo_is_self in tvarsym(currpara.parasym).varoptions then
  1094. begin
  1095. if assigned(right) then
  1096. hiddentree:=gen_self_tree_methodpointer
  1097. else
  1098. hiddentree:=gen_self_tree;
  1099. end
  1100. else
  1101. if vo_is_vmt in tvarsym(currpara.parasym).varoptions then
  1102. begin
  1103. hiddentree:=gen_vmt_tree;
  1104. end
  1105. else
  1106. if vo_is_parentfp in tvarsym(currpara.parasym).varoptions then
  1107. begin
  1108. if not(assigned(procdefinition.owner.defowner)) then
  1109. internalerror(200309287);
  1110. hiddentree:=cloadparentfpnode.create(tprocdef(procdefinition.owner.defowner));
  1111. end;
  1112. { add the hidden parameter }
  1113. if not assigned(hiddentree) then
  1114. internalerror(200304073);
  1115. { Already insert para and let the previous node point to
  1116. this new node }
  1117. pt:=ccallparanode.create(hiddentree,oldppt^);
  1118. pt.used_by_callnode:=used_by_callnode;
  1119. oldppt^:=pt;
  1120. end;
  1121. if not assigned(pt) then
  1122. internalerror(200310052);
  1123. pt.paraitem:=currpara;
  1124. oldppt:[email protected];
  1125. pt:=tcallparanode(pt.right);
  1126. currpara:=tparaitem(currpara.previous)
  1127. end;
  1128. { Create paraitems for varargs }
  1129. pt:=tcallparanode(left);
  1130. while assigned(pt) do
  1131. begin
  1132. if nf_varargs_para in pt.flags then
  1133. begin
  1134. if not assigned(varargsparas) then
  1135. varargsparas:=tvarargspara.create;
  1136. varargspara:=tparaitem.create;
  1137. varargspara.paratyp:=vs_value;
  1138. varargspara.paratype:=pt.resulttype;
  1139. { varargspara is left-right, use insert
  1140. instead of concat }
  1141. varargsparas.insert(varargspara);
  1142. pt.paraitem:=varargspara;
  1143. end;
  1144. pt:=tcallparanode(pt.right);
  1145. end;
  1146. end;
  1147. function tcallnode.det_resulttype:tnode;
  1148. var
  1149. candidates : tcallcandidates;
  1150. oldcallnode : tcallnode;
  1151. hpt : tnode;
  1152. pt : tcallparanode;
  1153. lastpara : longint;
  1154. currpara : tparaitem;
  1155. cand_cnt : integer;
  1156. i : longint;
  1157. method_must_be_valid,
  1158. is_const : boolean;
  1159. label
  1160. errorexit;
  1161. begin
  1162. result:=nil;
  1163. candidates:=nil;
  1164. oldcallnode:=aktcallnode;
  1165. aktcallnode:=nil;
  1166. { determine length of parameter list }
  1167. pt:=tcallparanode(left);
  1168. paralength:=0;
  1169. while assigned(pt) do
  1170. begin
  1171. inc(paralength);
  1172. pt:=tcallparanode(pt.right);
  1173. end;
  1174. { determine the type of the parameters }
  1175. if assigned(left) then
  1176. begin
  1177. tcallparanode(left).get_paratype;
  1178. if codegenerror then
  1179. goto errorexit;
  1180. end;
  1181. { procedure variable ? }
  1182. if assigned(right) then
  1183. begin
  1184. set_varstate(right,vs_used,true);
  1185. resulttypepass(right);
  1186. if codegenerror then
  1187. exit;
  1188. procdefinition:=tabstractprocdef(right.resulttype.def);
  1189. { Compare parameters from right to left }
  1190. currpara:=tparaitem(procdefinition.Para.last);
  1191. { Skip default parameters }
  1192. if not(po_varargs in procdefinition.procoptions) then
  1193. begin
  1194. { ignore hidden parameters }
  1195. while assigned(currpara) and (currpara.is_hidden) do
  1196. currpara:=tparaitem(currpara.previous);
  1197. for i:=1 to procdefinition.maxparacount-paralength do
  1198. begin
  1199. if not assigned(currpara) then
  1200. internalerror(200402261);
  1201. if not assigned(currpara.defaultvalue) then
  1202. begin
  1203. CGMessage(parser_e_wrong_parameter_size);
  1204. goto errorexit;
  1205. end;
  1206. currpara:=tparaitem(currpara.previous);
  1207. end;
  1208. end;
  1209. while assigned(currpara) and (currpara.is_hidden) do
  1210. currpara:=tparaitem(currpara.previous);
  1211. pt:=tcallparanode(left);
  1212. lastpara:=paralength;
  1213. while assigned(currpara) and assigned(pt) do
  1214. begin
  1215. { only goto next para if we're out of the varargs }
  1216. if not(po_varargs in procdefinition.procoptions) or
  1217. (lastpara<=procdefinition.maxparacount) then
  1218. begin
  1219. repeat
  1220. currpara:=tparaitem(currpara.previous);
  1221. until (not assigned(currpara)) or (not currpara.is_hidden);
  1222. end;
  1223. pt:=tcallparanode(pt.right);
  1224. dec(lastpara);
  1225. end;
  1226. if assigned(pt) or
  1227. (assigned(currpara) and
  1228. not assigned(currpara.defaultvalue)) then
  1229. begin
  1230. if assigned(pt) then
  1231. aktfilepos:=pt.fileinfo;
  1232. CGMessage(parser_e_wrong_parameter_size);
  1233. goto errorexit;
  1234. end;
  1235. end
  1236. else
  1237. { not a procedure variable }
  1238. begin
  1239. { do we know the procedure to call ? }
  1240. if not(assigned(procdefinition)) then
  1241. begin
  1242. candidates:=tcallcandidates.create(symtableprocentry,symtableproc,left,(nf_isproperty in flags));
  1243. { no procedures found? then there is something wrong
  1244. with the parameter size or the procedures are
  1245. not accessible }
  1246. if candidates.count=0 then
  1247. begin
  1248. { when it's an auto inherited call and there
  1249. is no procedure found, but the procedures
  1250. were defined with overload directive and at
  1251. least two procedures are defined then we ignore
  1252. this inherited by inserting a nothingn. Only
  1253. do this ugly hack in Delphi mode as it looks more
  1254. like a bug. It's also not documented }
  1255. if (m_delphi in aktmodeswitches) and
  1256. (nf_anon_inherited in flags) and
  1257. (symtableprocentry.owner.symtabletype=objectsymtable) and
  1258. (po_overload in symtableprocentry.first_procdef.procoptions) and
  1259. (symtableprocentry.procdef_count>=2) then
  1260. result:=cnothingnode.create
  1261. else
  1262. begin
  1263. { in tp mode we can try to convert to procvar if
  1264. there are no parameters specified. Only try it
  1265. when there is only one proc definition, else the
  1266. loadnode will give a strange error }
  1267. if not(assigned(left)) and
  1268. not(nf_inherited in flags) and
  1269. (m_tp_procvar in aktmodeswitches) and
  1270. (symtableprocentry.procdef_count=1) then
  1271. begin
  1272. hpt:=cloadnode.create(tprocsym(symtableprocentry),symtableproc);
  1273. if assigned(methodpointer) then
  1274. tloadnode(hpt).set_mp(methodpointer.getcopy);
  1275. resulttypepass(hpt);
  1276. result:=hpt;
  1277. end
  1278. else
  1279. begin
  1280. if assigned(left) then
  1281. aktfilepos:=left.fileinfo;
  1282. if paravisible then
  1283. begin
  1284. CGMessage(parser_e_wrong_parameter_size);
  1285. symtableprocentry.write_parameter_lists(nil);
  1286. end
  1287. else
  1288. CGMessage(parser_e_cant_access_private_member);
  1289. end;
  1290. end;
  1291. goto errorexit;
  1292. end;
  1293. { Retrieve information about the candidates }
  1294. candidates.get_information;
  1295. {$ifdef EXTDEBUG}
  1296. { Display info when multiple candidates are found }
  1297. if candidates.count>1 then
  1298. candidates.dump_info(V_Debug);
  1299. {$endif EXTDEBUG}
  1300. { Choose the best candidate and count the number of
  1301. candidates left }
  1302. cand_cnt:=candidates.choose_best(procdefinition);
  1303. { All parameters are checked, check if there are any
  1304. procedures left }
  1305. if cand_cnt>0 then
  1306. begin
  1307. { Multiple candidates left? }
  1308. if cand_cnt>1 then
  1309. begin
  1310. CGMessage(cg_e_cant_choose_overload_function);
  1311. {$ifdef EXTDEBUG}
  1312. candidates.dump_info(V_Hint);
  1313. {$else EXTDEBUG}
  1314. candidates.list(false);
  1315. {$endif EXTDEBUG}
  1316. { we'll just use the first candidate to make the
  1317. call }
  1318. end;
  1319. { assign procdefinition }
  1320. if symtableproc=nil then
  1321. symtableproc:=procdefinition.owner;
  1322. { update browser information }
  1323. if make_ref then
  1324. begin
  1325. tprocdef(procdefinition).lastref:=tref.create(tprocdef(procdefinition).lastref,@fileinfo);
  1326. inc(tprocdef(procdefinition).refcount);
  1327. if tprocdef(procdefinition).defref=nil then
  1328. tprocdef(procdefinition).defref:=tprocdef(procdefinition).lastref;
  1329. end;
  1330. end
  1331. else
  1332. begin
  1333. { No candidates left, this must be a type error,
  1334. because wrong size is already checked. procdefinition
  1335. is filled with the first (random) definition that is
  1336. found. We use this definition to display a nice error
  1337. message that the wrong type is passed }
  1338. candidates.find_wrong_para;
  1339. candidates.list(true);
  1340. {$ifdef EXTDEBUG}
  1341. candidates.dump_info(V_Hint);
  1342. {$endif EXTDEBUG}
  1343. { We can not proceed, release all procs and exit }
  1344. candidates.free;
  1345. goto errorexit;
  1346. end;
  1347. candidates.free;
  1348. end; { end of procedure to call determination }
  1349. end;
  1350. { add needed default parameters }
  1351. if assigned(procdefinition) and
  1352. (paralength<procdefinition.maxparacount) then
  1353. begin
  1354. currpara:=tparaitem(procdefinition.Para.first);
  1355. i:=0;
  1356. while (i<paralength) do
  1357. begin
  1358. if not assigned(currpara) then
  1359. internalerror(200306181);
  1360. if not currpara.is_hidden then
  1361. inc(i);
  1362. currpara:=tparaitem(currpara.next);
  1363. end;
  1364. while assigned(currpara) and currpara.is_hidden do
  1365. currpara:=tparaitem(currpara.next);
  1366. while assigned(currpara) do
  1367. begin
  1368. if not assigned(currpara.defaultvalue) then
  1369. internalerror(200212142);
  1370. left:=ccallparanode.create(genconstsymtree(tconstsym(currpara.defaultvalue)),left);
  1371. { Ignore vs_hidden parameters }
  1372. repeat
  1373. currpara:=tparaitem(currpara.next);
  1374. until (not assigned(currpara)) or (not currpara.is_hidden);
  1375. end;
  1376. end;
  1377. { handle predefined procedures }
  1378. is_const:=(po_internconst in procdefinition.procoptions) and
  1379. ((block_type in [bt_const,bt_type]) or
  1380. (assigned(left) and (tcallparanode(left).left.nodetype in [realconstn,ordconstn])));
  1381. if (procdefinition.proccalloption=pocall_internproc) or is_const then
  1382. begin
  1383. if assigned(left) then
  1384. begin
  1385. { ptr and settextbuf needs two args }
  1386. if assigned(tcallparanode(left).right) then
  1387. begin
  1388. hpt:=geninlinenode(tprocdef(procdefinition).extnumber,is_const,left);
  1389. left:=nil;
  1390. end
  1391. else
  1392. begin
  1393. hpt:=geninlinenode(tprocdef(procdefinition).extnumber,is_const,tcallparanode(left).left);
  1394. tcallparanode(left).left:=nil;
  1395. end;
  1396. end
  1397. else
  1398. hpt:=geninlinenode(tprocdef(procdefinition).extnumber,is_const,nil);
  1399. result:=hpt;
  1400. goto errorexit;
  1401. end;
  1402. { ensure that the result type is set }
  1403. if not(cnf_restypeset in callnodeflags) then
  1404. begin
  1405. { constructors return their current class type, not the type where the
  1406. constructor is declared, this can be different because of inheritance }
  1407. if (procdefinition.proctypeoption=potype_constructor) and
  1408. assigned(methodpointer) and
  1409. assigned(methodpointer.resulttype.def) and
  1410. (methodpointer.resulttype.def.deftype=classrefdef) then
  1411. resulttype:=tclassrefdef(methodpointer.resulttype.def).pointertype
  1412. else
  1413. resulttype:=procdefinition.rettype;
  1414. end
  1415. else
  1416. resulttype:=restype;
  1417. if resulttype.def.needs_inittable then
  1418. include(current_procinfo.flags,pi_needs_implicit_finally);
  1419. if assigned(methodpointer) then
  1420. begin
  1421. resulttypepass(methodpointer);
  1422. { direct call to inherited abstract method, then we
  1423. can already give a error in the compiler instead
  1424. of a runtime error }
  1425. if (nf_inherited in flags) and
  1426. (po_abstractmethod in procdefinition.procoptions) then
  1427. CGMessage(cg_e_cant_call_abstract_method);
  1428. { if an inherited con- or destructor should be }
  1429. { called in a con- or destructor then a warning }
  1430. { will be made }
  1431. { con- and destructors need a pointer to the vmt }
  1432. if (nf_inherited in flags) and
  1433. (procdefinition.proctypeoption in [potype_constructor,potype_destructor]) and
  1434. is_object(methodpointer.resulttype.def) and
  1435. not(current_procinfo.procdef.proctypeoption in [potype_constructor,potype_destructor]) then
  1436. CGMessage(cg_w_member_cd_call_from_method);
  1437. if methodpointer.nodetype<>typen then
  1438. begin
  1439. hpt:=methodpointer;
  1440. while assigned(hpt) and (hpt.nodetype in [subscriptn,vecn]) do
  1441. hpt:=tunarynode(hpt).left;
  1442. if (procdefinition.proctypeoption=potype_constructor) and
  1443. assigned(symtableproc) and
  1444. (symtableproc.symtabletype=withsymtable) and
  1445. (tnode(twithsymtable(symtableproc).withrefnode).nodetype=temprefn) then
  1446. CGmessage(cg_e_cannot_call_cons_dest_inside_with);
  1447. { R.Init then R will be initialized by the constructor,
  1448. Also allow it for simple loads }
  1449. if (procdefinition.proctypeoption=potype_constructor) or
  1450. ((hpt.nodetype=loadn) and
  1451. (
  1452. (methodpointer.resulttype.def.deftype=classrefdef) or
  1453. (
  1454. (methodpointer.resulttype.def.deftype=objectdef) and
  1455. not(oo_has_virtual in tobjectdef(methodpointer.resulttype.def).objectoptions)
  1456. )
  1457. )
  1458. ) then
  1459. method_must_be_valid:=false
  1460. else
  1461. method_must_be_valid:=true;
  1462. set_varstate(methodpointer,vs_used,method_must_be_valid);
  1463. { The object is already used if it is called once }
  1464. if (hpt.nodetype=loadn) and
  1465. (tloadnode(hpt).symtableentry.typ=varsym) then
  1466. tvarsym(tloadnode(hpt).symtableentry).varstate:=vs_used;
  1467. end;
  1468. { if we are calling the constructor check for abstract
  1469. methods. Ignore inherited and member calls, because the
  1470. class is then already created }
  1471. if (procdefinition.proctypeoption=potype_constructor) and
  1472. not(nf_inherited in flags) and
  1473. not(nf_member_call in flags) then
  1474. verifyabstractcalls;
  1475. end
  1476. else
  1477. begin
  1478. { When this is method the methodpointer must be available }
  1479. if (right=nil) and
  1480. (procdefinition.owner.symtabletype=objectsymtable) then
  1481. internalerror(200305061);
  1482. end;
  1483. { Change loading of array of const to varargs }
  1484. if assigned(left) and
  1485. is_array_of_const(tparaitem(procdefinition.para.last).paratype.def) and
  1486. (procdefinition.proccalloption in [pocall_cppdecl,pocall_cdecl]) then
  1487. convert_carg_array_of_const;
  1488. { bind paraitems to the callparanodes and insert hidden parameters }
  1489. aktcallnode:=self;
  1490. bind_paraitem;
  1491. { methodpointer is only needed for virtual calls, and
  1492. it should then be loaded with the VMT }
  1493. if (po_virtualmethod in procdefinition.procoptions) and
  1494. not(assigned(methodpointer) and
  1495. (methodpointer.nodetype=typen)) then
  1496. begin
  1497. if not assigned(methodpointer) then
  1498. internalerror(200305063);
  1499. if (methodpointer.resulttype.def.deftype<>classrefdef) then
  1500. begin
  1501. methodpointer:=cloadvmtaddrnode.create(methodpointer);
  1502. resulttypepass(methodpointer);
  1503. end;
  1504. end
  1505. else
  1506. begin
  1507. { not needed anymore }
  1508. methodpointer.free;
  1509. methodpointer:=nil;
  1510. end;
  1511. { insert type conversions for parameters }
  1512. if assigned(left) then
  1513. tcallparanode(left).insert_typeconv(true);
  1514. errorexit:
  1515. aktcallnode:=oldcallnode;
  1516. end;
  1517. procedure tcallnode.order_parameters;
  1518. var
  1519. hp,hpcurr,hpnext,hpfirst,hpprev : tcallparanode;
  1520. currloc : tcgloc;
  1521. begin
  1522. hpfirst:=nil;
  1523. hpcurr:=tcallparanode(left);
  1524. while assigned(hpcurr) do
  1525. begin
  1526. { pull out }
  1527. hpnext:=tcallparanode(hpcurr.right);
  1528. { pull in at the correct place.
  1529. Used order:
  1530. 1. LOC_REFERENCE with smallest offset (x86 only)
  1531. 2. LOC_REFERENCE with most registers
  1532. 3. LOC_REGISTER with most registers }
  1533. currloc:=hpcurr.paraitem.paraloc[callerside].loc;
  1534. hpprev:=nil;
  1535. hp:=hpfirst;
  1536. while assigned(hp) do
  1537. begin
  1538. case currloc of
  1539. LOC_REFERENCE :
  1540. begin
  1541. case hp.paraitem.paraloc[callerside].loc of
  1542. LOC_REFERENCE :
  1543. begin
  1544. { Offset is calculated like:
  1545. sub esp,12
  1546. mov [esp+8],para3
  1547. mov [esp+4],para2
  1548. mov [esp],para1
  1549. call function
  1550. That means the for pushes the para with the
  1551. highest offset (see para3) needs to be pushed first
  1552. }
  1553. if (hpcurr.registersint>hp.registersint)
  1554. {$ifdef x86}
  1555. or (hpcurr.paraitem.paraloc[callerside].reference.offset>hp.paraitem.paraloc[callerside].reference.offset)
  1556. {$endif x86}
  1557. then
  1558. break;
  1559. end;
  1560. LOC_REGISTER,
  1561. LOC_FPUREGISTER :
  1562. break;
  1563. end;
  1564. end;
  1565. LOC_FPUREGISTER,
  1566. LOC_REGISTER :
  1567. begin
  1568. if (hp.paraitem.paraloc[callerside].loc=currloc) and
  1569. (hpcurr.registersint>hp.registersint) then
  1570. break;
  1571. end;
  1572. end;
  1573. hpprev:=hp;
  1574. hp:=tcallparanode(hp.right);
  1575. end;
  1576. hpcurr.right:=hp;
  1577. if assigned(hpprev) then
  1578. hpprev.right:=hpcurr
  1579. else
  1580. hpfirst:=hpcurr;
  1581. { next }
  1582. hpcurr:=hpnext;
  1583. end;
  1584. left:=hpfirst;
  1585. end;
  1586. function tcallnode.pass_1 : tnode;
  1587. {$ifdef m68k}
  1588. var
  1589. regi : tregister;
  1590. {$endif}
  1591. label
  1592. errorexit;
  1593. begin
  1594. result:=nil;
  1595. { calculate the parameter info for the procdef }
  1596. if not procdefinition.has_paraloc_info then
  1597. begin
  1598. procdefinition.requiredargarea:=paramanager.create_paraloc_info(procdefinition,callerside);
  1599. procdefinition.has_paraloc_info:=true;
  1600. end;
  1601. current_procinfo.maxpushedparasize:=max(current_procinfo.maxpushedparasize,procdefinition.requiredargarea);
  1602. { calculate the parameter info for varargs }
  1603. if assigned(varargsparas) then
  1604. current_procinfo.maxpushedparasize:=max(current_procinfo.maxpushedparasize,
  1605. paramanager.create_varargs_paraloc_info(procdefinition,varargsparas));
  1606. { work trough all parameters to get the register requirements }
  1607. if assigned(left) then
  1608. tcallparanode(left).det_registers;
  1609. { order parameters }
  1610. order_parameters;
  1611. { function result node }
  1612. if assigned(_funcretnode) then
  1613. firstpass(_funcretnode);
  1614. { procedure variable ? }
  1615. if assigned(right) then
  1616. begin
  1617. firstpass(right);
  1618. { procedure does a call }
  1619. if not (block_type in [bt_const,bt_type]) then
  1620. include(current_procinfo.flags,pi_do_call);
  1621. end
  1622. else
  1623. { not a procedure variable }
  1624. begin
  1625. { calc the correture value for the register }
  1626. { handle predefined procedures }
  1627. if (procdefinition.proccalloption=pocall_inline) then
  1628. begin
  1629. { inherit flags }
  1630. current_procinfo.flags:=current_procinfo.flags+((procdefinition as tprocdef).inlininginfo^.flags*inherited_inlining_flags);
  1631. if assigned(methodpointer) then
  1632. CGMessage(cg_e_unable_inline_object_methods);
  1633. if assigned(right) then
  1634. CGMessage(cg_e_unable_inline_procvar);
  1635. if not assigned(inlinecode) then
  1636. begin
  1637. if assigned(tprocdef(procdefinition).inlininginfo^.code) then
  1638. inlinecode:=tprocdef(procdefinition).inlininginfo^.code.getcopy
  1639. else
  1640. CGMessage(cg_e_no_code_for_inline_stored);
  1641. if assigned(inlinecode) then
  1642. begin
  1643. { consider it has not inlined if called
  1644. again inside the args }
  1645. procdefinition.proccalloption:=pocall_default;
  1646. firstpass(inlinecode);
  1647. end;
  1648. end;
  1649. end
  1650. else
  1651. begin
  1652. if not (block_type in [bt_const,bt_type]) then
  1653. include(current_procinfo.flags,pi_do_call);
  1654. end;
  1655. end;
  1656. { get a register for the return value }
  1657. if (not is_void(resulttype.def)) then
  1658. begin
  1659. if paramanager.ret_in_param(resulttype.def,procdefinition.proccalloption) then
  1660. begin
  1661. expectloc:=LOC_REFERENCE;
  1662. end
  1663. else
  1664. { for win32 records returned in EDX:EAX, we
  1665. move them to memory after ... }
  1666. if (resulttype.def.deftype=recorddef) then
  1667. begin
  1668. expectloc:=LOC_CREFERENCE;
  1669. end
  1670. else
  1671. { ansi/widestrings must be registered, so we can dispose them }
  1672. if is_ansistring(resulttype.def) or
  1673. is_widestring(resulttype.def) then
  1674. begin
  1675. expectloc:=LOC_CREFERENCE;
  1676. registersint:=1;
  1677. end
  1678. else
  1679. { we have only to handle the result if it is used }
  1680. if (nf_return_value_used in flags) then
  1681. begin
  1682. case resulttype.def.deftype of
  1683. enumdef,
  1684. orddef :
  1685. begin
  1686. if (procdefinition.proctypeoption=potype_constructor) then
  1687. begin
  1688. expectloc:=LOC_REGISTER;
  1689. registersint:=1;
  1690. end
  1691. else
  1692. begin
  1693. expectloc:=LOC_REGISTER;
  1694. if is_64bit(resulttype.def) then
  1695. registersint:=2
  1696. else
  1697. registersint:=1;
  1698. end;
  1699. end;
  1700. floatdef :
  1701. begin
  1702. expectloc:=LOC_FPUREGISTER;
  1703. {$ifdef cpufpemu}
  1704. if (cs_fp_emulation in aktmoduleswitches) then
  1705. registersint:=1
  1706. else
  1707. {$endif cpufpemu}
  1708. {$ifdef m68k}
  1709. if (tfloatdef(resulttype.def).typ=s32real) then
  1710. registersint:=1
  1711. else
  1712. {$endif m68k}
  1713. registersfpu:=1;
  1714. end;
  1715. else
  1716. begin
  1717. expectloc:=LOC_REGISTER;
  1718. registersint:=1;
  1719. end;
  1720. end;
  1721. end
  1722. else
  1723. expectloc:=LOC_VOID;
  1724. end
  1725. else
  1726. expectloc:=LOC_VOID;
  1727. {$ifdef m68k}
  1728. { we need one more address register for virtual calls on m68k }
  1729. if (po_virtualmethod in procdefinition.procoptions) then
  1730. inc(registersint);
  1731. {$endif m68k}
  1732. { a fpu can be used in any procedure !! }
  1733. {$ifdef i386}
  1734. registersfpu:=procdefinition.fpu_used;
  1735. {$endif i386}
  1736. { if this is a call to a method calc the registers }
  1737. if (methodpointer<>nil) then
  1738. begin
  1739. if methodpointer.nodetype<>typen then
  1740. begin
  1741. firstpass(methodpointer);
  1742. registersfpu:=max(methodpointer.registersfpu,registersfpu);
  1743. registersint:=max(methodpointer.registersint,registersint);
  1744. {$ifdef SUPPORT_MMX }
  1745. registersmmx:=max(methodpointer.registersmmx,registersmmx);
  1746. {$endif SUPPORT_MMX}
  1747. end;
  1748. end;
  1749. { determine the registers of the procedure variable }
  1750. { is this OK for inlined procs also ?? (PM) }
  1751. if assigned(inlinecode) then
  1752. begin
  1753. registersfpu:=max(inlinecode.registersfpu,registersfpu);
  1754. registersint:=max(inlinecode.registersint,registersint);
  1755. {$ifdef SUPPORT_MMX}
  1756. registersmmx:=max(inlinecode.registersmmx,registersmmx);
  1757. {$endif SUPPORT_MMX}
  1758. end;
  1759. { determine the registers of the procedure variable }
  1760. { is this OK for inlined procs also ?? (PM) }
  1761. if assigned(right) then
  1762. begin
  1763. registersfpu:=max(right.registersfpu,registersfpu);
  1764. registersint:=max(right.registersint,registersint);
  1765. {$ifdef SUPPORT_MMX}
  1766. registersmmx:=max(right.registersmmx,registersmmx);
  1767. {$endif SUPPORT_MMX}
  1768. end;
  1769. { determine the registers of the procedure }
  1770. if assigned(left) then
  1771. begin
  1772. registersfpu:=max(left.registersfpu,registersfpu);
  1773. registersint:=max(left.registersint,registersint);
  1774. {$ifdef SUPPORT_MMX}
  1775. registersmmx:=max(left.registersmmx,registersmmx);
  1776. {$endif SUPPORT_MMX}
  1777. end;
  1778. errorexit:
  1779. if assigned(inlinecode) then
  1780. procdefinition.proccalloption:=pocall_inline;
  1781. end;
  1782. {$ifdef state_tracking}
  1783. function Tcallnode.track_state_pass(exec_known:boolean):boolean;
  1784. var hp:Tcallparanode;
  1785. value:Tnode;
  1786. begin
  1787. track_state_pass:=false;
  1788. hp:=Tcallparanode(left);
  1789. while assigned(hp) do
  1790. begin
  1791. if left.track_state_pass(exec_known) then
  1792. begin
  1793. left.resulttype.def:=nil;
  1794. do_resulttypepass(left);
  1795. end;
  1796. value:=aktstate.find_fact(hp.left);
  1797. if value<>nil then
  1798. begin
  1799. track_state_pass:=true;
  1800. hp.left.destroy;
  1801. hp.left:=value.getcopy;
  1802. do_resulttypepass(hp.left);
  1803. end;
  1804. hp:=Tcallparanode(hp.right);
  1805. end;
  1806. end;
  1807. {$endif}
  1808. function tcallnode.para_count:longint;
  1809. var
  1810. ppn : tcallparanode;
  1811. begin
  1812. result:=0;
  1813. ppn:=tcallparanode(left);
  1814. while assigned(ppn) do
  1815. begin
  1816. if not(assigned(ppn.paraitem) and
  1817. ppn.paraitem.is_hidden) then
  1818. inc(result);
  1819. ppn:=tcallparanode(ppn.right);
  1820. end;
  1821. end;
  1822. function tcallnode.docompare(p: tnode): boolean;
  1823. begin
  1824. docompare :=
  1825. inherited docompare(p) and
  1826. (symtableprocentry = tcallnode(p).symtableprocentry) and
  1827. (procdefinition = tcallnode(p).procdefinition) and
  1828. (methodpointer.isequal(tcallnode(p).methodpointer)) and
  1829. (((cnf_restypeset in callnodeflags) and (cnf_restypeset in tcallnode(p).callnodeflags) and
  1830. (equal_defs(restype.def,tcallnode(p).restype.def))) or
  1831. (not(cnf_restypeset in callnodeflags) and not(cnf_restypeset in tcallnode(p).callnodeflags)));
  1832. end;
  1833. procedure tcallnode.printnodedata(var t:text);
  1834. begin
  1835. if assigned(procdefinition) and
  1836. (procdefinition.deftype=procdef) then
  1837. writeln(t,printnodeindention,'proc = ',tprocdef(procdefinition).fullprocname(true))
  1838. else
  1839. begin
  1840. if assigned(symtableprocentry) then
  1841. writeln(t,printnodeindention,'proc = ',symtableprocentry.name)
  1842. else
  1843. writeln(t,printnodeindention,'proc = <nil>');
  1844. end;
  1845. printnode(t,methodpointer);
  1846. printnode(t,right);
  1847. printnode(t,left);
  1848. end;
  1849. begin
  1850. ccallnode:=tcallnode;
  1851. ccallparanode:=tcallparanode;
  1852. end.
  1853. {
  1854. $Log$
  1855. Revision 1.230 2004-03-04 17:25:16 peter
  1856. * fix check for parameter length when calling procvar, broken by the
  1857. previous default parameter for procvar fix
  1858. Revision 1.229 2004/02/26 16:09:49 peter
  1859. * fix procvars with default paras
  1860. Revision 1.228 2004/02/24 16:12:39 peter
  1861. * operator overload chooses rewrite
  1862. * overload choosing is now generic and moved to htypechk
  1863. Revision 1.227 2004/02/20 21:55:59 peter
  1864. * procvar cleanup
  1865. Revision 1.226 2004/02/19 17:07:42 florian
  1866. * fixed arg. area calculation
  1867. Revision 1.225 2004/02/13 15:42:21 peter
  1868. * compare_defs_ext has now a options argument
  1869. * fixes for variants
  1870. Revision 1.224 2004/02/12 15:54:03 peter
  1871. * make extcycle is working again
  1872. Revision 1.223 2004/02/05 01:24:08 florian
  1873. * several fixes to compile x86-64 system
  1874. Revision 1.222 2004/02/03 22:32:54 peter
  1875. * renamed xNNbittype to xNNinttype
  1876. * renamed registers32 to registersint
  1877. * replace some s32bit,u32bit with torddef([su]inttype).def.typ
  1878. Revision 1.221 2004/01/26 16:12:27 daniel
  1879. * reginfo now also only allocated during register allocation
  1880. * third round of gdb cleanups: kick out most of concatstabto
  1881. Revision 1.220 2004/01/15 15:16:18 daniel
  1882. * Some minor stuff
  1883. * Managed to eliminate speed effects of string compression
  1884. Revision 1.219 2004/01/14 17:53:58 peter
  1885. * ignore hidden parameters when default parameters are used
  1886. Revision 1.218 2004/01/11 23:56:19 daniel
  1887. * Experiment: Compress strings to save memory
  1888. Did not save a single byte of mem; clearly the core size is boosted by
  1889. temporary memory usage...
  1890. Revision 1.217 2003/12/28 22:09:12 florian
  1891. + setting of bit 6 of cr for c var args on ppc implemented
  1892. Revision 1.216 2003/12/21 19:42:42 florian
  1893. * fixed ppc inlining stuff
  1894. * fixed wrong unit writing
  1895. + added some sse stuff
  1896. Revision 1.215 2003/12/20 12:38:51 florian
  1897. * some x86-64 compilation fixe
  1898. Revision 1.214 2003/12/16 22:09:31 florian
  1899. * better inheritence of procinfo flags of inlined procedures
  1900. Revision 1.213 2003/12/16 21:29:24 florian
  1901. + inlined procedures inherit procinfo flags
  1902. Revision 1.212 2003/12/08 22:37:28 peter
  1903. * paralength is private again
  1904. Revision 1.211 2003/12/08 16:34:23 peter
  1905. * varargspara is left-right, so adding paraitems needs insert
  1906. instead of concat
  1907. Revision 1.210 2003/12/01 18:44:15 peter
  1908. * fixed some crashes
  1909. * fixed varargs and register calling probs
  1910. Revision 1.209 2003/11/28 17:24:22 peter
  1911. * reversed offset calculation for caller side so it works
  1912. correctly for interfaces
  1913. Revision 1.208 2003/11/23 17:05:15 peter
  1914. * register calling is left-right
  1915. * parameter ordering
  1916. * left-right calling inserts result parameter last
  1917. Revision 1.207 2003/11/10 22:02:52 peter
  1918. * cross unit inlining fixed
  1919. Revision 1.206 2003/11/10 19:09:29 peter
  1920. * procvar default value support
  1921. Revision 1.205 2003/11/06 15:54:32 peter
  1922. * fixed calling classmethod for other object from classmethod
  1923. Revision 1.204 2003/11/01 16:17:48 peter
  1924. * use explicit typecast when generating the high value
  1925. Revision 1.203 2003/10/31 15:52:58 peter
  1926. * support creating classes using <class of tobject>.create
  1927. Revision 1.202 2003/10/30 16:23:13 peter
  1928. * don't search for overloads in parents for constructors
  1929. Revision 1.201 2003/10/29 22:01:20 florian
  1930. * fixed passing of dyn. arrays to open array parameters
  1931. Revision 1.200 2003/10/23 14:44:07 peter
  1932. * splitted buildderef and buildderefimpl to fix interface crc
  1933. calculation
  1934. Revision 1.199 2003/10/22 20:40:00 peter
  1935. * write derefdata in a separate ppu entry
  1936. Revision 1.198 2003/10/21 18:17:02 peter
  1937. * only search for overloaded constructors in classes
  1938. Revision 1.197 2003/10/21 15:14:55 peter
  1939. * also search in parents for overloads when calling a constructor
  1940. Revision 1.196 2003/10/13 14:05:12 peter
  1941. * removed is_visible_for_proc
  1942. * search also for class overloads when finding interface
  1943. implementations
  1944. Revision 1.195 2003/10/09 21:31:37 daniel
  1945. * Register allocator splitted, ans abstract now
  1946. Revision 1.194 2003/10/09 15:00:13 florian
  1947. * fixed constructor call in class methods
  1948. Revision 1.193 2003/10/08 19:19:45 peter
  1949. * set_varstate cleanup
  1950. Revision 1.192 2003/10/07 21:14:32 peter
  1951. * compare_paras() has a parameter to ignore hidden parameters
  1952. * cross unit overload searching ignores hidden parameters when
  1953. comparing parameter lists. Now function(string):string is
  1954. not overriden with procedure(string) which has the same visible
  1955. parameter list
  1956. Revision 1.191 2003/10/05 21:21:52 peter
  1957. * c style array of const generates callparanodes
  1958. * varargs paraloc fixes
  1959. Revision 1.190 2003/10/05 12:54:17 peter
  1960. * don't check for abstract methods when the constructor is called
  1961. by inherited
  1962. * fix private member error instead of wrong number of parameters
  1963. Revision 1.189 2003/10/04 19:00:52 florian
  1964. * fixed TP 6.0 styled inherited call; fixes IDE with 1.1
  1965. Revision 1.188 2003/10/03 22:00:33 peter
  1966. * parameter alignment fixes
  1967. Revision 1.187 2003/10/03 14:44:38 peter
  1968. * fix IE when callnode was firstpassed twice
  1969. Revision 1.186 2003/10/02 21:13:46 peter
  1970. * protected visibility fixes
  1971. Revision 1.185 2003/10/01 20:34:48 peter
  1972. * procinfo unit contains tprocinfo
  1973. * cginfo renamed to cgbase
  1974. * moved cgmessage to verbose
  1975. * fixed ppc and sparc compiles
  1976. Revision 1.184 2003/09/28 21:44:55 peter
  1977. * fix check that filedef needs var para
  1978. Revision 1.183 2003/09/28 17:55:03 peter
  1979. * parent framepointer changed to hidden parameter
  1980. * tloadparentfpnode added
  1981. Revision 1.182 2003/09/25 21:28:00 peter
  1982. * parameter fixes
  1983. Revision 1.181 2003/09/23 17:56:05 peter
  1984. * locals and paras are allocated in the code generation
  1985. * tvarsym.localloc contains the location of para/local when
  1986. generating code for the current procedure
  1987. Revision 1.180 2003/09/16 16:17:01 peter
  1988. * varspez in calls to push_addr_param
  1989. Revision 1.179 2003/09/07 22:09:35 peter
  1990. * preparations for different default calling conventions
  1991. * various RA fixes
  1992. Revision 1.178 2003/09/06 22:27:08 florian
  1993. * fixed web bug 2669
  1994. * cosmetic fix in printnode
  1995. * tobjectdef.gettypename implemented
  1996. Revision 1.177 2003/09/03 15:55:00 peter
  1997. * NEWRA branch merged
  1998. Revision 1.176.2.3 2003/08/31 21:07:44 daniel
  1999. * callparatemp ripped
  2000. Revision 1.176.2.2 2003/08/27 20:23:55 peter
  2001. * remove old ra code
  2002. Revision 1.176.2.1 2003/08/27 19:55:54 peter
  2003. * first tregister patch
  2004. Revision 1.176 2003/08/23 18:42:57 peter
  2005. * only check for size matches when parameter is enum,ord,float
  2006. Revision 1.175 2003/08/10 17:25:23 peter
  2007. * fixed some reported bugs
  2008. Revision 1.174 2003/07/25 09:54:57 jonas
  2009. * fixed bogus abstract method warnings
  2010. Revision 1.173 2003/06/25 18:31:23 peter
  2011. * sym,def resolving partly rewritten to support also parent objects
  2012. not directly available through the uses clause
  2013. Revision 1.172 2003/06/17 16:34:44 jonas
  2014. * lots of newra fixes (need getfuncretparaloc implementation for i386)!
  2015. * renamed all_intregisters to volatile_intregisters and made it
  2016. processor dependent
  2017. Revision 1.171 2003/06/15 16:47:33 jonas
  2018. * fixed revious commit
  2019. Revision 1.170 2003/06/15 15:10:57 jonas
  2020. * callparatemp fix: if a threadvar is a parameter, that paramter also
  2021. does a call
  2022. Revision 1.169 2003/06/13 21:19:30 peter
  2023. * current_procdef removed, use current_procinfo.procdef instead
  2024. Revision 1.168 2003/06/08 20:01:53 jonas
  2025. * optimized assignments with on the right side a function that returns
  2026. an ansi- or widestring
  2027. Revision 1.167 2003/06/08 18:27:15 jonas
  2028. + ability to change the location of a ttempref node with changelocation()
  2029. method. Useful to use instead of copying the contents from one temp to
  2030. another
  2031. + some shortstring optimizations in tassignmentnode that avoid some
  2032. copying (required some shortstring optimizations to be moved from
  2033. resulttype to firstpass, because they work on callnodes and string
  2034. addnodes are only changed to callnodes in the firstpass)
  2035. * allow setting/changing the funcretnode of callnodes after the
  2036. resulttypepass has been done, funcretnode is now a property
  2037. (all of the above should have a quite big effect on callparatemp)
  2038. Revision 1.166 2003/06/08 11:42:33 peter
  2039. * creating class with abstract call checking fixed
  2040. * there will be only one warning for each class, the methods
  2041. are listed as hint
  2042. Revision 1.165 2003/06/07 20:26:32 peter
  2043. * re-resolving added instead of reloading from ppu
  2044. * tderef object added to store deref info for resolving
  2045. Revision 1.164 2003/06/03 21:05:48 peter
  2046. * fix check for procedure without parameters
  2047. * calling constructor as member will not allocate memory
  2048. Revision 1.163 2003/06/03 13:01:59 daniel
  2049. * Register allocator finished
  2050. Revision 1.162 2003/05/26 21:17:17 peter
  2051. * procinlinenode removed
  2052. * aktexit2label removed, fast exit removed
  2053. + tcallnode.inlined_pass_2 added
  2054. Revision 1.161 2003/05/25 11:34:17 peter
  2055. * methodpointer self pushing fixed
  2056. Revision 1.160 2003/05/25 08:59:16 peter
  2057. * inline fixes
  2058. Revision 1.159 2003/05/24 17:16:37 jonas
  2059. * added missing firstpass for callparatemp code
  2060. Revision 1.158 2003/05/23 14:27:35 peter
  2061. * remove some unit dependencies
  2062. * current_procinfo changes to store more info
  2063. Revision 1.157 2003/05/17 14:05:58 jonas
  2064. * fixed callparatemp for ansi/widestring and interfacecoms
  2065. Revision 1.156 2003/05/17 13:30:08 jonas
  2066. * changed tt_persistant to tt_persistent :)
  2067. * tempcreatenode now doesn't accept a boolean anymore for persistent
  2068. temps, but a ttemptype, so you can also create ansistring temps etc
  2069. Revision 1.155 2003/05/16 14:33:31 peter
  2070. * regvar fixes
  2071. Revision 1.154 2003/05/14 19:35:50 jonas
  2072. * fixed callparatemp so it works with vs_var, vs_out and formal const
  2073. parameters
  2074. Revision 1.153 2003/05/13 20:53:41 peter
  2075. * constructors return in register
  2076. Revision 1.152 2003/05/13 15:18:49 peter
  2077. * fixed various crashes
  2078. Revision 1.151 2003/05/11 21:37:03 peter
  2079. * moved implicit exception frame from ncgutil to psub
  2080. * constructor/destructor helpers moved from cobj/ncgutil to psub
  2081. Revision 1.150 2003/05/11 14:45:12 peter
  2082. * tloadnode does not support objectsymtable,withsymtable anymore
  2083. * withnode cleanup
  2084. * direct with rewritten to use temprefnode
  2085. Revision 1.149 2003/05/09 17:47:02 peter
  2086. * self moved to hidden parameter
  2087. * removed hdisposen,hnewn,selfn
  2088. Revision 1.148 2003/05/05 14:53:16 peter
  2089. * vs_hidden replaced by is_hidden boolean
  2090. Revision 1.147 2003/04/27 11:21:33 peter
  2091. * aktprocdef renamed to current_procinfo.procdef
  2092. * procinfo renamed to current_procinfo
  2093. * procinfo will now be stored in current_module so it can be
  2094. cleaned up properly
  2095. * gen_main_procsym changed to create_main_proc and release_main_proc
  2096. to also generate a tprocinfo structure
  2097. * fixed unit implicit initfinal
  2098. Revision 1.146 2003/04/27 09:08:44 jonas
  2099. * do callparatemp stuff only after the parameters have been firstpassed,
  2100. because some nodes are turned into calls during the firstpass
  2101. Revision 1.145 2003/04/27 07:29:50 peter
  2102. * current_procinfo.procdef cleanup, current_procdef is now always nil when parsing
  2103. a new procdef declaration
  2104. * aktprocsym removed
  2105. * lexlevel removed, use symtable.symtablelevel instead
  2106. * implicit init/final code uses the normal genentry/genexit
  2107. * funcret state checking updated for new funcret handling
  2108. Revision 1.144 2003/04/25 20:59:33 peter
  2109. * removed funcretn,funcretsym, function result is now in varsym
  2110. and aliases for result and function name are added using absolutesym
  2111. * vs_hidden parameter for funcret passed in parameter
  2112. * vs_hidden fixes
  2113. * writenode changed to printnode and released from extdebug
  2114. * -vp option added to generate a tree.log with the nodetree
  2115. * nicer printnode for statements, callnode
  2116. Revision 1.143 2002/04/25 20:15:39 florian
  2117. * block nodes within expressions shouldn't release the used registers,
  2118. fixed using a flag till the new rg is ready
  2119. Revision 1.142 2003/04/23 20:16:04 peter
  2120. + added currency support based on int64
  2121. + is_64bit for use in cg units instead of is_64bitint
  2122. * removed cgmessage from n386add, replace with internalerrors
  2123. Revision 1.141 2003/04/23 13:21:06 peter
  2124. * fix warning for calling constructor inside constructor
  2125. Revision 1.140 2003/04/23 12:35:34 florian
  2126. * fixed several issues with powerpc
  2127. + applied a patch from Jonas for nested function calls (PowerPC only)
  2128. * ...
  2129. Revision 1.139 2003/04/22 23:50:22 peter
  2130. * firstpass uses expectloc
  2131. * checks if there are differences between the expectloc and
  2132. location.loc from secondpass in EXTDEBUG
  2133. Revision 1.138 2003/04/22 09:53:33 peter
  2134. * fix insert_typeconv to handle new varargs which don't have a
  2135. paraitem set
  2136. Revision 1.137 2003/04/11 16:02:05 peter
  2137. * don't firstpass typen
  2138. Revision 1.136 2003/04/11 15:51:04 peter
  2139. * support subscript,vec for setting methodpointer varstate
  2140. Revision 1.135 2003/04/10 17:57:52 peter
  2141. * vs_hidden released
  2142. Revision 1.134 2003/04/07 11:58:22 jonas
  2143. * more vs_invisible fixes
  2144. Revision 1.133 2003/04/07 10:40:21 jonas
  2145. * fixed VS_HIDDEN for high parameter so it works again
  2146. Revision 1.132 2003/04/04 15:38:56 peter
  2147. * moved generic code from n386cal to ncgcal, i386 now also
  2148. uses the generic ncgcal
  2149. Revision 1.131 2003/03/17 18:54:23 peter
  2150. * fix missing self setting for method to procvar conversion in
  2151. tp_procvar mode
  2152. Revision 1.130 2003/03/17 16:54:41 peter
  2153. * support DefaultHandler and anonymous inheritance fixed
  2154. for message methods
  2155. Revision 1.129 2003/03/17 15:54:22 peter
  2156. * store symoptions also for procdef
  2157. * check symoptions (private,public) when calculating possible
  2158. overload candidates
  2159. Revision 1.128 2003/02/19 22:00:14 daniel
  2160. * Code generator converted to new register notation
  2161. - Horribily outdated todo.txt removed
  2162. Revision 1.127 2003/01/16 22:13:52 peter
  2163. * convert_l3 convertlevel added. This level is used for conversions
  2164. where information can be lost like converting widestring->ansistring
  2165. or dword->byte
  2166. Revision 1.126 2003/01/15 01:44:32 peter
  2167. * merged methodpointer fixes from 1.0.x
  2168. Revision 1.125 2003/01/12 17:52:07 peter
  2169. * only check for auto inherited in objectsymtable
  2170. Revision 1.124 2003/01/09 21:45:46 peter
  2171. * extended information about overloaded candidates when compiled
  2172. with EXTDEBUG
  2173. Revision 1.123 2002/12/26 18:24:33 jonas
  2174. * fixed check for whether or not a high parameter was already generated
  2175. * no type checking/conversions for invisible parameters
  2176. Revision 1.122 2002/12/15 22:50:00 florian
  2177. + some stuff for the new hidden parameter handling added
  2178. Revision 1.121 2002/12/15 21:34:15 peter
  2179. * give sign difference between ordinals a small penalty. This is
  2180. needed to get word->[longword|longint] working
  2181. Revision 1.120 2002/12/15 21:30:12 florian
  2182. * tcallnode.paraitem introduced, all references to defcoll removed
  2183. Revision 1.119 2002/12/15 20:59:58 peter
  2184. * fix crash with default parameters
  2185. Revision 1.118 2002/12/15 11:26:02 peter
  2186. * ignore vs_hidden parameters when choosing overloaded proc
  2187. Revision 1.117 2002/12/11 22:42:28 peter
  2188. * tcallnode.det_resulttype rewrite, merged code from nice_ncal and
  2189. the old code. The new code collects the information about possible
  2190. candidates only once resultting in much less calls to type compare
  2191. routines
  2192. Revision 1.116 2002/12/07 14:27:07 carl
  2193. * 3% memory optimization
  2194. * changed some types
  2195. + added type checking with different size for call node and for
  2196. parameters
  2197. Revision 1.115 2002/12/06 17:51:10 peter
  2198. * merged cdecl and array fixes
  2199. Revision 1.114 2002/12/06 16:56:58 peter
  2200. * only compile cs_fp_emulation support when cpufpuemu is defined
  2201. * define cpufpuemu for m68k only
  2202. Revision 1.113 2002/11/27 20:04:38 peter
  2203. * cdecl array of const fixes
  2204. Revision 1.112 2002/11/27 15:33:46 peter
  2205. * the never ending story of tp procvar hacks
  2206. Revision 1.111 2002/11/27 02:31:17 peter
  2207. * fixed inlinetree parsing in det_resulttype
  2208. Revision 1.110 2002/11/25 18:43:32 carl
  2209. - removed the invalid if <> checking (Delphi is strange on this)
  2210. + implemented abstract warning on instance creation of class with
  2211. abstract methods.
  2212. * some error message cleanups
  2213. Revision 1.109 2002/11/25 17:43:17 peter
  2214. * splitted defbase in defutil,symutil,defcmp
  2215. * merged isconvertable and is_equal into compare_defs(_ext)
  2216. * made operator search faster by walking the list only once
  2217. Revision 1.108 2002/11/18 17:31:54 peter
  2218. * pass proccalloption to ret_in_xxx and push_xxx functions
  2219. Revision 1.107 2002/11/15 01:58:50 peter
  2220. * merged changes from 1.0.7 up to 04-11
  2221. - -V option for generating bug report tracing
  2222. - more tracing for option parsing
  2223. - errors for cdecl and high()
  2224. - win32 import stabs
  2225. - win32 records<=8 are returned in eax:edx (turned off by default)
  2226. - heaptrc update
  2227. - more info for temp management in .s file with EXTDEBUG
  2228. Revision 1.106 2002/10/14 18:20:30 carl
  2229. * var parameter checking for classes and interfaces in Delphi mode
  2230. Revision 1.105 2002/10/06 21:02:17 peter
  2231. * fixed limit checking for qword
  2232. Revision 1.104 2002/10/05 15:15:45 peter
  2233. * Write unknwon compiler proc using Comment and only in Extdebug
  2234. Revision 1.103 2002/10/05 12:43:25 carl
  2235. * fixes for Delphi 6 compilation
  2236. (warning : Some features do not work under Delphi)
  2237. Revision 1.102 2002/10/05 00:48:57 peter
  2238. * support inherited; support for overload as it is handled by
  2239. delphi. This is only for delphi mode as it is working is
  2240. undocumented and hard to predict what is done
  2241. Revision 1.101 2002/09/16 14:11:12 peter
  2242. * add argument to equal_paras() to support default values or not
  2243. Revision 1.100 2002/09/15 17:49:59 peter
  2244. * don't have strict var parameter checking for procedures in the
  2245. system unit
  2246. Revision 1.99 2002/09/09 19:30:34 peter
  2247. * don't allow convertable parameters for var and out parameters in
  2248. delphi and tp mode
  2249. Revision 1.98 2002/09/07 15:25:02 peter
  2250. * old logs removed and tabs fixed
  2251. Revision 1.97 2002/09/07 12:16:05 carl
  2252. * second part bug report 1996 fix, testrange in cordconstnode
  2253. only called if option is set (also make parsing a tiny faster)
  2254. Revision 1.96 2002/09/05 14:53:41 peter
  2255. * fixed old callnode.det_resulttype code
  2256. * old ncal code is default again
  2257. Revision 1.95 2002/09/03 21:32:49 daniel
  2258. * Small bugfix for procdef selection
  2259. Revision 1.94 2002/09/03 19:27:22 daniel
  2260. * Activated new ncal code
  2261. Revision 1.93 2002/09/03 16:26:26 daniel
  2262. * Make Tprocdef.defs protected
  2263. Revision 1.92 2002/09/01 13:28:37 daniel
  2264. - write_access fields removed in favor of a flag
  2265. Revision 1.91 2002/09/01 12:14:15 peter
  2266. * remove debug line
  2267. * containself methods can be called directly
  2268. Revision 1.90 2002/09/01 08:01:16 daniel
  2269. * Removed sets from Tcallnode.det_resulttype
  2270. + Added read/write notifications of variables. These will be usefull
  2271. for providing information for several optimizations. For example
  2272. the value of the loop variable of a for loop does matter is the
  2273. variable is read after the for loop, but if it's no longer used
  2274. or written, it doesn't matter and this can be used to optimize
  2275. the loop code generation.
  2276. Revision 1.89 2002/08/23 16:13:16 peter
  2277. * also firstpass funcretrefnode if available. This was breaking the
  2278. asnode compilerproc code
  2279. Revision 1.88 2002/08/20 10:31:26 daniel
  2280. * Tcallnode.det_resulttype rewritten
  2281. Revision 1.87 2002/08/19 19:36:42 peter
  2282. * More fixes for cross unit inlining, all tnodes are now implemented
  2283. * Moved pocall_internconst to po_internconst because it is not a
  2284. calling type at all and it conflicted when inlining of these small
  2285. functions was requested
  2286. Revision 1.86 2002/08/17 22:09:44 florian
  2287. * result type handling in tcgcal.pass_2 overhauled
  2288. * better tnode.dowrite
  2289. * some ppc stuff fixed
  2290. Revision 1.85 2002/08/17 09:23:34 florian
  2291. * first part of current_procinfo rewrite
  2292. Revision 1.84 2002/08/16 14:24:57 carl
  2293. * issameref() to test if two references are the same (then emit no opcodes)
  2294. + ret_in_reg to replace ret_in_acc
  2295. (fix some register allocation bugs at the same time)
  2296. + save_std_register now has an extra parameter which is the
  2297. usedinproc registers
  2298. Revision 1.83 2002/07/20 11:57:53 florian
  2299. * types.pas renamed to defbase.pas because D6 contains a types
  2300. unit so this would conflicts if D6 programms are compiled
  2301. + Willamette/SSE2 instructions to assembler added
  2302. Revision 1.82 2002/07/19 11:41:35 daniel
  2303. * State tracker work
  2304. * The whilen and repeatn are now completely unified into whilerepeatn. This
  2305. allows the state tracker to change while nodes automatically into
  2306. repeat nodes.
  2307. * Resulttypepass improvements to the notn. 'not not a' is optimized away and
  2308. 'not(a>b)' is optimized into 'a<=b'.
  2309. * Resulttypepass improvements to the whilerepeatn. 'while not a' is optimized
  2310. by removing the notn and later switchting the true and falselabels. The
  2311. same is done with 'repeat until not a'.
  2312. Revision 1.81 2002/07/15 18:03:14 florian
  2313. * readded removed changes
  2314. Revision 1.79 2002/07/11 14:41:27 florian
  2315. * start of the new generic parameter handling
  2316. Revision 1.80 2002/07/14 18:00:43 daniel
  2317. + Added the beginning of a state tracker. This will track the values of
  2318. variables through procedures and optimize things away.
  2319. Revision 1.78 2002/07/04 20:43:00 florian
  2320. * first x86-64 patches
  2321. }