fmodule.pas 36 KB

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