+ fcl-res support for xcoff/aix

  + compiler support for Delphi-style resources on aix

git-svn-id: trunk@20841 -

.gitattributes

@@ -2338,6 +2338,7 @@ packages/fcl-res/src/versionconsts.pp svneol=native#text/plain
 packages/fcl-res/src/versionresource.pp svneol=native#text/plain
 packages/fcl-res/src/versiontypes.pp svneol=native#text/plain
 packages/fcl-res/src/winpeimagereader.pp svneol=native#text/plain
+packages/fcl-res/src/xcoffwriter.pp svneol=native#text/plain
 packages/fcl-res/xml/acceleratorsresource.xml svneol=native#text/plain
 packages/fcl-res/xml/bitmapresource.xml svneol=native#text/plain
 packages/fcl-res/xml/clean.sh svneol=native#text/plain

compiler/pmodules.pas

@@ -339,7 +339,7 @@ implementation
       ResourceInfo : TAsmList;
 
     begin
-      if (target_res.id in [res_elf,res_macho]) then
+      if (target_res.id in [res_elf,res_macho,res_xcoff]) then
         begin
         ResourceInfo:=TAsmList.Create;
 

compiler/rescmn.pas

@@ -42,6 +42,18 @@ uses
              resflags : [];
           );
 
+       res_xcoff_info : tresinfo =
+          (
+             id     : res_xcoff;
+             resbin : 'fpcres';
+             rescmd : '-o $OBJ -a $ARCH -of xcoff $DBG';
+             { cross compiled windres can be used to compile .rc files on other platforms }
+             rcbin  : 'windres';
+             rccmd  : '--include $INC -O res -o $RES $RC';
+             resourcefileclass : nil;
+             resflags : [];
+          );
+
        res_ext_info : tresinfo =
           (
              id     : res_ext;

compiler/systems.inc

@@ -197,7 +197,7 @@
        tres = (res_none
             ,res_gnu_windres,res_watcom_wrc_os2
             ,res_m68k_palmos,res_m68k_mpw
-            ,res_powerpc_mpw,res_elf
+            ,res_powerpc_mpw,res_elf,res_xcoff
             ,res_win64_gorc, res_macho, res_ext
        );
 

compiler/systems/i_aix.pas

@@ -67,7 +67,7 @@ unit i_aix;
             link         : nil;
             linkextern   : nil;
             ar           : ar_gnu_ar;
-            res          : res_elf;
+            res          : res_xcoff;
             dbg          : dbg_stabx;
             script       : script_unix;
             endian       : endian_big;
@@ -129,7 +129,7 @@ unit i_aix;
             link         : nil;
             linkextern   : nil;
             ar           : ar_gnu_ar;
-            res          : res_elf;
+            res          : res_xcoff;
             dbg          : dbg_stabx;
             script       : script_unix;
             endian       : endian_big;

compiler/systems/t_aix.pas

@@ -417,5 +417,5 @@ initialization
   RegisterExport(system_powerpc64_aix,texportlibaix);
   RegisterTarget(system_powerpc64_aix_info);
 {$endif powerpc64}
-  RegisterRes(res_elf_info,TWinLikeResourceFile);
+  RegisterRes(res_xcoff_info,TWinLikeResourceFile);
 end.

packages/fcl-res/fpmake.pp

@@ -59,6 +59,14 @@ begin
           AddUnit('cofftypes');
           AddUnit('coffconsts');
         end;
+    T:=P.Targets.AddUnit('xcoffwriter.pp');
+      with T.Dependencies do
+        begin
+          AddUnit('cofftypes');
+          AddUnit('coffwriter');
+          AddUnit('coffconsts');
+          AddUnit('fpcrestypes');
+        end;
     T:=P.Targets.AddUnit('dfmreader.pp');
       with T.Dependencies do
         begin

packages/fcl-res/src/coffconsts.pp

@@ -39,6 +39,10 @@ const
 {
   IMAGE_FILE_MACHINE_THUMB           = $01c2;
   IMAGE_FILE_MACHINE_AM33            = $01d3;
+}
+  IMAGE_FILE_MACHINE_POWERPC32_AIX   = $01DF;  // IBM AIX 32 bit PowerPC
+  IMAGE_FILE_MACHINE_POWERPC64_AIX   = $01EF;  // IBM AIX 62 bit PowerPC
+{
   IMAGE_FILE_MACHINE_POWERPC         = $01F0;  // IBM PowerPC Little-Endian
   IMAGE_FILE_MACHINE_POWERPCFP       = $01f1;
   IMAGE_FILE_MACHINE_IA64            = $0200;  // Intel 64
@@ -155,10 +159,35 @@ const
   IMAGE_REL_AMD64_PAIR          = $000F;
   IMAGE_REL_AMD64_SSPAN32       = $0010;  // 32 bit signed span-dependent value applied at link time
 
+// AIX PPC32/PPC64 relocation types.
+
+  IMAGE_REL_PPC_POS             = $1F00;  // A(sym) Positive Relocation
+
+
 const
-// storage classes
+  // storage classes
   IMAGE_SYM_CLASS_STATIC        = $0003;
 
+  // XCOFF
+  IMAGE_SYM_CLASS_EXT           = 2;
+  IMAGE_SYM_CLASS_HIDEXT        = 107;
+
+  XTY_ER = 0;
+  XTY_SD = 1;
+  XTY_LD = 2;
+  XTY_CM = 3;
+
+  XMC_RW = 5;
+
+  // section types
+  STYP_DATA = $40;
+  STYP_BSS = $80;
+
+const
+  XCoffRsrcSectName    = 'fpc.resources';
+  XCoffHandlesSectName = 'fpc.reshandles';
+
+
 implementation
 
 end.

packages/fcl-res/src/coffreader.pp

@@ -28,6 +28,7 @@ type
 
   TCoffResourceReader = class (TAbstractResourceReader)
   private
+    fOppositeEndianess: boolean;
     fDescription: string;
     fExtensions: string;
     fCoffHeader : TCoffHeader;
@@ -82,24 +83,38 @@ begin
   except
     on e : EReadError do exit;
   end;
-  
-  {$IFDEF ENDIAN_BIG}
-  hdr.machine:=SwapEndian(hdr.machine);
-  hdr.numsects:=SwapEndian(hdr.numsects);
-  hdr.timestamp:=SwapEndian(hdr.timestamp);
-  hdr.symtableptr:=SwapEndian(hdr.symtableptr);
-  hdr.symnum:=SwapEndian(hdr.symnum);
-  hdr.opthdrsize:=SwapEndian(hdr.opthdrsize);
-  hdr.characteristics:=SwapEndian(hdr.characteristics);
-  {$ENDIF}
 
   case hdr.machine of
     IMAGE_FILE_MACHINE_I386  : fMachineType:=cmti386;
     IMAGE_FILE_MACHINE_ARM   : fMachineType:=cmtarm;
-    IMAGE_FILE_MACHINE_AMD64 : fMachineType:=cmtx8664
-    else exit;
+    IMAGE_FILE_MACHINE_AMD64 : fMachineType:=cmtx8664;
+    IMAGE_FILE_MACHINE_POWERPC32_AIX : fMachineType:=cmtppc32aix;
+    IMAGE_FILE_MACHINE_POWERPC64_AIX : fMachineType:=cmtppc64aix;
+    else
+      begin
+        fOppositeEndianess:=true;
+        case SwapEndian(hdr.machine) of
+          IMAGE_FILE_MACHINE_I386  : fMachineType:=cmti386;
+          IMAGE_FILE_MACHINE_ARM   : fMachineType:=cmtarm;
+          IMAGE_FILE_MACHINE_AMD64 : fMachineType:=cmtx8664;
+          IMAGE_FILE_MACHINE_POWERPC32_AIX : fMachineType:=cmtppc32aix;
+          IMAGE_FILE_MACHINE_POWERPC64_AIX : fMachineType:=cmtppc64aix;
+          else exit;
+        end;
+      end;
   end;
 
+  if fOppositeEndianess then
+    begin
+      hdr.machine:=SwapEndian(hdr.machine);
+      hdr.numsects:=SwapEndian(hdr.numsects);
+      hdr.timestamp:=SwapEndian(hdr.timestamp);
+      hdr.symtableptr:=SwapEndian(hdr.symtableptr);
+      hdr.symnum:=SwapEndian(hdr.symnum);
+      hdr.opthdrsize:=SwapEndian(hdr.opthdrsize);
+      hdr.characteristics:=SwapEndian(hdr.characteristics);
+    end;
+
   if hdr.opthdrsize>0 then
     aStream.Seek(hdr.opthdrsize,soFromCurrent);
   Result:=true;
@@ -115,17 +130,18 @@ begin
   begin
     aStream.ReadBuffer(hdr,sizeof(hdr));
 
-    {$IFDEF ENDIAN_BIG}
-    hdr.VirtualSize:=SwapEndian(hdr.VirtualSize);
-    hdr.VirtualAddress:=SwapEndian(hdr.VirtualAddress);
-    hdr.SizeOfRawData:=SwapEndian(hdr.SizeOfRawData);
-    hdr.PointerToRawData:=SwapEndian(hdr.PointerToRawData);
-    hdr.PointerToRelocations:=SwapEndian(hdr.PointerToRelocations);
-    hdr.PointerToLineNumbers:=SwapEndian(hdr.PointerToLineNumbers);
-    hdr.NumberOfRelocations:=SwapEndian(hdr.NumberOfRelocations);
-    hdr.NumberOfLineNumbers:=SwapEndian(hdr.NumberOfLineNumbers);
-    hdr.Characteristics:=SwapEndian(hdr.Characteristics);
-    {$ENDIF}
+    if fOppositeEndianess then
+      begin
+        hdr.VirtualSize:=SwapEndian(hdr.VirtualSize);
+        hdr.VirtualAddress:=SwapEndian(hdr.VirtualAddress);
+        hdr.SizeOfRawData:=SwapEndian(hdr.SizeOfRawData);
+        hdr.PointerToRawData:=SwapEndian(hdr.PointerToRawData);
+        hdr.PointerToRelocations:=SwapEndian(hdr.PointerToRelocations);
+        hdr.PointerToLineNumbers:=SwapEndian(hdr.PointerToLineNumbers);
+        hdr.NumberOfRelocations:=SwapEndian(hdr.NumberOfRelocations);
+        hdr.NumberOfLineNumbers:=SwapEndian(hdr.NumberOfLineNumbers);
+        hdr.Characteristics:=SwapEndian(hdr.Characteristics);
+      end;
 
     if CheckRsrcName(hdr.Name) then
     begin
@@ -150,14 +166,15 @@ var table : TResDirTable;
     i : integer;
 begin
   aStream.ReadBuffer(table,sizeof(table));
-  {$IFDEF ENDIAN_BIG}
-  table.Characteristics:=SwapEndian(table.Characteristics);
-  table.TimeStamp:=SwapEndian(table.TimeStamp);
-  table.VerMajor:=SwapEndian(table.VerMajor);
-  table.VerMinor:=SwapEndian(table.VerMinor);
-  table.NamedEntriesCount:=SwapEndian(table.NamedEntriesCount);
-  table.IDEntriesCount:=SwapEndian(table.IDEntriesCount);
-  {$ENDIF}
+  if fOppositeEndianess then
+    begin
+      table.Characteristics:=SwapEndian(table.Characteristics);
+      table.TimeStamp:=SwapEndian(table.TimeStamp);
+      table.VerMajor:=SwapEndian(table.VerMajor);
+      table.VerMinor:=SwapEndian(table.VerMinor);
+      table.NamedEntriesCount:=SwapEndian(table.NamedEntriesCount);
+      table.IDEntriesCount:=SwapEndian(table.IDEntriesCount);
+    end;
 
   for i:=1 to table.NamedEntriesCount do
     ReadNodeDirEntry(aStream,aNode,aResources);
@@ -174,10 +191,11 @@ var entry : TResDirEntry;
 begin
   aStream.ReadBuffer(entry,sizeof(entry));
   oldpos:=aStream.Position;
-  {$IFDEF ENDIAN_BIG}
-  entry.NameID:=SwapEndian(entry.NameID);
-  entry.DataSubDirRVA:=SwapEndian(entry.DataSubDirRVA);
-  {$ENDIF}
+  if fOppositeEndianess then
+    begin
+      entry.NameID:=SwapEndian(entry.NameID);
+      entry.DataSubDirRVA:=SwapEndian(entry.DataSubDirRVA);
+    end;
 
   desc:=TResourceDesc.Create;
   try
@@ -213,17 +231,15 @@ begin
   aStream.Position:=fResSectStart+aRVA;
 
   aStream.ReadBuffer(w,2);
-  {$IFDEF ENDIAN_BIG}
-  w:=SwapEndian(w);
-  {$ENDIF}
+  if fOppositeEndianess then
+    w:=SwapEndian(w);
   setlength(ws,w);
 
   for i:=1 to length(ws) do
   begin
     aStream.ReadBuffer(w,2);
-    {$IFDEF ENDIAN_BIG}
-    w:=SwapEndian(w);
-    {$ENDIF}
+    if fOppositeEndianess then
+      w:=SwapEndian(w);
     ws[i]:=widechar(w);
   end;
   aStream.Position:=oldpos;
@@ -237,12 +253,13 @@ var entry : TResDataEntry;
     RawData : TResourceDataStream;
 begin
   aStream.ReadBuffer(entry,sizeof(entry));
-  {$IFDEF ENDIAN_BIG}
-  entry.DataRVA:=SwapEndian(entry.DataRVA);
-  entry.Size:=SwapEndian(entry.Size);
-  entry.Codepage:=SwapEndian(entry.Codepage);
-  entry.Reserved:=SwapEndian(entry.Reserved);
-  {$ENDIF}
+  if fOppositeEndianess then
+    begin
+      entry.DataRVA:=SwapEndian(entry.DataRVA);
+      entry.Size:=SwapEndian(entry.Size);
+      entry.Codepage:=SwapEndian(entry.Codepage);
+      entry.Reserved:=SwapEndian(entry.Reserved);
+    end;
 
   res:=aNode.CreateResource;
   if res=nil then
@@ -294,6 +311,7 @@ begin
   FillByte(fResSectHeader,sizeof(fResSectHeader),0);
   fRoot:=nil;
   fMachineType:=cmti386;
+  fOppositeEndianess:=false;
 end;
 
 destructor TCoffResourceReader.Destroy;

packages/fcl-res/src/cofftypes.pp

@@ -20,7 +20,7 @@ unit cofftypes;
 interface
 
 type
-  TCoffMachineType = (cmti386, cmtarm, cmtx8664);
+  TCoffMachineType = (cmti386, cmtarm, cmtx8664, cmtppc32aix, cmtppc64aix);
 
 type
   TSectionName = array [0..7] of char;
@@ -52,13 +52,49 @@ type
     Characteristics : longword;
   end;
 
-  TCoffSectionTable = packed record
-    Name : TSectionName;
-    Value : longword;
-    SectionNumber : word;
-    _type : word;
-    StorageClass : byte;
-    NumAuxSymbol : byte;
+  TXCoff32SectionHeader = packed record
+    s_name : TSectionName;
+    s_paddr : longword;
+    s_vaddr : longword;
+    s_size : longword;
+    s_scnptr : longword;
+    s_relptr : longword;
+    s_lnnoptr : longword;
+    s_nreloc : word;
+    s_nlnno : word;
+    s_flags : longword
+  end;
+
+  TCoffSymtableEntry = packed record
+    case byte of
+      1: (
+            Name : TSectionName;
+            Value : longword;
+            SectionNumber : word;
+            _type : word;
+            StorageClass : byte;
+            NumAuxSymbol : byte;
+         );
+      { AIX names }
+      2: (
+            n_name : TSectionName;
+            n_value : longword;
+            n_scnum : word;
+            n_type : word;
+            n_sclass : byte;
+            n_numaux : byte;
+         );
+  end;
+  TCoffSectionTable = TCoffSymtableEntry;
+
+  TXCoffAuxSymbol32 = packed record
+    x_scnlen: longword;
+    x_parmhash: longword;
+    x_snhash: word;
+    x_smtyp: byte;
+    x_smclas: byte;
+    x_stab: longword;
+    x_snstab: word;
   end;
 
   TResDirTable = packed record

packages/fcl-res/src/coffwriter.pp

@@ -24,6 +24,18 @@ uses
 
 type
 
+  { TCoffStringTable }
+
+  TCoffStringTable = class(TStringList)
+   private
+    fSize: ptruint;
+   public
+    constructor Create;
+    function Add(const S: string): Integer; override;
+    procedure Delete(Index: Integer); override;
+    property Size: ptruint read fSize;
+  end;
+
   { TResourceStringTable }
 
   TResourceStringTable = class
@@ -58,19 +70,22 @@ type
 
   TCoffRelocations = class
   private
+    fMachineType: TCoffMachineType;
     fList : TFPList;
     fStartAddress : longword;
   protected
     function GetCount : integer;
     function GetRelocation(index : integer) : PCoffRelocation;
   public
-    constructor Create;
+    constructor Create(aMachineType: TCoffMachineType);
     destructor Destroy; override;
-    procedure Add(aAddress : longword; aType : word);
+    procedure Add(aAddress : longword; aType : word; aSymTableIndex: longword);
+    procedure AddRelativeToSection(aAddress : longword; aSectSymTableIndex: longword);
     procedure Clear;
     property Count : integer read GetCount;
     property Items[index : integer] : PCoffRelocation read GetRelocation; default;
     property StartAddress : longword read fStartAddress write fStartAddress;
+    property MachineType : TCoffMachineType read fMachineType write fMachineType;
   end;
 
   { TCoffResourceWriter }
@@ -79,48 +94,78 @@ type
   private
     fExtensions : string;
     fDescription : string;
-    fRoot : TRootResTreeNode;
     fResStringTable : TResourceStringTable;
-    fResDataEntryCurrentRVA : longword;
-    fRelocations : TCoffRelocations;
-    fSymTablePtr : longword;
     fMachineType : TCoffMachineType;
+    procedure SetDefaultTarget;
     procedure AlignDword(aStream : TStream);
     function NextAlignedDword(aValue : longword) : longword;
     procedure SetNodeStringRVA(aNode : TResourceTreeNode);
-    function PrescanNode(aNode : TResourceTreeNode) : longword;
-    procedure PrescanResourceTree;
-    procedure WriteEmptyCoffHeader(aStream : TStream);
-    procedure WriteEmptySectionHeader(aStream : TStream);
     procedure WriteResDirTables(aStream : TStream);
     procedure WriteNodeTables(aStream : TStream; aNode : TResourceTreeNode);
     procedure WriteNodeDirEntry(aStream : TStream; aNode : TResourceTreeNode);
-    procedure WriteResStringTable(aStream : TStream);
     procedure WriteResString(aStream : TStream; TheString : string);
     procedure WriteResDataEntries(aStream : TStream);
     procedure WriteResDataEntry(aStream : TStream; aNode : TResourceTreeNode);
-    procedure WriteRawData(aStream : TStream);
     procedure WriteNodeRawData(aStream : TStream; aNode : TResourceTreeNode);
-    procedure WriteRelocations(aStream : TStream);
     procedure WriteRelocation(aStream : TStream; aRelocation : PCoffRelocation);
-    procedure WriteSymbolTable(aStream : TStream);
-    procedure WriteEmptyCoffStringTable(aStream : TStream);
-    procedure FixCoffHeader(aStream : TStream);
-    procedure FixSectionHeader(aStream : TStream);
+    procedure SetMachineType(AValue: TCoffMachineType);
   protected
+    fRoot : TRootResTreeNode;
+    fRelocations : TCoffRelocations;
+    fResDataSectionSymIdx,
+    fResHandlesSectionSymIdx : word;
+    fResDataEntryCurrentRVA : longword;
+    fSymTablePtr : longword;
+    fStringTable: TCoffStringTable;
+    fNumSymtableEntries: longword;
+    fSymStorageClass: byte;
+    fOppositeEndianess : boolean;
+    procedure WriteEmptyCoffHeader(aStream : TStream);
+    procedure WriteEmptySectionHeader(aStream : TStream); virtual;
+    procedure WriteResStringTable(aStream : TStream); virtual;
+    procedure WriteRawData(aStream : TStream);
+    procedure WriteRelocations(aStream : TStream);
+    procedure WriteCoffStringTable(aStream : TStream);
+    function GetFixedCoffHeader:TCoffHeader; virtual;
+    procedure FixCoffHeader(aStream : TStream);
+    procedure FixSectionHeader(aStream : TStream; aResources : TResources); virtual;
     function GetExtensions : string; override;
     function GetDescription : string; override;
+    function PrescanNode(aNode : TResourceTreeNode; aNodeSize : longword) : longword; virtual;
+    procedure PrescanResourceTree; virtual;
     procedure Write(aResources : TResources; aStream : TStream); override;
+    procedure WriteSymbolTable(aStream : TStream; aResources : TResources); virtual;
   public
     constructor Create; override;
     destructor Destroy; override;
-    property MachineType : TCoffMachineType read fMachineType write fMachineType;
+    property MachineType : TCoffMachineType read fMachineType write SetMachineType;
+    property OppositeEndianess : boolean read fOppositeEndianess write fOppositeEndianess;
   end;
 
 implementation
 
 uses coffconsts;
 
+{ TCoffStringTable }
+
+constructor TCoffStringTable.Create;
+  begin
+    fSize:=4;
+    Duplicates:=dupIgnore;
+  end;
+
+function TCoffStringTable.Add(const S: string): Integer;
+  begin
+    Result:=inherited Add(S);
+    inc(fSize,length(S)+1);
+  end;
+
+procedure TCoffStringTable.Delete(Index: Integer);
+begin
+  dec(fSize,length(Get(Index))+1);
+  inherited Delete(Index);
+end;
+
 (* Utility function to calculate the timestamp *)
 (*
 function DateTimeToTimeT(aDate : TDateTime) : longint;
@@ -136,6 +181,30 @@ end;
 
 { TCoffResourceWriter }
 
+procedure TCoffResourceWriter.SetDefaultTarget;
+begin
+  fMachineType:=cmti386; //default
+  fSymStorageClass:=IMAGE_SYM_CLASS_STATIC;
+  {$IFDEF CPUX86_64}
+  fMachineType:=cmtx8664;
+  fSymStorageClass:=IMAGE_SYM_CLASS_STATIC;
+  {$ENDIF}
+  {$IFDEF CPUARM}
+  fMachineType:=cmtarm;
+  fSymStorageClass:=IMAGE_SYM_CLASS_STATIC;
+  {$ENDIF}
+  {$IFDEF CPUPOWERPC32}
+  fMachineType:=cmtppc32aix;
+  fSymStorageClass:=IMAGE_SYM_CLASS_HIDEXT;
+  {$ENDIF}
+  {$IFDEF CPUPOWERPC64}
+  fMachineType:=cmtppc64aix;
+  fSymStorageClass:=IMAGE_SYM_CLASS_HIDEXT;
+  {$ENDIF}
+
+  fOppositeEndianess:=false;
+end;
+
 procedure TCoffResourceWriter.AlignDword(aStream: TStream);
 var topad : integer;
     lw : longword;
@@ -177,14 +246,15 @@ begin
   table.VerMinor:=0;
   table.NamedEntriesCount:=aNode.NamedCount;
   table.IDEntriesCount:=aNode.IDCount;
-  {$IFDEF ENDIAN_BIG}
-  table.Characteristics:=SwapEndian(table.Characteristics);
-  table.TimeStamp:=SwapEndian(table.TimeStamp);
-  table.VerMajor:=SwapEndian(table.VerMajor);
-  table.VerMinor:=SwapEndian(table.VerMinor);
-  table.NamedEntriesCount:=SwapEndian(table.NamedEntriesCount);
-  table.IDEntriesCount:=SwapEndian(table.IDEntriesCount);
-  {$ENDIF}
+  if OppositeEndianess then
+    begin
+      table.Characteristics:=SwapEndian(table.Characteristics);
+      table.TimeStamp:=SwapEndian(table.TimeStamp);
+      table.VerMajor:=SwapEndian(table.VerMajor);
+      table.VerMinor:=SwapEndian(table.VerMinor);
+      table.NamedEntriesCount:=SwapEndian(table.NamedEntriesCount);
+      table.IDEntriesCount:=SwapEndian(table.IDEntriesCount);
+    end;
   aStream.WriteBuffer(table,sizeof(Table));
 
   for i:=0 to aNode.NamedCount-1 do
@@ -211,19 +281,15 @@ begin
   begin
     entry.DataSubDirRVA:=fResDataEntryCurrentRVA;
     inc(fResDataEntryCurrentRVA,sizeof(TResDataEntry));
-    case fMachineType of
-      cmti386  : reloctype:=IMAGE_REL_I386_DIR32NB;
-      cmtarm   : reloctype:=IMAGE_REL_ARM_ADDR32NB;
-      cmtx8664 : reloctype:=IMAGE_REL_AMD64_ADDR32NB;
-    end;
-    fRelocations.Add(entry.DataSubDirRVA,reloctype);
+    fRelocations.AddRelativeToSection(entry.DataSubDirRVA,fResDataSectionSymIdx);
   end
   else entry.DataSubDirRVA:=aNode.SubDirRVA or $80000000;
 
-  {$IFDEF ENDIAN_BIG}
-  entry.NameID:=SwapEndian(entry.NameID);
-  entry.DataSubDirRVA:=SwapEndian(entry.DataSubDirRVA);
-  {$ENDIF}
+  if OppositeEndianess then
+    begin
+      entry.NameID:=SwapEndian(entry.NameID);
+      entry.DataSubDirRVA:=SwapEndian(entry.DataSubDirRVA);
+    end;
   aStream.WriteBuffer(entry,sizeof(entry));
 end;
 
@@ -250,17 +316,15 @@ var ws : widestring;
     i : integer;
 begin
   w:=length(thestring);
-  {$IFDEF ENDIAN_BIG}
-  w:=SwapEndian(w);
-  {$ENDIF}
+  if OppositeEndianess then
+    w:=SwapEndian(w);
   aStream.WriteBuffer(w,2);
   ws:=TheString;
   for i:=1 to length(ws) do
   begin
     w:=word(ws[i]);
-    {$IFDEF ENDIAN_BIG}
-    w:=SwapEndian(w);
-    {$ENDIF}
+    if OppositeEndianess then
+      w:=SwapEndian(w);
     aStream.WriteBuffer(w,2);
   end;
 end;
@@ -286,12 +350,13 @@ begin
     entry.Reserved:=0;
     inc(fResDataEntryCurrentRVA,entry.Size);
     fResDataEntryCurrentRVA:=NextAlignedDword(fResDataEntryCurrentRVA);
-    {$IFDEF ENDIAN_BIG}
-    entry.DataRVA:=SwapEndian(entry.DataRVA);
-    entry.Size:=SwapEndian(entry.Size);
-    entry.Codepage:=SwapEndian(entry.Codepage);
-    entry.Reserved:=SwapEndian(entry.Reserved);
-    {$ENDIF}
+    if OppositeEndianess then
+      begin
+        entry.DataRVA:=SwapEndian(entry.DataRVA);
+        entry.Size:=SwapEndian(entry.Size);
+        entry.Codepage:=SwapEndian(entry.Codepage);
+        entry.Reserved:=SwapEndian(entry.Reserved);
+      end;
     aStream.WriteBuffer(entry,sizeof(entry));
   end;
   for i:=0 to aNode.NamedCount-1 do
@@ -336,42 +401,65 @@ procedure TCoffResourceWriter.WriteRelocation(aStream: TStream;
 var r : TCoffRelocation;
 begin
   r:=aRelocation^;
-  {$IFDEF ENDIAN_BIG}
-  r.VirtualAddress:=SwapEndian(r.VirtualAddress);
-  r.SymTableIndex:=SwapEndian(r.SymTableIndex);
-  r._type:=SwapEndian(r._type);;
-  {$ENDIF}
+  if OppositeEndianess then
+    begin
+      r.VirtualAddress:=SwapEndian(r.VirtualAddress);
+      r.SymTableIndex:=SwapEndian(r.SymTableIndex);
+      r._type:=SwapEndian(r._type);
+    end;
   aStream.WriteBuffer(r,sizeof(r));
 end;
 
-procedure TCoffResourceWriter.WriteSymbolTable(aStream: TStream);
-var st : TCoffSectionTable;
+procedure TCoffResourceWriter.WriteSymbolTable(aStream: TStream; aResources : TResources);
+var
+  st : TCoffSectionTable;
+  aux : TXCoffAuxSymbol32;
+  offs : dword;
 begin
   fSymTablePtr:=aStream.Position;
   st.Name:=RSRCSectName;
   st.Value:=0;
   st.SectionNumber:=1;
   st._type:=0;
-  st.StorageClass:=IMAGE_SYM_CLASS_STATIC;
-  st.NumAuxSymbol:=0;
-  {$IFDEF ENDIAN_BIG}
-  st.Value:=SwapEndian(st.Value);
-  st.SectionNumber:=SwapEndian(st.SectionNumber);
-  st._type:=SwapEndian(st._type);
-  st.StorageClass:=SwapEndian(st.StorageClass);
-  st.NumAuxSymbol:=SwapEndian(st.NumAuxSymbol);
-  {$ENDIF}
+  st.StorageClass:=fSymStorageClass;
+  if OppositeEndianess then
+    begin
+      st.Value:=SwapEndian(st.Value);
+      st.SectionNumber:=SwapEndian(st.SectionNumber);
+      st._type:=SwapEndian(st._type);
+    end;
   aStream.WriteBuffer(st,sizeof(st));
+  inc(fNumSymtableEntries);
 end;
 
-procedure TCoffResourceWriter.WriteEmptyCoffStringTable(aStream : TStream);
-var lw : longword;
+procedure TCoffResourceWriter.WriteCoffStringTable(aStream : TStream);
+var
+  lw : longword;
+  i : longint;
 begin
-  lw:=4;
-  {$IFDEF ENDIAN_BIG}
-  lw:=SwapEndian(lw);
-  {$ENDIF}
+  lw:=fStringTable.Size;
+  if OppositeEndianess then
+    lw:=SwapEndian(lw);
   aStream.WriteBuffer(lw,4);
+  for i:=0 to fStringTable.Count-1 do
+    aStream.WriteBuffer(fStringTable[i][1],length(fStringTable[i])+1);
+end;
+
+function TCoffResourceWriter.GetFixedCoffHeader: TCoffHeader;
+begin
+  case fMachineType of
+    cmti386     : Result.machine:=IMAGE_FILE_MACHINE_I386;
+    cmtarm      : Result.machine:=IMAGE_FILE_MACHINE_ARM;
+    cmtx8664    : Result.machine:=IMAGE_FILE_MACHINE_AMD64;
+    cmtppc32aix : Result.machine:=IMAGE_FILE_MACHINE_POWERPC32_AIX;
+    cmtppc64aix : Result.machine:=IMAGE_FILE_MACHINE_POWERPC64_AIX;
+  end;
+  Result.numsects:=1;
+  Result.timestamp:=0; //DateTimeToTimeT(now);   //we need a crossplatform way to have it UTC
+  Result.symtableptr:=fSymTablePtr;
+  Result.symnum:=fNumSymtableEntries;
+  Result.opthdrsize:=0;
+  Result.characteristics:=IMAGE_FILE_32BIT_MACHINE or IMAGE_FILE_LINE_NUMS_STRIPPED;
 end;
 
 procedure TCoffResourceWriter.FixCoffHeader(aStream: TStream);
@@ -382,33 +470,24 @@ begin
   oldpos:=aStream.Position;
   aStream.Position:=0;
 
-  case fMachineType of
-    cmti386  : hdr.machine:=IMAGE_FILE_MACHINE_I386;
-    cmtarm   : hdr.machine:=IMAGE_FILE_MACHINE_ARM;
-    cmtx8664 : hdr.machine:=IMAGE_FILE_MACHINE_AMD64;
-  end;
-  hdr.numsects:=1;
-  hdr.timestamp:=0; //DateTimeToTimeT(now);   //we need a crossplatform way to have it UTC
-  hdr.symtableptr:=fSymTablePtr;
-  hdr.symnum:=1;
-  hdr.opthdrsize:=0;
-  hdr.characteristics:=IMAGE_FILE_32BIT_MACHINE or IMAGE_FILE_LINE_NUMS_STRIPPED;
-  {$IFDEF ENDIAN_BIG}
-  hdr.machine:=SwapEndian(hdr.machine);
-  hdr.numsects:=SwapEndian(hdr.numsects);
-  hdr.timestamp:=SwapEndian(hdr.timestamp);
-  hdr.symtableptr:=SwapEndian(hdr.symtableptr);
-  hdr.symnum:=SwapEndian(hdr.symnum);
-  hdr.opthdrsize:=SwapEndian(hdr.opthdrsize);
-  hdr.characteristics:=SwapEndian(hdr.characteristics);
-  {$ENDIF}
+  hdr:=GetFixedCoffHeader;
+  if OppositeEndianess then
+    begin
+      hdr.machine:=SwapEndian(hdr.machine);
+      hdr.numsects:=SwapEndian(hdr.numsects);
+      hdr.timestamp:=SwapEndian(hdr.timestamp);
+      hdr.symtableptr:=SwapEndian(hdr.symtableptr);
+      hdr.symnum:=SwapEndian(hdr.symnum);
+      hdr.opthdrsize:=SwapEndian(hdr.opthdrsize);
+      hdr.characteristics:=SwapEndian(hdr.characteristics);
+    end;
   aStream.WriteBuffer(hdr,sizeof(hdr));
   
   aStream.Position:=oldpos;
 
 end;
 
-procedure TCoffResourceWriter.FixSectionHeader(aStream : TStream);
+procedure TCoffResourceWriter.FixSectionHeader(aStream : TStream; aResources: TResources);
 var hdr : TCoffSectionHeader;
     oldpos : int64;
 begin
@@ -426,22 +505,45 @@ begin
   hdr.NumberOfLineNumbers:=0;
   hdr.Characteristics:=IMAGE_SCN_CNT_INITIALIZED_DATA or IMAGE_SCN_MEM_READ or
                        IMAGE_SCN_MEM_WRITE;
-  {$IFDEF ENDIAN_BIG}
-  hdr.VirtualSize:=SwapEndian(hdr.VirtualSize);
-  hdr.VirtualAddress:=SwapEndian(hdr.VirtualAddress);
-  hdr.SizeOfRawData:=SwapEndian(hdr.SizeOfRawData);
-  hdr.PointerToRawData:=SwapEndian(hdr.PointerToRawData);
-  hdr.PointerToRelocations:=SwapEndian(hdr.PointerToRelocations);
-  hdr.PointerToLineNumbers:=SwapEndian(hdr.PointerToLineNumbers);
-  hdr.NumberOfRelocations:=SwapEndian(hdr.NumberOfRelocations);
-  hdr.NumberOfLineNumbers:=SwapEndian(hdr.NumberOfLineNumbers);
-  hdr.Characteristics:=SwapEndian(hdr.Characteristics);
-  {$ENDIF}
+  if OppositeEndianess then
+    begin
+      hdr.VirtualSize:=SwapEndian(hdr.VirtualSize);
+      hdr.VirtualAddress:=SwapEndian(hdr.VirtualAddress);
+      hdr.SizeOfRawData:=SwapEndian(hdr.SizeOfRawData);
+      hdr.PointerToRawData:=SwapEndian(hdr.PointerToRawData);
+      hdr.PointerToRelocations:=SwapEndian(hdr.PointerToRelocations);
+      hdr.PointerToLineNumbers:=SwapEndian(hdr.PointerToLineNumbers);
+      hdr.NumberOfRelocations:=SwapEndian(hdr.NumberOfRelocations);
+      hdr.NumberOfLineNumbers:=SwapEndian(hdr.NumberOfLineNumbers);
+      hdr.Characteristics:=SwapEndian(hdr.Characteristics);
+    end;
   aStream.WriteBuffer(hdr,sizeof(hdr));
 
   aStream.Position:=oldpos;
 end;
 
+procedure TCoffResourceWriter.SetMachineType(AValue: TCoffMachineType);
+begin
+  fMachineType:=AValue;
+{$IFDEF ENDIAN_BIG}
+  if fMachineType in [cmti386,cmtx8664,cmtarm] then
+    fOppositeEndianess:=true;
+{$ELSE}
+  if fMachineType in [cmtppc32aix,cmtppc64aix] then
+    fOppositeEndianess:=true;
+{$ENDIF}
+  case fMachineType of
+    cmti386,
+    cmtx8664,
+    cmtarm:
+      fSymStorageClass:=IMAGE_SYM_CLASS_STATIC;
+    cmtppc32aix,
+    cmtppc64aix:
+      fSymStorageClass:=IMAGE_SYM_CLASS_HIDEXT;
+  end;
+  fRelocations.MachineType:=fMachineType;
+end;
+
 function TCoffResourceWriter.GetExtensions: string;
 begin
   Result:=fExtensions;
@@ -467,8 +569,7 @@ begin
   fResStringTable.Add(aNode.Desc.Name);
 end;
 
-function TCoffResourceWriter.PrescanNode(aNode: TResourceTreeNode
-  ): longword;
+function TCoffResourceWriter.PrescanNode(aNode: TResourceTreeNode; aNodeSize : longword): longword;
 var i : integer;
     currva : longword;
     subnode : TResourceTreeNode;
@@ -486,13 +587,13 @@ begin
   begin
     subnode:=aNode.NamedEntries[i];
     subnode.SubDirRVA:=currva;
-    currva:=PrescanNode(subnode);
+    currva:=PrescanNode(subnode,0);
   end;
   for i:=0 to aNode.IDCount-1 do
   begin
     subnode:=aNode.IDEntries[i];
     subnode.SubDirRVA:=currva;
-    currva:=PrescanNode(subnode);
+    currva:=PrescanNode(subnode,0);
   end;
   Result:=currva;
 end;
@@ -501,7 +602,7 @@ procedure TCoffResourceWriter.PrescanResourceTree;
 begin
   fRoot.SubDirRVA:=0;
   fResStringTable.Clear;
-  fResStringTable.StartRVA:=PrescanNode(fRoot);
+  fResStringTable.StartRVA:=PrescanNode(fRoot,0);
 end;
 
 procedure TCoffResourceWriter.Write(aResources: TResources; aStream: TStream);
@@ -515,28 +616,33 @@ begin
   WriteResDataEntries(aStream);
   WriteRawData(aStream);
   WriteRelocations(aStream);
-  WriteSymbolTable(aStream);
-  WriteEmptyCoffStringTable(aStream);
+  WriteSymbolTable(aStream,aResources);
+  WriteCoffStringTable(aStream);
   FixCoffHeader(aStream);
-  FixSectionHeader(aStream);
+  FixSectionHeader(aStream,aResources);
 end;
 
 constructor TCoffResourceWriter.Create;
 begin
   fExtensions:='.o .obj';
   fDescription:='COFF resource writer';
-  fMachineType:=cmti386;
+  SetDefaultTarget;
   fRoot:=nil;
   fResStringTable:=TResourceStringTable.Create;
   fResDataEntryCurrentRVA:=0;
   fSymTablePtr:=0;
-  fRelocations:=TCoffRelocations.Create;
+  fRelocations:=TCoffRelocations.Create(fMachineType);
+  fStringTable:=TCoffStringTable.Create;
+  fResDataSectionSymIdx:=0;
+  // unused for win32
+  fResHandlesSectionSymIdx:=word(low(smallint));
 end;
 
 destructor TCoffResourceWriter.Destroy;
 begin
   fResStringTable.Free;
   fRelocations.Free;
+  fStringTable.Free;
 end;
 
 { TResourceStringTable }
@@ -600,9 +706,10 @@ begin
   Result:=PCoffRelocation(fList[index]);
 end;
 
-constructor TCoffRelocations.Create;
+constructor TCoffRelocations.Create(aMachineType: TCoffMachineType);
 begin
   fList:=TFPList.Create;
+  fMachineType:=aMachineType;
   fStartAddress:=0;
 end;
 
@@ -612,16 +719,29 @@ begin
   fList.Free;
 end;
 
-procedure TCoffRelocations.Add(aAddress: longword; aType: word);
+procedure TCoffRelocations.Add(aAddress : longword; aType : word; aSymTableIndex: longword);
 var p : PCoffRelocation;
 begin
   p:=GetMem(sizeof(TCoffRelocation));
   p^.VirtualAddress:=aAddress;
-  p^.SymTableIndex:=0;
+  p^.SymTableIndex:=aSymTableIndex;
   p^._type:=aType;
   fList.Add(p);
 end;
 
+procedure TCoffRelocations.AddRelativeToSection(aAddress : longword; aSectSymTableIndex: longword);
+var reloctype: word;
+begin
+  case fMachineType of
+    cmti386     : reloctype:=IMAGE_REL_I386_DIR32NB;
+    cmtarm      : reloctype:=IMAGE_REL_ARM_ADDR32NB;
+    cmtx8664    : reloctype:=IMAGE_REL_AMD64_ADDR32NB;
+    cmtppc32aix : reloctype:=IMAGE_REL_PPC_POS;
+    cmtppc64aix : reloctype:=IMAGE_REL_PPC_POS;
+  end;
+  Add(aAddress,reloctype,aSectSymTableIndex);
+end;
+
 procedure TCoffRelocations.Clear;
 var i : integer;
 begin

packages/fcl-res/src/xcoffwriter.pp

@@ -0,0 +1,401 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2008 by Giulio Bernardi
+
+    Resource writer for COFF files
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit xcoffwriter;
+
+{$MODE OBJFPC} {$H+}
+
+interface
+
+uses
+  Classes, SysUtils, strtable, resource, resourcetree, cofftypes, coffwriter;
+
+type
+  { TXCoffResourceWriter }
+
+  TXCoffResourceWriter = class (TCoffResourceWriter)
+  protected
+    fResStrTable : TResStringTable;
+    fCurOfs : longword;
+    fDataAlignment : integer;
+    function NextAligned(aBound, aValue : longword) : longword;
+    procedure Align(aBound : integer; aStream : TStream);
+    function GetFixedCoffHeader: TCoffHeader; override;
+    procedure WriteEmptySectionHeader(aStream: TStream); override;
+    procedure FixSectionHeader(aStream : TStream; aResources : TResources); override;
+    function PrescanNode(aNode: TResourceTreeNode; aNodeSize : longword): longword; override;
+    procedure PrescanResourceTree; override;
+    procedure WriteNodeInfos(aStream: TStream);
+    procedure WriteNodeInfo(aStream: TStream; aNode: TResourceTreeNode);
+    procedure WriteSubNodes(aStream : TStream; aNode : TResourceTreeNode);
+    procedure WriteResStringTable(aStream: TStream); override;
+    procedure WriteDataSymbol(aStream: TStream; const name: String; aStorageClass, aAuxStorageType: byte; aSecNum, aSecOffset, aSize: qword);
+    procedure WriteSymbolTable(aStream : TStream; aResources : TResources); override;
+    procedure WriteResHeader(aStream : TStream; aResources : TResources);
+    procedure Write(aResources : TResources; aStream : TStream); override;
+  public
+    constructor Create; override;
+    destructor Destroy; override;
+  end;
+
+implementation
+
+uses coffconsts,fpcrestypes;
+
+type
+  // Todo: 64 bit
+  _ptrtype_ = longword;
+  _TResHdr_ = TResHdr32;
+  _TResInfoNode_ = TResInfoNode32;
+
+
+{ much of the code below is (almost) identical to the code in the Elf and
+  Mach-O writers (they already duplicated lots of stuff). Todo: consolidate.
+}
+
+{ TXCoffResourceWriter }
+
+function TXCoffResourceWriter.NextAligned(aBound, aValue : longword) : longword;
+var topad : longword;
+begin
+  Result:=aValue;
+  topad:=aBound-(aValue mod aBound);
+  if topad<>aBound then inc(Result,topad);
+end;
+
+procedure TXCoffResourceWriter.Align(aBound: integer; aStream: TStream);
+var topad,tmp : integer;
+    qw : qword;
+begin
+  qw:=0;
+  topad:=aBound-(aStream.Position mod aBound);
+  if topad<>aBound then
+    while topad>0 do
+    begin
+      if topad>8 then tmp:=8 else tmp:=topad;
+      aStream.WriteBuffer(qw,tmp);
+      dec(topad,tmp);
+    end;
+end;
+
+function TXCoffResourceWriter.GetFixedCoffHeader: TCoffHeader;
+begin
+  Result:=inherited GetFixedCoffHeader;
+  { we also have a BSS section }
+  Result.NumSects:=2;
+end;
+
+procedure TXCoffResourceWriter.WriteEmptySectionHeader(aStream: TStream);
+// Todo: 64 bit
+var hdr : TXCoff32SectionHeader;
+begin
+  FillByte(hdr,sizeof(hdr),0);
+  { .data }
+  aStream.WriteBuffer(hdr,sizeof(hdr));
+  { .bss }
+  aStream.WriteBuffer(hdr,sizeof(hdr));
+end;
+
+procedure TXCoffResourceWriter.FixSectionHeader(aStream: TStream; aResources: TResources);
+// Todo: 64 bit
+var hdr : TXCoff32SectionHeader;
+    oldpos : int64;
+begin
+  oldpos:=aStream.Position;
+  aStream.Position:=sizeof(TCoffHeader);
+
+  { initialized data }
+  hdr.s_name:='.data'#0#0#0;
+  hdr.s_paddr:=0;
+  hdr.s_vaddr:=0;
+  hdr.s_size:=fResDataEntryCurrentRVA;
+  hdr.s_scnptr:=sizeof(TCoffHeader)+2*sizeof(TCoffSectionHeader);
+  hdr.s_relptr:=fRelocations.StartAddress;
+  hdr.s_lnnoptr:=0;
+  hdr.s_nreloc:=fRelocations.Count;
+  hdr.s_nlnno:=0;
+  hdr.s_flags:=STYP_DATA;
+  if OppositeEndianess then
+    begin
+      hdr.s_paddr:=SwapEndian(hdr.s_paddr);
+      hdr.s_vaddr:=SwapEndian(hdr.s_vaddr);
+      hdr.s_size:=SwapEndian(hdr.s_size);
+      hdr.s_scnptr:=SwapEndian(hdr.s_scnptr);
+      hdr.s_relptr:=SwapEndian(hdr.s_relptr);
+      hdr.s_lnnoptr:=SwapEndian(hdr.s_lnnoptr);
+      hdr.s_nreloc:=SwapEndian(hdr.s_nreloc);
+      hdr.s_nlnno:=SwapEndian(hdr.s_nlnno);
+      hdr.s_flags:=SwapEndian(hdr.s_flags);
+    end;
+  aStream.WriteBuffer(hdr,sizeof(hdr));
+
+  { uninitialized data }
+  hdr.s_name:='.bss'#0#0#0#0;
+  hdr.s_paddr:=0;
+  hdr.s_vaddr:=0;
+  hdr.s_size:=aResources.Count*sizeof(_ptrtype_);
+  hdr.s_scnptr:=0;
+  hdr.s_relptr:=0;
+  hdr.s_lnnoptr:=0;
+  hdr.s_nreloc:=0;
+  hdr.s_nlnno:=0;
+  hdr.s_flags:=STYP_BSS;
+  if OppositeEndianess then
+    begin
+      hdr.s_paddr:=SwapEndian(hdr.s_paddr);
+      hdr.s_vaddr:=SwapEndian(hdr.s_vaddr);
+      hdr.s_size:=SwapEndian(hdr.s_size);
+      hdr.s_scnptr:=SwapEndian(hdr.s_scnptr);
+      hdr.s_relptr:=SwapEndian(hdr.s_relptr);
+      hdr.s_lnnoptr:=SwapEndian(hdr.s_lnnoptr);
+      hdr.s_nreloc:=SwapEndian(hdr.s_nreloc);
+      hdr.s_nlnno:=SwapEndian(hdr.s_nlnno);
+      hdr.s_flags:=SwapEndian(hdr.s_flags);
+    end;
+  aStream.WriteBuffer(hdr,sizeof(hdr));
+
+  aStream.Position:=oldpos;
+end;
+
+function TXCoffResourceWriter.PrescanNode(aNode: TResourceTreeNode; aNodeSize : longword): longword;
+var curofs : longword;
+    i : integer;
+    subnode : TResourceTreeNode;
+begin
+  if aNode.IsLeaf then
+  begin
+    Result:=aNode.SubDirRVA;
+    exit;
+  end;
+
+  if aNode.Desc.DescType=dtName then
+    aNode.NameRVA:=fResStrTable.Add(aNode.Desc.Name);
+
+  //first node subnodes begin at curofs (after all node headers)
+  curofs:=aNode.SubDirRva+(aNode.NamedCount+aNode.IDCount)*aNodeSize;
+  for i:=0 to aNode.NamedCount-1 do
+  begin
+    subnode:=aNode.NamedEntries[i];
+    subnode.SubDirRVA:=curofs;
+    curofs:=PrescanNode(subnode,aNodeSize);
+  end;
+  for i:=0 to aNode.IDCount-1 do
+  begin
+    subnode:=aNode.IDEntries[i];
+    subnode.SubDirRVA:=curofs;
+    curofs:=PrescanNode(subnode,aNodeSize);
+  end;
+  Result:=curofs;
+end;
+
+procedure TXCoffResourceWriter.PrescanResourceTree;
+begin
+  fResStrTable.Clear;
+  fRoot.SubDirRVA:=sizeof(_TResHdr_)+sizeof(_TResInfoNode_);
+  fResStrTable.StartOfs:=PrescanNode(fRoot,sizeof(_TResInfoNode_));
+  if fResStrTable.Used then
+    fResDataEntryCurrentRVA:=NextAligned(fDataAlignment,fResStrTable.StartOfs+fResStrTable.Size)
+  else
+    fResDataEntryCurrentRVA:=fResStrTable.StartOfs;
+end;
+
+procedure TXCoffResourceWriter.WriteNodeInfos(aStream: TStream);
+begin
+  fCurOfs:=sizeof(_TResHdr_);
+  WriteNodeInfo(aStream,fRoot);
+  WriteSubNodes(aStream,fRoot);
+end;
+
+procedure TXCoffResourceWriter.WriteNodeInfo(aStream: TStream; aNode: TResourceTreeNode);
+var infonode : _TResInfoNode_;
+begin
+  if aNode.Desc.DescType=dtID then
+    infonode.nameid:=aNode.Desc.ID
+  else
+  begin
+    infonode.nameid:=fResStrTable.StartOfs+aNode.NameRVA;
+    fRelocations.AddRelativeToSection(fCurOfs,fResDataSectionSymIdx);
+  end;
+  infonode.ncount:=aNode.NamedCount;
+  if aNode.IsLeaf then
+  begin
+    infonode.idcountsize:=aNode.Data.RawData.Size;
+    infonode.subptr:=fResDataEntryCurrentRVA;
+    fResDataEntryCurrentRVA:=NextAligned(fDataAlignment,fResDataEntryCurrentRVA+infonode.idcountsize);
+  end
+  else
+  begin
+    infonode.idcountsize:=aNode.IDCount;
+    infonode.subptr:=aNode.SubDirRVA;
+  end;
+  fRelocations.AddRelativeToSection(
+    fCurOfs+sizeof(infonode.nameid)+sizeof(infonode.ncount)+
+    sizeof(infonode.idcountsize),fResDataSectionSymIdx);
+  if fOppositeEndianess then
+  begin
+    infonode.nameid:=SwapEndian(infonode.nameid);
+    infonode.ncount:=SwapEndian(infonode.ncount);
+    infonode.idcountsize:=SwapEndian(infonode.idcountsize);
+    infonode.subptr:=SwapEndian(infonode.subptr);
+  end;
+  aStream.WriteBuffer(infonode,sizeof(infonode));
+  inc(fCurOfs,sizeof(infonode));
+end;
+
+procedure TXCoffResourceWriter.WriteSubNodes(aStream: TStream; aNode: TResourceTreeNode);
+var i : integer;
+begin
+  for i:=0 to aNode.NamedCount-1 do
+    WriteNodeInfo(aStream,aNode.NamedEntries[i]);
+  for i:=0 to aNode.IDCount-1 do
+    WriteNodeInfo(aStream,aNode.IDEntries[i]);
+
+  for i:=0 to aNode.NamedCount-1 do
+    WriteSubNodes(aStream,aNode.NamedEntries[i]);
+  for i:=0 to aNode.IDCount-1 do
+    WriteSubNodes(aStream,aNode.IDEntries[i]);
+end;
+
+procedure TXCoffResourceWriter.WriteResStringTable(aStream: TStream);
+begin
+  if fResStrTable.Used then
+    fResStrTable.WriteToStream(aStream);
+  Align(fDataAlignment,aStream);
+end;
+
+procedure TXCoffResourceWriter.WriteDataSymbol(aStream: TStream; const name: String; aStorageClass, aAuxStorageType: byte; aSecNum, aSecOffset, aSize: qword);
+var
+  st : TCoffSymtableEntry;
+  aux : TXCoffAuxSymbol32;
+  offs : dword;
+begin
+  { top 4 bytes 0, lower 4 bytes = offset in string table }
+  st.n_name:=#0#0#0#0;
+  offs:=fStringTable.Size;
+  if OppositeEndianess then
+    offs:=SwapEndian(offs);
+  PDWord(@st.n_name[4])^:=offs;
+  fStringTable.Add(name);
+
+  st.n_value:=aSecOffset;
+  st.n_scnum:=aSecNum;
+  st.n_type:=0;
+  st.n_sclass:=aStorageClass;
+  st.n_numaux:=1;
+  if OppositeEndianess then
+    begin
+      st.n_value:=SwapEndian(st.n_value);
+      st.n_scnum:=SwapEndian(st.n_scnum);
+      st.n_type:=SwapEndian(st.n_type);
+    end;
+  aStream.WriteBuffer(st,sizeof(st));
+  inc(fNumSymtableEntries);
+
+  aux.x_scnlen:=aSize;
+  aux.x_parmhash:=0;
+  aux.x_snhash:=0;
+  aux.x_smtyp:=aAuxStorageType;
+  aux.x_smclas:=XMC_RW;
+  aux.x_stab:=0;
+  aux.x_snstab:=0;
+  if OppositeEndianess then
+    begin
+      aux.x_scnlen:=SwapEndian(aux.x_scnlen);
+      aux.x_parmhash:=SwapEndian(aux.x_parmhash);
+      aux.x_snhash:=SwapEndian(aux.x_snhash);
+      aux.x_stab:=SwapEndian(aux.x_stab);
+      aux.x_snstab:=SwapEndian(aux.x_snstab);
+    end;
+  aStream.WriteBuffer(aux,sizeof(aux));
+  inc(fNumSymtableEntries);
+end;
+
+procedure TXCoffResourceWriter.WriteSymbolTable(aStream: TStream; aResources : TResources);
+const
+  SECTION_DATA_ALIGNMENT = 8;
+begin
+  fSymTablePtr:=aStream.Position;
+  { if order is changed, also adapt fResDataSectionSymIdx and fResHandlesSectionSymIdx }
+
+  { initialized data }
+  WriteDataSymbol(aStream,XCoffRsrcSectName,IMAGE_SYM_CLASS_HIDEXT,SECTION_DATA_ALIGNMENT or XTY_SD,1,0,fResDataEntryCurrentRVA);
+  { create global FPC_RESSYMBOL symbol at the start of XCoffRsrcSectName
+    (for XTY_LD: "size" = symbol index of the containing csect) }
+  WriteDataSymbol(aStream,'FPC_RESSYMBOL',IMAGE_SYM_CLASS_EXT,XTY_LD,1,0,0);
+  { uninitialized data }
+  WriteDataSymbol(aStream,XCoffHandlesSectName,IMAGE_SYM_CLASS_HIDEXT,SECTION_DATA_ALIGNMENT or XTY_CM,2,0,aResources.Count*sizeof(_ptrtype_));
+end;
+
+procedure TXCoffResourceWriter.WriteResHeader(aStream: TStream; aResources: TResources);
+var hdr : _TResHdr_;
+begin
+  hdr.rootptr:=sizeof(hdr);
+  hdr.count:=aResources.Count;
+  hdr.usedhandles:=0;
+  hdr.handles:=0;
+  fRelocations.AddRelativeToSection(0,fResDataSectionSymIdx);
+  fRelocations.AddRelativeToSection(sizeof(hdr.rootptr)+sizeof(hdr.count)+sizeof(hdr.usedhandles),fResHandlesSectionSymIdx);
+  if fOppositeEndianess then
+  begin
+    hdr.rootptr:=SwapEndian(hdr.rootptr);
+    hdr.count:=SwapEndian(hdr.count);
+    // only used at run time, always 0 in object file
+//    hdr.usedhandles:=SwapEndian(hdr.usedhandles);
+    // pointer to first byte of fpc.reshandles; since it's in a separate
+    // section, this is at address 0 so we don't have to change this anymore
+    // later either (hdr.handles is not yet known at this point)
+//    hdr.handles:=SwapEndian(hdr.handles);
+  end;
+  aStream.WriteBuffer(hdr,sizeof(hdr));
+end;
+
+procedure TXCoffResourceWriter.Write(aResources: TResources; aStream: TStream);
+begin
+  WriteEmptyCoffHeader(aStream);
+  WriteEmptySectionHeader(aStream);
+  fRoot:=TRootResTreeNode(GetTree(aResources));
+  PrescanResourceTree;
+  WriteResHeader(aStream,aResources);
+  WriteNodeInfos(aStream);
+  WriteResStringTable(aStream);
+  WriteRawData(aStream);
+  WriteRelocations(aStream);
+  WriteSymbolTable(aStream,aResources);
+  WriteCoffStringTable(aStream);
+  FixCoffHeader(aStream);
+  FixSectionHeader(aStream,aResources);
+end;
+
+constructor TXCoffResourceWriter.Create;
+begin
+  inherited;
+  fResStrTable:=TResStringTable.Create;
+  fResDataSectionSymIdx:=0;
+  { skip auxilary symtable entry part of data section symbol and FPC_RESSYMBOL }
+  fResHandlesSectionSymIdx:=4;
+  // TODO: 64 bit
+  fDataAlignment:=4;
+end;
+
+destructor TXCoffResourceWriter.Destroy;
+begin
+  fResStrTable.Free;
+  inherited Destroy;
+end;
+
+initialization
+  TResources.RegisterWriter('.o',TXCoffResourceWriter);
+
+end.

utils/Makefile

@@ -409,7 +409,7 @@ ifeq ($(FULL_TARGET),powerpc-wii)
 override TARGET_DIRS+=fppkg fpcm tply h2pas fprcp dxegen fpdoc fpcmkcfg
 endif
 ifeq ($(FULL_TARGET),powerpc-aix)
-override TARGET_DIRS+=fppkg fpcm tply h2pas fprcp dxegen fpdoc fpcmkcfg
+override TARGET_DIRS+=fppkg fpcm tply h2pas fprcp dxegen fpdoc fpcmkcfg  fpcres instantfpc
 endif
 ifeq ($(FULL_TARGET),sparc-linux)
 override TARGET_DIRS+=fppkg fpcm tply h2pas fprcp dxegen fpdoc fpcmkcfg  fpcres instantfpc
@@ -478,7 +478,7 @@ ifeq ($(FULL_TARGET),powerpc64-embedded)
 override TARGET_DIRS+=fppkg fpcm tply h2pas fprcp dxegen fpdoc fpcmkcfg
 endif
 ifeq ($(FULL_TARGET),powerpc64-aix)
-override TARGET_DIRS+=fppkg fpcm tply h2pas fprcp dxegen fpdoc fpcmkcfg
+override TARGET_DIRS+=fppkg fpcm tply h2pas fprcp dxegen fpdoc fpcmkcfg  fpcres instantfpc
 endif
 ifeq ($(FULL_TARGET),avr-embedded)
 override TARGET_DIRS+=fppkg fpcm tply h2pas fprcp dxegen fpdoc fpcmkcfg
@@ -3536,6 +3536,8 @@ TARGET_DIRS_FPRCP=1
 TARGET_DIRS_DXEGEN=1
 TARGET_DIRS_FPDOC=1
 TARGET_DIRS_FPCMKCFG=1
+TARGET_DIRS_FPCRES=1
+TARGET_DIRS_INSTANTFPC=1
 endif
 ifeq ($(FULL_TARGET),sparc-linux)
 TARGET_DIRS_FPPKG=1
@@ -3801,6 +3803,8 @@ TARGET_DIRS_FPRCP=1
 TARGET_DIRS_DXEGEN=1
 TARGET_DIRS_FPDOC=1
 TARGET_DIRS_FPCMKCFG=1
+TARGET_DIRS_FPCRES=1
+TARGET_DIRS_INSTANTFPC=1
 endif
 ifeq ($(FULL_TARGET),avr-embedded)
 TARGET_DIRS_FPPKG=1

utils/Makefile.fpc

@@ -24,6 +24,7 @@ dirs_solaris=fpcres instantfpc
 dirs_os2=fpmc fpcres rmwait
 dirs_emx=fpmc fpcres rmwait
 dirs_go32v2=rmwait
+dirs_aix=fpcres instantfpc
 rsts=rstconv
 
 [require]

utils/fpcres/fpcres.pas

@@ -25,7 +25,7 @@ uses
   resreader, coffreader, winpeimagereader, elfreader, machoreader,
   externalreader, dfmreader, tlbreader,
 //writers
-  reswriter, coffwriter, elfwriter, machowriter, externalwriter,
+  reswriter, coffwriter, xcoffwriter, elfwriter, machowriter, externalwriter,
 //misc
   elfconsts, cofftypes, machotypes, externaltypes
   ;
@@ -264,6 +264,16 @@ begin
   end;
 end;
 
+function SetUpXCoffWriter : TCoffResourceWriter;
+begin
+  Result:=TXCoffResourceWriter.Create;
+  case CurrentTarget.machine of
+//    mtnone :
+    mtppc : Result.MachineType:=cmtppc32aix;
+  end;
+end;
+
+
 function SetUpMachOWriter : TMachOResourceWriter;
 const
   ArmSubMachine2MachOSubMachine: array[TSubMachineTypeArm] of TMachOSubMachineTypeArm =
@@ -332,6 +342,7 @@ begin
       ofRes   : aWriter:=SetUpResWriter;
       ofElf   : aWriter:=SetUpElfWriter;
       ofCoff  : aWriter:=SetUpCoffWriter;
+      ofXCoff : aWriter:=SetUpXCoffWriter;
       ofMachO : aWriter:=SetUpMachOWriter;
       ofExt   : aWriter:=SetUpExternalWriter;
     end;

utils/fpcres/target.pas

@@ -37,7 +37,7 @@ type
         (subgen: TSubMachineTypeGeneric);
   end;
 
-  TObjFormat = (ofNone, ofRes, ofElf, ofCoff, ofMachO, ofExt);
+  TObjFormat = (ofNone, ofRes, ofElf, ofCoff, ofXCoff, ofMachO, ofExt);
   TObjFormats = set of TObjFormat;
   
 
@@ -67,19 +67,19 @@ function ObjFormatToStr(const aFormat : TObjFormat) : string;
 var
   Machines : array[TMachineType] of TMachineInfo =
   (
-    (name : '';             formats : [ofRes]),                  //mtnone
-    (name : 'i386';         formats : [ofElf, ofCoff, ofMachO]), //mti386
-    (name : 'x86_64';       formats : [ofElf, ofCoff, ofMachO]), //mtx86_64
-    (name : 'powerpc';      formats : [ofElf, ofMachO]),         //mtppc
-    (name : 'powerpc64';    formats : [ofElf, ofMachO]),         //mtppc64
-    (name : 'arm';          formats : [ofElf, ofCoff, ofMachO]), //mtarm
-    (name : 'armeb';        formats : [ofElf]),                  //mtarmeb
-    (name : 'm68k';         formats : [ofElf]),                  //mtm68k
-    (name : 'sparc';        formats : [ofElf]),                  //mtsparc
-    (name : 'alpha';        formats : [ofElf]),                  //mtalpha
-    (name : 'ia64';         formats : [ofElf]),                  //mtia64
-    (name : 'bigendian';    formats : [ofExt]),                  //mtBigEndian
-    (name : 'littleendian'; formats : [ofExt])                   //mtLittleEndian
+    (name : '';             formats : [ofRes]),                   //mtnone
+    (name : 'i386';         formats : [ofElf, ofCoff, ofMachO]),  //mti386
+    (name : 'x86_64';       formats : [ofElf, ofCoff, ofMachO]),  //mtx86_64
+    (name : 'powerpc';      formats : [ofElf, ofXCoff, ofMachO]), //mtppc
+    (name : 'powerpc64';    formats : [ofElf, ofMachO]),          //mtppc64
+    (name : 'arm';          formats : [ofElf, ofCoff, ofMachO]),  //mtarm
+    (name : 'armeb';        formats : [ofElf]),                   //mtarmeb
+    (name : 'm68k';         formats : [ofElf]),                   //mtm68k
+    (name : 'sparc';        formats : [ofElf]),                   //mtsparc
+    (name : 'alpha';        formats : [ofElf]),                   //mtalpha
+    (name : 'ia64';         formats : [ofElf]),                   //mtia64
+    (name : 'bigendian';    formats : [ofExt]),                   //mtBigEndian
+    (name : 'littleendian'; formats : [ofExt])                    //mtLittleEndian
   );
 
   SubMachinesArm: array[TSubMachineTypeArm] of string[8] =
@@ -95,7 +95,9 @@ var
                                                      mtppc64,mtarm,mtarmeb,
                                                      mtm68k,mtsparc,mtalpha,
                                                      mtia64]),
-    (name : 'coff';     ext : '.o';      machines : [mti386,mtx86_64,mtarm]),
+    (name : 'coff';     ext : '.o';      machines : [mti386,mtx86_64,mtarm,
+                                                     mtppc,mtppc64]),
+    (name : 'xcoff';    ext : '.o';      machines : [mtppc{,mtppc64}]),
     (name : 'mach-o';   ext : '.or';     machines : [mti386,mtx86_64,mtppc,
                                                      mtppc64,mtarm]),
     (name : 'external'; ext : '.fpcres'; machines : [mtBigEndian,mtLittleEndian])
@@ -160,8 +162,10 @@ var
   {$IFDEF WINDOWS}
     objformat : ofCoff;
   {$ELSE}
-    {$IFDEF DARWIN}
+    {$IF defined(DARWIN)}
       objformat : ofMachO;
+    {$ELSEIF defined(AIX)}
+      objformat : ofXCoff;
     {$ELSE}
       objformat : ofElf;
     {$ENDIF}
@@ -178,6 +182,7 @@ begin
     ofRes  : Result:=mtnone;
     ofElf  : Result:=mti386;
     ofCoff : Result:=mti386;
+    ofXCoff: Result:=mtppc;
     ofMachO: Result:=mti386;
     {$IFDEF ENDIAN_BIG}
     ofExt  : Result:=mtBigEndian;