symsym.inc 59 KB

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