Преглед на файлове

* moved some more common powerpc32/64 things to ppcgn
+ a few initial darwin/ppc64 things

git-svn-id: trunk@5197 -

Jonas Maebe преди 19 години
родител
ревизия
9acc38e82a
променени са 6 файла, в които са добавени 181 реда и са изтрити 233 реда
  1. 3 2
      compiler/cgbase.pas
  2. 4 133
      compiler/powerpc/cgcpu.pas
  3. 1 1
      compiler/powerpc64/agppcgas.pas
  4. 17 90
      compiler/powerpc64/cgcpu.pas
  5. 2 1
      compiler/powerpc64/cpubase.pas
  6. 154 6
      compiler/ppcgen/cgppc.pas

+ 3 - 2
compiler/cgbase.pas

@@ -64,10 +64,11 @@ interface
        trefaddr = (
        trefaddr = (
          addr_no,
          addr_no,
          addr_full,
          addr_full,
-         {$IFNDEF POWERPC64}
+         {IFNDEF POWERPC64}
+         // these are also available for ppc64 on Mac OS X
          addr_hi,
          addr_hi,
          addr_lo,
          addr_lo,
-         {$ENDIF}
+         {ENDIF}
          addr_pic
          addr_pic
          {$IFDEF POWERPC64}
          {$IFDEF POWERPC64}
          ,
          ,

+ 4 - 133
compiler/powerpc/cgcpu.pas

@@ -42,9 +42,7 @@ unit cgcpu;
         { left to right), this allows to move the parameter to    }
         { left to right), this allows to move the parameter to    }
         { register, if the cpu supports register calling          }
         { register, if the cpu supports register calling          }
         { conventions                                             }
         { conventions                                             }
-        procedure a_param_const(list : TAsmList;size : tcgsize;a : aint;const paraloc : tcgpara);override;
         procedure a_param_ref(list : TAsmList;size : tcgsize;const r : treference;const paraloc : tcgpara);override;
         procedure a_param_ref(list : TAsmList;size : tcgsize;const r : treference;const paraloc : tcgpara);override;
-        procedure a_paramaddr_ref(list : TAsmList;const r : treference;const paraloc : tcgpara);override;
 
 
 
 
         procedure a_call_name(list : TAsmList;const s : string);override;
         procedure a_call_name(list : TAsmList;const s : string);override;
@@ -60,7 +58,6 @@ unit cgcpu;
 
 
         { move instructions }
         { move instructions }
         procedure a_load_const_reg(list : TAsmList; size: tcgsize; a : aint;reg : tregister);override;
         procedure a_load_const_reg(list : TAsmList; size: tcgsize; a : aint;reg : tregister);override;
-        procedure a_load_reg_ref(list : TAsmList; fromsize, tosize: tcgsize; reg : tregister;const ref : treference);override;
         procedure a_load_ref_reg(list : TAsmList; fromsize, tosize : tcgsize;const Ref : treference;reg : tregister);override;
         procedure a_load_ref_reg(list : TAsmList; fromsize, tosize : tcgsize;const Ref : treference;reg : tregister);override;
         procedure a_load_reg_reg(list : TAsmList; fromsize, tosize : tcgsize;reg1,reg2 : tregister);override;
         procedure a_load_reg_reg(list : TAsmList; fromsize, tosize : tcgsize;reg1,reg2 : tregister);override;
 
 
@@ -120,7 +117,7 @@ unit cgcpu;
         { offset or symbol, in which case the base will have been changed }
         { offset or symbol, in which case the base will have been changed }
         { to a tempreg (which has to be freed by the caller) containing   }
         { to a tempreg (which has to be freed by the caller) containing   }
         { the sum of part of the original reference                       }
         { the sum of part of the original reference                       }
-        function fixref(list: TAsmList; var ref: treference): boolean;
+        function fixref(list: TAsmList; var ref: treference): boolean; override;
 
 
         { returns whether a reference can be used immediately in a powerpc }
         { returns whether a reference can be used immediately in a powerpc }
         { instruction                                                      }
         { instruction                                                      }
@@ -128,7 +125,7 @@ unit cgcpu;
 
 
         { contains the common code of a_load_reg_ref and a_load_ref_reg }
         { contains the common code of a_load_reg_ref and a_load_ref_reg }
         procedure a_load_store(list:TAsmList;op: tasmop;reg:tregister;
         procedure a_load_store(list:TAsmList;op: tasmop;reg:tregister;
-                    ref: treference);
+                    ref: treference); override;
 
 
         { creates the correct branch instruction for a given combination }
         { creates the correct branch instruction for a given combination }
         { of asmcondflags and destination addressing mode                }
         { of asmcondflags and destination addressing mode                }
