symsym.inc 61 KB

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