From d8abf76f6bc9d824e8f192e7680c7adf809ebd59 Mon Sep 17 00:00:00 2001
From: peter <peter@freepascal.org>
Date: Sun, 11 Mar 2001 22:58:49 +0000
Subject: [PATCH] * getsym redesign, removed the globals srsym,srsymtable
---
compiler/i386/ag386bin.pas | 7 +-
compiler/i386/n386cal.pas | 11 +-
compiler/i386/n386mem.pas | 10 +-
compiler/i386/n386util.pas | 20 +-
compiler/i386/ra386att.pas | 33 +-
compiler/i386/ra386dir.pas | 15 +-
compiler/i386/ra386int.pas | 34 +-
compiler/pbase.pas | 53 ++-
compiler/pdecl.pas | 13 +-
compiler/pdecobj.pas | 20 +-
compiler/pdecsub.pas | 36 ++-
compiler/pdecvar.pas | 37 +--
compiler/pexports.pas | 179 +++++-----
compiler/pexpr.pas | 645 ++++++++++++++++++-------------------
compiler/pstatmnt.pas | 82 ++---
compiler/ptconst.pas | 6 +-
compiler/ptype.pas | 11 +-
compiler/rautils.pas | 32 +-
compiler/symdef.pas | 15 +-
compiler/symsym.pas | 23 +-
compiler/symtable.pas | 166 +++++-----
21 files changed, 765 insertions(+), 683 deletions(-)
diff --git a/compiler/i386/ag386bin.pas b/compiler/i386/ag386bin.pas
index d6163b048d..e1a34fc173 100644
--- a/compiler/i386/ag386bin.pas
+++ b/compiler/i386/ag386bin.pas
@@ -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
diff --git a/compiler/i386/n386cal.pas b/compiler/i386/n386cal.pas
index 8862e28f97..525f697b34 100644
--- a/compiler/i386/n386cal.pas
+++ b/compiler/i386/n386cal.pas
@@ -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
diff --git a/compiler/i386/n386mem.pas b/compiler/i386/n386mem.pas
index 78d5546a46..60d60e45b7 100644
--- a/compiler/i386/n386mem.pas
+++ b/compiler/i386/n386mem.pas
@@ -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
diff --git a/compiler/i386/n386util.pas b/compiler/i386/n386util.pas
index bef338f43d..c7e138671f 100644
--- a/compiler/i386/n386util.pas
+++ b/compiler/i386/n386util.pas
@@ -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
diff --git a/compiler/i386/ra386att.pas b/compiler/i386/ra386att.pas
index 64c05b66cb..6d3a36cad5 100644
--- a/compiler/i386/ra386att.pas
+++ b/compiler/i386/ra386att.pas
@@ -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)
diff --git a/compiler/i386/ra386dir.pas b/compiler/i386/ra386dir.pas
index 4a7c77ce98..0ed177472c 100644
--- a/compiler/i386/ra386dir.pas
+++ b/compiler/i386/ra386dir.pas
@@ -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)
diff --git a/compiler/i386/ra386int.pas b/compiler/i386/ra386int.pas
index 50bf91c352..43ac0835cc 100644
--- a/compiler/i386/ra386int.pas
+++ b/compiler/i386/ra386int.pas
@@ -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
diff --git a/compiler/pbase.pas b/compiler/pbase.pas
index 5c32df99b4..6cf4ab0dbe 100644
--- a/compiler/pbase.pas
+++ b/compiler/pbase.pas
@@ -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)
diff --git a/compiler/pdecl.pas b/compiler/pdecl.pas
index acd01fd04e..462f32a579 100644
--- a/compiler/pdecl.pas
+++ b/compiler/pdecl.pas
@@ -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)
diff --git a/compiler/pdecobj.pas b/compiler/pdecobj.pas
index 634e18b2e0..be52e3d78b 100644
--- a/compiler/pdecobj.pas
+++ b/compiler/pdecobj.pas
@@ -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)
diff --git a/compiler/pdecsub.pas b/compiler/pdecsub.pas
index 67278034d7..e918e1afa0 100644
--- a/compiler/pdecsub.pas
+++ b/compiler/pdecsub.pas
@@ -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!
diff --git a/compiler/pdecvar.pas b/compiler/pdecvar.pas
index 33a7ced351..eb3b7561ff 100644
--- a/compiler/pdecvar.pas
+++ b/compiler/pdecvar.pas
@@ -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!
diff --git a/compiler/pexports.pas b/compiler/pexports.pas
index f4f1d6f44c..1c53dba9b6 100644
--- a/compiler/pexports.pas
+++ b/compiler/pexports.pas
@@ -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
diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas
index 3c19a8d4ce..6d9f257c6f 100644
--- a/compiler/pexpr.pas
+++ b/compiler/pexpr.pas
@@ -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)
diff --git a/compiler/pstatmnt.pas b/compiler/pstatmnt.pas
index 99c1f2ea96..f3cc24fc62 100644
--- a/compiler/pstatmnt.pas
+++ b/compiler/pstatmnt.pas
@@ -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)
diff --git a/compiler/ptconst.pas b/compiler/ptconst.pas
index b44908a3a1..69a84b3289 100644
--- a/compiler/ptconst.pas
+++ b/compiler/ptconst.pas
@@ -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
diff --git a/compiler/ptype.pas b/compiler/ptype.pas
index ec9eb309ef..c62f732431 100644
--- a/compiler/ptype.pas
+++ b/compiler/ptype.pas
@@ -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
diff --git a/compiler/rautils.pas b/compiler/rautils.pas
index 5690e75df7..c9705a043f 100644
--- a/compiler/rautils.pas
+++ b/compiler/rautils.pas
@@ -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
diff --git a/compiler/symdef.pas b/compiler/symdef.pas
index 3acbdf7f1d..e97231dc0d 100644
--- a/compiler/symdef.pas
+++ b/compiler/symdef.pas
@@ -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
diff --git a/compiler/symsym.pas b/compiler/symsym.pas
index 0fb8f04a27..7bab060e03 100644
--- a/compiler/symsym.pas
+++ b/compiler/symsym.pas
@@ -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)
diff --git a/compiler/symtable.pas b/compiler/symtable.pas
index 6f553ca7d1..ab88282fc5 100644
--- a/compiler/symtable.pas
+++ b/compiler/symtable.pas
@@ -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.