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
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
|
{
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
symconst,symbase,symtype,symsym;
function is_funcret_sym(p:TSymEntry):boolean;
function equal_constsym(sym1,sym2:tconstsym; nanequal: boolean):boolean;
function get_first_proc_str(Options: TProcOptions): ShortString;
procedure maybe_guarantee_record_typesym(var def: tdef; st: tsymtable);
function is_normal_fieldvarsym(sym: tsym): boolean; inline;
implementation
uses
systems,
globtype,cpuinfo,constexp,verbose,
widestr,
symdef;
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 equal_constsym(sym1,sym2:tconstsym; nanequal: boolean):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 :
if nanequal then
equal_constsym:=CompareByte(pbestreal(sym1.value.valueptr)^,pbestreal(sym2.value.valueptr)^,sizeof(pbestreal^))=0
else
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;
else
;
end;
end;
{ get_first_proc_str - returns the token string of the first option that
appears in the list }
function get_first_proc_str(Options: TProcOptions): ShortString;
var
X: TProcOption;
begin
if Options = [] then
InternalError(2018051700);
get_first_proc_str := '';
for X in Options do
begin
get_first_proc_str := ProcOptionKeywords[X];
Exit;
end;
end;
procedure maybe_guarantee_record_typesym(var def: tdef; st: tsymtable);
var
ts: ttypesym;
begin
{ create a dummy typesym for the JVM target, because the record
has to be wrapped by a class }
if (target_info.system in systems_jvm) and
(def.typ=recorddef) and
not assigned(def.typesym) then
begin
ts:=ctypesym.create(trecorddef(def).symtable.realname^,def);
st.insert(ts);
ts.visibility:=vis_strictprivate;
{ this typesym can't be used by any Pascal code, so make sure we don't
print a hint about it being unused }
include(ts.symoptions,sp_internal);
end;
end;
function is_normal_fieldvarsym(sym: tsym): boolean; inline;
begin
result:=
(sym.typ=fieldvarsym) and
not(sp_static in sym.symoptions);
end;
end.
|
