unit mr.trinity.hex;

interface
uses
   Generics.Collections,
   Classes;

const
   rtData            = $00;
   rtEOF             = $01;
   rtExtendedSegment = $02;
   rtStartSegment    = $03;
   rtExtendedLinear  = $04;
   rtStartLinear     = $05;

type
   THexLine = class
      public
         RecLength   : byte;
         RecType     : byte;
         Address     : word;
         Data        : PByte;
         Chksum      : byte;

      public
         destructor  Destroy; override;
   end;

   THexBlock = class
      public
         BlockLength : cardinal;
         BlockType   : byte;
         Address     : word;
         Data        : PByte;

      public
         destructor  Destroy; override;
   end;

   THexLineList  = TObjectList<THexLine>;
   THexBlockList = TObjectList<THexBlock>;

   THexFile = class
      protected
         fHexLines   : THexLineList;
         fHexBlocks  : THexBlockList;

      private
         function    GetBlockCount  : integer;
         function    GetBlock(i:integer): THexBlock;

      protected
         function    ReadLine( Stream: TStream): THexLine;

      public
         procedure   LoadFromFile(     FileName : string);
         procedure   LoadFromStream(   Stream   : TStream);

         procedure   Dump(             Stream   : TStream);

      public
         procedure   AfterConstruction; override;
         procedure   BeforeDestruction; override;

      public
         property    Lines             : THexLineList    read  fHexLines;
         property    Blocks            : THexBlockList   read  fHexBlocks;

         property    BlockCount        : integer      read  GetBlockCount;
         property    Block[i:integer]  : THexBlock    read  GetBlock;
	 
   end;


implementation
uses
   Windows,
   SysUtils;

{ THexFile }



// @@@: Construction/destruction ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//
//                                   Construction/destruction
//
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ================================================================================================
// After Construction
// ================================================================================================
procedure THexFile.AfterConstruction;
begin
   inherited;

   fHexLines   := THexLineList   .Create(false);
   fHexBlocks  := THexBlockList  .Create
end;

// ================================================================================================
// Before Destruction
// ================================================================================================
procedure THexFile.BeforeDestruction;
begin
   FreeAndNil(fHexBlocks);
   FreeAndNil(fHexLines );

   inherited
end;



// @@@: Interface +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//
//                                           Interface
//
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ================================================================================================
// Load From File
// ================================================================================================
procedure THexFile.LoadFromFile(FileName: string);
var
   stm: TMemoryStream;

begin
   if FileExists(FileName) then
   begin
      stm := TMemoryStream.Create;
      stm.LoadFromFile(FileName);
      LoadFromStream(stm);
      stm.Free;
   end
end;

// ================================================================================================
// Load From Stream
// ================================================================================================
procedure THexFile.LoadFromStream(Stream: TStream);
var
   block : THexBlock;
   line  : THexLine;
   cnt   : integer;

   procedure Compress;
   var
      blk1  : THexBlock;
      blk2  : THexBlock;
      i,j   : integer;
      size  : integer;
      ptr   : PByte;

   label
      loop;

   begin
loop:

      for i:=0 to fHexBlocks.Count -2 do
      begin
         blk1 := fHexBlocks[i];

         for j:=1 to fHexBlocks.Count -1 do
         begin
            blk2 := fHexBlocks[j];

            if (blk1.Address +blk1.BlockLength) = blk2.Address then
            begin
               size        := blk1.BlockLength +blk2.BlockLength;
               blk1.Data   := ReallocMemory( blk1.Data,size);
               ptr         := blk1.Data;

               INC(ptr, blk1.BlockLength);
               CopyMemory(ptr, blk2.Data, blk2.BlockLength);

               blk1.BlockLength  := size;

               fHexBlocks.Delete(j);

               goto loop;
            end

            else if (blk2.Address +blk2.BlockLength) = blk1.Address then
            begin
               size        := blk1.BlockLength +blk2.BlockLength;
               blk2.Data   := ReallocMemory( blk2.Data,size);
               ptr         := blk2.Data;

               INC(ptr, blk2.BlockLength);
               CopyMemory(ptr, blk1.Data, blk1.BlockLength);

               blk2.BlockLength  := size;

               fHexBlocks.Delete(i);

               goto loop;
            end;
         end;
      end;
   end;

begin
   if Assigned(Stream) then
   begin
      Stream.Seek(0, soBeginning);

      // ------------------------------------------------------------
      // Read hex records
      // ------------------------------------------------------------
      while true do
      begin
         line := ReadLine(Stream);

         if line = nil
            then break
            else fHexLines.Add(line)
      end;

      // ------------------------------------------------------------
      // If the last record is EOF then the data is correct,
      // so build the blocks.
      // ------------------------------------------------------------
      cnt := fHexLines.Count;

      if (cnt > 0) and (fHexLines[cnt-1].RecType = rtEOF) then
      begin
         for line in fHexLines do
            if line.RecType = rtData then
            begin
               block := THexBlock.Create;

               block.BlockLength := line.RecLength;
               block.BlockType   := line.RecType;
               block.Address     := line.Address;
               block.Data        := AllocMem(line.RecLength);

               CopyMemory( block.Data, line.Data, line.RecLength);

               fHexBlocks.Add(block);
            end;

         Compress;
      end;
   end
