huge syscall support refactor for Amiga-likes. removed large chunks of ancient duplicated code, and in general tried to make the entire thing more maintainable and cleaner. also added support for AROS EAXBase syscall convention

git-svn-id: trunk@34416 -

.gitattributes

@@ -705,6 +705,7 @@ compiler/symsym.pas svneol=native#text/plain
 compiler/symtable.pas svneol=native#text/plain
 compiler/symtype.pas svneol=native#text/plain
 compiler/symutil.pas svneol=native#text/plain
+compiler/syscinfo.pas svneol=native#text/plain
 compiler/systems.inc svneol=native#text/plain
 compiler/systems.pas svneol=native#text/plain
 compiler/systems/i_aix.pas svneol=native#text/plain

compiler/globals.pas

@@ -368,11 +368,6 @@ interface
        palmos_applicationid : string[4] = 'FPCA';
 {$endif defined(m68k) or defined(arm)}
 
-{$ifdef powerpc}
-       { default calling convention used on MorphOS }
-       syscall_convention : string = 'LEGACY';
-{$endif powerpc}
-
        { default name of the C-style "main" procedure of the library/program }
        { (this will be prefixed with the target_info.cprefix)                }
        defaultmainaliasname = 'main';

compiler/i386/cpupara.pas

@@ -44,6 +44,7 @@ unit cpupara;
           function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;override;
           procedure createtempparaloc(list: TAsmList;calloption : tproccalloption;parasym : tparavarsym;can_use_final_stack_loc : boolean;var cgpara:TCGPara);override;
           function get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): TCGPara;override;
+          function parseparaloc(p : tparavarsym;const s : string) : boolean;override;
        private
           procedure create_stdcall_paraloc_info(p : tabstractprocdef; side: tcallercallee;paras:tparalist;var parasize:longint);
           procedure create_register_paraloc_info(p : tabstractprocdef; side: tcallercallee;paras:tparalist;var parareg,parasize:longint);
@@ -53,7 +54,7 @@ unit cpupara;
   implementation
 
     uses
-       cutils,
+       cutils,sysutils,
        systems,verbose,
        symtable,
        defutil;
@@ -286,6 +287,32 @@ unit cpupara;
       end;
 
 
+    function tcpuparamanager.parseparaloc(p : tparavarsym;const s : string) : boolean;
+      var
+        paraloc : pcgparalocation;
+      begin
+        result:=false;
+        case target_info.system of
+          system_i386_aros:
+            begin
+              p.paraloc[callerside].alignment:=4;
+              paraloc:=p.paraloc[callerside].add_location;
+              paraloc^.loc:=LOC_REGISTER;
+              paraloc^.size:=def_cgsize(p.vardef);
+              paraloc^.def:=p.vardef;
+              paraloc^.register:=std_regnum_search(lowercase(s));
+              if paraloc^.register = NR_NO then
+                exit;
+
+              { copy to callee side }
+              p.paraloc[calleeside].add_location^:=paraloc^;
+            end;
+          else
+            internalerror(2016090103);
+        end;
+        result:=true;
+      end;
+
     function  tcpuparamanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): TCGPara;
       var
         retcgsize  : tcgsize;
@@ -417,6 +444,19 @@ unit cpupara;
           begin
             hp:=tparavarsym(paras[i]);
             paradef:=hp.vardef;
+
+            { syscall for AROS can have already a paraloc set }
+            if (vo_has_explicit_paraloc in hp.varoptions) then
+              begin
+                if not(vo_is_syscall_lib in hp.varoptions) then
+                  internalerror(2016090105);
+                if p.proccalloption in pushleftright_pocalls then
+                  dec(i)
+                else
+                  inc(i);
+                continue;
+              end;
+
             pushaddr:=push_addr_param(hp.varspez,paradef,p.proccalloption);
             if pushaddr then
               begin

compiler/i386/n386cal.pas

@@ -50,7 +50,8 @@ implementation
       cpubase,paramgr,
       aasmtai,aasmdata,aasmcpu,
       nbas,nmem,nld,ncnv,
