1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
|
{
Copyright (c) 1998-2002 by Florian Klaempfl
This unit provides some help routines for symbol handling
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
****************************************************************************
}
unit symutil;
{$i fpcdefs.inc}
interface
uses
symbase,symtype,symsym,cclasses;
function is_funcret_sym(p:tsymentry):boolean;
{ returns true, if sym needs an entry in the proplist of a class rtti }
function needs_prop_entry(sym : tsym) : boolean;
function equal_constsym(sym1,sym2:tconstsym):boolean;
procedure count_locals(p:tnamedindexitem;arg:pointer);
implementation
uses
globtype,cpuinfo,procinfo,
symconst,widestr;
function is_funcret_sym(p:tsymentry):boolean;
begin
is_funcret_sym:=(p.typ in [absolutevarsym,localvarsym,paravarsym]) and
(vo_is_funcret in tabstractvarsym(p).varoptions);
end;
function needs_prop_entry(sym : tsym) : boolean;
begin
needs_prop_entry:=(sp_published in tsym(sym).symoptions) and
(sym.typ in [propertysym,fieldvarsym]);
end;
function equal_constsym(sym1,sym2:tconstsym):boolean;
var
p1,p2,pend : pchar;
begin
equal_constsym:=false;
if sym1.consttyp<>sym2.consttyp then
exit;
case sym1.consttyp of
constord :
equal_constsym:=(sym1.value.valueord=sym2.value.valueord);
constpointer :
equal_constsym:=(sym1.value.valueordptr=sym2.value.valueordptr);
conststring,constresourcestring :
begin
if sym1.value.len=sym2.value.len then
begin
p1:=pchar(sym1.value.valueptr);
p2:=pchar(sym2.value.valueptr);
pend:=p1+sym1.value.len;
while (p1<pend) do
begin
if p1^<>p2^ then
break;
inc(p1);
inc(p2);
end;
if (p1=pend) then
equal_constsym:=true;
end;
end;
constwstring :
begin
if (sym1.value.len=sym2.value.len) and
(comparewidestrings(sym1.value.valueptr,sym2.value.valueptr)=0) then
equal_constsym:=true;
end;
constreal :
equal_constsym:=(pbestreal(sym1.value.valueptr)^=pbestreal(sym2.value.valueptr)^);
constset :
equal_constsym:=(pnormalset(sym1.value.valueptr)^=pnormalset(sym2.value.valueptr)^);
constnil :
equal_constsym:=true;
end;
end;
procedure count_locals(p:tnamedindexitem;arg:pointer);
begin
{ Count only varsyms, but ignore the funcretsym }
if (tsym(p).typ in [localvarsym,paravarsym]) and
(tsym(p)<>current_procinfo.procdef.funcretsym) and
(not(vo_is_parentfp in tabstractvarsym(p).varoptions) or
(tstoredsym(p).refs>0)) then
inc(plongint(arg)^);
end;
end.
|
