Browse Source

* -Or fixes for open array

peter 21 years ago
parent
commit
60c73cc0e5
6 changed files with 110 additions and 31 deletions
  1. 20 6
      compiler/cgobj.pas
  2. 32 11
      compiler/i386/cgcpu.pas
  3. 5 2
      compiler/i386/rgcpu.pas
  4. 29 9
      compiler/ncgutil.pas
  5. 8 2
      compiler/rgobj.pas
  6. 16 1
      compiler/x86_64/rgcpu.pas

+ 20 - 6
compiler/cgobj.pas

@@ -384,7 +384,7 @@ unit cgobj;
           procedure g_overflowcheck(list: taasmoutput; const Loc:tlocation; def:tdef); virtual;abstract;
           procedure g_overflowcheck(list: taasmoutput; const Loc:tlocation; def:tdef); virtual;abstract;
           procedure g_overflowCheck_loc(List:TAasmOutput;const Loc:TLocation;def:TDef;ovloc : tlocation);virtual;
           procedure g_overflowCheck_loc(List:TAasmOutput;const Loc:TLocation;def:TDef;ovloc : tlocation);virtual;
 
 
-          procedure g_copyvaluepara_openarray(list : taasmoutput;const ref:treference;const lenloc:tlocation;elesize:aint);virtual;
+          procedure g_copyvaluepara_openarray(list : taasmoutput;const ref:treference;const lenloc:tlocation;elesize:aint;loadref:boolean);virtual;
           procedure g_releasevaluepara_openarray(list : taasmoutput;const ref:treference);virtual;
           procedure g_releasevaluepara_openarray(list : taasmoutput;const ref:treference);virtual;
 
 
           {# Emits instructions when compilation is done in profile
           {# Emits instructions when compilation is done in profile
@@ -1888,7 +1888,7 @@ implementation
                             Entry/Exit Code Functions
                             Entry/Exit Code Functions
 *****************************************************************************}
 *****************************************************************************}
 
 
-    procedure tcg.g_copyvaluepara_openarray(list : taasmoutput;const ref:treference;const lenloc:tlocation;elesize:aint);
+    procedure tcg.g_copyvaluepara_openarray(list : taasmoutput;const ref:treference;const lenloc:tlocation;elesize:aint;loadref:boolean);
       var
       var
         sizereg,sourcereg,destreg : tregister;
         sizereg,sourcereg,destreg : tregister;
         paraloc1,paraloc2,paraloc3 : TCGPara;
         paraloc1,paraloc2,paraloc3 : TCGPara;
@@ -1906,7 +1906,14 @@ implementation
         a_op_const_reg(list,OP_ADD,OS_INT,1,sizereg);
         a_op_const_reg(list,OP_ADD,OS_INT,1,sizereg);
         a_op_const_reg(list,OP_IMUL,OS_INT,elesize,sizereg);
         a_op_const_reg(list,OP_IMUL,OS_INT,elesize,sizereg);
         { load source }
         { load source }
-        a_load_ref_reg(list,OS_ADDR,OS_ADDR,ref,sourcereg);
+        if loadref then
+          a_load_ref_reg(list,OS_ADDR,OS_ADDR,ref,sourcereg)
+        else
+          begin
+            if (ref.index<>NR_NO) or (ref.offset<>0) then
+              internalerror(200410126);
+            a_load_reg_reg(list,OS_ADDR,OS_ADDR,ref.base,sourcereg);
+          end;
 
 
         { do getmem call }
         { do getmem call }
         paraloc1.init;
         paraloc1.init;
@@ -1919,9 +1926,13 @@ implementation
         a_call_name(list,'FPC_GETMEM');
         a_call_name(list,'FPC_GETMEM');
         dealloccpuregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default));
         dealloccpuregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default));
         dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
         dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
