* synchronised with trunk till r29513blocks

git-svn-id: http://svn.freepascal.org/svn/fpc/branches/blocks@29516 3ad0048d-3df7-0310-abae-a5850022a9f2

1 files changed, 77 insertions, 17 deletions

diff --git a/compiler/pdecsub.pas b/compiler/pdecsub.pas
index e57308c7d0..a03c3c15f1 100644
--- a/compiler/pdecsub.pas
+++ b/compiler/pdecsub.pas
@@ -548,6 +548,8 @@ implementation
         orgsp,sp : TIDString;
         srsym : tsym;
         checkstack : psymtablestackitem;
+        oldfilepos,
+        classstartfilepos,
         procstartfilepos : tfileposinfo;
         i,
         index : longint;
@@ -822,9 +824,16 @@ implementation
            try_to_consume(_POINT) then
          begin
            repeat
+             classstartfilepos:=procstartfilepos;
              searchagain:=false;
+
+             { throw the error at the right location }
+             oldfilepos:=current_filepos;
+             current_filepos:=procstartfilepos;
              if not assigned(astruct) and not assigned(srsym) then
                srsym:=search_object_name(sp,true);
+             current_filepos:=oldfilepos;
+
              { consume proc name }
              procstartfilepos:=current_tokenpos;
              consume_proc_name;
@@ -837,7 +846,7 @@ implementation
                   if (potype in [potype_class_constructor,potype_class_destructor]) then
                     sp:=lower(sp)
                   else
-                  if (potype=potype_operator)and(optoken=NOTOKEN) then
+                  if (potype=potype_operator) and (optoken=NOTOKEN) then
                     parse_operator_name;
                 srsym:=tsym(astruct.symtable.Find(sp));
                 if assigned(srsym) then
@@ -865,13 +874,13 @@ implementation
                  end
                 else
                  begin
-                   Message(parser_e_methode_id_expected);
+                   MessagePos(procstartfilepos,parser_e_methode_id_expected);
                    { recover by making it a normal procedure instead of method }
                    astruct:=nil;
                  end;
               end
              else
-              Message(parser_e_class_id_expected);
+              MessagePos(classstartfilepos,parser_e_class_id_expected);
            until not searchagain;
          end
         else
@@ -1125,7 +1134,7 @@ implementation
               end;
             single_type(pd.returndef,[stoAllowSpecialization]);
 
-// Issue #24863, commented out for now because it breaks building of RTL and needs extensive
+            // Issue #24863, enabled only for the main progra commented out for now because it breaks building of RTL and needs extensive
 // testing and/or RTL patching.
 {
             if ((pd.returndef=cvarianttype) or (pd.returndef=colevarianttype)) and
@@ -1792,13 +1801,13 @@ end;
 
 
 procedure pd_syscall(pd:tabstractprocdef);
-{$if defined(powerpc) or defined(m68k)}
+{$if defined(powerpc) or defined(m68k) or defined(i386)}
 var
   vs  : tparavarsym;
   sym : tsym;
   symtable : TSymtable;
   v: Tconstexprint;
-{$endif defined(powerpc) or defined(m68k)}
+{$endif defined(powerpc) or defined(m68k) or defined(i386)}
 begin
   if (pd.typ<>procdef) and (target_info.system <> system_powerpc_amiga) then
     internalerror(2003042614);
@@ -1816,6 +1825,7 @@ begin
               is_32bitint(tabstractvarsym(sym).vardef)
              ) then
             begin
+              include(pd.procoptions,po_syscall_has_libsym);
               tcpuprocdef(pd).libsym:=sym;
               if po_syscall_legacy in tprocdef(pd).procoptions then
                 begin
@@ -1827,8 +1837,8 @@ begin
           else
             Message(parser_e_32bitint_or_pointer_variable_expected);
         end;
-      (paramanager as tm68kparamanager).create_funcretloc_info(pd,calleeside);
-      (paramanager as tm68kparamanager).create_funcretloc_info(pd,callerside);
+      paramanager.create_funcretloc_info(pd,calleeside);
+      paramanager.create_funcretloc_info(pd,callerside);
 
       v:=get_intconst;
       if (v<low(Tprocdef(pd).extnumber)) or (v>high(Tprocdef(pd).extnumber)) then
@@ -1850,6 +1860,7 @@ begin
               is_32bitint(tabstractvarsym(sym).vardef)
              ) then
             begin
+              include(pd.procoptions,po_syscall_has_libsym);
               tcpuprocdef(pd).libsym:=sym;
               vs:=cparavarsym.create('$syscalllib',paranr_syscall_basesysv,vs_value,tabstractvarsym(sym).vardef,[vo_is_syscall_lib,vo_is_hidden_para]);
               pd.parast.insert(vs);
@@ -1858,8 +1869,8 @@ begin
             Message(parser_e_32bitint_or_pointer_variable_expected);
         end;
 
-      (paramanager as tppcparamanager).create_funcretloc_info(pd,calleeside);
-      (paramanager as tppcparamanager).create_funcretloc_info(pd,callerside);
+      paramanager.create_funcretloc_info(pd,calleeside);
+      paramanager.create_funcretloc_info(pd,callerside);
 
       v:=get_intconst;
       if (v<low(Tprocdef(pd).extnumber)) or (v>high(Tprocdef(pd).extnumber)) then
@@ -1917,6 +1928,7 @@ begin
               is_32bitint(tabstractvarsym(sym).vardef)
              ) then
             begin
+              include(pd.procoptions,po_syscall_has_libsym);
               tcpuprocdef(pd).libsym:=sym;
               if po_syscall_legacy in tprocdef(pd).procoptions then
                 begin
