Try to improve RecordTokenBuf with respect to PPU reading

git-svn-id: trunk@18975 -

compiler/ppu.pas

@@ -26,7 +26,7 @@ unit ppu;
 interface
 
   uses
-    globtype,constexp,cstreams;
+    systems,globtype,constexp,cstreams;
 
 { Also write the ppu if only crc if done, this can be used with ppudump to
   see the differences between the intf and implementation }
@@ -162,6 +162,46 @@ const
   uf_classinits          = $800000; { this unit has class constructors/destructors }
   uf_resstrinits        = $1000000; { this unit has string consts referencing resourcestrings }
 
+{$ifdef generic_cpu}
+{ We need to use the correct size of aint and pint for
+  the target CPU }
+const
+  CpuAddrBitSize : array[tsystemcpu] of longint =
+    (
+    {  0 } 32 {'none'},
+    {  1 } 32 {'i386'},
+    {  2 } 32 {'m68k'},
+    {  3 } 32 {'alpha'},
+    {  4 } 32 {'powerpc'},
+    {  5 } 32 {'sparc'},
+    {  6 } 32 {'vis'},
+    {  7 } 64 {'ia64'},
+    {  8 } 64 {'x86_64'},
+    {  9 } 32 {'mips'},
+    { 10 } 32 {'arm'},
+    { 11 } 64 {'powerpc64'},
+    { 12 } 16 {'avr'},
+    { 13 } 32 {'mipsel'}
+    );
+  CpuAluBitSize : array[tsystemcpu] of longint =
+    (
+    {  0 } 32 {'none'},
+    {  1 } 32 {'i386'},
+    {  2 } 32 {'m68k'},
+    {  3 } 32 {'alpha'},
+    {  4 } 32 {'powerpc'},
+    {  5 } 32 {'sparc'},
+    {  6 } 32 {'vis'},
+    {  7 } 64 {'ia64'},
+    {  8 } 64 {'x86_64'},
+    {  9 } 32 {'mips'},
+    { 10 } 32 {'arm'},
+    { 11 } 64 {'powerpc64'},
+    { 12 }  8 {'avr'},
+    { 13 } 32 {'mipsel'}
+    );
+{$endif generic_cpu}
+
 type
   { bestreal is defined based on the target architecture }
   ppureal=bestreal;
@@ -302,53 +342,12 @@ type
 implementation
 
   uses
-    systems,
 {$ifdef Test_Double_checksum}
     comphook,
 {$endif def Test_Double_checksum}
     fpccrc,
     cutils;
 
-{$ifdef generic_cpu}
-{ We need to use the correct size of aint and pint for
-  the target CPU }
-const
-  CpuAddrBitSize : array[tsystemcpu] of longint =
-    (
-    {  0 } 32 {'none'},
-    {  1 } 32 {'i386'},
-    {  2 } 32 {'m68k'},
-    {  3 } 32 {'alpha'},
-    {  4 } 32 {'powerpc'},
-    {  5 } 32 {'sparc'},
-    {  6 } 32 {'vis'},
-    {  7 } 64 {'ia64'},
-    {  8 } 64 {'x86_64'},
-    {  9 } 32 {'mips'},
-    { 10 } 32 {'arm'},
-    { 11 } 64 {'powerpc64'},
-    { 12 } 16 {'avr'},
-    { 13 } 32 {'mipsel'}
-    );
-  CpuAluBitSize : array[tsystemcpu] of longint =
-    (
-    {  0 } 32 {'none'},
-    {  1 } 32 {'i386'},
-    {  2 } 32 {'m68k'},
-    {  3 } 32 {'alpha'},
-    {  4 } 32 {'powerpc'},
-    {  5 } 32 {'sparc'},
-    {  6 } 32 {'vis'},
-    {  7 } 64 {'ia64'},
-    {  8 } 64 {'x86_64'},
-    {  9 } 32 {'mips'},
-    { 10 } 32 {'arm'},
-    { 11 } 64 {'powerpc64'},
-    { 12 }  8 {'avr'},
-    { 13 } 32 {'mipsel'}
-    );
-{$endif generic_cpu}
-
 
 
 function swapendian_ppureal(d:ppureal):ppureal;

