fmodule.pas 30 KB

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