Browse Source

* ppc64: with -Or the compiler now also generates calls to helper functions in the function prolog/epilog instead of multiple stores/loads
* ppc64: moved function prolog/epilog helper code into startup code
* ppc64: added FPU configuration code in math unit (fixes tw3161)

git-svn-id: trunk@1786 -

tom_at_work 19 years ago
parent
commit
651f34e27c

+ 171 - 101
compiler/powerpc64/cgcpu.pas

@@ -546,7 +546,7 @@ begin
     { call ptrgl helper routine which expects the pointer to the function descriptor
     { call ptrgl helper routine which expects the pointer to the function descriptor
     in R11 }
     in R11 }
     a_load_reg_reg(list, OS_ADDR, OS_ADDR, reg, NR_R11);
     a_load_reg_reg(list, OS_ADDR, OS_ADDR, reg, NR_R11);
-    a_call_name_direct(list, 'ptrgl', true, false);
+    a_call_name_direct(list, '.ptrgl', false, false);
   end;
   end;
 
 
   { we need to load the old RTOC from stackframe because we changed it}
   { we need to load the old RTOC from stackframe because we changed it}
@@ -1185,12 +1185,14 @@ end;
 
 
 procedure tcgppc.g_save_standard_registers(list: Taasmoutput);
 procedure tcgppc.g_save_standard_registers(list: Taasmoutput);
 begin
 begin
-  { this work is done in g_proc_entry }
+  { this work is done in g_proc_entry; additionally it is not safe 
+  to use it because it is called at some weird time }
 end;
 end;
 
 
 procedure tcgppc.g_restore_standard_registers(list: Taasmoutput);
 procedure tcgppc.g_restore_standard_registers(list: Taasmoutput);
 begin
 begin
-  { this work is done in g_proc_exit }
+  { this work is done in g_proc_exit; mainly because it is not safe to
+  put the register restore code here because it is called at some weird time }
 end;
 end;
 
 
 procedure tcgppc.calcFirstUsedFPR(out firstfpr : TSuperRegister; out fprcount : aint);
 procedure tcgppc.calcFirstUsedFPR(out firstfpr : TSuperRegister; out fprcount : aint);
@@ -1199,15 +1201,13 @@ var
 begin
 begin
   fprcount := 0;
   fprcount := 0;
   firstfpr := RS_F31;
   firstfpr := RS_F31;
-  if not (po_assembler in current_procinfo.procdef.procoptions) then begin
-    for reg := RS_F14 to RS_F31 do begin
+  if not (po_assembler in current_procinfo.procdef.procoptions) then
+    for reg := RS_F14 to RS_F31 do
       if reg in rg[R_FPUREGISTER].used_in_proc then begin
       if reg in rg[R_FPUREGISTER].used_in_proc then begin
         fprcount := ord(RS_F31)-ord(reg)+1;
         fprcount := ord(RS_F31)-ord(reg)+1;
         firstfpr := reg;
         firstfpr := reg;
         break;
         break;
       end;
       end;
-    end;
-  end;
 end;
 end;
 
 
 procedure tcgppc.calcFirstUsedGPR(out firstgpr : TSuperRegister; out gprcount : aint);
 procedure tcgppc.calcFirstUsedGPR(out firstgpr : TSuperRegister; out gprcount : aint);
@@ -1216,42 +1216,87 @@ var
 begin
 begin
   gprcount := 0;
   gprcount := 0;
   firstgpr := RS_R31;
   firstgpr := RS_R31;
-  if not (po_assembler in current_procinfo.procdef.procoptions) then begin
-    for reg := RS_R14 to RS_R31 do begin
+  if not (po_assembler in current_procinfo.procdef.procoptions) then
+    for reg := RS_R14 to RS_R31 do
       if reg in rg[R_INTREGISTER].used_in_proc then begin
       if reg in rg[R_INTREGISTER].used_in_proc then begin
         gprcount := ord(RS_R31)-ord(reg)+1;
         gprcount := ord(RS_R31)-ord(reg)+1;
         firstgpr := reg;
         firstgpr := reg;
         break;
         break;
       end;
       end;
-    end;
-  end;
 end;
 end;
 
 
+{ Generates the entry code of a procedure/function. 
+                                                                     
+ This procedure may be called before, as well as after g_return_from_proc
+ is called. localsize is the sum of the size necessary for local variables 
+ and the maximum possible combined size of ALL the parameters of a procedure 
+ called by the current one 
+
+ IMPORTANT: registers are not to be allocated through the register
+ allocator here, because the register colouring has already occured !! 
+}
 procedure tcgppc.g_proc_entry(list: taasmoutput; localsize: longint;
 procedure tcgppc.g_proc_entry(list: taasmoutput; localsize: longint;
   nostackframe: boolean);
   nostackframe: boolean);
-{ generated the entry code of a procedure/function. Note: localsize is the 
- sum of the size necessary for local variables and the maximum possible
- combined size of ALL the parameters of a procedure called by the current
- one.                                                                     
- This procedure may be called before, as well as after g_return_from_proc
- is called. NOTE registers are not to be allocated through the register
- allocator here, because the register colouring has already occured !! }
 var
 var
   firstregfpu, firstreggpr: TSuperRegister;
   firstregfpu, firstreggpr: TSuperRegister;
-  href: treference;
   needslinkreg: boolean;
   needslinkreg: boolean;
-  regcount : TSuperRegister;
 
 
   fprcount, gprcount : aint;
   fprcount, gprcount : aint;
 
 
-begin
-  { CR and LR only have to be saved in case they are modified by the current
-   procedure, but currently this isn't checked, so save them always        
-   following is the entry code as described in "Altivec Programming
-   Interface Manual", bar the saving of AltiVec registers }
-  a_reg_alloc(list, NR_STACK_POINTER_REG);
-  a_reg_alloc(list, NR_R0);
+  { Save standard registers, both FPR and GPR; does not support VMX/Altivec }
+  procedure save_standard_registers;
+  var
+    regcount : TSuperRegister;
+    href : TReference;
+    mayNeedLRStore : boolean;
+  begin
+    { 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_littlesize in aktglobalswitches) 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);
+        a_call_name_direct(list, '_savegpr1_' + intToStr(32-gprcount), false, false);
+        a_call_name_direct(list, '_savefpr_' + intToStr(32-fprcount), false, false);
+      end else if (gprcount > 0) then
+        a_call_name_direct(list, '_savegpr0_' + intToStr(32-gprcount), false, false)
+      else if (fprcount > 0) then
+        a_call_name_direct(list, '_savefpr_' + intToStr(32-fprcount), false, false)
+      else
+        mayNeedLRStore := true;
+    end else begin
+      { save registers, FPU first, then GPR }
+      reference_reset_base(href, NR_STACK_POINTER_REG, -8);
+      if (fprcount > 0) then
+        for regcount := RS_F31 downto firstregfpu do begin
+          a_loadfpu_reg_ref(list, OS_FLOAT, newreg(R_FPUREGISTER, regcount,
+            R_SUBNONE), href);
+          dec(href.offset, tcgsize2size[OS_FLOAT]);
+        end;
+      if (gprcount > 0) then
+        for regcount := RS_R31 downto firstreggpr do begin
+          a_load_reg_ref(list, OS_INT, OS_INT, newreg(R_INTREGISTER, regcount,
+            R_SUBNONE), href);
+          dec(href.offset, tcgsize2size[OS_INT]);
+        end;
+      { VMX registers not supported by FPC atm }
 
 
+      { in this branch we may always need to store LR ourselves}
+      mayNeedLRStore := true;
+    end;
+
+    { we may need to store R0 (=LR) ourselves }
+    if (mayNeedLRStore) and (needslinkreg) then begin
+      reference_reset_base(href, NR_STACK_POINTER_REG, LA_LR_ELF);
+      list.concat(taicpu.op_reg_ref(A_STD, NR_R0, href));
+    end;
+  end;
+
+var
+  href: treference;
+
+begin
   calcFirstUsedFPR(firstregfpu, fprcount);
   calcFirstUsedFPR(firstregfpu, fprcount);
   calcFirstUsedGPR(firstreggpr, gprcount);
   calcFirstUsedGPR(firstreggpr, gprcount);
 
 
@@ -1260,42 +1305,24 @@ begin
     gprcount, fprcount);
     gprcount, fprcount);
 
 
   { determine whether we need to save the link register }
   { determine whether we need to save the link register }
-  needslinkreg := ((not (po_assembler in current_procinfo.procdef.procoptions)) and
-    (pi_do_call in current_procinfo.flags));
+  needslinkreg := 
+    ((not (po_assembler in current_procinfo.procdef.procoptions)) and (pi_do_call in current_procinfo.flags)) or 
+    ((cs_littlesize in aktglobalswitches) and ((fprcount > 0) or (gprcount > 0)));
+
+  a_reg_alloc(list, NR_STACK_POINTER_REG);
+  a_reg_alloc(list, NR_R0);
 
 
   { move link register to r0 }
   { move link register to r0 }
-  if (needslinkreg) then begin
+  if (needslinkreg) then
     list.concat(taicpu.op_reg(A_MFLR, NR_R0));
     list.concat(taicpu.op_reg(A_MFLR, NR_R0));
