AROS: syscall (library call) support for based on the Amiga/68k and MorphOS/PPC versions

git-svn-id: trunk@28463 -

compiler/i386/cpupara.pas

@@ -243,6 +243,7 @@ unit cpupara;
           pocall_safecall,
           pocall_stdcall,
           pocall_cdecl,
+          pocall_syscall,
           pocall_cppdecl,
           pocall_mwpascal :
             result:=[RS_EAX,RS_EDX,RS_ECX];

compiler/i386/n386cal.pas

@@ -28,13 +28,16 @@ interface
 { $define AnsiStrRef}
 
     uses
-      nx86cal;
+      nx86cal,ncal;
 
     type
        ti386callnode = class(tx86callnode)
        protected
+          procedure gen_syscall_para(para: tcallparanode); override;
           procedure pop_parasize(pop_size:longint);override;
           procedure extra_interrupt_code;override;
+       public
+         procedure do_syscall;override;
        end;
 
 
@@ -46,7 +49,8 @@ implementation
       cgbase,cgutils,
       cpubase,paramgr,
       aasmtai,aasmdata,aasmcpu,
-      ncal,nbas,nmem,nld,ncnv,
+      nbas,nmem,nld,ncnv,
+      symdef,symsym,symcpu,
       cga,cgobj,cpuinfo;
 
 
@@ -55,6 +59,36 @@ implementation
 *****************************************************************************}
 
 
+    procedure ti386callnode.do_syscall;
+      var
+        tmpref: treference;
+      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));
+              tmpref.symbol:=current_asmdata.RefAsmSymbol(tstaticvarsym(tcpuprocdef(procdefinition).libsym).mangledname);
+              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);
+            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 }
+        para.left:=cloadnode.create(tcpuprocdef(procdefinition).libsym,tcpuprocdef(procdefinition).libsym.owner);
+      end;
+
     procedure ti386callnode.extra_interrupt_code;
       begin
         if not(target_info.system in [system_i386_darwin,system_i386_iphonesim,system_i386_android]) then

compiler/i386/symcpu.pas

@@ -26,7 +26,7 @@ unit symcpu;
 interface
 
 uses
-  symtype,symdef,symsym,symx86,symi86;
+  symconst,symtype,symdef,symsym,symx86,symi86;
 
 type
   { defs }
@@ -91,6 +91,15 @@ type
   tcpuprocvardefclass = class of tcpuprocvardef;
 
   tcpuprocdef = class(ti86procdef)
+    procedure ppuload_platform(ppufile: tcompilerppufile); override;
+    procedure ppuwrite_platform(ppufile: tcompilerppufile); override;
+   public
+    { library symbol for AROS }
+    libsym : tsym;
+    libsymderef : tderef;
+    function getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp): tstoreddef; override;
+    procedure buildderef; override;
+    procedure deref; override;
   end;
   tcpuprocdefclass = class of tcpuprocdef;
 
@@ -170,6 +179,46 @@ const
 
 implementation
 
+{****************************************************************************
+                             tcpuprocdef
+****************************************************************************}
+
+  procedure tcpuprocdef.ppuload_platform(ppufile: tcompilerppufile);
+    begin
+      inherited;
+      ppufile.getderef(libsymderef);
+    end;
+
+
+  procedure tcpuprocdef.ppuwrite_platform(ppufile: tcompilerppufile);
+    begin
+      inherited;
+      ppufile.putderef(libsymderef);
+    end;
+
+
+  function tcpuprocdef.getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp): tstoreddef;
+    begin
+      result:=inherited;
+      if newtyp=procdef then
+        tcpuprocdef(result).libsym:=libsym;
+    end;
+
+
+  procedure tcpuprocdef.buildderef;
+    begin
+      inherited;
+      libsymderef.build(libsym);
+    end;
+
+
+  procedure tcpuprocdef.deref;
+    begin
+      inherited;
+      libsym:=tsym(libsymderef.resolve);
+    end;
+
+
 begin
   { used tdef classes }
   cfiledef:=tcpufiledef;

compiler/pdecsub.pas

@@ -1792,13 +1792,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);
@@ -1960,6 +1960,37 @@ 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
+              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 as ti386paramanager).create_funcretloc_info(pd,calleeside);
+      (paramanager as ti386paramanager).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;