fmodule.pas 36 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093
  1. {
  2. Copyright (c) 1998-2002 by Florian Klaempfl
  3. This unit implements the first loading and searching of the modules
  4. This program is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 2 of the License, or
  7. (at your option) any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software
  14. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  15. ****************************************************************************
  16. }
  17. unit fmodule;
  18. {$i fpcdefs.inc}
  19. {$ifdef go32v2}
  20. {$define shortasmprefix}
  21. {$endif}
  22. {$ifdef watcom}
  23. {$define shortasmprefix}
  24. {$endif}
  25. {$ifdef tos}
  26. {$define shortasmprefix}
  27. {$endif}
  28. {$ifdef OS2}
  29. { Allthough OS/2 supports long filenames I play it safe and
  30. use 8.3 filenames, because this allows the compiler to run
  31. on a FAT partition. (DM) }
  32. {$define shortasmprefix}
  33. {$endif}
  34. interface
  35. uses
  36. cutils,cclasses,cfileutl,
  37. globtype,finput,ogbase,
  38. symbase,symsym,
  39. wpobase,
  40. aasmbase,aasmtai,aasmdata;
  41. const
  42. UNSPECIFIED_LIBRARY_NAME = '<none>';
  43. type
  44. trecompile_reason = (rr_unknown,
  45. rr_noppu,rr_sourcenewer,rr_build,rr_crcchanged
  46. );
  47. { unit options }
  48. tmoduleoption = (mo_none,
  49. mo_hint_deprecated,
  50. mo_hint_platform,
  51. mo_hint_library,
  52. mo_hint_unimplemented,
  53. mo_hint_experimental,
  54. mo_has_deprecated_msg
  55. );
  56. tmoduleoptions = set of tmoduleoption;
  57. tlinkcontaineritem=class(tlinkedlistitem)
  58. public
  59. data : TPathStr;
  60. needlink : cardinal;
  61. constructor Create(const s:TPathStr;m:cardinal);
  62. end;
  63. tlinkcontainer=class(tlinkedlist)
  64. procedure add(const s : TPathStr;m:cardinal);
  65. function get(var m:cardinal) : TPathStr;
  66. function getusemask(mask:cardinal) : TPathStr;
  67. function find(const s:TPathStr):boolean;
  68. end;
  69. tmodule = class;
  70. tused_unit = class;
  71. tunitmaprec = record
  72. u : tmodule;
  73. { number of references }
  74. refs : longint;
  75. { index in the derefmap }
  76. derefidx : longint;
  77. end;
  78. punitmap = ^tunitmaprec;
  79. tderefmaprec = record
  80. u : tmodule;
  81. { modulename, used during ppu load }
  82. modulename : pshortstring;
  83. end;
  84. pderefmap = ^tderefmaprec;
  85. { tmodule }
  86. tmodule = class(tmodulebase)
  87. private
  88. FImportLibraryList : TFPHashObjectList;
  89. public
  90. do_reload, { force reloading of the unit }
  91. do_compile, { need to compile the sources }
  92. sources_avail, { if all sources are reachable }
  93. interface_compiled, { if the interface section has been parsed/compiled/loaded }
  94. is_dbginfo_written,
  95. is_unit,
  96. in_interface, { processing the implementation part? }
  97. { allow global settings }
  98. in_global : boolean;
  99. { Whether a mode switch is still allowed at this point in the parsing.}
  100. mode_switch_allowed,
  101. { generate pic helper which loads eip in ecx (for leave procedures) }
  102. requires_ecx_pic_helper,
  103. { generate pic helper which loads eip in ebx (for non leave procedures) }
  104. requires_ebx_pic_helper : boolean;
  105. interface_only: boolean; { interface-only macpas unit; flag does not need saving/restoring to ppu }
  106. mainfilepos : tfileposinfo;
  107. recompile_reason : trecompile_reason; { the reason why the unit should be recompiled }
  108. crc,
  109. interface_crc,
  110. indirect_crc : cardinal;
  111. flags : cardinal; { the PPU flags }
  112. islibrary : boolean; { if it is a library (win32 dll) }
  113. IsPackage : boolean;
  114. moduleid : longint;
  115. unitmap : punitmap; { mapping of all used units }
  116. unitmapsize : longint; { number of units in the map }
  117. derefmap : pderefmap; { mapping of all units needed for deref }
  118. derefmapcnt : longint; { number of units in the map }
  119. derefmapsize : longint; { number of units in the map }
  120. derefdataintflen : longint;
  121. derefdata : tdynamicarray;
  122. checkforwarddefs,
  123. deflist,
  124. symlist : TFPObjectList;
  125. ptrdefs : THashSet; { list of pointerdefs created in this module so we can reuse them (not saved/restored) }
  126. arraydefs : THashSet; { list of single-element-arraydefs created in this module so we can reuse them (not saved/restored) }
  127. {$ifdef llvm}
  128. llvmdefs : THashSet; { defs added for llvm-specific reasons (not saved/restored) }
  129. {$endif llvm}
  130. ansistrdef : tobject; { an ansistring def redefined for the current module }
  131. wpoinfo : tunitwpoinfobase; { whole program optimization-related information that is generated during the current run for this unit }
  132. globalsymtable, { pointer to the global symtable of this unit }
  133. localsymtable : TSymtable;{ pointer to the local symtable of this unit }
  134. globalmacrosymtable, { pointer to the global macro symtable of this unit }
  135. localmacrosymtable : TSymtable;{ pointer to the local macro symtable of this unit }
  136. scanner : TObject; { scanner object used }
  137. procinfo : TObject; { current procedure being compiled }
  138. asmdata : TObject; { Assembler data }
  139. asmprefix : pshortstring; { prefix for the smartlink asmfiles }
  140. debuginfo : TObject;
  141. loaded_from : tmodule;
  142. _exports : tlinkedlist;
  143. dllscannerinputlist : TFPHashList;
  144. resourcefiles : TCmdStrList;
  145. linkunitofiles,
  146. linkunitstaticlibs,
  147. linkunitsharedlibs,
  148. linkotherofiles, { objects,libs loaded from the source }
  149. linkothersharedlibs, { using $L or $LINKLIB or import lib (for linux) }
  150. linkotherstaticlibs,
  151. linkotherframeworks : tlinkcontainer;
  152. mainname : pshortstring; { alternate name for "main" procedure }
  153. used_units : tlinkedlist;
  154. dependent_units : tlinkedlist;
  155. localunitsearchpath, { local searchpaths }
  156. localobjectsearchpath,
  157. localincludesearchpath,
  158. locallibrarysearchpath,
  159. localframeworksearchpath : TSearchPathList;
  160. moduleoptions: tmoduleoptions;
  161. deprecatedmsg: pshortstring;
  162. { contains a list of types that are extended by helper types; the key is
  163. the full name of the type and the data is a TFPObjectList of
  164. tobjectdef instances (the helper defs) }
  165. extendeddefs: TFPHashObjectList;
  166. { contains a list of the current topmost non-generic symbol for a
  167. typename of which at least one generic exists; the key is the
  168. non-generic typename and the data is a TFPObjectList of tgenericdummyentry
  169. instances whereby the last one is the current top most one }
  170. genericdummysyms: TFPHashObjectList;
  171. { this contains a list of units that needs to be waited for until the
  172. unit can be finished (code generated, etc.); this is needed to handle
  173. specializations in circular unit usages correctly }
  174. waitingforunit: tfpobjectlist;
  175. { this contains a list of all units that are waiting for this unit to be
  176. finished }
  177. waitingunits: tfpobjectlist;
  178. finishstate: pointer;
  179. globalstate: pointer;
  180. namespace: pshortstring; { for JVM target: corresponds to Java package name }
  181. { for targets that initialise typed constants via explicit assignments
  182. instead of by generating an initialised data section (holds typed
  183. constant assignments at the module level; does not have to be saved
  184. into the ppu file, because translated into code during compilation)
  185. -- actual type: tnode (but fmodule should not depend on node) }
  186. tcinitcode : tobject;
  187. {create creates a new module which name is stored in 's'. LoadedFrom
  188. points to the module calling it. It is nil for the first compiled
  189. module. This allow inheritence of all path lists. MUST pay attention
  190. to that when creating link.res!!!!(mazen)}
  191. constructor create(LoadedFrom:TModule;const amodulename: string; const afilename:TPathStr;_is_unit:boolean);
  192. destructor destroy;override;
  193. procedure reset;virtual;
  194. procedure adddependency(callermodule:tmodule);
  195. procedure flagdependent(callermodule:tmodule);
  196. function addusedunit(hp:tmodule;inuses:boolean;usym:tunitsym):tused_unit;
  197. procedure updatemaps;
  198. procedure check_hints;
  199. function derefidx_unit(id:longint):longint;
  200. function resolve_unit(id:longint):tmodule;
  201. procedure allunitsused;
  202. procedure end_of_parsing;virtual;
  203. procedure setmodulename(const s:string);
  204. procedure AddExternalImport(const libname,symname,symmangledname:string;OrdNr: longint;isvar:boolean;ImportByOrdinalOnly:boolean);
  205. property ImportLibraryList : TFPHashObjectList read FImportLibraryList;
  206. end;
  207. tused_unit = class(tlinkedlistitem)
  208. checksum,
  209. interface_checksum,
  210. indirect_checksum: cardinal;
  211. in_uses,
  212. in_interface : boolean;
  213. u : tmodule;
  214. unitsym : tunitsym;
  215. constructor create(_u : tmodule;intface,inuses:boolean;usym:tunitsym);
  216. end;
  217. tdependent_unit = class(tlinkedlistitem)
  218. u : tmodule;
  219. constructor create(_u : tmodule);
  220. end;
  221. var
  222. main_module : tmodule; { Main module of the program }
  223. current_module : tmodule; { Current module which is compiled or loaded }
  224. compiled_module : tmodule; { Current module which is compiled }
  225. usedunits : tlinkedlist; { Used units for this program }
  226. loaded_units : tlinkedlist; { All loaded units }
  227. unloaded_units : tlinkedlist; { Units removed from loaded_units, to be freed }
  228. SmartLinkOFiles : TCmdStrList; { List of .o files which are generated,
  229. used to delete them after linking }
  230. procedure set_current_module(p:tmodule);
  231. function get_module(moduleindex : longint) : tmodule;
  232. function get_source_file(moduleindex,fileindex : longint) : tinputfile;
  233. procedure addloadedunit(hp:tmodule);
  234. function find_module_from_symtable(st:tsymtable):tmodule;
  235. implementation
  236. uses
  237. SysUtils,globals,
  238. verbose,systems,
  239. scanner,ppu,dbgbase,
  240. procinfo,symdef;
  241. {$ifdef MEMDEBUG}
  242. var
  243. memsymtable : TMemDebug;
  244. {$endif}
  245. {*****************************************************************************
  246. Global Functions
  247. *****************************************************************************}
  248. function find_module_from_symtable(st:tsymtable):tmodule;
  249. var
  250. hp : tmodule;
  251. begin
  252. result:=nil;
  253. hp:=tmodule(loaded_units.first);
  254. while assigned(hp) do
  255. begin
  256. if (hp.moduleid=st.moduleid) then
  257. begin
  258. result:=hp;
  259. exit;
  260. end;
  261. hp:=tmodule(hp.next);
  262. end;
  263. end;
  264. procedure set_current_module(p:tmodule);
  265. begin
  266. { save the state of the scanner }
  267. if assigned(current_scanner) then
  268. current_scanner.tempcloseinputfile;
  269. { set new module }
  270. current_module:=p;
  271. { restore previous module settings }
  272. Fillchar(current_filepos,0,sizeof(current_filepos));
  273. if assigned(current_module) then
  274. begin
  275. current_asmdata:=tasmdata(current_module.asmdata);
  276. current_debuginfo:=tdebuginfo(current_module.debuginfo);
  277. { restore scanner and file positions }
  278. current_scanner:=tscannerfile(current_module.scanner);
  279. if assigned(current_scanner) then
  280. begin
  281. current_scanner.tempopeninputfile;
  282. current_scanner.gettokenpos;
  283. parser_current_file:=current_scanner.inputfile.name;
  284. end
  285. else
  286. begin
  287. current_filepos.moduleindex:=current_module.unit_index;
  288. parser_current_file:='';
  289. end;
  290. end
  291. else
  292. begin
  293. current_asmdata:=nil;
  294. current_scanner:=nil;
  295. current_debuginfo:=nil;
  296. end;
  297. end;
  298. function get_module(moduleindex : longint) : tmodule;
  299. var
  300. hp : tmodule;
  301. begin
  302. result:=nil;
  303. if moduleindex=0 then
  304. exit;
  305. result:=current_module;
  306. if not(assigned(loaded_units)) then
  307. exit;
  308. hp:=tmodule(loaded_units.first);
  309. while assigned(hp) and (hp.unit_index<>moduleindex) do
  310. hp:=tmodule(hp.next);
  311. result:=hp;
  312. end;
  313. function get_source_file(moduleindex,fileindex : longint) : tinputfile;
  314. var
  315. hp : tmodule;
  316. begin
  317. hp:=get_module(moduleindex);
  318. if assigned(hp) then
  319. get_source_file:=hp.sourcefiles.get_file(fileindex)
  320. else
  321. get_source_file:=nil;
  322. end;
  323. procedure addloadedunit(hp:tmodule);
  324. begin
  325. hp.moduleid:=loaded_units.count;
  326. loaded_units.concat(hp);
  327. end;
  328. {****************************************************************************
  329. TLinkContainerItem
  330. ****************************************************************************}
  331. constructor TLinkContainerItem.Create(const s:TPathStr;m:cardinal);
  332. begin
  333. inherited Create;
  334. data:=s;
  335. needlink:=m;
  336. end;
  337. {****************************************************************************
  338. TLinkContainer
  339. ****************************************************************************}
  340. procedure TLinkContainer.add(const s : TPathStr;m:cardinal);
  341. begin
  342. inherited concat(TLinkContainerItem.Create(s,m));
  343. end;
  344. function TLinkContainer.get(var m:cardinal) : TPathStr;
  345. var
  346. p : tlinkcontaineritem;
  347. begin
  348. p:=tlinkcontaineritem(inherited getfirst);
  349. if p=nil then
  350. begin
  351. get:='';
  352. m:=0;
  353. end
  354. else
  355. begin
  356. get:=p.data;
  357. m:=p.needlink;
  358. p.free;
  359. end;
  360. end;
  361. function TLinkContainer.getusemask(mask:cardinal) : TPathStr;
  362. var
  363. p : tlinkcontaineritem;
  364. found : boolean;
  365. begin
  366. found:=false;
  367. repeat
  368. p:=tlinkcontaineritem(inherited getfirst);
  369. if p=nil then
  370. begin
  371. getusemask:='';
  372. exit;
  373. end;
  374. getusemask:=p.data;
  375. found:=(p.needlink and mask)<>0;
  376. p.free;
  377. until found;
  378. end;
  379. function TLinkContainer.find(const s:TPathStr):boolean;
  380. var
  381. newnode : tlinkcontaineritem;
  382. begin
  383. find:=false;
  384. newnode:=tlinkcontaineritem(First);
  385. while assigned(newnode) do
  386. begin
  387. if newnode.data=s then
  388. begin
  389. find:=true;
  390. exit;
  391. end;
  392. newnode:=tlinkcontaineritem(newnode.next);
  393. end;
  394. end;
  395. {****************************************************************************
  396. TUSED_UNIT
  397. ****************************************************************************}
  398. constructor tused_unit.create(_u : tmodule;intface,inuses:boolean;usym:tunitsym);
  399. begin
  400. u:=_u;
  401. in_interface:=intface;
  402. in_uses:=inuses;
  403. unitsym:=usym;
  404. if _u.state=ms_compiled then
  405. begin
  406. checksum:=u.crc;
  407. interface_checksum:=u.interface_crc;
  408. indirect_checksum:=u.indirect_crc;
  409. end
  410. else
  411. begin
  412. checksum:=0;
  413. interface_checksum:=0;
  414. indirect_checksum:=0;
  415. end;
  416. end;
  417. {****************************************************************************
  418. TDENPENDENT_UNIT
  419. ****************************************************************************}
  420. constructor tdependent_unit.create(_u : tmodule);
  421. begin
  422. u:=_u;
  423. end;
  424. {****************************************************************************
  425. TMODULE
  426. ****************************************************************************}
  427. constructor tmodule.create(LoadedFrom:TModule;const amodulename: string; const afilename:TPathStr;_is_unit:boolean);
  428. var
  429. n:string;
  430. fn:TPathStr;
  431. begin
  432. if amodulename='' then
  433. n:=ChangeFileExt(ExtractFileName(afilename),'')
  434. else
  435. n:=amodulename;
  436. if afilename='' then
  437. fn:=amodulename
  438. else
  439. fn:=afilename;
  440. { Programs have the name 'Program' to don't conflict with dup id's }
  441. if _is_unit then
  442. inherited create(amodulename)
  443. else
  444. inherited create('Program');
  445. mainsource:=fn;
  446. { Dos has the famous 8.3 limit :( }
  447. {$ifdef shortasmprefix}
  448. asmprefix:=stringdup(FixFileName('as'));
  449. {$else}
  450. asmprefix:=stringdup(FixFileName(n));
  451. {$endif}
  452. setfilename(fn,true);
  453. localunitsearchpath:=TSearchPathList.Create;
  454. localobjectsearchpath:=TSearchPathList.Create;
  455. localincludesearchpath:=TSearchPathList.Create;
  456. locallibrarysearchpath:=TSearchPathList.Create;
  457. localframeworksearchpath:=TSearchPathList.Create;
  458. used_units:=TLinkedList.Create;
  459. dependent_units:=TLinkedList.Create;
  460. resourcefiles:=TCmdStrList.Create;
  461. linkunitofiles:=TLinkContainer.Create;
  462. linkunitstaticlibs:=TLinkContainer.Create;
  463. linkunitsharedlibs:=TLinkContainer.Create;
  464. linkotherofiles:=TLinkContainer.Create;
  465. linkotherstaticlibs:=TLinkContainer.Create;
  466. linkothersharedlibs:=TLinkContainer.Create;
  467. linkotherframeworks:=TLinkContainer.Create;
  468. mainname:=nil;
  469. FImportLibraryList:=TFPHashObjectList.Create(true);
  470. crc:=0;
  471. interface_crc:=0;
  472. indirect_crc:=0;
  473. flags:=0;
  474. scanner:=nil;
  475. unitmap:=nil;
  476. unitmapsize:=0;
  477. derefmap:=nil;
  478. derefmapsize:=0;
  479. derefmapcnt:=0;
  480. derefdata:=TDynamicArray.Create(1024);
  481. derefdataintflen:=0;
  482. deflist:=TFPObjectList.Create(false);
  483. symlist:=TFPObjectList.Create(false);
  484. ptrdefs:=THashSet.Create(64,true,false);
  485. arraydefs:=THashSet.Create(64,true,false);
  486. {$ifdef llvm}
  487. llvmdefs:=THashSet.Create(64,true,false);
  488. {$endif llvm}
  489. ansistrdef:=nil;
  490. wpoinfo:=nil;
  491. checkforwarddefs:=TFPObjectList.Create(false);
  492. extendeddefs:=TFPHashObjectList.Create(true);
  493. genericdummysyms:=tfphashobjectlist.create(true);
  494. waitingforunit:=tfpobjectlist.create(false);
  495. waitingunits:=tfpobjectlist.create(false);
  496. globalsymtable:=nil;
  497. localsymtable:=nil;
  498. globalmacrosymtable:=nil;
  499. localmacrosymtable:=nil;
  500. loaded_from:=LoadedFrom;
  501. do_reload:=false;
  502. do_compile:=false;
  503. sources_avail:=true;
  504. mainfilepos.line:=0;
  505. mainfilepos.column:=0;
  506. mainfilepos.fileindex:=0;
  507. recompile_reason:=rr_unknown;
  508. in_interface:=true;
  509. in_global:=true;
  510. is_unit:=_is_unit;
  511. islibrary:=false;
  512. ispackage:=false;
  513. is_dbginfo_written:=false;
  514. mode_switch_allowed:= true;
  515. moduleoptions:=[];
  516. deprecatedmsg:=nil;
  517. namespace:=nil;
  518. tcinitcode:=nil;
  519. _exports:=TLinkedList.Create;
  520. dllscannerinputlist:=TFPHashList.Create;
  521. asmdata:=casmdata.create(modulename);
  522. InitDebugInfo(self,false);
  523. end;
  524. destructor tmodule.Destroy;
  525. var
  526. i : longint;
  527. current_debuginfo_reset : boolean;
  528. begin
  529. if assigned(unitmap) then
  530. freemem(unitmap);
  531. if assigned(derefmap) then
  532. begin
  533. for i:=0 to derefmapcnt-1 do
  534. stringdispose(derefmap[i].modulename);
  535. freemem(derefmap);
  536. end;
  537. if assigned(_exports) then
  538. _exports.free;
  539. if assigned(dllscannerinputlist) then
  540. dllscannerinputlist.free;
  541. if assigned(scanner) then
  542. begin
  543. { also update current_scanner if it was pointing
  544. to this module }
  545. if current_scanner=tscannerfile(scanner) then
  546. current_scanner:=nil;
  547. tscannerfile(scanner).free;
  548. end;
  549. if assigned(asmdata) then
  550. begin
  551. if current_asmdata=asmdata then
  552. current_asmdata:=nil;
  553. asmdata.free;
  554. end;
  555. if assigned(procinfo) then
  556. begin
  557. if current_procinfo=tprocinfo(procinfo) then
  558. begin
  559. current_procinfo:=nil;
  560. current_structdef:=nil;
  561. current_genericdef:=nil;
  562. current_specializedef:=nil;
  563. end;
  564. { release procinfo tree }
  565. tprocinfo(procinfo).destroy_tree;
  566. end;
  567. DoneDebugInfo(self,current_debuginfo_reset);
  568. used_units.free;
  569. dependent_units.free;
  570. resourcefiles.Free;
  571. linkunitofiles.Free;
  572. linkunitstaticlibs.Free;
  573. linkunitsharedlibs.Free;
  574. linkotherofiles.Free;
  575. linkotherstaticlibs.Free;
  576. linkothersharedlibs.Free;
  577. linkotherframeworks.Free;
  578. stringdispose(mainname);
  579. FImportLibraryList.Free;
  580. extendeddefs.Free;
  581. genericdummysyms.free;
  582. waitingforunit.free;
  583. waitingunits.free;
  584. stringdispose(asmprefix);
  585. stringdispose(deprecatedmsg);
  586. stringdispose(namespace);
  587. tcinitcode.free;
  588. localunitsearchpath.Free;
  589. localobjectsearchpath.free;
  590. localincludesearchpath.free;
  591. locallibrarysearchpath.free;
  592. localframeworksearchpath.free;
  593. {$ifdef MEMDEBUG}
  594. memsymtable.start;
  595. {$endif}
  596. derefdata.free;
  597. deflist.free;
  598. symlist.free;
  599. ptrdefs.free;
  600. arraydefs.free;
  601. {$ifdef llvm}
  602. llvmdefs.free;
  603. {$endif llvm}
  604. ansistrdef:=nil;
  605. wpoinfo.free;
  606. checkforwarddefs.free;
  607. globalsymtable.free;
  608. localsymtable.free;
  609. globalmacrosymtable.free;
  610. localmacrosymtable.free;
  611. {$ifdef MEMDEBUG}
  612. memsymtable.stop;
  613. {$endif}
  614. inherited Destroy;
  615. end;
  616. procedure tmodule.reset;
  617. var
  618. i : longint;
  619. current_debuginfo_reset : boolean;
  620. begin
  621. if assigned(scanner) then
  622. begin
  623. { also update current_scanner if it was pointing
  624. to this module }
  625. if current_scanner=tscannerfile(scanner) then
  626. current_scanner:=nil;
  627. tscannerfile(scanner).free;
  628. scanner:=nil;
  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. if assigned(asmdata) then
  643. begin
  644. if current_asmdata=asmdata then
  645. current_asmdata:=nil;
  646. asmdata.free;
  647. asmdata:=nil;
  648. end;
  649. DoneDebugInfo(self,current_debuginfo_reset);
  650. globalsymtable.free;
  651. globalsymtable:=nil;
  652. localsymtable.free;
  653. localsymtable:=nil;
  654. globalmacrosymtable.free;
  655. globalmacrosymtable:=nil;
  656. localmacrosymtable.free;
  657. localmacrosymtable:=nil;
  658. deflist.free;
  659. deflist:=TFPObjectList.Create(false);
  660. symlist.free;
  661. symlist:=TFPObjectList.Create(false);
  662. ptrdefs.free;
  663. ptrdefs:=THashSet.Create(64,true,false);
  664. arraydefs.free;
  665. arraydefs:=THashSet.Create(64,true,false);
  666. {$ifdef llvm}
  667. llvmdefs.free;
  668. llvmdefs:=THashSet.Create(64,true,false);
  669. {$endif llvm}
  670. wpoinfo.free;
  671. wpoinfo:=nil;
  672. checkforwarddefs.free;
  673. checkforwarddefs:=TFPObjectList.Create(false);
  674. derefdata.free;
  675. derefdata:=TDynamicArray.Create(1024);
  676. if assigned(unitmap) then
  677. begin
  678. freemem(unitmap);
  679. unitmap:=nil;
  680. end;
  681. if assigned(derefmap) then
  682. begin
  683. for i:=0 to derefmapcnt-1 do
  684. stringdispose(derefmap[i].modulename);
  685. freemem(derefmap);
  686. derefmap:=nil;
  687. end;
  688. unitmapsize:=0;
  689. derefmapsize:=0;
  690. derefmapcnt:=0;
  691. derefdataintflen:=0;
  692. sourcefiles.free;
  693. sourcefiles:=tinputfilemanager.create;
  694. asmdata:=casmdata.create(modulename);
  695. InitDebugInfo(self,current_debuginfo_reset);
  696. _exports.free;
  697. _exports:=tlinkedlist.create;
  698. dllscannerinputlist.free;
  699. dllscannerinputlist:=TFPHashList.create;
  700. used_units.free;
  701. used_units:=TLinkedList.Create;
  702. dependent_units.free;
  703. dependent_units:=TLinkedList.Create;
  704. resourcefiles.Free;
  705. resourcefiles:=TCmdStrList.Create;
  706. linkunitofiles.Free;
  707. linkunitofiles:=TLinkContainer.Create;
  708. linkunitstaticlibs.Free;
  709. linkunitstaticlibs:=TLinkContainer.Create;
  710. linkunitsharedlibs.Free;
  711. linkunitsharedlibs:=TLinkContainer.Create;
  712. linkotherofiles.Free;
  713. linkotherofiles:=TLinkContainer.Create;
  714. linkotherstaticlibs.Free;
  715. linkotherstaticlibs:=TLinkContainer.Create;
  716. linkothersharedlibs.Free;
  717. linkothersharedlibs:=TLinkContainer.Create;
  718. linkotherframeworks.Free;
  719. linkotherframeworks:=TLinkContainer.Create;
  720. stringdispose(mainname);
  721. FImportLibraryList.Free;
  722. FImportLibraryList:=TFPHashObjectList.Create;
  723. do_compile:=false;
  724. do_reload:=false;
  725. interface_compiled:=false;
  726. in_interface:=true;
  727. in_global:=true;
  728. mode_switch_allowed:=true;
  729. stringdispose(deprecatedmsg);
  730. stringdispose(namespace);
  731. tcinitcode.free;
  732. tcinitcode:=nil;
  733. moduleoptions:=[];
  734. is_dbginfo_written:=false;
  735. crc:=0;
  736. interface_crc:=0;
  737. indirect_crc:=0;
  738. flags:=0;
  739. mainfilepos.line:=0;
  740. mainfilepos.column:=0;
  741. mainfilepos.fileindex:=0;
  742. recompile_reason:=rr_unknown;
  743. {
  744. The following fields should not
  745. be reset:
  746. mainsource
  747. state
  748. loaded_from
  749. sources_avail
  750. }
  751. end;
  752. procedure tmodule.adddependency(callermodule:tmodule);
  753. begin
  754. { This is not needed for programs }
  755. if not callermodule.is_unit then
  756. exit;
  757. Message2(unit_u_add_depend_to,callermodule.modulename^,modulename^);
  758. dependent_units.concat(tdependent_unit.create(callermodule));
  759. end;
  760. procedure tmodule.flagdependent(callermodule:tmodule);
  761. var
  762. pm : tdependent_unit;
  763. begin
  764. { flag all units that depend on this unit for reloading }
  765. pm:=tdependent_unit(current_module.dependent_units.first);
  766. while assigned(pm) do
  767. begin
  768. { We do not have to reload the unit that wants to load
  769. this unit, unless this unit is already compiled during
  770. the loading }
  771. if (pm.u=callermodule) and
  772. (pm.u.state<>ms_compiled) then
  773. Message1(unit_u_no_reload_is_caller,pm.u.modulename^)
  774. else
  775. if pm.u.state=ms_second_compile then
  776. Message1(unit_u_no_reload_in_second_compile,pm.u.modulename^)
  777. else
  778. begin
  779. pm.u.do_reload:=true;
  780. Message1(unit_u_flag_for_reload,pm.u.modulename^);
  781. end;
  782. pm:=tdependent_unit(pm.next);
  783. end;
  784. end;
  785. function tmodule.addusedunit(hp:tmodule;inuses:boolean;usym:tunitsym):tused_unit;
  786. var
  787. pu : tused_unit;
  788. begin
  789. pu:=tused_unit.create(hp,in_interface,inuses,usym);
  790. used_units.concat(pu);
  791. addusedunit:=pu;
  792. end;
  793. procedure tmodule.updatemaps;
  794. var
  795. oldmapsize : longint;
  796. hp : tmodule;
  797. i : longint;
  798. begin
  799. { Extend unitmap }
  800. oldmapsize:=unitmapsize;
  801. unitmapsize:=loaded_units.count;
  802. reallocmem(unitmap,unitmapsize*sizeof(tunitmaprec));
  803. fillchar(unitmap[oldmapsize],(unitmapsize-oldmapsize)*sizeof(tunitmaprec),0);
  804. { Extend Derefmap }
  805. oldmapsize:=derefmapsize;
  806. derefmapsize:=loaded_units.count;
  807. reallocmem(derefmap,derefmapsize*sizeof(tderefmaprec));
  808. fillchar(derefmap[oldmapsize],(derefmapsize-oldmapsize)*sizeof(tderefmaprec),0);
  809. { Add all units to unitmap }
  810. hp:=tmodule(loaded_units.first);
  811. i:=0;
  812. while assigned(hp) do
  813. begin
  814. if hp.moduleid>=unitmapsize then
  815. internalerror(200501151);
  816. { Verify old entries }
  817. if (i<oldmapsize) then
  818. begin
  819. if (hp.moduleid<>i) or
  820. (unitmap[hp.moduleid].u<>hp) then
  821. internalerror(200501156);
  822. end
  823. else
  824. begin
  825. unitmap[hp.moduleid].u:=hp;
  826. unitmap[hp.moduleid].derefidx:=-1;
  827. end;
  828. inc(i);
  829. hp:=tmodule(hp.next);
  830. end;
  831. end;
  832. procedure tmodule.check_hints;
  833. begin
  834. if mo_hint_deprecated in moduleoptions then
  835. if (mo_has_deprecated_msg in moduleoptions) and (deprecatedmsg <> nil) then
  836. Message2(sym_w_deprecated_unit_with_msg,realmodulename^,deprecatedmsg^)
  837. else
  838. Message1(sym_w_deprecated_unit,realmodulename^);
  839. if mo_hint_experimental in moduleoptions then
  840. Message1(sym_w_experimental_unit,realmodulename^);
  841. if mo_hint_platform in moduleoptions then
  842. Message1(sym_w_non_portable_unit,realmodulename^);
  843. if mo_hint_library in moduleoptions then
  844. Message1(sym_w_library_unit,realmodulename^);
  845. if mo_hint_unimplemented in moduleoptions then
  846. Message1(sym_w_non_implemented_unit,realmodulename^);
  847. end;
  848. function tmodule.derefidx_unit(id:longint):longint;
  849. begin
  850. if id>=unitmapsize then
  851. internalerror(2005011511);
  852. if unitmap[id].derefidx=-1 then
  853. begin
  854. unitmap[id].derefidx:=derefmapcnt;
  855. inc(derefmapcnt);
  856. derefmap[unitmap[id].derefidx].u:=unitmap[id].u;
  857. end;
  858. if unitmap[id].derefidx>=derefmapsize then
  859. internalerror(2005011514);
  860. result:=unitmap[id].derefidx;
  861. end;
  862. function tmodule.resolve_unit(id:longint):tmodule;
  863. var
  864. hp : tmodule;
  865. begin
  866. if id>=derefmapsize then
  867. internalerror(200306231);
  868. result:=derefmap[id].u;
  869. if not assigned(result) then
  870. begin
  871. if not assigned(derefmap[id].modulename) or
  872. (derefmap[id].modulename^='') then
  873. internalerror(200501159);
  874. hp:=tmodule(loaded_units.first);
  875. while assigned(hp) do
  876. begin
  877. { only check for units. The main program is also
  878. as a unit in the loaded_units list. We simply need
  879. to ignore this entry (PFV) }
  880. if hp.is_unit and
  881. (hp.modulename^=derefmap[id].modulename^) then
  882. break;
  883. hp:=tmodule(hp.next);
  884. end;
  885. if not assigned(hp) then
  886. internalerror(2005011510);
  887. derefmap[id].u:=hp;
  888. result:=hp;
  889. end;
  890. end;
  891. procedure tmodule.allunitsused;
  892. var
  893. pu : tused_unit;
  894. begin
  895. pu:=tused_unit(used_units.first);
  896. while assigned(pu) do
  897. begin
  898. if assigned(pu.u.globalsymtable) then
  899. begin
  900. if unitmap[pu.u.moduleid].u<>pu.u then
  901. internalerror(200501157);
  902. { Give a note when the unit is not referenced, skip
  903. this is for units with an initialization/finalization }
  904. if (unitmap[pu.u.moduleid].refs=0) and
  905. ((pu.u.flags and (uf_init or uf_finalize))=0) then
  906. CGMessagePos2(pu.unitsym.fileinfo,sym_n_unit_not_used,pu.u.realmodulename^,realmodulename^);
  907. end;
  908. pu:=tused_unit(pu.next);
  909. end;
  910. end;
  911. procedure tmodule.end_of_parsing;
  912. begin
  913. { free asmdata }
  914. if assigned(asmdata) then
  915. begin
  916. asmdata.free;
  917. asmdata:=nil;
  918. end;
  919. { free scanner }
  920. if assigned(scanner) then
  921. begin
  922. if current_scanner=tscannerfile(scanner) then
  923. current_scanner:=nil;
  924. tscannerfile(scanner).free;
  925. scanner:=nil;
  926. end;
  927. { free symtable stack }
  928. if assigned(symtablestack) then
  929. begin
  930. symtablestack.free;
  931. symtablestack:=nil;
  932. end;
  933. if assigned(macrosymtablestack) then
  934. begin
  935. macrosymtablestack.free;
  936. macrosymtablestack:=nil;
  937. end;
  938. end;
  939. procedure tmodule.setmodulename(const s:string);
  940. begin
  941. stringdispose(modulename);
  942. stringdispose(realmodulename);
  943. modulename:=stringdup(upper(s));
  944. realmodulename:=stringdup(s);
  945. { also update asmlibrary names }
  946. current_asmdata.name:=modulename;
  947. end;
  948. procedure TModule.AddExternalImport(const libname,symname,symmangledname:string;
  949. OrdNr: longint;isvar:boolean;ImportByOrdinalOnly:boolean);
  950. var
  951. ImportLibrary,OtherIL : TImportLibrary;
  952. ImportSymbol : TImportSymbol;
  953. i : longint;
  954. begin
  955. ImportLibrary:=TImportLibrary(ImportLibraryList.Find(libname));
  956. if not assigned(ImportLibrary) then
  957. ImportLibrary:=TImportLibrary.Create(ImportLibraryList,libname);
  958. ImportSymbol:=TImportSymbol(ImportLibrary.ImportSymbolList.Find(symname));
  959. if not assigned(ImportSymbol) then
  960. begin
  961. { Check that the same name does not exist in another library }
  962. { If it does and the same mangled name is used, issue a warning }
  963. if ImportLibraryList.Count>1 then
  964. for i:=0 To ImportLibraryList.Count-1 do
  965. begin
  966. OtherIL:=TImportLibrary(ImportLibraryList.Items[i]);
  967. ImportSymbol:=TImportSymbol(OtherIL.ImportSymbolList.Find(symname));
  968. if assigned(ImportSymbol) then
  969. begin
  970. if ImportSymbol.MangledName=symmangledname then
  971. begin
  972. CGMessage3(sym_w_library_overload,symname,libname,OtherIL.Name);
  973. break;
  974. end;
  975. end;
  976. end;
  977. if not ImportByOrdinalOnly then
  978. { negative ordinal number indicates import by name with ordinal number as hint }
  979. OrdNr:=-OrdNr;
  980. ImportSymbol:=TImportSymbol.Create(ImportLibrary.ImportSymbolList,
  981. symname,symmangledname,OrdNr,isvar);
  982. end;
  983. end;
  984. initialization
  985. {$ifdef MEMDEBUG}
  986. memsymtable:=TMemDebug.create('Symtables');
  987. memsymtable.stop;
  988. {$endif MEMDEBUG}
  989. finalization
  990. {$ifdef MEMDEBUG}
  991. memsymtable.free;
  992. {$endif MEMDEBUG}
  993. end.