Merged revisions 8412,8627,8650-8653,8657,8660,8663,8668-8669,8675,8683,8841,8868,8872-8873 via svnmerge from

svn+ssh://[email protected]/FPC/svn/fpc/trunk

........
r8412 | jonas | 2007-09-09 00:47:34 +0200 (Sun, 09 Sep 2007) | 2 lines

  * enabled tail recursion optimization for ppc

........
r8627 | jonas | 2007-09-23 23:15:59 +0200 (Sun, 23 Sep 2007) | 3 lines

  * optimized code for jumptables (same as for ppc now)
  * put jump tables in const section for darwin/i386

........
r8650 | jonas | 2007-09-26 17:49:01 +0200 (Wed, 26 Sep 2007) | 11 lines

  * split off sec_rodata_norel from sec_rodata, and only put constant data
    without relocations in sec_rodata_norel. It should be possible to make
    this new section read-only on all platforms, although currently it
    is only done for darwin, and for non-pic code written using the
    -Aas assembler writer.

    Most platforms also have a special section for "constant but with
    relocations" data, but such a section is currently only used for
    Darwin (others still use plain .data sections for that, like they
    did before)

........
r8651 | jonas | 2007-09-26 18:41:32 +0200 (Wed, 26 Sep 2007) | 7 lines

  + PIC support for darwin/ppc32 (-Cg works now, no regressions in test
    suite compiled with -Cg compared to without -Cg)
  + support for using a virtual register as PIC/got base register
  * moved got loading code from ncgutil to cgobj/cgcpu (can't test whether
    it didn't break anything under linux/i386, because "make cycle OPT=-Cg"
    was already broken due to the *prt*.as -> si_*.pp changes)

........
r8652 | jonas | 2007-09-26 19:25:38 +0200 (Wed, 26 Sep 2007) | 2 lines

  * fixed x86 compilation after r8651

........
r8653 | jonas | 2007-09-26 20:39:14 +0200 (Wed, 26 Sep 2007) | 3 lines

  * added comment clarifying why g_indirect_sym_load doesn't have to
    care about PIC

........
r8657 | jonas | 2007-09-26 23:42:27 +0200 (Wed, 26 Sep 2007) | 9 lines

  + Compiler support for pic on darwin/i386. The i386 rtl still needs
    to be made pic-safe (mainly accesses to the global default8087cw)
  * At the same time also made the non-pic code abi-compliant (access
    external data via indirect symbol pointers etc)

    Darwin/i386 also puts the got into a virtual register (like
    Darwin/ppc), a.o. because the register allocator fails to colour
    a routine in aasmcpu.pas if we take away ebx from it.

........
r8660 | jonas | 2007-09-27 10:08:45 +0200 (Thu, 27 Sep 2007) | 3 lines

  * made less complex in case of pic code because then many more
    virtual registers are needed

........
r8663 | jonas | 2007-09-27 17:08:09 +0200 (Thu, 27 Sep 2007) | 4 lines

  * made pic-safe (by simply not accessing global variables from
    assembler code anymore, as I don't see how to easily support
    PIC access to global variables for Darwin/i386)

........
r8668 | jonas | 2007-09-28 13:15:16 +0200 (Fri, 28 Sep 2007) | 3 lines

  * don't try to translate the got register if it's NR_NO (fixes
    regression of webtbs/tw3402 on linux/ppc64 after r8651)

........
r8669 | jonas | 2007-09-28 16:12:46 +0200 (Fri, 28 Sep 2007) | 5 lines

  * fixed a_jmp_name() for darwin/i386 (go via a stub)
  * fixed g_external_wrapper for darwin/i386 (both with and without pic,
    by using a_jmp_name(), because the darwin jump stubs can always
    be called directly)

........
r8675 | jonas | 2007-09-29 01:27:16 +0200 (Sat, 29 Sep 2007) | 3 lines

  * fixed crashes when combining -Cg with -g or -pg due to a missing
    restore of lr in leaf procedures in that case (Darwin-only)

........
r8683 | jonas | 2007-09-29 22:24:51 +0200 (Sat, 29 Sep 2007) | 8 lines

  * don't try to add current_procinfo.got to used_in_proc if it's a
    virtual register
  * always add EBX to used_in_proc in case pi_needs_got, because it's
    currently always used due to the geteipasebx call
  * don't explicitly free the PIC register in the exitcode because
    then the assembler optimizer assumes the load restoring it (ebx)
    can be safely removed

........
r8841 | jonas | 2007-10-18 20:23:03 +0200 (Thu, 18 Oct 2007) | 2 lines

  * support for -Cg- to disable pic code

........
r8868 | jonas | 2007-10-20 22:14:45 +0200 (Sat, 20 Oct 2007) | 3 lines

  + PIC support for darwin/ppc64
  * added {$PIC+} for darwin to all library tests

........
r8872 | jonas | 2007-10-21 12:34:01 +0200 (Sun, 21 Oct 2007) | 3 lines

  * make PIC generation default on Darwin (ppc and i386; ppc64 will be
    done in next commit to ease merging)

........
r8873 | jonas | 2007-10-21 12:36:05 +0200 (Sun, 21 Oct 2007) | 2 lines

  * generate PIC by default for darwin/ppc64

........

git-svn-id: branches/fixes_2_2@8912 -

compiler/aasmbase.pas