-        a_load_reg_reg(list,OS_ADDR,OS_ADDR,NR_FUNCTION_RESULT_REG,destreg);
-        a_load_reg_ref(list,OS_ADDR,OS_ADDR,NR_FUNCTION_RESULT_REG,ref);
         paraloc1.done;
         paraloc1.done;
+        a_load_reg_reg(list,OS_ADDR,OS_ADDR,NR_FUNCTION_RESULT_REG,destreg);
+        { patch the new address }
+        if loadref then
+          a_load_reg_ref(list,OS_ADDR,OS_ADDR,NR_FUNCTION_RESULT_REG,ref)
+        else
+          a_load_reg_reg(list,OS_ADDR,OS_ADDR,NR_FUNCTION_RESULT_REG,ref.base);
 
 
         { do move call }
         { do move call }
         paraloc1.init;
         paraloc1.init;
@@ -2084,7 +2095,10 @@ finalization
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.177  2004-10-11 15:46:45  peter
+  Revision 1.178  2004-10-13 21:12:51  peter
+    * -Or fixes for open array
+
+  Revision 1.177  2004/10/11 15:46:45  peter
     * length parameter for copyvaluearray changed to tlocation
     * length parameter for copyvaluearray changed to tlocation
 
 
   Revision 1.176  2004/10/10 20:31:48  peter
   Revision 1.176  2004/10/10 20:31:48  peter

+ 32 - 11
compiler/i386/cgcpu.pas

@@ -49,7 +49,7 @@ unit cgcpu;
         procedure g_save_all_registers(list : taasmoutput);override;
         procedure g_save_all_registers(list : taasmoutput);override;
         procedure g_restore_all_registers(list : taasmoutput;const funcretparaloc:tcgpara);override;
         procedure g_restore_all_registers(list : taasmoutput;const funcretparaloc:tcgpara);override;
         procedure g_proc_exit(list : taasmoutput;parasize:longint;nostackframe:boolean);override;
         procedure g_proc_exit(list : taasmoutput;parasize:longint;nostackframe:boolean);override;
-        procedure g_copyvaluepara_openarray(list : taasmoutput;const ref:treference;const lenloc:tlocation;elesize:aint);override;
+        procedure g_copyvaluepara_openarray(list : taasmoutput;const ref:treference;const lenloc:tlocation;elesize:aint;loadref:boolean);override;
 
 
         procedure g_exception_reason_save(list : taasmoutput; const href : treference);override;
         procedure g_exception_reason_save(list : taasmoutput; const href : treference);override;
         procedure g_exception_reason_save_const(list : taasmoutput; const href : treference; a: aint);override;
         procedure g_exception_reason_save_const(list : taasmoutput; const href : treference; a: aint);override;
@@ -299,7 +299,7 @@ unit cgcpu;
       end;
       end;
 
 
 
 
-    procedure tcg386.g_copyvaluepara_openarray(list : taasmoutput;const ref:treference;const lenloc:tlocation;elesize:aint);
+    procedure tcg386.g_copyvaluepara_openarray(list : taasmoutput;const ref:treference;const lenloc:tlocation;elesize:aint;loadref:boolean);
       var
       var
         power,len  : longint;
         power,len  : longint;
         opsize : topsize;
         opsize : topsize;
@@ -354,8 +354,9 @@ unit cgcpu;
           list.concat(Taicpu.op_reg_reg(A_SUB,S_L,NR_EDI,NR_ESP));
           list.concat(Taicpu.op_reg_reg(A_SUB,S_L,NR_EDI,NR_ESP));
         { align stack on 4 bytes }
         { align stack on 4 bytes }
         list.concat(Taicpu.op_const_reg(A_AND,S_L,aint($fffffff4),NR_ESP));
         list.concat(Taicpu.op_const_reg(A_AND,S_L,aint($fffffff4),NR_ESP));
