Calculating Offsets of Code Blocks

This procedure calculates offset of each program code block and total code size.

Procedure CalculateCodeBlockOffsetsAndTotalCodeSize;
Var ProgramCodeBlock: PProgramCodeBlockRecord;
    ProcedureRecordPtr: PProceduresBlockRecord absolute ProgramCodeBlock;
    BlockPtr: PtrRec absolute ProgramCodeBlock;
    UnitCodeSize, NumberOfSegmentReferencesInUnitProgramCode: Word;
    ExeHeaderSize: LongRec;
begin
  UnitPtrRec.Seg := LastLoadedUsedUnit;
  Repeat
    UnitPtr^.CodeSegment := CurrentCodeSegment;
    ProgramCodeBlock := Ptr (UnitPtrRec.Seg, UnitPtr^.BlockOffset [stCodeBlocks]);
    UnitCodeSize := 0;
    While BlockPtr.Ofs <> UnitPtr^.BlockOffset [Succ (stCodeBlocks)] do
      begin
        If ProgramCodeBlock^.Offset <> BlockUnused then
          begin
            ProgramCodeBlock^.Offset := UnitCodeSize;
            Inc (UnitCodeSize, ProgramCodeBlock^.CodeSize);
          end;
        Inc (ProgramCodeBlock);
      end;
    NumberOfSegmentReferencesInUnitProgramCode := UnitPtr^.NumberOfSegmentReferencesInProgramCodeBlocks;
    If UnitPtr^.OverlayedUnitCodeSize <> 0 then
      begin
        UnitPtr^.OverlayedUnitCodeSize := UnitCodeSize;
        UnitCodeSize := (UnitCodeSize + $000F) shr 4;
        Inc (UnitCodeSize, (NumberOfSegmentReferencesInUnitProgramCode + $0007) shr 3);
        If UnitCodeSize > OverlayHeapSize then OverlayHeapSize := UnitCodeSize;
        UnitCodeSize := $20;
        BlockPtr.Ofs := UnitPtr^.BlockOffset [stProcedures];
        While BlockPtr.Ofs <> UnitPtr^.BlockOffset [Succ (stProcedures)] do
          begin
            If ProcedureRecordPtr^.OverlayedProcedureOffset <> 0 then
              begin
                ProcedureRecordPtr^.OverlayedProcedureOffset := UnitCodeSize;
                Inc (UnitCodeSize, 5);
              end;
            Inc (ProcedureRecordPtr);
          end;
        NumberOfSegmentReferencesInUnitProgramCode := 0;
      end;
    UnitPtr^.CodeSize := UnitCodeSize;
    Inc (CurrentCodeSegment, (UnitCodeSize + $000F) shr 4);
    ExeHeaderSize.Long := (NumberOfSegmentReferencesInUnitProgramCode +
                           UnitPtr^.NumberOfSegmentReferencesInTypedConstantsBlocks) * 4 + CurrentRelocationItemOffset;
    If (ExeHeaderSize.WordH <> 0) or (ExeHeaderSize.WordL > $FFF0) then Error (TooManyRelocationItems);
    CurrentRelocationItemOffset := ExeHeaderSize.WordL;
    UnitPtrRec.Seg := UnitPtr^.PreviousUnitSegment;
  until UnitPtrRec.Seg = 0;
  CodeBytes := 16 * LongInt (CurrentCodeSegment);
end;