symsym.inc 58 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939
  1. {
  2. $Id$
  3. Copyright (c) 1993-98 by Florian Klaempfl, Pierre Muller
  4. Implementation for the symbols types of the symtable
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. {****************************************************************************
  19. TSYM (base for all symtypes)
  20. ****************************************************************************}
  21. constructor tsym.init(const n : string);
  22. begin
  23. left:=nil;
  24. right:=nil;
  25. setname(n);
  26. typ:=abstractsym;
  27. properties:=current_object_option;
  28. {$ifdef GDB}
  29. isstabwritten := false;
  30. {$endif GDB}
  31. fileinfo:=tokenpos;
  32. {$ifdef UseBrowser}
  33. defref:=nil;
  34. lastwritten:=nil;
  35. refcount:=0;
  36. if (cs_browser in aktmoduleswitches) and make_ref then
  37. begin
  38. defref:=new(pref,init(defref,@tokenpos));
  39. inc(refcount);
  40. end;
  41. lastref:=defref;
  42. {$endif UseBrowser}
  43. end;
  44. constructor tsym.load;
  45. begin
  46. left:=nil;
  47. right:=nil;
  48. setname(readstring);
  49. typ:=abstractsym;
  50. fillchar(fileinfo,sizeof(fileinfo),0);
  51. if object_options then
  52. properties:=symprop(readbyte)
  53. else
  54. properties:=sp_public;
  55. {$ifdef UseBrowser}
  56. lastref:=nil;
  57. defref:=nil;
  58. lastwritten:=nil;
  59. refcount:=0;
  60. {$endif UseBrowser}
  61. {$ifdef GDB}
  62. isstabwritten := false;
  63. {$endif GDB}
  64. end;
  65. {$ifdef UseBrowser}
  66. procedure tsym.load_references;
  67. var
  68. pos : tfileposinfo;
  69. move_last : boolean;
  70. begin
  71. move_last:=lastwritten=lastref;
  72. while (not current_ppu^.endofentry) do
  73. begin
  74. readposinfo(pos);
  75. inc(refcount);
  76. lastref:=new(pref,init(lastref,@pos));
  77. lastref^.is_written:=true;
  78. if refcount=1 then
  79. defref:=lastref;
  80. end;
  81. if move_last then
  82. lastwritten:=lastref;
  83. end;
  84. { big problem here :
  85. wrong refs were written because of
  86. interface parsing of other units PM
  87. moduleindex must be checked !! }
  88. function tsym.write_references : boolean;
  89. var
  90. ref : pref;
  91. symref_written,move_last : boolean;
  92. begin
  93. write_references:=false;
  94. if lastwritten=lastref then
  95. exit;
  96. { should we update lastref }
  97. move_last:=true;
  98. symref_written:=false;
  99. { write symbol refs }
  100. if assigned(lastwritten) then
  101. ref:=lastwritten
  102. else
  103. ref:=defref;
  104. while assigned(ref) do
  105. begin
  106. if ref^.moduleindex=current_module^.unit_index then
  107. begin
  108. { write address to this symbol }
  109. if not symref_written then
  110. begin
  111. writesymref(@self);
  112. symref_written:=true;
  113. end;
  114. writeposinfo(ref^.posinfo);
  115. ref^.is_written:=true;
  116. if move_last then
  117. lastwritten:=ref;
  118. end
  119. else if not ref^.is_written then
  120. move_last:=false
  121. else if move_last then
  122. lastwritten:=ref;
  123. ref:=ref^.nextref;
  124. end;
  125. if symref_written then
  126. current_ppu^.writeentry(ibsymref);
  127. write_references:=symref_written;
  128. end;
  129. procedure tsym.add_to_browserlog;
  130. begin
  131. if assigned(defref) then
  132. begin
  133. Browse.AddLog('***'+name+'***');
  134. Browse.AddLogRefs(defref);
  135. end;
  136. end;
  137. {$endif UseBrowser}
  138. destructor tsym.done;
  139. begin
  140. {$ifdef tp}
  141. if not(use_big) then
  142. {$endif tp}
  143. strdispose(_name);
  144. {$ifdef UseBrowser}
  145. if assigned(defref) then
  146. dispose(defref,done);
  147. {$endif UseBrowser}
  148. if assigned(left) then
  149. dispose(left,done);
  150. if assigned(right) then
  151. dispose(right,done);
  152. end;
  153. procedure tsym.write;
  154. begin
  155. writestring(name);
  156. if object_options then
  157. writebyte(byte(properties));
  158. end;
  159. procedure tsym.deref;
  160. begin
  161. end;
  162. function tsym.name : string;
  163. {$ifdef tp}
  164. var
  165. s : string;
  166. b : byte;
  167. {$endif}
  168. begin
  169. {$ifdef tp}
  170. if use_big then
  171. begin
  172. symbolstream.seek(longint(_name));
  173. symbolstream.read(b,1);
  174. symbolstream.read(s[1],b);
  175. s[0]:=chr(b);
  176. name:=s;
  177. end
  178. else
  179. {$endif}
  180. if assigned(_name) then
  181. name:=strpas(_name)
  182. else
  183. name:='';
  184. end;
  185. function tsym.mangledname : string;
  186. begin
  187. mangledname:=name;
  188. end;
  189. procedure tsym.setname(const s : string);
  190. begin
  191. setstring(_name,s);
  192. end;
  193. { for most symbol types ther is nothing to do at all }
  194. procedure tsym.insert_in_data;
  195. begin
  196. end;
  197. {$ifdef GDB}
  198. function tsym.stabstring : pchar;
  199. begin
  200. stabstring:=strpnew('"'+name+'",'+tostr(N_LSYM)+',0,'+
  201. tostr(fileinfo.line)+',0');
  202. end;
  203. procedure tsym.concatstabto(asmlist : paasmoutput);
  204. var stab_str : pchar;
  205. begin
  206. if not isstabwritten then
  207. begin
  208. stab_str := stabstring;
  209. if asmlist = debuglist then do_count_dbx := true;
  210. { count_dbx(stab_str); moved to GDB.PAS }
  211. asmlist^.concat(new(pai_stabs,init(stab_str)));
  212. isstabwritten:=true;
  213. end;
  214. end;
  215. {$endif GDB}
  216. {****************************************************************************
  217. TLABELSYM
  218. ****************************************************************************}
  219. constructor tlabelsym.init(const n : string; l : plabel);
  220. begin
  221. inherited init(n);
  222. typ:=labelsym;
  223. number:=l;
  224. number^.is_used:=false;
  225. number^.is_set:=true;
  226. number^.refcount:=0;
  227. defined:=false;
  228. end;
  229. constructor tlabelsym.load;
  230. begin
  231. tsym.load;
  232. typ:=labelsym;
  233. { this is all dummy
  234. it is only used for local browsing }
  235. number:=nil;
  236. defined:=true;
  237. end;
  238. destructor tlabelsym.done;
  239. begin
  240. if not(defined) then
  241. Message1(sym_e_label_not_defined,name);
  242. inherited done;
  243. end;
  244. function tlabelsym.mangledname : string;
  245. begin
  246. { this also sets the is_used field }
  247. mangledname:=lab2str(number);
  248. end;
  249. procedure tlabelsym.write;
  250. begin
  251. if owner^.symtabletype in [unitsymtable,globalsymtable] then
  252. Message(sym_e_ill_label_decl)
  253. else
  254. begin
  255. tsym.write;
  256. current_ppu^.writeentry(iblabelsym);
  257. end;
  258. end;
  259. {****************************************************************************
  260. TUNITSYM
  261. ****************************************************************************}
  262. constructor tunitsym.init(const n : string;ref : punitsymtable);
  263. var
  264. old_make_ref : boolean;
  265. begin
  266. old_make_ref:=make_ref;
  267. make_ref:=false;
  268. inherited init(n);
  269. make_ref:=old_make_ref;
  270. typ:=unitsym;
  271. unitsymtable:=ref;
  272. prevsym:=ref^.unitsym;
  273. ref^.unitsym:=@self;
  274. refs:=0;
  275. end;
  276. constructor tunitsym.load;
  277. begin
  278. tsym.load;
  279. typ:=unitsym;
  280. unitsymtable:=punitsymtable(current_module^.globalsymtable);
  281. prevsym:=nil;
  282. end;
  283. destructor tunitsym.done;
  284. begin
  285. if assigned(unitsymtable) and (unitsymtable^.unitsym=@self) then
  286. unitsymtable^.unitsym:=prevsym;
  287. inherited done;
  288. end;
  289. procedure tunitsym.write;
  290. begin
  291. tsym.write;
  292. current_ppu^.writeentry(ibunitsym);
  293. end;
  294. {$ifdef GDB}
  295. procedure tunitsym.concatstabto(asmlist : paasmoutput);
  296. begin
  297. {Nothing to write to stabs !}
  298. end;
  299. {$endif GDB}
  300. {****************************************************************************
  301. TPROCSYM
  302. ****************************************************************************}
  303. constructor tprocsym.init(const n : string);
  304. begin
  305. tsym.init(n);
  306. typ:=procsym;
  307. definition:=nil;
  308. owner:=nil;
  309. {$ifdef GDB}
  310. is_global := false;
  311. {$endif GDB}
  312. end;
  313. constructor tprocsym.load;
  314. begin
  315. tsym.load;
  316. typ:=procsym;
  317. definition:=pprocdef(readdefref);
  318. {$ifdef GDB}
  319. is_global := false;
  320. {$endif GDB}
  321. end;
  322. destructor tprocsym.done;
  323. begin
  324. check_forward;
  325. tsym.done;
  326. end;
  327. function tprocsym.mangledname : string;
  328. begin
  329. mangledname:=definition^.mangledname;
  330. end;
  331. function tprocsym.demangledname:string;
  332. begin
  333. demangledname:=name+definition^.demangled_paras;
  334. end;
  335. procedure tprocsym.write_parameter_lists;
  336. var
  337. p : pprocdef;
  338. begin
  339. p:=definition;
  340. while assigned(p) do
  341. begin
  342. { force the error to be printed }
  343. Verbose.Message1(sym_b_param_list,name+p^.demangled_paras);
  344. p:=p^.nextoverloaded;
  345. end;
  346. end;
  347. procedure tprocsym.check_forward;
  348. var
  349. pd : pprocdef;
  350. oldaktfilepos : tfileposinfo;
  351. begin
  352. pd:=definition;
  353. while assigned(pd) do
  354. begin
  355. if pd^.forwarddef then
  356. begin
  357. oldaktfilepos:=aktfilepos;
  358. aktfilepos:=fileinfo;
  359. if assigned(pd^._class) then
  360. Message1(sym_e_forward_not_resolved,pd^._class^.name^+'.'+name+demangledparas(pd^.demangled_paras))
  361. else
  362. Message1(sym_e_forward_not_resolved,name+pd^.demangled_paras);
  363. aktfilepos:=oldaktfilepos;
  364. end;
  365. pd:=pd^.nextoverloaded;
  366. end;
  367. end;
  368. procedure tprocsym.deref;
  369. var
  370. t : ttoken;
  371. last : pprocdef;
  372. begin
  373. resolvedef(pdef(definition));
  374. if (definition^.options and pooperator) <> 0 then
  375. begin
  376. last:=definition;
  377. while assigned(last^.nextoverloaded) do
  378. last:=last^.nextoverloaded;
  379. for t:=first_overloaded to last_overloaded do
  380. if (name=overloaded_names[t]) then
  381. begin
  382. if assigned(overloaded_operators[t]) then
  383. last^.nextoverloaded:=overloaded_operators[t]^.definition;
  384. overloaded_operators[t]:=@self;
  385. end;
  386. end;
  387. end;
  388. procedure tprocsym.write;
  389. begin
  390. tsym.write;
  391. writedefref(pdef(definition));
  392. current_ppu^.writeentry(ibprocsym);
  393. end;
  394. {$ifdef UseBrowser}
  395. procedure tprocsym.load_references;
  396. var
  397. prdef : pprocdef;
  398. begin
  399. inherited load_references;
  400. prdef:=definition;
  401. { take care about operators !! }
  402. while assigned(prdef) and (prdef^.owner=definition^.owner) do
  403. begin
  404. prdef^.load_references;
  405. prdef:=prdef^.nextoverloaded;
  406. end;
  407. end;
  408. function tprocsym.write_references : boolean;
  409. var
  410. prdef : pprocdef;
  411. begin
  412. write_references:=false;
  413. if not inherited write_references then
  414. exit;
  415. write_references:=true;
  416. prdef:=definition;
  417. while assigned(prdef) and (prdef^.owner=definition^.owner) do
  418. begin
  419. prdef^.write_references;
  420. prdef:=prdef^.nextoverloaded;
  421. end;
  422. end;
  423. procedure tprocsym.add_to_browserlog;
  424. var
  425. prdef : pprocdef;
  426. begin
  427. inherited add_to_browserlog;
  428. prdef:=definition;
  429. while assigned(prdef) do
  430. begin
  431. pprocdef(prdef)^.add_to_browserlog;
  432. prdef:=pprocdef(prdef)^.nextoverloaded;
  433. end;
  434. end;
  435. {$endif UseBrowser}
  436. {$ifdef GDB}
  437. function tprocsym.stabstring : pchar;
  438. Var RetType : Char;
  439. Obj,Info : String;
  440. begin
  441. obj := name;
  442. info := '';
  443. if is_global then
  444. RetType := 'F'
  445. else
  446. RetType := 'f';
  447. if assigned(owner) then
  448. begin
  449. if (owner^.symtabletype = objectsymtable) then
  450. obj := owner^.name^+'__'+name;
  451. if (owner^.symtabletype=localsymtable) and assigned(owner^.name) then
  452. info := ','+name+','+owner^.name^;
  453. end;
  454. stabstring :=strpnew('"'+obj+':'+RetType
  455. +definition^.retdef^.numberstring+info+'",'+tostr(n_function)
  456. +',0,'+
  457. tostr(aktfilepos.line)
  458. +','+definition^.mangledname);
  459. end;
  460. procedure tprocsym.concatstabto(asmlist : paasmoutput);
  461. begin
  462. if (definition^.options and pointernproc) <> 0 then exit;
  463. if not isstabwritten then
  464. asmlist^.concat(new(pai_stabs,init(stabstring)));
  465. isstabwritten := true;
  466. if assigned(definition^.parast) then
  467. definition^.parast^.concatstabto(asmlist);
  468. if assigned(definition^.localst) then
  469. definition^.localst^.concatstabto(asmlist);
  470. definition^.is_def_stab_written := true;
  471. end;
  472. {$endif GDB}
  473. {****************************************************************************
  474. TPROGRAMSYM
  475. ****************************************************************************}
  476. constructor tprogramsym.init(const n : string);
  477. begin
  478. inherited init(n);
  479. typ:=programsym;
  480. end;
  481. {****************************************************************************
  482. TERRORSYM
  483. ****************************************************************************}
  484. constructor terrorsym.init;
  485. begin
  486. inherited init('');
  487. typ:=errorsym;
  488. end;
  489. {****************************************************************************
  490. TPROPERTYSYM
  491. ****************************************************************************}
  492. constructor tpropertysym.init(const n : string);
  493. begin
  494. inherited init(n);
  495. typ:=propertysym;
  496. options:=0;
  497. proptype:=nil;
  498. readaccessdef:=nil;
  499. writeaccessdef:=nil;
  500. readaccesssym:=nil;
  501. writeaccesssym:=nil;
  502. storedsym:=nil;
  503. storeddef:=nil;
  504. index:=0;
  505. default:=0;
  506. end;
  507. destructor tpropertysym.done;
  508. begin
  509. inherited done;
  510. end;
  511. constructor tpropertysym.load;
  512. begin
  513. inherited load;
  514. typ:=propertysym;
  515. proptype:=readdefref;
  516. options:=readlong;
  517. index:=readlong;
  518. default:=readlong;
  519. { it's hack ... }
  520. readaccesssym:=psym(stringdup(readstring));
  521. writeaccesssym:=psym(stringdup(readstring));
  522. storedsym:=psym(stringdup(readstring));
  523. { now the defs: }
  524. readaccessdef:=readdefref;
  525. writeaccessdef:=readdefref;
  526. storeddef:=readdefref;
  527. end;
  528. procedure tpropertysym.deref;
  529. begin
  530. resolvedef(proptype);
  531. resolvedef(readaccessdef);
  532. resolvedef(writeaccessdef);
  533. resolvedef(storeddef);
  534. { solve the hack we did in load: }
  535. if pstring(readaccesssym)^<>'' then
  536. begin
  537. srsym:=search_class_member(pobjectdef(owner^.defowner),pstring(readaccesssym)^);
  538. if not(assigned(srsym)) then
  539. srsym:=generrorsym;
  540. end
  541. else
  542. srsym:=nil;
  543. stringdispose(pstring(readaccesssym));
  544. readaccesssym:=srsym;
  545. if pstring(writeaccesssym)^<>'' then
  546. begin
  547. srsym:=search_class_member(pobjectdef(owner^.defowner),pstring(writeaccesssym)^);
  548. if not(assigned(srsym)) then
  549. srsym:=generrorsym;
  550. end
  551. else
  552. srsym:=nil;
  553. stringdispose(pstring(writeaccesssym));
  554. writeaccesssym:=srsym;
  555. if pstring(storedsym)^<>'' then
  556. begin
  557. srsym:=search_class_member(pobjectdef(owner^.defowner),pstring(storedsym)^);
  558. if not(assigned(srsym)) then
  559. srsym:=generrorsym;
  560. end
  561. else
  562. srsym:=nil;
  563. stringdispose(pstring(storedsym));
  564. storedsym:=srsym;
  565. end;
  566. function tpropertysym.getsize : longint;
  567. begin
  568. getsize:=0;
  569. end;
  570. procedure tpropertysym.write;
  571. begin
  572. tsym.write;
  573. writedefref(proptype);
  574. writelong(options);
  575. writelong(index);
  576. writelong(default);
  577. if assigned(readaccesssym) then
  578. writestring(readaccesssym^.name)
  579. else
  580. writestring('');
  581. if assigned(writeaccesssym) then
  582. writestring(writeaccesssym^.name)
  583. else
  584. writestring('');
  585. if assigned(storedsym) then
  586. writestring(storedsym^.name)
  587. else
  588. writestring('');
  589. writedefref(readaccessdef);
  590. writedefref(writeaccessdef);
  591. writedefref(storeddef);
  592. current_ppu^.writeentry(ibpropertysym);
  593. end;
  594. {$ifdef GDB}
  595. function tpropertysym.stabstring : pchar;
  596. begin
  597. { !!!! don't know how to handle }
  598. stabstring:=strpnew('');
  599. end;
  600. procedure tpropertysym.concatstabto(asmlist : paasmoutput);
  601. begin
  602. { !!!! don't know how to handle }
  603. end;
  604. {$endif GDB}
  605. {****************************************************************************
  606. TFUNCRETSYM
  607. ****************************************************************************}
  608. constructor tfuncretsym.init(const n : string;approcinfo : pointer{pprocinfo});
  609. begin
  610. tsym.init(n);
  611. typ:=funcretsym;
  612. funcretprocinfo:=approcinfo;
  613. funcretdef:=pprocinfo(approcinfo)^.retdef;
  614. { address valid for ret in param only }
  615. { otherwise set by insert }
  616. address:=pprocinfo(approcinfo)^.retoffset;
  617. end;
  618. {$ifdef GDB}
  619. procedure tfuncretsym.concatstabto(asmlist : paasmoutput);
  620. begin
  621. { Nothing to do here, it is done in genexitcode }
  622. end;
  623. {$endif GDB}
  624. {****************************************************************************
  625. TABSOLUTESYM
  626. ****************************************************************************}
  627. { constructor tabsolutesym.init(const s : string;p : pdef;newref : psym);
  628. begin
  629. inherited init(s,p);
  630. ref:=newref;
  631. typ:=absolutesym;
  632. end; }
  633. constructor tabsolutesym.load;
  634. begin
  635. tvarsym.load;
  636. typ:=absolutesym;
  637. ref:=nil;
  638. address:=0;
  639. asmname:=nil;
  640. abstyp:=absolutetyp(readbyte);
  641. absseg:=false;
  642. case abstyp of
  643. tovar : begin
  644. asmname:=stringdup(readstring);
  645. ref:=srsym;
  646. end;
  647. toasm : asmname:=stringdup(readstring);
  648. toaddr : address:=readlong;
  649. end;
  650. end;
  651. procedure tabsolutesym.write;
  652. begin
  653. tsym.write;
  654. writebyte(byte(varspez));
  655. if read_member then
  656. writelong(address);
  657. writedefref(definition);
  658. writebyte(byte(abstyp));
  659. case abstyp of
  660. tovar : writestring(ref^.name);
  661. toasm : writestring(asmname^);
  662. toaddr : writelong(address);
  663. end;
  664. current_ppu^.writeentry(ibabsolutesym);
  665. end;
  666. procedure tabsolutesym.deref;
  667. begin
  668. resolvedef(definition);
  669. if (abstyp=tovar) and (asmname<>nil) then
  670. begin
  671. { search previous loaded symtables }
  672. getsym(asmname^,false);
  673. if not(assigned(srsym)) then
  674. getsymonlyin(owner,asmname^);
  675. if not(assigned(srsym)) then
  676. srsym:=generrorsym;
  677. ref:=srsym;
  678. stringdispose(asmname);
  679. end;
  680. end;
  681. function tabsolutesym.mangledname : string;
  682. begin
  683. case abstyp of
  684. tovar : mangledname:=ref^.mangledname;
  685. toasm : mangledname:=asmname^;
  686. toaddr : mangledname:='$'+tostr(address);
  687. else
  688. internalerror(10002);
  689. end;
  690. end;
  691. procedure tabsolutesym.insert_in_data;
  692. begin
  693. end;
  694. {$ifdef GDB}
  695. procedure tabsolutesym.concatstabto(asmlist : paasmoutput);
  696. begin
  697. { I don't know how to handle this !! }
  698. end;
  699. {$endif GDB}
  700. {****************************************************************************
  701. TVARSYM
  702. ****************************************************************************}
  703. constructor tvarsym.init(const n : string;p : pdef);
  704. begin
  705. tsym.init(n);
  706. typ:=varsym;
  707. definition:=p;
  708. _mangledname:=nil;
  709. varspez:=vs_value;
  710. address:=0;
  711. refs:=0;
  712. is_valid := 1;
  713. var_options:=0;
  714. { can we load the value into a register ? }
  715. case p^.deftype of
  716. pointerdef,
  717. enumdef,
  718. procvardef : var_options:=var_options or vo_regable;
  719. orddef : case porddef(p)^.typ of
  720. u8bit,u16bit,u32bit,
  721. bool8bit,bool16bit,bool32bit,
  722. s8bit,s16bit,s32bit :
  723. var_options:=var_options or vo_regable;
  724. else
  725. var_options:=var_options and not vo_regable;
  726. end;
  727. else
  728. var_options:=var_options and not vo_regable;
  729. end;
  730. reg:=R_NO;
  731. end;
  732. constructor tvarsym.load;
  733. begin
  734. tsym.load;
  735. typ:=varsym;
  736. _mangledname:=nil;
  737. varspez:=tvarspez(readbyte);
  738. if read_member then
  739. address:=readlong
  740. else
  741. address:=0;
  742. definition:=readdefref;
  743. refs := 0;
  744. is_valid := 1;
  745. { symbols which are load are never candidates for a register }
  746. var_options:=0;
  747. { was regable:=false; }
  748. reg:=R_NO;
  749. end;
  750. constructor tvarsym.init_C(const n,mangled : string;p : pdef);
  751. begin
  752. { The tvarsym is necessary for 0.99.5 (PFV) }
  753. tvarsym.init(n,p);
  754. var_options:=var_options or vo_is_C_var;
  755. { C prefix not allways added moved to
  756. pdecl PM }
  757. _mangledname:=strpnew(mangled);
  758. end;
  759. constructor tvarsym.load_C;
  760. begin
  761. { Adding tvarsym removes the warning }
  762. tvarsym.load;
  763. typ:=varsym;
  764. var_options:=readbyte;
  765. _mangledname:=strpnew(readstring);
  766. end;
  767. procedure tvarsym.deref;
  768. begin
  769. resolvedef(definition);
  770. end;
  771. procedure tvarsym.write;
  772. begin
  773. tsym.write;
  774. writebyte(byte(varspez));
  775. if read_member then
  776. writelong(address);
  777. writedefref(definition);
  778. if (var_options and vo_is_C_var)<>0 then
  779. begin
  780. writebyte(var_options);
  781. writestring(mangledname);
  782. end;
  783. if (var_options and vo_is_C_var)<>0 then
  784. current_ppu^.writeentry(ibvarsym_C)
  785. else
  786. current_ppu^.writeentry(ibvarsym);
  787. end;
  788. function tvarsym.mangledname : string;
  789. var
  790. prefix : string;
  791. begin
  792. if assigned(_mangledname) then
  793. begin
  794. mangledname:=strpas(_mangledname);
  795. exit;
  796. end;
  797. case owner^.symtabletype of
  798. staticsymtable : if (cs_smartlink in aktmoduleswitches) then
  799. prefix:='_'+owner^.name^+'$$$_'
  800. else
  801. prefix:='_';
  802. unitsymtable,
  803. globalsymtable : prefix:='U_'+owner^.name^+'_';
  804. else
  805. Message(sym_e_invalid_call_tvarsymmangledname);
  806. end;
  807. mangledname:=prefix+name;
  808. end;
  809. function tvarsym.getsize : longint;
  810. begin
  811. { only if the definition is set, we could determine the }
  812. { size, this is if an error occurs while reading the type }
  813. { also used for operator, this allows not to allocate the }
  814. { return size twice }
  815. if assigned(definition) then
  816. begin
  817. case varspez of
  818. vs_value : begin
  819. if is_open_array(definition) then
  820. getsize:=sizeof(pointer)+4
  821. else
  822. getsize:=definition^.size;
  823. end;
  824. vs_var : begin
  825. { open arrays push also the high valye }
  826. if is_open_array(definition) then
  827. getsize:=sizeof(pointer)+4
  828. else
  829. getsize:=sizeof(pointer);
  830. end;
  831. vs_const : begin
  832. case definition^.deftype of
  833. stringdef,
  834. recorddef,
  835. objectdef,
  836. setdef : getsize:=sizeof(pointer);
  837. arraydef : begin
  838. { open arrays push also the high valye }
  839. if (parraydef(definition)^.lowrange=0) and
  840. (parraydef(definition)^.highrange=-1) then
  841. getsize:=sizeof(pointer)+4
  842. else
  843. getsize:=sizeof(pointer);
  844. end;
  845. else
  846. getsize:=definition^.size;
  847. end;
  848. end;
  849. end;
  850. end
  851. else
  852. getsize:=0;
  853. end;
  854. procedure tvarsym.insert_in_data;
  855. var
  856. l,modulo : longint;
  857. begin
  858. if (var_options and vo_is_external)<>0 then
  859. exit;
  860. { handle static variables of objects especially }
  861. if read_member and (owner^.symtabletype=objectsymtable) and
  862. ((properties and sp_static)<>0) then
  863. begin
  864. { the data filed is generated in parser.pas
  865. with a tobject_FIELDNAME variable }
  866. { this symbol can't be loaded to a register }
  867. var_options:=var_options and not vo_regable;
  868. end
  869. else
  870. if not(read_member) then
  871. begin
  872. { made problems with parameters etc. ! (FK) }
  873. { check for instance of an abstract object or class }
  874. {
  875. if (pvarsym(sym)^.definition^.deftype=objectdef) and
  876. ((pobjectdef(pvarsym(sym)^.definition)^.options and oois_abstract)<>0) then
  877. Message(sym_e_no_instance_of_abstract_object);
  878. }
  879. l:=getsize;
  880. case owner^.symtabletype of
  881. stt_exceptsymtable:
  882. { can contain only one symbol, address calculated later }
  883. ;
  884. localsymtable : begin
  885. is_valid := 0;
  886. modulo:=owner^.datasize and 3;
  887. {$ifdef m68k}
  888. { word alignment required for motorola }
  889. if (l=1) then
  890. l:=2
  891. else
  892. {$endif}
  893. if (l>=4) and (modulo<>0) then
  894. inc(l,4-modulo)
  895. else
  896. if (l>=2) and ((modulo and 1)<>0) then
  897. inc(l,2-(modulo and 1));
  898. inc(owner^.datasize,l);
  899. address:=owner^.datasize;
  900. end;
  901. staticsymtable : begin
  902. if (cs_smartlink in aktmoduleswitches) then
  903. bsssegment^.concat(new(pai_cut,init));
  904. {$ifdef GDB}
  905. if cs_debuginfo in aktmoduleswitches then
  906. concatstabto(bsssegment);
  907. {$endif GDB}
  908. if (cs_smartlink in aktmoduleswitches) or
  909. ((var_options and vo_is_c_var)<>0) then
  910. bsssegment^.concat(new(pai_datablock,init_global(mangledname,l)))
  911. else
  912. bsssegment^.concat(new(pai_datablock,init(mangledname,l)));
  913. { increase datasize }
  914. inc(owner^.datasize,l);
  915. { this symbol can't be loaded to a register }
  916. var_options:=var_options and not vo_regable;
  917. end;
  918. globalsymtable : begin
  919. if (cs_smartlink in aktmoduleswitches) then
  920. bsssegment^.concat(new(pai_cut,init));
  921. {$ifdef GDB}
  922. if cs_debuginfo in aktmoduleswitches then
  923. concatstabto(bsssegment);
  924. {$endif GDB}
  925. bsssegment^.concat(new(pai_datablock,init_global(mangledname,l)));
  926. inc(owner^.datasize,l);
  927. { this symbol can't be loaded to a register }
  928. var_options:=var_options and not vo_regable;
  929. end;
  930. recordsymtable,
  931. objectsymtable : begin
  932. { this symbol can't be loaded to a register }
  933. var_options:=var_options and not vo_regable;
  934. { align record and object fields }
  935. if (l=1) or (aktpackrecords=1) then
  936. begin
  937. address:=owner^.datasize;
  938. inc(owner^.datasize,l)
  939. end
  940. else
  941. if (l=2) or (aktpackrecords=2) then
  942. begin
  943. owner^.datasize:=(owner^.datasize+1) and (not 1);
  944. address:=owner^.datasize;
  945. inc(owner^.datasize,l)
  946. end
  947. else
  948. if (l<=4) or (aktpackrecords=4) then
  949. begin
  950. owner^.datasize:=(owner^.datasize+3) and (not 3);
  951. address:=owner^.datasize;
  952. inc(owner^.datasize,l);
  953. end
  954. else
  955. if (l<=8) or (aktpackrecords=8) then
  956. begin
  957. owner^.datasize:=(owner^.datasize+7) and (not 7);
  958. address:=owner^.datasize;
  959. inc(owner^.datasize,l);
  960. end
  961. else
  962. if (l<=16) or (aktpackrecords=16) then
  963. begin
  964. owner^.datasize:=(owner^.datasize+15) and (not 15);
  965. address:=owner^.datasize;
  966. inc(owner^.datasize,l);
  967. end
  968. else
  969. if (l<=32) or (aktpackrecords=32) then
  970. begin
  971. owner^.datasize:=(owner^.datasize+31) and (not 31);
  972. address:=owner^.datasize;
  973. inc(owner^.datasize,l);
  974. end;
  975. end;
  976. parasymtable : begin
  977. address:=owner^.datasize;
  978. { needs word alignment }
  979. if odd(l) then
  980. inc(owner^.datasize,l+1)
  981. else
  982. inc(owner^.datasize,l);
  983. end
  984. else
  985. begin
  986. modulo:=owner^.datasize and 3 ;
  987. if (l>=4) and (modulo<>0) then
  988. inc(owner^.datasize,4-modulo)
  989. else
  990. if (l>=2) and ((modulo and 1)<>0) then
  991. { nice piece of code !!
  992. inc(owner^.datasize,2-(datasize and 1));
  993. 2 - (datasize and 1) is allways 1 in this case
  994. Florian when will your global stream analyser
  995. find this out ?? }
  996. inc(owner^.datasize);
  997. address:=owner^.datasize;
  998. inc(owner^.datasize,l);
  999. end;
  1000. end;
  1001. end;
  1002. end;
  1003. {$ifdef GDB}
  1004. function tvarsym.stabstring : pchar;
  1005. var
  1006. st : char;
  1007. begin
  1008. if (owner^.symtabletype = objectsymtable) and
  1009. ((properties and sp_static)<>0) then
  1010. begin
  1011. if use_gsym then st := 'G' else st := 'S';
  1012. stabstring := strpnew('"'+owner^.name^+'__'+name+':'+
  1013. +definition^.numberstring+'",'+
  1014. tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname);
  1015. end
  1016. else if (owner^.symtabletype = globalsymtable) or
  1017. (owner^.symtabletype = unitsymtable) then
  1018. begin
  1019. { Here we used S instead of
  1020. because with G GDB doesn't look at the address field
  1021. but searches the same name or with a leading underscore
  1022. but these names don't exist in pascal !}
  1023. if use_gsym then st := 'G' else st := 'S';
  1024. stabstring := strpnew('"'+name+':'+st
  1025. +definition^.numberstring+'",'+
  1026. tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname);
  1027. end
  1028. else if owner^.symtabletype = staticsymtable then
  1029. begin
  1030. stabstring := strpnew('"'+name+':S'
  1031. +definition^.numberstring+'",'+
  1032. tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname);
  1033. end
  1034. else if (owner^.symtabletype=parasymtable) then
  1035. begin
  1036. case varspez of
  1037. vs_value : st := 'p';
  1038. vs_var : st := 'v';
  1039. vs_const : if dont_copy_const_param(definition) then
  1040. st := 'v'{ should be 'i' but 'i' doesn't work }
  1041. else
  1042. st := 'p';
  1043. end;
  1044. stabstring := strpnew('"'+name+':'+st
  1045. +definition^.numberstring+'",'+
  1046. tostr(N_PSYM)+',0,'+tostr(fileinfo.line)+','+
  1047. tostr(address+owner^.call_offset));
  1048. {offset to ebp => will not work if the framepointer is esp
  1049. so some optimizing will make things harder to debug }
  1050. end
  1051. else if (owner^.symtabletype=localsymtable) then
  1052. {$ifdef i386}
  1053. if reg<>R_NO then
  1054. begin
  1055. { "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }
  1056. { this is the register order for GDB}
  1057. stabstring:=strpnew('"'+name+':r'
  1058. +definition^.numberstring+'",'+
  1059. tostr(N_RSYM)+',0,'+
  1060. tostr(fileinfo.line)+','+tostr(GDB_i386index[reg]));
  1061. end
  1062. else
  1063. {$endif i386}
  1064. stabstring := strpnew('"'+name+':'
  1065. +definition^.numberstring+'",'+
  1066. tostr(N_LSYM)+',0,'+tostr(fileinfo.line)+',-'+tostr(address))
  1067. else
  1068. stabstring := inherited stabstring;
  1069. end;
  1070. procedure tvarsym.concatstabto(asmlist : paasmoutput);
  1071. {$ifdef i386}
  1072. var stab_str : pchar;
  1073. {$endif i386}
  1074. begin
  1075. inherited concatstabto(asmlist);
  1076. {$ifdef i386}
  1077. if (owner^.symtabletype=parasymtable) and
  1078. (reg<>R_NO) then
  1079. begin
  1080. { "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }
  1081. { this is the register order for GDB}
  1082. stab_str:=strpnew('"'+name+':r'
  1083. +definition^.numberstring+'",'+
  1084. tostr(N_RSYM)+',0,'+
  1085. tostr(fileinfo.line)+','+tostr(GDB_i386index[reg]));
  1086. asmlist^.concat(new(pai_stabs,init(stab_str)));
  1087. end;
  1088. {$endif i386}
  1089. end;
  1090. {$endif GDB}
  1091. destructor tvarsym.done;
  1092. begin
  1093. strdispose(_mangledname);
  1094. inherited done;
  1095. end;
  1096. {****************************************************************************
  1097. TTYPEDCONSTSYM
  1098. *****************************************************************************}
  1099. constructor ttypedconstsym.init(const n : string;p : pdef);
  1100. begin
  1101. tsym.init(n);
  1102. typ:=typedconstsym;
  1103. definition:=p;
  1104. prefix:=stringdup(procprefix);
  1105. end;
  1106. constructor ttypedconstsym.load;
  1107. begin
  1108. tsym.load;
  1109. typ:=typedconstsym;
  1110. definition:=readdefref;
  1111. prefix:=stringdup(readstring);
  1112. end;
  1113. destructor ttypedconstsym.done;
  1114. begin
  1115. stringdispose(prefix);
  1116. tsym.done;
  1117. end;
  1118. function ttypedconstsym.mangledname : string;
  1119. begin
  1120. mangledname:='TC_'+prefix^+'_'+name;
  1121. end;
  1122. procedure ttypedconstsym.deref;
  1123. begin
  1124. resolvedef(definition);
  1125. end;
  1126. procedure ttypedconstsym.write;
  1127. begin
  1128. tsym.write;
  1129. writedefref(definition);
  1130. writestring(prefix^);
  1131. current_ppu^.writeentry(ibtypedconstsym);
  1132. end;
  1133. { for most symbol types ther is nothing to do at all }
  1134. procedure ttypedconstsym.insert_in_data;
  1135. begin
  1136. { here there is a problem for ansistrings !! }
  1137. { we must write the label only after the 12 header bytes (PM)
  1138. if not is_ansistring(definition) then
  1139. }
  1140. { solved, the ansis string is moved to consts (FK) }
  1141. really_insert_in_data;
  1142. end;
  1143. procedure ttypedconstsym.really_insert_in_data;
  1144. begin
  1145. if owner^.symtabletype=globalsymtable then
  1146. begin
  1147. if (cs_smartlink in aktmoduleswitches) then
  1148. datasegment^.concat(new(pai_cut,init));
  1149. {$ifdef GDB}
  1150. if cs_debuginfo in aktmoduleswitches then
  1151. concatstabto(datasegment);
  1152. {$endif GDB}
  1153. datasegment^.concat(new(pai_symbol,init_global(mangledname)));
  1154. end
  1155. else
  1156. if owner^.symtabletype<>unitsymtable then
  1157. begin
  1158. if (cs_smartlink in aktmoduleswitches) then
  1159. datasegment^.concat(new(pai_cut,init));
  1160. {$ifdef GDB}
  1161. if cs_debuginfo in aktmoduleswitches then
  1162. concatstabto(datasegment);
  1163. {$endif GDB}
  1164. if (cs_smartlink in aktmoduleswitches) then
  1165. datasegment^.concat(new(pai_symbol,init_global(mangledname)))
  1166. else
  1167. datasegment^.concat(new(pai_symbol,init(mangledname)));
  1168. end;
  1169. end;
  1170. {$ifdef GDB}
  1171. function ttypedconstsym.stabstring : pchar;
  1172. var
  1173. st : char;
  1174. begin
  1175. if use_gsym and (owner^.symtabletype in [unitsymtable,globalsymtable]) then
  1176. st := 'G'
  1177. else
  1178. st := 'S';
  1179. stabstring := strpnew('"'+name+':'+st+
  1180. definition^.numberstring+'",'+tostr(n_STSYM)+',0,'+
  1181. tostr(fileinfo.line)+','+mangledname);
  1182. end;
  1183. {$endif GDB}
  1184. {****************************************************************************
  1185. TCONSTSYM
  1186. ****************************************************************************}
  1187. constructor tconstsym.init(const n : string;t : tconsttype;v : longint;def : pdef);
  1188. begin
  1189. tsym.init(n);
  1190. typ:=constsym;
  1191. definition:=def;
  1192. consttype:=t;
  1193. value:=v;
  1194. end;
  1195. constructor tconstsym.load;
  1196. var
  1197. pd : pbestreal;
  1198. ps : pnormalset;
  1199. begin
  1200. tsym.load;
  1201. typ:=constsym;
  1202. consttype:=tconsttype(readbyte);
  1203. case consttype of
  1204. constint,
  1205. constbool,
  1206. constchar : value:=readlong;
  1207. constord : begin
  1208. definition:=readdefref;
  1209. value:=readlong;
  1210. end;
  1211. conststring : value:=longint(stringdup(readstring));
  1212. constreal : begin
  1213. new(pd);
  1214. pd^:=readreal;
  1215. value:=longint(pd);
  1216. end;
  1217. constset : begin
  1218. definition:=readdefref;
  1219. new(ps);
  1220. readnormalset(ps^);
  1221. value:=longint(ps);
  1222. end;
  1223. else
  1224. Message1(unit_f_ppu_invalid_entry,tostr(ord(consttype)));
  1225. end;
  1226. end;
  1227. destructor tconstsym.done;
  1228. begin
  1229. case consttype of
  1230. conststring : stringdispose(pstring(value));
  1231. constreal : dispose(pbestreal(value));
  1232. constset : dispose(pnormalset(value));
  1233. end;
  1234. inherited done;
  1235. end;
  1236. function tconstsym.mangledname : string;
  1237. begin
  1238. mangledname:=name;
  1239. end;
  1240. procedure tconstsym.deref;
  1241. begin
  1242. if consttype in [constord,constset] then
  1243. resolvedef(pdef(definition));
  1244. end;
  1245. procedure tconstsym.write;
  1246. begin
  1247. tsym.write;
  1248. writebyte(byte(consttype));
  1249. case consttype of
  1250. constint,
  1251. constbool,
  1252. constchar : writelong(value);
  1253. constord : begin
  1254. writedefref(definition);
  1255. writelong(value);
  1256. end;
  1257. conststring : writestring(pstring(value)^);
  1258. constreal : writereal(pbestreal(value)^);
  1259. constset : begin
  1260. writedefref(definition);
  1261. writenormalset(pointer(value)^);
  1262. end;
  1263. else
  1264. internalerror(13);
  1265. end;
  1266. current_ppu^.writeentry(ibconstsym);
  1267. end;
  1268. {$ifdef GDB}
  1269. function tconstsym.stabstring : pchar;
  1270. var st : string;
  1271. begin
  1272. {even GDB v4.16 only now 'i' 'r' and 'e' !!!}
  1273. case consttype of
  1274. conststring : begin
  1275. { I had to remove ibm2ascii !! }
  1276. st := pstring(value)^;
  1277. {st := ibm2ascii(pstring(value)^);}
  1278. st := 's'''+st+'''';
  1279. end;
  1280. constbool, constint, constord, constchar : st := 'i'+tostr(value);
  1281. constreal : begin
  1282. system.str(pbestreal(value)^,st);
  1283. st := 'r'+st;
  1284. end;
  1285. { if we don't know just put zero !! }
  1286. else st:='i0';
  1287. {***SETCONST}
  1288. {constset:;} {*** I don't know what to do with a set.}
  1289. { sets are not recognized by GDB}
  1290. {***}
  1291. end;
  1292. stabstring := strpnew('"'+name+':c='+st+'",'+tostr(N_function)+',0,'+
  1293. tostr(fileinfo.line)+',0');
  1294. end;
  1295. procedure tconstsym.concatstabto(asmlist : paasmoutput);
  1296. begin
  1297. if consttype <> conststring then
  1298. inherited concatstabto(asmlist);
  1299. end;
  1300. {$endif GDB}
  1301. {****************************************************************************
  1302. TENUMSYM
  1303. ****************************************************************************}
  1304. constructor tenumsym.init(const n : string;def : penumdef;v : longint);
  1305. begin
  1306. tsym.init(n);
  1307. typ:=enumsym;
  1308. definition:=def;
  1309. value:=v;
  1310. if def^.min>v then
  1311. def^.setmin(v);
  1312. if def^.max<v then
  1313. def^.setmax(v);
  1314. order;
  1315. end;
  1316. constructor tenumsym.load;
  1317. begin
  1318. tsym.load;
  1319. typ:=enumsym;
  1320. definition:=penumdef(readdefref);
  1321. value:=readlong;
  1322. next := Nil;
  1323. end;
  1324. procedure tenumsym.deref;
  1325. begin
  1326. resolvedef(pdef(definition));
  1327. order;
  1328. end;
  1329. procedure tenumsym.order;
  1330. var
  1331. sym : penumsym;
  1332. begin
  1333. sym := definition^.first;
  1334. if sym = nil then
  1335. begin
  1336. definition^.first := @self;
  1337. next := nil;
  1338. exit;
  1339. end;
  1340. { reorder the symbols in increasing value }
  1341. if value < sym^.value then
  1342. begin
  1343. next := sym;
  1344. definition^.first := @self;
  1345. end
  1346. else
  1347. begin
  1348. while (sym^.value <= value) and assigned(sym^.next) do
  1349. sym := sym^.next;
  1350. next := sym^.next;
  1351. sym^.next := @self;
  1352. end;
  1353. end;
  1354. procedure tenumsym.write;
  1355. begin
  1356. tsym.write;
  1357. writedefref(definition);
  1358. writelong(value);
  1359. current_ppu^.writeentry(ibenumsym);
  1360. end;
  1361. {$ifdef GDB}
  1362. procedure tenumsym.concatstabto(asmlist : paasmoutput);
  1363. begin
  1364. {enum elements have no stab !}
  1365. end;
  1366. {$EndIf GDB}
  1367. {****************************************************************************
  1368. TTYPESYM
  1369. ****************************************************************************}
  1370. constructor ttypesym.init(const n : string;d : pdef);
  1371. begin
  1372. tsym.init(n);
  1373. typ:=typesym;
  1374. definition:=d;
  1375. {$ifdef GDB}
  1376. isusedinstab := false;
  1377. {$endif GDB}
  1378. forwardpointer:=nil;
  1379. { this allows to link definitions with the type with declares }
  1380. { them }
  1381. if assigned(definition) then
  1382. if definition^.sym=nil then
  1383. definition^.sym:=@self;
  1384. end;
  1385. constructor ttypesym.load;
  1386. begin
  1387. tsym.load;
  1388. typ:=typesym;
  1389. forwardpointer:=nil;
  1390. {$ifdef GDB}
  1391. isusedinstab := false;
  1392. {$endif GDB}
  1393. definition:=readdefref;
  1394. end;
  1395. destructor ttypesym.done;
  1396. begin
  1397. if assigned(definition) then
  1398. if definition^.sym=@self then
  1399. definition^.sym:=nil;
  1400. inherited done;
  1401. end;
  1402. procedure ttypesym.deref;
  1403. begin
  1404. resolvedef(definition);
  1405. if assigned(definition) then
  1406. begin
  1407. if definition^.sym=nil then
  1408. definition^.sym:=@self;
  1409. if (definition^.deftype=recorddef) and assigned(precdef(definition)^.symtable) then
  1410. precdef(definition)^.symtable^.name:=stringdup('record '+name);
  1411. end;
  1412. end;
  1413. procedure ttypesym.write;
  1414. begin
  1415. tsym.write;
  1416. writedefref(definition);
  1417. current_ppu^.writeentry(ibtypesym);
  1418. end;
  1419. {$ifdef UseBrowser}
  1420. procedure ttypesym.load_references;
  1421. begin
  1422. inherited load_references;
  1423. if (definition^.deftype=recorddef) then
  1424. precdef(definition)^.symtable^.load_browser;
  1425. if (definition^.deftype=objectdef) then
  1426. pobjectdef(definition)^.publicsyms^.load_browser;
  1427. end;
  1428. function ttypesym.write_references : boolean;
  1429. begin
  1430. if not inherited write_references then
  1431. { write address of this symbol if record or object
  1432. even if no real refs are there
  1433. because we need it for the symtable }
  1434. if (definition^.deftype=recorddef) or
  1435. (definition^.deftype=objectdef) then
  1436. begin
  1437. writesymref(@self);
  1438. current_ppu^.writeentry(ibsymref);
  1439. end;
  1440. write_references:=true;
  1441. if (definition^.deftype=recorddef) then
  1442. precdef(definition)^.symtable^.write_browser;
  1443. if (definition^.deftype=objectdef) then
  1444. pobjectdef(definition)^.publicsyms^.write_browser;
  1445. end;
  1446. procedure ttypesym.add_to_browserlog;
  1447. begin
  1448. inherited add_to_browserlog;
  1449. if (definition^.deftype=recorddef) then
  1450. precdef(definition)^.symtable^.writebrowserlog;
  1451. if (definition^.deftype=objectdef) then
  1452. pobjectdef(definition)^.publicsyms^.writebrowserlog;
  1453. end;
  1454. {$endif UseBrowser}
  1455. {$ifdef GDB}
  1456. function ttypesym.stabstring : pchar;
  1457. var stabchar : string[2];
  1458. short : string;
  1459. begin
  1460. if definition^.deftype in tagtypes then
  1461. stabchar := 'Tt'
  1462. else
  1463. stabchar := 't';
  1464. short := '"'+name+':'+stabchar+definition^.numberstring
  1465. +'",'+tostr(N_LSYM)+',0,'+tostr(fileinfo.line)+',0';
  1466. stabstring := strpnew(short);
  1467. end;
  1468. procedure ttypesym.concatstabto(asmlist : paasmoutput);
  1469. begin
  1470. {not stabs for forward defs }
  1471. if assigned(definition) then
  1472. if (definition^.sym = @self) then
  1473. definition^.concatstabto(asmlist)
  1474. else
  1475. inherited concatstabto(asmlist);
  1476. end;
  1477. {$endif GDB}
  1478. {****************************************************************************
  1479. TSYSSYM
  1480. ****************************************************************************}
  1481. constructor tsyssym.init(const n : string;l : longint);
  1482. begin
  1483. inherited init(n);
  1484. typ:=syssym;
  1485. number:=l;
  1486. end;
  1487. procedure tsyssym.write;
  1488. begin
  1489. end;
  1490. {$ifdef GDB}
  1491. procedure tsyssym.concatstabto(asmlist : paasmoutput);
  1492. begin
  1493. end;
  1494. {$endif GDB}
  1495. {****************************************************************************
  1496. TMACROSYM
  1497. ****************************************************************************}
  1498. constructor tmacrosym.init(const n : string);
  1499. begin
  1500. inherited init(n);
  1501. defined:=true;
  1502. buftext:=nil;
  1503. buflen:=0;
  1504. end;
  1505. destructor tmacrosym.done;
  1506. begin
  1507. if assigned(buftext) then
  1508. freemem(buftext,buflen);
  1509. inherited done;
  1510. end;
  1511. {
  1512. $Log$
  1513. Revision 1.51 1998-10-08 13:48:50 peter
  1514. * fixed memory leaks for do nothing source
  1515. * fixed unit interdependency
  1516. Revision 1.50 1998/10/06 17:16:56 pierre
  1517. * some memory leaks fixed (thanks to Peter for heaptrc !)
  1518. Revision 1.49 1998/10/01 09:22:55 peter
  1519. * fixed value openarray
  1520. * ungettemp of arrayconstruct
  1521. Revision 1.48 1998/09/26 17:45:44 peter
  1522. + idtoken and only one token table
  1523. Revision 1.47 1998/09/24 15:11:17 peter
  1524. * fixed enum for not GDB
  1525. Revision 1.46 1998/09/23 15:39:13 pierre
  1526. * browser bugfixes
  1527. was adding a reference when looking for the symbol
  1528. if -bSYM_NAME was used
  1529. Revision 1.45 1998/09/21 08:45:24 pierre
  1530. + added vmt_offset in tobjectdef.write for fututre use
  1531. (first steps to have objects without vmt if no virtual !!)
  1532. + added fpu_used field for tabstractprocdef :
  1533. sets this level to 2 if the functions return with value in FPU
  1534. (is then set to correct value at parsing of implementation)
  1535. THIS MIGHT refuse some code with FPU expression too complex
  1536. that were accepted before and even in some cases
  1537. that don't overflow in fact
  1538. ( like if f : float; is a forward that finally in implementation
  1539. only uses one fpu register !!)
  1540. Nevertheless I think that it will improve security on
  1541. FPU operations !!
  1542. * most other changes only for UseBrowser code
  1543. (added symtable references for record and objects)
  1544. local switch for refs to args and local of each function
  1545. (static symtable still missing)
  1546. UseBrowser still not stable and probably broken by
  1547. the definition hash array !!
  1548. Revision 1.44 1998/09/18 16:03:47 florian
  1549. * some changes to compile with Delphi
  1550. Revision 1.43 1998/09/18 08:01:38 pierre
  1551. + improvement on the usebrowser part
  1552. (does not work correctly for now)
  1553. Revision 1.42 1998/09/07 19:33:25 florian
  1554. + some stuff for property rtti added:
  1555. - NameIndex of the TPropInfo record is now written correctly
  1556. - the DEFAULT/NODEFAULT keyword is supported now
  1557. - the default value and the storedsym/def are now written to
  1558. the PPU fiel
  1559. Revision 1.41 1998/09/07 18:46:12 peter
  1560. * update smartlinking, uses getdatalabel
  1561. * renamed ptree.value vars to value_str,value_real,value_set
  1562. Revision 1.40 1998/09/07 17:37:04 florian
  1563. * first fixes for published properties
  1564. Revision 1.39 1998/09/05 22:11:02 florian
  1565. + switch -vb
  1566. * while/repeat loops accept now also word/longbool conditions
  1567. * makebooltojump did an invalid ungetregister32, fixed
  1568. Revision 1.38 1998/09/01 12:53:26 peter
  1569. + aktpackenum
  1570. Revision 1.37 1998/09/01 07:54:25 pierre
  1571. * UseBrowser a little updated (might still be buggy !!)
  1572. * bug in psub.pas in function specifier removed
  1573. * stdcall allowed in interface and in implementation
  1574. (FPC will not yet complain if it is missing in either part
  1575. because stdcall is only a dummy !!)
  1576. Revision 1.36 1998/08/25 13:09:26 pierre
  1577. * corrected mangling sheme :
  1578. cvar add Cprefix to the mixed case name whereas
  1579. export or public use direct name
  1580. Revision 1.35 1998/08/25 12:42:46 pierre
  1581. * CDECL changed to CVAR for variables
  1582. specifications are read in structures also
  1583. + started adding GPC compatibility mode ( option -Sp)
  1584. * names changed to lowercase
  1585. Revision 1.34 1998/08/21 14:08:53 pierre
  1586. + TEST_FUNCRET now default (old code removed)
  1587. works also for m68k (at least compiles)
  1588. Revision 1.33 1998/08/20 12:53:27 peter
  1589. * object_options are always written for object syms
  1590. Revision 1.32 1998/08/20 09:26:46 pierre
  1591. + funcret setting in underproc testing
  1592. compile with _dTEST_FUNCRET
  1593. Revision 1.31 1998/08/17 10:10:12 peter
  1594. - removed OLDPPU
  1595. Revision 1.30 1998/08/13 10:57:29 peter
  1596. * constant sets are now written correctly to the ppufile
  1597. Revision 1.29 1998/08/11 15:31:42 peter
  1598. * write extended to ppu file
  1599. * new version 0.99.7
  1600. Revision 1.28 1998/08/11 14:07:27 peter
  1601. * fixed pushing of high value for openarray
  1602. Revision 1.27 1998/08/10 14:50:31 peter
  1603. + localswitches, moduleswitches, globalswitches splitting
  1604. Revision 1.26 1998/08/10 10:18:35 peter
  1605. + Compiler,Comphook unit which are the new interface units to the
  1606. compiler
  1607. Revision 1.25 1998/07/30 11:18:19 florian
  1608. + first implementation of try ... except on .. do end;
  1609. * limitiation of 65535 bytes parameters for cdecl removed
  1610. Revision 1.24 1998/07/20 18:40:16 florian
  1611. * handling of ansi string constants should now work
  1612. Revision 1.23 1998/07/14 21:37:24 peter
  1613. * fixed packrecords as discussed at the alias
  1614. Revision 1.22 1998/07/14 14:47:08 peter
  1615. * released NEWINPUT
  1616. Revision 1.21 1998/07/13 21:17:38 florian
  1617. * changed to compile with TP
  1618. Revision 1.20 1998/07/10 00:00:05 peter
  1619. * fixed ttypesym bug finally
  1620. * fileinfo in the symtable and better using for unused vars
  1621. Revision 1.19 1998/07/07 17:40:39 peter
  1622. * packrecords 4 works
  1623. * word aligning of parameters
  1624. Revision 1.18 1998/07/07 11:20:15 peter
  1625. + NEWINPUT for a better inputfile and scanner object
  1626. Revision 1.17 1998/06/24 14:48:40 peter
  1627. * ifdef newppu -> ifndef oldppu
  1628. Revision 1.16 1998/06/19 15:40:42 peter
  1629. * removed cosntructor/constructor warning and 0.99.5 recompiles it again
  1630. Revision 1.15 1998/06/17 14:10:18 peter
  1631. * small os2 fixes
  1632. * fixed interdependent units with newppu (remake3 under linux works now)
  1633. Revision 1.14 1998/06/16 08:56:34 peter
  1634. + targetcpu
  1635. * cleaner pmodules for newppu
  1636. Revision 1.13 1998/06/15 15:38:10 pierre
  1637. * small bug in systems.pas corrected
  1638. + operators in different units better hanlded
  1639. Revision 1.12 1998/06/15 14:23:44 daniel
  1640. * Reverted my changes.
  1641. Revision 1.10 1998/06/13 00:10:18 peter
  1642. * working browser and newppu
  1643. * some small fixes against crashes which occured in bp7 (but not in
  1644. fpc?!)
  1645. Revision 1.9 1998/06/12 16:15:35 pierre
  1646. * external name 'C_var';
  1647. export name 'intern_C_var';
  1648. cdecl;
  1649. cdecl;external;
  1650. are now supported only with -Sv switch
  1651. Revision 1.8 1998/06/11 10:11:59 peter
  1652. * -gb works again
  1653. Revision 1.7 1998/06/09 16:01:51 pierre
  1654. + added procedure directive parsing for procvars
  1655. (accepted are popstack cdecl and pascal)
  1656. + added C vars with the following syntax
  1657. var C calias 'true_c_name';(can be followed by external)
  1658. reason is that you must add the Cprefix
  1659. which is target dependent
  1660. Revision 1.6 1998/06/08 22:59:53 peter
  1661. * smartlinking works for win32
  1662. * some defines to exclude some compiler parts
  1663. Revision 1.5 1998/06/04 23:52:02 peter
  1664. * m68k compiles
  1665. + .def file creation moved to gendef.pas so it could also be used
  1666. for win32
  1667. Revision 1.4 1998/06/04 09:55:46 pierre
  1668. * demangled name of procsym reworked to become independant of the mangling scheme
  1669. Revision 1.3 1998/06/03 22:14:20 florian
  1670. * problem with sizes of classes fixed (if the anchestor was declared
  1671. forward, the compiler doesn't update the child classes size)
  1672. Revision 1.2 1998/05/28 14:40:29 peter
  1673. * fixes for newppu, remake3 works now with it
  1674. Revision 1.1 1998/05/27 19:45:09 peter
  1675. * symtable.pas splitted into includefiles
  1676. * symtable adapted for $ifndef OLDPPU
  1677. }