fppu.pas 73 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198
  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 fppu;
  18. {$i fpcdefs.inc}
  19. { $define DEBUG_UNIT_CRC_CHANGES}
  20. { close ppufiles on system that are
  21. short on file handles like DOS system PM }
  22. {$ifdef GO32V2}
  23. {$define SHORT_ON_FILE_HANDLES}
  24. {$endif GO32V2}
  25. {$ifdef WATCOM}
  26. {$define SHORT_ON_FILE_HANDLES}
  27. {$endif WATCOM}
  28. interface
  29. uses
  30. cmsgs,verbose,
  31. cutils,cclasses,cstreams,
  32. globtype,globals,finput,fmodule,
  33. symbase,ppu,symtype;
  34. type
  35. { tppumodule }
  36. tppumodule = class(tmodule)
  37. ppufile : tcompilerppufile; { the PPU file }
  38. sourcefn : TPathStr; { Source specified with "uses .. in '..'" }
  39. comments : TCmdStrList;
  40. nsprefix : TCmdStr; { Namespace prefix the unit was found with }
  41. {$ifdef Test_Double_checksum}
  42. crc_array : pointer;
  43. crc_size : longint;
  44. crc_array2 : pointer;
  45. crc_size2 : longint;
  46. {$endif def Test_Double_checksum}
  47. constructor create(LoadedFrom:TModule;const amodulename: string; const afilename:TPathStr;_is_unit:boolean);
  48. destructor destroy;override;
  49. procedure reset;override;
  50. function openppufile:boolean;
  51. function openppustream(strm:TCStream):boolean;
  52. procedure getppucrc;
  53. procedure writeppu;
  54. procedure loadppu;
  55. function needrecompile:boolean;
  56. procedure setdefgeneration;
  57. procedure reload_flagged_units;
  58. procedure end_of_parsing;override;
  59. private
  60. unitimportsymsderefs : tfplist;
  61. { Each time a unit's defs are (re)created, its defsgeneration is
  62. set to the value of a global counter, and the global counter is
  63. increased. We only reresolve its dependent units' defs in case
  64. they have been resolved only for an older generation, in order to
  65. avoid endless resolving loops in case of cyclic dependencies. }
  66. defsgeneration : longint;
  67. function openppu(ppufiletime:longint):boolean;
  68. function search_unit_files(onlysource:boolean):boolean;
  69. function search_unit(onlysource,shortname:boolean):boolean;
  70. function loadfrompackage:boolean;
  71. procedure load_interface;
  72. procedure load_implementation;
  73. procedure load_usedunits;
  74. procedure printcomments;
  75. procedure queuecomment(const s:TMsgStr;v,w:longint);
  76. procedure buildderefunitimportsyms;
  77. procedure derefunitimportsyms;
  78. procedure freederefunitimportsyms;
  79. procedure writesourcefiles;
  80. procedure writeusedunit(intf:boolean);
  81. procedure writelinkcontainer(var p:tlinkcontainer;id:byte;strippath:boolean);
  82. procedure writederefmap;
  83. procedure writederefdata;
  84. procedure writeImportSymbols;
  85. procedure writeResources;
  86. procedure writeunitimportsyms;
  87. procedure writeasmsyms(kind:tunitasmlisttype;list:tfphashobjectlist);
  88. procedure readsourcefiles;
  89. procedure readloadunit;
  90. procedure readlinkcontainer(var p:tlinkcontainer);
  91. procedure readderefmap;
  92. procedure readderefdata;
  93. procedure readImportSymbols;
  94. procedure readResources;
  95. procedure readwpofile;
  96. procedure readunitimportsyms;
  97. procedure readasmsyms;
  98. {$IFDEF MACRO_DIFF_HINT}
  99. procedure writeusedmacro(p:TNamedIndexItem;arg:pointer);
  100. procedure writeusedmacros;
  101. procedure readusedmacros;
  102. {$ENDIF}
  103. end;
  104. function registerunit(callermodule:tmodule;const s : TIDString;const fn:string) : tppumodule;
  105. implementation
  106. uses
  107. SysUtils,
  108. cfileutl,
  109. systems,version,options,
  110. symtable, symsym,
  111. wpoinfo,
  112. scanner,
  113. aasmbase,ogbase,
  114. parser,
  115. comphook,
  116. entfile,fpkg,fpcp;
  117. var
  118. currentdefgeneration: longint;
  119. {****************************************************************************
  120. TPPUMODULE
  121. ****************************************************************************}
  122. constructor tppumodule.create(LoadedFrom:TModule;const amodulename: string; const afilename:TPathStr;_is_unit:boolean);
  123. begin
  124. inherited create(LoadedFrom,amodulename,afilename,_is_unit);
  125. ppufile:=nil;
  126. sourcefn:=afilename;
  127. unitimportsymsderefs:=tfplist.create;
  128. end;
  129. destructor tppumodule.Destroy;
  130. begin
  131. if assigned(ppufile) then
  132. ppufile.free;
  133. ppufile:=nil;
  134. comments.free;
  135. comments:=nil;
  136. { all derefs allocated with new
  137. are dispose'd inside this method }
  138. freederefunitimportsyms;
  139. unitimportsymsderefs.free;
  140. unitimportsymsderefs:=nil;
  141. inherited Destroy;
  142. end;
  143. procedure tppumodule.reset;
  144. begin
  145. inc(currentdefgeneration);
  146. if assigned(ppufile) then
  147. begin
  148. ppufile.free;
  149. ppufile:=nil;
  150. end;
  151. freederefunitimportsyms;
  152. unitimportsymsderefs.free;
  153. unitimportsymsderefs:=tfplist.create;
  154. inherited reset;
  155. end;
  156. procedure tppumodule.queuecomment(const s:TMsgStr;v,w:longint);
  157. begin
  158. if comments = nil then
  159. comments := TCmdStrList.create;
  160. comments.insert(s);
  161. end;
  162. procedure tppumodule.printcomments;
  163. var
  164. comment: string;
  165. begin
  166. if comments = nil then
  167. exit;
  168. { comments are inserted in reverse order }
  169. repeat
  170. comment := comments.getlast;
  171. if length(comment) = 0 then
  172. exit;
  173. do_comment(v_normal, comment);
  174. until false;
  175. end;
  176. function tppumodule.openppufile:boolean;
  177. var
  178. ppufiletime : longint;
  179. begin
  180. openppufile:=false;
  181. Message1(unit_t_ppu_loading,ppufilename,@queuecomment);
  182. { Get ppufile time (also check if the file exists) }
  183. ppufiletime:=getnamedfiletime(ppufilename);
  184. if ppufiletime=-1 then
  185. exit;
  186. { Open the ppufile }
  187. Message1(unit_u_ppu_name,ppufilename);
  188. ppufile:=tcompilerppufile.create(ppufilename);
  189. if not ppufile.openfile then
  190. begin
  191. ppufile.free;
  192. ppufile:=nil;
  193. Message(unit_u_ppu_file_too_short);
  194. exit;
  195. end;
  196. result:=openppu(ppufiletime);
  197. end;
  198. function tppumodule.openppustream(strm:TCStream):boolean;
  199. begin
  200. result:=false;
  201. { Open the ppufile }
  202. Message1(unit_u_ppu_name,ppufilename);
  203. ppufile:=tcompilerppufile.create(ppufilename);
  204. if not ppufile.openstream(strm) then
  205. begin
  206. ppufile.free;
  207. ppufile:=nil;
  208. Message(unit_u_ppu_file_too_short);
  209. exit;
  210. end;
  211. result:=openppu(-1);
  212. end;
  213. function tppumodule.openppu(ppufiletime:longint):boolean;
  214. begin
  215. openppu:=false;
  216. { check for a valid PPU file }
  217. if not ppufile.CheckPPUId then
  218. begin
  219. ppufile.free;
  220. ppufile:=nil;
  221. Message(unit_u_ppu_invalid_header);
  222. exit;
  223. end;
  224. { check for allowed PPU versions }
  225. if not (ppufile.getversion = CurrentPPUVersion) then
  226. begin
  227. Message1(unit_u_ppu_invalid_version,tostr(ppufile.getversion),@queuecomment);
  228. ppufile.free;
  229. ppufile:=nil;
  230. exit;
  231. end;
  232. { check the target processor }
  233. if tsystemcpu(ppufile.header.common.cpu)<>target_cpu then
  234. begin
  235. ppufile.free;
  236. ppufile:=nil;
  237. Message(unit_u_ppu_invalid_processor,@queuecomment);
  238. exit;
  239. end;
  240. { check target }
  241. if tsystem(ppufile.header.common.target)<>target_info.system then
  242. begin
  243. ppufile.free;
  244. ppufile:=nil;
  245. Message(unit_u_ppu_invalid_target,@queuecomment);
  246. exit;
  247. end;
  248. {$ifdef i8086}
  249. { check i8086 memory model flags }
  250. if ((ppufile.header.common.flags and uf_i8086_far_code)<>0) xor
  251. (current_settings.x86memorymodel in [mm_medium,mm_large,mm_huge]) then
  252. begin
  253. ppufile.free;
  254. ppufile:=nil;
  255. Message(unit_u_ppu_invalid_memory_model,@queuecomment);
  256. exit;
  257. end;
  258. if ((ppufile.header.common.flags and uf_i8086_far_data)<>0) xor
  259. (current_settings.x86memorymodel in [mm_compact,mm_large]) then
  260. begin
  261. ppufile.free;
  262. ppufile:=nil;
  263. Message(unit_u_ppu_invalid_memory_model,@queuecomment);
  264. exit;
  265. end;
  266. if ((ppufile.header.common.flags and uf_i8086_huge_data)<>0) xor
  267. (current_settings.x86memorymodel=mm_huge) then
  268. begin
  269. ppufile.free;
  270. ppufile:=nil;
  271. Message(unit_u_ppu_invalid_memory_model,@queuecomment);
  272. exit;
  273. end;
  274. if ((ppufile.header.common.flags and uf_i8086_cs_equals_ds)<>0) xor
  275. (current_settings.x86memorymodel=mm_tiny) then
  276. begin
  277. ppufile.free;
  278. ppufile:=nil;
  279. Message(unit_u_ppu_invalid_memory_model,@queuecomment);
  280. exit;
  281. end;
  282. if ((ppufile.header.common.flags and uf_i8086_ss_equals_ds)<>0) xor
  283. (current_settings.x86memorymodel in [mm_tiny,mm_small,mm_medium]) then
  284. begin
  285. ppufile.free;
  286. ppufile:=nil;
  287. Message(unit_u_ppu_invalid_memory_model,@queuecomment);
  288. exit;
  289. end;
  290. {$endif i8086}
  291. {$ifdef cpufpemu}
  292. { check if floating point emulation is on?
  293. fpu emulation isn't unit levelwise because it affects calling convention }
  294. if ((ppufile.header.common.flags and uf_fpu_emulation)<>0) xor
  295. (cs_fp_emulation in current_settings.moduleswitches) then
  296. begin
  297. ppufile.free;
  298. ppufile:=nil;
  299. Message(unit_u_ppu_invalid_fpumode,@queuecomment);
  300. exit;
  301. end;
  302. {$endif cpufpemu}
  303. { Load values to be access easier }
  304. flags:=ppufile.header.common.flags;
  305. crc:=ppufile.header.checksum;
  306. interface_crc:=ppufile.header.interface_checksum;
  307. indirect_crc:=ppufile.header.indirect_checksum;
  308. change_endian:=ppufile.change_endian;
  309. { Show Debug info }
  310. if ppufiletime<>-1 then
  311. Message1(unit_u_ppu_time,filetimestring(ppufiletime))
  312. else
  313. Message1(unit_u_ppu_time,'unknown');
  314. Message1(unit_u_ppu_flags,tostr(flags));
  315. Message1(unit_u_ppu_crc,hexstr(ppufile.header.checksum,8));
  316. Message1(unit_u_ppu_crc,hexstr(ppufile.header.interface_checksum,8)+' (intfc)');
  317. Message1(unit_u_ppu_crc,hexstr(ppufile.header.indirect_checksum,8)+' (indc)');
  318. Comment(V_used,'Number of definitions: '+tostr(ppufile.header.deflistsize));
  319. Comment(V_used,'Number of symbols: '+tostr(ppufile.header.symlistsize));
  320. do_compile:=false;
  321. openppu:=true;
  322. end;
  323. function tppumodule.search_unit_files(onlysource:boolean):boolean;
  324. var
  325. found : boolean;
  326. begin
  327. found:=false;
  328. if search_unit(onlysource,false) then
  329. found:=true;
  330. if (not found) and
  331. (length(modulename^)>8) and
  332. search_unit(onlysource,true) then
  333. found:=true;
  334. search_unit_files:=found;
  335. end;
  336. function tppumodule.search_unit(onlysource,shortname:boolean):boolean;
  337. var
  338. singlepathstring,
  339. filename : TCmdStr;
  340. Function UnitExists(const ext:string;var foundfile:TCmdStr;const prefix:TCmdStr):boolean;
  341. var
  342. s : tcmdstr;
  343. begin
  344. if CheckVerbosity(V_Tried) then
  345. Message1(unit_t_unitsearch,Singlepathstring+filename+ext);
  346. s:=FileName+ext;
  347. if prefix<>'' then
  348. s:=prefix+'.'+s;
  349. UnitExists:=FindFile(s,Singlepathstring,true,foundfile);
  350. end;
  351. Function PPUSearchPath(const s,prefix:TCmdStr):boolean;
  352. var
  353. found : boolean;
  354. hs,
  355. newname : TCmdStr;
  356. begin
  357. Found:=false;
  358. singlepathstring:=FixPath(s,false);
  359. { Check for PPU file }
  360. Found:=UnitExists(target_info.unitext,hs,prefix);
  361. if Found then
  362. Begin
  363. SetFileName(hs,false);
  364. if prefix<>'' then
  365. begin
  366. newname:=prefix+'.'+realmodulename^;
  367. stringdispose(realmodulename);
  368. realmodulename:=stringdup(newname);
  369. stringdispose(modulename);
  370. modulename:=stringdup(upper(newname));
  371. end;
  372. Found:=openppufile;
  373. End;
  374. PPUSearchPath:=Found;
  375. end;
  376. Function SourceSearchPath(const s,prefix:TCmdStr):boolean;
  377. var
  378. found : boolean;
  379. hs,
  380. newname : TCmdStr;
  381. begin
  382. Found:=false;
  383. singlepathstring:=FixPath(s,false);
  384. { Check for Sources }
  385. ppufile:=nil;
  386. do_compile:=true;
  387. recompile_reason:=rr_noppu;
  388. {Check for .pp file}
  389. Found:=UnitExists(sourceext,hs,prefix);
  390. if not Found then
  391. begin
  392. { Check for .pas }
  393. Found:=UnitExists(pasext,hs,prefix);
  394. end;
  395. if not Found and
  396. ((m_mac in current_settings.modeswitches) or
  397. (tf_p_ext_support in target_info.flags)) then
  398. begin
  399. { Check for .p, if mode is macpas}
  400. Found:=UnitExists(pext,hs,prefix);
  401. end;
  402. mainsource:='';
  403. if Found then
  404. begin
  405. sources_avail:=true;
  406. { Load Filenames when found }
  407. mainsource:=hs;
  408. SetFileName(hs,false);
  409. if prefix<>'' then
  410. begin
  411. newname:=prefix+'.'+realmodulename^;
  412. stringdispose(realmodulename);
  413. realmodulename:=stringdup(newname);
  414. stringdispose(modulename);
  415. modulename:=stringdup(upper(newname));
  416. end;
  417. end
  418. else
  419. sources_avail:=false;
  420. SourceSearchPath:=Found;
  421. end;
  422. Function SearchPath(const s,prefix:TCmdStr):boolean;
  423. var
  424. found : boolean;
  425. begin
  426. { First check for a ppu, then for the source }
  427. found:=false;
  428. if not onlysource then
  429. found:=PPUSearchPath(s,prefix);
  430. if not found then
  431. found:=SourceSearchPath(s,prefix);
  432. SearchPath:=found;
  433. end;
  434. Function SearchPathList(list:TSearchPathList;const prefix:TCmdStr):boolean;
  435. var
  436. hp : TCmdStrListItem;
  437. found : boolean;
  438. begin
  439. found:=false;
  440. hp:=TCmdStrListItem(list.First);
  441. while assigned(hp) do
  442. begin
  443. found:=SearchPath(hp.Str,prefix);
  444. if found then
  445. break;
  446. hp:=TCmdStrListItem(hp.next);
  447. end;
  448. SearchPathList:=found;
  449. end;
  450. function SearchPPUPaths(const prefix:TCmdStr):boolean;
  451. begin
  452. result:=PPUSearchPath('.',prefix);
  453. if (not result) and (outputpath<>'') then
  454. result:=PPUSearchPath(outputpath,prefix);
  455. if (not result) and Assigned(main_module) and (main_module.Path<>'') then
  456. result:=PPUSearchPath(main_module.Path,prefix);
  457. end;
  458. function SearchSourcePaths(const prefix:TCmdStr):boolean;
  459. begin
  460. result:=SourceSearchPath('.',prefix);
  461. if (not result) and Assigned(main_module) and (main_module.Path<>'') then
  462. result:=SourceSearchPath(main_module.Path,prefix);
  463. if (not result) and Assigned(loaded_from) then
  464. result:=SearchPathList(loaded_from.LocalUnitSearchPath,prefix);
  465. if not result then
  466. result:=SearchPathList(UnitSearchPath,prefix);
  467. end;
  468. var
  469. fnd : boolean;
  470. hs : TPathStr;
  471. nsitem : TCmdStrListItem;
  472. begin
  473. if shortname then
  474. filename:=FixFileName(Copy(realmodulename^,1,8))
  475. else
  476. filename:=FixFileName(realmodulename^);
  477. { try to find unit
  478. 1. look for ppu in cwd
  479. 2. look for ppu in outputpath if set, this is tp7 compatible (PFV)
  480. 3. look for ppu in maindir
  481. 4. look for the specified source file (from the uses line)
  482. 5. look for source in cwd
  483. 6. look for source in maindir
  484. 7. local unit pathlist
  485. 8. global unit pathlist
  486. 9. for each default namespace:
  487. repeat 1 - 3 and 5 - 8 with namespace as prefix }
  488. fnd:=false;
  489. if not onlysource then
  490. fnd:=SearchPPUPaths('');
  491. if (not fnd) and (sourcefn<>'') then
  492. begin
  493. { the full filename is specified so we can't use here the
  494. searchpath (PFV) }
  495. if CheckVerbosity(V_Tried) then
  496. Message1(unit_t_unitsearch,ChangeFileExt(sourcefn,sourceext));
  497. fnd:=FindFile(ChangeFileExt(sourcefn,sourceext),'',true,hs);
  498. if not fnd then
  499. begin
  500. if CheckVerbosity(V_Tried) then
  501. Message1(unit_t_unitsearch,ChangeFileExt(sourcefn,pasext));
  502. fnd:=FindFile(ChangeFileExt(sourcefn,pasext),'',true,hs);
  503. end;
  504. if not fnd and
  505. ((m_mac in current_settings.modeswitches) or
  506. (tf_p_ext_support in target_info.flags)) then
  507. begin
  508. if CheckVerbosity(V_Tried) then
  509. Message1(unit_t_unitsearch,ChangeFileExt(sourcefn,pext));
  510. fnd:=FindFile(ChangeFileExt(sourcefn,pext),'',true,hs);
  511. end;
  512. if fnd then
  513. begin
  514. sources_avail:=true;
  515. do_compile:=true;
  516. recompile_reason:=rr_noppu;
  517. mainsource:=hs;
  518. SetFileName(hs,false);
  519. end;
  520. end;
  521. if not fnd then
  522. begin
  523. fnd:=SearchSourcePaths('');
  524. if not fnd and (namespacelist.count>0) then
  525. begin
  526. nsitem:=TCmdStrListItem(namespacelist.first);
  527. while assigned(nsitem) do
  528. begin
  529. if not onlysource then
  530. begin
  531. fnd:=SearchPPUPaths(nsitem.str);
  532. if fnd then
  533. break;
  534. end;
  535. fnd:=SearchSourcePaths(nsitem.str);
  536. if fnd then
  537. break;
  538. nsitem:=TCmdStrListItem(nsitem.next);
  539. end;
  540. if assigned(nsitem) then
  541. nsprefix:=nsitem.str;
  542. end;
  543. end;
  544. search_unit:=fnd;
  545. end;
  546. function tppumodule.loadfrompackage: boolean;
  547. (*var
  548. singlepathstring,
  549. filename : TCmdStr;
  550. Function UnitExists(const ext:string;var foundfile:TCmdStr):boolean;
  551. begin
  552. if CheckVerbosity(V_Tried) then
  553. Message1(unit_t_unitsearch,Singlepathstring+filename);
  554. UnitExists:=FindFile(FileName,Singlepathstring,true,foundfile);
  555. end;
  556. Function PPUSearchPath(const s:TCmdStr):boolean;
  557. var
  558. found : boolean;
  559. hs : TCmdStr;
  560. begin
  561. Found:=false;
  562. singlepathstring:=FixPath(s,false);
  563. { Check for PPU file }
  564. Found:=UnitExists(target_info.unitext,hs);
  565. if Found then
  566. Begin
  567. SetFileName(hs,false);
  568. //Found:=OpenPPU;
  569. End;
  570. PPUSearchPath:=Found;
  571. end;
  572. Function SearchPathList(list:TSearchPathList):boolean;
  573. var
  574. hp : TCmdStrListItem;
  575. found : boolean;
  576. begin
  577. found:=false;
  578. hp:=TCmdStrListItem(list.First);
  579. while assigned(hp) do
  580. begin
  581. found:=PPUSearchPath(hp.Str);
  582. if found then
  583. break;
  584. hp:=TCmdStrListItem(hp.next);
  585. end;
  586. SearchPathList:=found;
  587. end;*)
  588. var
  589. pkg : ppackageentry;
  590. pkgunit : pcontainedunit;
  591. i,idx : longint;
  592. strm : TCStream;
  593. begin
  594. result:=false;
  595. for i:=0 to packagelist.count-1 do
  596. begin
  597. pkg:=ppackageentry(packagelist[i]);
  598. if not assigned(pkg^.package) then
  599. internalerror(2013053103);
  600. idx:=pkg^.package.containedmodules.FindIndexOf(modulename^);
  601. if idx>=0 then
  602. begin
  603. { the unit is part of this package }
  604. pkgunit:=pcontainedunit(pkg^.package.containedmodules[idx]);
  605. if not assigned(pkgunit^.module) then
  606. pkgunit^.module:=self;
  607. { ToDo: check whether we really don't need this anymore }
  608. {filename:=pkgunit^.ppufile;
  609. if not SearchPathList(unitsearchpath) then
  610. exit};
  611. strm:=tpcppackage(pkg^.package).getmodulestream(self);
  612. if not assigned(strm) then
  613. internalerror(2015103002);
  614. if not openppustream(strm) then
  615. exit;
  616. package:=pkg^.package;
  617. Message2(unit_u_loading_from_package,modulename^,pkg^.package.packagename^);
  618. { now load the unit and all used units }
  619. load_interface;
  620. setdefgeneration;
  621. load_usedunits;
  622. Message1(unit_u_finished_loading_unit,modulename^);
  623. result:=true;
  624. break;
  625. end;
  626. end;
  627. end;
  628. procedure tppumodule.buildderefunitimportsyms;
  629. var
  630. i : longint;
  631. deref : pderef;
  632. begin
  633. for i:=0 to unitimportsyms.count-1 do
  634. begin
  635. new(deref);
  636. deref^.build(unitimportsyms[i]);
  637. unitimportsymsderefs.add(deref);
  638. end;
  639. end;
  640. procedure tppumodule.derefunitimportsyms;
  641. var
  642. i : longint;
  643. sym : tsym;
  644. begin
  645. for i:=0 to unitimportsymsderefs.count-1 do
  646. begin
  647. sym:=tsym(pderef(unitimportsymsderefs[i])^.resolve);
  648. unitimportsyms.add(sym);
  649. end;
  650. end;
  651. procedure tppumodule.freederefunitimportsyms;
  652. var
  653. i : longint;
  654. deref : pderef;
  655. begin
  656. for i:=0 to unitimportsymsderefs.count-1 do
  657. begin
  658. deref:=pderef(unitimportsymsderefs[i]);
  659. system.dispose(deref);
  660. end;
  661. end;
  662. {**********************************
  663. PPU Reading/Writing Helpers
  664. ***********************************}
  665. {$IFDEF MACRO_DIFF_HINT}
  666. var
  667. is_initial: Boolean;
  668. procedure tppumodule.writeusedmacro(p:TNamedIndexItem;arg:pointer);
  669. begin
  670. if tmacro(p).is_used or is_initial then
  671. begin
  672. ppufile.putstring(p.name);
  673. ppufile.putboolean(is_initial);
  674. ppufile.putboolean(tmacro(p).is_used);
  675. end;
  676. end;
  677. procedure tppumodule.writeusedmacros;
  678. begin
  679. ppufile.do_crc:=false;
  680. is_initial:= true;
  681. initialmacrosymtable.foreach(@writeusedmacro,nil);
  682. is_initial:= false;
  683. if assigned(globalmacrosymtable) then
  684. globalmacrosymtable.foreach(@writeusedmacro,nil);
  685. localmacrosymtable.foreach(@writeusedmacro,nil);
  686. ppufile.writeentry(ibusedmacros);
  687. ppufile.do_crc:=true;
  688. end;
  689. {$ENDIF}
  690. procedure tppumodule.writesourcefiles;
  691. var
  692. hp : tinputfile;
  693. i,j : longint;
  694. begin
  695. { second write the used source files }
  696. ppufile.do_crc:=false;
  697. hp:=sourcefiles.files;
  698. { write source files directly in good order }
  699. j:=0;
  700. while assigned(hp) do
  701. begin
  702. inc(j);
  703. hp:=hp.ref_next;
  704. end;
  705. while j>0 do
  706. begin
  707. hp:=sourcefiles.files;
  708. for i:=1 to j-1 do
  709. hp:=hp.ref_next;
  710. ppufile.putstring(hp.inc_path+hp.name);
  711. ppufile.putlongint(hp.getfiletime);
  712. dec(j);
  713. end;
  714. ppufile.writeentry(ibsourcefiles);
  715. ppufile.do_crc:=true;
  716. end;
  717. procedure tppumodule.writeusedunit(intf:boolean);
  718. var
  719. hp : tused_unit;
  720. oldcrc : boolean;
  721. begin
  722. { write a reference for each used unit }
  723. hp:=tused_unit(used_units.first);
  724. while assigned(hp) do
  725. begin
  726. if hp.in_interface=intf then
  727. begin
  728. ppufile.putstring(hp.u.realmodulename^);
  729. { the checksum should not affect the crc of this unit ! (PFV) }
  730. oldcrc:=ppufile.do_crc;
  731. ppufile.do_crc:=false;
  732. ppufile.putlongint(longint(hp.checksum));
  733. ppufile.putlongint(longint(hp.interface_checksum));
  734. ppufile.putlongint(longint(hp.indirect_checksum));
  735. ppufile.do_crc:=oldcrc;
  736. { combine all indirect checksums from units used by this unit }
  737. if intf then
  738. ppufile.indirect_crc:=ppufile.indirect_crc xor hp.indirect_checksum;
  739. end;
  740. hp:=tused_unit(hp.next);
  741. end;
  742. ppufile.do_interface_crc:=true;
  743. ppufile.writeentry(ibloadunit);
  744. end;
  745. procedure tppumodule.writelinkcontainer(var p:tlinkcontainer;id:byte;strippath:boolean);
  746. var
  747. hcontainer : tlinkcontainer;
  748. s : TPathStr;
  749. mask : cardinal;
  750. begin
  751. hcontainer:=TLinkContainer.Create;
  752. while not p.empty do
  753. begin
  754. s:=p.get(mask);
  755. if strippath then
  756. ppufile.putstring(ExtractFileName(s))
  757. else
  758. ppufile.putstring(s);
  759. ppufile.putlongint(mask);
  760. hcontainer.add(s,mask);
  761. end;
  762. ppufile.writeentry(id);
  763. p.Free;
  764. p:=hcontainer;
  765. end;
  766. procedure tppumodule.writederefmap;
  767. var
  768. i : longint;
  769. oldcrc : boolean;
  770. begin
  771. { This does not influence crc }
  772. oldcrc:=ppufile.do_crc;
  773. ppufile.do_crc:=false;
  774. { The unit map used for resolving }
  775. ppufile.putlongint(derefmapcnt);
  776. for i:=0 to derefmapcnt-1 do
  777. begin
  778. if not assigned(derefmap[i].u) then
  779. internalerror(2005011512);
  780. ppufile.putstring(derefmap[i].u.modulename^)
  781. end;
  782. ppufile.writeentry(ibderefmap);
  783. ppufile.do_crc:=oldcrc;
  784. end;
  785. procedure tppumodule.writederefdata;
  786. var
  787. oldcrc : boolean;
  788. len,hlen : longint;
  789. buf : array[0..1023] of byte;
  790. begin
  791. if longword(derefdataintflen)>derefdata.size then
  792. internalerror(200310223);
  793. derefdata.seek(0);
  794. { Write interface data }
  795. len:=derefdataintflen;
  796. while (len>0) do
  797. begin
  798. if len>1024 then
  799. hlen:=1024
  800. else
  801. hlen:=len;
  802. derefdata.read(buf,hlen);
  803. ppufile.putdata(buf,hlen);
  804. dec(len,hlen);
  805. end;
  806. { Write implementation data, this does not influence crc }
  807. oldcrc:=ppufile.do_crc;
  808. ppufile.do_crc:=false;
  809. len:=derefdata.size-derefdataintflen;
  810. while (len>0) do
  811. begin
  812. if len>1024 then
  813. hlen:=1024
  814. else
  815. hlen:=len;
  816. derefdata.read(buf,hlen);
  817. ppufile.putdata(buf,hlen);
  818. dec(len,hlen);
  819. end;
  820. if derefdata.pos<>derefdata.size then
  821. internalerror(200310224);
  822. ppufile.do_crc:=oldcrc;
  823. ppufile.writeentry(ibderefdata);
  824. end;
  825. procedure tppumodule.writeImportSymbols;
  826. var
  827. i,j : longint;
  828. ImportLibrary : TImportLibrary;
  829. ImportSymbol : TImportSymbol;
  830. begin
  831. for i:=0 to ImportLibraryList.Count-1 do
  832. begin
  833. ImportLibrary:=TImportLibrary(ImportLibraryList[i]);
  834. ppufile.putstring(ImportLibrary.Name);
  835. ppufile.putlongint(ImportLibrary.ImportSymbolList.Count);
  836. for j:=0 to ImportLibrary.ImportSymbolList.Count-1 do
  837. begin
  838. ImportSymbol:=TImportSymbol(ImportLibrary.ImportSymbolList[j]);
  839. ppufile.putstring(ImportSymbol.Name);
  840. ppufile.putstring(ImportSymbol.MangledName);
  841. ppufile.putlongint(ImportSymbol.OrdNr);
  842. ppufile.putbyte(byte(ImportSymbol.IsVar));
  843. end;
  844. end;
  845. ppufile.writeentry(ibImportSymbols);
  846. end;
  847. procedure tppumodule.writeResources;
  848. var
  849. res : TCmdStrListItem;
  850. begin
  851. res:=TCmdStrListItem(ResourceFiles.First);
  852. while res<>nil do
  853. begin
  854. ppufile.putstring(res.FPStr);
  855. res:=TCmdStrListItem(res.Next);
  856. end;
  857. ppufile.writeentry(ibresources);
  858. end;
  859. procedure tppumodule.writeunitimportsyms;
  860. var
  861. i : longint;
  862. begin
  863. ppufile.putlongint(unitimportsymsderefs.count);
  864. for i:=0 to unitimportsymsderefs.count-1 do
  865. ppufile.putderef(pderef(unitimportsymsderefs[i])^);
  866. ppufile.writeentry(ibunitimportsyms);
  867. end;
  868. procedure tppumodule.writeasmsyms(kind:tunitasmlisttype;list:tfphashobjectlist);
  869. var
  870. i : longint;
  871. sym : TAsmSymbol;
  872. begin
  873. ppufile.putbyte(ord(kind));
  874. ppufile.putlongint(list.count);
  875. for i:=0 to list.count-1 do
  876. begin
  877. sym:=TAsmSymbol(list[i]);
  878. ppufile.putstring(sym.Name);
  879. ppufile.putbyte(ord(sym.bind));
  880. ppufile.putbyte(ord(sym.typ));
  881. end;
  882. ppufile.writeentry(ibasmsymbols);
  883. end;
  884. {$IFDEF MACRO_DIFF_HINT}
  885. {
  886. Define MACRO_DIFF_HINT for the whole compiler (and ppudump)
  887. to turn this facility on. Also the hint messages defined
  888. below must be commented in in the msg/errore.msg file.
  889. There is some problems with this, thats why it is shut off:
  890. At the first compilation, consider a macro which is not initially
  891. defined, but it is used (e g the check that it is undefined is true).
  892. Since it do not exist, there is no macro object where the is_used
  893. flag can be set. Later on when the macro is defined, and the ppu
  894. is opened, the check cannot detect this.
  895. Also, in which macro object should this flag be set ? It cant be set
  896. for macros in the initialmacrosymboltable since this table is shared
  897. between different files.
  898. }
  899. procedure tppumodule.readusedmacros;
  900. var
  901. hs : string;
  902. mac : tmacro;
  903. was_initial,
  904. was_used : boolean;
  905. {Reads macros which was defined or used when the module was compiled.
  906. This is done when a ppu file is open, before it possibly is parsed.}
  907. begin
  908. while not ppufile.endofentry do
  909. begin
  910. hs:=ppufile.getstring;
  911. was_initial:=ppufile.getboolean;
  912. was_used:=ppufile.getboolean;
  913. mac:=tmacro(initialmacrosymtable.Find(hs));
  914. if assigned(mac) then
  915. begin
  916. {$ifndef EXTDEBUG}
  917. { if we don't have the sources why tell }
  918. if sources_avail then
  919. {$endif ndef EXTDEBUG}
  920. if (not was_initial) and was_used then
  921. Message2(unit_h_cond_not_set_in_last_compile,hs,mainsource^);
  922. end
  923. else { not assigned }
  924. if was_initial and
  925. was_used then
  926. Message2(unit_h_cond_set_in_last_compile,hs,mainsource^);
  927. end;
  928. end;
  929. {$ENDIF}
  930. procedure tppumodule.readsourcefiles;
  931. var
  932. temp,hs : string;
  933. inc_path : string;
  934. temp_dir : TCmdStr;
  935. main_dir : TCmdStr;
  936. found,
  937. is_main : boolean;
  938. orgfiletime,
  939. source_time : longint;
  940. hp : tinputfile;
  941. begin
  942. sources_avail:=(flags and uf_release) = 0;
  943. is_main:=true;
  944. main_dir:='';
  945. while not ppufile.endofentry do
  946. begin
  947. hs:=SetDirSeparators(ppufile.getstring);
  948. inc_path:=ExtractFilePath(hs);
  949. orgfiletime:=ppufile.getlongint;
  950. temp_dir:='';
  951. if sources_avail then
  952. begin
  953. if (flags and uf_in_library)<>0 then
  954. begin
  955. sources_avail:=false;
  956. temp:=' library';
  957. end
  958. else if pos('Macro ',hs)=1 then
  959. begin
  960. { we don't want to find this file }
  961. { but there is a problem with file indexing !! }
  962. temp:='';
  963. end
  964. else
  965. begin
  966. { check the date of the source files:
  967. 1 path of ppu
  968. 2 path of main source
  969. 3 current dir
  970. 4 include/unit path }
  971. Source_Time:=GetNamedFileTime(path+hs);
  972. found:=false;
  973. if Source_Time<>-1 then
  974. hs:=path+hs
  975. else
  976. if not(is_main) then
  977. begin
  978. Source_Time:=GetNamedFileTime(main_dir+hs);
  979. if Source_Time<>-1 then
  980. hs:=main_dir+hs;
  981. end;
  982. if Source_Time=-1 then
  983. Source_Time:=GetNamedFileTime(hs);
  984. if (Source_Time=-1) then
  985. begin
  986. if is_main then
  987. found:=unitsearchpath.FindFile(hs,true,temp_dir)
  988. else
  989. found:=includesearchpath.FindFile(hs,true,temp_dir);
  990. if found then
  991. begin
  992. Source_Time:=GetNamedFileTime(temp_dir);
  993. if Source_Time<>-1 then
  994. hs:=temp_dir;
  995. end;
  996. end;
  997. if Source_Time<>-1 then
  998. begin
  999. if is_main then
  1000. main_dir:=ExtractFilePath(hs);
  1001. temp:=' time '+filetimestring(source_time);
  1002. if (orgfiletime<>-1) and
  1003. (source_time<>orgfiletime) then
  1004. begin
  1005. do_compile:=true;
  1006. recompile_reason:=rr_sourcenewer;
  1007. Message2(unit_u_source_modified,hs,ppufilename,@queuecomment);
  1008. temp:=temp+' *';
  1009. end;
  1010. end
  1011. else
  1012. begin
  1013. sources_avail:=false;
  1014. temp:=' not found';
  1015. end;
  1016. hp:=tdosinputfile.create(hs);
  1017. hp.inc_path:=inc_path;
  1018. { the indexing is wrong here PM }
  1019. sourcefiles.register_file(hp);
  1020. end;
  1021. end
  1022. else
  1023. begin
  1024. { still register the source module for proper error messages
  1025. since source_avail for the module is still false, this should not hurt }
  1026. sourcefiles.register_file(tdosinputfile.create(hs));
  1027. temp:=' not available';
  1028. end;
  1029. if is_main then
  1030. begin
  1031. mainsource:=hs;
  1032. end;
  1033. Message1(unit_u_ppu_source,hs+temp,@queuecomment);
  1034. is_main:=false;
  1035. end;
  1036. { check if we want to rebuild every unit, only if the sources are
  1037. available }
  1038. if do_build and sources_avail then
  1039. begin
  1040. do_compile:=true;
  1041. recompile_reason:=rr_build;
  1042. end;
  1043. end;
  1044. procedure tppumodule.readloadunit;
  1045. var
  1046. hs : string;
  1047. pu : tused_unit;
  1048. hp : tppumodule;
  1049. indchecksum,
  1050. intfchecksum,
  1051. checksum : cardinal;
  1052. begin
  1053. while not ppufile.endofentry do
  1054. begin
  1055. hs:=ppufile.getstring;
  1056. checksum:=cardinal(ppufile.getlongint);
  1057. intfchecksum:=cardinal(ppufile.getlongint);
  1058. indchecksum:=cardinal(ppufile.getlongint);
  1059. { set the state of this unit before registering, this is
  1060. needed for a correct circular dependency check }
  1061. hp:=registerunit(self,hs,'');
  1062. pu:=addusedunit(hp,false,nil);
  1063. pu.checksum:=checksum;
  1064. pu.interface_checksum:=intfchecksum;
  1065. pu.indirect_checksum:=indchecksum;
  1066. end;
  1067. in_interface:=false;
  1068. end;
  1069. procedure tppumodule.readlinkcontainer(var p:tlinkcontainer);
  1070. var
  1071. s : string;
  1072. m : longint;
  1073. begin
  1074. while not ppufile.endofentry do
  1075. begin
  1076. s:=ppufile.getstring;
  1077. m:=ppufile.getlongint;
  1078. p.add(s,m);
  1079. end;
  1080. end;
  1081. procedure tppumodule.readderefmap;
  1082. var
  1083. i : longint;
  1084. begin
  1085. { Load unit map used for resolving }
  1086. derefmapsize:=ppufile.getlongint;
  1087. derefmapcnt:=derefmapsize;
  1088. getmem(derefmap,derefmapsize*sizeof(tderefmaprec));
  1089. fillchar(derefmap^,derefmapsize*sizeof(tderefmaprec),0);
  1090. for i:=0 to derefmapsize-1 do
  1091. derefmap[i].modulename:=ppufile.getpshortstring;
  1092. end;
  1093. procedure tppumodule.readderefdata;
  1094. var
  1095. len,hlen : longint;
  1096. buf : array[0..1023] of byte;
  1097. begin
  1098. len:=ppufile.entrysize;
  1099. while (len>0) do
  1100. begin
  1101. if len>1024 then
  1102. hlen:=1024
  1103. else
  1104. hlen:=len;
  1105. ppufile.getdata(buf,hlen);
  1106. derefdata.write(buf,hlen);
  1107. dec(len,hlen);
  1108. end;
  1109. end;
  1110. procedure tppumodule.readImportSymbols;
  1111. var
  1112. j,
  1113. extsymcnt : longint;
  1114. ImportLibrary : TImportLibrary;
  1115. extsymname : string;
  1116. extsymmangledname : string;
  1117. extsymordnr : longint;
  1118. extsymisvar : boolean;
  1119. begin
  1120. while not ppufile.endofentry do
  1121. begin
  1122. ImportLibrary:=TImportLibrary.Create(ImportLibraryList,ppufile.getstring);
  1123. extsymcnt:=ppufile.getlongint;
  1124. for j:=0 to extsymcnt-1 do
  1125. begin
  1126. extsymname:=ppufile.getstring;
  1127. extsymmangledname:=ppufile.getstring;
  1128. extsymordnr:=ppufile.getlongint;
  1129. extsymisvar:=(ppufile.getbyte<>0);
  1130. TImportSymbol.Create(ImportLibrary.ImportSymbolList,extsymname,
  1131. extsymmangledname,extsymordnr,extsymisvar);
  1132. end;
  1133. end;
  1134. end;
  1135. procedure tppumodule.readResources;
  1136. begin
  1137. while not ppufile.endofentry do
  1138. resourcefiles.Insert(ppufile.getstring);
  1139. end;
  1140. procedure tppumodule.readwpofile;
  1141. var
  1142. orgwpofilename: string;
  1143. orgwpofiletime: longint;
  1144. begin
  1145. { check whether we are using the same wpo feedback input file as when
  1146. this unit was compiled (same file name and file date)
  1147. }
  1148. orgwpofilename:=ppufile.getstring;
  1149. orgwpofiletime:=ppufile.getlongint;
  1150. if (extractfilename(orgwpofilename)<>extractfilename(wpofeedbackinput)) or
  1151. (orgwpofiletime<>GetNamedFileTime(orgwpofilename)) then
  1152. { make sure we don't throw away a precompiled unit if the user simply
  1153. forgot to specify the right wpo feedback file
  1154. }
  1155. message3(unit_e_different_wpo_file,ppufilename,orgwpofilename,filetimestring(orgwpofiletime));
  1156. end;
  1157. procedure tppumodule.readunitimportsyms;
  1158. var
  1159. c,i : longint;
  1160. deref : pderef;
  1161. begin
  1162. c:=ppufile.getlongint;
  1163. for i:=0 to c-1 do
  1164. begin
  1165. new(deref);
  1166. ppufile.getderef(deref^);
  1167. unitimportsymsderefs.add(deref);
  1168. end;
  1169. end;
  1170. procedure tppumodule.readasmsyms;
  1171. var
  1172. c,i : longint;
  1173. name : TSymStr;
  1174. bind : TAsmsymbind;
  1175. typ : TAsmsymtype;
  1176. list : tfphashobjectlist;
  1177. begin
  1178. case tunitasmlisttype(ppufile.getbyte) of
  1179. ualt_public:
  1180. list:=publicasmsyms;
  1181. ualt_extern:
  1182. list:=externasmsyms;
  1183. else
  1184. internalerror(2016060301);
  1185. end;
  1186. c:=ppufile.getlongint;
  1187. for i:=0 to c-1 do
  1188. begin
  1189. name:=ppufile.getstring;
  1190. bind:=TAsmsymbind(ppufile.getbyte);
  1191. typ:=TAsmsymtype(ppufile.getbyte);
  1192. TAsmSymbol.Create(list,name,bind,typ);
  1193. end;
  1194. end;
  1195. procedure tppumodule.load_interface;
  1196. var
  1197. b : byte;
  1198. newmodulename : string;
  1199. begin
  1200. { read interface part }
  1201. repeat
  1202. b:=ppufile.readentry;
  1203. case b of
  1204. ibjvmnamespace :
  1205. begin
  1206. namespace:=ppufile.getpshortstring;
  1207. end;
  1208. ibmodulename :
  1209. begin
  1210. newmodulename:=ppufile.getstring;
  1211. if (cs_check_unit_name in current_settings.globalswitches) and
  1212. (upper(newmodulename)<>modulename^) then
  1213. Message2(unit_f_unit_name_error,realmodulename^,newmodulename);
  1214. stringdispose(modulename);
  1215. stringdispose(realmodulename);
  1216. modulename:=stringdup(upper(newmodulename));
  1217. realmodulename:=stringdup(newmodulename);
  1218. end;
  1219. ibfeatures :
  1220. begin
  1221. ppufile.getsmallset(features);
  1222. end;
  1223. ibmoduleoptions:
  1224. begin
  1225. ppufile.getsmallset(moduleoptions);
  1226. if mo_has_deprecated_msg in moduleoptions then
  1227. begin
  1228. stringdispose(deprecatedmsg);
  1229. deprecatedmsg:=ppufile.getpshortstring;
  1230. end;
  1231. end;
  1232. ibsourcefiles :
  1233. readsourcefiles;
  1234. {$IFDEF MACRO_DIFF_HINT}
  1235. ibusedmacros :
  1236. readusedmacros;
  1237. {$ENDIF}
  1238. ibloadunit :
  1239. readloadunit;
  1240. iblinkunitofiles :
  1241. readlinkcontainer(LinkUnitOFiles);
  1242. iblinkunitstaticlibs :
  1243. readlinkcontainer(LinkUnitStaticLibs);
  1244. iblinkunitsharedlibs :
  1245. readlinkcontainer(LinkUnitSharedLibs);
  1246. iblinkotherofiles :
  1247. readlinkcontainer(LinkotherOFiles);
  1248. iblinkotherstaticlibs :
  1249. readlinkcontainer(LinkotherStaticLibs);
  1250. iblinkothersharedlibs :
  1251. readlinkcontainer(LinkotherSharedLibs);
  1252. iblinkotherframeworks :
  1253. readlinkcontainer(LinkOtherFrameworks);
  1254. ibmainname:
  1255. begin
  1256. mainname:=ppufile.getpshortstring;
  1257. if (mainaliasname<>defaultmainaliasname) then
  1258. Message1(scan_w_multiple_main_name_overrides,mainaliasname);
  1259. mainaliasname:=mainname^;
  1260. end;
  1261. ibImportSymbols :
  1262. readImportSymbols;
  1263. ibderefmap :
  1264. readderefmap;
  1265. ibderefdata :
  1266. readderefdata;
  1267. ibresources:
  1268. readResources;
  1269. ibwpofile:
  1270. readwpofile;
  1271. ibendinterface :
  1272. break;
  1273. else
  1274. Message1(unit_f_ppu_invalid_entry,tostr(b));
  1275. end;
  1276. { we can already stop when we know that we must recompile }
  1277. if do_compile then
  1278. exit;
  1279. until false;
  1280. end;
  1281. procedure tppumodule.load_implementation;
  1282. var
  1283. b : byte;
  1284. begin
  1285. { read implementation part }
  1286. repeat
  1287. b:=ppufile.readentry;
  1288. case b of
  1289. ibloadunit :
  1290. readloadunit;
  1291. ibasmsymbols :
  1292. readasmsyms;
  1293. ibunitimportsyms:
  1294. readunitimportsyms;
  1295. ibendimplementation :
  1296. break;
  1297. else
  1298. Message1(unit_f_ppu_invalid_entry,tostr(b));
  1299. end;
  1300. until false;
  1301. end;
  1302. procedure tppumodule.writeppu;
  1303. begin
  1304. Message1(unit_u_ppu_write,realmodulename^);
  1305. { create unit flags }
  1306. if do_release then
  1307. flags:=flags or uf_release;
  1308. if assigned(localsymtable) then
  1309. flags:=flags or uf_local_symtable;
  1310. if (cs_checkpointer_called in current_settings.moduleswitches) then
  1311. flags:=flags or uf_checkpointer_called;
  1312. {$ifdef i8086}
  1313. if current_settings.x86memorymodel in [mm_medium,mm_large,mm_huge] then
  1314. flags:=flags or uf_i8086_far_code;
  1315. if current_settings.x86memorymodel in [mm_compact,mm_large] then
  1316. flags:=flags or uf_i8086_far_data;
  1317. if current_settings.x86memorymodel=mm_huge then
  1318. flags:=flags or uf_i8086_huge_data;
  1319. if current_settings.x86memorymodel=mm_tiny then
  1320. flags:=flags or uf_i8086_cs_equals_ds;
  1321. if current_settings.x86memorymodel in [mm_tiny,mm_small,mm_medium] then
  1322. flags:=flags or uf_i8086_ss_equals_ds;
  1323. {$endif i8086}
  1324. {$ifdef cpufpemu}
  1325. if (cs_fp_emulation in current_settings.moduleswitches) then
  1326. flags:=flags or uf_fpu_emulation;
  1327. {$endif cpufpemu}
  1328. {$ifdef Test_Double_checksum_write}
  1329. Assign(CRCFile,s+'.IMP');
  1330. Rewrite(CRCFile);
  1331. {$endif def Test_Double_checksum_write}
  1332. { create new ppufile }
  1333. ppufile:=tcompilerppufile.create(ppufilename);
  1334. if not ppufile.createfile then
  1335. Message(unit_f_ppu_cannot_write);
  1336. { first the (JVM) namespace }
  1337. if assigned(namespace) then
  1338. begin
  1339. ppufile.putstring(namespace^);
  1340. ppufile.writeentry(ibjvmnamespace);
  1341. end;
  1342. { the unitname }
  1343. ppufile.putstring(realmodulename^);
  1344. ppufile.writeentry(ibmodulename);
  1345. ppufile.putsmallset(moduleoptions);
  1346. if mo_has_deprecated_msg in moduleoptions then
  1347. ppufile.putstring(deprecatedmsg^);
  1348. ppufile.writeentry(ibmoduleoptions);
  1349. { write the alternate main procedure name if any }
  1350. if assigned(mainname) then
  1351. begin
  1352. ppufile.putstring(mainname^);
  1353. ppufile.writeentry(ibmainname);
  1354. end;
  1355. if cs_compilesystem in current_settings.moduleswitches then
  1356. begin
  1357. ppufile.putsmallset(features);
  1358. ppufile.writeentry(ibfeatures);
  1359. end;
  1360. writesourcefiles;
  1361. {$IFDEF MACRO_DIFF_HINT}
  1362. writeusedmacros;
  1363. {$ENDIF}
  1364. { write interface uses }
  1365. writeusedunit(true);
  1366. { write the objectfiles and libraries that come for this unit,
  1367. preserve the containers because they are still needed to load
  1368. the link.res.
  1369. All doesn't depend on the crc! It doesn't matter
  1370. if a unit is in a .o or .a file }
  1371. ppufile.do_crc:=false;
  1372. { write after source files, so that we know whether or not the compiler
  1373. will recompile the unit when checking whether the correct wpo file is
  1374. used (if it will recompile the unit anyway, it doesn't matter)
  1375. }
  1376. if (wpofeedbackinput<>'') then
  1377. begin
  1378. ppufile.putstring(wpofeedbackinput);
  1379. ppufile.putlongint(getnamedfiletime(wpofeedbackinput));
  1380. ppufile.writeentry(ibwpofile);
  1381. end;
  1382. writelinkcontainer(linkunitofiles,iblinkunitofiles,true);
  1383. writelinkcontainer(linkunitstaticlibs,iblinkunitstaticlibs,true);
  1384. writelinkcontainer(linkunitsharedlibs,iblinkunitsharedlibs,true);
  1385. writelinkcontainer(linkotherofiles,iblinkotherofiles,false);
  1386. writelinkcontainer(linkotherstaticlibs,iblinkotherstaticlibs,true);
  1387. writelinkcontainer(linkothersharedlibs,iblinkothersharedlibs,true);
  1388. writelinkcontainer(linkotherframeworks,iblinkotherframeworks,true);
  1389. writeImportSymbols;
  1390. writeResources;
  1391. ppufile.do_crc:=true;
  1392. { generate implementation deref data, the interface deref data is
  1393. already generated when calculating the interface crc }
  1394. if (cs_compilesystem in current_settings.moduleswitches) then
  1395. begin
  1396. tstoredsymtable(globalsymtable).buildderef;
  1397. derefdataintflen:=derefdata.size;
  1398. end
  1399. else
  1400. { the unit may have been re-resolved, in which case the current
  1401. position in derefdata is not necessarily at the end }
  1402. derefdata.seek(derefdata.size);
  1403. tstoredsymtable(globalsymtable).buildderefimpl;
  1404. tunitwpoinfo(wpoinfo).buildderef;
  1405. tunitwpoinfo(wpoinfo).buildderefimpl;
  1406. if assigned(globalmacrosymtable) and (globalmacrosymtable.SymList.count > 0) then
  1407. begin
  1408. tstoredsymtable(globalmacrosymtable).buildderef;
  1409. tstoredsymtable(globalmacrosymtable).buildderefimpl;
  1410. end;
  1411. if (flags and uf_local_symtable)<>0 then
  1412. tstoredsymtable(localsymtable).buildderef_registered;
  1413. buildderefunitimportsyms;
  1414. writederefmap;
  1415. writederefdata;
  1416. ppufile.writeentry(ibendinterface);
  1417. { write the symtable entries }
  1418. tstoredsymtable(globalsymtable).ppuwrite(ppufile);
  1419. if assigned(globalmacrosymtable) and (globalmacrosymtable.SymList.count > 0) then
  1420. begin
  1421. ppufile.putbyte(byte(true));
  1422. ppufile.writeentry(ibexportedmacros);
  1423. tstoredsymtable(globalmacrosymtable).ppuwrite(ppufile);
  1424. end
  1425. else
  1426. begin
  1427. ppufile.putbyte(byte(false));
  1428. ppufile.writeentry(ibexportedmacros);
  1429. end;
  1430. { everything after this doesn't affect the crc }
  1431. ppufile.do_crc:=false;
  1432. { write implementation uses }
  1433. writeusedunit(false);
  1434. { write all public assembler symbols }
  1435. writeasmsyms(ualt_public,publicasmsyms);
  1436. { write all external assembler symbols }
  1437. writeasmsyms(ualt_extern,externasmsyms);
  1438. { write all symbols imported from another unit }
  1439. writeunitimportsyms;
  1440. { end of implementation }
  1441. ppufile.writeentry(ibendimplementation);
  1442. { write static symtable
  1443. needed for local debugging of unit functions }
  1444. if (flags and uf_local_symtable)<>0 then
  1445. tstoredsymtable(localsymtable).ppuwrite(ppufile);
  1446. { write whole program optimisation-related information }
  1447. tunitwpoinfo(wpoinfo).ppuwrite(ppufile);
  1448. { the last entry ibend is written automatically }
  1449. { flush to be sure }
  1450. ppufile.flush;
  1451. { create and write header }
  1452. ppufile.header.common.size:=ppufile.size;
  1453. ppufile.header.checksum:=ppufile.crc;
  1454. ppufile.header.interface_checksum:=ppufile.interface_crc;
  1455. ppufile.header.indirect_checksum:=ppufile.indirect_crc;
  1456. ppufile.header.common.compiler:=wordversion;
  1457. ppufile.header.common.cpu:=word(target_cpu);
  1458. ppufile.header.common.target:=word(target_info.system);
  1459. ppufile.header.common.flags:=flags;
  1460. ppufile.header.deflistsize:=current_module.deflist.count;
  1461. ppufile.header.symlistsize:=current_module.symlist.count;
  1462. ppufile.writeheader;
  1463. { save crc in current module also }
  1464. crc:=ppufile.crc;
  1465. interface_crc:=ppufile.interface_crc;
  1466. indirect_crc:=ppufile.indirect_crc;
  1467. {$ifdef Test_Double_checksum_write}
  1468. close(CRCFile);
  1469. {$endif Test_Double_checksum_write}
  1470. ppufile.closefile;
  1471. ppufile.free;
  1472. ppufile:=nil;
  1473. end;
  1474. procedure tppumodule.getppucrc;
  1475. begin
  1476. {$ifdef Test_Double_checksum_write}
  1477. Assign(CRCFile,s+'.INT')
  1478. Rewrite(CRCFile);
  1479. {$endif def Test_Double_checksum_write}
  1480. { create new ppufile }
  1481. ppufile:=tcompilerppufile.create(ppufilename);
  1482. ppufile.crc_only:=true;
  1483. if not ppufile.createfile then
  1484. Message(unit_f_ppu_cannot_write);
  1485. { first the (JVM) namespace }
  1486. if assigned(namespace) then
  1487. begin
  1488. ppufile.putstring(namespace^);
  1489. ppufile.writeentry(ibjvmnamespace);
  1490. end;
  1491. { the unitname }
  1492. ppufile.putstring(realmodulename^);
  1493. ppufile.writeentry(ibmodulename);
  1494. ppufile.putsmallset(moduleoptions);
  1495. if mo_has_deprecated_msg in moduleoptions then
  1496. ppufile.putstring(deprecatedmsg^);
  1497. ppufile.writeentry(ibmoduleoptions);
  1498. { the interface units affect the crc }
  1499. writeusedunit(true);
  1500. { deref data of interface that affect the crc }
  1501. derefdata.reset;
  1502. tstoredsymtable(globalsymtable).buildderef;
  1503. derefdataintflen:=derefdata.size;
  1504. writederefmap;
  1505. writederefdata;
  1506. ppufile.writeentry(ibendinterface);
  1507. { write the symtable entries }
  1508. tstoredsymtable(globalsymtable).ppuwrite(ppufile);
  1509. if assigned(globalmacrosymtable) and (globalmacrosymtable.SymList.count > 0) then
  1510. begin
  1511. ppufile.putbyte(byte(true));
  1512. ppufile.writeentry(ibexportedmacros);
  1513. tstoredsymtable(globalmacrosymtable).ppuwrite(ppufile);
  1514. end
  1515. else
  1516. begin
  1517. ppufile.putbyte(byte(false));
  1518. ppufile.writeentry(ibexportedmacros);
  1519. end;
  1520. { save crc }
  1521. crc:=ppufile.crc;
  1522. interface_crc:=ppufile.interface_crc;
  1523. indirect_crc:=ppufile.indirect_crc;
  1524. { end of implementation, to generate a correct ppufile
  1525. for ppudump when using INTFPPU define }
  1526. ppufile.writeentry(ibendimplementation);
  1527. {$ifdef Test_Double_checksum}
  1528. crc_array:=ppufile.crc_test;
  1529. ppufile.crc_test:=nil;
  1530. crc_size:=ppufile.crc_index2;
  1531. crc_array2:=ppufile.crc_test2;
  1532. ppufile.crc_test2:=nil;
  1533. crc_size2:=ppufile.crc_index2;
  1534. {$endif Test_Double_checksum}
  1535. {$ifdef Test_Double_checksum_write}
  1536. close(CRCFile);
  1537. {$endif Test_Double_checksum_write}
  1538. { create and write header, this will only be used
  1539. for debugging purposes }
  1540. ppufile.header.common.size:=ppufile.size;
  1541. ppufile.header.checksum:=ppufile.crc;
  1542. ppufile.header.interface_checksum:=ppufile.interface_crc;
  1543. ppufile.header.indirect_checksum:=ppufile.indirect_crc;
  1544. ppufile.header.common.compiler:=wordversion;
  1545. ppufile.header.common.cpu:=word(target_cpu);
  1546. ppufile.header.common.target:=word(target_info.system);
  1547. ppufile.header.common.flags:=flags;
  1548. ppufile.writeheader;
  1549. ppufile.closefile;
  1550. ppufile.free;
  1551. ppufile:=nil;
  1552. end;
  1553. procedure tppumodule.load_usedunits;
  1554. var
  1555. pu : tused_unit;
  1556. begin
  1557. if current_module<>self then
  1558. internalerror(200212284);
  1559. { load the used units from interface }
  1560. in_interface:=true;
  1561. pu:=tused_unit(used_units.first);
  1562. while assigned(pu) do
  1563. begin
  1564. if pu.in_interface then
  1565. begin
  1566. tppumodule(pu.u).loadppu;
  1567. { if this unit is compiled we can stop }
  1568. if state=ms_compiled then
  1569. exit;
  1570. { add this unit to the dependencies }
  1571. pu.u.adddependency(self);
  1572. { need to recompile the current unit, check the interface
  1573. crc. And when not compiled with -Ur then check the complete
  1574. crc }
  1575. if (pu.u.interface_crc<>pu.interface_checksum) or
  1576. (pu.u.indirect_crc<>pu.indirect_checksum) or
  1577. (
  1578. ((ppufile.header.common.flags and uf_release)=0) and
  1579. (pu.u.crc<>pu.checksum)
  1580. ) then
  1581. begin
  1582. Message2(unit_u_recompile_crc_change,realmodulename^,pu.u.ppufilename,@queuecomment);
  1583. {$ifdef DEBUG_UNIT_CRC_CHANGES}
  1584. if (pu.u.interface_crc<>pu.interface_checksum) then
  1585. writeln(' intfcrc change: ',hexstr(pu.u.interface_crc,8),' <> ',hexstr(pu.interface_checksum,8))
  1586. else if (pu.u.indirect_crc<>pu.indirect_checksum) then
  1587. writeln(' indcrc change: ',hexstr(pu.u.indirect_crc,8),' <> ',hexstr(pu.indirect_checksum,8))
  1588. else
  1589. writeln(' implcrc change: ',hexstr(pu.u.crc,8),' <> ',hexstr(pu.checksum,8));
  1590. {$endif DEBUG_UNIT_CRC_CHANGES}
  1591. recompile_reason:=rr_crcchanged;
  1592. do_compile:=true;
  1593. exit;
  1594. end;
  1595. end;
  1596. pu:=tused_unit(pu.next);
  1597. end;
  1598. { ok, now load the interface of this unit }
  1599. if current_module<>self then
  1600. internalerror(200208187);
  1601. deflist.count:=ppufile.header.deflistsize;
  1602. symlist.count:=ppufile.header.symlistsize;
  1603. globalsymtable:=tglobalsymtable.create(modulename^,moduleid);
  1604. tstoredsymtable(globalsymtable).ppuload(ppufile);
  1605. if ppufile.readentry<>ibexportedmacros then
  1606. Message(unit_f_ppu_read_error);
  1607. if boolean(ppufile.getbyte) then
  1608. begin
  1609. globalmacrosymtable:=tmacrosymtable.Create(true);
  1610. tstoredsymtable(globalmacrosymtable).ppuload(ppufile)
  1611. end;
  1612. interface_compiled:=true;
  1613. { read the implementation part, containing
  1614. the implementation uses and ObjData }
  1615. in_interface:=false;
  1616. load_implementation;
  1617. { now only read the implementation uses }
  1618. pu:=tused_unit(used_units.first);
  1619. while assigned(pu) do
  1620. begin
  1621. if (not pu.in_interface) then
  1622. begin
  1623. tppumodule(pu.u).loadppu;
  1624. { if this unit is compiled we can stop }
  1625. if state=ms_compiled then
  1626. exit;
  1627. { add this unit to the dependencies }
  1628. pu.u.adddependency(self);
  1629. { need to recompile the current unit ? }
  1630. if (pu.u.interface_crc<>pu.interface_checksum) or
  1631. (pu.u.indirect_crc<>pu.indirect_checksum) then
  1632. begin
  1633. Message2(unit_u_recompile_crc_change,realmodulename^,pu.u.ppufilename+' {impl}',@queuecomment);
  1634. {$ifdef DEBUG_UNIT_CRC_CHANGES}
  1635. if (pu.u.interface_crc<>pu.interface_checksum) then
  1636. writeln(' intfcrc change (2): ',hexstr(pu.u.interface_crc,8),' <> ',hexstr(pu.interface_checksum,8))
  1637. else if (pu.u.indirect_crc<>pu.indirect_checksum) then
  1638. writeln(' indcrc change (2): ',hexstr(pu.u.indirect_crc,8),' <> ',hexstr(pu.indirect_checksum,8));
  1639. {$endif DEBUG_UNIT_CRC_CHANGES}
  1640. recompile_reason:=rr_crcchanged;
  1641. do_compile:=true;
  1642. exit;
  1643. end;
  1644. end;
  1645. pu:=tused_unit(pu.next);
  1646. end;
  1647. { load implementation symtable }
  1648. if (flags and uf_local_symtable)<>0 then
  1649. begin
  1650. localsymtable:=tstaticsymtable.create(modulename^,moduleid);
  1651. tstaticsymtable(localsymtable).ppuload(ppufile);
  1652. end;
  1653. { we can now derefence all pointers to the implementation parts }
  1654. tstoredsymtable(globalsymtable).derefimpl(false);
  1655. { we've just loaded the localsymtable from the ppu file, so everything
  1656. in it was registered by definition (otherwise it wouldn't have been in
  1657. there) }
  1658. if assigned(localsymtable) then
  1659. tstoredsymtable(localsymtable).derefimpl(false);
  1660. derefunitimportsyms;
  1661. { read whole program optimisation-related information }
  1662. wpoinfo:=tunitwpoinfo.ppuload(ppufile);
  1663. tunitwpoinfo(wpoinfo).deref;
  1664. tunitwpoinfo(wpoinfo).derefimpl;
  1665. end;
  1666. function tppumodule.needrecompile:boolean;
  1667. var
  1668. pu : tused_unit;
  1669. begin
  1670. result:=false;
  1671. pu:=tused_unit(used_units.first);
  1672. while assigned(pu) do
  1673. begin
  1674. { need to recompile the current unit, check the interface
  1675. crc. And when not compiled with -Ur then check the complete
  1676. crc }
  1677. if (pu.u.interface_crc<>pu.interface_checksum) or
  1678. (pu.u.indirect_crc<>pu.indirect_checksum) or
  1679. (
  1680. (pu.in_interface) and
  1681. (pu.u.crc<>pu.checksum)
  1682. ) then
  1683. begin
  1684. {$ifdef DEBUG_UNIT_CRC_CHANGES}
  1685. if (pu.u.interface_crc<>pu.interface_checksum) then
  1686. writeln(' intfcrc change (3): ',hexstr(pu.u.interface_crc,8),' <> ',hexstr(pu.interface_checksum,8))
  1687. else if (pu.u.indirect_crc<>pu.indirect_checksum) then
  1688. writeln(' indcrc change (3): ',hexstr(pu.u.indirect_crc,8),' <> ',hexstr(pu.indirect_checksum,8))
  1689. else
  1690. writeln(' implcrc change (3): ',hexstr(pu.u.crc,8),' <> ',hexstr(pu.checksum,8));
  1691. {$endif DEBUG_UNIT_CRC_CHANGES}
  1692. result:=true;
  1693. exit;
  1694. end;
  1695. pu:=tused_unit(pu.next);
  1696. end;
  1697. end;
  1698. procedure tppumodule.setdefgeneration;
  1699. begin
  1700. defsgeneration:=currentdefgeneration;
  1701. inc(currentdefgeneration);
  1702. end;
  1703. procedure tppumodule.reload_flagged_units;
  1704. var
  1705. hp : tppumodule;
  1706. begin
  1707. { now reload all dependent units with outdated defs }
  1708. hp:=tppumodule(loaded_units.first);
  1709. while assigned(hp) do
  1710. begin
  1711. if hp.do_reload and
  1712. (hp.defsgeneration<defsgeneration) then
  1713. begin
  1714. hp.defsgeneration:=defsgeneration;
  1715. hp.loadppu
  1716. end
  1717. else
  1718. hp.do_reload:=false;
  1719. hp:=tppumodule(hp.next);
  1720. end;
  1721. end;
  1722. procedure tppumodule.end_of_parsing;
  1723. begin
  1724. { module is now compiled }
  1725. state:=ms_compiled;
  1726. { free ppu }
  1727. if assigned(ppufile) then
  1728. begin
  1729. ppufile.free;
  1730. ppufile:=nil;
  1731. end;
  1732. inherited end_of_parsing;
  1733. end;
  1734. procedure tppumodule.loadppu;
  1735. const
  1736. ImplIntf : array[boolean] of string[15]=('implementation','interface');
  1737. var
  1738. do_load,
  1739. second_time : boolean;
  1740. old_current_module : tmodule;
  1741. pu : tused_unit;
  1742. begin
  1743. old_current_module:=current_module;
  1744. Message3(unit_u_load_unit,old_current_module.modulename^,
  1745. ImplIntf[old_current_module.in_interface],
  1746. modulename^);
  1747. { Update loaded_from to detect cycles }
  1748. loaded_from:=old_current_module;
  1749. { check if the globalsymtable is already available, but
  1750. we must reload when the do_reload flag is set }
  1751. if (not do_reload) and
  1752. assigned(globalsymtable) then
  1753. exit;
  1754. { reset }
  1755. do_load:=true;
  1756. second_time:=false;
  1757. set_current_module(self);
  1758. { try to load it as a package unit first }
  1759. if (packagelist.count>0) and loadfrompackage then
  1760. begin
  1761. do_load:=false;
  1762. do_reload:=false;
  1763. state:=ms_compiled;
  1764. { PPU is not needed anymore }
  1765. if assigned(ppufile) then
  1766. begin
  1767. ppufile.closefile;
  1768. ppufile.free;
  1769. ppufile:=nil;
  1770. end;
  1771. { add the unit to the used units list of the program }
  1772. usedunits.concat(tused_unit.create(self,true,false,nil));
  1773. end;
  1774. { A force reload }
  1775. if do_reload then
  1776. begin
  1777. Message(unit_u_forced_reload);
  1778. do_reload:=false;
  1779. { When the unit is already loaded or being loaded
  1780. we can maybe skip a complete reload/recompile }
  1781. if assigned(globalsymtable) and
  1782. (not needrecompile) then
  1783. begin
  1784. { When we don't have any data stored yet there
  1785. is nothing to resolve }
  1786. if interface_compiled then
  1787. begin
  1788. Message1(unit_u_reresolving_unit,modulename^);
  1789. tstoredsymtable(globalsymtable).deref(false);
  1790. tstoredsymtable(globalsymtable).derefimpl(false);
  1791. if assigned(localsymtable) then
  1792. begin
  1793. { we have only builderef(impl)'d the registered symbols of
  1794. the localsymtable -> also only deref those again }
  1795. tstoredsymtable(localsymtable).deref(true);
  1796. tstoredsymtable(localsymtable).derefimpl(true);
  1797. end;
  1798. if assigned(wpoinfo) then
  1799. begin
  1800. tunitwpoinfo(wpoinfo).deref;
  1801. tunitwpoinfo(wpoinfo).derefimpl;
  1802. end;
  1803. { We have to flag the units that depend on this unit even
  1804. though it didn't change, because they might also
  1805. indirectly depend on the unit that did change (e.g.,
  1806. in case rgobj, rgx86 and rgcpu have been compiled
  1807. already, and then rgobj is recompiled for some reason
  1808. -> rgx86 is re-reresolved, but the vmtentries of trgcpu
  1809. must also be re-resolved, because they will also contain
  1810. pointers to procdefs in the old trgobj (in case of a
  1811. recompile, all old defs are freed) }
  1812. flagdependent(old_current_module);
  1813. reload_flagged_units;
  1814. end
  1815. else
  1816. Message1(unit_u_skipping_reresolving_unit,modulename^);
  1817. do_load:=false;
  1818. end;
  1819. end;
  1820. if do_load then
  1821. begin
  1822. { loading the unit for a second time? }
  1823. if state=ms_registered then
  1824. state:=ms_load
  1825. else
  1826. begin
  1827. { try to load the unit a second time first }
  1828. Message1(unit_u_second_load_unit,modulename^);
  1829. Message2(unit_u_previous_state,modulename^,ModuleStateStr[state]);
  1830. { Flag modules to reload }
  1831. flagdependent(old_current_module);
  1832. { Reset the module }
  1833. reset;
  1834. if state in [ms_compile,ms_second_compile] then
  1835. begin
  1836. Message1(unit_u_second_compile_unit,modulename^);
  1837. state:=ms_second_compile;
  1838. do_compile:=true;
  1839. end
  1840. else
  1841. state:=ms_second_load;
  1842. second_time:=true;
  1843. end;
  1844. { close old_current_ppu on system that are
  1845. short on file handles like DOS PM }
  1846. {$ifdef SHORT_ON_FILE_HANDLES}
  1847. if old_current_module.is_unit and
  1848. assigned(tppumodule(old_current_module).ppufile) then
  1849. tppumodule(old_current_module).ppufile.tempclose;
  1850. {$endif SHORT_ON_FILE_HANDLES}
  1851. { try to opening ppu, skip this when we already
  1852. know that we need to compile the unit }
  1853. if not do_compile then
  1854. begin
  1855. Message1(unit_u_loading_unit,modulename^);
  1856. search_unit_files(false);
  1857. if not do_compile then
  1858. begin
  1859. load_interface;
  1860. setdefgeneration;
  1861. if not do_compile then
  1862. begin
  1863. load_usedunits;
  1864. if not do_compile then
  1865. Message1(unit_u_finished_loading_unit,modulename^);
  1866. end;
  1867. end;
  1868. { PPU is not needed anymore }
  1869. if assigned(ppufile) then
  1870. begin
  1871. ppufile.closefile;
  1872. ppufile.free;
  1873. ppufile:=nil;
  1874. end;
  1875. end;
  1876. { Do we need to recompile the unit }
  1877. if do_compile then
  1878. begin
  1879. { recompile the unit or give a fatal error if sources not available }
  1880. if not(sources_avail) then
  1881. begin
  1882. search_unit_files(true);
  1883. if not(sources_avail) then
  1884. begin
  1885. printcomments;
  1886. if recompile_reason=rr_noppu then
  1887. begin
  1888. pu:=tused_unit(loaded_from.used_units.first);
  1889. while assigned(pu) do
  1890. begin
  1891. if pu.u=self then
  1892. break;
  1893. pu:=tused_unit(pu.next);
  1894. end;
  1895. if assigned(pu) and assigned(pu.unitsym) then
  1896. MessagePos2(pu.unitsym.fileinfo,unit_f_cant_find_ppu,realmodulename^,loaded_from.realmodulename^)
  1897. else
  1898. Message2(unit_f_cant_find_ppu,realmodulename^,loaded_from.realmodulename^);
  1899. end
  1900. else
  1901. Message1(unit_f_cant_compile_unit,realmodulename^);
  1902. end;
  1903. end;
  1904. { we found the sources, we do not need the verbose messages anymore }
  1905. if comments <> nil then
  1906. begin
  1907. comments.free;
  1908. comments:=nil;
  1909. end;
  1910. { Flag modules to reload }
  1911. flagdependent(old_current_module);
  1912. { Reset the module }
  1913. reset;
  1914. { compile this module }
  1915. if not(state in [ms_compile,ms_second_compile]) then
  1916. state:=ms_compile;
  1917. compile(mainsource);
  1918. setdefgeneration;
  1919. end
  1920. else
  1921. state:=ms_compiled;
  1922. if current_module<>self then
  1923. internalerror(200212282);
  1924. if in_interface then
  1925. internalerror(200212283);
  1926. { for a second_time recompile reload all dependent units,
  1927. for a first time compile register the unit _once_ }
  1928. if second_time then
  1929. reload_flagged_units
  1930. else
  1931. usedunits.concat(tused_unit.create(self,true,false,nil));
  1932. { reopen the old module }
  1933. {$ifdef SHORT_ON_FILE_HANDLES}
  1934. if old_current_module.is_unit and
  1935. assigned(tppumodule(old_current_module).ppufile) then
  1936. tppumodule(old_current_module).ppufile.tempopen;
  1937. {$endif SHORT_ON_FILE_HANDLES}
  1938. end;
  1939. { we are back, restore current_module }
  1940. set_current_module(old_current_module);
  1941. end;
  1942. {*****************************************************************************
  1943. RegisterUnit
  1944. *****************************************************************************}
  1945. function registerunit(callermodule:tmodule;const s : TIDString;const fn:string) : tppumodule;
  1946. var
  1947. ups : TIDString;
  1948. hp : tppumodule;
  1949. hp2 : tmodule;
  1950. begin
  1951. { Info }
  1952. ups:=upper(s);
  1953. { search all loaded units }
  1954. hp:=tppumodule(loaded_units.first);
  1955. while assigned(hp) do
  1956. begin
  1957. if hp.modulename^=ups then
  1958. begin
  1959. { only check for units. The main program is also
  1960. as a unit in the loaded_units list. We simply need
  1961. to ignore this entry (PFV) }
  1962. if hp.is_unit then
  1963. begin
  1964. { both units in interface ? }
  1965. if callermodule.in_interface and
  1966. hp.in_interface then
  1967. begin
  1968. { check for a cycle }
  1969. hp2:=callermodule.loaded_from;
  1970. while assigned(hp2) and (hp2<>hp) do
  1971. begin
  1972. if hp2.in_interface then
  1973. hp2:=hp2.loaded_from
  1974. else
  1975. hp2:=nil;
  1976. end;
  1977. if assigned(hp2) then
  1978. Message2(unit_f_circular_unit_reference,callermodule.realmodulename^,hp.realmodulename^);
  1979. end;
  1980. break;
  1981. end;
  1982. end;
  1983. { the next unit }
  1984. hp:=tppumodule(hp.next);
  1985. end;
  1986. { the unit is not in the loaded units,
  1987. we create an entry and register the unit }
  1988. if not assigned(hp) then
  1989. begin
  1990. Message1(unit_u_registering_new_unit,Upper(s));
  1991. hp:=tppumodule.create(callermodule,s,fn,true);
  1992. hp.loaded_from:=callermodule;
  1993. addloadedunit(hp);
  1994. end;
  1995. { return }
  1996. registerunit:=hp;
  1997. end;
  1998. end.