powerpc: clean up and simplify the PPC version of the VASM writer (based on the 68k version), and also enable it for AmigaOS4/PPC and Linux/PPC

git-svn-id: trunk@35117 -

compiler/powerpc/agppcvasm.pas

@@ -1,7 +1,7 @@
 {
-    Copyright (c) 1998-2002 by Florian Klaempfl
+    Copyright (c) 2016 by the Free Pascal development team
 
-    This unit is the VASM writer for PowerPC
+    This unit is the VASM assembler writer for PowerPC
 
     This program is free software; you can redistribute it and/or modify
     it under the terms of the GNU General Public License as published by
@@ -20,41 +20,29 @@
  ****************************************************************************
 }
 
-{****************************************************************************}
-{                  Helper routines for Instruction Writer                    }
-{****************************************************************************}
-
 unit agppcvasm;
 
 {$i fpcdefs.inc}
 
   interface
-  
+
     uses
        aasmbase,systems,
        aasmtai,aasmdata,
-       assemble,aggas,
+       assemble,aggas,agppcgas,
        cpubase,cgutils,
        globtype;
 
   type
-    TPPCInstrWriter=class(TCPUInstrWriter)
-       procedure WriteInstruction(hp : tai);override;
-    end;
-
-    TPPCVASM=class(TGNUassembler)
+    tppcvasm = class(TPPCGNUassembler)
+    protected
+      function sectionattrs(atype:TAsmSectiontype):string; override;
+    public
       constructor CreateWithWriter(info: pasminfo; wr: TExternalAssemblerOutputFile; freewriter, smart: boolean); override;
       function MakeCmdLine: TCmdStr; override;
+      procedure WriteExtraHeader; override;
     end;
 
-    topstr = string[4];
-
-    function getreferencestring(var ref : treference) : string;
-    function getopstr_jmp(const o:toper) : string;
-    function getopstr(const o:toper) : string;
-    function branchmode(o: tasmop): topstr;
-    function cond2str(op: tasmop; c: tasmcond): string;  
-
   implementation
 
     uses
@@ -64,324 +52,62 @@ unit agppcvasm;
        itcpugas,cpuinfo,
        aasmcpu;
 