end;



// @@@: Internals +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//
//                                           Internals
//
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ================================================================================================
// Read Line
// ================================================================================================
function THexFile.ReadLine(Stream: TStream): THexLine;

   function HexToBin( hex: byte): byte;
   begin
      result := 0;

      if ansichar(hex) in ['0'..'9'] then result := ord(hex) -ord('0');
      if ansichar(hex) in ['a'..'f'] then result := ord(hex) -ord('a') +10;
      if ansichar(hex) in ['A'..'F'] then result := ord(hex) -ord('A') +10;
   end;

   function GetByte( Data: array of byte): byte;
   begin
      result   := (HexToBin(Data[0]) shl 4) +
                  (HexToBin(Data[1]));
   end;

   function GetWord( Data0: array of byte; Data1: array of byte): word;
   begin
      result   := (HexToBin(Data0[0]) shl 12) +
                  (HexToBin(Data0[1]) shl  8) +
                  (HexToBin(Data1[0]) shl  4) +
                  (HexToBin(Data1[1]));
   end;

var
   mark     : ansichar;
   chksum   : byte;
   i        : byte;
   l        : cardinal;
   ptr      : PByte;

   x1       : array [0..1] of byte;
   x2       : array [0..1] of byte;


begin
   result := nil;

   l := Stream.Read( mark, 1);

   // -----------------------------------------------------
   // skip CR,LF
   // -----------------------------------------------------
   while (l > 0) and (mark in [#10,#13]) do
      l := Stream.Read(mark,1);

   if l = 0 then
      exit;

   // -----------------------------------------------------
   // process record
   // -----------------------------------------------------
   if mark = ':' then
   begin
      chksum := 0;

      // --------------------------------------------------
      // Allocate HexLine
      // --------------------------------------------------
      result := THexLine.Create;

      // --------------------------------------------------
      // Length
      // --------------------------------------------------
      Stream.Read(x1, 2);
      inc(chksum, GetByte(x1));

      result.RecLength  := GetByte(x1);
      result.Data       := GetMemory(result.RecLength);

      // --------------------------------------------------
      // Offset
      // --------------------------------------------------
      Stream.Read(x1, 2);
      Stream.Read(x2, 2);
      inc(chksum, GetByte(x1));
      inc(chksum, GetByte(x2));

      result.Address := GetWord(x1,x2);

      // --------------------------------------------------
      // Record type
      // --------------------------------------------------
      Stream.Read(x1, 2);
      inc(chksum, GetByte(x1));

      result.RecType := GetByte(x1);

      // --------------------------------------------------
      // Data
      // --------------------------------------------------
      ptr := result.Data;

      for i:=0 to result.RecLength -1 do
      begin
         Stream.Read(x1,2);
         inc(chksum, GetByte(x1));

         ptr^ := GetByte(x1);
         inc(ptr);
      end;

      // --------------------------------------------------
      // Checksum
      // --------------------------------------------------
      Stream.Read(x1,2);
      inc(chksum, GetByte(x1));

      // --------------------------------------------------
      // At that point the checksum must be 0!!!
      // --------------------------------------------------
      if chksum <> 0 then
         FreeAndNil(result);
   end
end;



// @@@: Property Handlers +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//
//                                       Property Handlers
//
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ================================================================================================
// Get Block Count
// ================================================================================================
function THexFile.GetBlockCount: integer;
begin
   result := fHexBlocks.Count
end;

// ================================================================================================
// Get Block
// ================================================================================================
function THexFile.GetBlock(i: integer): THexBlock;
begin
   if (i>=0) and (i<fHexBlocks.Count)
      then result := fHexBlocks.Items[i]
      else result := nil
end;


// ================================================================================================
// Dump
// ================================================================================================
procedure THexFile.Dump(Stream: TStream);
var
   blk: THexBlock;
   i  : integer;
   s  : string;

begin
   i := 1;

   for blk in fHexBlocks do
   begin
//      blk.Address;
//      blk.BlockLength;
      s := Format('%3d %4.4x-%4.4x (%4.4x)'#13, [i,blk.Address,blk.Address+blk.BlockLength, blk.BlockLength]);
      writeln(s);
      INC(i);

   end;
end;




{ THexLine }

destructor THexLine.Destroy;
begin
   if Assigned(Data) then FreeMem(Data);
   inherited;
end;

{ THexBlock }

destructor THexBlock.Destroy;
begin
   if Assigned(Data) then FreeMem(Data);
   inherited;
end;

end.