-        { load destination }
-        a_load_reg_reg(list,OS_INT,OS_INT,NR_ESP,NR_EDI);
+        { load destination, don't use a_load_reg_reg, that will add a move instruction
+          that can confuse the reg allocator }
+        list.concat(Taicpu.Op_reg_reg(A_MOV,S_L,NR_ESP,NR_EDI));
 
 
         { Allocate other registers }
         { Allocate other registers }
         getcpuregister(list,NR_ECX);
         getcpuregister(list,NR_ECX);
@@ -365,7 +366,14 @@ unit cgcpu;
         a_load_loc_reg(list,OS_INT,lenloc,NR_ECX);
         a_load_loc_reg(list,OS_INT,lenloc,NR_ECX);
 
 
         { load source }
         { load source }
-        a_load_ref_reg(list,OS_INT,OS_INT,ref,NR_ESI);
+        if loadref then
+          a_load_ref_reg(list,OS_INT,OS_INT,ref,NR_ESI)
+        else
+          begin
+            if (ref.index<>NR_NO) or (ref.offset<>0) then
+              internalerror(200410123);
+            a_load_reg_reg(list,OS_INT,OS_INT,ref.base,NR_ESI)
+          end;
 
 
         { scheduled .... }
         { scheduled .... }
         list.concat(Taicpu.op_reg(A_INC,S_L,NR_ECX));
         list.concat(Taicpu.op_reg(A_INC,S_L,NR_ECX));
@@ -385,10 +393,13 @@ unit cgcpu;
             len:=len shr 1;
             len:=len shr 1;
           end;
           end;
 
 
-        if ispowerof2(len, power) then
-          list.concat(Taicpu.op_const_reg(A_SHL,S_L,power,NR_ECX))
-        else
-          list.concat(Taicpu.op_const_reg(A_IMUL,S_L,len,NR_ECX));
+        if len<>0 then
+          begin
+            if ispowerof2(len, power) then
+              list.concat(Taicpu.op_const_reg(A_SHL,S_L,power,NR_ECX))
+            else
+              list.concat(Taicpu.op_const_reg(A_IMUL,S_L,len,NR_ECX));
+          end;
         list.concat(Taicpu.op_none(A_REP,S_NO));
         list.concat(Taicpu.op_none(A_REP,S_NO));
         case opsize of
         case opsize of
           S_B : list.concat(Taicpu.Op_none(A_MOVSB,S_NO));
           S_B : list.concat(Taicpu.Op_none(A_MOVSB,S_NO));
@@ -400,7 +411,14 @@ unit cgcpu;
         ungetcpuregister(list,NR_ESI);
         ungetcpuregister(list,NR_ESI);
 
 
         { patch the new address }
         { patch the new address }
-        a_load_reg_ref(list,OS_INT,OS_INT,NR_ESP,ref);
+        if loadref then
+          a_load_reg_ref(list,OS_INT,OS_INT,NR_ESP,ref)
+        else
+          begin
+            { Don't use a_load_reg_reg, that will add a move instruction
+              that can confuse the reg allocator }
+            list.concat(Taicpu.Op_reg_reg(A_MOV,S_L,NR_ESP,ref.base));
+          end;
       end;
       end;
 
 
 
 
@@ -556,7 +574,10 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.55  2004-10-11 15:46:45  peter
+  Revision 1.56  2004-10-13 21:12:51  peter
+    * -Or fixes for open array
+
+  Revision 1.55  2004/10/11 15:46:45  peter
     * length parameter for copyvaluearray changed to tlocation
     * length parameter for copyvaluearray changed to tlocation
 
 
   Revision 1.54  2004/10/05 20:41:01  peter
   Revision 1.54  2004/10/05 20:41:01  peter

+ 5 - 2
compiler/i386/rgcpu.pas

@@ -60,8 +60,8 @@ implementation
       begin
       begin
         if getsubreg(reg) in [R_SUBL,R_SUBH] then
         if getsubreg(reg) in [R_SUBL,R_SUBH] then
           begin
           begin
