paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-04 09:19:39 +01:00
Code Issues Packages Projects Releases Wiki Activity

Try to improve RecordTokenBuf with respect to PPU reading

Browse Source 
git-svn-id: trunk@18975 -
This commit is contained in:
pierre 2011-09-04 22:43:41 +00:00
parent 2f780a7a28
commit 68d27263e7
3 changed files with 162 additions and 69 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

83
compiler/ppu.pas
View File

@ -26,7 +26,7 @@ unit ppu;
interface interface
uses uses
globtype,constexp,cstreams; systems,globtype,constexp,cstreams;
{ Also write the ppu if only crc if done, this can be used with ppudump to { Also write the ppu if only crc if done, this can be used with ppudump to
see the differences between the intf and implementation } see the differences between the intf and implementation }
@ -162,6 +162,46 @@ const
uf_classinits = $800000; { this unit has class constructors/destructors } uf_classinits = $800000; { this unit has class constructors/destructors }
uf_resstrinits = $1000000; { this unit has string consts referencing resourcestrings } 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 type
{ bestreal is defined based on the target architecture } { bestreal is defined based on the target architecture }
ppureal=bestreal; ppureal=bestreal;
@ -302,53 +342,12 @@ type
implementation implementation
uses uses
systems,
{$ifdef Test_Double_checksum} {$ifdef Test_Double_checksum}
comphook, comphook,
{$endif def Test_Double_checksum} {$endif def Test_Double_checksum}
fpccrc, fpccrc,
cutils; 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; function swapendian_ppureal(d:ppureal):ppureal;

71
compiler/scanner.pas
View File

