diff --git a/compiler/pdecl.pas b/compiler/pdecl.pas index ebe0c97e09..1fc69d4aa5 100644 --- a/compiler/pdecl.pas +++ b/compiler/pdecl.pas @@ -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 diff --git a/compiler/pdecvar.pas b/compiler/pdecvar.pas index 04e399403b..2ee20c35e5 100644 --- a/compiler/pdecvar.pas +++ b/compiler/pdecvar.pas @@ -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 diff --git a/compiler/psub.pas b/compiler/psub.pas index 56bf907210..6621ecca00 100644 --- a/compiler/psub.pas +++ b/compiler/psub.pas @@ -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 diff --git a/compiler/ptype.pas b/compiler/ptype.pas index f0b8af72c7..e167715405 100644 --- a/compiler/ptype.pas +++ b/compiler/ptype.pas @@ -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