fmodule.pas 34 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029
  1. {
  2. Copyright (c) 1998-2002 by Florian Klaempfl
  3. This unit implements the first loading and searching of the modules
  4. This program is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 2 of the License, or
  7. (at your option) any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software
  14. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  15. ****************************************************************************
  16. }
  17. unit fmodule;
  18. {$i fpcdefs.inc}
  19. {$ifdef go32v2}
  20. {$define shortasmprefix}
  21. {$endif}
  22. {$ifdef watcom}
  23. {$define shortasmprefix}
  24. {$endif}
  25. {$ifdef tos}
  26. {$define shortasmprefix}
  27. {$endif}
  28. {$ifdef OS2}
  29. { Allthough OS/2 supports long filenames I play it safe and
  30. use 8.3 filenames, because this allows the compiler to run
  31. on a FAT partition. (DM) }
  32. {$define shortasmprefix}
  33. {$endif}
  34. interface
  35. uses
  36. cutils,cclasses,cfileutl,
  37. globtype,finput,ogbase,
  38. symbase,symsym,
  39. wpobase,
  40. aasmbase,aasmtai,aasmdata;
  41. const
  42. UNSPECIFIED_LIBRARY_NAME = '<none>';
  43. type
  44. trecompile_reason = (rr_unknown,
  45. rr_noppu,rr_sourcenewer,rr_build,rr_crcchanged
  46. );
  47. { unit options }
  48. tmoduleoption = (mo_none,
  49. mo_hint_deprecated,
  50. mo_hint_platform,
  51. mo_hint_library,
  52. mo_hint_unimplemented,
  53. mo_hint_experimental,
  54. mo_has_deprecated_msg
  55. );
  56. tmoduleoptions = set of tmoduleoption;
  57. tlinkcontaineritem=class(tlinkedlistitem)
  58. public
  59. data : TPathStr;
  60. needlink : cardinal;
  61. constructor Create(const s:TPathStr;m:cardinal);
  62. end;
  63. tlinkcontainer=class(tlinkedlist)
  64. procedure add(const s : TPathStr;m:cardinal);
  65. function get(var m:cardinal) : TPathStr;
  66. function getusemask(mask:cardinal) : TPathStr;
  67. function find(const s:TPathStr):boolean;
  68. end;
  69. tmodule = class;
  70. tused_unit = class;
  71. tunitmaprec = record
  72. u : tmodule;
  73. { number of references }
  74. refs : longint;
  75. { index in the derefmap }
  76. derefidx : longint;
  77. end;
  78. punitmap = ^tunitmaprec;
  79. tderefmaprec = record
  80. u : tmodule;
  81. { modulename, used during ppu load }
  82. modulename : pshortstring;
  83. end;
  84. pderefmap = ^tderefmaprec;
  85. { tmodule }
  86. tmodule = class(tmodulebase)
  87. private
  88. FImportLibraryList : TFPHashObjectList;
  89. public
  90. do_reload, { force reloading of the unit }
  91. do_compile, { need to compile the sources }
  92. sources_avail, { if all sources are reachable }
  93. interface_compiled, { if the interface section has been parsed/compiled/loaded }
  94. is_dbginfo_written,
  95. is_unit,
  96. in_interface, { processing the implementation part? }
  97. { allow global settings }
  98. in_global : boolean;
  99. { Whether a mode switch is still allowed at this point in the parsing.}
  100. mode_switch_allowed,
  101. { generate pic helper which loads eip in ecx (for leave procedures) }
  102. requires_ecx_pic_helper,
  103. { generate pic helper which loads eip in ebx (for non leave procedures) }
  104. requires_ebx_pic_helper : boolean;
  105. interface_only: boolean; { interface-only macpas unit; flag does not need saving/restoring to ppu }
  106. mainfilepos : tfileposinfo;
  107. recompile_reason : trecompile_reason; { the reason why the unit should be recompiled }
  108. crc,
  109. interface_crc,
  110. indirect_crc : cardinal;
  111. flags : cardinal; { the PPU flags }
  112. islibrary : boolean; { if it is a library (win32 dll) }
  113. IsPackage : boolean;
  114. moduleid : longint;
  115. unitmap : punitmap; { mapping of all used units }
  116. unitmapsize : longint; { number of units in the map }
  117. derefmap : pderefmap; { mapping of all units needed for deref }
  118. derefmapcnt : longint; { number of units in the map }
  119. derefmapsize : longint; { number of units in the map }
  120. derefdataintflen : longint;
  121. derefdata : tdynamicarray;
  122. checkforwarddefs,
  123. deflist,
  124. symlist : TFPObjectList;
  125. ptrdefs : THashSet; { list of pointerdefs created in this module so we can reuse them (not saved/restored) }
  126. arraydefs : THashSet; { list of single-element-arraydefs created in this module so we can reuse them (not saved/restored) }
  127. ansistrdef : tobject; { an ansistring def redefined for the current module }
  128. wpoinfo : tunitwpoinfobase; { whole program optimization-related information that is generated during the current run for this unit }
  129. globalsymtable, { pointer to the global symtable of this unit }
  130. localsymtable : TSymtable;{ pointer to the local symtable of this unit }
  131. globalmacrosymtable, { pointer to the global macro symtable of this unit }
  132. localmacrosymtable : TSymtable;{ pointer to the local macro symtable of this unit }
  133. scanner : TObject; { scanner object used }
  134. procinfo : TObject; { current procedure being compiled }
  135. asmdata : TObject; { Assembler data }
  136. asmprefix : pshortstring; { prefix for the smartlink asmfiles }
  137. debuginfo : TObject;
  138. loaded_from : tmodule;
  139. _exports : tlinkedlist;
  140. dllscannerinputlist : TFPHashList;
  141. resourcefiles : TCmdStrList;
  142. linkunitofiles,
  143. linkunitstaticlibs,
  144. linkunitsharedlibs,
  145. linkotherofiles, { objects,libs loaded from the source }
  146. linkothersharedlibs, { using $L or $LINKLIB or import lib (for linux) }
  147. linkotherstaticlibs,
  148. linkotherframeworks : tlinkcontainer;
  149. mainname : pshortstring; { alternate name for "main" procedure }
  150. used_units : tlinkedlist;
  151. dependent_units : tlinkedlist;
  152. localunitsearchpath, { local searchpaths }
  153. localobjectsearchpath,
  154. localincludesearchpath,
  155. locallibrarysearchpath,
  156. localframeworksearchpath : TSearchPathList;
  157. moduleoptions: tmoduleoptions;
  158. deprecatedmsg: pshortstring;
  159. { contains a reference to the TUnitInfo rtti information for this module }
  160. extrttiinfo : TAsmSymbol;
  161. { contains a list of types that are extended by helper types; the key is
  162. the full name of the type and the data is a TFPObjectList of
  163. tobjectdef instances (the helper defs) }
  164. extendeddefs: TFPHashObjectList;
  165. namespace: pshortstring; { for JVM target: corresponds to Java package name }
  166. { for targets that initialise typed constants via explicit assignments
  167. instead of by generating an initialised data section (holds typed
  168. constant assignments at the module level; does not have to be saved
  169. into the ppu file, because translated into code during compilation)
  170. -- actual type: tnode (but fmodule should not depend on node) }
  171. tcinitcode : tobject;
  172. {create creates a new module which name is stored in 's'. LoadedFrom
  173. points to the module calling it. It is nil for the first compiled
  174. module. This allow inheritence of all path lists. MUST pay attention
  175. to that when creating link.res!!!!(mazen)}
  176. constructor create(LoadedFrom:TModule;const amodulename: string; const afilename:TPathStr;_is_unit:boolean);
  177. destructor destroy;override;
  178. procedure reset;virtual;
  179. procedure adddependency(callermodule:tmodule);
  180. procedure flagdependent(callermodule:tmodule);
  181. function addusedunit(hp:tmodule;inuses:boolean;usym:tunitsym):tused_unit;
  182. procedure updatemaps;
  183. procedure check_hints;
  184. function derefidx_unit(id:longint):longint;
  185. function resolve_unit(id:longint):tmodule;
  186. procedure allunitsused;
  187. procedure setmodulename(const s:string);
  188. procedure AddExternalImport(const libname,symname,symmangledname:string;OrdNr: longint;isvar:boolean;ImportByOrdinalOnly:boolean);
  189. property ImportLibraryList : TFPHashObjectList read FImportLibraryList;
  190. end;
  191. tused_unit = class(tlinkedlistitem)
  192. checksum,
  193. interface_checksum,
  194. indirect_checksum: cardinal;
  195. in_uses,
  196. in_interface : boolean;
  197. u : tmodule;
  198. unitsym : tunitsym;
  199. constructor create(_u : tmodule;intface,inuses:boolean;usym:tunitsym);
  200. end;
  201. tdependent_unit = class(tlinkedlistitem)
  202. u : tmodule;
  203. constructor create(_u : tmodule);
  204. end;
  205. var
  206. main_module : tmodule; { Main module of the program }
  207. current_module : tmodule; { Current module which is compiled or loaded }
  208. compiled_module : tmodule; { Current module which is compiled }
  209. usedunits : tlinkedlist; { Used units for this program }
  210. loaded_units : tlinkedlist; { All loaded units }
  211. unloaded_units : tlinkedlist; { Units removed from loaded_units, to be freed }
  212. SmartLinkOFiles : TCmdStrList; { List of .o files which are generated,
  213. used to delete them after linking }
  214. procedure set_current_module(p:tmodule);
  215. function get_module(moduleindex : longint) : tmodule;
  216. function get_source_file(moduleindex,fileindex : longint) : tinputfile;
  217. procedure addloadedunit(hp:tmodule);
  218. function find_module_from_symtable(st:tsymtable):tmodule;
  219. implementation
  220. uses
  221. SysUtils,globals,
  222. verbose,systems,
  223. scanner,ppu,dbgbase,
  224. procinfo,symdef;
  225. {$ifdef MEMDEBUG}
  226. var
  227. memsymtable : TMemDebug;
  228. {$endif}
  229. {*****************************************************************************
  230. Global Functions
  231. *****************************************************************************}
  232. function find_module_from_symtable(st:tsymtable):tmodule;
  233. var
  234. hp : tmodule;
  235. begin
  236. result:=nil;
  237. hp:=tmodule(loaded_units.first);
  238. while assigned(hp) do
  239. begin
  240. if (hp.moduleid=st.moduleid) then
  241. begin
  242. result:=hp;
  243. exit;
  244. end;
  245. hp:=tmodule(hp.next);
  246. end;
  247. end;
  248. procedure set_current_module(p:tmodule);
  249. begin
  250. { save the state of the scanner }
  251. if assigned(current_scanner) then
  252. current_scanner.tempcloseinputfile;
  253. { set new module }
  254. current_module:=p;
  255. { restore previous module settings }
  256. Fillchar(current_filepos,0,sizeof(current_filepos));
  257. if assigned(current_module) then
  258. begin
  259. current_asmdata:=tasmdata(current_module.asmdata);
  260. current_debuginfo:=tdebuginfo(current_module.debuginfo);
  261. { restore scanner and file positions }
  262. current_scanner:=tscannerfile(current_module.scanner);
  263. if assigned(current_scanner) then
  264. begin
  265. current_scanner.tempopeninputfile;
  266. current_scanner.gettokenpos;
  267. parser_current_file:=current_scanner.inputfile.name;
  268. end
  269. else
  270. begin
  271. current_filepos.moduleindex:=current_module.unit_index;
  272. parser_current_file:='';
  273. end;
  274. end
  275. else
  276. begin
  277. current_asmdata:=nil;
  278. current_scanner:=nil;
  279. current_debuginfo:=nil;
  280. end;
  281. end;
  282. function get_module(moduleindex : longint) : tmodule;
  283. var
  284. hp : tmodule;
  285. begin
  286. result:=nil;
  287. if moduleindex=0 then
  288. exit;
  289. result:=current_module;
  290. if not(assigned(loaded_units)) then
  291. exit;
  292. hp:=tmodule(loaded_units.first);
  293. while assigned(hp) and (hp.unit_index<>moduleindex) do
  294. hp:=tmodule(hp.next);
  295. result:=hp;
  296. end;
  297. function get_source_file(moduleindex,fileindex : longint) : tinputfile;
  298. var
  299. hp : tmodule;
  300. begin
  301. hp:=get_module(moduleindex);
  302. if assigned(hp) then
  303. get_source_file:=hp.sourcefiles.get_file(fileindex)
  304. else
  305. get_source_file:=nil;
  306. end;
  307. procedure addloadedunit(hp:tmodule);
  308. begin
  309. hp.moduleid:=loaded_units.count;
  310. loaded_units.concat(hp);
  311. end;
  312. {****************************************************************************
  313. TLinkContainerItem
  314. ****************************************************************************}
  315. constructor TLinkContainerItem.Create(const s:TPathStr;m:cardinal);
  316. begin
  317. inherited Create;
  318. data:=s;
  319. needlink:=m;
  320. end;
  321. {****************************************************************************
  322. TLinkContainer
  323. ****************************************************************************}
  324. procedure TLinkContainer.add(const s : TPathStr;m:cardinal);
  325. begin
  326. inherited concat(TLinkContainerItem.Create(s,m));
  327. end;
  328. function TLinkContainer.get(var m:cardinal) : TPathStr;
  329. var
  330. p : tlinkcontaineritem;
  331. begin
  332. p:=tlinkcontaineritem(inherited getfirst);
  333. if p=nil then
  334. begin
  335. get:='';
  336. m:=0;
  337. end
  338. else
  339. begin
  340. get:=p.data;
  341. m:=p.needlink;
  342. p.free;
  343. end;
  344. end;
  345. function TLinkContainer.getusemask(mask:cardinal) : TPathStr;
  346. var
  347. p : tlinkcontaineritem;
  348. found : boolean;
  349. begin
  350. found:=false;
  351. repeat
  352. p:=tlinkcontaineritem(inherited getfirst);
  353. if p=nil then
  354. begin
  355. getusemask:='';
  356. exit;
  357. end;
  358. getusemask:=p.data;
  359. found:=(p.needlink and mask)<>0;
  360. p.free;
  361. until found;
  362. end;
  363. function TLinkContainer.find(const s:TPathStr):boolean;
  364. var
  365. newnode : tlinkcontaineritem;
  366. begin
  367. find:=false;
  368. newnode:=tlinkcontaineritem(First);
  369. while assigned(newnode) do
  370. begin
  371. if newnode.data=s then
  372. begin
  373. find:=true;
  374. exit;
  375. end;
  376. newnode:=tlinkcontaineritem(newnode.next);
  377. end;
  378. end;
  379. {****************************************************************************
  380. TUSED_UNIT
  381. ****************************************************************************}
  382. constructor tused_unit.create(_u : tmodule;intface,inuses:boolean;usym:tunitsym);
  383. begin
  384. u:=_u;
  385. in_interface:=intface;
  386. in_uses:=inuses;
  387. unitsym:=usym;
  388. if _u.state=ms_compiled then
  389. begin
  390. checksum:=u.crc;
  391. interface_checksum:=u.interface_crc;
  392. indirect_checksum:=u.indirect_crc;
  393. end
  394. else
  395. begin
  396. checksum:=0;
  397. interface_checksum:=0;
  398. indirect_checksum:=0;
  399. end;
  400. end;
  401. {****************************************************************************
  402. TDENPENDENT_UNIT
  403. ****************************************************************************}
  404. constructor tdependent_unit.create(_u : tmodule);
  405. begin
  406. u:=_u;
  407. end;
  408. {****************************************************************************
  409. TMODULE
  410. ****************************************************************************}
  411. constructor tmodule.create(LoadedFrom:TModule;const amodulename: string; const afilename:TPathStr;_is_unit:boolean);
  412. var
  413. n:string;
  414. fn:TPathStr;
  415. begin
  416. if amodulename='' then
  417. n:=ChangeFileExt(ExtractFileName(afilename),'')
  418. else
  419. n:=amodulename;
  420. if afilename='' then
  421. fn:=amodulename
  422. else
  423. fn:=afilename;
  424. { Programs have the name 'Program' to don't conflict with dup id's }
  425. if _is_unit then
  426. inherited create(amodulename)
  427. else
  428. inherited create('Program');
  429. mainsource:=fn;
  430. { Dos has the famous 8.3 limit :( }
  431. {$ifdef shortasmprefix}
  432. asmprefix:=stringdup(FixFileName('as'));
  433. {$else}
  434. asmprefix:=stringdup(FixFileName(n));
  435. {$endif}
  436. setfilename(fn,true);
  437. localunitsearchpath:=TSearchPathList.Create;
  438. localobjectsearchpath:=TSearchPathList.Create;
  439. localincludesearchpath:=TSearchPathList.Create;
  440. locallibrarysearchpath:=TSearchPathList.Create;
  441. localframeworksearchpath:=TSearchPathList.Create;
  442. used_units:=TLinkedList.Create;
  443. dependent_units:=TLinkedList.Create;
  444. resourcefiles:=TCmdStrList.Create;
  445. linkunitofiles:=TLinkContainer.Create;
  446. linkunitstaticlibs:=TLinkContainer.Create;
  447. linkunitsharedlibs:=TLinkContainer.Create;
  448. linkotherofiles:=TLinkContainer.Create;
  449. linkotherstaticlibs:=TLinkContainer.Create;
  450. linkothersharedlibs:=TLinkContainer.Create;
  451. linkotherframeworks:=TLinkContainer.Create;
  452. mainname:=nil;
  453. FImportLibraryList:=TFPHashObjectList.Create(true);
  454. crc:=0;
  455. interface_crc:=0;
  456. indirect_crc:=0;
  457. flags:=0;
  458. scanner:=nil;
  459. unitmap:=nil;
  460. unitmapsize:=0;
  461. derefmap:=nil;
  462. derefmapsize:=0;
  463. derefmapcnt:=0;
  464. derefdata:=TDynamicArray.Create(1024);
  465. derefdataintflen:=0;
  466. deflist:=TFPObjectList.Create(false);
  467. symlist:=TFPObjectList.Create(false);
  468. ptrdefs:=THashSet.Create(64,true,false);
  469. arraydefs:=THashSet.Create(64,true,false);
  470. ansistrdef:=nil;
  471. wpoinfo:=nil;
  472. checkforwarddefs:=TFPObjectList.Create(false);
  473. extendeddefs := TFPHashObjectList.Create(true);
  474. globalsymtable:=nil;
  475. localsymtable:=nil;
  476. globalmacrosymtable:=nil;
  477. localmacrosymtable:=nil;
  478. loaded_from:=LoadedFrom;
  479. do_reload:=false;
  480. do_compile:=false;
  481. sources_avail:=true;
  482. mainfilepos.line:=0;
  483. mainfilepos.column:=0;
  484. mainfilepos.fileindex:=0;
  485. recompile_reason:=rr_unknown;
  486. in_interface:=true;
  487. in_global:=true;
  488. is_unit:=_is_unit;
  489. islibrary:=false;
  490. ispackage:=false;
  491. is_dbginfo_written:=false;
  492. mode_switch_allowed:= true;
  493. moduleoptions:=[];
  494. deprecatedmsg:=nil;
  495. namespace:=nil;
  496. tcinitcode:=nil;
  497. extrttiinfo:=nil;
  498. _exports:=TLinkedList.Create;
  499. dllscannerinputlist:=TFPHashList.Create;
  500. asmdata:=casmdata.create(realmodulename^);
  501. InitDebugInfo(self,false);
  502. end;
  503. destructor tmodule.Destroy;
  504. var
  505. i : longint;
  506. current_debuginfo_reset : boolean;
  507. begin
  508. if assigned(unitmap) then
  509. freemem(unitmap);
  510. if assigned(derefmap) then
  511. begin
  512. for i:=0 to derefmapcnt-1 do
  513. stringdispose(derefmap[i].modulename);
  514. freemem(derefmap);
  515. end;
  516. if assigned(_exports) then
  517. _exports.free;
  518. if assigned(dllscannerinputlist) then
  519. dllscannerinputlist.free;
  520. if assigned(scanner) then
  521. begin
  522. { also update current_scanner if it was pointing
  523. to this module }
  524. if current_scanner=tscannerfile(scanner) then
  525. current_scanner:=nil;
  526. tscannerfile(scanner).free;
  527. end;
  528. if assigned(asmdata) then
  529. begin
  530. if current_asmdata=asmdata then
  531. current_asmdata:=nil;
  532. asmdata.free;
  533. end;
  534. if assigned(procinfo) then
  535. begin
  536. if current_procinfo=tprocinfo(procinfo) then
  537. begin
  538. current_procinfo:=nil;
  539. current_structdef:=nil;
  540. current_genericdef:=nil;
  541. current_specializedef:=nil;
  542. end;
  543. { release procinfo tree }
  544. tprocinfo(procinfo).destroy_tree;
  545. end;
  546. DoneDebugInfo(self,current_debuginfo_reset);
  547. used_units.free;
  548. dependent_units.free;
  549. resourcefiles.Free;
  550. linkunitofiles.Free;
  551. linkunitstaticlibs.Free;
  552. linkunitsharedlibs.Free;
  553. linkotherofiles.Free;
  554. linkotherstaticlibs.Free;
  555. linkothersharedlibs.Free;
  556. linkotherframeworks.Free;
  557. stringdispose(mainname);
  558. FImportLibraryList.Free;
  559. extendeddefs.Free;
  560. stringdispose(asmprefix);
  561. stringdispose(deprecatedmsg);
  562. stringdispose(namespace);
  563. tcinitcode.free;
  564. localunitsearchpath.Free;
  565. localobjectsearchpath.free;
  566. localincludesearchpath.free;
  567. locallibrarysearchpath.free;
  568. localframeworksearchpath.free;
  569. {$ifdef MEMDEBUG}
  570. memsymtable.start;
  571. {$endif}
  572. derefdata.free;
  573. deflist.free;
  574. symlist.free;
  575. ptrdefs.free;
  576. arraydefs.free;
  577. ansistrdef:=nil;
  578. wpoinfo.free;
  579. checkforwarddefs.free;
  580. globalsymtable.free;
  581. localsymtable.free;
  582. globalmacrosymtable.free;
  583. localmacrosymtable.free;
  584. {$ifdef MEMDEBUG}
  585. memsymtable.stop;
  586. {$endif}
  587. inherited Destroy;
  588. end;
  589. procedure tmodule.reset;
  590. var
  591. i : longint;
  592. current_debuginfo_reset : boolean;
  593. begin
  594. if assigned(scanner) then
  595. begin
  596. { also update current_scanner if it was pointing
  597. to this module }
  598. if current_scanner=tscannerfile(scanner) then
  599. current_scanner:=nil;
  600. tscannerfile(scanner).free;
  601. scanner:=nil;
  602. end;
  603. if assigned(procinfo) then
  604. begin
  605. if current_procinfo=tprocinfo(procinfo) then
  606. begin
  607. current_procinfo:=nil;
  608. current_structdef:=nil;
  609. current_genericdef:=nil;
  610. current_specializedef:=nil;
  611. end;
  612. { release procinfo tree }
  613. tprocinfo(procinfo).destroy_tree;
  614. end;
  615. if assigned(asmdata) then
  616. begin
  617. if current_asmdata=asmdata then
  618. current_asmdata:=nil;
  619. asmdata.free;
  620. asmdata:=nil;
  621. end;
  622. DoneDebugInfo(self,current_debuginfo_reset);
  623. globalsymtable.free;
  624. globalsymtable:=nil;
  625. localsymtable.free;
  626. localsymtable:=nil;
  627. globalmacrosymtable.free;
  628. globalmacrosymtable:=nil;
  629. localmacrosymtable.free;
  630. localmacrosymtable:=nil;
  631. deflist.free;
  632. deflist:=TFPObjectList.Create(false);
  633. symlist.free;
  634. symlist:=TFPObjectList.Create(false);
  635. ptrdefs.free;
  636. ptrdefs:=THashSet.Create(64,true,false);
  637. arraydefs.free;
  638. arraydefs:=THashSet.Create(64,true,false);
  639. wpoinfo.free;
  640. wpoinfo:=nil;
  641. checkforwarddefs.free;
  642. checkforwarddefs:=TFPObjectList.Create(false);
  643. derefdata.free;
  644. derefdata:=TDynamicArray.Create(1024);
  645. if assigned(unitmap) then
  646. begin
  647. freemem(unitmap);
  648. unitmap:=nil;
  649. end;
  650. if assigned(derefmap) then
  651. begin
  652. for i:=0 to derefmapcnt-1 do
  653. stringdispose(derefmap[i].modulename);
  654. freemem(derefmap);
  655. derefmap:=nil;
  656. end;
  657. unitmapsize:=0;
  658. derefmapsize:=0;
  659. derefmapcnt:=0;
  660. derefdataintflen:=0;
  661. sourcefiles.free;
  662. sourcefiles:=tinputfilemanager.create;
  663. asmdata:=casmdata.create(realmodulename^);
  664. InitDebugInfo(self,current_debuginfo_reset);
  665. _exports.free;
  666. _exports:=tlinkedlist.create;
  667. dllscannerinputlist.free;
  668. dllscannerinputlist:=TFPHashList.create;
  669. used_units.free;
  670. used_units:=TLinkedList.Create;
  671. dependent_units.free;
  672. dependent_units:=TLinkedList.Create;
  673. resourcefiles.Free;
  674. resourcefiles:=TCmdStrList.Create;
  675. linkunitofiles.Free;
  676. linkunitofiles:=TLinkContainer.Create;
  677. linkunitstaticlibs.Free;
  678. linkunitstaticlibs:=TLinkContainer.Create;
  679. linkunitsharedlibs.Free;
  680. linkunitsharedlibs:=TLinkContainer.Create;
  681. linkotherofiles.Free;
  682. linkotherofiles:=TLinkContainer.Create;
  683. linkotherstaticlibs.Free;
  684. linkotherstaticlibs:=TLinkContainer.Create;
  685. linkothersharedlibs.Free;
  686. linkothersharedlibs:=TLinkContainer.Create;
  687. linkotherframeworks.Free;
  688. linkotherframeworks:=TLinkContainer.Create;
  689. stringdispose(mainname);
  690. FImportLibraryList.Free;
  691. FImportLibraryList:=TFPHashObjectList.Create;
  692. do_compile:=false;
  693. do_reload:=false;
  694. interface_compiled:=false;
  695. in_interface:=true;
  696. in_global:=true;
  697. mode_switch_allowed:=true;
  698. stringdispose(deprecatedmsg);
  699. stringdispose(namespace);
  700. tcinitcode.free;
  701. tcinitcode:=nil;
  702. moduleoptions:=[];
  703. is_dbginfo_written:=false;
  704. crc:=0;
  705. interface_crc:=0;
  706. indirect_crc:=0;
  707. flags:=0;
  708. mainfilepos.line:=0;
  709. mainfilepos.column:=0;
  710. mainfilepos.fileindex:=0;
  711. recompile_reason:=rr_unknown;
  712. {
  713. The following fields should not
  714. be reset:
  715. mainsource
  716. state
  717. loaded_from
  718. sources_avail
  719. }
  720. end;
  721. procedure tmodule.adddependency(callermodule:tmodule);
  722. begin
  723. { This is not needed for programs }
  724. if not callermodule.is_unit then
  725. exit;
  726. Message2(unit_u_add_depend_to,callermodule.modulename^,modulename^);
  727. dependent_units.concat(tdependent_unit.create(callermodule));
  728. end;
  729. procedure tmodule.flagdependent(callermodule:tmodule);
  730. var
  731. pm : tdependent_unit;
  732. begin
  733. { flag all units that depend on this unit for reloading }
  734. pm:=tdependent_unit(current_module.dependent_units.first);
  735. while assigned(pm) do
  736. begin
  737. { We do not have to reload the unit that wants to load
  738. this unit, unless this unit is already compiled during
  739. the loading }
  740. if (pm.u=callermodule) and
  741. (pm.u.state<>ms_compiled) then
  742. Message1(unit_u_no_reload_is_caller,pm.u.modulename^)
  743. else
  744. if pm.u.state=ms_second_compile then
  745. Message1(unit_u_no_reload_in_second_compile,pm.u.modulename^)
  746. else
  747. begin
  748. pm.u.do_reload:=true;
  749. Message1(unit_u_flag_for_reload,pm.u.modulename^);
  750. end;
  751. pm:=tdependent_unit(pm.next);
  752. end;
  753. end;
  754. function tmodule.addusedunit(hp:tmodule;inuses:boolean;usym:tunitsym):tused_unit;
  755. var
  756. pu : tused_unit;
  757. begin
  758. pu:=tused_unit.create(hp,in_interface,inuses,usym);
  759. used_units.concat(pu);
  760. addusedunit:=pu;
  761. end;
  762. procedure tmodule.updatemaps;
  763. var
  764. oldmapsize : longint;
  765. hp : tmodule;
  766. i : longint;
  767. begin
  768. { Extend unitmap }
  769. oldmapsize:=unitmapsize;
  770. unitmapsize:=loaded_units.count;
  771. reallocmem(unitmap,unitmapsize*sizeof(tunitmaprec));
  772. fillchar(unitmap[oldmapsize],(unitmapsize-oldmapsize)*sizeof(tunitmaprec),0);
  773. { Extend Derefmap }
  774. oldmapsize:=derefmapsize;
  775. derefmapsize:=loaded_units.count;
  776. reallocmem(derefmap,derefmapsize*sizeof(tderefmaprec));
  777. fillchar(derefmap[oldmapsize],(derefmapsize-oldmapsize)*sizeof(tderefmaprec),0);
  778. { Add all units to unitmap }
  779. hp:=tmodule(loaded_units.first);
  780. i:=0;
  781. while assigned(hp) do
  782. begin
  783. if hp.moduleid>=unitmapsize then
  784. internalerror(200501151);
  785. { Verify old entries }
  786. if (i<oldmapsize) then
  787. begin
  788. if (hp.moduleid<>i) or
  789. (unitmap[hp.moduleid].u<>hp) then
  790. internalerror(200501156);
  791. end
  792. else
  793. begin
  794. unitmap[hp.moduleid].u:=hp;
  795. unitmap[hp.moduleid].derefidx:=-1;
  796. end;
  797. inc(i);
  798. hp:=tmodule(hp.next);
  799. end;
  800. end;
  801. procedure tmodule.check_hints;
  802. begin
  803. if mo_hint_deprecated in moduleoptions then
  804. if (mo_has_deprecated_msg in moduleoptions) and (deprecatedmsg <> nil) then
  805. Message2(sym_w_deprecated_unit_with_msg,realmodulename^,deprecatedmsg^)
  806. else
  807. Message1(sym_w_deprecated_unit,realmodulename^);
  808. if mo_hint_experimental in moduleoptions then
  809. Message1(sym_w_experimental_unit,realmodulename^);
  810. if mo_hint_platform in moduleoptions then
  811. Message1(sym_w_non_portable_unit,realmodulename^);
  812. if mo_hint_library in moduleoptions then
  813. Message1(sym_w_library_unit,realmodulename^);
  814. if mo_hint_unimplemented in moduleoptions then
  815. Message1(sym_w_non_implemented_unit,realmodulename^);
  816. end;
  817. function tmodule.derefidx_unit(id:longint):longint;
  818. begin
  819. if id>=unitmapsize then
  820. internalerror(2005011511);
  821. if unitmap[id].derefidx=-1 then
  822. begin
  823. unitmap[id].derefidx:=derefmapcnt;
  824. inc(derefmapcnt);
  825. derefmap[unitmap[id].derefidx].u:=unitmap[id].u;
  826. end;
  827. if unitmap[id].derefidx>=derefmapsize then
  828. internalerror(2005011514);
  829. result:=unitmap[id].derefidx;
  830. end;
  831. function tmodule.resolve_unit(id:longint):tmodule;
  832. var
  833. hp : tmodule;
  834. begin
  835. if id>=derefmapsize then
  836. internalerror(200306231);
  837. result:=derefmap[id].u;
  838. if not assigned(result) then
  839. begin
  840. if not assigned(derefmap[id].modulename) or
  841. (derefmap[id].modulename^='') then
  842. internalerror(200501159);
  843. hp:=tmodule(loaded_units.first);
  844. while assigned(hp) do
  845. begin
  846. { only check for units. The main program is also
  847. as a unit in the loaded_units list. We simply need
  848. to ignore this entry (PFV) }
  849. if hp.is_unit and
  850. (hp.modulename^=derefmap[id].modulename^) then
  851. break;
  852. hp:=tmodule(hp.next);
  853. end;
  854. if not assigned(hp) then
  855. internalerror(2005011510);
  856. derefmap[id].u:=hp;
  857. result:=hp;
  858. end;
  859. end;
  860. procedure tmodule.allunitsused;
  861. var
  862. pu : tused_unit;
  863. begin
  864. pu:=tused_unit(used_units.first);
  865. while assigned(pu) do
  866. begin
  867. if assigned(pu.u.globalsymtable) then
  868. begin
  869. if unitmap[pu.u.moduleid].u<>pu.u then
  870. internalerror(200501157);
  871. { Give a note when the unit is not referenced, skip
  872. this is for units with an initialization/finalization }
  873. if (unitmap[pu.u.moduleid].refs=0) and
  874. ((pu.u.flags and (uf_init or uf_finalize))=0) then
  875. CGMessagePos2(pu.unitsym.fileinfo,sym_n_unit_not_used,pu.u.realmodulename^,realmodulename^);
  876. end;
  877. pu:=tused_unit(pu.next);
  878. end;
  879. end;
  880. procedure tmodule.setmodulename(const s:string);
  881. begin
  882. modulename:=stringdup(upper(s));
  883. realmodulename:=stringdup(s);
  884. { also update asmlibrary names }
  885. current_asmdata.name:=modulename^;
  886. current_asmdata.realname:=realmodulename^;
  887. end;
  888. procedure TModule.AddExternalImport(const libname,symname,symmangledname:string;
  889. OrdNr: longint;isvar:boolean;ImportByOrdinalOnly:boolean);
  890. var
  891. ImportLibrary,OtherIL : TImportLibrary;
  892. ImportSymbol : TImportSymbol;
  893. i : longint;
  894. begin
  895. ImportLibrary:=TImportLibrary(ImportLibraryList.Find(libname));
  896. if not assigned(ImportLibrary) then
  897. ImportLibrary:=TImportLibrary.Create(ImportLibraryList,libname);
  898. ImportSymbol:=TImportSymbol(ImportLibrary.ImportSymbolList.Find(symname));
  899. if not assigned(ImportSymbol) then
  900. begin
  901. { Check that the same name does not exist in another library }
  902. { If it does and the same mangled name is used, issue a warning }
  903. if ImportLibraryList.Count>1 then
  904. for i:=0 To ImportLibraryList.Count-1 do
  905. begin
  906. OtherIL:=TImportLibrary(ImportLibraryList.Items[i]);
  907. ImportSymbol:=TImportSymbol(OtherIL.ImportSymbolList.Find(symname));
  908. if assigned(ImportSymbol) then
  909. begin
  910. if ImportSymbol.MangledName=symmangledname then
  911. begin
  912. CGMessage3(sym_w_library_overload,symname,libname,OtherIL.Name);
  913. break;
  914. end;
  915. end;
  916. end;
  917. if not ImportByOrdinalOnly then
  918. { negative ordinal number indicates import by name with ordinal number as hint }
  919. OrdNr:=-OrdNr;
  920. ImportSymbol:=TImportSymbol.Create(ImportLibrary.ImportSymbolList,
  921. symname,symmangledname,OrdNr,isvar);
  922. end;
  923. end;
  924. initialization
  925. {$ifdef MEMDEBUG}
  926. memsymtable:=TMemDebug.create('Symtables');
  927. memsymtable.stop;
  928. {$endif MEMDEBUG}
  929. finalization
  930. {$ifdef MEMDEBUG}
  931. memsymtable.free;
  932. {$endif MEMDEBUG}
  933. end.