@@ -137,8 +134,6 @@ unit cgcpu;
 
 
         function save_regs(list : TAsmList):longint;
         function save_regs(list : TAsmList):longint;
         procedure restore_regs(list : TAsmList);
         procedure restore_regs(list : TAsmList);
-
-        function get_darwin_call_stub(const s: string): tasmsymbol;
      end;
      end;
 
 
      tcg64fppc = class(tcg64f32)
      tcg64fppc = class(tcg64f32)
@@ -219,27 +214,6 @@ const
       end;
       end;
 
 
 
 
-    procedure tcgppc.a_param_const(list : TAsmList;size : tcgsize;a : aint;const paraloc : tcgpara);
-      var
-        ref: treference;
-      begin
-        paraloc.check_simple_location;
-        case paraloc.location^.loc of
-          LOC_REGISTER,LOC_CREGISTER:
-            a_load_const_reg(list,size,a,paraloc.location^.register);
-          LOC_REFERENCE:
-            begin
-               reference_reset(ref);
-               ref.base:=paraloc.location^.reference.index;
-               ref.offset:=paraloc.location^.reference.offset;
-               a_load_const_ref(list,size,a,ref);
-            end;
-          else
-            internalerror(2002081101);
-        end;
-      end;
-
-
     procedure tcgppc.a_param_ref(list : TAsmList;size : tcgsize;const r : treference;const paraloc : tcgpara);
     procedure tcgppc.a_param_ref(list : TAsmList;size : tcgsize;const r : treference;const paraloc : tcgpara);
 
 
       var
       var
@@ -304,74 +278,6 @@ const
       end;
       end;
 
 
 
 
