fmodule.pas 45 KB

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