fmodule.pas 36 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099
  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,symconst,symsym,symcpu,
  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 : tPtrDefHashSet; { 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. function derefidx_unit(id:longint):longint;
  199. function resolve_unit(id:longint):tmodule;
  200. procedure allunitsused;
  201. procedure end_of_parsing;virtual;
  202. procedure setmodulename(const s:string);
  203. procedure AddExternalImport(const libname,symname,symmangledname:string;OrdNr: longint;isvar:boolean;ImportByOrdinalOnly:boolean);
  204. property ImportLibraryList : TFPHashObjectList read FImportLibraryList;
  205. end;
  206. tused_unit = class(tlinkedlistitem)
  207. checksum,
  208. interface_checksum,
  209. indirect_checksum: cardinal;
  210. in_uses,
  211. in_interface : boolean;
  212. u : tmodule;
  213. unitsym : tunitsym;
  214. constructor create(_u : tmodule;intface,inuses:boolean;usym:tunitsym);
  215. procedure check_hints;
  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. procedure tused_unit.check_hints;
  418. var
  419. uname: pshortstring;
  420. begin
  421. uname:=u.realmodulename;
  422. if mo_hint_deprecated in u.moduleoptions then
  423. if (mo_has_deprecated_msg in u.moduleoptions) and (u.deprecatedmsg <> nil) then
  424. MessagePos2(unitsym.fileinfo,sym_w_deprecated_unit_with_msg,uname^,u.deprecatedmsg^)
  425. else
  426. MessagePos1(unitsym.fileinfo,sym_w_deprecated_unit,uname^);
  427. if mo_hint_experimental in u.moduleoptions then
  428. MessagePos1(unitsym.fileinfo,sym_w_experimental_unit,uname^);
  429. if mo_hint_platform in u.moduleoptions then
  430. MessagePos1(unitsym.fileinfo,sym_w_non_portable_unit,uname^);
  431. if mo_hint_library in u.moduleoptions then
  432. MessagePos1(unitsym.fileinfo,sym_w_library_unit,uname^);
  433. if mo_hint_unimplemented in u.moduleoptions then
  434. MessagePos1(unitsym.fileinfo,sym_w_non_implemented_unit,uname^);
  435. end;
  436. {****************************************************************************
  437. TDENPENDENT_UNIT
  438. ****************************************************************************}
  439. constructor tdependent_unit.create(_u : tmodule);
  440. begin
  441. u:=_u;
  442. end;
  443. {****************************************************************************
  444. TMODULE
  445. ****************************************************************************}
  446. constructor tmodule.create(LoadedFrom:TModule;const amodulename: string; const afilename:TPathStr;_is_unit:boolean);
  447. var
  448. n:string;
  449. fn:TPathStr;
  450. begin
  451. if amodulename='' then
  452. n:=ChangeFileExt(ExtractFileName(afilename),'')
  453. else
  454. n:=amodulename;
  455. if afilename='' then
  456. fn:=amodulename
  457. else
  458. fn:=afilename;
  459. { Programs have the name 'Program' to don't conflict with dup id's }
  460. if _is_unit then
  461. inherited create(amodulename)
  462. else
  463. inherited create('Program');
  464. mainsource:=fn;
  465. { Dos has the famous 8.3 limit :( }
  466. {$ifdef shortasmprefix}
  467. asmprefix:=stringdup(FixFileName('as'));
  468. {$else}
  469. asmprefix:=stringdup(FixFileName(n));
  470. {$endif}
  471. setfilename(fn,true);
  472. localunitsearchpath:=TSearchPathList.Create;
  473. localobjectsearchpath:=TSearchPathList.Create;
  474. localincludesearchpath:=TSearchPathList.Create;
  475. locallibrarysearchpath:=TSearchPathList.Create;
  476. localframeworksearchpath:=TSearchPathList.Create;
  477. used_units:=TLinkedList.Create;
  478. dependent_units:=TLinkedList.Create;
  479. resourcefiles:=TCmdStrList.Create;
  480. linkunitofiles:=TLinkContainer.Create;
  481. linkunitstaticlibs:=TLinkContainer.Create;
  482. linkunitsharedlibs:=TLinkContainer.Create;
  483. linkotherofiles:=TLinkContainer.Create;
  484. linkotherstaticlibs:=TLinkContainer.Create;
  485. linkothersharedlibs:=TLinkContainer.Create;
  486. linkotherframeworks:=TLinkContainer.Create;
  487. mainname:=nil;
  488. FImportLibraryList:=TFPHashObjectList.Create(true);
  489. crc:=0;
  490. interface_crc:=0;
  491. indirect_crc:=0;
  492. flags:=0;
  493. scanner:=nil;
  494. unitmap:=nil;
  495. unitmapsize:=0;
  496. derefmap:=nil;
  497. derefmapsize:=0;
  498. derefmapcnt:=0;
  499. derefdata:=TDynamicArray.Create(1024);
  500. derefdataintflen:=0;
  501. deflist:=TFPObjectList.Create(false);
  502. symlist:=TFPObjectList.Create(false);
  503. ptrdefs:=cPtrDefHashSet.Create;
  504. arraydefs:=THashSet.Create(64,true,false);
  505. {$ifdef llvm}
  506. llvmdefs:=THashSet.Create(64,true,false);
  507. {$endif llvm}
  508. ansistrdef:=nil;
  509. wpoinfo:=nil;
  510. checkforwarddefs:=TFPObjectList.Create(false);
  511. extendeddefs:=TFPHashObjectList.Create(true);
  512. genericdummysyms:=tfphashobjectlist.create(true);
  513. waitingforunit:=tfpobjectlist.create(false);
  514. waitingunits:=tfpobjectlist.create(false);
  515. globalsymtable:=nil;
  516. localsymtable:=nil;
  517. globalmacrosymtable:=nil;
  518. localmacrosymtable:=nil;
  519. loaded_from:=LoadedFrom;
  520. do_reload:=false;
  521. do_compile:=false;
  522. sources_avail:=true;
  523. mainfilepos.line:=0;
  524. mainfilepos.column:=0;
  525. mainfilepos.fileindex:=0;
  526. recompile_reason:=rr_unknown;
  527. in_interface:=true;
  528. in_global:=true;
  529. is_unit:=_is_unit;
  530. islibrary:=false;
  531. ispackage:=false;
  532. is_dbginfo_written:=false;
  533. mode_switch_allowed:= true;
  534. moduleoptions:=[];
  535. deprecatedmsg:=nil;
  536. namespace:=nil;
  537. tcinitcode:=nil;
  538. _exports:=TLinkedList.Create;
  539. dllscannerinputlist:=TFPHashList.Create;
  540. asmdata:=casmdata.create(modulename);
  541. InitDebugInfo(self,false);
  542. end;
  543. destructor tmodule.Destroy;
  544. var
  545. i : longint;
  546. current_debuginfo_reset : boolean;
  547. begin
  548. if assigned(unitmap) then
  549. freemem(unitmap);
  550. if assigned(derefmap) then
  551. begin
  552. for i:=0 to derefmapcnt-1 do
  553. stringdispose(derefmap[i].modulename);
  554. freemem(derefmap);
  555. end;
  556. if assigned(_exports) then
  557. _exports.free;
  558. if assigned(dllscannerinputlist) then
  559. dllscannerinputlist.free;
  560. if assigned(scanner) then
  561. begin
  562. { also update current_scanner if it was pointing
  563. to this module }
  564. if current_scanner=tscannerfile(scanner) then
  565. current_scanner:=nil;
  566. tscannerfile(scanner).free;
  567. end;
  568. if assigned(asmdata) then
  569. begin
  570. if current_asmdata=asmdata then
  571. current_asmdata:=nil;
  572. asmdata.free;
  573. end;
  574. if assigned(procinfo) then
  575. begin
  576. if current_procinfo=tprocinfo(procinfo) then
  577. begin
  578. current_procinfo:=nil;
  579. current_structdef:=nil;
  580. current_genericdef:=nil;
  581. current_specializedef:=nil;
  582. end;
  583. { release procinfo tree }
  584. tprocinfo(procinfo).destroy_tree;
  585. end;
  586. DoneDebugInfo(self,current_debuginfo_reset);
  587. used_units.free;
  588. dependent_units.free;
  589. resourcefiles.Free;
  590. linkunitofiles.Free;
  591. linkunitstaticlibs.Free;
  592. linkunitsharedlibs.Free;
  593. linkotherofiles.Free;
  594. linkotherstaticlibs.Free;
  595. linkothersharedlibs.Free;
  596. linkotherframeworks.Free;
  597. stringdispose(mainname);
  598. FImportLibraryList.Free;
  599. extendeddefs.Free;
  600. genericdummysyms.free;
  601. waitingforunit.free;
  602. waitingunits.free;
  603. stringdispose(asmprefix);
  604. stringdispose(deprecatedmsg);
  605. stringdispose(namespace);
  606. tcinitcode.free;
  607. localunitsearchpath.Free;
  608. localobjectsearchpath.free;
  609. localincludesearchpath.free;
  610. locallibrarysearchpath.free;
  611. localframeworksearchpath.free;
  612. {$ifdef MEMDEBUG}
  613. memsymtable.start;
  614. {$endif}
  615. derefdata.free;
  616. deflist.free;
  617. symlist.free;
  618. ptrdefs.free;
  619. arraydefs.free;
  620. {$ifdef llvm}
  621. llvmdefs.free;
  622. {$endif llvm}
  623. ansistrdef:=nil;
  624. wpoinfo.free;
  625. checkforwarddefs.free;
  626. globalsymtable.free;
  627. localsymtable.free;
  628. globalmacrosymtable.free;
  629. localmacrosymtable.free;
  630. {$ifdef MEMDEBUG}
  631. memsymtable.stop;
  632. {$endif}
  633. inherited Destroy;
  634. end;
  635. procedure tmodule.reset;
  636. var
  637. i : longint;
  638. current_debuginfo_reset : boolean;
  639. begin
  640. if assigned(scanner) then
  641. begin
  642. { also update current_scanner if it was pointing
  643. to this module }
  644. if current_scanner=tscannerfile(scanner) then
  645. current_scanner:=nil;
  646. tscannerfile(scanner).free;
  647. scanner:=nil;
  648. end;
  649. if assigned(procinfo) then
  650. begin
  651. if current_procinfo=tprocinfo(procinfo) then
  652. begin
  653. current_procinfo:=nil;
  654. current_structdef:=nil;
  655. current_genericdef:=nil;
  656. current_specializedef:=nil;
  657. end;
  658. { release procinfo tree }
  659. tprocinfo(procinfo).destroy_tree;
  660. end;
  661. if assigned(asmdata) then
  662. begin
  663. if current_asmdata=asmdata then
  664. current_asmdata:=nil;
  665. asmdata.free;
  666. asmdata:=nil;
  667. end;
  668. DoneDebugInfo(self,current_debuginfo_reset);
  669. globalsymtable.free;
  670. globalsymtable:=nil;
  671. localsymtable.free;
  672. localsymtable:=nil;
  673. globalmacrosymtable.free;
  674. globalmacrosymtable:=nil;
  675. localmacrosymtable.free;
  676. localmacrosymtable:=nil;
  677. deflist.free;
  678. deflist:=TFPObjectList.Create(false);
  679. symlist.free;
  680. symlist:=TFPObjectList.Create(false);
  681. ptrdefs.free;
  682. ptrdefs:=cPtrDefHashSet.Create;
  683. arraydefs.free;
  684. arraydefs:=THashSet.Create(64,true,false);
  685. {$ifdef llvm}
  686. llvmdefs.free;
  687. llvmdefs:=THashSet.Create(64,true,false);
  688. {$endif llvm}
  689. wpoinfo.free;
  690. wpoinfo:=nil;
  691. checkforwarddefs.free;
  692. checkforwarddefs:=TFPObjectList.Create(false);
  693. derefdata.free;
  694. derefdata:=TDynamicArray.Create(1024);
  695. if assigned(unitmap) then
  696. begin
  697. freemem(unitmap);
  698. unitmap:=nil;
  699. end;
  700. if assigned(derefmap) then
  701. begin
  702. for i:=0 to derefmapcnt-1 do
  703. stringdispose(derefmap[i].modulename);
  704. freemem(derefmap);
  705. derefmap:=nil;
  706. end;
  707. unitmapsize:=0;
  708. derefmapsize:=0;
  709. derefmapcnt:=0;
  710. derefdataintflen:=0;
  711. sourcefiles.free;
  712. sourcefiles:=tinputfilemanager.create;
  713. asmdata:=casmdata.create(modulename);
  714. InitDebugInfo(self,current_debuginfo_reset);
  715. _exports.free;
  716. _exports:=tlinkedlist.create;
  717. dllscannerinputlist.free;
  718. dllscannerinputlist:=TFPHashList.create;
  719. used_units.free;
  720. used_units:=TLinkedList.Create;
  721. dependent_units.free;
  722. dependent_units:=TLinkedList.Create;
  723. resourcefiles.Free;
  724. resourcefiles:=TCmdStrList.Create;
  725. linkunitofiles.Free;
  726. linkunitofiles:=TLinkContainer.Create;
  727. linkunitstaticlibs.Free;
  728. linkunitstaticlibs:=TLinkContainer.Create;
  729. linkunitsharedlibs.Free;
  730. linkunitsharedlibs:=TLinkContainer.Create;
  731. linkotherofiles.Free;
  732. linkotherofiles:=TLinkContainer.Create;
  733. linkotherstaticlibs.Free;
  734. linkotherstaticlibs:=TLinkContainer.Create;
  735. linkothersharedlibs.Free;
  736. linkothersharedlibs:=TLinkContainer.Create;
  737. linkotherframeworks.Free;
  738. linkotherframeworks:=TLinkContainer.Create;
  739. stringdispose(mainname);
  740. FImportLibraryList.Free;
  741. FImportLibraryList:=TFPHashObjectList.Create;
  742. do_compile:=false;
  743. do_reload:=false;
  744. interface_compiled:=false;
  745. in_interface:=true;
  746. in_global:=true;
  747. mode_switch_allowed:=true;
  748. stringdispose(deprecatedmsg);
  749. stringdispose(namespace);
  750. tcinitcode.free;
  751. tcinitcode:=nil;
  752. moduleoptions:=[];
  753. is_dbginfo_written:=false;
  754. crc:=0;
  755. interface_crc:=0;
  756. indirect_crc:=0;
  757. flags:=0;
  758. mainfilepos.line:=0;
  759. mainfilepos.column:=0;
  760. mainfilepos.fileindex:=0;
  761. recompile_reason:=rr_unknown;
  762. {
  763. The following fields should not
  764. be reset:
  765. mainsource
  766. state
  767. loaded_from
  768. sources_avail
  769. }
  770. end;
  771. procedure tmodule.adddependency(callermodule:tmodule);
  772. begin
  773. { This is not needed for programs }
  774. if not callermodule.is_unit then
  775. exit;
  776. Message2(unit_u_add_depend_to,callermodule.modulename^,modulename^);
  777. dependent_units.concat(tdependent_unit.create(callermodule));
  778. end;
  779. procedure tmodule.flagdependent(callermodule:tmodule);
  780. var
  781. pm : tdependent_unit;
  782. begin
  783. { flag all units that depend on this unit for reloading }
  784. pm:=tdependent_unit(current_module.dependent_units.first);
  785. while assigned(pm) do
  786. begin
  787. { We do not have to reload the unit that wants to load
  788. this unit, unless this unit is already compiled during
  789. the loading }
  790. if (pm.u=callermodule) and
  791. (pm.u.state<>ms_compiled) then
  792. Message1(unit_u_no_reload_is_caller,pm.u.modulename^)
  793. else
  794. if pm.u.state=ms_second_compile then
  795. Message1(unit_u_no_reload_in_second_compile,pm.u.modulename^)
  796. else
  797. begin
  798. pm.u.do_reload:=true;
  799. Message1(unit_u_flag_for_reload,pm.u.modulename^);
  800. end;
  801. pm:=tdependent_unit(pm.next);
  802. end;
  803. end;
  804. function tmodule.addusedunit(hp:tmodule;inuses:boolean;usym:tunitsym):tused_unit;
  805. var
  806. pu : tused_unit;
  807. begin
  808. pu:=tused_unit.create(hp,in_interface,inuses,usym);
  809. used_units.concat(pu);
  810. addusedunit:=pu;
  811. end;
  812. procedure tmodule.updatemaps;
  813. var
  814. oldmapsize : longint;
  815. hp : tmodule;
  816. i : longint;
  817. begin
  818. { Extend unitmap }
  819. oldmapsize:=unitmapsize;
  820. unitmapsize:=loaded_units.count;
  821. reallocmem(unitmap,unitmapsize*sizeof(tunitmaprec));
  822. fillchar(unitmap[oldmapsize],(unitmapsize-oldmapsize)*sizeof(tunitmaprec),0);
  823. { Extend Derefmap }
  824. oldmapsize:=derefmapsize;
  825. derefmapsize:=loaded_units.count;
  826. reallocmem(derefmap,derefmapsize*sizeof(tderefmaprec));
  827. fillchar(derefmap[oldmapsize],(derefmapsize-oldmapsize)*sizeof(tderefmaprec),0);
  828. { Add all units to unitmap }
  829. hp:=tmodule(loaded_units.first);
  830. i:=0;
  831. while assigned(hp) do
  832. begin
  833. if hp.moduleid>=unitmapsize then
  834. internalerror(200501151);
  835. { Verify old entries }
  836. if (i<oldmapsize) then
  837. begin
  838. if (hp.moduleid<>i) or
  839. (unitmap[hp.moduleid].u<>hp) then
  840. internalerror(200501156);
  841. end
  842. else
  843. begin
  844. unitmap[hp.moduleid].u:=hp;
  845. unitmap[hp.moduleid].derefidx:=-1;
  846. end;
  847. inc(i);
  848. hp:=tmodule(hp.next);
  849. end;
  850. end;
  851. function tmodule.derefidx_unit(id:longint):longint;
  852. begin
  853. if id>=unitmapsize then
  854. internalerror(2005011511);
  855. if unitmap[id].derefidx=-1 then
  856. begin
  857. unitmap[id].derefidx:=derefmapcnt;
  858. inc(derefmapcnt);
  859. derefmap[unitmap[id].derefidx].u:=unitmap[id].u;
  860. end;
  861. if unitmap[id].derefidx>=derefmapsize then
  862. internalerror(2005011514);
  863. result:=unitmap[id].derefidx;
  864. end;
  865. function tmodule.resolve_unit(id:longint):tmodule;
  866. var
  867. hp : tmodule;
  868. begin
  869. if id>=derefmapsize then
  870. internalerror(200306231);
  871. result:=derefmap[id].u;
  872. if not assigned(result) then
  873. begin
  874. if not assigned(derefmap[id].modulename) or
  875. (derefmap[id].modulename^='') then
  876. internalerror(200501159);
  877. hp:=tmodule(loaded_units.first);
  878. while assigned(hp) do
  879. begin
  880. { only check for units. The main program is also
  881. as a unit in the loaded_units list. We simply need
  882. to ignore this entry (PFV) }
  883. if hp.is_unit and
  884. (hp.modulename^=derefmap[id].modulename^) then
  885. break;
  886. hp:=tmodule(hp.next);
  887. end;
  888. if not assigned(hp) then
  889. internalerror(2005011510);
  890. derefmap[id].u:=hp;
  891. result:=hp;
  892. end;
  893. end;
  894. procedure tmodule.allunitsused;
  895. var
  896. pu : tused_unit;
  897. begin
  898. pu:=tused_unit(used_units.first);
  899. while assigned(pu) do
  900. begin
  901. if assigned(pu.u.globalsymtable) then
  902. begin
  903. if unitmap[pu.u.moduleid].u<>pu.u then
  904. internalerror(200501157);
  905. { Give a note when the unit is not referenced, skip
  906. this is for units with an initialization/finalization }
  907. if (unitmap[pu.u.moduleid].refs=0) and
  908. pu.in_uses and
  909. ((pu.u.flags and (uf_init or uf_finalize))=0) then
  910. CGMessagePos2(pu.unitsym.fileinfo,sym_n_unit_not_used,pu.u.realmodulename^,realmodulename^);
  911. end;
  912. pu:=tused_unit(pu.next);
  913. end;
  914. end;
  915. procedure tmodule.end_of_parsing;
  916. begin
  917. { free asmdata }
  918. if assigned(asmdata) then
  919. begin
  920. asmdata.free;
  921. asmdata:=nil;
  922. end;
  923. { free scanner }
  924. if assigned(scanner) then
  925. begin
  926. if current_scanner=tscannerfile(scanner) then
  927. current_scanner:=nil;
  928. tscannerfile(scanner).free;
  929. scanner:=nil;
  930. end;
  931. { free symtable stack }
  932. if assigned(symtablestack) then
  933. begin
  934. symtablestack.free;
  935. symtablestack:=nil;
  936. end;
  937. if assigned(macrosymtablestack) then
  938. begin
  939. macrosymtablestack.free;
  940. macrosymtablestack:=nil;
  941. end;
  942. end;
  943. procedure tmodule.setmodulename(const s:string);
  944. begin
  945. stringdispose(modulename);
  946. stringdispose(realmodulename);
  947. modulename:=stringdup(upper(s));
  948. realmodulename:=stringdup(s);
  949. { also update asmlibrary names }
  950. current_asmdata.name:=modulename;
  951. end;
  952. procedure TModule.AddExternalImport(const libname,symname,symmangledname:string;
  953. OrdNr: longint;isvar:boolean;ImportByOrdinalOnly:boolean);
  954. var
  955. ImportLibrary,OtherIL : TImportLibrary;
  956. ImportSymbol : TImportSymbol;
  957. i : longint;
  958. begin
  959. ImportLibrary:=TImportLibrary(ImportLibraryList.Find(libname));
  960. if not assigned(ImportLibrary) then
  961. ImportLibrary:=TImportLibrary.Create(ImportLibraryList,libname);
  962. ImportSymbol:=TImportSymbol(ImportLibrary.ImportSymbolList.Find(symname));
  963. if not assigned(ImportSymbol) then
  964. begin
  965. { Check that the same name does not exist in another library }
  966. { If it does and the same mangled name is used, issue a warning }
  967. if ImportLibraryList.Count>1 then
  968. for i:=0 To ImportLibraryList.Count-1 do
  969. begin
  970. OtherIL:=TImportLibrary(ImportLibraryList.Items[i]);
  971. ImportSymbol:=TImportSymbol(OtherIL.ImportSymbolList.Find(symname));
  972. if assigned(ImportSymbol) then
  973. begin
  974. if ImportSymbol.MangledName=symmangledname then
  975. begin
  976. CGMessage3(sym_w_library_overload,symname,libname,OtherIL.Name);
  977. break;
  978. end;
  979. end;
  980. end;
  981. if not ImportByOrdinalOnly then
  982. { negative ordinal number indicates import by name with ordinal number as hint }
  983. OrdNr:=-OrdNr;
  984. ImportSymbol:=TImportSymbol.Create(ImportLibrary.ImportSymbolList,
  985. symname,symmangledname,OrdNr,isvar);
  986. end;
  987. end;
  988. initialization
  989. {$ifdef MEMDEBUG}
  990. memsymtable:=TMemDebug.create('Symtables');
  991. memsymtable.stop;
  992. {$endif MEMDEBUG}
  993. finalization
  994. {$ifdef MEMDEBUG}
  995. memsymtable.free;
  996. {$endif MEMDEBUG}
  997. end.