* basic code generation for dynamic linking code for ppc64

git-svn-id: trunk@2214 -

compiler/aasmbase.pas

@@ -61,6 +61,11 @@ interface
          sec_debug_frame,
          { ELF resources }
          sec_fpc
+         {$IFDEF POWERPC64}
+         ,
+         { PPC64/Linux Table of contents section }
+         sec_toc
+         {$ENDIF POWERPC64}
        );
 
        TAsmSectionOption = (aso_alloconly,aso_executable);
@@ -589,6 +594,9 @@ implementation
           'eh_frame',
           'debug_frame',
           'fpc'
+          {$IFDEF POWERPC64}
+          , 'toc'
+          {$ENDIF POWERPC64}
         );
       begin
         if aname<>'' then

compiler/aasmtai.pas

@@ -301,7 +301,7 @@ interface
        end;
 
        tasmdirective=(asd_non_lazy_symbol_pointer,asd_indirect_symbol,asd_lazy_symbol_pointer,
-                      asd_extern,asd_nasm_import);
+                      asd_extern,asd_nasm_import{$IFDEF POWERPC64}, asd_toc_entry{$ENDIF POWERPC64});
 
        tai_directive = class(tailineinfo)
           name : pstring;
@@ -633,7 +633,7 @@ interface
       stabtypestr : array[tstabtype] of string[5]=('stabs','stabn','stabd');
       directivestr : array[tasmdirective] of string[24]=(
         'non_lazy_symbol_pointer','indirect_symbol','lazy_symbol_pointer',
-        'extern','nasm_import'
+        'extern','nasm_import'{$IFDEF POWERPC64}, 'tc'{$ENDIF POWERPC64}
       );
 
     var

compiler/aggas.pas

@@ -214,6 +214,9 @@ implementation
           '.eh_frame',
           '.debug_frame',
           'fpc.resptrs'
+          {$IFDEF POWERPC64}
+          , '.toc'
+          {$ENDIF}
         );
         secnames_pic : array[tasmsectiontype] of string[12] = ('',
           '.text','.data.rel','.data.rel','.bss','.threadvar',
@@ -225,6 +228,9 @@ implementation
           '.eh_frame',
           '.debug_frame',
           'fpc.resptrs'
+          {$IFDEF POWERPC64}
+          , '.toc'
+          {$ENDIF}
         );
       var
         secname : string;
@@ -806,7 +812,7 @@ implementation
                    AsmWriteLn('.size ' + tai_symbol(hp).sym.name + ', 24');
                    AsmWriteLn('.globl .' + tai_symbol(hp).sym.name);
                    AsmWriteLn('.type .' + tai_symbol(hp).sym.name + ', @function');
-                   { the dotted name is the name of the actual function }
+                   { the dotted name is the name of the actual function entry }
                    AsmWrite('.');
                  end
                else
@@ -848,15 +854,11 @@ implementation
                   AsmWriteLn(s+':');
                   AsmWrite(#9'.size'#9);
                   if (target_info.system = system_powerpc64_linux) and (tai_symbol_end(hp).sym.typ = AT_FUNCTION) then
-                    begin
-                      AsmWrite('.');
-                    end;
+                    AsmWrite('.');
                   AsmWrite(tai_symbol_end(hp).sym.name);
                   AsmWrite(', '+s+' - ');
                   if (target_info.system = system_powerpc64_linux) and (tai_symbol_end(hp).sym.typ = AT_FUNCTION) then
-                    begin
-                      AsmWrite('.');
-                    end;
+                     AsmWrite('.');
                   AsmWriteLn(tai_symbol_end(hp).sym.name);
                 end;
              end;

compiler/parabase.pas

@@ -56,7 +56,7 @@ unit parabase;
              E.g. the value $5544433 is passed in bits 40-63 of the register (others are zero),
              but they should actually be stored in the first bits of the stack location reserved
              for this value. So they have to be shifted left by this amount of bits before. }
-             {$IFDEF CPUPOWERPC64}shiftval : byte;{$ENDIF CPUPOWERPC64}
+             {$IFDEF POWERPC64}shiftval : byte;{$ENDIF POWERPC64}
              register : tregister);
        end;
 

