fppu.pas 81 KB

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