home *** CD-ROM | disk | FTP | other *** search
-
- 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.
-
- {----------------------------------------------------------------------------}
-