fmodule.pas 38 KB

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