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

* better browser info

Browse Source
This commit is contained in:
pierre 1999-11-09 23:43:08 +00:00
parent d766ee87fc
commit 142ace2afc
3 changed files with 46 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
compiler/pdecl.pas
View File

@ -892,6 +892,7 @@ unit pdecl;
procedure resolve_type_forward(p : pnamedindexobject);{$ifndef FPC}far;{$endif} procedure resolve_type_forward(p : pnamedindexobject);{$ifndef FPC}far;{$endif}
var var
hpd,pd : pdef; hpd,pd : pdef;
stpos : tfileposinfo;
begin begin
{ Check only typesyms or record/object fields } { Check only typesyms or record/object fields }
case psym(p)^.typ of case psym(p)^.typ of
@ -915,7 +916,13 @@ unit pdecl;
if hpd^.deftype=forwarddef then if hpd^.deftype=forwarddef then
begin begin
{ try to resolve the forward } { try to resolve the forward }
{ get the correct position for it }
stpos:=tokenpos;
tokenpos:=pforwarddef(hpd)^.forwardpos;
resolving_forward:=true;
getsym(pforwarddef(hpd)^.tosymname,false); getsym(pforwarddef(hpd)^.tosymname,false);
resolving_forward:=false;
tokenpos:=stpos;
{ we don't need the forwarddef anymore, dispose it } { we don't need the forwarddef anymore, dispose it }
dispose(hpd,done); dispose(hpd,done);
{ was a type sym found ? } { was a type sym found ? }
@ -962,6 +969,8 @@ unit pdecl;
typename : stringid; typename : stringid;
newtype : ptypesym; newtype : ptypesym;
sym : psym; sym : psym;
typedef : pdef;
defpos,storetokenpos : tfileposinfo;
old_block_type : tblock_type; old_block_type : tblock_type;
begin begin
old_block_type:=block_type; old_block_type:=block_type;
@ -970,6 +979,7 @@ unit pdecl;
typecanbeforward:=true; typecanbeforward:=true;
repeat repeat
typename:=pattern; typename:=pattern;
defpos:=tokenpos;
consume(_ID); consume(_ID);
consume(_EQUAL); consume(_EQUAL);
{ support 'ttype=type word' syntax } { support 'ttype=type word' syntax }
@ -1000,8 +1010,12 @@ unit pdecl;
{ no old type reused ? Then insert this new type } { no old type reused ? Then insert this new type }
if not assigned(newtype) then if not assigned(newtype) then
begin begin
newtype:=new(ptypesym,init(typename,read_type(typename))); typedef:=read_type(typename);
storetokenpos:=tokenpos;
tokenpos:=defpos;
newtype:=new(ptypesym,init(typename,typedef));
newtype:=ptypesym(symtablestack^.insert(newtype)); newtype:=ptypesym(symtablestack^.insert(newtype));
tokenpos:=storetokenpos;
end; end;
consume(_SEMICOLON); consume(_SEMICOLON);
if assigned(newtype^.definition) and if assigned(newtype^.definition) and
@ -1015,7 +1029,7 @@ unit pdecl;
procedure var_dec; procedure var_dec;
{ parses varaible declarations and inserts them in } { parses variable declarations and inserts them in }
{ the top symbol table of symtablestack } { the top symbol table of symtablestack }
begin begin
consume(_VAR); consume(_VAR);
@ -1186,7 +1200,10 @@ unit pdecl;
end. end.
{ {
$Log$ $Log$
Revision 1.170 1999-11-09 23:06:45 peter Revision 1.171 1999-11-09 23:43:08 pierre
* better browser info
Revision 1.170 1999/11/09 23:06:45 peter
* esi_offset -> selfpointer_offset to be newcg compatible * esi_offset -> selfpointer_offset to be newcg compatible
* hcogegen -> cgbase fixes for newcg * hcogegen -> cgbase fixes for newcg

22
compiler/psub.pas
View File

@ -104,8 +104,9 @@ var sp:stringid;
begin begin
{ Save the position where this procedure really starts and set col to 1 which { Save the position where this procedure really starts and set col to 1 which
looks nicer } looks nicer }
procstartfilepos:=aktfilepos; procstartfilepos:=tokenpos;
procstartfilepos.column:=1; { procstartfilepos.column:=1; I do not agree here !!
lets keep excat position PM }
if (options=potype_operator) then if (options=potype_operator) then
begin begin
@ -122,11 +123,13 @@ begin
{ method ? } { method ? }
if not(parse_only) and try_to_consume(_POINT) then if not(parse_only) and try_to_consume(_POINT) then
begin begin
tokenpos:=procstartfilepos;
getsym(sp,true); getsym(sp,true);
sym:=srsym; sym:=srsym;
{ load proc name } { load proc name }
sp:=pattern; sp:=pattern;
realname:=orgpattern; realname:=orgpattern;
procstartfilepos:=tokenpos;
{ qualifier is class name ? } { qualifier is class name ? }
if (sym^.typ<>typesym) or if (sym^.typ<>typesym) or
(ptypesym(sym)^.definition^.deftype<>objectdef) then (ptypesym(sym)^.definition^.deftype<>objectdef) then
@ -139,9 +142,9 @@ begin
begin begin
{ used to allow private syms to be seen } { used to allow private syms to be seen }
aktobjectdef:=pobjectdef(ptypesym(sym)^.definition); aktobjectdef:=pobjectdef(ptypesym(sym)^.definition);
consume(_ID);
procinfo^._class:=pobjectdef(ptypesym(sym)^.definition); procinfo^._class:=pobjectdef(ptypesym(sym)^.definition);
aktprocsym:=pprocsym(procinfo^._class^.symtable^.search(sp)); aktprocsym:=pprocsym(procinfo^._class^.symtable^.search(sp));
consume(_ID);
{The procedure has been found. So it is {The procedure has been found. So it is
a global one. Set the flags to mark this.} a global one. Set the flags to mark this.}
procinfo^.flags:=procinfo^.flags or pi_is_global; procinfo^.flags:=procinfo^.flags or pi_is_global;
@ -158,6 +161,7 @@ begin
(options in [potype_constructor,potype_destructor]) then (options in [potype_constructor,potype_destructor]) then
Message(parser_e_constructors_always_objects); Message(parser_e_constructors_always_objects);
tokenpos:=procstartfilepos;
aktprocsym:=pprocsym(symtablestack^.search(sp)); aktprocsym:=pprocsym(symtablestack^.search(sp));
if not(parse_only) then if not(parse_only) then
@ -229,6 +233,7 @@ begin
begin begin
DuplicateSym(aktprocsym); DuplicateSym(aktprocsym);
{ try to recover by creating a new aktprocsym } { try to recover by creating a new aktprocsym }
tokenpos:=procstartfilepos;
aktprocsym:=new(pprocsym,init(sp)); aktprocsym:=new(pprocsym,init(sp));
end end
else else
@ -244,6 +249,7 @@ begin
begin begin
Message1(parser_e_overloaded_no_procedure,aktprocsym^.name); Message1(parser_e_overloaded_no_procedure,aktprocsym^.name);
{ try to recover by creating a new aktprocsym } { try to recover by creating a new aktprocsym }
tokenpos:=procstartfilepos;
aktprocsym:=new(pprocsym,init(sp)); aktprocsym:=new(pprocsym,init(sp));
end; end;
end; end;
@ -251,6 +257,7 @@ begin
else else
begin begin
{ create a new procsym and set the real filepos } { create a new procsym and set the real filepos }
tokenpos:=procstartfilepos;
aktprocsym:=new(pprocsym,init(sp)); aktprocsym:=new(pprocsym,init(sp));
{ for operator we have only one definition for each overloaded { for operator we have only one definition for each overloaded
operation } operation }
@ -314,13 +321,11 @@ begin
pd^.nextoverloaded:=aktprocsym^.definition; pd^.nextoverloaded:=aktprocsym^.definition;
aktprocsym^.definition:=pd; aktprocsym^.definition:=pd;
{ this is probably obsolete now PM }
aktprocsym^.definition^.fileinfo:=procstartfilepos; aktprocsym^.definition^.fileinfo:=procstartfilepos;
aktprocsym^.definition^.setmangledname(hs); aktprocsym^.definition^.setmangledname(hs);
aktprocsym^.definition^.procsym:=aktprocsym; aktprocsym^.definition^.procsym:=aktprocsym;
{ update also the current filepos for aktprocsym }
aktprocsym^.fileinfo:=procstartfilepos;
if not parse_only then if not parse_only then
begin begin
overloaded_level:=0; overloaded_level:=0;
@ -1902,7 +1907,10 @@ end.
{ {
$Log$ $Log$
Revision 1.32 1999-11-09 23:06:45 peter Revision 1.33 1999-11-09 23:43:08 pierre
* better browser info
Revision 1.32 1999/11/09 23:06:45 peter
* esi_offset -> selfpointer_offset to be newcg compatible * esi_offset -> selfpointer_offset to be newcg compatible
* hcogegen -> cgbase fixes for newcg * hcogegen -> cgbase fixes for newcg

14
compiler/ptype.pas
View File

@ -121,29 +121,34 @@ uses
{ the type to allow name mangling } { the type to allow name mangling }
var var
is_unit_specific : boolean; is_unit_specific : boolean;
pos : tfileposinfo;
begin begin
s:=pattern; s:=pattern;
consume(_ID); pos:=tokenpos;
{ classes can be used also in classes } { classes can be used also in classes }
if (curobjectname=pattern) and aktobjectdef^.is_class then if (curobjectname=pattern) and aktobjectdef^.is_class then
begin begin
id_type:=aktobjectdef; id_type:=aktobjectdef;
consume(_ID);
exit; exit;
end; end;
{ objects can be parameters } { objects can be parameters }
if (testcurobject=2) and (curobjectname=pattern) then if (testcurobject=2) and (curobjectname=pattern) then
begin begin
id_type:=aktobjectdef; id_type:=aktobjectdef;
consume(_ID);
exit; exit;
end; end;
{ try to load the symbol to see if it's a unitsym } { try to load the symbol to see if it's a unitsym }
is_unit_specific:=false; is_unit_specific:=false;
getsym(s,false); getsym(s,false);
consume(_ID);
if assigned(srsym) and if assigned(srsym) and
(srsym^.typ=unitsym) then (srsym^.typ=unitsym) then
begin begin
consume(_POINT); consume(_POINT);
getsymonlyin(punitsym(srsym)^.unitsymtable,pattern); getsymonlyin(punitsym(srsym)^.unitsymtable,pattern);
pos:=tokenpos;
s:=pattern; s:=pattern;
consume(_ID); consume(_ID);
is_unit_specific:=true; is_unit_specific:=true;
@ -152,7 +157,7 @@ uses
if isforwarddef and if isforwarddef and
not(is_unit_specific) then not(is_unit_specific) then
begin begin
id_type:=new(pforwarddef,init(s)); id_type:=new(pforwarddef,init(s,pos));
exit; exit;
end; end;
{ unknown sym ? } { unknown sym ? }
@ -1598,7 +1603,10 @@ uses
end. end.
{ {
$Log$ $Log$
Revision 1.7 1999-11-08 14:02:16 florian Revision 1.8 1999-11-09 23:43:09 pierre
* better browser info
Revision 1.7 1999/11/08 14:02:16 florian
* problem with "index X"-properties solved * problem with "index X"-properties solved
* typed constants of class references are now allowed * typed constants of class references are now allowed