+ 1st attempt to have explicit funcretloc for Amiga/m68k

git-svn-id: trunk@1978 -

compiler/m68k/cpupara.pas

@@ -43,12 +43,13 @@ unit cpupara;
           procedure getintparaloc(calloption : tproccalloption; nr : longint;var cgpara : TCGPara);override;
           function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
           function push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;override;
-	   procedure create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
+          procedure create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
          private
            procedure init_values(var curintreg, curfloatreg: tsuperregister; var cur_stack_offset: aword);
            function create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tparalist;
                                                var curintreg, curfloatreg: tsuperregister; var cur_stack_offset: aword):longint;   
            function parseparaloc(p : tparavarsym;const s : string) : boolean;override;
+           function parsefuncretloc(p : tabstractprocdef; const s : string) : boolean;override;
        end;
 
   implementation
@@ -190,6 +191,16 @@ unit cpupara;
           retcgsize:=def_cgsize(p.rettype.def);
 
         location_reset(p.funcretloc[side],LOC_INVALID,OS_NO);
+
+        { explicit paraloc specified? }
+        if po_explicitparaloc in p.procoptions then 
+         begin
+           p.funcretloc[side].loc:=LOC_REGISTER;
+           p.funcretloc[side].register:=p.exp_funcretloc;
+           p.funcretloc[side].size:=retcgsize;
+           exit;
+         end;
+
         { void has no location }
         if is_void(p.rettype.def) then
           begin
@@ -414,6 +425,56 @@ unit cpupara;
       end;
 }
 
+    function tm68kparamanager.parsefuncretloc(p : tabstractprocdef; const s : string) : boolean;
+      begin
+        result:=false;
+        case target_info.system of
+          system_m68k_amiga:
+            begin
+              if s='D0' then
+                p.exp_funcretloc:=NR_D0
+              else if s='D1' then
+                p.exp_funcretloc:=NR_D1
+              else if s='D2' then
+                p.exp_funcretloc:=NR_D2
+              else if s='D3' then
+                p.exp_funcretloc:=NR_D3
+              else if s='D4' then
+                p.exp_funcretloc:=NR_D4
+              else if s='D5' then
+                p.exp_funcretloc:=NR_D5
+              else if s='D6' then
+                p.exp_funcretloc:=NR_D6
+              else if s='D7' then
+                p.exp_funcretloc:=NR_D7
+              else if s='A0' then
+                p.exp_funcretloc:=NR_A0
+              else if s='A1' then
+                p.exp_funcretloc:=NR_A1
+              else if s='A2' then
+                p.exp_funcretloc:=NR_A2
+              else if s='A3' then
+                p.exp_funcretloc:=NR_A3
+              else if s='A4' then
+                p.exp_funcretloc:=NR_A4
+              else if s='A5' then
+                p.exp_funcretloc:=NR_A5
+              { 'A6' is problematic, since it's the frame pointer in fpc,
+                so it should be saved before a call! }
+              else if s='A6' then
+                p.exp_funcretloc:=NR_A6
+              { 'A7' is the stack pointer on 68k, can't be overwritten by API calls }
+              else
+                p.exp_funcretloc:=NR_NO;
+                
+              if p.exp_funcretloc<>NR_NO then result:=true;
+            end;
+          else
+            internalerror(2005121801);
+        end;    
+      end;
+
+
     function tm68kparamanager.parseparaloc(p : tparavarsym;const s : string) : boolean;
       var
         paraloc : pcgparalocation;

compiler/paramgr.pas

@@ -112,6 +112,7 @@ unit paramgr;
           procedure duplicateparaloc(list: taasmoutput;calloption : tproccalloption;parasym : tparavarsym;var cgpara:TCGPara);
 
           function parseparaloc(parasym : tparavarsym;const s : string) : boolean;virtual;abstract;
+          function parsefuncretloc(p : tabstractprocdef; const s : string) : boolean;virtual;abstract;
        end;
 
 

compiler/pdecsub.pas

@@ -862,7 +862,9 @@ implementation
       var
         pd : tprocdef;
         isclassmethod : boolean;
+        locationstr: string;
       begin
+        locationstr:='';
         pd:=nil;
         isclassmethod:=false;
         { read class method }
@@ -892,6 +894,30 @@ implementation
                          single_type(pd.rettype,false);
                          pd.test_if_fpu_result;
                          dec(testcurobject);
+                         
+                         if (target_info.system in [system_m68k_amiga]) then
+                          begin
+                           if (idtoken=_LOCATION) then
+                            begin
+                             if po_explicitparaloc in pd.procoptions then
+                              begin
+                               consume(_LOCATION);
+                               locationstr:=pattern;
+                               consume(_CSTRING);
+                              end
+                             else
+                              { I guess this needs a new message... (KB) }
+                              Message(parser_e_paraloc_all_paras);
+                            end
+                           else
+                            begin
+                             if po_explicitparaloc in pd.procoptions then
+                              { assign default locationstr, if none specified }
+                              { and we've arguments with explicit paraloc }
+                              locationstr:='D0'; 
+                            end;    
+                          end;
+                          
                        end
                       else
                        begin
@@ -1021,6 +1047,13 @@ implementation
         if not(check_proc_directive(false)) then
           consume(_SEMICOLON);
         result:=pd;
+
+        if locationstr<>'' then
+         begin
+           if not(paramanager.parsefuncretloc(pd,upper(locationstr))) then
+             { I guess this needs a new message... (KB) }
+             message(parser_e_illegal_explicit_paraloc);
+         end;
       end;
 
 
@@ -1264,7 +1297,6 @@ begin
           else
             Message(parser_e_32bitint_or_pointer_variable_expected);
         end;
-      { FIX ME!!! 68k amigaos syscalls needs explicit funcretloc support to be complete (KB) }
       (paramanager as tm68kparamanager).create_funcretloc_info(pd,calleeside);
       (paramanager as tm68kparamanager).create_funcretloc_info(pd,callerside);
     end;

compiler/symdef.pas

@@ -385,6 +385,9 @@ interface
 {$ifdef i386}
           fpu_used        : longint;    { how many stack fpu must be empty }
 {$endif i386}
+{$ifdef m68k}
+          exp_funcretloc : tregister;   { explicit funcretloc for AmigaOS }
+{$endif}
           funcretloc : array[tcallercallee] of TLocation;
           has_paraloc_info : boolean; { paraloc info is available }
           constructor create(level:byte);