symsym.inc 57 KB

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