fmodule.pas 47 KB

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