nld.pas 48 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351
  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(is_const(left)) and
  740. not(target_info.system in systems_garbage_collected_managed_types) then
  741. begin
  742. { remove property flag to avoid errors, see comments for }
  743. { tf_winlikewidestring assignments below }
  744. exclude(left.flags,nf_isproperty);
  745. hdef:=search_system_type('TVARDATA').typedef;
  746. hp:=ccallparanode.create(ctypeconvnode.create_internal(
  747. right,hdef),
  748. ccallparanode.create(ctypeconvnode.create_internal(
  749. left,hdef),
  750. nil));
  751. result:=ccallnode.createintern('fpc_variant_copy',hp);
  752. firstpass(result);
  753. left:=nil;
  754. right:=nil;
  755. exit;
  756. end
  757. else if not(target_info.system in systems_garbage_collected_managed_types) and
  758. not(is_const(left)) then
  759. begin
  760. { call helpers for pointer-sized managed types }
  761. if is_widestring(left.resultdef) then
  762. hs:='fpc_widestr_assign'
  763. else if is_ansistring(left.resultdef) then
  764. hs:='fpc_ansistr_assign'
  765. else if is_unicodestring(left.resultdef) then
  766. hs:='fpc_unicodestr_assign'
  767. else if is_interfacecom_or_dispinterface(left.resultdef) then
  768. hs:='fpc_intf_assign'
  769. else if is_dynamic_array(left.resultdef) then
  770. begin
  771. hs:='fpc_dynarray_assign';
  772. needrtti:=true;
  773. end
  774. else
  775. exit;
  776. end
  777. else
  778. exit;
  779. { The first argument of these procedures is a var parameter. Properties cannot }
  780. { be passed to var or out parameters, because in that case setters/getters are not }
  781. { used. Further, if we would allow it in case there are no getters or setters, you }
  782. { would need source changes in case these are introduced later on, thus defeating }
  783. { part of the transparency advantages of properties. In this particular case, }
  784. { however: }
  785. { a) if there is a setter, this code will not be used since then the assignment }
  786. { will be converted to a procedure call }
  787. { b) the getter is irrelevant, because fpc_widestr_assign must always decrease }
  788. { the refcount of the field to which we are writing }
  789. { c) source code changes are not required if a setter is added/removed, because }
  790. { this transformation is handled at compile time }
  791. { -> we can remove the nf_isproperty flag (if any) from left, so that in case it }
  792. { is a property which refers to a field without a setter call, we will not get }
  793. { an error about trying to pass a property as a var parameter }
  794. exclude(left.flags,nf_isproperty);
  795. hp:=ccallparanode.create(ctypeconvnode.create_internal(right,voidpointertype),
  796. ccallparanode.create(ctypeconvnode.create_internal(left,voidpointertype),
  797. nil));
  798. if needrtti then
  799. hp:=ccallparanode.create(
  800. caddrnode.create_internal(
  801. crttinode.create(tstoreddef(left.resultdef),initrtti,rdt_normal)),
  802. hp);
  803. result:=ccallnode.createintern(hs,hp);
  804. firstpass(result);
  805. left:=nil;
  806. right:=nil;
  807. end;
  808. function tassignmentnode.docompare(p: tnode): boolean;
  809. begin
  810. docompare :=
  811. inherited docompare(p) and
  812. (assigntype = tassignmentnode(p).assigntype);
  813. end;
  814. {$ifdef state_tracking}
  815. function Tassignmentnode.track_state_pass(exec_known:boolean):boolean;
  816. var se:Tstate_entry;
  817. begin
  818. track_state_pass:=false;
  819. if exec_known then
  820. begin
  821. track_state_pass:=right.track_state_pass(exec_known);
  822. {Force a new resultdef pass.}
  823. right.resultdef:=nil;
  824. do_typecheckpass(right);
  825. typecheckpass(right);
  826. aktstate.store_fact(left.getcopy,right.getcopy);
  827. end
  828. else
  829. aktstate.delete_fact(left);
  830. end;
  831. {$endif}
  832. {*****************************************************************************
  833. TARRAYCONSTRUCTORRANGENODE
  834. *****************************************************************************}
  835. constructor tarrayconstructorrangenode.create(l,r : tnode);
  836. begin
  837. inherited create(arrayconstructorrangen,l,r);
  838. end;
  839. function tarrayconstructorrangenode.pass_typecheck:tnode;
  840. begin
  841. result:=nil;
  842. typecheckpass(left);
  843. typecheckpass(right);
  844. set_varstate(left,vs_read,[vsf_must_be_valid]);
  845. set_varstate(right,vs_read,[vsf_must_be_valid]);
  846. if codegenerror then
  847. exit;
  848. resultdef:=left.resultdef;
  849. end;
  850. function tarrayconstructorrangenode.pass_1 : tnode;
  851. begin
  852. result:=nil;
  853. CGMessage(parser_e_illegal_expression);
  854. end;
  855. {****************************************************************************
  856. TARRAYCONSTRUCTORNODE
  857. *****************************************************************************}
  858. constructor tarrayconstructornode.create(l,r : tnode);
  859. begin
  860. inherited create(arrayconstructorn,l,r);
  861. end;
  862. function tarrayconstructornode.dogetcopy : tnode;
  863. var
  864. n : tarrayconstructornode;
  865. begin
  866. n:=tarrayconstructornode(inherited dogetcopy);
  867. result:=n;
  868. end;
  869. function tarrayconstructornode.pass_typecheck:tnode;
  870. var
  871. hdef : tdef;
  872. hp : tarrayconstructornode;
  873. len : longint;
  874. varia : boolean;
  875. eq : tequaltype;
  876. hnodetype : tnodetype;
  877. begin
  878. result:=nil;
  879. { are we allowing array constructor? Then convert it to a set.
  880. Do this only if we didn't convert the arrayconstructor yet. This
  881. is needed for the cases where the resultdef is forced for a second
  882. run }
  883. if not(allow_array_constructor) then
  884. begin
  885. hp:=tarrayconstructornode(getcopy);
  886. arrayconstructor_to_set(tnode(hp));
  887. result:=hp;
  888. exit;
  889. end;
  890. { only pass left tree, right tree contains next construct if any }
  891. hdef:=nil;
  892. hnodetype:=errorn;
  893. len:=0;
  894. varia:=false;
  895. if assigned(left) then
  896. begin
  897. hp:=self;
  898. while assigned(hp) do
  899. begin
  900. typecheckpass(hp.left);
  901. set_varstate(hp.left,vs_read,[vsf_must_be_valid]);
  902. if (hdef=nil) then
  903. begin
  904. hdef:=hp.left.resultdef;
  905. hnodetype:=hp.left.nodetype;
  906. end
  907. else
  908. begin
  909. { If we got a niln we don't know the type yet and need to take the
  910. type of the next array element.
  911. This is to handle things like [nil,tclass,tclass], see also tw8371 (PFV) }
  912. if hnodetype=niln then
  913. begin
  914. eq:=compare_defs(hp.left.resultdef,hdef,hnodetype);
  915. if eq>te_incompatible then
  916. begin
  917. hdef:=hp.left.resultdef;
  918. hnodetype:=hp.left.nodetype;
  919. end;
  920. end
  921. else
  922. eq:=compare_defs(hdef,hp.left.resultdef,hp.left.nodetype);
  923. if (not varia) and (eq<te_equal) then
  924. begin
  925. { If both are integers we need to take the type that can hold both
  926. defs }
  927. if is_integer(hdef) and is_integer(hp.left.resultdef) then
  928. begin
  929. if is_in_limit(hdef,hp.left.resultdef) then
  930. hdef:=hp.left.resultdef;
  931. end
  932. else
  933. if (nf_novariaallowed in flags) then
  934. varia:=true;
  935. end;
  936. end;
  937. inc(len);
  938. hp:=tarrayconstructornode(hp.right);
  939. end;
  940. end;
  941. { Set the type of empty or varia arrays to void. Also
  942. do this if the type is array of const/open array
  943. because those can't be used with setelementdef }
  944. if not assigned(hdef) or
  945. varia or
  946. is_array_of_const(hdef) or
  947. is_open_array(hdef) then
  948. hdef:=voidtype;
  949. resultdef:=carraydef.create(0,len-1,s32inttype);
  950. tarraydef(resultdef).elementdef:=hdef;
  951. include(tarraydef(resultdef).arrayoptions,ado_IsConstructor);
  952. if varia then
  953. include(tarraydef(resultdef).arrayoptions,ado_IsVariant);
  954. end;
  955. procedure tarrayconstructornode.force_type(def:tdef);
  956. var
  957. hp : tarrayconstructornode;
  958. begin
  959. tarraydef(resultdef).elementdef:=def;
  960. include(tarraydef(resultdef).arrayoptions,ado_IsConstructor);
  961. exclude(tarraydef(resultdef).arrayoptions,ado_IsVariant);
  962. if assigned(left) then
  963. begin
  964. hp:=self;
  965. while assigned(hp) do
  966. begin
  967. inserttypeconv(hp.left,def);
  968. hp:=tarrayconstructornode(hp.right);
  969. end;
  970. end;
  971. end;
  972. procedure tarrayconstructornode.insert_typeconvs;
  973. var
  974. hp : tarrayconstructornode;
  975. dovariant : boolean;
  976. begin
  977. dovariant:=(nf_forcevaria in flags) or (ado_isvariant in tarraydef(resultdef).arrayoptions);
  978. { only pass left tree, right tree contains next construct if any }
  979. if assigned(left) then
  980. begin
  981. hp:=self;
  982. while assigned(hp) do
  983. begin
  984. typecheckpass(hp.left);
  985. { Insert typeconvs for array of const }
  986. if dovariant then
  987. { at this time C varargs are no longer an arrayconstructornode }
  988. insert_varargstypeconv(hp.left,false);
  989. hp:=tarrayconstructornode(hp.right);
  990. end;
  991. end;
  992. end;
  993. function tarrayconstructornode.pass_1 : tnode;
  994. var
  995. hp : tarrayconstructornode;
  996. do_variant,
  997. do_managed_variant:boolean;
  998. begin
  999. do_variant:=(nf_forcevaria in flags) or (ado_isvariant in tarraydef(resultdef).arrayoptions);
  1000. do_managed_variant:=
  1001. do_variant and
  1002. (target_info.system in systems_managed_vm);
  1003. result:=nil;
  1004. { Insert required type convs, this must be
  1005. done in pass 1, because the call must be
  1006. typecheckpassed already }
  1007. if assigned(left) then
  1008. begin
  1009. insert_typeconvs;
  1010. { call firstpass for all nodes }
  1011. hp:=self;
  1012. while assigned(hp) do
  1013. begin
  1014. if hp.left<>nil then
  1015. begin
  1016. {This check is pessimistic; a call will happen depending
  1017. on the location in which the elements will be found in
  1018. pass 2.}
  1019. if not do_variant then
  1020. include(current_procinfo.flags,pi_do_call);
  1021. firstpass(hp.left);
  1022. if do_managed_variant then
  1023. wrapmanagedvarrec(hp.left);
  1024. end;
  1025. hp:=tarrayconstructornode(hp.right);
  1026. end;
  1027. end;
  1028. { set the elementdef to the correct type in case of a variant array }
  1029. if do_variant then
  1030. tarraydef(resultdef).elementdef:=search_system_type('TVARREC').typedef;
  1031. expectloc:=LOC_CREFERENCE;
  1032. end;
  1033. function tarrayconstructornode.docompare(p: tnode): boolean;
  1034. begin
  1035. docompare:=inherited docompare(p);
  1036. end;
  1037. {*****************************************************************************
  1038. TTYPENODE
  1039. *****************************************************************************}
  1040. constructor ttypenode.create(def:tdef);
  1041. begin
  1042. inherited create(typen);
  1043. typedef:=def;
  1044. typesym:=def.typesym;
  1045. allowed:=false;
  1046. helperallowed:=false;
  1047. end;
  1048. constructor ttypenode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  1049. begin
  1050. inherited ppuload(t,ppufile);
  1051. ppufile.getderef(typedefderef);
  1052. ppufile.getderef(typesymderef);
  1053. allowed:=boolean(ppufile.getbyte);
  1054. helperallowed:=boolean(ppufile.getbyte);
  1055. end;
  1056. procedure ttypenode.ppuwrite(ppufile:tcompilerppufile);
  1057. begin
  1058. inherited ppuwrite(ppufile);
  1059. ppufile.putderef(typedefderef);
  1060. ppufile.putderef(typesymderef);
  1061. ppufile.putbyte(byte(allowed));
  1062. ppufile.putbyte(byte(helperallowed));
  1063. end;
  1064. procedure ttypenode.buildderefimpl;
  1065. begin
  1066. inherited buildderefimpl;
  1067. typedefderef.build(typedef);
  1068. typesymderef.build(typesym);
  1069. end;
  1070. procedure ttypenode.derefimpl;
  1071. begin
  1072. inherited derefimpl;
  1073. typedef:=tdef(typedefderef.resolve);
  1074. typesym:=tsym(typesymderef.resolve);
  1075. end;
  1076. function ttypenode.pass_typecheck:tnode;
  1077. begin
  1078. result:=nil;
  1079. resultdef:=typedef;
  1080. { check if it's valid }
  1081. if typedef.typ = errordef then
  1082. CGMessage(parser_e_illegal_expression);
  1083. end;
  1084. function ttypenode.pass_1 : tnode;
  1085. begin
  1086. result:=nil;
  1087. expectloc:=LOC_VOID;
  1088. { a typenode can't generate code, so we give here
  1089. an error. Else it'll be an abstract error in pass_generate_code.
  1090. Only when the allowed flag is set we don't generate
  1091. an error }
  1092. if not allowed then
  1093. CGMessage(parser_e_no_type_not_allowed_here);
  1094. if not helperallowed and is_objectpascal_helper(typedef) then
  1095. CGMessage(parser_e_no_category_as_types);
  1096. end;
  1097. function ttypenode.dogetcopy : tnode;
  1098. var
  1099. n : ttypenode;
  1100. begin
  1101. n:=ttypenode(inherited dogetcopy);
  1102. n.allowed:=allowed;
  1103. n.typedef:=typedef;
  1104. n.helperallowed:=helperallowed;
  1105. result:=n;
  1106. end;
  1107. function ttypenode.docompare(p: tnode): boolean;
  1108. begin
  1109. docompare :=
  1110. inherited docompare(p) and
  1111. (typedef=ttypenode(p).typedef) and
  1112. (allowed=ttypenode(p).allowed) and
  1113. (helperallowed=ttypenode(p).helperallowed);
  1114. end;
  1115. {*****************************************************************************
  1116. TRTTINODE
  1117. *****************************************************************************}
  1118. constructor trttinode.create(def:tstoreddef;rt:trttitype;dt:Trttidatatype);
  1119. begin
  1120. inherited create(rttin);
  1121. rttidef:=def;
  1122. rttitype:=rt;
  1123. rttidatatype:=dt;
  1124. end;
  1125. constructor trttinode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  1126. begin
  1127. inherited ppuload(t,ppufile);
  1128. ppufile.getderef(rttidefderef);
  1129. rttitype:=trttitype(ppufile.getbyte);
  1130. rttidatatype:=trttidatatype(ppufile.getbyte);
  1131. end;
  1132. procedure trttinode.ppuwrite(ppufile:tcompilerppufile);
  1133. begin
  1134. inherited ppuwrite(ppufile);
  1135. ppufile.putderef(rttidefderef);
  1136. ppufile.putbyte(byte(rttitype));
  1137. ppufile.putbyte(byte(rttidatatype));
  1138. end;
  1139. procedure trttinode.buildderefimpl;
  1140. begin
  1141. inherited buildderefimpl;
  1142. rttidefderef.build(rttidef);
  1143. end;
  1144. procedure trttinode.derefimpl;
  1145. begin
  1146. inherited derefimpl;
  1147. rttidef:=tstoreddef(rttidefderef.resolve);
  1148. end;
  1149. function trttinode.dogetcopy : tnode;
  1150. var
  1151. n : trttinode;
  1152. begin
  1153. n:=trttinode(inherited dogetcopy);
  1154. n.rttidef:=rttidef;
  1155. n.rttitype:=rttitype;
  1156. n.rttidatatype:=rttidatatype;
  1157. result:=n;
  1158. end;
  1159. function trttinode.pass_typecheck:tnode;
  1160. begin
  1161. { rtti information will be returned as a void pointer }
  1162. result:=nil;
  1163. resultdef:=voidpointertype;
  1164. end;
  1165. function trttinode.pass_1 : tnode;
  1166. begin
  1167. result:=nil;
  1168. expectloc:=LOC_CREFERENCE;
  1169. if (cs_create_pic in current_settings.moduleswitches) and
  1170. (tf_pic_uses_got in target_info.flags) then
  1171. include(current_procinfo.flags,pi_needs_got);
  1172. end;
  1173. function trttinode.docompare(p: tnode): boolean;
  1174. begin
  1175. docompare :=
  1176. inherited docompare(p) and
  1177. (rttidef = trttinode(p).rttidef) and
  1178. (rttitype = trttinode(p).rttitype) and
  1179. (rttidatatype = trttinode(p).rttidatatype);
  1180. end;
  1181. end.