Browse Source

fpcdefs.inc: Set fpc_compiler_has_fixup_jmps for powerpcXX and mips CPUs.
psub.pas: Use new fpc_compiler_has_fixup_jmps conditional.
mips/aasmcpu.pas: MIPS specific fixup_jmps function,
The insttruction distance calculation is not exact as
some pseudo-instruction can be expanded to a variable number of real instructions
real calculation would only be possible if we first
convert pseudo-instuctions to real instructions before calling fixup_jmps.

ncgutil.pas: Revert commit r21791
ncgcon.pas: Revert commit r21786
mips/cgcpu.pas: Partial revert of commit r21798, no need to always use A_J,
as fixup_jmps now handles out of range branches.

git-svn-id: trunk@21822 -

pierre 13 years ago
parent
commit
bc0c94c204
6 changed files with 155 additions and 71 deletions
  1. 3 0
      compiler/fpcdefs.inc
  2. 146 1
      compiler/mips/aasmcpu.pas
  3. 2 12
      compiler/mips/cgcpu.pas
  4. 1 45
      compiler/ncgcon.pas
  5. 1 11
      compiler/ncgutil.pas
  6. 2 2
      compiler/psub.pas

+ 3 - 0
compiler/fpcdefs.inc

@@ -107,6 +107,7 @@
   {$define cpumm}
   {$define cpumm}
   {$define cpurox}
   {$define cpurox}
   {$define cpurefshaveindexreg}
   {$define cpurefshaveindexreg}
+  {$define fpc_compiler_has_fixup_jmps}
 {$endif powerpc}
 {$endif powerpc}
 
 
 {$ifdef powerpc64}
 {$ifdef powerpc64}
@@ -117,6 +118,7 @@
   {$define cpumm}
   {$define cpumm}
   {$define cpurox}
   {$define cpurox}
   {$define cpurefshaveindexreg}
   {$define cpurefshaveindexreg}
+  {$define fpc_compiler_has_fixup_jmps}
 {$endif powerpc64}
 {$endif powerpc64}
 
 
 {$ifdef arm}
 {$ifdef arm}
@@ -195,6 +197,7 @@
   {$define cpurequiresproperalignment}
   {$define cpurequiresproperalignment}
   { define cpumm}
   { define cpumm}
   {$define cpurefshaveindexreg}
   {$define cpurefshaveindexreg}
+  {$define fpc_compiler_has_fixup_jmps}
 {$endif mips}
 {$endif mips}
 
 
 {$ifdef jvm}
 {$ifdef jvm}

+ 146 - 1
compiler/mips/aasmcpu.pas

@@ -28,7 +28,7 @@ interface
 uses
 uses
   cclasses,
   cclasses,
   globtype, globals, verbose,
   globtype, globals, verbose,
-  aasmbase, aasmsym, aasmtai,
+  aasmbase, aasmdata, aasmsym, aasmtai,
   cgbase, cgutils, cpubase, cpuinfo;
   cgbase, cgutils, cpubase, cpuinfo;
 
 
 const
 const
@@ -78,11 +78,16 @@ type
   procedure InitAsm;
   procedure InitAsm;
   procedure DoneAsm;
   procedure DoneAsm;
 
 
+  procedure fixup_jmps(list: TAsmList);
+
   function spilling_create_load(const ref: treference; r: tregister): taicpu;
   function spilling_create_load(const ref: treference; r: tregister): taicpu;
   function spilling_create_store(r: tregister; const ref: treference): taicpu;
   function spilling_create_store(r: tregister; const ref: treference): taicpu;
 
 
 implementation
 implementation
 
 
+  uses
+    cutils;
+
 {*****************************************************************************
 {*****************************************************************************
                                  taicpu Constructors
                                  taicpu Constructors
 *****************************************************************************}
 *****************************************************************************}
@@ -452,6 +457,146 @@ procedure DoneAsm;
   end;
   end;
 
 
 
 
