paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-05-30 03:22:40 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ store compiler switch changes in generic token streams

Browse Source 
git-svn-id: trunk@5095 -
This commit is contained in:
florian 2006-10-30 19:54:17 +00:00
parent 85d63d9fa9
commit 058e1877ba
8 changed files with 187 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -6352,6 +6352,7 @@ tests/test/tgeneric3.pp svneol=native#text/plain
tests/test/tgeneric4.pp svneol=native#text/plain
tests/test/tgeneric5.pp svneol=native#text/plain
tests/test/tgeneric6.pp svneol=native#text/plain
tests/test/tgeneric7.pp svneol=native#text/plain
tests/test/tgoto.pp svneol=native#text/plain
tests/test/theap.pp svneol=native#text/plain
tests/test/thintdir.pp svneol=native#text/plain
@ -6467,6 +6468,7 @@ tests/test/tstrreal1.pp svneol=native#text/plain
tests/test/tstrreal2.pp svneol=native#text/plain
tests/test/tstrreal3.pp -text
tests/test/tsubdecl.pp svneol=native#text/plain
tests/test/tugeneric7.pp svneol=native#text/plain
tests/test/tunaligned1.pp svneol=native#text/plain
tests/test/tunit1.pp svneol=native#text/plain
tests/test/tunit2.pp svneol=native#text/plain

92
compiler/scanner.pas
View File

@ -67,6 +67,8 @@ interface
tcompile_time_predicate = function(var valuedescr: String) : Boolean;
tspecialgenerictoken = (ST_LOADSETTINGS);
tscannerfile = class
public
inputfile : tinputfile; { current inputfile list }
@ -86,6 +88,8 @@ interface
replaysavetoken : ttoken;
replaytokenbuf,
recordtokenbuf : tdynamicarray;
{ last settings we stored }
last_settings : tsettings;
comment_level,
yylexcount : longint;
@ -1824,6 +1828,7 @@ In case not, the value returned can be arbitrary.
if assigned(recordtokenbuf) then
internalerror(200511173);
recordtokenbuf:=buf;
fillchar(last_settings,sizeof(last_settings),0);
end;
@ -1839,6 +1844,15 @@ In case not, the value returned can be arbitrary.
begin
if not assigned(recordtokenbuf) then
internalerror(200511176);
{ settings changed? }
if CompareByte(current_settings,last_settings,sizeof(current_settings))<>0 then
begin
{ use a special token to record it }
recordtokenbuf.write(_GENERICSPECIALTOKEN,1);
recordtokenbuf.write(ST_LOADSETTINGS,1);
recordtokenbuf.write(current_settings,sizeof(current_settings));
last_settings:=current_settings;
end;
recordtokenbuf.write(token,1);
if token=_ID then
recordtokenbuf.write(idtoken,1);
@ -1877,6 +1891,9 @@ In case not, the value returned can be arbitrary.
dec(inputpointer);
{ install buffer }
replaytokenbuf:=buf;
fillchar(last_settings,sizeof(last_settings),0);
{ reload next token }
replaytokenbuf.seek(0);
replaytoken;
@ -1886,6 +1903,7 @@ In case not, the value returned can be arbitrary.
procedure tscannerfile.replaytoken;
var
wlen : sizeint;
specialtoken : tspecialgenerictoken;
begin
if not assigned(replaytokenbuf) then
internalerror(200511177);
@ -1898,35 +1916,51 @@ In case not, the value returned can be arbitrary.
token:=replaysavetoken;
exit;
end;
{ load token from the buffer }
replaytokenbuf.read(token,1);
if token=_ID then
replaytokenbuf.read(idtoken,1);
case token of
_CWCHAR,
_CWSTRING :
begin
replaytokenbuf.read(wlen,sizeof(SizeInt));
setlengthwidestring(patternw,wlen);
replaytokenbuf.read(patternw^.data^,patternw^.len*sizeof(tcompilerwidechar));
pattern:='';
end;
_CCHAR,
_CSTRING,
_INTCONST,
_REALNUMBER :
begin
replaytokenbuf.read(pattern[0],1);
replaytokenbuf.read(pattern[1],length(pattern));
orgpattern:='';
end;
_ID :
begin
replaytokenbuf.read(orgpattern[0],1);
replaytokenbuf.read(orgpattern[1],length(orgpattern));
pattern:=upper(orgpattern);
end;
end;
repeat
{ load token from the buffer }
replaytokenbuf.read(token,1);
if token=_ID then
replaytokenbuf.read(idtoken,1);
case token of
_CWCHAR,
_CWSTRING :
begin
replaytokenbuf.read(wlen,sizeof(SizeInt));
setlengthwidestring(patternw,wlen);
replaytokenbuf.read(patternw^.data^,patternw^.len*sizeof(tcompilerwidechar));
pattern:='';
end;
_CCHAR,
_CSTRING,
_INTCONST,
_REALNUMBER :
begin
replaytokenbuf.read(pattern[0],1);
replaytokenbuf.read(pattern[1],length(pattern));
orgpattern:='';
end;
_ID :
begin
replaytokenbuf.read(orgpattern[0],1);
replaytokenbuf.read(orgpattern[1],length(orgpattern));
pattern:=upper(orgpattern);
end;
_GENERICSPECIALTOKEN:
begin
replaytokenbuf.read(specialtoken,1);
case specialtoken of
ST_LOADSETTINGS:
begin
replaytokenbuf.read(current_settings,sizeof(current_settings));
end
else
internalerror(2006103010);
end;
continue;
end;
end;
break;
until false;
end;