-  end;
+
+  save_standard_registers;
+
   { save old stack frame pointer }
   { save old stack frame pointer }
   if (localsize > 0) then begin
   if (localsize > 0) then begin
     a_reg_alloc(list, NR_OLD_STACK_POINTER_REG);
     a_reg_alloc(list, NR_OLD_STACK_POINTER_REG);
     list.concat(taicpu.op_reg_reg(A_MR, NR_OLD_STACK_POINTER_REG, NR_STACK_POINTER_REG));
     list.concat(taicpu.op_reg_reg(A_MR, NR_OLD_STACK_POINTER_REG, NR_STACK_POINTER_REG));
   end;
   end;
-  { save registers, FPU first, then GPR }
-  reference_reset_base(href, NR_STACK_POINTER_REG, -8);
-  if (fprcount > 0) then begin
-    for regcount := RS_F31 downto firstregfpu do begin
-      a_loadfpu_reg_ref(list, OS_FLOAT, newreg(R_FPUREGISTER, regcount,
-        R_SUBNONE), href);
-      dec(href.offset, tcgsize2size[OS_FLOAT]);
-    end;
-  end;
-  if (gprcount > 0) then begin
-    for regcount := RS_R31 downto firstreggpr do begin
-      a_load_reg_ref(list, OS_INT, OS_INT, newreg(R_INTREGISTER, regcount,
-        R_SUBNONE), href);
-      dec(href.offset, tcgsize2size[OS_INT]);
-    end;
-  end;
-
-  { VMX registers not supported by FPC atm }
-
-  { we may need to store R0 (=LR) ourselves }
-  if (needslinkreg) then begin
-    reference_reset_base(href, NR_STACK_POINTER_REG, LA_LR_ELF);
-    list.concat(taicpu.op_reg_ref(A_STD, NR_R0, href));
-  end;
 
 
   { create stack frame }
   { create stack frame }
   if (not nostackframe) and (localsize > 0) then begin
   if (not nostackframe) and (localsize > 0) then begin
@@ -1305,10 +1332,11 @@ begin
     end else begin
     end else begin
       reference_reset_base(href, NR_NO, -localsize);
       reference_reset_base(href, NR_NO, -localsize);
 
 
