symsym.inc 60 KB

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