paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-06-03 15:39:26 +02:00
Code Issues Packages Projects Releases Wiki Activity

* realname updated for some hints

Browse Source 
* realname used for consts,labels
This commit is contained in:
michael 2001-09-19 11:06:03 +00:00
parent d75c4d6486
commit 387ad2c42e
3 changed files with 49 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

58
compiler/pdecl.pas
View File

@ -34,7 +34,7 @@ interface
{ pass_1 }
node;
function readconstant(const name:string;const filepos:tfileposinfo):tconstsym;
function readconstant(const orgname:string;const filepos:tfileposinfo):tconstsym;
procedure const_dec;
procedure label_dec;
@ -62,7 +62,7 @@ implementation
pbase,pexpr,ptype,ptconst,pdecsub,pdecvar,pdecobj;
function readconstant(const name:string;const filepos:tfileposinfo):tconstsym;
function readconstant(const orgname:string;const filepos:tfileposinfo):tconstsym;
var
hp : tconstsym;
p : tnode;
@ -72,7 +72,7 @@ implementation
storetokenpos : tfileposinfo;
begin
readconstant:=nil;
if name='' then
if orgname='' then
internalerror(9584582);
hp:=nil;
p:=comp_expr(true);
@ -82,44 +82,44 @@ implementation
ordconstn:
begin
if is_constintnode(p) then
hp:=tconstsym.create_ord_typed(name,constint,tordconstnode(p).value,tordconstnode(p).resulttype)
hp:=tconstsym.create_ord_typed(orgname,constint,tordconstnode(p).value,tordconstnode(p).resulttype)
else if is_constcharnode(p) then
hp:=tconstsym.create_ord(name,constchar,tordconstnode(p).value)
hp:=tconstsym.create_ord(orgname,constchar,tordconstnode(p).value)
else if is_constboolnode(p) then
hp:=tconstsym.create_ord(name,constbool,tordconstnode(p).value)
hp:=tconstsym.create_ord(orgname,constbool,tordconstnode(p).value)
else if is_constwidecharnode(p) then
hp:=tconstsym.create_ord(name,constwchar,tordconstnode(p).value)
hp:=tconstsym.create_ord(orgname,constwchar,tordconstnode(p).value)
else if p.resulttype.def.deftype=enumdef then
hp:=tconstsym.create_ord_typed(name,constord,tordconstnode(p).value,p.resulttype)
hp:=tconstsym.create_ord_typed(orgname,constord,tordconstnode(p).value,p.resulttype)
else if p.resulttype.def.deftype=pointerdef then
hp:=tconstsym.create_ordptr_typed(name,constpointer,tordconstnode(p).value,p.resulttype)
hp:=tconstsym.create_ordptr_typed(orgname,constpointer,tordconstnode(p).value,p.resulttype)
else internalerror(111);
end;
stringconstn:
begin
getmem(sp,tstringconstnode(p).len+1);
move(tstringconstnode(p).value_str^,sp^,tstringconstnode(p).len+1);
hp:=tconstsym.create_string(name,conststring,sp,tstringconstnode(p).len);
hp:=tconstsym.create_string(orgname,conststring,sp,tstringconstnode(p).len);
end;
realconstn :
begin
new(pd);
pd^:=trealconstnode(p).value_real;
hp:=tconstsym.create_ptr(name,constreal,pd);
hp:=tconstsym.create_ptr(orgname,constreal,pd);
end;
setconstn :
begin
new(ps);
ps^:=tsetconstnode(p).value_set^;
hp:=tconstsym.create_ptr_typed(name,constset,ps,p.resulttype);
hp:=tconstsym.create_ptr_typed(orgname,constset,ps,p.resulttype);
end;
pointerconstn :
begin
hp:=tconstsym.create_ordptr_typed(name,constpointer,tpointerconstnode(p).value,p.resulttype);
hp:=tconstsym.create_ordptr_typed(orgname,constpointer,tpointerconstnode(p).value,p.resulttype);
end;
niln :
begin
hp:=tconstsym.create_ord_typed(name,constnil,0,p.resulttype);
hp:=tconstsym.create_ord_typed(orgname,constnil,0,p.resulttype);
end;
else
Message(cg_e_illegal_expression);
@ -132,7 +132,7 @@ implementation
procedure const_dec;
var
name : stringid;
orgname : stringid;
tt : ttype;
sym : tsym;
storetokenpos,filepos : tfileposinfo;
@ -143,7 +143,7 @@ implementation
old_block_type:=block_type;
block_type:=bt_const;
repeat
name:=pattern;
orgname:=orgpattern;
filepos:=akttokenpos;
consume(_ID);
case token of
@ -151,7 +151,7 @@ implementation
_EQUAL:
begin
consume(_EQUAL);
sym:=readconstant(name,filepos);
sym:=readconstant(orgname,filepos);
if assigned(sym) then
symtablestack.insert(sym);
try_consume_hintdirective(sym.symoptions);
@ -176,14 +176,14 @@ implementation
if m_delphi in aktmodeswitches then
begin
if assigned(readtypesym) then
sym:=ttypedconstsym.createsym(name,readtypesym,true)
sym:=ttypedconstsym.createsym(orgname,readtypesym,true)
else
sym:=ttypedconstsym.create(name,def,true)
sym:=ttypedconstsym.create(orgname,def,true)
end
else
{$endif DELPHI_CONST_IN_RODATA}
begin
sym:=ttypedconstsym.createtype(name,tt,false)
sym:=ttypedconstsym.createtype(orgname,tt,false)
end;
akttokenpos:=storetokenpos;
symtablestack.insert(sym);
@ -253,7 +253,7 @@ implementation
end
else
getlabel(hl);
symtablestack.insert(tlabelsym.create(pattern,hl));
symtablestack.insert(tlabelsym.create(orgpattern,hl));
consume(token);
end;
if token<>_SEMICOLON then consume(_COMMA);
@ -497,8 +497,6 @@ implementation
if (tt.def.deftype=objectdef) and
not(oo_is_forward in tobjectdef(tt.def).objectoptions) then
begin
if (cs_create_smart in aktmoduleswitches) then
dataSegment.concat(Tai_cut.Create);
ch:=cclassheader.create(tobjectdef(tt.def));
if is_interface(tobjectdef(tt.def)) then
ch.writeinterfaceids;
@ -538,7 +536,7 @@ implementation
procedure resourcestring_dec;
var
name : stringid;
orgname : stringid;
p : tnode;
storetokenpos,filepos : tfileposinfo;
old_block_type : tblock_type;
@ -550,7 +548,7 @@ implementation
old_block_type:=block_type;
block_type:=bt_const;
repeat
name:=pattern;
orgname:=orgpattern;
filepos:=akttokenpos;
consume(_ID);
case token of
@ -568,7 +566,7 @@ implementation
getmem(sp,2);
sp[0]:=chr(tordconstnode(p).value);
sp[1]:=#0;
symtablestack.insert(tconstsym.create_string(name,constresourcestring,sp,1));
symtablestack.insert(tconstsym.create_string(orgname,constresourcestring,sp,1));
end
else
Message(cg_e_illegal_expression);
@ -577,7 +575,7 @@ implementation
begin
getmem(sp,tstringconstnode(p).len+1);
move(tstringconstnode(p).value_str^,sp^,tstringconstnode(p).len+1);
symtablestack.insert(tconstsym.create_string(name,constresourcestring,sp,tstringconstnode(p).len));
symtablestack.insert(tconstsym.create_string(orgname,constresourcestring,sp,tstringconstnode(p).len));
end;
else
Message(cg_e_illegal_expression);
@ -595,7 +593,11 @@ implementation
end.
{
$Log$
Revision 1.33 2001-09-02 21:18:28 peter
Revision 1.34 2001-09-19 11:06:03 michael
* realname updated for some hints
* realname used for consts,labels
Revision 1.33 2001/09/02 21:18:28 peter
* split constsym.value in valueord,valueordptr,valueptr. The valueordptr
is used for holding target platform pointer values. As those can be
bigger than the source platform.

16
compiler/ptconst.pas
View File

@ -67,7 +67,7 @@ implementation
strlength : longint;
curconstsegment : TAAsmoutput;
ll : tasmlabel;
s : string;
s,sorg : string;
c : char;
ca : pchar;
tmpguid : tguid;
@ -741,6 +741,7 @@ implementation
while token<>_RKLAMMER do
begin
s:=pattern;
sorg:=orgpattern;
consume(_ID);
consume(_COLON);
error := false;
@ -777,13 +778,13 @@ implementation
{ Delphi allows you to skip fields }
else if (m_delphi in aktmodeswitches) then
begin
Message1(parser_w_skipped_fields_before,s);
Message1(parser_w_skipped_fields_before,sorg);
srsym := recsym;
end
{ FPC and TP don't }
else
begin
Message1(parser_e_skipped_fields_before,s);
Message1(parser_e_skipped_fields_before,sorg);
error := true;
end;
end;
@ -857,6 +858,7 @@ implementation
while token<>_RKLAMMER do
begin
s:=pattern;
sorg:=orgpattern;
consume(_ID);
consume(_COLON);
srsym:=nil;
@ -875,7 +877,7 @@ implementation
if srsym=nil then
begin
Message1(sym_e_id_not_found,s);
Message1(sym_e_id_not_found,sorg);
consume_all_until(_SEMICOLON);
end
else
@ -945,7 +947,11 @@ implementation
end.
{
$Log$
Revision 1.33 2001-09-17 21:29:12 peter
Revision 1.34 2001-09-19 11:06:03 michael
* realname updated for some hints
* realname used for consts,labels
Revision 1.33 2001/09/17 21:29:12 peter
* merged netbsd, fpu-overflow from fixes branch
Revision 1.32 2001/09/02 21:18:28 peter

12
compiler/symtable.pas
View File

@ -735,7 +735,7 @@ implementation
MessagePos1(tsym(p).fileinfo,sym_h_para_identifier_not_used,tsym(p).realname);
end
else if (tsym(p).owner.symtabletype=objectsymtable) then
MessagePos2(tsym(p).fileinfo,sym_n_private_identifier_not_used,tsym(p).owner.name^,tsym(p).realname)
MessagePos2(tsym(p).fileinfo,sym_n_private_identifier_not_used,tsym(p).owner.realname^,tsym(p).realname)
else
MessagePos1(tsym(p).fileinfo,sym_n_local_identifier_not_used,tsym(p).realname);
end
@ -752,7 +752,7 @@ implementation
MessagePos1(tsym(p).fileinfo,sym_h_para_identifier_only_set,tsym(p).realname);
end
else if (tsym(p).owner.symtabletype=objectsymtable) then
MessagePos2(tsym(p).fileinfo,sym_n_private_identifier_only_set,tsym(p).owner.name^,tsym(p).realname)
MessagePos2(tsym(p).fileinfo,sym_n_private_identifier_only_set,tsym(p).owner.realname^,tsym(p).realname)
else if (tsym(p).owner.symtabletype<>parasymtable) then
if not (vo_is_exported in tvarsym(p).varoptions) then
MessagePos1(tsym(p).fileinfo,sym_n_local_identifier_only_set,tsym(p).realname);
@ -765,7 +765,7 @@ implementation
exit;
{ do not claim for inherited private fields !! }
if (tstoredsym(p).refs=0) and (tsym(p).owner.symtabletype=objectsymtable) then
MessagePos2(tsym(p).fileinfo,sym_n_private_method_not_used,tsym(p).owner.name^,tsym(p).realname)
MessagePos2(tsym(p).fileinfo,sym_n_private_method_not_used,tsym(p).owner.realname^,tsym(p).realname)
{ units references are problematic }
else if (tstoredsym(p).refs=0) and not(tsym(p).typ in [funcretsym,enumsym,unitsym]) then
if (tsym(p).typ<>procsym) or not (tprocsym(p).is_global) or
@ -2103,7 +2103,11 @@ implementation
end.
{
$Log$
Revision 1.44 2001-09-04 11:38:55 jonas
Revision 1.45 2001-09-19 11:06:03 michael
* realname updated for some hints
* realname used for consts,labels
Revision 1.44 2001/09/04 11:38:55 jonas
+ searchsystype() and searchsystype() functions in symtable
* changed ninl and nadd to use these functions
* i386 set comparison functions now return their results in al instead