@@ -60,7 +60,10 @@ interface
        TAsmSectiontype=(sec_none,
          sec_code,
          sec_data,
+         { read-only, but may contain relocations }
          sec_rodata,
+         { read-only and cannot contain relocations }
+         sec_rodata_norel,
          sec_bss,
          sec_threadvar,
          { used for wince exception handling }

compiler/aggas.pas

@@ -248,12 +248,13 @@ implementation
           '.text',
           '.data',
 { why doesn't .rodata work? (FK) }
-{$warning TODO .rodata not yet working}
+{$warning TODO .data.ro not yet working}
 {$if defined(arm) or defined(powerpc)}
           '.rodata',
 {$else arm}
           '.data',
 {$endif arm}
+          '.rodata',
           '.bss',
           '.threadvar',
           '.pdata',
@@ -272,6 +273,7 @@ implementation
           '.text',
           '.data.rel',
           '.data.rel',
+          '.data.rel',
           '.bss',
           '.threadvar',
           '.pdata',
@@ -369,7 +371,10 @@ implementation
                 { they don't work and gcc doesn't use them either...     }
                 system_powerpc_darwin,
                 system_powerpc64_darwin:
-                  AsmWriteln('__TEXT,__symbol_stub1,symbol_stubs,pure_instructions,16');
+                  if (cs_create_pic in current_settings.moduleswitches) then
+                    AsmWriteln('__TEXT,__picsymbolstub1,symbol_stubs,pure_instructions,32')
+                  else
+                    AsmWriteln('__TEXT,__symbol_stub1,symbol_stubs,pure_instructions,16');
                 system_i386_darwin:
                   AsmWriteln('__IMPORT,__jump_table,symbol_stubs,self_modifying_code+pure_instructions,5');
                 { darwin/x86-64 uses RIP-based GOT addressing }
@@ -595,12 +600,12 @@ implementation
              begin
                if (target_info.system in systems_darwin) then
                  begin
-                   {On Mac OS X you can't have common symbols in a shared
-                    library, since those are in the TEXT section and the text section is
-                    read-only in shared libraries (so it can be shared among different
-                    processes). The alternate code creates some kind of common symbols in
-                    the data segment. The generic code no longer uses common symbols, but
-                    this doesn't work on Mac OS X as well.}
+                   { On Mac OS X you can't have common symbols in a shared library
+                     since those are in the TEXT section and the text section is
+                     read-only in shared libraries (so it can be shared among different
+                     processes). The alternate code creates some kind of common symbols
+                     in the data segment.
+                   }
                    if tai_datablock(hp).is_global then
                      begin
                        asmwrite('.globl ');
@@ -728,7 +733,7 @@ implementation
                            { Values with symbols are written on a single line to improve
                              reading of the .s file (PFV) }
                            if assigned(tai_const(hp).sym) or
-                              not(CurrSecType in [sec_data,sec_rodata]) or
+                              not(CurrSecType in [sec_data,sec_rodata,sec_rodata_norel]) or
                               (l>line_length) or
                               (hp.next=nil) or
                               (tai(hp.next).typ<>ait_const) or
@@ -1111,6 +1116,11 @@ implementation
                  exit;
                end;
             sec_rodata:
+              begin
+                result := '.const_data';
+                exit;
+              end;
+            sec_rodata_norel:
               begin
                 result := '.const';
                 exit;
@@ -1120,6 +1130,16 @@ implementation
                 result := '.section __TEXT, .fpc, regular, no_dead_strip';
                 exit;
               end;
+            sec_code:
+              begin
+                if (aname='fpc_geteipasebx') or
+                   (aname='fpc_geteipasecx') then
+                  begin
+                    result:='.section __TEXT,__textcoal_nt,coalesced,pure_instructions'#10'.weak_definition '+aname+
+                      #10'.private_extern '+aname;
+                    exit;
+                  end;
+              end;
           end;
         result := inherited sectionname(atype,aname,aorder);
       end;
@@ -1137,6 +1157,7 @@ implementation
          sec_code,
          sec_data,
          sec_data (* sec_rodata *),
+         sec_data (* sec_rodata_norel *),
          sec_bss,
          sec_data (* sec_threadvar *),
          { used for wince exception handling }

compiler/cgobj.pas

@@ -70,7 +70,7 @@ unit cgobj;
           {# Clean up the register allocators needed for the codegenerator.}
           procedure done_register_allocators;virtual;
           {# Set whether live_start or live_end should be updated when allocating registers, needed when e.g. generating initcode after the rest of the code. }
-          procedure set_regalloc_extend_backwards(b: boolean);
+          procedure set_regalloc_live_range_direction(dir: TRADirection);
 
        {$ifdef flowgraph}
           procedure init_flowgraph;
@@ -479,6 +479,9 @@ unit cgobj;
 
           The default implementation issues a jump instruction to the external name. }
           procedure g_external_wrapper(list : TAsmList; procdef: tprocdef; const externalname: string); virtual;
+          
+          { initialize the pic/got register }
+          procedure g_maybe_got_init(list: TAsmList); virtual;
         protected
           procedure get_subsetref_load_info(const sref: tsubsetreference; out loadsize: tcgsize; out extra_load: boolean);
           procedure a_load_subsetref_regs_noindex(list: TAsmList; subsetsize: tcgsize; loadbitsize: byte; const sref: tsubsetreference; valuereg, extra_value_reg: tregister); virtual;
@@ -769,14 +772,14 @@ implementation
       end;
 
 
-    procedure tcg.set_regalloc_extend_backwards(b: boolean);
+    procedure tcg.set_regalloc_live_range_direction(dir: TRADirection);
       var
         rt : tregistertype;
       begin
         for rt:=low(rg) to high(rg) do
           begin
             if assigned(rg[rt]) then
-              rg[rt].extend_live_range_backwards := b;
+              rg[rt].live_range_direction:=dir;
           end;
       end;
 
@@ -3751,6 +3754,10 @@ implementation
         end;
 
 
+    procedure tcg.g_maybe_got_init(list: TAsmList);
+      begin
+      end;
+
 {*****************************************************************************
                                     TCG64
 *****************************************************************************}

compiler/globtype.pas

@@ -348,6 +348,10 @@ interface
         s64comp,s64currency,s128real
       );
 
+    type
+      { register allocator live range extension direction }
+      TRADirection = (rad_forward, rad_backwards, rad_backwards_reinit);
+
     type
        TIDString = string[maxidlen];
 

compiler/i386/ag386nsm.pas

@@ -402,6 +402,7 @@ interface
         secnames : array[TAsmSectiontype] of string[17] = ('',
           '.text',
           '.data',
+          '.data',
           '.rodata',
           '.bss',
           '.tbss',

compiler/i386/cgcpu.pas

@@ -52,6 +52,7 @@ unit cgcpu;
         procedure g_exception_reason_save_const(list : TAsmList; const href : treference; a: aint);override;
         procedure g_exception_reason_load(list : TAsmList; const href : treference);override;
         procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override;
+        procedure g_maybe_got_init(list: TAsmList); override;
      end;
 
       tcg64f386 = class(tcg64f32)
@@ -82,7 +83,8 @@ unit cgcpu;
     procedure tcg386.init_register_allocators;
       begin
         inherited init_register_allocators;
-        if cs_create_pic in current_settings.moduleswitches then
+        if (target_info.system<>system_i386_darwin) and
+           (cs_create_pic in current_settings.moduleswitches) then
           rg[R_INTREGISTER]:=trgcpu.create(R_INTREGISTER,R_SUBWHOLE,[RS_EAX,RS_EDX,RS_ECX,RS_ESI,RS_EDI],first_int_imreg,[RS_EBP])
         else
           rg[R_INTREGISTER]:=trgcpu.create(R_INTREGISTER,R_SUBWHOLE,[RS_EAX,RS_EDX,RS_ECX,RS_EBX,RS_ESI,RS_EDI],first_int_imreg,[RS_EBP]);
@@ -93,8 +95,13 @@ unit cgcpu;
 
     procedure tcg386.do_register_allocation(list:TAsmList;headertai:tai);
       begin
-        if pi_needs_got in current_procinfo.flags then
-          include(rg[R_INTREGISTER].used_in_proc,getsupreg(current_procinfo.got));
+        if (pi_needs_got in current_procinfo.flags) then
+          begin
+            if getsupreg(current_procinfo.got) < first_int_imreg then
+              include(rg[R_INTREGISTER].used_in_proc,getsupreg(current_procinfo.got));
+            { ebx is currently always used (do to getiepasebx call) }
+            include(rg[R_INTREGISTER].used_in_proc,RS_EBX);
+          end;
         inherited do_register_allocation(list,headertai);
       end;
 
@@ -246,10 +253,6 @@ unit cgcpu;
       var
         stacksize : longint;
       begin
-        { Release PIC register }
-        if cs_create_pic in current_settings.moduleswitches then
-          list.concat(tai_regalloc.dealloc(NR_PIC_OFFSET_REG,nil));
-
         { MMX needs to call EMMS }
         if assigned(rg[R_MMXREGISTER]) and
            (rg[R_MMXREGISTER].uses_registers) then
@@ -485,6 +488,37 @@ unit cgcpu;
       end;
 
 
+    procedure tcg386.g_maybe_got_init(list: TAsmList);
+      begin
+        { allocate PIC register }
+        if (cs_create_pic in current_settings.moduleswitches) and
+           (tf_pic_uses_got in target_info.flags) and
+           (pi_needs_got in current_procinfo.flags) and
+           not(po_kylixlocal in current_procinfo.procdef.procoptions) then
+          begin
+            if (target_info.system<>system_i386_darwin) then
+              begin
+                current_module.requires_ebx_pic_helper:=true;
+                cg.a_call_name_static(list,'fpc_geteipasebx');
+                list.concat(taicpu.op_sym_ofs_reg(A_ADD,S_L,current_asmdata.RefAsmSymbol('_GLOBAL_OFFSET_TABLE_'),0,NR_PIC_OFFSET_REG));
+                list.concat(tai_regalloc.alloc(NR_PIC_OFFSET_REG,nil));
+                { ecx could be used in leaf procedures }
+                current_procinfo.got:=NR_EBX;
+              end
+            else
+              begin
+                { can't use ecx, since that one may overwrite a parameter }
+                current_module.requires_ebx_pic_helper:=true;
+                cg.a_call_name_static(list,'fpc_geteipasebx');
+                list.concat(tai_regalloc.alloc(NR_EBX,nil));
+                a_label(list,current_procinfo.CurrGotLabel);
+                { got is already set by ti386procinfo.allocate_got_register }
+                list.concat(tai_regalloc.dealloc(NR_EBX,nil));
+                a_load_reg_reg(list,OS_ADDR,OS_ADDR,NR_EBX,current_procinfo.got);
+              end;
+          end;
+      end;
+
 
     procedure tcg386.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
       {

compiler/i386/cpupi.pas

@@ -28,7 +28,7 @@ unit cpupi;
   interface
 
     uses
-       psub,procinfo;
+       psub,procinfo,aasmdata;
 
     type
        ti386procinfo = class(tcgprocinfo)
@@ -36,6 +36,7 @@ unit cpupi;
          procedure set_first_temp_offset;override;
          function calc_stackframe_size:longint;override;
          procedure generate_parameter_info;override;
+         procedure allocate_got_register(list: tasmlist);override;
        end;
 
 
@@ -43,8 +44,8 @@ unit cpupi;
 
     uses
       cutils,
-      systems,globals,
-      tgobj,
+      systems,globals,globtype,
+      cgobj,tgobj,
       cpubase,
       cgutils,
       symconst;
@@ -88,6 +89,14 @@ unit cpupi;
           para_stack_size := 0;
       end;
 
+    procedure ti386procinfo.allocate_got_register(list: tasmlist);
+      begin
+        if (target_info.system = system_i386_darwin) and
+           (cs_create_pic in current_settings.moduleswitches) then
+          begin
+            got := cg.getaddressregister(list);
+          end;
+      end;
 
 begin
    cprocinfo:=ti386procinfo;

compiler/i386/n386set.pas

@@ -82,6 +82,8 @@ implementation
         last : TConstExprInt;
         indexreg : tregister;
         href : treference;
+        jtlist: tasmlist;
+        sectype: TAsmSectiontype;
 
         procedure genitem(list:TAsmList;t : pcaselabel);
           var
@@ -100,12 +102,14 @@ implementation
           end;
 
       begin
+        last:=min_;
         if not(jumptable_no_range) then
           begin
-             { case expr less than min_ => goto elselabel }
-             cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,opsize,jmp_lt,aint(min_),hregister,elselabel);
+             { a <= x <= b <-> unsigned(x-a) <= (b-a) }
+             cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_SUB,opsize,aint(min_),hregister);
              { case expr greater than max_ => goto elselabel }
-             cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,opsize,jmp_gt,aint(max_),hregister,elselabel);
+             cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,opsize,OC_A,aint(max_)-aint(min_),hregister,elselabel);
+             min_:=0;
           end;
         current_asmdata.getjumplabel(table);
         { make it a 32bit register }
@@ -118,10 +122,19 @@ implementation
         href.scalefactor:=4;
         emit_ref(A_JMP,S_NO,href);
         { generate jump table }
-        new_section(current_procinfo.aktlocaldata,sec_data,current_procinfo.procdef.mangledname,sizeof(aint));
-        current_procinfo.aktlocaldata.concat(Tai_label.Create(table));
-        last:=min_;
-        genitem(current_procinfo.aktlocaldata,hp);
+        if (target_info.system = system_i386_darwin) then
+          begin
+            jtlist:=current_asmdata.asmlists[al_const];
+            sectype:=sec_rodata;
+          end
+        else
+          begin
+            jtlist:=current_procinfo.aktlocaldata;
+            sectype:=sec_data;
+          end;
+        new_section(jtlist,sectype,current_procinfo.procdef.mangledname,sizeof(aint));
+        jtlist.concat(Tai_label.Create(table));
+        genitem(jtlist,hp);
       end;
 
 

compiler/ncgcon.pas

@@ -167,7 +167,7 @@ implementation
                   current_asmdata.getdatalabel(lastlabel);
                   lab_real:=lastlabel;
                   maybe_new_object_file(current_asmdata.asmlists[al_typedconsts]);
-                  new_section(current_asmdata.asmlists[al_typedconsts],sec_rodata,lastlabel.name,const_align(resultdef.size));
+                  new_section(current_asmdata.asmlists[al_typedconsts],sec_rodata_norel,lastlabel.name,const_align(resultdef.size));
                   current_asmdata.asmlists[al_typedconsts].concat(Tai_label.Create(lastlabel));
                   case realait of
                     ait_real_32bit :
@@ -413,7 +413,11 @@ implementation
                    current_asmdata.getdatalabel(lastlabel);
                    lab_str:=lastlabel;
                    maybe_new_object_file(current_asmdata.asmlists[al_typedconsts]);
-                   new_section(current_asmdata.asmlists[al_typedconsts],sec_rodata,lastlabel.name,const_align(sizeof(aint)));
+                   if (len=0) or
+                      not(cst_type in [cst_ansistring,cst_widestring]) then
+                     new_section(current_asmdata.asmlists[al_typedconsts],sec_rodata_norel,lastlabel.name,const_align(sizeof(aint)))
+                   else
+                     new_section(current_asmdata.asmlists[al_typedconsts],sec_rodata,lastlabel.name,const_align(sizeof(aint)));
                    current_asmdata.asmlists[al_typedconsts].concat(Tai_label.Create(lastlabel));
                    { generate an ansi string ? }
                    case cst_type of
@@ -616,7 +620,7 @@ implementation
                  current_asmdata.getdatalabel(lastlabel);
                  lab_set:=lastlabel;
                  maybe_new_object_file(current_asmdata.asmlists[al_typedconsts]);
-                 new_section(current_asmdata.asmlists[al_typedconsts],sec_rodata,lastlabel.name,const_align(sizeof(aint)));
+                 new_section(current_asmdata.asmlists[al_typedconsts],sec_rodata_norel,lastlabel.name,const_align(sizeof(aint)));
                  current_asmdata.asmlists[al_typedconsts].concat(Tai_label.Create(lastlabel));
                  { already handled at the start of this method?? (JM)
                  if tsetdef(resultdef).settype=smallset then

compiler/ncgutil.pas

@@ -150,7 +150,6 @@ interface
     function getprocalign : shortint;
 
     procedure gen_pic_helpers(list : TAsmList);
-    procedure gen_got_load(list : TAsmList);
 
 implementation
 
@@ -2142,27 +2141,6 @@ implementation
       end;
 
 
-    procedure gen_got_load(list : TAsmList);
-      begin
-        { if loading got is necessary for more cpus, it can be moved
-          to the cg }
-{$ifdef i386}
-        { allocate PIC register }
-        if (cs_create_pic in current_settings.moduleswitches) and
-           (tf_pic_uses_got in target_info.flags) and
-           (pi_needs_got in current_procinfo.flags) and
-           not(po_kylixlocal in current_procinfo.procdef.procoptions) then
-          begin
-            current_module.requires_ebx_pic_helper:=true;
-            cg.a_call_name_static(list,'fpc_geteipasebx');
-            list.concat(taicpu.op_sym_ofs_reg(A_ADD,S_L,current_asmdata.RefAsmSymbol('_GLOBAL_OFFSET_TABLE_'),0,NR_PIC_OFFSET_REG));
-            list.concat(tai_regalloc.alloc(NR_PIC_OFFSET_REG,nil));
-            { ecx could be used in leave procedures }
-            current_procinfo.got:=NR_EBX;
-          end;
-{$endif i386}
-      end;
-
 {****************************************************************************
                            External handling
 ****************************************************************************}
@@ -2779,7 +2757,7 @@ implementation
         href : treference;
 {$endif i386}
       begin
-        { if other cpus require such helpers as well, it can be solved more cleaner }
+        { if other cpus require such helpers as well, it can be solved more cleanly }
 {$ifdef i386}
         if current_module.requires_ebx_pic_helper then
           begin

compiler/ogbase.pas

@@ -801,6 +801,7 @@ implementation
         secnames : array[TAsmSectiontype] of string[16] = ('',
           'code',
           'Data',
+          'Data',
           'roData',
           'bss',
           'threadvar',
@@ -840,8 +841,10 @@ implementation
         secoptions : array[TAsmSectiontype] of TObjSectionOptions = ([],
           {code} [oso_Data,oso_load,oso_readonly,oso_executable,oso_keep],
           {Data} [oso_Data,oso_load,oso_write,oso_keep],
-{$warning TODO Fix roData be read-only}
+{$warning TODO Fix sec_rodata be read-only-with-relocs}
           {roData} [oso_Data,oso_load,oso_write,oso_keep],
+{$warning TODO Fix sec_rodata_norel be read-only/constant}
+          {roData_norel} [oso_Data,oso_load,oso_write,oso_keep],
           {bss} [oso_load,oso_write,oso_keep],
           {threadvar} [oso_load,oso_write],
           {pdata} [oso_load,oso_readonly,oso_keep],

compiler/ogcoff.pas

@@ -477,7 +477,7 @@ implementation
        StrsMaxGrow   = 8192;
 
        coffsecnames : array[TAsmSectiontype] of string[17] = ('',
-          '.text','.data','.data','.bss','.tls',
+          '.text','.data','.data','.data','.bss','.tls',
           '.text',
           '.pdata',
           '.stab','.stabstr',

compiler/ogelf.pas

@@ -571,9 +571,9 @@ implementation
       const
         secnames : array[TAsmSectiontype] of string[13] = ('',
 {$ifdef userodata}
-          '.text','.data','.rodata','.bss','.threadvar',
+          '.text','.data','.data','.rodata','.bss','.threadvar',
 {$else userodata}
-          '.text','.data','.data','.bss','.threadvar',
+          '.text','.data','.data','.data','.bss','.threadvar',
 {$endif userodata}
           '.pdata',
           '.text', { darwin stubs }
@@ -590,6 +590,7 @@ implementation
           '.text',
           '.data.rel',
           '.data.rel',
+          '.data.rel',
           '.bss',
           '.threadvar',
           '.pdata',

compiler/options.pas

@@ -56,7 +56,7 @@ Type
     procedure Interpret_file(const filename : string);
     procedure Read_Parameters;
     procedure parsecmd(cmd:string);
-    procedure TargetDefines(def:boolean);
+    procedure TargetOptions(def:boolean);
   end;
 
   TOptionClass=class of toption;
@@ -508,6 +508,8 @@ begin
                     'g' :
                        if tf_no_pic_supported in target_info.flags then
                          message(scan_w_pic_ignored)
+                       else if UnsetBool(More, j) then
+                         exclude(init_settings.moduleswitches,cs_create_pic)
                        else
                          include(init_settings.moduleswitches,cs_create_pic);
                     'h' :
@@ -1188,7 +1190,7 @@ begin
                if paratarget=system_none then
                 begin
                   { remove old target define }
-                  TargetDefines(false);
+                  TargetOptions(false);
                   { load new target }
                   paratarget:=find_system_by_string(More);
                   if paratarget<>system_none then
@@ -1196,7 +1198,7 @@ begin
                   else
                     IllegalPara(opt);
                   { set new define }
-                  TargetDefines(true);
+                  TargetOptions(true);
                 end
                else
                 if More<>upper(target_info.shortname) then
@@ -1882,7 +1884,7 @@ begin
 end;
 
 
-procedure TOption.TargetDefines(def:boolean);
+procedure TOption.TargetOptions(def:boolean);
 var
   s : string;
   i : integer;
@@ -1972,6 +1974,13 @@ begin
       def_system_macro('FPC_CPUCROSSCOMPILING')
     else
       def_system_macro('FPC_CPUCROSSCOMPILING');
+
+  { Code generation flags }
+  if def and
+     (tf_pic_default in target_info.flags) then
+    include(init_settings.moduleswitches,cs_create_pic)
+  else
+    exclude(init_settings.moduleswitches,cs_create_pic);
 end;
 
 
@@ -2065,7 +2074,7 @@ begin
   disable_configfile:=false;
 
   { Non-core target defines }
-  Option.TargetDefines(true);
+  Option.TargetOptions(true);
 
 { get default messagefile }
   msgfilename:=GetEnvironmentVariable('PPC_ERROR_FILE');

compiler/powerpc/agppcmpw.pas

@@ -72,6 +72,7 @@ interface
         'csect', {code}
         'csect', {data}
         'csect', {read only data}
+        'csect', {read only data - no relocations}
         'csect', {bss} 'csect', '',
         'csect','csect','csect','csect',
          '','','','','','','','','','','','','',''

compiler/powerpc/cgcpu.pas

@@ -100,14 +100,6 @@ unit cgcpu;
         { the upper 24/16 bits of a register after an operation          }
         procedure maybeadjustresult(list: TAsmList; op: TOpCg; size: tcgsize; dst: tregister);
 
-        { Make sure ref is a valid reference for the PowerPC and sets the }
-        { base to the value of the index if (base = R_NO).                }
-        { Returns true if the reference contained a base, index and an    }
-        { offset or symbol, in which case the base will have been changed }
-        { to a tempreg (which has to be freed by the caller) containing   }
-        { the sum of part of the original reference                       }
-        function fixref(list: TAsmList; var ref: treference): boolean; override;
-
         { returns whether a reference can be used immediately in a powerpc }
         { instruction                                                      }
         function issimpleref(const ref: treference): boolean;
@@ -889,9 +881,7 @@ const
 
      var regcounter,firstregfpu,firstregint: TSuperRegister;
          href : treference;
-         usesfpr,usesgpr,gotgot : boolean;
-{         cond : tasmcond;
-         instr : taicpu; }
+         usesfpr,usesgpr : boolean;
 
       begin
         { CR and LR only have to be saved in case they are modified by the current }
@@ -905,8 +895,7 @@ const
         if not(po_assembler in current_procinfo.procdef.procoptions) then
           begin
             { save link register? }
-            if (pi_do_call in current_procinfo.flags) or
-               ([cs_lineinfo,cs_debuginfo,cs_profile] * current_settings.moduleswitches <> []) then
+            if save_lr_in_prologue then
               begin
                 a_reg_alloc(list,NR_R0);
                 { save return address... }
@@ -950,20 +939,8 @@ const
               end;
           end;
 
-        { no GOT pointer loaded yet }
-        gotgot:=false;
         if usesfpr then
           begin
-{            save floating-point registers
-             if (cs_create_pic in current_settings.moduleswitches) and not(usesgpr) then
-               begin
-                  a_call_name(current_asmdata.RefAsmSymbol('_savefpr_'+tostr(ord(firstregfpu)-ord(R_F14)+14)+'_g'));
-                  gotgot:=true;
-               end
-             else
-               a_call_name(current_asmdata.RefAsmSymbol('_savefpr_'+tostr(ord(firstregfpu)-ord(R_F14)+14)));
-}
-
              reference_reset_base(href,NR_R1,-8);
              for regcounter:=firstregfpu to RS_F31 do
                begin
@@ -980,15 +957,6 @@ const
         { save gprs and fetch GOT pointer }
         if usesgpr then
           begin
-             {
-             if cs_create_pic in current_settings.moduleswitches then
-               begin
-                  a_call_name(current_asmdata.RefAsmSymbol('_savegpr_'+tostr(ord(firstreggpr)-ord(R_14)+14)+'_g'));
-                  gotgot:=true;
-               end
-             else
-               a_call_name(current_asmdata.RefAsmSymbol('_savegpr_'+tostr(ord(firstreggpr)-ord(R_14)+14)))
-             }
             if (firstregint <= RS_R22) or
                ((cs_opt_size in current_settings.optimizerswitches) and
                { with RS_R30 it's also already smaller, but too big a speed trade-off to make }
@@ -1010,34 +978,6 @@ const
 {        if (tppcprocinfo(current_procinfo).needs_frame_pointer) then }
 {          a_reg_dealloc(list,NR_R12); }
 
-
-        { if we didn't get the GOT pointer till now, we've to calculate it now }
-(*
-        if not(gotgot) and (pi_needs_got in current_procinfo.flags) then
-          case target_info.system of
-            system_powerpc_darwin:
-              begin
-                list.concat(taicpu.op_reg_reg(A_MFSPR,NR_R0,NR_LR));
-                fillchar(cond,sizeof(cond),0);
-                cond.simple:=false;
-                cond.bo:=20;
-                cond.bi:=31;
-                instr:=taicpu.op_sym(A_BCL,current_procinfo.CurrGOTLabel);
-                instr.setcondition(cond);
-                list.concat(instr);
-                a_label(list,current_procinfo.CurrGOTLabel);
-                list.concat(taicpu.op_reg_reg(A_MFSPR,current_procinfo.got,NR_LR));
-                list.concat(taicpu.op_reg_reg(A_MTSPR,NR_LR,NR_R0));
-              end;
-            else
-              begin
-                a_reg_alloc(list,NR_R31);
-                { place GOT ptr in r31 }
-                list.concat(taicpu.op_reg_reg(A_MFSPR,NR_R31,NR_LR));
-              end;
-          end;
-*)
-
         if (not nostackframe) and
            tppcprocinfo(current_procinfo).needstackframe and
            (localsize <> 0) then
@@ -1052,9 +992,17 @@ const
                 reference_reset_base(href,NR_STACK_POINTER_REG,0);
                 { can't use getregisterint here, the register colouring }
                 { is already done when we get here                      }
-                href.index := NR_R11;
+                { R12 may hold previous stack pointer, R11  may be in   }
+                { use as got => use R0 (but then we can't use           }
+                { a_load_const_reg)                                     }
+                href.index := NR_R0;
                 a_reg_alloc(list,href.index);
-                a_load_const_reg(list,OS_S32,-localsize,href.index);
+                list.concat(taicpu.op_reg_const(A_LI,NR_R0,smallint((-localsize) and $ffff)));
+                if (smallint((-localsize) and $ffff) < 0) then
+                  { upper 16 bits are now $ffff -> xor with inverse }
+                  list.concat(taicpu.op_reg_reg_const(A_XORIS,NR_R0,NR_R0,word(not(((-localsize) shr 16) and $ffff))))
+                else
+                  list.concat(taicpu.op_reg_reg_const(A_ORIS,NR_R0,NR_R0,word(((-localsize) shr 16) and $ffff)));
                 a_load_store(list,A_STWUX,NR_STACK_POINTER_REG,href);
                 a_reg_dealloc(list,href.index);
               end;
@@ -1700,54 +1648,6 @@ const
       end;
 
 
-    function tcgppc.fixref(list: TAsmList; var ref: treference): boolean;
-
-       var
-         tmpreg: tregister;
-       begin
-         result := false;
-
-         if (target_info.system = system_powerpc_darwin) and
-            assigned(ref.symbol) and
-            (ref.symbol.bind = AB_EXTERNAL) then
-           begin
-             tmpreg := g_indirect_sym_load(list,ref.symbol.name);
-             if (ref.base = NR_NO) then
-               ref.base := tmpreg
-             else if (ref.index = NR_NO) then
-               ref.index := tmpreg
-             else
-               begin
-                 list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,ref.base,tmpreg));
-                 ref.base := tmpreg;
-               end;
-             ref.symbol := nil;
-           end;
-
-         if (ref.base = NR_NO) then
-           begin
-             ref.base := ref.index;
-             ref.index := NR_NO;
-           end;
-         if (ref.base <> NR_NO) then
-           begin
-             if (ref.index <> NR_NO) and
-                ((ref.offset <> 0) or assigned(ref.symbol)) then
-               begin
-                 result := true;
-                 tmpreg := rg[R_INTREGISTER].getregister(list,R_SUBWHOLE);
-                 list.concat(taicpu.op_reg_reg_reg(
-                   A_ADD,tmpreg,ref.base,ref.index));
-                 ref.index := NR_NO;
-                 ref.base := tmpreg;
-               end
-           end
-         else
-           if ref.index <> NR_NO then
-             internalerror(200208102);
-       end;
-
-
     { find out whether a is of the form 11..00..11b or 00..11...00. If }
     { that's the case, we can use rlwinm to do an AND operation        }
     function tcgppc.get_rlwi_const(a: aint; var l1, l2: longint): boolean;

compiler/powerpc/cpuinfo.pas

@@ -76,10 +76,10 @@ Const
                                  genericlevel3optimizerswitches-
                                  { no need to write info about those }
                                  [cs_opt_level1,cs_opt_level2,cs_opt_level3]+
-                                 [cs_opt_regvar,cs_opt_loopunroll];
+                                 [cs_opt_regvar,cs_opt_loopunroll,cs_opt_tailrecursion];
 
    level1optimizerswitches = genericlevel1optimizerswitches;
-   level2optimizerswitches = genericlevel2optimizerswitches + level1optimizerswitches + [cs_opt_regvar];
+   level2optimizerswitches = genericlevel2optimizerswitches + level1optimizerswitches + [cs_opt_regvar,cs_opt_tailrecursion];
    level3optimizerswitches = genericlevel3optimizerswitches + level2optimizerswitches + [{,cs_opt_loopunroll}];
 
 Implementation

compiler/powerpc/cpupi.pas

@@ -29,7 +29,7 @@ unit cpupi;
 
     uses
        cutils,globtype,
-       cgbase,
+       cgbase,aasmdata,
        procinfo,cpuinfo,psub;
 
     type
@@ -43,6 +43,7 @@ unit cpupi;
           function calc_stackframe_size:longint;override;
 
           function uses_stack_temps: boolean;
+          procedure allocate_got_register(list: TAsmList);override;
          private
           first_save_int_reg, first_save_fpu_reg: tsuperregister;
          public
@@ -58,7 +59,7 @@ unit cpupi;
     uses
        globals,systems,
        cpubase,
-       aasmtai,aasmdata,
+       aasmtai,
        tgobj,cgobj,
        symconst,symsym,paramgr,symutil,symtable,
        verbose;
@@ -184,7 +185,17 @@ unit cpupi;
         else
           begin
             result := align(tg.lasttemp,16);
-            needstackframe:=result<>0;
+            needstackframe := result<>0;
+          end;
+      end;
+
+
+    procedure tppcprocinfo.allocate_got_register(list: TAsmList);
+      begin
+        if (target_info.system = system_powerpc_darwin) and
+           (cs_create_pic in current_settings.moduleswitches) then
+          begin
+            got := cg.getaddressregister(list);
           end;
       end;
 

compiler/powerpc/rappcgas.pas

@@ -140,6 +140,8 @@ Unit rappcgas;
 
       var
         l : aint;
+        relsym: string;
+        asmsymtyp: tasmsymtype;
 
       begin
         Consume(AS_LPAREN);
@@ -195,21 +197,51 @@ Unit rappcgas;
           AS_ID:
             Begin
               ReadSym(oper);
-              { add a constant expression? }
-              if (actasmtoken=AS_PLUS) then
-               begin
-                 l:=BuildConstExpression(true,true);
-                 case oper.opr.typ of
-                   OPR_CONSTANT :
-                     inc(oper.opr.val,l);
-                   OPR_LOCAL :
-                     inc(oper.opr.localsymofs,l);
-                   OPR_REFERENCE :
-                     inc(oper.opr.ref.offset,l);
-                   else
-                     internalerror(200309202);
-                 end;
-               end;
+              case actasmtoken of
+                AS_PLUS:
+                  begin
+                    { add a constant expression? }
+                    l:=BuildConstExpression(true,true);
+                    case oper.opr.typ of
+                      OPR_CONSTANT :
+                        inc(oper.opr.val,l);
+                      OPR_LOCAL :
+                        inc(oper.opr.localsymofs,l);
+                      OPR_REFERENCE :
+                        inc(oper.opr.ref.offset,l);
+                      else
+                        internalerror(200309202);
+                    end;
+                  end;
+                AS_MINUS:
+                  begin
+                    Consume(AS_MINUS);
+                    BuildConstSymbolExpression(false,true,false,l,relsym,asmsymtyp);
+                    if (relsym<>'') then
+                      begin
+                        if (oper.opr.typ = OPR_REFERENCE) then
+                          oper.opr.ref.relsymbol:=current_asmdata.RefAsmSymbol(relsym)
+                        else
+                          begin
+                            Message(asmr_e_invalid_reference_syntax);
+                            RecoverConsume(false);
+                          end
+                      end
+                    else
+                      begin
+                        case oper.opr.typ of
+                          OPR_CONSTANT :
+                            dec(oper.opr.val,l);
+                          OPR_LOCAL :
+                            dec(oper.opr.localsymofs,l);
+                          OPR_REFERENCE :
+                            dec(oper.opr.ref.offset,l);
+                          else
+                            internalerror(2007092601);
+                        end;
+                      end;
+                  end;
+              end;
               Consume(AS_RPAREN);
               if actasmtoken=AS_AT then
                 ReadAt(oper);

compiler/powerpc64/cgcpu.pas

@@ -107,16 +107,6 @@ type
 
     procedure maybeadjustresult(list: TAsmList; op: TOpCg; size: tcgsize; dst: tregister);
 
-    { Make sure ref is a valid reference for the PowerPC and sets the }
-    { base to the value of the index if (base = R_NO).                }
-    { Returns true if the reference contained a base, index and an    }
-    { offset or symbol, in which case the base will have been changed }
-    { to a tempreg (which has to be freed by the caller) containing   }
-    { the sum of part of the original reference                       }
-    function fixref(list: TAsmList; var ref: treference): boolean; override;
-
-    function load_got_symbol(list : TAsmList; symbol : string) : tregister;
-
     { returns whether a reference can be used immediately in a powerpc }
     { instruction                                                      }
     function issimpleref(const ref: treference): boolean;
@@ -1397,7 +1387,8 @@ var
     { there are two ways to do this: manually, by generating a few "std" instructions,
      or via the restore helper functions. The latter are selected by the -Og switch,
      i.e. "optimize for size" }
-    if (cs_opt_size in current_settings.optimizerswitches) then begin
+    if (cs_opt_size in current_settings.optimizerswitches) and
+       (target_info.system <> system_powerpc64_darwin) then begin
       mayNeedLRStore := false;
       if ((fprcount > 0) and (gprcount > 0)) then begin
         a_op_const_reg_reg(list, OP_SUB, OS_INT, 8 * fprcount, NR_R1, NR_R12);
@@ -1450,10 +1441,10 @@ begin
   { determine whether we need to save the link register }
   needslinkreg :=
     not(nostackframe) and
-    (((not (po_assembler in current_procinfo.procdef.procoptions)) and
-       ((pi_do_call in current_procinfo.flags) or (cs_profile in init_settings.moduleswitches))) or
-     ((cs_opt_size in current_settings.optimizerswitches) and ((fprcount > 0) or (gprcount > 0))) or
-     ([cs_lineinfo, cs_debuginfo] * current_settings.moduleswitches <> []));
+    (save_lr_in_prologue or
+     ((cs_opt_size in current_settings.optimizerswitches) and
+      ((fprcount > 0) or
+       (gprcount > 0))));
 
   a_reg_alloc(list, NR_STACK_POINTER_REG);
   a_reg_alloc(list, NR_R0);
@@ -1944,93 +1935,6 @@ begin
     (ref.offset = 0)));
 end;
 
-function tcgppc.load_got_symbol(list: TAsmList; symbol : string) : tregister;
-var
-  l: tasmsymbol;
-  ref: treference;
-  symname : string;
-begin
-  l:=current_asmdata.getasmsymbol(symbol);
-  reference_reset_symbol(ref,l,0);
-  ref.base := NR_R2;
-  ref.refaddr := addr_pic;
-
-  result := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE);
-  {$IFDEF EXTDEBUG}
-  list.concat(tai_comment.create(strpnew('loading got reference for ' + symbol)));
-  {$ENDIF EXTDEBUG}
-//  cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,ref,result);
-  list.concat(taicpu.op_reg_ref(A_LD, result, ref));
-end;
-
-
-function tcgppc.fixref(list: TAsmList; var ref: treference): boolean;
-var
-  tmpreg: tregister;
-  name : string;
-begin
-  result := false;
-  { Avoids recursion. }
-  if (ref.refaddr = addr_pic) then exit;
-  {$IFDEF EXTDEBUG}
-  list.concat(tai_comment.create(strpnew('fixref0 ' + ref2string(ref))));
-  {$ENDIF EXTDEBUG}
-
-  if (target_info.system = system_powerpc64_darwin) and
-     assigned(ref.symbol) and
-     (ref.symbol.bind = AB_EXTERNAL) then
-    begin
-      tmpreg := g_indirect_sym_load(list,ref.symbol.name);
-      if (ref.base = NR_NO) then
-        ref.base := tmpreg
-      else if (ref.index = NR_NO) then
-        ref.index := tmpreg
-      else
-        begin
-          list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,ref.base,tmpreg));
-          ref.base := tmpreg;
-        end;
-      ref.symbol := nil;
-    end;
-
-  { if we have to create PIC, add the symbol to the TOC/GOT }
-  if (target_info.system <> system_powerpc64_darwin) and
-     (cs_create_pic in current_settings.moduleswitches) and 
-     (assigned(ref.symbol)) then begin
-    tmpreg := load_got_symbol(list, ref.symbol.name);
-    if (ref.base = NR_NO) then
-      ref.base := tmpreg
-    else if (ref.index = NR_NO) then
-      ref.index := tmpreg
-    else begin
-      a_op_reg_reg_reg(list, OP_ADD, OS_ADDR, ref.base, tmpreg, tmpreg);
-      ref.base := tmpreg;
-    end;
-    ref.symbol := nil;
-    {$IFDEF EXTDEBUG}
-    list.concat(tai_comment.create(strpnew('fixref-pic ' + ref2string(ref))));
-    {$ENDIF EXTDEBUG}
-  end;
-
-  if (ref.base = NR_NO) then begin
-    ref.base := ref.index;
-    ref.index := NR_NO;
-  end;
-  if (ref.base <> NR_NO) and (ref.index <> NR_NO) and
-    ((ref.offset <> 0) or assigned(ref.symbol)) then begin
-      result := true;
-      tmpreg := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE);
-      a_op_reg_reg_reg(list, OP_ADD, OS_ADDR, ref.base, ref.index, tmpreg);
-      ref.base := tmpreg;
-      ref.index := NR_NO;
-  end;
-  if (ref.index <> NR_NO) and (assigned(ref.symbol) or (ref.offset <> 0)) then
-    internalerror(2006010506);
-  {$IFDEF EXTDEBUG}
-  list.concat(tai_comment.create(strpnew('fixref1 ' + ref2string(ref))));
-  {$ENDIF EXTDEBUG}
-end;
-
 procedure tcgppc.a_load_store(list: TAsmList; op: tasmop; reg: tregister;
   ref: treference);
 

compiler/powerpc64/cpupi.pas

@@ -28,7 +28,7 @@ unit cpupi;
 interface
 
 uses
-  cutils,
+  cutils,aasmdata,
   procinfo, cpuinfo, psub;
 
 type
@@ -43,6 +43,8 @@ type
     function calc_stackframe_size(numgpr, numfpr : longint): longint;
 
     needs_frame_pointer : boolean;
+
+    procedure allocate_got_register(list: TAsmList); override;
   end;
 
 implementation
@@ -50,8 +52,8 @@ implementation
 uses
   globtype, globals, systems,
   cpubase, cgbase,
-  aasmtai,aasmdata,
-  tgobj,
+  aasmtai,
+  tgobj,cgobj,
   symconst, symsym, paramgr, symutil, symtable,
   verbose;
 
@@ -111,6 +113,16 @@ begin
   end;
 end;
 
+
+procedure tppcprocinfo.allocate_got_register(list: TAsmList);
+  begin
+    if (target_info.system = system_powerpc64_darwin) and
+       (cs_create_pic in current_settings.moduleswitches) then
+      begin
+        got := cg.getaddressregister(list);
+      end;
+  end;
+
 begin
   cprocinfo := tppcprocinfo;
 end.

compiler/powerpc64/rappcgas.pas

@@ -151,6 +151,8 @@ procedure tppcattreader.BuildReference(oper: tppcoperand);
 
 var
   l: aint;
+  relsym: string;
+  asmsymtyp: tasmsymtype;
 
 begin
   Consume(AS_LPAREN);
@@ -207,20 +209,50 @@ begin
     AS_ID:
       begin
         ReadSym(oper);
-        { add a constant expression? }
-        if (actasmtoken = AS_PLUS) then
-        begin
-          l := BuildConstExpression(true, true);
-          case oper.opr.typ of
-            OPR_CONSTANT:
-              inc(oper.opr.val, l);
-            OPR_LOCAL:
-              inc(oper.opr.localsymofs, l);
-            OPR_REFERENCE:
-              inc(oper.opr.ref.offset, l);
-          else
-            internalerror(200309202);
-          end;
+        case actasmtoken of
+          AS_PLUS:
+            begin
+              { add a constant expression? }
+              l:=BuildConstExpression(true,true);
+              case oper.opr.typ of
+                OPR_CONSTANT :
+                  inc(oper.opr.val,l);
+                OPR_LOCAL :
+                  inc(oper.opr.localsymofs,l);
+                OPR_REFERENCE :
+                  inc(oper.opr.ref.offset,l);
+                else
+                  internalerror(200309202);
+              end;
+            end;
+          AS_MINUS:
+            begin
+              Consume(AS_MINUS);
+              BuildConstSymbolExpression(false,true,false,l,relsym,asmsymtyp);
+              if (relsym<>'') then
+                begin
+                  if (oper.opr.typ = OPR_REFERENCE) then
+                    oper.opr.ref.relsymbol:=current_asmdata.RefAsmSymbol(relsym)
+                  else
+                    begin
+                      Message(asmr_e_invalid_reference_syntax);
+                      RecoverConsume(false);
+                    end
+                end
+              else
+                begin
+                  case oper.opr.typ of
+                    OPR_CONSTANT :
+                      dec(oper.opr.val,l);
+                    OPR_LOCAL :
+                      dec(oper.opr.localsymofs,l);
+                    OPR_REFERENCE :
+                      dec(oper.opr.ref.offset,l);
+                    else
+                      internalerror(2007092601);
+                  end;
+                end;
+            end;
         end;
         Consume(AS_RPAREN);
         if actasmtoken = AS_AT then

compiler/ppcgen/cgppc.pas

@@ -61,10 +61,18 @@ unit cgppc;
         procedure a_jmp_cond(list : TAsmList;cond : TOpCmp;l: tasmlabel);
 
         procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override;
+
+        procedure g_maybe_got_init(list: TAsmList); override;
        protected
         function  get_darwin_call_stub(const s: string): tasmsymbol;
         procedure a_load_subsetref_regs_noindex(list: TAsmList; subsetsize: tcgsize; loadbitsize: byte; const sref: tsubsetreference; valuereg, extra_value_reg: tregister); override;
-        function  fixref(list: TAsmList; var ref: treference): boolean; virtual; abstract;
+        { Make sure ref is a valid reference for the PowerPC and sets the }
+        { base to the value of the index if (base = R_NO).                }
+        { Returns true if the reference contained a base, index and an    }
+        { offset or symbol, in which case the base will have been changed }
+        { to a tempreg (which has to be freed by the caller) containing   }
+        { the sum of part of the original reference                       }
+        function  fixref(list: TAsmList; var ref: treference): boolean;
         { contains the common code of a_load_reg_ref and a_load_ref_reg }
         procedure a_load_store(list:TAsmList;op: tasmop;reg:tregister;ref: treference);virtual;
 
@@ -77,6 +85,10 @@ unit cgppc;
         { represented by a 16 bit immediate as required by some PowerPC }
         { instructions                                                  }
         function hasLargeOffset(const ref : TReference) : Boolean; inline;
+
+        function save_lr_in_prologue: boolean;
+
+        function load_got_symbol(list : TAsmList; symbol : string) : tregister;
      end;
 
   const
@@ -98,6 +110,16 @@ unit cgppc;
       end;
 
 
+    function tcgppcgen.save_lr_in_prologue: boolean;
+      begin
+        result:=
+        (not (po_assembler in current_procinfo.procdef.procoptions) and
+         ((pi_do_call in current_procinfo.flags) or 
+          (cs_profile in init_settings.moduleswitches)))  or
+        ([cs_lineinfo,cs_debuginfo] * current_settings.moduleswitches <> []);
+      end;
+
+
     procedure tcgppcgen.a_param_const(list: TAsmList; size: tcgsize; a: aint; const
       paraloc: tcgpara);
     var
@@ -145,11 +167,54 @@ unit cgppc;
       end;
 
 
+    procedure tcgppcgen.g_maybe_got_init(list: TAsmList);
+      var
+         instr: taicpu;
+         cond: tasmcond;
+        savedlr: boolean;
+      begin
+        if not(po_assembler in current_procinfo.procdef.procoptions) then
+          begin
+            if (cs_create_pic in current_settings.moduleswitches) and
+               (pi_needs_got in current_procinfo.flags) then
+              case target_info.system of
+                system_powerpc_darwin,
+                system_powerpc64_darwin:
+                  begin
+                    savedlr:=save_lr_in_prologue;
+                    if not savedlr then
+                      list.concat(taicpu.op_reg_reg(A_MFSPR,NR_R0,NR_LR));
+                    fillchar(cond,sizeof(cond),0);
+                    cond.simple:=false;
+                    cond.bo:=20;
+                    cond.bi:=31;
+                    instr:=taicpu.op_sym(A_BCL,current_procinfo.CurrGOTLabel);
+                    instr.setcondition(cond);
+                    list.concat(instr);
+                    a_label(list,current_procinfo.CurrGOTLabel);
+                    a_reg_alloc(list,current_procinfo.got);
+                    list.concat(taicpu.op_reg_reg(A_MFSPR,current_procinfo.got,NR_LR));
+                    if not savedlr or
+                       { in the following case lr is saved, but not restored }
+                       { (happens e.g. when generating debug info for leaf   }
+                       { procedures)                                         }
+                       not(pi_do_call in current_procinfo.flags) then
+                      list.concat(taicpu.op_reg_reg(A_MTSPR,NR_LR,NR_R0));
+                  end;
+              end;
+          end;
+      end;
+
+
     function tcgppcgen.get_darwin_call_stub(const s: string): tasmsymbol;
       var
         stubname: string;
+        instr: taicpu;
         href: treference;
         l1: tasmsymbol;
+        localgotlab: tasmlabel;
+        cond: tasmcond;
+        stubalign: byte;
       begin
         { function declared in the current unit? }
         { doesn't work correctly, because this will also return a hit if we }
@@ -164,14 +229,36 @@ unit cgppc;
           current_asmdata.asmlists[al_imports]:=TAsmList.create;
 
         current_asmdata.asmlists[al_imports].concat(Tai_section.create(sec_stub,'',0));
-        current_asmdata.asmlists[al_imports].concat(Tai_align.Create(16));
+        if (cs_create_pic in current_settings.moduleswitches) then
+          stubalign:=32
+        else
+          stubalign:=16;
+        current_asmdata.asmlists[al_imports].concat(Tai_align.Create(stubalign));
         result := current_asmdata.RefAsmSymbol(stubname);
         current_asmdata.asmlists[al_imports].concat(Tai_symbol.Create(result,0));
         current_asmdata.asmlists[al_imports].concat(tai_directive.create(asd_indirect_symbol,s));
         l1 := current_asmdata.RefAsmSymbol('L'+s+'$lazy_ptr');
         reference_reset_symbol(href,l1,0);
         href.refaddr := addr_higha;
-        current_asmdata.asmlists[al_imports].concat(taicpu.op_reg_ref(A_LIS,NR_R11,href));
+        if (cs_create_pic in current_settings.moduleswitches) then
+          begin
+            current_asmdata.getjumplabel(localgotlab);
+            href.relsymbol:=localgotlab;
+            fillchar(cond,sizeof(cond),0);
+            cond.simple:=false;
+            cond.bo:=20;
+            cond.bi:=31;
+            current_asmdata.asmlists[al_imports].concat(taicpu.op_reg(A_MFLR,NR_R0));
+            instr:=taicpu.op_sym(A_BCL,localgotlab);
+            instr.setcondition(cond);
+            current_asmdata.asmlists[al_imports].concat(instr);
+            a_label(current_asmdata.asmlists[al_imports],localgotlab);
+            current_asmdata.asmlists[al_imports].concat(taicpu.op_reg(A_MFLR,NR_R11));
+            current_asmdata.asmlists[al_imports].concat(taicpu.op_reg_reg_ref(A_ADDIS,NR_R11,NR_R11,href));
+            current_asmdata.asmlists[al_imports].concat(taicpu.op_reg(A_MTLR,NR_R0));
+          end
+        else
+          current_asmdata.asmlists[al_imports].concat(taicpu.op_reg_ref(A_LIS,NR_R11,href));
         href.refaddr := addr_low;
         href.base := NR_R11;
 {$ifndef cpu64bit}
@@ -611,6 +698,125 @@ unit cgppc;
       end;
 
 
+    function tcgppcgen.load_got_symbol(list: TAsmList; symbol : string) : tregister;
+    var
+      l: tasmsymbol;
+      ref: treference;
+    begin
+      if (target_info.system <> system_powerpc64_linux) then
+        internalerror(2007102010);
+      l:=current_asmdata.getasmsymbol(symbol);
+      reference_reset_symbol(ref,l,0);
+      ref.base := NR_R2;
+      ref.refaddr := addr_pic;
+    
+      result := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE);
+      {$IFDEF EXTDEBUG}
+      list.concat(tai_comment.create(strpnew('loading got reference for ' + symbol)));
+      {$ENDIF EXTDEBUG}
+    //  cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,ref,result);
+      
+{$ifdef cpu64bit}
+      list.concat(taicpu.op_reg_ref(A_LD, result, ref));
+{$else cpu64bit}
+      list.concat(taicpu.op_reg_ref(A_LWZ, result, ref));
+{$endif cpu64bit}
+    end;
+    
+    
+    function tcgppcgen.fixref(list: TAsmList; var ref: treference): boolean;
+      var
+        tmpreg: tregister;
+      begin
+        result := false;
+
+        { Avoid recursion. }
+        if (ref.refaddr = addr_pic) then
+          exit;
+
+        {$IFDEF EXTDEBUG}
+        list.concat(tai_comment.create(strpnew('fixref0 ' + ref2string(ref))));
+        {$ENDIF EXTDEBUG}
+        if (target_info.system in [system_powerpc_darwin,system_powerpc64_darwin]) and
+           assigned(ref.symbol) and
+           not assigned(ref.relsymbol) and
+           ((ref.symbol.bind = AB_EXTERNAL) or
+            (cs_create_pic in current_settings.moduleswitches))then
+          begin
+            if (ref.symbol.bind = AB_EXTERNAL) or
+               ((cs_create_pic in current_settings.moduleswitches) and
+                (ref.symbol.bind in [AB_COMMON,AB_GLOBAL])) then
+              begin
+                tmpreg := g_indirect_sym_load(list,ref.symbol.name);
+                ref.symbol:=nil;
+              end
+            else
+              begin
+                include(current_procinfo.flags,pi_needs_got);
+                tmpreg := current_procinfo.got;
+                if assigned(ref.relsymbol) then
+                  internalerror(2007093501);
+                ref.relsymbol := current_procinfo.CurrGOTLabel;
+              end;
+            if (ref.base = NR_NO) then
+              ref.base := tmpreg
+            else if (ref.index = NR_NO) then
+              ref.index := tmpreg
+            else
+              begin
+                list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,ref.base,tmpreg));
+                ref.base := tmpreg;
+              end;
+          end;
+
+        { if we have to create PIC, add the symbol to the TOC/GOT }
+        if (target_info.system = system_powerpc64_linux) and
+           (cs_create_pic in current_settings.moduleswitches) and 
+           (assigned(ref.symbol)) then
+          begin
+            tmpreg := load_got_symbol(list, ref.symbol.name);
+            if (ref.base = NR_NO) then
+              ref.base := tmpreg
+            else if (ref.index = NR_NO) then
+              ref.index := tmpreg
+            else begin
+              a_op_reg_reg_reg(list, OP_ADD, OS_ADDR, ref.base, tmpreg, tmpreg);
+              ref.base := tmpreg;
+            end;
+            ref.symbol := nil;
+            {$IFDEF EXTDEBUG}
+            list.concat(tai_comment.create(strpnew('fixref-pic ' + ref2string(ref))));
+            {$ENDIF EXTDEBUG}
+          end;
+
+        if (ref.base = NR_NO) then
+          begin
+            ref.base := ref.index;
+            ref.index := NR_NO;
+          end;
+        if (ref.base <> NR_NO) then
+          begin
+            if (ref.index <> NR_NO) and
+               ((ref.offset <> 0) or assigned(ref.symbol)) then
+              begin
+                result := true;
+                tmpreg := rg[R_INTREGISTER].getregister(list,R_SUBWHOLE);
+                list.concat(taicpu.op_reg_reg_reg(
+                  A_ADD,tmpreg,ref.base,ref.index));
+                ref.index := NR_NO;
+                ref.base := tmpreg;
+              end
+          end;
+        if (ref.index <> NR_NO) and
+           (assigned(ref.symbol) or
+            (ref.offset <> 0)) then
+          internalerror(200208102);
+        {$IFDEF EXTDEBUG}
+        list.concat(tai_comment.create(strpnew('fixref1 ' + ref2string(ref))));
+        {$ENDIF EXTDEBUG}
+       end;
+
+
     procedure tcgppcgen.a_load_store(list:TAsmList;op: tasmop;reg:tregister;
        ref: treference);
 

compiler/procinfo.pas

@@ -115,6 +115,9 @@ unit procinfo;
 
           { Generate parameter information }
           procedure generate_parameter_info;virtual;
+
+          { Allocate got register }
+          procedure allocate_got_register(list: TAsmList);virtual;
        end;
        tcprocinfo = class of tprocinfo;
 
@@ -193,4 +196,10 @@ implementation
       end;
 
 
+    procedure tprocinfo.allocate_got_register(list: TAsmList);
+      begin
+        { most os/cpu combo's don't use this yet, so not yet abstract }
+      end;
+
+
 end.

compiler/psub.pas

@@ -826,6 +826,9 @@ implementation
             set_first_temp_offset;
             generate_parameter_info;
 
+            { allocate got register if needed }
+            current_procinfo.allocate_got_register(aktproccode);
+
             { Allocate space in temp/registers for parast and localst }
             current_filepos:=entrypos;
             gen_alloc_symtable(aktproccode,procdef.parast);
@@ -845,9 +848,10 @@ implementation
             current_filepos:=entrypos;
             { record which registers are allocated here, since all code }
             { allocating registers comes after it                       }
-            cg.set_regalloc_extend_backwards(true);
+            cg.set_regalloc_live_range_direction(rad_backwards);
+
             gen_load_para_value(templist);
-            cg.set_regalloc_extend_backwards(false);
+            cg.set_regalloc_live_range_direction(rad_forward);
 
             { caller paraloc info is also necessary in the stackframe_entry
               code of the ppc (and possibly other processors)               }
@@ -872,7 +876,7 @@ implementation
             current_filepos:=entrypos;
             current_settings.localswitches:=entryswitches;
 
-            cg.set_regalloc_extend_backwards(true);
+            cg.set_regalloc_live_range_direction(rad_backwards);
 
             gen_entry_code(templist);
             aktproccode.insertlistafter(entry_asmnode.currenttai,templist);
@@ -884,7 +888,7 @@ implementation
             current_filepos:=exitpos;
             current_settings.localswitches:=exitswitches;
 
-            cg.set_regalloc_extend_backwards(false);
+            cg.set_regalloc_live_range_direction(rad_forward);
 
             gen_finalize_code(templist);
             { the finalcode must be concated if there was no position available,
@@ -927,6 +931,14 @@ implementation
             { Free space in temp/registers for parast and localst, must be
               done after gen_entry_code }
             current_filepos:=exitpos;
+
+            { make sure the got/pic register doesn't get freed in the }
+            { middle of a loop                                        }
+            if (cs_create_pic in current_settings.moduleswitches) and
+               (pi_needs_got in current_procinfo.flags) and
+               (current_procinfo.got<>NR_NO) then
+              cg.a_reg_sync(aktproccode,current_procinfo.got);
+
             gen_free_symtable(aktproccode,procdef.localst);
             gen_free_symtable(aktproccode,procdef.parast);
 
@@ -947,13 +959,27 @@ implementation
                 aktproccode.insertlistafter(stackcheck_asmnode.currenttai,templist)
               end;
 
-            { load got if necessary }
-            cg.set_regalloc_extend_backwards(true);
+            { this code (got loading) comes before everything which has }
+            { already been generated, so reset the info about already   }
+            { backwards extended registers (so their live range can be  }
+            { extended backwards even further if needed)                }
+            { This code must be                                         }
+            {  a) generated after do_secondpass has been called         }
+            {     (because pi_needs_got may be set there)               }
+            {  b) generated before register allocation, because the     }
+            {     got/pic register can be a virtual one                 }
+            {  c) inserted before the entry code, because the entry     }
+            {     code may need global symbols such as init rtti        }
+            {  d) inserted after the stackframe allocation, because     }
+            {     this register may have to be spilled                  }
+            cg.set_regalloc_live_range_direction(rad_backwards_reinit);
             current_filepos:=entrypos;
