Unit MapInfo;

interface

uses
  DOS;

  var
    MapFileName : PathStr;
    UnitName : String[16];
    CurrentLineNumber,NextLineNumber : Word;
    CurrentLineAddress,NextLineAddress : Pointer;

  {$F+}
  Function GetMapInfo(Address : Pointer) : Pointer;
  {$F-}
  Function HexPtrStr(P : Pointer) : String;

implementation

var
  MapFile : Text;

Function HexWordStr(A : Word) : String;
  const
    HexDigits : Array[$0..$F] of Char = '0123456789ABCDEF';
  Begin
    HexWordStr := HexDigits[Hi(A) shr 4]+HexDigits[Hi(A) and $F]+
                  HexDigits[Lo(A) shr 4]+HexDigits[Lo(A) and $F];
  End;

Function HexPtrStr(P : Pointer) : String;
  var
    H,L : Word;
  Begin
    asm
      mov ax,word ptr P
      mov L,ax
      mov ax,word ptr P+2
      mov H,ax
    end;
    HexPtrStr := HexWordStr(H)+':'+HexWordStr(L);
  End;

Function GetMapInfo(Address : Pointer) : Pointer;

  Procedure WhichUnit;
    var
      Previous,Current,Target,Buffer,Temp : String;
    Begin
      Target := Copy(HexPtrStr(Address),1,4)+'0';
      ReadLn(MapFile);
      ReadLn(MapFile);
      ReadLn(MapFile);
      ReadLn(MapFile,Buffer);
      Current := ' 0000'+#47;
      repeat
        Previous := Current;
        Temp := Buffer;
        ReadLn(MapFile,Buffer);
        Current := Copy(Buffer,2,5);
      until ((Target > Previous) and (Target <= Current));
      Temp := Copy(Temp,23,16);
      Temp := Copy(Temp,1,Pos(' ',Temp)-1);
      UnitName := Temp;
    End;

  Procedure GotoLineNumbers;
    var
      Buffer : String;
    Begin
      repeat
        ReadLn(MapFile,Buffer);
      until ((Pos(UnitName+'(',Buffer) <> 0) or EOF(MapFile));
      ReadLn(MapFile);
    End;

  Procedure GetInfo;
    var
      i,dummy,Segment,Offset : Word;
      Previous,Current,Target,Buffer,LineAddress : String;
    Begin
      Target := HexPtrStr(Address);
      Current := '0000:000'+#47;
      i := 0;
      ReadLn(MapFile,Buffer);
      repeat
        Previous := Current;
        if (i >= 4) then
          begin
            ReadLn(MapFile,Buffer);
            i := 0;
          end;
        Inc(i);
        Current := Copy(Buffer,(i-1)*16+1,16);
        LineAddress := Copy(Current,8,9);
      until ((Target > Previous) and (Target <= LineAddress));

      Buffer := Copy(Previous,1,6);
      while (Buffer[1] = ' ') do
        Buffer := Copy(Buffer,2,Length(Buffer)-1);
      Val(Buffer,CurrentLineNumber,dummy);
      Val('$'+Copy(Previous,8,4),Segment,dummy);
      Val('$'+Copy(Previous,13,4),Offset,dummy);
      CurrentLineAddress := Ptr(Segment,Offset);

      Buffer := Copy(Current,1,6);
      while (Buffer[1] = ' ') do
        Buffer := Copy(Buffer,2,Length(Buffer)-1);
      Val(Buffer,NextLineNumber,dummy);
      Val('$'+Copy(Current,8,4),Segment,dummy);
      Val('$'+Copy(Current,13,4),Offset,dummy);
      NextLineAddress := Ptr(Segment,Offset);
    End;

  Begin
    if (MapFileName <> '') then
      begin
        UnitName := 'UNKNOWN';
        CurrentLineNumber := 0;
        CurrentLineAddress := nil;
        NextLineNumber := 0;
        NextLineAddress := nil;
        Assign(MapFile,MapFileName);
        {$I-}
        Reset(MapFile);
        {$I+}
        if (IOResult <> 0) then
          WriteLn(MapFileName,' not found.  Cannot locate error address.')
        else
          begin
            WhichUnit;
            GotoLineNumbers;
            GetInfo;
            Close(MapFile);
          end;
      end;
  End;

{----------------------------------------------------------------------------}

Procedure Find_MapFile;
  var
    Path : PathStr;
    Dir  : DirStr;
    Name : NameStr;
    Ext  : ExtStr;
  Begin
    FSplit(ParamStr(0),Dir,Name,Ext);
    Path := FSearch(Name+'.MAP',Dir+';'+GetEnv('MAP'));
    if (Path <> '') then
      begin
        FSplit(Path,Dir,Name,Ext);
        MapFileName := Path;
      end
    else
      MapFileName := '';
  End;

{----------------------------------------------------------------------------}

BEGIN
  Find_MapFile;
END.

{----------------------------------------------------------------------------}