-    procedure tcgppc.a_paramaddr_ref(list : TAsmList;const r : treference;const paraloc : tcgpara);
-      var
-        ref: treference;
-        tmpreg: tregister;
-
-      begin
-        paraloc.check_simple_location;
-        case paraloc.location^.loc of
-           LOC_REGISTER,LOC_CREGISTER:
-             a_loadaddr_ref_reg(list,r,paraloc.location^.register);
-           LOC_REFERENCE:
-             begin
-               reference_reset(ref);
-               ref.base := paraloc.location^.reference.index;
-               ref.offset := paraloc.location^.reference.offset;
-               tmpreg := rg[R_INTREGISTER].getregister(list,R_SUBWHOLE);
-               a_loadaddr_ref_reg(list,r,tmpreg);
-               a_load_reg_ref(list,OS_ADDR,OS_ADDR,tmpreg,ref);
-             end;
-           else
-             internalerror(2002080701);
-        end;
-      end;
-
-
-    function tcgppc.get_darwin_call_stub(const s: string): tasmsymbol;
-      var
-        stubname: string;
-        href: treference;
-        l1: tasmsymbol;
-      begin
-        { function declared in the current unit? }
-        { doesn't work correctly, because this will also return a hit if we }
-        { previously took the address of an external procedure. It doesn't  }
-        { really matter, the linker will remove all unnecessary stubs.      }
-{        result := current_asmdata.getasmsymbol(s);
-        if not(assigned(result)) then
-          begin }
-            stubname := 'L'+s+'$stub';
-            result := current_asmdata.getasmsymbol(stubname);
-{          end; }
-        if assigned(result) then
-          exit;
-
-        if current_asmdata.asmlists[al_imports]=nil then
-          current_asmdata.asmlists[al_imports]:=TAsmList.create;
-
-        current_asmdata.asmlists[al_imports].concat(Tai_section.create(sec_stub,'',0));
-        current_asmdata.asmlists[al_imports].concat(Tai_align.Create(16));
-        result := current_asmdata.RefAsmSymbol(stubname);
-        current_asmdata.asmlists[al_imports].concat(Tai_symbol.Create(result,0));
-        current_asmdata.asmlists[al_imports].concat(tai_directive.create(asd_indirect_symbol,s));
-        l1 := current_asmdata.RefAsmSymbol('L'+s+'$lazy_ptr');
-        reference_reset_symbol(href,l1,0);
-        href.refaddr := addr_hi;
-        current_asmdata.asmlists[al_imports].concat(taicpu.op_reg_ref(A_LIS,NR_R11,href));
-        href.refaddr := addr_lo;
-        href.base := NR_R11;
-        current_asmdata.asmlists[al_imports].concat(taicpu.op_reg_ref(A_LWZU,NR_R12,href));
-        current_asmdata.asmlists[al_imports].concat(taicpu.op_reg(A_MTCTR,NR_R12));
-        current_asmdata.asmlists[al_imports].concat(taicpu.op_none(A_BCTR));
-        current_asmdata.asmlists[al_imports].concat(tai_directive.create(asd_lazy_symbol_pointer,''));
-        current_asmdata.asmlists[al_imports].concat(Tai_symbol.Create(l1,0));
-        current_asmdata.asmlists[al_imports].concat(tai_directive.create(asd_indirect_symbol,s));
-        current_asmdata.asmlists[al_imports].concat(tai_const.createname(strpnew('dyld_stub_binding_helper'),0));
-      end;
-
-
     { calling a procedure by name }
     { calling a procedure by name }
     procedure tcgppc.a_call_name(list : TAsmList;const s : string);
     procedure tcgppc.a_call_name(list : TAsmList;const s : string);
       begin
       begin
@@ -414,20 +320,10 @@ const
             //tmpref.symaddr := refs_full;
             //tmpref.symaddr := refs_full;
             tmpref.base:= reg;
             tmpref.base:= reg;
             list.concat(taicpu.op_reg_ref(A_LWZ,tmpreg,tmpref));
             list.concat(taicpu.op_reg_ref(A_LWZ,tmpreg,tmpref));
-            list.concat(taicpu.op_reg(A_MTCTR,tmpreg));
           end
           end
         else
         else
-          list.concat(taicpu.op_reg(A_MTCTR,reg));
-        list.concat(taicpu.op_none(A_BCTRL));
-        //if target_info.system=system_powerpc_macos then
-        //  //NOP is not needed here.
-        //  list.concat(taicpu.op_none(A_NOP));
-        include(current_procinfo.flags,pi_do_call);
-{
-        if not(pi_do_call in current_procinfo.flags) then
-          internalerror(2003060704);
-}
-        //list.concat(tai_comment.create(strpnew('***** a_call_reg')));
+          tmpreg:=reg;
+        inherited a_call_reg(list,tmpreg);
       end;
       end;
 
 
 
 
@@ -454,31 +350,6 @@ const
        end;
        end;
 
 
 
 
-     procedure tcgppc.a_load_reg_ref(list : TAsmList; fromsize, tosize: TCGSize; reg : tregister;const ref : treference);
-
-       const
-         StoreInstr: Array[OS_8..OS_32,boolean, boolean] of TAsmOp =
-                                 { indexed? updating?}
-                    (((A_STB,A_STBU),(A_STBX,A_STBUX)),
-                     ((A_STH,A_STHU),(A_STHX,A_STHUX)),
-                     ((A_STW,A_STWU),(A_STWX,A_STWUX)));
-       var
-         op: TAsmOp;
-         ref2: TReference;
-       begin
-         ref2 := ref;
-         fixref(list,ref2);
-         if tosize in [OS_S8..OS_S16] then
-           { storing is the same for signed and unsigned values }
-           tosize := tcgsize(ord(tosize)-(ord(OS_S8)-ord(OS_8)));
-         { 64 bit stuff should be handled separately }
-         if tosize in [OS_64,OS_S64] then
-           internalerror(200109236);
-         op := storeinstr[tcgsize2unsigned[tosize],ref2.index<>NR_NO,false];
-         a_load_store(list,op,reg,ref2);
-       End;
-
-
      procedure tcgppc.a_load_ref_reg(list : TAsmList; fromsize,tosize : tcgsize;const ref: treference;reg : tregister);
      procedure tcgppc.a_load_ref_reg(list : TAsmList; fromsize,tosize : tcgsize;const ref: treference;reg : tregister);
 
 
        const
        const

+ 1 - 1
compiler/powerpc64/agppcgas.pas

@@ -82,7 +82,7 @@ end;
 {****************************************************************************}
 {****************************************************************************}
 
 
 const
 const
-  refaddr2str: array[trefaddr] of string[9] = ('', '', '', '@l', '@h', '@higher', '@highest', '@ha', '@highera', '@highesta');
+  refaddr2str: array[trefaddr] of string[9] = ('', '', 'ha16','lo16','', '@l', '@h', '@higher', '@highest', '@ha', '@highera', '@highesta');
 
 
 function getreferencestring(var ref: treference): string;
 function getreferencestring(var ref: treference): string;
 var
 var

+ 17 - 90
compiler/powerpc64/cgcpu.pas

@@ -42,12 +42,8 @@ type
     { left to right), this allows to move the parameter to    }
     { left to right), this allows to move the parameter to    }
     { register, if the cpu supports register calling          }
     { register, if the cpu supports register calling          }
     { conventions                                             }
     { conventions                                             }