compiler/scanner.pas

@@ -171,6 +171,8 @@ interface
           procedure stoprecordtokens;
           procedure replaytoken;
           procedure startreplaytokens(buf:tdynamicarray);
+          procedure writesizeint(val : sizeint);
+          function  readsizeint : sizeint;
           procedure readchar;
           procedure readstring;
           procedure readnumber;
@@ -248,6 +250,25 @@ implementation
       symbase,symtable,symtype,symsym,symconst,symdef,defutil,
       fmodule;
 
+   const
+   { Same valus as in ppu unit, but
+   their only goal here is to set change_endian constant }
+
+     uf_big_endian          = $000004;
+     uf_little_endian       = $001000;
+   {$ifdef FPC_BIG_ENDIAN}
+       target_flags = uf_little_endian;
+   {$else not FPC_BIG_ENDIAN}
+       target_flags = uf_big_endian;
+   {$endif not FPC_BIG_ENDIAN}
+   {$IFDEF ENDIAN_LITTLE}
+       source_flags = uf_little_endian;
+   {$ELSE}
+       source_flags = uf_big_endian;
+   {$ENDIF}
+     { Change_endian must be use to store recordtokenbuf in
+       target endian order }
+       change_endian = (source_flags<>target_flags);
     var
       { dictionaries with the supported directives }
       turbo_scannerdirectives : TFPHashObjectList;     { for other modes }
@@ -2080,13 +2101,30 @@ In case not, the value returned can be arbitrary.
         recordtokenbuf.write(b,1);
       end;
 
+    procedure tscannerfile.writesizeint(val : sizeint);
+      begin
+        if change_endian then
+          val:=swapendian(val);
+        recordtokenbuf.write(val,sizeof(sizeint));
+      end;
+
+    function tscannerfile.readsizeint : sizeint;
+      var
+        val : sizeint;
+      begin
+        replaytokenbuf.read(val,sizeof(sizeint));
+        if change_endian then
+          val:=swapendian(val);
+        result:=val;
+      end;
 
     procedure tscannerfile.recordtoken;
       var
         t : ttoken;
         s : tspecialgenerictoken;
-        len : sizeint;
-        b,msgnb : byte;
+        len,val,msgnb : sizeint;
+        copy_size : longint;
+        b : byte;
         pmsg : pmessagestaterecord;
       begin
         if not assigned(recordtokenbuf) then
@@ -2099,8 +2137,9 @@ In case not, the value returned can be arbitrary.
             s:=ST_LOADSETTINGS;
             writetoken(t);
             recordtokenbuf.write(s,1);
-            recordtokenbuf.write(current_settings,
-              sizeof(current_settings)-sizeof(pointer));
+            copy_size:=sizeof(current_settings)-sizeof(pointer);
+            recordtokenbuf.write(copy_size,sizeof(longint));
+            recordtokenbuf.write(current_settings,copy_size);
             last_settings:=current_settings;
           end;
 
@@ -2114,19 +2153,21 @@ In case not, the value returned can be arbitrary.
             pmsg:=current_settings.pmessage;
             while assigned(pmsg) do
               begin
-                if msgnb=255 then
+                if msgnb=high(sizeint) then
                   { Too many messages }
                   internalerror(2011090401);
                 inc(msgnb);
                 pmsg:=pmsg^.next;
               end;
-            recordtokenbuf.write(msgnb,1);
+            writesizeint(msgnb);
             pmsg:=current_settings.pmessage;
             while assigned(pmsg) do
               begin
                 { What about endianess here? }
