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. if (mf_wasm_threads in moduleflags) <>
  325. (ts_wasm_threads in current_settings.targetswitches) then
  326. begin
  327. Message(unit_u_ppu_wasm_threads_mismatch,@queuecomment);
  328. exit;
  329. end;
  330. {$endif}
  331. if {$ifdef symansistr}not{$endif}(mf_symansistr in moduleflags) then
  332. begin
  333. Message(unit_u_ppu_symansistr_mismatch,@queuecomment);
  334. exit;
  335. end;
  336. if {$ifdef llvm}not{$endif}(mf_llvm in moduleflags) then
  337. begin
  338. Message(unit_u_ppu_llvm_mismatch,@queuecomment);
  339. exit;
  340. end;
  341. result:=true;
  342. end;
  343. begin
  344. openppu:=false;
  345. if not checkheader or
  346. not checkextraheader then
  347. begin
  348. ppufile.free;
  349. ppufile:=nil;
  350. exit;
  351. end;
  352. { Load values to be access easier }
  353. headerflags:=ppufile.header.common.flags;
  354. crc:=ppufile.header.checksum;
  355. interface_crc:=ppufile.header.interface_checksum;
  356. indirect_crc:=ppufile.header.indirect_checksum;
  357. change_endian:=ppufile.change_endian;
  358. { Show Debug info }
  359. if ppufiletime<>-1 then
  360. Message1(unit_u_ppu_time,filetimestring(ppufiletime))
  361. else
  362. Message1(unit_u_ppu_time,'unknown');
  363. Message1(unit_u_ppu_flags,tostr(headerflags));
  364. Message1(unit_u_ppu_crc,hexstr(ppufile.header.checksum,8));
  365. Message1(unit_u_ppu_crc,hexstr(ppufile.header.interface_checksum,8)+' (intfc)');
  366. Message1(unit_u_ppu_crc,hexstr(ppufile.header.indirect_checksum,8)+' (indc)');
  367. Comment(V_used,'Number of definitions: '+tostr(ppufile.header.deflistsize));
  368. Comment(V_used,'Number of symbols: '+tostr(ppufile.header.symlistsize));
  369. do_compile:=false;
  370. openppu:=true;
  371. end;
  372. function tppumodule.search_unit_files(onlysource:boolean):boolean;
  373. var
  374. found : boolean;
  375. begin
  376. found:=false;
  377. if search_unit(onlysource,false) then
  378. found:=true;
  379. if (not found) and
  380. (length(modulename^)>8) and
  381. search_unit(onlysource,true) then
  382. found:=true;
  383. search_unit_files:=found;
  384. end;
  385. function tppumodule.search_unit(onlysource,shortname:boolean):boolean;
  386. var
  387. singlepathstring,
  388. filename : TCmdStr;
  389. Function UnitExists(const ext:string;var foundfile:TCmdStr;const prefix:TCmdStr):boolean;
  390. var
  391. s : tcmdstr;
  392. begin
  393. if CheckVerbosity(V_Tried) then
  394. Message1(unit_t_unitsearch,Singlepathstring+filename+ext);
  395. s:=FileName+ext;
  396. if prefix<>'' then
  397. s:=prefix+'.'+s;
  398. UnitExists:=FindFile(s,Singlepathstring,true,foundfile);
  399. end;
  400. Function PPUSearchPath(const s,prefix:TCmdStr):boolean;
  401. var
  402. found : boolean;
  403. hs,
  404. newname : TCmdStr;
  405. begin
  406. Found:=false;
  407. singlepathstring:=FixPath(s,false);
  408. { Check for PPU file }
  409. Found:=UnitExists(target_info.unitext,hs,prefix);
  410. if Found then
  411. Begin
  412. SetFileName(hs,false);
  413. if prefix<>'' then
  414. begin
  415. newname:=prefix+'.'+realmodulename^;
  416. stringdispose(realmodulename);
  417. realmodulename:=stringdup(newname);
  418. stringdispose(modulename);
  419. modulename:=stringdup(upper(newname));
  420. end;
  421. Found:=openppufile;
  422. End;
  423. PPUSearchPath:=Found;
  424. end;
  425. Function SourceSearchPath(const s,prefix:TCmdStr):boolean;
  426. var
  427. found : boolean;
  428. hs,
  429. newname : TCmdStr;
  430. begin
  431. Found:=false;
  432. singlepathstring:=FixPath(s,false);
  433. { Check for Sources }
  434. ppufile:=nil;
  435. do_compile:=true;
  436. recompile_reason:=rr_noppu;
  437. {Check for .pp file}
  438. Found:=UnitExists(sourceext,hs,prefix);
  439. if not Found then
  440. begin
  441. { Check for .pas }
  442. Found:=UnitExists(pasext,hs,prefix);
  443. end;
  444. if not Found and
  445. ((m_mac in current_settings.modeswitches) or
  446. (tf_p_ext_support in target_info.flags)) then
  447. begin
  448. { Check for .p, if mode is macpas}
  449. Found:=UnitExists(pext,hs,prefix);
  450. end;
  451. mainsource:='';
  452. if Found then
  453. begin
  454. sources_avail:=true;
  455. { Load Filenames when found }
  456. mainsource:=hs;
  457. SetFileName(hs,false);
  458. if prefix<>'' then
  459. begin
  460. newname:=prefix+'.'+realmodulename^;
  461. stringdispose(realmodulename);
  462. realmodulename:=stringdup(newname);
  463. stringdispose(modulename);
  464. modulename:=stringdup(upper(newname));
  465. end;
  466. end
  467. else
  468. sources_avail:=false;
  469. SourceSearchPath:=Found;
  470. end;
  471. Function SearchPath(const s,prefix:TCmdStr):boolean;
  472. var
  473. found : boolean;
  474. begin
  475. { First check for a ppu, then for the source }
  476. found:=false;
  477. if not onlysource then
  478. found:=PPUSearchPath(s,prefix);
  479. if not found then
  480. found:=SourceSearchPath(s,prefix);
  481. SearchPath:=found;
  482. end;
  483. Function SearchPathList(list:TSearchPathList;const prefix:TCmdStr):boolean;
  484. var
  485. hp : TCmdStrListItem;
  486. found : boolean;
  487. begin
  488. found:=false;
  489. hp:=TCmdStrListItem(list.First);
  490. while assigned(hp) do
  491. begin
  492. found:=SearchPath(hp.Str,prefix);
  493. if found then
  494. break;
  495. hp:=TCmdStrListItem(hp.next);
  496. end;
  497. SearchPathList:=found;
  498. end;
  499. function SearchPPUPaths(const prefix:TCmdStr):boolean;
  500. begin
  501. result:=PPUSearchPath('.',prefix);
  502. if (not result) and (outputpath<>'') then
  503. result:=PPUSearchPath(outputpath,prefix);
  504. if (not result) and Assigned(main_module) and (main_module.Path<>'') then
  505. result:=PPUSearchPath(main_module.Path,prefix);
  506. end;
  507. function SearchSourcePaths(const prefix:TCmdStr):boolean;
  508. begin
  509. result:=SourceSearchPath('.',prefix);
  510. if (not result) and Assigned(main_module) and (main_module.Path<>'') then
  511. result:=SourceSearchPath(main_module.Path,prefix);
  512. if (not result) and Assigned(loaded_from) then
  513. result:=SearchPathList(loaded_from.LocalUnitSearchPath,prefix);
  514. if not result then
  515. result:=SearchPathList(UnitSearchPath,prefix);
  516. end;
  517. var
  518. fnd : boolean;
  519. hs : TPathStr;
  520. nsitem : TCmdStrListItem;
  521. begin
  522. if shortname then
  523. filename:=FixFileName(Copy(realmodulename^,1,8))
  524. else
  525. filename:=FixFileName(realmodulename^);
  526. { try to find unit
  527. 1. look for ppu in cwd
  528. 2. look for ppu in outputpath if set, this is tp7 compatible (PFV)
  529. 3. look for ppu in maindir
  530. 4. look for the specified source file (from the uses line)
  531. 5. look for source in cwd
  532. 6. look for source in maindir
  533. 7. local unit pathlist
  534. 8. global unit pathlist
  535. 9. for each default namespace:
  536. repeat 1 - 3 and 5 - 8 with namespace as prefix }
  537. fnd:=false;
  538. if not onlysource then
  539. fnd:=SearchPPUPaths('');
  540. if (not fnd) and (sourcefn<>'') then
  541. begin
  542. { the full filename is specified so we can't use here the
  543. searchpath (PFV) }
  544. if CheckVerbosity(V_Tried) then
  545. Message1(unit_t_unitsearch,ChangeFileExt(sourcefn,sourceext));
  546. fnd:=FindFile(ChangeFileExt(sourcefn,sourceext),'',true,hs);
  547. if not fnd then
  548. begin
  549. if CheckVerbosity(V_Tried) then
  550. Message1(unit_t_unitsearch,ChangeFileExt(sourcefn,pasext));
  551. fnd:=FindFile(ChangeFileExt(sourcefn,pasext),'',true,hs);
  552. end;
  553. if not fnd and
  554. ((m_mac in current_settings.modeswitches) or
  555. (tf_p_ext_support in target_info.flags)) then
  556. begin
  557. if CheckVerbosity(V_Tried) then
  558. Message1(unit_t_unitsearch,ChangeFileExt(sourcefn,pext));
  559. fnd:=FindFile(ChangeFileExt(sourcefn,pext),'',true,hs);
  560. end;
  561. if fnd then
  562. begin
  563. sources_avail:=true;
  564. do_compile:=true;
  565. recompile_reason:=rr_noppu;
  566. mainsource:=hs;
  567. SetFileName(hs,false);
  568. end;
  569. end;
  570. if not fnd then
  571. begin
  572. fnd:=SearchSourcePaths('');
  573. if not fnd and (namespacelist.count>0) then
  574. begin
  575. nsitem:=TCmdStrListItem(namespacelist.first);
  576. while assigned(nsitem) do
  577. begin
  578. if not onlysource then
  579. begin
  580. fnd:=SearchPPUPaths(nsitem.str);
  581. if fnd then
  582. break;
  583. end;
  584. fnd:=SearchSourcePaths(nsitem.str);
  585. if fnd then
  586. break;
  587. nsitem:=TCmdStrListItem(nsitem.next);
  588. end;
  589. if assigned(nsitem) then
  590. nsprefix:=nsitem.str;
  591. end;
  592. end;
  593. search_unit:=fnd;
  594. end;
  595. function tppumodule.loadfrompackage: boolean;
  596. (*var
  597. singlepathstring,
  598. filename : TCmdStr;
  599. Function UnitExists(const ext:string;var foundfile:TCmdStr):boolean;
  600. begin
  601. if CheckVerbosity(V_Tried) then
  602. Message1(unit_t_unitsearch,Singlepathstring+filename);
  603. UnitExists:=FindFile(FileName,Singlepathstring,true,foundfile);
  604. end;
  605. Function PPUSearchPath(const s:TCmdStr):boolean;
  606. var
  607. found : boolean;
  608. hs : TCmdStr;
  609. begin
  610. Found:=false;
  611. singlepathstring:=FixPath(s,false);
  612. { Check for PPU file }
  613. Found:=UnitExists(target_info.unitext,hs);
  614. if Found then
  615. Begin
  616. SetFileName(hs,false);
  617. //Found:=OpenPPU;
  618. End;
  619. PPUSearchPath:=Found;
  620. end;
  621. Function SearchPathList(list:TSearchPathList):boolean;
  622. var
  623. hp : TCmdStrListItem;
  624. found : boolean;
  625. begin
  626. found:=false;
  627. hp:=TCmdStrListItem(list.First);
  628. while assigned(hp) do
  629. begin
  630. found:=PPUSearchPath(hp.Str);
  631. if found then
  632. break;
  633. hp:=TCmdStrListItem(hp.next);
  634. end;
  635. SearchPathList:=found;
  636. end;*)
  637. var
  638. pkg : ppackageentry;
  639. pkgunit : pcontainedunit;
  640. i,idx : longint;
  641. strm : TCStream;
  642. begin
  643. result:=false;
  644. for i:=0 to packagelist.count-1 do
  645. begin
  646. pkg:=ppackageentry(packagelist[i]);
  647. if not assigned(pkg^.package) then
  648. internalerror(2013053103);
  649. idx:=pkg^.package.containedmodules.FindIndexOf(modulename^);
  650. if idx>=0 then
  651. begin
  652. { the unit is part of this package }
  653. pkgunit:=pcontainedunit(pkg^.package.containedmodules[idx]);
  654. if not assigned(pkgunit^.module) then
  655. pkgunit^.module:=self;
  656. { ToDo: check whether we really don't need this anymore }
  657. {filename:=pkgunit^.ppufile;
  658. if not SearchPathList(unitsearchpath) then
  659. exit};
  660. strm:=tpcppackage(pkg^.package).getmodulestream(self);
  661. if not assigned(strm) then
  662. internalerror(2015103002);
  663. if not openppustream(strm) then
  664. exit;
  665. package:=pkg^.package;
  666. Message2(unit_u_loading_from_package,modulename^,pkg^.package.packagename^);
  667. { now load the unit and all used units }
  668. load_interface;
  669. setdefgeneration;
  670. load_usedunits;
  671. Message1(unit_u_finished_loading_unit,modulename^);
  672. result:=true;
  673. break;
  674. end;
  675. end;
  676. end;
  677. procedure tppumodule.buildderefunitimportsyms;
  678. var
  679. i : longint;
  680. deref : pderef;
  681. begin
  682. for i:=0 to unitimportsyms.count-1 do
  683. begin
  684. new(deref);
  685. deref^.build(unitimportsyms[i]);
  686. unitimportsymsderefs.add(deref);
  687. end;
  688. end;
  689. procedure tppumodule.derefunitimportsyms;
  690. var
  691. i : longint;
  692. sym : tsym;
  693. begin
  694. for i:=0 to unitimportsymsderefs.count-1 do
  695. begin
  696. sym:=tsym(pderef(unitimportsymsderefs[i])^.resolve);
  697. unitimportsyms.add(sym);
  698. end;
  699. end;
  700. procedure tppumodule.freederefunitimportsyms;
  701. var
  702. i : longint;
  703. deref : pderef;
  704. begin
  705. for i:=0 to unitimportsymsderefs.count-1 do
  706. begin
  707. deref:=pderef(unitimportsymsderefs[i]);
  708. system.dispose(deref);
  709. end;
  710. end;
  711. {**********************************
  712. PPU Reading/Writing Helpers
  713. ***********************************}
  714. {$IFDEF MACRO_DIFF_HINT}
  715. var
  716. is_initial: Boolean;
  717. procedure tppumodule.writeusedmacro(p:TNamedIndexItem;arg:pointer);
  718. begin
  719. if tmacro(p).is_used or is_initial then
  720. begin
  721. ppufile.putstring(p.name);
  722. ppufile.putboolean(is_initial);
  723. ppufile.putboolean(tmacro(p).is_used);
  724. end;
  725. end;
  726. procedure tppumodule.writeusedmacros;
  727. begin
  728. ppufile.do_crc:=false;
  729. is_initial:= true;
  730. initialmacrosymtable.foreach(@writeusedmacro,nil);
  731. is_initial:= false;
  732. if assigned(globalmacrosymtable) then
  733. globalmacrosymtable.foreach(@writeusedmacro,nil);
  734. localmacrosymtable.foreach(@writeusedmacro,nil);
  735. ppufile.writeentry(ibusedmacros);
  736. ppufile.do_crc:=true;
  737. end;
  738. {$ENDIF}
  739. procedure tppumodule.writesourcefiles;
  740. var
  741. hp : tinputfile;
  742. ifile : sizeint;
  743. begin
  744. { second write the used source files }
  745. ppufile.do_crc:=false;
  746. { write source files directly in good order }
  747. for ifile:=0 to sourcefiles.nfiles-1 do
  748. begin
  749. hp:=sourcefiles.files[ifile];
  750. ppufile.putstring(hp.inc_path+hp.name);
  751. ppufile.putlongint(hp.getfiletime);
  752. end;
  753. ppufile.writeentry(ibsourcefiles);
  754. ppufile.do_crc:=true;
  755. end;
  756. procedure tppumodule.writeusedunit(intf:boolean);
  757. var
  758. hp : tused_unit;
  759. oldcrc : boolean;
  760. begin
  761. { write a reference for each used unit }
  762. hp:=tused_unit(used_units.first);
  763. while assigned(hp) do
  764. begin
  765. if hp.in_interface=intf then
  766. begin
  767. ppufile.putstring(hp.u.realmodulename^);
  768. { the checksum should not affect the crc of this unit ! (PFV) }
  769. oldcrc:=ppufile.do_crc;
  770. ppufile.do_crc:=false;
  771. ppufile.putlongint(longint(hp.checksum));
  772. ppufile.putlongint(longint(hp.interface_checksum));
  773. ppufile.putlongint(longint(hp.indirect_checksum));
  774. ppufile.do_crc:=oldcrc;
  775. { combine all indirect checksums from units used by this unit }
  776. if intf then
  777. ppufile.indirect_crc:=ppufile.indirect_crc xor hp.indirect_checksum;
  778. end;
  779. hp:=tused_unit(hp.next);
  780. end;
  781. ppufile.do_interface_crc:=true;
  782. ppufile.writeentry(ibloadunit);
  783. end;
  784. procedure tppumodule.writelinkcontainer(var p:tlinkcontainer;id:byte;strippath:boolean);
  785. var
  786. hcontainer : tlinkcontainer;
  787. s : TPathStr;
  788. mask : cardinal;
  789. begin
  790. hcontainer:=TLinkContainer.Create;
  791. while not p.empty do
  792. begin
  793. s:=p.get(mask);
  794. if strippath then
  795. ppufile.putstring(ExtractFileName(s))
  796. else
  797. ppufile.putstring(s);
  798. ppufile.putlongint(mask);
  799. hcontainer.add(s,mask);
  800. end;
  801. ppufile.writeentry(id);
  802. p.Free;
  803. p:=hcontainer;
  804. end;
  805. procedure tppumodule.writederefmap;
  806. var
  807. i : longint;
  808. oldcrc : boolean;
  809. begin
  810. { This does not influence crc }
  811. oldcrc:=ppufile.do_crc;
  812. ppufile.do_crc:=false;
  813. { The unit map used for resolving }
  814. ppufile.putlongint(derefmapcnt);
  815. for i:=0 to derefmapcnt-1 do
  816. begin
  817. if not assigned(derefmap[i].u) then
  818. internalerror(2005011512);
  819. ppufile.putstring(derefmap[i].u.modulename^)
  820. end;
  821. ppufile.writeentry(ibderefmap);
  822. ppufile.do_crc:=oldcrc;
  823. end;
  824. procedure tppumodule.writederefdata;
  825. var
  826. oldcrc : boolean;
  827. len,hlen : longint;
  828. buf : array[0..1023] of byte;
  829. begin
  830. if longword(derefdataintflen)>derefdata.size then
  831. internalerror(200310223);
  832. derefdata.seek(0);
  833. { Write interface data }
  834. len:=derefdataintflen;
  835. while (len>0) do
  836. begin
  837. if len>1024 then
  838. hlen:=1024
  839. else
  840. hlen:=len;
  841. derefdata.read(buf,hlen);
  842. ppufile.putdata(buf,hlen);
  843. dec(len,hlen);
  844. end;
  845. { Write implementation data, this does not influence crc }
  846. oldcrc:=ppufile.do_crc;
  847. ppufile.do_crc:=false;
  848. len:=derefdata.size-derefdataintflen;
  849. while (len>0) do
  850. begin
  851. if len>1024 then
  852. hlen:=1024
  853. else
  854. hlen:=len;
  855. derefdata.read(buf,hlen);
  856. ppufile.putdata(buf,hlen);
  857. dec(len,hlen);
  858. end;
  859. if derefdata.pos<>derefdata.size then
  860. internalerror(200310224);
  861. ppufile.do_crc:=oldcrc;
  862. ppufile.writeentry(ibderefdata);
  863. end;
  864. procedure tppumodule.writeImportSymbols;
  865. var
  866. i,j : longint;
  867. ImportLibrary : TImportLibrary;
  868. ImportSymbol : TImportSymbol;
  869. begin
  870. for i:=0 to ImportLibraryList.Count-1 do
  871. begin
  872. ImportLibrary:=TImportLibrary(ImportLibraryList[i]);
  873. ppufile.putstring(ImportLibrary.Name);
  874. ppufile.putlongint(ImportLibrary.ImportSymbolList.Count);
  875. for j:=0 to ImportLibrary.ImportSymbolList.Count-1 do
  876. begin
  877. ImportSymbol:=TImportSymbol(ImportLibrary.ImportSymbolList[j]);
  878. ppufile.putstring(ImportSymbol.Name);
  879. ppufile.putstring(ImportSymbol.MangledName);
  880. ppufile.putlongint(ImportSymbol.OrdNr);
  881. ppufile.putbyte(byte(ImportSymbol.IsVar));
  882. end;
  883. end;
  884. ppufile.writeentry(ibImportSymbols);
  885. end;
  886. procedure tppumodule.writeResources;
  887. var
  888. res : TCmdStrListItem;
  889. begin
  890. res:=TCmdStrListItem(ResourceFiles.First);
  891. while res<>nil do
  892. begin
  893. ppufile.putstring(res.FPStr);
  894. res:=TCmdStrListItem(res.Next);
  895. end;
  896. ppufile.writeentry(ibresources);
  897. end;
  898. procedure tppumodule.writeOrderedSymbols;
  899. var
  900. res : TCmdStrListItem;
  901. begin
  902. res:=TCmdStrListItem(linkorderedsymbols.First);
  903. while res<>nil do
  904. begin
  905. ppufile.putstring(res.FPStr);
  906. res:=TCmdStrListItem(res.Next);
  907. end;
  908. ppufile.writeentry(iborderedsymbols);
  909. end;
  910. procedure tppumodule.writeunitimportsyms;
  911. var
  912. i : longint;
  913. begin
  914. ppufile.putlongint(unitimportsymsderefs.count);
  915. for i:=0 to unitimportsymsderefs.count-1 do
  916. ppufile.putderef(pderef(unitimportsymsderefs[i])^);
  917. ppufile.writeentry(ibunitimportsyms);
  918. end;
  919. procedure tppumodule.writeasmsyms(kind:tunitasmlisttype;list:tfphashobjectlist);
  920. var
  921. i : longint;
  922. sym : TAsmSymbol;
  923. begin
  924. ppufile.putbyte(ord(kind));
  925. ppufile.putlongint(list.count);
  926. for i:=0 to list.count-1 do
  927. begin
  928. sym:=TAsmSymbol(list[i]);
  929. ppufile.putstring(sym.Name);
  930. ppufile.putbyte(ord(sym.bind));
  931. ppufile.putbyte(ord(sym.typ));
  932. end;
  933. ppufile.writeentry(ibasmsymbols);
  934. end;
  935. procedure tppumodule.writeextraheader;
  936. var
  937. old_docrc: boolean;
  938. begin
  939. { create unit flags }
  940. if do_release then
  941. include(moduleflags,mf_release);
  942. if assigned(localsymtable) then
  943. include(moduleflags,mf_local_symtable);
  944. if cs_checkpointer_called in current_settings.moduleswitches then
  945. include(moduleflags,mf_checkpointer_called);
  946. if cs_compilesystem in current_settings.moduleswitches then
  947. include(moduleflags,mf_system_unit);
  948. {$ifdef i8086}
  949. if current_settings.x86memorymodel in [mm_medium,mm_large,mm_huge] then
  950. include(moduleflags,mf_i8086_far_code);
  951. if current_settings.x86memorymodel in [mm_compact,mm_large] then
  952. include(moduleflags,mf_i8086_far_data);
  953. if current_settings.x86memorymodel=mm_huge then
  954. include(moduleflags,mf_i8086_huge_data);
  955. if current_settings.x86memorymodel=mm_tiny then
  956. include(moduleflags,mf_i8086_cs_equals_ds);
  957. if current_settings.x86memorymodel in [mm_tiny,mm_small,mm_medium] then
  958. include(moduleflags,mf_i8086_ss_equals_ds);
  959. {$endif i8086}
  960. {$ifdef wasm}
  961. if ts_wasm_no_exceptions in current_settings.targetswitches then
  962. include(moduleflags,mf_wasm_no_exceptions);
  963. if ts_wasm_native_exceptions in current_settings.targetswitches then
  964. include(moduleflags,mf_wasm_native_exceptions);
  965. if ts_wasm_js_exceptions in current_settings.targetswitches then
  966. include(moduleflags,mf_wasm_js_exceptions);
  967. if ts_wasm_bf_exceptions in current_settings.targetswitches then
  968. include(moduleflags,mf_wasm_bf_exceptions);
  969. if ts_wasm_threads in current_settings.targetswitches then
  970. include(moduleflags,mf_wasm_threads);
  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.