+            { Some registers have no 8-bit subregister }
             supreg:=getsupreg(reg);
             supreg:=getsupreg(reg);
-            {These registers have no 8-bit subregister, so add interferences.}
             add_edge(supreg,RS_ESI);
             add_edge(supreg,RS_ESI);
             add_edge(supreg,RS_EDI);
             add_edge(supreg,RS_EDI);
             add_edge(supreg,RS_EBP);
             add_edge(supreg,RS_EBP);
@@ -72,7 +72,10 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.43  2004-06-20 08:55:31  florian
+  Revision 1.44  2004-10-13 21:12:51  peter
+    * -Or fixes for open array
+
+  Revision 1.43  2004/06/20 08:55:31  florian
     * logs truncated
     * logs truncated
 
 
   Revision 1.42  2004/01/12 16:39:40  peter
   Revision 1.42  2004/01/12 16:39:40  peter

+ 29 - 9
compiler/ncgutil.pas

@@ -724,7 +724,7 @@ implementation
                   hsym:=tvarsym(tsym(p).owner.search('high'+p.name));
                   hsym:=tvarsym(tsym(p).owner.search('high'+p.name));
                   if not assigned(hsym) then
                   if not assigned(hsym) then
                     internalerror(200306061);
                     internalerror(200306061);
-                  cg.g_copyvaluepara_openarray(list,href1,hsym.localloc,tarraydef(tvarsym(p).vartype.def).elesize);
+                  cg.g_copyvaluepara_openarray(list,href1,hsym.localloc,tarraydef(tvarsym(p).vartype.def).elesize,loadref);
                 end;
                 end;
             end
             end
            else
            else
@@ -753,6 +753,25 @@ implementation
       end;
       end;
 
 
 
 
+    { initializes the regvars from staticsymtable with 0 }
+    procedure initialize_regvars(p : tnamedindexitem;arg:pointer);
+      var
+        oldexprasmlist : TAAsmoutput;
+        hp : tnode;
+      begin
+        if (tsym(p).typ=varsym) then
+         begin
+           case tvarsym(p).localloc.loc of
+             LOC_CREGISTER :
+               cg.a_load_const_reg(taasmoutput(arg),reg_cgsize(tvarsym(p).localloc.register),0,tvarsym(p).localloc.register);
+             LOC_REFERENCE : ;
+             else
+               internalerror(200410124);
+           end;
+         end;
+      end;
+
+
     { generates the code for initialisation of local data }
     { generates the code for initialisation of local data }
     procedure initialize_data(p : tnamedindexitem;arg:pointer);
     procedure initialize_data(p : tnamedindexitem;arg:pointer);
       var
       var
@@ -894,14 +913,8 @@ implementation
                end;
                end;
              vs_out :
              vs_out :
                begin
                begin
-                 case tvarsym(p).localloc.loc of
-                   LOC_REFERENCE :
-                     href:=tvarsym(p).localloc.reference;
-                   else
-                     internalerror(2003091810);
-                 end;
                  tmpreg:=cg.getaddressregister(list);
                  tmpreg:=cg.getaddressregister(list);
-                 cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,tmpreg);
+                 cg.a_load_loc_reg(list,OS_ADDR,tvarsym(p).localloc,tmpreg);
                  reference_reset_base(href,tmpreg,0);
                  reference_reset_base(href,tmpreg,0);
                  cg.g_initialize(list,tvarsym(p).vartype.def,href,false);
                  cg.g_initialize(list,tvarsym(p).vartype.def,href,false);
                end;
                end;