+procedure fixup_jmps(list: TAsmList);
+  var
+    p,pdelayslot: tai;
+    newcomment: tai_comment;
+    newjmp,newnoop: taicpu;
+    labelpositions: TFPList;
+    instrpos: ptrint;
+    l: tasmlabel;
+    inserted_something: boolean;
+  begin
+    // if certainly not enough instructions to cause an overflow, dont bother
+    if (list.count <= (high(smallint) div 4)) then
+      exit;
+    labelpositions := TFPList.create;
+    p := tai(list.first);
+    instrpos := 1;
+    // record label positions
+    while assigned(p) do
+      begin
+        if p.typ = ait_label then
+          begin
+            if (tai_label(p).labsym.labelnr >= labelpositions.count) then
+              labelpositions.count := tai_label(p).labsym.labelnr * 2;
+            labelpositions[tai_label(p).labsym.labelnr] := pointer(instrpos);
+          end;
+        { ait_const is for jump tables }
+        case p.typ of
+          ait_instruction:
+            { probleim here: pseudo-instructions can translate into
+              several CPU instructions, possibly depending on assembler options,
+              to obe on safe side, let's assume a mean of two. } 
+            inc(instrpos,2);
+          ait_const:
+            begin
+              if (tai_const(p).consttype<>aitconst_32bit) then
+                internalerror(2008052101);
+              inc(instrpos);
+            end;
+        end;
+        p := tai(p.next);
+      end;
+
+    { If the number of instructions is below limit, we can't overflow either }
+    if (instrpos <= (high(smallint) div 4)) then
+      exit;
+    // check and fix distances
+    repeat
+      inserted_something := false;
+      p := tai(list.first);
+      instrpos := 1;
+      while assigned(p) do
+        begin
+          case p.typ of
+            ait_label:
+              // update labelposition in case it changed due to insertion
+              // of jumps
+              begin
+                // can happen because of newly inserted labels
+                if (tai_label(p).labsym.labelnr > labelpositions.count) then
+                  labelpositions.count := tai_label(p).labsym.labelnr * 2;
+                labelpositions[tai_label(p).labsym.labelnr] := pointer(instrpos);
+              end;
+            ait_instruction:
+              begin
+                inc(instrpos,2);
+                case taicpu(p).opcode of
+                  A_BA:
+                    if (taicpu(p).oper[0]^.typ = top_ref) and
+                       assigned(taicpu(p).oper[0]^.ref^.symbol) and
+                       (taicpu(p).oper[0]^.ref^.symbol is tasmlabel) and
+                       (labelpositions[tasmlabel(taicpu(p).oper[0]^.ref^.symbol).labelnr] <> NIL) and
+{$push}
+{$q-}
+                       (ptruint(abs(ptrint(labelpositions[tasmlabel(taicpu(p).oper[0]^.ref^.symbol).labelnr]-instrpos)) - (low(smallint) div 4)) > ptruint((high(smallint) - low(smallint)) div 4)) then
+{$pop}
+                      begin
+                        { This is not PIC safe }
+                        taicpu(p).opcode:=A_J;
+                        newcomment:=tai_comment.create(strpnew('fixup_jmps, A_BA changed into A_J'));
+                        list.insertbefore(newcomment,p);
+                      end;
+                  A_BC:
+                    if (taicpu(p).ops=3) and (taicpu(p).oper[2]^.typ = top_ref) and
+                       assigned(taicpu(p).oper[2]^.ref^.symbol) and
+                       (taicpu(p).oper[2]^.ref^.symbol is tasmlabel) and
+                       (labelpositions[tasmlabel(taicpu(p).oper[2]^.ref^.symbol).labelnr] <> NIL) and
+{$push}
+{$q-}
+                       (ptruint(abs(ptrint(labelpositions[tasmlabel(taicpu(p).oper[2]^.ref^.symbol).labelnr]-instrpos)) - (low(smallint) div 4)) > ptruint((high(smallint) - low(smallint)) div 4)) then
+{$pop}
+                      begin
+                        // add a new label after this jump
+                        current_asmdata.getjumplabel(l);
+                        { new label -> may have to increase array size }
+                        if (l.labelnr >= labelpositions.count) then
+                          labelpositions.count := l.labelnr + 10;
+                        { newjmp will be inserted before the label, and it's inserted after }
+                        { plus delay slot                                                   } 
+                        { the current jump -> instrpos+3                                    }
+                        labelpositions[l.labelnr] := pointer(instrpos+2*3);
+                        pdelayslot:=tai(p.next);
+                        { We need to insert the new instruction after the delay slot instruction ! }
+                        while assigned(pdelayslot) and (pdelayslot.typ<>ait_instruction) do
+                          pdelayslot:=tai(pdelayslot.next);
+
+                        list.insertafter(tai_label.create(l),pdelayslot);
+                        // add a new unconditional jump between this jump and the label
+                        newcomment:=tai_comment.create(strpnew('fixup_jmps, A_BXX changed into A_BNOTXX label;A_J;label:'));
+                        list.insertbefore(newcomment,p);
+                        newjmp := taicpu.op_sym(A_J,taicpu(p).oper[2]^.ref^.symbol);
+                        newjmp.is_jmp := true;
+                        newjmp.fileinfo := taicpu(p).fileinfo;
+                        list.insertafter(newjmp,pdelayslot);
+                        inc(instrpos,2);
+                        { Add a delay slot for new A_J instruction }
+                        newnoop:=taicpu.op_none(A_NOP);
+                        newnoop.fileinfo := taicpu(p).fileinfo;
+                        list.insertafter(newnoop,newjmp);
+                        inc(instrpos,2);
+                        // change the conditional jump to point to the newly inserted label
+                        tasmlabel(taicpu(p).oper[2]^.ref^.symbol).decrefs;
+                        taicpu(p).oper[2]^.ref^.symbol := l;
+                        l.increfs;
+                        // and invert its condition code
+                        taicpu(p).condition := inverse_cond(taicpu(p).condition);
+                        // we inserted an instruction, so will have to check everything again
+                        inserted_something := true;
+                      end;
+                end;
+              end;
+            ait_const:
+              inc(instrpos);
+          end;
+          p := tai(p.next);
+        end;
+     until not inserted_something;
+    labelpositions.free;
+  end;
+
+
 begin
 begin
   cai_cpu   := taicpu;
   cai_cpu   := taicpu;
   cai_align := tai_align;
   cai_align := tai_align;

+ 2 - 12
compiler/mips/cgcpu.pas

@@ -1323,12 +1323,7 @@ procedure TCGMIPS.a_jmp_always(List: tasmlist; l: TAsmLabel);
 var
 var
   ai : Taicpu;
   ai : Taicpu;
 begin
 begin
-  { Always use A_J instead of A_BA to avoid 
-    out of range error, but not for PIC code }
-  if (cs_create_pic in current_settings.moduleswitches) then
-    ai := taicpu.op_sym(A_BA, l)
-  else
-    ai := taicpu.op_sym(A_J, l);
+  ai := taicpu.op_sym(A_BA, l);
   list.concat(ai);
   list.concat(ai);
   { Delay slot }
   { Delay slot }
   list.Concat(TAiCpu.Op_none(A_NOP));
   list.Concat(TAiCpu.Op_none(A_NOP));
@@ -1337,12 +1332,7 @@ end;
 
 
 procedure TCGMIPS.a_jmp_name(list: tasmlist; const s: string);
 procedure TCGMIPS.a_jmp_name(list: tasmlist; const s: string);
 begin
 begin
-  { Always use A_J instead of A_BA to avoid 
-    out of range error, but not for PIC code }
-  if (cs_create_pic in current_settings.moduleswitches) then
-    List.Concat(TAiCpu.op_sym(A_BA, current_asmdata.RefAsmSymbol(s)))
-  else
-    List.Concat(TAiCpu.op_sym(A_J, current_asmdata.RefAsmSymbol(s)));
+  List.Concat(TAiCpu.op_sym(A_BA, current_asmdata.RefAsmSymbol(s)));
   { Delay slot }
   { Delay slot }
   list.Concat(TAiCpu.Op_none(A_NOP));
   list.Concat(TAiCpu.Op_none(A_NOP));
 end;
 end;

+ 1 - 45
compiler/ncgcon.pas

@@ -32,12 +32,10 @@ interface
 
 
     type
     type
        tcgdataconstnode = class(tdataconstnode)
        tcgdataconstnode = class(tdataconstnode)
-          function pass_1 : tnode;override;
           procedure pass_generate_code;override;
           procedure pass_generate_code;override;
        end;
        end;
 
 
        tcgrealconstnode = class(trealconstnode)
        tcgrealconstnode = class(trealconstnode)
-          function pass_1 : tnode;override;
           procedure pass_generate_code;override;
           procedure pass_generate_code;override;
        end;
        end;
 
 
@@ -50,12 +48,10 @@ interface
        end;
        end;
 
 
        tcgstringconstnode = class(tstringconstnode)
        tcgstringconstnode = class(tstringconstnode)
-          function pass_1 : tnode;override;
           procedure pass_generate_code;override;
           procedure pass_generate_code;override;
        end;
        end;
 
 
        tcgsetconstnode = class(tsetconstnode)
        tcgsetconstnode = class(tsetconstnode)
-          function pass_1 : tnode;override;
          protected
          protected
           function emitvarsetconst: tasmsymbol; virtual;
           function emitvarsetconst: tasmsymbol; virtual;
           procedure handlevarsetconst;
           procedure handlevarsetconst;
@@ -68,7 +64,6 @@ interface
        end;
        end;
 
 
        tcgguidconstnode = class(tguidconstnode)
        tcgguidconstnode = class(tguidconstnode)
-          function pass_1 : tnode;override;
           procedure pass_generate_code;override;
           procedure pass_generate_code;override;
        end;
        end;
 
 
@@ -79,7 +74,7 @@ implementation
       globtype,widestr,systems,
       globtype,widestr,systems,
       verbose,globals,cutils,
       verbose,globals,cutils,
       symconst,symdef,aasmtai,aasmdata,aasmcpu,defutil,
       symconst,symdef,aasmtai,aasmdata,aasmcpu,defutil,
-      procinfo,cpuinfo,cpubase,
+      cpuinfo,cpubase,
       cgbase,cgobj,cgutils,
       cgbase,cgobj,cgutils,
       ncgutil, cclasses,asmutils,tgobj
       ncgutil, cclasses,asmutils,tgobj
       ;
       ;
@@ -89,20 +84,6 @@ implementation
                            TCGREALCONSTNODE
                            TCGREALCONSTNODE
 *****************************************************************************}
 *****************************************************************************}
 
 
-
-    procedure needs_got_for_pic;
-	  begin
-        if (cs_create_pic in current_settings.moduleswitches) and
-		   assigned(current_procinfo) then
-          include(current_procinfo.flags,pi_needs_got);
-      end;
-
-    function tcgdataconstnode.pass_1 : tnode;
-	  begin
-        pass_1:=inherited pass_1;
-		needs_got_for_pic;
-	  end;
-
     procedure tcgdataconstnode.pass_generate_code;
     procedure tcgdataconstnode.pass_generate_code;
       var
       var
         l : tasmlabel;
         l : tasmlabel;
@@ -127,12 +108,6 @@ implementation
                            TCGREALCONSTNODE
                            TCGREALCONSTNODE
 *****************************************************************************}
 *****************************************************************************}
 
 