2
compiler/tokens.pas
View File

@ -91,6 +91,7 @@ type
_DIVASN,
_NOTASN,
_XORASN,
_GENERICSPECIALTOKEN,
{ Normal words -- ATTENTION: These words must be sorted: }
{ first in length order, then in alphabetical order. }
_C,
@ -340,6 +341,7 @@ const
(str:'' ;special:true ;keyword:m_none;op:NOTOKEN),
(str:'' ;special:true ;keyword:m_none;op:NOTOKEN),
(str:'' ;special:true ;keyword:m_none;op:NOTOKEN),
(str:'gen. spec.' ;special:true ;keyword:m_none;op:NOTOKEN),
{ Normal words -- ATTENTION: These words must be sorted: }
{ first in length order, then in alphabetical order. }
(str:'C' ;special:false;keyword:m_none;op:NOTOKEN),

7
compiler/utils/Makefile
View File

@ -1,5 +1,5 @@
#
# Don't edit, this file is generated by FPCMake Version 2.0.0 [2006/10/28]
# Don't edit, this file is generated by FPCMake Version 2.0.0 [2006/08/20]
#
default: all
MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd x86_64-win64 arm-linux arm-palmos arm-wince arm-gba powerpc64-linux
@ -1669,7 +1669,7 @@ ifeq ($(CPU_TARGET),powerpc)
FPCCPUOPT:=-O1r
endif
else
FPCCPUOPT:=-O2
FPCCPUOPT:=-O1r
endif
override FPCOPT+=-Ur -Xs $(FPCCPUOPT) -n
override FPCOPTDEF+=RELEASE
@ -2133,11 +2133,12 @@ endif
ppu$(PPUEXT): ppu.pas
ppufiles$(EXEEXT): ppufiles.pp ppu$(PPUEXT)
ppudump$(EXEEXT): ppudump.pp ppu$(PPUEXT)
$(COMPILER) ppudump.pp -Fu../i386 -Fi..
ppumove$(EXEEXT): ppumove.pp ppu$(PPUEXT)
fpcsubst$(EXEEXT): fpcsubst.pp usubst.pp
fpcmkcfg$(EXEEXT): fpcmkcfg.pp usubst.pp fpccfg.inc
ifneq ($(DATA2INC),)
fpccfg.inc: fpc.cft
$(DATA2INC) -b -s fpc.cft fpccfg.inc DefaultConfig
$(DATA2INC) -b -s fpc.cft fpccfg.inc DefaultConfig
endif
unexport PPUFILES PPUMOVE

