paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-14 01:39:42 +02:00
Code Issues Packages Projects Releases Wiki Activity

* more proc directive for procvar fixes

Browse Source
This commit is contained in:
peter 2003-10-03 14:45:09 +00:00
parent 9f2ec4dabd
commit 6edadf3df5
4 changed files with 63 additions and 62 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
compiler/pdecl.pas
View File

@ -52,7 +52,7 @@ implementation
globtype,tokens,verbose, globtype,tokens,verbose,
systems, systems,
{ aasm } { aasm }
aasmbase,aasmtai,aasmcpu,fmodule, aasmbase,aasmtai,fmodule,
{ symtable } { symtable }
symconst,symbase,symtype,symdef,symtable,paramgr, symconst,symbase,symtype,symdef,symtable,paramgr,
{ pass 1 } { pass 1 }
@ -187,7 +187,7 @@ implementation
block_type:=bt_type; block_type:=bt_type;
consume(_COLON); consume(_COLON);
ignore_equal:=true; ignore_equal:=true;
read_type(tt,''); read_type(tt,'',false);
ignore_equal:=false; ignore_equal:=false;
block_type:=bt_const; block_type:=bt_const;
skipequal:=false; skipequal:=false;
@ -198,17 +198,15 @@ implementation
akttokenpos:=storetokenpos; akttokenpos:=storetokenpos;
symtablestack.insert(sym); symtablestack.insert(sym);
insertconstdata(ttypedconstsym(sym)); insertconstdata(ttypedconstsym(sym));
{ procvar can have proc directives } { procvar can have proc directives, but not type references }
if (tt.def.deftype=procvardef) then if (tt.def.deftype=procvardef) and
(tt.sym=nil) then
begin begin
{ support p : procedure;stdcall=nil; } { support p : procedure;stdcall=nil; }
if try_to_consume(_SEMICOLON) then if try_to_consume(_SEMICOLON) then
begin begin
if is_proc_directive(token,true) then if is_proc_directive(token,true) then
begin parse_var_proc_directives(sym)
parse_var_proc_directives(sym);
handle_calling_convention(tprocvardef(tt.def));
end
else else
begin begin
Message(parser_e_proc_directive_expected); Message(parser_e_proc_directive_expected);
@ -223,6 +221,7 @@ implementation
end; end;
{ add default calling convention } { add default calling convention }
handle_calling_convention(tabstractprocdef(tt.def)); handle_calling_convention(tabstractprocdef(tt.def));
calc_parast(tprocvardef(tt.def));
end; end;
if not skipequal then if not skipequal then
begin begin
@ -451,7 +450,7 @@ implementation
akttokenpos:=defpos; akttokenpos:=defpos;
akttokenpos:=storetokenpos; akttokenpos:=storetokenpos;
{ read the type definition } { read the type definition }
read_type(tt,orgtypename); read_type(tt,orgtypename,false);
{ update the definition of the type } { update the definition of the type }
newtype.restype:=tt; newtype.restype:=tt;
if assigned(tt.sym) then if assigned(tt.sym) then
@ -494,6 +493,8 @@ implementation
if not is_proc_directive(token,true) then if not is_proc_directive(token,true) then
consume(_SEMICOLON); consume(_SEMICOLON);
parse_var_proc_directives(tsym(newtype)); parse_var_proc_directives(tsym(newtype));
handle_calling_convention(tprocvardef(tt.def));
calc_parast(tprocvardef(tt.def));
end; end;
end; end;
objectdef, objectdef,
@ -635,7 +636,10 @@ implementation
end. end.
{ {
$Log$ $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 * procvar directive parsing fixes
Revision 1.69 2003/09/23 17:56:05 peter Revision 1.69 2003/09/23 17:56:05 peter

42
compiler/pdecvar.pas
View File

@ -186,11 +186,11 @@ implementation
the symbols of the types } the symbols of the types }
oldsymtablestack:=symtablestack; oldsymtablestack:=symtablestack;
symtablestack:=symtablestack.next; symtablestack:=symtablestack.next;
read_type(tt,''); read_type(tt,'',true);
symtablestack:=oldsymtablestack; symtablestack:=oldsymtablestack;
end end
else else
read_type(tt,''); read_type(tt,'',true);
{ types that use init/final are not allowed in variant parts, but { types that use init/final are not allowed in variant parts, but
classes are allowed } classes are allowed }
if (variantrecordlevel>0) and if (variantrecordlevel>0) and
@ -306,6 +306,10 @@ implementation
{ Records and objects can't have default values } { Records and objects can't have default values }
if is_record or is_object then if is_record or is_object then
begin 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 ) } { for a record there doesn't need to be a ; before the END or ) }
if not(token in [_END,_RKLAMMER]) then if not(token in [_END,_RKLAMMER]) then
consume(_SEMICOLON); consume(_SEMICOLON);
@ -324,6 +328,10 @@ implementation
newtype.free; newtype.free;
end; end;
{ try to parse the hint directives }
dummysymoptions:=[];
try_consume_hintdirective(dummysymoptions);
{ Handling of Delphi typed const = initialized vars ! } { Handling of Delphi typed const = initialized vars ! }
{ When should this be rejected ? { When should this be rejected ?
- in parasymtable - in parasymtable
@ -335,12 +343,12 @@ implementation
not is_record and not is_record and
not is_object then not is_object then
begin begin
vs:=tvarsym(sc.first); vs:=tvarsym(sc.first);
if assigned(vs.listnext) then if assigned(vs.listnext) then
Message(parser_e_initialized_only_one_var); Message(parser_e_initialized_only_one_var);
if is_threadvar then if is_threadvar then
Message(parser_e_initialized_not_for_threadvar); Message(parser_e_initialized_not_for_threadvar);
if symtablestack.symtabletype=localsymtable then if symtablestack.symtabletype=localsymtable then
begin begin
consume(_EQUAL); consume(_EQUAL);
tconstsym:=ttypedconstsym.createtype('default'+vs.realname,tt,false); tconstsym:=ttypedconstsym.createtype('default'+vs.realname,tt,false);
@ -349,7 +357,7 @@ implementation
insertconstdata(tconstsym); insertconstdata(tconstsym);
readtypedconst(tt,tconstsym,false); readtypedconst(tt,tconstsym,false);
end end
else else
begin begin
tconstsym:=ttypedconstsym.createtype(vs.realname,tt,true); tconstsym:=ttypedconstsym.createtype(vs.realname,tt,true);
tconstsym.fileinfo:=vs.fileinfo; tconstsym.fileinfo:=vs.fileinfo;
@ -359,21 +367,14 @@ implementation
consume(_EQUAL); consume(_EQUAL);
readtypedconst(tt,tconstsym,true); readtypedconst(tt,tconstsym,true);
symdone:=true; symdone:=true;
consume(_SEMICOLON); end;
end consume(_SEMICOLON);
end end
else else
begin begin
consume(_SEMICOLON); consume(_SEMICOLON);
end; end;
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 ; } { Parse procvar directives after ; }
if (tt.def.deftype=procvardef) and if (tt.def.deftype=procvardef) and
(tt.def.typesym=nil) then (tt.def.typesym=nil) then
@ -540,7 +541,7 @@ implementation
the symbols of the types } the symbols of the types }
oldsymtablestack:=symtablestack; oldsymtablestack:=symtablestack;
symtablestack:=symtablestack.next; symtablestack:=symtablestack.next;
read_type(casetype,''); read_type(casetype,'',true);
symtablestack:=oldsymtablestack; symtablestack:=oldsymtablestack;
end end
else else
@ -551,7 +552,7 @@ implementation
the symbols of the types } the symbols of the types }
oldsymtablestack:=symtablestack; oldsymtablestack:=symtablestack;
symtablestack:=symtablestack.next; symtablestack:=symtablestack.next;
read_type(casetype,''); read_type(casetype,'',true);
symtablestack:=oldsymtablestack; symtablestack:=oldsymtablestack;
vs:=tvarsym.create(sorg,vs_value,casetype); vs:=tvarsym.create(sorg,vs_value,casetype);
tabstractrecordsymtable(symtablestack).insertfield(vs,true); tabstractrecordsymtable(symtablestack).insertfield(vs,true);
@ -647,7 +648,10 @@ implementation
end. end.
{ {
$Log$ $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 * procvar directive parsing fixes
Revision 1.53 2003/10/02 15:12:07 peter Revision 1.53 2003/10/02 15:12:07 peter

23
compiler/psub.pas
View File

@ -72,7 +72,7 @@ implementation
globtype,tokens,verbose,comphook, globtype,tokens,verbose,comphook,
systems, systems,
{ aasm } { aasm }
cpubase,cpuinfo,aasmbase,aasmtai, aasmtai,
{ symtable } { symtable }
symconst,symbase,symsym,symtype,symtable,defutil, symconst,symbase,symsym,symtype,symtable,defutil,
paramgr, paramgr,
@ -1201,17 +1201,6 @@ implementation
procedure read_declarations(islibrary : boolean); 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 begin
repeat repeat
if not assigned(current_procinfo) then if not assigned(current_procinfo) then
@ -1219,17 +1208,14 @@ implementation
case token of case token of
_LABEL: _LABEL:
begin begin
Not_supported_for_inline(token);
label_dec; label_dec;
end; end;
_CONST: _CONST:
begin begin
Not_supported_for_inline(token);
const_dec; const_dec;
end; end;
_TYPE: _TYPE:
begin begin
Not_supported_for_inline(token);
type_dec; type_dec;
end; end;
_VAR: _VAR:
@ -1239,14 +1225,12 @@ implementation
_CONSTRUCTOR,_DESTRUCTOR, _CONSTRUCTOR,_DESTRUCTOR,
_FUNCTION,_PROCEDURE,_OPERATOR,_CLASS: _FUNCTION,_PROCEDURE,_OPERATOR,_CLASS:
begin begin
Not_supported_for_inline(token);
read_proc; read_proc;
end; end;
_RESOURCESTRING: _RESOURCESTRING:
resourcestring_dec; resourcestring_dec;
_EXPORTS: _EXPORTS:
begin begin
Not_supported_for_inline(token);
if not(assigned(current_procinfo.procdef.localst)) or if not(assigned(current_procinfo.procdef.localst)) or
(current_procinfo.procdef.localst.symtablelevel>main_program_level) or (current_procinfo.procdef.localst.symtablelevel>main_program_level) or
(current_module.is_unit) then (current_module.is_unit) then
@ -1307,7 +1291,10 @@ begin
end. end.
{ {
$Log$ $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 * handle_calling_convention removed from parse_proc_directive to
separate call separate call

36
compiler/ptype.pas
View File

@ -43,7 +43,7 @@ interface
{ tdef } { tdef }
procedure single_type(var tt:ttype;var s : string;isforwarddef:boolean); 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 } { reads a type definition }
{ to a appropriating tdef, s gets the name of } { to a appropriating tdef, s gets the name of }
@ -251,7 +251,7 @@ implementation
{ reads a type definition and returns a pointer to it } { 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 var
pt : tnode; pt : tnode;
tt2 : ttype; tt2 : ttype;
@ -389,7 +389,7 @@ implementation
be parsed by readtype (PFV) } be parsed by readtype (PFV) }
if token=_LKLAMMER then if token=_LKLAMMER then
begin begin
read_type(ht,''); read_type(ht,'',true);
setdefdecl(ht); setdefdecl(ht);
end end
else else
@ -448,7 +448,7 @@ implementation
tt.setdef(ap); tt.setdef(ap);
end; end;
consume(_OF); consume(_OF);
read_type(tt2,''); read_type(tt2,'',true);
{ if no error, set element type } { if no error, set element type }
if assigned(ap) then if assigned(ap) then
ap.setelementtype(tt2); ap.setelementtype(tt2);
@ -530,7 +530,7 @@ implementation
begin begin
consume(_SET); consume(_SET);
consume(_OF); consume(_OF);
read_type(tt2,''); read_type(tt2,'',true);
if assigned(tt2.def) then if assigned(tt2.def) then
begin begin
case tt2.def.deftype of case tt2.def.deftype of
@ -618,17 +618,20 @@ implementation
end; end;
tt.def:=pd; tt.def:=pd;
{ possible proc directives } { possible proc directives }
if is_proc_directive(token,true) then if parseprocvardir then
begin begin
newtype:=ttypesym.create('unnamed',tt); if is_proc_directive(token,true) then
parse_var_proc_directives(tsym(newtype)); begin
newtype.restype.def:=nil; newtype:=ttypesym.create('unnamed',tt);
tt.def.typesym:=nil; parse_var_proc_directives(tsym(newtype));
newtype.free; 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; end;
{ Add implicit hidden parameters and function result }
handle_calling_convention(pd);
calc_parast(pd);
end; end;
else else
expr_type; expr_type;
@ -640,7 +643,10 @@ implementation
end. end.
{ {
$Log$ $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 * procvar directive parsing fixes
Revision 1.57 2003/10/01 19:05:33 peter Revision 1.57 2003/10/01 19:05:33 peter