* more proc directive for procvar fixes

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

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

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
 

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