* cleaner allocation of scratch registers, removed unnecessary cg methods which emitted code using a fixed register

+ generation of lots of additional debug/trace messages with $EXTDEBUG
* code cleanup (intendation)

git-svn-id: trunk@3584 -

compiler/powerpc64/agppcgas.pas

@@ -61,10 +61,10 @@ uses
 {****************************************************************************}
 
 constructor TPPCGNUAssembler.create(smart: boolean);
-  begin
-    inherited create(smart);
-    InstrWriter := TPPCInstrWriter.create(self);
-  end;
+begin
+  inherited create(smart);
+  InstrWriter := TPPCInstrWriter.create(self);
+end;
 
 
 procedure TPPCGNUAssembler.WriteExtraHeader;
@@ -88,18 +88,15 @@ function getreferencestring(var ref: treference): string;
 var
   s: string;
 begin
-  with ref do
-  begin
+  with ref do begin
     if ((offset < -32768) or (offset > 32767)) and
       (refaddr = addr_no) then
       ; //internalerror(19991);
     if (refaddr = addr_no) then
       s := ''
-    else
-    begin
+    else begin
       s := '(';
-      if assigned(symbol) then
-      begin
+      if assigned(symbol) then begin
         s := s + symbol.name;
         if assigned(relsymbol) then
           s := s + '-' + relsymbol.name;
@@ -107,33 +104,27 @@ begin
     end;
     if offset < 0 then
       s := s + tostr(offset)
-    else if (offset > 0) then
-    begin
+    else if (offset > 0) then begin
       if assigned(symbol) then
         s := s + '+' + tostr(offset)
       else
         s := s + tostr(offset);
     end;
 
-    if (refaddr in [addr_low, addr_high, addr_higher, addr_highest, addr_higha, addr_highera, addr_highesta]) then
-    begin
+    if (refaddr in [addr_low, addr_high, addr_higher, addr_highest, addr_higha, addr_highera, addr_highesta]) then begin
       s := s + ')';
       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
-      if offset = 0 then
-      begin
+    if (index = NR_NO) and (base <> NR_NO) then begin
+      if offset = 0 then begin
         if not (assigned(symbol)) then
           s := s + '0';
       end;
       s := s + '(' + gas_regname(base) + ')';
-    end
-    else if (index <> NR_NO) and (base <> NR_NO) then
-    begin
+    end else if (index <> NR_NO) and (base <> NR_NO) then begin
       if (offset = 0) then
         s := s + gas_regname(base) + ',' + gas_regname(index)
       else
@@ -181,16 +172,14 @@ begin
     top_const:
       getopstr := tostr(longint(o.val));
     top_ref:
-      if o.ref^.refaddr = addr_full then
-      begin
+      if o.ref^.refaddr = addr_full then begin
         hs := o.ref^.symbol.name;
         if o.ref^.offset > 0 then
           hs := hs + '+' + tostr(o.ref^.offset)
         else if o.ref^.offset < 0 then
           hs := hs + tostr(o.ref^.offset);
         getopstr := hs;
-      end
-      else
+      end else
         getopstr := getreferencestring(o.ref^);
   else
     internalerror(2002070604);
@@ -270,8 +259,7 @@ begin
           end;
         end
           { we have a trap instruction }
-      else
-      begin
+      else begin
         internalerror(2002070601);
         { not yet implemented !!!!!!!!!!!!!!!!!!!!! }
         { case tempstr := 'tw';}
@@ -292,12 +280,10 @@ var
   sep: string[3];
 begin
   op := taicpu(hp).opcode;
-  if is_calljmp(op) then
-  begin
+  if is_calljmp(op) then begin
     { direct BO/BI in op[0] and op[1] not supported, put them in condition! }
     case op of
-      A_BL :
-        s := #9 + gas_op2str[op] + #9;
+      A_BL,
       A_B, A_BA, A_BLA:
         s := #9 + gas_op2str[op] + #9;
       A_BCTR, A_BCTRL, A_BLR, A_BLRL:
@@ -311,28 +297,23 @@ begin
       end;
     end;
 
-    if (taicpu(hp).ops > 0) and (taicpu(hp).oper[0]^.typ <> top_none) then
-    begin
+    if (taicpu(hp).ops > 0) and (taicpu(hp).oper[0]^.typ <> top_none) then begin
       { first write the current contents of s, because the symbol }
       { may be 255 characters                                     }
       owner.AsmWrite(s);
       s := getopstr_jmp(taicpu(hp).oper[0]^);
     end;