-      { use R0 for loading the constant (which is definitely > 32k when entering
-       this branch)
+      { Use R0 for loading the constant (which is definitely > 32k when entering
+       this branch).
+
        Inlined at this position because it must not use temp registers because 
        Inlined at this position because it must not use temp registers because 
-       register allocations have already been done :( }
+       register allocations have already been done  }
       { Code template:
       { Code template:
       lis   r0,ofs@highest
       lis   r0,ofs@highest
       ori   r0,r0,ofs@higher
       ori   r0,r0,ofs@higher
@@ -1325,30 +1353,99 @@ begin
       list.concat(taicpu.op_reg_reg_reg(A_STDUX, NR_R1, NR_R1, NR_R0));
       list.concat(taicpu.op_reg_reg_reg(A_STDUX, NR_R1, NR_R1, NR_R0));
     end;
     end;
   end;
   end;
+
   { CR register not used by FPC atm }
   { CR register not used by FPC atm }
 
 
   { keep R1 allocated??? }
   { keep R1 allocated??? }
   a_reg_dealloc(list, NR_R0);
   a_reg_dealloc(list, NR_R0);
 end;
 end;
 
 
+{ Generates the exit code for a method. 
+
+ This procedure may be called before, as well as after g_stackframe_entry
+ is called. 
+
+ IMPORTANT: registers are not to be allocated through the register
+ allocator here, because the register colouring has already occured !!
+}
 procedure tcgppc.g_proc_exit(list: taasmoutput; parasize: longint; nostackframe:
 procedure tcgppc.g_proc_exit(list: taasmoutput; parasize: longint; nostackframe:
   boolean);
   boolean);
-{ This procedure may be called before, as well as after g_stackframe_entry }
-{ is called. NOTE registers are not to be allocated through the register   }
-{ allocator here, because the register colouring has already occured !!    }
 var
 var
-  regcount, firstregfpu, firstreggpr: TSuperRegister;
-  href: treference;
+  firstregfpu, firstreggpr: TSuperRegister;
   needslinkreg : boolean;
   needslinkreg : boolean;
-  localsize,
   fprcount, gprcount: aint;
   fprcount, gprcount: aint;
+
+  { Restore standard registers, both FPR and GPR; does not support VMX/Altivec }
+  procedure restore_standard_registers;
+  var
+    { flag indicating whether we need to manually add the exit code (e.g. blr instruction)
+     or not }
+    needsExitCode : Boolean;
+    href : treference;
+    regcount : TSuperRegister;
+  begin
+    { there are two ways to do this: manually, by generating a few "ld" instructions,
+     or via the restore helper functions. The latter are selected by the -Og switch,
+     i.e. "optimize for size" }
+    if (cs_littlesize in aktglobalswitches) then begin
+      needsExitCode := 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);
+        a_call_name_direct(list, '_restgpr1_' + intToStr(32-gprcount), false, false);
+        a_jmp_name(list, '_restfpr_' + intToStr(32-fprcount));
+      end else if (gprcount > 0) then
+        a_jmp_name(list, '_restgpr0_' + intToStr(32-gprcount))
+      else if (fprcount > 0) then
+        a_jmp_name(list, '_restfpr_' + intToStr(32-fprcount))
+      else
+        needsExitCode := true;
+    end else begin
+      needsExitCode := true;
+      { restore registers, FPU first, GPR next }
+      reference_reset_base(href, NR_STACK_POINTER_REG, -tcgsize2size[OS_FLOAT]);
+      if (fprcount > 0) then
+        for regcount := RS_F31 downto firstregfpu do begin
+          a_loadfpu_ref_reg(list, OS_FLOAT, href, newreg(R_FPUREGISTER, regcount,
+            R_SUBNONE));
+          dec(href.offset, tcgsize2size[OS_FLOAT]);
+        end;
+      if (gprcount > 0) then
+        for regcount := RS_R31 downto firstreggpr do begin
+          a_load_ref_reg(list, OS_INT, OS_INT, href, newreg(R_INTREGISTER, regcount,
+            R_SUBNONE));
+          dec(href.offset, tcgsize2size[OS_INT]);
+        end;
+
+      { VMX not supported by FPC atm }
+    end;
+
+    if (needsExitCode) then begin
+
+      { restore LR (if needed) }
+      if (needslinkreg) then begin
+        reference_reset_base(href, NR_STACK_POINTER_REG, LA_LR_ELF);
+        list.concat(taicpu.op_reg_ref(A_LD, NR_R0, href));
+        list.concat(taicpu.op_reg(A_MTLR, NR_R0));
+      end;
+
+      { generate return instruction }
+      list.concat(taicpu.op_none(A_BLR));
+    end;
+  end;
+
+var
+  href: treference;
+  localsize : aint;
+
 begin
 begin
   calcFirstUsedFPR(firstregfpu, fprcount);
   calcFirstUsedFPR(firstregfpu, fprcount);
   calcFirstUsedGPR(firstreggpr, gprcount);
   calcFirstUsedGPR(firstreggpr, gprcount);
 
 
   { determine whether we need to restore the link register }
   { determine whether we need to restore the link register }
-  needslinkreg := ((not (po_assembler in current_procinfo.procdef.procoptions)) and
-    (pi_do_call in current_procinfo.flags));
+  needslinkreg := 
+    ((not (po_assembler in current_procinfo.procdef.procoptions)) and (pi_do_call in current_procinfo.flags)) or
+    ((cs_littlesize in aktglobalswitches) and ((fprcount > 0) or (gprcount > 0)));
+
   { calculate stack frame }
   { calculate stack frame }
   localsize := tppcprocinfo(current_procinfo).calc_stackframe_size(
   localsize := tppcprocinfo(current_procinfo).calc_stackframe_size(
     gprcount, fprcount);
     gprcount, fprcount);
@@ -1365,13 +1462,14 @@ begin
       { use R0 for loading the constant (which is definitely > 32k when entering
       { use R0 for loading the constant (which is definitely > 32k when entering
        this branch)
        this branch)
        Inlined because it must not use temp registers because register allocations
        Inlined because it must not use temp registers because register allocations
-       have already been done :( }
+       have already been done
+      }
       { Code template:
       { Code template:
-      lis   r0,ofs@highest
-      ori   r0,ofs@higher
-      sldi  r0,r0,32
-      oris  r0,r0,ofs@h
-      ori   r0,r0,ofs@l
+       lis   r0,ofs@highest
+       ori   r0,ofs@higher
+       sldi  r0,r0,32
+       oris  r0,r0,ofs@h
+       ori   r0,r0,ofs@l
       }
       }
       list.concat(taicpu.op_reg_const(A_LIS, NR_R0, word(href.offset shr 48)));
       list.concat(taicpu.op_reg_const(A_LIS, NR_R0, word(href.offset shr 48)));
       list.concat(taicpu.op_reg_reg_const(A_ORI, NR_R0, NR_R0, word(href.offset shr 32)));
       list.concat(taicpu.op_reg_reg_const(A_ORI, NR_R0, NR_R0, word(href.offset shr 32)));
@@ -1383,35 +1481,7 @@ begin
     end;
     end;
   end;
   end;
 
 
-  { load registers, FPR first, then GPR }
-  {$note ts:todo change order of loading}
-  reference_reset_base(href, NR_STACK_POINTER_REG, -tcgsize2size[OS_FLOAT]);
-  if (fprcount > 0) then begin
-    for regcount := RS_F31 downto firstregfpu do begin
-      a_loadfpu_ref_reg(list, OS_FLOAT, href, newreg(R_FPUREGISTER, regcount,
-        R_SUBNONE));
-      dec(href.offset, tcgsize2size[OS_FLOAT]);
-    end;
-  end;
-  if (gprcount > 0) then begin
-    for regcount := RS_R31 downto firstreggpr do begin
-      a_load_ref_reg(list, OS_INT, OS_INT, href, newreg(R_INTREGISTER, regcount,
-        R_SUBNONE));
-      dec(href.offset, tcgsize2size[OS_INT]);
-    end;
-  end;
-
-  { VMX not supported... }
-
-  { restore LR (if needed) }
-  if (needslinkreg) then begin
-    reference_reset_base(href, NR_STACK_POINTER_REG, LA_LR_ELF);
-    list.concat(taicpu.op_reg_ref(A_LD, NR_R0, href));
-    list.concat(taicpu.op_reg(A_MTLR, NR_R0));
-  end;
-
-  { generate return instruction }
-  list.concat(taicpu.op_none(A_BLR));
+  restore_standard_registers;
 end;
 end;
 
 
 
 

+ 270 - 3
rtl/linux/powerpc64/cprt0.as

@@ -54,8 +54,18 @@
     .globl    .\fn
     .globl    .\fn
 .\fn:
 .\fn:
 .endm
 .endm
-
-/* "ptrgl" glue code */
+
+/* 
+ * "ptrgl" glue code for calls via pointer. This function 
+ * sequence loads the data from the function descriptor 
+ * referenced by R11 into the CTR register (function address),
+ * R2 (GOT/TOC pointer), and R11 (the outer frame pointer).
+ * 
+ * On entry, R11 must be set to point to the function descriptor.
+ *
+ * See also the 64-bit PowerPC ABI specification for more 
+ * information, chapter 3.5.11 (in v1.7).
+ */
 .section ".text"
 .section ".text"
 .align 3
 .align 3
 .globl .ptrgl
 .globl .ptrgl
@@ -67,10 +77,267 @@
     ld      11, 8(11)
     ld      11, 8(11)
     bctr
     bctr
 .long 0
 .long 0
-.byte 0, 12, 0, 0, 0, 0, 0, 0
+.byte 0, 12, 128, 0, 0, 0, 0, 0
 .type .ptrgl, @function
 .type .ptrgl, @function
 .size .ptrgl, . - .ptrgl
 .size .ptrgl, . - .ptrgl
 
 
+/* 
+ * Function prolog/epilog helpers, which are part of the 64-bit 
+ * PowerPC ABI.
+ *
+ * See also the 64-bit PowerPC ABI specification for more 
+ * information, chapter 3.5.5, "Register saving and restoring
+ * function" (in v1.7).
+ */
+
+/* Each _savegpr0_N routine saves the general registers from rN to r31,
+ * inclusive. When the routine is called, r1 must point to the start 
+ * of the general register save area. R0 must contain the old LR on 
+ * entry.
+ */
+_savegpr0_14: std 14,-144(1)
+_savegpr0_15: std 15,-136(1)
+_savegpr0_16: std 16,-128(1)
+_savegpr0_17: std 17,-120(1)
+_savegpr0_18: std 18,-112(1)
+_savegpr0_19: std 19,-104(1)
+_savegpr0_20: std 20,-96(1)
+_savegpr0_21: std 21,-88(1)
+_savegpr0_22: std 22,-80(1)
+_savegpr0_23: std 23,-72(1)
+_savegpr0_24: std 24,-64(1)
+_savegpr0_25: std 25,-56(1)
+_savegpr0_26: std 26,-48(1)
+_savegpr0_27: std 27,-40(1)
+_savegpr0_28: std 28,-32(1)
+_savegpr0_29: std 29,-24(1)
+_savegpr0_30: std 30,-16(1)
+_savegpr0_31: 
+    std 31,-8(1)
+    std 0, 16(1)
+    blr
+.long 0
+.byte 0, 12, 64, 0, 0, 0, 0, 0
+
+/* Each _restgpr0_N routine restores the general registers from rN to r31,
+ * inclusive. When the routine is called, r1 must point to the start 
+ * of the general register save area.
+ */
+_restgpr0_14: ld 14,-144(1)
+_restgpr0_15: ld 15,-136(1)
+_restgpr0_16: ld 16,-128(1)
+_restgpr0_17: ld 17,-120(1)
+_restgpr0_18: ld 18,-112(1)
+_restgpr0_19: ld 19,-104(1)
+_restgpr0_20: ld 20,-96(1)
+_restgpr0_21: ld 21,-88(1)
+_restgpr0_22: ld 22,-80(1)
+_restgpr0_23: ld 23,-72(1)
+_restgpr0_24: ld 24,-64(1)
+_restgpr0_25: ld 25,-56(1)
+_restgpr0_26: ld 26,-48(1)
+_restgpr0_27: ld 27,-40(1)
+_restgpr0_28: ld 28,-32(1)
+_restgpr0_29: 
+    ld 0, 16(1)
+    ld 29,-24(1)
+    mtlr 0
+    ld 30,-16(1)
+    ld 31,-8(1)
+    blr
+.long 0
+.byte 0, 12, 64, 0, 0, 0, 0, 0
+
+_restgpr0_30: ld 30,-16(1)
+_restgpr0_31: ld 0, 16(1)
+    ld 31,-8(1)
+    mtlr 0
+    blr
+.long 0
+.byte 0, 12, 64, 0, 0, 0, 0, 0
+
+/* Each _savegpr1_N routine saves the general registers from rN to r31,
+ * inclusive. When the routine is called, r12
+ * must point to the start of the general register save area.
+ */
+_savegpr1_14: std 14,-144(12)
+_savegpr1_15: std 15,-136(12)
+_savegpr1_16: std 16,-128(12)
+_savegpr1_17: std 17,-120(12)
+_savegpr1_18: std 18,-112(12)
+_savegpr1_19: std 19,-104(12)
+_savegpr1_20: std 20,-96(12)
+_savegpr1_21: std 21,-88(12)
+_savegpr1_22: std 22,-80(12)
+_savegpr1_23: std 23,-72(12)
+_savegpr1_24: std 24,-64(12)
+_savegpr1_25: std 25,-56(12)
+_savegpr1_26: std 26,-48(12)
+_savegpr1_27: std 27,-40(12)
+_savegpr1_28: std 28,-32(12)
+_savegpr1_29: std 29,-24(12)
+_savegpr1_30: std 30,-16(12)
+_savegpr1_31: std 31,-8(12)
+    blr
+.long 0
+.byte 0, 12, 64, 0, 0, 0, 0, 0
+
+/* The _restgpr1_N routines restore the general registers from rN to r31.
+ * When the routine is called, r12 must point to the start of the general
+ * register save area.
+ */
+_restgpr1_14: ld 14,-144(12)
+_restgpr1_15: ld 15,-136(12)
+_restgpr1_16: ld 16,-128(12)
+_restgpr1_17: ld 17,-120(12)
+_restgpr1_18: ld 18,-112(12)
+_restgpr1_19: ld 19,-104(12)
+_restgpr1_20: ld 20,-96(12)
+_restgpr1_21: ld 21,-88(12)
+_restgpr1_22: ld 22,-80(12)
+_restgpr1_23: ld 23,-72(12)
+_restgpr1_24: ld 24,-64(12)
+_restgpr1_25: ld 25,-56(12)
+_restgpr1_26: ld 26,-48(12)
+_restgpr1_27: ld 27,-40(12)
+_restgpr1_28: ld 28,-32(12)
+_restgpr1_29: ld 29,-24(12)
+_restgpr1_30: ld 30,-16(12)
+_restgpr1_31: ld 31,-8(12)
+    blr
+.long 0
+.byte 0, 12, 64, 0, 0, 0, 0, 0
+/* Each _savefpr_M routine saves the floating point registers from fM to f31,
+ * inclusive. When the routine is called, r1 must point to the start of the
+ * floating point register save area, and r0 must contain the value of LR on
+ * function entry.
+ */
+_savefpr_14: stfd 14,-144(1)
+_savefpr_15: stfd 15,-136(1)
+_savefpr_16: stfd 16,-128(1)
+_savefpr_17: stfd 17,-120(1)
+_savefpr_18: stfd 18,-112(1)
+_savefpr_19: stfd 19,-104(1)
+_savefpr_20: stfd 20,-96(1)
+_savefpr_21: stfd 21,-88(1)
+_savefpr_22: stfd 22,-80(1)
+_savefpr_23: stfd 23,-72(1)
+_savefpr_24: stfd 24,-64(1)
+_savefpr_25: stfd 25,-56(1)
+_savefpr_26: stfd 26,-48(1)
+_savefpr_27: stfd 27,-40(1)
+_savefpr_28: stfd 28,-32(1)
+_savefpr_29: stfd 29,-24(1)
+_savefpr_30: stfd 30,-16(1)
+_savefpr_31: stfd 31,-8(1)
+    std 0, 16(1)
+    blr
+.long 0
+.byte 0, 12, 64, 0, 0, 0, 0, 0
+
+/* The _restfpr_M routines restore the floating point registers from fM to f31.
+ * When the routine is called, r1 must point to the start of the floating point
+ * register save area.
+ */
+_restfpr_14: lfd 14,-144(1)
+_restfpr_15: lfd 15,-136(1)
+_restfpr_16: lfd 16,-128(1)
+_restfpr_17: lfd 17,-120(1)
+_restfpr_18: lfd 18,-112(1)
+_restfpr_19: lfd 19,-104(1)
+_restfpr_20: lfd 20,-96(1)
+_restfpr_21: lfd 21,-88(1)
+_restfpr_22: lfd 22,-80(1)
+_restfpr_23: lfd 23,-72(1)
+_restfpr_24: lfd 24,-64(1)
+_restfpr_25: lfd 25,-56(1)
+_restfpr_26: lfd 26,-48(1)
+_restfpr_27: lfd 27,-40(1)
+_restfpr_28: lfd 28,-32(1)
+_restfpr_29: 
+    ld 0, 16(1)
+    lfd 29,-24(1)
+    mtlr 0
+    lfd 30,-16(1)
+    lfd 31,-8(1)
+    blr
+.long 0
+.byte 0, 12, 64, 0, 0, 0, 0, 0
+
+_restfpr_30: lfd 30,-16(1)
+_restfpr_31: 
+    ld 0, 16(1)
+    lfd 31,-8(1)
+    mtlr 0
+    blr
+.long 0
+.byte 0, 12, 64, 0, 0, 0, 0, 0
+
+/* Each _savevr_M routine saves the vector registers from vM to v31, inclusive.
+ * When the routine is called, r0 must point to the word just beyound the end
+ * of the vector register save area. On return the value of r0 is unchanged
+ * while r12 may be modified.
+ */
+/* commented out for now, unused
+_savevr_20: addi r12,r0,-192
+    stvx v20,r12,r0
+_savevr_21: addi r12,r0,-176
+    stvx v21,r12,r0
+_savevr_22: addi r12,r0,-160
+    stvx v22,r12,r0
+_savevr_23: addi r12,r0,-144
+    stvx v23,r12,r0
+_savevr_24: addi r12,r0,-128
+    stvx v24,r12,r0
+_savevr_25: addi r12,r0,-112
+    stvx v25,r12,r0
+_savevr_26: addi r12,r0,-96
+    stvx v26,r12,r0
+_savevr_27: addi r12,r0,-80
+    stvx v27,r12,r0
+_savevr_28: addi r12,r0,-64
+    stvx v28,r12,r0
+_savevr_29: addi r12,r0,-48
+    stvx v29,r12,r0
+_savevr_30: addi r12,r0,-32
+    stvx v30,r12,r0
+_savevr_31: addi r12,r0,-16
+    stvx v31,r12,r0
+    blr
+*/
+/* The _restvr_M routines restore the vector registers from vM to v31. When the
+ * routine is called, r0 must point to the word just beyound the end of the
+ * vector register save area. On return the value of r0 is unchanged while r12
+ * may be modified.
+ */
+/* commented out for now, unused
+_restvr_20: addi r12,r0,-192
+    lvx v20,r12,r0
+_restvr_21: addi r12,r0,-176
+    lvx v21,r12,r0
+_restvr_22: addi r12,r0,-160
+    lvx v22,r12,r0
+_restvr_23: addi r12,r0,-144
+    lvx v23,r12,r0
+_restvr_24: addi r12,r0,-128
+    lvx v24,r12,r0
+_restvr_25: addi r12,r0,-112
+    lvx v25,r12,r0
+_restvr_26: addi r12,r0,-96
+    lvx v26,r12,r0
+_restvr_27: addi r12,r0,-80
+    lvx v27,r12,r0
+_restvr_28: addi r12,r0,-64
+    lvx v28,r12,r0
+_restvr_29: addi r12,r0,-48
+    lvx v29,r12,r0
+_restvr_30: addi r12,r0,-32
+    lvx v30,r12,r0
+_restvr_31: addi r12,r0,-16
+    lvx v31,r12,r0
+    blr
+*/
+
 /* 
 /* 
  * start_addresses is a structure containing the real 
  * start_addresses is a structure containing the real 
  * entry point (next to other things not interesting to
  * entry point (next to other things not interesting to

+ 280 - 3
rtl/linux/powerpc64/prt0.as

@@ -1,6 +1,16 @@
 /*
 /*
+ * This file is part of the Free Pascal run time library.
+ * Copyright (c) 2005 by Thomas Schatzl,
+ * member of the Free Pascal development team.
+ *
  * Startup code for normal programs, PowerPC64 version.
  * Startup code for normal programs, PowerPC64 version.
  *
  *
+ * 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.
  */
  */
    
    
 .macro LOAD_64BIT_VAL ra, value 
 .macro LOAD_64BIT_VAL ra, value 
@@ -27,7 +37,17 @@
 .\fn:
 .\fn:
 .endm
 .endm
 
 
-/* "ptrgl" glue code */
+/* 
+ * "ptrgl" glue code for calls via pointer. This function 
+ * sequence loads the data from the function descriptor 
+ * referenced by R11 into the CTR register (function address),
+ * R2 (GOT/TOC pointer), and R11 (the outer frame pointer).
+ * 
+ * On entry, R11 must be set to point to the function descriptor.
+ *
+ * See also the 64-bit PowerPC ABI specification for more 
+ * information, chapter 3.5.11 (in v1.7).
+ */
 .section ".text"
 .section ".text"
 .align 3
 .align 3
 .globl .ptrgl
 .globl .ptrgl
@@ -39,12 +59,269 @@
     ld      11, 8(11)
     ld      11, 8(11)
     bctr
     bctr
 .long 0
 .long 0
-.byte 0, 12, 0, 0, 0, 0, 0, 0
+.byte 0, 12, 128, 0, 0, 0, 0, 0
 .type .ptrgl, @function
 .type .ptrgl, @function
 .size .ptrgl, . - .ptrgl
 .size .ptrgl, . - .ptrgl
 
 
+/* 
+ * Function prolog/epilog helpers, which are part of the 64-bit 
+ * PowerPC ABI.
+ *
+ * See also the 64-bit PowerPC ABI specification for more 
+ * information, chapter 3.5.5, "Register saving and restoring
+ * function" (in v1.7).
+ */
+
+/* Each _savegpr0_N routine saves the general registers from rN to r31,
+ * inclusive. When the routine is called, r1 must point to the start 
+ * of the general register save area. R0 must contain the old LR on 
+ * entry.
+ */
+_savegpr0_14: std 14,-144(1)
+_savegpr0_15: std 15,-136(1)
+_savegpr0_16: std 16,-128(1)
+_savegpr0_17: std 17,-120(1)
+_savegpr0_18: std 18,-112(1)
+_savegpr0_19: std 19,-104(1)
+_savegpr0_20: std 20,-96(1)
+_savegpr0_21: std 21,-88(1)
+_savegpr0_22: std 22,-80(1)
+_savegpr0_23: std 23,-72(1)
+_savegpr0_24: std 24,-64(1)
+_savegpr0_25: std 25,-56(1)
+_savegpr0_26: std 26,-48(1)
+_savegpr0_27: std 27,-40(1)
+_savegpr0_28: std 28,-32(1)
+_savegpr0_29: std 29,-24(1)
+_savegpr0_30: std 30,-16(1)
+_savegpr0_31: 
+    std 31,-8(1)
+    std 0, 16(1)
+    blr
+.long 0
+.byte 0, 12, 64, 0, 0, 0, 0, 0
+
+/* Each _restgpr0_N routine restores the general registers from rN to r31,
+ * inclusive. When the routine is called, r1 must point to the start 
+ * of the general register save area.
+ */
+_restgpr0_14: ld 14,-144(1)
+_restgpr0_15: ld 15,-136(1)
+_restgpr0_16: ld 16,-128(1)
+_restgpr0_17: ld 17,-120(1)
+_restgpr0_18: ld 18,-112(1)
+_restgpr0_19: ld 19,-104(1)
+_restgpr0_20: ld 20,-96(1)
+_restgpr0_21: ld 21,-88(1)
+_restgpr0_22: ld 22,-80(1)
+_restgpr0_23: ld 23,-72(1)
+_restgpr0_24: ld 24,-64(1)
+_restgpr0_25: ld 25,-56(1)
+_restgpr0_26: ld 26,-48(1)
+_restgpr0_27: ld 27,-40(1)
+_restgpr0_28: ld 28,-32(1)
+_restgpr0_29: 
+    ld 0, 16(1)
+    ld 29,-24(1)
+    mtlr 0
+    ld 30,-16(1)
+    ld 31,-8(1)
+    blr
+.long 0
+.byte 0, 12, 64, 0, 0, 0, 0, 0
+
+_restgpr0_30: ld 30,-16(1)
+_restgpr0_31: ld 0, 16(1)
+    ld 31,-8(1)
+    mtlr 0
+    blr
+.long 0
+.byte 0, 12, 64, 0, 0, 0, 0, 0
+
+/* Each _savegpr1_N routine saves the general registers from rN to r31,
+ * inclusive. When the routine is called, r12
+ * must point to the start of the general register save area.
+ */
+_savegpr1_14: std 14,-144(12)
+_savegpr1_15: std 15,-136(12)
+_savegpr1_16: std 16,-128(12)
+_savegpr1_17: std 17,-120(12)
+_savegpr1_18: std 18,-112(12)
+_savegpr1_19: std 19,-104(12)
+_savegpr1_20: std 20,-96(12)
+_savegpr1_21: std 21,-88(12)
+_savegpr1_22: std 22,-80(12)
+_savegpr1_23: std 23,-72(12)
+_savegpr1_24: std 24,-64(12)
+_savegpr1_25: std 25,-56(12)
+_savegpr1_26: std 26,-48(12)
+_savegpr1_27: std 27,-40(12)
+_savegpr1_28: std 28,-32(12)
+_savegpr1_29: std 29,-24(12)
+_savegpr1_30: std 30,-16(12)
+_savegpr1_31: std 31,-8(12)
+    blr
+.long 0
+.byte 0, 12, 64, 0, 0, 0, 0, 0
+
+/* The _restgpr1_N routines restore the general registers from rN to r31.
+ * When the routine is called, r12 must point to the start of the general
+ * register save area.
+ */
+_restgpr1_14: ld 14,-144(12)
+_restgpr1_15: ld 15,-136(12)
+_restgpr1_16: ld 16,-128(12)
+_restgpr1_17: ld 17,-120(12)
+_restgpr1_18: ld 18,-112(12)
+_restgpr1_19: ld 19,-104(12)
+_restgpr1_20: ld 20,-96(12)
+_restgpr1_21: ld 21,-88(12)
+_restgpr1_22: ld 22,-80(12)
+_restgpr1_23: ld 23,-72(12)
+_restgpr1_24: ld 24,-64(12)
+_restgpr1_25: ld 25,-56(12)
+_restgpr1_26: ld 26,-48(12)
+_restgpr1_27: ld 27,-40(12)
+_restgpr1_28: ld 28,-32(12)
+_restgpr1_29: ld 29,-24(12)
+_restgpr1_30: ld 30,-16(12)
+_restgpr1_31: ld 31,-8(12)
+    blr
+.long 0
+.byte 0, 12, 64, 0, 0, 0, 0, 0
+/* Each _savefpr_M routine saves the floating point registers from fM to f31,
+ * inclusive. When the routine is called, r1 must point to the start of the
+ * floating point register save area, and r0 must contain the value of LR on
+ * function entry.
+ */
+_savefpr_14: stfd 14,-144(1)
+_savefpr_15: stfd 15,-136(1)
+_savefpr_16: stfd 16,-128(1)
+_savefpr_17: stfd 17,-120(1)
+_savefpr_18: stfd 18,-112(1)
+_savefpr_19: stfd 19,-104(1)
+_savefpr_20: stfd 20,-96(1)
+_savefpr_21: stfd 21,-88(1)
+_savefpr_22: stfd 22,-80(1)
+_savefpr_23: stfd 23,-72(1)
+_savefpr_24: stfd 24,-64(1)
+_savefpr_25: stfd 25,-56(1)
+_savefpr_26: stfd 26,-48(1)
+_savefpr_27: stfd 27,-40(1)
+_savefpr_28: stfd 28,-32(1)
+_savefpr_29: stfd 29,-24(1)
+_savefpr_30: stfd 30,-16(1)
+_savefpr_31: stfd 31,-8(1)
+    std 0, 16(1)
+    blr
+.long 0
+.byte 0, 12, 64, 0, 0, 0, 0, 0
+
+/* The _restfpr_M routines restore the floating point registers from fM to f31.
+ * When the routine is called, r1 must point to the start of the floating point
+ * register save area.
+ */
+_restfpr_14: lfd 14,-144(1)
+_restfpr_15: lfd 15,-136(1)
+_restfpr_16: lfd 16,-128(1)
+_restfpr_17: lfd 17,-120(1)
+_restfpr_18: lfd 18,-112(1)
+_restfpr_19: lfd 19,-104(1)
+_restfpr_20: lfd 20,-96(1)
+_restfpr_21: lfd 21,-88(1)
+_restfpr_22: lfd 22,-80(1)
+_restfpr_23: lfd 23,-72(1)
+_restfpr_24: lfd 24,-64(1)
+_restfpr_25: lfd 25,-56(1)
+_restfpr_26: lfd 26,-48(1)
+_restfpr_27: lfd 27,-40(1)
+_restfpr_28: lfd 28,-32(1)
+_restfpr_29: 
+    ld 0, 16(1)
+    lfd 29,-24(1)
+    mtlr 0
+    lfd 30,-16(1)
+    lfd 31,-8(1)
+    blr
+.long 0
+.byte 0, 12, 64, 0, 0, 0, 0, 0
+
+_restfpr_30: lfd 30,-16(1)
+_restfpr_31: 
+    ld 0, 16(1)
+    lfd 31,-8(1)
+    mtlr 0
+    blr
+.long 0
+.byte 0, 12, 64, 0, 0, 0, 0, 0
+
+/* Each _savevr_M routine saves the vector registers from vM to v31, inclusive.
+ * When the routine is called, r0 must point to the word just beyound the end
+ * of the vector register save area. On return the value of r0 is unchanged
+ * while r12 may be modified.
+ */
+/* commented out for now, unused
+_savevr_20: addi r12,r0,-192
+    stvx v20,r12,r0
+_savevr_21: addi r12,r0,-176
+    stvx v21,r12,r0
+_savevr_22: addi r12,r0,-160
+    stvx v22,r12,r0
+_savevr_23: addi r12,r0,-144
+    stvx v23,r12,r0
+_savevr_24: addi r12,r0,-128
+    stvx v24,r12,r0
+_savevr_25: addi r12,r0,-112
+    stvx v25,r12,r0
+_savevr_26: addi r12,r0,-96
+    stvx v26,r12,r0
+_savevr_27: addi r12,r0,-80
+    stvx v27,r12,r0
+_savevr_28: addi r12,r0,-64
+    stvx v28,r12,r0
+_savevr_29: addi r12,r0,-48
+    stvx v29,r12,r0
+_savevr_30: addi r12,r0,-32
+    stvx v30,r12,r0
+_savevr_31: addi r12,r0,-16
+    stvx v31,r12,r0
+    blr
+*/
+/* The _restvr_M routines restore the vector registers from vM to v31. When the
+ * routine is called, r0 must point to the word just beyound the end of the
+ * vector register save area. On return the value of r0 is unchanged while r12
+ * may be modified.
+ */
+/* commented out for now, unused
+_restvr_20: addi r12,r0,-192
+    lvx v20,r12,r0
+_restvr_21: addi r12,r0,-176
+    lvx v21,r12,r0
+_restvr_22: addi r12,r0,-160
+    lvx v22,r12,r0
+_restvr_23: addi r12,r0,-144
+    lvx v23,r12,r0
+_restvr_24: addi r12,r0,-128
+    lvx v24,r12,r0
+_restvr_25: addi r12,r0,-112
+    lvx v25,r12,r0
+_restvr_26: addi r12,r0,-96
+    lvx v26,r12,r0
+_restvr_27: addi r12,r0,-80
+    lvx v27,r12,r0
+_restvr_28: addi r12,r0,-64
+    lvx v28,r12,r0
+_restvr_29: addi r12,r0,-48
+    lvx v29,r12,r0
+_restvr_30: addi r12,r0,-32
+    lvx v30,r12,r0
+_restvr_31: addi r12,r0,-16
+    lvx v31,r12,r0
+    blr
+*/
+
 /*
 /*
- * Main Pascal entry point label (function)
+ * Main program entry point label (function), called by the loader
  */
  */
 FUNCTION_PROLOG _start
 FUNCTION_PROLOG _start
 
 

+ 108 - 1
rtl/powerpc64/mathu.inc

@@ -1,6 +1,6 @@
 {
 {
     This file is part of the Free Pascal run time library.
     This file is part of the Free Pascal run time library.
-    Copyright (c) 1999-2000 by Florian Klaempfl
+    Copyright (c) 2005 by Thomas Schatzl
     member of the Free Pascal development team
     member of the Free Pascal development team
 
 
     See the file COPYING.FPC, included in this distribution,
     See the file COPYING.FPC, included in this distribution,
@@ -11,3 +11,110 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
 
  **********************************************************************}
  **********************************************************************}
+
+const
+  RoundModeMask        = %00000011;
+  NonIEEEModeMask      = %00000100;
+
+  InvalidOperationMask = %10000000;
+  OverflowMask         = %01000000;
+  UnderflowMask        = %00100000;
+  ZeroDivideMask       = %00010000;
+  InexactMask          = %00001000;
+
+  ExceptionMask        = InvalidOperationMask or OverflowMask or UnderflowMask or ZeroDivideMask or InexactMask;
+
+  AllConfigBits        = ExceptionMask or NonIEEEModeMask or RoundModeMask;
+
+function getFPSCR : DWord; assembler; nostackframe;
+asm
+  mffs f0
+  stfd f0, -8(r1)
+  ld r3, -8(r1)
+end;
+
+procedure setFPSCR(newFPSCR : DWord); assembler; nostackframe;
+asm
+  std r3, -8(r1)
+  lfd f0, -8(r1)
+  mtfsf 255, f0
+end;
+
+function GetRoundMode: TFPURoundingMode;
+begin
+  case (getFPSCR and RoundModeMask) of
+    0 : result := rmNearest;
+    1 : result := rmTruncate;
+    2 : result := rmUp;
+    3 : result := rmDown;
+  end;
+end;
+
+function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
+var
+  mode : DWord;
+begin
+  case (RoundMode) of
+    rmNearest : mode := 0;
+    rmTruncate : mode := 1;
+    rmUp : mode := 2;
+    rmDown : mode := 3;
+  end;
+  setFPSCR((getFPSCR and (not RoundModeMask)) or mode);
+  result := RoundMode;
+end;
+
+
+function GetPrecisionMode: TFPUPrecisionMode;
+begin
+  result := pmDouble;
+end;
+
+function SetPrecisionMode(const Precision: TFPUPrecisionMode): TFPUPrecisionMode;
+begin
+  { nothing to do, not supported }
+end;
+
+
+function GetExceptionMask: TFPUExceptionMask;
+begin
+  result := [];
+  if ((getFPSCR and InvalidOperationMask) <> 0) then 
+    result := result + [exInvalidOp];
+  if ((getFPSCR and OverflowMask) <> 0) then 
+    result := result + [exOverflow];
+  if ((getFPSCR and UnderflowMask) <> 0) then 
+    result := result + [exUnderflow];
+  if ((getFPSCR and ZeroDivideMask) <> 0) then 
+    result := result + [exZeroDivide];
+  if ((getFPSCR and InexactMask) <> 0) then 
+    result := result + [exPrecision];
+end;
+
+function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
+var
+  mode : DWord;
+begin
+  mode := 0;
+  if (exInvalidOp in Mask) then
+    mode := mode or InvalidOperationMask;
+  if (exOverflow in Mask) then
+    mode := mode or OverflowMask;
+  if (exUnderflow in Mask) then
+    mode := mode or UnderflowMask;
+  if (exZeroDivide in Mask) then
+    mode := mode or ZeroDivideMask;
+  if (exPrecision in Mask) then
+    mode := mode or InexactMask;
+  
+  setFPSCR((getFPSCR and (not ExceptionMask)) or mode);
+  result := Mask - [exDenormalized];
+end;
+
+
+procedure ClearExceptions(RaisePending: Boolean = true);
+begin
+  { RaisePending has no effect on PPC, always raises them at the correct location }
+  setFPSCR(getFPSCR and (not AllConfigBits));
+end;
+

+ 20 - 1
rtl/powerpc64/mathuh.inc

@@ -1,6 +1,6 @@
 {
 {
     This file is part of the Free Pascal run time library.
     This file is part of the Free Pascal run time library.
-    Copyright (c) 1999-2000 by Florian Klaempfl
+    Copyright (c) 1999-2005 by Florian Klaempfl
     member of the Free Pascal development team
     member of the Free Pascal development team
 
 
     See the file COPYING.FPC, included in this distribution,
     See the file COPYING.FPC, included in this distribution,
@@ -12,3 +12,22 @@
 
 
  **********************************************************************}
  **********************************************************************}
 
 
+type
+  TFPURoundingMode = (rmNearest, rmDown, rmUp, rmTruncate);
+  TFPUPrecisionMode = (pmSingle, pmReserved, pmDouble, pmExtended);
+  TFPUException = (
+    exInvalidOp, exDenormalized, exZeroDivide,
+    exOverflow, exUnderflow, exPrecision);
+  TFPUExceptionMask = set of TFPUException;
+
+function GetRoundMode: TFPURoundingMode;
+function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
+
+function GetPrecisionMode: TFPUPrecisionMode;
+
+function SetPrecisionMode(const Precision: TFPUPrecisionMode): TFPUPrecisionMode;
+function GetExceptionMask: TFPUExceptionMask;
+function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
+
+procedure ClearExceptions(RaisePending: Boolean = true);
+

+ 16 - 384
rtl/powerpc64/powerpc64.inc

@@ -1,9 +1,8 @@
 {
 {
-
     This file is part of the Free Pascal run time library.
     This file is part of the Free Pascal run time library.
     Copyright (c) 2000-2001 by the Free Pascal development team.
     Copyright (c) 2000-2001 by the Free Pascal development team.
 
 
-    Portions Copyright (c) 2000 by Casey Duncan ([email protected])
+    Portions Copyright (c) 2000 by Casey Duncan ([email protected])
 
 
     Processor dependent implementation for the system unit for
     Processor dependent implementation for the system unit for
     PowerPC64
     PowerPC64
@@ -22,16 +21,7 @@
                            PowerPC specific stuff
                            PowerPC specific stuff
 ****************************************************************************}
 ****************************************************************************}
 
 
-const
-  ppc_fpu_overflow     = (1 shl (32-3));
-  ppc_fpu_underflow    = (1 shl (32-4));
-  ppc_fpu_divbyzero    = (1 shl (32-5));
-  ppc_fpu_inexact      = (1 shl (32-6));
-  ppc_fpu_invalid_snan = (1 shl (32-7));
-
-
-procedure fpc_enable_ppc_fpu_exceptions;
-assembler; nostackframe;
+procedure fpc_enable_ppc_fpu_exceptions; assembler; nostackframe;
 asm
 asm
   { clear all "exception happened" flags we care about}
   { clear all "exception happened" flags we care about}
   mtfsfi 0,0
   mtfsfi 0,0
@@ -42,7 +32,6 @@ asm
   mtfsb0 21
   mtfsb0 21
   mtfsb0 22
   mtfsb0 22
   mtfsb0 23
   mtfsb0 23
-
 {$endif fpc_mtfsb0_corrected}
 {$endif fpc_mtfsb0_corrected}
 
 
   { enable invalid operations and division by zero exceptions. }
   { enable invalid operations and division by zero exceptions. }
@@ -57,358 +46,6 @@ begin
   fpc_enable_ppc_fpu_exceptions;
   fpc_enable_ppc_fpu_exceptions;
 end;
 end;
 
 
-
-function fpc_get_ppc_fpscr: cardinal;
-assembler;
-var
-  temp: record a,b:longint; end;
-asm
-  mffs f0
-  stfd f0,temp
-  lwz  r3,temp.b
-  { clear all exception flags }
-{ TODO
-  rlwinm r4,r3,0,16,31
-  stw  r4,temp.b
-  lfd  f0,temp
-  mtfsf f0
-
}
-end;
-
-
-{ note: unused; to be moved into startup code }
-{ The following code is never called directly, it's a dummy which holds the
-entry points and code to the register save/load subroutines; it is part of the
-PPC ABI and used in procedure entry and exit methods.
-See the comments in the code for "calling conventions". Directly taken from
-the ABI specification. The labels right below are required to shut up the
-compiler. }
-
-label
-        // _savegpr0_x
-        _savegpr0_14, _savegpr0_15, _savegpr0_16, _savegpr0_17, _savegpr0_18, _savegpr0_19,
-        _savegpr0_20, _savegpr0_21, _savegpr0_22, _savegpr0_23, _savegpr0_24, _savegpr0_25,
-        _savegpr0_26, _savegpr0_27, _savegpr0_28, _savegpr0_29, _savegpr0_30, _savegpr0_31,
-        // _restgpr0_x
-        _restgpr0_14, _restgpr0_15, _restgpr0_16, _restgpr0_17, _restgpr0_18, _restgpr0_19,
-        _restgpr0_20, _restgpr0_21, _restgpr0_22, _restgpr0_23, _restgpr0_24, _restgpr0_25,
-        _restgpr0_26, _restgpr0_27, _restgpr0_28, _restgpr0_29, _restgpr0_30, _restgpr0_31,
-        // _savegpr1_x
-        _savegpr1_14, _savegpr1_15, _savegpr1_16, _savegpr1_17, _savegpr1_18, _savegpr1_19,
-        _savegpr1_20, _savegpr1_21, _savegpr1_22, _savegpr1_23, _savegpr1_24, _savegpr1_25,
-        _savegpr1_26, _savegpr1_27, _savegpr1_28, _savegpr1_29, _savegpr1_30, _savegpr1_31,
-        // _restgpr1_x
-        _restgpr1_14, _restgpr1_15, _restgpr1_16, _restgpr1_17, _restgpr1_18, _restgpr1_19,
-        _restgpr1_20, _restgpr1_21, _restgpr1_22, _restgpr1_23, _restgpr1_24, _restgpr1_25,
-        _restgpr1_26, _restgpr1_27, _restgpr1_28, _restgpr1_29, _restgpr1_30, _restgpr1_31,
-        // _savefpr_x
-        _savefpr_14, _savefpr_15, _savefpr_16, _savefpr_17, _savefpr_18, _savefpr_19,
-        _savefpr_20, _savefpr_21, _savefpr_22, _savefpr_23, _savefpr_24, _savefpr_25,
-        _savefpr_26, _savefpr_27, _savefpr_28, _savefpr_29, _savefpr_30, _savefpr_31,
-        // _restfpr_x
-        _restfpr_14, _restfpr_15, _restfpr_16, _restfpr_17, _restfpr_18, _restfpr_19,
-        _restfpr_20, _restfpr_21, _restfpr_22, _restfpr_23, _restfpr_24, _restfpr_25,
-        _restfpr_26, _restfpr_27, _restfpr_28, _restfpr_29, _restfpr_30, _restfpr_31,
-        // _savevr_x
-        _savevr_20, _savevr_21, _savevr_22, _savevr_23, _savevr_24, _savevr_25,
-        _savevr_26, _savevr_27, _savevr_28, _savevr_29, _savevr_30, _savevr_31,
-        // _restvr_x
-        _restvr_20, _restvr_21, _restvr_22, _restvr_23, _restvr_24, _restvr_25,
-        _restvr_26, _restvr_27, _restvr_28, _restvr_29, _restvr_30, _restvr_31;
-
-
-procedure __save_restore_services; assembler; nostackframe;
-assembler;
-asm
-// Each _savegpr0_N routine saves the general registers from rN to r31, inclusive.
-// Each routine also saves the LR. When the routine is called, r1 must point to
-// the start of the general register save area, and r0 must contain the
-// value of LR on function entry.
-.globl _savegpr0_14
-_savegpr0_14: std r14,-144(r1)
-.globl _savegpr0_15
-_savegpr0_15: std r15,-136(r1)
-.globl _savegpr0_16
-_savegpr0_16: std r16,-128(r1)
-.globl _savegpr0_17
-_savegpr0_17: std r17,-120(r1)
-.globl _savegpr0_18
-_savegpr0_18: std r18,-112(r1)
-.globl _savegpr0_19
-_savegpr0_19: std r19,-104(r1)
-.globl _savegpr0_20
-_savegpr0_20: std r20,-96(r1)
-.globl _savegpr0_21
-_savegpr0_21: std r21,-88(r1)
-.globl _savegpr0_22
-_savegpr0_22: std r22,-80(r1)
-.globl _savegpr0_23
-_savegpr0_23: std r23,-72(r1)
-.globl _savegpr0_24
-_savegpr0_24: std r24,-64(r1)
-.globl _savegpr0_25
-_savegpr0_25: std r25,-56(r1)
-.globl _savegpr0_26
-_savegpr0_26: std r26,-48(r1)
-.globl _savegpr0_27
-_savegpr0_27: std r27,-40(r1)
-.globl _savegpr0_28
-_savegpr0_28: std r28,-32(r1)
-.globl _savegpr0_29
-_savegpr0_29: std r29,-24(r1)
-.globl _savegpr0_30
-_savegpr0_30: std r30,-16(r1)
-.globl _savegpr0_31
-_savegpr0_31: std r31,-8(r1)
-        std r0, 16(r1)
-        blr
-// The _restgpr0_N routines restore the general registers from rN to r31, and then
-// return to the caller. When the routine is called, r1 must point to the start of
-// the general register save area.
-.globl _restgpr0_14
-_restgpr0_14: ld r14,-144(r1)
-.globl _restgpr0_15
-_restgpr0_15: ld r15,-136(r1)
-.globl _restgpr0_16
-_restgpr0_16: ld r16,-128(r1)
-.globl _restgpr0_17
-_restgpr0_17: ld r17,-120(r1)
-.globl _restgpr0_18
-_restgpr0_18: ld r18,-112(r1)
-.globl _restgpr0_19
-_restgpr0_19: ld r19,-104(r1)
-.globl _restgpr0_20
-_restgpr0_20: ld r20,-96(r1)
-.globl _restgpr0_21
-_restgpr0_21: ld r21,-88(r1)
-.globl _restgpr0_22
-_restgpr0_22: ld r22,-80(r1)
-.globl _restgpr0_23
-_restgpr0_23: ld r23,-72(r1)
-.globl _restgpr0_24
-_restgpr0_24: ld r24,-64(r1)
-.globl _restgpr0_25
-_restgpr0_25: ld r25,-56(r1)
-.globl _restgpr0_26
-_restgpr0_26: ld r26,-48(r1)
-.globl _restgpr0_27
-_restgpr0_27: ld r27,-40(r1)
-.globl _restgpr0_28
-_restgpr0_28: ld r28,-32(r1)
-.globl _restgpr0_29
-_restgpr0_29: ld r0, 16(r1)
-        ld r29,-24(r1)
-        mtlr r0
-        ld r30,-16(r1)
-        ld r31,-8(r1)
-        blr
-.globl _restgpr0_30
-_restgpr0_30: ld r30,-16(r1)
-.globl _restgpr0_31
-_restgpr0_31: ld r0, 16(r1)
-        ld r31,-8(r1)
-        mtlr r0
-        blr
-// Each _savegpr1_N routine saves the general registers from rN to r31,
-// inclusive. When the routine is called, r12
-// must point to the start of the general register save area.
-.globl _savegpr1_14
-_savegpr1_14: std r14,-144(r12)
-.globl _savegpr1_15
-_savegpr1_15: std r15,-136(r12)
-.globl _savegpr1_16
-_savegpr1_16: std r16,-128(r12)
-.globl _savegpr1_17
-_savegpr1_17: std r17,-120(r12)
-.globl _savegpr1_18
-_savegpr1_18: std r18,-112(r12)
-.globl _savegpr1_19
-_savegpr1_19: std r19,-104(r12)
-.globl _savegpr1_20
-_savegpr1_20: std r20,-96(r12)
-.globl _savegpr1_21
-_savegpr1_21: std r21,-88(r12)
-.globl _savegpr1_22
-_savegpr1_22: std r22,-80(r12)
-.globl _savegpr1_23
-_savegpr1_23: std r23,-72(r12)
-.globl _savegpr1_24
-_savegpr1_24: std r24,-64(r12)
-.globl _savegpr1_25
-_savegpr1_25: std r25,-56(r12)
-.globl _savegpr1_26
-_savegpr1_26: std r26,-48(r12)
-.globl _savegpr1_27
-_savegpr1_27: std r27,-40(r12)
-.globl _savegpr1_28
-_savegpr1_28: std r28,-32(r12)
-.globl _savegpr1_29
-_savegpr1_29: std r29,-24(r12)
-.globl _savegpr1_30
-_savegpr1_30: std r30,-16(r12)
-.globl _savegpr1_31
-_savegpr1_31: std r31,-8(r12)
-        blr
-// The _restgpr1_N routines restore the general registers from rN to r31.
-// When the routine is called, r12 must point to the start of the general
-// register save area.
-.globl _restgpr1_14
-_restgpr1_14: ld r14,-144(r12)
-.globl _restgpr1_15
-_restgpr1_15: ld r15,-136(r12)
-.globl _restgpr1_16
-_restgpr1_16: ld r16,-128(r12)
-.globl _restgpr1_17
-_restgpr1_17: ld r17,-120(r12)
-.globl _restgpr1_18
-_restgpr1_18: ld r18,-112(r12)
-.globl _restgpr1_19
-_restgpr1_19: ld r19,-104(r12)
-.globl _restgpr1_20
-_restgpr1_20: ld r20,-96(r12)
-.globl _restgpr1_21
-_restgpr1_21: ld r21,-88(r12)
-.globl _restgpr1_22
-_restgpr1_22: ld r22,-80(r12)
-.globl _restgpr1_23
-_restgpr1_23: ld r23,-72(r12)
-.globl _restgpr1_24
-_restgpr1_24: ld r24,-64(r12)
-.globl _restgpr1_25
-_restgpr1_25: ld r25,-56(r12)
-.globl _restgpr1_26
-_restgpr1_26: ld r26,-48(r12)
-.globl _restgpr1_27
-_restgpr1_27: ld r27,-40(r12)
-.globl _restgpr1_28
-_restgpr1_28: ld r28,-32(r12)
-.globl _restgpr1_29
-_restgpr1_29: ld r29,-24(r12)
-.globl _restgpr1_30
-_restgpr1_30: ld r30,-16(r12)
-.globl _restgpr1_31
-_restgpr1_31: ld r31,-8(r12)
-        blr
-
-// Each _savefpr_M routine saves the floating point registers from fM to f31,
-// inclusive. When the routine is called, r1 must point to the start of the
-// floating point register save area, and r0 must contain the value of LR on
-// function entry.
-_savefpr_14: stfd f14,-144(r1)
-_savefpr_15: stfd f15,-136(r1)
-_savefpr_16: stfd f16,-128(r1)
-_savefpr_17: stfd f17,-120(r1)
-_savefpr_18: stfd f18,-112(r1)
-_savefpr_19: stfd f19,-104(r1)
-_savefpr_20: stfd f20,-96(r1)
-_savefpr_21: stfd f21,-88(r1)
-_savefpr_22: stfd f22,-80(r1)
-_savefpr_23: stfd f23,-72(r1)
-_savefpr_24: stfd f24,-64(r1)
-_savefpr_25: stfd f25,-56(r1)
-_savefpr_26: stfd f26,-48(r1)
-_savefpr_27: stfd f27,-40(r1)
-_savefpr_28: stfd f28,-32(r1)
-_savefpr_29: stfd f29,-24(r1)
-_savefpr_30: stfd f30,-16(r1)
-_savefpr_31: stfd f31,-8(r1)
-        std r0, 16(r1)
-        blr
-// The _restfpr_M routines restore the floating point registers from fM to f31.
-// When the routine is called, r1 must point to the start of the floating point
-// register save area.
-_restfpr_14: lfd f14,-144(r1)
-_restfpr_15: lfd f15,-136(r1)
-_restfpr_16: lfd f16,-128(r1)
-_restfpr_17: lfd f17,-120(r1)
-_restfpr_18: lfd f18,-112(r1)
-_restfpr_19: lfd f19,-104(r1)
-_restfpr_20: lfd f20,-96(r1)
-_restfpr_21: lfd f21,-88(r1)
-_restfpr_22: lfd f22,-80(r1)
-_restfpr_23: lfd f23,-72(r1)
-_restfpr_24: lfd f24,-64(r1)
-_restfpr_25: lfd f25,-56(r1)
-_restfpr_26: lfd f26,-48(r1)
-_restfpr_27: lfd f27,-40(r1)
-_restfpr_28: lfd f28,-32(r1)
-_restfpr_29: lfd f29,-24(r1)
-_restfpr_29: ld r0, 16(r1)
-        lfd f29,-24(r1)
-        mtlr r0
-        lfd f30,-16(r1)
-        lfd f31,-8(r1)
-        blr
-_restfpr_30: lfd f30,-16(r1)
-_restfpr_31: ld r0, 16(r1)
-        lfd f31,-8(r1)
-        mtlr r0
-        blr
-// Each _savevr_M routine saves the vector registers from vM to v31, inclusive.
-// When the routine is called, r0 must point to the word just beyound the end
-// of the vector register save area. On return the value of r0 is unchanged
-// while r12 may be modified.
-(* commented out: GAS does not understand VMX opcodes?
-_savevr_20: addi r12,r0,-192
-        stvx v20,r12,r0
-_savevr_21: addi r12,r0,-176
-        stvx v21,r12,r0
-_savevr_22: addi r12,r0,-160
-        stvx v22,r12,r0
-_savevr_23: addi r12,r0,-144
-        stvx v23,r12,r0
-_savevr_24: addi r12,r0,-128
-        stvx v24,r12,r0
-_savevr_25: addi r12,r0,-112
-        stvx v25,r12,r0
-_savevr_26: addi r12,r0,-96
-        stvx v26,r12,r0
-_savevr_27: addi r12,r0,-80
-        stvx v27,r12,r0
-_savevr_28: addi r12,r0,-64
-        stvx v28,r12,r0
-_savevr_29: addi r12,r0,-48
-        stvx v29,r12,r0
-_savevr_30: addi r12,r0,-32
-        stvx v30,r12,r0
-_savevr_31: addi r12,r0,-16
-        stvx v31,r12,r0
-        blr
-*)
-// The _restvr_M routines restore the vector registers from vM to v31. When the
-// routine is called, r0 must point to the word just beyound the end of the
-// vector register save area. On return the value of r0 is unchanged while r12
-// may be modified.
-(* commented out: GAS does not understand VMX opcodes?
-_restvr_20: addi r12,r0,-192
-        lvx v20,r12,r0
-_restvr_21: addi r12,r0,-176
-        lvx v21,r12,r0
-_restvr_22: addi r12,r0,-160
-        lvx v22,r12,r0
-_restvr_23: addi r12,r0,-144
-        lvx v23,r12,r0
-_restvr_24: addi r12,r0,-128
-        lvx v24,r12,r0
-_restvr_25: addi r12,r0,-112
-        lvx v25,r12,r0
-_restvr_26: addi r12,r0,-96
-        lvx v26,r12,r0
-_restvr_27: addi r12,r0,-80
-        lvx v27,r12,r0
-_restvr_28: addi r12,r0,-64
-        lvx v28,r12,r0
-_restvr_29: addi r12,r0,-48
-        lvx v29,r12,r0
-_restvr_30: addi r12,r0,-32
-        lvx v30,r12,r0
-_restvr_31: addi r12,r0,-16
-        lvx v31,r12,r0
-        blr
-*)
-end;
-
-
 {****************************************************************************
 {****************************************************************************
                                 Move / Fill
                                 Move / Fill
 ****************************************************************************}
 ****************************************************************************}
@@ -451,27 +88,22 @@ begin
   v := 0;
   v := 0;
   { aligned? }
   { aligned? }
   if (PtrUInt(@x) mod sizeof(PtrUInt))<>0 then
   if (PtrUInt(@x) mod sizeof(PtrUInt))<>0 then
-    begin
       for i:=0 to count-1 do
       for i:=0 to count-1 do
-        bytearray(x)[i]:=value;
-    end
-  else
-    begin
-      v:=(value shl 8) or (value and $FF);
-      v:=(v shl 16) or (v and $ffff);
-      for i:=0 to (count div 4)-1 do
-        longintarray(x)[i]:=v;
-      for i:=(count div 4)*4 to count-1 do
-        bytearray(x)[i]:=value;
-    end;
+        bytearray(x)[i]:=value
+  else begin
+    v:=(value shl 8) or (value and $FF);
+    v:=(v shl 16) or (v and $ffff);
+    for i:=0 to (count div 4)-1 do
+      longintarray(x)[i]:=v;
+    for i:=(count div 4)*4 to count-1 do
+      bytearray(x)[i]:=value;
+  end;
 end;
 end;
 {$endif FPC_SYSTEM_HAS_FILLCHAR}
 {$endif FPC_SYSTEM_HAS_FILLCHAR}
 
 
-
 {$ifndef FPC_SYSTEM_HAS_FILLDWORD}
 {$ifndef FPC_SYSTEM_HAS_FILLDWORD}
 {$define FPC_SYSTEM_HAS_FILLDWORD}
 {$define FPC_SYSTEM_HAS_FILLDWORD}
-procedure filldword(var x;count : SizeInt;value : dword);
-assembler; nostackframe;
+procedure filldword(var x;count : SizeInt;value : dword); assembler; nostackframe;
 asm
 asm
   cmpdi   cr0,r4,0
   cmpdi   cr0,r4,0
   mtctr   r4
   mtctr   r4
@@ -787,7 +419,7 @@ asm
 .Lcopys2loop:
 .Lcopys2loop:
   lbzu    r0,1(r5)
   lbzu    r0,1(r5)
   stbu    r0,1(r9)
   stbu    r0,1(r9)
-  bdnz    .Lcopys2loop
+  bdnz    .Lcopys2loop
 .LconcatDone:
 .LconcatDone:
 end;
 end;
 {$endif FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT}
 {$endif FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT}
@@ -840,8 +472,8 @@ end;
 (*
 (*
 {$define FPC_SYSTEM_HAS_FPC_SHORTSTR_COMPARE}
 {$define FPC_SYSTEM_HAS_FPC_SHORTSTR_COMPARE}
 function fpc_shortstr_compare(const dstr, sstr:shortstring): SizeInt; [public,alias:'FPC_SHORTSTR_COMPARE']; compilerproc;
 function fpc_shortstr_compare(const dstr, sstr:shortstring): SizeInt; [public,alias:'FPC_SHORTSTR_COMPARE']; compilerproc;
-assembler; 
-{ TODO: improve, because the main compare loop does an unaligned access everytime.. :( 
+assembler; 
+{ TODO: improve, because the main compare loop does an unaligned access everytime.. :( 
   TODO: needs some additional opcodes not yet known to the compiler :( }
   TODO: needs some additional opcodes not yet known to the compiler :( }
 asm
 asm
   { load length sstr }
   { load length sstr }
@@ -857,7 +489,7 @@ asm
 
 
   { first compare qwords (length/4) }
   { first compare qwords (length/4) }
   srdi.   r5,r9,3
   srdi.   r5,r9,3
-  { keep length mod 8 for the ends; note that the value in r9 <= 255
+  { keep length mod 8 for the ends; note that the value in r9 <= 255
    so we can use rlwinm safely }
    so we can use rlwinm safely }
   rlwinm  r9,r9,0,29,31
   rlwinm  r9,r9,0,29,31
   { already check whether length mod 8 = 0 }
   { already check whether length mod 8 = 0 }