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

* getsym redesign, removed the globals srsym,srsymtable

Browse Source
This commit is contained in:
peter 2001-03-11 22:58:49 +00:00
parent d6f289a9df
commit d8abf76f6b
21 changed files with 765 additions and 683 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
compiler/i386/ag386bin.pas
View File

@ -604,6 +604,8 @@ implementation
end;
top_symbol :
begin
if sym=nil then
sym:=sym;
UsedAsmSymbolListInsert(sym);
end;
end;
@ -1031,7 +1033,10 @@ implementation
end.
{
$Log$
Revision 1.5 2001-03-05 21:39:11 peter
Revision 1.6 2001-03-11 22:58:51 peter
* getsym redesign, removed the globals srsym,srsymtable
Revision 1.5 2001/03/05 21:39:11 peter
* changed to class with common TAssembler also for internal assembler
Revision 1.4 2000/12/25 00:07:31 peter

11
compiler/i386/n386cal.pas
View File

@ -261,7 +261,9 @@ implementation
{ we must pop this size also after !! }
{ must_pop : boolean; }
pop_size : longint;
{$ifdef dummy}
push_size : longint;
{$endif}
pop_esp : boolean;
pop_allowed : boolean;
regs_to_push : byte;
@ -390,7 +392,7 @@ implementation
{$endif GDB}
end;
end;
{
{$ifdef dummy}
if pop_allowed and (cs_align in aktglobalswitches) then
begin
pop_esp:=true;
@ -411,7 +413,7 @@ implementation
emit_reg(A_PUSH,S_L,R_EDI);
end
else
}
{$endif dummy}
pop_esp:=false;
if (resulttype<>pdef(voiddef)) and
ret_in_param(resulttype) then
@ -1587,7 +1589,10 @@ begin
end.
{
$Log$
Revision 1.18 2001-01-27 21:29:35 florian
Revision 1.19 2001-03-11 22:58:51 peter
* getsym redesign, removed the globals srsym,srsymtable
Revision 1.18 2001/01/27 21:29:35 florian
* behavior -Oa optimized
Revision 1.17 2001/01/08 21:46:46 peter

10
compiler/i386/n386mem.pas
View File

@ -91,7 +91,7 @@ implementation
{$endif GDB}
globtype,systems,
cutils,verbose,globals,
symconst,symbase,symdef,symsym,symtable,aasm,types,
symconst,symbase,symtype,symdef,symsym,symtable,aasm,types,
hcodegen,temp_gen,pass_2,
pass_1,nld,ncon,nadd,
cpubase,cpuasm,
@ -462,6 +462,7 @@ implementation
hp : preference;
href : treference;
tai : Taicpu;
srsym : psym;
pushed : tpushed;
hightree : tnode;
hl,otl,ofl : pasmlabel;
@ -741,7 +742,7 @@ implementation
parraydef(left.resulttype)^.genrangecheck;
href.symbol:=newasmsymbol(parraydef(left.resulttype)^.getrangecheckstring);
href.offset:=4;
getsymonlyin(tloadnode(left).symtable,
srsym:=searchsymonlyin(tloadnode(left).symtable,
'high'+pvarsym(tloadnode(left).symtableentry)^.name);
hightree:=genloadnode(pvarsym(srsym),tloadnode(left).symtable);
firstpass(hightree);
@ -1060,7 +1061,10 @@ begin
end.
{
$Log$
Revision 1.9 2001-02-02 22:38:00 peter
Revision 1.10 2001-03-11 22:58:52 peter
* getsym redesign, removed the globals srsym,srsymtable
Revision 1.9 2001/02/02 22:38:00 peter
* fixed crash with new(precord), merged
Revision 1.8 2000/12/25 00:07:33 peter

20
compiler/i386/n386util.pas
View File

@ -1083,19 +1083,13 @@ implementation
equal the check is also insert (needed for succ,pref,inc,dec)
}
var
neglabel,
poslabel : pasmlabel;
href : treference;
rstr : string;
hreg : tregister;
neglabel : pasmlabel;
opsize : topsize;
op : tasmop;
fromdef : pdef;
lto,hto,
lfrom,hfrom : longint;
doublebound,
is_reg,
popecx : boolean;
is_reg : boolean;
begin
{ range checking on and range checkable value? }
if not(cs_check_range in aktlocalswitches) or
@ -1172,7 +1166,7 @@ implementation
{ since from is signed, values > maxlongint are < 0 and must }
{ be rejected }
if hto < 0 then
hto := maxlongint;
hto := maxlongint;
end
else
{ from is unsigned, to is signed }
@ -1253,10 +1247,11 @@ implementation
procedure push_shortstring_length(p:tnode);
var
hightree : tnode;
srsym : psym;
begin
if is_open_string(p.resulttype) then
begin
getsymonlyin(tloadnode(p).symtable,'high'+pvarsym(tloadnode(p).symtableentry)^.name);
srsym:=searchsymonlyin(tloadnode(p).symtable,'high'+pvarsym(tloadnode(p).symtableentry)^.name);
hightree:=genloadnode(pvarsym(srsym),tloadnode(p).symtable);
firstpass(hightree);
secondpass(hightree);
@ -1482,7 +1477,10 @@ implementation
end.
{
$Log$
Revision 1.12 2001-03-04 10:26:56 jonas
Revision 1.13 2001-03-11 22:58:52 peter
* getsym redesign, removed the globals srsym,srsymtable
Revision 1.12 2001/03/04 10:26:56 jonas
* new rangecheck code now handles conversion between signed and cardinal types correctly
Revision 1.11 2001/03/03 12:41:22 jonas

33
compiler/i386/ra386att.pas
View File

@ -43,7 +43,7 @@ Implementation
{ aasm }
cpubase,aasm,
{ symtable }
symconst,symtype,symsym,symtable,types,
symconst,symbase,symtype,symsym,symtable,types,
{ pass 1 }
nbas,
{ parser }
@ -818,6 +818,7 @@ var
errorflag : boolean;
prevtok : tasmtoken;
sym : psym;
srsymtable : psymtable;
hl : PAsmLabel;
Begin
asmsym:='';
@ -947,16 +948,16 @@ Begin
BuildRecordOffsetSize(tempstr,k,l)
else
begin
getsym(tempstr,false);
if assigned(srsym) then
searchsym(tempstr,sym,srsymtable);
if assigned(sym) then
begin
case srsym^.typ of
case sym^.typ of
varsym :
l:=pvarsym(srsym)^.getsize;
l:=pvarsym(sym)^.getsize;
typedconstsym :
l:=ptypedconstsym(srsym)^.getsize;
l:=ptypedconstsym(sym)^.getsize;
typesym :
l:=ptypesym(srsym)^.restype.def^.size;
l:=ptypesym(sym)^.restype.def^.size;
else
Message(asmr_e_wrong_sym_type);
end;
@ -991,24 +992,23 @@ Begin
hs:=hl^.name
else
begin
getsym(tempstr,false);
sym:=srsym;
searchsym(tempstr,sym,srsymtable);
if assigned(sym) then
begin
case srsym^.typ of
case sym^.typ of
varsym :
begin
if sym^.owner^.symtabletype in [localsymtable,parasymtable] then
Message(asmr_e_no_local_or_para_allowed);
hs:=pvarsym(srsym)^.mangledname;
hs:=pvarsym(sym)^.mangledname;
end;
typedconstsym :
hs:=ptypedconstsym(srsym)^.mangledname;
hs:=ptypedconstsym(sym)^.mangledname;
procsym :
hs:=pprocsym(srsym)^.mangledname;
hs:=pprocsym(sym)^.mangledname;
typesym :
begin
if not(ptypesym(srsym)^.restype.def^.deftype in [recorddef,objectdef]) then
if not(ptypesym(sym)^.restype.def^.deftype in [recorddef,objectdef]) then
Message(asmr_e_wrong_sym_type);
end;
else
@ -2120,7 +2120,10 @@ begin
end.
{
$Log$
Revision 1.6 2000-12-25 00:07:34 peter
Revision 1.7 2001-03-11 22:58:52 peter
* getsym redesign, removed the globals srsym,srsymtable
Revision 1.6 2000/12/25 00:07:34 peter
+ new tlinkedlist class (merge of old tstringqueue,tcontainer and
tlinkedlist objects)

15
compiler/i386/ra386dir.pas
View File

@ -42,7 +42,7 @@ interface
{ aasm }
cpubase,aasm,
{ symtable }
symconst,symtype,symdef,symsym,symtable,types,
symconst,symbase,symtype,symdef,symsym,symtable,types,
{ pass 1 }
nbas,
{ parser }
@ -62,7 +62,8 @@ interface
retstr,s,hs : string;
c : char;
ende : boolean;
sym : psym;
srsym,sym : psym;
srsymtable : psymtable;
code : TAAsmoutput;
i,l : longint;
@ -121,7 +122,7 @@ interface
begin
if c=':' then
begin
getsym(upper(hs),false);
searchsym(upper(hs),srsym,srsymtable);
if srsym<>nil then
if (srsym^.typ = labelsym) then
Begin
@ -208,8 +209,7 @@ interface
begin
{$ifndef IGNOREGLOBALVAR}
getsym(upper(hs),false);
sym:=srsym;
searchsym(upper(hs),sym,srsymtable);
if assigned(sym) and (sym^.owner^.symtabletype in [unitsymtable,
globalsymtable,staticsymtable]) then
begin
@ -288,7 +288,10 @@ interface
end.
{
$Log$
Revision 1.4 2000-12-25 00:07:34 peter
Revision 1.5 2001-03-11 22:58:52 peter
* getsym redesign, removed the globals srsym,srsymtable
Revision 1.4 2000/12/25 00:07:34 peter
+ new tlinkedlist class (merge of old tstringqueue,tcontainer and
tlinkedlist objects)

34
compiler/i386/ra386int.pas
View File

@ -43,7 +43,7 @@ Implementation
{ aasm }
cpubase,aasm,
{ symtable }
symconst,symtype,symsym,symtable,types,
symconst,symbase,symtype,symsym,symtable,types,
{ pass 1 }
nbas,
{ parser }
@ -705,6 +705,7 @@ var
prevtok : tasmtoken;
hl : PAsmLabel;
sym : psym;
srsymtable : psymtable;
Begin
{ reset }
value:=0;
@ -812,16 +813,16 @@ Begin
BuildRecordOffsetSize(tempstr,k,l)
else
begin
getsym(tempstr,false);
if assigned(srsym) then
searchsym(tempstr,sym,srsymtable);
if assigned(sym) then
begin
case srsym^.typ of
case sym^.typ of
varsym :
l:=pvarsym(srsym)^.getsize;
l:=pvarsym(sym)^.getsize;
typedconstsym :
l:=ptypedconstsym(srsym)^.getsize;
l:=ptypedconstsym(sym)^.getsize;
typesym :
l:=ptypesym(srsym)^.restype.def^.size;
l:=ptypesym(sym)^.restype.def^.size;
else
Message(asmr_e_wrong_sym_type);
end;
@ -877,24 +878,23 @@ Begin
hs:=hl^.name
else
begin
getsym(tempstr,false);
sym:=srsym;
searchsym(tempstr,sym,srsymtable);
if assigned(sym) then
begin
case srsym^.typ of
case sym^.typ of
varsym :
begin
if sym^.owner^.symtabletype in [localsymtable,parasymtable] then
Message(asmr_e_no_local_or_para_allowed);
hs:=pvarsym(srsym)^.mangledname;
hs:=pvarsym(sym)^.mangledname;
end;
typedconstsym :
hs:=ptypedconstsym(srsym)^.mangledname;
hs:=ptypedconstsym(sym)^.mangledname;
procsym :
hs:=pprocsym(srsym)^.mangledname;
hs:=pprocsym(sym)^.mangledname;
typesym :
begin
if not(ptypesym(srsym)^.restype.def^.deftype in [recorddef,objectdef]) then
if not(ptypesym(sym)^.restype.def^.deftype in [recorddef,objectdef]) then
Message(asmr_e_wrong_sym_type);
end;
else
@ -1605,7 +1605,6 @@ Procedure T386IntelInstruction.BuildOpCode;
var
PrefixOp,OverrideOp: tasmop;
size : topsize;
lasttoken : tasmtoken;
operandnum : longint;
Begin
PrefixOp:=A_None;
@ -1950,7 +1949,10 @@ begin
end.
{
$Log$
Revision 1.9 2001-02-20 21:51:36 peter
Revision 1.10 2001-03-11 22:58:52 peter
* getsym redesign, removed the globals srsym,srsymtable
Revision 1.9 2001/02/20 21:51:36 peter
* fpu fixes (merged)
Revision 1.8 2001/02/09 23:42:49 peter

53
compiler/pbase.pas
View File

@ -29,7 +29,7 @@ interface
uses
cutils,cobjects,cclasses,
tokens,globals,
symbase,symdef,symsym
symconst,symbase,symtype,symdef,symsym,symtable
{$ifdef fixLeaksOnError}
,comphook
{$endif fixLeaksOnError}
@ -98,6 +98,10 @@ interface
{ consumes tokens while they are semicolons }
procedure emptystats;
{ consume a symbol, if not found give an error and
and return an errorsym }
function consume_sym(var srsym:psym;var srsymtable:psymtable):boolean;
{ reads a list of identifiers into a string list }
function idlist : tidstringlist;
@ -239,6 +243,48 @@ implementation
end;
function consume_sym(var srsym:psym;var srsymtable:psymtable):boolean;
begin
{ first check for identifier }
if token<>_ID then
begin
consume(_ID);
srsym:=generrorsym;
srsymtable:=nil;
consume_sym:=false;
exit;
end;
searchsym(pattern,srsym,srsymtable);
if assigned(srsym) then
begin
if (srsym^.typ=unitsym) then
begin
{ only allow unit.symbol access if the name was
found in the current module }
if srsym^.owner^.unitid=0 then
begin
consume(_ID);
consume(_POINT);
srsymtable:=punitsym(srsym)^.unitsymtable;
srsym:=searchsymonlyin(srsymtable,pattern);
end
else
srsym:=nil;
end;
end;
{ if nothing found give error and return errorsym }
if srsym=nil then
begin
identifier_not_found(pattern);
srsym:=generrorsym;
srsymtable:=nil;
end;
consume(_ID);
consume_sym:=assigned(srsym);
end;
{ reads a list of identifiers into a string list }
function idlist : tidstringlist;
var
@ -276,7 +322,10 @@ end.
{
$Log$
Revision 1.7 2000-12-25 00:07:27 peter
Revision 1.8 2001-03-11 22:58:49 peter
* getsym redesign, removed the globals srsym,srsymtable
Revision 1.7 2000/12/25 00:07:27 peter
+ new tlinkedlist class (merge of old tstringqueue,tcontainer and
tlinkedlist objects)

13
compiler/pdecl.pas
View File

@ -269,6 +269,8 @@ implementation
hpd,pd : pdef;
stpos : tfileposinfo;
again : boolean;
srsym : psym;
srsymtable : psymtable;
begin
{ Check only typesyms or record/object fields }
case psym(p)^.typ of
@ -305,7 +307,7 @@ implementation
akttokenpos:=pforwarddef(hpd)^.forwardpos;
resolving_forward:=true;
make_ref:=false;
getsym(pforwarddef(hpd)^.tosymname,false);
searchsym(pforwarddef(hpd)^.tosymname,srsym,srsymtable);
make_ref:=true;
resolving_forward:=false;
akttokenpos:=stpos;
@ -371,6 +373,7 @@ implementation
typename,orgtypename : stringid;
newtype : ptypesym;
sym : psym;
srsymtable : psymtable;
tt : ttype;
defpos,storetokenpos : tfileposinfo;
old_block_type : tblock_type;
@ -389,8 +392,7 @@ implementation
if token=_TYPE then
Consume(_TYPE);
{ is the type already defined? }
getsym(typename,false);
sym:=srsym;
searchsym(typename,sym,srsymtable);
newtype:=nil;
{ found a symbol with this name? }
if assigned(sym) then
@ -544,7 +546,10 @@ implementation
end.
{
$Log$
Revision 1.24 2000-12-25 00:07:27 peter
Revision 1.25 2001-03-11 22:58:49 peter
* getsym redesign, removed the globals srsym,srsymtable
Revision 1.24 2000/12/25 00:07:27 peter
+ new tlinkedlist class (merge of old tstringqueue,tcontainer and
tlinkedlist objects)

20
compiler/pdecobj.pas
View File

@ -281,10 +281,9 @@ implementation
begin
p^.readaccess^.addsym(sym);
consume(_POINT);
getsymonlyin(precorddef(pvarsym(sym)^.vartype.def)^.symtable,pattern);
if not assigned(srsym) then
sym:=searchsymonlyin(precorddef(pvarsym(sym)^.vartype.def)^.symtable,pattern);
if not assigned(sym) then
Message1(sym_e_illegal_field,pattern);
sym:=srsym;
consume(_ID);
end;
end;
@ -332,10 +331,9 @@ implementation
begin
p^.writeaccess^.addsym(sym);
consume(_POINT);
getsymonlyin(precorddef(pvarsym(sym)^.vartype.def)^.symtable,pattern);
if not assigned(srsym) then
sym:=searchsymonlyin(precorddef(pvarsym(sym)^.vartype.def)^.symtable,pattern);
if not assigned(sym) then
Message1(sym_e_illegal_field,pattern);
sym:=srsym;
consume(_ID);
end;
end;
@ -395,10 +393,9 @@ implementation
begin
p^.storedaccess^.addsym(sym);
consume(_POINT);
getsymonlyin(precorddef(pvarsym(sym)^.vartype.def)^.symtable,pattern);
if not assigned(srsym) then
sym:=searchsymonlyin(precorddef(pvarsym(sym)^.vartype.def)^.symtable,pattern);
if not assigned(sym) then
Message1(sym_e_illegal_field,pattern);
sym:=srsym;
consume(_ID);
end;
end;
@ -1168,7 +1165,10 @@ implementation
end.
{
$Log$
Revision 1.15 2000-12-25 00:07:27 peter
Revision 1.16 2001-03-11 22:58:49 peter
* getsym redesign, removed the globals srsym,srsymtable
Revision 1.15 2000/12/25 00:07:27 peter
+ new tlinkedlist class (merge of old tstringqueue,tcontainer and
tlinkedlist objects)

36
compiler/pdecsub.pas
View File

@ -99,6 +99,7 @@ implementation
tt : ttype;
hvs,
vs : Pvarsym;
srsym : psym;
hs1,hs2 : string;
varspez : Tvarspez;
inserthigh : boolean;
@ -174,8 +175,7 @@ implementation
if (token=_CONST) and (m_objpas in aktmodeswitches) then
begin
consume(_CONST);
srsym:=nil;
getsymonlyin(systemunit,'TVARREC');
srsym:=searchsymonlyin(systemunit,'TVARREC');
if not assigned(srsym) then
InternalError(1234124);
Parraydef(tt.def)^.elementtype:=ptypesym(srsym)^.restype;
@ -314,6 +314,7 @@ var orgsp,sp:stringid;
sym:Psym;
hs:string;
st : psymtable;
srsymtable : psymtable;
overloaded_level:word;
storepos,procstartfilepos : tfileposinfo;
i: longint;
@ -337,7 +338,8 @@ begin
end;
{ examine interface map: function/procedure iname.functionname=locfuncname }
if parse_only and assigned(procinfo^._class) and
if parse_only and
assigned(procinfo^._class) and
assigned(procinfo^._class^.implementedinterfaces) and
(procinfo^._class^.implementedinterfaces^.count>0) and
try_to_consume(_POINT) then
@ -345,11 +347,14 @@ begin
storepos:=akttokenpos;
akttokenpos:=procstartfilepos;
{ get interface syms}
getsym(sp,true);
sym:=srsym;
searchsym(sp,sym,srsymtable);
if not assigned(sym) then
begin
identifier_not_found(orgsp);
sym:=generrorsym;
end;
akttokenpos:=storepos;
{ load proc name }
sp:=pattern;
if sym^.typ=typesym then
i:=procinfo^._class^.implementedinterfaces^.searchintf(ptypesym(sym)^.restype.def);
{ qualifier is interface name? }
@ -378,22 +383,27 @@ begin
(lexlevel=normal_function_level) and
try_to_consume(_POINT) then
begin
{ search for object name }
storepos:=akttokenpos;
akttokenpos:=procstartfilepos;
getsym(sp,true);
sym:=srsym;
searchsym(sp,sym,srsymtable);
if not assigned(sym) then
begin
identifier_not_found(orgsp);
sym:=generrorsym;
end;
akttokenpos:=storepos;
{ load proc name }
{ consume proc name }
sp:=pattern;
orgsp:=orgpattern;
procstartfilepos:=akttokenpos;
consume(_ID);
{ qualifier is class name ? }
if (sym^.typ<>typesym) or
(ptypesym(sym)^.restype.def^.deftype<>objectdef) then
begin
Message(parser_e_class_id_expected);
aktprocsym:=nil;
consume(_ID);
end
else
begin
@ -401,7 +411,6 @@ begin
aktobjectdef:=pobjectdef(ptypesym(sym)^.restype.def);
procinfo^._class:=pobjectdef(ptypesym(sym)^.restype.def);
aktprocsym:=pprocsym(procinfo^._class^.symtable^.search(sp));
consume(_ID);
{The procedure has been found. So it is
a global one. Set the flags to mark this.}
procinfo^.flags:=procinfo^.flags or pi_is_global;
@ -1878,7 +1887,10 @@ end;
end.
{
$Log$
Revision 1.12 2001-03-06 18:28:02 peter
Revision 1.13 2001-03-11 22:58:50 peter
* getsym redesign, removed the globals srsym,srsymtable
Revision 1.12 2001/03/06 18:28:02 peter
* patch from Pavel with a new and much faster DLL Scanner for
automatic importing so $linklib works for DLLs. Thanks Pavel!

37
compiler/pdecvar.pas
View File

@ -25,8 +25,6 @@ unit pdecvar;
{$i defines.inc}
{$define UseUnionSymtable}
interface
procedure read_var_decs(is_record,is_object,is_threadvar:boolean);
@ -120,13 +118,13 @@ implementation
{ startvarrec contains the start of the variant part of a record }
maxsize,maxalignment,startvarrecalign,startvarrecsize : longint;
pt : tnode;
{$ifdef UseUnionSymtable}
srsym : psym;
srsymtable : psymtable;
unionsymtable : psymtable;
offset : longint;
uniondef : precorddef;
unionsym : pvarsym;
uniontype : ttype;
{$endif UseUnionSymtable}
begin
old_current_object_option:=current_object_option;
{ all variables are public if not in a object declaration }
@ -212,15 +210,7 @@ implementation
{ parse the rest }
if token=_ID then
begin
getsym(pattern,true);
consume(_ID);
{ support unit.variable }
if srsym^.typ=unitsym then
begin
consume(_POINT);
getsymonlyin(punitsym(srsym)^.unitsymtable,pattern);
consume(_ID);
end;
consume_sym(srsym,srsymtable);
{ we should check the result type of srsym }
if not (srsym^.typ in [varsym,typedconstsym,funcretsym]) then
Message(parser_e_absolute_only_to_var_or_const);
@ -447,17 +437,17 @@ implementation
maxalignment:=0;
consume(_CASE);
s:=pattern;
getsym(s,false);
searchsym(s,srsym,srsymtable);
{ may be only a type: }
if assigned(srsym) and (srsym^.typ in [typesym,unitsym]) then
begin
{ for records, don't search the recordsymtable for
the symbols of the types }
oldsymtablestack:=symtablestack;
symtablestack:=symtablestack^.next;
symtablestack:=symtablestack^.next;
read_type(casetype,'');
symtablestack:=oldsymtablestack;
end
symtablestack:=oldsymtablestack;
end
else
begin
consume(_ID);
@ -465,22 +455,20 @@ implementation
{ for records, don't search the recordsymtable for
the symbols of the types }
oldsymtablestack:=symtablestack;
symtablestack:=symtablestack^.next;
symtablestack:=symtablestack^.next;
read_type(casetype,'');
symtablestack:=oldsymtablestack;
symtablestack:=oldsymtablestack;
symtablestack^.insert(new(pvarsym,init(s,casetype)));
end;
if not(is_ordinal(casetype.def)) or is_64bitint(casetype.def) then
Message(type_e_ordinal_expr_expected);
consume(_OF);
{$ifdef UseUnionSymtable}
UnionSymtable:=new(pstoredsymtable,init(recordsymtable));
UnionSymtable^.next:=symtablestack;
registerdef:=false;
UnionDef:=new(precorddef,init(unionsymtable));
registerdef:=true;
symtablestack:=UnionSymtable;
{$endif UseUnionSymtable}
startvarrecsize:=symtablestack^.datasize;
startvarrecalign:=symtablestack^.dataalignment;
repeat
@ -517,7 +505,6 @@ implementation
{ at last set the record size to that of the biggest variant }
symtablestack^.datasize:=maxsize;
symtablestack^.dataalignment:=maxalignment;
{$ifdef UseUnionSymtable}
uniontype.def:=uniondef;
uniontype.sym:=nil;
UnionSym:=new(pvarsym,init('case',uniontype));
@ -532,7 +519,6 @@ implementation
UnionSym^.owner:=nil;
dispose(unionsym,done);
dispose(uniondef,done);
{$endif UseUnionSymtable}
end;
block_type:=old_block_type;
current_object_option:=old_current_object_option;
@ -541,7 +527,10 @@ implementation
end.
{
$Log$
Revision 1.10 2001-03-06 18:28:02 peter
Revision 1.11 2001-03-11 22:58:50 peter
* getsym redesign, removed the globals srsym,srsymtable
Revision 1.10 2001/03/06 18:28:02 peter
* patch from Pavel with a new and much faster DLL Scanner for
automatic importing so $linklib works for DLLs. Thanks Pavel!

179
compiler/pexports.pas
View File

@ -39,7 +39,7 @@ implementation
globals,tokens,verbose,
systems,
{ symtable }
symconst,symdef,symsym,symtable,
symconst,symbase,symtype,symdef,symsym,symtable,
{ pass 1 }
node,pass_1,
ncon,
@ -56,9 +56,10 @@ implementation
hp : texported_item;
orgs,
DefString : string;
ProcName : string;
InternalProcName : string;
pt : tnode;
pt : tnode;
srsym : psym;
srsymtable : psymtable;
begin
DefString:='';
InternalProcName:='';
@ -68,96 +69,85 @@ implementation
hp:=texported_item.create;
if token=_ID then
begin
getsym(pattern,true);
if srsym^.typ=unitsym then
begin
consume(_ID);
consume(_POINT);
getsymonlyin(punitsym(srsym)^.unitsymtable,pattern);
end;
orgs:=orgpattern;
consume(_ID);
if assigned(srsym) then
begin
hp.sym:=srsym;
if ((hp.sym^.typ<>procsym) or
((tf_need_export in target_info.flags) and
not(po_exports in pprocdef(pprocsym(srsym)^.definition)^.procoptions)
)
) and
(srsym^.typ<>varsym) and (srsym^.typ<>typedconstsym) then
Message(parser_e_illegal_symbol_exported)
else
begin
ProcName:=orgs;
InternalProcName:=hp.sym^.mangledname;
{ This is wrong if the first is not
an underline }
if InternalProcName[1]='_' then
delete(InternalProcName,1,1)
else if (target_os.id=os_i386_win32) and UseDeffileForExport then
begin
Message(parser_e_dlltool_unit_var_problem);
Message(parser_e_dlltool_unit_var_problem2);
end;
if length(InternalProcName)<2 then
Message(parser_e_procname_to_short_for_export);
DefString:=ProcName+'='+InternalProcName;
end;
if (idtoken=_INDEX) then
begin
consume(_INDEX);
pt:=comp_expr(true);
do_firstpass(pt);
if pt.nodetype=ordconstn then
hp.index:=tordconstnode(pt).value
else
begin
hp.index:=0;
consume(_INTCONST);
end;
hp.options:=hp.options or eo_index;
pt.free;
if target_os.id=os_i386_win32 then
DefString:=ProcName+'='+InternalProcName+' @ '+tostr(hp.index)
else
DefString:=ProcName+'='+InternalProcName; {Index ignored!}
end;
if (idtoken=_NAME) then
begin
consume(_NAME);
pt:=comp_expr(true);
do_firstpass(pt);
if pt.nodetype=stringconstn then
hp.name:=stringdup(strpas(tstringconstnode(pt).value_str))
else
begin
hp.name:=stringdup('');
consume(_CSTRING);
end;
hp.options:=hp.options or eo_name;
pt.free;
DefString:=hp.name^+'='+InternalProcName;
end;
if (idtoken=_RESIDENT) then
begin
consume(_RESIDENT);
hp.options:=hp.options or eo_resident;
DefString:=ProcName+'='+InternalProcName;{Resident ignored!}
end;
if (DefString<>'') and UseDeffileForExport then
DefFile.AddExport(DefString);
{ Default to generate a name entry with the provided name }
if not assigned(hp.name) then
begin
hp.name:=stringdup(orgs);
hp.options:=hp.options or eo_name;
end;
if hp.sym^.typ=procsym then
exportlib.exportprocedure(hp)
else
exportlib.exportvar(hp);
end;
consume_sym(srsym,srsymtable);
hp.sym:=srsym;
if ((hp.sym^.typ<>procsym) or
((tf_need_export in target_info.flags) and
not(po_exports in pprocdef(pprocsym(srsym)^.definition)^.procoptions)
)
) and
(srsym^.typ<>varsym) and (srsym^.typ<>typedconstsym) then
Message(parser_e_illegal_symbol_exported)
else
begin
InternalProcName:=srsym^.mangledname;
{ This is wrong if the first is not
an underline }
if InternalProcName[1]='_' then
delete(InternalProcName,1,1)
else if (target_os.id=os_i386_win32) and UseDeffileForExport then
begin
Message(parser_e_dlltool_unit_var_problem);
Message(parser_e_dlltool_unit_var_problem2);
end;
if length(InternalProcName)<2 then
Message(parser_e_procname_to_short_for_export);
DefString:=srsym^.realname+'='+InternalProcName;
end;
if (idtoken=_INDEX) then
begin
consume(_INDEX);
pt:=comp_expr(true);
do_firstpass(pt);
if pt.nodetype=ordconstn then
hp.index:=tordconstnode(pt).value
else
begin
hp.index:=0;
consume(_INTCONST);
end;
hp.options:=hp.options or eo_index;
pt.free;
if target_os.id=os_i386_win32 then
DefString:=srsym^.realname+'='+InternalProcName+' @ '+tostr(hp.index)
else
DefString:=srsym^.realname+'='+InternalProcName; {Index ignored!}
end;
if (idtoken=_NAME) then
begin
consume(_NAME);
pt:=comp_expr(true);
do_firstpass(pt);
if pt.nodetype=stringconstn then
hp.name:=stringdup(strpas(tstringconstnode(pt).value_str))
else
begin
hp.name:=stringdup('');
consume(_CSTRING);
end;
hp.options:=hp.options or eo_name;
pt.free;
DefString:=hp.name^+'='+InternalProcName;
end;
if (idtoken=_RESIDENT) then
begin
consume(_RESIDENT);
hp.options:=hp.options or eo_resident;
DefString:=srsym^.realname+'='+InternalProcName;{Resident ignored!}
end;
if (DefString<>'') and UseDeffileForExport then
DefFile.AddExport(DefString);
{ Default to generate a name entry with the provided name }
if not assigned(hp.name) then
begin
hp.name:=stringdup(orgs);
hp.options:=hp.options or eo_name;
end;
if hp.sym^.typ=procsym then
exportlib.exportprocedure(hp)
else
exportlib.exportvar(hp);
end
else
consume(_ID);
@ -175,7 +165,10 @@ end.
{
$Log$
Revision 1.11 2001-01-03 13:12:50 jonas
Revision 1.12 2001-03-11 22:58:50 peter
* getsym redesign, removed the globals srsym,srsymtable
Revision 1.11 2001/01/03 13:12:50 jonas
* fixed copy/past bugs
Revision 1.10 2000/12/30 22:53:25 peter

645
compiler/pexpr.pas
View File

@ -43,7 +43,7 @@ interface
function string_dec : pdef;
{ the ID token has to be consumed before calling this function }
procedure do_member_read(getaddr : boolean;const sym : psym;var p1 : tnode;
procedure do_member_read(getaddr : boolean;sym : psym;var p1 : tnode;
var pd : pdef;var again : boolean);
{$ifdef int64funcresok}
@ -904,12 +904,13 @@ implementation
{ the ID token has to be consumed before calling this function }
procedure do_member_read(getaddr : boolean;const sym : psym;var p1 : tnode;
procedure do_member_read(getaddr : boolean;sym : psym;var p1 : tnode;
var pd : pdef;var again : boolean);
var
static_name : string;
isclassref : boolean;
srsymtable : psymtable;
objdef : pobjectdef;
begin
@ -978,10 +979,10 @@ implementation
Message(parser_e_only_class_methods_via_class_ref);
if (sp_static in sym^.symoptions) then
begin
static_name:=lower(srsym^.owner^.name^)+'_'+sym^.name;
getsym(static_name,true);
static_name:=lower(sym^.owner^.name^)+'_'+sym^.name;
searchsym(static_name,sym,srsymtable);
p1.destroy;
p1:=genloadnode(pvarsym(srsym),srsymtable);
p1:=genloadnode(pvarsym(sym),srsymtable);
end
else
p1:=gensubscriptnode(pvarsym(sym),p1);
@ -991,7 +992,7 @@ implementation
begin
if isclassref then
Message(parser_e_only_class_methods_via_class_ref);
handle_propertysym(sym,srsymtable,p1,pd);
handle_propertysym(sym,sym^.owner,p1,pd);
end;
else internalerror(16);
end;
@ -1032,11 +1033,10 @@ implementation
Is_func_ret
---------------------------------------------}
function is_func_ret(sym : psym) : boolean;
function is_func_ret(var sym : psym;var srsymtable:psymtable) : boolean;
var
p : pprocinfo;
storesymtablestack : psymtable;
begin
is_func_ret:=false;
if not assigned(procinfo) or
@ -1073,14 +1073,17 @@ implementation
end;
p:=p^.parent;
end;
{ we must use the function call }
{ we must use the function call, update the
sym to be the procsym }
if (sym^.typ=funcretsym) then
begin
storesymtablestack:=symtablestack;
symtablestack:=srsymtable^.next;
getsym(sym^.name,true);
if srsym^.typ<>procsym then
Message(cg_e_illegal_expression);
symtablestack:=sym^.owner^.next;
searchsym(sym^.name,sym,srsymtable);
if not assigned(sym) then
sym:=generrorsym;
if (sym^.typ<>procsym) then
Message(cg_e_illegal_expression);
symtablestack:=storesymtablestack;
end;
end;
@ -1093,326 +1096,318 @@ implementation
var
pc : pchar;
len : longint;
srsym : psym;
srsymtable : psymtable;
begin
{ allow post fix operators }
again:=true;
consume_sym(srsym,srsymtable);
if not is_func_ret(srsym,srsymtable) then
begin
if lastsymknown then
{ check semantics of private }
if (srsym^.typ in [propertysym,procsym,varsym]) and
(srsym^.owner^.symtabletype=objectsymtable) then
begin
srsym:=lastsrsym;
srsymtable:=lastsrsymtable;
lastsymknown:=false;
end
else
getsym(pattern,true);
consume(_ID);
if not is_func_ret(srsym) then
{ else it's a normal symbol }
begin
{ is it defined like UNIT.SYMBOL ? }
if srsym^.typ=unitsym then
begin
consume(_POINT);
getsymonlyin(punitsym(srsym)^.unitsymtable,pattern);
{$ifdef TEST_PROCSYMS}
unit_specific:=true;
{$endif TEST_PROCSYMS}
consume(_ID);
{$ifdef TEST_PROCSYMS}
end
else
unit_specific:=false;
{$else TEST_PROCSYMS}
end;
{$endif TEST_PROCSYMS}
if not assigned(srsym) then
Begin
p1:=cerrornode.create;
{ try to clean up }
pd:=generrordef;
end
else
Begin
{ check semantics of private }
if (srsym^.typ in [propertysym,procsym,varsym]) and
(srsymtable^.symtabletype=objectsymtable) then
begin
if (sp_private in srsym^.symoptions) and
(pobjectdef(srsym^.owner^.defowner)^.owner^.symtabletype=unitsymtable) then
Message(parser_e_cant_access_private_member);
end;
case srsym^.typ of
absolutesym : begin
p1:=genloadnode(pvarsym(srsym),srsymtable);
pd:=pabsolutesym(srsym)^.vartype.def;
end;
varsym : begin
{ are we in a class method ? }
if (srsymtable^.symtabletype=objectsymtable) and
assigned(aktprocsym) and
(po_classmethod in aktprocsym^.definition^.procoptions) then
Message(parser_e_only_class_methods);
if (sp_static in srsym^.symoptions) then
if (sp_private in srsym^.symoptions) and
(pobjectdef(srsym^.owner^.defowner)^.owner^.symtabletype=unitsymtable) then
Message(parser_e_cant_access_private_member);
end;
case srsym^.typ of
absolutesym :
begin
p1:=genloadnode(pvarsym(srsym),srsymtable);
pd:=pabsolutesym(srsym)^.vartype.def;
end;
varsym :
begin
{ are we in a class method ? }
if (srsym^.owner^.symtabletype=objectsymtable) and
assigned(aktprocsym) and
(po_classmethod in aktprocsym^.definition^.procoptions) then
Message(parser_e_only_class_methods);
if (sp_static in srsym^.symoptions) then
begin
static_name:=lower(srsym^.owner^.name^)+'_'+srsym^.name;
searchsym(static_name,srsym,srsymtable);
end;
p1:=genloadnode(pvarsym(srsym),srsymtable);
if pvarsym(srsym)^.varstate=vs_declared then
begin
include(p1.flags,nf_first);
{ set special between first loaded until checked in firstpass }
pvarsym(srsym)^.varstate:=vs_declared_and_first_found;
end;
pd:=pvarsym(srsym)^.vartype.def;
end;
typedconstsym :
begin
p1:=gentypedconstloadnode(ptypedconstsym(srsym),srsymtable);
pd:=ptypedconstsym(srsym)^.typedconsttype.def;
end;
syssym :
p1:=statement_syssym(psyssym(srsym)^.number,pd);
typesym :
begin
pd:=ptypesym(srsym)^.restype.def;
if not assigned(pd) then
begin
pd:=generrordef;
again:=false;
end
else
begin
{ if we read a type declaration }
{ we have to return the type and }
{ nothing else }
if block_type=bt_type then
begin
{ we don't need sym reference when it's in the
current unit or system unit, because those
units are always loaded (PFV) }
if not(assigned(pd^.owner)) or
(pd^.owner^.unitid=0) or
(pd^.owner^.unitid=1) then
p1:=gentypenode(pd,nil)
else
p1:=gentypenode(pd,ptypesym(srsym));
{ here we can also set resulttype !! }
p1.resulttype:=pd;
pd:=voiddef;
end
else { not type block }
begin
if token=_LKLAMMER then
begin
consume(_LKLAMMER);
p1:=comp_expr(true);
consume(_RKLAMMER);
p1:=gentypeconvnode(p1,pd);
include(p1.flags,nf_explizit);
end
else { not LKLAMMER }
if (token=_POINT) and
is_object(pd) then
begin
consume(_POINT);
if assigned(procinfo) and
assigned(procinfo^._class) and
not(getaddr) then
begin
static_name:=lower(srsym^.owner^.name^)+'_'+srsym^.name;
getsym(static_name,true);
end;
p1:=genloadnode(pvarsym(srsym),srsymtable);
if pvarsym(srsym)^.varstate=vs_declared then
begin
include(p1.flags,nf_first);
{ set special between first loaded until checked in firstpass }
pvarsym(srsym)^.varstate:=vs_declared_and_first_found;
end;
pd:=pvarsym(srsym)^.vartype.def;
end;
typedconstsym : begin
p1:=gentypedconstloadnode(ptypedconstsym(srsym),srsymtable);
pd:=ptypedconstsym(srsym)^.typedconsttype.def;
end;
syssym : p1:=statement_syssym(psyssym(srsym)^.number,pd);
typesym : begin
pd:=ptypesym(srsym)^.restype.def;
if not assigned(pd) then
begin
pd:=generrordef;
again:=false;
if procinfo^._class^.is_related(pobjectdef(pd)) then
begin
p1:=gentypenode(pd,ptypesym(srsym));
p1.resulttype:=pd;
{ search also in inherited methods }
repeat
sym:=pvarsym(pobjectdef(pd)^.symtable^.search(pattern));
if assigned(sym) then
break;
pd:=pobjectdef(pd)^.childof;
until not assigned(pd);
consume(_ID);
do_member_read(false,sym,p1,pd,again);
end
else
begin
Message(parser_e_no_super_class);
pd:=generrordef;
again:=false;
end;
end
else
begin
{ if we read a type declaration }
{ we have to return the type and }
{ nothing else }
if block_type=bt_type then
begin
{ we don't need sym reference when it's in the
current unit or system unit, because those
units are always loaded (PFV) }
if not(assigned(pd^.owner)) or
(pd^.owner^.unitid=0) or
(pd^.owner^.unitid=1) then
p1:=gentypenode(pd,nil)
else
p1:=gentypenode(pd,ptypesym(srsym));
{ here we can also set resulttype !! }
p1.resulttype:=pd;
pd:=voiddef;
end
else { not type block }
{ allows @TObject.Load }
{ also allows static methods and variables }
p1:=ctypenode.create(nil,nil);
p1.resulttype:=pd;
{ TP allows also @TMenu.Load if Load is only }
{ defined in an anchestor class }
sym:=pvarsym(search_class_member(pobjectdef(pd),pattern));
if not assigned(sym) then
Message1(sym_e_id_no_member,pattern)
else if not(getaddr) and not(sp_static in sym^.symoptions) then
Message(sym_e_only_static_in_static)
else
begin
if token=_LKLAMMER then
begin
consume(_LKLAMMER);
p1:=comp_expr(true);
consume(_RKLAMMER);
p1:=gentypeconvnode(p1,pd);
include(p1.flags,nf_explizit);
end
else { not LKLAMMER }
if (token=_POINT) and
is_object(pd) then
begin
consume(_POINT);
if assigned(procinfo) and
assigned(procinfo^._class) and
not(getaddr) then
begin
if procinfo^._class^.is_related(pobjectdef(pd)) then
begin
p1:=gentypenode(pd,ptypesym(srsym));
p1.resulttype:=pd;
{ search also in inherited methods }
repeat
srsymtable:=pobjectdef(pd)^.symtable;
sym:=pvarsym(srsymtable^.search(pattern));
if assigned(sym) then
break;
pd:=pobjectdef(pd)^.childof;
until not assigned(pd);
consume(_ID);
do_member_read(false,sym,p1,pd,again);
end
else
begin
Message(parser_e_no_super_class);
pd:=generrordef;
again:=false;
end;
end
else
begin
{ allows @TObject.Load }
{ also allows static methods and variables }
p1:=ctypenode.create(nil,nil);
p1.resulttype:=pd;
{ TP allows also @TMenu.Load if Load is only }
{ defined in an anchestor class }
sym:=pvarsym(search_class_member(pobjectdef(pd),pattern));
if not assigned(sym) then
Message1(sym_e_id_no_member,pattern)
else if not(getaddr) and not(sp_static in sym^.symoptions) then
Message(sym_e_only_static_in_static)
else
begin
consume(_ID);
do_member_read(getaddr,sym,p1,pd,again);
end;
end;
end
else
begin
{ class reference ? }
if is_class(pd) then
begin
if getaddr and (token=_POINT) then
begin
consume(_POINT);
{ allows @Object.Method }
{ also allows static methods and variables }
p1:=gentypenode(nil,nil);
p1.resulttype:=pd;
{ TP allows also @TMenu.Load if Load is only }
{ defined in an anchestor class }
sym:=pvarsym(search_class_member(pobjectdef(pd),pattern));
if not assigned(sym) then
Message1(sym_e_id_no_member,pattern)
else
begin
consume(_ID);
do_member_read(getaddr,sym,p1,pd,again);
end;
end
else
begin
p1:=gentypenode(pd,nil);
p1.resulttype:=pd;
pd:=new(pclassrefdef,init(pd));
p1:=cloadvmtnode.create(p1);
p1.resulttype:=pd;
end;
end
else
begin
{ generate a type node }
{ (for typeof etc) }
if allow_type then
begin
p1:=gentypenode(pd,nil);
{ here we must use typenodetype explicitly !! PM
p1.resulttype:=pd; }
pd:=voiddef;
end
else
Message(parser_e_no_type_not_allowed_here);
end;
end;
consume(_ID);
do_member_read(getaddr,sym,p1,pd,again);
end;
end;
end;
enumsym : begin
p1:=genenumnode(penumsym(srsym));
pd:=p1.resulttype;
end;
constsym : begin
case pconstsym(srsym)^.consttyp of
constint :
{ do a very dirty trick to bootstrap this code }
if (pconstsym(srsym)^.value>=-(int64(2147483647)+int64(1))) and (pconstsym(srsym)^.value<=2147483647) then
p1:=genordinalconstnode(pconstsym(srsym)^.value,s32bitdef)
else if (pconstsym(srsym)^.value > maxlongint) and (pconstsym(srsym)^.value <= int64(maxlongint)+int64(maxlongint)+1) then
p1:=genordinalconstnode(pconstsym(srsym)^.value,u32bitdef)
else
p1:=genordinalconstnode(pconstsym(srsym)^.value,cs64bitdef);
conststring :
begin
len:=pconstsym(srsym)^.len;
if not(cs_ansistrings in aktlocalswitches) and (len>255) then
len:=255;
getmem(pc,len+1);
move(pchar(tpointerord(pconstsym(srsym)^.value))^,pc^,len);
pc[len]:=#0;
p1:=genpcharconstnode(pc,len);
end;
constchar :
p1:=genordinalconstnode(pconstsym(srsym)^.value,cchardef);
constreal :
p1:=genrealconstnode(pbestreal(tpointerord(pconstsym(srsym)^.value))^,bestrealdef^);
constbool :
p1:=genordinalconstnode(pconstsym(srsym)^.value,booldef);
constset :
p1:=gensetconstnode(pconstset(tpointerord(pconstsym(srsym)^.value)),
psetdef(pconstsym(srsym)^.consttype.def));
constord :
p1:=genordinalconstnode(pconstsym(srsym)^.value,
pconstsym(srsym)^.consttype.def);
constpointer :
p1:=genpointerconstnode(pconstsym(srsym)^.value,
pconstsym(srsym)^.consttype.def);
constnil :
p1:=cnilnode.create;
constresourcestring:
begin
p1:=genloadnode(pvarsym(srsym),srsymtable);
p1.resulttype:=cansistringdef;
end;
end
else
begin
{ class reference ? }
if is_class(pd) then
begin
if getaddr and (token=_POINT) then
begin
consume(_POINT);
{ allows @Object.Method }
{ also allows static methods and variables }
p1:=gentypenode(nil,nil);
p1.resulttype:=pd;
{ TP allows also @TMenu.Load if Load is only }
{ defined in an anchestor class }
sym:=pvarsym(search_class_member(pobjectdef(pd),pattern));
if not assigned(sym) then
Message1(sym_e_id_no_member,pattern)
else
begin
consume(_ID);
do_member_read(getaddr,sym,p1,pd,again);
end;
end
else
begin
p1:=gentypenode(pd,nil);
p1.resulttype:=pd;
pd:=new(pclassrefdef,init(pd));
p1:=cloadvmtnode.create(p1);
p1.resulttype:=pd;
end;
end
else
begin
{ generate a type node }
{ (for typeof etc) }
if allow_type then
begin
p1:=gentypenode(pd,nil);
{ here we must use typenodetype explicitly !! PM
p1.resulttype:=pd; }
pd:=voiddef;
end
else
Message(parser_e_no_type_not_allowed_here);
end;
pd:=p1.resulttype;
end;
procsym : begin
{ are we in a class method ? }
possible_error:=(srsymtable^.symtabletype=objectsymtable) and
assigned(aktprocsym) and
(po_classmethod in aktprocsym^.definition^.procoptions);
p1:=gencallnode(pprocsym(srsym),srsymtable);
{$ifdef TEST_PROCSYMS}
p1.unit_specific:=unit_specific;
{$endif TEST_PROCSYMS}
do_proc_call(getaddr or
(getprocvar and
((block_type=bt_const) or
((m_tp_procvar in aktmodeswitches) and
proc_to_procvar_equal(pprocsym(srsym)^.definition,getprocvardef)
end;
end;
end;
end;
enumsym :
begin
p1:=genenumnode(penumsym(srsym));
pd:=p1.resulttype;
end;
constsym :
begin
case pconstsym(srsym)^.consttyp of
constint :
begin
{ do a very dirty trick to bootstrap this code }
if (pconstsym(srsym)^.value>=-(int64(2147483647)+int64(1))) and (pconstsym(srsym)^.value<=2147483647) then
p1:=genordinalconstnode(pconstsym(srsym)^.value,s32bitdef)
else if (pconstsym(srsym)^.value > maxlongint) and (pconstsym(srsym)^.value <= int64(maxlongint)+int64(maxlongint)+1) then
p1:=genordinalconstnode(pconstsym(srsym)^.value,u32bitdef)
else
p1:=genordinalconstnode(pconstsym(srsym)^.value,cs64bitdef);
end;
conststring :
begin
len:=pconstsym(srsym)^.len;
if not(cs_ansistrings in aktlocalswitches) and (len>255) then
len:=255;
getmem(pc,len+1);
move(pchar(tpointerord(pconstsym(srsym)^.value))^,pc^,len);
pc[len]:=#0;
p1:=genpcharconstnode(pc,len);
end;
constchar :
p1:=genordinalconstnode(pconstsym(srsym)^.value,cchardef);
constreal :
p1:=genrealconstnode(pbestreal(tpointerord(pconstsym(srsym)^.value))^,bestrealdef^);
constbool :
p1:=genordinalconstnode(pconstsym(srsym)^.value,booldef);
constset :
p1:=gensetconstnode(pconstset(tpointerord(pconstsym(srsym)^.value)),
psetdef(pconstsym(srsym)^.consttype.def));
constord :
p1:=genordinalconstnode(pconstsym(srsym)^.value,pconstsym(srsym)^.consttype.def);
constpointer :
p1:=genpointerconstnode(pconstsym(srsym)^.value,pconstsym(srsym)^.consttype.def);
constnil :
p1:=cnilnode.create;
constresourcestring:
begin
p1:=genloadnode(pvarsym(srsym),srsymtable);
p1.resulttype:=cansistringdef;
end;
end;
pd:=p1.resulttype;
end;
procsym :
begin
{ are we in a class method ? }
possible_error:=(srsym^.owner^.symtabletype=objectsymtable) and
assigned(aktprocsym) and
(po_classmethod in aktprocsym^.definition^.procoptions);
p1:=gencallnode(pprocsym(srsym),srsymtable);
do_proc_call(getaddr or
(getprocvar and
((block_type=bt_const) or
((m_tp_procvar in aktmodeswitches) and
proc_to_procvar_equal(pprocsym(srsym)^.definition,getprocvardef)
)
)
)
),again,tcallnode(p1),pd);
if (block_type=bt_const) and
getprocvar then
handle_procvar(getprocvardef,p1);
if possible_error and
not(po_classmethod in tcallnode(p1).procdefinition^.procoptions) then
Message(parser_e_only_class_methods);
end;
propertysym : begin
{ access to property in a method }
{ are we in a class method ? }
if (srsymtable^.symtabletype=objectsymtable) and
assigned(aktprocsym) and
(po_classmethod in aktprocsym^.definition^.procoptions) then
Message(parser_e_only_class_methods);
{ no method pointer }
p1:=nil;
handle_propertysym(srsym,srsymtable,p1,pd);
end;
errorsym : begin
p1:=cerrornode.create;
p1.resulttype:=generrordef;
pd:=generrordef;
if token=_LKLAMMER then
begin
consume(_LKLAMMER);
parse_paras(false,false);
consume(_RKLAMMER);
end;
end;
else
begin
p1:=cerrornode.create;
pd:=generrordef;
Message(cg_e_illegal_expression);
end;
end; { end case }
end;
end;
),again,tcallnode(p1),pd);
if (block_type=bt_const) and
getprocvar then
handle_procvar(getprocvardef,p1);
if possible_error and
not(po_classmethod in tcallnode(p1).procdefinition^.procoptions) then
Message(parser_e_only_class_methods);
end;
propertysym :
begin
{ access to property in a method }
{ are we in a class method ? }
if (srsym^.owner^.symtabletype=objectsymtable) and
assigned(aktprocsym) and
(po_classmethod in aktprocsym^.definition^.procoptions) then
Message(parser_e_only_class_methods);
{ no method pointer }
p1:=nil;
handle_propertysym(srsym,srsymtable,p1,pd);
end;
labelsym :
begin
consume(_COLON);
if plabelsym(srsym)^.defined then
Message(sym_e_label_already_defined);
plabelsym(srsym)^.defined:=true;
p1:=clabelnode.create(plabelsym(srsym)^.lab,nil);
pd:=voiddef;
end;
errorsym :
begin
p1:=cerrornode.create;
p1.resulttype:=generrordef;
pd:=generrordef;
if token=_LKLAMMER then
begin
consume(_LKLAMMER);
parse_paras(false,false);
consume(_RKLAMMER);
end;
end;
else
begin
p1:=cerrornode.create;
pd:=generrordef;
Message(cg_e_illegal_expression);
end;
end; { end case }
end;
end;
@ -1522,7 +1517,6 @@ implementation
var
store_static : boolean;
{ p1 and p2 must contain valid value_str }
begin
check_tokenpos;
@ -1677,7 +1671,6 @@ implementation
while assigned(classh) do
begin
sym:=psym(classh^.symtable^.search(pattern));
srsymtable:=classh^.symtable;
if assigned(sym) then
break;
classh:=classh^.childof;
@ -1707,7 +1700,6 @@ implementation
while assigned(classh) do
begin
sym:=psym(classh^.symtable^.search(pattern));
srsymtable:=classh^.symtable;
if assigned(sym) then
break;
classh:=classh^.childof;
@ -1867,7 +1859,6 @@ implementation
while assigned(classh) do
begin
sym:=psym(classh^.symtable^.search(pattern));
srsymtable:=classh^.symtable;
if assigned(sym) then
break;
classh:=classh^.childof;
@ -1935,8 +1926,7 @@ implementation
classh:=procinfo^._class^.childof;
while assigned(classh) do
begin
srsymtable:=pobjectdef(classh)^.symtable;
sym:=psym(srsymtable^.search(hs));
sym:=psym(pobjectdef(classh)^.symtable^.search(hs));
if assigned(sym) then
begin
{ only for procsyms we need to set the type (PFV) }
@ -2420,7 +2410,10 @@ _LECKKLAMMER : begin
end.
{
$Log$
Revision 1.24 2000-12-25 00:07:27 peter
Revision 1.25 2001-03-11 22:58:50 peter
* getsym redesign, removed the globals srsym,srsymtable
Revision 1.24 2000/12/25 00:07:27 peter
+ new tlinkedlist class (merge of old tstringqueue,tcontainer and
tlinkedlist objects)

82
compiler/pstatmnt.pas
View File

@ -524,6 +524,8 @@ implementation
old_block_type : tblock_type;
exceptsymtable : psymtable;
objname : stringid;
srsym : psym;
srsymtable : psymtable;
begin
procinfo^.flags:=procinfo^.flags or
@ -576,19 +578,14 @@ implementation
if token=_ID then
begin
objname:=pattern;
getsym(objname,false);
{ can't use consume_sym here, because we need already
to check for the colon }
searchsym(objname,srsym,srsymtable);
consume(_ID);
{ is a explicit name for the exception given ? }
if try_to_consume(_COLON) then
begin
getsym(pattern,true);
consume(_ID);
if srsym^.typ=unitsym then
begin
consume(_POINT);
getsymonlyin(punitsym(srsym)^.unitsymtable,pattern);
consume(_ID);
end;
consume_sym(srsym,srsymtable);
if (srsym^.typ=typesym) and
is_class(ptypesym(srsym)^.restype.def) then
begin
@ -615,16 +612,23 @@ implementation
with "e: Exception" the e is not necessary }
if srsym=nil then
begin
Message1(sym_e_id_not_found,objname);
identifier_not_found(objname);
srsym:=generrorsym;
end;
{ only exception type }
{ support unit.identifier }
if srsym^.typ=unitsym then
begin
consume(_POINT);
getsymonlyin(punitsym(srsym)^.unitsymtable,pattern);
srsym:=searchsymonlyin(punitsym(srsym)^.unitsymtable,pattern);
consume(_ID);
if srsym=nil then
begin
identifier_not_found(objname);
srsym:=generrorsym;
end;
end;
{ check if type is valid, must be done here because
with "e: Exception" the e is not necessary }
if (srsym^.typ=typesym) and
is_class(ptypesym(srsym)^.restype.def) then
ot:=pobjectdef(ptypesym(srsym)^.restype.def)
@ -941,7 +945,7 @@ implementation
end
else
begin
p2:=ccallnode.create(pprocsym(sym),srsymtable,p2);
p2:=ccallnode.create(pprocsym(sym),sym^.owner,p2);
{ support dispose(p,done()); }
if try_to_consume(_LKLAMMER) then
begin
@ -1016,9 +1020,8 @@ implementation
p : tnode;
code : tnode;
filepos : tfileposinfo;
sr : plabelsym;
label
ready;
srsym : psym;
srsymtable : psymtable;
begin
filepos:=akttokenpos;
case token of
@ -1034,8 +1037,7 @@ implementation
end
else
begin
getsym(pattern,true);
consume(token);
consume_sym(srsym,srsymtable);
if srsym^.typ<>labelsym then
begin
Message(sym_e_id_is_no_label_id);
@ -1092,36 +1094,16 @@ implementation
Message(scan_f_end_of_file);
else
begin
if (token in [_INTCONST,_ID]) then
begin
getsym(pattern,true);
lastsymknown:=true;
lastsrsym:=srsym;
{ it is NOT necessarily the owner
it can be a withsymtable !!! }
lastsrsymtable:=srsymtable;
if assigned(srsym) and (srsym^.typ=labelsym) then
begin
consume(token);
consume(_COLON);
{ we must preserve srsym to set code later }
sr:=plabelsym(srsym);
if sr^.defined then
Message(sym_e_label_already_defined);
sr^.defined:=true;
{ statement modifies srsym }
lastsymknown:=false;
{ the pointer to the following instruction }
{ isn't a very clean way }
code:=clabelnode.create(sr^.lab,statement{$ifdef FPCPROCVAR}(){$endif});
sr^.code:=code;
{ sorry, but here is a jump the easiest way }
goto ready;
end;
end;
p:=expr;
if not(p.nodetype in [calln,assignn,breakn,inlinen,continuen]) then
if p.nodetype=labeln then
begin
{ the pointer to the following instruction }
{ isn't a very clean way }
tlabelnode(p).left:=statement{$ifdef FPCPROCVAR}(){$endif};
end;
if not(p.nodetype in [calln,assignn,breakn,inlinen,continuen,labeln]) then
Message(cg_e_illegal_expression);
{ specify that we don't use the value returned by the call }
{ Question : can this be also improtant
@ -1134,7 +1116,6 @@ implementation
code:=p;
end;
end;
ready:
if assigned(code) then
code.set_tree_filepos(filepos);
statement:=code;
@ -1259,7 +1240,10 @@ implementation
end.
{
$Log$
Revision 1.19 2000-12-25 00:07:27 peter
Revision 1.20 2001-03-11 22:58:50 peter
* getsym redesign, removed the globals srsym,srsymtable
Revision 1.19 2000/12/25 00:07:27 peter
+ new tlinkedlist class (merge of old tstringqueue,tcontainer and
tlinkedlist objects)

6
compiler/ptconst.pas
View File

@ -77,6 +77,7 @@ implementation
tmpguid : tguid;
aktpos : longint;
obj : pobjectdef;
srsym : psym;
symt : psymtable;
value : bestreal;
strval : pchar;
@ -864,7 +865,10 @@ implementation
end.
{
$Log$
Revision 1.17 2001-02-04 11:12:16 jonas
Revision 1.18 2001-03-11 22:58:50 peter
* getsym redesign, removed the globals srsym,srsymtable
Revision 1.17 2001/02/04 11:12:16 jonas
* fixed web bug 1377 & const pointer arithmtic
Revision 1.16 2001/02/03 00:26:35 peter

11
compiler/ptype.pas
View File

@ -76,6 +76,8 @@ implementation
var
is_unit_specific : boolean;
pos : tfileposinfo;
srsym : psym;
srsymtable : psymtable;
begin
s:=pattern;
pos:=akttokenpos;
@ -95,13 +97,13 @@ implementation
end;
{ try to load the symbol to see if it's a unitsym }
is_unit_specific:=false;
getsym(s,false);
searchsym(s,srsym,srsymtable);
consume(_ID);
if assigned(srsym) and
(srsym^.typ=unitsym) then
begin
consume(_POINT);
getsymonlyin(punitsym(srsym)^.unitsymtable,pattern);
srsym:=searchsymonlyin(punitsym(srsym)^.unitsymtable,pattern);
pos:=akttokenpos;
s:=pattern;
consume(_ID);
@ -577,7 +579,10 @@ implementation
end.
{
$Log$
Revision 1.17 2000-12-07 17:19:43 jonas
Revision 1.18 2001-03-11 22:58:50 peter
* getsym redesign, removed the globals srsym,srsymtable
Revision 1.17 2000/12/07 17:19:43 jonas
* new constant handling: from now on, hex constants >$7fffffff are
parsed as unsigned constants (otherwise, $80000000 got sign extended
and became $ffffffff80000000), all constants in the longint range

32
compiler/rautils.pas
View File

@ -791,12 +791,12 @@ Function TOperand.SetupVar(const hs:string;GetOffset : boolean): Boolean;
{ if not found returns FALSE. }
var
sym : psym;
srsymtable : psymtable;
harrdef : parraydef;
Begin
SetupVar:=false;
{ are we in a routine ? }
getsym(hs,false);
sym:=srsym;
searchsym(hs,sym,srsymtable);
if sym=nil then
exit;
case sym^.typ of
@ -1179,8 +1179,11 @@ end;
****************************************************************************}
Function SearchType(const hs:string): Boolean;
var
srsym : psym;
srsymtable : psymtable;
begin
getsym(hs,false);
searchsym(hs,srsym,srsymtable);
SearchType:=assigned(srsym) and
(srsym^.typ=typesym);
end;
@ -1188,10 +1191,13 @@ end;
Function SearchRecordType(const s:string): boolean;
var
srsym : psym;
srsymtable : psymtable;
Begin
SearchRecordType:=false;
{ Check the constants in symtable }
getsym(s,false);
searchsym(s,srsym,srsymtable);
if srsym <> nil then
Begin
case srsym^.typ of
@ -1217,6 +1223,9 @@ Function SearchIConstant(const s:string; var l:longint): boolean;
{ Remarks: Also handle TRUE and FALSE returning in those cases 1 and 0 }
{ respectively. }
{**********************************************************************}
var
srsym : psym;
srsymtable : psymtable;
Begin
SearchIConstant:=false;
{ check for TRUE or FALSE reserved words first }
@ -1233,7 +1242,7 @@ Begin
exit;
end;
{ Check the constants in symtable }
getsym(s,false);
searchsym(s,srsym,srsymtable);
if srsym <> nil then
Begin
case srsym^.typ of
@ -1266,6 +1275,7 @@ var
st : psymtable;
harrdef : parraydef;
sym : psym;
srsymtable : psymtable;
i : longint;
base : string;
Begin
@ -1281,8 +1291,7 @@ Begin
st:=procinfo^._class^.symtable
else
begin
getsym(base,false);
sym:=srsym;
searchsym(base,sym,srsymtable);
st:=nil;
{ we can start with a var,type,typedconst }
case sym^.typ of
@ -1365,14 +1374,14 @@ end;
Function SearchLabel(const s: string; var hl: pasmlabel;emit:boolean): boolean;
var
sym : psym;
srsymtable : psymtable;
hs : string;
Begin
hl:=nil;
SearchLabel:=false;
{ Check for pascal labels, which are case insensetive }
hs:=upper(s);
getsym(hs,false);
sym:=srsym;
searchsym(hs,sym,srsymtable);
if sym=nil then
exit;
case sym^.typ of
@ -1556,7 +1565,10 @@ end;
end.
{
$Log$
Revision 1.15 2001-02-26 19:44:54 peter
Revision 1.16 2001-03-11 22:58:50 peter
* getsym redesign, removed the globals srsym,srsymtable
Revision 1.15 2001/02/26 19:44:54 peter
* merged generic m68k updates from fixes branch
Revision 1.14 2000/12/25 00:07:28 peter

15
compiler/symdef.pas
View File

@ -5425,6 +5425,8 @@ Const local_symtable_index : longint = $8001;
var st : string;
symt : psymtable;
srsym : psym;
srsymtable : psymtable;
old_make_ref : boolean;
begin
old_make_ref:=make_ref;
@ -5434,7 +5436,7 @@ Const local_symtable_index : longint = $8001;
if pos('.',s) > 0 then
begin
st := copy(s,1,pos('.',s)-1);
getsym(st,false);
searchsym(st,srsym,srsymtable);
st := copy(s,pos('.',s)+1,255);
if assigned(srsym) then
begin
@ -5445,8 +5447,10 @@ Const local_symtable_index : longint = $8001;
end else srsym := nil;
end;
end else st := s;
if srsym = nil then getsym(st,true);
if srsym^.typ<>typesym then
if srsym = nil then
searchsym(st,srsym,srsymtable);
if (srsym=nil) or
(srsym^.typ<>typesym) then
begin
Message(type_e_type_id_expected);
exit;
@ -5561,7 +5565,10 @@ Const local_symtable_index : longint = $8001;
end.
{
$Log$
Revision 1.20 2001-01-06 20:11:29 peter
Revision 1.21 2001-03-11 22:58:50 peter
* getsym redesign, removed the globals srsym,srsymtable
Revision 1.20 2001/01/06 20:11:29 peter
* merged c packrecords fix
Revision 1.19 2000/12/25 00:07:29 peter

23
compiler/symsym.pas
View File

@ -1186,10 +1186,7 @@ implementation
absseg:=false;
case abstyp of
tovar :
begin
asmname:=stringdup(readstring);
ref:=pstoredsym(srsym);
end;
asmname:=stringdup(readstring);
toasm :
asmname:=stringdup(readstring);
toaddr :
@ -1231,16 +1228,19 @@ implementation
procedure tabsolutesym.deref;
var
srsym : psym;
srsymtable : psymtable;
begin
tvarsym.deref;
if (abstyp=tovar) and (asmname<>nil) then
begin
{ search previous loaded symtables }
getsym(asmname^,false);
if not(assigned(srsym)) then
getsymonlyin(owner,asmname^);
if not(assigned(srsym)) then
srsym:=generrorsym;
searchsym(asmname^,srsym,srsymtable);
if not assigned(srsym) then
srsym:=searchsymonlyin(owner,asmname^);
if not assigned(srsym) then
srsym:=generrorsym;
ref:=pstoredsym(srsym);
stringdispose(asmname);
end;
@ -2471,7 +2471,10 @@ implementation
end.
{
$Log$
Revision 1.7 2000-12-25 00:07:30 peter
Revision 1.8 2001-03-11 22:58:51 peter
* getsym redesign, removed the globals srsym,srsymtable
Revision 1.7 2000/12/25 00:07:30 peter
+ new tlinkedlist class (merge of old tstringqueue,tcontainer and
tlinkedlist objects)

166
compiler/symtable.pas
View File

@ -116,19 +116,14 @@ interface
var
srsym : psym; { result of the last search }
srsymtable : psymtable;
lastsrsym : psym; { last sym found in statement }
lastsrsymtable : psymtable;
lastsymknown : boolean;
constsymtable : psymtable; { symtable were the constants can be inserted }
systemunit : punitsymtable; { pointer to the system unit }
read_member : boolean; { reading members of an symtable }
read_member : boolean; { reading members of an symtable }
lexlevel : longint; { level of code }
{ 1 for main procedure }
{ 2 for normal function or proc }
{ higher for locals }
lexlevel : longint; { level of code }
{ 1 for main procedure }
{ 2 for normal function or proc }
{ higher for locals }
{****************************************************************************
Functions
@ -138,11 +133,13 @@ interface
function globaldef(const s : string) : pdef;
function findunitsymtable(st:psymtable):psymtable;
procedure duplicatesym(sym:psym);
procedure identifier_not_found(const s:string);
{*** Search ***}
function searchsym(const s : stringid;var srsym:psym;var srsymtable:psymtable):boolean;
function search_a_symtable(const symbol:string;symtabletype:tsymtabletype):Psym;
procedure getsym(const s : stringid;notfounderror : boolean);
procedure getsymonlyin(p : psymtable;const s : stringid);
function searchsymonlyin(p : psymtable;const s : stringid):psym;
function search_class_member(pd : pobjectdef;const s : string):psym;
{*** PPU Write/Loading ***}
procedure writeunitas(const s : string;unittable : punitsymtable;only_crc : boolean);
@ -150,7 +147,6 @@ interface
procedure load_interface;
{*** Object Helpers ***}
function search_class_member(pd : pobjectdef;const n : string) : psym;
function search_default_property(pd : pobjectdef) : ppropertysym;
{*** symtable stack ***}
@ -386,6 +382,8 @@ implementation
procedure chainprocsym(p : psym);
var
storesymtablestack : psymtable;
srsym : psym;
srsymtable : psymtable;
begin
if p^.typ=procsym then
begin
@ -394,8 +392,9 @@ implementation
while assigned(symtablestack) do
begin
{ search for same procsym in other units }
getsym(p^.name,false);
if assigned(srsym) and (srsym^.typ=procsym) then
searchsym(p^.name,srsym,srsymtable)
if assigned(srsym) and
(srsym^.typ=procsym) then
begin
pprocsym(p)^.nextprocsym:=pprocsym(srsym);
symtablestack:=storesymtablestack;
@ -448,6 +447,8 @@ implementation
p : pprocsym;
t : ttoken;
def : pprocdef;
srsym : psym;
srsymtable,
storesymtablestack : psymtable;
begin
storesymtablestack:=symtablestack;
@ -461,12 +462,15 @@ implementation
{ each operator has a unique lowercased internal name PM }
while assigned(symtablestack) do
begin
getsym(overloaded_names[t],false);
if (t=_STARSTAR) and (srsym=nil) then
begin
symtablestack:=systemunit;
getsym('POWER',false);
end;
searchsym(overloaded_names[t],srsym,srsymtable);
if not assigned(srsym) then
begin
if (t=_STARSTAR) then
begin
symtablestack:=systemunit;
searchsym('POWER',srsym,srsymtable);
end;
end;
if assigned(srsym) then
begin
if (srsym^.typ<>procsym) then
@ -486,7 +490,7 @@ implementation
(def^.nextoverloaded^.owner=p^.owner) do
def:=def^.nextoverloaded;
def^.nextoverloaded:=nil;
symtablestack:=srsymtable^.next;
symtablestack:=srsym^.owner^.next;
end
else
begin
@ -734,7 +738,6 @@ implementation
procedure tstoredsymtable.prederef;
var
hp : pdef;
hs : psym;
begin
{ first deref the ttypesyms }
@ -1085,8 +1088,8 @@ implementation
is_object(pdef(defowner))
) then
begin
hsym:=search_class_member(pobjectdef(defowner),sym^.name);
{ but private ids can be reused }
hsym:=search_class_member(pobjectdef(defowner),sym^.name);
if assigned(hsym) and
(not(sp_private in hsym^.symoptions) or
(hsym^.owner^.defowner^.owner^.symtabletype<>unitsymtable)) then
@ -2047,7 +2050,7 @@ implementation
{ show a fatal that you need -S2 or -Sd, but only
if we just parsed the a token that has m_class }
if not(m_class in aktmodeswitches) and
(s=pattern) and
(Upper(s)=pattern) and
(tokeninfo^[idtoken].keyword=m_class) then
Message(parser_f_need_objfpc_or_delphi_mode);
end;
@ -2058,55 +2061,73 @@ implementation
Search
*****************************************************************************}
procedure getsym(const s : stringid;notfounderror : boolean);
function searchsym(const s : stringid;var srsym:psym;var srsymtable:psymtable):boolean;
var
speedvalue : longint;
begin
speedvalue:=getspeedvalue(s);
lastsrsym:=nil;
srsymtable:=symtablestack;
while assigned(srsymtable) do
begin
srsym:=psym(srsymtable^.speedsearch(s,speedvalue));
if assigned(srsym) then
exit
begin
searchsym:=true;
exit;
end
else
srsymtable:=srsymtable^.next;
srsymtable:=srsymtable^.next;
end;
if notfounderror then
begin
identifier_not_found(s);
srsym:=generrorsym;
end
else
srsym:=nil;
searchsym:=false;
end;
procedure getsymonlyin(p : psymtable;const s : stringid);
function searchsymonlyin(p : psymtable;const s : stringid):psym;
var
srsym : psym;
begin
{ the caller have to take care if srsym=nil (FK) }
srsym:=nil;
{ the caller have to take care if srsym=nil }
if assigned(p) then
begin
srsymtable:=p;
srsym:=psym(srsymtable^.search(s));
srsym:=psym(p^.search(s));
if assigned(srsym) then
exit
else
begin
if (punitsymtable(srsymtable)=punitsymtable(current_module.globalsymtable)) then
begin
getsymonlyin(psymtable(current_module.localsymtable),s);
if assigned(srsym) then
srsymtable:=psymtable(current_module.localsymtable)
else
identifier_not_found(s);
end
else
identifier_not_found(s);
searchsymonlyin:=srsym;
exit;
end;
{ also check in the local symtbale if it exists }
if (punitsymtable(p)=punitsymtable(current_module.globalsymtable)) then
begin
srsym:=psym(psymtable(current_module.localsymtable)^.search(s));
if assigned(srsym) then
begin
searchsymonlyin:=srsym;
exit;
end;
end
end;
searchsymonlyin:=nil;
end;
function search_class_member(pd : pobjectdef;const s : string):psym;
{ searches n in symtable of pd and all anchestors }
var
speedvalue : longint;
srsym : psym;
begin
speedvalue:=getspeedvalue(s);
while assigned(pd) do
begin
srsym:=psym(pd^.symtable^.speedsearch(s,speedvalue));
if assigned(srsym) then
begin
search_class_member:=srsym;
exit;
end;
pd:=pd^.childof;
end;
search_class_member:=nil;
end;
@ -2138,12 +2159,14 @@ implementation
var st : string;
symt : psymtable;
srsym : psym;
srsymtable : psymtable;
begin
srsym := nil;
if pos('.',s) > 0 then
begin
st := copy(s,1,pos('.',s)-1);
getsym(st,false);
searchsym(st,srsym,srsymtable);
st := copy(s,pos('.',s)+1,255);
if assigned(srsym) then
begin
@ -2154,10 +2177,12 @@ implementation
end else srsym := nil;
end;
end else st := s;
if srsym = nil then getsym(st,false);
if srsym = nil then
getsymonlyin(systemunit,st);
if srsym^.typ<>typesym then
searchsym(st,srsym,srsymtable);
if srsym = nil then
srsym:=searchsymonlyin(systemunit,st);
if (not assigned(srsym)) or
(srsym^.typ<>typesym) then
begin
Message(type_e_type_id_expected);
exit;
@ -2169,28 +2194,6 @@ implementation
Object Helpers
****************************************************************************}
function search_class_member(pd : pobjectdef;const n : string) : psym;
{ searches n in symtable of pd and all anchestors }
var
sym : psym;
begin
sym:=nil;
while assigned(pd) do
begin
sym:=psym(pd^.symtable^.search(n));
if assigned(sym) then
break;
pd:=pd^.childof;
end;
{ this is needed for static methods in do_member_read pexpr unit PM
caused bug0214 }
if assigned(sym) then
begin
srsymtable:=pd^.symtable;
end;
search_class_member:=sym;
end;
var
_defaultprop : ppropertysym;
@ -2374,7 +2377,10 @@ implementation
end.
{
$Log$
Revision 1.26 2001-02-21 19:37:19 peter
Revision 1.27 2001-03-11 22:58:51 peter
* getsym redesign, removed the globals srsym,srsymtable
Revision 1.26 2001/02/21 19:37:19 peter
* moved deref to be done after loading of implementation units. prederef
is still done directly after loading of symbols and definitions.