-  end
-  else
+  end else begin
     { process operands }
-  begin
     s := #9 + gas_op2str[op];
-    if taicpu(hp).ops <> 0 then
-    begin
+    if taicpu(hp).ops <> 0 then begin
       {
         if not is_calljmp(op) then
           sep:=','
         else
       }
       sep := #9;
-      for i := 0 to taicpu(hp).ops - 1 do
-      begin
+      for i := 0 to taicpu(hp).ops - 1 do begin
         // debug code
         // writeln(s);
         // writeln(taicpu(hp).fileinfo.line);

compiler/powerpc64/cgcpu.pas

@@ -195,6 +195,26 @@ begin
     result := result + ref.symbol.name;
 end;
 
+function cgsize2string(const size : TCgSize) : string;
+const
+  cgsize_strings : array[TCgSize] of string[6] = (
+    'OS_NO', 'OS_8', 'OS_16', 'OS_32', 'OS_64', 'OS_128', 'OS_S8', 'OS_S16', 'OS_S32',
+    'OS_S64', 'OS_S128', 'OS_F32', 'OS_F64', 'OS_F80', 'OS_C64', 'OS_F128',
+    'OS_M8', 'OS_M16', 'OS_M32', 'OS_M64', 'OS_M128', 'OS_MS8', 'OS_MS16', 'OS_MS32',
+    'OS_MS64', 'OS_MS128');
+begin
+  result := cgsize_strings[size];
+end;
+
+function is_signed_cgsize(const size : TCgSize) : Boolean;
+begin
+  case size of
+    OS_S8,OS_S16,OS_S32,OS_S64 : result := true;
+    OS_8,OS_16,OS_32,OS_64 : result := false;
+    else
+      internalerror(2006050701);
+  end;
+end;
 
 { helper function which calculate "magic" values for replacement of unsigned
  division by constant operation by multiplication. See the PowerPC compiler
@@ -581,19 +601,21 @@ end;
 procedure tcgppc.a_call_reg(list: TAsmList; reg: tregister);
 var
   tmpref: treference;
+  tempreg : TRegister;
 begin
   if (not (cs_opt_size in aktoptimizerswitches)) then begin
+    tempreg := cg.getintregister(current_asmdata.CurrAsmList, OS_INT);
     { load actual function entry (reg contains the reference to the function descriptor)
-    into R0 }
+    into tempreg }
     reference_reset_base(tmpref, reg, 0);
-    a_load_ref_reg(list, OS_ADDR, OS_ADDR, tmpref, NR_R0);
+    a_load_ref_reg(list, OS_ADDR, OS_ADDR, tmpref, tempreg);
 
     { save TOC pointer in stackframe }
     reference_reset_base(tmpref, NR_STACK_POINTER_REG, LA_RTOC_ELF);
     a_load_reg_ref(list, OS_ADDR, OS_ADDR, NR_RTOC, tmpref);
 
     { move actual function pointer to CTR register }
-    list.concat(taicpu.op_reg(A_MTCTR, NR_R0));
+    list.concat(taicpu.op_reg(A_MTCTR, tempreg));
 
     { load new TOC pointer from function descriptor into RTOC register }
     reference_reset_base(tmpref, reg, tcgsize2size[OS_ADDR]);
@@ -601,15 +623,18 @@ begin
 
     { load new environment pointer from function descriptor into R11 register }
     reference_reset_base(tmpref, reg, 2*tcgsize2size[OS_ADDR]);
+    a_reg_alloc(list, NR_R11);
     a_load_ref_reg(list, OS_ADDR, OS_ADDR, tmpref, NR_R11);
-
     { call function }
     list.concat(taicpu.op_none(A_BCTRL));
+    a_reg_dealloc(list, NR_R11);
   end else begin
     { call ptrgl helper routine which expects the pointer to the function descriptor
     in R11 }
+    a_reg_alloc(list, NR_R11);
     a_load_reg_reg(list, OS_ADDR, OS_ADDR, reg, NR_R11);
     a_call_name_direct(list, '.ptrgl', false, false);
+    a_reg_dealloc(list, NR_R11);
   end;
 
   { we need to load the old RTOC from stackframe because we changed it}
@@ -695,9 +720,11 @@ procedure tcgppc.a_load_const_reg(list: TAsmList; size: TCGSize; a: aint;
            32 bits should contain -1
           - loading the lower 32 bits resulted in 0 in the upper 32 bits, and the upper
            32 bits should contain 0 }