compiler/powerpc64/agppcgas.pas

@@ -115,6 +115,7 @@ begin
       if (target_info.system <> system_powerpc_darwin) then
         s := s + refaddr2str[refaddr];
     end;
+    if (refaddr = addr_pic) then s := s + ')';
 
     if (index = NR_NO) and (base <> NR_NO) then
     begin

compiler/powerpc64/cgcpu.pas

@@ -174,6 +174,14 @@ uses
   symconst, symsym, fmodule,
   rgobj, tgobj, cpupi, procinfo, paramgr;
 
+function ref2string(const ref : treference) : string;
+begin
+  result := 'base : ' + inttostr(ord(ref.base)) + ' index : ' + inttostr(ord(ref.index)) + ' refaddr : ' + inttostr(ord(ref.refaddr)) + ' offset : ' + inttostr(ref.offset) + ' symbol : ';
+  if (assigned(ref.symbol)) then
+    result := result + ref.symbol.name;
+end;
+
+
 { helper function which calculate "magic" values for replacement of unsigned 
  division by constant operation by multiplication. See the PowerPC compiler
  developer manual for more information }
@@ -375,7 +383,7 @@ begin
               location^.register)
           else
           {$IFDEF extdebug}
-            list.concat(tai_comment.create(strpnew('a_param_ref with OS_NO, sizeleft ' + inttostr(sizeleft))));
+          list.concat(tai_comment.create(strpnew('a_param_ref with OS_NO, sizeleft ' + inttostr(sizeleft))));
           {$ENDIF extdebug}
 
             { load non-integral sized memory location into register. This 
@@ -694,6 +702,10 @@ var
   ref2: treference;
 
 begin
+  {$IFDEF EXTDEBUG}
+  list.concat(tai_comment.create(strpnew('a_load_ref_reg ' + ref2string(ref))));
+  {$ENDIF EXTDEBUG}
+
   if not (fromsize in [OS_8, OS_S8, OS_16, OS_S16, OS_32, OS_S32, OS_64, OS_S64]) then
     internalerror(2002090902);
   ref2 := ref;
@@ -874,7 +886,7 @@ var
       internalerror(2005061701);
     end else if (a = 1) then begin
       cg.a_load_reg_reg(exprasmlist, OS_INT, OS_INT, src, dst);
-    end else if (a = -1) then begin
+    end else if (a = -1) and (signed) then begin
       { note: only in the signed case possible..., may overflow }
       exprasmlist.concat(taicpu.op_reg_reg(negops[cs_check_overflow in aktlocalswitches], dst, src));
     end else if (ispowerof2(a, power, isNegPower)) then begin
@@ -1498,31 +1510,35 @@ begin
   ref2 := ref;
   fixref(list, ref2, OS_64);
   { load a symbol }
-  if assigned(ref2.symbol) or (hasLargeOffset(ref2)) then begin
-      { add the symbol's value to the base of the reference, and if the }
-      { reference doesn't have a base, create one                       }
-      reference_reset(tmpref);
-      tmpref.offset := ref2.offset;
-      tmpref.symbol := ref2.symbol;
-      tmpref.relsymbol := ref2.relsymbol;
-      { load 64 bit reference into r. If the reference already has a base register,
-       first load the 64 bit value into a temp register, then add it to the result
-       register rD }
-      if (ref2.base <> NR_NO) then begin
-        { already have a base register, so allocate a new one }
-        tempreg := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE);
-      end else begin
-        tempreg := r;
-      end;
+  if (assigned(ref2.symbol) or (hasLargeOffset(ref2))) then begin
+    { add the symbol's value to the base of the reference, and if the }
+    { reference doesn't have a base, create one                       }
+    reference_reset(tmpref);
+    tmpref.offset := ref2.offset;
+    tmpref.symbol := ref2.symbol;
+    tmpref.relsymbol := ref2.relsymbol;
+    { load 64 bit reference into r. If the reference already has a base register,
+     first load the 64 bit value into a temp register, then add it to the result
+     register rD }
+    if (ref2.base <> NR_NO) then begin
+      { already have a base register, so allocate a new one }
+      tempreg := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE);
+    end else begin
+      tempreg := r;
+    end;
 
-      { code for loading a reference from a symbol into a register rD }
-      (*
-      lis   rX,SYM@highest
-      ori   rX,SYM@higher
-      sldi  rX,rX,32
-      oris  rX,rX,SYM@h
-      ori   rX,rX,SYM@l
-      *)
+    { code for loading a reference from a symbol into a register rD }
+    (*
+    lis   rX,SYM@highest
+    ori   rX,SYM@higher
+    sldi  rX,rX,32
+    oris  rX,rX,SYM@h
+    ori   rX,rX,SYM@l
+    *)
+    {$IFDEF EXTDEBUG}
+    list.concat(tai_comment.create(strpnew('loadaddr_ref_reg ')));
+    {$ENDIF EXTDEBUG}
+    if (assigned(tmpref.symbol)) then begin
       tmpref.refaddr := addr_highest;
       list.concat(taicpu.op_reg_ref(A_LIS, tempreg, tmpref));
       tmpref.refaddr := addr_higher;
@@ -1532,27 +1548,30 @@ begin
       list.concat(taicpu.op_reg_reg_ref(A_ORIS, tempreg, tempreg, tmpref));
       tmpref.refaddr := addr_low;
       list.concat(taicpu.op_reg_reg_ref(A_ORI, tempreg, tempreg, tmpref));
+    end else
+      a_load_const_reg(list, OS_ADDR, tmpref.offset, tempreg);
 
-      { if there's already a base register, add the temp register contents to
-       the base register }
-      if (ref2.base <> NR_NO) then begin
-        list.concat(taicpu.op_reg_reg_reg(A_ADD, r, tempreg, ref2.base));
-      end;
-  end else if ref2.offset <> 0 then begin
+    { if there's already a base register, add the temp register contents to
+     the base register }
+    if (ref2.base <> NR_NO) then begin
+      list.concat(taicpu.op_reg_reg_reg(A_ADD, r, tempreg, ref2.base));
+    end;
+  end else if (ref2.offset <> 0) then begin
     { no symbol, but offset <> 0 }
-    if ref2.base <> NR_NO then begin
+    if (ref2.base <> NR_NO) then begin
       a_op_const_reg_reg(list, OP_ADD, OS_64, ref2.offset, ref2.base, r)
       { FixRef makes sure that "(ref.index <> R_NO) and (ref.offset <> 0)" never
        occurs, so now only ref.offset has to be loaded }
     end else begin
-      a_load_const_reg(list, OS_64, ref2.offset, r)
+      a_load_const_reg(list, OS_64, ref2.offset, r);
     end;
-  end else if ref.index <> NR_NO then
+  end else if (ref2.index <> NR_NO) then begin
     list.concat(taicpu.op_reg_reg_reg(A_ADD, r, ref2.base, ref2.index))
-  else if (ref2.base <> NR_NO) and
-    (r <> ref2.base) then
+  end else if (ref2.base <> NR_NO) and
+    (r <> ref2.base) then begin
     a_load_reg_reg(list, OS_ADDR, OS_ADDR, ref2.base, r)
-  else begin
+    //list.concat(taicpu.op_reg_reg(A_MR, ref2.base, r));
+  end else begin
     list.concat(taicpu.op_reg_const(A_LI, r, 0));
   end;
 end;
@@ -1577,7 +1596,7 @@ begin
 {$IFDEF extdebug}
   if len > high(aint) then
     internalerror(2002072704);
-  list.concat(tai_comment.create(strpnew('g_concatcopy')));
+  list.concat(tai_comment.create(strpnew('g_concatcopy1 ' + inttostr(len) + ' bytes left ')));
 {$ENDIF extdebug}
   { make sure short loads are handled as optimally as possible;
    note that the data here never overlaps, so we can do a forward
@@ -1587,6 +1606,7 @@ begin
 
   if (len <= maxmoveunit) then begin
     src := source; dst := dest;
+    list.concat(tai_comment.create(strpnew('g_concatcopy3 ' + inttostr(src.offset) + ' ' + inttostr(dst.offset))));
     while (len <> 0) do begin
       if (len = 8) then begin
         a_load_ref_ref(list, OS_64, OS_64, src, dst);    
@@ -1607,6 +1627,10 @@ begin
     end;
     exit;
   end;
+{$IFDEF extdebug}
+  list.concat(tai_comment.create(strpnew('g_concatcopy2 ' + inttostr(len) + ' bytes left ')));
+{$ENDIF extdebug}
+
 
   count := len div maxmoveunit;
 
@@ -1830,36 +1854,54 @@ var
 begin
   l:=objectlibrary.getasmsymbol(symbol+'$got');
   if not(assigned(l)) then begin
-    l:=objectlibrary.newasmsymbol(symbol+'$got',AB_COMMON,AT_DATA);
+    l:=objectlibrary.newasmsymbol(symbol+'$got',AB_LOCAL, AT_LABEL);
+    asmlist[al_picdata].concat(tai_section.create(sec_toc, '.toc', 8));
     asmlist[al_picdata].concat(tai_symbol.create(l,0));
-    asmlist[al_picdata].concat(tai_const.create_indirect_sym(objectlibrary.newasmsymbol(symbol,AB_EXTERNAL,AT_DATA)));
-    asmlist[al_picdata].concat(tai_const.create_32bit(0));
+    asmlist[al_picdata].concat(tai_directive.create(asd_toc_entry, symbol + '[TC], ' + symbol));
   end;
   reference_reset_symbol(ref,l,0);
   ref.base := NR_R2;
-  result := cg.rg[R_INTREGISTER].getregister(list, R_SUBWHOLE);
-  cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,ref,result);
+  ref.refaddr := addr_pic;
+
+  result := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE);
+  {$IFDEF EXTDEBUG}
+  list.concat(tai_comment.create(strpnew('loading got reference for ' + symbol)));
+  {$ENDIF EXTDEBUG}
+//  cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,ref,result);
+  list.concat(taicpu.op_reg_ref(A_LD, result, ref));
 end;
 
+
 function tcgppc.fixref(list: taasmoutput; var ref: treference; const size : TCgsize): boolean;
 var
   tmpreg: tregister; 
   name : string;
 begin
   result := false;
-  if (cs_create_pic in aktmoduleswitches) and (assigned(ref.symbol)) and (ref.symbol.defbind = AB_EXTERNAL) then begin
-    if (length(name) > 100) then internalerror(123456);
+  { Avoids recursion. }
+  if (ref.refaddr = addr_pic) then exit;
+  {$IFDEF EXTDEBUG}
+  list.concat(tai_comment.create(strpnew('fixref0 ' + ref2string(ref))));
+  {$ENDIF EXTDEBUG}
+
+  { if we have to create PIC, add the symbol to the TOC/GOT }
+  if (cs_create_pic in aktmoduleswitches) and (assigned(ref.symbol)) then begin
     tmpreg := load_got_symbol(list, ref.symbol.name);
     if (ref.base = NR_NO) then
       ref.base := tmpreg
     else if (ref.index = NR_NO) then
       ref.index := tmpreg
-    else
-      list.concat(taicpu.op_reg_reg_reg(A_ADD,ref.base,ref.base,tmpreg));
+    else begin
+      a_op_reg_reg_reg(list, OP_ADD, OS_ADDR, ref.base, tmpreg, tmpreg);
+      ref.base := tmpreg;
+    end;
     ref.symbol := nil;    
+    {$IFDEF EXTDEBUG}
+    list.concat(tai_comment.create(strpnew('fixref-pic ' + ref2string(ref))));
+    {$ENDIF EXTDEBUG}
   end;
 
-  if (ref.base = NR_NO) then  begin
+  if (ref.base = NR_NO) then begin
     ref.base := ref.index;
     ref.index := NR_NO;
   end;
@@ -1868,9 +1910,14 @@ begin
       result := true;
       tmpreg := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE);
       a_op_reg_reg_reg(list, OP_ADD, size, ref.base, ref.index, tmpreg);
-      ref.index := NR_NO;
       ref.base := tmpreg;
+      ref.index := NR_NO;
   end;
+  if (ref.index <> NR_NO) and (assigned(ref.symbol) or (ref.offset <> 0)) then
+    internalerror(2006010506);
+  {$IFDEF EXTDEBUG}
+  list.concat(tai_comment.create(strpnew('fixref1 ' + ref2string(ref))));
+  {$ENDIF EXTDEBUG}
 end;
 
 procedure tcgppc.a_load_store(list: taasmoutput; op: tasmop; reg: tregister;
@@ -1884,6 +1931,18 @@ begin
     which is not possible to directly map to instructions of the PowerPC architecture }
   if (ref.index <> NR_NO) and ((ref.offset <> 0) or (assigned(ref.symbol))) then
     internalerror(200310131);
+
+  { if this is a PIC'ed address, handle it and exit }
+  if (ref.refaddr = addr_pic) then begin
+    if (ref.offset <> 0) then
+      internalerror(2006010501);
+    if (ref.index <> NR_NO) then
+      internalerror(2006010502);
+    if (not assigned(ref.symbol)) then
+      internalerror(200601050);
+    list.concat(taicpu.op_reg_ref(op, reg, ref));
+    exit;
+  end;
  
   { for some instructions we need to check that the offset is divisible by at
    least four. If not, add the bytes which are "off" to the base register and
@@ -1903,10 +1962,12 @@ begin
        ref.offset := (ref.offset div 4) * 4;
      end;
   end;
-
+  {$IFDEF EXTDEBUG}
+  list.concat(tai_comment.create(strpnew('a_load_store1 ' + BoolToStr(ref.refaddr = addr_pic))));
+  {$ENDIF EXTDEBUG}
   { if we have to load/store from a symbol or large addresses, use a temporary register
    containing the address }
-  if assigned(ref.symbol) or (hasLargeOffset(ref)) then begin
+  if (assigned(ref.symbol) or (hasLargeOffset(ref))) then begin
     tmpreg := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE);
 
     if (hasLargeOffset(ref) and (ref.base = NR_NO)) then begin
@@ -1936,17 +1997,20 @@ begin
       }
 
       tmpreg2 := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE);
