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