symsym.inc 71 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424
  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. inherited initname(n);
  24. typ:=abstractsym;
  25. properties:=current_object_option;
  26. {$ifdef GDB}
  27. isstabwritten := false;
  28. {$endif GDB}
  29. fileinfo:=tokenpos;
  30. defref:=nil;
  31. lastwritten:=nil;
  32. refcount:=0;
  33. if (cs_browser in aktmoduleswitches) and make_ref then
  34. begin
  35. defref:=new(pref,init(defref,@tokenpos));
  36. inc(refcount);
  37. end;
  38. lastref:=defref;
  39. end;
  40. constructor tsym.load;
  41. begin
  42. inherited init;
  43. indexnr:=readword;
  44. setname(readstring);
  45. typ:=abstractsym;
  46. properties:=symprop(readbyte);
  47. readposinfo(fileinfo);
  48. lastref:=nil;
  49. defref:=nil;
  50. lastwritten:=nil;
  51. refcount:=0;
  52. {$ifdef GDB}
  53. isstabwritten := false;
  54. {$endif GDB}
  55. end;
  56. procedure tsym.load_references;
  57. var
  58. pos : tfileposinfo;
  59. move_last : boolean;
  60. begin
  61. move_last:=lastwritten=lastref;
  62. while (not current_ppu^.endofentry) do
  63. begin
  64. readposinfo(pos);
  65. inc(refcount);
  66. lastref:=new(pref,init(lastref,@pos));
  67. lastref^.is_written:=true;
  68. if refcount=1 then
  69. defref:=lastref;
  70. end;
  71. if move_last then
  72. lastwritten:=lastref;
  73. end;
  74. { big problem here :
  75. wrong refs were written because of
  76. interface parsing of other units PM
  77. moduleindex must be checked !! }
  78. function tsym.write_references : boolean;
  79. var
  80. ref : pref;
  81. symref_written,move_last : boolean;
  82. begin
  83. write_references:=false;
  84. if lastwritten=lastref then
  85. exit;
  86. { should we update lastref }
  87. move_last:=true;
  88. symref_written:=false;
  89. { write symbol refs }
  90. if assigned(lastwritten) then
  91. ref:=lastwritten
  92. else
  93. ref:=defref;
  94. while assigned(ref) do
  95. begin
  96. if ref^.moduleindex=current_module^.unit_index then
  97. begin
  98. { write address to this symbol }
  99. if not symref_written then
  100. begin
  101. writesymref(@self);
  102. symref_written:=true;
  103. end;
  104. writeposinfo(ref^.posinfo);
  105. ref^.is_written:=true;
  106. if move_last then
  107. lastwritten:=ref;
  108. end
  109. else if not ref^.is_written then
  110. move_last:=false
  111. else if move_last then
  112. lastwritten:=ref;
  113. ref:=ref^.nextref;
  114. end;
  115. if symref_written then
  116. current_ppu^.writeentry(ibsymref);
  117. write_references:=symref_written;
  118. end;
  119. {$ifdef BrowserLog}
  120. procedure tsym.add_to_browserlog;
  121. begin
  122. if assigned(defref) then
  123. begin
  124. browserlog.AddLog('***'+name+'***');
  125. browserlog.AddLogRefs(defref);
  126. end;
  127. end;
  128. {$endif BrowserLog}
  129. destructor tsym.done;
  130. begin
  131. if assigned(defref) then
  132. dispose(defref,done);
  133. inherited done;
  134. end;
  135. procedure tsym.write;
  136. begin
  137. writeword(indexnr);
  138. writestring(name);
  139. writebyte(byte(properties));
  140. writeposinfo(fileinfo);
  141. end;
  142. procedure tsym.deref;
  143. begin
  144. end;
  145. function tsym.mangledname : string;
  146. begin
  147. mangledname:=name;
  148. end;
  149. { for most symbol types there is nothing to do at all }
  150. procedure tsym.insert_in_data;
  151. begin
  152. end;
  153. {$ifdef GDB}
  154. function tsym.stabstring : pchar;
  155. begin
  156. stabstring:=strpnew('"'+name+'",'+tostr(N_LSYM)+',0,'+
  157. tostr(fileinfo.line)+',0');
  158. end;
  159. procedure tsym.concatstabto(asmlist : paasmoutput);
  160. var stab_str : pchar;
  161. begin
  162. if not isstabwritten then
  163. begin
  164. stab_str := stabstring;
  165. if asmlist = debuglist then do_count_dbx := true;
  166. { count_dbx(stab_str); moved to GDB.PAS }
  167. asmlist^.concat(new(pai_stabs,init(stab_str)));
  168. isstabwritten:=true;
  169. end;
  170. end;
  171. {$endif GDB}
  172. {****************************************************************************
  173. TLABELSYM
  174. ****************************************************************************}
  175. constructor tlabelsym.init(const n : string; l : pasmlabel);
  176. begin
  177. inherited init(n);
  178. typ:=labelsym;
  179. lab:=l;
  180. defined:=false;
  181. end;
  182. constructor tlabelsym.load;
  183. begin
  184. tsym.load;
  185. typ:=labelsym;
  186. { this is all dummy
  187. it is only used for local browsing }
  188. lab:=nil;
  189. defined:=true;
  190. end;
  191. destructor tlabelsym.done;
  192. begin
  193. inherited done;
  194. end;
  195. function tlabelsym.mangledname : string;
  196. begin
  197. mangledname:=lab^.name;
  198. end;
  199. procedure tlabelsym.write;
  200. begin
  201. if owner^.symtabletype in [unitsymtable,globalsymtable] then
  202. Message(sym_e_ill_label_decl)
  203. else
  204. begin
  205. tsym.write;
  206. current_ppu^.writeentry(iblabelsym);
  207. end;
  208. end;
  209. {****************************************************************************
  210. TUNITSYM
  211. ****************************************************************************}
  212. constructor tunitsym.init(const n : string;ref : punitsymtable);
  213. var
  214. old_make_ref : boolean;
  215. begin
  216. old_make_ref:=make_ref;
  217. make_ref:=false;
  218. inherited init(n);
  219. make_ref:=old_make_ref;
  220. typ:=unitsym;
  221. unitsymtable:=ref;
  222. prevsym:=ref^.unitsym;
  223. ref^.unitsym:=@self;
  224. refs:=0;
  225. end;
  226. constructor tunitsym.load;
  227. begin
  228. tsym.load;
  229. typ:=unitsym;
  230. unitsymtable:=punitsymtable(current_module^.globalsymtable);
  231. prevsym:=nil;
  232. end;
  233. { we need to remove it from the prevsym chain ! }
  234. destructor tunitsym.done;
  235. var pus,ppus : punitsym;
  236. begin
  237. if assigned(unitsymtable) then
  238. begin
  239. ppus:=nil;
  240. pus:=unitsymtable^.unitsym;
  241. if pus=@self then
  242. unitsymtable^.unitsym:=prevsym
  243. else while assigned(pus) do
  244. begin
  245. if pus=@self then
  246. begin
  247. ppus^.prevsym:=prevsym;
  248. break;
  249. end
  250. else
  251. begin
  252. ppus:=pus;
  253. pus:=ppus^.prevsym;
  254. end;
  255. end;
  256. end;
  257. prevsym:=nil;
  258. unitsymtable:=nil;
  259. inherited done;
  260. end;
  261. procedure tunitsym.write;
  262. begin
  263. tsym.write;
  264. current_ppu^.writeentry(ibunitsym);
  265. end;
  266. {$ifdef GDB}
  267. procedure tunitsym.concatstabto(asmlist : paasmoutput);
  268. begin
  269. {Nothing to write to stabs !}
  270. end;
  271. {$endif GDB}
  272. {****************************************************************************
  273. TPROCSYM
  274. ****************************************************************************}
  275. constructor tprocsym.init(const n : string);
  276. begin
  277. tsym.init(n);
  278. typ:=procsym;
  279. definition:=nil;
  280. owner:=nil;
  281. {$ifdef GDB}
  282. is_global := false;
  283. {$endif GDB}
  284. end;
  285. constructor tprocsym.load;
  286. begin
  287. tsym.load;
  288. typ:=procsym;
  289. definition:=pprocdef(readdefref);
  290. {$ifdef GDB}
  291. is_global := false;
  292. {$endif GDB}
  293. end;
  294. destructor tprocsym.done;
  295. begin
  296. { don't check if errors !! }
  297. if Errorcount=0 then
  298. check_forward;
  299. tsym.done;
  300. end;
  301. function tprocsym.mangledname : string;
  302. begin
  303. mangledname:=definition^.mangledname;
  304. end;
  305. function tprocsym.demangledname:string;
  306. begin
  307. demangledname:=name+definition^.demangled_paras;
  308. end;
  309. procedure tprocsym.write_parameter_lists;
  310. var
  311. p : pprocdef;
  312. begin
  313. p:=definition;
  314. while assigned(p) do
  315. begin
  316. { force the error to be printed }
  317. Verbose.Message1(sym_b_param_list,name+p^.demangled_paras);
  318. p:=p^.nextoverloaded;
  319. end;
  320. end;
  321. procedure tprocsym.check_forward;
  322. var
  323. pd : pprocdef;
  324. begin
  325. pd:=definition;
  326. while assigned(pd) do
  327. begin
  328. if pd^.forwarddef then
  329. begin
  330. if assigned(pd^._class) then
  331. MessagePos1(fileinfo,sym_e_forward_not_resolved,pd^._class^.objname^+'.'+name+
  332. demangledparas(pd^.demangled_paras))
  333. else
  334. MessagePos1(fileinfo,sym_e_forward_not_resolved,name+pd^.demangled_paras);
  335. { Turn futher error messages off }
  336. pd^.forwarddef:=false;
  337. end;
  338. pd:=pd^.nextoverloaded;
  339. end;
  340. end;
  341. procedure tprocsym.deref;
  342. var
  343. t : ttoken;
  344. last : pprocdef;
  345. begin
  346. resolvedef(pdef(definition));
  347. if (definition^.options and pooperator) <> 0 then
  348. begin
  349. last:=definition;
  350. while assigned(last^.nextoverloaded) do
  351. last:=last^.nextoverloaded;
  352. for t:=first_overloaded to last_overloaded do
  353. if (name=overloaded_names[t]) then
  354. begin
  355. if assigned(overloaded_operators[t]) then
  356. last^.nextoverloaded:=overloaded_operators[t]^.definition;
  357. overloaded_operators[t]:=@self;
  358. end;
  359. end;
  360. end;
  361. procedure tprocsym.write;
  362. begin
  363. tsym.write;
  364. writedefref(pdef(definition));
  365. current_ppu^.writeentry(ibprocsym);
  366. end;
  367. procedure tprocsym.load_references;
  368. (*var
  369. prdef,prdef2 : pprocdef;
  370. b : byte; *)
  371. begin
  372. inherited load_references;
  373. (*prdef:=definition;
  374. done in tsymtable.load_browser (PM)
  375. { take care about operators !! }
  376. if (current_module^.flags and uf_has_browser) <>0 then
  377. while assigned(prdef) and (prdef^.owner=definition^.owner) do
  378. begin
  379. b:=current_ppu^.readentry;
  380. if b<>ibdefref then
  381. Message(unit_f_ppu_read_error);
  382. prdef2:=pprocdef(readdefref);
  383. resolvedef(prdef2);
  384. if prdef<>prdef2 then
  385. Message(unit_f_ppu_read_error);
  386. prdef^.load_references;
  387. prdef:=prdef^.nextoverloaded;
  388. end; *)
  389. end;
  390. function tprocsym.write_references : boolean;
  391. var
  392. prdef : pprocdef;
  393. begin
  394. write_references:=false;
  395. if not inherited write_references then
  396. exit;
  397. write_references:=true;
  398. prdef:=definition;
  399. while assigned(prdef) and (prdef^.owner=definition^.owner) do
  400. begin
  401. prdef^.write_references;
  402. prdef:=prdef^.nextoverloaded;
  403. end;
  404. end;
  405. {$ifdef BrowserLog}
  406. procedure tprocsym.add_to_browserlog;
  407. var
  408. prdef : pprocdef;
  409. begin
  410. inherited add_to_browserlog;
  411. prdef:=definition;
  412. while assigned(prdef) do
  413. begin
  414. pprocdef(prdef)^.add_to_browserlog;
  415. prdef:=pprocdef(prdef)^.nextoverloaded;
  416. end;
  417. end;
  418. {$endif BrowserLog}
  419. {$ifdef GDB}
  420. function tprocsym.stabstring : pchar;
  421. Var RetType : Char;
  422. Obj,Info : String;
  423. stabsstr : string;
  424. p : pchar;
  425. begin
  426. obj := name;
  427. info := '';
  428. if is_global then
  429. RetType := 'F'
  430. else
  431. RetType := 'f';
  432. if assigned(owner) then
  433. begin
  434. if (owner^.symtabletype = objectsymtable) then
  435. obj := owner^.name^+'__'+name;
  436. { this code was correct only as long as the local symboltable
  437. of the parent had the same name as the function
  438. but this is no true anymore !! PM
  439. if (owner^.symtabletype=localsymtable) and assigned(owner^.name) then
  440. info := ','+name+','+owner^.name^; }
  441. if (owner^.symtabletype=localsymtable) and assigned(owner^.defowner) and
  442. assigned(owner^.defowner^.sym) then
  443. info := ','+name+','+owner^.defowner^.sym^.name;
  444. end;
  445. stabsstr:=definition^.mangledname;
  446. getmem(p,length(stabsstr)+255);
  447. strpcopy(p,'"'+obj+':'+RetType
  448. +definition^.retdef^.numberstring+info+'",'+tostr(n_function)
  449. +',0,'+
  450. tostr(aktfilepos.line)
  451. +',');
  452. strpcopy(strend(p),stabsstr);
  453. stabstring:=strnew(p);
  454. freemem(p,length(stabsstr)+255);
  455. end;
  456. procedure tprocsym.concatstabto(asmlist : paasmoutput);
  457. begin
  458. if (definition^.options and pointernproc) <> 0 then exit;
  459. if not isstabwritten then
  460. asmlist^.concat(new(pai_stabs,init(stabstring)));
  461. isstabwritten := true;
  462. if assigned(definition^.parast) then
  463. definition^.parast^.concatstabto(asmlist);
  464. if assigned(definition^.localst) then
  465. definition^.localst^.concatstabto(asmlist);
  466. definition^.is_def_stab_written := true;
  467. end;
  468. {$endif GDB}
  469. {****************************************************************************
  470. TPROGRAMSYM
  471. ****************************************************************************}
  472. constructor tprogramsym.init(const n : string);
  473. begin
  474. inherited init(n);
  475. typ:=programsym;
  476. end;
  477. {****************************************************************************
  478. TERRORSYM
  479. ****************************************************************************}
  480. constructor terrorsym.init;
  481. begin
  482. inherited init('');
  483. typ:=errorsym;
  484. end;
  485. {****************************************************************************
  486. TPROPERTYSYM
  487. ****************************************************************************}
  488. constructor tpropertysym.init(const n : string);
  489. begin
  490. inherited init(n);
  491. typ:=propertysym;
  492. options:=0;
  493. proptype:=nil;
  494. readaccessdef:=nil;
  495. writeaccessdef:=nil;
  496. readaccesssym:=nil;
  497. writeaccesssym:=nil;
  498. storedsym:=nil;
  499. storeddef:=nil;
  500. index:=0;
  501. default:=0;
  502. end;
  503. destructor tpropertysym.done;
  504. begin
  505. inherited done;
  506. end;
  507. constructor tpropertysym.load;
  508. begin
  509. inherited load;
  510. typ:=propertysym;
  511. proptype:=readdefref;
  512. options:=readlong;
  513. index:=readlong;
  514. default:=readlong;
  515. { it's hack ... }
  516. readaccesssym:=readsymref;
  517. writeaccesssym:=readsymref;
  518. storedsym:=readsymref;
  519. { now the defs: }
  520. readaccessdef:=readdefref;
  521. writeaccessdef:=readdefref;
  522. storeddef:=readdefref;
  523. end;
  524. procedure tpropertysym.deref;
  525. begin
  526. resolvedef(proptype);
  527. resolvedef(readaccessdef);
  528. resolvedef(writeaccessdef);
  529. resolvedef(storeddef);
  530. resolvesym(readaccesssym);
  531. resolvesym(writeaccesssym);
  532. resolvesym(storedsym);
  533. end;
  534. function tpropertysym.getsize : longint;
  535. begin
  536. getsize:=0;
  537. end;
  538. procedure tpropertysym.write;
  539. begin
  540. tsym.write;
  541. writedefref(proptype);
  542. writelong(options);
  543. writelong(index);
  544. writelong(default);
  545. writesymref(readaccesssym);
  546. writesymref(writeaccesssym);
  547. writesymref(storedsym);
  548. writedefref(readaccessdef);
  549. writedefref(writeaccessdef);
  550. writedefref(storeddef);
  551. current_ppu^.writeentry(ibpropertysym);
  552. end;
  553. {$ifdef GDB}
  554. function tpropertysym.stabstring : pchar;
  555. begin
  556. { !!!! don't know how to handle }
  557. stabstring:=strpnew('');
  558. end;
  559. procedure tpropertysym.concatstabto(asmlist : paasmoutput);
  560. begin
  561. { !!!! don't know how to handle }
  562. end;
  563. {$endif GDB}
  564. {****************************************************************************
  565. TFUNCRETSYM
  566. ****************************************************************************}
  567. constructor tfuncretsym.init(const n : string;approcinfo : pointer{pprocinfo});
  568. begin
  569. tsym.init(n);
  570. typ:=funcretsym;
  571. funcretprocinfo:=approcinfo;
  572. funcretdef:=pprocinfo(approcinfo)^.retdef;
  573. { address valid for ret in param only }
  574. { otherwise set by insert }
  575. address:=pprocinfo(approcinfo)^.retoffset;
  576. end;
  577. constructor tfuncretsym.load;
  578. begin
  579. tsym.load;
  580. funcretdef:=readdefref;
  581. address:=readlong;
  582. funcretprocinfo:=nil;
  583. typ:=funcretsym;
  584. end;
  585. procedure tfuncretsym.write;
  586. begin
  587. (*
  588. Normally all references are
  589. transfered to the function symbol itself !! PM *)
  590. tsym.write;
  591. writedefref(funcretdef);
  592. writelong(address);
  593. current_ppu^.writeentry(ibfuncretsym);
  594. end;
  595. procedure tfuncretsym.deref;
  596. begin
  597. resolvedef(funcretdef);
  598. end;
  599. {$ifdef GDB}
  600. procedure tfuncretsym.concatstabto(asmlist : paasmoutput);
  601. begin
  602. { Nothing to do here, it is done in genexitcode }
  603. end;
  604. {$endif GDB}
  605. procedure tfuncretsym.insert_in_data;
  606. var
  607. l : longint;
  608. begin
  609. { allocate space in local if ret in acc or in fpu }
  610. if ret_in_acc(procinfo.retdef) or (procinfo.retdef^.deftype=floatdef) then
  611. begin
  612. l:=funcretdef^.size;
  613. inc(owner^.datasize,l);
  614. {$ifdef m68k}
  615. { word alignment required for motorola }
  616. if (l=1) then
  617. inc(owner^.datasize,1)
  618. else
  619. {$endif}
  620. if (l>=4) and ((owner^.datasize and 3)<>0) then
  621. inc(owner^.datasize,4-(owner^.datasize and 3))
  622. else if (l>=2) and ((owner^.datasize and 1)<>0) then
  623. inc(owner^.datasize,2-(owner^.datasize and 1));
  624. address:=owner^.datasize;
  625. procinfo.retoffset:=-owner^.datasize;
  626. end;
  627. end;
  628. {****************************************************************************
  629. TABSOLUTESYM
  630. ****************************************************************************}
  631. constructor tabsolutesym.init(const n : string;p : pdef);
  632. begin
  633. inherited init(n,p);
  634. typ:=absolutesym;
  635. end;
  636. constructor tabsolutesym.load;
  637. begin
  638. tvarsym.load;
  639. typ:=absolutesym;
  640. ref:=nil;
  641. address:=0;
  642. asmname:=nil;
  643. abstyp:=absolutetyp(readbyte);
  644. absseg:=false;
  645. case abstyp of
  646. tovar :
  647. begin
  648. asmname:=stringdup(readstring);
  649. ref:=srsym;
  650. end;
  651. toasm :
  652. asmname:=stringdup(readstring);
  653. toaddr :
  654. begin
  655. address:=readlong;
  656. absseg:=boolean(readbyte);
  657. end;
  658. end;
  659. end;
  660. procedure tabsolutesym.write;
  661. begin
  662. tsym.write;
  663. writebyte(byte(varspez));
  664. if read_member then
  665. writelong(address);
  666. writedefref(definition);
  667. writebyte(var_options and (not vo_regable));
  668. writebyte(byte(abstyp));
  669. case abstyp of
  670. tovar :
  671. writestring(ref^.name);
  672. toasm :
  673. writestring(asmname^);
  674. toaddr :
  675. begin
  676. writelong(address);
  677. writebyte(byte(absseg));
  678. end;
  679. end;
  680. current_ppu^.writeentry(ibabsolutesym);
  681. end;
  682. procedure tabsolutesym.deref;
  683. begin
  684. resolvedef(definition);
  685. if (abstyp=tovar) and (asmname<>nil) then
  686. begin
  687. { search previous loaded symtables }
  688. getsym(asmname^,false);
  689. if not(assigned(srsym)) then
  690. getsymonlyin(owner,asmname^);
  691. if not(assigned(srsym)) then
  692. srsym:=generrorsym;
  693. ref:=srsym;
  694. stringdispose(asmname);
  695. end;
  696. end;
  697. function tabsolutesym.mangledname : string;
  698. begin
  699. case abstyp of
  700. tovar :
  701. mangledname:=ref^.mangledname;
  702. toasm :
  703. mangledname:=asmname^;
  704. toaddr :
  705. mangledname:='$'+tostr(address);
  706. else
  707. internalerror(10002);
  708. end;
  709. end;
  710. procedure tabsolutesym.insert_in_data;
  711. begin
  712. end;
  713. {$ifdef GDB}
  714. procedure tabsolutesym.concatstabto(asmlist : paasmoutput);
  715. begin
  716. { I don't know how to handle this !! }
  717. end;
  718. {$endif GDB}
  719. {****************************************************************************
  720. TVARSYM
  721. ****************************************************************************}
  722. constructor tvarsym.init(const n : string;p : pdef);
  723. begin
  724. tsym.init(n);
  725. typ:=varsym;
  726. definition:=p;
  727. _mangledname:=nil;
  728. varspez:=vs_value;
  729. address:=0;
  730. islocalcopy:=false;
  731. localvarsym:=nil;
  732. refs:=0;
  733. is_valid := 1;
  734. var_options:=0;
  735. { can we load the value into a register ? }
  736. case p^.deftype of
  737. pointerdef,
  738. enumdef,
  739. procvardef :
  740. var_options:=var_options or vo_regable;
  741. orddef :
  742. case porddef(p)^.typ of
  743. bool8bit,bool16bit,bool32bit,
  744. u8bit,u16bit,u32bit,
  745. s8bit,s16bit,s32bit :
  746. var_options:=var_options or vo_regable;
  747. else
  748. var_options:=var_options and not vo_regable;
  749. end;
  750. setdef:
  751. if psetdef(p)^.settype=smallset then
  752. var_options:=var_options or vo_regable;
  753. else
  754. var_options:=var_options and not vo_regable;
  755. end;
  756. reg:=R_NO;
  757. end;
  758. constructor tvarsym.init_dll(const n : string;p : pdef);
  759. begin
  760. { The tvarsym is necessary for 0.99.5 (PFV) }
  761. tvarsym.init(n,p);
  762. var_options:=var_options or vo_is_dll_var;
  763. end;
  764. constructor tvarsym.init_C(const n,mangled : string;p : pdef);
  765. begin
  766. { The tvarsym is necessary for 0.99.5 (PFV) }
  767. tvarsym.init(n,p);
  768. var_options:=var_options or vo_is_C_var;
  769. setmangledname(mangled);
  770. end;
  771. constructor tvarsym.load;
  772. begin
  773. tsym.load;
  774. typ:=varsym;
  775. _mangledname:=nil;
  776. reg:=R_NO;
  777. refs := 0;
  778. is_valid := 1;
  779. varspez:=tvarspez(readbyte);
  780. if read_member then
  781. address:=readlong
  782. else
  783. address:=0;
  784. islocalcopy:=false;
  785. localvarsym:=nil;
  786. definition:=readdefref;
  787. var_options:=readbyte;
  788. if (var_options and vo_is_C_var)<>0 then
  789. setmangledname(readstring);
  790. end;
  791. procedure tvarsym.deref;
  792. begin
  793. resolvedef(definition);
  794. end;
  795. procedure tvarsym.write;
  796. begin
  797. tsym.write;
  798. writebyte(byte(varspez));
  799. if read_member then
  800. writelong(address);
  801. writedefref(definition);
  802. { symbols which are load are never candidates for a register,
  803. turn off the regable }
  804. writebyte(var_options and (not vo_regable));
  805. if (var_options and vo_is_C_var)<>0 then
  806. writestring(mangledname);
  807. current_ppu^.writeentry(ibvarsym);
  808. end;
  809. procedure tvarsym.setmangledname(const s : string);
  810. begin
  811. _mangledname:=strpnew(s);
  812. end;
  813. function tvarsym.mangledname : string;
  814. var
  815. prefix : string;
  816. begin
  817. if assigned(_mangledname) then
  818. begin
  819. mangledname:=strpas(_mangledname);
  820. exit;
  821. end;
  822. case owner^.symtabletype of
  823. staticsymtable :
  824. if (cs_smartlink in aktmoduleswitches) then
  825. prefix:='_'+owner^.name^+'$$$_'
  826. else
  827. prefix:='_';
  828. unitsymtable,
  829. globalsymtable :
  830. prefix:='U_'+owner^.name^+'_';
  831. else
  832. Message(sym_e_invalid_call_tvarsymmangledname);
  833. end;
  834. mangledname:=prefix+name;
  835. end;
  836. function tvarsym.getsize : longint;
  837. begin
  838. if assigned(definition) and (varspez=vs_value) then
  839. getsize:=definition^.size
  840. else
  841. getsize:=0;
  842. end;
  843. function tvarsym.getpushsize : longint;
  844. begin
  845. if assigned(definition) then
  846. begin
  847. case varspez of
  848. vs_var :
  849. getpushsize:=target_os.size_of_pointer;
  850. vs_value,
  851. vs_const :
  852. begin
  853. (*case definition^.deftype of
  854. arraydef,
  855. setdef,
  856. stringdef,
  857. recorddef,
  858. objectdef :
  859. getpushsize:=target_os.size_of_pointer;
  860. else
  861. getpushsize:=definition^.size;
  862. this is obsolete use push_param instead (PM) *)
  863. if push_addr_param(definition) then
  864. getpushsize:=target_os.size_of_pointer
  865. else
  866. getpushsize:=definition^.size;
  867. end;
  868. end;
  869. end
  870. else
  871. getpushsize:=0;
  872. end;
  873. function data_align(length : longint) : longint;
  874. begin
  875. (* this is useless under go32v2 at least
  876. because the section are only align to dword
  877. if length>8 then
  878. data_align:=16
  879. else if length>4 then
  880. data_align:=8
  881. else *)
  882. if length>2 then
  883. data_align:=4
  884. else if length>1 then
  885. data_align:=2
  886. else
  887. data_align:=1;
  888. end;
  889. procedure tvarsym.insert_in_data;
  890. var
  891. varalign,
  892. l,ali,modulo : longint;
  893. storefilepos : tfileposinfo;
  894. begin
  895. if (var_options and vo_is_external)<>0 then
  896. exit;
  897. { handle static variables of objects especially }
  898. if read_member and (owner^.symtabletype=objectsymtable) and
  899. ((properties and sp_static)<>0) then
  900. begin
  901. { the data filed is generated in parser.pas
  902. with a tobject_FIELDNAME variable }
  903. { this symbol can't be loaded to a register }
  904. var_options:=var_options and not vo_regable;
  905. end
  906. else
  907. if not(read_member) then
  908. begin
  909. { made problems with parameters etc. ! (FK) }
  910. { check for instance of an abstract object or class }
  911. {
  912. if (pvarsym(sym)^.definition^.deftype=objectdef) and
  913. ((pobjectdef(pvarsym(sym)^.definition)^.options and oo_is_abstract)<>0) then
  914. Message(sym_e_no_instance_of_abstract_object);
  915. }
  916. storefilepos:=aktfilepos;
  917. aktfilepos:=tokenpos;
  918. if ((var_options and vo_is_thread_var)<>0) then
  919. l:=4
  920. else
  921. l:=getsize;
  922. case owner^.symtabletype of
  923. stt_exceptsymtable:
  924. { can contain only one symbol, address calculated later }
  925. ;
  926. localsymtable :
  927. begin
  928. is_valid := 0;
  929. modulo:=owner^.datasize and 3;
  930. {$ifdef m68k}
  931. { word alignment required for motorola }
  932. if (l=1) then
  933. l:=2
  934. else
  935. {$endif}
  936. if (l>=4) and (modulo<>0) then
  937. inc(l,4-modulo)
  938. else
  939. if (l>=2) and ((modulo and 1)<>0) then
  940. inc(l,2-(modulo and 1));
  941. inc(owner^.datasize,l);
  942. address:=owner^.datasize;
  943. end;
  944. staticsymtable :
  945. begin
  946. { enable unitialized warning for local symbols }
  947. is_valid := 0;
  948. if (cs_smartlink in aktmoduleswitches) then
  949. bsssegment^.concat(new(pai_cut,init));
  950. ali:=data_align(l);
  951. if ali>1 then
  952. begin
  953. (* this is done
  954. either by the assembler or in ag386bin
  955. bsssegment^.concat(new(pai_align,init(ali))); *)
  956. modulo:=owner^.datasize mod ali;
  957. if modulo>0 then
  958. inc(owner^.datasize,ali-modulo);
  959. end;
  960. {$ifdef GDB}
  961. if cs_debuginfo in aktmoduleswitches then
  962. concatstabto(bsssegment);
  963. {$endif GDB}
  964. if (cs_smartlink in aktmoduleswitches) or
  965. ((var_options and vo_is_c_var)<>0) then
  966. bsssegment^.concat(new(pai_datablock,init_global(mangledname,l)))
  967. else
  968. bsssegment^.concat(new(pai_datablock,init(mangledname,l)));
  969. { increase datasize }
  970. inc(owner^.datasize,l);
  971. { this symbol can't be loaded to a register }
  972. var_options:=var_options and not vo_regable;
  973. end;
  974. globalsymtable :
  975. begin
  976. if (cs_smartlink in aktmoduleswitches) then
  977. bsssegment^.concat(new(pai_cut,init));
  978. ali:=data_align(l);
  979. if ali>1 then
  980. begin
  981. (* this is done
  982. either by the assembler or in ag386bin
  983. bsssegment^.concat(new(pai_align,init(ali))); *)
  984. modulo:=owner^.datasize mod ali;
  985. if modulo>0 then
  986. inc(owner^.datasize,ali-modulo);
  987. end;
  988. {$ifdef GDB}
  989. if cs_debuginfo in aktmoduleswitches then
  990. concatstabto(bsssegment);
  991. {$endif GDB}
  992. bsssegment^.concat(new(pai_datablock,init_global(mangledname,l)));
  993. inc(owner^.datasize,l);
  994. { this symbol can't be loaded to a register }
  995. var_options:=var_options and not vo_regable;
  996. end;
  997. recordsymtable,
  998. objectsymtable :
  999. begin
  1000. { this symbol can't be loaded to a register }
  1001. var_options:=var_options and not vo_regable;
  1002. { get the alignment size }
  1003. if (aktpackrecords=packrecord_C) then
  1004. begin
  1005. varalign:=definition^.alignment;
  1006. if varalign=0 then
  1007. begin
  1008. if (owner^.dataalignment<4) then
  1009. begin
  1010. if (l>=4) then
  1011. owner^.dataalignment:=4
  1012. else
  1013. if (owner^.dataalignment<2) and (l>=2) then
  1014. owner^.dataalignment:=2;
  1015. end;
  1016. end;
  1017. end
  1018. else
  1019. varalign:=0;
  1020. { align record and object fields }
  1021. if (l=1) or (varalign=1) or (owner^.dataalignment=1) then
  1022. begin
  1023. address:=owner^.datasize;
  1024. inc(owner^.datasize,l)
  1025. end
  1026. else
  1027. if (l=2) or (varalign=2) or (owner^.dataalignment=2) then
  1028. begin
  1029. owner^.datasize:=(owner^.datasize+1) and (not 1);
  1030. address:=owner^.datasize;
  1031. inc(owner^.datasize,l)
  1032. end
  1033. else
  1034. if (l<=4) or (varalign=4) or (owner^.dataalignment=4) then
  1035. begin
  1036. owner^.datasize:=(owner^.datasize+3) and (not 3);
  1037. address:=owner^.datasize;
  1038. inc(owner^.datasize,l);
  1039. end
  1040. else
  1041. if (l<=8) or (owner^.dataalignment=8) then
  1042. begin
  1043. owner^.datasize:=(owner^.datasize+7) and (not 7);
  1044. address:=owner^.datasize;
  1045. inc(owner^.datasize,l);
  1046. end
  1047. else
  1048. if (l<=16) or (owner^.dataalignment=16) then
  1049. begin
  1050. owner^.datasize:=(owner^.datasize+15) and (not 15);
  1051. address:=owner^.datasize;
  1052. inc(owner^.datasize,l);
  1053. end
  1054. else
  1055. if (l<=32) or (owner^.dataalignment=32) then
  1056. begin
  1057. owner^.datasize:=(owner^.datasize+31) and (not 31);
  1058. address:=owner^.datasize;
  1059. inc(owner^.datasize,l);
  1060. end;
  1061. end;
  1062. parasymtable :
  1063. begin
  1064. { here we need the size of a push instead of the
  1065. size of the data }
  1066. l:=getpushsize;
  1067. address:=owner^.datasize;
  1068. owner^.datasize:=align(owner^.datasize+l,target_os.stackalignment);
  1069. end
  1070. else
  1071. begin
  1072. modulo:=owner^.datasize and 3 ;
  1073. if (l>=4) and (modulo<>0) then
  1074. inc(owner^.datasize,4-modulo)
  1075. else
  1076. if (l>=2) and ((modulo and 1)<>0) then
  1077. inc(owner^.datasize);
  1078. address:=owner^.datasize;
  1079. inc(owner^.datasize,l);
  1080. end;
  1081. end;
  1082. aktfilepos:=storefilepos;
  1083. end;
  1084. end;
  1085. {$ifdef GDB}
  1086. function tvarsym.stabstring : pchar;
  1087. var
  1088. st : char;
  1089. begin
  1090. if (owner^.symtabletype = objectsymtable) and
  1091. ((properties and sp_static)<>0) then
  1092. begin
  1093. if (cs_gdb_gsym in aktglobalswitches) then st := 'G' else st := 'S';
  1094. {$ifndef Delphi}
  1095. stabstring := strpnew('"'+owner^.name^+'__'+name+':'+
  1096. +definition^.numberstring+'",'+
  1097. tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname);
  1098. {$endif}
  1099. end
  1100. else if (owner^.symtabletype = globalsymtable) or
  1101. (owner^.symtabletype = unitsymtable) then
  1102. begin
  1103. { Here we used S instead of
  1104. because with G GDB doesn't look at the address field
  1105. but searches the same name or with a leading underscore
  1106. but these names don't exist in pascal !}
  1107. if (cs_gdb_gsym in aktglobalswitches) then st := 'G' else st := 'S';
  1108. stabstring := strpnew('"'+name+':'+st
  1109. +definition^.numberstring+'",'+
  1110. tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname);
  1111. end
  1112. else if owner^.symtabletype = staticsymtable then
  1113. begin
  1114. stabstring := strpnew('"'+name+':S'
  1115. +definition^.numberstring+'",'+
  1116. tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname);
  1117. end
  1118. else if (owner^.symtabletype=parasymtable) then
  1119. begin
  1120. case varspez of
  1121. vs_var : st := 'v';
  1122. vs_value,
  1123. vs_const : if push_addr_param(definition) then
  1124. st := 'v' { should be 'i' but 'i' doesn't work }
  1125. else
  1126. st := 'p';
  1127. end;
  1128. stabstring := strpnew('"'+name+':'+st
  1129. +definition^.numberstring+'",'+
  1130. tostr(N_PSYM)+',0,'+tostr(fileinfo.line)+','+
  1131. tostr(address+owner^.address_fixup));
  1132. {offset to ebp => will not work if the framepointer is esp
  1133. so some optimizing will make things harder to debug }
  1134. end
  1135. else if (owner^.symtabletype=localsymtable) then
  1136. {$ifdef i386}
  1137. if reg<>R_NO then
  1138. begin
  1139. { "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }
  1140. { this is the register order for GDB}
  1141. stabstring:=strpnew('"'+name+':r'
  1142. +definition^.numberstring+'",'+
  1143. tostr(N_RSYM)+',0,'+
  1144. tostr(fileinfo.line)+','+tostr(GDB_i386index[reg]));
  1145. end
  1146. else
  1147. {$endif i386}
  1148. { I don't know if this will work (PM) }
  1149. if (var_options and vo_is_C_var)<>0 then
  1150. stabstring := strpnew('"'+name+':S'
  1151. +definition^.numberstring+'",'+
  1152. tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname)
  1153. else
  1154. stabstring := strpnew('"'+name+':'
  1155. +definition^.numberstring+'",'+
  1156. tostr(N_LSYM)+',0,'+tostr(fileinfo.line)+',-'+tostr(address))
  1157. else
  1158. stabstring := inherited stabstring;
  1159. end;
  1160. procedure tvarsym.concatstabto(asmlist : paasmoutput);
  1161. {$ifdef i386}
  1162. var stab_str : pchar;
  1163. {$endif i386}
  1164. begin
  1165. inherited concatstabto(asmlist);
  1166. {$ifdef i386}
  1167. if (owner^.symtabletype=parasymtable) and
  1168. (reg<>R_NO) then
  1169. begin
  1170. { "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }
  1171. { this is the register order for GDB}
  1172. stab_str:=strpnew('"'+name+':r'
  1173. +definition^.numberstring+'",'+
  1174. tostr(N_RSYM)+',0,'+
  1175. tostr(fileinfo.line)+','+tostr(GDB_i386index[reg]));
  1176. asmlist^.concat(new(pai_stabs,init(stab_str)));
  1177. end;
  1178. {$endif i386}
  1179. end;
  1180. {$endif GDB}
  1181. destructor tvarsym.done;
  1182. begin
  1183. strdispose(_mangledname);
  1184. inherited done;
  1185. end;
  1186. {****************************************************************************
  1187. TTYPEDCONSTSYM
  1188. *****************************************************************************}
  1189. constructor ttypedconstsym.init(const n : string;p : pdef;really_const : boolean);
  1190. begin
  1191. tsym.init(n);
  1192. typ:=typedconstsym;
  1193. definition:=p;
  1194. is_really_const:=really_const;
  1195. prefix:=stringdup(procprefix);
  1196. end;
  1197. constructor ttypedconstsym.load;
  1198. begin
  1199. tsym.load;
  1200. typ:=typedconstsym;
  1201. definition:=readdefref;
  1202. {$ifdef DELPHI_CONST_IN_RODATA}
  1203. is_really_const:=boolean(readbyte);
  1204. {$else DELPHI_CONST_IN_RODATA}
  1205. is_really_const:=false;
  1206. {$endif DELPHI_CONST_IN_RODATA}
  1207. prefix:=stringdup(readstring);
  1208. end;
  1209. destructor ttypedconstsym.done;
  1210. begin
  1211. stringdispose(prefix);
  1212. tsym.done;
  1213. end;
  1214. function ttypedconstsym.mangledname : string;
  1215. begin
  1216. mangledname:='TC_'+prefix^+'_'+name;
  1217. end;
  1218. function ttypedconstsym.getsize : longint;
  1219. begin
  1220. if assigned(definition) then
  1221. getsize:=definition^.size
  1222. else
  1223. getsize:=0;
  1224. end;
  1225. procedure ttypedconstsym.deref;
  1226. begin
  1227. resolvedef(definition);
  1228. end;
  1229. procedure ttypedconstsym.write;
  1230. begin
  1231. tsym.write;
  1232. writedefref(definition);
  1233. writestring(prefix^);
  1234. {$ifdef DELPHI_CONST_IN_RODATA}
  1235. writebyte(byte(is_really_const));
  1236. {$endif DELPHI_CONST_IN_RODATA}
  1237. current_ppu^.writeentry(ibtypedconstsym);
  1238. end;
  1239. { for most symbol types ther is nothing to do at all }
  1240. procedure ttypedconstsym.insert_in_data;
  1241. begin
  1242. { here there is a problem for ansistrings !! }
  1243. { we must write the label only after the 12 header bytes (PM)
  1244. if not is_ansistring(definition) then
  1245. }
  1246. { solved, the ansis string is moved to consts (FK) }
  1247. really_insert_in_data;
  1248. end;
  1249. procedure ttypedconstsym.really_insert_in_data;
  1250. var curconstsegment : paasmoutput;
  1251. l,ali,modulo : longint;
  1252. storefilepos : tfileposinfo;
  1253. begin
  1254. storefilepos:=aktfilepos;
  1255. aktfilepos:=tokenpos;
  1256. if is_really_const then
  1257. curconstsegment:=consts
  1258. else
  1259. curconstsegment:=datasegment;
  1260. if (cs_smartlink in aktmoduleswitches) then
  1261. curconstsegment^.concat(new(pai_cut,init));
  1262. l:=getsize;
  1263. ali:=data_align(l);
  1264. if ali>1 then
  1265. begin
  1266. curconstsegment^.concat(new(pai_align,init(ali)));
  1267. modulo:=owner^.datasize mod ali;
  1268. if modulo>0 then
  1269. inc(owner^.datasize,ali-modulo);
  1270. end;
  1271. { Why was there no owner size update here ??? }
  1272. inc(owner^.datasize,l);
  1273. {$ifdef GDB}
  1274. if cs_debuginfo in aktmoduleswitches then
  1275. concatstabto(curconstsegment);
  1276. {$endif GDB}
  1277. if owner^.symtabletype=globalsymtable then
  1278. begin
  1279. curconstsegment^.concat(new(pai_symbol,initname_global(mangledname)));
  1280. end
  1281. else
  1282. if owner^.symtabletype<>unitsymtable then
  1283. begin
  1284. if (cs_smartlink in aktmoduleswitches) then
  1285. curconstsegment^.concat(new(pai_symbol,initname_global(mangledname)))
  1286. else
  1287. curconstsegment^.concat(new(pai_symbol,initname(mangledname)));
  1288. end;
  1289. aktfilepos:=storefilepos;
  1290. end;
  1291. {$ifdef GDB}
  1292. function ttypedconstsym.stabstring : pchar;
  1293. var
  1294. st : char;
  1295. begin
  1296. if (cs_gdb_gsym in aktglobalswitches) and (owner^.symtabletype in [unitsymtable,globalsymtable]) then
  1297. st := 'G'
  1298. else
  1299. st := 'S';
  1300. stabstring := strpnew('"'+name+':'+st+
  1301. definition^.numberstring+'",'+tostr(n_STSYM)+',0,'+
  1302. tostr(fileinfo.line)+','+mangledname);
  1303. end;
  1304. {$endif GDB}
  1305. {****************************************************************************
  1306. TCONSTSYM
  1307. ****************************************************************************}
  1308. constructor tconstsym.init(const n : string;t : tconsttype;v : longint);
  1309. begin
  1310. inherited init(n);
  1311. typ:=constsym;
  1312. consttype:=t;
  1313. value:=v;
  1314. definition:=nil;
  1315. len:=0;
  1316. end;
  1317. constructor tconstsym.init_def(const n : string;t : tconsttype;v : longint;def : pdef);
  1318. begin
  1319. inherited init(n);
  1320. typ:=constsym;
  1321. consttype:=t;
  1322. value:=v;
  1323. definition:=def;
  1324. len:=0;
  1325. end;
  1326. constructor tconstsym.init_string(const n : string;t : tconsttype;str:pchar;l:longint);
  1327. begin
  1328. inherited init(n);
  1329. typ:=constsym;
  1330. consttype:=t;
  1331. value:=longint(str);
  1332. definition:=nil;
  1333. len:=l;
  1334. if t=constresourcestring then
  1335. registerresourcestring(pchar(value),len);
  1336. end;
  1337. constructor tconstsym.load;
  1338. var
  1339. pd : pbestreal;
  1340. ps : pnormalset;
  1341. begin
  1342. tsym.load;
  1343. typ:=constsym;
  1344. consttype:=tconsttype(readbyte);
  1345. case consttype of
  1346. constint,
  1347. constbool,
  1348. constchar : value:=readlong;
  1349. constord :
  1350. begin
  1351. definition:=readdefref;
  1352. value:=readlong;
  1353. end;
  1354. conststring :
  1355. begin
  1356. len:=readlong;
  1357. getmem(pchar(value),len+1);
  1358. current_ppu^.getdata(pchar(value)^,len);
  1359. registerresourcestring(pchar(value),len);
  1360. end;
  1361. constreal :
  1362. begin
  1363. new(pd);
  1364. pd^:=readreal;
  1365. value:=longint(pd);
  1366. end;
  1367. constset :
  1368. begin
  1369. definition:=readdefref;
  1370. new(ps);
  1371. readnormalset(ps^);
  1372. value:=longint(ps);
  1373. end;
  1374. constnil : ;
  1375. else
  1376. Message1(unit_f_ppu_invalid_entry,tostr(ord(consttype)));
  1377. end;
  1378. end;
  1379. destructor tconstsym.done;
  1380. begin
  1381. case consttype of
  1382. conststring :
  1383. freemem(pchar(value),len+1);
  1384. constreal :
  1385. dispose(pbestreal(value));
  1386. constset :
  1387. dispose(pnormalset(value));
  1388. end;
  1389. inherited done;
  1390. end;
  1391. function tconstsym.mangledname : string;
  1392. begin
  1393. mangledname:=name;
  1394. end;
  1395. procedure tconstsym.deref;
  1396. begin
  1397. if consttype in [constord,constset] then
  1398. resolvedef(pdef(definition));
  1399. end;
  1400. procedure tconstsym.write;
  1401. begin
  1402. tsym.write;
  1403. writebyte(byte(consttype));
  1404. case consttype of
  1405. constnil : ;
  1406. constint,
  1407. constbool,
  1408. constchar :
  1409. writelong(value);
  1410. constord :
  1411. begin
  1412. writedefref(definition);
  1413. writelong(value);
  1414. end;
  1415. conststring :
  1416. begin
  1417. writelong(len);
  1418. current_ppu^.putdata(pchar(value)^,len);
  1419. end;
  1420. constreal :
  1421. writereal(pbestreal(value)^);
  1422. constset :
  1423. begin
  1424. writedefref(definition);
  1425. writenormalset(pointer(value)^);
  1426. end;
  1427. else
  1428. internalerror(13);
  1429. end;
  1430. current_ppu^.writeentry(ibconstsym);
  1431. end;
  1432. {$ifdef GDB}
  1433. function tconstsym.stabstring : pchar;
  1434. var st : string;
  1435. begin
  1436. {even GDB v4.16 only now 'i' 'r' and 'e' !!!}
  1437. case consttype of
  1438. conststring : begin
  1439. { I had to remove ibm2ascii !! }
  1440. st := pstring(value)^;
  1441. {st := ibm2ascii(pstring(value)^);}
  1442. st := 's'''+st+'''';
  1443. end;
  1444. constbool, constint, constord, constchar : st := 'i'+tostr(value);
  1445. constreal : begin
  1446. system.str(pbestreal(value)^,st);
  1447. st := 'r'+st;
  1448. end;
  1449. { if we don't know just put zero !! }
  1450. else st:='i0';
  1451. {***SETCONST}
  1452. {constset:;} {*** I don't know what to do with a set.}
  1453. { sets are not recognized by GDB}
  1454. {***}
  1455. end;
  1456. stabstring := strpnew('"'+name+':c='+st+'",'+tostr(N_function)+',0,'+
  1457. tostr(fileinfo.line)+',0');
  1458. end;
  1459. procedure tconstsym.concatstabto(asmlist : paasmoutput);
  1460. begin
  1461. if consttype <> conststring then
  1462. inherited concatstabto(asmlist);
  1463. end;
  1464. {$endif GDB}
  1465. {****************************************************************************
  1466. TENUMSYM
  1467. ****************************************************************************}
  1468. constructor tenumsym.init(const n : string;def : penumdef;v : longint);
  1469. begin
  1470. tsym.init(n);
  1471. typ:=enumsym;
  1472. definition:=def;
  1473. value:=v;
  1474. if def^.min>v then
  1475. def^.setmin(v);
  1476. if def^.max<v then
  1477. def^.setmax(v);
  1478. order;
  1479. end;
  1480. constructor tenumsym.load;
  1481. begin
  1482. tsym.load;
  1483. typ:=enumsym;
  1484. definition:=penumdef(readdefref);
  1485. value:=readlong;
  1486. nextenum := Nil;
  1487. end;
  1488. procedure tenumsym.deref;
  1489. begin
  1490. resolvedef(pdef(definition));
  1491. order;
  1492. end;
  1493. procedure tenumsym.order;
  1494. var
  1495. sym : penumsym;
  1496. begin
  1497. sym := definition^.firstenum;
  1498. if sym = nil then
  1499. begin
  1500. definition^.firstenum := @self;
  1501. nextenum := nil;
  1502. exit;
  1503. end;
  1504. { reorder the symbols in increasing value }
  1505. if value < sym^.value then
  1506. begin
  1507. nextenum := sym;
  1508. definition^.firstenum := @self;
  1509. end
  1510. else
  1511. begin
  1512. while (sym^.value <= value) and assigned(sym^.nextenum) do
  1513. sym := sym^.nextenum;
  1514. nextenum := sym^.nextenum;
  1515. sym^.nextenum := @self;
  1516. end;
  1517. end;
  1518. procedure tenumsym.write;
  1519. begin
  1520. tsym.write;
  1521. writedefref(definition);
  1522. writelong(value);
  1523. current_ppu^.writeentry(ibenumsym);
  1524. end;
  1525. {$ifdef GDB}
  1526. procedure tenumsym.concatstabto(asmlist : paasmoutput);
  1527. begin
  1528. {enum elements have no stab !}
  1529. end;
  1530. {$EndIf GDB}
  1531. {****************************************************************************
  1532. TTYPESYM
  1533. ****************************************************************************}
  1534. constructor ttypesym.init(const n : string;d : pdef);
  1535. begin
  1536. tsym.init(n);
  1537. typ:=typesym;
  1538. definition:=d;
  1539. {$ifdef GDB}
  1540. isusedinstab := false;
  1541. {$endif GDB}
  1542. forwardpointer:=nil;
  1543. if assigned(definition) then
  1544. begin
  1545. if not(assigned(definition^.sym)) then
  1546. begin
  1547. definition^.sym:=@self;
  1548. synonym:=nil;
  1549. properties:=sp_primary_typesym;
  1550. end
  1551. else
  1552. begin
  1553. synonym:=definition^.sym^.synonym;
  1554. definition^.sym^.synonym:=@self;
  1555. end;
  1556. end;
  1557. end;
  1558. constructor ttypesym.load;
  1559. begin
  1560. tsym.load;
  1561. typ:=typesym;
  1562. forwardpointer:=nil;
  1563. synonym:=nil;
  1564. {$ifdef GDB}
  1565. isusedinstab := false;
  1566. {$endif GDB}
  1567. definition:=readdefref;
  1568. end;
  1569. destructor ttypesym.done;
  1570. var prevsym : ptypesym;
  1571. begin
  1572. if assigned(definition) then
  1573. begin
  1574. prevsym:=definition^.sym;
  1575. if prevsym=@self then
  1576. definition^.sym:=synonym;
  1577. while assigned(prevsym) do
  1578. begin
  1579. if (prevsym^.synonym=@self) then
  1580. begin
  1581. prevsym^.synonym:=synonym;
  1582. break;
  1583. end;
  1584. prevsym:=prevsym^.synonym;
  1585. end;
  1586. end;
  1587. synonym:=nil;
  1588. definition:=nil;
  1589. inherited done;
  1590. end;
  1591. procedure ttypesym.deref;
  1592. begin
  1593. resolvedef(definition);
  1594. if assigned(definition) then
  1595. begin
  1596. if properties=sp_primary_typesym then
  1597. begin
  1598. if definition^.sym<>@self then
  1599. synonym:=definition^.sym;
  1600. definition^.sym:=@self;
  1601. end
  1602. else
  1603. begin
  1604. if assigned(definition^.sym) then
  1605. begin
  1606. synonym:=definition^.sym^.synonym;
  1607. if definition^.sym<>@self then
  1608. definition^.sym^.synonym:=@self;
  1609. end
  1610. else
  1611. definition^.sym:=@self;
  1612. end;
  1613. if (definition^.deftype=recorddef) and assigned(precdef(definition)^.symtable) and
  1614. (definition^.sym=@self) then
  1615. precdef(definition)^.symtable^.name:=stringdup('record '+name);
  1616. end;
  1617. end;
  1618. procedure ttypesym.write;
  1619. begin
  1620. tsym.write;
  1621. writedefref(definition);
  1622. current_ppu^.writeentry(ibtypesym);
  1623. end;
  1624. procedure ttypesym.load_references;
  1625. begin
  1626. inherited load_references;
  1627. if (definition^.deftype=recorddef) then
  1628. precdef(definition)^.symtable^.load_browser;
  1629. if (definition^.deftype=objectdef) then
  1630. pobjectdef(definition)^.publicsyms^.load_browser;
  1631. end;
  1632. function ttypesym.write_references : boolean;
  1633. begin
  1634. if not inherited write_references then
  1635. { write address of this symbol if record or object
  1636. even if no real refs are there
  1637. because we need it for the symtable }
  1638. if (definition^.deftype=recorddef) or
  1639. (definition^.deftype=objectdef) then
  1640. begin
  1641. writesymref(@self);
  1642. current_ppu^.writeentry(ibsymref);
  1643. end;
  1644. write_references:=true;
  1645. if (definition^.deftype=recorddef) then
  1646. precdef(definition)^.symtable^.write_browser;
  1647. if (definition^.deftype=objectdef) then
  1648. pobjectdef(definition)^.publicsyms^.write_browser;
  1649. end;
  1650. procedure ttypesym.addforwardpointer(p:ppointerdef);
  1651. var
  1652. hfp : pforwardpointer;
  1653. begin
  1654. new(hfp);
  1655. hfp^.next:=forwardpointer;
  1656. hfp^.def:=p;
  1657. forwardpointer:=hfp;
  1658. end;
  1659. procedure ttypesym.updateforwarddef(p:pdef);
  1660. var
  1661. lasthfp,hfp : pforwardpointer;
  1662. begin
  1663. definition:=p;
  1664. properties:=current_object_option;
  1665. fileinfo:=tokenpos;
  1666. if assigned(definition) and not(assigned(definition^.sym)) then
  1667. definition^.sym:=@self;
  1668. { update all forwardpointers to this definition }
  1669. hfp:=forwardpointer;
  1670. while assigned(hfp) do
  1671. begin
  1672. lasthfp:=hfp;
  1673. hfp^.def^.definition:=definition;
  1674. hfp:=hfp^.next;
  1675. dispose(lasthfp);
  1676. end;
  1677. end;
  1678. {$ifdef BrowserLog}
  1679. procedure ttypesym.add_to_browserlog;
  1680. begin
  1681. inherited add_to_browserlog;
  1682. if (definition^.deftype=recorddef) then
  1683. precdef(definition)^.symtable^.writebrowserlog;
  1684. if (definition^.deftype=objectdef) then
  1685. pobjectdef(definition)^.publicsyms^.writebrowserlog;
  1686. end;
  1687. {$endif BrowserLog}
  1688. {$ifdef GDB}
  1689. function ttypesym.stabstring : pchar;
  1690. var stabchar : string[2];
  1691. short : string;
  1692. begin
  1693. if definition^.deftype in tagtypes then
  1694. stabchar := 'Tt'
  1695. else
  1696. stabchar := 't';
  1697. short := '"'+name+':'+stabchar+definition^.numberstring
  1698. +'",'+tostr(N_LSYM)+',0,'+tostr(fileinfo.line)+',0';
  1699. stabstring := strpnew(short);
  1700. end;
  1701. procedure ttypesym.concatstabto(asmlist : paasmoutput);
  1702. begin
  1703. {not stabs for forward defs }
  1704. if assigned(definition) then
  1705. if (definition^.sym = @self) then
  1706. definition^.concatstabto(asmlist)
  1707. else
  1708. inherited concatstabto(asmlist);
  1709. end;
  1710. {$endif GDB}
  1711. {****************************************************************************
  1712. TSYSSYM
  1713. ****************************************************************************}
  1714. constructor tsyssym.init(const n : string;l : longint);
  1715. begin
  1716. inherited init(n);
  1717. typ:=syssym;
  1718. number:=l;
  1719. end;
  1720. constructor tsyssym.load;
  1721. begin
  1722. tsym.load;
  1723. typ:=syssym;
  1724. number:=readlong;
  1725. end;
  1726. destructor tsyssym.done;
  1727. begin
  1728. inherited done;
  1729. end;
  1730. procedure tsyssym.write;
  1731. begin
  1732. tsym.write;
  1733. writelong(number);
  1734. current_ppu^.writeentry(ibsyssym);
  1735. end;
  1736. {$ifdef GDB}
  1737. procedure tsyssym.concatstabto(asmlist : paasmoutput);
  1738. begin
  1739. end;
  1740. {$endif GDB}
  1741. {****************************************************************************
  1742. TMACROSYM
  1743. ****************************************************************************}
  1744. constructor tmacrosym.init(const n : string);
  1745. begin
  1746. inherited init(n);
  1747. typ:=macrosym;
  1748. defined:=true;
  1749. buftext:=nil;
  1750. buflen:=0;
  1751. end;
  1752. destructor tmacrosym.done;
  1753. begin
  1754. if assigned(buftext) then
  1755. freemem(buftext,buflen);
  1756. inherited done;
  1757. end;
  1758. {
  1759. $Log$
  1760. Revision 1.101 1999-07-23 20:59:23 peter
  1761. * more C packing fixes
  1762. Revision 1.100 1999/07/23 16:05:32 peter
  1763. * alignment is now saved in the symtable
  1764. * C alignment added for records
  1765. * PPU version increased to solve .12 <-> .13 probs
  1766. Revision 1.99 1999/07/23 11:33:23 peter
  1767. * removed oldppu from propertysym
  1768. Revision 1.98 1999/07/22 09:37:55 florian
  1769. + resourcestring implemented
  1770. + start of longstring support
  1771. Revision 1.97 1999/07/05 12:13:25 florian
  1772. * property reading from PPU fixed (new PPU format), it uses now writesym...
  1773. Revision 1.96 1999/06/28 10:49:48 pierre
  1774. merged from 0-99-12 branch
  1775. Revision 1.94.2.2 1999/06/28 10:32:29 pierre
  1776. * fixes bug453
  1777. Revision 1.94.2.1 1999/06/22 16:26:45 pierre
  1778. * local browser stuff corrected
  1779. Revision 1.94 1999/06/03 16:25:05 pierre
  1780. * local Cvar stabs corrected
  1781. Revision 1.93 1999/05/27 19:45:06 peter
  1782. * removed oldasm
  1783. * plabel -> pasmlabel
  1784. * -a switches to source writing automaticly
  1785. * assembler readers OOPed
  1786. * asmsymbol automaticly external
  1787. * jumptables and other label fixes for asm readers
  1788. Revision 1.92 1999/05/21 13:55:21 peter
  1789. * NEWLAB for label as symbol
  1790. Revision 1.91 1999/05/20 22:22:44 pierre
  1791. + added synonym filed for ttypesym
  1792. allows a clean disposal of tdefs and related ttypesyms
  1793. Revision 1.90 1999/05/17 13:11:40 pierre
  1794. * unitsym security stuff
  1795. Revision 1.89 1999/05/13 21:59:45 peter
  1796. * removed oldppu code
  1797. * warning if objpas is loaded from uses
  1798. * first things for new deref writing
  1799. Revision 1.88 1999/05/10 09:01:43 peter
  1800. * small message fixes
  1801. Revision 1.87 1999/05/08 19:52:38 peter
  1802. + MessagePos() which is enhanced Message() function but also gets the
  1803. position info
  1804. * Removed comp warnings
  1805. Revision 1.86 1999/05/07 00:06:22 pierre
  1806. + added aligmnent of data for typed consts
  1807. for var it is done by AS or LD or in ag386bin for direct object output
  1808. Revision 1.85 1999/05/04 21:45:07 florian
  1809. * changes to compile it with Delphi 4.0
  1810. Revision 1.84 1999/05/04 16:05:13 pierre
  1811. * fix for unitsym problem
  1812. Revision 1.83 1999/04/28 06:02:13 florian
  1813. * changes of Bruessel:
  1814. + message handler can now take an explicit self
  1815. * typinfo fixed: sometimes the type names weren't written
  1816. * the type checking for pointer comparisations and subtraction
  1817. and are now more strict (was also buggy)
  1818. * small bug fix to link.pas to support compiling on another
  1819. drive
  1820. * probable bug in popt386 fixed: call/jmp => push/jmp
  1821. transformation didn't count correctly the jmp references
  1822. + threadvar support
  1823. * warning if ln/sqrt gets an invalid constant argument
  1824. Revision 1.82 1999/04/26 13:31:52 peter
  1825. * release storenumber,double_checksum
  1826. Revision 1.81 1999/04/25 22:38:39 pierre
  1827. + added is_really_const booleanfield for typedconstsym
  1828. for Delphi in $J- mode (not yet implemented !)
  1829. Revision 1.80 1999/04/21 09:43:54 peter
  1830. * storenumber works
  1831. * fixed some typos in double_checksum
  1832. + incompatible types type1 and type2 message (with storenumber)
  1833. Revision 1.79 1999/04/17 13:16:21 peter
  1834. * fixes for storenumber
  1835. Revision 1.78 1999/04/14 09:15:02 peter
  1836. * first things to store the symbol/def number in the ppu
  1837. Revision 1.77 1999/04/08 10:11:32 pierre
  1838. + enable uninitilized warnings for static symbols
  1839. Revision 1.76 1999/03/31 13:55:21 peter
  1840. * assembler inlining working for ag386bin
  1841. Revision 1.75 1999/03/24 23:17:27 peter
  1842. * fixed bugs 212,222,225,227,229,231,233
  1843. Revision 1.74 1999/02/23 18:29:27 pierre
  1844. * win32 compilation error fix
  1845. + some work for local browser (not cl=omplete yet)
  1846. Revision 1.73 1999/02/22 13:07:09 pierre
  1847. + -b and -bl options work !
  1848. + cs_local_browser ($L+) is disabled if cs_browser ($Y+)
  1849. is not enabled when quitting global section
  1850. * local vars and procedures are not yet stored into PPU
  1851. Revision 1.72 1999/02/08 09:51:22 pierre
  1852. * gdb info for local functions was wrong
  1853. Revision 1.71 1999/01/23 23:29:41 florian
  1854. * first running version of the new code generator
  1855. * when compiling exceptions under Linux fixed
  1856. Revision 1.70 1999/01/21 22:10:48 peter
  1857. * fixed array of const
  1858. * generic platform independent high() support
  1859. Revision 1.69 1999/01/20 10:20:20 peter
  1860. * don't make localvar copies for assembler procedures
  1861. Revision 1.68 1999/01/12 14:25:36 peter
  1862. + BrowserLog for browser.log generation
  1863. + BrowserCol for browser info in TCollections
  1864. * released all other UseBrowser
  1865. Revision 1.67 1998/12/30 22:15:54 peter
  1866. + farpointer type
  1867. * absolutesym now also stores if its far
  1868. Revision 1.66 1998/12/30 13:41:14 peter
  1869. * released valuepara
  1870. Revision 1.65 1998/12/26 15:35:44 peter
  1871. + read/write of constnil
  1872. Revision 1.64 1998/12/08 10:18:15 peter
  1873. + -gh for heaptrc unit
  1874. Revision 1.63 1998/11/28 16:20:56 peter
  1875. + support for dll variables
  1876. Revision 1.62 1998/11/27 14:50:48 peter
  1877. + open strings, $P switch support
  1878. Revision 1.61 1998/11/18 15:44:18 peter
  1879. * VALUEPARA for tp7 compatible value parameters
  1880. Revision 1.60 1998/11/16 10:13:51 peter
  1881. * label defines are checked at the end of the proc
  1882. Revision 1.59 1998/11/13 12:09:11 peter
  1883. * unused label is now a warning
  1884. Revision 1.58 1998/11/10 10:50:57 pierre
  1885. * temporary fix for long mangled procsym names
  1886. Revision 1.57 1998/11/05 23:39:31 peter
  1887. + typedconst.getsize
  1888. Revision 1.56 1998/10/28 18:26:18 pierre
  1889. * removed some erros after other errors (introduced by useexcept)
  1890. * stabs works again correctly (for how long !)
  1891. Revision 1.55 1998/10/20 08:07:00 pierre
  1892. * several memory corruptions due to double freemem solved
  1893. => never use p^.loc.location:=p^.left^.loc.location;
  1894. + finally I added now by default
  1895. that ra386dir translates global and unit symbols
  1896. + added a first field in tsymtable and
  1897. a nextsym field in tsym
  1898. (this allows to obtain ordered type info for
  1899. records and objects in gdb !)
  1900. Revision 1.54 1998/10/19 08:55:07 pierre
  1901. * wrong stabs info corrected once again !!
  1902. + variable vmt offset with vmt field only if required
  1903. implemented now !!!
  1904. Revision 1.53 1998/10/16 08:51:53 peter
  1905. + target_os.stackalignment
  1906. + stack can be aligned at 2 or 4 byte boundaries
  1907. Revision 1.52 1998/10/08 17:17:32 pierre
  1908. * current_module old scanner tagged as invalid if unit is recompiled
  1909. + added ppheap for better info on tracegetmem of heaptrc
  1910. (adds line column and file index)
  1911. * several memory leaks removed ith help of heaptrc !!
  1912. Revision 1.51 1998/10/08 13:48:50 peter
  1913. * fixed memory leaks for do nothing source
  1914. * fixed unit interdependency
  1915. Revision 1.50 1998/10/06 17:16:56 pierre
  1916. * some memory leaks fixed (thanks to Peter for heaptrc !)
  1917. Revision 1.49 1998/10/01 09:22:55 peter
  1918. * fixed value openarray
  1919. * ungettemp of arrayconstruct
  1920. Revision 1.48 1998/09/26 17:45:44 peter
  1921. + idtoken and only one token table
  1922. Revision 1.47 1998/09/24 15:11:17 peter
  1923. * fixed enum for not GDB
  1924. Revision 1.46 1998/09/23 15:39:13 pierre
  1925. * browser bugfixes
  1926. was adding a reference when looking for the symbol
  1927. if -bSYM_NAME was used
  1928. Revision 1.45 1998/09/21 08:45:24 pierre
  1929. + added vmt_offset in tobjectdef.write for fututre use
  1930. (first steps to have objects without vmt if no virtual !!)
  1931. + added fpu_used field for tabstractprocdef :
  1932. sets this level to 2 if the functions return with value in FPU
  1933. (is then set to correct value at parsing of implementation)
  1934. THIS MIGHT refuse some code with FPU expression too complex
  1935. that were accepted before and even in some cases
  1936. that don't overflow in fact
  1937. ( like if f : float; is a forward that finally in implementation
  1938. only uses one fpu register !!)
  1939. Nevertheless I think that it will improve security on
  1940. FPU operations !!
  1941. * most other changes only for UseBrowser code
  1942. (added symtable references for record and objects)
  1943. local switch for refs to args and local of each function
  1944. (static symtable still missing)
  1945. UseBrowser still not stable and probably broken by
  1946. the definition hash array !!
  1947. Revision 1.44 1998/09/18 16:03:47 florian
  1948. * some changes to compile with Delphi
  1949. Revision 1.43 1998/09/18 08:01:38 pierre
  1950. + improvement on the usebrowser part
  1951. (does not work correctly for now)
  1952. Revision 1.42 1998/09/07 19:33:25 florian
  1953. + some stuff for property rtti added:
  1954. - NameIndex of the TPropInfo record is now written correctly
  1955. - the DEFAULT/NODEFAULT keyword is supported now
  1956. - the default value and the storedsym/def are now written to
  1957. the PPU fiel
  1958. Revision 1.41 1998/09/07 18:46:12 peter
  1959. * update smartlinking, uses getdatalabel
  1960. * renamed ptree.value vars to value_str,value_real,value_set
  1961. Revision 1.40 1998/09/07 17:37:04 florian
  1962. * first fixes for published properties
  1963. Revision 1.39 1998/09/05 22:11:02 florian
  1964. + switch -vb
  1965. * while/repeat loops accept now also word/longbool conditions
  1966. * makebooltojump did an invalid ungetregister32, fixed
  1967. Revision 1.38 1998/09/01 12:53:26 peter
  1968. + aktpackenum
  1969. Revision 1.37 1998/09/01 07:54:25 pierre
  1970. * UseBrowser a little updated (might still be buggy !!)
  1971. * bug in psub.pas in function specifier removed
  1972. * stdcall allowed in interface and in implementation
  1973. (FPC will not yet complain if it is missing in either part
  1974. because stdcall is only a dummy !!)
  1975. Revision 1.36 1998/08/25 13:09:26 pierre
  1976. * corrected mangling sheme :
  1977. cvar add Cprefix to the mixed case name whereas
  1978. export or public use direct name
  1979. Revision 1.35 1998/08/25 12:42:46 pierre
  1980. * CDECL changed to CVAR for variables
  1981. specifications are read in structures also
  1982. + started adding GPC compatibility mode ( option -Sp)
  1983. * names changed to lowercase
  1984. Revision 1.34 1998/08/21 14:08:53 pierre
  1985. + TEST_FUNCRET now default (old code removed)
  1986. works also for m68k (at least compiles)
  1987. Revision 1.33 1998/08/20 12:53:27 peter
  1988. * object_options are always written for object syms
  1989. Revision 1.32 1998/08/20 09:26:46 pierre
  1990. + funcret setting in underproc testing
  1991. compile with _dTEST_FUNCRET
  1992. Revision 1.31 1998/08/17 10:10:12 peter
  1993. - removed OLDPPU
  1994. Revision 1.30 1998/08/13 10:57:29 peter
  1995. * constant sets are now written correctly to the ppufile
  1996. Revision 1.29 1998/08/11 15:31:42 peter
  1997. * write extended to ppu file
  1998. * new version 0.99.7
  1999. Revision 1.28 1998/08/11 14:07:27 peter
  2000. * fixed pushing of high value for openarray
  2001. Revision 1.27 1998/08/10 14:50:31 peter
  2002. + localswitches, moduleswitches, globalswitches splitting
  2003. Revision 1.26 1998/08/10 10:18:35 peter
  2004. + Compiler,Comphook unit which are the new interface units to the
  2005. compiler
  2006. Revision 1.25 1998/07/30 11:18:19 florian
  2007. + first implementation of try ... except on .. do end;
  2008. * limitiation of 65535 bytes parameters for cdecl removed
  2009. Revision 1.24 1998/07/20 18:40:16 florian
  2010. * handling of ansi string constants should now work
  2011. Revision 1.23 1998/07/14 21:37:24 peter
  2012. * fixed packrecords as discussed at the alias
  2013. Revision 1.22 1998/07/14 14:47:08 peter
  2014. * released NEWINPUT
  2015. Revision 1.21 1998/07/13 21:17:38 florian
  2016. * changed to compile with TP
  2017. Revision 1.20 1998/07/10 00:00:05 peter
  2018. * fixed ttypesym bug finally
  2019. * fileinfo in the symtable and better using for unused vars
  2020. Revision 1.19 1998/07/07 17:40:39 peter
  2021. * packrecords 4 works
  2022. * word aligning of parameters
  2023. Revision 1.18 1998/07/07 11:20:15 peter
  2024. + NEWINPUT for a better inputfile and scanner object
  2025. Revision 1.17 1998/06/24 14:48:40 peter
  2026. * ifdef newppu -> ifndef oldppu
  2027. Revision 1.16 1998/06/19 15:40:42 peter
  2028. * removed cosntructor/constructor warning and 0.99.5 recompiles it again
  2029. Revision 1.15 1998/06/17 14:10:18 peter
  2030. * small os2 fixes
  2031. * fixed interdependent units with newppu (remake3 under linux works now)
  2032. Revision 1.14 1998/06/16 08:56:34 peter
  2033. + targetcpu
  2034. * cleaner pmodules for newppu
  2035. Revision 1.13 1998/06/15 15:38:10 pierre
  2036. * small bug in systems.pas corrected
  2037. + operators in different units better hanlded
  2038. Revision 1.12 1998/06/15 14:23:44 daniel
  2039. * Reverted my changes.
  2040. Revision 1.10 1998/06/13 00:10:18 peter
  2041. * working browser and newppu
  2042. * some small fixes against crashes which occured in bp7 (but not in
  2043. fpc?!)
  2044. Revision 1.9 1998/06/12 16:15:35 pierre
  2045. * external name 'C_var';
  2046. export name 'intern_C_var';
  2047. cdecl;
  2048. cdecl;external;
  2049. are now supported only with -Sv switch
  2050. Revision 1.8 1998/06/11 10:11:59 peter
  2051. * -gb works again
  2052. Revision 1.7 1998/06/09 16:01:51 pierre
  2053. + added procedure directive parsing for procvars
  2054. (accepted are popstack cdecl and pascal)
  2055. + added C vars with the following syntax
  2056. var C calias 'true_c_name';(can be followed by external)
  2057. reason is that you must add the Cprefix
  2058. which is target dependent
  2059. Revision 1.6 1998/06/08 22:59:53 peter
  2060. * smartlinking works for win32
  2061. * some defines to exclude some compiler parts
  2062. Revision 1.5 1998/06/04 23:52:02 peter
  2063. * m68k compiles
  2064. + .def file creation moved to gendef.pas so it could also be used
  2065. for win32
  2066. Revision 1.4 1998/06/04 09:55:46 pierre
  2067. * demangled name of procsym reworked to become independant of the mangling scheme
  2068. Revision 1.3 1998/06/03 22:14:20 florian
  2069. * problem with sizes of classes fixed (if the anchestor was declared
  2070. forward, the compiler doesn't update the child classes size)
  2071. Revision 1.2 1998/05/28 14:40:29 peter
  2072. * fixes for newppu, remake3 works now with it
  2073. Revision 1.1 1998/05/27 19:45:09 peter
  2074. * symtable.pas splitted into includefiles
  2075. * symtable adapted for $ifndef OLDPPU
  2076. }