Ver Fonte

* some m68k stuff updated

florian há 20 anos atrás
pai
commit
54ceea9e60
2 ficheiros alterados com 82 adições e 58 exclusões
  1. 50 46
      compiler/m68k/cgcpu.pas
  2. 32 12
      compiler/m68k/cpupara.pas

+ 50 - 46
compiler/m68k/cgcpu.pas

@@ -29,56 +29,57 @@ unit cgcpu;
     uses
        cgbase,cgobj,globtype,
        aasmbase,aasmtai,aasmcpu,
-       cpubase,cpuinfo,cpupara,
+       cpubase,cpuinfo,
+       parabase,cpupara,
        node,symconst,symtype,
        cgutils,cg64f32;
 
     type
       tcg68k = class(tcg)
-          procedure init_register_allocators;override;
-          procedure done_register_allocators;override;
-          procedure a_call_name(list : taasmoutput;const s : string);override;
-          procedure a_call_reg(list : taasmoutput;reg : tregister);override;
-          procedure a_load_const_reg(list : taasmoutput;size : tcgsize;a : aint;register : tregister);override;
-          procedure a_load_reg_ref(list : taasmoutput;fromsize,tosize : tcgsize;register : tregister;const ref : treference);override;
-          procedure a_load_reg_reg(list : taasmoutput;fromsize,tosize : tcgsize;reg1,reg2 : tregister);override;
-          procedure a_load_ref_reg(list : taasmoutput;fromsize,tosize : tcgsize;const ref : treference;register : tregister);override;
-          procedure a_loadaddr_ref_reg(list : taasmoutput;const ref : treference;r : tregister);override;
-          procedure a_loadfpu_reg_reg(list: taasmoutput; size: tcgsize; reg1, reg2: tregister); override;
-          procedure a_loadfpu_ref_reg(list: taasmoutput; size: tcgsize; const ref: treference; reg: tregister); override;
-          procedure a_loadfpu_reg_ref(list: taasmoutput; size: tcgsize; reg: tregister; const ref: treference); override;
-          procedure a_loadmm_reg_reg(list: taasmoutput;fromsize,tosize : tcgsize; reg1, reg2: tregister;shuffle : pmmshuffle); override;
-          procedure a_loadmm_ref_reg(list: taasmoutput;fromsize,tosize : tcgsize; const ref: treference; reg: tregister;shuffle : pmmshuffle); override;
-          procedure a_loadmm_reg_ref(list: taasmoutput;fromsize,tosize : tcgsize; reg: tregister; const ref: treference;shuffle : pmmshuffle); override;
-          procedure a_parammm_reg(list: taasmoutput; size: tcgsize; reg: tregister;const locpara : tparalocation;shuffle : pmmshuffle); override;
-          procedure a_op_const_reg(list : taasmoutput; Op: TOpCG; size: tcgsize; a: aint; reg: TRegister); override;
-          procedure a_op_reg_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; reg1, reg2: TRegister); override;
-          procedure a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aint;reg : tregister;
-            l : tasmlabel);override;
-          procedure a_cmp_reg_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); override;
-          procedure a_jmp_always(list : taasmoutput;l: tasmlabel); override;
-          procedure a_jmp_flags(list : taasmoutput;const f : TResFlags;l: tasmlabel); override;
-          procedure g_flags2reg(list: taasmoutput; size: TCgSize; const f: tresflags; reg: TRegister); override;
-
-          procedure g_concatcopy(list : taasmoutput;const source,dest : treference;len : aint;delsource,loadref : boolean);override;
-          { generates overflow checking code for a node }
-          procedure g_overflowcheck(list: taasmoutput; const l:tlocation; def:tdef); override;
-          procedure g_copyvaluepara_openarray(list : taasmoutput;const ref:treference;const lenloc:tlocation;elesize:aint); override;
-          procedure g_stackframe_entry(list : taasmoutput;localsize : longint);override;
-          procedure g_restore_frame_pointer(list : taasmoutput);override;
-          procedure g_return_from_proc(list : taasmoutput;parasize : aint);override;
-          procedure g_restore_standard_registers(list:Taasmoutput);override;
-          procedure g_save_standard_registers(list:Taasmoutput);override;
-          procedure g_save_all_registers(list : taasmoutput);override;
-          procedure g_restore_all_registers(list : taasmoutput;const funcretparaloc:tparalocation);override;
+        procedure init_register_allocators;override;
+        procedure done_register_allocators;override;
+        procedure a_call_name(list : taasmoutput;const s : string);override;
+        procedure a_call_reg(list : taasmoutput;reg : tregister);override;
+        procedure a_load_const_reg(list : taasmoutput;size : tcgsize;a : aint;register : tregister);override;
+        procedure a_load_reg_ref(list : taasmoutput;fromsize,tosize : tcgsize;register : tregister;const ref : treference);override;
+        procedure a_load_reg_reg(list : taasmoutput;fromsize,tosize : tcgsize;reg1,reg2 : tregister);override;
+        procedure a_load_ref_reg(list : taasmoutput;fromsize,tosize : tcgsize;const ref : treference;register : tregister);override;
+        procedure a_loadaddr_ref_reg(list : taasmoutput;const ref : treference;r : tregister);override;
+        procedure a_loadfpu_reg_reg(list: taasmoutput; size: tcgsize; reg1, reg2: tregister); override;
+        procedure a_loadfpu_ref_reg(list: taasmoutput; size: tcgsize; const ref: treference; reg: tregister); override;
+        procedure a_loadfpu_reg_ref(list: taasmoutput; size: tcgsize; reg: tregister; const ref: treference); override;
+        procedure a_loadmm_reg_reg(list: taasmoutput;fromsize,tosize : tcgsize; reg1, reg2: tregister;shuffle : pmmshuffle); override;
+        procedure a_loadmm_ref_reg(list: taasmoutput;fromsize,tosize : tcgsize; const ref: treference; reg: tregister;shuffle : pmmshuffle); override;
+        procedure a_loadmm_reg_ref(list: taasmoutput;fromsize,tosize : tcgsize; reg: tregister; const ref: treference;shuffle : pmmshuffle); override;
+        procedure a_parammm_reg(list: taasmoutput; size: tcgsize; reg: tregister;const locpara : TCGPara;shuffle : pmmshuffle); override;
+        procedure a_op_const_reg(list : taasmoutput; Op: TOpCG; size: tcgsize; a: aint; reg: TRegister); override;
+        procedure a_op_reg_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; reg1, reg2: TRegister); override;
+        procedure a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aint;reg : tregister;
+          l : tasmlabel);override;
+        procedure a_cmp_reg_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); override;
+        procedure a_jmp_always(list : taasmoutput;l: tasmlabel); override;
+        procedure a_jmp_flags(list : taasmoutput;const f : TResFlags;l: tasmlabel); override;
+        procedure g_flags2reg(list: taasmoutput; size: TCgSize; const f: tresflags; reg: TRegister); override;
+
+        procedure g_concatcopy(list : taasmoutput;const source,dest : treference;len : aint;delsource,loadref : boolean);override;
+        { generates overflow checking code for a node }
+        procedure g_overflowcheck(list: taasmoutput; const l:tlocation; def:tdef); override;
+        procedure g_copyvaluepara_openarray(list : taasmoutput;const ref:treference;const lenloc:tlocation;elesize:aint); override;
+        procedure g_stackframe_entry(list : taasmoutput;localsize : longint);override;
+        procedure g_restore_frame_pointer(list : taasmoutput);override;
+        procedure g_return_from_proc(list : taasmoutput;parasize : aint);override;
+        procedure g_restore_standard_registers(list:Taasmoutput);override;
+        procedure g_save_standard_registers(list:Taasmoutput);override;
+        procedure g_save_all_registers(list : taasmoutput);override;
+        procedure g_restore_all_registers(list : taasmoutput;const funcretparaloc:TCGPara);override;
      protected