-      symdef,symsym,symcpu,
+      parabase,
+      symdef,symsym,symcpu,symconst,
       cga,cgobj,cpuinfo;
 
 
@@ -62,31 +63,43 @@ implementation
     procedure ti386callnode.do_syscall;
       var
         tmpref: treference;
+        libparaloc: pcgparalocation;
       begin
         case target_info.system of
           system_i386_aros:
             begin
-              // one syscall convention for AROS
-              current_asmdata.CurrAsmList.concat(tai_comment.create(strpnew('AROS SysCall')));
-              reference_reset(tmpref,sizeof(pint));
-              { re-read the libbase pushed first on the stack, instead of just trusting the
-                mangledname will work. this is important for example for threadvar libbases.
-                and this way they also don't need to be resolved twice then. (KB) }
-              tmpref.base:=NR_ESP;
-              tmpref.offset:=pushedparasize-sizeof(pint);
-              cg.getcpuregister(current_asmdata.CurrAsmList,NR_EAX);
-              cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,tmpref,NR_EAX);
-              reference_reset_base(tmpref,NR_EAX,-tprocdef(procdefinition).extnumber,sizeof(pint));
-              cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,tmpref,NR_EAX);
-              cg.a_call_reg(current_asmdata.CurrAsmList,NR_EAX);
-              cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_EAX);
+              if (po_syscall_stackbase in tprocdef(procdefinition).procoptions) then
+                begin
+                  current_asmdata.CurrAsmList.concat(tai_comment.create(strpnew('AROS SysCall - StackBase')));
+                  { re-read the libbase pushed first on the stack, instead of just trusting the
+                    mangledname will work. this is important for example for threadvar libbases.
+                    and this way they also don't need to be resolved twice then. (KB) }
+                  libparaloc:=paralocs[procdefinition.paras.count-1]^.location;
+                  if libparaloc^.loc <> LOC_REFERENCE then
+                    internalerror(2016090203);
+                  reference_reset_base(tmpref,libparaloc^.reference.index,libparaloc^.reference.offset,sizeof(pint));
+                  cg.getcpuregister(current_asmdata.CurrAsmList,NR_EAX);
+                  cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,tmpref,NR_EAX);
+                  reference_reset_base(tmpref,NR_EAX,-tprocdef(procdefinition).extnumber,sizeof(pint));
+                  current_asmdata.CurrAsmList.concat(taicpu.op_ref(A_CALL,S_NO,tmpref));
+                  cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_EAX);
+                  exit;
+                end;
+             if (po_syscall_eaxbase in tprocdef(procdefinition).procoptions) then
+                begin
+                  current_asmdata.CurrAsmList.concat(tai_comment.create(strpnew('AROS SysCall - EAXBase')));
+                  { libbase must be in EAX already, so just piggyback that, and dereference it }
+                  reference_reset_base(tmpref,NR_EAX,-tprocdef(procdefinition).extnumber,sizeof(pint));
+                  current_asmdata.CurrAsmList.concat(taicpu.op_ref(A_CALL,S_NO,tmpref));
+                  exit;
+                end;
+              internalerror(2016090104);
             end;
           else
             internalerror(2014081801);
         end;
       end;
 
-
     procedure ti386callnode.gen_syscall_para(para: tcallparanode);
       begin
         { lib parameter has no special type but proccalloptions must be a syscall }

compiler/msg/errore.msg

@@ -139,7 +139,7 @@ general_e_exception_raised=01026_E_Compilation raised exception internally
 #
 # Scanner
 #
-# 02099 is the last used one
+# 02101 is the last used one
 #
 % \section{Scanner messages.}
 % This section lists the messages that the scanner emits. The scanner takes
@@ -413,6 +413,11 @@ scan_e_illegal_hugepointernormalization=02098_E_Illegal argument for HUGEPOINTER
 scan_e_illegal_asmcpu_specifier=02099_E_Illegal assembler CPU instruction set specified "$1"
 % When you specify an assembler CPU with the \var{\{\$ASMCPU xxx\}} directive,
 % the compiler didn't recognize the CPU you specified.