3
compiler/utils/Makefile.fpc
View File

@ -34,6 +34,7 @@ ppu$(PPUEXT): ppu.pas
ppufiles$(EXEEXT): ppufiles.pp ppu$(PPUEXT)
ppudump$(EXEEXT): ppudump.pp ppu$(PPUEXT)
$(COMPILER) ppudump.pp -Fu../i386 -Fi..
ppumove$(EXEEXT): ppumove.pp ppu$(PPUEXT)
@ -43,7 +44,7 @@ fpcmkcfg$(EXEEXT): fpcmkcfg.pp usubst.pp fpccfg.inc
ifneq ($(DATA2INC),)
fpccfg.inc: fpc.cft
$(DATA2INC) -b -s fpc.cft fpccfg.inc DefaultConfig
$(DATA2INC) -b -s fpc.cft fpccfg.inc DefaultConfig
endif
#

71
compiler/utils/ppudump.pp
View File

@ -24,7 +24,9 @@
program pppdump;
uses
dos,
ppu;
ppu,
globals,
tokens;
const
Version = 'Version 2.1.1';
@ -823,7 +825,7 @@ var
i : longint;
first : boolean;
tokenbufsize : longint;
tokenbuf : pointer;
tokenbuf : pbyte;
defid : longint;
begin
defid:=ppufile.getlongint;
@ -867,6 +869,71 @@ begin
writeln(space,' Tokenbuffer size : ',tokenbufsize);
tokenbuf:=allocmem(tokenbufsize);
ppufile.getdata(tokenbuf^,tokenbufsize);
i:=0;
write(space,' Tokens: ');
while i<tokenbufsize do
begin
write(arraytokeninfo[ttoken(tokenbuf[i])].str);
case ttoken(tokenbuf[i]) of
_CWCHAR,
_CWSTRING :
begin
inc(i);
{
replaytokenbuf.read(wlen,sizeof(SizeInt));
setlengthwidestring(patternw,wlen);
replaytokenbuf.read(patternw^.data^,patternw^.len*sizeof(tcompilerwidechar));
pattern:='';
}
end;
_CCHAR,
_CSTRING,
_INTCONST,
_REALNUMBER :
begin
inc(i);
{
replaytokenbuf.read(pattern[0],1);
replaytokenbuf.read(pattern[1],length(pattern));
orgpattern:='';
}
end;
_ID :
begin
inc(i);
{
replaytokenbuf.read(orgpattern[0],1);
replaytokenbuf.read(orgpattern[1],length(orgpattern));
pattern:=upper(orgpattern);
}
end;
_GENERICSPECIALTOKEN:
begin
inc(i);
inc(i);
inc(i,sizeof(tsettings));
{
replaytokenbuf.read(specialtoken,1);
case specialtoken of
ST_LOADSETTINGS:
begin
replaytokenbuf.read(current_settings,sizeof(current_settings));
end
else
internalerror(2006103010);
end;
continue;
}
end;
else
inc(i);
end;
if i<tokenbufsize then
write(',');
end;
writeln;
freemem(tokenbuf);
end;
if df_specialization in defoptions then

18
tests/test/tgeneric7.pp Normal file
View File

@ -0,0 +1,18 @@
{ %result=201 }
{ checks proper saving of compiler state }
{$mode objfpc}
{$R-}
uses
tugeneric7;
type
tmytype = specialize tgeneric<byte>;
var
s : tmytype;
begin
s:=tmytype.create;
s.test;
s.free;
end.

27
tests/test/tugeneric7.pp Normal file
View File

@ -0,0 +1,27 @@
{$mode objfpc}
unit tugeneric7;
interface
type
generic tgeneric<t> = class
field : t;
procedure test;
end;
implementation
{$R-}
procedure tgeneric.test;
var
l : longint;
begin
l:=1234;
{$R+}
field:=l;
{$R-}
writeln(byte(field));
end;
{$R+}
end.