nld.pas 48 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350
  1. {
  2. Copyright (c) 2000-2002 by Florian Klaempfl
  3. Type checking and register allocation for load/assignment nodes
  4. This program is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 2 of the License, or
  7. (at your option) any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software
  14. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  15. ****************************************************************************
  16. }
  17. unit nld;
  18. {$i fpcdefs.inc}
  19. interface
  20. uses
  21. node,
  22. {$ifdef state_tracking}
  23. nstate,
  24. {$endif}
  25. symconst,symbase,symtype,symsym,symdef;
  26. type
  27. Trttidatatype = (rdt_normal,rdt_ord2str,rdt_str2ord);
  28. tloadnodeflags = (
  29. loadnf_is_self,
  30. loadnf_load_self_pointer,
  31. loadnf_inherited,
  32. { the loadnode is generated internally and a varspez=vs_const should be ignore,
  33. this requires that the parameter is actually passed by value
  34. Be really carefull when using this flag! }
  35. loadnf_isinternal_ignoreconst,
  36. loadnf_only_uninitialized_hint
  37. );
  38. tloadnode = class(tunarynode)
  39. protected
  40. fprocdef : tprocdef;
  41. fprocdefderef : tderef;
  42. function handle_threadvar_access: tnode; virtual;
  43. public
  44. loadnodeflags : set of tloadnodeflags;
  45. symtableentry : tsym;
  46. symtableentryderef : tderef;
  47. symtable : TSymtable;
  48. constructor create(v : tsym;st : TSymtable);virtual;
  49. constructor create_procvar(v : tsym;d:tprocdef;st : TSymtable);virtual;
  50. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  51. procedure ppuwrite(ppufile:tcompilerppufile);override;
  52. procedure buildderefimpl;override;
  53. procedure derefimpl;override;
  54. procedure set_mp(p:tnode);
  55. function is_addr_param_load:boolean;virtual;
  56. function dogetcopy : tnode;override;
  57. function pass_1 : tnode;override;
  58. function pass_typecheck:tnode;override;
  59. procedure mark_write;override;
  60. function docompare(p: tnode): boolean; override;
  61. procedure printnodedata(var t:text);override;
  62. procedure setprocdef(p : tprocdef);
  63. property procdef: tprocdef read fprocdef write setprocdef;
  64. end;
  65. tloadnodeclass = class of tloadnode;
  66. { different assignment types }
  67. tassigntype = (at_normal,at_plus,at_minus,at_star,at_slash);
  68. tassignmentnode = class(tbinarynode)
  69. protected
  70. function direct_shortstring_assignment: boolean; virtual;
  71. public
  72. assigntype : tassigntype;
  73. constructor create(l,r : tnode);virtual;
  74. { no checks for validity of assignment }
  75. constructor create_internal(l,r : tnode);virtual;
  76. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  77. procedure ppuwrite(ppufile:tcompilerppufile);override;
  78. function dogetcopy : tnode;override;
  79. function pass_1 : tnode;override;
  80. function pass_typecheck:tnode;override;
  81. function simplify(forinline : boolean) : tnode;override;
  82. {$ifdef state_tracking}
  83. function track_state_pass(exec_known:boolean):boolean;override;
  84. {$endif state_tracking}
  85. function docompare(p: tnode): boolean; override;
  86. end;
  87. tassignmentnodeclass = class of tassignmentnode;
  88. tarrayconstructorrangenode = class(tbinarynode)
  89. constructor create(l,r : tnode);virtual;
  90. function pass_1 : tnode;override;
  91. function pass_typecheck:tnode;override;
  92. end;
  93. tarrayconstructorrangenodeclass = class of tarrayconstructorrangenode;
  94. tarrayconstructornode = class(tbinarynode)
  95. protected
  96. procedure wrapmanagedvarrec(var n: tnode);virtual;abstract;
  97. public
  98. constructor create(l,r : tnode);virtual;
  99. function dogetcopy : tnode;override;
  100. function pass_1 : tnode;override;
  101. function pass_typecheck:tnode;override;
  102. function docompare(p: tnode): boolean; override;
  103. procedure force_type(def:tdef);
  104. procedure insert_typeconvs;
  105. end;
  106. tarrayconstructornodeclass = class of tarrayconstructornode;
  107. ttypenode = class(tnode)
  108. allowed : boolean;
  109. helperallowed : boolean;
  110. typedef : tdef;
  111. typedefderef : tderef;
  112. typesym : tsym;
  113. typesymderef : tderef;
  114. constructor create(def:tdef);virtual;
  115. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  116. procedure ppuwrite(ppufile:tcompilerppufile);override;
  117. procedure buildderefimpl;override;
  118. procedure derefimpl;override;
  119. function pass_1 : tnode;override;
  120. function pass_typecheck:tnode;override;
  121. function dogetcopy : tnode;override;
  122. function docompare(p: tnode): boolean; override;
  123. end;
  124. ttypenodeclass = class of ttypenode;
  125. trttinode = class(tnode)
  126. l1,l2 : longint;
  127. rttitype : trttitype;
  128. rttidef : tstoreddef;
  129. rttidefderef : tderef;
  130. rttidatatype : Trttidatatype;
  131. constructor create(def:tstoreddef;rt:trttitype;dt:Trttidatatype);virtual;
  132. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  133. procedure ppuwrite(ppufile:tcompilerppufile);override;
  134. procedure buildderefimpl;override;
  135. procedure derefimpl;override;
  136. function dogetcopy : tnode;override;
  137. function pass_1 : tnode;override;
  138. function pass_typecheck:tnode;override;
  139. function docompare(p: tnode): boolean; override;
  140. end;
  141. trttinodeclass = class of trttinode;
  142. var
  143. cloadnode : tloadnodeclass = tloadnode;
  144. cassignmentnode : tassignmentnodeclass = tassignmentnode;
  145. carrayconstructorrangenode : tarrayconstructorrangenodeclass = tarrayconstructorrangenode;
  146. carrayconstructornode : tarrayconstructornodeclass = tarrayconstructornode;
  147. ctypenode : ttypenodeclass = ttypenode;
  148. crttinode : trttinodeclass = trttinode;
  149. { Current assignment node }
  150. aktassignmentnode : tassignmentnode;
  151. implementation
  152. uses
  153. verbose,globtype,globals,systems,constexp,
  154. symtable,
  155. defutil,defcmp,
  156. htypechk,pass_1,procinfo,paramgr,
  157. cpuinfo,
  158. ncon,ninl,ncnv,nmem,ncal,nutils,
  159. cgbase
  160. ;
  161. {*****************************************************************************
  162. TLOADNODE
  163. *****************************************************************************}
  164. function tloadnode.handle_threadvar_access: tnode;
  165. begin
  166. { nothing special by default }
  167. result:=nil;
  168. end;
  169. constructor tloadnode.create(v : tsym;st : TSymtable);
  170. begin
  171. inherited create(loadn,nil);
  172. if not assigned(v) then
  173. internalerror(200108121);
  174. symtableentry:=v;
  175. symtable:=st;
  176. fprocdef:=nil;
  177. end;
  178. constructor tloadnode.create_procvar(v : tsym;d:tprocdef;st : TSymtable);
  179. begin
  180. inherited create(loadn,nil);
  181. if not assigned(v) then
  182. internalerror(200108122);
  183. symtableentry:=v;
  184. symtable:=st;
  185. fprocdef:=d;
  186. end;
  187. constructor tloadnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  188. begin
  189. inherited ppuload(t,ppufile);
  190. ppufile.getderef(symtableentryderef);
  191. symtable:=nil;
  192. ppufile.getderef(fprocdefderef);
  193. ppufile.getsmallset(loadnodeflags);
  194. end;
  195. procedure tloadnode.ppuwrite(ppufile:tcompilerppufile);
  196. begin
  197. inherited ppuwrite(ppufile);
  198. ppufile.putderef(symtableentryderef);
  199. ppufile.putderef(fprocdefderef);
  200. ppufile.putsmallset(loadnodeflags);
  201. end;
  202. procedure tloadnode.buildderefimpl;
  203. begin
  204. inherited buildderefimpl;
  205. symtableentryderef.build(symtableentry);
  206. fprocdefderef.build(fprocdef);
  207. end;
  208. procedure tloadnode.derefimpl;
  209. begin
  210. inherited derefimpl;
  211. symtableentry:=tsym(symtableentryderef.resolve);
  212. symtable:=symtableentry.owner;
  213. fprocdef:=tprocdef(fprocdefderef.resolve);
  214. end;
  215. procedure tloadnode.set_mp(p:tnode);
  216. begin
  217. { typen nodes should not be set }
  218. if p.nodetype=typen then
  219. internalerror(200301042);
  220. left:=p;
  221. end;
  222. function tloadnode.dogetcopy : tnode;
  223. var
  224. n : tloadnode;
  225. begin
  226. n:=tloadnode(inherited dogetcopy);
  227. n.symtable:=symtable;
  228. n.symtableentry:=symtableentry;
  229. n.fprocdef:=fprocdef;
  230. result:=n;
  231. end;
  232. function tloadnode.is_addr_param_load:boolean;
  233. begin
  234. result:=(symtable.symtabletype=parasymtable) and
  235. (symtableentry.typ=paravarsym) and
  236. not(vo_has_local_copy in tparavarsym(symtableentry).varoptions) and
  237. not(loadnf_load_self_pointer in loadnodeflags) and
  238. paramanager.push_addr_param(tparavarsym(symtableentry).varspez,tparavarsym(symtableentry).vardef,tprocdef(symtable.defowner).proccalloption);
  239. end;
  240. function tloadnode.pass_typecheck:tnode;
  241. begin
  242. result:=nil;
  243. case symtableentry.typ of
  244. absolutevarsym :
  245. resultdef:=tabsolutevarsym(symtableentry).vardef;
  246. constsym:
  247. begin
  248. if tconstsym(symtableentry).consttyp=constresourcestring then
  249. resultdef:=getansistringdef
  250. else
  251. internalerror(22799);
  252. end;
  253. staticvarsym :
  254. begin
  255. tabstractvarsym(symtableentry).IncRefCountBy(1);
  256. { static variables referenced in procedures or from finalization,
  257. variable needs to be in memory.
  258. It is too hard and the benefit is too small to detect whether a
  259. variable is only used in the finalization to add support for it (PFV) }
  260. if assigned(current_procinfo) and
  261. (symtable.symtabletype=staticsymtable) and
  262. (
  263. (symtable.symtablelevel<>current_procinfo.procdef.localst.symtablelevel) or
  264. (current_procinfo.procdef.proctypeoption=potype_unitfinalize)
  265. ) then
  266. make_not_regable(self,[ra_addr_taken]);
  267. resultdef:=tabstractvarsym(symtableentry).vardef;
  268. if vo_is_thread_var in tstaticvarsym(symtableentry).varoptions then
  269. result:=handle_threadvar_access;
  270. end;
  271. paravarsym,
  272. localvarsym :
  273. begin
  274. tabstractvarsym(symtableentry).IncRefCountBy(1);
  275. { Nested variable? The we need to load the framepointer of
  276. the parent procedure }
  277. if assigned(current_procinfo) and
  278. (symtable.symtabletype in [localsymtable,parasymtable]) and
  279. (symtable.symtablelevel<>current_procinfo.procdef.parast.symtablelevel) then
  280. begin
  281. if assigned(left) then
  282. internalerror(200309289);
  283. left:=cloadparentfpnode.create(tprocdef(symtable.defowner),lpf_forload);
  284. { we can't inline the referenced parent procedure }
  285. exclude(tprocdef(symtable.defowner).procoptions,po_inline);
  286. { reference in nested procedures, variable needs to be in memory }
  287. { and behaves as if its address escapes its parent block }
  288. make_not_regable(self,[ra_addr_taken]);
  289. end;
  290. resultdef:=tabstractvarsym(symtableentry).vardef;
  291. { self for objects is passed as var-parameter on the caller
  292. side, but on the callee-side we use it as a pointer ->
  293. adjust }
  294. if (vo_is_self in tabstractvarsym(symtableentry).varoptions) then
  295. begin
  296. if (is_object(resultdef) or is_record(resultdef)) and
  297. (loadnf_load_self_pointer in loadnodeflags) then
  298. resultdef:=cpointerdef.getreusable(resultdef)
  299. else if (resultdef=objc_idtype) and
  300. (po_classmethod in tprocdef(symtableentry.owner.defowner).procoptions) then
  301. resultdef:=cclassrefdef.create(tprocdef(symtableentry.owner.defowner).struct)
  302. end
  303. end;
  304. procsym :
  305. begin
  306. { Return the first procdef. In case of overloaded
  307. procdefs the matching procdef will be choosen
  308. when the expected procvardef is known, see get_information
  309. in htypechk.pas (PFV) }
  310. if not assigned(fprocdef) then
  311. fprocdef:=tprocdef(tprocsym(symtableentry).ProcdefList[0])
  312. else if po_kylixlocal in fprocdef.procoptions then
  313. CGMessage(type_e_cant_take_address_of_local_subroutine);
  314. { the result is a fprocdef, addrn and proc_to_procvar
  315. typeconvn need this as resultdef so they know
  316. that the address needs to be returned }
  317. resultdef:=fprocdef;
  318. { process methodpointer/framepointer }
  319. if assigned(left) then
  320. begin
  321. typecheckpass(left);
  322. if (po_classmethod in fprocdef.procoptions) and
  323. is_class(left.resultdef) then
  324. begin
  325. left:=cloadvmtaddrnode.create(left);
  326. typecheckpass(left);
  327. end
  328. end;
  329. end;
  330. labelsym:
  331. begin
  332. tlabelsym(symtableentry).used:=true;
  333. resultdef:=voidtype;
  334. end;
  335. else
  336. internalerror(200104141);
  337. end;
  338. end;
  339. procedure Tloadnode.mark_write;
  340. begin
  341. include(flags,nf_write);
  342. end;
  343. function tloadnode.pass_1 : tnode;
  344. begin
  345. result:=nil;
  346. expectloc:=LOC_REFERENCE;
  347. if (cs_create_pic in current_settings.moduleswitches) and
  348. not(symtableentry.typ in [paravarsym,localvarsym]) then
  349. include(current_procinfo.flags,pi_needs_got);
  350. case symtableentry.typ of
  351. absolutevarsym :
  352. ;
  353. constsym:
  354. begin
  355. if tconstsym(symtableentry).consttyp=constresourcestring then
  356. expectloc:=LOC_CREFERENCE;
  357. end;
  358. staticvarsym,
  359. localvarsym,
  360. paravarsym :
  361. begin
  362. if assigned(left) then
  363. firstpass(left);
  364. if not is_addr_param_load and
  365. tabstractvarsym(symtableentry).is_regvar(is_addr_param_load) then
  366. expectloc:=tvarregable2tcgloc[tabstractvarsym(symtableentry).varregable]
  367. else
  368. if (tabstractvarsym(symtableentry).varspez=vs_const) then
  369. expectloc:=LOC_CREFERENCE;
  370. if (target_info.system=system_powerpc_darwin) and
  371. ([vo_is_dll_var,vo_is_external] * tabstractvarsym(symtableentry).varoptions <> []) then
  372. include(current_procinfo.flags,pi_needs_got);
  373. { call to get address of threadvar }
  374. if (vo_is_thread_var in tabstractvarsym(symtableentry).varoptions) then
  375. include(current_procinfo.flags,pi_do_call);
  376. end;
  377. procsym :
  378. begin
  379. { initialise left for nested procs if necessary }
  380. if (m_nested_procvars in current_settings.modeswitches) then
  381. setprocdef(fprocdef);
  382. { method pointer or nested proc ? }
  383. if assigned(left) then
  384. begin
  385. expectloc:=LOC_CREGISTER;
  386. firstpass(left);
  387. end;
  388. end;
  389. labelsym :
  390. begin
  391. if not assigned(tlabelsym(symtableentry).asmblocklabel) and
  392. not assigned(tlabelsym(symtableentry).code) then
  393. Message(parser_e_label_outside_proc);
  394. end
  395. else
  396. internalerror(200104143);
  397. end;
  398. end;
  399. function tloadnode.docompare(p: tnode): boolean;
  400. begin
  401. docompare :=
  402. inherited docompare(p) and
  403. (symtableentry = tloadnode(p).symtableentry) and
  404. (fprocdef = tloadnode(p).fprocdef) and
  405. (symtable = tloadnode(p).symtable);
  406. end;
  407. procedure tloadnode.printnodedata(var t:text);
  408. begin
  409. inherited printnodedata(t);
  410. write(t,printnodeindention,'symbol = ',symtableentry.name);
  411. if symtableentry.typ=procsym then
  412. write(t,printnodeindention,'procdef = ',fprocdef.mangledname);
  413. writeln(t,'');
  414. end;
  415. procedure tloadnode.setprocdef(p : tprocdef);
  416. begin
  417. fprocdef:=p;
  418. resultdef:=p;
  419. { nested procedure? }
  420. if assigned(p) and
  421. is_nested_pd(p) then
  422. begin
  423. if not(m_nested_procvars in current_settings.modeswitches) then
  424. CGMessage(type_e_cant_take_address_of_local_subroutine)
  425. else
  426. begin
  427. { parent frame pointer pointer as "self" }
  428. left.free;
  429. left:=cloadparentfpnode.create(tprocdef(p.owner.defowner),lpf_forpara);
  430. end;
  431. end
  432. { we should never go from nested to non-nested }
  433. else if assigned(left) and
  434. (left.nodetype=loadparentfpn) then
  435. internalerror(2010072201);
  436. end;
  437. {*****************************************************************************
  438. TASSIGNMENTNODE
  439. *****************************************************************************}
  440. function tassignmentnode.direct_shortstring_assignment: boolean;
  441. begin
  442. result:=
  443. is_char(right.resultdef) or
  444. (right.resultdef.typ=stringdef);
  445. end;
  446. constructor tassignmentnode.create(l,r : tnode);
  447. begin
  448. inherited create(assignn,l,r);
  449. l.mark_write;
  450. assigntype:=at_normal;
  451. if r.nodetype = typeconvn then
  452. ttypeconvnode(r).warn_pointer_to_signed:=false;
  453. end;
  454. constructor tassignmentnode.create_internal(l, r: tnode);
  455. begin
  456. create(l,r);
  457. include(flags,nf_internal);
  458. end;
  459. constructor tassignmentnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  460. begin
  461. inherited ppuload(t,ppufile);
  462. assigntype:=tassigntype(ppufile.getbyte);
  463. end;
  464. procedure tassignmentnode.ppuwrite(ppufile:tcompilerppufile);
  465. begin
  466. inherited ppuwrite(ppufile);
  467. ppufile.putbyte(byte(assigntype));
  468. end;
  469. function tassignmentnode.dogetcopy : tnode;
  470. var
  471. n : tassignmentnode;
  472. begin
  473. n:=tassignmentnode(inherited dogetcopy);
  474. n.assigntype:=assigntype;
  475. result:=n;
  476. end;
  477. function tassignmentnode.simplify(forinline : boolean) : tnode;
  478. begin
  479. result:=nil;
  480. { assignment nodes can perform several floating point }
  481. { type conversions directly, so no typeconversions }
  482. { are inserted in those cases. When inlining, a }
  483. { variable may be replaced by a constant which can be }
  484. { converted at compile time, so check for this case }
  485. if is_real(left.resultdef) and
  486. is_real(right.resultdef) and
  487. is_constrealnode(right) and
  488. not equal_defs(right.resultdef,left.resultdef) then
  489. inserttypeconv(right,left.resultdef);
  490. end;
  491. function tassignmentnode.pass_typecheck:tnode;
  492. var
  493. hp : tnode;
  494. useshelper : boolean;
  495. oldassignmentnode : tassignmentnode;
  496. begin
  497. result:=nil;
  498. resultdef:=voidtype;
  499. { must be made unique }
  500. set_unique(left);
  501. typecheckpass(left);
  502. { PI. This is needed to return correct resultdef of add nodes for ansistrings
  503. rawbytestring return needs to be replaced by left.resultdef }
  504. oldassignmentnode:=aktassignmentnode;
  505. aktassignmentnode:=self;
  506. typecheckpass(right);
  507. aktassignmentnode:=oldassignmentnode;
  508. set_varstate(right,vs_read,[vsf_must_be_valid]);
  509. set_varstate(left,vs_written,[]);
  510. if codegenerror then
  511. exit;
  512. { tp procvar support, when we don't expect a procvar
  513. then we need to call the procvar }
  514. if (left.resultdef.typ<>procvardef) then
  515. maybe_call_procvar(right,true);
  516. { assignments to formaldefs and open arrays aren't allowed }
  517. if is_open_array(left.resultdef) then
  518. CGMessage(type_e_assignment_not_allowed)
  519. else if (left.resultdef.typ=formaldef) then
  520. if not(target_info.system in systems_managed_vm) then
  521. CGMessage(type_e_assignment_not_allowed)
  522. else
  523. begin
  524. { on managed platforms, assigning to formaldefs is allowed (but
  525. typecasting them on the left hand side isn't), but primitive
  526. values need to be boxed first }
  527. if (right.resultdef.typ in [orddef,floatdef]) then
  528. begin
  529. right:=cinlinenode.create(in_box_x,false,ccallparanode.create(right,nil));
  530. typecheckpass(right);
  531. end;
  532. end;
  533. { test if node can be assigned, properties are allowed }
  534. if not(nf_internal in flags) then
  535. if not valid_for_assignment(left,true) then
  536. { errors can in situations that cause the compiler to run out of
  537. memory, such as assigning to an implicit pointer-to-array
  538. converted node (that array is 2^31 or 2^63 bytes large) }
  539. exit;
  540. { assigning nil to a dynamic array clears the array }
  541. if is_dynamic_array(left.resultdef) and
  542. (right.nodetype=niln) then
  543. begin
  544. { remove property flag to avoid errors, see comments for }
  545. { tf_winlikewidestring assignments below }
  546. exclude(left.flags,nf_isproperty);
  547. { generate a setlength node so it can be intercepted by
  548. target-specific code }
  549. result:=cinlinenode.create(in_setlength_x,false,
  550. ccallparanode.create(genintconstnode(0),
  551. ccallparanode.create(left,nil)));
  552. left:=nil;
  553. exit;
  554. end;
  555. { shortstring helpers can do the conversion directly,
  556. so treat them separatly }
  557. if (is_shortstring(left.resultdef)) then
  558. begin
  559. { insert typeconv, except for chars that are handled in
  560. secondpass and except for ansi/wide string that can
  561. be converted immediatly }
  562. if not direct_shortstring_assignment then
  563. inserttypeconv(right,left.resultdef);
  564. if right.resultdef.typ=stringdef then
  565. begin
  566. useshelper:=true;
  567. { convert constant strings to shortstrings. But
  568. skip empty constant strings, that will be handled
  569. in secondpass }
  570. if (right.nodetype=stringconstn) then
  571. begin
  572. { verify if range fits within shortstring }
  573. { just emit a warning, delphi gives an }
  574. { error, only if the type definition of }
  575. { of the string is less < 255 characters }
  576. if not is_open_string(left.resultdef) and
  577. (tstringconstnode(right).len > tstringdef(left.resultdef).len) then
  578. cgmessage(type_w_string_too_long);
  579. inserttypeconv(right,left.resultdef);
  580. if (right.nodetype=stringconstn) and
  581. (tstringconstnode(right).len=0) then
  582. useshelper:=false;
  583. end
  584. else if (tstringdef(right.resultdef).stringtype in [st_unicodestring,st_widestring]) then
  585. Message2(type_w_implicit_string_cast_loss,right.resultdef.typename,left.resultdef.typename);
  586. { rest is done in pass 1 (JM) }
  587. if useshelper then
  588. exit;
  589. end
  590. end
  591. { floating point assignments can also perform the conversion directly }
  592. else if is_real(left.resultdef) and is_real(right.resultdef) and
  593. not is_constrealnode(right)
  594. {$ifdef cpufpemu}
  595. { the emulator can't do this obviously }
  596. and not(current_settings.fputype in [fpu_libgcc,fpu_soft])
  597. {$endif cpufpemu}
  598. {$ifdef x86}
  599. { the assignment node code can't convert a double in an }
  600. { sse register to an extended value in memory more }
  601. { efficiently than a type conversion node, so don't }
  602. { bother implementing support for that }
  603. and (use_vectorfpu(left.resultdef) or not(use_vectorfpu(right.resultdef)))
  604. {$endif}
  605. {$ifdef arm}
  606. { the assignment node code can't convert a single in
  607. an interger register to a double in an mmregister or
  608. vice versa }
  609. and (use_vectorfpu(left.resultdef) and
  610. use_vectorfpu(right.resultdef) and
  611. (tfloatdef(left.resultdef).floattype=tfloatdef(right.resultdef).floattype))
  612. {$endif}
  613. then
  614. begin
  615. if not(nf_internal in flags) then
  616. check_ranges(fileinfo,right,left.resultdef);
  617. end
  618. else
  619. begin
  620. { check if the assignment may cause a range check error }
  621. if not(nf_internal in flags) then
  622. check_ranges(fileinfo,right,left.resultdef);
  623. { beginners might be confused about an error message like
  624. Incompatible types: got "untyped" expected "LongInt"
  625. when trying to assign the result of a procedure, so give
  626. a better error message, see also #19122 }
  627. if (left.resultdef.typ<>procvardef) and
  628. (right.nodetype=calln) and is_void(right.resultdef) then
  629. CGMessage(type_e_procedures_return_no_value)
  630. else if nf_internal in flags then
  631. inserttypeconv_internal(right,left.resultdef)
  632. else
  633. inserttypeconv(right,left.resultdef);
  634. end;
  635. { call helpers for interface }
  636. if is_interfacecom_or_dispinterface(left.resultdef) then
  637. begin
  638. { Normal interface assignments are handled by the generic refcount incr/decr }
  639. if not def_is_related(right.resultdef,left.resultdef) then
  640. begin
  641. { remove property flag to avoid errors, see comments for }
  642. { tf_winlikewidestring assignments below }
  643. exclude(left.flags,nf_isproperty);
  644. hp:=
  645. ccallparanode.create(
  646. cguidconstnode.create(tobjectdef(left.resultdef).iidguid^),
  647. ccallparanode.create(
  648. ctypeconvnode.create_internal(right,voidpointertype),
  649. ccallparanode.create(
  650. ctypeconvnode.create_internal(left,voidpointertype),
  651. nil)));
  652. result:=ccallnode.createintern('fpc_intf_assign_by_iid',hp);
  653. left:=nil;
  654. right:=nil;
  655. exit;
  656. end;
  657. end;
  658. { check if local proc/func is assigned to procvar }
  659. if right.resultdef.typ=procvardef then
  660. test_local_to_procvar(tprocvardef(right.resultdef),left.resultdef);
  661. end;
  662. function tassignmentnode.pass_1 : tnode;
  663. var
  664. hp: tnode;
  665. oldassignmentnode : tassignmentnode;
  666. hdef: tdef;
  667. hs: string;
  668. needrtti: boolean;
  669. begin
  670. result:=nil;
  671. expectloc:=LOC_VOID;
  672. firstpass(left);
  673. { Optimize the reuse of the destination of the assingment in left.
  674. Allow the use of the left inside the tree generated on the right.
  675. This is especially useful for string routines where the destination
  676. is pushed as a parameter. Using the final destination of left directly
  677. save a temp allocation and copy of data (PFV) }
  678. oldassignmentnode:=aktassignmentnode;
  679. aktassignmentnode:=self;
  680. firstpass(right);
  681. aktassignmentnode:=oldassignmentnode;
  682. if nf_assign_done_in_right in flags then
  683. begin
  684. result:=right;
  685. right:=nil;
  686. exit;
  687. end;
  688. if codegenerror then
  689. exit;
  690. { assignment to refcounted variable -> inc/decref }
  691. if is_managed_type(left.resultdef) then
  692. include(current_procinfo.flags,pi_do_call);
  693. needrtti:=false;
  694. if (is_shortstring(left.resultdef)) then
  695. begin
  696. if right.resultdef.typ=stringdef then
  697. begin
  698. if (right.nodetype<>stringconstn) or
  699. (tstringconstnode(right).len<>0) then
  700. begin
  701. { remove property flag to avoid errors, see comments for }
  702. { tf_winlikewidestring assignments below }
  703. exclude(left.flags, nf_isproperty);
  704. hp:=ccallparanode.create
  705. (right,
  706. ccallparanode.create(left,nil));
  707. result:=ccallnode.createintern('fpc_'+tstringdef(right.resultdef).stringtypname+'_to_shortstr',hp);
  708. firstpass(result);
  709. left:=nil;
  710. right:=nil;
  711. end;
  712. end;
  713. exit;
  714. end
  715. { call helpers for composite types containing automated types }
  716. else if is_managed_type(left.resultdef) and
  717. (left.resultdef.typ in [arraydef,objectdef,recorddef]) and
  718. not is_interfacecom_or_dispinterface(left.resultdef) and
  719. not is_dynamic_array(left.resultdef) and
  720. not is_const(left) and
  721. not(target_info.system in systems_garbage_collected_managed_types) then
  722. begin
  723. hp:=ccallparanode.create(caddrnode.create_internal(
  724. crttinode.create(tstoreddef(left.resultdef),initrtti,rdt_normal)),
  725. ccallparanode.create(ctypeconvnode.create_internal(
  726. caddrnode.create_internal(left),voidpointertype),
  727. ccallparanode.create(ctypeconvnode.create_internal(
  728. caddrnode.create_internal(right),voidpointertype),
  729. nil)));
  730. result:=ccallnode.createintern('fpc_copy_proc',hp);
  731. firstpass(result);
  732. left:=nil;
  733. right:=nil;
  734. exit;
  735. end
  736. { call helpers for variant, they can contain non ref. counted types like
  737. vararrays which must be really copied }
  738. else if (left.resultdef.typ=variantdef) and
  739. not(target_info.system in systems_garbage_collected_managed_types) then
  740. begin
  741. { remove property flag to avoid errors, see comments for }
  742. { tf_winlikewidestring assignments below }
  743. exclude(left.flags,nf_isproperty);
  744. hdef:=search_system_type('TVARDATA').typedef;
  745. hp:=ccallparanode.create(ctypeconvnode.create_internal(
  746. right,hdef),
  747. ccallparanode.create(ctypeconvnode.create_internal(
  748. left,hdef),
  749. nil));
  750. result:=ccallnode.createintern('fpc_variant_copy',hp);
  751. firstpass(result);
  752. left:=nil;
  753. right:=nil;
  754. exit;
  755. end
  756. else if not(target_info.system in systems_garbage_collected_managed_types) and
  757. not(is_const(left)) then
  758. begin
  759. { call helpers for pointer-sized managed types }
  760. if is_widestring(left.resultdef) then
  761. hs:='fpc_widestr_assign'
  762. else if is_ansistring(left.resultdef) then
  763. hs:='fpc_ansistr_assign'
  764. else if is_unicodestring(left.resultdef) then
  765. hs:='fpc_unicodestr_assign'
  766. else if is_interfacecom_or_dispinterface(left.resultdef) then
  767. hs:='fpc_intf_assign'
  768. else if is_dynamic_array(left.resultdef) then
  769. begin
  770. hs:='fpc_dynarray_assign';
  771. needrtti:=true;
  772. end
  773. else
  774. exit;
  775. end
  776. else
  777. exit;
  778. { The first argument of these procedures is a var parameter. Properties cannot }
  779. { be passed to var or out parameters, because in that case setters/getters are not }
  780. { used. Further, if we would allow it in case there are no getters or setters, you }
  781. { would need source changes in case these are introduced later on, thus defeating }
  782. { part of the transparency advantages of properties. In this particular case, }
  783. { however: }
  784. { a) if there is a setter, this code will not be used since then the assignment }
  785. { will be converted to a procedure call }
  786. { b) the getter is irrelevant, because fpc_widestr_assign must always decrease }
  787. { the refcount of the field to which we are writing }
  788. { c) source code changes are not required if a setter is added/removed, because }
  789. { this transformation is handled at compile time }
  790. { -> we can remove the nf_isproperty flag (if any) from left, so that in case it }
  791. { is a property which refers to a field without a setter call, we will not get }
  792. { an error about trying to pass a property as a var parameter }
  793. exclude(left.flags,nf_isproperty);
  794. hp:=ccallparanode.create(ctypeconvnode.create_internal(right,voidpointertype),
  795. ccallparanode.create(ctypeconvnode.create_internal(left,voidpointertype),
  796. nil));
  797. if needrtti then
  798. hp:=ccallparanode.create(
  799. caddrnode.create_internal(
  800. crttinode.create(tstoreddef(left.resultdef),initrtti,rdt_normal)),
  801. hp);
  802. result:=ccallnode.createintern(hs,hp);
  803. firstpass(result);
  804. left:=nil;
  805. right:=nil;
  806. end;
  807. function tassignmentnode.docompare(p: tnode): boolean;
  808. begin
  809. docompare :=
  810. inherited docompare(p) and
  811. (assigntype = tassignmentnode(p).assigntype);
  812. end;
  813. {$ifdef state_tracking}
  814. function Tassignmentnode.track_state_pass(exec_known:boolean):boolean;
  815. var se:Tstate_entry;
  816. begin
  817. track_state_pass:=false;
  818. if exec_known then
  819. begin
  820. track_state_pass:=right.track_state_pass(exec_known);
  821. {Force a new resultdef pass.}
  822. right.resultdef:=nil;
  823. do_typecheckpass(right);
  824. typecheckpass(right);
  825. aktstate.store_fact(left.getcopy,right.getcopy);
  826. end
  827. else
  828. aktstate.delete_fact(left);
  829. end;
  830. {$endif}
  831. {*****************************************************************************
  832. TARRAYCONSTRUCTORRANGENODE
  833. *****************************************************************************}
  834. constructor tarrayconstructorrangenode.create(l,r : tnode);
  835. begin
  836. inherited create(arrayconstructorrangen,l,r);
  837. end;
  838. function tarrayconstructorrangenode.pass_typecheck:tnode;
  839. begin
  840. result:=nil;
  841. typecheckpass(left);
  842. typecheckpass(right);
  843. set_varstate(left,vs_read,[vsf_must_be_valid]);
  844. set_varstate(right,vs_read,[vsf_must_be_valid]);
  845. if codegenerror then
  846. exit;
  847. resultdef:=left.resultdef;
  848. end;
  849. function tarrayconstructorrangenode.pass_1 : tnode;
  850. begin
  851. result:=nil;
  852. CGMessage(parser_e_illegal_expression);
  853. end;
  854. {****************************************************************************
  855. TARRAYCONSTRUCTORNODE
  856. *****************************************************************************}
  857. constructor tarrayconstructornode.create(l,r : tnode);
  858. begin
  859. inherited create(arrayconstructorn,l,r);
  860. end;
  861. function tarrayconstructornode.dogetcopy : tnode;
  862. var
  863. n : tarrayconstructornode;
  864. begin
  865. n:=tarrayconstructornode(inherited dogetcopy);
  866. result:=n;
  867. end;
  868. function tarrayconstructornode.pass_typecheck:tnode;
  869. var
  870. hdef : tdef;
  871. hp : tarrayconstructornode;
  872. len : longint;
  873. varia : boolean;
  874. eq : tequaltype;
  875. hnodetype : tnodetype;
  876. begin
  877. result:=nil;
  878. { are we allowing array constructor? Then convert it to a set.
  879. Do this only if we didn't convert the arrayconstructor yet. This
  880. is needed for the cases where the resultdef is forced for a second
  881. run }
  882. if not(allow_array_constructor) then
  883. begin
  884. hp:=tarrayconstructornode(getcopy);
  885. arrayconstructor_to_set(tnode(hp));
  886. result:=hp;
  887. exit;
  888. end;
  889. { only pass left tree, right tree contains next construct if any }
  890. hdef:=nil;
  891. hnodetype:=errorn;
  892. len:=0;
  893. varia:=false;
  894. if assigned(left) then
  895. begin
  896. hp:=self;
  897. while assigned(hp) do
  898. begin
  899. typecheckpass(hp.left);
  900. set_varstate(hp.left,vs_read,[vsf_must_be_valid]);
  901. if (hdef=nil) then
  902. begin
  903. hdef:=hp.left.resultdef;
  904. hnodetype:=hp.left.nodetype;
  905. end
  906. else
  907. begin
  908. { If we got a niln we don't know the type yet and need to take the
  909. type of the next array element.
  910. This is to handle things like [nil,tclass,tclass], see also tw8371 (PFV) }
  911. if hnodetype=niln then
  912. begin
  913. eq:=compare_defs(hp.left.resultdef,hdef,hnodetype);
  914. if eq>te_incompatible then
  915. begin
  916. hdef:=hp.left.resultdef;
  917. hnodetype:=hp.left.nodetype;
  918. end;
  919. end
  920. else
  921. eq:=compare_defs(hdef,hp.left.resultdef,hp.left.nodetype);
  922. if (not varia) and (eq<te_equal) then
  923. begin
  924. { If both are integers we need to take the type that can hold both
  925. defs }
  926. if is_integer(hdef) and is_integer(hp.left.resultdef) then
  927. begin
  928. if is_in_limit(hdef,hp.left.resultdef) then
  929. hdef:=hp.left.resultdef;
  930. end
  931. else
  932. if (nf_novariaallowed in flags) then
  933. varia:=true;
  934. end;
  935. end;
  936. inc(len);
  937. hp:=tarrayconstructornode(hp.right);
  938. end;
  939. end;
  940. { Set the type of empty or varia arrays to void. Also
  941. do this if the type is array of const/open array
  942. because those can't be used with setelementdef }
  943. if not assigned(hdef) or
  944. varia or
  945. is_array_of_const(hdef) or
  946. is_open_array(hdef) then
  947. hdef:=voidtype;
  948. resultdef:=carraydef.create(0,len-1,s32inttype);
  949. tarraydef(resultdef).elementdef:=hdef;
  950. include(tarraydef(resultdef).arrayoptions,ado_IsConstructor);
  951. if varia then
  952. include(tarraydef(resultdef).arrayoptions,ado_IsVariant);
  953. end;
  954. procedure tarrayconstructornode.force_type(def:tdef);
  955. var
  956. hp : tarrayconstructornode;
  957. begin
  958. tarraydef(resultdef).elementdef:=def;
  959. include(tarraydef(resultdef).arrayoptions,ado_IsConstructor);
  960. exclude(tarraydef(resultdef).arrayoptions,ado_IsVariant);
  961. if assigned(left) then
  962. begin
  963. hp:=self;
  964. while assigned(hp) do
  965. begin
  966. inserttypeconv(hp.left,def);
  967. hp:=tarrayconstructornode(hp.right);
  968. end;
  969. end;
  970. end;
  971. procedure tarrayconstructornode.insert_typeconvs;
  972. var
  973. hp : tarrayconstructornode;
  974. dovariant : boolean;
  975. begin
  976. dovariant:=(nf_forcevaria in flags) or (ado_isvariant in tarraydef(resultdef).arrayoptions);
  977. { only pass left tree, right tree contains next construct if any }
  978. if assigned(left) then
  979. begin
  980. hp:=self;
  981. while assigned(hp) do
  982. begin
  983. typecheckpass(hp.left);
  984. { Insert typeconvs for array of const }
  985. if dovariant then
  986. { at this time C varargs are no longer an arrayconstructornode }
  987. insert_varargstypeconv(hp.left,false);
  988. hp:=tarrayconstructornode(hp.right);
  989. end;
  990. end;
  991. end;
  992. function tarrayconstructornode.pass_1 : tnode;
  993. var
  994. hp : tarrayconstructornode;
  995. do_variant,
  996. do_managed_variant:boolean;
  997. begin
  998. do_variant:=(nf_forcevaria in flags) or (ado_isvariant in tarraydef(resultdef).arrayoptions);
  999. do_managed_variant:=
  1000. do_variant and
  1001. (target_info.system in systems_managed_vm);
  1002. result:=nil;
  1003. { Insert required type convs, this must be
  1004. done in pass 1, because the call must be
  1005. typecheckpassed already }
  1006. if assigned(left) then
  1007. begin
  1008. insert_typeconvs;
  1009. { call firstpass for all nodes }
  1010. hp:=self;
  1011. while assigned(hp) do
  1012. begin
  1013. if hp.left<>nil then
  1014. begin
  1015. {This check is pessimistic; a call will happen depending
  1016. on the location in which the elements will be found in
  1017. pass 2.}
  1018. if not do_variant then
  1019. include(current_procinfo.flags,pi_do_call);
  1020. firstpass(hp.left);
  1021. if do_managed_variant then
  1022. wrapmanagedvarrec(hp.left);
  1023. end;
  1024. hp:=tarrayconstructornode(hp.right);
  1025. end;
  1026. end;
  1027. { set the elementdef to the correct type in case of a variant array }
  1028. if do_variant then
  1029. tarraydef(resultdef).elementdef:=search_system_type('TVARREC').typedef;
  1030. expectloc:=LOC_CREFERENCE;
  1031. end;
  1032. function tarrayconstructornode.docompare(p: tnode): boolean;
  1033. begin
  1034. docompare:=inherited docompare(p);
  1035. end;
  1036. {*****************************************************************************
  1037. TTYPENODE
  1038. *****************************************************************************}
  1039. constructor ttypenode.create(def:tdef);
  1040. begin
  1041. inherited create(typen);
  1042. typedef:=def;
  1043. typesym:=def.typesym;
  1044. allowed:=false;
  1045. helperallowed:=false;
  1046. end;
  1047. constructor ttypenode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  1048. begin
  1049. inherited ppuload(t,ppufile);
  1050. ppufile.getderef(typedefderef);
  1051. ppufile.getderef(typesymderef);
  1052. allowed:=boolean(ppufile.getbyte);
  1053. helperallowed:=boolean(ppufile.getbyte);
  1054. end;
  1055. procedure ttypenode.ppuwrite(ppufile:tcompilerppufile);
  1056. begin
  1057. inherited ppuwrite(ppufile);
  1058. ppufile.putderef(typedefderef);
  1059. ppufile.putderef(typesymderef);
  1060. ppufile.putbyte(byte(allowed));
  1061. ppufile.putbyte(byte(helperallowed));
  1062. end;
  1063. procedure ttypenode.buildderefimpl;
  1064. begin
  1065. inherited buildderefimpl;
  1066. typedefderef.build(typedef);
  1067. typesymderef.build(typesym);
  1068. end;
  1069. procedure ttypenode.derefimpl;
  1070. begin
  1071. inherited derefimpl;
  1072. typedef:=tdef(typedefderef.resolve);
  1073. typesym:=tsym(typesymderef.resolve);
  1074. end;
  1075. function ttypenode.pass_typecheck:tnode;
  1076. begin
  1077. result:=nil;
  1078. resultdef:=typedef;
  1079. { check if it's valid }
  1080. if typedef.typ = errordef then
  1081. CGMessage(parser_e_illegal_expression);
  1082. end;
  1083. function ttypenode.pass_1 : tnode;
  1084. begin
  1085. result:=nil;
  1086. expectloc:=LOC_VOID;
  1087. { a typenode can't generate code, so we give here
  1088. an error. Else it'll be an abstract error in pass_generate_code.
  1089. Only when the allowed flag is set we don't generate
  1090. an error }
  1091. if not allowed then
  1092. CGMessage(parser_e_no_type_not_allowed_here);
  1093. if not helperallowed and is_objectpascal_helper(typedef) then
  1094. CGMessage(parser_e_no_category_as_types);
  1095. end;
  1096. function ttypenode.dogetcopy : tnode;
  1097. var
  1098. n : ttypenode;
  1099. begin
  1100. n:=ttypenode(inherited dogetcopy);
  1101. n.allowed:=allowed;
  1102. n.typedef:=typedef;
  1103. n.helperallowed:=helperallowed;
  1104. result:=n;
  1105. end;
  1106. function ttypenode.docompare(p: tnode): boolean;
  1107. begin
  1108. docompare :=
  1109. inherited docompare(p) and
  1110. (typedef=ttypenode(p).typedef) and
  1111. (allowed=ttypenode(p).allowed) and
  1112. (helperallowed=ttypenode(p).helperallowed);
  1113. end;
  1114. {*****************************************************************************
  1115. TRTTINODE
  1116. *****************************************************************************}
  1117. constructor trttinode.create(def:tstoreddef;rt:trttitype;dt:Trttidatatype);
  1118. begin
  1119. inherited create(rttin);
  1120. rttidef:=def;
  1121. rttitype:=rt;
  1122. rttidatatype:=dt;
  1123. end;
  1124. constructor trttinode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  1125. begin
  1126. inherited ppuload(t,ppufile);
  1127. ppufile.getderef(rttidefderef);
  1128. rttitype:=trttitype(ppufile.getbyte);
  1129. rttidatatype:=trttidatatype(ppufile.getbyte);
  1130. end;
  1131. procedure trttinode.ppuwrite(ppufile:tcompilerppufile);
  1132. begin
  1133. inherited ppuwrite(ppufile);
  1134. ppufile.putderef(rttidefderef);
  1135. ppufile.putbyte(byte(rttitype));
  1136. ppufile.putbyte(byte(rttidatatype));
  1137. end;
  1138. procedure trttinode.buildderefimpl;
  1139. begin
  1140. inherited buildderefimpl;
  1141. rttidefderef.build(rttidef);
  1142. end;
  1143. procedure trttinode.derefimpl;
  1144. begin
  1145. inherited derefimpl;
  1146. rttidef:=tstoreddef(rttidefderef.resolve);
  1147. end;
  1148. function trttinode.dogetcopy : tnode;
  1149. var
  1150. n : trttinode;
  1151. begin
  1152. n:=trttinode(inherited dogetcopy);
  1153. n.rttidef:=rttidef;
  1154. n.rttitype:=rttitype;
  1155. n.rttidatatype:=rttidatatype;
  1156. result:=n;
  1157. end;
  1158. function trttinode.pass_typecheck:tnode;
  1159. begin
  1160. { rtti information will be returned as a void pointer }
  1161. result:=nil;
  1162. resultdef:=voidpointertype;
  1163. end;
  1164. function trttinode.pass_1 : tnode;
  1165. begin
  1166. result:=nil;
  1167. expectloc:=LOC_CREFERENCE;
  1168. if (cs_create_pic in current_settings.moduleswitches) and
  1169. (tf_pic_uses_got in target_info.flags) then
  1170. include(current_procinfo.flags,pi_needs_got);
  1171. end;
  1172. function trttinode.docompare(p: tnode): boolean;
  1173. begin
  1174. docompare :=
  1175. inherited docompare(p) and
  1176. (rttidef = trttinode(p).rttidef) and
  1177. (rttitype = trttinode(p).rttitype) and
  1178. (rttidatatype = trttinode(p).rttidatatype);
  1179. end;
  1180. end.