@@ -1950,8 +1962,8 @@ begin
           else
             Message(parser_e_32bitint_or_pointer_variable_expected);
         end;
-      (paramanager as tppcparamanager).create_funcretloc_info(pd,calleeside);
-      (paramanager as tppcparamanager).create_funcretloc_info(pd,callerside);
+      paramanager.create_funcretloc_info(pd,calleeside);
+      paramanager.create_funcretloc_info(pd,callerside);
 
       v:=get_intconst;
       if (v<low(Tprocdef(pd).extnumber)) or (v>high(Tprocdef(pd).extnumber)) then
@@ -1960,6 +1972,38 @@ begin
         Tprocdef(pd).extnumber:=v.uvalue;
     end;
 {$endif powerpc}
+{$ifdef i386}
+   if target_info.system = system_i386_aros then
+    begin
+      include(pd.procoptions,po_syscall_sysvbase);
+
+      if consume_sym(sym,symtable) then
+        begin
+          if (sym.typ=staticvarsym) and
+             (
+              (tabstractvarsym(sym).vardef.typ=pointerdef) or
+              is_32bitint(tabstractvarsym(sym).vardef)
+             ) then
+            begin
+              include(pd.procoptions,po_syscall_has_libsym);
+              tcpuprocdef(pd).libsym:=sym;
+              vs:=cparavarsym.create('$syscalllib',paranr_syscall_sysvbase,vs_value,tabstractvarsym(sym).vardef,[vo_is_syscall_lib,vo_is_hidden_para]);
+              pd.parast.insert(vs);
+            end
+          else
+            Message(parser_e_32bitint_or_pointer_variable_expected);
+        end;
+
+      paramanager.create_funcretloc_info(pd,calleeside);
+      paramanager.create_funcretloc_info(pd,callerside);
+
+      v:=get_intconst;
+      if (v<low(Tprocdef(pd).extnumber)) or (v>high(Tprocdef(pd).extnumber)) then
+        message(parser_e_range_check_error)
+      else
+        Tprocdef(pd).extnumber:=v.uvalue * 4; { sizeof Pointer for the target }
+    end;
+{$endif}
 end;
 
 
@@ -2061,6 +2105,13 @@ begin
     pd_external(pd);
 end;
 
+procedure pd_winapi(pd:tabstractprocdef);
+begin
+  if not(target_info.system in systems_wince) then
+    pd.proccalloption:=pocall_cdecl
+  else
+    pd.proccalloption:=pocall_stdcall;
+end;
 
 type
    pd_handler=procedure(pd:tabstractprocdef);
@@ -2076,7 +2127,7 @@ type
    end;
 const
   {Should contain the number of procedure directives we support.}
-  num_proc_directives=44;
+  num_proc_directives=45;
   proc_direcdata:array[1..num_proc_directives] of proc_dir_rec=
    (
     (
@@ -2443,7 +2494,7 @@ const
       handler  : nil;
       pocall   : pocall_none;
       pooption : [po_varargs];
-      mutexclpocall : [pocall_internproc,pocall_stdcall,pocall_register,
+      mutexclpocall : [pocall_internproc,pocall_register,
                        pocall_far16,pocall_oldfpccall,pocall_mwpascal];
       mutexclpotype : [];
       mutexclpo     : [po_assembler,po_interrupt,po_inline]
@@ -2470,6 +2521,15 @@ const
       mutexclpotype : [{potype_constructor,potype_destructor}potype_class_constructor,potype_class_destructor];
       mutexclpo     : [po_public,po_exports,po_interrupt,po_assembler,po_inline]
     ),(
+      idtok:_WINAPI;
+      pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar];
+      handler  : @pd_winapi;
+      pocall   : pocall_none;
+      pooption : [];
+      mutexclpocall : [pocall_stdcall,pocall_cdecl];
+      mutexclpotype : [potype_constructor,potype_destructor,potype_class_constructor,potype_class_destructor];
+      mutexclpo     : [po_external]
+    ),(
       idtok:_ENUMERATOR;
       pd_flags : [pd_interface,pd_object,pd_record];
       handler  : @pd_enumerator;
@@ -2565,7 +2625,7 @@ const
               next variable !! }
             if ((pdflags * [pd_procvar,pd_object,pd_record,pd_objcclass,pd_objcprot])=[]) and
                not(idtoken=_PROPERTY) then
-              Message1(parser_w_unknown_proc_directive_ignored,name);
+              Message1(parser_w_unknown_proc_directive_ignored,pattern);
             exit;
          end;
 
@@ -2876,7 +2936,7 @@ const
                          { for objcclasses this is checked later, because the entire
                            class may be external.  }
                          is_objc_class_or_protocol(tprocdef(pd).struct)) and
-                     not(pd.proccalloption in (cdecl_pocalls + [pocall_mwpascal])) then
+                     not(pd.proccalloption in (cdecl_pocalls + [pocall_mwpascal,pocall_stdcall])) then
                     Message(parser_e_varargs_need_cdecl_and_external);
                 end
                else
@@ -2884,7 +2944,7 @@ const
                   { both must be defined now }
                   if not((po_external in pd.procoptions) or
                          (pd.typ=procvardef)) or
-                     not(pd.proccalloption in (cdecl_pocalls + [pocall_mwpascal])) then
+                     not(pd.proccalloption in (cdecl_pocalls + [pocall_mwpascal,pocall_stdcall])) then
                     Message(parser_e_varargs_need_cdecl_and_external);
                 end;
              end;