+scan_w_syscall_convention_not_useable_on_target=02100_W_Specified syscall convention is not useable on this target
+% The specified syscall convention using the \var{\{\$SYSCALL xxx\}} directive,
+% is not useable on the current target system.
+scan_w_syscall_convention_invalid=02101_W_Invalid syscall convention specified
+% The compiler did not recognize the syscall convention specified by the \var{\{\$SYSCALL xxx\}} directive.
 % \end{description}
 #
 # Parser

compiler/msgidx.inc

@@ -122,6 +122,8 @@ const
   scan_w_heapmax_lessthan_heapmin=02097;
   scan_e_illegal_hugepointernormalization=02098;
   scan_e_illegal_asmcpu_specifier=02099;
+  scan_w_syscall_convention_not_useable_on_target=02100;
+  scan_w_syscall_convention_invalid=02101;
   parser_e_syntax_error=03000;
   parser_e_dont_nest_interrupt=03004;
   parser_w_proc_directive_ignored=03005;
@@ -1059,9 +1061,9 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 78269;
+  MsgTxtSize = 78381;
 
   MsgIdxMax : array[1..20] of longint=(
-    27,100,347,124,96,58,130,33,208,65,
+    27,102,347,124,96,58,130,33,208,65,
     58,20,30,1,1,1,1,1,1,1
   );

compiler/pdecsub.pas

@@ -115,6 +115,7 @@ implementation
        objcutil,
        { parser }
        scanner,
+       syscinfo,
        pbase,pexpr,ptype,pdecl,pparautl,pgenutil
 {$ifdef jvm}
        ,pjvm
@@ -2044,209 +2045,113 @@ end;
 
 
 procedure pd_syscall(pd:tabstractprocdef);
-{$if defined(powerpc) or defined(m68k) or defined(i386) or defined(x86_64)}
-var
-  vs  : tparavarsym;
-  sym : tsym;
-  symtable : TSymtable;
-  v: Tconstexprint;
-{$endif defined(powerpc) or defined(m68k) or defined(i386) or defined(x86_64)}
-begin
-  if (pd.typ<>procdef) and (target_info.system <> system_powerpc_amiga) then
-    internalerror(2003042614);
-  tprocdef(pd).forwarddef:=false;
-{$ifdef m68k}
-   if target_info.system in [system_m68k_amiga] then
-    begin
-      include(pd.procoptions,po_syscall_legacy);
 
-      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;
-              if po_syscall_legacy in tprocdef(pd).procoptions then
-                begin
-                  vs:=cparavarsym.create('$syscalllib',paranr_syscall_legacy,vs_value,tabstractvarsym(sym).vardef,[vo_is_syscall_lib,vo_is_hidden_para,vo_has_explicit_paraloc]);
-                  paramanager.parseparaloc(vs,'A6');
-                  pd.parast.insert(vs);
-                end
-            end
-          else
-            Message(parser_e_32bitint_or_pointer_variable_expected);
+    procedure include_po_syscall;
+      var
+        syscall: psyscallinfo;
+      begin
+        case target_info.system of
+          system_m68k_amiga,
+          system_powerpc_amiga:
+              include(pd.procoptions,get_default_syscall);
+          system_powerpc_morphos,
+          system_i386_aros,
+          system_x86_64_aros:
+              begin
+                syscall:=get_syscall_by_token(idtoken);
+                if assigned(syscall) then
+                  begin
+                    if target_info.system in syscall^.validon then
+                      begin
+                        consume(idtoken);
+                        include(pd.procoptions,syscall^.procoption);
+                      end
+                  end
+                else
+                  include(pd.procoptions,get_default_syscall);
+              end;
         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
-        message3(type_e_range_check_error_bounds,tostr(v),tostr(low(Tprocdef(pd).extnumber)),tostr(high(Tprocdef(pd).extnumber)))
-      else
-        Tprocdef(pd).extnumber:=v.uvalue;
-    end;
-{$endif m68k}
-{$ifdef powerpc}
-   if target_info.system = system_powerpc_amiga then
-    begin
-      include(pd.procoptions,po_syscall_basesysv);
+      end;
 
