+ AIX assembler writer

   o .short/.long/.llong are automatically aligned to 2/4/8 byte multiples
     by the AIX assembler (and for compatibility reasons, also by the
     GNU assembler when targeting AIX) -> change to .vbyte statements
  o .ascii does not allow non-ASCII characters in the AIX assembler
    -> change to .byte sequences like gcc on AIX

git-svn-id: http://svn.freepascal.org/svn/fpc/trunk@20803 3ad0048d-3df7-0310-abae-a5850022a9f2

3 files changed, 363 insertions, 55 deletions

diff --git a/compiler/aggas.pas b/compiler/aggas.pas
index cc3d43d641..2fc9dde536 100644
--- a/compiler/aggas.pas
+++ b/compiler/aggas.pas
@@ -48,8 +48,11 @@ interface
         function sectionattrs_coff(atype:TAsmSectiontype):string;virtual;
         procedure WriteSection(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder);
         procedure WriteExtraHeader;virtual;
+        procedure WriteExtraFooter;virtual;
         procedure WriteInstruction(hp: tai);
         procedure WriteWeakSymbolDef(s: tasmsymbol); virtual;
+        procedure WriteAixStringConst(hp: tai_string);
+        procedure WriteAixIntConst(hp: tai_const);
        public
         function MakeCmdLine: TCmdStr; override;
         procedure WriteTree(p:TAsmList);override;
@@ -475,7 +478,9 @@ implementation
          system_i386_iphonesim,
          system_powerpc64_darwin,
          system_x86_64_darwin,
-         system_arm_darwin:
+         system_arm_darwin,
+         system_powerpc_aix,
+         system_powerpc64_aix:
            begin
              if (atype in [sec_stub,sec_objc_data,sec_objc_const,sec_data_coalesced]) then
                AsmWrite('.section ');
@@ -586,7 +591,7 @@ implementation
           last_align:=alignment;
           if alignment>1 then
             begin
