2
0

fmodule.pas 55 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635
  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. { Although 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. {$IFDEF EnableCTaskPPU}
  47. ,rr_buildcycle
  48. {$ENDIF}
  49. );
  50. {$ifdef VER3_2}
  51. RTLString = ansistring;
  52. {$endif VER3_2}
  53. { unit options }
  54. tmoduleoption = (mo_none,
  55. mo_hint_deprecated,
  56. mo_hint_platform,
  57. mo_hint_library,
  58. mo_hint_unimplemented,
  59. mo_hint_experimental,
  60. mo_has_deprecated_msg
  61. );
  62. tmoduleoptions = set of tmoduleoption;
  63. tlinkcontaineritem=class(tlinkedlistitem)
  64. public
  65. data : TPathStr;
  66. needlink : cardinal;
  67. constructor Create(const s:TPathStr;m:cardinal);
  68. end;
  69. tlinkcontainer=class(tlinkedlist)
  70. procedure add(const s : TPathStr;m:cardinal);
  71. function get(var m:cardinal) : TPathStr;
  72. function getusemask(mask:cardinal) : TPathStr;
  73. function find(const s:TPathStr):boolean;
  74. end;
  75. tmodule = class;
  76. tused_unit = class;
  77. tunitmaprec = record
  78. u : tmodule;
  79. { number of references }
  80. refs : longint;
  81. { index in the derefmap }
  82. derefidx : longint;
  83. end;
  84. tunitmaparray = array of tunitmaprec;
  85. tderefmaprec = record
  86. u : tmodule;
  87. { modulename, used during ppu load }
  88. modulename : pshortstring;
  89. end;
  90. tderefmaparray = array of tderefmaprec;
  91. {$IFDEF EnableCTaskPPU}
  92. tqueue_module_event = procedure(m: tmodule) of object;
  93. {$ENDIF}
  94. { tused_unit }
  95. tused_unit = class(tlinkedlistitem)
  96. checksum,
  97. interface_checksum,
  98. indirect_checksum: cardinal;
  99. in_uses,
  100. in_interface : boolean;
  101. u : tmodule;
  102. unitsym : tunitsym;
  103. {$IFDEF EnableCTaskPPU}
  104. dependent_added : boolean;
  105. {$ENDIF}
  106. constructor create(_u : tmodule;intface,inuses:boolean;usym:tunitsym);
  107. procedure check_hints;
  108. end;
  109. tdependent_unit = class(tlinkedlistitem)
  110. u : tmodule;
  111. in_interface : boolean;
  112. constructor create(_u : tmodule; frominterface : boolean);
  113. end;
  114. { tmodule }
  115. tmodule = class(tmodulebase)
  116. private
  117. FImportLibraryList : TFPHashObjectList;
  118. public
  119. is_reset, { has reset been called ? }
  120. do_reload, { force reloading of the unit }
  121. {$IFDEF EnableCTaskPPU}
  122. fromppu: boolean;
  123. {$ENDIF}
  124. sources_avail, { if all sources are reachable }
  125. interface_compiled, { if the interface section has been parsed/compiled/loaded }
  126. is_dbginfo_written,
  127. is_unit,
  128. in_interface, { processing the implementation part? }
  129. { allow global settings }
  130. in_global : boolean;
  131. { Whether a mode switch is still allowed at this point in the parsing.}
  132. mode_switch_allowed,
  133. { generate pic helper which loads eip in ecx (for leave procedures) }
  134. requires_ecx_pic_helper,
  135. { generate pic helper which loads eip in ebx (for non leave procedures) }
  136. requires_ebx_pic_helper : boolean;
  137. interface_only: boolean; { interface-only macpas unit; flag does not need saving/restoring to ppu }
  138. mainfilepos : tfileposinfo;
  139. recompile_reason : trecompile_reason; { the reason why the unit should be recompiled }
  140. crc_final: boolean;
  141. crc,
  142. interface_crc,
  143. indirect_crc : cardinal;
  144. headerflags : cardinal; { the PPU header flags }
  145. longversion : cardinal; { longer version than what fits in the ppu header }
  146. moduleflags : tmoduleflags; { ppu flags that do not need to be known by just reading the ppu header }
  147. islibrary : boolean; { if it is a library (win32 dll) }
  148. IsPackage : boolean;
  149. change_endian : boolean; { if the unit is loaded on a system with a different endianess than it was compiled on }
  150. moduleid : longint;
  151. unitmap : tunitmaparray; { mapping of all used units }
  152. unitmapsize : longint; { number of units in the map }
  153. derefmap : tderefmaparray; { mapping of all units needed for deref }
  154. derefmapcnt : longint; { number of units in the map }
  155. derefmapsize : longint; { number of units in the map }
  156. derefdataintflen : longint;
  157. derefdata : tdynamicarray;
  158. checkforwarddefs,
  159. deflist,
  160. symlist : TFPObjectList;
  161. forwardgenericdefs : TFPHashObjectList; { contains a list of specializations of a forward declared generic (the key) }
  162. ptrdefs : THashSet; { list of pointerdefs created in this module so we can reuse them (not saved/restored) }
  163. arraydefs : THashSet; { list of single-element-arraydefs created in this module so we can reuse them (not saved/restored) }
  164. procaddrdefs : THashSet; { list of procvardefs created when getting the address of a procdef (not saved/restored) }
  165. {$ifdef llvm}
  166. llvmdefs : THashSet; { defs added for llvm-specific reasons (not saved/restored) }
  167. 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) }
  168. 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) }
  169. llvminitprocs,
  170. llvmfiniprocs : TFPList;
  171. llvmmetadatastrings: TFPHashList; { metadata strings (mapping string -> superregister) }
  172. {$endif llvm}
  173. ansistrdef : tobject; { an ansistring def redefined for the current module }
  174. wpoinfo : tunitwpoinfobase; { whole program optimization-related information that is generated during the current run for this unit }
  175. globalsymtable, { pointer to the global symtable of this unit }
  176. localsymtable : TSymtable;{ pointer to the local symtable of this unit }
  177. globalmacrosymtable, { pointer to the global macro symtable of this unit }
  178. localmacrosymtable : TSymtable;{ pointer to the local macro symtable of this unit }
  179. mainscanner : TObject; { scanner object used }
  180. scanner : TObject; { scanner object used }
  181. procinfo : TObject; { current procedure being compiled }
  182. asmdata : TObject; { Assembler data }
  183. asmprefix : pshortstring; { prefix for the smartlink asmfiles }
  184. publicasmsyms : TFPHashObjectList; { contains the assembler symbols which need to be exported from a package }
  185. externasmsyms : TFPHashObjectList; { contains the assembler symbols which are imported from another unit }
  186. unitimportsyms : tfpobjectlist; { list of symbols that are imported from other units }
  187. debuginfo : TObject;
  188. _exports : tlinkedlist;
  189. dllscannerinputlist : TFPHashList;
  190. localnamespacelist,
  191. resourcefiles,
  192. linkorderedsymbols : TCmdStrList;
  193. linkunitofiles,
  194. linkunitstaticlibs,
  195. linkunitsharedlibs,
  196. linkotherofiles, { objects,libs loaded from the source }
  197. linkothersharedlibs, { using $L or $LINKLIB or import lib (for linux) }
  198. linkotherstaticlibs,
  199. linkotherframeworks : tlinkcontainer;
  200. mainname : pshortstring; { alternate name for "main" procedure }
  201. package : tpackage;
  202. used_units : tlinkedlist; { list of tused_unit }
  203. dependent_units : tlinkedlist;
  204. localunitsearchpath, { local searchpaths }
  205. localobjectsearchpath,
  206. localincludesearchpath,
  207. locallibrarysearchpath,
  208. localframeworksearchpath : TSearchPathList;
  209. moduleoptions: tmoduleoptions;
  210. deprecatedmsg: pshortstring;
  211. loadcount : integer; // EnableCTaskPPU: remove
  212. compilecount : integer;
  213. consume_semicolon_after_uses : Boolean;
  214. initfinalchecked : boolean;
  215. functypechecked : boolean;
  216. { contains a list of types that are extended by helper types; the key is
  217. the full name of the type and the data is a TFPObjectList of
  218. tobjectdef instances (the helper defs) }
  219. extendeddefs: TFPHashObjectList;
  220. { contains a list of the current topmost non-generic symbol for a
  221. typename of which at least one generic exists; the key is the
  222. non-generic typename and the data is a TFPObjectList of tgenericdummyentry
  223. instances whereby the last one is the current top most one }
  224. genericdummysyms: TFPHashObjectList;
  225. { contains a list of specializations for which the method bodies need
  226. to be generated }
  227. pendingspecializations : TFPHashObjectList;
  228. { list of attributes that are used and thus need their construction
  229. functions generated }
  230. used_rtti_attrs: tfpobjectlist;
  231. { this contains a list of units (tmodule) that needs to be waited for until the
  232. unit can be finished (code generated, etc.); this is needed to handle
  233. specializations in circular unit usages correctly }
  234. waitingforunit: tfpobjectlist;
  235. { this contains a list of all units (tmodule) that are waiting for this unit to be
  236. finished }
  237. waitingunits: tfpobjectlist;
  238. finishstate: pointer;
  239. specializestate : pointer;
  240. namespace: pshortstring; { for JVM target: corresponds to Java package name }
  241. { for targets that initialise typed constants via explicit assignments
  242. instead of by generating an initialised data section (holds typed
  243. constant assignments at the module level; does not have to be saved
  244. into the ppu file, because translated into code during compilation)
  245. -- actual type: tnode (but fmodule should not depend on node) }
  246. tcinitcode : tobject;
  247. { the current extended rtti directive }
  248. rtti_directive : trtti_directive;
  249. {create creates a new module which name is stored in 's'. LoadedFrom
  250. points to the module calling it. It is nil for the first compiled
  251. module. This allow inheritance of all path lists. MUST pay attention
  252. to that when creating link.res!!!!(mazen)}
  253. constructor create(LoadedFrom:TModule;const amodulename: string; const afilename:TPathStr;_is_unit:boolean);
  254. destructor destroy;override;
  255. procedure reset(for_recompile: boolean);virtual;
  256. function statestr: string; virtual;
  257. procedure loadlocalnamespacelist;
  258. procedure adddependency(callermodule:tmodule; frominterface : boolean);
  259. procedure removedependency(callermodule:tmodule);
  260. function hasdependency(callermodule:tmodule): boolean;
  261. procedure flagdependent(callermodule:tmodule);
  262. {$IFDEF EnableCTaskPPU}
  263. procedure disconnect_depending_modules; virtual;
  264. function is_reload_needed(du: tdependent_unit): boolean; virtual; // true if reload needed after self changed
  265. class var queue_module: tqueue_module_event;
  266. {$ENDIF}
  267. procedure addimportedsym(sym:TSymEntry);
  268. function addusedunit(hp:tmodule;inuses:boolean;usym:tunitsym):tused_unit;
  269. function usesmodule_in_interface(m : tmodule) : boolean;
  270. function findusedunit(m : tmodule) : tused_unit;
  271. function usedunitsloaded(interface_units: boolean; out firstwaiting : tmodule): boolean;
  272. function nowaitingforunits(out firstwaiting : tmodule) : Boolean;
  273. function usedunitsfinalcrc(out firstwaiting : tmodule): boolean;
  274. procedure updatemaps;
  275. function derefidx_unit(id:longint):longint;
  276. function resolve_unit(id:longint):tmodule;
  277. procedure allunitsused;
  278. procedure end_of_parsing;virtual;
  279. procedure setmodulename(const s:string);
  280. procedure AddExternalImport(const libname,symname,symmangledname:string;OrdNr: longint;isvar:boolean;ImportByOrdinalOnly:boolean);
  281. procedure add_public_asmsym(sym:TAsmSymbol);
  282. procedure add_public_asmsym(const name:TSymStr;bind:TAsmsymbind;typ:Tasmsymtype);
  283. procedure add_extern_asmsym(sym:TAsmSymbol);
  284. procedure add_extern_asmsym(const name:TSymStr;bind:TAsmsymbind;typ:Tasmsymtype);
  285. procedure remove_from_waitingforunits(amodule : tmodule);
  286. property ImportLibraryList : TFPHashObjectList read FImportLibraryList;
  287. function ToString: RTLString; override;
  288. end;
  289. var
  290. main_module : tmodule; { Main module of the program }
  291. current_module : tmodule; { Current module which is compiled or loaded }
  292. compiled_module : tmodule; { Current module which is compiled }
  293. usedunits : tlinkedlist; { Used units for this program }
  294. loaded_units : tlinkedlist; { All loaded units }
  295. unloaded_units : tlinkedlist; { Units removed from loaded_units, to be freed }
  296. SmartLinkOFiles : TCmdStrList; { List of .o files which are generated,
  297. used to delete them after linking }
  298. procedure set_current_module(p:tmodule);
  299. function get_module(moduleindex : longint) : tmodule;
  300. function get_source_file(moduleindex,fileindex : longint) : tinputfile;
  301. procedure addloadedunit(hp:tmodule);
  302. function find_module_from_symtable(st:tsymtable):tmodule;
  303. implementation
  304. uses
  305. SysUtils,globals,
  306. verbose,systems,
  307. scanner,ppu,dbgbase,
  308. procinfo,symdef,symtype;
  309. {$ifdef MEMDEBUG}
  310. var
  311. memsymtable : TMemDebug;
  312. {$endif}
  313. {*****************************************************************************
  314. Global Functions
  315. *****************************************************************************}
  316. function find_module_from_symtable(st:tsymtable):tmodule;
  317. var
  318. hp : tmodule;
  319. begin
  320. result:=nil;
  321. hp:=tmodule(loaded_units.first);
  322. while assigned(hp) do
  323. begin
  324. if (hp.moduleid=st.moduleid) then
  325. begin
  326. result:=hp;
  327. exit;
  328. end;
  329. hp:=tmodule(hp.next);
  330. end;
  331. end;
  332. procedure set_current_module(p:tmodule);
  333. begin
  334. { save the state of the scanner }
  335. if assigned(current_scanner) then
  336. current_scanner.tempcloseinputfile;
  337. { set new module }
  338. current_module:=p;
  339. { restore previous module settings }
  340. Fillchar(current_filepos,sizeof(current_filepos),0);
  341. if assigned(current_module) then
  342. begin
  343. current_asmdata:=tasmdata(current_module.asmdata);
  344. current_debuginfo:=tdebuginfo(current_module.debuginfo);
  345. { restore scanner and file positions }
  346. set_current_scanner(tscannerfile(current_module.scanner));
  347. if assigned(current_scanner) then
  348. begin
  349. current_scanner.tempopeninputfile;
  350. current_scanner.gettokenpos;
  351. parser_current_file:=current_scanner.inputfile.name;
  352. end
  353. else
  354. begin
  355. current_filepos.moduleindex:=current_module.unit_index;
  356. parser_current_file:='';
  357. end;
  358. end
  359. else
  360. begin
  361. current_asmdata:=nil;
  362. set_current_scanner(nil);
  363. current_debuginfo:=nil;
  364. end;
  365. end;
  366. function get_module(moduleindex : longint) : tmodule;
  367. var
  368. hp : tmodule;
  369. begin
  370. result:=nil;
  371. if moduleindex=0 then
  372. exit;
  373. result:=current_module;
  374. if not(assigned(loaded_units)) then
  375. exit;
  376. hp:=tmodule(loaded_units.first);
  377. while assigned(hp) and (hp.unit_index<>moduleindex) do
  378. hp:=tmodule(hp.next);
  379. result:=hp;
  380. end;
  381. function get_source_file(moduleindex,fileindex : longint) : tinputfile;
  382. var
  383. hp : tmodule;
  384. begin
  385. hp:=get_module(moduleindex);
  386. if assigned(hp) then
  387. get_source_file:=hp.sourcefiles.get_file(fileindex)
  388. else
  389. get_source_file:=nil;
  390. end;
  391. procedure addloadedunit(hp:tmodule);
  392. begin
  393. hp.moduleid:=loaded_units.count;
  394. loaded_units.concat(hp);
  395. end;
  396. {****************************************************************************
  397. TLinkContainerItem
  398. ****************************************************************************}
  399. constructor TLinkContainerItem.Create(const s:TPathStr;m:cardinal);
  400. begin
  401. inherited Create;
  402. data:=s;
  403. needlink:=m;
  404. end;
  405. {****************************************************************************
  406. TLinkContainer
  407. ****************************************************************************}
  408. procedure TLinkContainer.add(const s : TPathStr;m:cardinal);
  409. begin
  410. inherited concat(TLinkContainerItem.Create(s,m));
  411. end;
  412. function TLinkContainer.get(var m:cardinal) : TPathStr;
  413. var
  414. p : tlinkcontaineritem;
  415. begin
  416. p:=tlinkcontaineritem(inherited getfirst);
  417. if p=nil then
  418. begin
  419. get:='';
  420. m:=0;
  421. end
  422. else
  423. begin
  424. get:=p.data;
  425. m:=p.needlink;
  426. p.free;
  427. p := nil;
  428. end;
  429. end;
  430. function TLinkContainer.getusemask(mask:cardinal) : TPathStr;
  431. var
  432. p : tlinkcontaineritem;
  433. found : boolean;
  434. begin
  435. found:=false;
  436. repeat
  437. p:=tlinkcontaineritem(inherited getfirst);
  438. if p=nil then
  439. begin
  440. getusemask:='';
  441. exit;
  442. end;
  443. getusemask:=p.data;
  444. found:=(p.needlink and mask)<>0;
  445. p.free;
  446. p := nil;
  447. until found;
  448. end;
  449. function TLinkContainer.find(const s:TPathStr):boolean;
  450. var
  451. newnode : tlinkcontaineritem;
  452. begin
  453. find:=false;
  454. newnode:=tlinkcontaineritem(First);
  455. while assigned(newnode) do
  456. begin
  457. if newnode.data=s then
  458. begin
  459. find:=true;
  460. exit;
  461. end;
  462. newnode:=tlinkcontaineritem(newnode.next);
  463. end;
  464. end;
  465. {****************************************************************************
  466. TUSED_UNIT
  467. ****************************************************************************}
  468. constructor tused_unit.create(_u : tmodule;intface,inuses:boolean;usym:tunitsym);
  469. begin
  470. u:=_u;
  471. in_interface:=intface;
  472. in_uses:=inuses;
  473. unitsym:=usym;
  474. if _u.state in [ms_compiled_waitcrc,ms_compiled,ms_processed] then
  475. begin
  476. checksum:=u.crc;
  477. interface_checksum:=u.interface_crc;
  478. indirect_checksum:=u.indirect_crc;
  479. end
  480. else
  481. begin
  482. checksum:=0;
  483. interface_checksum:=0;
  484. indirect_checksum:=0;
  485. end;
  486. end;
  487. procedure tused_unit.check_hints;
  488. var
  489. uname: pshortstring;
  490. begin
  491. uname:=u.realmodulename;
  492. if mo_hint_deprecated in u.moduleoptions then
  493. if (mo_has_deprecated_msg in u.moduleoptions) and (u.deprecatedmsg <> nil) then
  494. MessagePos2(unitsym.fileinfo,sym_w_deprecated_unit_with_msg,uname^,u.deprecatedmsg^)
  495. else
  496. MessagePos1(unitsym.fileinfo,sym_w_deprecated_unit,uname^);
  497. if mo_hint_experimental in u.moduleoptions then
  498. MessagePos1(unitsym.fileinfo,sym_w_experimental_unit,uname^);
  499. if mo_hint_platform in u.moduleoptions then
  500. MessagePos1(unitsym.fileinfo,sym_w_non_portable_unit,uname^);
  501. if mo_hint_library in u.moduleoptions then
  502. MessagePos1(unitsym.fileinfo,sym_w_library_unit,uname^);
  503. if mo_hint_unimplemented in u.moduleoptions then
  504. MessagePos1(unitsym.fileinfo,sym_w_non_implemented_unit,uname^);
  505. end;
  506. {****************************************************************************
  507. TDENPENDENT_UNIT
  508. ****************************************************************************}
  509. constructor tdependent_unit.create(_u: tmodule; frominterface: boolean);
  510. begin
  511. u:=_u;
  512. in_interface:=frominterface;
  513. end;
  514. {****************************************************************************
  515. TMODULE
  516. ****************************************************************************}
  517. constructor tmodule.create(LoadedFrom:TModule;const amodulename: string; const afilename:TPathStr;_is_unit:boolean);
  518. var
  519. n:string;
  520. fn:TPathStr;
  521. begin
  522. if amodulename='' then
  523. n:=ChangeFileExt(ExtractFileName(afilename),'')
  524. else
  525. n:=amodulename;
  526. if afilename='' then
  527. fn:=amodulename
  528. else
  529. fn:=afilename;
  530. { Programs have the name 'Program' to don't conflict with dup id's }
  531. if _is_unit then
  532. inherited create(amodulename)
  533. else
  534. inherited create('Program');
  535. mainsource:=fn;
  536. { Dos has the famous 8.3 limit :( }
  537. {$ifdef shortasmprefix}
  538. asmprefix:=stringdup(FixFileName('as'));
  539. {$else}
  540. asmprefix:=stringdup(FixFileName(n));
  541. {$endif}
  542. setfilename(fn,true);
  543. localunitsearchpath:=TSearchPathList.Create;
  544. localobjectsearchpath:=TSearchPathList.Create;
  545. localincludesearchpath:=TSearchPathList.Create;
  546. locallibrarysearchpath:=TSearchPathList.Create;
  547. localframeworksearchpath:=TSearchPathList.Create;
  548. used_units:=TLinkedList.Create;
  549. dependent_units:=TLinkedList.Create;
  550. localnamespacelist:=TCmdStrList.Create;
  551. resourcefiles:=TCmdStrList.Create;
  552. linkorderedsymbols:=TCmdStrList.Create;
  553. linkunitofiles:=TLinkContainer.Create;
  554. linkunitstaticlibs:=TLinkContainer.Create;
  555. linkunitsharedlibs:=TLinkContainer.Create;
  556. linkotherofiles:=TLinkContainer.Create;
  557. linkotherstaticlibs:=TLinkContainer.Create;
  558. linkothersharedlibs:=TLinkContainer.Create;
  559. linkotherframeworks:=TLinkContainer.Create;
  560. mainname:=nil;
  561. FImportLibraryList:=TFPHashObjectList.Create(true);
  562. crc_final:=false;
  563. crc:=0;
  564. interface_crc:=0;
  565. indirect_crc:=0;
  566. headerflags:=0;
  567. longversion:=0;
  568. moduleflags:=[];
  569. scanner:=nil;
  570. unitmap:=nil;
  571. unitmapsize:=0;
  572. derefmap:=nil;
  573. derefmapsize:=0;
  574. derefmapcnt:=0;
  575. derefdata:=TDynamicArray.Create(1024);
  576. derefdataintflen:=0;
  577. deflist:=TFPObjectList.Create(false);
  578. symlist:=TFPObjectList.Create(false);
  579. ptrdefs:=THashSet.Create(64,true,false);
  580. arraydefs:=THashSet.Create(64,true,false);
  581. procaddrdefs:=THashSet.Create(64,true,false);
  582. {$ifdef llvm}
  583. llvmdefs:=THashSet.Create(64,true,false);
  584. llvmusedsyms:=TFPObjectList.Create(true);
  585. llvmcompilerusedsyms:=TFPObjectList.Create(true);
  586. llvminitprocs:=TFPList.Create;
  587. llvmfiniprocs:=TFPList.Create;
  588. llvmmetadatastrings:=TFPHashList.Create;
  589. {$endif llvm}
  590. ansistrdef:=nil;
  591. wpoinfo:=nil;
  592. checkforwarddefs:=TFPObjectList.Create(false);
  593. forwardgenericdefs:=TFPHashObjectList.Create(true);
  594. extendeddefs:=TFPHashObjectList.Create(true);
  595. genericdummysyms:=tfphashobjectlist.create(true);
  596. pendingspecializations:=tfphashobjectlist.create(false);
  597. waitingforunit:=tfpobjectlist.create(false);
  598. waitingunits:=tfpobjectlist.create(false);
  599. used_rtti_attrs:=tfpobjectlist.create(false);
  600. globalsymtable:=nil;
  601. localsymtable:=nil;
  602. globalmacrosymtable:=nil;
  603. localmacrosymtable:=nil;
  604. do_reload:=false;
  605. sources_avail:=true;
  606. mainfilepos.line:=0;
  607. mainfilepos.column:=0;
  608. mainfilepos.fileindex:=0;
  609. recompile_reason:=rr_unknown;
  610. in_interface:=true;
  611. in_global:=true;
  612. is_unit:=_is_unit;
  613. islibrary:=false;
  614. ispackage:=false;
  615. change_endian:=false;
  616. is_dbginfo_written:=false;
  617. mode_switch_allowed:= true;
  618. moduleoptions:=[];
  619. deprecatedmsg:=nil;
  620. namespace:=nil;
  621. tcinitcode:=nil;
  622. _exports:=TLinkedList.Create;
  623. dllscannerinputlist:=TFPHashList.Create;
  624. asmdata:=casmdata.create(modulename);
  625. unitimportsyms:=TFPObjectList.Create(false);
  626. publicasmsyms:=TFPHashObjectList.Create(true);
  627. externasmsyms:=TFPHashObjectList.Create(true);
  628. InitDebugInfo(self,false);
  629. end;
  630. destructor tmodule.destroy;
  631. var
  632. i : longint;
  633. current_debuginfo_reset : boolean;
  634. begin
  635. unitmap:=nil;
  636. if assigned(derefmap) then
  637. begin
  638. for i:=0 to derefmapcnt-1 do
  639. stringdispose(derefmap[i].modulename);
  640. end;
  641. derefmap:=nil;
  642. if assigned(_exports) then
  643. freeandnil(_exports);
  644. if assigned(dllscannerinputlist) then
  645. freeandnil(dllscannerinputlist);
  646. if assigned(localnamespacelist) then
  647. freeandnil(localnamespacelist);
  648. if assigned(scanner) then
  649. begin
  650. { also update current_scanner if it was pointing
  651. to this module }
  652. if current_scanner=tscannerfile(scanner) then
  653. set_current_scanner(nil);
  654. freeandnil(scanner);
  655. end;
  656. if assigned(asmdata) then
  657. begin
  658. if current_asmdata=asmdata then
  659. current_asmdata:=nil;
  660. asmdata.free;
  661. asmdata := nil;
  662. end;
  663. if assigned(procinfo) then
  664. begin
  665. if current_procinfo=tprocinfo(procinfo) then
  666. begin
  667. current_procinfo:=nil;
  668. current_structdef:=nil;
  669. current_genericdef:=nil;
  670. current_specializedef:=nil;
  671. end;
  672. { release procinfo tree }
  673. tprocinfo(procinfo).destroy_tree;
  674. procinfo := nil;
  675. end;
  676. DoneDebugInfo(self,current_debuginfo_reset);
  677. used_units.free;
  678. used_units := nil;
  679. dependent_units.free;
  680. dependent_units := nil;
  681. resourcefiles.Free;
  682. resourcefiles := nil;
  683. linkorderedsymbols.Free;
  684. linkorderedsymbols := nil;
  685. linkunitofiles.Free;
  686. linkunitofiles := nil;
  687. linkunitstaticlibs.Free;
  688. linkunitstaticlibs := nil;
  689. linkunitsharedlibs.Free;
  690. linkunitsharedlibs := nil;
  691. linkotherofiles.Free;
  692. linkotherofiles := nil;
  693. linkotherstaticlibs.Free;
  694. linkotherstaticlibs := nil;
  695. linkothersharedlibs.Free;
  696. linkothersharedlibs := nil;
  697. linkotherframeworks.Free;
  698. linkotherframeworks := nil;
  699. stringdispose(mainname);
  700. externasmsyms.Free;
  701. externasmsyms := nil;
  702. publicasmsyms.Free;
  703. publicasmsyms := nil;
  704. unitimportsyms.Free;
  705. unitimportsyms := nil;
  706. FImportLibraryList.Free;
  707. FImportLibraryList := nil;
  708. extendeddefs.Free;
  709. extendeddefs := nil;
  710. genericdummysyms.free;
  711. genericdummysyms := nil;
  712. pendingspecializations.free;
  713. pendingspecializations := nil;
  714. waitingforunit.free;
  715. waitingforunit := nil;
  716. waitingunits.free;
  717. waitingunits := nil;
  718. used_rtti_attrs.free;
  719. used_rtti_attrs := nil;
  720. stringdispose(asmprefix);
  721. stringdispose(deprecatedmsg);
  722. stringdispose(namespace);
  723. tcinitcode.free;
  724. tcinitcode := nil;
  725. localunitsearchpath.Free;
  726. localunitsearchpath := nil;
  727. localobjectsearchpath.free;
  728. localobjectsearchpath := nil;
  729. localincludesearchpath.free;
  730. localincludesearchpath := nil;
  731. locallibrarysearchpath.free;
  732. locallibrarysearchpath := nil;
  733. localframeworksearchpath.free;
  734. localframeworksearchpath := nil;
  735. {$ifdef MEMDEBUG}
  736. memsymtable.start;
  737. {$endif}
  738. derefdata.free;
  739. derefdata := nil;
  740. if assigned(deflist) then
  741. begin
  742. for i:=0 to deflist.Count-1 do
  743. if assigned(deflist[i]) and
  744. (tdef(deflist[i]).registered_in_module=self) then
  745. tdef(deflist[i]).registered_in_module:=nil;
  746. deflist.free;
  747. deflist := nil;
  748. end;
  749. symlist.free;
  750. symlist := nil;
  751. ptrdefs.free;
  752. ptrdefs := nil;
  753. arraydefs.free;
  754. arraydefs := nil;
  755. procaddrdefs.free;
  756. procaddrdefs := nil;
  757. {$ifdef llvm}
  758. llvmdefs.free;
  759. llvmdefs := nil;
  760. llvmusedsyms.free;
  761. llvmusedsyms := nil;
  762. llvmcompilerusedsyms.free;
  763. llvmcompilerusedsyms := nil;
  764. llvminitprocs.free;
  765. llvminitprocs := nil;
  766. llvmfiniprocs.free;
  767. llvmfiniprocs := nil;
  768. llvmmetadatastrings.free;
  769. llvmmetadatastrings := nil;
  770. {$endif llvm}
  771. ansistrdef:=nil;
  772. wpoinfo.free;
  773. wpoinfo := nil;
  774. checkforwarddefs.free;
  775. checkforwarddefs := nil;
  776. forwardgenericdefs.free;
  777. forwardgenericdefs := nil;
  778. globalsymtable.free;
  779. globalsymtable := nil;
  780. localsymtable.free;
  781. localsymtable := nil;
  782. globalmacrosymtable.free;
  783. globalmacrosymtable := nil;
  784. localmacrosymtable.free;
  785. localmacrosymtable := nil;
  786. {$ifdef MEMDEBUG}
  787. memsymtable.stop;
  788. {$endif}
  789. inherited Destroy;
  790. end;
  791. procedure tmodule.reset(for_recompile: boolean);
  792. var
  793. i : longint;
  794. current_debuginfo_reset : boolean;
  795. m : tmodule;
  796. begin
  797. is_reset:=true;
  798. {$IFDEF EnableCTaskPPU}
  799. fromppu:=false;
  800. {$ENDIF}
  801. LoadCount:=0;
  802. if assigned(scanner) then
  803. begin
  804. { also update current_scanner if it was pointing
  805. to this module }
  806. if current_scanner=tscannerfile(scanner) then
  807. set_current_scanner(nil);
  808. freeandnil(scanner);
  809. end;
  810. if assigned(procinfo) then
  811. begin
  812. if current_procinfo=tprocinfo(procinfo) then
  813. begin
  814. current_procinfo:=nil;
  815. current_structdef:=nil;
  816. current_genericdef:=nil;
  817. current_specializedef:=nil;
  818. end;
  819. { release procinfo tree }
  820. tprocinfo(procinfo).destroy_tree;
  821. end;
  822. if assigned(asmdata) then
  823. begin
  824. if current_asmdata=asmdata then
  825. current_asmdata:=nil;
  826. asmdata.free;
  827. asmdata:=nil;
  828. end;
  829. DoneDebugInfo(self,current_debuginfo_reset);
  830. globalsymtable.free;
  831. globalsymtable:=nil;
  832. localsymtable.free;
  833. localsymtable:=nil;
  834. globalmacrosymtable.free;
  835. globalmacrosymtable:=nil;
  836. localmacrosymtable.free;
  837. localmacrosymtable:=nil;
  838. deflist.free;
  839. deflist:=TFPObjectList.Create(false);
  840. symlist.free;
  841. symlist:=TFPObjectList.Create(false);
  842. ptrdefs.free;
  843. ptrdefs:=THashSet.Create(64,true,false);
  844. arraydefs.free;
  845. arraydefs:=THashSet.Create(64,true,false);
  846. procaddrdefs.free;
  847. procaddrdefs:=THashSet.Create(64,true,false);
  848. {$ifdef llvm}
  849. llvmdefs.free;
  850. llvmdefs:=THashSet.Create(64,true,false);
  851. llvmusedsyms.free;
  852. llvmusedsyms:=TFPObjectList.Create(true);
  853. llvmcompilerusedsyms.free;
  854. llvmcompilerusedsyms:=TFPObjectList.Create(true);
  855. llvminitprocs.free;
  856. llvminitprocs:=TFPList.Create;
  857. llvmfiniprocs.free;
  858. llvmfiniprocs:=TFPList.Create;
  859. llvmmetadatastrings.free;
  860. llvmmetadatastrings:=TFPHashList.Create;
  861. {$endif llvm}
  862. ansistrdef:=nil;
  863. wpoinfo.free;
  864. wpoinfo:=nil;
  865. checkforwarddefs.free;
  866. checkforwarddefs:=TFPObjectList.Create(false);
  867. forwardgenericdefs.free;
  868. forwardgenericdefs:=TFPHashObjectList.Create(true);
  869. publicasmsyms.free;
  870. publicasmsyms:=TFPHashObjectList.Create(true);
  871. externasmsyms.free;
  872. externasmsyms:=TFPHashObjectList.Create(true);
  873. unitimportsyms.free;
  874. unitimportsyms:=TFPObjectList.Create(false);
  875. derefdata.free;
  876. derefdata:=TDynamicArray.Create(1024);
  877. unitmap:=nil;
  878. if assigned(derefmap) then
  879. begin
  880. for i:=0 to derefmapcnt-1 do
  881. stringdispose(derefmap[i].modulename);
  882. end;
  883. derefmap:=nil;
  884. unitmapsize:=0;
  885. derefmapsize:=0;
  886. derefmapcnt:=0;
  887. derefdataintflen:=0;
  888. sourcefiles.free;
  889. sourcefiles:=tinputfilemanager.create;
  890. asmdata:=casmdata.create(modulename);
  891. InitDebugInfo(self,current_debuginfo_reset);
  892. _exports.free;
  893. _exports:=tlinkedlist.create;
  894. dllscannerinputlist.free;
  895. dllscannerinputlist:=TFPHashList.create;
  896. { During reload, the list of used units cannot change.
  897. It can only change while recompiling.
  898. Because the used_units is used in loops in the load cycle(s) which
  899. can recurse into the same unit due to circular dependencies,
  900. we do not destroy the list, we only update the contents.
  901. As a result the loop variable does not get reset during the loop.
  902. For recompile, we recreate the list }
  903. if for_recompile then
  904. begin
  905. used_units.free;
  906. used_units:=TLinkedList.Create;
  907. end;
  908. // keep dependent_units
  909. resourcefiles.Free;
  910. resourcefiles:=TCmdStrList.Create;
  911. linkorderedsymbols.Free;
  912. linkorderedsymbols:=TCmdStrList.Create;
  913. pendingspecializations.free;
  914. pendingspecializations:=tfphashobjectlist.create(false);
  915. genericdummysyms.Free;
  916. genericdummysyms := tfphashobjectlist.create(true);
  917. extendeddefs.Free;
  918. extendeddefs:=TFPHashObjectList.Create(true);
  919. if assigned(waitingforunit) and
  920. (waitingforunit.count<>0) then
  921. begin
  922. Write(Self.modulename^, ' is reset while still waiting for units: ');
  923. for I:=0 to waitingforunit.Count-1 do
  924. begin
  925. M:=tmodule(waitingforunit.Items[i]);
  926. write(m.modulename^,' (state:',M.state,') ');
  927. end;
  928. Writeln;
  929. internalerror(2016070501);
  930. end;
  931. waitingforunit.free;
  932. waitingforunit:=tfpobjectlist.create(false);
  933. linkunitofiles.Free;
  934. linkunitofiles:=TLinkContainer.Create;
  935. linkunitstaticlibs.Free;
  936. linkunitstaticlibs:=TLinkContainer.Create;
  937. linkunitsharedlibs.Free;
  938. linkunitsharedlibs:=TLinkContainer.Create;
  939. linkotherofiles.Free;
  940. linkotherofiles:=TLinkContainer.Create;
  941. linkotherstaticlibs.Free;
  942. linkotherstaticlibs:=TLinkContainer.Create;
  943. linkothersharedlibs.Free;
  944. linkothersharedlibs:=TLinkContainer.Create;
  945. linkotherframeworks.Free;
  946. linkotherframeworks:=TLinkContainer.Create;
  947. stringdispose(mainname);
  948. FImportLibraryList.Free;
  949. FImportLibraryList:=TFPHashObjectList.Create;
  950. do_reload:=false;
  951. interface_compiled:=false;
  952. in_interface:=true;
  953. in_global:=true;
  954. mode_switch_allowed:=true;
  955. stringdispose(deprecatedmsg);
  956. stringdispose(namespace);
  957. tcinitcode.free;
  958. tcinitcode:=nil;
  959. localunitsearchpath.Free;
  960. localunitsearchpath:=TSearchPathList.Create;
  961. localobjectsearchpath.free;
  962. localobjectsearchpath:=TSearchPathList.Create;
  963. localincludesearchpath.free;
  964. localincludesearchpath:=TSearchPathList.Create;
  965. locallibrarysearchpath.free;
  966. locallibrarysearchpath:=TSearchPathList.Create;
  967. localframeworksearchpath.free;
  968. localframeworksearchpath:=TSearchPathList.Create;
  969. moduleoptions:=[];
  970. is_dbginfo_written:=false;
  971. crc_final:=false;
  972. crc:=0;
  973. interface_crc:=0;
  974. indirect_crc:=0;
  975. headerflags:=0;
  976. longversion:=0;
  977. moduleflags:=[];
  978. mainfilepos.line:=0;
  979. mainfilepos.column:=0;
  980. mainfilepos.fileindex:=0;
  981. recompile_reason:=rr_unknown;
  982. {
  983. The following fields should not
  984. be reset:
  985. mainsource
  986. state
  987. loaded_from
  988. sources_avail
  989. }
  990. end;
  991. procedure tmodule.loadlocalnamespacelist;
  992. var
  993. nsitem : TCmdStrListItem;
  994. begin
  995. // Copying local namespace list
  996. if premodule_namespacelist.Count>0 then
  997. begin
  998. nsitem:=TCmdStrListItem(premodule_namespacelist.First);
  999. while assigned(nsItem) do
  1000. begin
  1001. localnamespacelist.Concat(nsitem.Str);
  1002. nsItem:=TCmdStrListItem(nsitem.Next);
  1003. end;
  1004. premodule_namespacelist.Clear;
  1005. end;
  1006. current_namespacelist:=localnamespacelist;
  1007. end;
  1008. procedure tmodule.adddependency(callermodule: tmodule; frominterface: boolean);
  1009. begin
  1010. { This is not needed for programs }
  1011. if not callermodule.is_unit then
  1012. exit;
  1013. if hasdependency(callermodule) then exit;
  1014. Message2(unit_u_add_depend_to,callermodule.modulename^,modulename^);
  1015. dependent_units.concat(tdependent_unit.create(callermodule,frominterface));
  1016. end;
  1017. procedure tmodule.removedependency(callermodule: tmodule);
  1018. var
  1019. du, nextdu: tdependent_unit;
  1020. begin
  1021. du:=tdependent_unit(dependent_units.First);
  1022. while Assigned(du) do
  1023. begin
  1024. nextdu:=tdependent_unit(du.Next);
  1025. if du.u=callermodule then
  1026. dependent_units.Remove(du);
  1027. du:=nextdu;
  1028. end;
  1029. end;
  1030. function tmodule.hasdependency(callermodule: tmodule): boolean;
  1031. var
  1032. du: tdependent_unit;
  1033. begin
  1034. du:=tdependent_unit(dependent_units.First);
  1035. while Assigned(du) do
  1036. begin
  1037. if du.u=callermodule then
  1038. exit(true);
  1039. du:=tdependent_unit(du.Next);
  1040. end;
  1041. Result:=false;
  1042. end;
  1043. procedure tmodule.flagdependent(callermodule:tmodule);
  1044. var
  1045. dm : tdependent_unit;
  1046. m : tmodule;
  1047. begin
  1048. { flag all units that depend on this unit for reloading }
  1049. dm:=tdependent_unit(dependent_units.first);
  1050. while assigned(dm) do
  1051. begin
  1052. { We do not have to reload the unit that wants to load
  1053. this unit, unless this unit is already compiled during
  1054. the loading }
  1055. m:=dm.u;
  1056. {$IFDEF DEBUG_PPU_CYCLES}
  1057. writeln('PPUALGO tmodule.flagdependent ',modulename^,' state=',statestr,', is used by ',BoolToStr(dm.in_interface,'interface','implementation'),' of ',m.modulename^,' ',m.statestr);
  1058. {$ENDIF}
  1059. {$IFDEF EnableCTaskPPU}
  1060. if not m.do_reload and is_reload_needed(dm) then
  1061. begin
  1062. m.do_reload:=true;
  1063. Message1(unit_u_flag_for_reload,m.modulename^);
  1064. queue_module(m);
  1065. { We have to flag the units that depend on this unit even
  1066. though it didn't change, because they might also
  1067. indirectly depend on the unit that did change (e.g.,
  1068. in case rgobj, rgx86 and rgcpu have been compiled
  1069. already, and then rgobj is recompiled for some reason
  1070. -> rgx86 is re-reresolved, but the vmtentries of trgcpu
  1071. must also be re-resolved, because they will also contain
  1072. pointers to procdefs in the old trgobj (in case of a
  1073. recompile, all old defs are freed) }
  1074. flagdependent(m);
  1075. end;
  1076. {$ELSE}
  1077. if (m=callermodule) and (m.state<ms_compiled_waitcrc) then
  1078. Message1(unit_u_no_reload_is_caller,m.modulename^)
  1079. else if (m.state=ms_compile) then
  1080. Message1(unit_u_no_reload_in_second_compile,m.modulename^)
  1081. else
  1082. begin
  1083. m.do_reload:=true;
  1084. Message1(unit_u_flag_for_reload,m.modulename^);
  1085. end;
  1086. {$ENDIF}
  1087. dm:=tdependent_unit(dm.next);
  1088. end;
  1089. end;
  1090. function tmodule.statestr: string;
  1091. begin
  1092. str(state,Result);
  1093. if do_reload then
  1094. Result:='do_reload,'+Result;
  1095. end;
  1096. {$IFDEF EnableCTaskPPU}
  1097. procedure tmodule.disconnect_depending_modules;
  1098. var
  1099. uu: tused_unit;
  1100. begin
  1101. uu:=tused_unit(used_units.first);
  1102. while assigned(uu) do
  1103. begin
  1104. uu.u.removedependency(self);
  1105. uu.dependent_added:=false;
  1106. uu:=tused_unit(uu.next);
  1107. end;
  1108. end;
  1109. function tmodule.is_reload_needed(du: tdependent_unit): boolean;
  1110. begin
  1111. Result:=(du.u.state in [ms_compiling_waitfinish,ms_compiled_waitcrc,ms_compiled,ms_processed])
  1112. or (du.in_interface and du.u.interface_compiled);
  1113. // Note: see also the override in fppu.tppumodule
  1114. end;
  1115. {$ENDIF EnableCTaskPPU}
  1116. procedure tmodule.addimportedsym(sym:TSymEntry);
  1117. begin
  1118. if unitimportsyms.IndexOf(sym)<0 then
  1119. unitimportsyms.Add(sym);
  1120. end;
  1121. function tmodule.addusedunit(hp:tmodule;inuses:boolean;usym:tunitsym):tused_unit;
  1122. var
  1123. pu : tused_unit;
  1124. begin
  1125. pu:=tused_unit.create(hp,in_interface,inuses,usym);
  1126. used_units.concat(pu);
  1127. addusedunit:=pu;
  1128. end;
  1129. function tmodule.usedunitsloaded(interface_units : boolean; out firstwaiting : tmodule): boolean;
  1130. {$IFDEF EnableCTaskPPU}
  1131. var
  1132. uu: tused_unit;
  1133. ok: Boolean;
  1134. begin
  1135. Result:=true;
  1136. firstwaiting:=nil;
  1137. uu:=tused_unit(used_units.First);
  1138. while assigned(uu) do
  1139. begin
  1140. ok:=uu.u.interface_compiled and not uu.u.do_reload;
  1141. { $IFDEF DEBUG_CTASK_VERBOSE}
  1142. writeln(' ',ToString,' checking state of ', uu.u.ToString,' : ',uu.u.statestr,' : ',ok);
  1143. { $ENDIF}
  1144. if not ok then
  1145. begin
  1146. Result:=false;
  1147. firstwaiting:=uu.u;
  1148. {$IFNDEF DEBUG_CTASK_VERBOSE}
  1149. break;
  1150. {$ENDIF}
  1151. end;
  1152. uu:=tused_unit(uu.Next);
  1153. end;
  1154. end;
  1155. {$ELSE}
  1156. const
  1157. statesneeded : array[boolean] of tmodulestates = (
  1158. [ms_processed, ms_compiled, ms_compiling_waitimpl, ms_compiling_waitfinish, ms_compiled_waitcrc],
  1159. [ms_processed, ms_compiled, ms_compiling_waitimpl, ms_compiling_waitfinish, ms_compiled_waitcrc]);
  1160. var
  1161. itm : TLinkedListItem;
  1162. states : set of tmodulestate;
  1163. begin
  1164. Result:=True;
  1165. States:=statesneeded[interface_units];
  1166. itm:=self.used_units.First;
  1167. firstwaiting:=Nil;
  1168. while Result and assigned(itm) do
  1169. begin
  1170. result:=tused_unit(itm).u.state in states;
  1171. {$IFDEF DEBUG_CTASK_VERBOSE}writeln(' ',ToString,' checking state of ', tused_unit(itm).u.ToString,' : ',tused_unit(itm).u.state,' : ',Result);{$ENDIF}
  1172. if not result then
  1173. begin
  1174. if firstwaiting=Nil then
  1175. begin
  1176. firstwaiting:=tused_unit(itm).u;
  1177. {$IFNDEF DEBUG_CTASK_VERBOSE}
  1178. break;
  1179. {$ENDIF}
  1180. end;
  1181. end;
  1182. itm:=itm.Next;
  1183. end;
  1184. end;
  1185. {$ENDIF}
  1186. function tmodule.nowaitingforunits(out firstwaiting : tmodule): Boolean;
  1187. begin
  1188. firstwaiting:=nil;
  1189. Result:=waitingforunit.count=0;
  1190. If not Result then
  1191. firstwaiting:=tmodule(waitingforunit[0]);
  1192. end;
  1193. function tmodule.usedunitsfinalcrc(out firstwaiting: tmodule): boolean;
  1194. var
  1195. itm: TLinkedListItem;
  1196. begin
  1197. Result:=True;
  1198. itm:=self.used_units.First;
  1199. firstwaiting:=Nil;
  1200. while assigned(itm) do
  1201. begin
  1202. if not tused_unit(itm).u.crc_final then
  1203. begin
  1204. firstwaiting:=tused_unit(itm).u;
  1205. exit(false);
  1206. end;
  1207. itm:=itm.Next;
  1208. end;
  1209. end;
  1210. function tmodule.usesmodule_in_interface(m: tmodule): boolean;
  1211. var
  1212. u : tused_unit;
  1213. begin
  1214. result:=False;
  1215. u:=tused_unit(used_units.First);
  1216. while assigned(u) do
  1217. begin
  1218. if (u.u=m) then
  1219. exit(u.in_interface) ;
  1220. u:=tused_unit(u.next);
  1221. end;
  1222. end;
  1223. function tmodule.findusedunit(m: tmodule): tused_unit;
  1224. var
  1225. u : tused_unit;
  1226. begin
  1227. result:=nil;
  1228. u:=tused_unit(used_units.First);
  1229. while assigned(u) do
  1230. begin
  1231. if (u.u=m) then
  1232. exit(u);
  1233. u:=tused_unit(u.next);
  1234. end;
  1235. end;
  1236. procedure tmodule.updatemaps;
  1237. var
  1238. oldmapsize : longint;
  1239. hp : tmodule;
  1240. i : longint;
  1241. begin
  1242. { Extend unitmap }
  1243. oldmapsize:=unitmapsize;
  1244. unitmapsize:=loaded_units.count;
  1245. setlength(unitmap,unitmapsize);
  1246. { Extend Derefmap }
  1247. oldmapsize:=derefmapsize;
  1248. derefmapsize:=loaded_units.count;
  1249. setlength(derefmap,derefmapsize);
  1250. { Add all units to unitmap }
  1251. hp:=tmodule(loaded_units.first);
  1252. i:=0;
  1253. while assigned(hp) do
  1254. begin
  1255. if hp.moduleid>=unitmapsize then
  1256. internalerror(200501151);
  1257. { Verify old entries }
  1258. if (i<oldmapsize) then
  1259. begin
  1260. if (hp.moduleid<>i) or
  1261. (unitmap[hp.moduleid].u<>hp) then
  1262. internalerror(200501156);
  1263. end
  1264. else
  1265. begin
  1266. unitmap[hp.moduleid].u:=hp;
  1267. unitmap[hp.moduleid].derefidx:=-1;
  1268. end;
  1269. inc(i);
  1270. hp:=tmodule(hp.next);
  1271. end;
  1272. end;
  1273. function tmodule.derefidx_unit(id:longint):longint;
  1274. begin
  1275. if id>=unitmapsize then
  1276. internalerror(2005011511);
  1277. if unitmap[id].derefidx=-1 then
  1278. begin
  1279. unitmap[id].derefidx:=derefmapcnt;
  1280. inc(derefmapcnt);
  1281. derefmap[unitmap[id].derefidx].u:=unitmap[id].u;
  1282. end;
  1283. if unitmap[id].derefidx>=derefmapsize then
  1284. internalerror(2005011514);
  1285. result:=unitmap[id].derefidx;
  1286. end;
  1287. function tmodule.resolve_unit(id:longint):tmodule;
  1288. var
  1289. hp : tmodule;
  1290. begin
  1291. if id>=derefmapsize then
  1292. internalerror(200306231);
  1293. result:=derefmap[id].u;
  1294. if not assigned(result) then
  1295. begin
  1296. if not assigned(derefmap[id].modulename) or
  1297. (derefmap[id].modulename^='') then
  1298. internalerror(200501159);
  1299. hp:=tmodule(loaded_units.first);
  1300. while assigned(hp) do
  1301. begin
  1302. { only check for units. The main program is also
  1303. as a unit in the loaded_units list. We simply need
  1304. to ignore this entry (PFV) }
  1305. if hp.is_unit and
  1306. (hp.modulename^=derefmap[id].modulename^) then
  1307. break;
  1308. hp:=tmodule(hp.next);
  1309. end;
  1310. if not assigned(hp) then
  1311. internalerror(2005011510);
  1312. derefmap[id].u:=hp;
  1313. result:=hp;
  1314. end;
  1315. end;
  1316. procedure tmodule.allunitsused;
  1317. var
  1318. pu : tused_unit;
  1319. begin
  1320. pu:=tused_unit(used_units.first);
  1321. while assigned(pu) do
  1322. begin
  1323. if assigned(pu.u.globalsymtable) then
  1324. begin
  1325. if unitmap[pu.u.moduleid].u<>pu.u then
  1326. internalerror(200501157);
  1327. { Give a note when the unit is not referenced, skip
  1328. this is for units with an initialization/finalization }
  1329. if (unitmap[pu.u.moduleid].refs=0) and
  1330. pu.in_uses and
  1331. ((pu.u.moduleflags * [mf_init,mf_finalize])=[]) then
  1332. CGMessagePos2(pu.unitsym.fileinfo,sym_n_unit_not_used,pu.u.realmodulename^,realmodulename^);
  1333. end;
  1334. pu:=tused_unit(pu.next);
  1335. end;
  1336. end;
  1337. procedure tmodule.end_of_parsing;
  1338. begin
  1339. { free asmdata }
  1340. if assigned(asmdata) then
  1341. begin
  1342. asmdata.free;
  1343. asmdata:=nil;
  1344. end;
  1345. { free scanner }
  1346. if assigned(scanner) then
  1347. begin
  1348. if current_scanner=tscannerfile(scanner) then
  1349. set_current_scanner(nil);
  1350. FreeAndNil(scanner);
  1351. scanner:=nil;
  1352. end;
  1353. { free symtable stack }
  1354. if assigned(symtablestack) then
  1355. begin
  1356. symtablestack.free;
  1357. symtablestack:=nil;
  1358. end;
  1359. if assigned(macrosymtablestack) then
  1360. begin
  1361. macrosymtablestack.free;
  1362. macrosymtablestack:=nil;
  1363. end;
  1364. waitingforunit.free;
  1365. waitingforunit:=nil;
  1366. localmacrosymtable.free;
  1367. localmacrosymtable:=nil;
  1368. ptrdefs.free;
  1369. ptrdefs:=nil;
  1370. arraydefs.free;
  1371. arraydefs:=nil;
  1372. procaddrdefs.free;
  1373. procaddrdefs:=nil;
  1374. {$ifdef llvm}
  1375. llvmdefs.free;
  1376. llvmdefs:=nil;
  1377. {$endif llvm}
  1378. checkforwarddefs.free;
  1379. checkforwarddefs:=nil;
  1380. tcinitcode.free;
  1381. tcinitcode:=nil;
  1382. localunitsearchpath.free;
  1383. localunitsearchpath:=nil;
  1384. localobjectsearchpath.free;
  1385. localobjectsearchpath:=nil;
  1386. localincludesearchpath.free;
  1387. localincludesearchpath:=nil;
  1388. locallibrarysearchpath.free;
  1389. locallibrarysearchpath:=nil;
  1390. localframeworksearchpath.free;
  1391. localframeworksearchpath:=nil;
  1392. end;
  1393. procedure tmodule.setmodulename(const s:string);
  1394. begin
  1395. stringdispose(modulename);
  1396. stringdispose(realmodulename);
  1397. modulename:=stringdup(upper(s));
  1398. realmodulename:=stringdup(s);
  1399. { also update asmlibrary names }
  1400. current_asmdata.name:=modulename;
  1401. end;
  1402. procedure tmodule.AddExternalImport(const libname, symname, symmangledname: string; OrdNr: longint; isvar: boolean;
  1403. ImportByOrdinalOnly: boolean);
  1404. var
  1405. ImportLibrary,OtherIL : TImportLibrary;
  1406. ImportSymbol : TImportSymbol;
  1407. i : longint;
  1408. begin
  1409. ImportLibrary:=TImportLibrary(ImportLibraryList.Find(libname));
  1410. if not assigned(ImportLibrary) then
  1411. ImportLibrary:=TImportLibrary.Create(ImportLibraryList,libname);
  1412. ImportSymbol:=TImportSymbol(ImportLibrary.ImportSymbolList.Find(symname));
  1413. if not assigned(ImportSymbol) then
  1414. begin
  1415. { Check that the same name does not exist in another library }
  1416. { If it does and the same mangled name is used, issue a warning }
  1417. if ImportLibraryList.Count>1 then
  1418. for i:=0 To ImportLibraryList.Count-1 do
  1419. begin
  1420. OtherIL:=TImportLibrary(ImportLibraryList.Items[i]);
  1421. ImportSymbol:=TImportSymbol(OtherIL.ImportSymbolList.Find(symname));
  1422. if assigned(ImportSymbol) then
  1423. begin
  1424. if ImportSymbol.MangledName=symmangledname then
  1425. begin
  1426. CGMessage3(sym_w_library_overload,symname,libname,OtherIL.Name);
  1427. break;
  1428. end;
  1429. end;
  1430. end;
  1431. if not ImportByOrdinalOnly then
  1432. { negative ordinal number indicates import by name with ordinal number as hint }
  1433. OrdNr:=-OrdNr;
  1434. ImportSymbol:=TImportSymbol.Create(ImportLibrary.ImportSymbolList,
  1435. symname,symmangledname,OrdNr,isvar);
  1436. end;
  1437. end;
  1438. procedure tmodule.add_public_asmsym(sym:TAsmSymbol);
  1439. begin
  1440. add_public_asmsym(sym.name,sym.bind,sym.typ);
  1441. end;
  1442. procedure tmodule.add_public_asmsym(const name:TSymStr;bind:TAsmsymbind;typ:Tasmsymtype);
  1443. var
  1444. sym : tasmsymbol;
  1445. begin
  1446. { ToDo: check for AB_GLOBAL, AB_EXTERNAL? }
  1447. sym:=tasmsymbol(publicasmsyms.find(name));
  1448. if assigned(sym) then
  1449. begin
  1450. if (sym.bind<>bind) or (sym.typ<>typ) then
  1451. internalerror(2016070101);
  1452. exit;
  1453. end;
  1454. tasmsymbol.create(publicasmsyms,name,bind,typ);
  1455. end;
  1456. procedure tmodule.add_extern_asmsym(sym:TAsmSymbol);
  1457. begin
  1458. add_extern_asmsym(sym.name,sym.bind,sym.typ);
  1459. end;
  1460. procedure tmodule.add_extern_asmsym(const name:TSymStr;bind:TAsmsymbind;typ:Tasmsymtype);
  1461. var
  1462. sym : tasmsymbol;
  1463. begin
  1464. { ToDo: check for AB_EXTERNAL? }
  1465. sym:=tasmsymbol(externasmsyms.find(name));
  1466. if assigned(sym) then
  1467. begin
  1468. if (sym.bind<>bind) or (sym.typ<>typ) then
  1469. internalerror(2016070102);
  1470. exit;
  1471. end;
  1472. tasmsymbol.create(externasmsyms,name,bind,typ);
  1473. end;
  1474. procedure tmodule.remove_from_waitingforunits(amodule: tmodule);
  1475. begin
  1476. // It can be nil after when this is called after end_of_parsing was called.
  1477. if assigned(waitingforunit) then
  1478. waitingforunit.remove(amodule);
  1479. end;
  1480. function tmodule.ToString: RTLString;
  1481. begin
  1482. // Assigned self so we can detect nil.
  1483. if assigned(modulename) then
  1484. Result:='('+ModuleName^+')'
  1485. else
  1486. Result:='(<'+inttostr(ptrint(self))+'>)';
  1487. // Possibly add some state ?
  1488. end;
  1489. initialization
  1490. {$ifdef MEMDEBUG}
  1491. memsymtable:=TMemDebug.create('Symtables');
  1492. memsymtable.stop;
  1493. {$endif MEMDEBUG}
  1494. finalization
  1495. {$ifdef MEMDEBUG}
  1496. memsymtable.free;
  1497. memsymtable := nil;
  1498. {$endif MEMDEBUG}
  1499. end.