fmodule.pas 42 KB

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