-    procedure a_param_const(list: TAsmList; size: tcgsize; a: aint; const
-      paraloc: tcgpara); override;
     procedure a_param_ref(list: TAsmList; size: tcgsize; const r: treference;
     procedure a_param_ref(list: TAsmList; size: tcgsize; const r: treference;
       const paraloc: tcgpara); override;
       const paraloc: tcgpara); override;
-    procedure a_paramaddr_ref(list: TAsmList; const r: treference; const
-      paraloc: tcgpara); override;
 
 
     procedure a_call_name(list: TAsmList; const s: string); override;
     procedure a_call_name(list: TAsmList; const s: string); override;
     procedure a_call_reg(list: TAsmList; reg: tregister); override;
     procedure a_call_reg(list: TAsmList; reg: tregister); override;
@@ -65,10 +61,6 @@ type
     { move instructions }
     { move instructions }
     procedure a_load_const_reg(list: TAsmList; size: tcgsize; a: aint; reg:
     procedure a_load_const_reg(list: TAsmList; size: tcgsize; a: aint; reg:
       tregister); override;
       tregister); override;
-    { stores the contents of register reg to the memory location described by
-    ref }
-    procedure a_load_reg_ref(list: TAsmList; fromsize, tosize: tcgsize; reg:
-      tregister; const ref: treference); override;
     { loads the memory pointed to by ref into register reg }
     { loads the memory pointed to by ref into register reg }
     procedure a_load_ref_reg(list: TAsmList; fromsize, tosize: tcgsize; const
     procedure a_load_ref_reg(list: TAsmList; fromsize, tosize: tcgsize; const
       Ref: treference; reg: tregister); override;
       Ref: treference; reg: tregister); override;
@@ -133,7 +125,7 @@ type
     { offset or symbol, in which case the base will have been changed }
     { offset or symbol, in which case the base will have been changed }
     { to a tempreg (which has to be freed by the caller) containing   }
     { to a tempreg (which has to be freed by the caller) containing   }
     { the sum of part of the original reference                       }
     { the sum of part of the original reference                       }
-    function fixref(list: TAsmList; var ref: treference; const size : TCgsize): boolean;
+    function fixref(list: TAsmList; var ref: treference): boolean; override;
 
 
     function load_got_symbol(list : TAsmList; symbol : string) : tregister;
     function load_got_symbol(list : TAsmList; symbol : string) : tregister;
 
 
@@ -143,7 +135,7 @@ type
 
 
     { contains the common code of a_load_reg_ref and a_load_ref_reg }
     { contains the common code of a_load_reg_ref and a_load_ref_reg }
     procedure a_load_store(list: TAsmList; op: tasmop; reg: tregister;
     procedure a_load_store(list: TAsmList; op: tasmop; reg: tregister;
-      ref: treference);
+      ref: treference); override;
 
 
     { creates the correct branch instruction for a given combination }
     { creates the correct branch instruction for a given combination }
     { of asmcondflags and destination addressing mode                }
     { of asmcondflags and destination addressing mode                }
@@ -432,27 +424,6 @@ begin
   inherited done_register_allocators;
   inherited done_register_allocators;
 end;
 end;
 
 
-procedure tcgppc.a_param_const(list: TAsmList; size: tcgsize; a: aint; const
-  paraloc: tcgpara);
-var
-  ref: treference;
-begin
-  paraloc.check_simple_location;
-  case paraloc.location^.loc of
-    LOC_REGISTER, LOC_CREGISTER:
-      a_load_const_reg(list, size, a, paraloc.location^.register);
-    LOC_REFERENCE:
-      begin
-        reference_reset(ref);
-        ref.base := paraloc.location^.reference.index;
-        ref.offset := paraloc.location^.reference.offset;
-        a_load_const_ref(list, size, a, ref);
-      end;
-  else
-    internalerror(2002081101);
-  end;
-end;
-
 procedure tcgppc.a_param_ref(list: TAsmList; size: tcgsize; const r:
 procedure tcgppc.a_param_ref(list: TAsmList; size: tcgsize; const r:
   treference; const paraloc: tcgpara);
   treference; const paraloc: tcgpara);
 
 
@@ -564,37 +535,19 @@ begin
   end;
   end;
 end;
 end;
 
 