-                recordtokenbuf.write(pmsg^.value,sizeof(longint));
-                recordtokenbuf.write(pmsg^.state,sizeof(tmsgstate));
+                val:=pmsg^.value;
+                writesizeint(val);
+                val:=ord(pmsg^.state);
+                writesizeint(val);
                 pmsg:=pmsg^.next;
               end;
             last_message:=current_settings.pmessage;
@@ -2174,13 +2215,13 @@ In case not, the value returned can be arbitrary.
           _CWCHAR,
           _CWSTRING :
             begin
-              recordtokenbuf.write(patternw^.len,sizeof(sizeint));
+              writesizeint(patternw^.len);
               recordtokenbuf.write(patternw^.data^,patternw^.len*sizeof(tcompilerwidechar));
             end;
           _CSTRING:
             begin
               len:=length(cstringpattern);
-              recordtokenbuf.write(len,sizeof(sizeint));
+              writesizeint(len);
               recordtokenbuf.write(cstringpattern[1],length(cstringpattern));
             end;
           _CCHAR,
@@ -2241,9 +2282,9 @@ In case not, the value returned can be arbitrary.
 
     procedure tscannerfile.replaytoken;
       var
-        wlen : sizeint;
+        wlen,mesgnb : sizeint;
         specialtoken : tspecialgenerictoken;
-        i,mesgnb : byte;
+        i : byte;
         pmsg,prevmsg : pmessagestaterecord;
       begin
         if not assigned(replaytokenbuf) then
@@ -2274,7 +2315,7 @@ In case not, the value returned can be arbitrary.
             _CWCHAR,
             _CWSTRING :
               begin
-                replaytokenbuf.read(wlen,sizeof(SizeInt));
+                wlen:=readsizeint;
                 setlengthwidestring(patternw,wlen);
                 replaytokenbuf.read(patternw^.data^,patternw^.len*sizeof(tcompilerwidechar));
                 orgpattern:='';
@@ -2283,7 +2324,7 @@ In case not, the value returned can be arbitrary.
               end;
             _CSTRING:
               begin
-                replaytokenbuf.read(wlen,sizeof(sizeint));
+                wlen:=readsizeint;
                 setlength(cstringpattern,wlen);
                 replaytokenbuf.read(cstringpattern[1],wlen);
                 orgpattern:='';
@@ -2325,7 +2366,7 @@ In case not, the value returned can be arbitrary.
                     ST_LOADMESSAGES:
                       begin
                         current_settings.pmessage:=nil;
-                        replaytokenbuf.read(mesgnb,sizeof(mesgnb));
+                        mesgnb:=readsizeint;
                         if mesgnb>0 then
                           Comment(V_Error,'Message recordind not yet supported');
                         for i:=1 to mesgnb do

compiler/utils/ppudump.pp

@@ -31,6 +31,7 @@ uses
   constexp,
   symconst,
   ppu,
+  systems,
   globals,
   globtype,
   widestr,
@@ -51,7 +52,7 @@ const
 //  v_browser        = $20;
   v_all            = $ff;
 
-{$i systems.inc }
+{ not needed anymore $i systems.inc }
 
 { List of all supported cpus }
 const
@@ -156,6 +157,7 @@ const
   thus widecharsize seems to always be 2 bytes }
 
   widecharsize : longint = 2;
+  cpu : tsystemcpu = cpu_no;
 
 { This type is defined in scanner.pas unit }
 type
@@ -217,7 +219,10 @@ end;
 Function Cpu2Str(w:longint):string;
 begin
   if w<=ord(high(tsystemcpu)) then
-    Cpu2Str:=CpuTxt[tsystemcpu(w)]
+    begin
+      cpu:=tsystemcpu(w);
+      Cpu2Str:=CpuTxt[cpu];
+    end
   else
     Cpu2Str:=Unknown('cpu',w);
 end;
@@ -894,11 +899,12 @@ var
   defstates  : tdefstates;
   i, nb, msgvalue, mesgnb : longint;
   first  : boolean;
-  tokenbufsize : longint;
+  copy_size, min_size, tokenbufsize : longint;
   tokenbuf : pbyte;
   idtoken,
   token : ttoken;
   state : tmsgstate;