+        a_reg_alloc(list, NR_R0);
         load32bitconstantR0(list, size, hi(a));
         { combine both registers }
         list.concat(taicpu.op_reg_reg_const_const(A_RLDIMI, reg, NR_R0, 32, 0));
+        a_reg_dealloc(list, NR_R0);
       end;
     end;
   end;
@@ -709,7 +736,7 @@ var
 
 begin
   {$IFDEF EXTDEBUG}
-  astring := 'a_load_const reg ' + inttostr(hi(a)) + ' ' + inttostr(lo(a)) + ' ' + inttostr(ord(size)) + ' ' + inttostr(tcgsize2size[size]);
+  astring := 'a_load_const_reg ' + inttostr(hi(a)) + ' ' + inttostr(lo(a)) + ' ' + inttostr(ord(size)) + ' ' + inttostr(tcgsize2size[size]);
   list.concat(tai_comment.create(strpnew(astring)));
   {$ENDIF EXTDEBUG}
   if not (size in [OS_8, OS_S8, OS_16, OS_S16, OS_32, OS_S32, OS_64, OS_S64]) then
@@ -1151,6 +1178,11 @@ var
   scratch_register: TRegister;
   signed: boolean;
 begin
+
+  {$IFDEF EXTDEBUG}
+  list.concat(tai_comment.create(strpnew('a_cmp_const_reg_label ' + inttostr(ord(size)) + ' ' + inttostr(tcgsize2size[size]))));
+  {$ENDIF EXTDEBUG}
+
   signed := cmp_op in [OC_GT, OC_LT, OC_GTE, OC_LTE];
   { in the following case, we generate more efficient code when }
   { signed is true                                              }
@@ -1162,14 +1194,14 @@ begin
       list.concat(taicpu.op_reg_reg_const(A_CMPDI, NR_CR0, reg, a))
     else begin
       scratch_register := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE);
-      a_load_const_reg(list, OS_64, a, scratch_register);
+      a_load_const_reg(list, OS_INT, a, scratch_register);
       list.concat(taicpu.op_reg_reg_reg(A_CMPD, NR_CR0, reg, scratch_register));
     end
   else if (aword(a) <= $FFFF) then
     list.concat(taicpu.op_reg_reg_const(A_CMPLDI, NR_CR0, reg, aword(a)))
   else begin
     scratch_register := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE);
-    a_load_const_reg(list, OS_64, a, scratch_register);
+    a_load_const_reg(list, OS_INT, a, scratch_register);
     list.concat(taicpu.op_reg_reg_reg(A_CMPLD, NR_CR0, reg,
       scratch_register));
   end;
@@ -1181,6 +1213,10 @@ procedure tcgppc.a_cmp_reg_reg_label(list: TAsmList; size: tcgsize;
 var
   op: tasmop;
 begin
+  {$IFDEF extdebug}
+  list.concat(tai_comment.create(strpnew('a_cmp_reg_reg_label, size ' + cgsize2string(size) + ' op ' + inttostr(ord(cmp_op)))));
+  {$ENDIF extdebug}
+
   if cmp_op in [OC_GT, OC_LT, OC_GTE, OC_LTE] then
     if (size in [OS_64, OS_S64]) then
       op := A_CMPD
@@ -2069,18 +2105,18 @@ begin
    adjust the offset accordingly }
   case op of
     A_LD, A_LDU, A_STD, A_STDU, A_LWA :
-     if ((ref.offset mod 4) <> 0) then begin
-       tmpreg := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE);
-
-       if (ref.base <> NR_NO) then begin
-         a_op_const_reg_reg(list, OP_ADD, OS_ADDR, ref.offset mod 4, ref.base, tmpreg);
-         ref.base := tmpreg;
-       end else begin
-         list.concat(taicpu.op_reg_const(A_LI, tmpreg, ref.offset mod 4));
-         ref.base := tmpreg;
-       end;
-       ref.offset := (ref.offset div 4) * 4;
-     end;
+       if ((ref.offset mod 4) <> 0) then begin
+        tmpreg := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE);
+
+        if (ref.base <> NR_NO) then begin
+          a_op_const_reg_reg(list, OP_ADD, OS_ADDR, ref.offset mod 4, ref.base, tmpreg);
+          ref.base := tmpreg;
+        end else begin
+          list.concat(taicpu.op_reg_const(A_LI, tmpreg, ref.offset mod 4));
+          ref.base := tmpreg;
+        end;
+        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))));
@@ -2230,7 +2266,6 @@ begin
   cg.a_load_ref_reg(list, OS_INT, OS_INT, ref, reg);
 end;
 
