fppu.pas 55 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682
  1. {
  2. $Id$
  3. Copyright (c) 1998-2002 by Florian Klaempfl
  4. This unit implements the first loading and searching of the modules
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. unit fppu;
  19. {$i fpcdefs.inc}
  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. cutils,cclasses,
  31. globtype,globals,finput,fmodule,
  32. symbase,symppu,ppu;
  33. type
  34. tppumodule = class(tmodule)
  35. ppufile : tcompilerppufile; { the PPU file }
  36. sourcefn : pstring; { Source specified with "uses .. in '..'" }
  37. {$ifdef Test_Double_checksum}
  38. crc_array : pointer;
  39. crc_size : longint;
  40. crc_array2 : pointer;
  41. crc_size2 : longint;
  42. {$endif def Test_Double_checksum}
  43. constructor create(LoadedFrom:TModule;const s:string;const fn:string;_is_unit:boolean);
  44. destructor destroy;override;
  45. procedure reset;override;
  46. function openppu:boolean;
  47. procedure getppucrc;
  48. procedure writeppu;
  49. procedure loadppu;
  50. function needrecompile:boolean;
  51. private
  52. function search_unit(onlysource,shortname:boolean):boolean;
  53. procedure load_interface;
  54. procedure load_implementation;
  55. procedure load_symtable_refs;
  56. procedure load_usedunits;
  57. procedure writeusedmacro(p:TNamedIndexItem;arg:pointer);
  58. procedure writeusedmacros;
  59. procedure writesourcefiles;
  60. procedure writeusedunit(intf:boolean);
  61. procedure writelinkcontainer(var p:tlinkcontainer;id:byte;strippath:boolean);
  62. procedure writederefdata;
  63. procedure putasmsymbol_in_idx(s:tnamedindexitem;arg:pointer);
  64. procedure writeasmsymbols;
  65. procedure readusedmacros;
  66. procedure readsourcefiles;
  67. procedure readloadunit;
  68. procedure readlinkcontainer(var p:tlinkcontainer);
  69. procedure readderefdata;
  70. procedure readasmsymbols;
  71. end;
  72. procedure reload_flagged_units;
  73. function registerunit(callermodule:tmodule;const s : stringid;const fn:string) : tppumodule;
  74. implementation
  75. uses
  76. verbose,systems,version,
  77. symtable,
  78. scanner,
  79. aasmbase,
  80. parser;
  81. {****************************************************************************
  82. Helpers
  83. ****************************************************************************}
  84. procedure reload_flagged_units;
  85. var
  86. hp : tmodule;
  87. begin
  88. { now reload all dependent units }
  89. hp:=tmodule(loaded_units.first);
  90. while assigned(hp) do
  91. begin
  92. if hp.do_reload then
  93. tppumodule(hp).loadppu;
  94. hp:=tmodule(hp.next);
  95. end;
  96. end;
  97. {****************************************************************************
  98. TPPUMODULE
  99. ****************************************************************************}
  100. constructor tppumodule.create(LoadedFrom:TModule;const s:string;const fn:string;_is_unit:boolean);
  101. begin
  102. inherited create(LoadedFrom,s,_is_unit);
  103. ppufile:=nil;
  104. sourcefn:=stringdup(fn);
  105. end;
  106. destructor tppumodule.Destroy;
  107. begin
  108. if assigned(ppufile) then
  109. ppufile.free;
  110. ppufile:=nil;
  111. stringdispose(sourcefn);
  112. inherited Destroy;
  113. end;
  114. procedure tppumodule.reset;
  115. begin
  116. if assigned(ppufile) then
  117. begin
  118. ppufile.free;
  119. ppufile:=nil;
  120. end;
  121. inherited reset;
  122. end;
  123. function tppumodule.openppu:boolean;
  124. var
  125. ppufiletime : longint;
  126. begin
  127. openppu:=false;
  128. Message1(unit_t_ppu_loading,ppufilename^);
  129. { Get ppufile time (also check if the file exists) }
  130. ppufiletime:=getnamedfiletime(ppufilename^);
  131. if ppufiletime=-1 then
  132. exit;
  133. { Open the ppufile }
  134. Message1(unit_u_ppu_name,ppufilename^);
  135. ppufile:=tcompilerppufile.create(ppufilename^);
  136. if not ppufile.openfile then
  137. begin
  138. ppufile.free;
  139. ppufile:=nil;
  140. Message(unit_u_ppu_file_too_short);
  141. exit;
  142. end;
  143. { check for a valid PPU file }
  144. if not ppufile.CheckPPUId then
  145. begin
  146. ppufile.free;
  147. ppufile:=nil;
  148. Message(unit_u_ppu_invalid_header);
  149. exit;
  150. end;
  151. { check for allowed PPU versions }
  152. if not (ppufile.GetPPUVersion = CurrentPPUVersion) then
  153. begin
  154. Message1(unit_u_ppu_invalid_version,tostr(ppufile.GetPPUVersion));
  155. ppufile.free;
  156. ppufile:=nil;
  157. exit;
  158. end;
  159. { check the target processor }
  160. if tsystemcpu(ppufile.header.cpu)<>target_cpu then
  161. begin
  162. ppufile.free;
  163. ppufile:=nil;
  164. Message(unit_u_ppu_invalid_processor);
  165. exit;
  166. end;
  167. { check target }
  168. if tsystem(ppufile.header.target)<>target_info.system then
  169. begin
  170. ppufile.free;
  171. ppufile:=nil;
  172. Message(unit_u_ppu_invalid_target);
  173. exit;
  174. end;
  175. {$ifdef cpufpemu}
  176. { check if floating point emulation is on?}
  177. if ((ppufile.header.flags and uf_fpu_emulation)<>0) and
  178. (cs_fp_emulation in aktmoduleswitches) then
  179. begin
  180. ppufile.free;
  181. ppufile:=nil;
  182. Message(unit_u_ppu_invalid_fpumode);
  183. exit;
  184. end;
  185. {$endif cpufpemu}
  186. { Load values to be access easier }
  187. flags:=ppufile.header.flags;
  188. crc:=ppufile.header.checksum;
  189. interface_crc:=ppufile.header.interface_checksum;
  190. { Show Debug info }
  191. Message1(unit_u_ppu_time,filetimestring(ppufiletime));
  192. Message1(unit_u_ppu_flags,tostr(flags));
  193. Message1(unit_u_ppu_crc,hexstr(ppufile.header.checksum,8));
  194. Message1(unit_u_ppu_crc,hexstr(ppufile.header.interface_checksum,8)+' (intfc)');
  195. do_compile:=false;
  196. openppu:=true;
  197. end;
  198. function tppumodule.search_unit(onlysource,shortname:boolean):boolean;
  199. var
  200. singlepathstring,
  201. filename : string;
  202. Function UnitExists(const ext:string;var foundfile:string):boolean;
  203. begin
  204. Message1(unit_t_unitsearch,Singlepathstring+filename+ext);
  205. UnitExists:=FindFile(FileName+ext,Singlepathstring,foundfile);
  206. end;
  207. Function PPUSearchPath(const s:string):boolean;
  208. var
  209. found : boolean;
  210. hs : string;
  211. begin
  212. Found:=false;
  213. singlepathstring:=FixPath(s,false);
  214. { Check for PPU file }
  215. Found:=UnitExists(target_info.unitext,hs);
  216. if Found then
  217. Begin
  218. SetFileName(hs,false);
  219. Found:=OpenPPU;
  220. End;
  221. PPUSearchPath:=Found;
  222. end;
  223. Function SourceSearchPath(const s:string):boolean;
  224. var
  225. found : boolean;
  226. hs : string;
  227. begin
  228. Found:=false;
  229. singlepathstring:=FixPath(s,false);
  230. { Check for Sources }
  231. ppufile:=nil;
  232. do_compile:=true;
  233. recompile_reason:=rr_noppu;
  234. {Check for .pp file}
  235. Found:=UnitExists(target_info.sourceext,hs);
  236. if not Found then
  237. begin
  238. { Check for .pas }
  239. Found:=UnitExists(target_info.pasext,hs);
  240. end;
  241. stringdispose(mainsource);
  242. if Found then
  243. begin
  244. sources_avail:=true;
  245. { Load Filenames when found }
  246. mainsource:=StringDup(hs);
  247. SetFileName(hs,false);
  248. end
  249. else
  250. sources_avail:=false;
  251. SourceSearchPath:=Found;
  252. end;
  253. Function SearchPath(const s:string):boolean;
  254. var
  255. found : boolean;
  256. begin
  257. { First check for a ppu, then for the source }
  258. found:=false;
  259. if not onlysource then
  260. found:=PPUSearchPath(s);
  261. if not found then
  262. found:=SourceSearchPath(s);
  263. SearchPath:=found;
  264. end;
  265. Function SearchPathList(list:TSearchPathList):boolean;
  266. var
  267. hp : TStringListItem;
  268. found : boolean;
  269. begin
  270. found:=false;
  271. hp:=TStringListItem(list.First);
  272. while assigned(hp) do
  273. begin
  274. found:=SearchPath(hp.Str);
  275. if found then
  276. break;
  277. hp:=TStringListItem(hp.next);
  278. end;
  279. SearchPathList:=found;
  280. end;
  281. var
  282. fnd : boolean;
  283. hs : string;
  284. begin
  285. if shortname then
  286. filename:=FixFileName(Copy(realmodulename^,1,8))
  287. else
  288. filename:=FixFileName(realmodulename^);
  289. { try to find unit
  290. 1. look for ppu in cwd
  291. 2. look for ppu in outputpath if set, this is tp7 compatible (PFV)
  292. 3. look for the specified source file (from the uses line)
  293. 4. look for source in cwd
  294. 5. local unit pathlist
  295. 6. global unit pathlist }
  296. fnd:=false;
  297. if not onlysource then
  298. begin
  299. fnd:=PPUSearchPath('.');
  300. if (not fnd) and (outputpath^<>'') then
  301. fnd:=PPUSearchPath(outputpath^);
  302. end;
  303. if (not fnd) and (sourcefn^<>'') then
  304. begin
  305. { the full filename is specified so we can't use here the
  306. searchpath (PFV) }
  307. Message1(unit_t_unitsearch,AddExtension(sourcefn^,target_info.sourceext));
  308. fnd:=FindFile(AddExtension(sourcefn^,target_info.sourceext),'',hs);
  309. if not fnd then
  310. begin
  311. Message1(unit_t_unitsearch,AddExtension(sourcefn^,target_info.pasext));
  312. fnd:=FindFile(AddExtension(sourcefn^,target_info.pasext),'',hs);
  313. end;
  314. if fnd then
  315. begin
  316. sources_avail:=true;
  317. do_compile:=true;
  318. recompile_reason:=rr_noppu;
  319. stringdispose(mainsource);
  320. mainsource:=StringDup(hs);
  321. SetFileName(hs,false);
  322. end;
  323. end;
  324. if not fnd then
  325. fnd:=SourceSearchPath('.');
  326. if (not fnd) and Assigned(Loaded_From) then
  327. fnd:=SearchPathList(Loaded_From.LocalUnitSearchPath);
  328. if not fnd then
  329. fnd:=SearchPathList(UnitSearchPath);
  330. { try to find a file with the first 8 chars of the modulename, like
  331. dos }
  332. if (not fnd) and (length(filename)>8) then
  333. begin
  334. filename:=copy(filename,1,8);
  335. fnd:=SearchPath('.');
  336. if (not fnd) then
  337. fnd:=SearchPathList(LocalUnitSearchPath);
  338. if not fnd then
  339. fnd:=SearchPathList(UnitSearchPath);
  340. end;
  341. search_unit:=fnd;
  342. end;
  343. {**********************************
  344. PPU Reading/Writing Helpers
  345. ***********************************}
  346. procedure tppumodule.writeusedmacro(p:TNamedIndexItem;arg:pointer);
  347. begin
  348. if tmacro(p).is_used or tmacro(p).defined_at_startup then
  349. begin
  350. ppufile.putstring(p.name);
  351. ppufile.putbyte(byte(tmacro(p).defined_at_startup));
  352. ppufile.putbyte(byte(tmacro(p).is_used));
  353. end;
  354. end;
  355. procedure tppumodule.writeusedmacros;
  356. begin
  357. ppufile.do_crc:=false;
  358. tscannerfile(scanner).macros.foreach({$ifdef FPCPROCVAR}@{$endif}writeusedmacro,nil);
  359. ppufile.writeentry(ibusedmacros);
  360. ppufile.do_crc:=true;
  361. end;
  362. procedure tppumodule.writesourcefiles;
  363. var
  364. hp : tinputfile;
  365. i,j : longint;
  366. begin
  367. { second write the used source files }
  368. ppufile.do_crc:=false;
  369. hp:=sourcefiles.files;
  370. { write source files directly in good order }
  371. j:=0;
  372. while assigned(hp) do
  373. begin
  374. inc(j);
  375. hp:=hp.ref_next;
  376. end;
  377. while j>0 do
  378. begin
  379. hp:=sourcefiles.files;
  380. for i:=1 to j-1 do
  381. hp:=hp.ref_next;
  382. ppufile.putstring(hp.name^);
  383. ppufile.putlongint(hp.getfiletime);
  384. dec(j);
  385. end;
  386. ppufile.writeentry(ibsourcefiles);
  387. ppufile.do_crc:=true;
  388. end;
  389. procedure tppumodule.writeusedunit(intf:boolean);
  390. var
  391. hp : tused_unit;
  392. oldcrc : boolean;
  393. begin
  394. { renumber the units for derefence writing }
  395. numberunits;
  396. { write a reference for each used unit }
  397. hp:=tused_unit(used_units.first);
  398. while assigned(hp) do
  399. begin
  400. if hp.in_interface=intf then
  401. begin
  402. ppufile.putstring(hp.u.realmodulename^);
  403. { the checksum should not affect the crc of this unit ! (PFV) }
  404. oldcrc:=ppufile.do_crc;
  405. ppufile.do_crc:=false;
  406. ppufile.putlongint(longint(hp.checksum));
  407. ppufile.putlongint(longint(hp.interface_checksum));
  408. ppufile.do_crc:=oldcrc;
  409. end;
  410. hp:=tused_unit(hp.next);
  411. end;
  412. ppufile.do_interface_crc:=true;
  413. ppufile.writeentry(ibloadunit);
  414. end;
  415. procedure tppumodule.writelinkcontainer(var p:tlinkcontainer;id:byte;strippath:boolean);
  416. var
  417. hcontainer : tlinkcontainer;
  418. s : string;
  419. mask : cardinal;
  420. begin
  421. hcontainer:=TLinkContainer.Create;
  422. while not p.empty do
  423. begin
  424. s:=p.get(mask);
  425. if strippath then
  426. ppufile.putstring(SplitFileName(s))
  427. else
  428. ppufile.putstring(s);
  429. ppufile.putlongint(mask);
  430. hcontainer.add(s,mask);
  431. end;
  432. ppufile.writeentry(id);
  433. p.Free;
  434. p:=hcontainer;
  435. end;
  436. procedure tppumodule.writederefdata;
  437. var
  438. oldcrc : boolean;
  439. len,hlen : longint;
  440. buf : array[0..1023] of byte;
  441. begin
  442. if derefdataintflen>derefdata.size then
  443. internalerror(200310223);
  444. derefdata.seek(0);
  445. { Write interface data }
  446. len:=derefdataintflen;
  447. while (len>0) do
  448. begin
  449. if len>1024 then
  450. hlen:=1024
  451. else
  452. hlen:=len;
  453. derefdata.read(buf,hlen);
  454. ppufile.putdata(buf,hlen);
  455. dec(len,hlen);
  456. end;
  457. { Write implementation data, this does not influence crc }
  458. oldcrc:=ppufile.do_crc;
  459. ppufile.do_crc:=false;
  460. len:=derefdata.size-derefdataintflen;
  461. while (len>0) do
  462. begin
  463. if len>1024 then
  464. hlen:=1024
  465. else
  466. hlen:=len;
  467. derefdata.read(buf,hlen);
  468. ppufile.putdata(buf,hlen);
  469. dec(len,hlen);
  470. end;
  471. if derefdata.pos<>derefdata.size then
  472. internalerror(200310224);
  473. ppufile.do_crc:=oldcrc;
  474. ppufile.writeentry(ibderefdata);
  475. end;
  476. procedure tppumodule.putasmsymbol_in_idx(s:tnamedindexitem;arg:pointer);
  477. begin
  478. if tasmsymbol(s).ppuidx<>-1 then
  479. librarydata.asmsymbolidx^[tasmsymbol(s).ppuidx-1]:=tasmsymbol(s);
  480. end;
  481. procedure tppumodule.writeasmsymbols;
  482. var
  483. s : tasmsymbol;
  484. i : longint;
  485. asmsymtype : byte;
  486. begin
  487. { get an ordered list of all symbols to put in the ppu }
  488. getmem(librarydata.asmsymbolidx,librarydata.asmsymbolppuidx*sizeof(pointer));
  489. fillchar(librarydata.asmsymbolidx^,librarydata.asmsymbolppuidx*sizeof(pointer),0);
  490. librarydata.symbolsearch.foreach({$ifdef FPCPROCVAR}@{$endif}putasmsymbol_in_idx,nil);
  491. { write the number of symbols }
  492. ppufile.putlongint(librarydata.asmsymbolppuidx);
  493. { write the symbols from the indexed list to the ppu }
  494. for i:=1 to librarydata.asmsymbolppuidx do
  495. begin
  496. s:=librarydata.asmsymbolidx^[i-1];
  497. if not assigned(s) then
  498. internalerror(200208071);
  499. asmsymtype:=1;
  500. if s.Classtype=tasmlabel then
  501. begin
  502. if tasmlabel(s).is_addr then
  503. asmsymtype:=4
  504. else if tasmlabel(s).typ=AT_DATA then
  505. asmsymtype:=3
  506. else
  507. asmsymtype:=2;
  508. end;
  509. ppufile.putbyte(asmsymtype);
  510. case asmsymtype of
  511. 1 :
  512. ppufile.putstring(s.name);
  513. 2 :
  514. ppufile.putlongint(tasmlabel(s).labelnr);
  515. end;
  516. ppufile.putbyte(byte(s.defbind));
  517. ppufile.putbyte(byte(s.typ));
  518. end;
  519. ppufile.writeentry(ibasmsymbols);
  520. end;
  521. procedure tppumodule.readusedmacros;
  522. var
  523. hs : string;
  524. mac : tmacro;
  525. was_defined_at_startup,
  526. was_used : boolean;
  527. begin
  528. { only possible when we've a scanner of the current file }
  529. if not assigned(current_scanner) then
  530. exit;
  531. while not ppufile.endofentry do
  532. begin
  533. hs:=ppufile.getstring;
  534. was_defined_at_startup:=boolean(ppufile.getbyte);
  535. was_used:=boolean(ppufile.getbyte);
  536. mac:=tmacro(tscannerfile(current_scanner).macros.search(hs));
  537. if assigned(mac) then
  538. begin
  539. {$ifndef EXTDEBUG}
  540. { if we don't have the sources why tell }
  541. if sources_avail then
  542. {$endif ndef EXTDEBUG}
  543. if (not was_defined_at_startup) and
  544. was_used and
  545. mac.defined_at_startup then
  546. Message2(unit_h_cond_not_set_in_last_compile,hs,mainsource^);
  547. end
  548. else { not assigned }
  549. if was_defined_at_startup and
  550. was_used then
  551. Message2(unit_h_cond_set_in_last_compile,hs,mainsource^);
  552. end;
  553. end;
  554. procedure tppumodule.readsourcefiles;
  555. var
  556. temp,hs : string;
  557. temp_dir : string;
  558. main_dir : string;
  559. found,
  560. is_main : boolean;
  561. orgfiletime,
  562. source_time : longint;
  563. hp : tinputfile;
  564. begin
  565. sources_avail:=true;
  566. is_main:=true;
  567. main_dir:='';
  568. while not ppufile.endofentry do
  569. begin
  570. hs:=ppufile.getstring;
  571. orgfiletime:=ppufile.getlongint;
  572. temp_dir:='';
  573. if (flags and uf_in_library)<>0 then
  574. begin
  575. sources_avail:=false;
  576. temp:=' library';
  577. end
  578. else if pos('Macro ',hs)=1 then
  579. begin
  580. { we don't want to find this file }
  581. { but there is a problem with file indexing !! }
  582. temp:='';
  583. end
  584. else
  585. begin
  586. { check the date of the source files:
  587. 1 path of ppu
  588. 2 path of main source
  589. 3 current dir
  590. 4 include/unit path }
  591. Source_Time:=GetNamedFileTime(path^+hs);
  592. found:=false;
  593. if Source_Time<>-1 then
  594. hs:=path^+hs
  595. else
  596. if not(is_main) then
  597. begin
  598. Source_Time:=GetNamedFileTime(main_dir+hs);
  599. if Source_Time<>-1 then
  600. hs:=main_dir+hs;
  601. end;
  602. if Source_Time=-1 then
  603. Source_Time:=GetNamedFileTime(hs);
  604. if (Source_Time=-1) then
  605. begin
  606. if is_main then
  607. found:=unitsearchpath.FindFile(hs,temp_dir)
  608. else
  609. found:=includesearchpath.FindFile(hs,temp_dir);
  610. if found then
  611. begin
  612. Source_Time:=GetNamedFileTime(temp_dir);
  613. if Source_Time<>-1 then
  614. hs:=temp_dir;
  615. end;
  616. end;
  617. if Source_Time<>-1 then
  618. begin
  619. if is_main then
  620. main_dir:=temp_dir;
  621. temp:=' time '+filetimestring(source_time);
  622. if (orgfiletime<>-1) and
  623. (source_time<>orgfiletime) then
  624. begin
  625. if ((flags and uf_release)=0) then
  626. begin
  627. do_compile:=true;
  628. recompile_reason:=rr_sourcenewer;
  629. end
  630. else
  631. Message2(unit_h_source_modified,hs,ppufilename^);
  632. temp:=temp+' *';
  633. end;
  634. end
  635. else
  636. begin
  637. sources_avail:=false;
  638. temp:=' not found';
  639. end;
  640. hp:=tinputfile.create(hs);
  641. { the indexing is wrong here PM }
  642. sourcefiles.register_file(hp);
  643. end;
  644. if is_main then
  645. begin
  646. stringdispose(mainsource);
  647. mainsource:=stringdup(hs);
  648. end;
  649. Message1(unit_u_ppu_source,hs+temp);
  650. is_main:=false;
  651. end;
  652. { check if we want to rebuild every unit, only if the sources are
  653. available }
  654. if do_build and sources_avail and
  655. ((flags and uf_release)=0) then
  656. begin
  657. do_compile:=true;
  658. recompile_reason:=rr_build;
  659. end;
  660. end;
  661. procedure tppumodule.readloadunit;
  662. var
  663. hs : string;
  664. pu : tused_unit;
  665. hp : tppumodule;
  666. intfchecksum,
  667. checksum : cardinal;
  668. begin
  669. while not ppufile.endofentry do
  670. begin
  671. hs:=ppufile.getstring;
  672. checksum:=cardinal(ppufile.getlongint);
  673. intfchecksum:=cardinal(ppufile.getlongint);
  674. { set the state of this unit before registering, this is
  675. needed for a correct circular dependency check }
  676. hp:=registerunit(self,hs,'');
  677. pu:=addusedunit(hp,false,nil);
  678. pu.checksum:=checksum;
  679. pu.interface_checksum:=intfchecksum;
  680. end;
  681. in_interface:=false;
  682. end;
  683. procedure tppumodule.readlinkcontainer(var p:tlinkcontainer);
  684. var
  685. s : string;
  686. m : longint;
  687. begin
  688. while not ppufile.endofentry do
  689. begin
  690. s:=ppufile.getstring;
  691. m:=ppufile.getlongint;
  692. p.add(s,m);
  693. end;
  694. end;
  695. procedure tppumodule.readderefdata;
  696. var
  697. len,hlen : longint;
  698. buf : array[0..1023] of byte;
  699. begin
  700. len:=ppufile.entrysize;
  701. while (len>0) do
  702. begin
  703. if len>1024 then
  704. hlen:=1024
  705. else
  706. hlen:=len;
  707. ppufile.getdata(buf,hlen);
  708. derefdata.write(buf,hlen);
  709. dec(len,hlen);
  710. end;
  711. end;
  712. procedure tppumodule.readasmsymbols;
  713. var
  714. labelnr,
  715. i : longint;
  716. name : string;
  717. bind : TAsmSymBind;
  718. typ : TAsmSymType;
  719. asmsymtype : byte;
  720. begin
  721. librarydata.asmsymbolppuidx:=ppufile.getlongint;
  722. if librarydata.asmsymbolppuidx>0 then
  723. begin
  724. getmem(librarydata.asmsymbolidx,librarydata.asmsymbolppuidx*sizeof(pointer));
  725. fillchar(librarydata.asmsymbolidx^,librarydata.asmsymbolppuidx*sizeof(pointer),0);
  726. for i:=1 to librarydata.asmsymbolppuidx do
  727. begin
  728. asmsymtype:=ppufile.getbyte;
  729. case asmsymtype of
  730. 1 :
  731. name:=ppufile.getstring;
  732. 2..4 :
  733. labelnr:=ppufile.getlongint;
  734. else
  735. internalerror(200208192);
  736. end;
  737. bind:=tasmsymbind(ppufile.getbyte);
  738. typ:=tasmsymtype(ppufile.getbyte);
  739. case asmsymtype of
  740. 1 :
  741. librarydata.asmsymbolidx^[i-1]:=librarydata.newasmsymboltype(name,bind,typ);
  742. 2 :
  743. librarydata.asmsymbolidx^[i-1]:=librarydata.newasmlabel(labelnr,false,false);
  744. 3 :
  745. librarydata.asmsymbolidx^[i-1]:=librarydata.newasmlabel(labelnr,true,false);
  746. 4 :
  747. librarydata.asmsymbolidx^[i-1]:=librarydata.newasmlabel(labelnr,false,true);
  748. end;
  749. end;
  750. end;
  751. end;
  752. procedure tppumodule.load_interface;
  753. var
  754. b : byte;
  755. newmodulename : string;
  756. begin
  757. { read interface part }
  758. repeat
  759. b:=ppufile.readentry;
  760. case b of
  761. ibmodulename :
  762. begin
  763. newmodulename:=ppufile.getstring;
  764. if (cs_check_unit_name in aktglobalswitches) and
  765. (upper(newmodulename)<>modulename^) then
  766. Message2(unit_f_unit_name_error,realmodulename^,newmodulename);
  767. stringdispose(modulename);
  768. stringdispose(realmodulename);
  769. modulename:=stringdup(upper(newmodulename));
  770. realmodulename:=stringdup(newmodulename);
  771. end;
  772. ibsourcefiles :
  773. readsourcefiles;
  774. ibusedmacros :
  775. readusedmacros;
  776. ibloadunit :
  777. readloadunit;
  778. iblinkunitofiles :
  779. readlinkcontainer(LinkUnitOFiles);
  780. iblinkunitstaticlibs :
  781. readlinkcontainer(LinkUnitStaticLibs);
  782. iblinkunitsharedlibs :
  783. readlinkcontainer(LinkUnitSharedLibs);
  784. iblinkotherofiles :
  785. readlinkcontainer(LinkotherOFiles);
  786. iblinkotherstaticlibs :
  787. readlinkcontainer(LinkotherStaticLibs);
  788. iblinkothersharedlibs :
  789. readlinkcontainer(LinkotherSharedLibs);
  790. ibderefdata :
  791. readderefdata;
  792. ibendinterface :
  793. break;
  794. else
  795. Message1(unit_f_ppu_invalid_entry,tostr(b));
  796. end;
  797. until false;
  798. end;
  799. procedure tppumodule.load_implementation;
  800. var
  801. b : byte;
  802. oldobjectlibrary : tasmlibrarydata;
  803. begin
  804. { read implementation part }
  805. repeat
  806. b:=ppufile.readentry;
  807. case b of
  808. ibloadunit :
  809. readloadunit;
  810. ibasmsymbols :
  811. readasmsymbols;
  812. ibendimplementation :
  813. break;
  814. else
  815. Message1(unit_f_ppu_invalid_entry,tostr(b));
  816. end;
  817. until false;
  818. { we can now derefence all pointers to the implementation parts }
  819. oldobjectlibrary:=objectlibrary;
  820. objectlibrary:=librarydata;
  821. aktglobalsymtable:=tstoredsymtable(globalsymtable);
  822. tstoredsymtable(globalsymtable).derefimpl;
  823. if assigned(localsymtable) then
  824. begin
  825. aktstaticsymtable:=tstoredsymtable(localsymtable);
  826. tstoredsymtable(localsymtable).derefimpl;
  827. end;
  828. objectlibrary:=oldobjectlibrary;
  829. end;
  830. procedure tppumodule.load_symtable_refs;
  831. var
  832. b : byte;
  833. i : longint;
  834. begin
  835. { load local symtable first }
  836. if ((flags and uf_local_browser)<>0) then
  837. begin
  838. localsymtable:=tstaticsymtable.create(modulename^);
  839. tstaticsymtable(localsymtable).ppuload(ppufile);
  840. end;
  841. { load browser }
  842. if (flags and uf_has_browser)<>0 then
  843. begin
  844. tstoredsymtable(globalsymtable).load_references(ppufile,true);
  845. for i:=0 to mapsize-1 do
  846. tstoredsymtable(globalsymtable).load_references(ppufile,false);
  847. b:=ppufile.readentry;
  848. if b<>ibendbrowser then
  849. Message1(unit_f_ppu_invalid_entry,tostr(b));
  850. end;
  851. if ((flags and uf_local_browser)<>0) then
  852. tstaticsymtable(localsymtable).load_references(ppufile,true);
  853. end;
  854. procedure tppumodule.writeppu;
  855. var
  856. pu : tused_unit;
  857. begin
  858. Message1(unit_u_ppu_write,realmodulename^);
  859. { create unit flags }
  860. {$ifdef GDB}
  861. if cs_gdb_dbx in aktglobalswitches then
  862. flags:=flags or uf_has_dbx;
  863. {$endif GDB}
  864. if cs_browser in aktmoduleswitches then
  865. flags:=flags or uf_has_browser;
  866. if cs_local_browser in aktmoduleswitches then
  867. flags:=flags or uf_local_browser;
  868. if do_release then
  869. flags:=flags or uf_release;
  870. {$ifdef cpufpemu}
  871. if (cs_fp_emulation in aktmoduleswitches) then
  872. flags:=flags or uf_fpu_emulation;
  873. {$endif cpufpemu}
  874. {$ifdef Test_Double_checksum_write}
  875. Assign(CRCFile,s+'.IMP');
  876. Rewrite(CRCFile);
  877. {$endif def Test_Double_checksum_write}
  878. { create new ppufile }
  879. ppufile:=tcompilerppufile.create(ppufilename^);
  880. if not ppufile.createfile then
  881. Message(unit_f_ppu_cannot_write);
  882. { first the unitname }
  883. ppufile.putstring(realmodulename^);
  884. ppufile.writeentry(ibmodulename);
  885. writesourcefiles;
  886. writeusedmacros;
  887. { write interface uses }
  888. writeusedunit(true);
  889. { write the objectfiles and libraries that come for this unit,
  890. preserve the containers becuase they are still needed to load
  891. the link.res. All doesn't depend on the crc! It doesn't matter
  892. if a unit is in a .o or .a file }
  893. ppufile.do_crc:=false;
  894. writelinkcontainer(linkunitofiles,iblinkunitofiles,true);
  895. writelinkcontainer(linkunitstaticlibs,iblinkunitstaticlibs,true);
  896. writelinkcontainer(linkunitsharedlibs,iblinkunitsharedlibs,true);
  897. writelinkcontainer(linkotherofiles,iblinkotherofiles,false);
  898. writelinkcontainer(linkotherstaticlibs,iblinkotherstaticlibs,true);
  899. writelinkcontainer(linkothersharedlibs,iblinkothersharedlibs,true);
  900. ppufile.do_crc:=true;
  901. { generate implementation deref data, the interface deref data is
  902. already generated when calculating the interface crc }
  903. if (cs_compilesystem in aktmoduleswitches) then
  904. begin
  905. aktglobalsymtable:=tstoredsymtable(globalsymtable);
  906. tstoredsymtable(globalsymtable).buildderef;
  907. derefdataintflen:=derefdata.size;
  908. end;
  909. tstoredsymtable(globalsymtable).buildderefimpl;
  910. if ((flags and uf_local_browser)<>0) and
  911. assigned(localsymtable) then
  912. begin
  913. aktglobalsymtable:=tstoredsymtable(globalsymtable);
  914. aktstaticsymtable:=tstoredsymtable(localsymtable);
  915. tstoredsymtable(localsymtable).buildderef;
  916. tstoredsymtable(localsymtable).buildderefimpl;
  917. end;
  918. writederefdata;
  919. ppufile.writeentry(ibendinterface);
  920. { write the symtable entries }
  921. tstoredsymtable(globalsymtable).ppuwrite(ppufile);
  922. { everything after this doesn't affect the crc }
  923. ppufile.do_crc:=false;
  924. { write implementation uses }
  925. writeusedunit(false);
  926. { write asmsymbols }
  927. writeasmsymbols;
  928. { end of implementation }
  929. ppufile.writeentry(ibendimplementation);
  930. { write static symtable
  931. needed for local debugging of unit functions }
  932. if ((flags and uf_local_browser)<>0) and
  933. assigned(localsymtable) then
  934. tstoredsymtable(localsymtable).ppuwrite(ppufile);
  935. { write all browser section }
  936. if (flags and uf_has_browser)<>0 then
  937. begin
  938. tstoredsymtable(globalsymtable).write_references(ppufile,true);
  939. pu:=tused_unit(used_units.first);
  940. while assigned(pu) do
  941. begin
  942. tstoredsymtable(pu.u.globalsymtable).write_references(ppufile,false);
  943. pu:=tused_unit(pu.next);
  944. end;
  945. ppufile.writeentry(ibendbrowser);
  946. end;
  947. if ((flags and uf_local_browser)<>0) and
  948. assigned(localsymtable) then
  949. tstaticsymtable(localsymtable).write_references(ppufile,true);
  950. { the last entry ibend is written automaticly }
  951. { flush to be sure }
  952. ppufile.flush;
  953. { create and write header }
  954. ppufile.header.size:=ppufile.size;
  955. ppufile.header.checksum:=ppufile.crc;
  956. ppufile.header.interface_checksum:=ppufile.interface_crc;
  957. ppufile.header.compiler:=wordversion;
  958. ppufile.header.cpu:=word(target_cpu);
  959. ppufile.header.target:=word(target_info.system);
  960. ppufile.header.flags:=flags;
  961. ppufile.writeheader;
  962. { save crc in current module also }
  963. crc:=ppufile.crc;
  964. interface_crc:=ppufile.interface_crc;
  965. {$ifdef Test_Double_checksum_write}
  966. close(CRCFile);
  967. {$endif Test_Double_checksum_write}
  968. ppufile.closefile;
  969. ppufile.free;
  970. ppufile:=nil;
  971. end;
  972. procedure tppumodule.getppucrc;
  973. begin
  974. {$ifdef Test_Double_checksum_write}
  975. Assign(CRCFile,s+'.INT')
  976. Rewrite(CRCFile);
  977. {$endif def Test_Double_checksum_write}
  978. { create new ppufile }
  979. ppufile:=tcompilerppufile.create(ppufilename^);
  980. ppufile.crc_only:=true;
  981. if not ppufile.createfile then
  982. Message(unit_f_ppu_cannot_write);
  983. { first the unitname }
  984. ppufile.putstring(realmodulename^);
  985. ppufile.writeentry(ibmodulename);
  986. { the interface units affect the crc }
  987. writeusedunit(true);
  988. { deref data of interface that affect the crc }
  989. derefdata.reset;
  990. aktglobalsymtable:=tstoredsymtable(globalsymtable);
  991. tstoredsymtable(globalsymtable).buildderef;
  992. derefdataintflen:=derefdata.size;
  993. writederefdata;
  994. ppufile.writeentry(ibendinterface);
  995. { write the symtable entries }
  996. tstoredsymtable(globalsymtable).ppuwrite(ppufile);
  997. { save crc }
  998. crc:=ppufile.crc;
  999. interface_crc:=ppufile.interface_crc;
  1000. { end of implementation, to generate a correct ppufile
  1001. for ppudump when using INTFPPU define }
  1002. ppufile.writeentry(ibendimplementation);
  1003. {$ifdef Test_Double_checksum}
  1004. crc_array:=ppufile.crc_test;
  1005. ppufile.crc_test:=nil;
  1006. crc_size:=ppufile.crc_index2;
  1007. crc_array2:=ppufile.crc_test2;
  1008. ppufile.crc_test2:=nil;
  1009. crc_size2:=ppufile.crc_index2;
  1010. {$endif Test_Double_checksum}
  1011. {$ifdef Test_Double_checksum_write}
  1012. close(CRCFile);
  1013. {$endif Test_Double_checksum_write}
  1014. { create and write header, this will only be used
  1015. for debugging purposes }
  1016. ppufile.header.size:=ppufile.size;
  1017. ppufile.header.checksum:=ppufile.crc;
  1018. ppufile.header.interface_checksum:=ppufile.interface_crc;
  1019. ppufile.header.compiler:=wordversion;
  1020. ppufile.header.cpu:=word(target_cpu);
  1021. ppufile.header.target:=word(target_info.system);
  1022. ppufile.header.flags:=flags;
  1023. ppufile.writeheader;
  1024. ppufile.closefile;
  1025. ppufile.free;
  1026. ppufile:=nil;
  1027. end;
  1028. procedure tppumodule.load_usedunits;
  1029. var
  1030. pu : tused_unit;
  1031. load_refs : boolean;
  1032. begin
  1033. if current_module<>self then
  1034. internalerror(200212284);
  1035. load_refs:=true;
  1036. { load the used units from interface }
  1037. in_interface:=true;
  1038. pu:=tused_unit(used_units.first);
  1039. while assigned(pu) do
  1040. begin
  1041. if pu.in_interface then
  1042. begin
  1043. tppumodule(pu.u).loadppu;
  1044. { if this unit is compiled we can stop }
  1045. if state=ms_compiled then
  1046. exit;
  1047. { add this unit to the dependencies }
  1048. pu.u.adddependency(self);
  1049. { need to recompile the current unit, check the interface
  1050. crc. And when not compiled with -Ur then check the complete
  1051. crc }
  1052. if (pu.u.interface_crc<>pu.interface_checksum) or
  1053. (
  1054. ((ppufile.header.flags and uf_release)=0) and
  1055. (pu.u.crc<>pu.checksum)
  1056. ) then
  1057. begin
  1058. Message2(unit_u_recompile_crc_change,realmodulename^,pu.u.realmodulename^);
  1059. recompile_reason:=rr_crcchanged;
  1060. do_compile:=true;
  1061. exit;
  1062. end;
  1063. end;
  1064. pu:=tused_unit(pu.next);
  1065. end;
  1066. numberunits;
  1067. { ok, now load the interface of this unit }
  1068. if current_module<>self then
  1069. internalerror(200208187);
  1070. globalsymtable:=tglobalsymtable.create(modulename^);
  1071. tstoredsymtable(globalsymtable).ppuload(ppufile);
  1072. interface_compiled:=true;
  1073. { read the implementation part, containing
  1074. the implementation uses and objectdata }
  1075. in_interface:=false;
  1076. load_implementation;
  1077. { now only read the implementation uses }
  1078. pu:=tused_unit(used_units.first);
  1079. while assigned(pu) do
  1080. begin
  1081. if (not pu.in_interface) then
  1082. begin
  1083. tppumodule(pu.u).loadppu;
  1084. { if this unit is compiled we can stop }
  1085. if state=ms_compiled then
  1086. exit;
  1087. { add this unit to the dependencies }
  1088. pu.u.adddependency(self);
  1089. { need to recompile the current unit ? }
  1090. if (pu.u.interface_crc<>pu.interface_checksum) then
  1091. begin
  1092. Message2(unit_u_recompile_crc_change,realmodulename^,pu.u.realmodulename^+' {impl}');
  1093. recompile_reason:=rr_crcchanged;
  1094. do_compile:=true;
  1095. exit;
  1096. end;
  1097. end;
  1098. pu:=tused_unit(pu.next);
  1099. end;
  1100. numberunits;
  1101. { load browser info if stored }
  1102. if ((flags and uf_has_browser)<>0) and load_refs then
  1103. begin
  1104. if current_module<>self then
  1105. internalerror(200208188);
  1106. load_symtable_refs;
  1107. end;
  1108. end;
  1109. function tppumodule.needrecompile:boolean;
  1110. var
  1111. pu : tused_unit;
  1112. begin
  1113. result:=false;
  1114. pu:=tused_unit(used_units.first);
  1115. while assigned(pu) do
  1116. begin
  1117. { need to recompile the current unit, check the interface
  1118. crc. And when not compiled with -Ur then check the complete
  1119. crc }
  1120. if (pu.u.interface_crc<>pu.interface_checksum) or
  1121. (
  1122. (pu.in_interface) and
  1123. (pu.u.crc<>pu.checksum)
  1124. ) then
  1125. begin
  1126. result:=true;
  1127. exit;
  1128. end;
  1129. pu:=tused_unit(pu.next);
  1130. end;
  1131. end;
  1132. procedure tppumodule.loadppu;
  1133. const
  1134. ImplIntf : array[boolean] of string[15]=('implementation','interface');
  1135. var
  1136. do_load,
  1137. second_time : boolean;
  1138. old_current_module : tmodule;
  1139. begin
  1140. old_current_module:=current_module;
  1141. Message3(unit_u_load_unit,old_current_module.modulename^,
  1142. ImplIntf[old_current_module.in_interface],
  1143. modulename^);
  1144. { Update loaded_from to detect cycles }
  1145. loaded_from:=old_current_module;
  1146. { check if the globalsymtable is already available, but
  1147. we must reload when the do_reload flag is set }
  1148. if (not do_reload) and
  1149. assigned(globalsymtable) then
  1150. exit;
  1151. { reset }
  1152. do_load:=true;
  1153. second_time:=false;
  1154. current_module:=self;
  1155. SetCompileModule(current_module);
  1156. Fillchar(aktfilepos,0,sizeof(aktfilepos));
  1157. { A force reload }
  1158. if do_reload then
  1159. begin
  1160. Message(unit_u_forced_reload);
  1161. do_reload:=false;
  1162. { When the unit is already loaded or being loaded
  1163. we can maybe skip a complete reload/recompile }
  1164. if assigned(globalsymtable) and
  1165. (not needrecompile) then
  1166. begin
  1167. { When we don't have any data stored yet there
  1168. is nothing to resolve }
  1169. if interface_compiled then
  1170. begin
  1171. Message1(unit_u_reresolving_unit,modulename^);
  1172. aktglobalsymtable:=tstoredsymtable(globalsymtable);
  1173. tstoredsymtable(globalsymtable).deref;
  1174. tstoredsymtable(globalsymtable).derefimpl;
  1175. if assigned(localsymtable) then
  1176. begin
  1177. aktstaticsymtable:=tstoredsymtable(localsymtable);
  1178. tstoredsymtable(localsymtable).deref;
  1179. tstoredsymtable(localsymtable).derefimpl;
  1180. end;
  1181. end
  1182. else
  1183. Message1(unit_u_skipping_reresolving_unit,modulename^);
  1184. do_load:=false;
  1185. end;
  1186. end;
  1187. if do_load then
  1188. begin
  1189. { we are loading a new module, save the state of the scanner
  1190. and reset scanner+module }
  1191. if assigned(current_scanner) then
  1192. current_scanner.tempcloseinputfile;
  1193. current_scanner:=nil;
  1194. { loading the unit for a second time? }
  1195. if state=ms_registered then
  1196. state:=ms_load
  1197. else
  1198. begin
  1199. { try to load the unit a second time first }
  1200. Message1(unit_u_second_load_unit,modulename^);
  1201. Message2(unit_u_previous_state,modulename^,ModuleStateStr[state]);
  1202. { Flag modules to reload }
  1203. flagdependent(old_current_module);
  1204. { Reset the module }
  1205. reset;
  1206. if state in [ms_compile,ms_second_compile] then
  1207. begin
  1208. Message1(unit_u_second_compile_unit,modulename^);
  1209. state:=ms_second_compile;
  1210. do_compile:=true;
  1211. end
  1212. else
  1213. state:=ms_second_load;
  1214. second_time:=true;
  1215. end;
  1216. { close old_current_ppu on system that are
  1217. short on file handles like DOS PM }
  1218. {$ifdef SHORT_ON_FILE_HANDLES}
  1219. if old_current_module.is_unit and
  1220. assigned(tppumodule(old_current_module).ppufile) then
  1221. tppumodule(old_current_module).ppufile.tempclose;
  1222. {$endif SHORT_ON_FILE_HANDLES}
  1223. { try to opening ppu, skip this when we already
  1224. know that we need to compile the unit }
  1225. if not do_compile then
  1226. begin
  1227. Message1(unit_u_loading_unit,modulename^);
  1228. search_unit(false,false);
  1229. if not do_compile then
  1230. begin
  1231. load_interface;
  1232. if not do_compile then
  1233. begin
  1234. load_usedunits;
  1235. if not do_compile then
  1236. Message1(unit_u_finished_loading_unit,modulename^);
  1237. end;
  1238. end;
  1239. { PPU is not needed anymore }
  1240. if assigned(ppufile) then
  1241. begin
  1242. ppufile.closefile;
  1243. ppufile.free;
  1244. ppufile:=nil;
  1245. end;
  1246. end;
  1247. { Do we need to recompile the unit }
  1248. if do_compile then
  1249. begin
  1250. { recompile the unit or give a fatal error if sources not available }
  1251. if not(sources_avail) then
  1252. begin
  1253. if (not search_unit(true,false)) and
  1254. (length(modulename^)>8) then
  1255. search_unit(true,true);
  1256. if not(sources_avail) then
  1257. begin
  1258. if recompile_reason=rr_noppu then
  1259. Message1(unit_f_cant_find_ppu,modulename^)
  1260. else
  1261. Message1(unit_f_cant_compile_unit,modulename^);
  1262. end;
  1263. end;
  1264. { Flag modules to reload }
  1265. flagdependent(old_current_module);
  1266. { Reset the module }
  1267. reset;
  1268. { compile this module }
  1269. if not(state in [ms_compile,ms_second_compile]) then
  1270. state:=ms_compile;
  1271. compile(mainsource^);
  1272. end
  1273. else
  1274. state:=ms_compiled;
  1275. if current_module<>self then
  1276. internalerror(200212282);
  1277. if in_interface then
  1278. internalerror(200212283);
  1279. { for a second_time recompile reload all dependent units,
  1280. for a first time compile register the unit _once_ }
  1281. if second_time then
  1282. reload_flagged_units
  1283. else
  1284. usedunits.concat(tused_unit.create(self,true,false,nil));
  1285. { reopen the old module }
  1286. {$ifdef SHORT_ON_FILE_HANDLES}
  1287. if old_current_module.is_unit and
  1288. assigned(tppumodule(old_current_module).ppufile) then
  1289. tppumodule(old_current_module).ppufile.tempopen;
  1290. {$endif SHORT_ON_FILE_HANDLES}
  1291. { reload old scanner }
  1292. current_scanner:=tscannerfile(old_current_module.scanner);
  1293. if assigned(current_scanner) then
  1294. begin
  1295. current_scanner.tempopeninputfile;
  1296. current_scanner.gettokenpos
  1297. end
  1298. else
  1299. fillchar(aktfilepos,sizeof(aktfilepos),0);
  1300. end;
  1301. { we are back, restore current_module }
  1302. current_module:=old_current_module;
  1303. SetCompileModule(current_module);
  1304. end;
  1305. {*****************************************************************************
  1306. RegisterUnit
  1307. *****************************************************************************}
  1308. function registerunit(callermodule:tmodule;const s : stringid;const fn:string) : tppumodule;
  1309. var
  1310. ups : stringid;
  1311. hp : tppumodule;
  1312. hp2,
  1313. shortnamehp : tmodule;
  1314. begin
  1315. { Info }
  1316. ups:=upper(s);
  1317. { search all loaded units }
  1318. shortnamehp:=nil;
  1319. hp:=tppumodule(loaded_units.first);
  1320. while assigned(hp) do
  1321. begin
  1322. if hp.modulename^=ups then
  1323. begin
  1324. { only check for units. The main program is also
  1325. as a unit in the loaded_units list. We simply need
  1326. to ignore this entry (PFV) }
  1327. if hp.is_unit then
  1328. begin
  1329. { both units in interface ? }
  1330. if callermodule.in_interface and
  1331. hp.in_interface then
  1332. begin
  1333. { check for a cycle }
  1334. hp2:=callermodule.loaded_from;
  1335. while assigned(hp2) and (hp2<>hp) do
  1336. begin
  1337. if hp2.in_interface then
  1338. hp2:=hp2.loaded_from
  1339. else
  1340. hp2:=nil;
  1341. end;
  1342. if assigned(hp2) then
  1343. Message2(unit_f_circular_unit_reference,callermodule.modulename^,hp.modulename^);
  1344. end;
  1345. break;
  1346. end;
  1347. end
  1348. else
  1349. if copy(hp.modulename^,1,8)=ups then
  1350. shortnamehp:=hp;
  1351. { the next unit }
  1352. hp:=tppumodule(hp.next);
  1353. end;
  1354. if assigned(shortnamehp) and not assigned(hp) then
  1355. Message2(unit_w_unit_name_error,s,shortnamehp.modulename^);
  1356. { the unit is not in the loaded units,
  1357. we create an entry and register the unit }
  1358. if not assigned(hp) then
  1359. begin
  1360. Message1(unit_u_registering_new_unit,Upper(s));
  1361. hp:=tppumodule.create(callermodule,s,fn,true);
  1362. hp.loaded_from:=callermodule;
  1363. loaded_units.insert(hp);
  1364. end;
  1365. { return }
  1366. registerunit:=hp;
  1367. end;
  1368. end.
  1369. {
  1370. $Log$
  1371. Revision 1.48 2003-12-14 18:13:18 peter
  1372. * also check currnet dir when searching source files
  1373. Revision 1.47 2003/11/28 17:23:16 peter
  1374. * serach also in include path for used files
  1375. Revision 1.46 2003/11/03 12:32:48 marco
  1376. * cycle detection patch from peter
  1377. Revision 1.45 2003/10/29 21:55:10 peter
  1378. * don't set second_load when second_compile was already set
  1379. Revision 1.44 2003/10/29 21:02:51 peter
  1380. * set ms_compiled after the program/unit is parsed
  1381. * check for ms_compiled before checking preproc matches
  1382. Revision 1.43 2003/10/23 14:44:07 peter
  1383. * splitted buildderef and buildderefimpl to fix interface crc
  1384. calculation
  1385. Revision 1.42 2003/10/22 20:40:00 peter
  1386. * write derefdata in a separate ppu entry
  1387. Revision 1.41 2003/10/22 17:38:25 peter
  1388. * write implementation units in implementation part of the ppu
  1389. so it doesn't confuse the unit loading
  1390. Revision 1.40 2003/10/22 15:22:33 peter
  1391. * fixed unitsym-globalsymtable relation so the uses of a unit
  1392. is counted correctly
  1393. Revision 1.39 2003/09/05 17:41:12 florian
  1394. * merged Wiktor's Watcom patches in 1.1
  1395. Revision 1.38 2003/08/23 22:29:24 peter
  1396. * reload flagged units when interface is loaded
  1397. Revision 1.37 2003/06/08 11:40:14 peter
  1398. * moved message to msg file
  1399. Revision 1.36 2003/06/07 20:26:32 peter
  1400. * re-resolving added instead of reloading from ppu
  1401. * tderef object added to store deref info for resolving
  1402. Revision 1.35 2003/05/25 10:27:12 peter
  1403. * moved Comment calls to messge file
  1404. Revision 1.34 2003/05/23 17:04:37 peter
  1405. * write interface crc to .ppu.intf when enabled
  1406. * when a unit is compiled with -Ur check only interface crc
  1407. Revision 1.33 2003/04/27 11:21:32 peter
  1408. * aktprocdef renamed to current_procdef
  1409. * procinfo renamed to current_procinfo
  1410. * procinfo will now be stored in current_module so it can be
  1411. cleaned up properly
  1412. * gen_main_procsym changed to create_main_proc and release_main_proc
  1413. to also generate a tprocinfo structure
  1414. * fixed unit implicit initfinal
  1415. Revision 1.32 2003/04/27 07:29:50 peter
  1416. * current_procdef cleanup, current_procdef is now always nil when parsing
  1417. a new procdef declaration
  1418. * aktprocsym removed
  1419. * lexlevel removed, use symtable.symtablelevel instead
  1420. * implicit init/final code uses the normal genentry/genexit
  1421. * funcret state checking updated for new funcret handling
  1422. Revision 1.31 2003/04/26 00:30:52 peter
  1423. * reset aktfilepos when setting new module for compile
  1424. Revision 1.30 2003/03/27 17:44:13 peter
  1425. * fixed small mem leaks
  1426. Revision 1.29 2002/12/29 14:57:50 peter
  1427. * unit loading changed to first register units and load them
  1428. afterwards. This is needed to support uses xxx in yyy correctly
  1429. * unit dependency check fixed
  1430. Revision 1.28 2002/12/06 16:56:57 peter
  1431. * only compile cs_fp_emulation support when cpufpuemu is defined
  1432. * define cpufpuemu for m68k only
  1433. Revision 1.27 2002/11/20 12:36:24 mazen
  1434. * $UNITPATH directive is now working
  1435. Revision 1.26 2002/11/15 01:58:46 peter
  1436. * merged changes from 1.0.7 up to 04-11
  1437. - -V option for generating bug report tracing
  1438. - more tracing for option parsing
  1439. - errors for cdecl and high()
  1440. - win32 import stabs
  1441. - win32 records<=8 are returned in eax:edx (turned off by default)
  1442. - heaptrc update
  1443. - more info for temp management in .s file with EXTDEBUG
  1444. Revision 1.25 2002/10/20 14:49:31 peter
  1445. * store original source time in ppu so it can be compared instead of
  1446. comparing with the ppu time
  1447. Revision 1.24 2002/10/04 20:13:10 peter
  1448. * set in_second_load flag before resetting the module, this is
  1449. required to skip some checkings
  1450. Revision 1.23 2002/08/19 19:36:42 peter
  1451. * More fixes for cross unit inlining, all tnodes are now implemented
  1452. * Moved pocall_internconst to po_internconst because it is not a
  1453. calling type at all and it conflicted when inlining of these small
  1454. functions was requested
  1455. Revision 1.22 2002/08/18 19:58:28 peter
  1456. * more current_scanner fixes
  1457. Revision 1.21 2002/08/15 15:09:41 carl
  1458. + fpu emulation helpers (ppu checking also)
  1459. Revision 1.20 2002/08/12 16:46:04 peter
  1460. * tscannerfile is now destroyed in tmodule.reset and current_scanner
  1461. is updated accordingly. This removes all the loading and saving of
  1462. the old scanner and the invalid flag marking
  1463. Revision 1.19 2002/08/11 14:28:19 peter
  1464. * TScannerFile.SetInvalid added that will also reset inputfile
  1465. Revision 1.18 2002/08/11 13:24:11 peter
  1466. * saving of asmsymbols in ppu supported
  1467. * asmsymbollist global is removed and moved into a new class
  1468. tasmlibrarydata that will hold the info of a .a file which
  1469. corresponds with a single module. Added librarydata to tmodule
  1470. to keep the library info stored for the module. In the future the
  1471. objectfiles will also be stored to the tasmlibrarydata class
  1472. * all getlabel/newasmsymbol and friends are moved to the new class
  1473. Revision 1.17 2002/07/26 21:15:37 florian
  1474. * rewrote the system handling
  1475. Revision 1.16 2002/05/16 19:46:36 carl
  1476. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  1477. + try to fix temp allocation (still in ifdef)
  1478. + generic constructor calls
  1479. + start of tassembler / tmodulebase class cleanup
  1480. Revision 1.15 2002/05/14 19:34:41 peter
  1481. * removed old logs and updated copyright year
  1482. Revision 1.14 2002/05/12 16:53:05 peter
  1483. * moved entry and exitcode to ncgutil and cgobj
  1484. * foreach gets extra argument for passing local data to the
  1485. iterator function
  1486. * -CR checks also class typecasts at runtime by changing them
  1487. into as
  1488. * fixed compiler to cycle with the -CR option
  1489. * fixed stabs with elf writer, finally the global variables can
  1490. be watched
  1491. * removed a lot of routines from cga unit and replaced them by
  1492. calls to cgobj
  1493. * u32bit-s32bit updates for and,or,xor nodes. When one element is
  1494. u32bit then the other is typecasted also to u32bit without giving
  1495. a rangecheck warning/error.
  1496. * fixed pascal calling method with reversing also the high tree in
  1497. the parast, detected by tcalcst3 test
  1498. Revision 1.13 2002/04/04 19:05:56 peter
  1499. * removed unused units
  1500. * use tlocation.size in cg.a_*loc*() routines
  1501. Revision 1.12 2002/03/28 20:46:44 carl
  1502. - remove go32v1 support
  1503. Revision 1.11 2002/01/19 14:20:13 peter
  1504. * check for -Un when loading ppu with wrong name
  1505. }