-              if not(target_info.system in systems_darwin) then
+              if not(target_info.system in (systems_darwin+systems_aix)) then
                 begin
                   AsmWrite(#9'.balign '+tostr(alignment));
                   if use_op then
@@ -599,7 +604,7 @@ implementation
                 end
               else
                 begin
-                  { darwin as only supports .align }
+                  { darwin and aix as only support .align }
                   if not ispowerof2(alignment,i) then
                     internalerror(2003010305);
                   AsmWrite(#9'.align '+tostr(i));
@@ -735,6 +740,28 @@ implementation
                        asmln;
                      end;
                  end
+               else if target_info.system in systems_aix then
+                 begin
+                   if tai_datablock(hp).is_global then
+                     begin
+                       asmwrite(#9'.globl ');
+                       asmwriteln(ReplaceForbiddenAsmSymbolChars(tai_datablock(hp).sym.name));
+                       asmwrite(ReplaceForbiddenAsmSymbolChars(tai_datablock(hp).sym.name));
+                       asmwriteln(':');
+                       asmwrite(#9'.space ');
+                       asmwriteln(tostr(tai_datablock(hp).size));
+                       if not(LastSecType in [sec_data,sec_none]) then
+                         writesection(LastSecType,'',secorder_default);
+                     end
+                   else
+                     begin
+                       asmwrite(#9'.lcomm ');
+                       asmwrite(ReplaceForbiddenAsmSymbolChars(tai_datablock(hp).sym.name));
+                       asmwrite(',_data.bss_[RW],');
+                       asmwrite(tostr(tai_datablock(hp).size)+',');
+                       asmwriteln(tostr(last_align));
+                     end;
+                 end
                else
                  begin
 {$ifdef USE_COMM_IN_BSS}
@@ -818,19 +845,24 @@ implementation
                     begin
                       if assigned(tai_const(hp).sym) then
                         internalerror(200404292);
-                      AsmWrite(ait_const2str[aitconst_32bit]);
-                      if target_info.endian = endian_little then
+                      if not(target_info.system in systems_aix) then
                         begin
-                          AsmWrite(tostr(longint(lo(tai_const(hp).value))));
-                          AsmWrite(',');
-                          AsmWrite(tostr(longint(hi(tai_const(hp).value))));
+                          AsmWrite(ait_const2str[aitconst_32bit]);
+                          if target_info.endian = endian_little then
+                            begin
+                              AsmWrite(tostr(longint(lo(tai_const(hp).value))));
+                              AsmWrite(',');
+                              AsmWrite(tostr(longint(hi(tai_const(hp).value))));
+                            end
+                          else
+                            begin
+                              AsmWrite(tostr(longint(hi(tai_const(hp).value))));
+                              AsmWrite(',');
+                              AsmWrite(tostr(longint(lo(tai_const(hp).value))));
+                            end;
                         end
                       else
-                        begin
-                          AsmWrite(tostr(longint(hi(tai_const(hp).value))));
-                          AsmWrite(',');
-                          AsmWrite(tostr(longint(lo(tai_const(hp).value))));
-                        end;
+                        WriteAixIntConst(tai_const(hp));
                       AsmLn;
                     end;
 {$endif cpu64bitaddr}
@@ -849,7 +881,19 @@ implementation
                  aitconst_darwin_dwarf_delta64,
                  aitconst_half16bit:
                    begin
-                     if (target_info.system in systems_darwin) and
+                     { the AIX assembler (and for compatibility, the GNU
+                       assembler when targeting AIX) automatically aligns
+                       .short/.long/.llong to a multiple of 2/4/8 bytes. We
+                       don't want that, since this may be data inside a packed
+                       record -> use .vbyte instead (byte stream of fixed
+                       length) }
+                     if (target_info.system in systems_aix) and
+                        (constdef in [aitconst_128bit,aitconst_64bit,aitconst_32bit,aitconst_16bit]) and
+                        not assigned(tai_const(hp).sym) then
+                       begin
+                         WriteAixIntConst(tai_const(hp));
+                       end
+                     else if (target_info.system in systems_darwin) and
                         (constdef in [aitconst_uleb128bit,aitconst_sleb128bit]) then
                        begin
                          AsmWrite(ait_const2str[aitconst_8bit]);
@@ -1023,31 +1067,36 @@ implementation
            ait_string :
              begin
                pos:=0;
-               for i:=1 to tai_string(hp).len do
-                begin
-                  if pos=0 then
-                   begin
-                     AsmWrite(#9'.ascii'#9'"');
-                     pos:=20;
-                   end;
-                  ch:=tai_string(hp).str[i-1];
-                  case ch of
-                     #0, {This can't be done by range, because a bug in FPC}
-                #1..#31,
-             #128..#255 : s:='\'+tostr(ord(ch) shr 6)+tostr((ord(ch) and 63) shr 3)+tostr(ord(ch) and 7);
-                    '"' : s:='\"';
-                    '\' : s:='\\';
-                  else
-                   s:=ch;
-                  end;
-                  AsmWrite(s);
-                  inc(pos,length(s));
-                  if (pos>line_length) or (i=tai_string(hp).len) then
-                   begin
-                     AsmWriteLn('"');
-                     pos:=0;
-                   end;
-                end;
+               if not(target_info.system in systems_aix) then
+                 begin
+                   for i:=1 to tai_string(hp).len do
+                    begin
+                      if pos=0 then
+                       begin
+                         AsmWrite(#9'.ascii'#9'"');
+                         pos:=20;
+                       end;
+                      ch:=tai_string(hp).str[i-1];
+                      case ch of
+                                #0, {This can't be done by range, because a bug in FPC}
+                           #1..#31,
+                        #128..#255 : s:='\'+tostr(ord(ch) shr 6)+tostr((ord(ch) and 63) shr 3)+tostr(ord(ch) and 7);
+                               '"' : s:='\"';
+                               '\' : s:='\\';
+                      else
+                        s:=ch;
+                      end;
+                      AsmWrite(s);
+                      inc(pos,length(s));
+                      if (pos>line_length) or (i=tai_string(hp).len) then
+                       begin
+                         AsmWriteLn('"');
+                         pos:=0;
+                       end;
+                    end;
+                 end
+               else
+                 WriteAixStringConst(tai_string(hp));
              end;
 
            ait_label :
@@ -1112,6 +1161,30 @@ implementation
                    { the dotted name is the name of the actual function entry }
                    AsmWrite('.');
                  end
+               else if (target_info.system in systems_aix) and
+                  (tai_symbol(hp).sym.typ = AT_FUNCTION) then
+                 begin
+                   if target_info.system=system_powerpc_aix then
+                     begin
+                       s:=#9'.long .';
+                       ch:='2';
+                     end
+                   else
+                     begin
+                       s:=#9'.llong .';
+                       ch:='3';
+                     end;
+                   AsmWriteLn(#9'.csect '+ReplaceForbiddenAsmSymbolChars(tai_symbol(hp).sym.name)+'[DS],'+ch);
+                   AsmWriteLn(ReplaceForbiddenAsmSymbolChars(tai_symbol(hp).sym.name)+':');
+                   AsmWriteln(s+ReplaceForbiddenAsmSymbolChars(tai_symbol(hp).sym.name)+', TOC[tc0], 0');
+                   AsmWriteln(#9'.csect .text[PR]');
+                   if (tai_symbol(hp).is_global) then
+                     AsmWriteLn('.globl .'+ReplaceForbiddenAsmSymbolChars(tai_symbol(hp).sym.name))
+                   else
+                     AsmWriteLn('.lglobl .'+ReplaceForbiddenAsmSymbolChars(tai_symbol(hp).sym.name));
+                   { the dotted name is the name of the actual function entry }
+                   AsmWrite('.');
+                 end
                else
                  begin
                    if (target_info.system <> system_arm_linux) then
@@ -1275,6 +1348,11 @@ implementation
       end;
 
 
+    procedure TGNUAssembler.WriteExtraFooter;
+      begin
+      end;
+
+
     procedure TGNUAssembler.WriteInstruction(hp: tai);
       begin
         InstrWriter.WriteInstruction(hp);
@@ -1287,6 +1365,113 @@ implementation
       end;
 
 
+    procedure TGNUAssembler.WriteAixStringConst(hp: tai_string);
+      type
+        tterminationkind = (term_none,term_string,term_nostring);
+
+      var
+        i: longint;
+        pos: longint;
+        s: string;
+        ch: char;
+        instring: boolean;
+
+      procedure newstatement(terminationkind: tterminationkind);
+        begin
+          case terminationkind of
+            term_none: ;
+            term_string:
+              AsmWriteLn('"');
+            term_nostring:
+              AsmLn;
+          end;
+          AsmWrite(#9'.byte'#9);
+          pos:=20;
+          instring:=false;
+        end;
+
+      begin
+        pos:=0;
+        for i:=1 to hp.len do
+          begin
+            if pos=0 then
+              newstatement(term_none);
+            ch:=hp.str[i-1];
+            case ch of
+              #0..#31,
+              #127..#255 :
+                begin
+                  if instring then
+                    newstatement(term_string);
+                  if pos=20 then
+                    s:=tostr(ord(ch))
+                  else
+                    s:=', '+tostr(ord(ch))
+                end;
+              '"' :
+                if instring then
+                  s:='""'
+                else
+                  begin
+                    if pos<>20 then
+                      newstatement(term_nostring);
+                    s:='"""';
+                    instring:=true;
+                  end;
+              else
+                if not instring then
+                  begin
+                    if (pos<>20) then
+                      newstatement(term_nostring);
+                    s:='"'+ch;
+                    instring:=true;
+                  end
+                else
+                  s:=ch;
+            end;
+            AsmWrite(s);
+            inc(pos,length(s));
+            if (pos>line_length) or (i=tai_string(hp).len) then
+              begin
+                if instring then
+                  AsmWriteLn('"')
+                else
+                  AsmLn;
+                pos:=0;
+              end;
+         end;
+      end;
+
+
+    procedure TGNUAssembler.WriteAixIntConst(hp: tai_const);
+      var
+        pos, size: longint;
+      begin
+        { only big endian AIX supported for now }
+        if target_info.endian<>endian_big then
+          internalerror(2012010401);
+        { limitation: can only write 4 bytes at a time }
+        pos:=0;
+        size:=tai_const(hp).size;
+        while pos<(size-4) do
+          begin
+            AsmWrite(#9'.vbyte'#9'4, ');
+            AsmWriteln(tostr(longint(tai_const(hp).value shr ((size-pos-4)*8))));
+            inc(pos,4);
+         end;
+        AsmWrite(#9'.vbyte'#9);
+        AsmWrite(tostr(size-pos));
+        AsmWrite(', ');
+        case size-pos of
+          1: AsmWrite(tostr(byte(tai_const(hp).value)));
+          2: AsmWrite(tostr(word(tai_const(hp).value)));
+          4: AsmWrite(tostr(longint(tai_const(hp).value)));
+          else
+            internalerror(2012010402);
+        end;
+      end;
+
+
     procedure TGNUAssembler.WriteAsmList;
     var
       n : string;
diff --git a/compiler/ppcgen/agppcgas.pas b/compiler/ppcgen/agppcgas.pas
index 5897489c69..1c1f58c483 100644
--- a/compiler/ppcgen/agppcgas.pas
+++ b/compiler/ppcgen/agppcgas.pas
@@ -52,6 +52,13 @@ unit agppcgas;
       function MakeCmdLine: TCmdStr; override;
     end;
 
+    TPPCAIXAssembler=class(TPPCGNUAssembler)
+      constructor create(smart: boolean); override;
+      procedure WriteExtraHeader; override;
+      procedure WriteExtraFooter; override;
+      function sectionname(atype: TAsmSectiontype; const aname: string; aorder: TAsmSectionOrder): string; override;
+    end;
+
     topstr = string[4];
 
     function getreferencestring(var ref : treference) : string;
@@ -91,22 +98,47 @@ unit agppcgas;
           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;
+          case refaddr of
+            addr_no:
+              s := '';
+            addr_pic_no_got:
+              begin
+                { used for TOC-based loads }
+                if (base<>NR_RTOC) or
+                   (index<>NR_NO) or
+                   (offset<>0) or
+                   not assigned(symbol) then
+                  internalerror(2011122701);
+                if target_asm.dollarsign<>'$' then
+                  getreferencestring:=ReplaceForbiddenAsmSymbolChars(symbol.name)+'('+gas_regname(NR_RTOC)+')'
+                else
+                  getreferencestring:=symbol.name+'('+gas_regname(NR_RTOC)+')';
+                exit;
+              end
+            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
+                    if target_asm.dollarsign<>'$' then
+                      begin
+                        s:=s+ReplaceForbiddenAsmSymbolChars(symbol.name);
+                        if assigned(relsymbol) then
+                          s:=s+'-'+ReplaceForbiddenAsmSymbolChars(relsymbol.name)
+                      end
+                    else
+                      begin
+                        s:=s+symbol.name;
+                        if assigned(relsymbol) then
+                          s:=s+'-'+relsymbol.name;
+                      end;
+                  end;
+              end;
+          end;
           if offset<0 then
            s:=s+tostr(offset)
           else
@@ -414,7 +446,77 @@ unit agppcgas;
       end;
 
 
+{****************************************************************************}
+{                         AIX PPC Assembler writer                           }
+{****************************************************************************}
+
+    constructor TPPCAIXAssembler.create(smart: boolean);
+      begin
+        inherited create(smart);
+        InstrWriter := TPPCInstrWriter.create(self);
+      end;
+
+
+    procedure TPPCAIXAssembler.WriteExtraHeader;
+      var
+        i: longint;
+      begin
+        inherited WriteExtraHeader;
+        { AIX assembler notation for .quad is .llong, let assembler itself
+          perform the substitution; the aix assembler uses .quad for defining
+          128 bit floating point numbers, but
+            a) we don't support those yet
+            b) once we support them, we'll encode them byte per byte like other
+               floating point numbers }
+        AsmWriteln(#9'.set'#9'.quad,.llong');
+        { map cr registers to plain numbers }
+        for i:=0 to 7 do
+          AsmWriteln(#9'.set'#9'cr'+tostr(i)+','+tostr(i));
+        { make sure we always have a code and toc section, the linker expects
+          that }
+        AsmWriteln(#9'.csect .text[PR]');
+        AsmWriteln(#9'.toc');
+      end;
+
+
+    procedure TPPCAIXAssembler.WriteExtraFooter;
+      begin
+        inherited WriteExtraFooter;
+        { link between data and text section }
+        AsmWriteln('_section_.text:');
+        AsmWriteln(#9'.csect .data[RW],4');
+{$ifdef cpu64bitaddr}
+        AsmWrite(#9'.llong _section_.text')
+{$else cpu64bitaddr}
+        AsmWrite(#9'.long _section_.text')
+{$endif cpu64bitaddr}
+      end;
+
 
+    function TPPCAIXAssembler.sectionname(atype: TAsmSectiontype; const aname: string; aorder: TAsmSectionOrder): string;
+      begin
+        case atype of
+          sec_code:
+            result:='.csect .text[PR]';
+          sec_data,
+          sec_rodata,
+          { don't use .bss[BS], causes relocation problems }
+          sec_bss:
+            result:='.csect .data[RW]';
+          sec_rodata_norel:
+            result:='.csect .text[RO]';
+          sec_fpc:
+            result:='.csect .fpc[RO]';
+          sec_toc:
+            result:='.toc';
+          { automatically placed in the right section }
+          sec_stab,
+          sec_stabstr:
+            result:='';
+          else
+            internalerror(2011122601);
+        end;
+      end;
 
 
 {*****************************************************************************
@@ -456,7 +558,27 @@ unit agppcgas;
        );
 
 
+    as_ppc_aix_powerpc_info : tasminfo =
+       (
+         id     : as_powerpc_xcoff;
+
+         idtxt  : 'AS-AIX';
+         asmbin : 'as';
+         { -u: allow using symbols before they are defined (when using native
+               AIX assembler, ignore by GNU assembler)
+           -mpwr5: we actually support Power3 and higher, but the AIX assembler
+               has no parameter to select that one (only -mpwr3 and -mpwr5) }
+         asmcmd : '-u -o $OBJ $ASM -mpwr5';
+         supported_targets : [system_powerpc_aix,system_powerpc64_aix];
+         flags : [af_needar,af_smartlink_sections,af_stabs_use_function_absolute_addresses];
+         labelprefix : 'L';
+         comment : '# ';
+         dollarsign : '.'
+       );
+
+
 begin
   RegisterAssembler(as_ppc_gas_info,TPPCGNUAssembler);
   RegisterAssembler(as_ppc_gas_darwin_powerpc_info,TPPCAppleGNUAssembler);
+  RegisterAssembler(as_ppc_aix_powerpc_info,TPPCAIXAssembler);
 end.
diff --git a/compiler/systems.inc b/compiler/systems.inc
index a352c70985..c05ca5ab95 100644
--- a/compiler/systems.inc
+++ b/compiler/systems.inc
@@ -184,6 +184,7 @@
              ,as_i386_nasmhaiku
              ,as_powerpc_vasm
              ,as_i386_nlmcoff
+             ,as_powerpc_xcoff
        );
 
        tar = (ar_none