@ -171,6 +171,8 @@ interface
procedure stoprecordtokens; procedure stoprecordtokens;
procedure replaytoken; procedure replaytoken;
procedure startreplaytokens(buf:tdynamicarray); procedure startreplaytokens(buf:tdynamicarray);
procedure writesizeint(val : sizeint);
function readsizeint : sizeint;
procedure readchar; procedure readchar;
procedure readstring; procedure readstring;
procedure readnumber; procedure readnumber;
@ -248,6 +250,25 @@ implementation
symbase,symtable,symtype,symsym,symconst,symdef,defutil, symbase,symtable,symtype,symsym,symconst,symdef,defutil,
fmodule; 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 var
{ dictionaries with the supported directives } { dictionaries with the supported directives }
turbo_scannerdirectives : TFPHashObjectList; { for other modes } turbo_scannerdirectives : TFPHashObjectList; { for other modes }
@ -2080,13 +2101,30 @@ In case not, the value returned can be arbitrary.
recordtokenbuf.write(b,1); recordtokenbuf.write(b,1);
end; 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; procedure tscannerfile.recordtoken;
var var
t : ttoken; t : ttoken;
s : tspecialgenerictoken; s : tspecialgenerictoken;
len : sizeint; len,val,msgnb : sizeint;
b,msgnb : byte; copy_size : longint;
b : byte;
pmsg : pmessagestaterecord; pmsg : pmessagestaterecord;
begin begin
if not assigned(recordtokenbuf) then if not assigned(recordtokenbuf) then
@ -2099,8 +2137,9 @@ In case not, the value returned can be arbitrary.
s:=ST_LOADSETTINGS; s:=ST_LOADSETTINGS;
writetoken(t); writetoken(t);
recordtokenbuf.write(s,1); recordtokenbuf.write(s,1);
recordtokenbuf.write(current_settings, copy_size:=sizeof(current_settings)-sizeof(pointer);
sizeof(current_settings)-sizeof(pointer)); recordtokenbuf.write(copy_size,sizeof(longint));
recordtokenbuf.write(current_settings,copy_size);
last_settings:=current_settings; last_settings:=current_settings;
end; end;
@ -2114,19 +2153,21 @@ In case not, the value returned can be arbitrary.
pmsg:=current_settings.pmessage; pmsg:=current_settings.pmessage;
while assigned(pmsg) do while assigned(pmsg) do
begin begin
if msgnb=255 then if msgnb=high(sizeint) then
{ Too many messages } { Too many messages }
internalerror(2011090401); internalerror(2011090401);
inc(msgnb); inc(msgnb);
pmsg:=pmsg^.next; pmsg:=pmsg^.next;
end; end;
recordtokenbuf.write(msgnb,1); writesizeint(msgnb);
pmsg:=current_settings.pmessage; pmsg:=current_settings.pmessage;
while assigned(pmsg) do while assigned(pmsg) do
begin begin
{ What about endianess here? } { What about endianess here? }
recordtokenbuf.write(pmsg^.value,sizeof(longint)); val:=pmsg^.value;
recordtokenbuf.write(pmsg^.state,sizeof(tmsgstate)); writesizeint(val);
val:=ord(pmsg^.state);
writesizeint(val);
pmsg:=pmsg^.next; pmsg:=pmsg^.next;
end; end;
last_message:=current_settings.pmessage; last_message:=current_settings.pmessage;
@ -2174,13 +2215,13 @@ In case not, the value returned can be arbitrary.
_CWCHAR, _CWCHAR,
_CWSTRING : _CWSTRING :
begin begin
recordtokenbuf.write(patternw^.len,sizeof(sizeint)); writesizeint(patternw^.len);
recordtokenbuf.write(patternw^.data^,patternw^.len*sizeof(tcompilerwidechar)); recordtokenbuf.write(patternw^.data^,patternw^.len*sizeof(tcompilerwidechar));
end; end;
_CSTRING: _CSTRING:
begin begin
len:=length(cstringpattern); len:=length(cstringpattern);
recordtokenbuf.write(len,sizeof(sizeint)); writesizeint(len);
recordtokenbuf.write(cstringpattern[1],length(cstringpattern)); recordtokenbuf.write(cstringpattern[1],length(cstringpattern));
end; end;
_CCHAR, _CCHAR,
@ -2241,9 +2282,9 @@ In case not, the value returned can be arbitrary.
procedure tscannerfile.replaytoken; procedure tscannerfile.replaytoken;
var var
wlen : sizeint; wlen,mesgnb : sizeint;
specialtoken : tspecialgenerictoken; specialtoken : tspecialgenerictoken;
i,mesgnb : byte; i : byte;
pmsg,prevmsg : pmessagestaterecord; pmsg,prevmsg : pmessagestaterecord;
begin begin
if not assigned(replaytokenbuf) then if not assigned(replaytokenbuf) then
@ -2274,7 +2315,7 @@ In case not, the value returned can be arbitrary.
_CWCHAR, _CWCHAR,
_CWSTRING : _CWSTRING :
begin begin
replaytokenbuf.read(wlen,sizeof(SizeInt)); wlen:=readsizeint;
setlengthwidestring(patternw,wlen); setlengthwidestring(patternw,wlen);
replaytokenbuf.read(patternw^.data^,patternw^.len*sizeof(tcompilerwidechar)); replaytokenbuf.read(patternw^.data^,patternw^.len*sizeof(tcompilerwidechar));
orgpattern:=''; orgpattern:='';
@ -2283,7 +2324,7 @@ In case not, the value returned can be arbitrary.
end; end;
_CSTRING: _CSTRING:
begin begin
replaytokenbuf.read(wlen,sizeof(sizeint)); wlen:=readsizeint;
setlength(cstringpattern,wlen); setlength(cstringpattern,wlen);
replaytokenbuf.read(cstringpattern[1],wlen); replaytokenbuf.read(cstringpattern[1],wlen);
orgpattern:=''; orgpattern:='';
@ -2325,7 +2366,7 @@ In case not, the value returned can be arbitrary.
ST_LOADMESSAGES: ST_LOADMESSAGES:
begin begin
current_settings.pmessage:=nil; current_settings.pmessage:=nil;
replaytokenbuf.read(mesgnb,sizeof(mesgnb)); mesgnb:=readsizeint;
if mesgnb>0 then if mesgnb>0 then
Comment(V_Error,'Message recordind not yet supported'); Comment(V_Error,'Message recordind not yet supported');
for i:=1 to mesgnb do for i:=1 to mesgnb do

77
compiler/utils/ppudump.pp
View File

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