-      tmpref.refaddr := addr_highest;
-      list.concat(taicpu.op_reg_ref(A_LIS, tmpreg, tmpref));
-      tmpref.refaddr := addr_higher;
-      list.concat(taicpu.op_reg_reg_ref(A_ORI, tmpreg, tmpreg, tmpref));
-
-      tmpref.refaddr := addr_high;
-      list.concat(taicpu.op_reg_ref(A_LIS, tmpreg2, tmpref));
-      tmpref.refaddr := addr_low;
-      list.concat(taicpu.op_reg_reg_ref(A_ORI, tmpreg2, tmpreg2, tmpref));
-
-      list.concat(taicpu.op_reg_reg_const_const(A_RLDIMI, tmpreg2, tmpreg, 32, 0));
+      if (assigned(tmpref.symbol)) then begin
+        tmpref.refaddr := addr_highest;
+        list.concat(taicpu.op_reg_ref(A_LIS, tmpreg, tmpref));
+        tmpref.refaddr := addr_higher;
+        list.concat(taicpu.op_reg_reg_ref(A_ORI, tmpreg, tmpreg, tmpref));
+
+        tmpref.refaddr := addr_high;
+        list.concat(taicpu.op_reg_ref(A_LIS, tmpreg2, tmpref));
+        tmpref.refaddr := addr_low;
+        list.concat(taicpu.op_reg_reg_ref(A_ORI, tmpreg2, tmpreg2, tmpref));
+
+        list.concat(taicpu.op_reg_reg_const_const(A_RLDIMI, tmpreg2, tmpreg, 32, 0));
+      end else
+        a_load_const_reg(list, OS_ADDR, tmpref.offset, tmpreg2);
 
       reference_reset(tmpref);
       tmpref.base := ref.base;