-    function tcgrealconstnode.pass_1 : tnode;
-	  begin
-        pass_1:=inherited pass_1;
-		needs_got_for_pic;
-	  end;
-
     procedure tcgrealconstnode.pass_generate_code;
     procedure tcgrealconstnode.pass_generate_code;
       { I suppose the parser/pass_1 must make sure the generated real  }
       { I suppose the parser/pass_1 must make sure the generated real  }
       { constants are actually supported by the target processor? (JM) }
       { constants are actually supported by the target processor? (JM) }
@@ -280,12 +255,6 @@ implementation
                           TCGSTRINGCONSTNODE
                           TCGSTRINGCONSTNODE
 *****************************************************************************}
 *****************************************************************************}
 
 
-    function tcgstringconstnode.pass_1 : tnode;
-	  begin
-        pass_1:=inherited pass_1;
-		needs_got_for_pic;
-	  end;
-
     procedure tcgstringconstnode.pass_generate_code;
     procedure tcgstringconstnode.pass_generate_code;
       var
       var
          lastlabel: tasmlabofs;
          lastlabel: tasmlabofs;
@@ -420,12 +389,6 @@ implementation
 {*****************************************************************************
 {*****************************************************************************
                            TCGSETCONSTNODE
                            TCGSETCONSTNODE
 *****************************************************************************}
 *****************************************************************************}
