symsym.inc 58 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947
  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) and
  1410. (definition^.sym=@self) then
  1411. precdef(definition)^.symtable^.name:=stringdup('record '+name);
  1412. end;
  1413. end;
  1414. procedure ttypesym.write;
  1415. begin
  1416. tsym.write;
  1417. writedefref(definition);
  1418. current_ppu^.writeentry(ibtypesym);
  1419. end;
  1420. {$ifdef UseBrowser}
  1421. procedure ttypesym.load_references;
  1422. begin
  1423. inherited load_references;
  1424. if (definition^.deftype=recorddef) then
  1425. precdef(definition)^.symtable^.load_browser;
  1426. if (definition^.deftype=objectdef) then
  1427. pobjectdef(definition)^.publicsyms^.load_browser;
  1428. end;
  1429. function ttypesym.write_references : boolean;
  1430. begin
  1431. if not inherited write_references then
  1432. { write address of this symbol if record or object
  1433. even if no real refs are there
  1434. because we need it for the symtable }
  1435. if (definition^.deftype=recorddef) or
  1436. (definition^.deftype=objectdef) then
  1437. begin
  1438. writesymref(@self);
  1439. current_ppu^.writeentry(ibsymref);
  1440. end;
  1441. write_references:=true;
  1442. if (definition^.deftype=recorddef) then
  1443. precdef(definition)^.symtable^.write_browser;
  1444. if (definition^.deftype=objectdef) then
  1445. pobjectdef(definition)^.publicsyms^.write_browser;
  1446. end;
  1447. procedure ttypesym.add_to_browserlog;
  1448. begin
  1449. inherited add_to_browserlog;
  1450. if (definition^.deftype=recorddef) then
  1451. precdef(definition)^.symtable^.writebrowserlog;
  1452. if (definition^.deftype=objectdef) then
  1453. pobjectdef(definition)^.publicsyms^.writebrowserlog;
  1454. end;
  1455. {$endif UseBrowser}
  1456. {$ifdef GDB}
  1457. function ttypesym.stabstring : pchar;
  1458. var stabchar : string[2];
  1459. short : string;
  1460. begin
  1461. if definition^.deftype in tagtypes then
  1462. stabchar := 'Tt'
  1463. else
  1464. stabchar := 't';
  1465. short := '"'+name+':'+stabchar+definition^.numberstring
  1466. +'",'+tostr(N_LSYM)+',0,'+tostr(fileinfo.line)+',0';
  1467. stabstring := strpnew(short);
  1468. end;
  1469. procedure ttypesym.concatstabto(asmlist : paasmoutput);
  1470. begin
  1471. {not stabs for forward defs }
  1472. if assigned(definition) then
  1473. if (definition^.sym = @self) then
  1474. definition^.concatstabto(asmlist)
  1475. else
  1476. inherited concatstabto(asmlist);
  1477. end;
  1478. {$endif GDB}
  1479. {****************************************************************************
  1480. TSYSSYM
  1481. ****************************************************************************}
  1482. constructor tsyssym.init(const n : string;l : longint);
  1483. begin
  1484. inherited init(n);
  1485. typ:=syssym;
  1486. number:=l;
  1487. end;
  1488. procedure tsyssym.write;
  1489. begin
  1490. end;
  1491. {$ifdef GDB}
  1492. procedure tsyssym.concatstabto(asmlist : paasmoutput);
  1493. begin
  1494. end;
  1495. {$endif GDB}
  1496. {****************************************************************************
  1497. TMACROSYM
  1498. ****************************************************************************}
  1499. constructor tmacrosym.init(const n : string);
  1500. begin
  1501. inherited init(n);
  1502. typ:=macrosym;
  1503. defined:=true;
  1504. buftext:=nil;
  1505. buflen:=0;
  1506. end;
  1507. destructor tmacrosym.done;
  1508. begin
  1509. if assigned(buftext) then
  1510. freemem(buftext,buflen);
  1511. inherited done;
  1512. end;
  1513. {
  1514. $Log$
  1515. Revision 1.52 1998-10-08 17:17:32 pierre
  1516. * current_module old scanner tagged as invalid if unit is recompiled
  1517. + added ppheap for better info on tracegetmem of heaptrc
  1518. (adds line column and file index)
  1519. * several memory leaks removed ith help of heaptrc !!
  1520. Revision 1.51 1998/10/08 13:48:50 peter
  1521. * fixed memory leaks for do nothing source
  1522. * fixed unit interdependency
  1523. Revision 1.50 1998/10/06 17:16:56 pierre
  1524. * some memory leaks fixed (thanks to Peter for heaptrc !)
  1525. Revision 1.49 1998/10/01 09:22:55 peter
  1526. * fixed value openarray
  1527. * ungettemp of arrayconstruct
  1528. Revision 1.48 1998/09/26 17:45:44 peter
  1529. + idtoken and only one token table
  1530. Revision 1.47 1998/09/24 15:11:17 peter
  1531. * fixed enum for not GDB
  1532. Revision 1.46 1998/09/23 15:39:13 pierre
  1533. * browser bugfixes
  1534. was adding a reference when looking for the symbol
  1535. if -bSYM_NAME was used
  1536. Revision 1.45 1998/09/21 08:45:24 pierre
  1537. + added vmt_offset in tobjectdef.write for fututre use
  1538. (first steps to have objects without vmt if no virtual !!)
  1539. + added fpu_used field for tabstractprocdef :
  1540. sets this level to 2 if the functions return with value in FPU
  1541. (is then set to correct value at parsing of implementation)
  1542. THIS MIGHT refuse some code with FPU expression too complex
  1543. that were accepted before and even in some cases
  1544. that don't overflow in fact
  1545. ( like if f : float; is a forward that finally in implementation
  1546. only uses one fpu register !!)
  1547. Nevertheless I think that it will improve security on
  1548. FPU operations !!
  1549. * most other changes only for UseBrowser code
  1550. (added symtable references for record and objects)
  1551. local switch for refs to args and local of each function
  1552. (static symtable still missing)
  1553. UseBrowser still not stable and probably broken by
  1554. the definition hash array !!
  1555. Revision 1.44 1998/09/18 16:03:47 florian
  1556. * some changes to compile with Delphi
  1557. Revision 1.43 1998/09/18 08:01:38 pierre
  1558. + improvement on the usebrowser part
  1559. (does not work correctly for now)
  1560. Revision 1.42 1998/09/07 19:33:25 florian
  1561. + some stuff for property rtti added:
  1562. - NameIndex of the TPropInfo record is now written correctly
  1563. - the DEFAULT/NODEFAULT keyword is supported now
  1564. - the default value and the storedsym/def are now written to
  1565. the PPU fiel
  1566. Revision 1.41 1998/09/07 18:46:12 peter
  1567. * update smartlinking, uses getdatalabel
  1568. * renamed ptree.value vars to value_str,value_real,value_set
  1569. Revision 1.40 1998/09/07 17:37:04 florian
  1570. * first fixes for published properties
  1571. Revision 1.39 1998/09/05 22:11:02 florian
  1572. + switch -vb
  1573. * while/repeat loops accept now also word/longbool conditions
  1574. * makebooltojump did an invalid ungetregister32, fixed
  1575. Revision 1.38 1998/09/01 12:53:26 peter
  1576. + aktpackenum
  1577. Revision 1.37 1998/09/01 07:54:25 pierre
  1578. * UseBrowser a little updated (might still be buggy !!)
  1579. * bug in psub.pas in function specifier removed
  1580. * stdcall allowed in interface and in implementation
  1581. (FPC will not yet complain if it is missing in either part
  1582. because stdcall is only a dummy !!)
  1583. Revision 1.36 1998/08/25 13:09:26 pierre
  1584. * corrected mangling sheme :
  1585. cvar add Cprefix to the mixed case name whereas
  1586. export or public use direct name
  1587. Revision 1.35 1998/08/25 12:42:46 pierre
  1588. * CDECL changed to CVAR for variables
  1589. specifications are read in structures also
  1590. + started adding GPC compatibility mode ( option -Sp)
  1591. * names changed to lowercase
  1592. Revision 1.34 1998/08/21 14:08:53 pierre
  1593. + TEST_FUNCRET now default (old code removed)
  1594. works also for m68k (at least compiles)
  1595. Revision 1.33 1998/08/20 12:53:27 peter
  1596. * object_options are always written for object syms
  1597. Revision 1.32 1998/08/20 09:26:46 pierre
  1598. + funcret setting in underproc testing
  1599. compile with _dTEST_FUNCRET
  1600. Revision 1.31 1998/08/17 10:10:12 peter
  1601. - removed OLDPPU
  1602. Revision 1.30 1998/08/13 10:57:29 peter
  1603. * constant sets are now written correctly to the ppufile
  1604. Revision 1.29 1998/08/11 15:31:42 peter
  1605. * write extended to ppu file
  1606. * new version 0.99.7
  1607. Revision 1.28 1998/08/11 14:07:27 peter
  1608. * fixed pushing of high value for openarray
  1609. Revision 1.27 1998/08/10 14:50:31 peter
  1610. + localswitches, moduleswitches, globalswitches splitting
  1611. Revision 1.26 1998/08/10 10:18:35 peter
  1612. + Compiler,Comphook unit which are the new interface units to the
  1613. compiler
  1614. Revision 1.25 1998/07/30 11:18:19 florian
  1615. + first implementation of try ... except on .. do end;
  1616. * limitiation of 65535 bytes parameters for cdecl removed
  1617. Revision 1.24 1998/07/20 18:40:16 florian
  1618. * handling of ansi string constants should now work
  1619. Revision 1.23 1998/07/14 21:37:24 peter
  1620. * fixed packrecords as discussed at the alias
  1621. Revision 1.22 1998/07/14 14:47:08 peter
  1622. * released NEWINPUT
  1623. Revision 1.21 1998/07/13 21:17:38 florian
  1624. * changed to compile with TP
  1625. Revision 1.20 1998/07/10 00:00:05 peter
  1626. * fixed ttypesym bug finally
  1627. * fileinfo in the symtable and better using for unused vars
  1628. Revision 1.19 1998/07/07 17:40:39 peter
  1629. * packrecords 4 works
  1630. * word aligning of parameters
  1631. Revision 1.18 1998/07/07 11:20:15 peter
  1632. + NEWINPUT for a better inputfile and scanner object
  1633. Revision 1.17 1998/06/24 14:48:40 peter
  1634. * ifdef newppu -> ifndef oldppu
  1635. Revision 1.16 1998/06/19 15:40:42 peter
  1636. * removed cosntructor/constructor warning and 0.99.5 recompiles it again
  1637. Revision 1.15 1998/06/17 14:10:18 peter
  1638. * small os2 fixes
  1639. * fixed interdependent units with newppu (remake3 under linux works now)
  1640. Revision 1.14 1998/06/16 08:56:34 peter
  1641. + targetcpu
  1642. * cleaner pmodules for newppu
  1643. Revision 1.13 1998/06/15 15:38:10 pierre
  1644. * small bug in systems.pas corrected
  1645. + operators in different units better hanlded
  1646. Revision 1.12 1998/06/15 14:23:44 daniel
  1647. * Reverted my changes.
  1648. Revision 1.10 1998/06/13 00:10:18 peter
  1649. * working browser and newppu
  1650. * some small fixes against crashes which occured in bp7 (but not in
  1651. fpc?!)
  1652. Revision 1.9 1998/06/12 16:15:35 pierre
  1653. * external name 'C_var';
  1654. export name 'intern_C_var';
  1655. cdecl;
  1656. cdecl;external;
  1657. are now supported only with -Sv switch
  1658. Revision 1.8 1998/06/11 10:11:59 peter
  1659. * -gb works again
  1660. Revision 1.7 1998/06/09 16:01:51 pierre
  1661. + added procedure directive parsing for procvars
  1662. (accepted are popstack cdecl and pascal)
  1663. + added C vars with the following syntax
  1664. var C calias 'true_c_name';(can be followed by external)
  1665. reason is that you must add the Cprefix
  1666. which is target dependent
  1667. Revision 1.6 1998/06/08 22:59:53 peter
  1668. * smartlinking works for win32
  1669. * some defines to exclude some compiler parts
  1670. Revision 1.5 1998/06/04 23:52:02 peter
  1671. * m68k compiles
  1672. + .def file creation moved to gendef.pas so it could also be used
  1673. for win32
  1674. Revision 1.4 1998/06/04 09:55:46 pierre
  1675. * demangled name of procsym reworked to become independant of the mangling scheme
  1676. Revision 1.3 1998/06/03 22:14:20 florian
  1677. * problem with sizes of classes fixed (if the anchestor was declared
  1678. forward, the compiler doesn't update the child classes size)
  1679. Revision 1.2 1998/05/28 14:40:29 peter
  1680. * fixes for newppu, remake3 works now with it
  1681. Revision 1.1 1998/05/27 19:45:09 peter
  1682. * symtable.pas splitted into includefiles
  1683. * symtable adapted for $ifndef OLDPPU
  1684. }