-      if consume_sym(sym,symtable) then
+      function po_syscall_to_varoptions: tvaroptions;
         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_basesysv,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);
+          result:=[vo_is_syscall_lib,vo_is_hidden_para];
+          if ([po_syscall_legacy,po_syscall_r12base,po_syscall_sysv,po_syscall_eaxbase] * tprocdef(pd).procoptions) <> [] then
+            include(result,vo_has_explicit_paraloc);
         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;
-    end else
-
-   if target_info.system = system_powerpc_morphos then
-    begin
-      if idtoken=_LEGACY then
-        begin
-          consume(_LEGACY);
-          include(pd.procoptions,po_syscall_legacy);
-        end
-      else if idtoken=_SYSV then
-        begin
-          consume(_SYSV);
-          include(pd.procoptions,po_syscall_sysv);
-        end
-      else if idtoken=_BASESYSV then
-        begin
-          consume(_BASESYSV);
-          include(pd.procoptions,po_syscall_basesysv);
-        end
-      else if idtoken=_SYSVBASE then
-        begin
-          consume(_SYSVBASE);
-          include(pd.procoptions,po_syscall_sysvbase);
-        end
-      else if idtoken=_R12BASE then
+      function po_syscall_to_regname: string;
         begin
-          consume(_R12BASE);
-          include(pd.procoptions,po_syscall_r12base);
-        end
-      else
-        if syscall_convention='LEGACY' then
-          include(pd.procoptions,po_syscall_legacy)
-        else if syscall_convention='SYSV' then
-          include(pd.procoptions,po_syscall_sysv)
-        else if syscall_convention='BASESYSV' then
-          include(pd.procoptions,po_syscall_basesysv)
-        else if syscall_convention='SYSVBASE' then
-          include(pd.procoptions,po_syscall_sysvbase)
-        else if syscall_convention='R12BASE' then
-          include(pd.procoptions,po_syscall_r12base)
-        else
-          internalerror(2005010404);
-
-      if consume_sym(sym,symtable) then
-        begin
-          if (sym.typ=staticvarsym) and
-             (
-              (tabstractvarsym(sym).vardef.typ=pointerdef) or
-              is_32bitint(tabstractvarsym(sym).vardef)
-             ) then
+          if po_syscall_legacy in tprocdef(pd).procoptions then
+            result:='A6'
+          else if po_syscall_r12base in tprocdef(pd).procoptions then
+            result:='R12'
+          { let sysv store the libbase in r12 as well, because we will
+            need the libbase anyway during the call generation }
+          else if po_syscall_sysv in tprocdef(pd).procoptions then
+            result:='R12'
+          else if po_syscall_eaxbase in tprocdef(pd).procoptions then
             begin
-              include(pd.procoptions,po_syscall_has_libsym);
-              tcpuprocdef(pd).libsym:=sym;
-              if po_syscall_legacy in tprocdef(pd).procoptions then
-                begin
-                  vs:=cparavarsym.create('$syscalllib',paranr_syscall_legacy,vs_value,tabstractvarsym(sym).vardef,[vo_is_syscall_lib,vo_is_hidden_para,vo_has_explicit_paraloc]);
-                  paramanager.parseparaloc(vs,'A6');
-                  pd.parast.insert(vs);
-                end
-              else if po_syscall_sysv in tprocdef(pd).procoptions then
-                begin
-                  { Nothing to be done for sysv here for now, but this might change }
-                end
-              else if po_syscall_basesysv in tprocdef(pd).procoptions then
-                begin
-                  vs:=cparavarsym.create('$syscalllib',paranr_syscall_basesysv,vs_value,tabstractvarsym(sym).vardef,[vo_is_syscall_lib,vo_is_hidden_para]);
-                  pd.parast.insert(vs);
-                end
-              else if po_syscall_sysvbase in tprocdef(pd).procoptions then
-                begin
-                  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 if po_syscall_r12base in tprocdef(pd).procoptions then
-                begin
-                  vs:=cparavarsym.create('$syscalllib',paranr_syscall_r12base,vs_value,tabstractvarsym(sym).vardef,[vo_is_syscall_lib,vo_is_hidden_para,vo_has_explicit_paraloc]);
-                  paramanager.parseparaloc(vs,'R12');
-                  pd.parast.insert(vs);
-                end
+              if target_info.system = system_i386_aros then
+                result:='EAX'
+              else if target_info.system = system_x86_64_aros then
+                result:='RAX'
               else
