fmodule.pas 34 KB

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