ncal.pas 85 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135
  1. {
  2. $Id$
  3. Copyright (c) 1998-2000 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 defines.inc}
  20. interface
  21. uses
  22. node,
  23. symbase,symtype,symsym,symdef,symtable;
  24. type
  25. tcallnode = class(tbinarynode)
  26. { the symbol containing the definition of the procedure }
  27. { to call }
  28. symtableprocentry : tprocsym;
  29. { the symtable containing symtableprocentry }
  30. symtableproc : tsymtable;
  31. { the definition of the procedure to call }
  32. procdefinition : tabstractprocdef;
  33. methodpointer : tnode;
  34. { separately specified resulttype for some compilerprocs (e.g. }
  35. { you can't have a function with an "array of char" resulttype }
  36. { the RTL) (JM) }
  37. restype: ttype;
  38. restypeset: boolean;
  39. { only the processor specific nodes need to override this }
  40. { constructor }
  41. constructor create(l:tnode; v : tprocsym;st : tsymtable; mp : tnode);virtual;
  42. constructor createintern(const name: string; params: tnode);
  43. constructor createinternres(const name: string; params: tnode; const res: ttype);
  44. destructor destroy;override;
  45. function getcopy : tnode;override;
  46. procedure insertintolist(l : tnodelist);override;
  47. function pass_1 : tnode;override;
  48. function det_resulttype:tnode;override;
  49. function docompare(p: tnode): boolean; override;
  50. procedure set_procvar(procvar:tnode);
  51. end;
  52. tcallnodeclass = class of tcallnode;
  53. tcallparaflags = (
  54. { flags used by tcallparanode }
  55. cpf_exact_match_found,
  56. cpf_convlevel1found,
  57. cpf_convlevel2found,
  58. cpf_is_colon_para
  59. );
  60. tcallparanode = class(tbinarynode)
  61. callparaflags : set of tcallparaflags;
  62. hightree : tnode;
  63. { only the processor specific nodes need to override this }
  64. { constructor }
  65. constructor create(expr,next : tnode);virtual;
  66. destructor destroy;override;
  67. function getcopy : tnode;override;
  68. procedure insertintolist(l : tnodelist);override;
  69. procedure gen_high_tree(openstring:boolean);
  70. procedure get_paratype;
  71. procedure insert_typeconv(defcoll : tparaitem;do_count : boolean);
  72. procedure det_registers;
  73. procedure firstcallparan(defcoll : tparaitem;do_count : boolean);
  74. procedure secondcallparan(defcoll : tparaitem;
  75. push_from_left_to_right,inlined,is_cdecl : boolean;
  76. para_alignment,para_offset : longint);virtual;abstract;
  77. function docompare(p: tnode): boolean; override;
  78. end;
  79. tcallparanodeclass = class of tcallparanode;
  80. tprocinlinenode = class(tnode)
  81. inlinetree : tnode;
  82. inlineprocdef : tprocdef;
  83. retoffset,para_offset,para_size : longint;
  84. constructor create(callp,code : tnode);virtual;
  85. destructor destroy;override;
  86. function getcopy : tnode;override;
  87. procedure insertintolist(l : tnodelist);override;
  88. function pass_1 : tnode;override;
  89. function docompare(p: tnode): boolean; override;
  90. end;
  91. tprocinlinenodeclass = class of tprocinlinenode;
  92. function reverseparameters(p: tcallparanode): tcallparanode;
  93. var
  94. ccallnode : tcallnodeclass;
  95. ccallparanode : tcallparanodeclass;
  96. cprocinlinenode : tprocinlinenodeclass;
  97. implementation
  98. uses
  99. cutils,globtype,systems,
  100. verbose,globals,
  101. symconst,types,
  102. htypechk,pass_1,cpubase,
  103. ncnv,nld,ninl,nadd,ncon,
  104. rgobj,cgbase
  105. ;
  106. {****************************************************************************
  107. HELPERS
  108. ****************************************************************************}
  109. function reverseparameters(p: tcallparanode): tcallparanode;
  110. var
  111. hp1, hp2: tcallparanode;
  112. begin
  113. hp1:=nil;
  114. while assigned(p) do
  115. begin
  116. { pull out }
  117. hp2:=p;
  118. p:=tcallparanode(p.right);
  119. { pull in }
  120. hp2.right:=hp1;
  121. hp1:=hp2;
  122. end;
  123. reverseparameters:=hp1;
  124. end;
  125. procedure search_class_overloads(aprocsym : tprocsym);
  126. { searches n in symtable of pd and all anchestors }
  127. var
  128. speedvalue : cardinal;
  129. srsym : tprocsym;
  130. s : string;
  131. found : boolean;
  132. srpdl,pdl : pprocdeflist;
  133. objdef : tobjectdef;
  134. begin
  135. if aprocsym.overloadchecked then
  136. exit;
  137. aprocsym.overloadchecked:=true;
  138. if (aprocsym.owner.symtabletype<>objectsymtable) then
  139. internalerror(200111021);
  140. objdef:=tobjectdef(aprocsym.owner.defowner);
  141. { we start in the parent }
  142. if not assigned(objdef.childof) then
  143. exit;
  144. objdef:=objdef.childof;
  145. s:=aprocsym.name;
  146. speedvalue:=getspeedvalue(s);
  147. while assigned(objdef) do
  148. begin
  149. srsym:=tprocsym(objdef.symtable.speedsearch(s,speedvalue));
  150. if assigned(srsym) then
  151. begin
  152. if (srsym.typ<>procsym) then
  153. internalerror(200111022);
  154. if srsym.is_visible_for_proc(aktprocdef) then
  155. begin
  156. srpdl:=srsym.defs;
  157. while assigned(srpdl) do
  158. begin
  159. found:=false;
  160. pdl:=aprocsym.defs;
  161. while assigned(pdl) do
  162. begin
  163. if equal_paras(pdl^.def.para,srpdl^.def.para,cp_value_equal_const) then
  164. begin
  165. found:=true;
  166. break;
  167. end;
  168. pdl:=pdl^.next;
  169. end;
  170. if not found then
  171. aprocsym.addprocdef(srpdl^.def);
  172. srpdl:=srpdl^.next;
  173. end;
  174. { we can stop if the overloads were already added
  175. for the found symbol }
  176. if srsym.overloadchecked then
  177. break;
  178. end;
  179. end;
  180. { next parent }
  181. objdef:=objdef.childof;
  182. end;
  183. end;
  184. {****************************************************************************
  185. TCALLPARANODE
  186. ****************************************************************************}
  187. constructor tcallparanode.create(expr,next : tnode);
  188. begin
  189. inherited create(callparan,expr,next);
  190. hightree:=nil;
  191. if assigned(expr) then
  192. expr.set_file_line(self);
  193. callparaflags:=[];
  194. end;
  195. destructor tcallparanode.destroy;
  196. begin
  197. hightree.free;
  198. inherited destroy;
  199. end;
  200. function tcallparanode.getcopy : tnode;
  201. var
  202. n : tcallparanode;
  203. begin
  204. n:=tcallparanode(inherited getcopy);
  205. n.callparaflags:=callparaflags;
  206. if assigned(hightree) then
  207. n.hightree:=hightree.getcopy
  208. else
  209. n.hightree:=nil;
  210. result:=n;
  211. end;
  212. procedure tcallparanode.insertintolist(l : tnodelist);
  213. begin
  214. end;
  215. procedure tcallparanode.get_paratype;
  216. var
  217. old_get_para_resulttype : boolean;
  218. old_array_constructor : boolean;
  219. begin
  220. inc(parsing_para_level);
  221. if assigned(right) then
  222. tcallparanode(right).get_paratype;
  223. old_array_constructor:=allow_array_constructor;
  224. old_get_para_resulttype:=get_para_resulttype;
  225. get_para_resulttype:=true;
  226. allow_array_constructor:=true;
  227. resulttypepass(left);
  228. get_para_resulttype:=old_get_para_resulttype;
  229. allow_array_constructor:=old_array_constructor;
  230. if codegenerror then
  231. resulttype:=generrortype
  232. else
  233. resulttype:=left.resulttype;
  234. dec(parsing_para_level);
  235. end;
  236. procedure tcallparanode.insert_typeconv(defcoll : tparaitem;do_count : boolean);
  237. var
  238. oldtype : ttype;
  239. {$ifdef extdebug}
  240. store_count_ref : boolean;
  241. {$endif def extdebug}
  242. begin
  243. inc(parsing_para_level);
  244. if not assigned(defcoll) then
  245. internalerror(200104261);
  246. {$ifdef extdebug}
  247. if do_count then
  248. begin
  249. store_count_ref:=count_ref;
  250. count_ref:=true;
  251. end;
  252. {$endif def extdebug}
  253. if assigned(right) then
  254. begin
  255. { if we are a para that belongs to varargs then keep
  256. the current defcoll }
  257. if (nf_varargs_para in flags) then
  258. tcallparanode(right).insert_typeconv(defcoll,do_count)
  259. else
  260. tcallparanode(right).insert_typeconv(tparaitem(defcoll.next),do_count);
  261. end;
  262. { Be sure to have the resulttype }
  263. if not assigned(left.resulttype.def) then
  264. resulttypepass(left);
  265. { Handle varargs directly, no typeconvs or typechecking needed }
  266. if (nf_varargs_para in flags) then
  267. begin
  268. { convert pascal to C types }
  269. case left.resulttype.def.deftype of
  270. stringdef :
  271. inserttypeconv(left,charpointertype);
  272. floatdef :
  273. inserttypeconv(left,s64floattype);
  274. end;
  275. set_varstate(left,true);
  276. resulttype:=left.resulttype;
  277. dec(parsing_para_level);
  278. exit;
  279. end;
  280. { Do we need arrayconstructor -> set conversion, then insert
  281. it here before the arrayconstructor node breaks the tree
  282. with its conversions of enum->ord }
  283. if (left.nodetype=arrayconstructorn) and
  284. (defcoll.paratype.def.deftype=setdef) then
  285. inserttypeconv(left,defcoll.paratype);
  286. { set some settings needed for arrayconstructor }
  287. if is_array_constructor(left.resulttype.def) then
  288. begin
  289. if is_array_of_const(defcoll.paratype.def) then
  290. begin
  291. if assigned(aktcallprocdef) and
  292. (aktcallprocdef.proccalloption in [pocall_cppdecl,pocall_cdecl]) and
  293. (po_external in aktcallprocdef.procoptions) then
  294. include(left.flags,nf_cargs);
  295. { force variant array }
  296. include(left.flags,nf_forcevaria);
  297. end
  298. else
  299. begin
  300. include(left.flags,nf_novariaallowed);
  301. { now that the resultting type is know we can insert the required
  302. typeconvs for the array constructor }
  303. tarrayconstructornode(left).force_type(tarraydef(defcoll.paratype.def).elementtype);
  304. end;
  305. end;
  306. { check if local proc/func is assigned to procvar }
  307. if left.resulttype.def.deftype=procvardef then
  308. test_local_to_procvar(tprocvardef(left.resulttype.def),defcoll.paratype.def);
  309. { generate the high() value tree }
  310. if not(assigned(aktcallprocdef) and
  311. (aktcallprocdef.proccalloption in [pocall_cppdecl,pocall_cdecl]) and
  312. (po_external in aktcallprocdef.procoptions)) and
  313. push_high_param(defcoll.paratype.def) then
  314. gen_high_tree(is_open_string(defcoll.paratype.def));
  315. { test conversions }
  316. if not(is_shortstring(left.resulttype.def) and
  317. is_shortstring(defcoll.paratype.def)) and
  318. (defcoll.paratype.def.deftype<>formaldef) then
  319. begin
  320. if (defcoll.paratyp in [vs_var,vs_out]) and
  321. { allows conversion from word to integer and
  322. byte to shortint, but only for TP7 compatibility }
  323. (not(
  324. (m_tp7 in aktmodeswitches) and
  325. (left.resulttype.def.deftype=orddef) and
  326. (defcoll.paratype.def.deftype=orddef) and
  327. (left.resulttype.def.size=defcoll.paratype.def.size)
  328. ) and
  329. { an implicit pointer conversion is allowed }
  330. not(
  331. (left.resulttype.def.deftype=pointerdef) and
  332. (defcoll.paratype.def.deftype=pointerdef)
  333. ) and
  334. { child classes can be also passed }
  335. not(
  336. (left.resulttype.def.deftype=objectdef) and
  337. (defcoll.paratype.def.deftype=objectdef) and
  338. tobjectdef(left.resulttype.def).is_related(tobjectdef(defcoll.paratype.def))
  339. ) and
  340. { passing a single element to a openarray of the same type }
  341. not(
  342. (is_open_array(defcoll.paratype.def) and
  343. is_equal(tarraydef(defcoll.paratype.def).elementtype.def,left.resulttype.def))
  344. ) and
  345. { an implicit file conversion is also allowed }
  346. { from a typed file to an untyped one }
  347. not(
  348. (left.resulttype.def.deftype=filedef) and
  349. (defcoll.paratype.def.deftype=filedef) and
  350. (tfiledef(defcoll.paratype.def).filetyp = ft_untyped) and
  351. (tfiledef(left.resulttype.def).filetyp = ft_typed)
  352. ) and
  353. not(is_equal(left.resulttype.def,defcoll.paratype.def))) then
  354. begin
  355. CGMessagePos2(left.fileinfo,parser_e_call_by_ref_without_typeconv,
  356. left.resulttype.def.typename,defcoll.paratype.def.typename);
  357. end;
  358. { Process open parameters }
  359. if push_high_param(defcoll.paratype.def) then
  360. begin
  361. { insert type conv but hold the ranges of the array }
  362. oldtype:=left.resulttype;
  363. inserttypeconv(left,defcoll.paratype);
  364. left.resulttype:=oldtype;
  365. end
  366. else
  367. begin
  368. inserttypeconv(left,defcoll.paratype);
  369. end;
  370. if codegenerror then
  371. begin
  372. dec(parsing_para_level);
  373. exit;
  374. end;
  375. end;
  376. { check var strings }
  377. if (cs_strict_var_strings in aktlocalswitches) and
  378. is_shortstring(left.resulttype.def) and
  379. is_shortstring(defcoll.paratype.def) and
  380. (defcoll.paratyp in [vs_out,vs_var]) and
  381. not(is_open_string(defcoll.paratype.def)) and
  382. not(is_equal(left.resulttype.def,defcoll.paratype.def)) then
  383. begin
  384. aktfilepos:=left.fileinfo;
  385. CGMessage(type_e_strict_var_string_violation);
  386. end;
  387. { Handle formal parameters separate }
  388. if (defcoll.paratype.def.deftype=formaldef) then
  389. begin
  390. case defcoll.paratyp of
  391. vs_var,
  392. vs_out :
  393. begin
  394. if not valid_for_formal_var(left) then
  395. CGMessagePos(left.fileinfo,parser_e_illegal_parameter_list);
  396. end;
  397. vs_const :
  398. begin
  399. if not valid_for_formal_const(left) then
  400. CGMessagePos(left.fileinfo,parser_e_illegal_parameter_list);
  401. end;
  402. end;
  403. end
  404. else
  405. begin
  406. { check if the argument is allowed }
  407. if (defcoll.paratyp in [vs_out,vs_var]) then
  408. valid_for_var(left);
  409. end;
  410. if defcoll.paratyp in [vs_var,vs_const] then
  411. begin
  412. { Causes problems with const ansistrings if also }
  413. { done for vs_const (JM) }
  414. if defcoll.paratyp = vs_var then
  415. set_unique(left);
  416. make_not_regable(left);
  417. end;
  418. { ansistrings out paramaters doesn't need to be }
  419. { unique, they are finalized }
  420. if defcoll.paratyp=vs_out then
  421. make_not_regable(left);
  422. if do_count then
  423. begin
  424. { not completly proper, but avoids some warnings }
  425. if (defcoll.paratyp in [vs_var,vs_out]) then
  426. set_funcret_is_valid(left);
  427. set_varstate(left,not(defcoll.paratyp in [vs_var,vs_out]));
  428. end;
  429. { must only be done after typeconv PM }
  430. resulttype:=defcoll.paratype;
  431. dec(parsing_para_level);
  432. {$ifdef extdebug}
  433. if do_count then
  434. count_ref:=store_count_ref;
  435. {$endif def extdebug}
  436. end;
  437. procedure tcallparanode.det_registers;
  438. var
  439. old_get_para_resulttype : boolean;
  440. old_array_constructor : boolean;
  441. begin
  442. if assigned(right) then
  443. begin
  444. tcallparanode(right).det_registers;
  445. registers32:=right.registers32;
  446. registersfpu:=right.registersfpu;
  447. {$ifdef SUPPORT_MMX}
  448. registersmmx:=right.registersmmx;
  449. {$endif}
  450. end;
  451. old_array_constructor:=allow_array_constructor;
  452. old_get_para_resulttype:=get_para_resulttype;
  453. get_para_resulttype:=true;
  454. allow_array_constructor:=true;
  455. firstpass(left);
  456. get_para_resulttype:=old_get_para_resulttype;
  457. allow_array_constructor:=old_array_constructor;
  458. if left.registers32>registers32 then
  459. registers32:=left.registers32;
  460. if left.registersfpu>registersfpu then
  461. registersfpu:=left.registersfpu;
  462. {$ifdef SUPPORT_MMX}
  463. if left.registersmmx>registersmmx then
  464. registersmmx:=left.registersmmx;
  465. {$endif SUPPORT_MMX}
  466. end;
  467. procedure tcallparanode.firstcallparan(defcoll : tparaitem;do_count : boolean);
  468. begin
  469. if not assigned(left.resulttype.def) then
  470. begin
  471. get_paratype;
  472. if assigned(defcoll) then
  473. insert_typeconv(defcoll,do_count);
  474. end;
  475. det_registers;
  476. end;
  477. procedure tcallparanode.gen_high_tree(openstring:boolean);
  478. var
  479. temp: tnode;
  480. len : integer;
  481. loadconst : boolean;
  482. begin
  483. if assigned(hightree) then
  484. exit;
  485. len:=-1;
  486. loadconst:=true;
  487. case left.resulttype.def.deftype of
  488. arraydef :
  489. begin
  490. { handle via a normal inline in_high_x node }
  491. loadconst := false;
  492. hightree := geninlinenode(in_high_x,false,left.getcopy);
  493. { only substract low(array) if it's <> 0 }
  494. temp := geninlinenode(in_low_x,false,left.getcopy);
  495. firstpass(temp);
  496. if (temp.nodetype <> ordconstn) or
  497. (tordconstnode(temp).value <> 0) then
  498. hightree := caddnode.create(subn,hightree,temp)
  499. else
  500. temp.free;
  501. end;
  502. stringdef :
  503. begin
  504. if openstring then
  505. begin
  506. { handle via a normal inline in_high_x node }
  507. loadconst := false;
  508. hightree := geninlinenode(in_high_x,false,left.getcopy);
  509. end
  510. else
  511. { passing a string to an array of char }
  512. begin
  513. if (left.nodetype=stringconstn) then
  514. begin
  515. len:=str_length(left);
  516. if len>0 then
  517. dec(len);
  518. end
  519. else
  520. begin
  521. hightree:=caddnode.create(subn,geninlinenode(in_length_x,false,left.getcopy),
  522. cordconstnode.create(1,s32bittype));
  523. loadconst:=false;
  524. end;
  525. end;
  526. end;
  527. else
  528. len:=0;
  529. end;
  530. if loadconst then
  531. hightree:=cordconstnode.create(len,s32bittype)
  532. else
  533. hightree:=ctypeconvnode.create(hightree,s32bittype);
  534. firstpass(hightree);
  535. end;
  536. function tcallparanode.docompare(p: tnode): boolean;
  537. begin
  538. docompare :=
  539. inherited docompare(p) and
  540. (callparaflags = tcallparanode(p).callparaflags) and
  541. hightree.isequal(tcallparanode(p).hightree);
  542. end;
  543. {****************************************************************************
  544. TCALLNODE
  545. ****************************************************************************}
  546. constructor tcallnode.create(l:tnode;v : tprocsym;st : tsymtable; mp : tnode);
  547. begin
  548. inherited create(calln,l,nil);
  549. symtableprocentry:=v;
  550. symtableproc:=st;
  551. include(flags,nf_return_value_used);
  552. methodpointer:=mp;
  553. procdefinition:=nil;
  554. restypeset := false;
  555. end;
  556. constructor tcallnode.createintern(const name: string; params: tnode);
  557. var
  558. srsym: tsym;
  559. symowner: tsymtable;
  560. begin
  561. if not (cs_compilesystem in aktmoduleswitches) then
  562. begin
  563. srsym := searchsymonlyin(systemunit,name);
  564. symowner := systemunit;
  565. end
  566. else
  567. begin
  568. searchsym(name,srsym,symowner);
  569. if not assigned(srsym) then
  570. searchsym(upper(name),srsym,symowner);
  571. end;
  572. if not assigned(srsym) or
  573. (srsym.typ <> procsym) then
  574. begin
  575. writeln('unknown compilerproc ',name);
  576. internalerror(200107271);
  577. end;
  578. self.create(params,tprocsym(srsym),symowner,nil);
  579. end;
  580. constructor tcallnode.createinternres(const name: string; params: tnode; const res: ttype);
  581. begin
  582. self.createintern(name,params);
  583. restype := res;
  584. restypeset := true;
  585. { both the normal and specified resulttype either have to be returned via a }
  586. { parameter or not, but no mixing (JM) }
  587. if ret_in_param(restype.def) xor ret_in_param(symtableprocentry.defs^.def.rettype.def) then
  588. internalerror(200108291);
  589. end;
  590. destructor tcallnode.destroy;
  591. begin
  592. methodpointer.free;
  593. inherited destroy;
  594. end;
  595. procedure tcallnode.set_procvar(procvar:tnode);
  596. begin
  597. right:=procvar;
  598. end;
  599. function tcallnode.getcopy : tnode;
  600. var
  601. n : tcallnode;
  602. begin
  603. n:=tcallnode(inherited getcopy);
  604. n.symtableprocentry:=symtableprocentry;
  605. n.symtableproc:=symtableproc;
  606. n.procdefinition:=procdefinition;
  607. n.restype := restype;
  608. n.restypeset := restypeset;
  609. if assigned(methodpointer) then
  610. n.methodpointer:=methodpointer.getcopy
  611. else
  612. n.methodpointer:=nil;
  613. result:=n;
  614. end;
  615. procedure tcallnode.insertintolist(l : tnodelist);
  616. begin
  617. end;
  618. function tcallnode.det_resulttype:tnode;
  619. type
  620. pprocdefcoll = ^tprocdefcoll;
  621. tprocdefcoll = record
  622. data : tprocdef;
  623. nextpara : tparaitem;
  624. firstpara : tparaitem;
  625. next : pprocdefcoll;
  626. end;
  627. var
  628. hp,procs,hp2 : pprocdefcoll;
  629. pd : pprocdeflist;
  630. oldcallprocdef : tprocdef;
  631. def_from,def_to,conv_to : tdef;
  632. hpt : tnode;
  633. pt : tcallparanode;
  634. exactmatch : boolean;
  635. paralength,lastpara : longint;
  636. lastparatype : tdef;
  637. pdc : tparaitem;
  638. { only Dummy }
  639. hcvt : tconverttype;
  640. label
  641. errorexit;
  642. { check if the resulttype.def from tree p is equal with def, needed
  643. for stringconstn and formaldef }
  644. function is_equal(p:tcallparanode;def:tdef) : boolean;
  645. begin
  646. { safety check }
  647. if not (assigned(def) or assigned(p.resulttype.def)) then
  648. begin
  649. is_equal:=false;
  650. exit;
  651. end;
  652. { all types can be passed to a formaldef }
  653. is_equal:=(def.deftype=formaldef) or
  654. (types.is_equal(p.resulttype.def,def))
  655. { integer constants are compatible with all integer parameters if
  656. the specified value matches the range }
  657. or
  658. (
  659. (tbinarynode(p).left.nodetype=ordconstn) and
  660. is_integer(p.resulttype.def) and
  661. is_integer(def) and
  662. (tordconstnode(p.left).value>=torddef(def).low) and
  663. (tordconstnode(p.left).value<=torddef(def).high)
  664. )
  665. { to support ansi/long/wide strings in a proper way }
  666. { string and string[10] are assumed as equal }
  667. { when searching the correct overloaded procedure }
  668. or
  669. (
  670. (def.deftype=stringdef) and (p.resulttype.def.deftype=stringdef) and
  671. (tstringdef(def).string_typ=tstringdef(p.resulttype.def).string_typ)
  672. )
  673. or
  674. (
  675. (p.left.nodetype=stringconstn) and
  676. (is_ansistring(p.resulttype.def) and is_pchar(def))
  677. )
  678. or
  679. (
  680. (p.left.nodetype=ordconstn) and
  681. (is_char(p.resulttype.def) and (is_shortstring(def) or is_ansistring(def)))
  682. )
  683. { set can also be a not yet converted array constructor }
  684. or
  685. (
  686. (def.deftype=setdef) and (p.resulttype.def.deftype=arraydef) and
  687. (tarraydef(p.resulttype.def).IsConstructor) and not(tarraydef(p.resulttype.def).IsVariant)
  688. )
  689. { in tp7 mode proc -> procvar is allowed }
  690. or
  691. (
  692. (m_tp_procvar in aktmodeswitches) and
  693. (def.deftype=procvardef) and (p.left.nodetype=calln) and
  694. (proc_to_procvar_equal(tprocdef(tcallnode(p.left).procdefinition),tprocvardef(def),false))
  695. )
  696. ;
  697. end;
  698. var
  699. i : longint;
  700. found,
  701. is_const : boolean;
  702. bestord : torddef;
  703. srprocsym : tprocsym;
  704. srsymtable : tsymtable;
  705. begin
  706. result:=nil;
  707. procs:=nil;
  708. oldcallprocdef:=aktcallprocdef;
  709. aktcallprocdef:=nil;
  710. { determine length of parameter list }
  711. pt:=tcallparanode(left);
  712. paralength:=0;
  713. while assigned(pt) do
  714. begin
  715. inc(paralength);
  716. pt:=tcallparanode(pt.right);
  717. end;
  718. { determine the type of the parameters }
  719. if assigned(left) then
  720. begin
  721. tcallparanode(left).get_paratype;
  722. if codegenerror then
  723. goto errorexit;
  724. end;
  725. { procedure variable ? }
  726. if assigned(right) then
  727. begin
  728. set_varstate(right,true);
  729. resulttypepass(right);
  730. if codegenerror then
  731. exit;
  732. procdefinition:=tabstractprocdef(right.resulttype.def);
  733. { check the amount of parameters }
  734. pdc:=tparaitem(procdefinition.Para.first);
  735. pt:=tcallparanode(left);
  736. lastpara:=paralength;
  737. while assigned(pdc) and assigned(pt) do
  738. begin
  739. { only goto next para if we're out of the varargs }
  740. if not(po_varargs in procdefinition.procoptions) or
  741. (lastpara<=procdefinition.maxparacount) then
  742. pdc:=tparaitem(pdc.next);
  743. pt:=tcallparanode(pt.right);
  744. dec(lastpara);
  745. end;
  746. if assigned(pt) or assigned(pdc) then
  747. begin
  748. if assigned(pt) then
  749. aktfilepos:=pt.fileinfo;
  750. CGMessage(parser_e_wrong_parameter_size);
  751. end;
  752. end
  753. else
  754. { not a procedure variable }
  755. begin
  756. { do we know the procedure to call ? }
  757. if not(assigned(procdefinition)) then
  758. begin
  759. { when the definition has overload directive set, we search for
  760. overloaded definitions in the class, this only needs to be done once
  761. for class entries as the tree keeps always the same }
  762. if (not symtableprocentry.overloadchecked) and
  763. (po_overload in symtableprocentry.defs^.def.procoptions) and
  764. (symtableprocentry.owner.symtabletype=objectsymtable) then
  765. search_class_overloads(symtableprocentry);
  766. { link all procedures which have the same # of parameters }
  767. pd:=symtableprocentry.defs;
  768. while assigned(pd) do
  769. begin
  770. { only when the # of parameter are supported by the
  771. procedure }
  772. if (paralength>=pd^.def.minparacount) and
  773. ((po_varargs in pd^.def.procoptions) or { varargs }
  774. (paralength<=pd^.def.maxparacount)) then
  775. begin
  776. new(hp);
  777. hp^.data:=pd^.def;
  778. hp^.next:=procs;
  779. hp^.firstpara:=tparaitem(pd^.def.Para.first);
  780. if not(po_varargs in pd^.def.procoptions) then
  781. begin
  782. { if not all parameters are given, then skip the
  783. default parameters }
  784. for i:=1 to pd^.def.maxparacount-paralength do
  785. hp^.firstpara:=tparaitem(hp^.firstPara.next);
  786. end;
  787. hp^.nextpara:=hp^.firstpara;
  788. procs:=hp;
  789. end;
  790. pd:=pd^.next;
  791. end;
  792. { when the definition has overload directive set, we search for
  793. overloaded definitions in the symtablestack. The found
  794. entries are only added to the procs list and not the procsym, because
  795. the list can change in every situation }
  796. if (po_overload in symtableprocentry.defs^.def.procoptions) and
  797. (symtableprocentry.owner.symtabletype<>objectsymtable) then
  798. begin
  799. srsymtable:=symtableprocentry.owner.next;
  800. while assigned(srsymtable) do
  801. begin
  802. if srsymtable.symtabletype in [localsymtable,staticsymtable,globalsymtable] then
  803. begin
  804. srprocsym:=tprocsym(srsymtable.speedsearch(symtableprocentry.name,symtableprocentry.speedvalue));
  805. { process only visible procsyms }
  806. if assigned(srprocsym) and
  807. (srprocsym.typ=procsym) and
  808. srprocsym.is_visible_for_proc(aktprocdef) then
  809. begin
  810. { if this procedure doesn't have overload we can stop
  811. searching }
  812. if not(po_overload in srprocsym.defs^.def.procoptions) then
  813. break;
  814. { process all overloaded definitions }
  815. pd:=srprocsym.defs;
  816. while assigned(pd) do
  817. begin
  818. { only when the # of parameter are supported by the
  819. procedure }
  820. if (paralength>=pd^.def.minparacount) and
  821. ((po_varargs in pd^.def.procoptions) or { varargs }
  822. (paralength<=pd^.def.maxparacount)) then
  823. begin
  824. found:=false;
  825. hp:=procs;
  826. while assigned(hp) do
  827. begin
  828. if equal_paras(hp^.data.para,pd^.def.para,cp_value_equal_const) then
  829. begin
  830. found:=true;
  831. break;
  832. end;
  833. hp:=hp^.next;
  834. end;
  835. if not found then
  836. begin
  837. new(hp);
  838. hp^.data:=pd^.def;
  839. hp^.next:=procs;
  840. hp^.firstpara:=tparaitem(pd^.def.Para.first);
  841. if not(po_varargs in pd^.def.procoptions) then
  842. begin
  843. { if not all parameters are given, then skip the
  844. default parameters }
  845. for i:=1 to pd^.def.maxparacount-paralength do
  846. hp^.firstpara:=tparaitem(hp^.firstPara.next);
  847. end;
  848. hp^.nextpara:=hp^.firstpara;
  849. procs:=hp;
  850. end;
  851. end;
  852. pd:=pd^.next;
  853. end;
  854. end;
  855. end;
  856. srsymtable:=srsymtable.next;
  857. end;
  858. end;
  859. { no procedures found? then there is something wrong
  860. with the parameter size }
  861. if not assigned(procs) then
  862. begin
  863. { in tp mode we can try to convert to procvar if
  864. there are no parameters specified }
  865. if not(assigned(left)) and
  866. (m_tp_procvar in aktmodeswitches) then
  867. begin
  868. hpt:=cloadnode.create(tprocsym(symtableprocentry),symtableproc);
  869. if (symtableprocentry.owner.symtabletype=objectsymtable) and
  870. assigned(methodpointer) then
  871. tloadnode(hpt).set_mp(methodpointer.getcopy);
  872. resulttypepass(hpt);
  873. result:=hpt;
  874. end
  875. else
  876. begin
  877. if assigned(left) then
  878. aktfilepos:=left.fileinfo;
  879. CGMessage(parser_e_wrong_parameter_size);
  880. symtableprocentry.write_parameter_lists(nil);
  881. end;
  882. goto errorexit;
  883. end;
  884. { now we can compare parameter after parameter }
  885. pt:=tcallparanode(left);
  886. { we start with the last parameter }
  887. lastpara:=paralength+1;
  888. lastparatype:=nil;
  889. while assigned(pt) do
  890. begin
  891. dec(lastpara);
  892. { walk all procedures and determine how this parameter matches and set:
  893. 1. pt.exact_match_found if one parameter has an exact match
  894. 2. exactmatch if an equal or exact match is found
  895. 3. Para.argconvtyp to exact,equal or convertable
  896. (when convertable then also convertlevel is set)
  897. 4. pt.convlevel1found if there is a convertlevel=1
  898. 5. pt.convlevel2found if there is a convertlevel=2
  899. }
  900. exactmatch:=false;
  901. hp:=procs;
  902. while assigned(hp) do
  903. begin
  904. { varargs are always equal, but not exact }
  905. if (po_varargs in hp^.data.procoptions) and
  906. (lastpara>hp^.data.minparacount) then
  907. begin
  908. hp^.nextPara.argconvtyp:=act_equal;
  909. exactmatch:=true;
  910. end
  911. else
  912. begin
  913. if is_equal(pt,hp^.nextPara.paratype.def) then
  914. begin
  915. if hp^.nextPara.paratype.def=pt.resulttype.def then
  916. begin
  917. include(pt.callparaflags,cpf_exact_match_found);
  918. hp^.nextPara.argconvtyp:=act_exact;
  919. end
  920. else
  921. hp^.nextPara.argconvtyp:=act_equal;
  922. exactmatch:=true;
  923. end
  924. else
  925. begin
  926. hp^.nextPara.argconvtyp:=act_convertable;
  927. hp^.nextPara.convertlevel:=isconvertable(pt.resulttype.def,hp^.nextPara.paratype.def,
  928. hcvt,pt.left.nodetype,false);
  929. case hp^.nextPara.convertlevel of
  930. 1 : include(pt.callparaflags,cpf_convlevel1found);
  931. 2 : include(pt.callparaflags,cpf_convlevel2found);
  932. end;
  933. end;
  934. end;
  935. hp:=hp^.next;
  936. end;
  937. { If there was an exactmatch then delete all convertables }
  938. if exactmatch then
  939. begin
  940. hp:=procs;
  941. procs:=nil;
  942. while assigned(hp) do
  943. begin
  944. hp2:=hp^.next;
  945. { keep if not convertable }
  946. if (hp^.nextPara.argconvtyp<>act_convertable) then
  947. begin
  948. hp^.next:=procs;
  949. procs:=hp;
  950. end
  951. else
  952. dispose(hp);
  953. hp:=hp2;
  954. end;
  955. end
  956. else
  957. { No exact match was found, remove all procedures that are
  958. not convertable (convertlevel=0) }
  959. begin
  960. hp:=procs;
  961. procs:=nil;
  962. while assigned(hp) do
  963. begin
  964. hp2:=hp^.next;
  965. { keep if not convertable }
  966. if (hp^.nextPara.convertlevel<>0) then
  967. begin
  968. hp^.next:=procs;
  969. procs:=hp;
  970. end
  971. else
  972. begin
  973. { save the type for nice error message }
  974. lastparatype:=hp^.nextPara.paratype.def;
  975. dispose(hp);
  976. end;
  977. hp:=hp2;
  978. end;
  979. end;
  980. { update nextpara for all procedures }
  981. hp:=procs;
  982. while assigned(hp) do
  983. begin
  984. { only goto next para if we're out of the varargs }
  985. if not(po_varargs in hp^.data.procoptions) or
  986. (lastpara<=hp^.data.maxparacount) then
  987. hp^.nextpara:=tparaitem(hp^.nextPara.next);
  988. hp:=hp^.next;
  989. end;
  990. { load next parameter or quit loop if no procs left }
  991. if assigned(procs) then
  992. pt:=tcallparanode(pt.right)
  993. else
  994. break;
  995. end;
  996. { All parameters are checked, check if there are any
  997. procedures left }
  998. if not assigned(procs) then
  999. begin
  1000. { there is an error, must be wrong type, because
  1001. wrong size is already checked (PFV) }
  1002. if (not assigned(lastparatype)) or
  1003. (not assigned(pt)) or
  1004. (not assigned(pt.resulttype.def)) then
  1005. internalerror(39393)
  1006. else
  1007. begin
  1008. aktfilepos:=pt.fileinfo;
  1009. CGMessage3(type_e_wrong_parameter_type,tostr(lastpara),
  1010. pt.resulttype.def.typename,lastparatype.typename);
  1011. end;
  1012. symtableprocentry.write_parameter_lists(nil);
  1013. goto errorexit;
  1014. end;
  1015. { if there are several choices left then for orddef }
  1016. { if a type is totally included in the other }
  1017. { we don't fear an overflow , }
  1018. { so we can do as if it is an exact match }
  1019. { this will convert integer to longint }
  1020. { rather than to words }
  1021. { conversion of byte to integer or longint }
  1022. { would still not be solved }
  1023. if assigned(procs) and assigned(procs^.next) then
  1024. begin
  1025. hp:=procs;
  1026. while assigned(hp) do
  1027. begin
  1028. hp^.nextpara:=hp^.firstpara;
  1029. hp:=hp^.next;
  1030. end;
  1031. pt:=tcallparanode(left);
  1032. while assigned(pt) do
  1033. begin
  1034. { matches a parameter of one procedure exact ? }
  1035. exactmatch:=false;
  1036. def_from:=pt.resulttype.def;
  1037. hp:=procs;
  1038. while assigned(hp) do
  1039. begin
  1040. if not is_equal(pt,hp^.nextPara.paratype.def) then
  1041. begin
  1042. def_to:=hp^.nextPara.paratype.def;
  1043. if ((def_from.deftype=orddef) and (def_to.deftype=orddef)) and
  1044. (is_in_limit(def_from,def_to) or
  1045. ((hp^.nextPara.paratyp in [vs_var,vs_out]) and
  1046. (def_from.size=def_to.size))) then
  1047. begin
  1048. exactmatch:=true;
  1049. conv_to:=def_to;
  1050. { there's no use in continuing the search, it will }
  1051. { only result in conv_to being overwritten }
  1052. break;
  1053. end;
  1054. end;
  1055. hp:=hp^.next;
  1056. end;
  1057. { .... if yes, del all the other procedures }
  1058. if exactmatch then
  1059. begin
  1060. { the first .... }
  1061. while (assigned(procs)) and not(is_in_limit(def_from,procs^.nextPara.paratype.def)) do
  1062. begin
  1063. hp:=procs^.next;
  1064. dispose(procs);
  1065. procs:=hp;
  1066. end;
  1067. { and the others }
  1068. hp:=procs;
  1069. while (assigned(hp)) and assigned(hp^.next) do
  1070. begin
  1071. def_to:=hp^.next^.nextPara.paratype.def;
  1072. if not(is_in_limit(def_from,def_to)) then
  1073. begin
  1074. hp2:=hp^.next^.next;
  1075. dispose(hp^.next);
  1076. hp^.next:=hp2;
  1077. end
  1078. else
  1079. begin
  1080. { did we possibly find a better match? }
  1081. if (conv_to.size>def_to.size) or
  1082. is_in_limit(def_to,conv_to) then
  1083. begin
  1084. { is it the same as the previous best? }
  1085. if not types.is_equal(def_to,conv_to) then
  1086. begin
  1087. { no -> remove all previous best matches }
  1088. hp := hp^.next;
  1089. while procs <> hp do
  1090. begin
  1091. hp2 := procs;
  1092. procs := procs^.next;
  1093. dispose(hp2);
  1094. end;
  1095. { set new match type }
  1096. conv_to:=def_to;
  1097. end
  1098. { the new one matches just as well as the }
  1099. { old one -> keep both }
  1100. else
  1101. hp := hp^.next;
  1102. end
  1103. { not a better match -> remove }
  1104. else
  1105. begin
  1106. hp2 := hp^.next^.next;
  1107. dispose(hp^.next);
  1108. hp^.next:=hp2;
  1109. end;
  1110. end;
  1111. end;
  1112. end;
  1113. { update nextpara for all procedures }
  1114. hp:=procs;
  1115. while assigned(hp) do
  1116. begin
  1117. hp^.nextpara:=tparaitem(hp^.nextPara.next);
  1118. hp:=hp^.next;
  1119. end;
  1120. pt:=tcallparanode(pt.right);
  1121. end;
  1122. end;
  1123. { let's try to eliminate equal if there is an exact match
  1124. is there }
  1125. if assigned(procs) and assigned(procs^.next) then
  1126. begin
  1127. { reset nextpara for all procs left }
  1128. hp:=procs;
  1129. while assigned(hp) do
  1130. begin
  1131. hp^.nextpara:=hp^.firstpara;
  1132. hp:=hp^.next;
  1133. end;
  1134. pt:=tcallparanode(left);
  1135. while assigned(pt) do
  1136. begin
  1137. if cpf_exact_match_found in pt.callparaflags then
  1138. begin
  1139. hp:=procs;
  1140. procs:=nil;
  1141. while assigned(hp) do
  1142. begin
  1143. hp2:=hp^.next;
  1144. { keep the exact matches, dispose the others }
  1145. if (hp^.nextPara.argconvtyp=act_exact) then
  1146. begin
  1147. hp^.next:=procs;
  1148. procs:=hp;
  1149. end
  1150. else
  1151. dispose(hp);
  1152. hp:=hp2;
  1153. end;
  1154. end;
  1155. { update nextpara for all procedures }
  1156. hp:=procs;
  1157. while assigned(hp) do
  1158. begin
  1159. hp^.nextpara:=tparaitem(hp^.nextPara.next);
  1160. hp:=hp^.next;
  1161. end;
  1162. pt:=tcallparanode(pt.right);
  1163. end;
  1164. end;
  1165. { Check if there are integer constant to integer
  1166. parameters then choose the best matching integer
  1167. parameter and remove the others, this is Delphi
  1168. compatible. 1 = byte, 256 = word, etc. }
  1169. if assigned(procs) and assigned(procs^.next) then
  1170. begin
  1171. { reset nextpara for all procs left }
  1172. hp:=procs;
  1173. while assigned(hp) do
  1174. begin
  1175. hp^.nextpara:=hp^.firstpara;
  1176. hp:=hp^.next;
  1177. end;
  1178. pt:=tcallparanode(left);
  1179. while assigned(pt) do
  1180. begin
  1181. bestord:=nil;
  1182. if (pt.left.nodetype=ordconstn) and
  1183. is_integer(pt.resulttype.def) then
  1184. begin
  1185. hp:=procs;
  1186. while assigned(hp) do
  1187. begin
  1188. def_to:=hp^.nextPara.paratype.def;
  1189. { to be sure, it couldn't be something else,
  1190. also the defs here are all in the range
  1191. so now find the closest range }
  1192. if not is_integer(def_to) then
  1193. internalerror(43297815);
  1194. if (not assigned(bestord)) or
  1195. ((torddef(def_to).low>bestord.low) or
  1196. (torddef(def_to).high<bestord.high)) then
  1197. bestord:=torddef(def_to);
  1198. hp:=hp^.next;
  1199. end;
  1200. end;
  1201. { if a bestmatch is found then remove the other
  1202. procs which don't match the bestord }
  1203. if assigned(bestord) then
  1204. begin
  1205. hp:=procs;
  1206. procs:=nil;
  1207. while assigned(hp) do
  1208. begin
  1209. hp2:=hp^.next;
  1210. { keep matching bestord, dispose the others }
  1211. if (torddef(hp^.nextPara.paratype.def)=bestord) then
  1212. begin
  1213. hp^.next:=procs;
  1214. procs:=hp;
  1215. end
  1216. else
  1217. dispose(hp);
  1218. hp:=hp2;
  1219. end;
  1220. end;
  1221. { update nextpara for all procedures }
  1222. hp:=procs;
  1223. while assigned(hp) do
  1224. begin
  1225. hp^.nextpara:=tparaitem(hp^.nextPara.next);
  1226. hp:=hp^.next;
  1227. end;
  1228. pt:=tcallparanode(pt.right);
  1229. end;
  1230. end;
  1231. { Check if there are convertlevel 1 and 2 differences
  1232. left for the parameters, then discard all convertlevel
  1233. 2 procedures. The value of convlevelXfound can still
  1234. be used, because all convertables are still here or
  1235. not }
  1236. if assigned(procs) and assigned(procs^.next) then
  1237. begin
  1238. { reset nextpara for all procs left }
  1239. hp:=procs;
  1240. while assigned(hp) do
  1241. begin
  1242. hp^.nextpara:=hp^.firstpara;
  1243. hp:=hp^.next;
  1244. end;
  1245. pt:=tcallparanode(left);
  1246. while assigned(pt) do
  1247. begin
  1248. if (cpf_convlevel1found in pt.callparaflags) and
  1249. (cpf_convlevel2found in pt.callparaflags) then
  1250. begin
  1251. hp:=procs;
  1252. procs:=nil;
  1253. while assigned(hp) do
  1254. begin
  1255. hp2:=hp^.next;
  1256. { keep all not act_convertable and all convertlevels=1 }
  1257. if (hp^.nextPara.argconvtyp<>act_convertable) or
  1258. (hp^.nextPara.convertlevel=1) then
  1259. begin
  1260. hp^.next:=procs;
  1261. procs:=hp;
  1262. end
  1263. else
  1264. dispose(hp);
  1265. hp:=hp2;
  1266. end;
  1267. end;
  1268. { update nextpara for all procedures }
  1269. hp:=procs;
  1270. while assigned(hp) do
  1271. begin
  1272. hp^.nextpara:=tparaitem(hp^.nextPara.next);
  1273. hp:=hp^.next;
  1274. end;
  1275. pt:=tcallparanode(pt.right);
  1276. end;
  1277. end;
  1278. if not(assigned(procs)) or assigned(procs^.next) then
  1279. begin
  1280. CGMessage(cg_e_cant_choose_overload_function);
  1281. symtableprocentry.write_parameter_lists(nil);
  1282. goto errorexit;
  1283. end;
  1284. if make_ref then
  1285. begin
  1286. procs^.data.lastref:=tref.create(procs^.data.lastref,@fileinfo);
  1287. inc(procs^.data.refcount);
  1288. if procs^.data.defref=nil then
  1289. procs^.data.defref:=procs^.data.lastref;
  1290. end;
  1291. procdefinition:=procs^.data;
  1292. { big error for with statements
  1293. symtableproc:=procdefinition.owner;
  1294. but neede for overloaded operators !! }
  1295. if symtableproc=nil then
  1296. symtableproc:=procdefinition.owner;
  1297. end; { end of procedure to call determination }
  1298. { add needed default parameters }
  1299. if assigned(procs) and
  1300. (paralength<procdefinition.maxparacount) then
  1301. begin
  1302. { add default parameters, just read back the skipped
  1303. paras starting from firstPara.previous, when not available
  1304. (all parameters are default) then start with the last
  1305. parameter and read backward (PFV) }
  1306. if not assigned(procs^.firstpara) then
  1307. pdc:=tparaitem(procs^.data.Para.last)
  1308. else
  1309. pdc:=tparaitem(procs^.firstPara.previous);
  1310. while assigned(pdc) do
  1311. begin
  1312. if not assigned(pdc.defaultvalue) then
  1313. internalerror(751349858);
  1314. left:=ccallparanode.create(genconstsymtree(tconstsym(pdc.defaultvalue)),left);
  1315. pdc:=tparaitem(pdc.previous);
  1316. end;
  1317. end;
  1318. end;
  1319. { handle predefined procedures }
  1320. is_const:=(procdefinition.proccalloption=pocall_internconst) and
  1321. ((block_type in [bt_const,bt_type]) or
  1322. (assigned(left) and (tcallparanode(left).left.nodetype in [realconstn,ordconstn])));
  1323. if (procdefinition.proccalloption=pocall_internproc) or is_const then
  1324. begin
  1325. if assigned(left) then
  1326. begin
  1327. { ptr and settextbuf needs two args }
  1328. if assigned(tcallparanode(left).right) then
  1329. begin
  1330. hpt:=geninlinenode(tprocdef(procdefinition).extnumber,is_const,left);
  1331. left:=nil;
  1332. end
  1333. else
  1334. begin
  1335. hpt:=geninlinenode(tprocdef(procdefinition).extnumber,is_const,tcallparanode(left).left);
  1336. tcallparanode(left).left:=nil;
  1337. end;
  1338. end
  1339. else
  1340. hpt:=geninlinenode(tprocdef(procdefinition).extnumber,is_const,nil);
  1341. result:=hpt;
  1342. goto errorexit;
  1343. end;
  1344. { Calling a message method directly ? }
  1345. if assigned(procdefinition) and
  1346. (po_containsself in procdefinition.procoptions) then
  1347. message(cg_e_cannot_call_message_direct);
  1348. { ensure that the result type is set }
  1349. if not restypeset then
  1350. resulttype:=procdefinition.rettype
  1351. else
  1352. resulttype:=restype;
  1353. { get a register for the return value }
  1354. if (not is_void(resulttype.def)) then
  1355. begin
  1356. if ret_in_acc(resulttype.def) then
  1357. begin
  1358. { wide- and ansistrings are returned in EAX }
  1359. { but they are imm. moved to a memory location }
  1360. if is_widestring(resulttype.def) or
  1361. is_ansistring(resulttype.def) then
  1362. begin
  1363. { we use ansistrings so no fast exit here }
  1364. procinfo^.no_fast_exit:=true;
  1365. end;
  1366. end;
  1367. end;
  1368. { constructors return their current class type, not the type where the
  1369. constructor is declared, this can be different because of inheritance }
  1370. if (procdefinition.proctypeoption=potype_constructor) then
  1371. begin
  1372. if assigned(methodpointer) and
  1373. assigned(methodpointer.resulttype.def) and
  1374. (methodpointer.resulttype.def.deftype=classrefdef) then
  1375. resulttype:=tclassrefdef(methodpointer.resulttype.def).pointertype;
  1376. end;
  1377. { flag all callparanodes that belong to the varargs }
  1378. if (po_varargs in procdefinition.procoptions) then
  1379. begin
  1380. pt:=tcallparanode(left);
  1381. i:=paralength;
  1382. while (i>procdefinition.maxparacount) do
  1383. begin
  1384. include(tcallparanode(pt).flags,nf_varargs_para);
  1385. pt:=tcallparanode(pt.right);
  1386. dec(i);
  1387. end;
  1388. end;
  1389. { insert type conversions }
  1390. if assigned(left) then
  1391. begin
  1392. aktcallprocdef:=tprocdef(procdefinition);
  1393. tcallparanode(left).insert_typeconv(tparaitem(procdefinition.Para.first),true);
  1394. end;
  1395. errorexit:
  1396. { Reset some settings back }
  1397. if assigned(procs) then
  1398. dispose(procs);
  1399. aktcallprocdef:=oldcallprocdef;
  1400. end;
  1401. function tcallnode.pass_1 : tnode;
  1402. var
  1403. inlinecode : tnode;
  1404. inlined : boolean;
  1405. {$ifdef m68k}
  1406. regi : tregister;
  1407. {$endif}
  1408. method_must_be_valid : boolean;
  1409. label
  1410. errorexit;
  1411. begin
  1412. result:=nil;
  1413. inlined:=false;
  1414. inlinecode := nil;
  1415. { work trough all parameters to get the register requirements }
  1416. if assigned(left) then
  1417. tcallparanode(left).det_registers;
  1418. if assigned(procdefinition) and
  1419. (procdefinition.proccalloption=pocall_inline) then
  1420. begin
  1421. inlinecode:=right;
  1422. if assigned(inlinecode) then
  1423. inlined:=true;
  1424. right:=nil;
  1425. end;
  1426. { procedure variable ? }
  1427. if assigned(right) then
  1428. begin
  1429. firstpass(right);
  1430. { procedure does a call }
  1431. if not (block_type in [bt_const,bt_type]) then
  1432. procinfo^.flags:=procinfo^.flags or pi_do_call;
  1433. rg.incrementregisterpushed(all_registers);
  1434. end
  1435. else
  1436. { not a procedure variable }
  1437. begin
  1438. location.loc:=LOC_CREFERENCE;
  1439. { calc the correture value for the register }
  1440. { handle predefined procedures }
  1441. if (procdefinition.proccalloption=pocall_inline) then
  1442. begin
  1443. if assigned(methodpointer) then
  1444. CGMessage(cg_e_unable_inline_object_methods);
  1445. if assigned(right) and (right.nodetype<>procinlinen) then
  1446. CGMessage(cg_e_unable_inline_procvar);
  1447. { nodetype:=procinlinen; }
  1448. if not assigned(right) then
  1449. begin
  1450. if assigned(tprocdef(procdefinition).code) then
  1451. inlinecode:=cprocinlinenode.create(self,tnode(tprocdef(procdefinition).code))
  1452. else
  1453. CGMessage(cg_e_no_code_for_inline_stored);
  1454. if assigned(inlinecode) then
  1455. begin
  1456. { consider it has not inlined if called
  1457. again inside the args }
  1458. procdefinition.proccalloption:=pocall_fpccall;
  1459. firstpass(inlinecode);
  1460. inlined:=true;
  1461. end;
  1462. end;
  1463. end
  1464. else
  1465. begin
  1466. if not (block_type in [bt_const,bt_type]) then
  1467. procinfo^.flags:=procinfo^.flags or pi_do_call;
  1468. end;
  1469. { for the PowerPC standard calling conventions this information isn't necassary (FK) }
  1470. { It doesn't hurt to calculate it already though :) (JM) }
  1471. rg.incrementregisterpushed(tprocdef(procdefinition).usedregisters);
  1472. end;
  1473. { get a register for the return value }
  1474. if (not is_void(resulttype.def)) then
  1475. begin
  1476. if (procdefinition.proctypeoption=potype_constructor) then
  1477. begin
  1478. { extra handling of classes }
  1479. { methodpointer should be assigned! }
  1480. if assigned(methodpointer) and
  1481. assigned(methodpointer.resulttype.def) and
  1482. (methodpointer.resulttype.def.deftype=classrefdef) then
  1483. begin
  1484. location.loc:=LOC_REGISTER;
  1485. registers32:=1;
  1486. end
  1487. { a object constructor returns the result with the flags }
  1488. else
  1489. location.loc:=LOC_FLAGS;
  1490. end
  1491. else
  1492. begin
  1493. {$ifdef SUPPORT_MMX}
  1494. if (cs_mmx in aktlocalswitches) and
  1495. is_mmx_able_array(resulttype.def) then
  1496. begin
  1497. location.loc:=LOC_MMXREGISTER;
  1498. registersmmx:=1;
  1499. end
  1500. else
  1501. {$endif SUPPORT_MMX}
  1502. if ret_in_acc(resulttype.def) then
  1503. begin
  1504. location.loc:=LOC_REGISTER;
  1505. if is_64bitint(resulttype.def) then
  1506. registers32:=2
  1507. else
  1508. registers32:=1;
  1509. { wide- and ansistrings are returned in EAX }
  1510. { but they are imm. moved to a memory location }
  1511. if is_widestring(resulttype.def) or
  1512. is_ansistring(resulttype.def) then
  1513. begin
  1514. location.loc:=LOC_CREFERENCE;
  1515. registers32:=1;
  1516. end;
  1517. end
  1518. else if (resulttype.def.deftype=floatdef) then
  1519. begin
  1520. location.loc:=LOC_FPUREGISTER;
  1521. {$ifdef m68k}
  1522. if (cs_fp_emulation in aktmoduleswitches) or
  1523. (tfloatdef(resulttype.def).typ=s32real) then
  1524. registers32:=1
  1525. else
  1526. registersfpu:=1;
  1527. {$else not m68k}
  1528. registersfpu:=1;
  1529. {$endif not m68k}
  1530. end
  1531. else
  1532. location.loc:=LOC_CREFERENCE;
  1533. end;
  1534. end;
  1535. { a fpu can be used in any procedure !! }
  1536. registersfpu:=procdefinition.fpu_used;
  1537. { if this is a call to a method calc the registers }
  1538. if (methodpointer<>nil) then
  1539. begin
  1540. case methodpointer.nodetype of
  1541. { but only, if this is not a supporting node }
  1542. typen: ;
  1543. { we need one register for new return value PM }
  1544. hnewn : if registers32=0 then
  1545. registers32:=1;
  1546. else
  1547. begin
  1548. if (procdefinition.proctypeoption in [potype_constructor,potype_destructor]) and
  1549. assigned(symtableproc) and (symtableproc.symtabletype=withsymtable) and
  1550. not twithsymtable(symtableproc).direct_with then
  1551. begin
  1552. CGmessage(cg_e_cannot_call_cons_dest_inside_with);
  1553. end; { Is accepted by Delphi !! }
  1554. { this is not a good reason to accept it in FPC if we produce
  1555. wrong code for it !!! (PM) }
  1556. { R.Assign is not a constructor !!! }
  1557. { but for R^.Assign, R must be valid !! }
  1558. if (procdefinition.proctypeoption=potype_constructor) or
  1559. ((methodpointer.nodetype=loadn) and
  1560. (not(oo_has_virtual in tobjectdef(methodpointer.resulttype.def).objectoptions))) then
  1561. method_must_be_valid:=false
  1562. else
  1563. method_must_be_valid:=true;
  1564. firstpass(methodpointer);
  1565. set_varstate(methodpointer,method_must_be_valid);
  1566. { The object is already used ven if it is called once }
  1567. if (methodpointer.nodetype=loadn) and
  1568. (tloadnode(methodpointer).symtableentry.typ=varsym) then
  1569. tvarsym(tloadnode(methodpointer).symtableentry).varstate:=vs_used;
  1570. registersfpu:=max(methodpointer.registersfpu,registersfpu);
  1571. registers32:=max(methodpointer.registers32,registers32);
  1572. {$ifdef SUPPORT_MMX}
  1573. registersmmx:=max(methodpointer.registersmmx,registersmmx);
  1574. {$endif SUPPORT_MMX}
  1575. end;
  1576. end;
  1577. end;
  1578. if inlined then
  1579. right:=inlinecode;
  1580. { determine the registers of the procedure variable }
  1581. { is this OK for inlined procs also ?? (PM) }
  1582. if assigned(right) then
  1583. begin
  1584. registersfpu:=max(right.registersfpu,registersfpu);
  1585. registers32:=max(right.registers32,registers32);
  1586. {$ifdef SUPPORT_MMX}
  1587. registersmmx:=max(right.registersmmx,registersmmx);
  1588. {$endif SUPPORT_MMX}
  1589. end;
  1590. { determine the registers of the procedure }
  1591. if assigned(left) then
  1592. begin
  1593. registersfpu:=max(left.registersfpu,registersfpu);
  1594. registers32:=max(left.registers32,registers32);
  1595. {$ifdef SUPPORT_MMX}
  1596. registersmmx:=max(left.registersmmx,registersmmx);
  1597. {$endif SUPPORT_MMX}
  1598. end;
  1599. errorexit:
  1600. if inlined then
  1601. procdefinition.proccalloption:=pocall_inline;
  1602. end;
  1603. function tcallnode.docompare(p: tnode): boolean;
  1604. begin
  1605. docompare :=
  1606. inherited docompare(p) and
  1607. (symtableprocentry = tcallnode(p).symtableprocentry) and
  1608. (symtableproc = tcallnode(p).symtableproc) and
  1609. (procdefinition = tcallnode(p).procdefinition) and
  1610. (methodpointer.isequal(tcallnode(p).methodpointer)) and
  1611. ((restypeset and tcallnode(p).restypeset and
  1612. (is_equal(restype.def,tcallnode(p).restype.def))) or
  1613. (not restypeset and not tcallnode(p).restypeset));
  1614. end;
  1615. {****************************************************************************
  1616. TPROCINLINENODE
  1617. ****************************************************************************}
  1618. constructor tprocinlinenode.create(callp,code : tnode);
  1619. begin
  1620. inherited create(procinlinen);
  1621. inlineprocdef:=tcallnode(callp).symtableprocentry.defs^.def;
  1622. retoffset:=-target_info.size_of_pointer; { less dangerous as zero (PM) }
  1623. para_offset:=0;
  1624. para_size:=inlineprocdef.para_size(target_info.alignment.paraalign);
  1625. if ret_in_param(inlineprocdef.rettype.def) then
  1626. inc(para_size,target_info.size_of_pointer);
  1627. { copy args }
  1628. if assigned(code) then
  1629. inlinetree:=code.getcopy
  1630. else inlinetree := nil;
  1631. registers32:=code.registers32;
  1632. registersfpu:=code.registersfpu;
  1633. {$ifdef SUPPORT_MMX}
  1634. registersmmx:=code.registersmmx;
  1635. {$endif SUPPORT_MMX}
  1636. resulttype:=inlineprocdef.rettype;
  1637. end;
  1638. destructor tprocinlinenode.destroy;
  1639. begin
  1640. if assigned(inlinetree) then
  1641. inlinetree.free;
  1642. inherited destroy;
  1643. end;
  1644. function tprocinlinenode.getcopy : tnode;
  1645. var
  1646. n : tprocinlinenode;
  1647. begin
  1648. n:=tprocinlinenode(inherited getcopy);
  1649. if assigned(inlinetree) then
  1650. n.inlinetree:=inlinetree.getcopy
  1651. else
  1652. n.inlinetree:=nil;
  1653. n.inlineprocdef:=inlineprocdef;
  1654. n.retoffset:=retoffset;
  1655. n.para_offset:=para_offset;
  1656. n.para_size:=para_size;
  1657. getcopy:=n;
  1658. end;
  1659. procedure tprocinlinenode.insertintolist(l : tnodelist);
  1660. begin
  1661. end;
  1662. function tprocinlinenode.pass_1 : tnode;
  1663. begin
  1664. result:=nil;
  1665. { left contains the code in tree form }
  1666. { but it has already been firstpassed }
  1667. { so firstpass(left); does not seem required }
  1668. { might be required later if we change the arg handling !! }
  1669. end;
  1670. function tprocinlinenode.docompare(p: tnode): boolean;
  1671. begin
  1672. docompare :=
  1673. inherited docompare(p) and
  1674. inlinetree.isequal(tprocinlinenode(p).inlinetree) and
  1675. (inlineprocdef = tprocinlinenode(p).inlineprocdef);
  1676. end;
  1677. begin
  1678. ccallnode:=tcallnode;
  1679. ccallparanode:=tcallparanode;
  1680. cprocinlinenode:=tprocinlinenode;
  1681. end.
  1682. {
  1683. $Log$
  1684. Revision 1.67 2002-04-02 17:11:28 peter
  1685. * tlocation,treference update
  1686. * LOC_CONSTANT added for better constant handling
  1687. * secondadd splitted in multiple routines
  1688. * location_force_reg added for loading a location to a register
  1689. of a specified size
  1690. * secondassignment parses now first the right and then the left node
  1691. (this is compatible with Kylix). This saves a lot of push/pop especially
  1692. with string operations
  1693. * adapted some routines to use the new cg methods
  1694. Revision 1.66 2002/03/31 20:26:33 jonas
  1695. + a_loadfpu_* and a_loadmm_* methods in tcg
  1696. * register allocation is now handled by a class and is mostly processor
  1697. independent (+rgobj.pas and i386/rgcpu.pas)
  1698. * temp allocation is now handled by a class (+tgobj.pas, -i386\tgcpu.pas)
  1699. * some small improvements and fixes to the optimizer
  1700. * some register allocation fixes
  1701. * some fpuvaroffset fixes in the unary minus node
  1702. * push/popusedregisters is now called rg.save/restoreusedregisters and
  1703. (for i386) uses temps instead of push/pop's when using -Op3 (that code is
  1704. also better optimizable)
  1705. * fixed and optimized register saving/restoring for new/dispose nodes
  1706. * LOC_FPU locations now also require their "register" field to be set to
  1707. R_ST, not R_ST0 (the latter is used for LOC_CFPUREGISTER locations only)
  1708. - list field removed of the tnode class because it's not used currently
  1709. and can cause hard-to-find bugs
  1710. Revision 1.65 2002/03/30 23:02:42 carl
  1711. * avoid crash with inline routines
  1712. Revision 1.64 2002/01/24 18:25:48 peter
  1713. * implicit result variable generation for assembler routines
  1714. * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
  1715. Revision 1.63 2002/01/24 12:33:52 jonas
  1716. * adapted ranges of native types to int64 (e.g. high cardinal is no
  1717. longer longint($ffffffff), but just $fffffff in psystem)
  1718. * small additional fix in 64bit rangecheck code generation for 32 bit
  1719. processors
  1720. * adaption of ranges required the matching talgorithm used for selecting
  1721. which overloaded procedure to call to be adapted. It should now always
  1722. select the closest match for ordinal parameters.
  1723. + inttostr(qword) in sysstr.inc/sysstrh.inc
  1724. + abs(int64), sqr(int64), sqr(qword) in systemh.inc/generic.inc (previous
  1725. fixes were required to be able to add them)
  1726. * is_in_limit() moved from ncal to types unit, should always be used
  1727. instead of direct comparisons of low/high values of orddefs because
  1728. qword is a special case
  1729. Revision 1.62 2002/01/19 11:57:05 peter
  1730. * fixed path appending for lib
  1731. Revision 1.61 2001/12/31 16:59:41 peter
  1732. * protected/private symbols parsing fixed
  1733. Revision 1.60 2001/12/11 13:21:36 jonas
  1734. * fixed to my previous patch: the hightree must always be converted to a
  1735. longint
  1736. Revision 1.59 2001/12/10 14:28:47 jonas
  1737. * gen_high_tree now uses an inline node of type in_high_x in most cases
  1738. so that it doesn't duplicate any code anymore from ninl.pas (and
  1739. dynamic array support was still missing)
  1740. Revision 1.58 2001/11/20 18:49:43 peter
  1741. * require overload for cross object overloading
  1742. Revision 1.57 2001/11/18 20:18:54 peter
  1743. * use cp_value_equal_const instead of cp_all
  1744. Revision 1.56 2001/11/18 18:43:13 peter
  1745. * overloading supported in child classes
  1746. * fixed parsing of classes with private and virtual and overloaded
  1747. so it is compatible with delphi
  1748. Revision 1.55 2001/11/02 23:16:50 peter
  1749. * removed obsolete chainprocsym and test_procsym code
  1750. Revision 1.54 2001/11/02 22:58:01 peter
  1751. * procsym definition rewrite
  1752. Revision 1.53 2001/10/28 17:22:25 peter
  1753. * allow assignment of overloaded procedures to procvars when we know
  1754. which procedure to take
  1755. Revision 1.51 2001/10/13 09:01:14 jonas
  1756. * fixed bug with using procedures as procvar parameters in TP/Delphi mode
  1757. Revision 1.50 2001/10/12 16:04:32 peter
  1758. * nested inline fix (merged)
  1759. Revision 1.49 2001/09/02 21:12:06 peter
  1760. * move class of definitions into type section for delphi
  1761. Revision 1.48 2001/08/30 15:39:59 jonas
  1762. * fixed docompare for the fields I added to tcallnode in my previous
  1763. commit
  1764. * removed nested comment warning
  1765. Revision 1.47 2001/08/29 12:18:07 jonas
  1766. + new createinternres() constructor for tcallnode to support setting a
  1767. custom resulttype
  1768. * compilerproc typeconversions now set the resulttype from the type
  1769. conversion for the generated call node, because the resulttype of
  1770. of the compilerproc helper isn't always exact (e.g. the ones that
  1771. return shortstrings, actually return a shortstring[x], where x is
  1772. specified by the typeconversion node)
  1773. * ti386callnode.pass_2 now always uses resulttype instead of
  1774. procsym.definition.rettype (so the custom resulttype, if any, is
  1775. always used). Note that this "rettype" stuff is only for use with
  1776. compilerprocs.
  1777. Revision 1.46 2001/08/28 13:24:46 jonas
  1778. + compilerproc implementation of most string-related type conversions
  1779. - removed all code from the compiler which has been replaced by
  1780. compilerproc implementations (using (ifdef hascompilerproc) is not
  1781. necessary in the compiler)
  1782. Revision 1.45 2001/08/26 13:36:39 florian
  1783. * some cg reorganisation
  1784. * some PPC updates
  1785. Revision 1.44 2001/08/24 13:47:27 jonas
  1786. * moved "reverseparameters" from ninl.pas to ncal.pas
  1787. + support for non-persistent temps in ttempcreatenode.create, for use
  1788. with typeconversion nodes
  1789. Revision 1.43 2001/08/23 14:28:35 jonas
  1790. + tempcreate/ref/delete nodes (allows the use of temps in the
  1791. resulttype and first pass)
  1792. * made handling of read(ln)/write(ln) processor independent
  1793. * moved processor independent handling for str and reset/rewrite-typed
  1794. from firstpass to resulttype pass
  1795. * changed names of helpers in text.inc to be generic for use as
  1796. compilerprocs + added "iocheck" directive for most of them
  1797. * reading of ordinals is done by procedures instead of functions
  1798. because otherwise FPC_IOCHECK overwrote the result before it could
  1799. be stored elsewhere (range checking still works)
  1800. * compilerprocs can now be used in the system unit before they are
  1801. implemented
  1802. * added note to errore.msg that booleans can't be read using read/readln
  1803. Revision 1.42 2001/08/19 21:11:20 florian
  1804. * some bugs fix:
  1805. - overload; with external procedures fixed
  1806. - better selection of routine to do an overloaded
  1807. type case
  1808. - ... some more
  1809. Revision 1.41 2001/08/13 12:41:56 jonas
  1810. * made code for str(x,y) completely processor independent
  1811. Revision 1.40 2001/08/06 21:40:46 peter
  1812. * funcret moved from tprocinfo to tprocdef
  1813. Revision 1.39 2001/08/01 15:07:29 jonas
  1814. + "compilerproc" directive support, which turns both the public and mangled
  1815. name to lowercase(declaration_name). This prevents a normal user from
  1816. accessing the routine, but they can still be easily looked up within
  1817. the compiler. This is used for helper procedures and should facilitate
  1818. the writing of more processor independent code in the code generator
  1819. itself (mostly written by Peter)
  1820. + new "createintern" constructor for tcal nodes to create a call to
  1821. helper exported using the "compilerproc" directive
  1822. + support for high(dynamic_array) using the the above new things
  1823. + definition of 'HASCOMPILERPROC' symbol (to be able to check in the
  1824. compiler and rtl whether the "compilerproc" directive is supported)
  1825. Revision 1.38 2001/07/30 20:52:25 peter
  1826. * fixed array constructor passing with type conversions
  1827. Revision 1.37 2001/07/09 21:15:40 peter
  1828. * Length made internal
  1829. * Add array support for Length
  1830. Revision 1.36 2001/07/01 20:16:15 peter
  1831. * alignmentinfo record added
  1832. * -Oa argument supports more alignment settings that can be specified
  1833. per type: PROC,LOOP,VARMIN,VARMAX,CONSTMIN,CONSTMAX,RECORDMIN
  1834. RECORDMAX,LOCALMIN,LOCALMAX. It is possible to set the mimimum
  1835. required alignment and the maximum usefull alignment. The final
  1836. alignment will be choosen per variable size dependent on these
  1837. settings
  1838. Revision 1.35 2001/06/04 18:08:19 peter
  1839. * procvar support for varargs
  1840. Revision 1.34 2001/06/04 11:48:02 peter
  1841. * better const to var checking
  1842. Revision 1.33 2001/05/20 12:09:31 peter
  1843. * fixed exit with ansistring return from function call, no_fast_exit
  1844. should be set in det_resulttype instead of pass_1
  1845. Revision 1.32 2001/04/26 21:55:05 peter
  1846. * defcoll must be assigned in insert_typeconv
  1847. Revision 1.31 2001/04/21 12:03:11 peter
  1848. * m68k updates merged from fixes branch
  1849. Revision 1.30 2001/04/18 22:01:54 peter
  1850. * registration of targets and assemblers
  1851. Revision 1.29 2001/04/13 23:52:29 peter
  1852. * don't allow passing signed-unsigned ords to var parameter, this
  1853. forbids smallint-word, shortint-byte, longint-cardinal mixtures.
  1854. It's still allowed in tp7 -So mode.
  1855. Revision 1.28 2001/04/13 22:22:59 peter
  1856. * call set_varstate for procvar calls
  1857. Revision 1.27 2001/04/13 01:22:08 peter
  1858. * symtable change to classes
  1859. * range check generation and errors fixed, make cycle DEBUG=1 works
  1860. * memory leaks fixed
  1861. Revision 1.26 2001/04/04 22:42:39 peter
  1862. * move constant folding into det_resulttype
  1863. Revision 1.25 2001/04/02 21:20:30 peter
  1864. * resulttype rewrite
  1865. Revision 1.24 2001/03/12 12:47:46 michael
  1866. + Patches from peter
  1867. Revision 1.23 2001/02/26 19:44:52 peter
  1868. * merged generic m68k updates from fixes branch
  1869. Revision 1.22 2001/01/08 21:46:46 peter
  1870. * don't push high value for open array with cdecl;external;
  1871. Revision 1.21 2000/12/31 11:14:10 jonas
  1872. + implemented/fixed docompare() mathods for all nodes (not tested)
  1873. + nopt.pas, nadd.pas, i386/n386opt.pas: optimized nodes for adding strings
  1874. and constant strings/chars together
  1875. * n386add.pas: don't copy temp strings (of size 256) to another temp string
  1876. when adding
  1877. Revision 1.20 2000/12/25 00:07:26 peter
  1878. + new tlinkedlist class (merge of old tstringqueue,tcontainer and
  1879. tlinkedlist objects)
  1880. Revision 1.19 2000/12/17 14:35:12 peter
  1881. * fixed crash with procvar load in tp mode
  1882. Revision 1.18 2000/11/29 00:30:32 florian
  1883. * unused units removed from uses clause
  1884. * some changes for widestrings
  1885. Revision 1.17 2000/11/22 15:12:06 jonas
  1886. * fixed inline-related problems (partially "merges")
  1887. Revision 1.16 2000/11/11 16:14:52 peter
  1888. * fixed crash with settextbuf,ptr
  1889. Revision 1.15 2000/11/06 21:36:25 peter
  1890. * fixed var parameter varstate bug
  1891. Revision 1.14 2000/11/04 14:25:20 florian
  1892. + merged Attila's changes for interfaces, not tested yet
  1893. Revision 1.13 2000/10/31 22:02:47 peter
  1894. * symtable splitted, no real code changes
  1895. Revision 1.12 2000/10/21 18:16:11 florian
  1896. * a lot of changes:
  1897. - basic dyn. array support
  1898. - basic C++ support
  1899. - some work for interfaces done
  1900. ....
  1901. Revision 1.11 2000/10/21 14:35:27 peter
  1902. * readd to many remove p. for tcallnode.is_equal()
  1903. Revision 1.10 2000/10/14 21:52:55 peter
  1904. * fixed memory leaks
  1905. Revision 1.9 2000/10/14 10:14:50 peter
  1906. * moehrendorf oct 2000 rewrite
  1907. Revision 1.8 2000/10/01 19:48:24 peter
  1908. * lot of compile updates for cg11
  1909. Revision 1.7 2000/09/28 19:49:52 florian
  1910. *** empty log message ***
  1911. Revision 1.6 2000/09/27 18:14:31 florian
  1912. * fixed a lot of syntax errors in the n*.pas stuff
  1913. Revision 1.5 2000/09/24 21:15:34 florian
  1914. * some errors fix to get more stuff compilable
  1915. Revision 1.4 2000/09/24 20:17:44 florian
  1916. * more conversion work done
  1917. Revision 1.3 2000/09/24 15:06:19 peter
  1918. * use defines.inc
  1919. Revision 1.2 2000/09/20 21:52:38 florian
  1920. * removed a lot of errors
  1921. Revision 1.1 2000/09/20 20:52:16 florian
  1922. * initial revision
  1923. }