-                internalerror(2005010501);
+                internalerror(2016090201);
             end
           else
-            Message(parser_e_32bitint_or_pointer_variable_expected);
+            internalerror(2016090101);
         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;
-    end;
-{$endif powerpc}
-{$if defined(i386) or defined(x86_64)}
-   if target_info.system in [system_i386_aros,system_x86_64_aros] then
-    begin
-      include(pd.procoptions,po_syscall_sysvbase);
+{$if defined(powerpc) or defined(m68k) or defined(i386) or defined(x86_64)}
+const
+  syscall_paranr: array[boolean] of aint =
+      ( paranr_syscall_lib_last, paranr_syscall_lib_first );
+var
+  vs  : tparavarsym;
+  sym : tsym;
+  symtable : TSymtable;
+  v: Tconstexprint;
+  vo: tvaroptions;
+  paranr: aint;
+{$endif defined(powerpc) or defined(m68k) or defined(i386) or defined(x86_64)}
+begin
+  if (pd.typ<>procdef) and (target_info.system <> system_powerpc_amiga) then
+    internalerror(2003042614);
+  tprocdef(pd).forwarddef:=false;
+{$if defined(powerpc) or defined(m68k) or defined(i386) or defined(x86_64)}
+  include_po_syscall;
 
-      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;
+  if consume_sym(sym,symtable) then
+    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;
+
+        vo:=po_syscall_to_varoptions;
+        paranr:=syscall_paranr[po_syscall_basesysv in tprocdef(pd).procoptions];
+        vs:=cparavarsym.create('$syscalllib',paranr,vs_value,tabstractvarsym(sym).vardef,vo);
+        if vo_has_explicit_paraloc in vo then
+          paramanager.parseparaloc(vs,po_syscall_to_regname);
+        pd.parast.insert(vs);
+      end
+    else
+      Message(parser_e_32bitint_or_pointer_variable_expected);
 
-      paramanager.create_funcretloc_info(pd,calleeside);
-      paramanager.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
-        message(parser_e_range_check_error)
-      else
-        Tprocdef(pd).extnumber:=v.uvalue * sizeof(pint);
-    end;
-{$endif}
+  v:=get_intconst;
+  if (v<low(Tprocdef(pd).extnumber)) or (v>high(Tprocdef(pd).extnumber)) then
+    message3(type_e_range_check_error_bounds,tostr(v),tostr(low(Tprocdef(pd).extnumber)),tostr(high(Tprocdef(pd).extnumber)))
+  else
+    if target_info.system in [system_i386_aros,system_x86_64_aros] then
+      Tprocdef(pd).extnumber:=v.uvalue * sizeof(pint)
+    else
+      Tprocdef(pd).extnumber:=v.uvalue;
+{$endif defined(powerpc) or defined(m68k) or defined(i386) or defined(x86_64)}
 end;
 
 

compiler/pdecvar.pas

@@ -1395,7 +1395,7 @@ implementation
                end;
 
              { Check for EXTERNAL etc directives before a semicolon }
-             if (idtoken in [_EXPORT,_EXTERNAL,_WEAKEXTERNAL,_PUBLIC,_CVAR]) then
+             if (idtoken in [_EXPORT,_EXTERNAL,_PUBLIC,_CVAR]) or (idtoken = _WEAKEXTERNAL) then
                begin
                  read_public_and_external_sc(sc);
                  allowdefaultvalue:=false;
