Loading Used Units |
|
Each used unit is checked if it is already loaded. If it is not, it needs to be found and checked if recompilation is needed. When used unit needs recompilation the current processed unit (symbol tables and compilar data) need to be pushed to the heap to make room for a new unit.
Once the used unit is recompiled the original unit can be restored from the heap.
Function LoadUsedUnits: Boolean;
Var SavedUnitPathAndName: PChar;
LoadedUnitPublicIdentifiersChecksum: Word;
UsedUnitPublicIdentifiersChecksum: Word;
LoadedUnitSegment: Word;
CurrentUsedUnitIdentifier: Word;
LoadedUnit, BaseUnit: PUnitHeader;
UnitIdentifierData: PUnitIdentifierData;
UnitNameLen: Byte;
Function FindUsedUnit: PUnitHeader;
Var FoundUnit, UnitToCheck: PUnitHeader;
PreviousUnitSegment: Word;
Function CurrentUsedUnitName: PString;
begin
CurrentUsedUnitName :=
@PIdentifier (Ptr (BaseUnitSegment, PUnitHeader (Ptr (BaseUnitSegment, 0))^.CurrentUsedUnitIdentifierOffset))^.Name.Str;
end;
Procedure CopyUnitPathAndNameToFileStrucBuffer;
begin
UnitPathAndName := StartOfSourceFileStructures;
If (Ofs (UnitPathAndName^) + 80) > Ofs (CurrentSourceFile^) then Error (TooManyFiles);
StartOfSourceFileStructures := StrECopy (UnitPathAndName, @Identifier) + 1;
end;
Function LoadUsedUnit: PUnitHeader;
Var DirInfo: SearchRec;
Function RemoveSymbolTables_Code_To_TypedConstantsReferencesOrAllIfAlreadyLoaded: PUnitHeader;
Var UnitPtr: PUnitHeader;
begin
RemoveSymbolTables_Code_To_TypedConstantsReferences (Ofs (UnitPathAndName^));
If IsLastUnitAlreadyLoaded (UnitPtr) then RemoveLastLoadedUnit
else begin
UnitPtr := Ptr (LastLoadedUsedUnit, 0);
PUnitHeader (Ptr (LastLoadedUsedUnit, 0))^.CodeSegment := 0;
PUnitHeader (Ptr (LastLoadedUsedUnit, 0))^.OverlayedUnitCodeSize := 0;
end;
RemoveSymbolTables_Code_To_TypedConstantsReferencesOrAllIfAlreadyLoaded := UnitPtr;
CheckStack;
end;
Function FindCurrentUsedUnitFile (Options: Word): Byte;
begin
StrPCopy (@Identifier, CurrentUsedUnitName^);
StrUpper (@Identifier);
FindCurrentUsedUnitFile := FindFilePath (@Identifier, Options);
end;
Function IncludeOrObjectFilesChanged: Boolean;
Var FilesBlockPtr: PUsedFilesBlockRecord;
FilesBlockPtrRec: PtrRec absolute FilesBlockPtr;
UnitHeader: PUnitHeader;
begin
IncludeOrObjectFilesChanged := True;
UnitHeader := Ptr (LastLoadedUsedUnit, 0);
FilesBlockPtr := Ptr (LastLoadedUsedUnit, UnitHeader^.BlockOffset [stUsedFiles]);
Inc (FilesBlockPtrRec.Ofs, FilesBlockPtr^.Name.Len + 8);
While FilesBlockPtrRec.Ofs <> UnitHeader^.BlockOffset [Succ (stUsedFiles)] do
begin
FindUsedFilePath (FilesBlockPtr, @Identifier);
FindFirst (StrPas (@Identifier), AnyFile, DirInfo);
If UnitDateTime < (DirInfo.Time + 1) then Exit;
Inc (FilesBlockPtrRec.Ofs, FilesBlockPtr^.Name.Len + 8);
end;
IncludeOrObjectFilesChanged := False;
end;
Function CheckUnitName: PString;
Var UsedUnitName: PString;
begin
UsedUnitName := CurrentUsedUnitName;
If not IdentifiersEqual (@PIdentifier (Ptr (LastLoadedUsedUnit,
PUnitHeader (Ptr (LastLoadedUsedUnit, 0))^.UnitNameIdentifierOffset))^.Name, UsedUnitName) then
begin
AdditionalErrorStr := @Identifier;
StrPCopy (@Identifier, UsedUnitName^);
Error (UnitNameMismatch);
end;
CheckUnitName := UsedUnitName;
end;
begin
If PushedUnitLevel <> UsedUnitLevel then
begin
PushUnit;
CompilerModeOptions := CompilerModeOptions + [cmoCreateExeFile, cmoCompileToDisk, cmoCompileOnlyInterfaceUsedUnits];
Saved_PushedUnitLevel := PushedUnitLevel;
PushedUnitLevel := UsedUnitLevel;
end;
ClearCurrentModuleVarsAndCreateUnit;
If cmoSearchForUnitSource in CompilerModeOptions then
begin { Check for UNIT source }
FindCurrentUsedUnitFile (Dir_Unit or Ext_PAS);
FindFirst (StrPas (@Identifier), AnyFile, DirInfo);
UnitSourceDateTime := DirInfo.Time + 1;
If DOSError = 0 then { UNIT source found }
begin
FindFilePath (@Identifier, Dir_Forced or Dir_EXE_TPU or Ext_Forced or Ext_TPU);
CopyUnitPathAndNameToFileStrucBuffer;
If cmoMakeModifiedUnitsOnly in CompilerModeOptions then
Repeat
FindFirst (StrPas (@Identifier), AnyFile, DirInfo);
If DOSError <> 0 then Break; { no TPU file }
UnitDateTime := DirInfo.Time + 1;
If UnitDateTime < UnitSourceDateTime then Break;
If ReadUnit (UnitPathAndName) then { TPU not older than PAS }
Repeat
CheckUnitName;
If IncludeOrObjectFilesChanged then Break;
If not LoadUsedUnits then Break;
LoadUsedUnit := RemoveSymbolTables_Code_To_TypedConstantsReferencesOrAllIfAlreadyLoaded;
Exit;
until True;
ClearUnitHeader;
until True;
CurrentSourceFilePathLength := FindCurrentUsedUnitFile (Dir_Unit or Ext_PAS);
CurrentFileName := @Identifier;
CompileModule;
CheckUnitName;
LoadUsedUnit := RemoveSymbolTables_Code_To_TypedConstantsReferencesOrAllIfAlreadyLoaded;
Exit;
end;
end;
FindCurrentUsedUnitFile (Dir_Forced or Dir_EXE_TPU or Ext_Forced or Ext_TPU);
FindFirst (StrPas (@Identifier), AnyFile, DirInfo);
If DOSError <> 0 then FindCurrentUsedUnitFile (Dir_Unit or Ext_Forced or Ext_TPU);
CopyUnitPathAndNameToFileStrucBuffer;
If not ReadUnit (UnitPathAndName) then Error (UnitVersionMismatch);
CheckUnitName;
If not LoadUsedUnits then Error (UnitVersionMismatch);
LoadUsedUnit := RemoveSymbolTables_Code_To_TypedConstantsReferencesOrAllIfAlreadyLoaded;
end;
Function IsCurrentUsedUnitUsedInInterface (UnitPtr: PUnitHeader): Boolean;
Var UsedUnitId: PIdentifier;
UsedUnitIdData: PUnitIdentifierData;
begin
UsedUnitId := Ptr (Seg (UnitPtr^), UnitPtr^.CurrentUsedUnitIdentifierOffset);
UsedUnitIdData := Ptr (Seg (UnitPtr^), Ofs (UsedUnitId^) + UsedUnitId^.Name.Len + 4);
IsCurrentUsedUnitUsedInInterface := UsedInInterface in UsedUnitIdData^.UnitIdentifierFlags
end;
Procedure UnitError (Err: TCompilerError);
Var UnitName: PString;
begin
UnitName := Ptr (BaseUnitSegment, PUnitHeader (Ptr (BaseUnitSegment, 0))^.CurrentUsedUnitIdentifierOffset + 3);
AdditionalErrorStr := @Identifier;
StrPCopy (@Identifier, UnitName^);
Error (Err);
end;
begin
CurrentIdentifier := CurrentUsedUnitName^;
If FindUnitWithName (LastLoadedUsedUnit, 4, CurrentIdentifier, FoundUnit) then
begin
CheckStack;
FindUsedUnit := FoundUnit;
Exit;
end;
If not FindUnitWithName (BaseUnitSegment, 4, CurrentIdentifier, FoundUnit) then
begin
If not FindUnitWithName (LastLibraryUnitSegment, 6, CurrentIdentifier, FoundUnit) then
begin
FindUsedUnit := LoadUsedUnit;
Exit;
end;
FoundUnit^.PreviousUnitSegment := LastLoadedUsedUnit;
LastLoadedUsedUnit := Seg (FoundUnit^);
If not LoadUsedUnits then UnitError (UnitVersionMismatch);
PUnitHeader (Ptr (LastLoadedUsedUnit, 0))^.CodeSegment := 0;
PUnitHeader (Ptr (LastLoadedUsedUnit, 0))^.OverlayedUnitCodeSize := 0;
FindUsedUnit := FoundUnit;
CheckStack;
Exit;
end;
If not IsCurrentUsedUnitUsedInInterface (FoundUnit) then
begin
CheckStack;
FindUsedUnit := FoundUnit;
Exit;
end;
UnitToCheck := Ptr (BaseUnitSegment, 0);
Repeat
If not IsCurrentUsedUnitUsedInInterface (UnitToCheck) then
begin
FindUsedUnit := LoadUsedUnit;
Exit;
end;
PreviousUnitSegment := UnitToCheck^.PreviousUnitSegment;
UnitToCheck := Ptr (PreviousUnitSegment, 0);
until PreviousUnitSegment = Seg (FoundUnit^);
UnitError (CircularUnitReference);
end;
{$IFDEF DebugUsedUnits}
Var LevelCounter: Word;
{$ENDIF}
begin
SavedUnitPathAndName := UnitPathAndName;
Inc (UsedUnitLevel);
BaseUnit := Ptr (LastLoadedUsedUnit, 0);
LastLoadedUsedUnit := BaseUnit^.PreviousUnitSegment;
BaseUnit^.PreviousUnitSegment := BaseUnitSegment;
BaseUnitSegment := Seg (BaseUnit^);
UnitNameLen := PIdentifier (Ptr (Seg (BaseUnit^), BaseUnit^.UnitNameIdentifierOffset))^.Name.Len;
UnitIdentifierData := Ptr (Seg (BaseUnit^), BaseUnit^.UnitNameIdentifierOffset + UnitNameLen + 4); { Base unit data }
LoadedUnitSegment := Seg (BaseUnit^);
{$IFDEF DebugUsedUnits}
If UsedUnitLevel = 1 then Writeln;
For LevelCounter := 2 to UsedUnitLevel do Write (' ');
If UsedUnitLevel = 1 then Write ('#') else Write (' ');
Writeln ('LOAD USED UNITS BY: ',
PIdentifier (Ptr (Seg (BaseUnit^), BaseUnit^.UnitNameIdentifierOffset))^.Name.Str);
{$ENDIF}
Repeat
UnitIdentifierData^.UnitSegment := LoadedUnitSegment;
CurrentUsedUnitIdentifier := UnitIdentifierData^.NextUnitIdentifier; { Next used unit }
BaseUnit^.CurrentUsedUnitIdentifierOffset := CurrentUsedUnitIdentifier;
If CurrentUsedUnitIdentifier = 0 then Break; { No more used units }
{$IFDEF DebugUsedUnits}
For LevelCounter := 1 to UsedUnitLevel do Write (' ');
Writeln (' USES: ', PIdentifier (Ptr (Seg (BaseUnit^), CurrentUsedUnitIdentifier))^.Name.Str);
{$ENDIF}
LoadedUnit := FindUsedUnit;
UnitNameLen := PIdentifier (Ptr (Seg (LoadedUnit^), LoadedUnit^.UnitNameIdentifierOffset))^.Name.Len;
UnitIdentifierData := Ptr (Seg (LoadedUnit^), LoadedUnit^.UnitNameIdentifierOffset + UnitNameLen + 4);
{$IFDEF DebugUsedUnits}
For LevelCounter := 1 to UsedUnitLevel do Write (' ');
Writeln (' LOADED: ', PIdentifier (Ptr (Seg (LoadedUnit^), LoadedUnit^.UnitNameIdentifierOffset))^.Name.Str);
{$ENDIF}
LoadedUnitPublicIdentifiersChecksum := UnitIdentifierData^.PublicIdentifiersChecksum;
LoadedUnitSegment := Seg (LoadedUnit^);
BaseUnit := Ptr (BaseUnitSegment, 0); { BaseUnitSegment might change during unit PUSH}
UnitNameLen := PIdentifier (Ptr (Seg (BaseUnit^), CurrentUsedUnitIdentifier))^.Name.Len;
UnitIdentifierData := Ptr (Seg (BaseUnit^), CurrentUsedUnitIdentifier + UnitNameLen + 4);
UsedUnitPublicIdentifiersChecksum := UnitIdentifierData^.PublicIdentifiersChecksum;
If UsedUnitPublicIdentifiersChecksum <> 0 then
begin
If UsedUnitPublicIdentifiersChecksum <> LoadedUnitPublicIdentifiersChecksum then
begin
Inc (CurrentUsedUnitIdentifier, 3); { name of unit which has different PublicIdentifiersChecksum }
Break;
end;
end else UnitIdentifierData^.PublicIdentifiersChecksum := LoadedUnitPublicIdentifiersChecksum;
until False; { Load next used unit }
BaseUnitSegment := BaseUnit^.PreviousUnitSegment;
BaseUnit^.PreviousUnitSegment := LastLoadedUsedUnit;
LastLoadedUsedUnit := Seg (BaseUnit^);
Dec (UsedUnitLevel);
If UsedUnitLevel = Saved_PushedUnitLevel then PopUnit;
UnitPathAndName := SavedUnitPathAndName;
LoadUsedUnits := CurrentUsedUnitIdentifier = 0; { All used units loaded }
{$IFDEF DebugUsedUnits}
For LevelCounter := 1 to UsedUnitLevel do Write (' ');
If UsedUnitLevel = 0 then Write ('#') else Write (' ');
Writeln ('LOAD USED UNITS END ',
PIdentifier (Ptr (Seg (BaseUnit^), BaseUnit^.UnitNameIdentifierOffset))^.Name.Str);
If UsedUnitLevel = 0 then Writeln;
{$ENDIF}
end;
PushUnit and PopUnit save and restore current module when compiler is needed to compile used unit. Procedure PushUnit;
Var ReferencedUnitRecord: PReferencedModulesBlockRecord;
Segment: Word;
Block: TSymbolTable;
Procedure AdjustUnitSegments (Var Segment: Word);
Var UnitPtr: PUnitHeader;
UnitIdentifier: PIdentifier;
UnitIdentifierData: PUnitIdentifierData;
begin
If Segment = HeapPtrRec.Seg then Segment := HeapEndRec.Seg;
UnitPtr := Ptr (Segment, 0);
While Seg (UnitPtr^) <> 0 do
begin
UnitIdentifier := Ptr (Seg (UnitPtr^), UnitPtr^.UnitNameIdentifierOffset);
Repeat
UnitIdentifierData := PUnitIdentifierData (PChar (UnitIdentifier) + UnitIdentifier^.Name.Len + 4);
If UnitIdentifierData^.UnitSegment = HeapPtrRec.Seg then UnitIdentifierData^.UnitSegment := HeapEndRec.Seg;
UnitIdentifier := Ptr (Seg (UnitPtr^), UnitIdentifierData^.NextUnitIdentifier);
until Ofs (UnitIdentifier^) = 0;
If UnitPtr^.PreviousUnitSegment = HeapPtrRec.Seg then UnitPtr^.PreviousUnitSegment := HeapEndRec.Seg;
UnitPtr := Ptr (UnitPtr^.PreviousUnitSegment, 0);
end;
end;
begin
HeapPtrRec.Seg := SymbolTable [stMain].Segment; { PUSH Memory Blocks }
Segment := HeapEndRec.Seg;
For Block := stIntermediateCode downto stMain do
begin
SymbolTable [Block].Size := (SymbolTable [Block].UsedSize + $000F) and $FFF0;
Dec (Segment, SymbolTable [Block].Size shr 4);
Move (Ptr (SymbolTable [Block].Segment, 0)^, Ptr (Segment, 0)^, SymbolTable [Block].UsedSize);
SymbolTable [Block].Segment := Segment;
end;
HeapEndRec.Seg := Segment;
AdjustUnitSegments (LastLoadedUsedUnit);
AdjustUnitSegments (BaseUnitSegment);
ReferencedUnitRecord := Ptr (SymbolTable [stReferencedModules].Segment, 0);
While ReferencedUnitRecord <> SymbolTable [stReferencedModules].Ptr do
begin
If ReferencedUnitRecord^.ModuleSegment = HeapPtrRec.Seg then ReferencedUnitRecord^.ModuleSegment := HeapEndRec.Seg;
Inc (PChar (ReferencedUnitRecord), ReferencedUnitRecord^.UnitName.Len + 5);
end;
Dec (HeapEndRec.Seg, (Ofs (CurrentLineBuff) - Ofs (CompilerModeOptions) + { PUSH Variables }
Ofs (ConditionalDefinesEnd^) - Ofs (ConditionalDefines) + $000F) shr 4);
Move (CompilerModeOptions, HeapEnd^, Ofs (CurrentLineBuff) - Ofs (CompilerModeOptions));
Move (ConditionalDefines, Ptr (HeapEndRec.Seg, Ofs (CurrentLineBuff) - Ofs (CompilerModeOptions))^,
Ofs (ConditionalDefinesEnd^) - Ofs (ConditionalDefines)); { PUSH Conditional Defines }
end;
Procedure PopUnit;
Var TempHeapPtr, TempHeapEnd: Word;
ReferencedUnitRecord: PReferencedModulesBlockRecord;
Segment: Word;
Block: TSymbolTable;
Procedure AdjustUnitSegments (Var Segment: Word);
Var UnitPtr: PUnitHeader;
UnitIdentifier: PIdentifier;
UnitIdentifierData: PUnitIdentifierData;
begin
If Segment = TempHeapEnd then Segment := TempHeapPtr;
UnitPtr := Ptr (Segment, 0);
While Seg (UnitPtr^) <> 0 do
begin
UnitIdentifier := Ptr (Seg (UnitPtr^), UnitPtr^.UnitNameIdentifierOffset);
Repeat
UnitIdentifierData := PUnitIdentifierData (PChar (UnitIdentifier) + UnitIdentifier^.Name.Len + 4);
If UnitIdentifierData^.UnitSegment = TempHeapEnd then UnitIdentifierData^.UnitSegment := TempHeapPtr;
UnitIdentifier := Ptr (Seg (UnitPtr^), UnitIdentifierData^.NextUnitIdentifier);
until Ofs (UnitIdentifier^) = 0;
If UnitPtr^.PreviousUnitSegment = TempHeapEnd then UnitPtr^.PreviousUnitSegment := TempHeapPtr;
UnitPtr := Ptr (UnitPtr^.PreviousUnitSegment, 0);
end;
end;
begin
Move (HeapEnd^, CompilerModeOptions, Ofs (CurrentLineBuff) - Ofs (CompilerModeOptions)); { POP Variables }
Move (Ptr (HeapEndRec.Seg, Ofs (CurrentLineBuff) - Ofs (CompilerModeOptions))^, ConditionalDefines,
Ofs (ConditionalDefinesEnd^) - Ofs (ConditionalDefines)); { POP Conditional Defines }
TempHeapEnd := HeapEndRec.Seg + (Ofs (CurrentLineBuff) - Ofs (CompilerModeOptions) +
Ofs (ConditionalDefinesEnd^) - Ofs (ConditionalDefines) + $000F) shr 4;
TempHeapPtr := HeapPtrRec.Seg;
HeapEndRec.Seg := SymbolTable [stIntermediateCode].Segment + SymbolTable [stIntermediateCode].Size shr 4;
Segment := HeapPtrRec.Seg;
For Block := stMain to stIntermediateCode do
begin
Move (Ptr (SymbolTable [Block].Segment, 0)^, Ptr (Segment, 0)^, SymbolTable [Block].UsedSize);
SymbolTable [Block].Segment := Segment;
Inc (Segment, (SymbolTable [Block].UsedSize + $000F) shr 4);
end;
HeapPtrRec.Seg := Segment;
AdjustUnitSegments (LastLoadedUsedUnit);
AdjustUnitSegments (BaseUnitSegment);
ReferencedUnitRecord := Ptr (SymbolTable [stReferencedModules].Segment, 0);
While ReferencedUnitRecord <> SymbolTable [stReferencedModules].Ptr do
begin
If ReferencedUnitRecord^.ModuleSegment = TempHeapEnd then ReferencedUnitRecord^.ModuleSegment := TempHeapPtr;
Inc (PChar (ReferencedUnitRecord), ReferencedUnitRecord^.UnitName.Len + 5);
end;
end;
|