-procedure tcgppc.a_paramaddr_ref(list: TAsmList; const r: treference; const
-  paraloc: tcgpara);
-var
-  ref: treference;
-  tmpreg: tregister;
+{ calling a procedure by name }
 
 
+procedure tcgppc.a_call_name(list: TAsmList; const s: string);
 begin
 begin
-  paraloc.check_simple_location;
-  case paraloc.location^.loc of
-    LOC_REGISTER, LOC_CREGISTER:
-      a_loadaddr_ref_reg(list, r, paraloc.location^.register);
-    LOC_REFERENCE:
+    if (target_info.system <> system_powerpc64_darwin) then
+      a_call_name_direct(list, s, true, true)
+    else
       begin
       begin
-        reference_reset(ref);
-        ref.base := paraloc.location^.reference.index;
-        ref.offset := paraloc.location^.reference.offset;
-        tmpreg := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE);
-        a_loadaddr_ref_reg(list, r, tmpreg);
-        a_load_reg_ref(list, OS_ADDR, OS_ADDR, tmpreg, ref);
+        list.concat(taicpu.op_sym(A_BL,get_darwin_call_stub(s)));
+        include(current_procinfo.flags,pi_do_call);
       end;
       end;
-  else
-    internalerror(2002080701);
-  end;
 end;
 end;
 
 
-{ calling a procedure by name }
-
-procedure tcgppc.a_call_name(list: TAsmList; const s: string);
-begin
-    a_call_name_direct(list, s, true, true);
-end;
 
 
 procedure tcgppc.a_call_name_direct(list: TAsmList; s: string; prependDot : boolean; addNOP : boolean; includeCall : boolean);
 procedure tcgppc.a_call_name_direct(list: TAsmList; s: string; prependDot : boolean; addNOP : boolean; includeCall : boolean);
 begin
 begin
@@ -616,7 +569,9 @@ var
   tmpref: treference;
   tmpref: treference;
   tempreg : TRegister;
   tempreg : TRegister;
 begin
 begin
-  if (not (cs_opt_size in current_settings.optimizerswitches)) then begin
+  if (target_info.system = system_powerpc64_darwin) then
+    inherited a_call_reg(list,reg)
+  else if (not (cs_opt_size in current_settings.optimizerswitches)) then begin
     tempreg := cg.getintregister(current_asmdata.CurrAsmList, OS_INT);
     tempreg := cg.getintregister(current_asmdata.CurrAsmList, OS_INT);
     { load actual function entry (reg contains the reference to the function descriptor)
     { load actual function entry (reg contains the reference to the function descriptor)
     into tempreg }
     into tempreg }
@@ -763,34 +718,6 @@ begin
     loadConstantNormal(list, size, a, reg);
     loadConstantNormal(list, size, a, reg);
 end;
 end;
 
 
-procedure tcgppc.a_load_reg_ref(list: TAsmList; fromsize, tosize: TCGSize;
-  reg: tregister; const ref: treference);
-
-const
-  StoreInstr: array[OS_8..OS_64, boolean, boolean] of TAsmOp =
-  { indexed? updating?}
-  (((A_STB, A_STBU), (A_STBX, A_STBUX)),
-    ((A_STH, A_STHU), (A_STHX, A_STHUX)),
-    ((A_STW, A_STWU), (A_STWX, A_STWUX)),
-    ((A_STD, A_STDU), (A_STDX, A_STDUX))
-    );
-var
-  op: TAsmOp;
-  ref2: TReference;
-begin
-  if not (fromsize in [OS_8, OS_S8, OS_16, OS_S16, OS_32, OS_S32, OS_64, OS_S64]) then
-    internalerror(2002090903);
-  if not (tosize in [OS_8, OS_S8, OS_16, OS_S16, OS_32, OS_S32, OS_64, OS_S64]) then
-    internalerror(2002090905);
-
-  ref2 := ref;
-  fixref(list, ref2, tosize);
-  if tosize in [OS_S8..OS_S64] then
-    { storing is the same for signed and unsigned values }
-    tosize := tcgsize(ord(tosize) - (ord(OS_S8) - ord(OS_8)));
-  op := storeinstr[tcgsize2unsigned[tosize], ref2.index <> NR_NO, false];
-  a_load_store(list, op, reg, ref2);
-end;
 
 
 procedure tcgppc.a_load_ref_reg(list: TAsmList; fromsize, tosize: tcgsize;
 procedure tcgppc.a_load_ref_reg(list: TAsmList; fromsize, tosize: tcgsize;
   const ref: treference; reg: tregister);
   const ref: treference; reg: tregister);
