fmodule.pas 34 KB

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