Index: gp.pas =================================================================== --- gp.pas (revision 309) +++ gp.pas (working copy) @@ -150,16 +150,21 @@ UsedBy: array [Boolean] of PDepList; { index means `interface' } MD5: TMD5; MD5Units: array [Boolean] of TMD5; { index means `interface' } + MD5UnitsAsRead: array [Boolean] of TMD5; { index means `interface' } Recompile: (rc_None, rc_Impossible, rc_SrcChanged, rc_AlwaysButGPIOK, rc_Always); InDegree: array [Boolean] of Integer; { index means `interface' } CyclePosition: PDepList; DepsProcessed: (dp_None, dp_Interface, dp_All); - InterfaceUsedUnitRecompiled, LinkOptionsMismatch: Boolean + LinkOptionsMismatch: Boolean; + Compiling, CompileDoAssemble, CompileInterfaceOnly: Boolean; + CompileStatus: Integer; + CompileProcess: PPipeProcess; end; TUnitList = record Next: PUnitList; FileName, InterfaceName: TString; + IsUnit: Boolean; MD5: TMD5; Dep: PDep end; @@ -361,6 +366,17 @@ ErrorFile (FileName, 'no directory or not writable') end; +function NewUsesElement (const InterfaceName, FileName: String; Next: PUnitList) = p: PUnitList; +begin + New (p); + p^.InterfaceName := LoCaseStr (InterfaceName); + p^.FileName := FileName; + MD5Clear (p^.MD5); + p^.Dep := nil; + p^.IsUnit := True; + p^.Next := Next +end; + { GPD file handling } function ReadGPD (var Dep: TDep): TGPD; @@ -426,7 +442,9 @@ end; function AddUnitList (var p: PPUnitList): Boolean; - var i, j: Integer; + var + i, j: Integer; + MD5: TMD5; begin AddUnitList := False; if not PascalFlag then @@ -434,17 +452,15 @@ ReadGPDError ('invalid unit dependency for C file'); Exit end; - New (p^); i := PosFrom (' ', Line, 3); j := LastPos (' ', Line); - if (i >= j) or not MD5Val (Copy (Line, j + 1), p^^.MD5) then + if (i >= j) or not MD5Val (Copy (Line, j + 1), MD5) then begin ReadGPDError ('invalid unit entry'); Exit end; - p^^.InterfaceName := Copy (Line, 3, i - 3); - p^^.FileName := Copy (Line, i + 1, j - i - 1); - p^^.Dep := nil; + p^ := NewUsesElement( Copy (Line, 3, i - 3), Copy (Line, i + 1, j - i - 1), nil ); + p^^.MD5 := MD5; p := @p^^.Next; AddUnitList := True end; @@ -499,7 +515,9 @@ end; if not ReadMD5 ('m ', MD5) then Exit; if not ReadMD5 ('m ', MD5Units[True]) then Exit; + MD5UnitsAsRead[True] := MD5Units[True]; if not ReadMD5 ('m ', MD5Units[False]) then Exit; + MD5UnitsAsRead[False] := MD5Units[False]; if not ReadLine ('M ', ModuleName) then Exit; PExportedInterfaces := @ExportedInterfaces; PIncludes := @Includes; @@ -562,7 +580,9 @@ begin while p <> nil do begin - WriteLn (f, Prefix, p^.InterfaceName, ' ', p^.FileName, ' ', MD5Str (p^.MD5)); + if p^.IsUnit then begin + WriteLn (f, Prefix, p^.InterfaceName, ' ', p^.FileName, ' ', MD5Str (p^.MD5)); + end; p := p^.Next end end; @@ -622,7 +642,8 @@ procedure StartPipe (PascalFlag: Boolean; OptionSelection: TOptionSelection; const AdditionalParameters: array [m .. n: Integer] of PString; var OutputFile, StdErrFile: AnyFile; var Status: Integer; - var CmdLine: String { CmdLine may be Null }); + var CmdLine: String; { CmdLine may be Null } + var TheProcess: PPipeProcess ); var Process: PPipeProcess; Parameters: PPStrings; @@ -669,7 +690,10 @@ for i := e + OptionCount + 1 to Parameters^.Count do Dispose (Parameters^[i]); Dispose (Parameters); - if (@OutputFile = nil) and (@StdErrFile = nil) then Discard (WaitPipeProcess (Process)) + if @TheProcess <> nil then + TheProcess := Process + else + if (@OutputFile = nil) and (@StdErrFile = nil) then Discard (WaitPipeProcess (Process)) end; procedure InitCompiler (PascalFlag: Boolean); @@ -686,7 +710,7 @@ if Compilers[PascalFlag].Initialized then Exit; Both := Compilers[False].ProgName = Compilers[True].ProgName; ProgressMessage ('Checking ' + CPascal[Ord (PascalFlag and not Both) + 2 * Ord (Both)] + ' compiler'); - StartPipe (PascalFlag, co_OnlyVersion, Parameters1, OutputFile, Null, Status, CmdLine); + StartPipe (PascalFlag, co_OnlyVersion, Parameters1, OutputFile, Null, Status, CmdLine, Null); ReadLn (OutputFile, s); Compilers[PascalFlag].Platform := s; if Both then Compilers[not PascalFlag].Platform := s; @@ -694,7 +718,7 @@ Error ('internal problem: unexpected additional output of `' + CmdLine + ''''); Close (OutputFile); if Status <> 0 then Quit (Status); - StartPipe (PascalFlag, co_OnlyVersion, Parameters2, OutputFile, Null, Status, CmdLine); + StartPipe (PascalFlag, co_OnlyVersion, Parameters2, OutputFile, Null, Status, CmdLine, Null); ReadLn (OutputFile, s); Compilers[PascalFlag].Version := s; if Both then Compilers[not PascalFlag].Version := s; @@ -720,16 +744,6 @@ UnitNameMatch := LoCaseStr( Dep.SrcBaseName ) = LoCaseStr( InterfaceName ); end; -function NewUsesElement (const InterfaceName, FileName: String; Next: PUnitList) = p: PUnitList; -begin - New (p); - p^.InterfaceName := LoCaseStr (InterfaceName); - p^.FileName := FileName; - MD5Clear (p^.MD5); - p^.Dep := nil; - p^.Next := Next -end; - procedure GetDep (var Dep: TDep); function ReadBufferAndIncludes (var OutputFile: File; var StdErrFile: Text; var Buffer: PBytes; @@ -864,7 +878,7 @@ end; begin - StartPipe (True, co_NoVerbose, Parameters, OutputFile, StdErrFile, Status, Null); + StartPipe (True, co_NoVerbose, Parameters, OutputFile, StdErrFile, Status, Null, Null); if not ReadBufferAndIncludes (OutputFile, StdErrFile, Buffer, BufCount, Dep.Lines, Dep.Includes) and (Status = 0) then Status := 1; if Status <> 0 then Quit (Status); @@ -961,7 +975,7 @@ Buffer: PBytes; Status, BufCount: Integer; begin - StartPipe (False, co_NoVerbose, Parameters, OutputFile, StdErrFile, Status, Null); + StartPipe (False, co_NoVerbose, Parameters, OutputFile, StdErrFile, Status, Null, Null); if not ReadBufferAndIncludes (OutputFile, StdErrFile, Buffer, BufCount, Dep.Lines, Dep.Includes) and (Status = 0) then Status := 1; if Status <> 0 then Quit (Status); @@ -1077,7 +1091,12 @@ Dep.Recompile := rc_Always end else if (Cleaning = 0) and SourceNewerThan (ObjectTime, GPITime, 'recompiling') then - Dep.Recompile := rc_SrcChanged; + Dep.Recompile := rc_SrcChanged + else if (Cleaning = 0) and Dep.Main and not AssembleFlag then + begin + Message (3, Dep.SrcName + ': recompiling main because of -S'); + Dep.Recompile := rc_Always; + end; if (Dep.Recompile <> rc_Always) and (Cleaning = 0) then begin if CheckPlatform and (Dep.Platform <> Compilers[PascalFlag].Platform) then @@ -1124,6 +1143,8 @@ MD5Clear (Dep.MD5); Dep.MD5Units[False] := Dep.MD5; Dep.MD5Units[True] := Dep.MD5; + Dep.MD5UnitsAsRead[False] := Dep.MD5; + Dep.MD5UnitsAsRead[True] := Dep.MD5; if PascalFlag then ParsePascal (Dep.SrcName, Dep) else @@ -1328,54 +1349,38 @@ ps := DepToDo^.Dep^.LinkedFiles; while ps <> nil do begin - { Just make sure the file is added to Deps. We don't need - any dependency relations because files linked with - linker directives can be compiled at any time. } - Discard (FindDep (ObjectPath, ps^.s, '', fk_CFile)); + { Must compile $L files before implementation. } + CurrentDep := FindDep (ObjectPath, ps^.s, '', fk_CFile); + AddDepList (CurrentDep^.Dep^.UsedBy[False], DepToDo^.Dep); + DepToDo^.Dep^.UsedUnits[False] := NewUsesElement ( CurrentDep^.Dep^.InterfaceName, CurrentDep^.Dep^.SrcName, DepToDo^.Dep^.UsedUnits[False]); + // what FileName should I use? + DepToDo^.Dep^.UsedUnits[False]^.Dep := CurrentDep^.Dep; + DepToDo^.Dep^.UsedUnits[False]^.IsUnit := False; ps := ps^.Next end; DepToDo := DepToDo^.Next end end; -{ Check if any used unit's interface has changed (by comparing the - MD5), and if so, update the MD5 and recompile this module. +function MD5IsClear (const Value: TMD5): Boolean; +var Zero: TMD5; +begin + MD5Clear( Zero ); + return MD5Compare( Value, Zero ); +end; - Don't abort the checking prematurely when it's clear that the - current module has to be recompiled because we have to update the - MD5 for all units. +{ Check if any directly used units are changed and force compilation. + Update MD5 in unit list. } - Note: The information whether to recompile the current module is - stored in a field of Dep (`Recompile') rather than a local - variable, so if InterfaceOnly is True, the information will still - be available when later compiling the same module without - `--interface-only'. - - MD5Units is recursively composed from the MD5 values of all units - used in the interface or implementation, respectively, directly or - indirectly through other modules' interfaces, so it's responsible - for recompiling the current module if a module used indirectly was - changed. } -procedure CompileIfNecessary (var Dep: TDep; InterfaceOnly: Boolean); -const - InterfaceOf: array [0 .. 2] of String (18) = ('', 'interface of ', 'implementation of '); +procedure CheckIfCompileDirectlyNecessary (var Dep: TDep); var - UsedUnitChanged, DoInterface, DoAssemble, ImplementationOnly: Boolean; + UsedUnitChanged, DoInterface: Boolean; p: PUnitList; - NewMD5Units: TMD5; - Status: Integer; - GPIDestinationPath, GPIDestinationPathAsUnitPath, CompileOption, ObjectName: TString; - Parameters: array [1 .. 10] of PString = - (@'--interface-only', @'--no-progress-bar', - @GPIDestinationPath, @GPIDestinationPathAsUnitPath, @'--no-automake', - @CompileOption, @'-o', @ObjectName, @Dep.SrcName, @AutoUsesOption); begin { If recompiling anyway, set UsedUnitChanged to suppress further messages } UsedUnitChanged := Dep.Recompile in [rc_SrcChanged, rc_Always]; - Dep.InterfaceUsedUnitRecompiled := False; - for DoInterface := InterfaceOnly to True do + for DoInterface := False to True do begin - NewMD5Units := Dep.MD5; p := Dep.UsedUnits[DoInterface]; while p <> nil do begin @@ -1383,41 +1388,70 @@ begin p^.MD5 := p^.Dep^.MD5; if not UsedUnitChanged then - Message (3, Dep.SrcName + ': recompiling because interface of `' + p^.Dep^.SrcBaseNameExt + ''' has changed'); + begin + Message (3, Dep.SrcName + ': recompiling because interface of `' + p^.Dep^.SrcBaseNameExt + ''' has changed'); + if DoInterface and (Dep.Recompile = rc_AlwaysButGPIOK) then + Dep.Recompile := rc_Always + end; UsedUnitChanged := True - end -{$if False} -{ I think that's too paranoid. If options have an influence, they - will affect the GPI's MD5. OTOH, this check forces recompilation - if a used interface is changed forth and back before this module - is updated. (If necessary, we could handle this latter case using - a new rc_... value, but perhaps we can just forget about this - check.) -- Frank, 20040329 } - else if ((p^.Dep^.Recompile = rc_Always) or (p^.Dep^.InterfaceUsedUnitRecompiled)) - and (Dep.Recompile <> rc_Impossible) then - begin - { A dependent module was recompiled for reasons other - than changed source, such as changed options, which - might also influence this module, so we recompile it - as well if at all possible. This check, however, is - not fail-safe when gp runs are aborted between - compilations or some modules are recompiled without - using gp. } - if not UsedUnitChanged then - if p^.Dep^.Recompile = rc_Always then - Message (3, Dep.SrcName + ': recompiling because `' + p^.Dep^.SrcBaseNameExt + ''' was recompiled') - else - Message (3, Dep.SrcName + ': recompiling because a unit used indirectly was recompiled'); - UsedUnitChanged := True; - if DoInterface then Dep.InterfaceUsedUnitRecompiled := True - end -{$endif} ; + end; + p := p^.Next + end; + end; + if UsedUnitChanged then + if Dep.Recompile = rc_Impossible then + ErrorFile (Dep.SrcName, 'must recompile because an interface used has changed,' + NewLine + + 'but source is not available') + else + Dep.Recompile := Max (Dep.Recompile, rc_SrcChanged); +end; + +{ Setup MD5Units by composing all dependent units. + In order to avoid having to sort by dependency, we simply retry + the entire list if the interface MD5Units changes } +procedure SetupMD5Units (var Dep: TDep; var NeedRetry: Boolean); +var + DoInterface: Boolean; + p: PUnitList; + NewMD5Units: TMD5; +begin + { if MD5Units[True] changes, we need to recheck all the dependent units } + { Set NeedRetry if necessary, otherwise leave it unchanged } +//WriteLn( StdErr, Dep.SrcName + ': ' + MD5Str( Dep.MD5 ) ); + for DoInterface := False to True do + begin + NewMD5Units := Dep.MD5; + p := Dep.UsedUnits[DoInterface]; + while p <> nil do + begin NewMD5Units := MD5Compose (NewMD5Units, p^.Dep^.MD5Units[True]); p := p^.Next end; if not MD5Compare (Dep.MD5Units[DoInterface], NewMD5Units) then begin + if DoInterface then begin +//WriteLn( StdErr, Dep.SrcName + ' MD5Units[True] changed, retry' ); +//WriteLn( StdErr, Dep.SrcName + ': Change ' + MD5Str( Dep.MD5Units[DoInterface] ) + ' -> ' + MD5Str( NewMD5Units ) ); + NeedRetry := True; + end; Dep.MD5Units[DoInterface] := NewMD5Units; + end + end; +end; + +{ Check if any unit's indirect interface has changed (using MD5Units) + Force a recompile if so } + +procedure CheckIfCompileIndirectlyNecessary (var Dep: TDep); +var + UsedUnitChanged, DoInterface: Boolean; +begin + { If recompiling anyway, set UsedUnitChanged to suppress further messages } + UsedUnitChanged := Dep.Recompile in [rc_SrcChanged, rc_Always]; + for DoInterface := False to True do + begin + if not MD5Compare (Dep.MD5Units[DoInterface], Dep.MD5UnitsAsRead[DoInterface]) then + begin if not UsedUnitChanged then Message (3, Dep.SrcName + ': recompiling because an interface used indirectly has changed'); UsedUnitChanged := True @@ -1429,241 +1463,290 @@ 'but source is not available') else Dep.Recompile := Max (Dep.Recompile, rc_SrcChanged); - DoAssemble := InterfaceOnly or not Dep.Main or AssembleFlag; - if not DoAssemble or - ((Dep.Recompile >= rc_SrcChanged) and not (InterfaceOnly and (Dep.Recompile = rc_AlwaysButGPIOK))) then - begin - CompileOption := '-c'; - ObjectName := Dep.ObjectName; - if not DoAssemble then - begin - CompileOption := '-S'; - if MainDestNameGiven then - ObjectName := MainDestName - else - ObjectName := Dep.SrcBaseName + '.s' - end; - if ObjectName = '' then Error ('internal error: missing object file name'); - GPIDestinationPath := DirFromPath (Dep.ObjectName); - CreateDir (GPIDestinationPath); - GPIDestinationPathAsUnitPath := '--unit-path=' + GPIDestinationPath; - Insert ('--gpi-destination-path=', GPIDestinationPath, 1); - ImplementationOnly := not InterfaceOnly and (Dep.DepsProcessed = dp_Interface); - BasicProgressMessage ('Compiling ' + InterfaceOf[Ord (InterfaceOnly) + 2 * Ord (ImplementationOnly)] - + Dep.SrcBaseNameExt + ' (' + Integer2String (Dep.Lines) + ')'); - if InterfaceOnly then - ProgressBarSet (LinesDone / TotalLines) - else - ProgressBarAdd (LinesDone / TotalLines, Dep.PBLines / TotalLines, Dep.PBLines); - if ImplementationOnly then Parameters[2] := @'--implementation-only'; - StartPipe (Dep.Kind <> fk_CFile, co_Compile, - Parameters[6 - 3 * Ord (Dep.Kind <> fk_CFile) - 2 * Ord (InterfaceOnly) - Ord (ImplementationOnly) - .. High (Parameters) - Ord ((AutoUses = '') or not Dep.ApplyAutoUses)], - Null, Null, Status, Null); - if Status <> 0 then Quit (Status); - if DoAssemble then WriteGPD (Dep, InterfaceOnly, not InterfaceOnly); - ProgressMessage ('') - end - else if not InterfaceOnly then - Message (4, Dep.SrcName + ': source and all interfaces used are unchanged, not recompiling'); - if not InterfaceOnly then Inc (LinesDone, Dep.PBLines) end; -{ Check all dependencies and recompile whatever necessary. +{ Check ifthe unit's interface and/or implementation needs recompiling } - To compile things in the right order, even in the presence of - cyclic unit dependencies, we do a dual topological sort (with - egdes representing the "used by" relation, i.e. we have an edge - from B to A if A uses B). "Dual" means we label the egdes as - `interface' and `implementation', depending on where the - `uses'/`import' declaration occurs. (C files and Pascal files - linked with a linker directive are handled like `implementation' - uses, regardless of where the directive occurs, since they have no - effect on the compilation of the module using them.) When there - are no nodes without incoming edges (i.e., dependencies on other - modules), we choose one with only incoming `implementation' edges. - If it needs to be compiled, we do it with `--interface-only'. - Afterwards, we remove the node's outgoing edges, but we don't - forget about the node yet. After its incoming edges have been - removed (i.e., all modules it depends on have been processed), it - will be compiled again, this time without `--interface--only'. +procedure DoesDepNeedCompile( var Dep: TDep; var NeedInterface, NeedImplementation, ImplementationDoAssemble: Boolean ); +begin + NeedInterface := ((Dep.Recompile >= rc_SrcChanged) and not (Dep.Recompile = rc_AlwaysButGPIOK)); + ImplementationDoAssemble := not Dep.Main or AssembleFlag; + NeedImplementation := not ImplementationDoAssemble or (Dep.Recompile >= rc_SrcChanged); +end; - To realize this, we use two ZeroIn lists, one (indexed with False) - for nodes without any incoming edges, and one (indexed with True) - for nodes without incoming `interface' edges. When choosing nodes - to process, the first one gets strict priority. +{ Start compiling a unit } - We keep track of the InDegrees concerning `interface' and - `implementation' edges separately. This guarantees that there are - exactly two times (including possibly the start of the algorithm) - where one of a given node's InDegrees reaches 0. +procedure StartCompile (var Dep: TDep; InterfaceOnly: Boolean; DoAssemble: Boolean ); +const + InterfaceOf: array [0 .. 2] of String (18) = ('', 'interface of ', 'implementation of '); +var + ImplementationOnly: Boolean; + GPIDestinationPath, GPIDestinationPathAsUnitPath, CompileOption, ObjectName: TString; + Parameters: array [1 .. 10] of PString = + (@'--interface-only', @'--no-progress-bar', + @GPIDestinationPath, @GPIDestinationPathAsUnitPath, @'--no-automake', + @CompileOption, @'-o', @ObjectName, @Dep.SrcName, @AutoUsesOption); +begin + Dep.CompileDoAssemble := InterfaceOnly or DoAssemble; + CompileOption := '-c'; + ObjectName := Dep.ObjectName; + if not Dep.CompileDoAssemble then + begin + CompileOption := '-S'; + if MainDestNameGiven then + ObjectName := MainDestName + else + ObjectName := Dep.SrcBaseName + '.s' + end; + if ObjectName = '' then Error ('internal error: missing object file name'); + GPIDestinationPath := DirFromPath (Dep.ObjectName); + CreateDir (GPIDestinationPath); + GPIDestinationPathAsUnitPath := '--unit-path=' + GPIDestinationPath; + Insert ('--gpi-destination-path=', GPIDestinationPath, 1); + ImplementationOnly := not InterfaceOnly and (Dep.DepsProcessed = dp_Interface); + BasicProgressMessage ('Compiling ' + InterfaceOf[Ord (InterfaceOnly) + 2 * Ord (ImplementationOnly)] + + Dep.SrcBaseNameExt + ' (' + Integer2String (Dep.Lines) + ')'); + if InterfaceOnly then + ProgressBarSet (LinesDone / TotalLines) + else + ProgressBarAdd (LinesDone / TotalLines, Dep.PBLines / TotalLines, Dep.PBLines); + if ImplementationOnly then Parameters[2] := @'--implementation-only'; + Dep.Compiling := True; + Dep.CompileInterfaceOnly := InterfaceOnly; + StartPipe (Dep.Kind <> fk_CFile, co_Compile, + Parameters[6 - 3 * Ord (Dep.Kind <> fk_CFile) - 2 * Ord (InterfaceOnly) - Ord (ImplementationOnly) + .. High (Parameters) - Ord ((AutoUses = '') or not Dep.ApplyAutoUses)], + Null, Null, Dep.CompileStatus, Null, Dep.CompileProcess); +end; - When the `interface' InDegree reaches 0, the node is added to the - first ZeroIn list if the `implementation' InDegree is already 0, - and to the second one otherwise. When the `implementation' - InDegree reaches 0, the node is added to the first list if the - `interface' InDegree is 0, otherwise nothing is done. +{ Finish compiling, wait for result } - Therefore, if the `implementation' InDegree reaches 0 before the - `interface' InDegree does, the node will only ever appear in the - first ZeroIn list (this should be the common case, without cyclic - dependencies). If the `interface' InDegree is the first to reach - 0, the node is added to the first list after is has been added to - the second list. By this time it either has already been removed - again from the second list (this is when it was considered to be - compiled with `--interface-only'), or it is still there. For the - latter case, since we don't remove it from the second list - immediately (which would be an extra O(n) unless we make the list - doubly linked), we maintain the `DepsProcessed' flag which, if set - to `dp_All', causes the node to be dropped without further - processing when found in the second list. } +function FinishCompile( var Dep: TDep ): Integer; +begin + Dep.Compiling := False; + Discard (WaitPipeProcess (Dep.CompileProcess)); + if Dep.CompileStatus <> 0 then return Dep.CompileStatus; // Quit (Dep.CompileStatus); + if Dep.CompileDoAssemble then begin + WriteGPD (Dep, Dep.CompileInterfaceOnly, not Dep.CompileInterfaceOnly); + end; + ProgressMessage (''); + if Dep.CompileInterfaceOnly then begin + Dep.Recompile := rc_AlwaysButGPIOK; + end else begin + Dep.Recompile := rc_None; + Inc (LinesDone, Dep.PBLines); + end; + return 0; +end; + procedure ProcessDependencies (Deps: PDepList); + +{ // $ define DEBUG} + +const + kMaxCompiles = 4; var - p, p2, pt, Cycle: PDepList; - ZeroIn: array [Boolean] of PDepList; - pu: PUnitList; - pd: PDep; - InterfaceOnly, DoInterface: Boolean; + p, CompileThisInterface: PDepList; TotalCount, ProcessedCount: Integer; - CycleStr: TString; + AnyDone, AnyNeedDoing: Boolean; + Compiling, FinalCompileStatus, ThisCompileStatus: Integer; + NeedInterface, NeedImplementation, ImplementationDoAssemble: Boolean; + NeedRetry: Boolean; - {$ifdef DEBUG} - procedure ShowInDegree (const Dep: TDep); attribute (inline); + function AnyIsCompiling( Deps: PDepList ): Boolean; + var + p: PDepList; + any_compiling: Boolean; begin - Message (5, 'DEBUG: ' + Dep.SrcBaseNameExt + ': InDegree=(' - + Integer2String (Dep.InDegree[True]) + ',' - + Integer2String (Dep.InDegree[False]) + ')') - end; - {$endif} - - procedure CountInDegree (Deps: PDepList; CareAboutInterface: Boolean); - var - p, p2: PDepList; - DoInterface: Boolean; - begin + any_compiling := False; p := Deps; - while p <> nil do - begin - p^.Dep^.InDegree[False] := 0; - p^.Dep^.InDegree[True] := 0; - p := p^.Next - end; - p := Deps; - while p <> nil do - begin - for DoInterface := False to True do - begin - p2 := p^.Dep^.UsedBy[DoInterface]; - while p2 <> nil do - begin - Inc (p2^.Dep^.InDegree[DoInterface and CareAboutInterface]); - p2 := p2^.Next - end - end; - p := p^.Next - end + while p <> nil do begin + if p^.Dep^.Compiling then begin +// WriteLn( StdErr, 'Busy compiling ', p^.Dep^.SrcName ); + any_compiling := True; + leave; + end; + p := p^.Next + end; + return any_compiling; end; - procedure AddZeroIn (DoInterface: Boolean; p: PDepList); - var pt: PDepList; + function AllDone( Units: PUnitList ): Boolean; + var + p: PUnitList; + done: Boolean; + NeedInterface, NeedImplementation, ImplementationDoAssemble: Boolean; begin - New (pt); - pt^.Dep := p^.Dep; - pt^.Next := ZeroIn[DoInterface]; - ZeroIn[DoInterface] := pt + done := True; + p := Units; + while p <> nil do begin + if p^.Dep^.Compiling then begin +// WriteLn( StdErr, 'Busy compiling ', p^.Dep^.SrcName ); + done := False; + leave; + end else begin + DoesDepNeedCompile( p^.Dep^, NeedInterface, NeedImplementation, ImplementationDoAssemble ); + if NeedInterface then begin +// WriteLn( StdErr, 'Not compiled interface for ', p^.Dep^.SrcName ); + done := False; + leave; + end else begin +// WriteLn( StdErr, 'Interface OK for ', p^.Dep^.SrcName ); + end; + end; + p := p^.Next + end; + return done; end; begin - ZeroIn[False] := nil; - ZeroIn[True] := nil; +// WriteLn( StdErr, 'ProcessDependencies' ); TotalCount := 0; ProcessedCount := 0; LinesDone := 0; TotalLines := 0; - CountInDegree (Deps, True); + p := Deps; + while p <> nil do begin + with p^.Dep^ do begin + if Main and not AssembleFlag then begin + Recompile := rc_Always; // Force recompile of Main if we are assembling + end; + DepsProcessed := dp_None; + Compiling := False; + CompileStatus := 0; + CompileProcess := nil; + Inc (TotalLines, PBLines); + Inc (TotalCount); + p := p^.Next + end; + end; + +(* + First we ensure everything that needs to be recompiled is set to do so. + We check direct depenencies first, but really only to give better messages, + since the MD5 would detect them. + Then we set up MD5Units. We repeat this as necessary until things settle, + rather than having to sort by depenency + Finally we check MD5Units for indirect changes +*) + + // Check direct dependencies +// WriteLn( StdErr, 'Check Direct If Compile Necessary Loop' ); + p := Deps; + while p <> nil do begin + CheckIfCompileDirectlyNecessary( p^.Dep^ ); + p := p^.Next + end; + + // Now setup MD5Units + repeat +// WriteLn( StdErr, 'Setup MD5Units Loop' ); + NeedRetry := False; + p := Deps; + while p <> nil do begin + SetupMD5Units( p^.Dep^, NeedRetry ); + p := p^.Next + end; + until not NeedRetry; + + // Check indirect dependencies +// WriteLn( StdErr, 'Check Indirect If Compile Necessary Loop' ); + p := Deps; + while p <> nil do begin + CheckIfCompileIndirectlyNecessary( p^.Dep^ ); + p := p^.Next + end; + p := Deps; while p <> nil do with p^.Dep^ do begin - Inc (TotalLines, PBLines); - Inc (TotalCount); - DepsProcessed := dp_None; - CyclePosition := nil; - if InDegree[True] = 0 then AddZeroIn (InDegree[False] <> 0, p); - {$ifdef DEBUG} - ShowInDegree (p^.Dep^); - {$endif} + case p^.Dep^.Recompile of + rc_None: ;// do nothing + rc_Impossible: WriteLn( StdErr, p^.Dep^.SrcName, ' is impossible to compile' ); + rc_SrcChanged: WriteLn( StdErr, p^.Dep^.SrcName, ' source changed, directly or indirectly' ); + rc_AlwaysButGPIOK: WriteLn( StdErr, p^.Dep^.SrcName, ' compile always but GPI OK' ); + rc_Always: WriteLn( StdErr, p^.Dep^.SrcName, ' compile always' ); + otherwise begin + end; + end; p := p^.Next end; - while (ZeroIn[False] <> nil) or (ZeroIn[True] <> nil) do - begin - InterfaceOnly := ZeroIn[False] = nil; - p := ZeroIn[InterfaceOnly]; - ZeroIn[InterfaceOnly] := p^.Next; - if p^.Dep^.DepsProcessed <> dp_All then - begin - CompileIfNecessary (p^.Dep^, InterfaceOnly); - if p^.Dep^.DepsProcessed = dp_None then - for DoInterface := False to True do - begin - p2 := p^.Dep^.UsedBy[DoInterface]; - while p2 <> nil do - with p2^.Dep^ do - begin - Dec (InDegree[DoInterface]); - if InDegree[DoInterface] = 0 then - if InDegree[not DoInterface] = 0 then - AddZeroIn (False, p2) - else if DoInterface then - AddZeroIn (True, p2); - {$ifdef DEBUG} - ShowInDegree (p2^.Dep^); - {$endif} - p2 := p2^.Next - end - end; - if InterfaceOnly then - p^.Dep^.DepsProcessed := dp_Interface - else - begin - p^.Dep^.DepsProcessed := dp_All; - Inc (ProcessedCount) - end - end; - Dispose (p) +(* + Now compile everything. + Rather than build a depency graph, we simply process the list repeatadely, plucking out + anything that can be compiled and compiling it. We handle up to kMaxCompiles simultaneously, + or a single interface compile if necessary (for cycles). + The code is not particularly efficient, it is designed to solve the problem as simply as + possible, while allowing simultaneous compiles, so we minimize any state information, + and in preference just go around the loop again. +*) + + Compiling := 0; + FinalCompileStatus := 0; + repeat +// WriteLn( StdErr, 'Loop, Compiling = ', Compiling ); + AnyDone := False; + AnyNeedDoing := False; + CompileThisInterface := nil; + // Try to compile something + p := Deps; + while p <> nil do begin + if p^.Dep^.Compiling then begin +WriteLn( StdErr, 'FinishCompile ', p^.Dep^.SrcBaseNameExt ); + ThisCompileStatus := FinishCompile( p^.Dep^ ); + AnyDone := True; + Dec( Compiling ); + if FinalCompileStatus = 0 then begin + FinalCompileStatus := ThisCompileStatus; + end; + end; + if (FinalCompileStatus = 0) and (Compiling < kMaxCompiles) then begin + DoesDepNeedCompile( p^.Dep^, NeedInterface, NeedImplementation, ImplementationDoAssemble ); + if NeedInterface or NeedImplementation then begin +// WriteLn( StdErr, 'Needs Compiling ', p^.Dep^.SrcName, ' ', NeedInterface, ' ', NeedImplementation, ' ', ImplementationDoAssemble ); + AnyNeedDoing := True; + if AllDone( p^.Dep^.UsedUnits[True] ) then begin + if AllDone( p^.Dep^.UsedUnits[False] ) then begin +// WriteLn( StdErr, 'Compile ', p^.Dep^.SrcName ); + if not AnyIsCompiling( p^.Dep^.UsedBy[True] ) and not AnyIsCompiling( p^.Dep^.UsedBy[False] ) then begin + StartCompile ( p^.Dep^, False, ImplementationDoAssemble ); + Inc( Compiling ); + end; + AnyDone := True; + end else if NeedInterface and (CompileThisInterface = nil) then begin +// WriteLn( StdErr, 'Save Interface Compile ', p^.Dep^.SrcName ); + CompileThisInterface := p; + end; + end; + end; + end; + p := p^.Next end; - if ProcessedCount <> TotalCount then - begin - p := Deps; - while (p <> nil) and (p^.Dep^.DepsProcessed = dp_All) do p := p^.Next; - if p = nil then - Error ('internal error: cycle not found'); - pd := p^.Dep; - Cycle := nil; - repeat - New (pt); - pt^.Dep := pd; - pt^.Next := Cycle; - Cycle := pt; - pd^.CyclePosition := Cycle; - pu := pd^.UsedUnits[True]; - while (pu <> nil) and (pu^.Dep^.DepsProcessed = dp_All) do pu := pu^.Next; - if pu = nil then - Error ('internal error: complete cycle not found'); - if pd = pu^.Dep then - ErrorFile (pd^.SrcName, 'dependent on itself'); - pd := pu^.Dep - until pd^.CyclePosition <> nil; - CycleStr := Cycle^.Dep^.SrcBaseNameExt; - while Cycle <> pd^.CyclePosition do - begin - Cycle := Cycle^.Next; - CycleStr := Cycle^.Dep^.SrcBaseNameExt + ' -> ' + CycleStr - end; - Error ('cyclic interface dependency: ' + CycleStr) - end - else - ProgressBarSet (1) + if (FinalCompileStatus = 0) and not AnyDone and (CompileThisInterface <> nil) then begin // Try to compile an interface if nothing else will work +WriteLn( StdErr, 'Compile Interface ', p^.Dep^.SrcBaseNameExt ); + StartCompile ( CompileThisInterface^.Dep^, True, True ); + ThisCompileStatus := FinishCompile( CompileThisInterface^.Dep^ ); + AnyDone := True; + if FinalCompileStatus = 0 then begin + FinalCompileStatus := ThisCompileStatus; + end; + end; + until (Compiling = 0) and not AnyDone; + if FinalCompileStatus <> 0 then begin + Quit( FinalCompileStatus ); + end; +// WriteLn( StdErr, 'Loop Done' ); + if AnyNeedDoing then begin + p := Deps; + while p <> nil do begin + DoesDepNeedCompile( p^.Dep^, NeedInterface, NeedImplementation, ImplementationDoAssemble ); + if NeedInterface or NeedImplementation then begin + ErrorFile (p^.Dep^.SrcName, 'not compiled'); + end; + p := p^.Next + end; + end; end; procedure TestParser (const MainSrc: String); @@ -1698,7 +1781,7 @@ begin InitCompiler (True); ProgressMessage ('Getting default unit path'); - StartPipe (True, co_OnlyVersion, Parameters, OutputFile, Null, Status, Null); + StartPipe (True, co_OnlyVersion, Parameters, OutputFile, Null, Status, Null, Null); ReadLn (OutputFile, Res); Close (OutputFile); if Status <> 0 then Quit (Status); @@ -1720,7 +1803,7 @@ Parameters[4] := @s; InitCompiler (True); ProgressMessage ('Getting needed options'); - StartPipe (True, co_OnlyVersion, Parameters, OutputFile, OutputFile, Status, Null); + StartPipe (True, co_OnlyVersion, Parameters, OutputFile, OutputFile, Status, Null, Null); s := ''; while not EOF (OutputFile) do begin @@ -1742,7 +1825,7 @@ begin InitCompiler (True); ProgressMessage ('Getting libgcc path from ' + Compilers[PascalFlag].ProgName); - StartPipe (PascalFlag, co_OnlyVersion, Parameters, OutputFile, Null, Status, Null); + StartPipe (PascalFlag, co_OnlyVersion, Parameters, OutputFile, Null, Status, Null, Null); ReadLn (OutputFile, Res); Close (OutputFile); if Status <> 0 then Quit (Status); @@ -1867,7 +1950,7 @@ Assert (ParIndex = ParCount); if MkDirFlag then CreateDir (DirFromPath (MainDestName)); BasicProgressMessage ('Linking'); - StartPipe (True, co_All, Parameters, Null, Null, Status, Null); + StartPipe (True, co_All, Parameters, Null, Null, Status, Null, Null); if Status <> 0 then Quit (Status); ProgressMessage ('') end; @@ -2653,7 +2736,7 @@ InitCompiler (True); Parameters[1] := @GPCPrintOptions^.s; ProgressMessage ('Doing `' + GPCPrintOptions^.s + ''''); - StartPipe (PascalFlag, co_OnlyVersion, Parameters, Null, Null, Status, Null); + StartPipe (PascalFlag, co_OnlyVersion, Parameters, Null, Null, Status, Null, Null); if Status <> 0 then Quit (Status); ps := GPCPrintOptions; GPCPrintOptions := GPCPrintOptions^.Next;