fmodule.pas 36 KB

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