symsym.inc 59 KB

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