From 322e3f8a163cb8cdcd5c4e9cd7a0fe5976160bef Mon Sep 17 00:00:00 2001
From: pierre <pierre@freepascal.org>
Date: Fri, 8 Jul 2011 15:38:14 +0000
Subject: [PATCH]  * More fixes for ppudump use

git-svn-id: trunk@17956 -
---
 compiler/ppu.pas | 137 ++++++++++++++++++++++++++++++++++++-----------
 1 file changed, 107 insertions(+), 30 deletions(-)

diff --git a/compiler/ppu.pas b/compiler/ppu.pas
index f9401c6c9b..8c4b4c19af 100644
--- a/compiler/ppu.pas
+++ b/compiler/ppu.pas
@@ -230,6 +230,9 @@ type
       used by this unit. Reason: see mantis #13840 }
     indirect_crc     : cardinal;
     error,
+{$ifdef generic_cpu}
+    has_more,
+{$endif not generic_cpu}
     do_crc,
     do_interface_crc,
     do_indirect_crc  : boolean;
@@ -250,6 +253,7 @@ type
     function  readentry:byte;
     function  EndOfEntry:boolean;
     function  entrysize:longint;
+    function  entryleft:longint;
     procedure getdatabuf(var b;len:integer;var res:integer);
     procedure getdata(var b;len:integer);
     function  getbyte:byte;
@@ -262,6 +266,7 @@ type
     function getasizeint:asizeint;
     function getaword:aword;
     function  getreal:ppureal;
+    function  getrealsize(sizeofreal : longint):ppureal;
     function  getstring:string;
     function  getansistring:ansistring;
     procedure getnormalset(var b);
@@ -301,7 +306,7 @@ implementation
     fpccrc,
     cutils;
 
-{$ifdef GENERIC_CPU}
+{$ifdef generic_cpu}
 { We need to use the correct size of aint and pint for
   the target CPU }
 const
@@ -339,7 +344,7 @@ const
     { 12 }  8 {'avr'},
     { 13 } 32 {'mipsel'}
     );
-{$endif GENERIC_CPU}
+{$endif generic_cpu}
 
 
 
@@ -571,12 +576,20 @@ end;
 function tppufile.readentry:byte;
 begin
   if entryidx<entry.size then
-   skipdata(entry.size-entryidx);
+    begin
+{$ifdef generic_cpu}
+     has_more:=true;
+{$endif not generic_cpu}
+     skipdata(entry.size-entryidx);
+    end;
   readdata(entry,sizeof(tppuentry));
   if change_endian then
     entry.size:=swapendian(entry.size);
   entrystart:=bufstart+bufidx;
   entryidx:=0;
+{$ifdef generic_cpu}
+  has_more:=false;
+{$endif not generic_cpu}
   if not(entry.id in [mainentryid,subentryid]) then
    begin
      readentry:=iberror;
@@ -589,7 +602,11 @@ end;
 
 function tppufile.endofentry:boolean;
 begin
+{$ifdef generic_cpu}
+  endofentry:=(entryidx=entry.size);
+{$else not generic_cpu}
   endofentry:=(entryidx>=entry.size);
+{$endif not generic_cpu}
 end;
 
 
@@ -598,6 +615,11 @@ begin
   entrysize:=entry.size;
 end;
 
+function tppufile.entryleft:longint;
+begin
+  entryleft:=entry.size-entryidx;
+end;
+
 
 procedure tppufile.getdatabuf(var b;len:integer;var res:integer);
 begin
@@ -756,7 +778,12 @@ begin
   else if CpuAluBitSize[tsystemcpu(header.cpu)]=16 then
     result:=smallint(getword)
   else if CpuAluBitSize[tsystemcpu(header.cpu)]=8 then
-    result:=shortint(getbyte);
+    result:=shortint(getbyte)
+  else
+    begin
+      error:=true;
+      result:=0;
+    end;
 {$else not generic_cpu}
 {$ifdef cpu64bitalu}
   result:=getint64;
@@ -775,7 +802,12 @@ begin
   else if CpuAddrBitSize[tsystemcpu(header.cpu)]=32 then
     result:=getlongint
   else if CpuAddrBitSize[tsystemcpu(header.cpu)]=16 then
-    result:=smallint(getword);
+    result:=smallint(getword)
+  else
+    begin
+      error:=true;
+      result:=0;
+    end;
 {$else not generic_cpu}
 {$ifdef cpu64bitaddr}
   result:=getint64;
@@ -796,7 +828,12 @@ begin
   else if CpuAluBitSize[tsystemcpu(header.cpu)]=16 then
     result:=getword
   else if CpuAluBitSize[tsystemcpu(header.cpu)]=8 then
-    result:=getbyte;
+    result:=getbyte
+  else
+    begin
+      error:=true;
+      result:=0;
+    end;
 {$else not generic_cpu}
 {$ifdef cpu64bitalu}
   result:=getqword;
@@ -806,6 +843,66 @@ begin
 {$endif not generic_cpu}
 end;
 
+function  tppufile.getrealsize(sizeofreal : longint):ppureal;
+var
+  e : ppureal;
+  d : double;
+  s : single;
+begin
+  if sizeofreal=sizeof(e) then
+    begin
+      if entryidx+sizeof(e)>entry.size then
+       begin
+         error:=true;
+         result:=0;
+         exit;
+       end;
+      readdata(e,sizeof(e));
+      if change_endian then
+        result:=swapendian_ppureal(e)
+      else
+        result:=e;
+      inc(entryidx,sizeof(e));
+      result:=e;
+      exit;
+    end;
+  if sizeofreal=sizeof(d) then
+    begin
+      if entryidx+sizeof(d)>entry.size then
+       begin
+         error:=true;
+         result:=0;
+         exit;
+       end;
+      readdata(d,sizeof(d));
+      if change_endian then
+        result:=swapendian(pqword(@d)^)
+      else
+        result:=d;
+      inc(entryidx,sizeof(d));
+      result:=d;
+      exit;
+    end;
+  if sizeofreal=sizeof(s) then
+    begin
+      if entryidx+sizeof(s)>entry.size then
+       begin
+         error:=true;
+         result:=0;
+         exit;
+       end;
+      readdata(s,sizeof(s));
+      if change_endian then
+        result:=swapendian(pdword(@s)^)
+      else
+        result:=s;
+      inc(entryidx,sizeof(s));
+      result:=s;
+      exit;
+    end;
+  error:=true;
+  result:=0.0;
+end;
 
 function tppufile.getreal:ppureal;
 var
@@ -814,33 +911,13 @@ var
 begin
   if target_info.system=system_x86_64_win64 then
     begin
-      if entryidx+sizeof(hd)>entry.size then
-       begin
-         error:=true;
-         getreal:=0;
-         exit;
-       end;
-      readdata(hd,sizeof(hd));
-      if change_endian then
-        getreal:=swapendian(qword(hd))
-      else
-        getreal:=hd;
-      inc(entryidx,sizeof(hd));
+      hd:=getrealsize(sizeof(hd));
+      getreal:=hd;
     end
   else
     begin
-      if entryidx+sizeof(ppureal)>entry.size then
-       begin
-         error:=true;
-         getreal:=0;
-         exit;
-       end;
-      readdata(d,sizeof(ppureal));
-      if change_endian then
-        getreal:=swapendian_ppureal(d)
-      else
-        getreal:=d;
-      inc(entryidx,sizeof(ppureal));
+      d:=getrealsize(sizeof(d));
+      getreal:=d;
     end;
 end;