fmodule.pas 41 KB

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