@@ -1456,7 +1456,7 @@ implementation
              { Check for EXTERNAL etc directives or, in macpas, if cs_external_var is set}
              if (
                  (
-                  (idtoken in [_EXPORT,_EXTERNAL,_WEAKEXTERNAL,_PUBLIC,_CVAR]) and
+                  ((idtoken in [_EXPORT,_EXTERNAL,_PUBLIC,_CVAR]) or (idtoken = _WEAKEXTERNAL)) and
                   (m_cvar_support in current_settings.modeswitches)
                  ) or
                  (

compiler/ppu.pas

@@ -43,7 +43,7 @@ type
 {$endif Test_Double_checksum}
 
 const
-  CurrentPPUVersion = 185;
+  CurrentPPUVersion = 186;
 
 { unit flags }
   uf_init                = $000001; { unit has initialization section }

compiler/ptconst.pas

@@ -92,7 +92,7 @@ implementation
            (
             (
              (token = _ID) and
-             (idtoken in [_EXPORT,_EXTERNAL,_WEAKEXTERNAL,_PUBLIC,_CVAR]) and
+             ((idtoken in [_EXPORT,_EXTERNAL,_PUBLIC,_CVAR]) or (idtoken = _WEAKEXTERNAL)) and
              (m_cvar_support in current_settings.modeswitches)
             ) or
             (

compiler/scandir.pas

@@ -58,6 +58,7 @@ unit scandir;
       fmodule,
       defutil,
       dirparse,link,
+      syscinfo,
       symconst,symtable,symbase,symtype,symsym,
       rabase;
 
@@ -1299,27 +1300,25 @@ unit scandir;
         // different places. Skip it for now.
       end;
 
-{$ifdef powerpc}
     procedure dir_syscall;
       var
         sctype : string;
+        syscall : psyscallinfo;
       begin
-        { not needed on amiga/m68k for now, because there's only one }
-        { syscall convention (legacy) (KB) }
-        { not needed on amiga/powerpc because there's only one }
-        { syscall convention (sysv) (KB) }
-        if not (target_info.system in [system_powerpc_morphos]) then
-          comment (V_Warning,'Syscall directive is useless on this target.');
         current_scanner.skipspace;
-
         sctype:=current_scanner.readid;
-        if (sctype='LEGACY') or (sctype='SYSV') or (sctype='SYSVBASE') or
-          (sctype='BASESYSV') or (sctype='R12BASE') then
-          syscall_convention:=sctype
-        else
-          comment (V_Warning,'Invalid Syscall directive ignored.');
+
+        syscall:=get_syscall_by_name(sctype);
+        if assigned(syscall) then
+          begin
+            if not (target_info.system in syscall^.validon) then
+              Message(scan_w_syscall_convention_not_useable_on_target)
+            else
+              set_default_syscall(syscall^.procoption);
+            exit;
+          end;
+        Message(scan_w_syscall_convention_invalid);
       end;
-{$endif}
 
     procedure dir_targetswitch;
       var
@@ -1861,9 +1860,7 @@ unit scandir;
         AddDirective('STACKFRAMES',directive_all, @dir_stackframes);
         AddDirective('STOP',directive_all, @dir_stop);
         AddDirective('STRINGCHECKS', directive_all, @dir_stringchecks);
-{$ifdef powerpc}
         AddDirective('SYSCALL',directive_all, @dir_syscall);
-{$endif powerpc}
         AddDirective('TARGETSWITCH',directive_all, @dir_targetswitch);
         AddDirective('THREADNAME',directive_all, @dir_threadname);
         AddDirective('TYPEDADDRESS',directive_all, @dir_typedaddress);

compiler/symconst.pas

@@ -134,11 +134,11 @@ const
     after the hidden result parameter }
   paranr_objc_self = 5;
   paranr_objc_cmd = 6;
-  { Required to support variations of syscalls on MorphOS }
-  paranr_syscall_basesysv    = 9;
-  paranr_syscall_sysvbase    = high(word)-5;
-  paranr_syscall_r12base     = high(word)-4;
-  paranr_syscall_legacy      = high(word)-3;
+
+  { Required to support variations of syscalls on Amiga-likes }
+  paranr_syscall_lib_first   = 9;             { for basesysv on MorphOS/ppc and AmigaOS4/ppc }
+  paranr_syscall_lib_last    = high(word)-3;  { everything else }
+
   paranr_result_leftright    = high(word)-2;
   paranr_parentfp_delphi_cc  = high(word)-1;
 
@@ -338,13 +338,16 @@ type
     po_has_public_name,
     po_forward,
     po_global,
-    { The different kind of syscalls on MorphOS }
+    { The different kind of syscalls on AmigaOS and MorphOS, m68k and PPC }
     po_syscall_legacy,
     po_syscall_sysv,
     po_syscall_basesysv,
     po_syscall_sysvbase,
     po_syscall_r12base,
-    { Used to record the fact that a symbol is asociated to this syscall }
+    { The different kind of syscalls on AROS, i386/x86_64 }
+    po_syscall_stackbase,
+    po_syscall_eaxbase,
+    { Used to record the fact that a symbol is associated to this syscall }
     po_syscall_has_libsym,
     { Procedure can be inlined }
     po_inline,

compiler/syscinfo.pas

@@ -0,0 +1,131 @@
+{
+    Copyright (c) 2016 by Karoly Balogh
+
+    Contains information on syscalls
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit syscinfo;
+
+{$i fpcdefs.inc}
+
+interface
+
+uses
+  globtype, systems, tokens, symconst;
+
+type
+  tsyscallinfo = record
+    token: ttoken;
+    procoption: tprocoption;
+    validon: set of tsystem;
+  end;
+  psyscallinfo = ^tsyscallinfo;
+
+const
+  syscall_conventions: array[1..7] of tsyscallinfo = (
+      ( token: _LEGACY;    procoption: po_syscall_legacy;    validon: [system_powerpc_morphos,system_m68k_amiga] ),
+      ( token: _SYSV;      procoption: po_syscall_sysv;      validon: [system_powerpc_morphos] ),
+      ( token: _SYSVBASE;  procoption: po_syscall_sysvbase;  validon: [system_powerpc_morphos] ),
+      ( token: _BASESYSV;  procoption: po_syscall_basesysv;  validon: [system_powerpc_morphos,system_powerpc_amiga] ),
+      ( token: _R12BASE;   procoption: po_syscall_r12base;   validon: [system_powerpc_morphos] ),
+      ( token: _STACKBASE; procoption: po_syscall_stackbase; validon: [system_i386_aros,system_x86_64_aros] ),
+      ( token: _EAXBASE;   procoption: po_syscall_eaxbase;   validon: [system_i386_aros,system_x86_64_aros] ));
+
+
+function get_syscall_by_token(const token: ttoken): psyscallinfo;
+function get_syscall_by_name(const name: string): psyscallinfo;
+function get_default_syscall: tprocoption;
+procedure set_default_syscall(sc: tprocoption);
+
+implementation
+
+uses
+  verbose;
+
+const
+  syscall_conventions_po = [ po_syscall_legacy, po_syscall_sysv, po_syscall_sysvbase, po_syscall_basesysv,
+                             po_syscall_r12base, po_syscall_stackbase, po_syscall_eaxbase ];
+
+type
+  tsyscalldefaultinfo = record
+    system: tsystem;
+    procoption: tprocoption;
+  end;
+
+const
+  default_syscall_conventions: array[0..4] of tsyscalldefaultinfo = (
+      ( system: system_m68k_amiga;      procoption: po_syscall_legacy ),
+      ( system: system_powerpc_amiga;   procoption: po_syscall_basesysv ),
+      ( system: system_powerpc_morphos; procoption: po_syscall_legacy ),
+      ( system: system_i386_aros;       procoption: po_syscall_stackbase ),
+      ( system: system_x86_64_aros;     procoption: po_syscall_stackbase ));
+
+var
+  default_syscall_convention: tprocoption = po_none;
+
+function get_syscall_by_token(const token: ttoken): psyscallinfo;
+var
+  i: aint;
+begin
+  result:=nil;
+  for i:=low(syscall_conventions) to high(syscall_conventions) do
+    if syscall_conventions[i].token = token then
+      begin
+        result:=@syscall_conventions[i];
+        break;
+      end;
+end;
+
+function get_syscall_by_name(const name: string): psyscallinfo;
+var
+  i: aint;
+begin
+  result:=nil;
+  for i:=low(syscall_conventions) to high(syscall_conventions) do
+    if arraytokeninfo[syscall_conventions[i].token].str = name then
+      begin
+        result:=@syscall_conventions[i];
+        break;
+      end;
+end;
+
+function get_default_syscall: tprocoption;
+var
+  i: aint;
+begin
+  if not (default_syscall_convention in syscall_conventions_po) then
+    begin
+      for i:=low(default_syscall_conventions) to high(default_syscall_conventions) do
+        if default_syscall_conventions[i].system = target_info.system then
+          default_syscall_convention:=default_syscall_conventions[i].procoption;
+      if not (default_syscall_convention in syscall_conventions_po) then
+        internalerror(2016090302);
+    end;
+
+  result:=default_syscall_convention;
+end;
+
+procedure set_default_syscall(sc: tprocoption);
+begin
+  if not (sc in syscall_conventions_po) then
+    internalerror(2016090301);
+
+  default_syscall_convention:=sc;
+end;
+
+end.

compiler/tokens.pas

@@ -192,6 +192,7 @@ type
     _CPPDECL,
     _DEFAULT,
     _DYNAMIC,
+    _EAXBASE,
     _EXPORTS,
     _FINALLY,
     _FORWARD,
@@ -261,6 +262,7 @@ type
     _PUBLISHED,
     _REFERENCE,
     _SOFTFLOAT,
+    _STACKBASE,
     _THREADVAR,
     _WRITEONLY,
     _BITWISEAND,
@@ -513,6 +515,7 @@ const
       (str:'CPPDECL'       ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'DEFAULT'       ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'DYNAMIC'       ;special:false;keyword:[m_none];op:NOTOKEN),
+      (str:'EAXBASE'       ;special:false;keyword:[m_none];op:NOTOKEN),   { Syscall variation on AROS }
       (str:'EXPORTS'       ;special:false;keyword:alllanguagemodes-[m_iso,m_extpas];op:NOTOKEN),
       (str:'FINALLY'       ;special:false;keyword:[m_except];op:NOTOKEN),
       (str:'FORWARD'       ;special:false;keyword:[m_none];op:NOTOKEN),
@@ -582,6 +585,7 @@ const
       (str:'PUBLISHED'     ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'REFERENCE'     ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'SOFTFLOAT'     ;special:false;keyword:[m_none];op:NOTOKEN),
+      (str:'STACKBASE'     ;special:false;keyword:[m_none];op:NOTOKEN), { Syscall variation on AROS }
       (str:'THREADVAR'     ;special:false;keyword:alllanguagemodes-[m_iso,m_extpas];op:NOTOKEN),
       (str:'WRITEONLY'     ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'BITWISEAND'    ;special:false;keyword:[m_none];op:NOTOKEN), { delphi operator name }

compiler/utils/ppuutils/ppudump.pp

@@ -1935,6 +1935,8 @@ const
      (mask:po_syscall_basesysv;str:'SyscallBaseSysV'),
      (mask:po_syscall_sysvbase;str:'SyscallSysVBase'),
      (mask:po_syscall_r12base; str:'SyscallR12Base'),
+     (mask:po_syscall_stackbase;str:'SyscallStackBase'),
+     (mask:po_syscall_eaxbase; str:'SyscallEAXBase'),
      (mask:po_syscall_has_libsym; str:'Has LibSym'),
      (mask:po_inline;          str:'Inline'),
      (mask:po_compilerproc;    str:'CompilerProc'),