|
@@ -32,10 +32,6 @@ uses
|
|
|
typecanbeforward : boolean = false;
|
|
|
|
|
|
var
|
|
|
- { ttypesym read by read_type, this is needed to be
|
|
|
- stored in the ppu for resolving purposes }
|
|
|
- readtypesym : ptypesym;
|
|
|
-
|
|
|
{ hack, which allows to use the current parsed }
|
|
|
{ object type as function argument type }
|
|
|
testcurobject : byte;
|
|
@@ -50,9 +46,9 @@ uses
|
|
|
|
|
|
{ reads a string, file type or a type id and returns a name and }
|
|
|
{ pdef }
|
|
|
- function single_type(var s : string;isforwarddef:boolean) : pdef;
|
|
|
+ procedure single_type(var tt:ttype;var s : string;isforwarddef:boolean);
|
|
|
|
|
|
- function read_type(const name : stringid) : pdef;
|
|
|
+ procedure read_type(var tt:ttype;const name : stringid);
|
|
|
|
|
|
|
|
|
implementation
|
|
@@ -115,8 +111,8 @@ uses
|
|
|
end;
|
|
|
|
|
|
|
|
|
- function id_type(var s : string;isforwarddef:boolean) : pdef;
|
|
|
- { reads a type definition and returns a pointer }
|
|
|
+ procedure id_type(var tt : ttype;var s : string;isforwarddef:boolean);
|
|
|
+ { reads a type definition }
|
|
|
{ to a appropriating pdef, s gets the name of }
|
|
|
{ the type to allow name mangling }
|
|
|
var
|
|
@@ -128,14 +124,14 @@ uses
|
|
|
{ classes can be used also in classes }
|
|
|
if (curobjectname=pattern) and aktobjectdef^.is_class then
|
|
|
begin
|
|
|
- id_type:=aktobjectdef;
|
|
|
+ tt.setdef(aktobjectdef);
|
|
|
consume(_ID);
|
|
|
exit;
|
|
|
end;
|
|
|
{ objects can be parameters }
|
|
|
if (testcurobject=2) and (curobjectname=pattern) then
|
|
|
begin
|
|
|
- id_type:=aktobjectdef;
|
|
|
+ tt.setdef(aktobjectdef);
|
|
|
consume(_ID);
|
|
|
exit;
|
|
|
end;
|
|
@@ -157,46 +153,47 @@ uses
|
|
|
if isforwarddef and
|
|
|
not(is_unit_specific) then
|
|
|
begin
|
|
|
- id_type:=new(pforwarddef,init(s,pos));
|
|
|
+ tt.setdef(new(pforwarddef,init(s,pos)));
|
|
|
exit;
|
|
|
end;
|
|
|
{ unknown sym ? }
|
|
|
if not assigned(srsym) then
|
|
|
begin
|
|
|
Message1(sym_e_id_not_found,s);
|
|
|
- id_type:=generrordef;
|
|
|
+ tt.setdef(generrordef);
|
|
|
exit;
|
|
|
end;
|
|
|
if (srsym^.typ<>typesym) then
|
|
|
begin
|
|
|
Message(type_e_type_id_expected);
|
|
|
- id_type:=generrordef;
|
|
|
+ tt.setdef(generrordef);
|
|
|
exit;
|
|
|
end;
|
|
|
- { can't use in [] here, becuase unitid can be > 255 }
|
|
|
+ { Only use the definitions for system/current unit, becuase
|
|
|
+ they can be refered from the parameters and symbols are not
|
|
|
+ loaded at that time. A symbol reference to an other unit
|
|
|
+ is still possible, because it's already loaded (PFV)
|
|
|
+ can't use in [] here, becuase unitid can be > 255 }
|
|
|
if (ptypesym(srsym)^.owner^.unitid=0) or
|
|
|
(ptypesym(srsym)^.owner^.unitid=1) then
|
|
|
- readtypesym:=nil
|
|
|
+ tt.setdef(ptypesym(srsym)^.restype.def)
|
|
|
else
|
|
|
- readtypesym:=ptypesym(srsym);
|
|
|
- { return the definition of the type }
|
|
|
- id_type:=ptypesym(srsym)^.definition;
|
|
|
+ tt.setsym(srsym);
|
|
|
end;
|
|
|
|
|
|
|
|
|
- function single_type(var s : string;isforwarddef:boolean) : pdef;
|
|
|
+ procedure single_type(var tt:ttype;var s : string;isforwarddef:boolean);
|
|
|
{ reads a string, file type or a type id and returns a name and }
|
|
|
{ pdef }
|
|
|
var
|
|
|
hs : string;
|
|
|
+ t2 : ttype;
|
|
|
begin
|
|
|
- readtypesym:=nil;
|
|
|
case token of
|
|
|
_STRING:
|
|
|
begin
|
|
|
- single_type:=string_dec;
|
|
|
+ tt.setdef(string_dec);
|
|
|
s:='STRING';
|
|
|
- readtypesym:=nil;
|
|
|
end;
|
|
|
_FILE:
|
|
|
begin
|
|
@@ -204,19 +201,19 @@ uses
|
|
|
if token=_OF then
|
|
|
begin
|
|
|
consume(_OF);
|
|
|
- single_type:=new(pfiledef,init(ft_typed,single_type(hs,false)));
|
|
|
+ single_type(t2,hs,false);
|
|
|
+ tt.setdef(new(pfiledef,inittyped(t2)));
|
|
|
s:='FILE$OF$'+hs;
|
|
|
end
|
|
|
else
|
|
|
begin
|
|
|
- single_type:=cfiledef;
|
|
|
+ tt.setdef(cfiledef);
|
|
|
s:='FILE';
|
|
|
end;
|
|
|
- readtypesym:=nil;
|
|
|
end;
|
|
|
else
|
|
|
begin
|
|
|
- single_type:=id_type(s,isforwarddef);
|
|
|
+ id_type(tt,s,isforwarddef);
|
|
|
end;
|
|
|
end;
|
|
|
end;
|
|
@@ -253,20 +250,12 @@ uses
|
|
|
if (aktclass^.is_class) then
|
|
|
begin
|
|
|
{ CLASS constructors return the created instance }
|
|
|
- aktprocsym^.definition^.retdef:=aktclass;
|
|
|
+ aktprocsym^.definition^.rettype.def:=aktclass;
|
|
|
end
|
|
|
else
|
|
|
begin
|
|
|
{ OBJECT constructors return a boolean }
|
|
|
-{$IfDef GDB}
|
|
|
- {GDB doesn't like unnamed types !}
|
|
|
- aktprocsym^.definition^.retdef:=
|
|
|
- globaldef('boolean');
|
|
|
-{$Else GDB}
|
|
|
- aktprocsym^.definition^.retdef:=
|
|
|
- new(porddef,init(bool8bit,0,1));
|
|
|
-
|
|
|
-{$Endif GDB}
|
|
|
+ aktprocsym^.definition^.rettype.setdef(booldef);
|
|
|
end;
|
|
|
end;
|
|
|
end;
|
|
@@ -296,64 +285,6 @@ uses
|
|
|
get_procdef:=p;
|
|
|
end;
|
|
|
|
|
|
- procedure deletepropsymlist(p : ppropsymlist);
|
|
|
-
|
|
|
- var
|
|
|
- hp : ppropsymlist;
|
|
|
-
|
|
|
- begin
|
|
|
- while assigned(p) do
|
|
|
- begin
|
|
|
- hp:=p;
|
|
|
- p:=p^.next;
|
|
|
- dispose(hp);
|
|
|
- end;
|
|
|
- end;
|
|
|
-
|
|
|
- procedure addpropsymlist(var root:ppropsymlist;s:psym);
|
|
|
- var
|
|
|
- last,hp : ppropsymlist;
|
|
|
- begin
|
|
|
- if not assigned(s) then
|
|
|
- exit;
|
|
|
- last:=root;
|
|
|
- new(hp);
|
|
|
- hp^.sym:=s;
|
|
|
- hp^.next:=nil;
|
|
|
- if assigned(last) then
|
|
|
- begin
|
|
|
- while assigned(last^.next) do
|
|
|
- last:=last^.next;
|
|
|
- last^.next:=hp;
|
|
|
- end
|
|
|
- else
|
|
|
- root:=hp;
|
|
|
- end;
|
|
|
-
|
|
|
- function copypropsymlist(s:ppropsymlist):ppropsymlist;
|
|
|
- var
|
|
|
- root,last,hp : ppropsymlist;
|
|
|
- begin
|
|
|
- copypropsymlist:=nil;
|
|
|
- if not assigned(s) then
|
|
|
- exit;
|
|
|
- last:=nil;
|
|
|
- root:=nil;
|
|
|
- while assigned(s) do
|
|
|
- begin
|
|
|
- new(hp);
|
|
|
- hp^.sym:=s^.sym;
|
|
|
- hp^.next:=nil;
|
|
|
- if assigned(last) then
|
|
|
- last^.next:=hp;
|
|
|
- last:=hp;
|
|
|
- if not assigned(root) then
|
|
|
- root:=hp;
|
|
|
- s:=s^.next;
|
|
|
- end;
|
|
|
- copypropsymlist:=root;
|
|
|
- end;
|
|
|
-
|
|
|
var
|
|
|
hp2,datacoll : pparaitem;
|
|
|
p,p2 : ppropertysym;
|
|
@@ -361,8 +292,8 @@ uses
|
|
|
hs : string;
|
|
|
varspez : tvarspez;
|
|
|
sc : pstringcontainer;
|
|
|
- hp : pdef;
|
|
|
s : string;
|
|
|
+ tt : ttype;
|
|
|
declarepos : tfileposinfo;
|
|
|
pp : pprocdef;
|
|
|
pt : ptree;
|
|
@@ -418,22 +349,22 @@ uses
|
|
|
consume(_ARRAY);
|
|
|
consume(_OF);
|
|
|
{ define range and type of range }
|
|
|
- hp:=new(parraydef,init(0,-1,s32bitdef));
|
|
|
+ tt.setdef(new(parraydef,init(0,-1,s32bitdef)));
|
|
|
{ define field type }
|
|
|
- parraydef(hp)^.definition:=single_type(s,false);
|
|
|
+ single_type(parraydef(tt.def)^.elementtype,s,false);
|
|
|
end
|
|
|
else
|
|
|
- hp:=single_type(s,false);
|
|
|
+ single_type(tt,s,false);
|
|
|
end
|
|
|
else
|
|
|
- hp:=cformaldef;
|
|
|
+ tt.setdef(cformaldef);
|
|
|
repeat
|
|
|
s:=sc^.get_with_tokeninfo(declarepos);
|
|
|
if s='' then
|
|
|
break;
|
|
|
new(hp2,init);
|
|
|
hp2^.paratyp:=varspez;
|
|
|
- hp2^.data:=hp;
|
|
|
+ hp2^.paratype:=tt;
|
|
|
propertyparas^.insert(hp2);
|
|
|
until false;
|
|
|
dispose(sc,done);
|
|
@@ -446,7 +377,7 @@ uses
|
|
|
if (token=_COLON) or not(propertyparas^.empty) then
|
|
|
begin
|
|
|
consume(_COLON);
|
|
|
- p^.proptype:=single_type(hs,false);
|
|
|
+ single_type(p^.proptype,hs,false);
|
|
|
if (idtoken=_INDEX) then
|
|
|
begin
|
|
|
consume(_INDEX);
|
|
@@ -456,12 +387,12 @@ uses
|
|
|
is_64bitint(pt^.resulttype) then
|
|
|
Message(parser_e_invalid_property_index_value);
|
|
|
p^.index:=pt^.value;
|
|
|
- p^.indexdef:=pt^.resulttype;
|
|
|
+ p^.indextype.setdef(pt^.resulttype);
|
|
|
include(p^.propoptions,ppo_indexed);
|
|
|
{ concat a longint to the para template }
|
|
|
new(hp2,init);
|
|
|
hp2^.paratyp:=vs_value;
|
|
|
- hp2^.data:=pt^.resulttype;
|
|
|
+ hp2^.paratype:=p^.indextype;
|
|
|
propertyparas^.insert(hp2);
|
|
|
disposetree(pt);
|
|
|
end;
|
|
@@ -475,40 +406,26 @@ uses
|
|
|
overriden:=search_class_member(aktclass,propname);
|
|
|
if assigned(overriden) and (overriden^.typ=propertysym) then
|
|
|
begin
|
|
|
- { take the whole info: }
|
|
|
- p^.propoptions:=ppropertysym(overriden)^.propoptions;
|
|
|
- p^.index:=ppropertysym(overriden)^.index;
|
|
|
- p^.proptype:=ppropertysym(overriden)^.proptype;
|
|
|
- p^.proptypesym:=ppropertysym(overriden);
|
|
|
- p^.writeaccesssym:=copypropsymlist(ppropertysym(overriden)^.writeaccesssym);
|
|
|
- p^.readaccesssym:=copypropsymlist(ppropertysym(overriden)^.readaccesssym);
|
|
|
- p^.storedsym:=copypropsymlist(ppropertysym(overriden)^.storedsym);
|
|
|
- p^.writeaccessdef:=ppropertysym(overriden)^.writeaccessdef;
|
|
|
- p^.readaccessdef:=ppropertysym(overriden)^.readaccessdef;
|
|
|
- p^.storeddef:=ppropertysym(overriden)^.storeddef;
|
|
|
- p^.indexdef:=ppropertysym(overriden)^.indexdef;
|
|
|
- p^.default:=ppropertysym(overriden)^.default;
|
|
|
+ p^.dooverride(ppropertysym(overriden));
|
|
|
end
|
|
|
else
|
|
|
begin
|
|
|
- p^.proptype:=generrordef;
|
|
|
- message(parser_e_no_property_found_to_override);
|
|
|
+ p^.proptype.setdef(generrordef);
|
|
|
+ message(parser_e_no_property_found_to_override);
|
|
|
end;
|
|
|
end;
|
|
|
if (sp_published in current_object_option) and
|
|
|
- not(p^.proptype^.is_publishable) then
|
|
|
+ not(p^.proptype.def^.is_publishable) then
|
|
|
Message(parser_e_cant_publish_that_property);
|
|
|
|
|
|
{ create data defcoll to allow correct parameter checks }
|
|
|
new(datacoll,init);
|
|
|
datacoll^.paratyp:=vs_value;
|
|
|
- datacoll^.data:=p^.proptype;
|
|
|
+ datacoll^.paratype:=p^.proptype;
|
|
|
|
|
|
if (idtoken=_READ) then
|
|
|
begin
|
|
|
- if assigned(p^.readaccesssym) then
|
|
|
- deletepropsymlist(p^.readaccesssym);
|
|
|
- p^.readaccesssym:=nil;
|
|
|
+ p^.readaccess^.clear;
|
|
|
consume(_READ);
|
|
|
sym:=search_class_member(aktclass,pattern);
|
|
|
if not(assigned(sym)) then
|
|
@@ -521,11 +438,11 @@ uses
|
|
|
consume(_ID);
|
|
|
while (token=_POINT) and
|
|
|
((sym^.typ=varsym) and
|
|
|
- (pvarsym(sym)^.definition^.deftype=recorddef)) do
|
|
|
+ (pvarsym(sym)^.vartype.def^.deftype=recorddef)) do
|
|
|
begin
|
|
|
- addpropsymlist(p^.readaccesssym,sym);
|
|
|
+ p^.readaccess^.addsym(sym);
|
|
|
consume(_POINT);
|
|
|
- getsymonlyin(precorddef(pvarsym(sym)^.definition)^.symtable,pattern);
|
|
|
+ getsymonlyin(precorddef(pvarsym(sym)^.vartype.def)^.symtable,pattern);
|
|
|
if not assigned(srsym) then
|
|
|
Message1(sym_e_illegal_field,pattern);
|
|
|
sym:=srsym;
|
|
@@ -541,27 +458,25 @@ uses
|
|
|
begin
|
|
|
pp:=get_procdef;
|
|
|
if not(assigned(pp)) or
|
|
|
- not(is_equal(pp^.retdef,p^.proptype)) then
|
|
|
+ not(is_equal(pp^.rettype.def,p^.proptype.def)) then
|
|
|
Message(parser_e_ill_property_access_sym);
|
|
|
- p^.readaccessdef:=pp;
|
|
|
+ p^.readaccess^.setdef(pp);
|
|
|
end;
|
|
|
varsym :
|
|
|
begin
|
|
|
if not(propertyparas^.empty) or
|
|
|
- not(is_equal(pvarsym(sym)^.definition,p^.proptype)) then
|
|
|
+ not(is_equal(pvarsym(sym)^.vartype.def,p^.proptype.def)) then
|
|
|
Message(parser_e_ill_property_access_sym);
|
|
|
end;
|
|
|
else
|
|
|
Message(parser_e_ill_property_access_sym);
|
|
|
end;
|
|
|
- addpropsymlist(p^.readaccesssym,sym);
|
|
|
+ p^.readaccess^.addsym(sym);
|
|
|
end;
|
|
|
end;
|
|
|
if (idtoken=_WRITE) then
|
|
|
begin
|
|
|
- if assigned(p^.writeaccesssym) then
|
|
|
- deletepropsymlist(p^.writeaccesssym);
|
|
|
- p^.writeaccesssym:=nil;
|
|
|
+ p^.writeaccess^.clear;
|
|
|
consume(_WRITE);
|
|
|
sym:=search_class_member(aktclass,pattern);
|
|
|
if not(assigned(sym)) then
|
|
@@ -574,11 +489,11 @@ uses
|
|
|
consume(_ID);
|
|
|
while (token=_POINT) and
|
|
|
((sym^.typ=varsym) and
|
|
|
- (pvarsym(sym)^.definition^.deftype=recorddef)) do
|
|
|
+ (pvarsym(sym)^.vartype.def^.deftype=recorddef)) do
|
|
|
begin
|
|
|
- addpropsymlist(p^.writeaccesssym,sym);
|
|
|
+ p^.writeaccess^.addsym(sym);
|
|
|
consume(_POINT);
|
|
|
- getsymonlyin(precorddef(pvarsym(sym)^.definition)^.symtable,pattern);
|
|
|
+ getsymonlyin(precorddef(pvarsym(sym)^.vartype.def)^.symtable,pattern);
|
|
|
if not assigned(srsym) then
|
|
|
Message1(sym_e_illegal_field,pattern);
|
|
|
sym:=srsym;
|
|
@@ -599,28 +514,25 @@ uses
|
|
|
propertyparas^.remove(datacoll);
|
|
|
if not(assigned(pp)) then
|
|
|
Message(parser_e_ill_property_access_sym);
|
|
|
- p^.writeaccessdef:=pp;
|
|
|
+ p^.writeaccess^.setdef(pp);
|
|
|
end;
|
|
|
varsym :
|
|
|
begin
|
|
|
if not(propertyparas^.empty) or
|
|
|
- not(is_equal(pvarsym(sym)^.definition,p^.proptype)) then
|
|
|
+ not(is_equal(pvarsym(sym)^.vartype.def,p^.proptype.def)) then
|
|
|
Message(parser_e_ill_property_access_sym);
|
|
|
end
|
|
|
else
|
|
|
Message(parser_e_ill_property_access_sym);
|
|
|
end;
|
|
|
- addpropsymlist(p^.writeaccesssym,sym);
|
|
|
+ p^.writeaccess^.addsym(sym);
|
|
|
end;
|
|
|
end;
|
|
|
include(p^.propoptions,ppo_stored);
|
|
|
if (idtoken=_STORED) then
|
|
|
begin
|
|
|
consume(_STORED);
|
|
|
- if assigned(p^.storedsym) then
|
|
|
- deletepropsymlist(p^.storedsym);
|
|
|
- p^.storedsym:=nil;
|
|
|
- p^.storeddef:=nil;
|
|
|
+ p^.storedaccess^.clear;
|
|
|
case token of
|
|
|
_ID:
|
|
|
{ in the case that idtoken=_DEFAULT }
|
|
@@ -640,11 +552,11 @@ uses
|
|
|
consume(_ID);
|
|
|
while (token=_POINT) and
|
|
|
((sym^.typ=varsym) and
|
|
|
- (pvarsym(sym)^.definition^.deftype=recorddef)) do
|
|
|
+ (pvarsym(sym)^.vartype.def^.deftype=recorddef)) do
|
|
|
begin
|
|
|
- addpropsymlist(p^.storedsym,sym);
|
|
|
+ p^.storedaccess^.addsym(sym);
|
|
|
consume(_POINT);
|
|
|
- getsymonlyin(precorddef(pvarsym(sym)^.definition)^.symtable,pattern);
|
|
|
+ getsymonlyin(precorddef(pvarsym(sym)^.vartype.def)^.symtable,pattern);
|
|
|
if not assigned(srsym) then
|
|
|
Message1(sym_e_illegal_field,pattern);
|
|
|
sym:=srsym;
|
|
@@ -668,20 +580,20 @@ uses
|
|
|
end;
|
|
|
{ found we a procedure and does it really return a bool? }
|
|
|
if not(assigned(pp)) or
|
|
|
- not(is_equal(pp^.retdef,booldef)) then
|
|
|
+ not(is_equal(pp^.rettype.def,booldef)) then
|
|
|
Message(parser_e_ill_property_storage_sym);
|
|
|
- p^.storeddef:=pp;
|
|
|
+ p^.storedaccess^.setdef(pp);
|
|
|
end;
|
|
|
varsym :
|
|
|
begin
|
|
|
if not(propertyparas^.empty) or
|
|
|
- not(is_equal(pvarsym(sym)^.definition,booldef)) then
|
|
|
+ not(is_equal(pvarsym(sym)^.vartype.def,booldef)) then
|
|
|
Message(parser_e_stored_property_must_be_boolean);
|
|
|
end;
|
|
|
else
|
|
|
Message(parser_e_ill_property_storage_sym);
|
|
|
end;
|
|
|
- addpropsymlist(p^.storedsym,sym);
|
|
|
+ p^.storedaccess^.addsym(sym);
|
|
|
end;
|
|
|
end;
|
|
|
_FALSE:
|
|
@@ -696,19 +608,18 @@ uses
|
|
|
if (idtoken=_DEFAULT) then
|
|
|
begin
|
|
|
consume(_DEFAULT);
|
|
|
- if not(is_ordinal(p^.proptype) or
|
|
|
- is_64bitint(p^.proptype) or
|
|
|
- ((p^.proptype^.deftype=setdef) and
|
|
|
- (psetdef(p^.proptype)^.settype=smallset)
|
|
|
- ) or
|
|
|
- not(propertyparas^.empty)
|
|
|
- ) then
|
|
|
+ if not(is_ordinal(p^.proptype.def) or
|
|
|
+ is_64bitint(p^.proptype.def) or
|
|
|
+ ((p^.proptype.def^.deftype=setdef) and
|
|
|
+ (psetdef(p^.proptype.def)^.settype=smallset)) or
|
|
|
+ not(propertyparas^.empty)
|
|
|
+ ) then
|
|
|
Message(parser_e_property_cant_have_a_default_value);
|
|
|
{ Get the result of the default, the firstpass is
|
|
|
needed to support values like -1 }
|
|
|
pt:=comp_expr(true);
|
|
|
do_firstpass(pt);
|
|
|
- if p^.proptype^.deftype=setdef then
|
|
|
+ if p^.proptype.def^.deftype=setdef then
|
|
|
begin
|
|
|
{$ifndef newcg}
|
|
|
{!!!!!!!!!!}
|
|
@@ -716,7 +627,7 @@ uses
|
|
|
{$endif newcg}
|
|
|
do_firstpass(pt);
|
|
|
end;
|
|
|
- pt:=gentypeconvnode(pt,p^.proptype);
|
|
|
+ pt:=gentypeconvnode(pt,p^.proptype.def);
|
|
|
do_firstpass(pt);
|
|
|
if not(is_constnode(pt)) then
|
|
|
Message(parser_e_property_default_value_must_const);
|
|
@@ -784,13 +695,13 @@ uses
|
|
|
if not(aktprocsym^.definition^.para^.empty) then
|
|
|
Message(parser_e_no_paras_for_destructor);
|
|
|
{ no return value }
|
|
|
- aktprocsym^.definition^.retdef:=voiddef;
|
|
|
+ aktprocsym^.definition^.rettype.def:=voiddef;
|
|
|
end;
|
|
|
|
|
|
var
|
|
|
hs : string;
|
|
|
pcrd : pclassrefdef;
|
|
|
- hp1 : pdef;
|
|
|
+ tt : ttype;
|
|
|
oldprocinfo : pprocinfo;
|
|
|
oldprocsym : pprocsym;
|
|
|
oldparse_only : boolean;
|
|
@@ -838,13 +749,13 @@ uses
|
|
|
{ a hack, but it's easy to handle }
|
|
|
{ class reference type }
|
|
|
consume(_OF);
|
|
|
- hp1:=single_type(hs,typecanbeforward);
|
|
|
+ single_type(tt,hs,typecanbeforward);
|
|
|
|
|
|
{ accept hp1, if is a forward def or a class }
|
|
|
- if (hp1^.deftype=forwarddef) or
|
|
|
- ((hp1^.deftype=objectdef) and pobjectdef(hp1)^.is_class) then
|
|
|
+ if (tt.def^.deftype=forwarddef) or
|
|
|
+ ((tt.def^.deftype=objectdef) and pobjectdef(tt.def)^.is_class) then
|
|
|
begin
|
|
|
- pcrd:=new(pclassrefdef,init(hp1));
|
|
|
+ pcrd:=new(pclassrefdef,init(tt.def));
|
|
|
object_dec:=pcrd;
|
|
|
end
|
|
|
else
|
|
@@ -889,7 +800,8 @@ uses
|
|
|
if token=_LKLAMMER then
|
|
|
begin
|
|
|
consume(_LKLAMMER);
|
|
|
- childof:=pobjectdef(id_type(pattern,false));
|
|
|
+ id_type(tt,pattern,false);
|
|
|
+ childof:=pobjectdef(tt.def);
|
|
|
if (childof^.deftype<>objectdef) then
|
|
|
begin
|
|
|
Message1(type_e_class_type_expected,childof^.typename);
|
|
@@ -987,8 +899,7 @@ uses
|
|
|
|
|
|
{ new procinfo }
|
|
|
oldprocinfo:=procinfo;
|
|
|
- new(procinfo);
|
|
|
- fillchar(procinfo^,sizeof(tprocinfo),0);
|
|
|
+ new(procinfo,init);
|
|
|
procinfo^._class:=aktclass;
|
|
|
|
|
|
|
|
@@ -1229,7 +1140,7 @@ uses
|
|
|
symtablestack:=symtablestack^.next;
|
|
|
aktobjectdef:=nil;
|
|
|
{Restore procinfo}
|
|
|
- dispose(procinfo);
|
|
|
+ dispose(procinfo,done);
|
|
|
procinfo:=oldprocinfo;
|
|
|
{Restore the aktprocsym.}
|
|
|
aktprocsym:=oldprocsym;
|
|
@@ -1269,10 +1180,10 @@ uses
|
|
|
|
|
|
|
|
|
{ reads a type definition and returns a pointer to it }
|
|
|
- function read_type(const name : stringid) : pdef;
|
|
|
+ procedure read_type(var tt : ttype;const name : stringid);
|
|
|
var
|
|
|
pt : ptree;
|
|
|
- hp1,p : pdef;
|
|
|
+ tt2 : ttype;
|
|
|
aufdef : penumdef;
|
|
|
{aufsym : penumsym;}
|
|
|
ap : parraydef;
|
|
@@ -1290,7 +1201,7 @@ uses
|
|
|
if (token=_ID) and (testcurobject=2) and (curobjectname=pattern) then
|
|
|
begin
|
|
|
consume(_ID);
|
|
|
- p:=aktobjectdef;
|
|
|
+ tt.setdef(aktobjectdef);
|
|
|
exit;
|
|
|
end;
|
|
|
{ we can't accept a equal in type }
|
|
@@ -1317,15 +1228,15 @@ uses
|
|
|
begin
|
|
|
{ All checks passed, create the new def }
|
|
|
case pt1^.resulttype^.deftype of
|
|
|
- enumdef : p:=new(penumdef,init_subrange(penumdef(pt1^.resulttype),pt1^.value,pt2^.value));
|
|
|
+ enumdef : tt.setdef(new(penumdef,init_subrange(penumdef(pt1^.resulttype),pt1^.value,pt2^.value)));
|
|
|
orddef : begin
|
|
|
if is_char(pt1^.resulttype) then
|
|
|
- p:=new(porddef,init(uchar,pt1^.value,pt2^.value))
|
|
|
+ tt.setdef(new(porddef,init(uchar,pt1^.value,pt2^.value)))
|
|
|
else
|
|
|
if is_boolean(pt1^.resulttype) then
|
|
|
- p:=new(porddef,init(bool8bit,pt1^.value,pt2^.value))
|
|
|
+ tt.setdef(new(porddef,init(bool8bit,pt1^.value,pt2^.value)))
|
|
|
else
|
|
|
- p:=new(porddef,init(uauto,pt1^.value,pt2^.value));
|
|
|
+ tt.setdef(new(porddef,init(uauto,pt1^.value,pt2^.value)));
|
|
|
end;
|
|
|
end;
|
|
|
end;
|
|
@@ -1338,8 +1249,10 @@ uses
|
|
|
{ a simple type renaming }
|
|
|
if (pt1^.treetype=typen) then
|
|
|
begin
|
|
|
- p:=pt1^.resulttype;
|
|
|
- readtypesym:=pt1^.typenodesym;
|
|
|
+ if assigned(pt1^.typenodesym) then
|
|
|
+ tt.setsym(pt1^.typenodesym)
|
|
|
+ else
|
|
|
+ tt.setdef(pt1^.resulttype);
|
|
|
end
|
|
|
else
|
|
|
Message(sym_e_error_in_type_def);
|
|
@@ -1359,7 +1272,7 @@ uses
|
|
|
arraytype:=generrordef;
|
|
|
lowval:=$80000000;
|
|
|
highval:=$7fffffff;
|
|
|
- p:=nil;
|
|
|
+ tt.reset;
|
|
|
repeat
|
|
|
{ read the expression and check it }
|
|
|
pt:=expr;
|
|
@@ -1408,15 +1321,15 @@ uses
|
|
|
disposetree(pt);
|
|
|
|
|
|
{ create arraydef }
|
|
|
- if p=nil then
|
|
|
+ if not assigned(tt.def) then
|
|
|
begin
|
|
|
ap:=new(parraydef,init(lowval,highval,arraytype));
|
|
|
- p:=ap;
|
|
|
+ tt.setdef(ap);
|
|
|
end
|
|
|
else
|
|
|
begin
|
|
|
- ap^.definition:=new(parraydef,init(lowval,highval,arraytype));
|
|
|
- ap:=parraydef(ap^.definition);
|
|
|
+ ap^.elementtype.setdef(new(parraydef,init(lowval,highval,arraytype)));
|
|
|
+ ap:=parraydef(ap^.elementtype.def);
|
|
|
end;
|
|
|
|
|
|
if token=_COMMA then
|
|
@@ -1426,90 +1339,86 @@ uses
|
|
|
until false;
|
|
|
consume(_RECKKLAMMER);
|
|
|
consume(_OF);
|
|
|
- hp1:=read_type('');
|
|
|
+ read_type(tt2,'');
|
|
|
{ if no error, set element type }
|
|
|
if assigned(ap) then
|
|
|
- ap^.definition:=hp1;
|
|
|
+ ap^.elementtype:=tt2;
|
|
|
end;
|
|
|
|
|
|
begin
|
|
|
- readtypesym:=nil;
|
|
|
- p:=nil;
|
|
|
+ tt.reset;
|
|
|
case token of
|
|
|
_STRING,_FILE:
|
|
|
begin
|
|
|
- p:=single_type(hs,false);
|
|
|
- readtypesym:=nil;
|
|
|
+ single_type(tt,hs,false);
|
|
|
end;
|
|
|
_LKLAMMER:
|
|
|
begin
|
|
|
- consume(_LKLAMMER);
|
|
|
- { allow negativ value_str }
|
|
|
- l:=-1;
|
|
|
- {aufsym := Nil;}
|
|
|
- aufdef:=new(penumdef,init);
|
|
|
- repeat
|
|
|
- s:=pattern;
|
|
|
- defpos:=tokenpos;
|
|
|
- consume(_ID);
|
|
|
- if token=_ASSIGNMENT then
|
|
|
- begin
|
|
|
- consume(_ASSIGNMENT);
|
|
|
- v:=get_intconst;
|
|
|
- { please leave that a note, allows type save }
|
|
|
- { declarations in the win32 units ! }
|
|
|
- if v<=l then
|
|
|
- Message(parser_n_duplicate_enum);
|
|
|
- l:=v;
|
|
|
- end
|
|
|
- else
|
|
|
- inc(l);
|
|
|
- storepos:=tokenpos;
|
|
|
- tokenpos:=defpos;
|
|
|
- constsymtable^.insert(new(penumsym,init(s,aufdef,l)));
|
|
|
- tokenpos:=storepos;
|
|
|
- if token=_COMMA then
|
|
|
- consume(_COMMA)
|
|
|
- else
|
|
|
- break;
|
|
|
- until false;
|
|
|
- {aufdef^.max:=l;
|
|
|
- if we allow unordered enums
|
|
|
- this can be wrong
|
|
|
- min and max are now set in tenumsym.init PM }
|
|
|
- p:=aufdef;
|
|
|
- consume(_RKLAMMER);
|
|
|
- readtypesym:=nil;
|
|
|
+ consume(_LKLAMMER);
|
|
|
+ { allow negativ value_str }
|
|
|
+ l:=-1;
|
|
|
+ {aufsym := Nil;}
|
|
|
+ aufdef:=new(penumdef,init);
|
|
|
+ repeat
|
|
|
+ s:=pattern;
|
|
|
+ defpos:=tokenpos;
|
|
|
+ consume(_ID);
|
|
|
+ if token=_ASSIGNMENT then
|
|
|
+ begin
|
|
|
+ consume(_ASSIGNMENT);
|
|
|
+ v:=get_intconst;
|
|
|
+ { please leave that a note, allows type save }
|
|
|
+ { declarations in the win32 units ! }
|
|
|
+ if v<=l then
|
|
|
+ Message(parser_n_duplicate_enum);
|
|
|
+ l:=v;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ inc(l);
|
|
|
+ storepos:=tokenpos;
|
|
|
+ tokenpos:=defpos;
|
|
|
+ constsymtable^.insert(new(penumsym,init(s,aufdef,l)));
|
|
|
+ tokenpos:=storepos;
|
|
|
+ if token=_COMMA then
|
|
|
+ consume(_COMMA)
|
|
|
+ else
|
|
|
+ break;
|
|
|
+ until false;
|
|
|
+ {aufdef^.max:=l;
|
|
|
+ if we allow unordered enums
|
|
|
+ this can be wrong
|
|
|
+ min and max are now set in tenumsym.init PM }
|
|
|
+ tt.setdef(aufdef);
|
|
|
+ consume(_RKLAMMER);
|
|
|
end;
|
|
|
_ARRAY:
|
|
|
begin
|
|
|
array_dec;
|
|
|
- readtypesym:=nil;
|
|
|
end;
|
|
|
_SET:
|
|
|
begin
|
|
|
consume(_SET);
|
|
|
consume(_OF);
|
|
|
- hp1:=read_type('');
|
|
|
- if assigned(hp1) then
|
|
|
+ read_type(tt2,'');
|
|
|
+ if assigned(tt2.def) then
|
|
|
begin
|
|
|
- case hp1^.deftype of
|
|
|
+ case tt2.def^.deftype of
|
|
|
{ don't forget that min can be negativ PM }
|
|
|
enumdef :
|
|
|
- if penumdef(hp1)^.min>=0 then
|
|
|
- p:=new(psetdef,init(hp1,penumdef(hp1)^.max))
|
|
|
+ if penumdef(tt2.def)^.min>=0 then
|
|
|
+ tt.setdef(new(psetdef,init(tt2.def,penumdef(tt2.def)^.max)))
|
|
|
else
|
|
|
Message(sym_e_ill_type_decl_set);
|
|
|
orddef :
|
|
|
begin
|
|
|
- case porddef(hp1)^.typ of
|
|
|
+ case porddef(tt2.def)^.typ of
|
|
|
uchar :
|
|
|
- p:=new(psetdef,init(hp1,255));
|
|
|
+ tt.setdef(new(psetdef,init(tt2.def,255)));
|
|
|
u8bit,u16bit,u32bit,
|
|
|
s8bit,s16bit,s32bit :
|
|
|
begin
|
|
|
- if (porddef(hp1)^.low>=0) then
|
|
|
- p:=new(psetdef,init(hp1,porddef(hp1)^.high))
|
|
|
+ if (porddef(tt2.def)^.low>=0) then
|
|
|
+ tt.setdef(new(psetdef,init(tt2.def,porddef(tt2.def)^.high)))
|
|
|
else
|
|
|
Message(sym_e_ill_type_decl_set);
|
|
|
end;
|
|
@@ -1522,20 +1431,17 @@ uses
|
|
|
end;
|
|
|
end
|
|
|
else
|
|
|
- p:=generrordef;
|
|
|
- readtypesym:=nil;
|
|
|
+ tt.setdef(generrordef);
|
|
|
end;
|
|
|
_CARET:
|
|
|
begin
|
|
|
consume(_CARET);
|
|
|
- hp1:=single_type(hs,typecanbeforward);
|
|
|
- p:=new(ppointerdef,init(hp1));
|
|
|
- readtypesym:=nil;
|
|
|
+ single_type(tt2,hs,typecanbeforward);
|
|
|
+ tt.setdef(new(ppointerdef,init(tt2)));
|
|
|
end;
|
|
|
_RECORD:
|
|
|
begin
|
|
|
- p:=record_dec;
|
|
|
- readtypesym:=nil;
|
|
|
+ tt.setdef(record_dec);
|
|
|
end;
|
|
|
_PACKED:
|
|
|
begin
|
|
@@ -1547,69 +1453,67 @@ uses
|
|
|
oldaktpackrecords:=aktpackrecords;
|
|
|
aktpackrecords:=packrecord_1;
|
|
|
if token in [_CLASS,_OBJECT] then
|
|
|
- p:=object_dec(name,nil)
|
|
|
+ tt.setdef(object_dec(name,nil))
|
|
|
else
|
|
|
- p:=record_dec;
|
|
|
+ tt.setdef(record_dec);
|
|
|
aktpackrecords:=oldaktpackrecords;
|
|
|
end;
|
|
|
- readtypesym:=nil;
|
|
|
end;
|
|
|
_CLASS,
|
|
|
_OBJECT:
|
|
|
begin
|
|
|
- p:=object_dec(name,nil);
|
|
|
- readtypesym:=nil;
|
|
|
+ tt.setdef(object_dec(name,nil));
|
|
|
end;
|
|
|
_PROCEDURE:
|
|
|
begin
|
|
|
consume(_PROCEDURE);
|
|
|
- p:=new(pprocvardef,init);
|
|
|
+ tt.setdef(new(pprocvardef,init));
|
|
|
if token=_LKLAMMER then
|
|
|
- parameter_dec(pprocvardef(p));
|
|
|
+ parameter_dec(pprocvardef(tt.def));
|
|
|
if token=_OF then
|
|
|
begin
|
|
|
consume(_OF);
|
|
|
consume(_OBJECT);
|
|
|
{$ifdef INCLUDEOK}
|
|
|
- include(pprocvardef(p)^.procoptions,po_methodpointer);
|
|
|
+ include(pprocvardef(tt.def)^.procoptions,po_methodpointer);
|
|
|
{$else}
|
|
|
- pprocvardef(p)^.procoptions:=pprocvardef(p)^.procoptions+[po_methodpointer];
|
|
|
+ pprocvardef(tt.def)^.procoptions:=pprocvardef(tt.def)^.procoptions+[po_methodpointer];
|
|
|
{$endif}
|
|
|
end;
|
|
|
- readtypesym:=nil;
|
|
|
end;
|
|
|
_FUNCTION:
|
|
|
begin
|
|
|
consume(_FUNCTION);
|
|
|
- p:=new(pprocvardef,init);
|
|
|
+ tt.def:=new(pprocvardef,init);
|
|
|
if token=_LKLAMMER then
|
|
|
- parameter_dec(pprocvardef(p));
|
|
|
+ parameter_dec(pprocvardef(tt.def));
|
|
|
consume(_COLON);
|
|
|
- pprocvardef(p)^.retdef:=single_type(hs,false);
|
|
|
+ single_type(pprocvardef(tt.def)^.rettype,hs,false);
|
|
|
if token=_OF then
|
|
|
begin
|
|
|
consume(_OF);
|
|
|
consume(_OBJECT);
|
|
|
{$ifdef INCLUDEOK}
|
|
|
- include(pprocvardef(p)^.procoptions,po_methodpointer);
|
|
|
+ include(pprocvardef(tt.def)^.procoptions,po_methodpointer);
|
|
|
{$else}
|
|
|
- pprocvardef(p)^.procoptions:=pprocvardef(p)^.procoptions+[po_methodpointer];
|
|
|
+ pprocvardef(tt.def)^.procoptions:=pprocvardef(tt.def)^.procoptions+[po_methodpointer];
|
|
|
{$endif}
|
|
|
end;
|
|
|
- readtypesym:=nil;
|
|
|
end;
|
|
|
else
|
|
|
expr_type;
|
|
|
end;
|
|
|
- if p=nil then
|
|
|
- p:=generrordef;
|
|
|
- read_type:=p;
|
|
|
+ if tt.def=nil then
|
|
|
+ tt.setdef(generrordef);
|
|
|
end;
|
|
|
|
|
|
end.
|
|
|
{
|
|
|
$Log$
|
|
|
- Revision 1.11 1999-11-26 00:19:12 peter
|
|
|
+ Revision 1.12 1999-11-30 10:40:52 peter
|
|
|
+ + ttype, tsymlist
|
|
|
+
|
|
|
+ Revision 1.11 1999/11/26 00:19:12 peter
|
|
|
* property overriding dereference fix, but it need a bigger redesign
|
|
|
which i'll do tomorrow. This quick hack is for the lazarus ppl so
|
|
|
they can hack on mwcustomedit.
|