@@ -823,7 +750,7 @@ begin
   if not (fromsize in [OS_8, OS_S8, OS_16, OS_S16, OS_32, OS_S32, OS_64, OS_S64]) then
   if not (fromsize in [OS_8, OS_S8, OS_16, OS_S16, OS_32, OS_S32, OS_64, OS_S64]) then
     internalerror(2002090904);
     internalerror(2002090904);
   ref2 := ref;
   ref2 := ref;
-  fixref(list, ref2, tosize);
+  fixref(list, ref2);
   { the caller is expected to have adjusted the reference already
   { the caller is expected to have adjusted the reference already
    in this case }
    in this case }
   if (TCGSize2Size[fromsize] >= TCGSize2Size[tosize]) then
   if (TCGSize2Size[fromsize] >= TCGSize2Size[tosize]) then
@@ -956,7 +883,7 @@ begin
     internalerror(200201121);
     internalerror(200201121);
   end;
   end;
   ref2 := ref;
   ref2 := ref;
-  fixref(list, ref2, size);
+  fixref(list, ref2);
   op := fpuloadinstr[size, ref2.index <> NR_NO, false];
   op := fpuloadinstr[size, ref2.index <> NR_NO, false];
   a_load_store(list, op, reg, ref2);
   a_load_store(list, op, reg, ref2);
 end;
 end;
@@ -976,7 +903,7 @@ begin
   if not (size in [OS_F32, OS_F64]) then
   if not (size in [OS_F32, OS_F64]) then
     internalerror(200201122);
     internalerror(200201122);
   ref2 := ref;
   ref2 := ref;
-  fixref(list, ref2, size);
+  fixref(list, ref2);
   op := fpustoreinstr[size, ref2.index <> NR_NO, false];
   op := fpustoreinstr[size, ref2.index <> NR_NO, false];
   a_load_store(list, op, reg, ref2);
   a_load_store(list, op, reg, ref2);
 end;
 end;
@@ -1748,7 +1675,7 @@ var
 
 
 begin
 begin
   ref2 := ref;
   ref2 := ref;
-  fixref(list, ref2, OS_64);
+  fixref(list, ref2);
   { load a symbol }
   { load a symbol }
   if (assigned(ref2.symbol) or (hasLargeOffset(ref2))) then begin
   if (assigned(ref2.symbol) or (hasLargeOffset(ref2))) then begin
     { add the symbol's value to the base of the reference, and if the }
     { add the symbol's value to the base of the reference, and if the }
@@ -2130,7 +2057,7 @@ begin
 end;
 end;
 
 
 
 
-function tcgppc.fixref(list: TAsmList; var ref: treference; const size : TCgsize): boolean;
+function tcgppc.fixref(list: TAsmList; var ref: treference): boolean;
   { symbol names must not be larger than this to be able to make a GOT reference out of them,
   { symbol names must not be larger than this to be able to make a GOT reference out of them,
    otherwise they get truncated by the compiler resulting in failing of the assembling stage }
    otherwise they get truncated by the compiler resulting in failing of the assembling stage }
 const
 const

+ 2 - 1
compiler/powerpc64/cpubase.pas

@@ -246,7 +246,7 @@ type
 *****************************************************************************}
 *****************************************************************************}
 
 
 const
 const