+  new_settings : Tsettings;
   len : sizeint;
   wstring : widestring;
   astring : ansistring;
@@ -919,6 +925,38 @@ var
         result:=ttoken(b);
     end;
 
+  function gettokenbufsizeint : int64;
+  var
+    var64 : int64;
+    var32 : longint;
+    var16 : smallint;
+
+  begin
+    if CpuAddrBitSize[cpu]=64 then
+      begin
+        var64:=pint64(@tokenbuf[i])^;
+        inc(i,sizeof(int64));
+        result:=var64;
+      end
+    else if CpuAddrBitSize[cpu]=32 then
+      begin
+        var32:=plongint(@tokenbuf[i])^;
+        inc(i,sizeof(longint));
+        result:=var32;
+      end
+    else if CpuAddrBitSize[cpu]=16 then
+      begin
+        var16:=psmallint(@tokenbuf[i])^;
+        inc(i,sizeof(smallint));
+        result:=var32;
+      end
+    else
+      begin
+        WriteError('Wrong CpuAddrBitSize');
+        result:=0;
+      end;
+  end;
+
 begin
   writeln(space,'** Definition Id ',ppufile.getlongint,' **');
   writeln(space,s);
@@ -971,15 +1009,21 @@ begin
           token:=readtoken;
           if token<>_GENERICSPECIALTOKEN then
             begin
-              write(arraytokeninfo[token].str);
+              if token <= high(ttoken) then
+                write(arraytokeninfo[token].str)
+              else
+                begin
+                  HasMoreInfos;
+                  write('Error in Token List');
+                  break;
+                end;
               idtoken:=readtoken;
             end;
           case token of
             _CWCHAR,
             _CWSTRING :
               begin
-                len:=psizeint(@tokenbuf[i])^;
-                inc(i,sizeof(sizeint));
+                len:=gettokenbufsizeint;
                 setlength(wstring,len);
                 move(tokenbuf[i],wstring[1],len*2);
                 write(' ',wstring);
@@ -987,8 +1031,7 @@ begin
               end;
             _CSTRING:
               begin
-                len:=psizeint(@tokenbuf[i])^;
-                inc(i,sizeof(sizeint));
+                len:=gettokenbufsizeint;
                 setlength(astring,len);
                 move(tokenbuf[i],astring[1],len);
                 write(' ',astring);
@@ -1025,7 +1068,16 @@ begin
                         inc(i);
                         write('Settings');
                         { This does not load pmessage pointer }
-                        inc(i,sizeof(tsettings)-sizeof(pointer));
+                        new_settings.pmessage:=nil;
+                        { TSettings size depends in target...
+                          We first read the size of the copied part }
+                        copy_size:=gettokenbufsizeint;
+                        if copy_size < sizeof(tsettings)-sizeof(pointer) then
+                          min_size:=copy_size
+                        else
+                          min_size:= sizeof(tsettings)-sizeof(pointer);
+                        move(tokenbuf[i],new_settings, min_size);
+                        inc(i,copy_size);
                       end;
                     ST_LOADMESSAGES:
                       begin
@@ -1035,10 +1087,9 @@ begin
                         inc(i);
                         for nb:=1 to mesgnb do
                           begin
-                            msgvalue:=plongint(@tokenbuf[i])^;
+                            msgvalue:=gettokenbufsizeint;
                             inc(i,sizeof(sizeint));
-                            state:=pmsgstate(@tokenbuf[i])^;
-                            inc(i,sizeof(tmsgstate));
+                            state:=tmsgstate(gettokenbufsizeint);
                           end;
                       end;
                     ST_LINE:
@@ -1528,6 +1579,8 @@ begin
              readcommonsym('Type symbol ');
              write(space,'  Result Type : ');
              readderef('');
+             write(space,' Pretty Name : ');
+             Write(getansistring);
            end;
 
          ibprocsym :