paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-31 20:30:26 +02:00
Code Issues Packages Projects Releases Wiki Activity

* read only typed const support, switch $J-

Browse Source
This commit is contained in:
peter 2001-10-20 20:30:20 +00:00
parent 17d6dded66
commit 7781fca6bd
8 changed files with 72 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
compiler/globals.pas
View File

@ -1361,7 +1361,7 @@ implementation
{ Init values }
initmodeswitches:=fpcmodeswitches;
initlocalswitches:=[cs_check_io];
initlocalswitches:=[cs_check_io,cs_typed_const_writable];
initmoduleswitches:=[cs_extsyntax,cs_browser];
initglobalswitches:=[cs_check_unit_name,cs_link_static];
initoutputformat:=target_asm.id;
@ -1411,7 +1411,10 @@ begin
end.
{
$Log$
Revision 1.45 2001-10-16 15:10:34 jonas
Revision 1.46 2001-10-20 20:30:20 peter
* read only typed const support, switch $J-
Revision 1.45 2001/10/16 15:10:34 jonas
* fixed goto/label/try bugs
Revision 1.44 2001/10/12 16:06:17 peter

9
compiler/globtype.pas
View File

@ -75,7 +75,7 @@ interface
cs_check_overflow,cs_check_range,cs_check_object_ext,
cs_check_io,cs_check_stack,
cs_omitstackframe,cs_do_assertion,cs_generate_rtti,
cs_full_boolean_eval,
cs_full_boolean_eval,cs_typed_const_writable,
{ mmx }
cs_mmx,cs_mmx_saturation,
{ parser }
@ -90,7 +90,6 @@ interface
{ support }
cs_support_inline,cs_support_goto,cs_support_macro,
cs_support_c_operators,cs_static_keyword,
cs_typed_const_not_changeable,
{ generation }
cs_profile,cs_debuginfo,cs_browser,cs_local_browser,cs_compilesystem,
cs_lineinfo,
@ -186,6 +185,7 @@ interface
{$ifndef Delphi}
{$ifndef xFPC}
type
pguid = ^tguid;
tguid = packed record
D1: LongWord;
D2: Word;
@ -208,7 +208,10 @@ implementation
end.
{
$Log$
Revision 1.15 2001-09-17 21:29:11 peter
Revision 1.16 2001-10-20 20:30:21 peter
* read only typed const support, switch $J-
Revision 1.15 2001/09/17 21:29:11 peter
* merged netbsd, fpu-overflow from fixes branch
Revision 1.14 2001/07/30 20:59:27 peter

16
compiler/htypechk.pas
View File

@ -904,12 +904,19 @@ implementation
exit;
end;
end;
funcretsym,
typedconstsym :
funcretsym :
begin
valid_for_assign:=true;
exit;
end;
typedconstsym :
begin
if ttypedconstsym(tloadnode(hp).symtableentry).is_writable then
valid_for_assign:=true
else
CGMessagePos(hp.fileinfo,type_e_no_assign_to_const);
exit;
end;
end;
end;
else
@ -967,7 +974,10 @@ implementation
end.
{
$Log$
Revision 1.36 2001-10-12 13:51:51 jonas
Revision 1.37 2001-10-20 20:30:21 peter
* read only typed const support, switch $J-
Revision 1.36 2001/10/12 13:51:51 jonas
* fixed internalerror(10) due to previous fpu overflow fixes ("merged")
* fixed bug in n386add (introduced after compilerproc changes for string
operations) where calcregisters wasn't called for shortstring addnodes

26
compiler/pdecl.pas
View File

@ -189,19 +189,7 @@ implementation
{ create symbol }
storetokenpos:=akttokenpos;
akttokenpos:=filepos;
{$ifdef DELPHI_CONST_IN_RODATA}
if m_delphi in aktmodeswitches then
begin
if assigned(readtypesym) then
sym:=ttypedconstsym.createsym(orgname,readtypesym,true)
else
sym:=ttypedconstsym.create(orgname,def,true)
end
else
{$endif DELPHI_CONST_IN_RODATA}
begin
sym:=ttypedconstsym.createtype(orgname,tt,false)
end;
sym:=ttypedconstsym.createtype(orgname,tt,(cs_typed_const_writable in aktlocalswitches));
akttokenpos:=storetokenpos;
symtablestack.insert(sym);
{ procvar can have proc directives }
@ -230,12 +218,7 @@ implementation
begin
{ get init value }
consume(_EQUAL);
{$ifdef DELPHI_CONST_IN_RODATA}
if m_delphi in aktmodeswitches then
readtypedconst(tt,ttypedconstsym(sym),true)
else
{$endif DELPHI_CONST_IN_RODATA}
readtypedconst(tt,ttypedconstsym(sym),false);
readtypedconst(tt,ttypedconstsym(sym),(cs_typed_const_writable in aktlocalswitches));
try_consume_hintdirective(sym.symoptions);
consume(_SEMICOLON);
end;
@ -610,7 +593,10 @@ implementation
end.
{
$Log$
Revision 1.36 2001-10-20 19:28:39 peter
Revision 1.37 2001-10-20 20:30:21 peter
* read only typed const support, switch $J-
Revision 1.36 2001/10/20 19:28:39 peter
* interface 2 guid support
* guid constants support

23
compiler/ptconst.pas
View File

@ -31,7 +31,7 @@ interface
{ this procedure reads typed constants }
{ sym is only needed for ansi strings }
{ the assembler label is in the middle (PM) }
procedure readtypedconst(const t:ttype;sym : ttypedconstsym;no_change_allowed : boolean);
procedure readtypedconst(const t:ttype;sym : ttypedconstsym;writable : boolean);
implementation
@ -57,7 +57,7 @@ implementation
{$maxfpuregisters 0}
{$endif fpc}
{ this procedure reads typed constants }
procedure readtypedconst(const t:ttype;sym : ttypedconstsym;no_change_allowed : boolean);
procedure readtypedconst(const t:ttype;sym : ttypedconstsym;writable : boolean);
var
len,base : longint;
@ -95,10 +95,10 @@ implementation
{$R-} {Range check creates problem with init_8bit(-1) !!}
begin
if no_change_allowed then
curconstsegment:=consts
if writable then
curconstsegment:=datasegment
else
curconstsegment:=datasegment;
curconstsegment:=consts;
case t.def.deftype of
orddef:
begin
@ -597,10 +597,10 @@ implementation
consume(_LKLAMMER);
for l:=tarraydef(t.def).lowrange to tarraydef(t.def).highrange-1 do
begin
readtypedconst(tarraydef(t.def).elementtype,nil,no_change_allowed);
readtypedconst(tarraydef(t.def).elementtype,nil,writable);
consume(_COMMA);
end;
readtypedconst(tarraydef(t.def).elementtype,nil,no_change_allowed);
readtypedconst(tarraydef(t.def).elementtype,nil,writable);
consume(_RKLAMMER);
end
else
@ -805,7 +805,7 @@ implementation
aktpos:=tvarsym(srsym).address+tvarsym(srsym).vartype.def.size;
{ read the data }
readtypedconst(tvarsym(srsym).vartype,nil,no_change_allowed);
readtypedconst(tvarsym(srsym).vartype,nil,writable);
{ keep previous field for checking whether whole }
{ record was initialized (JM) }
@ -910,7 +910,7 @@ implementation
aktpos:=tvarsym(srsym).address+tvarsym(srsym).vartype.def.size;
{ read the data }
readtypedconst(tvarsym(srsym).vartype,nil,no_change_allowed);
readtypedconst(tvarsym(srsym).vartype,nil,writable);
if token=_SEMICOLON then
consume(_SEMICOLON)
@ -950,7 +950,10 @@ implementation
end.
{
$Log$
Revision 1.35 2001-10-20 17:24:26 peter
Revision 1.36 2001-10-20 20:30:21 peter
* read only typed const support, switch $J-
Revision 1.35 2001/10/20 17:24:26 peter
* make all sets equal when reading an array of sets. Before it could
mix normal and small sets in the same array!

7
compiler/switches.pas
View File

@ -56,7 +56,7 @@ const
{G} (typesw:ignoredsw; setsw:ord(cs_localnone)),
{H} (typesw:localsw; setsw:ord(cs_ansistrings)),
{I} (typesw:localsw; setsw:ord(cs_check_io)),
{J} (typesw:unsupportedsw; setsw:ord(cs_typed_const_not_changeable)),
{J} (typesw:localsw; setsw:ord(cs_typed_const_writable)),
{K} (typesw:unsupportedsw; setsw:ord(cs_localnone)),
{L} (typesw:modulesw; setsw:ord(cs_local_browser)),
{M} (typesw:localsw; setsw:ord(cs_generate_rtti)),
@ -177,7 +177,10 @@ end;
end.
{
$Log$
Revision 1.7 2001-05-18 22:56:05 peter
Revision 1.8 2001-10-20 20:30:21 peter
* read only typed const support, switch $J-
Revision 1.7 2001/05/18 22:56:05 peter
* $E is moduleswitch (merged)
Revision 1.6 2000/12/25 00:07:29 peter

7
compiler/symconst.pas
View File

@ -401,7 +401,7 @@ type
tconsttyp = (constnone,
constord,conststring,constreal,constbool,
constint,constchar,constset,constpointer,constnil,
constresourcestring,constwstring,constwchar
constresourcestring,constwstring,constwchar,constguid
);
{ RTTI information to store }
@ -453,7 +453,10 @@ implementation
end.
{
$Log$
Revision 1.23 2001-08-30 20:13:54 peter
Revision 1.24 2001-10-20 20:30:21 peter
* read only typed const support, switch $J-
Revision 1.23 2001/08/30 20:13:54 peter
* rtti/init table updates
* rttisym for reusable global rtti/init info
* support published for interfaces

32
compiler/symsym.pas
View File

@ -229,9 +229,9 @@ interface
ttypedconstsym = class(tstoredsym)
prefix : pstring;
typedconsttype : ttype;
is_really_const : boolean;
constructor create(const n : string;p : tdef;really_const : boolean);
constructor createtype(const n : string;const tt : ttype;really_const : boolean);
is_writable : boolean;
constructor create(const n : string;p : tdef;writable : boolean);
constructor createtype(const n : string;const tt : ttype;writable : boolean);
constructor load(ppufile:tcompilerppufile);
destructor destroy;override;
function mangledname : string;override;
@ -1675,20 +1675,23 @@ implementation
TTYPEDCONSTSYM
*****************************************************************************}
constructor ttypedconstsym.create(const n : string;p : tdef;really_const : boolean);
constructor ttypedconstsym.create(const n : string;p : tdef;writable : boolean);
begin
inherited create(n);
typ:=typedconstsym;
typedconsttype.setdef(p);
is_really_const:=really_const;
is_writable:=writable;
prefix:=stringdup(procprefix);
end;
constructor ttypedconstsym.createtype(const n : string;const tt : ttype;really_const : boolean);
constructor ttypedconstsym.createtype(const n : string;const tt : ttype;writable : boolean);
begin
ttypedconstsym(self).create(n,nil,really_const);
inherited create(n);
typ:=typedconstsym;
typedconsttype:=tt;
is_writable:=writable;
prefix:=stringdup(procprefix);
end;
@ -1698,7 +1701,7 @@ implementation
typ:=typedconstsym;
ppufile.gettype(typedconsttype);
prefix:=stringdup(ppufile.getstring);
is_really_const:=boolean(ppufile.getbyte);
is_writable:=boolean(ppufile.getbyte);
end;
@ -1735,7 +1738,7 @@ implementation
inherited writesym(ppufile);
ppufile.puttype(typedconsttype);
ppufile.putstring(prefix^);
ppufile.putbyte(byte(is_really_const));
ppufile.putbyte(byte(is_writable));
ppufile.writeentry(ibtypedconstsym);
end;
@ -1748,10 +1751,10 @@ implementation
begin
storefilepos:=aktfilepos;
aktfilepos:=akttokenpos;
if is_really_const then
curconstsegment:=consts
if is_writable then
curconstsegment:=datasegment
else
curconstsegment:=datasegment;
curconstsegment:=consts;
l:=getsize;
varalign:=size_2_align(l);
varalign:=used_align(varalign,aktalignment.constalignmin,aktalignment.constalignmax);
@ -2484,7 +2487,10 @@ implementation
end.
{
$Log$
Revision 1.22 2001-09-19 11:04:42 michael
Revision 1.23 2001-10-20 20:30:21 peter
* read only typed const support, switch $J-
Revision 1.22 2001/09/19 11:04:42 michael
* Smartlinking with interfaces fixed
* Better smartlinking for rtti and init tables