mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-18 05:39:26 +02:00
* more proc directive for procvar fixes
This commit is contained in:
peter
parent
9f2ec4dabd
commit
6edadf3df5
@ -52,7 +52,7 @@ implementation
|
||||
globtype,tokens,verbose,
|
||||
systems,
|
||||
{ aasm }
|
||||
aasmbase,aasmtai,aasmcpu,fmodule,
|
||||
aasmbase,aasmtai,fmodule,
|
||||
{ symtable }
|
||||
symconst,symbase,symtype,symdef,symtable,paramgr,
|
||||
{ pass 1 }
|
||||
@ -187,7 +187,7 @@ implementation
|
||||
block_type:=bt_type;
|
||||
consume(_COLON);
|
||||
ignore_equal:=true;
|
||||
read_type(tt,'');
|
||||
read_type(tt,'',false);
|
||||
ignore_equal:=false;
|
||||
block_type:=bt_const;
|
||||
skipequal:=false;
|
||||
@ -198,17 +198,15 @@ implementation
|
||||
akttokenpos:=storetokenpos;
|
||||
symtablestack.insert(sym);
|
||||
insertconstdata(ttypedconstsym(sym));
|
||||
{ procvar can have proc directives }
|
||||
if (tt.def.deftype=procvardef) then
|
||||
{ procvar can have proc directives, but not type references }
|
||||
if (tt.def.deftype=procvardef) and
|
||||
(tt.sym=nil) then
|
||||
begin
|
||||
{ support p : procedure;stdcall=nil; }
|
||||
if try_to_consume(_SEMICOLON) then
|
||||
begin
|
||||
if is_proc_directive(token,true) then
|
||||
begin
|
||||
parse_var_proc_directives(sym);
|
||||
handle_calling_convention(tprocvardef(tt.def));
|
||||
end
|
||||
parse_var_proc_directives(sym)
|
||||
else
|
||||
begin
|
||||
Message(parser_e_proc_directive_expected);
|
||||
@ -223,6 +221,7 @@ implementation
|
||||
end;
|
||||
{ add default calling convention }
|
||||
handle_calling_convention(tabstractprocdef(tt.def));
|
||||
calc_parast(tprocvardef(tt.def));
|
||||
end;
|
||||
if not skipequal then
|
||||
begin
|
||||
@ -451,7 +450,7 @@ implementation
|
||||
akttokenpos:=defpos;
|
||||
akttokenpos:=storetokenpos;
|
||||
{ read the type definition }
|
||||
read_type(tt,orgtypename);
|
||||
read_type(tt,orgtypename,false);
|
||||
{ update the definition of the type }
|
||||
newtype.restype:=tt;
|
||||
if assigned(tt.sym) then
|
||||
@ -494,6 +493,8 @@ implementation
|
||||
if not is_proc_directive(token,true) then
|
||||
consume(_SEMICOLON);
|
||||
parse_var_proc_directives(tsym(newtype));
|
||||
handle_calling_convention(tprocvardef(tt.def));
|
||||
calc_parast(tprocvardef(tt.def));
|
||||
end;
|
||||
end;
|
||||
objectdef,
|
||||
@ -635,7 +636,10 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.70 2003-10-02 21:13:09 peter
|
||||
Revision 1.71 2003-10-03 14:45:09 peter
|
||||
* more proc directive for procvar fixes
|
||||
|
||||
Revision 1.70 2003/10/02 21:13:09 peter
|
||||
* procvar directive parsing fixes
|
||||
|
||||
Revision 1.69 2003/09/23 17:56:05 peter
|
||||
|
||||
@ -186,11 +186,11 @@ implementation
|
||||
the symbols of the types }
|
||||
oldsymtablestack:=symtablestack;
|
||||
symtablestack:=symtablestack.next;
|
||||
read_type(tt,'');
|
||||
read_type(tt,'',true);
|
||||
symtablestack:=oldsymtablestack;
|
||||
end
|
||||
else
|
||||
read_type(tt,'');
|
||||
read_type(tt,'',true);
|
||||
{ types that use init/final are not allowed in variant parts, but
|
||||
classes are allowed }
|
||||
if (variantrecordlevel>0) and
|
||||
@ -306,6 +306,10 @@ implementation
|
||||
{ Records and objects can't have default values }
|
||||
if is_record or is_object then
|
||||
begin
|
||||
{ try to parse the hint directives }
|
||||
dummysymoptions:=[];
|
||||
try_consume_hintdirective(dummysymoptions);
|
||||
|
||||
{ for a record there doesn't need to be a ; before the END or ) }
|
||||
if not(token in [_END,_RKLAMMER]) then
|
||||
consume(_SEMICOLON);
|
||||
@ -324,6 +328,10 @@ implementation
|
||||
newtype.free;
|
||||
end;
|
||||
|
||||
{ try to parse the hint directives }
|
||||
dummysymoptions:=[];
|
||||
try_consume_hintdirective(dummysymoptions);
|
||||
|
||||
{ Handling of Delphi typed const = initialized vars ! }
|
||||
{ When should this be rejected ?
|
||||
- in parasymtable
|
||||
@ -335,12 +343,12 @@ implementation
|
||||
not is_record and
|
||||
not is_object then
|
||||
begin
|
||||
vs:=tvarsym(sc.first);
|
||||
if assigned(vs.listnext) then
|
||||
vs:=tvarsym(sc.first);
|
||||
if assigned(vs.listnext) then
|
||||
Message(parser_e_initialized_only_one_var);
|
||||
if is_threadvar then
|
||||
if is_threadvar then
|
||||
Message(parser_e_initialized_not_for_threadvar);
|
||||
if symtablestack.symtabletype=localsymtable then
|
||||
if symtablestack.symtabletype=localsymtable then
|
||||
begin
|
||||
consume(_EQUAL);
|
||||
tconstsym:=ttypedconstsym.createtype('default'+vs.realname,tt,false);
|
||||
@ -349,7 +357,7 @@ implementation
|
||||
insertconstdata(tconstsym);
|
||||
readtypedconst(tt,tconstsym,false);
|
||||
end
|
||||
else
|
||||
else
|
||||
begin
|
||||
tconstsym:=ttypedconstsym.createtype(vs.realname,tt,true);
|
||||
tconstsym.fileinfo:=vs.fileinfo;
|
||||
@ -359,21 +367,14 @@ implementation
|
||||
consume(_EQUAL);
|
||||
readtypedconst(tt,tconstsym,true);
|
||||
symdone:=true;
|
||||
consume(_SEMICOLON);
|
||||
end
|
||||
end;
|
||||
consume(_SEMICOLON);
|
||||
end
|
||||
else
|
||||
begin
|
||||
consume(_SEMICOLON);
|
||||
end;
|
||||
end;
|
||||
{ if the symbol is not completely handled, then try to parse the
|
||||
hint directives }
|
||||
if not symdone then
|
||||
begin
|
||||
dummysymoptions:=[];
|
||||
try_consume_hintdirective(dummysymoptions);
|
||||
end;
|
||||
{ Parse procvar directives after ; }
|
||||
if (tt.def.deftype=procvardef) and
|
||||
(tt.def.typesym=nil) then
|
||||
@ -540,7 +541,7 @@ implementation
|
||||
the symbols of the types }
|
||||
oldsymtablestack:=symtablestack;
|
||||
symtablestack:=symtablestack.next;
|
||||
read_type(casetype,'');
|
||||
read_type(casetype,'',true);
|
||||
symtablestack:=oldsymtablestack;
|
||||
end
|
||||
else
|
||||
@ -551,7 +552,7 @@ implementation
|
||||
the symbols of the types }
|
||||
oldsymtablestack:=symtablestack;
|
||||
symtablestack:=symtablestack.next;
|
||||
read_type(casetype,'');
|
||||
read_type(casetype,'',true);
|
||||
symtablestack:=oldsymtablestack;
|
||||
vs:=tvarsym.create(sorg,vs_value,casetype);
|
||||
tabstractrecordsymtable(symtablestack).insertfield(vs,true);
|
||||
@ -647,7 +648,10 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.54 2003-10-02 21:13:09 peter
|
||||
Revision 1.55 2003-10-03 14:45:09 peter
|
||||
* more proc directive for procvar fixes
|
||||
|
||||
Revision 1.54 2003/10/02 21:13:09 peter
|
||||
* procvar directive parsing fixes
|
||||
|
||||
Revision 1.53 2003/10/02 15:12:07 peter
|
||||
|
||||
@ -72,7 +72,7 @@ implementation
|
||||
globtype,tokens,verbose,comphook,
|
||||
systems,
|
||||
{ aasm }
|
||||
cpubase,cpuinfo,aasmbase,aasmtai,
|
||||
aasmtai,
|
||||
{ symtable }
|
||||
symconst,symbase,symsym,symtype,symtable,defutil,
|
||||
paramgr,
|
||||
@ -1201,17 +1201,6 @@ implementation
|
||||
|
||||
|
||||
procedure read_declarations(islibrary : boolean);
|
||||
|
||||
procedure Not_supported_for_inline(t : ttoken);
|
||||
begin
|
||||
if (current_procinfo.procdef.proccalloption=pocall_inline) then
|
||||
Begin
|
||||
Message1(parser_w_not_supported_for_inline,tokenstring(t));
|
||||
Message(parser_w_inlining_disabled);
|
||||
current_procinfo.procdef.proccalloption:=pocall_default;
|
||||
End;
|
||||
end;
|
||||
|
||||
begin
|
||||
repeat
|
||||
if not assigned(current_procinfo) then
|
||||
@ -1219,17 +1208,14 @@ implementation
|
||||
case token of
|
||||
_LABEL:
|
||||
begin
|
||||
Not_supported_for_inline(token);
|
||||
label_dec;
|
||||
end;
|
||||
_CONST:
|
||||
begin
|
||||
Not_supported_for_inline(token);
|
||||
const_dec;
|
||||
end;
|
||||
_TYPE:
|
||||
begin
|
||||
Not_supported_for_inline(token);
|
||||
type_dec;
|
||||
end;
|
||||
_VAR:
|
||||
@ -1239,14 +1225,12 @@ implementation
|
||||
_CONSTRUCTOR,_DESTRUCTOR,
|
||||
_FUNCTION,_PROCEDURE,_OPERATOR,_CLASS:
|
||||
begin
|
||||
Not_supported_for_inline(token);
|
||||
read_proc;
|
||||
end;
|
||||
_RESOURCESTRING:
|
||||
resourcestring_dec;
|
||||
_EXPORTS:
|
||||
begin
|
||||
Not_supported_for_inline(token);
|
||||
if not(assigned(current_procinfo.procdef.localst)) or
|
||||
(current_procinfo.procdef.localst.symtablelevel>main_program_level) or
|
||||
(current_module.is_unit) then
|
||||
@ -1307,7 +1291,10 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.156 2003-10-02 21:20:32 peter
|
||||
Revision 1.157 2003-10-03 14:45:09 peter
|
||||
* more proc directive for procvar fixes
|
||||
|
||||
Revision 1.156 2003/10/02 21:20:32 peter
|
||||
* handle_calling_convention removed from parse_proc_directive to
|
||||
separate call
|
||||
|
||||
|
||||
@ -43,7 +43,7 @@ interface
|
||||
{ tdef }
|
||||
procedure single_type(var tt:ttype;var s : string;isforwarddef:boolean);
|
||||
|
||||
procedure read_type(var tt:ttype;const name : stringid);
|
||||
procedure read_type(var tt:ttype;const name : stringid;parseprocvardir:boolean);
|
||||
|
||||
{ reads a type definition }
|
||||
{ to a appropriating tdef, s gets the name of }
|
||||
@ -251,7 +251,7 @@ implementation
|
||||
|
||||
|
||||
{ reads a type definition and returns a pointer to it }
|
||||
procedure read_type(var tt : ttype;const name : stringid);
|
||||
procedure read_type(var tt : ttype;const name : stringid;parseprocvardir:boolean);
|
||||
var
|
||||
pt : tnode;
|
||||
tt2 : ttype;
|
||||
@ -389,7 +389,7 @@ implementation
|
||||
be parsed by readtype (PFV) }
|
||||
if token=_LKLAMMER then
|
||||
begin
|
||||
read_type(ht,'');
|
||||
read_type(ht,'',true);
|
||||
setdefdecl(ht);
|
||||
end
|
||||
else
|
||||
@ -448,7 +448,7 @@ implementation
|
||||
tt.setdef(ap);
|
||||
end;
|
||||
consume(_OF);
|
||||
read_type(tt2,'');
|
||||
read_type(tt2,'',true);
|
||||
{ if no error, set element type }
|
||||
if assigned(ap) then
|
||||
ap.setelementtype(tt2);
|
||||
@ -530,7 +530,7 @@ implementation
|
||||
begin
|
||||
consume(_SET);
|
||||
consume(_OF);
|
||||
read_type(tt2,'');
|
||||
read_type(tt2,'',true);
|
||||
if assigned(tt2.def) then
|
||||
begin
|
||||
case tt2.def.deftype of
|
||||
@ -618,17 +618,20 @@ implementation
|
||||
end;
|
||||
tt.def:=pd;
|
||||
{ possible proc directives }
|
||||
if is_proc_directive(token,true) then
|
||||
if parseprocvardir then
|
||||
begin
|
||||
newtype:=ttypesym.create('unnamed',tt);
|
||||
parse_var_proc_directives(tsym(newtype));
|
||||
newtype.restype.def:=nil;
|
||||
tt.def.typesym:=nil;
|
||||
newtype.free;
|
||||
if is_proc_directive(token,true) then
|
||||
begin
|
||||
newtype:=ttypesym.create('unnamed',tt);
|
||||
parse_var_proc_directives(tsym(newtype));
|
||||
newtype.restype.def:=nil;
|
||||
tt.def.typesym:=nil;
|
||||
newtype.free;
|
||||
end;
|
||||
{ Add implicit hidden parameters and function result }
|
||||
handle_calling_convention(pd);
|
||||
calc_parast(pd);
|
||||
end;
|
||||
{ Add implicit hidden parameters and function result }
|
||||
handle_calling_convention(pd);
|
||||
calc_parast(pd);
|
||||
end;
|
||||
else
|
||||
expr_type;
|
||||
@ -640,7 +643,10 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.58 2003-10-02 21:13:09 peter
|
||||
Revision 1.59 2003-10-03 14:45:09 peter
|
||||
* more proc directive for procvar fixes
|
||||
|
||||
Revision 1.58 2003/10/02 21:13:09 peter
|
||||
* procvar directive parsing fixes
|
||||
|
||||
Revision 1.57 2003/10/01 19:05:33 peter
|
||||
|
||||
Loading…
Reference in New Issue
Block a user