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

* trying to resurrect Browser

Browse Source 
git-svn-id: trunk@6016 -
This commit is contained in:
pierre 2007-01-17 05:43:22 +00:00
parent 57d944bbfe
commit 71c5820780
1 changed files with 190 additions and 51 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

241
compiler/browcol.pas
View File

@ -26,6 +26,7 @@
unit browcol; unit browcol;
{$i fpcdefs.inc} {$i fpcdefs.inc}
{ $define use_refs}
{$H-} {$H-}
interface interface
@ -88,6 +89,8 @@ type
TSymbol = object(TObject) TSymbol = object(TObject)
Name : PString; Name : PString;
Typ : tsymtyp; Typ : tsymtyp;
varoptions : tvaroptions;
varspez : tvarspez; { sets the type of access }
Params : PString; Params : PString;
References : PReferenceCollection; References : PReferenceCollection;
Items : PSymbolCollection; Items : PSymbolCollection;
@ -109,6 +112,8 @@ type
function GetText: string; function GetText: string;
function GetTypeName: string; function GetTypeName: string;
destructor Done; virtual; destructor Done; virtual;
procedure SetVarSpez(const AVarSpez : TVarSpez);
procedure SetVarOptions(const AVarOptions : TVarOptions);
constructor Load(var S: TStream); constructor Load(var S: TStream);
procedure Store(var S: TStream); procedure Store(var S: TStream);
end; end;
@ -337,6 +342,9 @@ const
Store: @TModuleSymbol.Store Store: @TModuleSymbol.Store
); );
SymbolCount : longint = 0;
Current_moduleIndex : longint = 0;
{**************************************************************************** {****************************************************************************
Helpers Helpers
****************************************************************************} ****************************************************************************}
@ -404,7 +412,7 @@ end;
constructor TSymbolCollection.Init(ALimit, ADelta: Integer); constructor TSymbolCollection.Init(ALimit, ADelta: Integer);
begin begin
inherited Init(ALimit,ADelta); inherited Init(ALimit,ADelta);
{ Duplicates:=true;} Duplicates:=true;
end; end;
function TSymbolCollection.At(Index: Sw_Integer): PSymbol; function TSymbolCollection.At(Index: Sw_Integer): PSymbol;
@ -448,7 +456,9 @@ begin
S2:=Upper(K2^.GetName); S2:=Upper(K2^.GetName);
if S1<S2 then R:=-1 else if S1<S2 then R:=-1 else
if S1>S2 then R:=1 else if S1>S2 then R:=1 else
if K1^.TypeID=K2^.TypeID then R:=0 else if K1^.TypeID=K2^.TypeID then
R:=0
else
begin begin
S1:=K1^.GetName; S1:=K1^.GetName;
S2:=K2^.GetName; S2:=K2^.GetName;
@ -456,7 +466,19 @@ begin
if S1>S2 then R:=1 else if S1>S2 then R:=1 else
if K1^.TypeID<K2^.TypeID then R:=-1 else if K1^.TypeID<K2^.TypeID then R:=-1 else
if K1^.TypeID>K2^.TypeID then R:= 1 else if K1^.TypeID>K2^.TypeID then R:= 1 else
R:=0; begin
{ Handle overloaded functions }
if (K1^.Typ=procsym) then
begin
S1:=K1^.GetText;
S2:=K2^.GetText;
if S1<S2 then R:=-1 else
if S1>S2 then R:=1 else
R:=0;
end
else
R:=0;
end
end; end;
Compare:=R; Compare:=R;
end; end;
@ -676,6 +698,9 @@ end;
constructor TSymbol.Init(const AName: string; ATyp: tsymtyp; AParams: string; AMemInfo: PSymbolMemInfo); constructor TSymbol.Init(const AName: string; ATyp: tsymtyp; AParams: string; AMemInfo: PSymbolMemInfo);
begin begin
inherited Init; inherited Init;
inc(SymbolCount);
VarSpez:=vs_value;
VarOptions:=[];
Name:=NewStr(AName); Typ:=ATyp; Name:=NewStr(AName); Typ:=ATyp;
if AMemInfo<>nil then if AMemInfo<>nil then
SetMemInfo(AMemInfo^); SetMemInfo(AMemInfo^);
@ -686,6 +711,16 @@ begin
end; end;
end; end;
procedure TSymbol.SetVarSpez(const AVarSpez : TVarSpez);
begin
VarSpez:=AVarSpez;
end;
procedure TSymbol.SetVarOptions(const AVarOptions : TVarOptions);
begin
VarOptions:=AVarOptions;
end;
procedure TSymbol.SetMemInfo(const AMemInfo: TSymbolMemInfo); procedure TSymbol.SetMemInfo(const AMemInfo: TSymbolMemInfo);
begin begin
if MemInfo=nil then New(MemInfo); if MemInfo=nil then New(MemInfo);
@ -758,6 +793,8 @@ begin
if Assigned(VType) then if Assigned(VType) then
S:=S+': '+VType^; S:=S+': '+VType^;
end; end;
if Typ=ProcSym then
S:=S+';';
GetText:=S; GetText:=S;
end; end;
@ -769,7 +806,13 @@ begin
fieldvarsym : S:='member'; fieldvarsym : S:='member';
staticvarsym, staticvarsym,
localvarsym, localvarsym,
paravarsym : S:='var'; paravarsym :
begin
if (vo_is_hidden_para in varoptions) then
S:='hidden'
else
S:='var';
end;
typesym : S:='type'; typesym : S:='type';
procsym : if VType=nil then procsym : if VType=nil then
S:='proc' S:='proc'
@ -781,7 +824,11 @@ begin
errorsym : S:='error'; errorsym : S:='error';
syssym : S:='sys'; syssym : S:='sys';
labelsym : S:='label'; labelsym : S:='label';
absolutevarsym : S:='abs'; absolutevarsym :
if (vo_is_funcret in varoptions) then
S:='ret'
else
S:='abs';
propertysym : S:='prop'; propertysym : S:='prop';
macrosym : S:='macro'; macrosym : S:='macro';
else S:=''; else S:='';
@ -791,7 +838,6 @@ end;
destructor TSymbol.Done; destructor TSymbol.Done;
begin begin
inherited Done;
if assigned(MemInfo) then if assigned(MemInfo) then
Dispose(MemInfo); Dispose(MemInfo);
if assigned(References) then if assigned(References) then
@ -808,6 +854,8 @@ begin
DisposeStr(DType); DisposeStr(DType);
if assigned(Ancestor) then if assigned(Ancestor) then
DisposeStr(Ancestor);} DisposeStr(Ancestor);}
dec(SymbolCount);
inherited Done;
end; end;
constructor TSymbol.Load(var S: TStream); constructor TSymbol.Load(var S: TStream);
@ -815,8 +863,25 @@ var MI: TSymbolMemInfo;
W: word; W: word;
begin begin
TObject.Init; TObject.Init;
inc(SymbolCount);
S.Read(Typ,SizeOf(Typ)); S.Read(Typ,SizeOf(Typ));
case Typ of
abstractsym,
absolutevarsym,
staticvarsym,
localvarsym,
paravarsym :
begin
S.Read(VarSpez,SizeOf(VarSpez));
S.Read(VarOptions,SizeOf(VarOptions));
end;
else
begin
VarSpez:=vs_value;
VarOptions:=[];
end;
end;
S.Read(TypeID, SizeOf(TypeID)); S.Read(TypeID, SizeOf(TypeID));
S.Read(RelatedTypeID, SizeOf(RelatedTypeID)); S.Read(RelatedTypeID, SizeOf(RelatedTypeID));
S.Read(Flags, SizeOf(Flags)); S.Read(Flags, SizeOf(Flags));
@ -844,6 +909,17 @@ procedure TSymbol.Store(var S: TStream);
var W: word; var W: word;
begin begin
S.Write(Typ,SizeOf(Typ)); S.Write(Typ,SizeOf(Typ));
case Typ of
abstractsym,
absolutevarsym,
staticvarsym,
localvarsym,
paravarsym :
begin
S.Write(VarSpez,SizeOf(VarSpez));
S.Write(VarOptions,SizeOf(VarOptions));
end;
end;
S.Write(TypeID, SizeOf(TypeID)); S.Write(TypeID, SizeOf(TypeID));
S.Write(RelatedTypeID, SizeOf(RelatedTypeID)); S.Write(RelatedTypeID, SizeOf(RelatedTypeID));
S.Write(Flags, SizeOf(Flags)); S.Write(Flags, SizeOf(Flags));
@ -998,7 +1074,6 @@ end;
destructor TModuleSymbol.Done; destructor TModuleSymbol.Done;
begin begin
inherited Done;
if Assigned(MainSource) then DisposeStr(MainSource); if Assigned(MainSource) then DisposeStr(MainSource);
if assigned(Exports_) then if assigned(Exports_) then
Dispose(Exports_, Done); Dispose(Exports_, Done);
@ -1017,6 +1092,7 @@ begin
Dispose(DependentUnits, Done); Dispose(DependentUnits, Done);
end; end;
if Assigned(SourceFiles) then Dispose(SourceFiles, Done); if Assigned(SourceFiles) then Dispose(SourceFiles, Done);
inherited Done;
end; end;
@ -1154,11 +1230,17 @@ end;
procedure ProcessSymTable(OwnerSym: PSymbol; var Owner: PSymbolCollection; Table: TSymTable); procedure ProcessSymTable(OwnerSym: PSymbol; var Owner: PSymbolCollection; Table: TSymTable);
var J: longint; var I,J: longint;
Sym: TSym; Sym: TSym;
pd : TProcDef;
Symbol: PSymbol; Symbol: PSymbol;
Reference: PReference; Reference: PReference;
inputfile : Tinputfile; inputfile : Tinputfile;
{$ifdef use_refs}
Ref : defref;
{$else not use_refs}
DefPos : TFilePosInfo;
{$endif not use_refs}
procedure SetVType(Symbol: PSymbol; VType: string); procedure SetVType(Symbol: PSymbol; VType: string);
begin begin
Symbol^.VType:=TypeNames^.Add(VType); Symbol^.VType:=TypeNames^.Add(VType);
@ -1236,7 +1318,7 @@ end;
end; end;
function GetAbsProcParmDefStr(def: tabstractprocdef): string; function GetAbsProcParmDefStr(def: tabstractprocdef): string;
var Name: string; var Name: string;
dc: tparavarsym; dc: tabstractvarsym;
i, i,
Count: integer; Count: integer;
CurName: string; CurName: string;
@ -1245,20 +1327,24 @@ end;
Count:=0; Count:=0;
for i:=0 to def.paras.count-1 do for i:=0 to def.paras.count-1 do
begin begin
dc:=tparavarsym(def.paras[i]); dc:=tabstractvarsym(def.paras[i]);
if i=0 then if not (vo_is_hidden_para in dc.VarOptions) then
CurName:='' begin
else CurName:='';
CurName:=', '+CurName; if assigned(dc.vardef) then
case dc.varspez of CurName:=': '+GetDefinitionStr(dc.vardef);
vs_Value : ; CurName:=dc.RealName+CurName;
vs_Const : CurName:=CurName+'const '; case dc.varspez of
vs_Var : CurName:=CurName+'var '; vs_Value : ;
end; vs_Const : CurName:='const '+CurName;
if assigned(dc.vardef) then vs_Var : CurName:='var '+CurName;
CurName:=CurName+GetDefinitionStr(dc.vardef); vs_Out : CurName:='out '+CurName;
Name:=CurName+Name; end;
Inc(Count); if Count>0 then
CurName:='; '+CurName;
Name:=Name+CurName;
Inc(Count);
end;
end; end;
GetAbsProcParmDefStr:=Name; GetAbsProcParmDefStr:=Name;
end; end;
@ -1268,9 +1354,9 @@ end;
Name:=GetAbsProcParmDefStr(def); Name:=GetAbsProcParmDefStr(def);
if Name<>'' then Name:='('+Name+')'; if Name<>'' then Name:='('+Name+')';
if retdefassigned(def) then if retdefassigned(def) then
Name:='function'+Name+': '+GetDefinitionStr(def.returndef) Name:='function'+Name+': '+GetDefinitionStr(def.returndef)+';'
else else
Name:='procedure'+Name; Name:='procedure'+Name+';';
GetAbsProcDefStr:=Name; GetAbsProcDefStr:=Name;
end; end;
function GetProcDefStr(def: tprocdef): string; function GetProcDefStr(def: tprocdef): string;
@ -1422,18 +1508,38 @@ end;
begin begin
if not Assigned(Table) then if not Assigned(Table) then
Exit; Exit;
Symbol:=nil;
if Owner=nil then if Owner=nil then
Owner:=New(PSortedSymbolCollection, Init(10,50)); Owner:=New(PSortedSymbolCollection, Init(10,50));
for symidx:=0 to Table.SymList.Count-1 do for symidx:=0 to Table.SymList.Count-1 do
begin begin
sym:=tsym(Table.SymList[symidx]); sym:=tsym(Table.SymList[symidx]);
New(Symbol, Init(Sym.Name,Sym.Typ,'',nil)); New(Symbol, Init(Sym.Name,Sym.Typ,'',nil));
case Sym.Typ of
staticvarsym,
localvarsym,
absolutevarsym,
paravarsym :
begin
Symbol^.SetVarOptions(tabstractvarsym(sym).VarOptions);
Symbol^.SetVarSpez(tabstractvarsym(sym).VarSpez);
end;
end;
case Sym.Typ of case Sym.Typ of
staticvarsym, staticvarsym,
localvarsym, localvarsym,
paravarsym : paravarsym :
with tabstractvarsym(sym) do with tabstractvarsym(sym) do
begin begin
if (vo_is_funcret in varoptions) then
begin
if Assigned(OwnerSym) then
if assigned(vardef) then
if assigned(vardef.typesym) then
SetVType(OwnerSym,vardef.typesym.name)
else
SetVType(OwnerSym,GetDefinitionStr(vardef));
end;
if assigned(vardef) then if assigned(vardef) then
if assigned(vardef.typesym) then if assigned(vardef.typesym) then
SetVType(Symbol,vardef.typesym.name) SetVType(Symbol,vardef.typesym.name)
@ -1466,7 +1572,13 @@ end;
else else
MemInfo.Size:=getsize; MemInfo.Size:=getsize;
{ this is not completely correct... } { this is not completely correct... }
MemInfo.PushSize:=paramanager.push_size(varspez,vardef,pocall_default); if assigned(vardef) then
MemInfo.PushSize:=paramanager.push_size(varspez,vardef,pocall_default)
else
begin
{ This can happen, why? }
MemInfo.PushSize:=0;
end;
Symbol^.SetMemInfo(MemInfo); Symbol^.SetMemInfo(MemInfo);
end; end;
fieldvarsym : fieldvarsym :
@ -1500,27 +1612,40 @@ end;
end; end;
procsym : procsym :
begin begin
with tprocsym(sym) do for i:=0 to tprocsym(sym).ProcdefList.Count-1 do
if assigned(tprocdef(procdeflist[0])) then begin
begin if i>0 then
ProcessSymTable(Symbol,Symbol^.Items,tprocdef(procdeflist[0]).parast); begin
if assigned(tprocdef(procdeflist[0]).parast) then if Assigned(Symbol) then
begin Owner^.Insert(Symbol);
Symbol^.Params:=TypeNames^.Add(GetAbsProcParmDefStr(tprocdef(procdeflist[0]))); New(Symbol, Init(Sym.Name,Sym.Typ,'',nil));
end end;
else { param-definition is NOT assigned } with tprocsym(sym) do
if assigned(Table.Name) then begin
if Table.Name^='SYSTEM' then pd:=tprocdef(procdeflist[i]);
begin if assigned(pd) then
Symbol^.Params:=TypeNames^.Add('...'); begin
end; ProcessSymTable(Symbol,Symbol^.Items,pd.parast);
// if cs_local_browser in current_settings.moduleswitches then if assigned(pd.parast) then
begin begin
if assigned(tprocdef(procdeflist[0]).localst) and Symbol^.Params:=TypeNames^.Add(
(tprocdef(procdeflist[0]).localst.symtabletype<>staticsymtable) then GetAbsProcParmDefStr(pd));
ProcessSymTable(Symbol,Symbol^.Items,tprocdef(procdeflist[0]).localst); end
end; else { param-definition is NOT assigned }
end; if assigned(Table.Name) and
(Table.Name^='SYSTEM') then
begin
Symbol^.Params:=TypeNames^.Add('...');
end;
// if cs_local_browser in current_settings.moduleswitches then
begin
if assigned(pd.localst) and
(pd.localst.symtabletype<>staticsymtable) then
ProcessSymTable(Symbol,Symbol^.Items,pd.localst);
end;
end;
end;
end;
end; end;
typesym : typesym :
begin begin
@ -1581,16 +1706,25 @@ end;
end; end;
Ref:=Ref.nextref; Ref:=Ref.nextref;
end; end;
{$else not use_refs}
DefPos:=tstoredsym(sym).FileInfo;
inputfile:=get_source_file(current_moduleindex,defpos.fileindex);
if Assigned(inputfile) and Assigned(inputfile.name) then
begin
New(Reference, Init(ModuleNames^.Add(inputfile.name^),
DefPos.line,DefPos.column));
Symbol^.References^.Insert(Reference);
end;
{$endif use_refs} {$endif use_refs}
if Assigned(Symbol) then if Assigned(Symbol) then
begin begin
if not Owner^.Search(Symbol,J) then (* if not Owner^.Search(Symbol,J) then *)
Owner^.Insert(Symbol) Owner^.Insert(Symbol)
else (*else
begin begin
Dispose(Symbol,done); Dispose(Symbol,done);
Symbol:=nil; Symbol:=nil;
end; end;*)
end; end;
end; end;
end; end;
@ -1624,7 +1758,11 @@ begin
// if (cs_browser in current_settings.moduleswitches) then // if (cs_browser in current_settings.moduleswitches) then
while assigned(hp) do while assigned(hp) do
begin begin
t:=tsymtable(hp.globalsymtable); current_moduleindex:=hp.unit_index;
if hp.is_unit then
t:=tsymtable(hp.globalsymtable)
else
t:=tsymtable(hp.localsymtable);
if assigned(t) then if assigned(t) then
begin begin
New(UnitS, Init(T.Name^,hp.mainsource^)); New(UnitS, Init(T.Name^,hp.mainsource^));
@ -1645,6 +1783,7 @@ begin
Modules^.Insert(UnitS); Modules^.Insert(UnitS);
ProcessSymTable(UnitS,UnitS^.Items,T); ProcessSymTable(UnitS,UnitS^.Items,T);
if hp.is_unit then
// if cs_local_browser in current_settings.moduleswitches then // if cs_local_browser in current_settings.moduleswitches then
begin begin
t:=tsymtable(hp.localsymtable); t:=tsymtable(hp.localsymtable);