-  symaddr2str: array[trefaddr] of string[9] = ('', '', '', '@l', '@h', '@higher', '@highest', '@ha', '@highera', '@highesta');
+  symaddr2str: array[trefaddr] of string[9] = ('', '', 'ha16','lo16','', '@l', '@h', '@higher', '@highest', '@ha', '@highera', '@highesta');
 
 
 const
 const
   { MacOS only. Whether the direct data area (TOC) directly contain
   { MacOS only. Whether the direct data area (TOC) directly contain
@@ -272,6 +272,7 @@ const
   OS_ADDR = OS_64;
   OS_ADDR = OS_64;
   {# the natural int size for a processor,             }
   {# the natural int size for a processor,             }
   OS_INT = OS_64;
   OS_INT = OS_64;
+  OS_SINT = OS_S64;
   {# the maximum float size for a processor,           }
   {# the maximum float size for a processor,           }
   OS_FLOAT = OS_F64;
   OS_FLOAT = OS_F64;
   {# the size of a vector register for a processor     }
   {# the size of a vector register for a processor     }

+ 154 - 6
compiler/ppcgen/cgppc.pas

@@ -29,13 +29,27 @@ unit cgppc;
        globtype,symtype,symdef,
        globtype,symtype,symdef,
        cgbase,cgobj,
        cgbase,cgobj,
        aasmbase,aasmcpu,aasmtai,aasmdata,
        aasmbase,aasmcpu,aasmtai,aasmdata,
-       cpubase,cpuinfo,cgutils,rgcpu;
+       cpubase,cpuinfo,cgutils,rgcpu,
+       parabase;
 
 
     type
     type
       tcgppcgen = class(tcg)
       tcgppcgen = class(tcg)
+        procedure a_param_const(list: TAsmList; size: tcgsize; a: aint; const paraloc : tcgpara); override;
+        procedure a_paramaddr_ref(list : TAsmList;const r : treference;const paraloc : tcgpara); override;
+
+        procedure a_call_reg(list : TAsmList;reg: tregister); override;
         procedure a_call_ref(list : TAsmList;ref: treference); override;
         procedure a_call_ref(list : TAsmList;ref: treference); override;
+
+        { stores the contents of register reg to the memory location described by
+        ref }
+        procedure a_load_reg_ref(list: TAsmList; fromsize, tosize: TCGSize;
+          reg: tregister; const ref: treference); override;
+
        protected
        protected
+        function  get_darwin_call_stub(const s: string): tasmsymbol;
         procedure a_load_subsetref_regs_noindex(list: TAsmList; subsetsize: tcgsize; loadbitsize: byte; const sref: tsubsetreference; valuereg, extra_value_reg: tregister); override;
         procedure a_load_subsetref_regs_noindex(list: TAsmList; subsetsize: tcgsize; loadbitsize: byte; const sref: tsubsetreference; valuereg, extra_value_reg: tregister); override;
+        function  fixref(list: TAsmList; var ref: treference): boolean; virtual; abstract;
+        procedure a_load_store(list:TAsmList;op: tasmop;reg:tregister;ref: treference);virtual;abstract;
      end;
      end;
 
 
   implementation
   implementation
@@ -45,13 +59,147 @@ unit cgppc;
        symconst,symsym,fmodule,
        symconst,symsym,fmodule,
        rgobj,tgobj,cpupi,procinfo,paramgr;
        rgobj,tgobj,cpupi,procinfo,paramgr;
 
 
-  procedure tcgppcgen.a_call_ref(list : TAsmList;ref: treference);
+
+    procedure tcgppcgen.a_param_const(list: TAsmList; size: tcgsize; a: aint; const
+      paraloc: tcgpara);
+    var
+      ref: treference;
+    begin
+      paraloc.check_simple_location;
+      case paraloc.location^.loc of
+        LOC_REGISTER, LOC_CREGISTER:
+          a_load_const_reg(list, size, a, paraloc.location^.register);
+        LOC_REFERENCE:
+          begin
+            reference_reset(ref);
+            ref.base := paraloc.location^.reference.index;
+            ref.offset := paraloc.location^.reference.offset;
+            a_load_const_ref(list, size, a, ref);
+          end;
+      else
+        internalerror(2002081101);
+      end;
+    end;
+
+
+    procedure tcgppcgen.a_paramaddr_ref(list : TAsmList;const r : treference;const paraloc : tcgpara);
+      var
+        ref: treference;
+        tmpreg: tregister;
+
+      begin
+        paraloc.check_simple_location;
+        case paraloc.location^.loc of
+           LOC_REGISTER,LOC_CREGISTER:
+             a_loadaddr_ref_reg(list,r,paraloc.location^.register);
+           LOC_REFERENCE:
+             begin
+               reference_reset(ref);
+               ref.base := paraloc.location^.reference.index;
+               ref.offset := paraloc.location^.reference.offset;
+               tmpreg := rg[R_INTREGISTER].getregister(list,R_SUBWHOLE);
+               a_loadaddr_ref_reg(list,r,tmpreg);
+               a_load_reg_ref(list,OS_ADDR,OS_ADDR,tmpreg,ref);
+             end;
+           else
+             internalerror(2002080701);
+        end;
+      end;
+
+
+    function tcgppcgen.get_darwin_call_stub(const s: string): tasmsymbol;
+      var
+        stubname: string;
+        href: treference;
+        l1: tasmsymbol;
+      begin
+        { function declared in the current unit? }
+        { doesn't work correctly, because this will also return a hit if we }
+        { previously took the address of an external procedure. It doesn't  }
+        { really matter, the linker will remove all unnecessary stubs.      }
+        stubname := 'L'+s+'$stub';
+        result := current_asmdata.getasmsymbol(stubname);
+        if assigned(result) then
+          exit;
+
+        if current_asmdata.asmlists[al_imports]=nil then
+          current_asmdata.asmlists[al_imports]:=TAsmList.create;
+
+        current_asmdata.asmlists[al_imports].concat(Tai_section.create(sec_stub,'',0));
+        current_asmdata.asmlists[al_imports].concat(Tai_align.Create(16));
+        result := current_asmdata.RefAsmSymbol(stubname);
+        current_asmdata.asmlists[al_imports].concat(Tai_symbol.Create(result,0));
+        current_asmdata.asmlists[al_imports].concat(tai_directive.create(asd_indirect_symbol,s));
+        l1 := current_asmdata.RefAsmSymbol('L'+s+'$lazy_ptr');
+        reference_reset_symbol(href,l1,0);
+        href.refaddr := addr_hi;
+        current_asmdata.asmlists[al_imports].concat(taicpu.op_reg_ref(A_LIS,NR_R11,href));
+        href.refaddr := addr_lo;
+        href.base := NR_R11;
+{$ifndef cpu64bit}
+        current_asmdata.asmlists[al_imports].concat(taicpu.op_reg_ref(A_LWZU,NR_R12,href));
+{$else cpu64bit}
+        { darwin/ppc64 uses a 32 bit absolute address here, strange... }
+        current_asmdata.asmlists[al_imports].concat(taicpu.op_reg_ref(A_LDU,NR_R12,href));
+{$endif cpu64bit}
+        current_asmdata.asmlists[al_imports].concat(taicpu.op_reg(A_MTCTR,NR_R12));
+        current_asmdata.asmlists[al_imports].concat(taicpu.op_none(A_BCTR));
+        current_asmdata.asmlists[al_imports].concat(tai_directive.create(asd_lazy_symbol_pointer,''));
+        current_asmdata.asmlists[al_imports].concat(Tai_symbol.Create(l1,0));
+        current_asmdata.asmlists[al_imports].concat(tai_directive.create(asd_indirect_symbol,s));
+        current_asmdata.asmlists[al_imports].concat(tai_const.createname(strpnew('dyld_stub_binding_helper'),0));
+      end;
+
+
+    { calling a procedure by address }
+    procedure tcgppcgen.a_call_reg(list : TAsmList;reg: tregister);
+      begin
+        list.concat(taicpu.op_reg(A_MTCTR,reg));
+        list.concat(taicpu.op_none(A_BCTRL));
+        include(current_procinfo.flags,pi_do_call);
+      end;
+
+
+    procedure tcgppcgen.a_call_ref(list : TAsmList;ref: treference);
+      var
+        tempreg : TRegister;
+      begin
+        tempreg := getintregister(list, OS_ADDR);
+        a_load_ref_reg(list,OS_ADDR,OS_ADDR,ref,tempreg);
+        a_call_reg(list,tempreg);
+      end;
+
+
+    procedure tcgppcgen.a_load_reg_ref(list: TAsmList; fromsize, tosize: TCGSize;
+      reg: tregister; const ref: treference);
+    
+    const
+      StoreInstr: array[OS_8..OS_INT, boolean, boolean] of TAsmOp =
+      { indexed? updating?}
+      (((A_STB, A_STBU), (A_STBX, A_STBUX)),
+        ((A_STH, A_STHU), (A_STHX, A_STHUX)),
+        ((A_STW, A_STWU), (A_STWX, A_STWUX))
+{$ifdef cpu64bit}
+        ,
+        ((A_STD, A_STDU), (A_STDX, A_STDUX))
+{$endif cpu64bit}
+        );
     var
     var
-      tempreg : TRegister;
+      op: TAsmOp;
+      ref2: TReference;
     begin
     begin
-      tempreg := getintregister(list, OS_ADDR);
-      a_load_ref_reg(list,OS_ADDR,OS_ADDR,ref,tempreg);
-      a_call_reg(list,tempreg);
+      if not (fromsize in [OS_8..OS_INT,OS_S8..OS_SINT]) then
+        internalerror(2002090903);
+      if not (tosize in [OS_8..OS_INT,OS_S8..OS_SINT]) then
+        internalerror(2002090905);
+    
+      ref2 := ref;
+      fixref(list, ref2);
+      if tosize in [OS_S8..OS_SINT] then
+        { storing is the same for signed and unsigned values }
+        tosize := tcgsize(ord(tosize) - (ord(OS_S8) - ord(OS_8)));
+      op := storeinstr[tcgsize2unsigned[tosize], ref2.index <> NR_NO, false];
+      a_load_store(list, op, reg, ref2);
     end;
     end;