home *** CD-ROM | disk | FTP | other *** search
/ World of Shareware - Software Farm 2 / wosw_2.zip / wosw_2 / PASCAL / HDEBUG.ZIP / MAPINFO.PAS < prev    next >
Pascal/Delphi Source File  |  1991-10-20  |  4KB  |  168 lines
  1.  
  2. Unit MapInfo;
  3.  
  4. interface
  5.  
  6. uses
  7.   DOS;
  8.  
  9.   var
  10.     MapFileName : PathStr;
  11.     UnitName : String[16];
  12.     CurrentLineNumber,NextLineNumber : Word;
  13.     CurrentLineAddress,NextLineAddress : Pointer;
  14.  
  15.   {$F+}
  16.   Function GetMapInfo(Address : Pointer) : Pointer;
  17.   {$F-}
  18.   Function HexPtrStr(P : Pointer) : String;
  19.  
  20. implementation
  21.  
  22. var
  23.   MapFile : Text;
  24.  
  25. Function HexWordStr(A : Word) : String;
  26.   const
  27.     HexDigits : Array[$0..$F] of Char = '0123456789ABCDEF';
  28.   Begin
  29.     HexWordStr := HexDigits[Hi(A) shr 4]+HexDigits[Hi(A) and $F]+
  30.                   HexDigits[Lo(A) shr 4]+HexDigits[Lo(A) and $F];
  31.   End;
  32.  
  33. Function HexPtrStr(P : Pointer) : String;
  34.   var
  35.     H,L : Word;
  36.   Begin
  37.     asm
  38.       mov ax,word ptr P
  39.       mov L,ax
  40.       mov ax,word ptr P+2
  41.       mov H,ax
  42.     end;
  43.     HexPtrStr := HexWordStr(H)+':'+HexWordStr(L);
  44.   End;
  45.  
  46. Function GetMapInfo(Address : Pointer) : Pointer;
  47.  
  48.   Procedure WhichUnit;
  49.     var
  50.       Previous,Current,Target,Buffer,Temp : String;
  51.     Begin
  52.       Target := Copy(HexPtrStr(Address),1,4)+'0';
  53.       ReadLn(MapFile);
  54.       ReadLn(MapFile);
  55.       ReadLn(MapFile);
  56.       ReadLn(MapFile,Buffer);
  57.       Current := ' 0000'+#47;
  58.       repeat
  59.         Previous := Current;
  60.         Temp := Buffer;
  61.         ReadLn(MapFile,Buffer);
  62.         Current := Copy(Buffer,2,5);
  63.       until ((Target > Previous) and (Target <= Current));
  64.       Temp := Copy(Temp,23,16);
  65.       Temp := Copy(Temp,1,Pos(' ',Temp)-1);
  66.       UnitName := Temp;
  67.     End;
  68.  
  69.   Procedure GotoLineNumbers;
  70.     var
  71.       Buffer : String;
  72.     Begin
  73.       repeat
  74.         ReadLn(MapFile,Buffer);
  75.       until ((Pos(UnitName+'(',Buffer) <> 0) or EOF(MapFile));
  76.       ReadLn(MapFile);
  77.     End;
  78.  
  79.   Procedure GetInfo;
  80.     var
  81.       i,dummy,Segment,Offset : Word;
  82.       Previous,Current,Target,Buffer,LineAddress : String;
  83.     Begin
  84.       Target := HexPtrStr(Address);
  85.       Current := '0000:000'+#47;
  86.       i := 0;
  87.       ReadLn(MapFile,Buffer);
  88.       repeat
  89.         Previous := Current;
  90.         if (i >= 4) then
  91.           begin
  92.             ReadLn(MapFile,Buffer);
  93.             i := 0;
  94.           end;
  95.         Inc(i);
  96.         Current := Copy(Buffer,(i-1)*16+1,16);
  97.         LineAddress := Copy(Current,8,9);
  98.       until ((Target > Previous) and (Target <= LineAddress));
  99.  
  100.       Buffer := Copy(Previous,1,6);
  101.       while (Buffer[1] = ' ') do
  102.         Buffer := Copy(Buffer,2,Length(Buffer)-1);
  103.       Val(Buffer,CurrentLineNumber,dummy);
  104.       Val('$'+Copy(Previous,8,4),Segment,dummy);
  105.       Val('$'+Copy(Previous,13,4),Offset,dummy);
  106.       CurrentLineAddress := Ptr(Segment,Offset);
  107.  
  108.       Buffer := Copy(Current,1,6);
  109.       while (Buffer[1] = ' ') do
  110.         Buffer := Copy(Buffer,2,Length(Buffer)-1);
  111.       Val(Buffer,NextLineNumber,dummy);
  112.       Val('$'+Copy(Current,8,4),Segment,dummy);
  113.       Val('$'+Copy(Current,13,4),Offset,dummy);
  114.       NextLineAddress := Ptr(Segment,Offset);
  115.     End;
  116.  
  117.   Begin
  118.     if (MapFileName <> '') then
  119.       begin
  120.         UnitName := 'UNKNOWN';
  121.         CurrentLineNumber := 0;
  122.         CurrentLineAddress := nil;
  123.         NextLineNumber := 0;
  124.         NextLineAddress := nil;
  125.         Assign(MapFile,MapFileName);
  126.         {$I-}
  127.         Reset(MapFile);
  128.         {$I+}
  129.         if (IOResult <> 0) then
  130.           WriteLn(MapFileName,' not found.  Cannot locate error address.')
  131.         else
  132.           begin
  133.             WhichUnit;
  134.             GotoLineNumbers;
  135.             GetInfo;
  136.             Close(MapFile);
  137.           end;
  138.       end;
  139.   End;
  140.  
  141. {----------------------------------------------------------------------------}
  142.  
  143. Procedure Find_MapFile;
  144.   var
  145.     Path : PathStr;
  146.     Dir  : DirStr;
  147.     Name : NameStr;
  148.     Ext  : ExtStr;
  149.   Begin
  150.     FSplit(ParamStr(0),Dir,Name,Ext);
  151.     Path := FSearch(Name+'.MAP',Dir+';'+GetEnv('MAP'));
  152.     if (Path <> '') then
  153.       begin
  154.         FSplit(Path,Dir,Name,Ext);
  155.         MapFileName := Path;
  156.       end
  157.     else
  158.       MapFileName := '';
  159.   End;
  160.  
  161. {----------------------------------------------------------------------------}
  162.  
  163. BEGIN
  164.   Find_MapFile;
  165. END.
  166.  
  167. {----------------------------------------------------------------------------}
  168.