-    function tcgsetconstnode.pass_1 : tnode;
-	  begin
-        pass_1:=inherited pass_1;
-		needs_got_for_pic;
-	  end;
-
 
 
     function tcgsetconstnode.emitvarsetconst: tasmsymbol;
     function tcgsetconstnode.emitvarsetconst: tasmsymbol;
       type
       type
@@ -560,12 +523,6 @@ implementation
                           TCGGUIDCONSTNODE
                           TCGGUIDCONSTNODE
 *****************************************************************************}
 *****************************************************************************}
 
 
-    function tcgguidconstnode.pass_1 : tnode;
-	  begin
-        pass_1:=inherited pass_1;
-		needs_got_for_pic;
-	  end;
-
     procedure tcgguidconstnode.pass_generate_code;
     procedure tcgguidconstnode.pass_generate_code;
       var
       var
         tmplabel : TAsmLabel;
         tmplabel : TAsmLabel;
@@ -595,5 +552,4 @@ begin
    csetconstnode:=tcgsetconstnode;
    csetconstnode:=tcgsetconstnode;
    cnilnode:=tcgnilnode;
    cnilnode:=tcgnilnode;
    cguidconstnode:=tcgguidconstnode;
    cguidconstnode:=tcgguidconstnode;
-   global_used:=@needs_got_for_pic;
 end.
 end.