-
 begin
   cg := tcgppc.create;
 end.

compiler/powerpc64/cpubase.pas

@@ -81,7 +81,7 @@ type
     a_extlwi, a_extlwi_, a_extrwi, a_extrwi_, a_inslwi, a_inslwi_, a_insrwi,
     a_insrwi_, a_rotlwi, a_rotlwi_, a_rotlw, a_rotlw_, a_slwi, a_slwi_,
     a_srwi, a_srwi_, a_clrlwi, a_clrlwi_, a_clrrwi, a_clrrwi_, a_clrslwi,
-    a_clrslwi_, a_blr, a_bctr, a_blrl, a_bctrl, a_crset, a_crclr, a_crmove,
+    a_clrslwi_, a_bf, a_bt, a_blr, a_bctr, a_blrl, a_bctrl, a_crset, a_crclr, a_crmove,
     a_crnot, a_mt {move to special prupose reg}, a_mf
       {move from special purpose reg},
     a_nop, a_li, a_lis, a_la, a_mr, a_mr_, a_not, a_mtcr, a_mtlr, a_mflr,
@@ -212,7 +212,7 @@ const
     true, false,
     true, false, false, true, false, false, true, false);
 
-  AsmCondFlag2Str: array[TAsmCondFlag] of string[4] = ({cf_none}'',
+  AsmCondFlag2Str : array[TAsmCondFlag] of string[4] = ({cf_none}'',
     { conditions when not using ctr decrement etc}
     'lt', 'le', 'eq', 'ge', 'gt', 'nl', 'ne', 'ng', 'so', 'ns', 'un', 'nu',
     't', 'f', 'dnz', 'dnzt', 'dnzf', 'dz', 'dzt', 'dzf');
@@ -398,7 +398,7 @@ function is_condreg(r: tregister): boolean;
 function inverse_cond(const c: TAsmCond): Tasmcond;
 {$IFDEF USEINLINE}inline;{$ENDIF USEINLINE}
 function conditions_equal(const c1, c2: TAsmCond): boolean;
-    function dwarf_reg(r:tregister):byte;
+function dwarf_reg(r:tregister):byte;
 
 implementation
 
@@ -546,12 +546,12 @@ begin
     result := generic_regname(r);
 end;
 
-    function dwarf_reg(r:tregister):byte;
-      begin
-        result:=regdwarf_table[findreg_by_number(r)];
-        if result=-1 then
-          internalerror(200603251);
-      end;
+function dwarf_reg(r:tregister):byte;
+begin
+  result:=regdwarf_table[findreg_by_number(r)];
+  if result=-1 then
+    internalerror(200603251);
+end;
 
 
 end.

compiler/powerpc64/cpupara.pas

@@ -278,7 +278,6 @@ var
   parashift : byte;
 
 begin
-//writeln('begin create_paraloc_info');
 {$IFDEF extdebug}
   if po_explicitparaloc in p.procoptions then
     internalerror(200411141);
@@ -292,8 +291,8 @@ begin
 
   for i := 0 to paras.count - 1 do begin
     parashift := 0;
-
     hp := tparavarsym(paras[i]);
+
     paradef := hp.vartype.def;
     { Syscall for Morphos can have already a paraloc set; not supported on ppc64 }
     if (vo_has_explicit_paraloc in hp.varoptions) then begin

compiler/powerpc64/itcpugas.pas

@@ -73,7 +73,7 @@ const
     'extlwi', 'extlwi.', 'extrwi', 'extrwi.', 'inslwi', 'inslwi.', 'insrwi',
     'insrwi.', 'rotlwi', 'rotlwi.', 'rotlw', 'rotlw.', 'slwi', 'slwi.',
     'srwi', 'srwi.', 'clrlwi', 'clrlwi.', 'clrrwi', 'clrrwi.', 'clrslwi',
-    'clrslwi.', 'blr', 'bctr', 'blrl', 'bctrl', 'crset', 'crclr', 'crmove',
+    'clrslwi.', 'bf', 'bt', 'blr', 'bctr', 'blrl', 'bctrl', 'crset', 'crclr', 'crmove',
     'crnot', 'mt', 'mf', 'nop', 'li', 'lis', 'la', 'mr', 'mr.', 'not', 'mtcr',
       'mtlr', 'mflr',
     'mtctr', 'mfctr',
@@ -124,8 +124,7 @@ begin
   p := 0;
   i := regnumber_count_bsstart;
   repeat
-    if (p + i <= high(tregisterindex)) and (gas_regname_table[gas_regname_index[p
-      + i]] <= s) then
+    if (p + i <= high(tregisterindex)) and (gas_regname_table[gas_regname_index[p + i]] <= s) then
       p := p + i;
     i := i shr 1;
   until i = 0;

compiler/powerpc64/nppcadd.pas

@@ -176,6 +176,11 @@ begin
   // get the constant on the right if there is one
   if (left.location.loc = LOC_CONSTANT) then
     swapleftright;
+
+  {$IFDEF EXTDEBUG}
+  current_asmdata.CurrAsmList.concat(tai_comment.create(strpnew('tppcaddnode.emit_compare ' + inttostr(ord(opsize)) + ' ' + inttostr(tcgsize2size[opsize]))));
+  {$ENDIF EXTDEBUG}
+
   // can we use an immediate, or do we have to load the
   // constant in a register first?
   if (right.location.loc = LOC_CONSTANT) then begin
@@ -198,13 +203,14 @@ begin
     else begin
       useconst := false;
       tmpreg := cg.getintregister(current_asmdata.CurrAsmList, OS_INT);
-      cg.a_load_const_reg(current_asmdata.CurrAsmList, OS_INT,
-        right.location.value, tmpreg);
+      cg.a_load_const_reg(current_asmdata.CurrAsmList, OS_INT, right.location.value, tmpreg);
     end
   end else
     useconst := false;
+
   location.loc := LOC_FLAGS;
   location.resflags := getresflags;
+
   if not unsigned then
     if useconst then
       op := A_CMPDI
@@ -492,10 +498,10 @@ begin
   if not (cmpop) and
     (location.register = NR_NO) then
     location.register := cg.getintregister(current_asmdata.CurrAsmList, OS_64);
-
+  {$ifdef extdebug}
   astring := 'addsmallset0 ' + inttostr(aword(1) shl aword(right.location.value)) + ' ' + inttostr(right.location.value);
   current_asmdata.CurrAsmList.concat(tai_comment.create(strpnew(astring)));
-
+  {$endif extdebug}
 
   case nodetype of
     addn:
@@ -508,10 +514,10 @@ begin
           if assigned(tsetelementnode(right).right) then
             internalerror(43244);
           if (right.location.loc = LOC_CONSTANT) then begin
-
+            {$ifdef extdebug}
             astring := 'addsmallset1 ' + inttostr(aword(1) shl aword(right.location.value)) + ' ' + inttostr(right.location.value);
             current_asmdata.CurrAsmList.concat(tai_comment.create(strpnew(astring)));
-
+            {$endif extdebug}
 
             cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_OR, OS_64,
               aint(1) shl aint(right.location.value),
@@ -526,9 +532,10 @@ begin
               cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList, OP_OR, OS_64, tmpreg,
                 left.location.register, location.register)
             end else begin
+              {$ifdef extdebug}
               astring := 'addsmallset2 ' + inttostr(left.location.value);
               current_asmdata.CurrAsmList.concat(tai_comment.create(strpnew(astring)));
-
+              {$endif extdebug}
               cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_OR, OS_64,
                 left.location.value, tmpreg, location.register);
             end;
@@ -572,7 +579,7 @@ begin
         end;
       end;
     equaln,
-      unequaln:
+    unequaln:
       begin
         emit_compare(true);
         opdone := true;
@@ -717,8 +724,7 @@ begin
     not (cmpop) then
     location.register := cg.getintregister(current_asmdata.CurrAsmList, OS_INT);
 
-  if not (cs_check_overflow in aktlocalswitches) or
-    (cmpop) or
+  if not (cs_check_overflow in aktlocalswitches) or (cmpop) or
     (nodetype in [orn, andn, xorn]) then
   begin
     case nodetype of
@@ -775,6 +781,10 @@ begin
         end;
       ltn, lten, gtn, gten, equaln, unequaln:
         begin
+          {$ifdef extdebug}
+          current_asmdata.CurrAsmList.concat(tai_comment.create('tppcaddnode.pass2'));
+          {$endif extdebug}
+
           emit_compare(unsigned);
         end;
     end;