fmodule.pas 42 KB

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