-{$ifdef cpu64bitaddr}
-    const
-      refaddr2str: array[trefaddr] of string[9] = ('', '', '', '', '@l', '@h', '@higher', '@highest', '@ha', '@highera', '@highesta');
-      verbose_refaddrs = [addr_low, addr_high, addr_higher, addr_highest, addr_higha, addr_highera, addr_highesta];
-      refaddr2str_darwin: array[trefaddr] of string[4] = ('','','','','lo16', 'hi16', '@err', '@err', 'ha16', '@err', '@err');
-{$else cpu64bitaddr}
-    const
-      refaddr2str: array[trefaddr] of string[3] = ('','','','','@l','@h','@ha');
-      refaddr2str_darwin: array[trefaddr] of string[4] = ('','','','','lo16','hi16','ha16');
-      verbose_refaddrs = [addr_low,addr_high,addr_higha];
-{$endif cpu64bitaddr}
-
-
-    function getreferencestring(var ref : treference) : string;
-    var
-      s : string;
-    begin
-       with ref do
-        begin
-          if ((offset < -32768) or (offset > 32767)) and
-             (refaddr = addr_no) then
-            internalerror(2006052501);
-          if (refaddr = addr_no) then
-            s := ''
-          else
-            begin
-              if target_info.system in [system_powerpc_darwin,system_powerpc64_darwin] then
-                s := refaddr2str_darwin[refaddr]
-              else
-                s :='';
-              s := s+'(';
-              if assigned(symbol) then
-                begin
-                  s:=s+symbol.name;
-                  if assigned(relsymbol) then
-                    s:=s+'-'+relsymbol.name;
-                end;
-            end;
-          if offset<0 then
-           s:=s+tostr(offset)
-          else
-           if (offset>0) then
-            begin
-              if assigned(symbol) then
-                s:=s+'+'+tostr(offset)
-              else
-                s:=s+tostr(offset);
-            end;
-
-           if (refaddr in verbose_refaddrs) then
-             begin
-               s := s+')';
-               if not(target_info.system in [system_powerpc_darwin,system_powerpc64_darwin]) then
-                 s := s+refaddr2str[refaddr];
-             end;
-{$ifdef cpu64bitaddr}
-           if (refaddr = addr_pic) then
-	     if (target_info.system <> system_powerpc64_linux) then
-	       s := s + ')'
-	     else
-	       s := s + ')@got';
-{$endif cpu64bitaddr}
-
-           if (index=NR_NO) then
-             begin
-                if offset=0 then
-                  begin
-                    if not (assigned(symbol)) then
-                      s:=s+'0';
-                  end;
-                if (base<>NR_NO) then
-                  s:=s+'('+gas_regname(base)+')'
-                else if not assigned(symbol) and
-                        not(refaddr in verbose_refaddrs) then
-                  s:=s+'(0)';
-             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
-                 internalerror(2006052502);
-             end;
-        end;
-      getreferencestring:=s;
-    end;
-    
-
-    function getopstr_jmp(const o:toper) : string;
-    var
-      hs : string;
-    begin
-      case o.typ of
-        top_reg :
-          getopstr_jmp:=gas_regname(o.reg);
-        { no top_ref jumping for powerpc }
-        top_const :
-          getopstr_jmp:=tostr(o.val);
-        top_ref :
-          begin
-            if o.ref^.refaddr<>addr_full then
-              internalerror(200402264);
-            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_jmp:=hs;
-          end;
-        top_none:
-          getopstr_jmp:='';
-        else
-          internalerror(2002070603);
-      end;
-    end;
-
-
-    function getopstr(const o:toper) : string;
-    var
-      hs : string;
-    begin
-      case o.typ of
-        top_reg:
-          getopstr:=gas_regname(o.reg);
-        top_const:
-          getopstr:=tostr(longint(o.val));
-        top_ref:
-          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
-            getopstr:=getreferencestring(o.ref^);
-        else
-          internalerror(2002070604);
-      end;
-    end;
-
-
-    function branchmode(o: tasmop): topstr;
-      var tempstr: topstr;
-      begin
-        tempstr := '';
-        case o of
-          A_BCCTR,A_BCCTRL: tempstr := 'ctr';
-          A_BCLR,A_BCLRL: tempstr := 'lr';
-        end;
-        case o of
-          A_BL,A_BLA,A_BCL,A_BCLA,A_BCCTRL,A_BCLRL: tempstr := tempstr+'l';
-        end;
-        case o of
-          A_BA,A_BLA,A_BCA,A_BCLA: tempstr:=tempstr+'a';
-        end;
-        branchmode := tempstr;
-      end;
-
-
-    function cond2str(op: tasmop; c: tasmcond): string;
-    { note: no checking is performed whether the given combination of }
-    { conditions is valid                                             }
-    var
-      tempstr: string;
-    begin
-      tempstr:=#9;
-      case c.simple of
-        false:
-          begin
-            cond2str := tempstr+gas_op2str[op];
-            case c.dirhint of
-              DH_None:;
-              DH_Minus:
-                cond2str:=cond2str+'-';
-              DH_Plus:
-                cond2str:=cond2str+'+';
-              else
-                internalerror(2003112901);
-            end;
-            cond2str:=cond2str+#9+tostr(c.bo)+','+tostr(c.bi);
-          end;
-        true:
-          if (op >= A_B) and (op <= A_BCLRL) then
-            case c.cond of
-              { unconditional branch }
-              C_NONE:
-                cond2str := tempstr+gas_op2str[op];
-              { bdnzt etc }
-              else
-                begin
-                  tempstr := tempstr+'b'+asmcondflag2str[c.cond]+
-                              branchmode(op);
-                  case c.dirhint of
-                    DH_None:
-                      tempstr:=tempstr+#9;
-                    DH_Minus:
-                      tempstr:=tempstr+('-'+#9);
-                    DH_Plus:
-                      tempstr:=tempstr+('+'+#9);
-                    else
-                      internalerror(2003112901);
-                  end;
-                  case c.cond of
-                    C_LT..C_NU:
-                      cond2str := tempstr+gas_regname(newreg(R_SPECIALREGISTER,c.cr,R_SUBWHOLE));
-                    C_T,C_F,C_DNZT,C_DNZF,C_DZT,C_DZF:
-                      cond2str := tempstr+tostr(c.crbit);
-                    else
-                      cond2str := tempstr;
-                  end;
-                end;
-            end
-          { we have a trap instruction }
-          else
-            begin
-              internalerror(2002070601);
-              { not yet implemented !!!!!!!!!!!!!!!!!!!!! }
-              { case tempstr := 'tw';}
-            end;
-      end;
-    end;
-
 
 {****************************************************************************}
-{                        PowerPC Instruction Writer                          }
+{                         VASM PPC Assembler writer                          }
 {****************************************************************************}
 
-    Procedure TPPCInstrWriter.WriteInstruction(hp : tai);
-    var op: TAsmOp;
-        s: string;
-        i: byte;
-        sep: string[3];
-    begin
-      op:=taicpu(hp).opcode;
-      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_B,A_BA,A_BL,A_BLA:
-               s:=#9+gas_op2str[op]+#9;
-             A_BCTR,A_BCTRL,A_BLR,A_BLRL:
-               s:=#9+gas_op2str[op]
-             else
-               begin
-                 s:=cond2str(op,taicpu(hp).condition);
-                 if (s[length(s)] <> #9) and
-                    (taicpu(hp).ops>0) then
-                   s := s + ',';
-               end;
-          end;
-
-          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.writer.AsmWrite(s);
-              s:=getopstr_jmp(taicpu(hp).oper[0]^);
-            end;
-        end
-      else
-        { process operands }
-        begin
-          s:=#9+gas_op2str[op];
-          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
-                   // debug code
-                   // writeln(s);
-                   // writeln(taicpu(hp).fileinfo.line);
-                   s:=s+sep+getopstr(taicpu(hp).oper[i]^);
-                   sep:=',';
-                end;
-            end;
-        end;
-      owner.writer.AsmWriteLn(s);
-    end;
-
 
-{****************************************************************************}
-{                         GNU PPC Assembler writer                           }
-{****************************************************************************}
-
-
-    constructor TPPCVASM.CreateWithWriter(info: pasminfo; wr: TExternalAssemblerOutputFile; freewriter, smart: boolean);
+    constructor tppcvasm.CreateWithWriter(info: pasminfo; wr: TExternalAssemblerOutputFile; freewriter, smart: boolean);
       begin
         inherited;
         InstrWriter := TPPCInstrWriter.create(self);
       end;
 
-    function TPPCVASM.MakeCmdLine: TCmdStr;
+    function tppcvasm.sectionattrs(atype:TAsmSectiontype):string;
+      begin
+        case atype of
+          sec_code, sec_fpc, sec_init, sec_fini:
+            result:='acrx';
+          sec_data:
+            result:='adrw';
+          sec_rodata, sec_rodata_norel:
+            result:='adr';
+          sec_bss, sec_threadvar:
+            result:='aurw';
+          sec_stab, sec_stabstr:
+            result:='dr';
+          else
+            result:='';
+        end;
+      end;
+
+    function tppcvasm.MakeCmdLine: TCmdStr;
+      var
+        objtype: string;
       begin
         result:=asminfo^.asmcmd;
-        
-        if (cs_link_on_target in current_settings.globalswitches) then
-         begin
-           Replace(result,'$ASM',maybequoted(ScriptFixFileName(AsmFileName)));
-           Replace(result,'$OBJ',maybequoted(ScriptFixFileName(ObjFileName)));
-         end
+
+        objtype:='-Felf';
+        if (target_info.system in [system_powerpc_amiga, system_powerpc_morphos]) then 
+          begin
+            Replace(result,'$ASM',maybequoted(ScriptFixFileName(Unix2AmigaPath(AsmFileName))));
+            Replace(result,'$OBJ',maybequoted(ScriptFixFileName(Unix2AmigaPath(ObjFileName))));
+          end
         else
-         begin
-           Replace(result,'$ASM',maybequoted(Unix2AmigaPath(AsmFileName)));
-           Replace(result,'$OBJ',maybequoted(Unix2AmigaPath(ObjFileName)));
-         end;
+          begin
+            Replace(result,'$ASM',maybequoted(ScriptFixFileName(AsmFileName)));
+            Replace(result,'$OBJ',maybequoted(ScriptFixFileName(ObjFileName)));
+          end;
+        Replace(result,'$OTYPE',objtype);
         Replace(result,'$EXTRAOPT',asmextraopt);
       end;
 
+    procedure tppcvasm.WriteExtraHeader;
+      begin
+        { no-op, compared to the PPC GAS writer, because vasm defines
+          the register symbols by default, so lets not redefine them }
+      end;
 
 
 {*****************************************************************************
@@ -394,15 +120,15 @@ unit agppcvasm;
          id     : as_powerpc_vasm;
 
          idtxt  : 'VASM';
-         asmbin : 'fpcvasm';
-         asmcmd: '-quiet -Felf -o $OBJ $EXTRAOPT $ASM';
-         supported_targets : [system_powerpc_morphos];
-         flags : [af_needar,af_smartlink_sections];
+         asmbin : 'vasmppc_std';
+         asmcmd:  '-quiet $OTYPE -o $OBJ $EXTRAOPT $ASM';
+         supported_targets : [system_powerpc_amiga,system_powerpc_morphos,system_powerpc_linux];
+         flags : [af_needar{,af_smartlink_sections}];
          labelprefix : '.L';
          comment : '# ';
          dollarsign: '$';
        );
 
 begin
-  RegisterAssembler(as_powerpc_vasm_info,TPPCVASM);
+  RegisterAssembler(as_powerpc_vasm_info,tppcvasm);
 end.