-         function fixref(list: taasmoutput; var ref: treference): boolean;
+        function fixref(list: taasmoutput; var ref: treference): boolean;
      private
-          { # Sign or zero extend the register to a full 32-bit value.
-              The new value is left in the same register.
-          }
-          procedure sign_extend(list: taasmoutput;_oldsize : tcgsize; reg: tregister);
-          procedure a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: tasmlabel);
+        { # Sign or zero extend the register to a full 32-bit value.
+            The new value is left in the same register.
+        }
+        procedure sign_extend(list: taasmoutput;_oldsize : tcgsize; reg: tregister);
+        procedure a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: tasmlabel);
 
      end;
 
@@ -380,7 +381,7 @@ unit cgcpu;
       end;
 
 
-    procedure tcg68k.a_parammm_reg(list: taasmoutput; size: tcgsize; reg: tregister;const locpara : tparalocation;shuffle : pmmshuffle);
+    procedure tcg68k.a_parammm_reg(list: taasmoutput; size: tcgsize; reg: tregister;const locpara : TCGPara;shuffle : pmmshuffle);
       begin
         internalerror(20020729);
       end;
@@ -1134,7 +1135,7 @@ unit cgcpu;
       begin
       end;
 
-    procedure tcg68k.g_restore_all_registers(list : taasmoutput;const funcretparaloc:tparalocation);
+    procedure tcg68k.g_restore_all_registers(list : taasmoutput;const funcretparaloc:TCGPara);
       begin
       end;
 