-            gen_got_load(templist);
+            { load got if necessary }
+            cg.g_maybe_got_init(templist);
+
             aktproccode.insertlistafter(headertai,templist);
 
-            cg.set_regalloc_extend_backwards(false);
+            cg.set_regalloc_live_range_direction(rad_forward);
 
             { The procedure body is finished, we can now
               allocate the registers }
@@ -965,6 +991,11 @@ implementation
               maintain location lists }
             current_procinfo.procdef.parast.SymList.ForEachCall(@translate_registers,templist);
             current_procinfo.procdef.localst.SymList.ForEachCall(@translate_registers,templist);
+            if (cs_create_pic in current_settings.moduleswitches) and
+               (pi_needs_got in current_procinfo.flags) and
+               not(cs_no_regalloc in current_settings.globalswitches) and
+               (current_procinfo.got<>NR_NO) then
+              cg.translate_register(current_procinfo.got);
 
             { Add save and restore of used registers }
             current_filepos:=entrypos;

compiler/rgobj.pas

@@ -175,7 +175,7 @@ unit rgobj;
                                       const r:Tsuperregisterset;
                                       const spilltemplist:Tspill_temp_list): boolean;virtual;
       private
-        do_extend_live_range_backwards: boolean;
+        int_live_range_direction: TRADirection;
         {# First imaginary register.}
         first_imaginary   : Tsuperregister;
         {# Highest register allocated until now.}
@@ -236,9 +236,9 @@ unit rgobj;
         procedure select_spill;
         procedure assign_colours;
         procedure clear_interferences(u:Tsuperregister);
-        procedure set_live_range_backwards(b: boolean);
+        procedure set_live_range_direction(dir: TRADirection);
        public
-        property extend_live_range_backwards: boolean read do_extend_live_range_backwards write set_live_range_backwards;
+        property live_range_direction: TRADirection read int_live_range_direction write set_live_range_direction;
       end;
 
     const
@@ -370,8 +370,9 @@ unit rgobj;
          { empty super register sets can cause very strange problems }
          if high(Ausable)=-1 then
            internalerror(200210181);
-         extend_live_range_backwards := false;
+         live_range_direction:=rad_forward;
          supregset_reset(extended_backwards,false,high(tsuperregister));
+         supregset_reset(backwards_was_first,false,high(tsuperregister));
          first_imaginary:=Afirst_imaginary;
          maxreg:=Afirst_imaginary;
          regtype:=Aregtype;
@@ -678,16 +679,18 @@ unit rgobj;
     end;
 
 
-    procedure trgobj.set_live_range_backwards(b: boolean);
+    procedure trgobj.set_live_range_direction(dir: TRADirection);
       begin
-        if (b) then
+        if (dir in [rad_backwards,rad_backwards_reinit]) then
           begin
+            if (dir=rad_backwards_reinit) then
+              supregset_reset(extended_backwards,false,high(tsuperregister));
+            int_live_range_direction:=rad_backwards;
             { new registers may be allocated }
             supregset_reset(backwards_was_first,false,high(tsuperregister));
-            do_extend_live_range_backwards := true;
           end
         else
-          do_extend_live_range_backwards := false;
+          int_live_range_direction:=rad_forward;
       end;
 
 
@@ -704,7 +707,7 @@ unit rgobj;
         if supreg>=first_imaginary then
           with reginfo[supreg] do
             begin
-              if not(extend_live_range_backwards) then
+              if (live_range_direction=rad_forward) then
                 begin
                   if not assigned(live_start) then
                     live_start:=instr;

compiler/systems.pas

@@ -310,7 +310,8 @@ interface
             tf_dwarf_relative_addresses,         // use offsets where the Dwarf spec requires this instead of absolute addresses (the latter is needed by Linux binutils)
             tf_dwarf_only_local_labels,          // only use local labels inside the Dwarf debug_info section (needed for e.g. Darwin)
             tf_requires_proper_alignment,
-            tf_no_pic_supported
+            tf_no_pic_supported,
+            tf_pic_default
        );
 
        psysteminfo = ^tsysteminfo;

compiler/systems/i_bsd.pas

@@ -399,7 +399,7 @@ unit i_bsd;
             system       : system_powerpc_darwin;
             name         : 'Darwin for PowerPC';
             shortname    : 'Darwin';
-            flags        : [tf_p_ext_support,tf_files_case_aware,tf_smartlink_sections,tf_dwarf_relative_addresses,tf_dwarf_only_local_labels];
+            flags        : [tf_p_ext_support,tf_files_case_aware,tf_smartlink_sections,tf_dwarf_relative_addresses,tf_dwarf_only_local_labels,tf_pic_default];
             cpu          : cpu_powerpc;
             unit_env     : 'BSDUNITS';
             extradefines : 'UNIX;BSD;HASUNIX';
@@ -460,7 +460,7 @@ unit i_bsd;
             system       : system_i386_darwin;
             name         : 'Darwin for i386';
             shortname    : 'Darwin';
-            flags        : [tf_p_ext_support,tf_files_case_aware,tf_smartlink_sections,tf_dwarf_relative_addresses,tf_dwarf_only_local_labels];
+            flags        : [tf_p_ext_support,tf_files_case_aware,tf_smartlink_sections,tf_dwarf_relative_addresses,tf_dwarf_only_local_labels,tf_pic_uses_got,tf_pic_default];
             cpu          : cpu_i386;
             unit_env     : 'BSDUNITS';
             extradefines : 'UNIX;BSD;HASUNIX';
@@ -520,7 +520,7 @@ unit i_bsd;
             system       : system_powerpc64_darwin;
             name         : 'Darwin for PowerPC64';
             shortname    : 'Darwin';
-            flags        : [tf_p_ext_support,tf_files_case_aware,tf_smartlink_sections,tf_dwarf_relative_addresses,tf_dwarf_only_local_labels];
+            flags        : [tf_p_ext_support,tf_files_case_aware,tf_smartlink_sections,tf_dwarf_relative_addresses,tf_dwarf_only_local_labels,tf_pic_default];
             cpu          : cpu_powerpc64;
             unit_env     : 'BSDUNITS';
             extradefines : 'UNIX;BSD;HASUNIX';

compiler/x86/agx86att.pas

@@ -113,6 +113,8 @@ interface
              owner.AsmWrite(gas_regname(segment)+':');
            if assigned(symbol) then
              owner.AsmWrite(symbol.name);
+           if assigned(relsymbol) then
+             owner.AsmWrite('-'+relsymbol.name);
            if ref.refaddr=addr_pic then
 {$ifdef x86_64}
              owner.AsmWrite('@GOTPCREL');

compiler/x86/agx86int.pas

@@ -60,7 +60,7 @@ implementation
       line_length = 70;
 
       secnames : array[TAsmSectiontype] of string[4] = ('',
-        'CODE','DATA','DATA','BSS','',
+        'CODE','DATA','DATA','DATA','BSS','',
         '','','','','','',
         '','','','',
         '',
@@ -72,7 +72,7 @@ implementation
       );
 
       secnamesml64 : array[TAsmSectiontype] of string[7] = ('',
-        '_TEXT','_DATE','_DATA','_BSS','',
+        '_TEXT','_DATE','_DATA','_DATA','_BSS','',
         '','','','',
         'idata$2','idata$4','idata$5','idata$6','idata$7','edata',
         '',

compiler/x86/cgx86.pas

@@ -347,6 +347,9 @@ unit cgx86;
       var
         hreg : tregister;
         href : treference;
+{$ifndef x86_64}
+        add_hreg: boolean;
+{$endif not  x86_64}
       begin
 {$ifdef x86_64}
         { Only 32bit is allowed }
@@ -403,18 +406,45 @@ unit cgx86;
               end;
           end;
 {$else x86_64}
-        if (cs_create_pic in current_settings.moduleswitches) and
-          assigned(ref.symbol) and not((ref.symbol.bind=AB_LOCAL) and (ref.symbol.typ in [AT_LABEL,AT_FUNCTION])) then
+        add_hreg:=false;
+        if (target_info.system=system_i386_darwin) then
+          begin
+            if assigned(ref.symbol) and
+               not(assigned(ref.relsymbol)) and
+               ((ref.symbol.bind = AB_EXTERNAL) or
+                (cs_create_pic in current_settings.moduleswitches)) then
+             begin
+               if (ref.symbol.bind = AB_EXTERNAL) or
+                  ((cs_create_pic in current_settings.moduleswitches) and
+                   (ref.symbol.bind in [AB_COMMON,AB_GLOBAL])) then
+                 begin
+                   hreg:=g_indirect_sym_load(list,ref.symbol.name);
+                   ref.symbol:=nil;
+                 end
+               else
+                 begin
+                   include(current_procinfo.flags,pi_needs_got);
+                   hreg:=current_procinfo.got;
+                   ref.relsymbol:=current_procinfo.CurrGOTLabel;
+                 end;
+               add_hreg:=true
+             end
+          end
+        else if (cs_create_pic in current_settings.moduleswitches) and
+           assigned(ref.symbol) and
+           not((ref.symbol.bind=AB_LOCAL) and
+               (ref.symbol.typ in [AT_LABEL,AT_FUNCTION])) then
           begin
-            reference_reset_symbol(href,ref.symbol,0);
-            hreg:=getaddressregister(list);
             href.refaddr:=addr_pic;
             href.base:=current_procinfo.got;
             include(current_procinfo.flags,pi_needs_got);
             list.concat(taicpu.op_ref_reg(A_MOV,S_L,href,hreg));
-
             ref.symbol:=nil;
+            add_hreg:=true;
+          end;
 
+        if add_hreg then
+          begin
             if ref.base=NR_NO then
               ref.base:=hreg
             else if ref.index=NR_NO then
@@ -537,8 +567,17 @@ unit cgx86;
 ****************************************************************************}
 
     procedure tcgx86.a_jmp_name(list : TAsmList;const s : string);
+      var
+        r: treference;
       begin
-        list.concat(taicpu.op_sym(A_JMP,S_NO,current_asmdata.RefAsmSymbol(s)));
+        if (target_info.system<>system_i386_darwin) then
+          list.concat(taicpu.op_sym(A_JMP,S_NO,current_asmdata.RefAsmSymbol(s)))
+        else
+          begin 
+            reference_reset_symbol(r,get_darwin_call_stub(s),0);
+            r.refaddr:=addr_full;
+            list.concat(taicpu.op_ref(A_JMP,S_NO,r));
+          end;
       end;
 
 
@@ -770,7 +809,29 @@ unit cgx86;
               begin
                 if assigned(ref.symbol) then
                   begin
-                    if (cs_create_pic in current_settings.moduleswitches) then
+                    if (target_info.system=system_i386_darwin) and
+                       ((ref.symbol.bind = AB_EXTERNAL) or
+                        (cs_create_pic in current_settings.moduleswitches)) then
+                      begin
+                        if (ref.symbol.bind = AB_EXTERNAL) or
+                           ((cs_create_pic in current_settings.moduleswitches) and
+                            (ref.symbol.bind in [AB_COMMON,AB_GLOBAL])) then
+                          begin
+                             reference_reset_base(tmpref,
+                               g_indirect_sym_load(list,ref.symbol.name),
+                               offset);
+                             a_loadaddr_ref_reg(list,tmpref,r);
+                          end
+                       else
+                         begin
+                           include(current_procinfo.flags,pi_needs_got);
+                           reference_reset_base(tmpref,current_procinfo.got,offset);
+                           tmpref.symbol:=symbol;
+                           tmpref.relsymbol:=current_procinfo.CurrGOTLabel;
+                           list.concat(Taicpu.op_ref_reg(A_LEA,tcgsize2opsize[OS_ADDR],tmpref,r));
+                         end;
+                      end
+                    else if (cs_create_pic in current_settings.moduleswitches) then
                       begin
 {$ifdef x86_64}
                         reference_reset_symbol(tmpref,ref.symbol,0);
@@ -1986,6 +2047,13 @@ unit cgx86;
         ref : treference;
         sym : tasmsymbol;
       begin
+       if (target_info.system=system_i386_darwin) then
+         begin
+           { a_jmp_name jumps to a stub which is always pic-safe on darwin }
+           inherited g_external_wrapper(list,procdef,externalname);
+           exit;
+         end;
+
         sym:=current_asmdata.RefAsmSymbol(externalname);
         reference_reset_symbol(ref,sym,0);
 
@@ -1995,8 +2063,8 @@ unit cgx86;
             { it could be that we're called from a procedure not having the
               got loaded
             }
-            gen_got_load(list);
-            ref.refaddr:=addr_pic;
+            g_maybe_got_init(list);
+            ref.refaddr:=addr_pic
           end
         else
           ref.refaddr:=addr_full;

rtl/i386/i386.inc

@@ -1219,16 +1219,24 @@ const
 
 {$define FPC_SYSTEM_HAS_SYSRESETFPU}
 Procedure SysResetFPU;{$ifdef SYSTEMINLINE}inline;{$endif}
+  var
+    { these locals are so we don't have to hack pic code in the assembler }
+    localmxcsr: dword;
+    localfpucw: word;
   begin
+    localfpucw:=Default8087CW;
     asm
       fninit
-      fldcw   Default8087CW
+      fldcw   localfpucw
       fwait
     end;
     if has_sse_support then
-      asm
-       { setup sse exceptions }
-       ldmxcsr mxcsr
+      begin
+        localmxcsr:=mxcsr;
+        asm
+          { setup sse exceptions }
+          ldmxcsr localmxcsr
+        end;
       end;
     softfloat_exception_flags:=0;
     softfloat_exception_mask:=float_flag_underflow or float_flag_inexact or float_flag_denormal;

rtl/i386/math.inc

@@ -17,14 +17,15 @@
                             FPU Control word
  ****************************************************************************}
 
-    procedure Set8087CW(cw:word);assembler;
-      asm
-{$ifndef REGCALL}
-        movw cw,%ax
-{$endif}
-        movw %ax,default8087cw
-        fnclex
-        fldcw default8087cw
+    procedure Set8087CW(cw:word);
+      begin
+        { pic-safe ; cw will not be a regvar because it's accessed from }
+        { assembler                                                     }
+        default8087cw:=cw;
+        asm
+          fnclex
+          fldcw cw
+        end;
       end;
 
 
@@ -120,20 +121,22 @@
 
   {$define FPC_SYSTEM_HAS_EXP}
     function fpc_exp_real(d : ValReal) : ValReal;assembler;compilerproc;
+      var
+        cw1,cw2: word;
       asm
         // comes from DJ GPP
         fldt        d
         fldl2e
         fmulp       %st,%st(1)
-        fstcw      .LCW1
-        fstcw      .LCW2
+        fstcw       CW1
+        fstcw       CW2
         fwait
-        andw        $0xf3ff,.LCW2
-        orw         $0x0400,.LCW2
-        fldcw      .LCW2
+        andw        $0xf3ff,CW2
+        orw         $0x0400,CW2
+        fldcw       CW2
         fld         %st(0)
         frndint
-        fldcw      .LCW1
+        fldcw       CW1
         fxch        %st(1)
         fsub        %st(1),%st
         f2xm1
@@ -142,15 +145,6 @@
         fscale
         fstp        %st(1)
         fclex
-        jmp         .LCW3
-        // store some help data in the data segment
-    .data
-    .LCW1:
-        .word       0
-    .LCW2:
-        .word       0
-    .text
-    .LCW3:
      end;
 
 

rtl/powerpc/math.inc

@@ -75,12 +75,26 @@ const
         fabs    f1,f1
         // load 2^32 in f2
         {$ifndef macos}
+        {$ifdef FPC_PIC}
+        {$ifdef darwin}
+        mflr   r0
+        bcl    20,31,.Lpiclab
+.Lpiclab:
+        mflr   r5
+        mtlr   r0
+        addis  r4,r5,(factor-.Lpiclab)@ha
+        lfd    f2,(factor-.Lpiclab)@l(r4)
+        {$else darwin}
+        {$error Add pic code for linux/ppc32}
+        {$endif darwin}
+        {$else FPC_PIC}
         lis    r4,factor@ha
         lfd    f2,factor@l(r4)
-        {$else}
+        {$endif FPC_PIC}
+        {$else not macos}
         lwz    r4,factor(r2)
         lfd    f2,0(r4)
-        {$endif}
+        {$endif not macos}
         // check if value is < 0
         // f3 := d / 2^32;
         fdiv     f3,f1,f2
@@ -96,12 +110,21 @@ const
         xoris    r0,r3,0x8000
         stw      r0,temp+4
         {$ifndef macos}
+        {$ifdef FPC_PIC}
+        {$ifdef darwin}
+        addis  r4,r5,(longint_to_real_helper-.Lpiclab)@ha
+        lfd    f0,(longint_to_real_helper-.Lpiclab)@l(r4)
+        {$else darwin}
+        {$error Add pic code for linux/ppc32}
+        {$endif darwin}
+        {$else FPC_PIC}
         lis    r4,longint_to_real_helper@ha
         lfd    f0,longint_to_real_helper@l(r4)
-        {$else}
+        {$endif FPC_PIC}
+        {$else not macos}
         lwz    r4,longint_to_real_helper(r2)
         lfd    f0,0(r4)
-        {$endif}
+        {$endif not macos}
         lfd    f3,temp
         fsub   f3,f3,f0
 
@@ -113,12 +136,21 @@ const
 
         // load 2^31 in f2
         {$ifndef macos}
+        {$ifdef FPC_PIC}
+        {$ifdef darwin}
+        addis  r4,r5,(factor2-.Lpiclab)@ha
+        lfd    f2,(factor2-.Lpiclab)@l(r4)
+        {$else darwin}
+        {$error Add pic code for linux/ppc32}
+        {$endif darwin}
+        {$else FPC_PIC}
         lis    r4,factor2@ha
         lfd    f2,factor2@l(r4)
-        {$else}
+        {$endif FPC_PIC}
+        {$else not macos}
         lwz    r4,factor2(r2)
         lfd    f2,0(r4)
-        {$endif}
+        {$endif not macos}
 
         // subtract 2^31
         fsub   f3,f4,f2
@@ -261,28 +293,54 @@ asm
            xoris  r3,r3,0x8000
            stw    r3,temp+4
            {$ifndef macos}
+           {$ifdef FPC_PIC}
+           {$ifdef darwin}
+           mflr   r0
+           bcl    20,31,.Lpiclab
+ .Lpiclab:
+           mflr   r5
+           mtlr   r0
+           addis  r3,r5,(longint_to_real_helper-.Lpiclab)@ha
+           lfd    f1,(longint_to_real_helper-.Lpiclab)@l(r3)
+           {$else darwin}
+           {$error Add pic code for linux/ppc32}
+           {$endif darwin}
+           {$else FPC_PIC}
            lis    r3,longint_to_real_helper@ha
            lfd    f1,longint_to_real_helper@l(r3)
-           {$else}
+           {$endif FPC_PIC}
+           {$else not macos}
            lwz    r3,longint_to_real_helper(r2)
            lfd    f1,0(r3)
-           {$endif}
+           {$endif not mac os}
            lfd    f0,temp
            stw    r4,temp+4
            fsub   f0,f0,f1
            {$ifndef macos}
+           {$ifdef FPC_PIC}
+           {$ifdef darwin}
+           addis  r4,r5,(cardinal_to_real_helper-.Lpiclab)@ha
+           lfd    f1,(cardinal_to_real_helper-.Lpiclab)@l(r4)
+           addis  r4,r5,(int_to_real_factor-.Lpiclab)@ha
+           lfd    f3,temp
+           lfd    f2,(int_to_real_factor-.Lpiclab)@l(r4)
+           {$else darwin}
+           {$error Add pic code for linux/ppc32}
+           {$endif darwin}
+           {$else FPC_PIC}
            lis    r4,cardinal_to_real_helper@ha
            lfd    f1,cardinal_to_real_helper@l(r4)
            lis    r4,int_to_real_factor@ha
            lfd    f3,temp
            lfd    f2,int_to_real_factor@l(r4)
-           {$else}
+           {$endif FPC_PIC}
+           {$else not macos}
            lwz    r4,cardinal_to_real_helper(r2)
            lwz    r3,int_to_real_factor(r2)
            lfd    f3,temp
            lfd    f1,0(r4)
            lfd    f2,0(r3)
-           {$endif}
+           {$endif not macos}
            fsub   f3,f3,f1
            fmadd  f1,f0,f2,f3
 end;
@@ -305,22 +363,45 @@ asm
            stw    r3,temp+4
            lfd    f0,temp
            {$ifndef macos}
+           {$ifdef FPC_PIC}
+           {$ifdef darwin}
+           mflr   r0
+           bcl    20,31,.Lpiclab
+ .Lpiclab:
+           mflr   r5
+           mtlr   r0
+           addis  r3,r5,(cardinal_to_real_helper-.Lpiclab)@ha
+           lfd    f1,(cardinal_to_real_helper-.Lpiclab)@l(r3)
+           {$else darwin}
+           {$error Add pic code for linux/ppc32}
+           {$endif darwin}
+           {$else FPC_PIC}
            lis    r3,cardinal_to_real_helper@ha
            lfd    f1,cardinal_to_real_helper@l(r3)
-           {$else}
+           {$endif FPC_PIC}
+           {$else not macos}
            lwz    r3,longint_to_real_helper(r2)
            lfd    f1,0(r3)
-           {$endif}
+           {$endif not macos}
            stw    r4,temp+4
            fsub   f0,f0,f1
            lfd    f3,temp
            {$ifndef macos}
+           {$ifdef FPC_PIC}
+           {$ifdef darwin}
+           addis  r4,r5,(int_to_real_factor-.Lpiclab)@ha
+           lfd    f2,(int_to_real_factor-.Lpiclab)@l(r4)
+           {$else darwin}
+           {$error Add pic code for linux/ppc32}
+           {$endif darwin}
+           {$else FPC_PIC}
            lis    r4,int_to_real_factor@ha
            lfd    f2,int_to_real_factor@l(r4)
-           {$else}
+           {$endif FPC_PIC}
+           {$else not macos}
            lwz    r4,int_to_real_factor(r2)
            lfd    f2,0(r4)
-           {$endif}
+           {$endif not macos}
            fsub   f3,f3,f1
            fmadd  f1,f0,f2,f3
 end;

rtl/powerpc64/math.inc

@@ -99,11 +99,21 @@ asm
   ori   r4, r4, longint_to_real_helper@highera
   sldi  r4, r4, 32
   oris  r4, r4, longint_to_real_helper@ha
-{$else darwin}
+  lfd   f4, longint_to_real_helper@l(r4)
+{$else not darwin}
+{$ifdef FPC_PIC}
+   mflr   r0
+   bcl    20,31,.Lpiclab
+.Lpiclab:
+   mflr   r5
+   mtlr   r0
+   addis  r4,r5,(longint_to_real_helper-.Lpiclab)@ha
+   lfd    f2,(longint_to_real_helper-.Lpiclab)@l(r4)
+{$else FPC_PIC}
   lis   r4, longint_to_real_helper@ha
-{$endif darwin}
   lfd   f4, longint_to_real_helper@l(r4)
-
+{$endif FPC_PIC}
+{$endif not darwin}
   rldicl r4,r3,32,32  // isolate high half
   rldicl r0,r3,0,32   // isolate low half
   std r4,temp1        // store dword both
@@ -114,4 +124,4 @@ asm
   fcfid f0,f0         // fpu int (no rnd)
   fmadd f0,f4,f2,f0   // (2**32)*high+low (only add can rnd)
 end;
- 
+

tests/test/tlibrary1.pp

@@ -1,6 +1,10 @@
 { %NORUN }
 { %SKIPTARGET=macos }
 
+{$ifdef darwin}
+{$PIC+}
+{$endif darwin}
+
 {$ifdef CPUX86_64}
 {$ifndef WINDOWS}
 {$PIC+}
@@ -32,7 +36,7 @@ const
 procedure Test;export;
 
  begin
-//   writeln('Hoi');
+   writeln('Hoi');
  end;
 
 exports

tests/test/tlibrary3.pp

@@ -1,6 +1,10 @@
 { %NORUN }
 { %SKIPTARGET=macos, win64 }
 
+{$ifdef darwin}
+{$PIC+}
+{$endif darwin}
+
 {$ifdef CPUX86_64}
 {$ifndef WINDOWS}
 {$PIC+}

tests/webtbs/tw2242.pp

@@ -7255,6 +7255,7 @@ s += chr(84);
 s += chr(85);
 s += chr(86);
 s += chr(87);
+{$ifndef fpc_pic}
 s += chr(88);
 s += chr(89);
 s += chr(90);
@@ -13077,5 +13078,6 @@ s += chr(81);
 s += chr(82);
 s += chr(83);
 {$endif cpuarm or cpusparc}
+{$endif not fpc_pic}
 writeln(s)
 END.

tests/webtbs/tw3082.pp

@@ -2,6 +2,11 @@
 { %cpu=x86_64,i386,powerpc,sparc}
 { %skiptarget = go32v2,macos }
 { execute this test only on reasonable fast cpus }
+
+{$ifdef darwin}
+{$PIC+}
+{$endif darwin}
+
 library lib;
 const
   s =

tests/webtbs/tw3573.pp

@@ -4,6 +4,10 @@
 
 {$ifdef fpc}{$mode delphi}{$endif}
 
+{$ifdef darwin}
+{$PIC+}
+{$endif darwin}
+
 resourcestring
   wurst = 'jo' deprecated;