+ Add preliminary debugging support on the UEFI target with

  basic checkpointer and heaptrc support.
  Output need to be fixed, though...


git-svn-id: https://svn.freepascal.org/svn/fpc/branches/olivier@36932 3ad0048d-3df7-0310-abae-a5850022a9f2

3 files changed, 80 insertions, 2 deletions

diff --git a/uefi/compiler/systems.pas b/uefi/compiler/systems.pas
index f0ed76ef16..957546a258 100644
--- a/uefi/compiler/systems.pas
+++ b/uefi/compiler/systems.pas
@@ -385,7 +385,8 @@ interface
                              + [system_i386_GO32V2]
                              + [system_i386_os2]
                              + [system_i386_beos,system_i386_haiku]
-                             + [system_powerpc_morphos];
+                             + [system_powerpc_morphos] 
+                             + [system_i386_uefi];
 
        cpu2str : array[TSystemCpu] of string[10] =
             ('','i386','m68k','alpha','powerpc','sparc','vm','ia64','x86_64',
diff --git a/uefi/rtl/inc/heaptrc.pp b/uefi/rtl/inc/heaptrc.pp
index ff390fb65e..fed8ee5cd8 100644
--- a/uefi/rtl/inc/heaptrc.pp
+++ b/uefi/rtl/inc/heaptrc.pp
@@ -63,6 +63,39 @@ const
 {$else EXTRA}
   tracesize = 8;
 {$endif EXTRA}
+
+{$ifdef UEFI}
+  { install heaptrc memorymanager }
+  useheaptrace : boolean=true;
+  { less checking }
+  quicktrace : boolean=false;
+  { calls halt() on error by default !! }
+  HaltOnError : boolean = true;
+  { Halt on exit if any memory was not freed }
+  HaltOnNotReleased : boolean = false;
+
+  { set this to true if you suspect that memory
+    is freed several times }
+{$ifdef EXTRA}
+  keepreleased : boolean=true;
+{$else EXTRA}
+  keepreleased : boolean=false;
+{$endif EXTRA}
+  { add a small footprint at the end of memory blocks, this
+    can check for memory overwrites at the end of a block }
+  add_tail : boolean = true;
+  tail_size : longint = sizeof(ptruint);
+
+  { put crc in sig
+    this allows to test for writing into that part }
+  usecrc : boolean = true;
+
+  printleakedblock: boolean = false;
+  printfaultyblock: boolean = false;
+  maxprintedblocklength: integer = 128;
+
+  GlobalSkipIfNoLeaks : Boolean = False;
+{$else}
   { install heaptrc memorymanager }
   useheaptrace : boolean=true;
   { less checking }
@@ -93,6 +126,7 @@ const
   maxprintedblocklength: integer = 128;
 
   GlobalSkipIfNoLeaks : Boolean = False;
+{$endif}
 
 implementation
 
@@ -975,6 +1009,16 @@ function TlsGetValue(dwTlsIndex : DWord) : pointer;
   {$ifdef wince}cdecl{$else}stdcall{$endif};external KernelDLL name 'TlsGetValue';
 {$endif}
 
+{$ifdef UEFI}
+// Same as Windows as it is the same file format...
+var
+   sdata : ptruint; external name '__data_start__';
+   edata : ptruint; external name '__data_end__';
+   sbss : ptruint; external name '__bss_start__';
+   ebss : ptruint; external name '__bss_end__';
+
+{$endif}
+
 {$ifdef BEOS}
 const
   B_ERROR = -1;
@@ -1010,6 +1054,20 @@ begin
   else
     ptext:=textoutput;
 
+{$ifdef UEFI}
+  // Same as Windows as it is the same file format...
+  // Good enough until proven totally wrong.
+  // Incomplete for sure...
+  { inside stack ? }
+  if (ptruint(p)>ptruint(get_frame)) and
+     (p<StackTop) then
+    exit;
+  { inside data, rdata ... bss }
+  if (ptruint(p)>=ptruint(@sdata)) and (ptruint(p)<ptruint(@ebss)) then
+    exit;
+
+{$endif}
+
 {$ifdef go32v2}
   if ptruint(p)<$1000 then
     runerror(216);
@@ -1147,7 +1205,14 @@ begin
          halt(1);
       end;
    end;
-  writeln(ptext^,'pointer $',hexstr(p),' does not point to valid memory block');
+
+  //Debugger('heaptrc : Here...');
+  // Maybe error here...
+  // probably ptext^...
+  //writeln(ptext^,'pointer $',hexstr(p),' does not point to valid memory block');
+  // TODO : test with a WideString...
+  //debugger('pointer $' + hexstr(p) + ' does not point to valid memory block');
+  //Debugger('After the supposed crash...');
   dump_stack(ptext^,1);
   runerror(204);
 end;
@@ -1632,6 +1697,14 @@ var
   s,s2   : string;
   err : word;
 begin
+  {$ifdef UEFI}
+  // Avoid GetEnv in case it cause the problem when initializing heaptrc unit
+  keepreleased:=true;
+  useheaptrace:=false;
+  haltonerror:=true;
+  HaltOnNotReleased :=true;
+  GlobalSkipIfNoLeaks :=true;
+  {$else}
   s:=Getenv('HEAPTRC');
   if pos('keepreleased',s)>0 then
    keepreleased:=true;
@@ -1668,6 +1741,7 @@ begin
       j:=length(outputstr)+1;
      delete(outputstr,j,255);
    end;
+  {$endif}
 end;
 
 
diff --git a/uefi/rtl/inc/system.inc b/uefi/rtl/inc/system.inc
index b41f5d1172..f27995d376 100644
--- a/uefi/rtl/inc/system.inc
+++ b/uefi/rtl/inc/system.inc
@@ -1207,11 +1207,14 @@ var
   pcaddr : codepointer;
 begin
   errorcode:=w;
+  {$ifndef UEFI}
+  // TODO : some work required here to support this under UEFI
   pcaddr:=get_pc_addr;
   bp:=get_frame;
   get_caller_stackinfo(bp,pcaddr);
   erroraddr:=pcaddr;
   errorbase:=bp;
+  {$endif}
   Halt(errorcode);
 end;