Ver Fonte

+ add overloaded versions of HexStr(pointer) for i8086 near and far pointers
- rm ifdefs for i8086 far code memory model when doing stack traces. The
compiler will now choose the correct overload of HexStr according to the
CodePointer type.

git-svn-id: trunk@27163 -

nickysn há 11 anos atrás
pai
commit
a176c2d4f5
4 ficheiros alterados com 25 adições e 11 exclusões
  1. 20 0
      rtl/i8086/i8086.inc
  2. 0 8
      rtl/inc/system.inc
  3. 5 0
      rtl/inc/systemh.inc
  4. 0 3
      rtl/objpas/sysutils/sysutils.inc

+ 20 - 0
rtl/i8086/i8086.inc

@@ -353,6 +353,26 @@ asm
 end;
 
 
+{****************************************************************************
+                                  HexStr
+****************************************************************************}
+
+{$define FPC_HAS_HEXSTR_POINTER_SHORTSTR}
+function HexStr(Val: NearPointer): ShortString;
+begin
+  HexStr:=HexStr(Word(Val),4);
+end;
+
+function HexStr(Val: FarPointer): ShortString;
+type
+  TFarPointerRec = record
+    Offset, Segment: Word;
+  end;
+begin
+  HexStr:=HexStr(TFarPointerRec(Val).Segment,4)+':'+HexStr(TFarPointerRec(Val).Offset,4);
+end;
+
+
 {****************************************************************************
                                   FPU
 ****************************************************************************}

+ 0 - 8
rtl/inc/system.inc

@@ -985,11 +985,7 @@ Begin
   pstdout:=@stdout;
   If erroraddr<>nil Then
    Begin
-{$if defined(CPUI8086) and defined(FPC_X86_CODE_FAR)}
-     Writeln(pstdout^,'Runtime error ',Errorcode,' at $',hexstr(DWord(erroraddr) shr 16,4),':',hexstr(DWord(erroraddr) and $FFFF,4));
-{$else}
      Writeln(pstdout^,'Runtime error ',Errorcode,' at $',hexstr(erroraddr));
-{$endif}
      { to get a nice symify }
      Writeln(pstdout^,BackTraceStrFunc(Erroraddr));
      dump_stack(pstdout^,ErrorBase,ErrorAddr);
@@ -1067,11 +1063,7 @@ end;
 
 function SysBackTraceStr (Addr: CodePointer): ShortString;
 begin
-{$if defined(CPUI8086) and defined(FPC_X86_CODE_FAR)}
-  SysBackTraceStr:='  $'+hexstr(DWord(addr) shr 16,4)+':'+hexstr(DWord(addr) and $FFFF,4);
-{$else}
   SysBackTraceStr:='  $'+hexstr(addr);
-{$endif}
 end;
 
 

+ 5 - 0
rtl/inc/systemh.inc

@@ -1076,7 +1076,12 @@ Function  binStr(Val:int64;cnt:byte):shortstring;
 Function  hexStr(Val:qword;cnt:byte):shortstring;
 Function  OctStr(Val:qword;cnt:byte):shortstring;
 Function  binStr(Val:qword;cnt:byte):shortstring;
+{$ifdef CPUI8086}
+Function  hexStr(Val:NearPointer):shortstring;
+Function  hexStr(Val:FarPointer):shortstring;
+{$else CPUI8086}
 Function  hexStr(Val:Pointer):shortstring;
+{$endif CPUI8086}
 
 { Char functions }
 Function chr(b : byte) : Char;      [INTERNPROC: fpc_in_chr_byte];

+ 0 - 3
rtl/objpas/sysutils/sysutils.inc

@@ -291,10 +291,7 @@ Var
   hstdout : ^text;
 begin
   hstdout:=@stdout;
-{$if defined(CPUI8086) and (defined(FPC_MM_MEDIUM) or defined(FPC_MM_LARGE) or defined(FPC_MM_HUGE))}
-{$else}
   Writeln(hstdout^,'An unhandled exception occurred at $',HexStr(Addr),':');
-{$endif}
   if Obj is exception then
     Writeln(hstdout^,Obj.ClassName,': ',Exception(Obj).Message)
   else