fmodule.pas 41 KB

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