+ 1 - 11
compiler/ncgutil.pas

@@ -413,9 +413,6 @@ implementation
     procedure new_exception(list:TAsmList;const t:texceptiontemps;exceptlabel:tasmlabel);
     procedure new_exception(list:TAsmList;const t:texceptiontemps;exceptlabel:tasmlabel);
       var
       var
         paraloc1,paraloc2,paraloc3 : tcgpara;
         paraloc1,paraloc2,paraloc3 : tcgpara;
-{$ifdef MIPS}
-		sbl : tasmlabel;
-{$endif MIPS}
       begin
       begin
         paraloc1.init;
         paraloc1.init;
         paraloc2.init;
         paraloc2.init;
@@ -443,14 +440,7 @@ implementation
         cg.alloccpuregisters(list,R_INTREGISTER,[RS_FUNCTION_RESULT_REG]);
         cg.alloccpuregisters(list,R_INTREGISTER,[RS_FUNCTION_RESULT_REG]);
 
 
         cg.g_exception_reason_save(list, t.reasonbuf);
         cg.g_exception_reason_save(list, t.reasonbuf);
-{$ifdef MIPS}
-        current_asmdata.getjumplabel(sbl);
-		cg.a_cmp_const_reg_label(list,OS_S32,OC_EQ,0,cg.makeregsize(list,NR_FUNCTION_RESULT_REG,OS_S32),sbl);
-        cg.a_jmp_always(list,exceptlabel);
-        cg.a_label(list,sbl);
-{$else not MIPS}
-          cg.a_cmp_const_reg_label(list,OS_S32,OC_NE,0,cg.makeregsize(list,NR_FUNCTION_RESULT_REG,OS_S32),exceptlabel);
-{$endif not MIPS}
+        cg.a_cmp_const_reg_label(list,OS_S32,OC_NE,0,cg.makeregsize(list,NR_FUNCTION_RESULT_REG,OS_S32),exceptlabel);
         cg.dealloccpuregisters(list,R_INTREGISTER,[RS_FUNCTION_RESULT_REG]);
         cg.dealloccpuregisters(list,R_INTREGISTER,[RS_FUNCTION_RESULT_REG]);
         paraloc1.done;
         paraloc1.done;
         paraloc2.done;
         paraloc2.done;

+ 2 - 2
compiler/psub.pas

@@ -116,7 +116,7 @@ implementation
        opttail,
        opttail,
        optcse,optloop,
        optcse,optloop,
        optutils
        optutils
-{$if defined(arm) or defined(powerpc) or defined(powerpc64) or defined(avr)}
+{$if defined(arm) or defined(avr) or defined(fpc_compiler_has_fixup_jmps)}
        ,aasmcpu
        ,aasmcpu
 {$endif arm}
 {$endif arm}
        {$ifndef NOOPT}
        {$ifndef NOOPT}
@@ -1493,7 +1493,7 @@ implementation
             current_filepos:=exitpos;
             current_filepos:=exitpos;
             hlcg.gen_proc_symbol_end(templist);
             hlcg.gen_proc_symbol_end(templist);
             aktproccode.concatlist(templist);
             aktproccode.concatlist(templist);
-{$if defined(POWERPC) or defined(POWERPC64)}
+{$ifdef fpc_compiler_has_fixup_jmps}
             fixup_jmps(aktproccode);
             fixup_jmps(aktproccode);
 {$endif}
 {$endif}
             { insert line debuginfo }
             { insert line debuginfo }