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;
 
 
 
© 2017 Turbo Pascal | Privacy Policy