fmodule.pas 34 KB

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