@@ -1382,6 +1395,10 @@ implementation
         { initialize ansi/widesstring para's }
         { initialize ansi/widesstring para's }
         current_procinfo.procdef.parast.foreach_static({$ifndef TP}@{$endif}init_paras,list);
         current_procinfo.procdef.parast.foreach_static({$ifndef TP}@{$endif}init_paras,list);
 
 
+        { initialize regvars in staticsymtable with 0, like .bss }
+        if current_procinfo.procdef.localst.symtabletype=staticsymtable then
+          current_procinfo.procdef.localst.foreach_static({$ifndef TP}@{$endif}initialize_regvars,list);
+
 {$ifdef OLDREGVARS}
 {$ifdef OLDREGVARS}
         load_regvars(list,nil);
         load_regvars(list,nil);
 {$endif OLDREGVARS}
 {$endif OLDREGVARS}
@@ -2202,7 +2219,10 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.226  2004-10-11 15:48:15  peter
+  Revision 1.227  2004-10-13 21:12:51  peter
+    * -Or fixes for open array
+
+  Revision 1.226  2004/10/11 15:48:15  peter
     * small regvar for para fixes
     * small regvar for para fixes
     * function tvarsym.is_regvar added
     * function tvarsym.is_regvar added
     * tvarsym.getvaluesize removed, use getsize instead
     * tvarsym.getvaluesize removed, use getsize instead

+ 8 - 2
compiler/rgobj.pas

@@ -1264,7 +1264,8 @@ unit rgobj;
                 if supregset_in(colourednodes,a) and (reginfo[a].colour<=255) then
                 if supregset_in(colourednodes,a) and (reginfo[a].colour<=255) then
                   include(adj_colours,reginfo[a].colour);
                   include(adj_colours,reginfo[a].colour);
               end;
               end;
-          include(adj_colours,RS_STACK_POINTER_REG);
+          if regtype=R_INTREGISTER then
+            include(adj_colours,RS_STACK_POINTER_REG);
           {Assume a spill by default...}
           {Assume a spill by default...}
           found:=false;
           found:=false;
           {Search for a colour not in this list.}
           {Search for a colour not in this list.}
@@ -1462,6 +1463,8 @@ unit rgobj;
           start with the headertai, because before the header tai is
           start with the headertai, because before the header tai is
           only symbols. }
           only symbols. }
         live_registers.clear;
         live_registers.clear;
+//live_registers.add(RS_STACK_POINTER_REG);
+//live_registers.add(RS_FRAME_POINTER_REG);
         p:=headertai;
         p:=headertai;
         while assigned(p) do
         while assigned(p) do
           begin
           begin
@@ -1992,7 +1995,10 @@ unit rgobj;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.141  2004-10-11 15:47:03  peter
+  Revision 1.142  2004-10-13 21:12:51  peter
+    * -Or fixes for open array
+
+  Revision 1.141  2004/10/11 15:47:03  peter
     * removed warning about register used only once
     * removed warning about register used only once
 
 
   Revision 1.140  2004/10/06 20:14:08  peter
   Revision 1.140  2004/10/06 20:14:08  peter

+ 16 - 1
compiler/x86_64/rgcpu.pas

@@ -33,15 +33,30 @@ unit rgcpu;
 
 
      type
      type
        trgcpu = class(trgx86)
        trgcpu = class(trgx86)
+         procedure add_constraints(reg:Tregister);
        end;
        end;
 
 
   implementation
   implementation
 
 
+
+    procedure trgcpu.add_constraints(reg:Tregister);
+      var
+        supreg : tsuperregister;
+      begin
+        supreg:=getsupreg(reg);
+        { All registers conflict with rsp/rbp }
+        add_edge(supreg,RS_RSP);
+        add_edge(supreg,RS_RBP);
+      end;
+
 end.
 end.
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.9  2004-06-20 08:55:32  florian
+  Revision 1.10  2004-10-13 21:12:51  peter
+    * -Or fixes for open array
+
+  Revision 1.9  2004/06/20 08:55:32  florian
     * logs truncated
     * logs truncated
 
 
   Revision 1.8  2004/02/05 01:24:08  florian
   Revision 1.8  2004/02/05 01:24:08  florian