@@ -1313,7 +1314,10 @@ end.
 
 {
   $Log$
-  Revision 1.31  2004-11-09 22:32:59  peter
+  Revision 1.32  2004-11-27 16:16:02  florian
+    * some m68k stuff updated
+
+  Revision 1.31  2004/11/09 22:32:59  peter
     * small m68k updates to bring it up2date
     * give better error for external local variable
 

+ 32 - 12
compiler/m68k/cpupara.pas

@@ -31,7 +31,7 @@ unit cpupara;
     uses
       globtype,
       cpubase,
-      symconst,symdef,
+      symconst,symdef,symsym,
       parabase,paramgr;
 
     type
@@ -44,7 +44,7 @@ unit cpupara;
           procedure getintparaloc(calloption : tproccalloption; nr : longint;var cgpara : TCGPara);override;
           function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
          private
-           function parseparaloc(p : tparaitem;const s : string) : boolean;override;
+           function parseparaloc(p : tparavarsym;const s : string) : boolean;override;
        end;
 
   implementation
@@ -81,24 +81,42 @@ unit cpupara;
     function tm68kparamanager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;
       var
         paraloc      : pcgparalocation;
-        hp           : tparaitem;
+        hp           : tparavarsym;
         paracgsize   : tcgsize;
         paralen      : longint;
         parasize     : longint;
+        i            : longint;
       begin
         parasize:=0;
-        hp:=tparaitem(p.para.first);
-        while assigned(hp) do
+        for i:=0 to p.paras.count-1 do
           begin
-            if push_addr_param(hp.paratyp,hp.paratype.def,p.proccalloption) then
+            hp:=tparavarsym(p.paras[i]);
+
+            hp.paraloc[side].reset;
+            { currently only support C-style array of const }
+            if (p.proccalloption in [pocall_cdecl,pocall_cppdecl]) and
+               is_array_of_const(hp.vartype.def) then
+              begin
+                paraloc:=hp.paraloc[side].add_location;
+                { hack: the paraloc must be valid, but is not actually used }
+                paraloc^.loc:=LOC_REFERENCE;
+                if side=callerside then
+                  paraloc^.reference.index:=NR_STACK_POINTER_REG
+                else
+                  paraloc^.reference.index:=NR_FRAME_POINTER_REG;
+                paraloc^.size:=OS_ADDR;
+                paraloc^.reference.offset:=0;
+                break;
+              end;
+
+            if push_addr_param(hp.varspez,hp.vartype.def,p.proccalloption) then
               paracgsize:=OS_ADDR
             else
               begin
-                paracgsize:=def_cgSize(hp.paratype.def);
+                paracgsize:=def_cgsize(hp.vartype.def);
                 if paracgsize=OS_NO then
                   paracgsize:=OS_ADDR;
               end;
-            hp.paraloc[side].reset;
             hp.paraloc[side].size:=paracgsize;
             hp.paraloc[side].Alignment:=std_param_align;
             paraloc:=hp.paraloc[side].add_location;
@@ -109,13 +127,12 @@ unit cpupara;
             else
               paraloc^.reference.index:=NR_FRAME_POINTER_REG;
             paraloc^.reference.offset:=target_info.first_parm_offset+parasize;
-            hp:=TParaItem(hp.Next);
           end;
         result:=parasize;
       end;
 
 
-    function tm68kparamanager.parseparaloc(p : tparaitem;const s : string) : boolean;
+    function tm68kparamanager.parseparaloc(p : tparavarsym;const s : string) : boolean;
       var
         paraloc : pcgparalocation;
       begin
@@ -126,7 +143,7 @@ unit cpupara;
               p.paraloc[callerside].alignment:=4;
               paraloc:=p.paraloc[callerside].add_location;
               paraloc^.loc:=LOC_REGISTER;
-              paraloc^.size:=def_cgsize(p.paratype.def);
+              paraloc^.size:=def_cgsize(p.vartype.def);
               { pattern is always uppercase'd }
               if s='D0' then
                 paraloc^.register:=NR_D0
@@ -179,7 +196,10 @@ end.
 
 {
   $Log$
-  Revision 1.8  2004-11-09 22:32:59  peter
+  Revision 1.9  2004-11-27 16:16:02  florian
+    * some m68k stuff updated
+
+  Revision 1.8  2004/11/09 22:32:59  peter
     * small m68k updates to bring it up2date
     * give better error for external local variable