fppu.pas 81 KB

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