Browse Source

* several PC related fixes

florian 23 years ago
parent
commit
c8a3171dc9
3 changed files with 1976 additions and 1967 deletions
  1. 76 73
      rtl/linux/powerpc/prt0.as
  2. 1018 1015
      rtl/powerpc/powerpc.inc
  3. 882 879
      rtl/unix/sysunix.inc

+ 76 - 73
rtl/linux/powerpc/prt0.as

@@ -1,74 +1,77 @@
-/* Startup code for programs linked with GNU libc.
-   Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc.
-   This file is part of the GNU C Library.
-
-   The GNU C Library is free software; you can redistribute it and/or
-   modify it under the terms of the GNU Lesser General Public
-   License as published by the Free Software Foundation; either
-   version 2.1 of the License, or (at your option) any later version.
-
-   The GNU C Library 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.  See the GNU
-   Lesser General Public License for more details.
-
-   You should have received a copy of the GNU Lesser General Public
-   License along with the GNU C Library; if not, write to the Free
-   Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
-   02111-1307 USA.  */
-
-        .section ".text"
-        .globl  _start
-_start:
- 	/* Save the stack pointer, in case we're statically linked under Linux.  */
-	mr	9,1
-	/* Set up an initial stack frame, and clear the LR.  */
-	clrrwi	1,1,4
-	li	0,0
-	stwu	1,-16(1)
-	mtlr	0
-	stw	0,0(1)
-	bl	PASCALMAIN
-
-        .globl  _haltproc
-        .type   _haltproc,@function
-_haltproc:
-        li      0,1	         /* exit call */
-	lis	3,U_SYSTEM_EXITCODE@h
-	stw	3,U_SYSTEM_EXITCODE@l(3)
-        sc
-        b	_haltproc
-
-	/* Define a symbol for the first piece of initialized data.  */
-	.section ".data"
-	.globl	__data_start
-__data_start:
-data_start:
-        .globl  ___fpc_brk_addr         /* heap management */
-        .type   ___fpc_brk_addr,@object
-        .size   ___fpc_brk_addr,4
-___fpc_brk_addr:
-        .long   0
-/*
+/* Startup code for programs linked with GNU libc.
+   Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc.
+   This file is part of the GNU C Library.
+
+   The GNU C Library is free software; you can redistribute it and/or
+   modify it under the terms of the GNU Lesser General Public
+   License as published by the Free Software Foundation; either
+   version 2.1 of the License, or (at your option) any later version.
+
+   The GNU C Library 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.  See the GNU
+   Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with the GNU C Library; if not, write to the Free
+   Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+   02111-1307 USA.  */
+
+        .section ".text"
+        .globl  _start
+_start:
+ 	/* Save the stack pointer, in case we're statically linked under Linux.  */
+	mr	9,1
+	/* Set up an initial stack frame, and clear the LR.  */
+	clrrwi	1,1,4
+	li	0,0
+	stwu	1,-16(1)
+	mtlr	0
+	stw	0,0(1)
+	bl	PASCALMAIN
+
+        .globl  _haltproc
+        .type   _haltproc,@function
+_haltproc:
+        li      0,1	         /* exit call */
+	lis	3,U_SYSTEM_EXITCODE@h
+	stw	3,U_SYSTEM_EXITCODE@l(3)
+        sc
+        b	_haltproc
+
+	/* Define a symbol for the first piece of initialized data.  */
+	.section ".data"
+	.globl	__data_start
+__data_start:
+data_start:
+        .globl  ___fpc_brk_addr         /* heap management */
+        .type   ___fpc_brk_addr,@object
+        .size   ___fpc_brk_addr,4
+___fpc_brk_addr:
+        .long   0
+/*
   $Log$
-  Revision 1.7  2002-08-31 16:13:12  florian
-    * made _start global
-
-  Revision 1.6  2002/08/31 14:02:23  florian
-    * r3 renamed to 3
-
-  Revision 1.5  2002/08/31 14:01:28  florian
-    * _haltproc to prt0.as added (Linux/PPC)
-
-  Revision 1.4  2002/08/31 13:11:11  florian
-    * several fixes for Linux/PPC compilation
-
-  Revision 1.3  2002/08/19 21:19:15  florian
-    * small fixes
-
-  Revision 1.2  2002/07/26 17:09:44  florian
-    * log fixed
-
-  Revision 1.1  2002/07/26 16:57:40  florian
-    + initial version, plain copy from glibc/sysdeps/powerpc/elf/start.S
-*/
+  Revision 1.8  2002-08-31 21:29:57  florian
+    * several PC related fixes
+
+  Revision 1.7  2002/08/31 16:13:12  florian
+    * made _start global
+
+  Revision 1.6  2002/08/31 14:02:23  florian
+    * r3 renamed to 3
+
+  Revision 1.5  2002/08/31 14:01:28  florian
+    * _haltproc to prt0.as added (Linux/PPC)
+
+  Revision 1.4  2002/08/31 13:11:11  florian
+    * several fixes for Linux/PPC compilation
+
+  Revision 1.3  2002/08/19 21:19:15  florian
+    * small fixes
+
+  Revision 1.2  2002/07/26 17:09:44  florian
+    * log fixed
+
+  Revision 1.1  2002/07/26 16:57:40  florian
+    + initial version, plain copy from glibc/sysdeps/powerpc/elf/start.S
+*/

+ 1018 - 1015
rtl/powerpc/powerpc.inc

@@ -1,1016 +1,1019 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 2000-2001 by the Free Pascal development team.
-
-    Portions Copyright (c) 2000 by Casey Duncan ([email protected])
-
-    Processor dependent implementation for the system unit for
-    PowerPC
-
-    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.
-
- **********************************************************************}
-
-
-{****************************************************************************
-                           PowerPC specific stuff
-****************************************************************************}
-
-{ This function is never called directly, it's a dummy to hold the register save/
-  load subroutines
-}
-procedure saverestorereg;assembler;
-asm
-{ exit }
-.global _restfpr_14_x
-_restfpr_14_x:  lfd     f14, -144(r11)
-.global _restfpr_15_x
-_restfpr_15_x:  lfd     f15, -136(r11)
-.global _restfpr_16_x
-_restfpr_16_x:  lfd     f16, -128(r11)
-.global _restfpr_17_x
-_restfpr_17_x:  lfd     f17, -120(r11)
-.global _restfpr_18_x
-_restfpr_18_x:  lfd     f18, -112(r11)
-.global _restfpr_19_x
-_restfpr_19_x:  lfd     f19, -104(r11)
-.global _restfpr_20_x
-_restfpr_20_x:  lfd     f20, -96(r11)
-.global _restfpr_21_x
-_restfpr_21_x:  lfd     f21, -88(r11)
-.global _restfpr_22_x
-_restfpr_22_x:  lfd     f22, -80(r11)
-.global _restfpr_23_x
-_restfpr_23_x:  lfd     f23, -72(r11)
-.global _restfpr_24_x
-_restfpr_24_x:  lfd     f24, -64(r11)
-.global _restfpr_25_x
-_restfpr_25_x:  lfd     f25, -56(r11)
-.global _restfpr_26_x
-_restfpr_26_x:  lfd     f26, -48(r11)
-.global _restfpr_27_x
-_restfpr_27_x:  lfd     f27, -40(r11)
-.global _restfpr_28_x
-_restfpr_28_x:  lfd     f28, -32(r11)
-.global _restfpr_29_x
-_restfpr_29_x:  lfd     f29, -24(r11)
-.global _restfpr_30_x
-_restfpr_30_x:  lfd     f30, -16(r11)
-.global _restfpr_31_x
-_restfpr_31_x:  lwz     r0, 4(r11)
-                lfd     f31, -8(r11)
-                mtlr    r0
-                ori     r1, r11, 0
-                blr
-
-{ exit with restoring lr }
-.global _restfpr_14_l
-_restfpr_14_l:  lfd     f14, -144(r11)
-.global _restfpr_15_l
-_restfpr_15_l:  lfd     f15, -136(r11)
-.global _restfpr_16_l
-_restfpr_16_l:  lfd     f16, -128(r11)
-.global _restfpr_17_l
-_restfpr_17_l:  lfd     f17, -120(r11)
-.global _restfpr_18_l
-_restfpr_18_l:  lfd     f18, -112(r11)
-.global _restfpr_19_l
-_restfpr_19_l:  lfd     f19, -104(r11)
-.global _restfpr_20_l
-_restfpr_20_l:  lfd     f20, -96(r11)
-.global _restfpr_21_l
-_restfpr_21_l:  lfd     f21, -88(r11)
-.global _restfpr_22_l
-_restfpr_22_l:  lfd     f22, -80(r11)
-.global _restfpr_23_l
-_restfpr_23_l:  lfd     f23, -72(r11)
-.global _restfpr_24_l
-_restfpr_24_l:  lfd     f24, -64(r11)
-.global _restfpr_25_l
-_restfpr_25_l:  lfd     f25, -56(r11)
-.global _restfpr_26_l
-_restfpr_26_l:  lfd     f26, -48(r11)
-.global _restfpr_27_l
-_restfpr_27_l:  lfd     f27, -40(r11)
-.global _restfpr_28_l
-_restfpr_28_l:  lfd     f28, -32(r11)
-.global _restfpr_29_l
-_restfpr_29_l:  lfd     f29, -24(r11)
-.global _restfpr_30_l
-_restfpr_30_l:  lfd     f30, -16(r11)
-.global _restfpr_31_l
-_restfpr_31_l:  lwz     r0, 4(r11)
-                lfd     f31, -8(r11)
-                mtlr    r0
-                ori     r1, r11, 0
-                blr
-end;
-
-
-{****************************************************************************
-                                Move / Fill
-****************************************************************************}
-
-{$define FPC_SYSTEM_HAS_MOVE}
-
-procedure Move(const source;var dest;count:longint);assembler;
-asm
-          {  count <= 0 ?  }
-          cmpwi   cr0,r5,0
-          {  check if we have to do the move backwards because of overlap  }
-          sub     r10,r4,r3
-          {  carry := boolean(dest-source < count) = boolean(overlap) }
-          subc    r10,r10,r5
-
-          {  count < 15 ? (to decide whether we will move dwords or bytes  }
-          cmpwi   cr1,r5,15
-
-          {  if overlap, then r10 := -1 else r10 := 0  }
-          subfe   r10,r10,r10
-
-          {  count < 39 ? (32 + max. alignment (7) }
-          cmpwi   cr7,r5,39
-
-          {  if count <= 0, stop  }
-          ble     cr0,LMoveDone
-
-          {  load the begin of the source in the data cache }
-          dcbt    0,r3
-          { and the dest as well }
-          dcbst   0,r4
-
-          {  if overlap, then r0 := count else r0 := 0  }
-          and     r0,r5,r10
-          {  if overlap, then point source and dest to the end  }
-          add     r3,r3,r0
-          add     r4,r4,r0
-          {  if overlap, then r0 := 0, else r0 := -1  }
-          not     r0,r10
-          {  if overlap, then r10 := -2, else r10 := 0  }
-          slwi    r10,r10,1
-          {  if overlap, then r10 := -1, else r10 := 1  }
-          addi    r10,r10,1
-          {  if overlap, then source/dest += -1, otherwise they stay }
-          {  After the next instruction, r3/r4 + r10 = next position }
-          {  to load/store from/to                                   }
-          add     r3,r3,r0
-          add     r4,r4,r0
-
-          {  if count < 15, copy everything byte by byte  }
-          blt     cr1,LMoveBytes
-
-          {  otherwise, guarantee 4 byte alignment for dest for starters  }
-LMove4ByteAlignLoop:
-          lbzux   r0,r3,r10
-          stbux   r0,r4,r10
-          {  is dest now 4 aligned?  }
-          andi.   r0,r4,3
-          subi    r5,r5,1
-          {  while not aligned, continue  }
-          bne     cr0,LMove4ByteAlignLoop
-
-          { check for 8 byte alignment }
-          andi.   r0,r4,7
-          { we are going to copy one byte again (the one at the newly }
-          { aligned address), so increase count byte 1                }
-          addi    r5,r5,1
-          { count div 4 for number of dwords to copy }
-          srwi    r0,r5,2
-          {  if 11 <= count < 39, copy using dwords }
-          blt     cr7,LMoveDWords
-
-          { multiply the update count with 4 }
-          slwi    r10,r10,2
-
-          beq     cr0,L8BytesAligned
-
-          {  count >= 39 -> align to 8 byte boundary and then use the FPU  }
-          {  since we're already at 4 byte alignment, use dword store      }
-          lwzux   r0,r3,r10
-          stwux   r0,r4,r10
-          subi    r5,r5,4
-L8BytesAligned:
-          { count div 32 ( >= 1, since count was >=39 }
-          srwi    r0,r5,5
-          { remainder }
-          andi.   r5,r5,31
-          { to decide if we will do some dword stores (instead of only }
-          { byte stores) afterwards or not                             }
-          cmpwi   cr1,r5,11
-          mtctr   r0
-
-          {  r0 := count div 4, will be moved to ctr when copying dwords  }
-          srwi    r0,r5,2
-
-          {  adjust the update count: it will now be 8 or -8 depending on overlap  }
-          slwi    r10,r10,1
-
-          {  adjust source and dest pointers: because of the above loop, dest is now   }
-          {  aligned to 8 bytes. So if we substract r10 we will still have an 8 bytes  }
-          { aligned address)                                                           }
-          sub     r3,r3,r10
-          sub     r4,r4,r10
-
-LMove32ByteLoop:
-          lfdux   f0,r3,r10
-          lfdux   f1,r3,r10
-          lfdux   f2,r3,r10
-          lfdux   f3,r3,r10
-          stfdux  f0,r4,r10
-          stfdux  f1,r4,r10
-          stfdux  f2,r4,r10
-          stfdux  f3,r4,r10
-          bdnz    LMove32ByteLoop
-
-          { cr0*4+eq is true if "count and 31" = 0 }
-          beq     cr0,LMoveDone
-
-          {  make r10 again -1 or 1, but first adjust source/dest pointers }
-          add     r3,r3,r10
-          add     r4,r4,r10
-          srawi   r10,r10,3
-          sub     r3,r3,r10
-          sub     r4,r4,r10
-
-          { cr1 contains whether count <= 11 }
-          ble     cr1,LMoveBytes
-          add     r3,r3,r10
-          add     r4,r4,r10
-
-LMoveDWords:
-          mtctr   r0
-          andi.   r5,r5,3
-          {  r10 * 4  }
-          slwi    r10,r10,2
-          sub     r3,r3,r10
-          sub     r4,r4,r10
-
-LMoveDWordsLoop:
-          lwzux   r0,r3,r10
-          stwux   r0,r4,r10
-          bdnz    LMoveDWordsLoop
-
-          beq     cr0,LMoveDone
-          {  make r10 again -1 or 1  }
-          add     r3,r3,r10
-          add     r4,r4,r10
-          srawi   r10,r10,2
-          sub     r3,r3,r10
-          sub     r4,r4,r10
-LMoveBytes:
-          mtctr   r5
-LMoveBytesLoop:
-          lbzux   r0,r3,r10
-          stbux   r0,r4,r10
-          bdnz    LMoveBytesLoop
-LMoveDone:
-end ['R0','R3','R4','R5','R10','F0','F11','F12','F13','CTR','CR0','CR1','CR7'];
-
-
-{$define FPC_SYSTEM_HAS_FILLCHAR}
-
-Procedure FillChar(var x;count:longint;value:byte);assembler;
-{ input: x in r3, count in r4, value in r5 }
-
-{$ifndef ABI_AIX}
-{ in the AIX ABI, we can use te red zone for temp storage, otherwise we have }
-{ to explicitely allocate room                                               }
-var
-  temp : packed record
-    case byte of
-      0: (l1,l2: longint);
-      1: (d: double);
-    end;
-{$endif ABI_AIX}
-asm
-        { no bytes? }
-        cmpwi     cr6,r4,0
-        { less than 15 bytes? }
-        cmpwi     cr7,r4,15
-        { less than 63 bytes? }
-        cmpwi     cr1,r4,63
-        { fill r5 with ValueValueValueValue }
-        rlwimi    r5,r5,8,16,23
-        { setup for aligning x to multiple of 4}
-        rlwinm    r10,r3,0,31-2+1,31
-        rlwimi    r5,r5,16,0,15
-        beq       cr6,LFillCharDone
-        { get the start of the data in the cache (and mark it as "will be }
-        { modified")                                                      }
-        dcbst     0,r3
-        subfic    r10,r10,4
-        blt       cr7,LFillCharVerySmall
-        { just store 4 bytes instead of using a loop to align (there are }
-        { plenty of other instructions now to keep the processor busy    }
-        { while it handles the (possibly unaligned) store)               }
-        stw       r5,0(r3)
-        { r3 := align(r3,4) }
-        add       r3,r3,r10
-        { decrease count with number of bytes already stored }
-        sub       r4,r4,r10
-        blt       cr1,LFillCharSmall
-        { if we have to fill with 0 (which happens a lot), we can simply use }
-        { dcbz for the most part, which is very fast, so make a special case }
-        { for that                                                           }
-        cmplwi    cr1,r5,0
-        { align to a multiple of 32 (and immediately check whether we aren't }
-        { already 32 byte aligned)                                           }
-        rlwinm.   r10,r3,0,31-5+1,31
-        { setup r3 for using update forms of store instructions }
-        subi      r3,r3,4
-        { get number of bytes to store }
-        subfic    r10,r10,32
-        { if already 32byte aligned, skip align loop }
-        beq       L32ByteAlignLoopDone
-        { substract from the total count }
-        sub       r4,r4,r10
-L32ByteAlignLoop:
-        { we were already aligned to 4 byres, so this will count down to }
-        { exactly 0                                                      }
-        subic.    r10,r10,4
-        stwu      r5,4(r3)
-        bne       L32ByteAlignLoop
-L32ByteAlignLoopDone:
-        { get the amount of 32 byte blocks }
-        srwi      r10,r4,5
-        { and keep the rest in r4 (recording whether there is any rest) }
-        rlwinm.   r4,r4,0,31-5+2,31
-        { move to ctr }
-        mtctr     r10
-        { check how many rest there is (to decide whether we'll use }
-        { FillCharSmall or FillCharVerySmall)                       }
-        cmpl      cr7,r4,11
-        { if filling with zero, only use dcbz }
-        bne       cr1, LFillCharNoZero
-        { make r3 point again to the actual store position }
-        addi      r3,r3,4
-LFillCharDCBZLoop:
-        dcbz      0,r3
-        addi      r3,r3,32
-        bdnz      LFillCharDCBZLoop
-        { if there was no rest, we're finished }
-        beq       LFillCharDone
-        b         LFillCharSmall
-LFillCharNoZero:
-{$ifdef ABI_AIX}
-        stw       r5,0(sp)
-        stw       r5,4(sp)
-        lfd       f0,0(sp)
-{$else ABI_AIX}
-        stw       r5,temp
-        stw       r5,4+temp
-        lfd       f0,temp
-{$endif ABI_AIX}
-        { make r3 point to address-8, so we're able to use fp double stores }
-        { with update (it's already -4 now)                                 }
-        subi      r3,r3,4
-        { load r10 with 8, so that dcbz uses the correct address }
-LFillChar32ByteLoop:
-        dcbz      r3,r10
-        stfdu     f0,8(r3)
-        stfdu     f0,8(r3)
-        stfdu     f0,8(r3)
-        stfdu     f0,8(r3)
-        bdnz      LFillChar32ByteLoop
-        { if there was no rest, we're finished }
-        beq       LFillCharDone
-LFillCharSmall:
-        { when we arrive here, we're already 4 byte aligned }
-        { get count div 4 to store dwords }
-        srwi      r10,r4,2
-        { get ready for use of update stores }
-        subi      r3,r3,4
-        mtctr     r10
-        rlwinm.   r4,r4,0,31-2+1,31
-LFillCharSmallLoop:
-        stwu      r5,4(r3)
-        bdnz      LFillCharSmallLoop
-        { if nothing left, stop }
-        beq       LFillCharDone
-        { get ready to store bytes }
-        addi      r3,r3,4
-LFillCharVerySmall:
-        mtctr     r4
-        subi      r3,r3,1
-LFillCharVerySmallLoop:
-        stbu      r5,1(r3)
-        bdnz      LFillCharVerySmallLoop
-LFillCharDone:
-end;
-
-
-{$define FPC_SYSTEM_HAS_FILLDWORD}
-procedure filldword(var x;count : longint;value : dword);
-assembler;
-asm
-{       registers:
-        r3              x
-        r4              count
-        r5              value
-        r13             value.value
-        r14             ptr to dest word
-        r15             increment 1
-        r16             increment 2
-        r17             scratch
-        r18             scratch
-        f1              value.value.value.value
-}
-                cmpwi   cr0,r3,0
-                mtctr   r4
-                subi    r3,r3,4
-                ble    .FillWordEnd    //if count<=0 Then Exit
-.FillWordLoop:
-                stwu    r5,4(r3)
-                bdnz    .FillWordLoop
-.FillWordEnd:
-end ['R3','R4','R5','CTR'];
-
-
-{$define FPC_SYSTEM_HAS_INDEXBYTE}
-function IndexByte(const buf;len:longint;b:byte):longint; assembler;
-{ input: r3 = buf, r4 = len, r5 = b                   }
-{ output: r3 = position of b in buf (-1 if not found) }
-asm
-                {  load the begin of the buffer in the data cache }
-                dcbt    0,r3
-                cmplwi  r4,0
-                mtctr   r4
-                subi    r10,r3,1
-                mr      r0,r3
-                { assume not found }
-                li      r3,-1
-                beq     LIndexByteDone
-LIndexByteLoop:
-                lbzu    r9,1(r10)
-                cmplw   r9,r5
-                bdnzf   cr0*4+eq,LIndexByteLoop
-                { r3 still contains -1 here }
-                bne     LIndexByteDone
-                sub     r3,r10,r0
-LIndexByteDone:
-end ['R0','R3','R9','R10','CR0','CTR'];
-
-
-{$define FPC_SYSTEM_HAS_INDEXWORD}
-function IndexWord(const buf;len:longint;b:word):longint; assembler;
-{ input: r3 = buf, r4 = len, r5 = b                   }
-{ output: r3 = position of b in buf (-1 if not found) }
-asm
-                {  load the begin of the buffer in the data cache }
-                dcbt    0,r3
-                cmplwi  r4,0
-                mtctr   r4
-                subi    r10,r3,2
-                mr      r0,r3
-                { assume not found }
-                li      r3,-1
-                beq     LIndexWordDone
-LIndexWordLoop:
-                lhzu    r9,2(r10)
-                cmplw   r9,r5
-                bdnzf   cr0*4+eq,LIndexWordLoop
-                { r3 still contains -1 here }
-                bne     LIndexWordDone
-                sub     r3,r10,r0
-LIndexWordDone:
-end ['R0','R3','R9','R10','CR0','CTR'];
-
-
-{$define FPC_SYSTEM_HAS_INDEXDWORD}
-function IndexDWord(const buf;len:longint;b:DWord):longint; assembler;
-{ input: r3 = buf, r4 = len, r5 = b                   }
-{ output: r3 = position of b in buf (-1 if not found) }
-asm
-                {  load the begin of the buffer in the data cache }
-                dcbt    0,r3
-                cmplwi  r4,0
-                mtctr   r4
-                subi    r10,r3,4
-                mr      r0,r3
-                { assume not found }
-                li      r3,-1
-                beq     LIndexDWordDone
-LIndexDWordLoop:
-                lwzu    r9,4(r30)
-                cmplw   r9,r5
-                bdnzf   cr0*4+eq, LIndexDWordLoop
-                { r3 still contains -1 here }
-                bne     LIndexDWordDone
-                sub     r3,r10,r0
-LIndexDWordDone:
-end ['R0','R3','R9','R10','CR0','CTR'];
-
-{$define FPC_SYSTEM_HAS_COMPAREBYTE}
-function CompareByte(const buf1,buf2;len:longint):longint; assembler;
-{ input: r3 = buf1, r4 = buf2, r5 = len                           }
-{ output: r3 = 0 if equal, < 0 if buf1 < str2, > 0 if buf1 > str2 }
-{ note: almost direct copy of strlcomp() from strings.inc         }
-asm
-        {  load the begin of the first buffer in the data cache }
-        dcbt    0,r3
-        { use r0 instead of r3 for buf1 since r3 contains result }
-        cmplwi  r5,0
-        mtctr   r5
-        subi    r11,r3,1
-        subi    r4,r4,1
-        li      r3,0
-        beq     LCompByteDone
-LCompByteLoop:
-        { load next chars }
-        lbzu    r9,1(r11)
-        lbzu    r10,1(r4)
-        { calculate difference }
-        sub.    r3,r9,r10
-        { if chars not equal or at the end, we're ready }
-        bdnzt   cr0*4+eq, LCompByteLoop
-LCompByteDone:
-end ['R0','R3','R4','R9','R10','R11','CR0','CTR'];
-
-{$define FPC_SYSTEM_HAS_COMPAREWORD}
-function CompareWord(const buf1,buf2;len:longint):longint; assembler;
-{ input: r3 = buf1, r4 = buf2, r5 = len                           }
-{ output: r3 = 0 if equal, < 0 if buf1 < str2, > 0 if buf1 > str2 }
-{ note: almost direct copy of strlcomp() from strings.inc         }
-asm
-        {  load the begin of the first buffer in the data cache }
-        dcbt    0,r3
-        { use r0 instead of r3 for buf1 since r3 contains result }
-        cmplwi  r5,0
-        mtctr   r5
-        subi    r11,r3,2
-        subi    r4,r4,2
-        li      r3,0
-        beq     LCompWordDone
-LCompWordLoop:
-        { load next chars }
-        lhzu    r9,2(r11)
-        lhzu    r10,2(r4)
-        { calculate difference }
-        sub.    r3,r9,r10
-        { if chars not equal or at the end, we're ready }
-        bdnzt   cr0*4+eq, LCompWordLoop
-LCompWordDone:
-end ['R0','R3','R4','R9','R10','R11','CR0','CTR'];
-
-
-{$define FPC_SYSTEM_HAS_COMPAREDWORD}
-function CompareDWord(const buf1,buf2;len:longint):longint; assembler;
-{ input: r3 = buf1, r4 = buf2, r5 = len                           }
-{ output: r3 = 0 if equal, < 0 if buf1 < str2, > 0 if buf1 > str2 }
-{ note: almost direct copy of strlcomp() from strings.inc         }
-asm
-        {  load the begin of the first buffer in the data cache }
-        dcbt    0,r3
-        { use r0 instead of r3 for buf1 since r3 contains result }
-        cmplwi  r5,0
-        mtctr   r5
-        subi    r11,r3,4
-        subi    r4,r4,4
-        li      r3,0
-        beq     LCompDWordDone
-LCompDWordLoop:
-        { load next chars }
-        lwzu    r9,4(r11)
-        lwzu    r10,4(r4)
-        { calculate difference }
-        sub.    r3,r9,r10
-        { if chars not equal or at the end, we're ready }
-        bdnzt   cr0*4+eq, LCompDWordLoop
-LCompDWordDone:
-end ['R0','R3','R4','R9','R10','R11','CR0','CTR'];
-
-{$define FPC_SYSTEM_HAS_INDEXCHAR0}
-function IndexChar0(const buf;len:longint;b:Char):longint; assembler;
-{ input: r3 = buf, r4 = len, r5 = b                         }
-{ output: r3 = position of found position (-1 if not found) }
-asm
-        {  load the begin of the buffer in the data cache }
-        dcbt    0,r3
-        { length = 0? }
-        cmplwi  r4,0
-        mtctr   r4
-        subi    r9,r3,1
-        mr      r0,r9
-        { assume not found }
-        li      r3,-1
-        { if yes, do nothing }
-        beq     LIndexChar0Done
-        subi    r3,r3,1
-LIndexChar0Loop:
-        lbzu    r10,1(r9)
-        cmplwi  cr1,r10,0
-        cmplw   r10,r5
-        beq     cr1,LIndexChar0Done
-        bdnzf   cr0*4+eq, LIndexChar0Loop
-        bne     LIndexChar0Done
-        sub     r3,r9,r0
-LIndexChar0Done:
-end ['R0','R3','R4','R9','R10','CR0','CTR'];
-
-
-{****************************************************************************
-                              Object Helpers
-****************************************************************************}
-
-{ use generic implementation for now }
-{ that's a problem currently, the generic has a another prototyp than this defined in compproc.inc (FK) }
-
-{$define FPC_SYSTEM_HAS_FPC_HELP_CONSTRUCTOR}
-procedure fpc_help_constructor; assembler;compilerproc;
-asm
-end;
-
-{$define FPC_SYSTEM_HAS_FPC_HELP_FAIL}
-procedure fpc_help_fail;assembler;[public,alias:'FPC_HELP_FAIL']; compilerproc;
-assembler;
-asm
-{$warning FIX ME!}
-// !!!!!!!!!!!
-end;
-
-
-{$define FPC_SYSTEM_HAS_FPC_HELP_DESTRUCTOR}
-{ use generic implementation for now }
-{ that's a problem currently, the generic has a another prototyp than this defined in compproc.inc (FK) }
-
-procedure fpc_help_destructor;assembler; compilerproc;
-asm
-end;
-
-{$define FPC_SYSTEM_HAS_FPC_NEW_CLASS}
-procedure fpc_new_class;assembler;[public,alias:'FPC_NEW_CLASS']; compilerproc;
-assembler;
-asm
-{$warning FIX ME!}
-// !!!!!!!!!!!
-end;
-
-
-{$define FPC_SYSTEM_HAS_FPC_DISPOSE_CLASS}
-procedure fpc_dispose_class;assembler;[public,alias:'FPC_DISPOSE_CLASS']; compilerproc;
-assembler;
-asm
-{$warning FIX ME!}
-// !!!!!!!!!!!
-end;
-
-{$define FPC_SYSTEM_HAS_FPC_HELP_FAIL_CLASS}
-procedure fpc_help_fail_class;assembler;[public,alias:'FPC_HELP_FAIL_CLASS']; {$ifdef hascompilerproc} compilerproc; {$endif}
-{ a non zero class must allways be disposed
-  VMT is allways at pos 0 }
-assembler;
-asm
-{$warning FIX ME!}
-// !!!!!!!!!!!
-end;
-
-
-
-{$define FPC_SYSTEM_HAS_FPC_CHECK_OBJECT}
-{ use generic implementation for now }
-{ that's a problem currently, the generic has a another prototy than this defined in compproc.inc (FK) }
-procedure fpc_check_object(obj : pointer);assembler; compilerproc;
-asm
-{$warning FIX ME!}
-// !!!!!!!!!!!
-end;
-
-{ use generic implementation for now }
-{ that's a problem currently, the generic has a another prototy than this defined in compproc.inc (FK) }
-{$define FPC_SYSTEM_HAS_FPC_CHECK_OBJECT_EXT}
-procedure fpc_check_object_ext; compilerproc;assembler;
-asm
-{$warning FIX ME!}
-// !!!!!!!!!!!
-end;
-
-{****************************************************************************
-                                 String
-****************************************************************************}
-
-{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_COPY}
-function fpc_shortstr_to_shortstr(len:longint; const sstr: shortstring): shortstring; [public,alias: 'FPC_SHORTSTR_TO_SHORTSTR']; compilerproc;
-assembler;
-{ input: r3: pointer to result, r4: len, r5: sstr }
-asm
-        { load length source }
-        lbz     r10,0(r5)
-        {  load the begin of the dest buffer in the data cache }
-        dcbtst  r0,r3
-
-        { put min(length(sstr),len) in r3 }
-        subc    r0,r4,r10     { r0 := r3 - r10                               }
-        subfme  r4,r4         { if r3 >= r4 then r3' := 0 else r3' := -1     }
-        and     r4,r0,r4      { if r3 >= r4 then r3' := 0 else r3' := r3-r10 }
-        add     r4,r4,r10     { if r3 >= r4 then r3' := r10 else r3' := r3   }
-
-        cmplwi  r4,0
-        { put length in ctr }
-        mtctr   r4
-        stb     r4,0(r3)
-        beq     LShortStrCopyDone
-LShortStrCopyLoop:
-        lbzu    r0,1(r5)
-        stbu    r0,1(r3)
-        bdnz    LShortStrCopyLoop
-LShortStrCopyDone:
-end ['R0','R3','R4','R5','R10','CR0','CTR'];
-
-
-{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_COPY}
-procedure fpc_shortstr_copy(len:longint;sstr,dstr:pointer);[public,alias:'FPC_SHORTSTR_COPY'];
-assembler;
-{ input: r3: len, r4: sstr, r5: dstr }
-asm
-        { load length source }
-        lbz     r10,0(r4)
-        {  load the begin of the dest buffer in the data cache }
-        dcbtst  r0,r5
-
-        { put min(length(sstr),len) in r3 }
-        subc    r0,r3,r10    { r0 := r3 - r10                               }
-        subfme  r3,r3        { if r3 >= r4 then r3' := 0 else r3' := -1     }
-        and     r3,r0,r3     { if r3 >= r4 then r3' := 0 else r3' := r3-r10 }
-        add     r3,r3,r10    { if r3 >= r4 then r3' := r10 else r3' := r3   }
-
-        cmplwi  r3,0
-        { put length in ctr }
-        mtctr   r3
-        stb     r3,0(r5)
-        beq     LShortStrCopyDone2
-LShortStrCopyLoop2:
-        lbzu    r0,1(r4)
-        stbu    r0,1(r5)
-        bdnz    LShortStrCopyLoop2
-LShortStrCopyDone2:
-end ['R0','R3','R4','R5','R10','CR0','CTR'];
-
-{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT}
-function fpc_shortstr_concat(const s1,s2: shortstring): shortstring; compilerproc;
-{ expects that results (r3) contains a pointer to the current string and s1 }
-{ (r4) a pointer to the one that has to be concatenated                     }
-assembler;
-asm
-      { load length s1 }
-      lbz     r9, 0(r4)
-      { load length result }
-      lbz     r10, 0(r3)
-      { go to last current character of result }
-      add     r4,r9,r4
-
-      { calculate min(length(s1),255-length(result)) }
-      subfic  r9,r9,255
-      subc    r8,r9,r10    { r8 := r9 - r10                               }
-      subfme  r9,r9        { if r9 >= r10 then r9' := 0 else r9' := -1    }
-      and     r9,r8,r9     { if r9 >= r10 then r9' := 0 else r9' := r9-r8 }
-      add     r9,r9,r10    { if r9 >= r10 then r9' := r10 else r9' := r9  }
-
-      { and concatenate }
-      mtctr   r9
-LShortStrConcatLoop:
-      lbzu    r10,1(r4)
-      stbu    r10,1(r3)
-      bdnz    LShortStrConcatLoop
-end ['R3','R4','R8','R9','R10','CTR'];
-
-
-{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_COMPARE}
-function fpc_shortstr_compare(const dstr,sstr:shortstring): longint; [public,alias:'FPC_SHORTSTR_COMPARE']; compilerproc;
-assembler;
-asm
-      { load length sstr }
-      lbz     r9,0(r4)
-      { load length dstr }
-      lbz     r10,0(r3)
-      { save their difference for later and      }
-      { calculate min(length(sstr),length(dstr)) }
-      subc    r0,r9,r10    { r0 := r9 - r10                               }
-      subfme  r9,r9        { if r9 >= r10 then r9' := 0 else r9' := -1    }
-      and     r9,r0,r9     { if r9 >= r10 then r9' := 0 else r9' := r9-r8 }
-      add     r9,r9,r10    { if r9 >= r10 then r9' := r10 else r9' := r9  }
-
-      { first compare dwords (length/4) }
-      srwi.   r8,r9,2
-      { keep length mod 4 for the ends }
-      rlwinm  r9,r9,0,30,31
-      { already check whether length mod 4 = 0 }
-      cmplwi  cr1,r9,0
-      { length div 4 in ctr for loop }
-      mtctr   r8
-      { if length < 3, goto byte comparing }
-      beq     LShortStrCompare1
-      { setup for use of update forms of load/store with dwords }
-      subi    r4,r4,3
-      subi    r8,r3,3
-LShortStrCompare4Loop:
-      lwzu    r3,4(r4)
-      lwzu    r10,4(r8)
-      sub.    r3,r3,r10
-      bdnzt   cr0+eq,LShortStrCompare4Loop
-      { r3 contains result if we stopped because of "ne" flag }
-      bne     LShortStrCompareDone
-      { setup for use of update forms of load/store with bytes }
-      addi    r4,r4,3
-      addi    r8,r8,3
-LShortStrCompare1:
-      { if comparelen mod 4 = 0, skip this and return the difference in }
-      { lengths                                                         }
-      beq     cr1,LShortStrCompareLen
-LShortStrCompare1Loop:
-      lbzu    r3,1(r4)
-      lbzu    r10,1(r8)
-      sub.    r3,r3,r10
-      bdnzt   cr0+eq,LShortStrCompare4Loop
-      bne     LShortStrCompareDone
-LShortStrCompareLen:
-      { also return result in flags, maybe we can use this in the CG }
-      mr.     r3,r0
-LShortStrCompareDone:
-end ['R0','R3','R4','R8','R9','R10','CR0','CR1','CTR'];
-
-
-{$define FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR}
-function fpc_pchar_to_shortstr(p:pchar):shortstring;[public,alias:'FPC_PCHAR_TO_SHORTSTR']; compilerproc;
-assembler;
-{$include strpas.inc}
-
-
-{$define FPC_SYSTEM_HAS_STRLEN}
-function strlen(p:pchar):longint;assembler;
-{$include strlen.inc}
-
-
-{$define FPC_SYSTEM_HAS_GET_FRAME}
-function get_frame:longint;assembler;
-asm
-    {$warning FIX ME!}
-    //    !!!!!!! depends on ABI !!!!!!!!
-end ['R3'];
-
-
-{$define FPC_SYSTEM_HAS_GET_CALLER_ADDR}
-function get_caller_addr(framebp:longint):longint;assembler;
-asm
-   {$warning FIX ME!}
-    //     !!!!!!! depends on ABI !!!!!!!!
-end ['R3'];
-
-
-{$define FPC_SYSTEM_HAS_GET_CALLER_FRAME}
-function get_caller_frame(framebp:longint):longint;assembler;
-asm
-    {$warning FIX ME!}
-   //     !!!!!!! depends on ABI !!!!!!!!
-end ['R3'];
-
-{$define FPC_SYSTEM_HAS_ABS_LONGINT}
-function abs(l:longint):longint; assembler;[internconst:in_const_abs];
-asm
-        srawi   r0,r3,31
-        add     r3,r0,r3
-        xor     r3,r3,r0
-end ['R0','R3'];
-
-
-{****************************************************************************
-                                 Math
-****************************************************************************}
-
-{$define FPC_SYSTEM_HAS_ODD_LONGINT}
-function odd(l:longint):boolean;assembler;[internconst:in_const_odd];
-asm
-        rlwinm  r3,r3,0,31,31
-end ['R3'];
-
-
-{$define FPC_SYSTEM_HAS_SQR_LONGINT}
-function sqr(l:longint):longint;assembler;[internconst:in_const_sqr];
-asm
-        mullw   r3,r3,r3
-end ['R3'];
-
-
-{$define FPC_SYSTEM_HAS_SPTR}
-Function Sptr : Longint;assembler;
-asm
-        mr    r3,r1
-end ['R3'];
-
-
-{****************************************************************************
-                                 Str()
-****************************************************************************}
-
-{ int_str: generic implementation is used for now }
-
-
-{****************************************************************************
-                             Multithreading
-****************************************************************************}
-
-{ do a thread save inc/dec }
-
-function declocked(var l : longint) : boolean;assembler;
-{ input:  address of l in r3                                      }
-{ output: boolean indicating whether l is zero after decrementing }
-asm
-LDecLockedLoop:
-{$ifdef MT}
-    lwarx   r10,0,r3
-    subi    r10,r10,1
-    stwcx.  r10,0,r3
-    bne-    LDecLockedLoop
-{$else MT}
-    lwzx    r10,0,r3
-    subi    r10,r10,1
-    stw     r10,0(r3)
-{$endif MT}
-    mr.     r3,r10
-end ['R3','R10'];
-
-procedure inclocked(var l : longint);assembler;
-asm
-LIncLockedLoop:
-{$ifdef MT}
-    lwarx   r10,0,r3
-    addi    r10,r10,1
-    stwcx.  r10,0,r3
-    bne-    LDecLockedLoop
-{$else MT}
-    lwzx    r10,0,r3
-    addi    r10,r10,1
-    stw     r10,0(r3)
-{$endif MT}
-end ['R3','R10'];
-
-
-{
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2000-2001 by the Free Pascal development team.
+
+    Portions Copyright (c) 2000 by Casey Duncan ([email protected])
+
+    Processor dependent implementation for the system unit for
+    PowerPC
+
+    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.
+
+ **********************************************************************}
+
+
+{****************************************************************************
+                           PowerPC specific stuff
+****************************************************************************}
+
+{ This function is never called directly, it's a dummy to hold the register save/
+  load subroutines
+}
+procedure saverestorereg;assembler;
+asm
+{ exit }
+.global _restfpr_14_x
+_restfpr_14_x:  lfd     f14, -144(r11)
+.global _restfpr_15_x
+_restfpr_15_x:  lfd     f15, -136(r11)
+.global _restfpr_16_x
+_restfpr_16_x:  lfd     f16, -128(r11)
+.global _restfpr_17_x
+_restfpr_17_x:  lfd     f17, -120(r11)
+.global _restfpr_18_x
+_restfpr_18_x:  lfd     f18, -112(r11)
+.global _restfpr_19_x
+_restfpr_19_x:  lfd     f19, -104(r11)
+.global _restfpr_20_x
+_restfpr_20_x:  lfd     f20, -96(r11)
+.global _restfpr_21_x
+_restfpr_21_x:  lfd     f21, -88(r11)
+.global _restfpr_22_x
+_restfpr_22_x:  lfd     f22, -80(r11)
+.global _restfpr_23_x
+_restfpr_23_x:  lfd     f23, -72(r11)
+.global _restfpr_24_x
+_restfpr_24_x:  lfd     f24, -64(r11)
+.global _restfpr_25_x
+_restfpr_25_x:  lfd     f25, -56(r11)
+.global _restfpr_26_x
+_restfpr_26_x:  lfd     f26, -48(r11)
+.global _restfpr_27_x
+_restfpr_27_x:  lfd     f27, -40(r11)
+.global _restfpr_28_x
+_restfpr_28_x:  lfd     f28, -32(r11)
+.global _restfpr_29_x
+_restfpr_29_x:  lfd     f29, -24(r11)
+.global _restfpr_30_x
+_restfpr_30_x:  lfd     f30, -16(r11)
+.global _restfpr_31_x
+_restfpr_31_x:  lwz     r0, 4(r11)
+                lfd     f31, -8(r11)
+                mtlr    r0
+                ori     r1, r11, 0
+                blr
+
+{ exit with restoring lr }
+.global _restfpr_14_l
+_restfpr_14_l:  lfd     f14, -144(r11)
+.global _restfpr_15_l
+_restfpr_15_l:  lfd     f15, -136(r11)
+.global _restfpr_16_l
+_restfpr_16_l:  lfd     f16, -128(r11)
+.global _restfpr_17_l
+_restfpr_17_l:  lfd     f17, -120(r11)
+.global _restfpr_18_l
+_restfpr_18_l:  lfd     f18, -112(r11)
+.global _restfpr_19_l
+_restfpr_19_l:  lfd     f19, -104(r11)
+.global _restfpr_20_l
+_restfpr_20_l:  lfd     f20, -96(r11)
+.global _restfpr_21_l
+_restfpr_21_l:  lfd     f21, -88(r11)
+.global _restfpr_22_l
+_restfpr_22_l:  lfd     f22, -80(r11)
+.global _restfpr_23_l
+_restfpr_23_l:  lfd     f23, -72(r11)
+.global _restfpr_24_l
+_restfpr_24_l:  lfd     f24, -64(r11)
+.global _restfpr_25_l
+_restfpr_25_l:  lfd     f25, -56(r11)
+.global _restfpr_26_l
+_restfpr_26_l:  lfd     f26, -48(r11)
+.global _restfpr_27_l
+_restfpr_27_l:  lfd     f27, -40(r11)
+.global _restfpr_28_l
+_restfpr_28_l:  lfd     f28, -32(r11)
+.global _restfpr_29_l
+_restfpr_29_l:  lfd     f29, -24(r11)
+.global _restfpr_30_l
+_restfpr_30_l:  lfd     f30, -16(r11)
+.global _restfpr_31_l
+_restfpr_31_l:  lwz     r0, 4(r11)
+                lfd     f31, -8(r11)
+                mtlr    r0
+                ori     r1, r11, 0
+                blr
+end;
+
+
+{****************************************************************************
+                                Move / Fill
+****************************************************************************}
+
+{$define FPC_SYSTEM_HAS_MOVE}
+
+procedure Move(const source;var dest;count:longint);assembler;
+asm
+          {  count <= 0 ?  }
+          cmpwi   cr0,r5,0
+          {  check if we have to do the move backwards because of overlap  }
+          sub     r10,r4,r3
+          {  carry := boolean(dest-source < count) = boolean(overlap) }
+          subc    r10,r10,r5
+
+          {  count < 15 ? (to decide whether we will move dwords or bytes  }
+          cmpwi   cr1,r5,15
+
+          {  if overlap, then r10 := -1 else r10 := 0  }
+          subfe   r10,r10,r10
+
+          {  count < 39 ? (32 + max. alignment (7) }
+          cmpwi   cr7,r5,39
+
+          {  if count <= 0, stop  }
+          ble     cr0,LMoveDone
+
+          {  load the begin of the source in the data cache }
+          dcbt    0,r3
+          { and the dest as well }
+          dcbst   0,r4
+
+          {  if overlap, then r0 := count else r0 := 0  }
+          and     r0,r5,r10
+          {  if overlap, then point source and dest to the end  }
+          add     r3,r3,r0
+          add     r4,r4,r0
+          {  if overlap, then r0 := 0, else r0 := -1  }
+          not     r0,r10
+          {  if overlap, then r10 := -2, else r10 := 0  }
+          slwi    r10,r10,1
+          {  if overlap, then r10 := -1, else r10 := 1  }
+          addi    r10,r10,1
+          {  if overlap, then source/dest += -1, otherwise they stay }
+          {  After the next instruction, r3/r4 + r10 = next position }
+          {  to load/store from/to                                   }
+          add     r3,r3,r0
+          add     r4,r4,r0
+
+          {  if count < 15, copy everything byte by byte  }
+          blt     cr1,LMoveBytes
+
+          {  otherwise, guarantee 4 byte alignment for dest for starters  }
+LMove4ByteAlignLoop:
+          lbzux   r0,r3,r10
+          stbux   r0,r4,r10
+          {  is dest now 4 aligned?  }
+          andi.   r0,r4,3
+          subi    r5,r5,1
+          {  while not aligned, continue  }
+          bne     cr0,LMove4ByteAlignLoop
+
+          { check for 8 byte alignment }
+          andi.   r0,r4,7
+          { we are going to copy one byte again (the one at the newly }
+          { aligned address), so increase count byte 1                }
+          addi    r5,r5,1
+          { count div 4 for number of dwords to copy }
+          srwi    r0,r5,2
+          {  if 11 <= count < 39, copy using dwords }
+          blt     cr7,LMoveDWords
+
+          { multiply the update count with 4 }
+          slwi    r10,r10,2
+
+          beq     cr0,L8BytesAligned
+
+          {  count >= 39 -> align to 8 byte boundary and then use the FPU  }
+          {  since we're already at 4 byte alignment, use dword store      }
+          lwzux   r0,r3,r10
+          stwux   r0,r4,r10
+          subi    r5,r5,4
+L8BytesAligned:
+          { count div 32 ( >= 1, since count was >=39 }
+          srwi    r0,r5,5
+          { remainder }
+          andi.   r5,r5,31
+          { to decide if we will do some dword stores (instead of only }
+          { byte stores) afterwards or not                             }
+          cmpwi   cr1,r5,11
+          mtctr   r0
+
+          {  r0 := count div 4, will be moved to ctr when copying dwords  }
+          srwi    r0,r5,2
+
+          {  adjust the update count: it will now be 8 or -8 depending on overlap  }
+          slwi    r10,r10,1
+
+          {  adjust source and dest pointers: because of the above loop, dest is now   }
+          {  aligned to 8 bytes. So if we substract r10 we will still have an 8 bytes  }
+          { aligned address)                                                           }
+          sub     r3,r3,r10
+          sub     r4,r4,r10
+
+LMove32ByteLoop:
+          lfdux   f0,r3,r10
+          lfdux   f1,r3,r10
+          lfdux   f2,r3,r10
+          lfdux   f3,r3,r10
+          stfdux  f0,r4,r10
+          stfdux  f1,r4,r10
+          stfdux  f2,r4,r10
+          stfdux  f3,r4,r10
+          bdnz    LMove32ByteLoop
+
+          { cr0*4+eq is true if "count and 31" = 0 }
+          beq     cr0,LMoveDone
+
+          {  make r10 again -1 or 1, but first adjust source/dest pointers }
+          add     r3,r3,r10
+          add     r4,r4,r10
+          srawi   r10,r10,3
+          sub     r3,r3,r10
+          sub     r4,r4,r10
+
+          { cr1 contains whether count <= 11 }
+          ble     cr1,LMoveBytes
+          add     r3,r3,r10
+          add     r4,r4,r10
+
+LMoveDWords:
+          mtctr   r0
+          andi.   r5,r5,3
+          {  r10 * 4  }
+          slwi    r10,r10,2
+          sub     r3,r3,r10
+          sub     r4,r4,r10
+
+LMoveDWordsLoop:
+          lwzux   r0,r3,r10
+          stwux   r0,r4,r10
+          bdnz    LMoveDWordsLoop
+
+          beq     cr0,LMoveDone
+          {  make r10 again -1 or 1  }
+          add     r3,r3,r10
+          add     r4,r4,r10
+          srawi   r10,r10,2
+          sub     r3,r3,r10
+          sub     r4,r4,r10
+LMoveBytes:
+          mtctr   r5
+LMoveBytesLoop:
+          lbzux   r0,r3,r10
+          stbux   r0,r4,r10
+          bdnz    LMoveBytesLoop
+LMoveDone:
+end ['R0','R3','R4','R5','R10','F0','F11','F12','F13','CTR','CR0','CR1','CR7'];
+
+
+{$define FPC_SYSTEM_HAS_FILLCHAR}
+
+Procedure FillChar(var x;count:longint;value:byte);assembler;
+{ input: x in r3, count in r4, value in r5 }
+
+{$ifndef ABI_AIX}
+{ in the AIX ABI, we can use te red zone for temp storage, otherwise we have }
+{ to explicitely allocate room                                               }
+var
+  temp : packed record
+    case byte of
+      0: (l1,l2: longint);
+      1: (d: double);
+    end;
+{$endif ABI_AIX}
+asm
+        { no bytes? }
+        cmpwi     cr6,r4,0
+        { less than 15 bytes? }
+        cmpwi     cr7,r4,15
+        { less than 63 bytes? }
+        cmpwi     cr1,r4,63
+        { fill r5 with ValueValueValueValue }
+        rlwimi    r5,r5,8,16,23
+        { setup for aligning x to multiple of 4}
+        rlwinm    r10,r3,0,31-2+1,31
+        rlwimi    r5,r5,16,0,15
+        beq       cr6,LFillCharDone
+        { get the start of the data in the cache (and mark it as "will be }
+        { modified")                                                      }
+        dcbst     0,r3
+        subfic    r10,r10,4
+        blt       cr7,LFillCharVerySmall
+        { just store 4 bytes instead of using a loop to align (there are }
+        { plenty of other instructions now to keep the processor busy    }
+        { while it handles the (possibly unaligned) store)               }
+        stw       r5,0(r3)
+        { r3 := align(r3,4) }
+        add       r3,r3,r10
+        { decrease count with number of bytes already stored }
+        sub       r4,r4,r10
+        blt       cr1,LFillCharSmall
+        { if we have to fill with 0 (which happens a lot), we can simply use }
+        { dcbz for the most part, which is very fast, so make a special case }
+        { for that                                                           }
+        cmplwi    cr1,r5,0
+        { align to a multiple of 32 (and immediately check whether we aren't }
+        { already 32 byte aligned)                                           }
+        rlwinm.   r10,r3,0,31-5+1,31
+        { setup r3 for using update forms of store instructions }
+        subi      r3,r3,4
+        { get number of bytes to store }
+        subfic    r10,r10,32
+        { if already 32byte aligned, skip align loop }
+        beq       L32ByteAlignLoopDone
+        { substract from the total count }
+        sub       r4,r4,r10
+L32ByteAlignLoop:
+        { we were already aligned to 4 byres, so this will count down to }
+        { exactly 0                                                      }
+        subic.    r10,r10,4
+        stwu      r5,4(r3)
+        bne       L32ByteAlignLoop
+L32ByteAlignLoopDone:
+        { get the amount of 32 byte blocks }
+        srwi      r10,r4,5
+        { and keep the rest in r4 (recording whether there is any rest) }
+        rlwinm.   r4,r4,0,31-5+2,31
+        { move to ctr }
+        mtctr     r10
+        { check how many rest there is (to decide whether we'll use }
+        { FillCharSmall or FillCharVerySmall)                       }
+        cmpl      cr7,r4,11
+        { if filling with zero, only use dcbz }
+        bne       cr1, LFillCharNoZero
+        { make r3 point again to the actual store position }
+        addi      r3,r3,4
+LFillCharDCBZLoop:
+        dcbz      0,r3
+        addi      r3,r3,32
+        bdnz      LFillCharDCBZLoop
+        { if there was no rest, we're finished }
+        beq       LFillCharDone
+        b         LFillCharSmall
+LFillCharNoZero:
+{$ifdef ABI_AIX}
+        stw       r5,0(sp)
+        stw       r5,4(sp)
+        lfd       f0,0(sp)
+{$else ABI_AIX}
+        stw       r5,temp
+        stw       r5,4+temp
+        lfd       f0,temp
+{$endif ABI_AIX}
+        { make r3 point to address-8, so we're able to use fp double stores }
+        { with update (it's already -4 now)                                 }
+        subi      r3,r3,4
+        { load r10 with 8, so that dcbz uses the correct address }
+LFillChar32ByteLoop:
+        dcbz      r3,r10
+        stfdu     f0,8(r3)
+        stfdu     f0,8(r3)
+        stfdu     f0,8(r3)
+        stfdu     f0,8(r3)
+        bdnz      LFillChar32ByteLoop
+        { if there was no rest, we're finished }
+        beq       LFillCharDone
+LFillCharSmall:
+        { when we arrive here, we're already 4 byte aligned }
+        { get count div 4 to store dwords }
+        srwi      r10,r4,2
+        { get ready for use of update stores }
+        subi      r3,r3,4
+        mtctr     r10
+        rlwinm.   r4,r4,0,31-2+1,31
+LFillCharSmallLoop:
+        stwu      r5,4(r3)
+        bdnz      LFillCharSmallLoop
+        { if nothing left, stop }
+        beq       LFillCharDone
+        { get ready to store bytes }
+        addi      r3,r3,4
+LFillCharVerySmall:
+        mtctr     r4
+        subi      r3,r3,1
+LFillCharVerySmallLoop:
+        stbu      r5,1(r3)
+        bdnz      LFillCharVerySmallLoop
+LFillCharDone:
+end;
+
+
+{$define FPC_SYSTEM_HAS_FILLDWORD}
+procedure filldword(var x;count : longint;value : dword);
+assembler;
+asm
+{       registers:
+        r3              x
+        r4              count
+        r5              value
+        r13             value.value
+        r14             ptr to dest word
+        r15             increment 1
+        r16             increment 2
+        r17             scratch
+        r18             scratch
+        f1              value.value.value.value
+}
+                cmpwi   cr0,r3,0
+                mtctr   r4
+                subi    r3,r3,4
+                ble    .FillWordEnd    //if count<=0 Then Exit
+.FillWordLoop:
+                stwu    r5,4(r3)
+                bdnz    .FillWordLoop
+.FillWordEnd:
+end ['R3','R4','R5','CTR'];
+
+
+{$define FPC_SYSTEM_HAS_INDEXBYTE}
+function IndexByte(const buf;len:longint;b:byte):longint; assembler;
+{ input: r3 = buf, r4 = len, r5 = b                   }
+{ output: r3 = position of b in buf (-1 if not found) }
+asm
+                {  load the begin of the buffer in the data cache }
+                dcbt    0,r3
+                cmplwi  r4,0
+                mtctr   r4
+                subi    r10,r3,1
+                mr      r0,r3
+                { assume not found }
+                li      r3,-1
+                beq     LIndexByteDone
+LIndexByteLoop:
+                lbzu    r9,1(r10)
+                cmplw   r9,r5
+                bdnzf   cr0*4+eq,LIndexByteLoop
+                { r3 still contains -1 here }
+                bne     LIndexByteDone
+                sub     r3,r10,r0
+LIndexByteDone:
+end ['R0','R3','R9','R10','CR0','CTR'];
+
+
+{$define FPC_SYSTEM_HAS_INDEXWORD}
+function IndexWord(const buf;len:longint;b:word):longint; assembler;
+{ input: r3 = buf, r4 = len, r5 = b                   }
+{ output: r3 = position of b in buf (-1 if not found) }
+asm
+                {  load the begin of the buffer in the data cache }
+                dcbt    0,r3
+                cmplwi  r4,0
+                mtctr   r4
+                subi    r10,r3,2
+                mr      r0,r3
+                { assume not found }
+                li      r3,-1
+                beq     LIndexWordDone
+LIndexWordLoop:
+                lhzu    r9,2(r10)
+                cmplw   r9,r5
+                bdnzf   cr0*4+eq,LIndexWordLoop
+                { r3 still contains -1 here }
+                bne     LIndexWordDone
+                sub     r3,r10,r0
+LIndexWordDone:
+end ['R0','R3','R9','R10','CR0','CTR'];
+
+
+{$define FPC_SYSTEM_HAS_INDEXDWORD}
+function IndexDWord(const buf;len:longint;b:DWord):longint; assembler;
+{ input: r3 = buf, r4 = len, r5 = b                   }
+{ output: r3 = position of b in buf (-1 if not found) }
+asm
+                {  load the begin of the buffer in the data cache }
+                dcbt    0,r3
+                cmplwi  r4,0
+                mtctr   r4
+                subi    r10,r3,4
+                mr      r0,r3
+                { assume not found }
+                li      r3,-1
+                beq     LIndexDWordDone
+LIndexDWordLoop:
+                lwzu    r9,4(r30)
+                cmplw   r9,r5
+                bdnzf   cr0*4+eq, LIndexDWordLoop
+                { r3 still contains -1 here }
+                bne     LIndexDWordDone
+                sub     r3,r10,r0
+LIndexDWordDone:
+end ['R0','R3','R9','R10','CR0','CTR'];
+
+{$define FPC_SYSTEM_HAS_COMPAREBYTE}
+function CompareByte(const buf1,buf2;len:longint):longint; assembler;
+{ input: r3 = buf1, r4 = buf2, r5 = len                           }
+{ output: r3 = 0 if equal, < 0 if buf1 < str2, > 0 if buf1 > str2 }
+{ note: almost direct copy of strlcomp() from strings.inc         }
+asm
+        {  load the begin of the first buffer in the data cache }
+        dcbt    0,r3
+        { use r0 instead of r3 for buf1 since r3 contains result }
+        cmplwi  r5,0
+        mtctr   r5
+        subi    r11,r3,1
+        subi    r4,r4,1
+        li      r3,0
+        beq     LCompByteDone
+LCompByteLoop:
+        { load next chars }
+        lbzu    r9,1(r11)
+        lbzu    r10,1(r4)
+        { calculate difference }
+        sub.    r3,r9,r10
+        { if chars not equal or at the end, we're ready }
+        bdnzt   cr0*4+eq, LCompByteLoop
+LCompByteDone:
+end ['R0','R3','R4','R9','R10','R11','CR0','CTR'];
+
+{$define FPC_SYSTEM_HAS_COMPAREWORD}
+function CompareWord(const buf1,buf2;len:longint):longint; assembler;
+{ input: r3 = buf1, r4 = buf2, r5 = len                           }
+{ output: r3 = 0 if equal, < 0 if buf1 < str2, > 0 if buf1 > str2 }
+{ note: almost direct copy of strlcomp() from strings.inc         }
+asm
+        {  load the begin of the first buffer in the data cache }
+        dcbt    0,r3
+        { use r0 instead of r3 for buf1 since r3 contains result }
+        cmplwi  r5,0
+        mtctr   r5
+        subi    r11,r3,2
+        subi    r4,r4,2
+        li      r3,0
+        beq     LCompWordDone
+LCompWordLoop:
+        { load next chars }
+        lhzu    r9,2(r11)
+        lhzu    r10,2(r4)
+        { calculate difference }
+        sub.    r3,r9,r10
+        { if chars not equal or at the end, we're ready }
+        bdnzt   cr0*4+eq, LCompWordLoop
+LCompWordDone:
+end ['R0','R3','R4','R9','R10','R11','CR0','CTR'];
+
+
+{$define FPC_SYSTEM_HAS_COMPAREDWORD}
+function CompareDWord(const buf1,buf2;len:longint):longint; assembler;
+{ input: r3 = buf1, r4 = buf2, r5 = len                           }
+{ output: r3 = 0 if equal, < 0 if buf1 < str2, > 0 if buf1 > str2 }
+{ note: almost direct copy of strlcomp() from strings.inc         }
+asm
+        {  load the begin of the first buffer in the data cache }
+        dcbt    0,r3
+        { use r0 instead of r3 for buf1 since r3 contains result }
+        cmplwi  r5,0
+        mtctr   r5
+        subi    r11,r3,4
+        subi    r4,r4,4
+        li      r3,0
+        beq     LCompDWordDone
+LCompDWordLoop:
+        { load next chars }
+        lwzu    r9,4(r11)
+        lwzu    r10,4(r4)
+        { calculate difference }
+        sub.    r3,r9,r10
+        { if chars not equal or at the end, we're ready }
+        bdnzt   cr0*4+eq, LCompDWordLoop
+LCompDWordDone:
+end ['R0','R3','R4','R9','R10','R11','CR0','CTR'];
+
+{$define FPC_SYSTEM_HAS_INDEXCHAR0}
+function IndexChar0(const buf;len:longint;b:Char):longint; assembler;
+{ input: r3 = buf, r4 = len, r5 = b                         }
+{ output: r3 = position of found position (-1 if not found) }
+asm
+        {  load the begin of the buffer in the data cache }
+        dcbt    0,r3
+        { length = 0? }
+        cmplwi  r4,0
+        mtctr   r4
+        subi    r9,r3,1
+        mr      r0,r9
+        { assume not found }
+        li      r3,-1
+        { if yes, do nothing }
+        beq     LIndexChar0Done
+        subi    r3,r3,1
+LIndexChar0Loop:
+        lbzu    r10,1(r9)
+        cmplwi  cr1,r10,0
+        cmplw   r10,r5
+        beq     cr1,LIndexChar0Done
+        bdnzf   cr0*4+eq, LIndexChar0Loop
+        bne     LIndexChar0Done
+        sub     r3,r9,r0
+LIndexChar0Done:
+end ['R0','R3','R4','R9','R10','CR0','CTR'];
+
+
+{****************************************************************************
+                              Object Helpers
+****************************************************************************}
+
+{ use generic implementation for now }
+{ that's a problem currently, the generic has a another prototyp than this defined in compproc.inc (FK) }
+
+{$define FPC_SYSTEM_HAS_FPC_HELP_CONSTRUCTOR}
+procedure fpc_help_constructor; assembler;compilerproc;
+asm
+end;
+
+{$define FPC_SYSTEM_HAS_FPC_HELP_FAIL}
+procedure fpc_help_fail;assembler;[public,alias:'FPC_HELP_FAIL']; compilerproc;
+assembler;
+asm
+{$warning FIX ME!}
+// !!!!!!!!!!!
+end;
+
+
+{$define FPC_SYSTEM_HAS_FPC_HELP_DESTRUCTOR}
+{ use generic implementation for now }
+{ that's a problem currently, the generic has a another prototyp than this defined in compproc.inc (FK) }
+
+procedure fpc_help_destructor;assembler; compilerproc;
+asm
+end;
+
+{$define FPC_SYSTEM_HAS_FPC_NEW_CLASS}
+procedure fpc_new_class;assembler;[public,alias:'FPC_NEW_CLASS']; compilerproc;
+assembler;
+asm
+{$warning FIX ME!}
+// !!!!!!!!!!!
+end;
+
+
+{$define FPC_SYSTEM_HAS_FPC_DISPOSE_CLASS}
+procedure fpc_dispose_class;assembler;[public,alias:'FPC_DISPOSE_CLASS']; compilerproc;
+assembler;
+asm
+{$warning FIX ME!}
+// !!!!!!!!!!!
+end;
+
+{$define FPC_SYSTEM_HAS_FPC_HELP_FAIL_CLASS}
+procedure fpc_help_fail_class;assembler;[public,alias:'FPC_HELP_FAIL_CLASS']; {$ifdef hascompilerproc} compilerproc; {$endif}
+{ a non zero class must allways be disposed
+  VMT is allways at pos 0 }
+assembler;
+asm
+{$warning FIX ME!}
+// !!!!!!!!!!!
+end;
+
+
+
+{$define FPC_SYSTEM_HAS_FPC_CHECK_OBJECT}
+{ use generic implementation for now }
+{ that's a problem currently, the generic has a another prototy than this defined in compproc.inc (FK) }
+procedure fpc_check_object(obj : pointer);assembler; compilerproc;
+asm
+{$warning FIX ME!}
+// !!!!!!!!!!!
+end;
+
+{ use generic implementation for now }
+{ that's a problem currently, the generic has a another prototy than this defined in compproc.inc (FK) }
+{$define FPC_SYSTEM_HAS_FPC_CHECK_OBJECT_EXT}
+procedure fpc_check_object_ext; compilerproc;assembler;
+asm
+{$warning FIX ME!}
+// !!!!!!!!!!!
+end;
+
+{****************************************************************************
+                                 String
+****************************************************************************}
+
+{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_COPY}
+function fpc_shortstr_to_shortstr(len:longint; const sstr: shortstring): shortstring; [public,alias: 'FPC_SHORTSTR_TO_SHORTSTR']; compilerproc;
+assembler;
+{ input: r3: pointer to result, r4: len, r5: sstr }
+asm
+        { load length source }
+        lbz     r10,0(r5)
+        {  load the begin of the dest buffer in the data cache }
+        dcbtst  r0,r3
+
+        { put min(length(sstr),len) in r3 }
+        subc    r0,r4,r10     { r0 := r3 - r10                               }
+        subfme  r4,r4         { if r3 >= r4 then r3' := 0 else r3' := -1     }
+        and     r4,r0,r4      { if r3 >= r4 then r3' := 0 else r3' := r3-r10 }
+        add     r4,r4,r10     { if r3 >= r4 then r3' := r10 else r3' := r3   }
+
+        cmplwi  r4,0
+        { put length in ctr }
+        mtctr   r4
+        stb     r4,0(r3)
+        beq     LShortStrCopyDone
+LShortStrCopyLoop:
+        lbzu    r0,1(r5)
+        stbu    r0,1(r3)
+        bdnz    LShortStrCopyLoop
+LShortStrCopyDone:
+end ['R0','R3','R4','R5','R10','CR0','CTR'];
+
+
+{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_COPY}
+procedure fpc_shortstr_copy(len:longint;sstr,dstr:pointer);[public,alias:'FPC_SHORTSTR_COPY'];
+assembler;
+{ input: r3: len, r4: sstr, r5: dstr }
+asm
+        { load length source }
+        lbz     r10,0(r4)
+        {  load the begin of the dest buffer in the data cache }
+        dcbtst  r0,r5
+
+        { put min(length(sstr),len) in r3 }
+        subc    r0,r3,r10    { r0 := r3 - r10                               }
+        subfme  r3,r3        { if r3 >= r4 then r3' := 0 else r3' := -1     }
+        and     r3,r0,r3     { if r3 >= r4 then r3' := 0 else r3' := r3-r10 }
+        add     r3,r3,r10    { if r3 >= r4 then r3' := r10 else r3' := r3   }
+
+        cmplwi  r3,0
+        { put length in ctr }
+        mtctr   r3
+        stb     r3,0(r5)
+        beq     LShortStrCopyDone2
+LShortStrCopyLoop2:
+        lbzu    r0,1(r4)
+        stbu    r0,1(r5)
+        bdnz    LShortStrCopyLoop2
+LShortStrCopyDone2:
+end ['R0','R3','R4','R5','R10','CR0','CTR'];
+
+{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT}
+function fpc_shortstr_concat(const s1,s2: shortstring): shortstring; compilerproc;
+{ expects that results (r3) contains a pointer to the current string and s1 }
+{ (r4) a pointer to the one that has to be concatenated                     }
+assembler;
+asm
+      { load length s1 }
+      lbz     r9, 0(r4)
+      { load length result }
+      lbz     r10, 0(r3)
+      { go to last current character of result }
+      add     r4,r9,r4
+
+      { calculate min(length(s1),255-length(result)) }
+      subfic  r9,r9,255
+      subc    r8,r9,r10    { r8 := r9 - r10                               }
+      subfme  r9,r9        { if r9 >= r10 then r9' := 0 else r9' := -1    }
+      and     r9,r8,r9     { if r9 >= r10 then r9' := 0 else r9' := r9-r8 }
+      add     r9,r9,r10    { if r9 >= r10 then r9' := r10 else r9' := r9  }
+
+      { and concatenate }
+      mtctr   r9
+LShortStrConcatLoop:
+      lbzu    r10,1(r4)
+      stbu    r10,1(r3)
+      bdnz    LShortStrConcatLoop
+end ['R3','R4','R8','R9','R10','CTR'];
+
+
+{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_COMPARE}
+function fpc_shortstr_compare(const dstr,sstr:shortstring): longint; [public,alias:'FPC_SHORTSTR_COMPARE']; compilerproc;
+assembler;
+asm
+      { load length sstr }
+      lbz     r9,0(r4)
+      { load length dstr }
+      lbz     r10,0(r3)
+      { save their difference for later and      }
+      { calculate min(length(sstr),length(dstr)) }
+      subc    r0,r9,r10    { r0 := r9 - r10                               }
+      subfme  r9,r9        { if r9 >= r10 then r9' := 0 else r9' := -1    }
+      and     r9,r0,r9     { if r9 >= r10 then r9' := 0 else r9' := r9-r8 }
+      add     r9,r9,r10    { if r9 >= r10 then r9' := r10 else r9' := r9  }
+
+      { first compare dwords (length/4) }
+      srwi.   r8,r9,2
+      { keep length mod 4 for the ends }
+      rlwinm  r9,r9,0,30,31
+      { already check whether length mod 4 = 0 }
+      cmplwi  cr1,r9,0
+      { length div 4 in ctr for loop }
+      mtctr   r8
+      { if length < 3, goto byte comparing }
+      beq     LShortStrCompare1
+      { setup for use of update forms of load/store with dwords }
+      subi    r4,r4,3
+      subi    r8,r3,3
+LShortStrCompare4Loop:
+      lwzu    r3,4(r4)
+      lwzu    r10,4(r8)
+      sub.    r3,r3,r10
+      bdnzt   cr0+eq,LShortStrCompare4Loop
+      { r3 contains result if we stopped because of "ne" flag }
+      bne     LShortStrCompareDone
+      { setup for use of update forms of load/store with bytes }
+      addi    r4,r4,3
+      addi    r8,r8,3
+LShortStrCompare1:
+      { if comparelen mod 4 = 0, skip this and return the difference in }
+      { lengths                                                         }
+      beq     cr1,LShortStrCompareLen
+LShortStrCompare1Loop:
+      lbzu    r3,1(r4)
+      lbzu    r10,1(r8)
+      sub.    r3,r3,r10
+      bdnzt   cr0+eq,LShortStrCompare4Loop
+      bne     LShortStrCompareDone
+LShortStrCompareLen:
+      { also return result in flags, maybe we can use this in the CG }
+      mr.     r3,r0
+LShortStrCompareDone:
+end ['R0','R3','R4','R8','R9','R10','CR0','CR1','CTR'];
+
+
+{$define FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR}
+function fpc_pchar_to_shortstr(p:pchar):shortstring;[public,alias:'FPC_PCHAR_TO_SHORTSTR']; compilerproc;
+assembler;
+{$include strpas.inc}
+
+
+{$define FPC_SYSTEM_HAS_STRLEN}
+function strlen(p:pchar):longint;assembler;
+{$include strlen.inc}
+
+
+{$define FPC_SYSTEM_HAS_GET_FRAME}
+function get_frame:longint;assembler;
+asm
+    {$warning FIX ME!}
+    //    !!!!!!! depends on ABI !!!!!!!!
+end ['R3'];
+
+
+{$define FPC_SYSTEM_HAS_GET_CALLER_ADDR}
+function get_caller_addr(framebp:longint):longint;assembler;
+asm
+   {$warning FIX ME!}
+    //     !!!!!!! depends on ABI !!!!!!!!
+end ['R3'];
+
+
+{$define FPC_SYSTEM_HAS_GET_CALLER_FRAME}
+function get_caller_frame(framebp:longint):longint;assembler;
+asm
+    {$warning FIX ME!}
+   //     !!!!!!! depends on ABI !!!!!!!!
+end ['R3'];
+
+{$define FPC_SYSTEM_HAS_ABS_LONGINT}
+function abs(l:longint):longint; assembler;[internconst:in_const_abs];
+asm
+        srawi   r0,r3,31
+        add     r3,r0,r3
+        xor     r3,r3,r0
+end ['R0','R3'];
+
+
+{****************************************************************************
+                                 Math
+****************************************************************************}
+
+{$define FPC_SYSTEM_HAS_ODD_LONGINT}
+function odd(l:longint):boolean;assembler;[internconst:in_const_odd];
+asm
+        rlwinm  r3,r3,0,31,31
+end ['R3'];
+
+
+{$define FPC_SYSTEM_HAS_SQR_LONGINT}
+function sqr(l:longint):longint;assembler;[internconst:in_const_sqr];
+asm
+        mullw   r3,r3,r3
+end ['R3'];
+
+
+{$define FPC_SYSTEM_HAS_SPTR}
+Function Sptr : Longint;assembler;
+asm
+        mr    r3,r1
+end ['R3'];
+
+
+{****************************************************************************
+                                 Str()
+****************************************************************************}
+
+{ int_str: generic implementation is used for now }
+
+
+{****************************************************************************
+                             Multithreading
+****************************************************************************}
+
+{ do a thread save inc/dec }
+
+function declocked(var l : longint) : boolean;assembler;
+{ input:  address of l in r3                                      }
+{ output: boolean indicating whether l is zero after decrementing }
+asm
+LDecLockedLoop:
+{$ifdef MT}
+    lwarx   r10,0,r3
+    subi    r10,r10,1
+    stwcx.  r10,0,r3
+    bne-    LDecLockedLoop
+{$else MT}
+    lwzx    r10,0,r3
+    subi    r10,r10,1
+    stw     r10,0(r3)
+{$endif MT}
+    mr.     r3,r10
+end ['R3','R10'];
+
+procedure inclocked(var l : longint);assembler;
+asm
+LIncLockedLoop:
+{$ifdef MT}
+    lwarx   r10,0,r3
+    addi    r10,r10,1
+    stwcx.  r10,0,r3
+    bne-    LDecLockedLoop
+{$else MT}
+    lwzx    r10,0,r3
+    addi    r10,r10,1
+    stw     r10,0(r3)
+{$endif MT}
+end ['R3','R10'];
+
+
+{
   $Log$
-  Revision 1.16  2002-08-31 16:08:36  florian
-    * fixed undefined labels
-
-  Revision 1.15  2002/08/31 13:11:11  florian
-    * several fixes for Linux/PPC compilation
-
-  Revision 1.14  2002/08/18 22:11:10  florian
-    * fixed remaining assembler errors
-
-  Revision 1.13  2002/08/18 21:37:48  florian
-    * several errors in inline assembler fixed
-
-  Revision 1.12  2002/08/10 17:14:36  jonas
-    * various fixes, mostly changing the names of the modifies registers to
-      upper case since that seems to be required by the compiler
-
-  Revision 1.11  2002/07/30 17:29:53  florian
-    + dummy setjmp and longjmp added
-    + dummy implemtation of the destructor helper
-
-  Revision 1.10  2002/07/28 21:39:29  florian
-    * made abs a compiler proc if it is generic
-
-  Revision 1.9  2002/07/28 20:43:49  florian
-    * several fixes for linux/powerpc
-    * several fixes to MT
-
-  Revision 1.8  2002/07/26 15:45:56  florian
-    * changed multi threading define: it's MT instead of MTRTL
-
-  Revision 1.7  2001/09/28 13:28:49  jonas
-    * small changes to move (different count values trigger the selection of
-      moving bytes instead dwords/doubles and move dcbt instruction)
-    + implemented fillchar (untested)
-
-  Revision 1.6  2001/09/27 15:30:29  jonas
-    * conversion to compilerproc and to structure used by i386 rtl
-    * some bugfixes
-    * powerpc.inc is almost complete (only fillchar/word/dword, get_frame etc
-      and the class helpers are still needed
-    - removed unnecessary register saving in set.inc (thanks to compilerproc)
-    * use registers reserved for parameters as much as possible instead of
-      those reserved for local vars (since those have to be saved by the
-      called anyway, while the ones for local vars have to be saved by the
-      callee)
-
-  Revision 1.5  2001/07/07 12:46:12  jonas
-    * some small bugfixes and cache optimizations
-
-  Revision 1.4  2001/03/03 13:53:36  jonas
-    * fixed small bug in move
-
-  Revision 1.3  2001/03/02 13:24:10  jonas
-    + new, complete implementation of move procedure (including support for
-      overlapping regions)
-
-  Revision 1.2  2001/02/11 17:59:46  jonas
-    * implemented several more procedures
-
-  Revision 1.1  2000/07/27 07:32:12  jonas
-    + initial version by Casey Duncan (not yet thoroughly debugged or complete)
-}
+  Revision 1.17  2002-08-31 21:29:57  florian
+    * several PC related fixes
+
+  Revision 1.16  2002/08/31 16:08:36  florian
+    * fixed undefined labels
+
+  Revision 1.15  2002/08/31 13:11:11  florian
+    * several fixes for Linux/PPC compilation
+
+  Revision 1.14  2002/08/18 22:11:10  florian
+    * fixed remaining assembler errors
+
+  Revision 1.13  2002/08/18 21:37:48  florian
+    * several errors in inline assembler fixed
+
+  Revision 1.12  2002/08/10 17:14:36  jonas
+    * various fixes, mostly changing the names of the modifies registers to
+      upper case since that seems to be required by the compiler
+
+  Revision 1.11  2002/07/30 17:29:53  florian
+    + dummy setjmp and longjmp added
+    + dummy implemtation of the destructor helper
+
+  Revision 1.10  2002/07/28 21:39:29  florian
+    * made abs a compiler proc if it is generic
+
+  Revision 1.9  2002/07/28 20:43:49  florian
+    * several fixes for linux/powerpc
+    * several fixes to MT
+
+  Revision 1.8  2002/07/26 15:45:56  florian
+    * changed multi threading define: it's MT instead of MTRTL
+
+  Revision 1.7  2001/09/28 13:28:49  jonas
+    * small changes to move (different count values trigger the selection of
+      moving bytes instead dwords/doubles and move dcbt instruction)
+    + implemented fillchar (untested)
+
+  Revision 1.6  2001/09/27 15:30:29  jonas
+    * conversion to compilerproc and to structure used by i386 rtl
+    * some bugfixes
+    * powerpc.inc is almost complete (only fillchar/word/dword, get_frame etc
+      and the class helpers are still needed
+    - removed unnecessary register saving in set.inc (thanks to compilerproc)
+    * use registers reserved for parameters as much as possible instead of
+      those reserved for local vars (since those have to be saved by the
+      called anyway, while the ones for local vars have to be saved by the
+      callee)
+
+  Revision 1.5  2001/07/07 12:46:12  jonas
+    * some small bugfixes and cache optimizations
+
+  Revision 1.4  2001/03/03 13:53:36  jonas
+    * fixed small bug in move
+
+  Revision 1.3  2001/03/02 13:24:10  jonas
+    + new, complete implementation of move procedure (including support for
+      overlapping regions)
+
+  Revision 1.2  2001/02/11 17:59:46  jonas
+    * implemented several more procedures
+
+  Revision 1.1  2000/07/27 07:32:12  jonas
+    + initial version by Casey Duncan (not yet thoroughly debugged or complete)
+}

+ 882 - 879
rtl/unix/sysunix.inc

@@ -1,880 +1,883 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1999-2000 by Michael Van Canneyt,
-    member of the Free Pascal development team.
-
-    This is the core of the system unit *nix systems (now FreeBSD
-     and Unix).
-
-    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.
-
- **********************************************************************}
-
-{ These things are set in the makefile, }
-{ But you can override them here.}
-
-{ If you use an aout system, set the conditional AOUT}
-{ $Define AOUT}
-
-{$I system.inc}
-
-{ used in syscall to report errors.}
-var
-  Errno : longint;
-
-{ Include constant and type definitions }
-{$i errno.inc    }  { Error numbers                 }
-{$i sysnr.inc    }  { System call numbers           }
-{$i sysconst.inc }  { Miscellaneous constants       }
-{$i systypes.inc }  { Types needed for system calls }
-
-{ Read actual system call definitions. }
-{$i signal.inc}
-{$i syscalls.inc }
-
-
-{*****************************************************************************
-                       Misc. System Dependent Functions
-*****************************************************************************}
-
-{$ifdef I386}
-{ this should be defined in i386 directory !! PM }
-const
-  fpucw : word = $1332;
-  FPU_Invalid = 1;
-  FPU_Denormal = 2;
-  FPU_DivisionByZero = 4;
-  FPU_Overflow = 8;
-  FPU_Underflow = $10;
-  FPU_StackUnderflow = $20;
-  FPU_StackOverflow = $40;
-
-{$endif I386}
-
-Procedure ResetFPU;
-begin
-{$ifdef I386}
-  asm
-    fninit
-    fldcw   fpucw
-  end;
-{$endif I386}
-end;
-
-
-procedure prthaltproc;external name '_haltproc';
-
-Procedure System_exit;
-Begin
-  prthaltproc;
-End;
-
-
-Function ParamCount: Longint;
-Begin
-  Paramcount:=argc-1;
-End;
-
-
-Function ParamStr(l: Longint): String;
-var
-  link,
-  hs : string;
-  i : longint;
-begin
-  if l=0 then
-   begin
-     str(sys_getpid,hs);
-     {$ifdef FreeBSD}
-      hs:='/proc/'+hs+'/file'#0;
-     {$else}
-      hs:='/proc/'+hs+'/exe'#0;
-     {$endif}
-     i:=Sys_readlink(@hs[1],@link[1],high(link));
-     { it must also be an absolute filename, linux 2.0 points to a memory
-       location so this will skip that }
-     if (i>0) and (link[1]='/') then
-      begin
-        link[0]:=chr(i);
-        paramstr:=link;
-      end
-     else
-      paramstr:=strpas(argv[0]);
-   end
-  else
-   if (l>0) and (l<argc) then
-    paramstr:=strpas(argv[l])
-  else
-    paramstr:='';
-end;
-
-
-Procedure Randomize;
-Begin
-  randseed:=sys_time;
-End;
-
-
-{*****************************************************************************
-                              Heap Management
-*****************************************************************************}
-
-var
-  _HEAP : pointer;external name 'HEAP';
-  _HEAPSIZE : longint;external name 'HEAPSIZE';
-
-function getheapstart:pointer;assembler;
-{$undef fpc_getheapstart_ok}
-{$ifdef i386}
-{$define fpc_getheapstart_ok}
-asm
-        leal    _HEAP,%eax
-end ['EAX'];
-{$endif i386}
-{$ifdef m68k}
-{$define fpc_getheapstart_ok}
-asm
-        lea.l   _HEAP,a0
-        move.l  a0,d0
-end['A0','D0'];
-{$endif m68k}
-{$ifdef powerpc}
-{$define fpc_getheapstart_ok}
-asm
-	lis r3,_HEAP@ha
-        la r3,_HEAP@l(r3)
-end['R3'];
-{$endif powerpc}
-{$ifndef fpc_getheapstart_ok}
-asm
-end;
-{$error Getheapstart code is not implemented }
-{$endif not fpc_getheapstart_ok}
-
-
-function getheapsize:longint;assembler;
-{$undef fpc_getheapsize_ok}
-{$ifdef i386}
-{$define fpc_getheapsize_ok}
-asm
-        movl    _HEAPSIZE,%eax
-end ['EAX'];
-{$endif i386}
-{$ifdef m68k}
-{$define fpc_getheapsize_ok}
-asm
-	move.l   _HEAPSIZE,d0
-end ['D0'];
-{$endif m68k}
-{$ifdef powerpc}
-{$define fpc_getheapsize_ok}
-asm
-	lis r9,_HEAPSIZE@ha
-	lwz r3,_HEAPSIZE@l(r9)
-end ['R0','R9'];
-{$endif powerpc}
-{$ifndef fpc_getheapsize_ok}
-asm
-end;
-{$error Getheapsize code is not implemented }
-{$endif not fpc_getheapsize_ok}
-
-
-Function sbrk(size : longint) : Longint;
-begin
-  sbrk:=Sys_mmap(0,Size,3,MAP_PRIVATE+MAP_ANONYMOUS,-1,0);
-  if sbrk<>-1 then
-   errno:=0;
-  {! It must be -1, not 0 as before, see heap.inc. Should be in sysmmap?}
-end;
-
-
-{ include standard heap management }
-{$I heap.inc}
-
-
-{*****************************************************************************
-                          Low Level File Routines
-*****************************************************************************}
-
-{
-  The lowlevel file functions should take care of setting the InOutRes to the
-  correct value if an error has occured, else leave it untouched
-}
-
-Procedure Errno2Inoutres;
-{
-  Convert ErrNo error to the correct Inoutres value
-}
-
-begin
-  if ErrNo=0 then { Else it will go through all the cases }
-   exit;
-  If errno<0 then Errno:=-errno;
-  case ErrNo of
-   Sys_ENFILE,
-   Sys_EMFILE : Inoutres:=4;
-   Sys_ENOENT : Inoutres:=2;
-    Sys_EBADF : Inoutres:=6;
-   Sys_ENOMEM,
-   Sys_EFAULT : Inoutres:=217;
-   Sys_EINVAL : Inoutres:=218;
-    Sys_EPIPE,
-    Sys_EINTR,
-      Sys_EIO,
-   Sys_EAGAIN,
-   Sys_ENOSPC : Inoutres:=101;
- Sys_ENAMETOOLONG,
-    Sys_ELOOP,
-  Sys_ENOTDIR : Inoutres:=3;
-    Sys_EROFS,
-   Sys_EEXIST,
-   Sys_EISDIR,
-   Sys_ENOTEMPTY,
-   Sys_EACCES : Inoutres:=5;
-  Sys_ETXTBSY : Inoutres:=162;
-  else
-    InOutRes := Integer(Errno);
-  end;
-end;
-
-
-Procedure Do_Close(Handle:Longint);
-Begin
-  sys_close(Handle);
-  {Errno2Inoutres;}
-End;
-
-
-Procedure Do_Erase(p:pchar);
-{$ifdef BSD}
- var FileInfo : Stat;
-{$endif}
-
-Begin
-  {$ifdef BSD} {or POSIX}
-  { verify if the filename is actually a directory }
-  { if so return error and do nothing, as defined  }
-  { by POSIX                                       }
-  if sys_stat(p,fileinfo)<0 then
-   begin
-     Errno2Inoutres;
-     exit;
-   end;
-  {$ifdef BSD}
-   if (fileinfo.mode and STAT_IFMT)=STAT_IFDIR then
-  {$else}
-   if s_ISDIR(fileinfo.st_mode) then
-  {$endif}
-   begin
-     InOutRes := 2;
-     exit;
-   end;
-  {$endif}
-  sys_unlink(p);
-  Errno2Inoutres;
-  {$ifdef Linux}
-  { tp compatible result }
-  if (Errno=Sys_EISDIR) then
-   InOutRes:=2;
-  {$endif}
-End;
-
-
-Procedure Do_Rename(p1,p2:pchar);
-Begin
-  sys_rename(p1,p2);
-  Errno2Inoutres;
-End;
-
-Function Do_Write(Handle,Addr,Len:Longint):longint;
-Begin
-  repeat
-    Do_Write:=sys_write(Handle,pchar(addr),len);
-  until ErrNo<>Sys_EINTR;
-  Errno2Inoutres;
-  if Do_Write<0 then
-   Do_Write:=0;
-End;
-
-
-Function Do_Read(Handle,Addr,Len:Longint):Longint;
-Begin
-  repeat
-    Do_Read:=sys_read(Handle,pchar(addr),len);
-  until ErrNo<>Sys_EINTR;
-  Errno2Inoutres;
-  if Do_Read<0 then
-   Do_Read:=0;
-End;
-
-
-Function Do_FilePos(Handle: Longint): Longint;
-Begin
-  Do_FilePos:=sys_lseek(Handle, 0, Seek_Cur);
-  Errno2Inoutres;
-End;
-
-
-Procedure Do_Seek(Handle,Pos:Longint);
-Begin
-  sys_lseek(Handle, pos, Seek_set);
-  errno2inoutres;
-End;
-
-
-Function Do_SeekEnd(Handle:Longint): Longint;
-begin
-  Do_SeekEnd:=sys_lseek(Handle,0,Seek_End);
-  errno2inoutres;
-end;
-
-Function Do_FileSize(Handle:Longint): Longint;
-var
-  Info : Stat;
-Begin
-  if sys_fstat(handle,info)=0 then
-   Do_FileSize:=Info.Size
-  else
-   Do_FileSize:=0;
-  Errno2Inoutres;
-End;
-
-
-Procedure Do_Truncate(Handle,fPos:longint);
-begin
-  sys_ftruncate(handle,fpos);
-  Errno2Inoutres;
-end;
-
-
-Procedure Do_Open(var f;p:pchar;flags:longint);
-{
-  FileRec and textrec have both Handle and mode as the first items so
-  they could use the same routine for opening/creating.
-  when (flags and $100)   the file will be append
-  when (flags and $1000)  the file will be truncate/rewritten
-  when (flags and $10000) there is no check for close (needed for textfiles)
-}
-var
-  oflags : longint;
-
-Begin
-{ close first if opened }
-  if ((flags and $10000)=0) then
-   begin
-     case FileRec(f).mode of
-      fminput,fmoutput,fminout : Do_Close(FileRec(f).Handle);
-      fmclosed : ;
-     else
-      begin
-        inoutres:=102; {not assigned}
-        exit;
-      end;
-     end;
-   end;
-{ reset file Handle }
-  FileRec(f).Handle:=UnusedHandle;
-{ We do the conversion of filemodes here, concentrated on 1 place }
-  case (flags and 3) of
-   0 : begin
-         oflags :=Open_RDONLY;
-         FileRec(f).mode:=fminput;
-       end;
-   1 : begin
-         oflags :=Open_WRONLY;
-         FileRec(f).mode:=fmoutput;
-       end;
-   2 : begin
-         oflags :=Open_RDWR;
-         FileRec(f).mode:=fminout;
-       end;
-  end;
-  if (flags and $1000)=$1000 then
-   oflags:=oflags or (Open_CREAT or Open_TRUNC)
-  else
-   if (flags and $100)=$100 then
-    oflags:=oflags or (Open_APPEND);
-{ empty name is special }
-  if p[0]=#0 then
-   begin
-     case FileRec(f).mode of
-       fminput :
-         FileRec(f).Handle:=StdInputHandle;
-       fminout, { this is set by rewrite }
-       fmoutput :
-         FileRec(f).Handle:=StdOutputHandle;
-       fmappend :
-         begin
-           FileRec(f).Handle:=StdOutputHandle;
-           FileRec(f).mode:=fmoutput; {fool fmappend}
-         end;
-     end;
-     exit;
-   end;
-{ real open call }
-  FileRec(f).Handle:=sys_open(p,oflags,438);
-  if (ErrNo=Sys_EROFS) and ((OFlags and Open_RDWR)<>0) then
-   begin
-     Oflags:=Oflags and not(Open_RDWR);
-     FileRec(f).Handle:=sys_open(p,oflags,438);
-   end;
-  Errno2Inoutres;
-End;
-
-
-Function Do_IsDevice(Handle:Longint):boolean;
-{
-  Interface to Unix ioctl call.
-  Performs various operations on the filedescriptor Handle.
-  Ndx describes the operation to perform.
-  Data points to data needed for the Ndx function. The structure of this
-  data is function-dependent.
-}
-var
-  Data : array[0..255] of byte; {Large enough for termios info}
-begin
-  Do_IsDevice:=(sys_ioctl(handle,IOCTL_TCGETS,@data)<>-1);
-end;
-
-
-{*****************************************************************************
-                           UnTyped File Handling
-*****************************************************************************}
-
-{$i file.inc}
-
-{*****************************************************************************
-                           Typed File Handling
-*****************************************************************************}
-
-{$i typefile.inc}
-
-{*****************************************************************************
-                           Text File Handling
-*****************************************************************************}
-
-{$DEFINE SHORT_LINEBREAK}
-{$DEFINE EXTENDED_EOF}
-
-{$i text.inc}
-
-{*****************************************************************************
-                           Directory Handling
-*****************************************************************************}
-
-Procedure MkDir(Const s: String);[IOCheck];
-Var
-  Buffer: Array[0..255] of Char;
-Begin
-  If (s='') or (InOutRes <> 0) then
-   exit;
-  Move(s[1], Buffer, Length(s));
-  Buffer[Length(s)] := #0;
-  sys_mkdir(@buffer, 511);
-  Errno2Inoutres;
-End;
-
-
-Procedure RmDir(Const s: String);[IOCheck];
-Var
-  Buffer: Array[0..255] of Char;
-Begin
-  if (s ='.') then
-    InOutRes := 16;
-  If (s='') or (InOutRes <> 0) then
-   exit;
-  Move(s[1], Buffer, Length(s));
-  Buffer[Length(s)] := #0;
-  sys_rmdir(@buffer);
-  {$ifdef BSD}
-    if (Errno=Sys_EINVAL) Then
-     InOutRes:=5
-    Else
-   {$endif}
-  Errno2Inoutres;
-End;
-
-
-Procedure ChDir(Const s: String);[IOCheck];
-Var
-  Buffer: Array[0..255] of Char;
-Begin
-  If (s='') or (InOutRes <> 0) then
-   exit;
-  Move(s[1], Buffer, Length(s));
-  Buffer[Length(s)] := #0;
-  sys_chdir(@buffer);
-  Errno2Inoutres;
-  { file not exists is path not found under tp7 }
-  if InOutRes=2 then
-   InOutRes:=3;
-End;
-
-
-procedure GetDir (DriveNr: byte; var Dir: ShortString);
-var
-  thisdir      : stat;
-  rootino,
-  thisino,
-  dotdotino    : longint;
-  rootdev,
-  thisdev,
-  dotdotdev    : dev_t;
-  thedir,dummy : string[255];
-  dirstream    : pdir;
-  d            : pdirent;
-  mountpoint,validdir : boolean;
-  predot       : string[255];
-begin
-  drivenr:=0;
-  dir:='';
-  thedir:='/'#0;
-  if sys_stat(@thedir[1],thisdir)<0 then
-   exit;
-  rootino:=thisdir.ino;
-  rootdev:=thisdir.dev;
-  thedir:='.'#0;
-  if sys_stat(@thedir[1],thisdir)<0 then
-   exit;
-  thisino:=thisdir.ino;
-  thisdev:=thisdir.dev;
-  { Now we can uniquely identify the current and root dir }
-  thedir:='';
-  predot:='';
-  while not ((thisino=rootino) and (thisdev=rootdev)) do
-   begin
-   { Are we on a mount point ? }
-     dummy:=predot+'..'#0;
-     if sys_stat(@dummy[1],thisdir)<0 then
-      exit;
-     dotdotino:=thisdir.ino;
-     dotdotdev:=thisdir.dev;
-     mountpoint:=(thisdev<>dotdotdev);
-   { Now, Try to find the name of this dir in the previous one }
-     dirstream:=opendir (@dummy[1]);
-     if dirstream=nil then
-      exit;
-     repeat
-       d:=sys_readdir (dirstream);
-       validdir:=false;
-       if (d<>nil) and
-          (not ((d^.name[0]='.') and ((d^.name[1]=#0) or ((d^.name[1]='.')
-                                 and (d^.name[2]=#0))))) and
-                                 (mountpoint or (d^.ino=thisino)) then
-        begin
-          dummy:=predot+'../'+strpas(@(d^.name[0]))+#0;
-          validdir:=not (sys_stat (@(dummy[1]),thisdir)<0);
-        end
-       else
-        validdir:=false;
-     until (d=nil) or
-           ((validdir) and (thisdir.dev=thisdev) and (thisdir.ino=thisino) );
-     { At this point, d.name contains the name of the current dir}
-     if (d<>nil) then
-      thedir:='/'+strpas(@(d^.name[0]))+thedir;
-     { closedir also makes d invalid }
-     if (closedir(dirstream)<0) or (d=nil) then
-      exit;
-     thisdev:=dotdotdev;
-     thisino:=dotdotino;
-     predot:=predot+'../';
-   end;
-{ Now rootino=thisino and rootdev=thisdev so we've reached / }
-  dir:=thedir
-end;
-
-{$ifdef Unix}
-{*****************************************************************************
-                             Thread Handling
-*****************************************************************************}
-
-{ include threading stuff, this is os independend part }
-{$I thread.inc}
-{$endif Unix}
-
-{*****************************************************************************
-                         SystemUnit Initialization
-*****************************************************************************}
-
-{$ifdef BSD}
- procedure SignalToRunerror(Sig: longint; SigContext: SigContextRec;someptr:pointer); cdecl;
-{$else}
- {$ifdef Solaris}
-  procedure SignalToRunerror(Sig: longint; SigContext: SigContextRec;someptr:pointer); cdecl;
- {$else}
-  procedure SignalToRunerror(Sig: longint; SigContext: SigContextRec); cdecl;
- {$endif}
-{$ENDIF}
-var
-
-  res,fpustate : word;
-begin
-  res:=0;
-  case sig of
-    SIGFPE :
-      begin
-    { this is not allways necessary but I don't know yet
-      how to tell if it is or not PM }
-{$ifdef I386}
-          fpustate:=0;
-          res:=200;
-  {$ifndef FreeBSD}
-           if assigned(SigContext.fpstate) then
-             fpuState:=SigContext.fpstate^.sw;
-  {$else}
-            fpustate:=SigContext.en_sw;
-    {$ifdef SYSTEM_DEBUG}
-           writeln('xx:',sigcontext.en_tw,' ',sigcontext.en_cw);
-    {$endif SYSTEM_DEBUG}
-  {$endif}
-  {$ifdef SYSTEM_DEBUG}
-          Writeln(stderr,'FpuState = ',FpuState);
-  {$endif SYSTEM_DEBUG}
-          if (FpuState and $7f) <> 0 then
-            begin
-              { first check te more precise options }
-              if (FpuState and FPU_DivisionByZero)<>0 then
-                res:=200
-              else if (FpuState and FPU_Overflow)<>0 then
-                res:=205
-              else if (FpuState and FPU_Underflow)<>0 then
-                res:=206
-              else if (FpuState and FPU_Denormal)<>0 then
-                res:=216
-              else if (FpuState and (FPU_StackOverflow or FPU_StackUnderflow))<>0 then
-                res:=207
-              else if (FpuState and FPU_Invalid)<>0 then
-                res:=216
-              else
-                res:=207;  {'Coprocessor Error'}
-            end;
-{$endif I386}
-          ResetFPU;
-        end;
-   SIGILL,
-   SIGBUS,
-   SIGSEGV :
-        res:=216;
-  end;
-{ give runtime error at the position where the signal was raised }
-  if res<>0 then
-   begin
-{$ifdef I386}
-     {$ifdef FreeBSD}
-      HandleErrorAddrFrame(res,SigContext.sc_eip,SigContext.sc_ebp);
-     {$else}
-      HandleErrorAddrFrame(res,SigContext.eip,SigContext.ebp);
-     {$endif}
-{$else}
-     HandleError(res);
-{$endif}
-   end;
-end;
-
-
-Procedure InstallSignals;
-const
-{$Ifndef BSD}
- {$ifdef solaris}
-  act: SigActionRec =(sa_flags:SA_SIGINFO;Handler:(sa:@signaltorunerror;sa_mask:0);
- {$else}
-  act: SigActionRec = (handler:(Sa:@SignalToRunError);sa_mask:0;sa_flags:0;
-                       Sa_restorer: NIL);
- {$endif}
-{$ELSE}
-   act: SigActionRec = (handler:(Sa:@SignalToRunError);sa_flags:SA_SIGINFO;
-    sa_mask:0);
-{$endif}
-
-  oldact: PSigActionRec = Nil;          {Probably not necessary anymore, now
-                                         VAR is removed}
-begin
-  ResetFPU;
-  SigAction(SIGFPE,@act,oldact);
-{$ifndef Solaris}
-  SigAction(SIGSEGV,@act,oldact);
-  SigAction(SIGBUS,@act,oldact);
-  SigAction(SIGILL,@act,oldact);
-{$endif}
-end;
-
-
-procedure SetupCmdLine;
-var
-  bufsize,
-  len,j,
-  size,i : longint;
-  found  : boolean;
-  buf    : array[0..1026] of char;
-
-  procedure AddBuf;
-  begin
-    reallocmem(cmdline,size+bufsize);
-    move(buf,cmdline[size],bufsize);
-    inc(size,bufsize);
-    bufsize:=0;
-  end;
-
-begin
-  size:=0;
-  bufsize:=0;
-  i:=0;
-  while (i<argc) do
-   begin
-     len:=strlen(argv[i]);
-     if len>sizeof(buf)-2 then
-      len:=sizeof(buf)-2;
-     found:=false;
-     for j:=1 to len do
-      if argv[i][j]=' ' then
-       begin
-         found:=true;
-         break;
-       end;
-     if bufsize+len>=sizeof(buf)-2 then
-      AddBuf;
-     if found then
-      begin
-        buf[bufsize]:='"';
-        inc(bufsize);
-      end;
-     move(argv[i]^,buf[bufsize],len);
-     inc(bufsize,len);
-     if found then
-      begin
-        buf[bufsize]:='"';
-        inc(bufsize);
-      end;
-     if i<argc then
-      buf[bufsize]:=' '
-     else
-      buf[bufsize]:=#0;
-     inc(bufsize);
-     inc(i);
-   end;
-  AddBuf;
-end;
-
-
-Begin
-  IsConsole := TRUE;
-  IsLibrary := FALSE;
-  StackBottom := Sptr - StackLength;
-{ Set up signals handlers }
-  InstallSignals;
-{ Setup heap }
-  InitHeap;
-  InitExceptions;
-{ Arguments }
-  SetupCmdLine;
-{ Setup stdin, stdout and stderr }
-  OpenStdIO(Input,fmInput,StdInputHandle);
-  OpenStdIO(Output,fmOutput,StdOutputHandle);
-  OpenStdIO(StdOut,fmOutput,StdOutputHandle);
-  OpenStdIO(StdErr,fmOutput,StdErrorHandle);
-{ Reset IO Error }
-  InOutRes:=0;
-End.
-
-{
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by Michael Van Canneyt,
+    member of the Free Pascal development team.
+
+    This is the core of the system unit *nix systems (now FreeBSD
+     and Unix).
+
+    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.
+
+ **********************************************************************}
+
+{ These things are set in the makefile, }
+{ But you can override them here.}
+
+{ If you use an aout system, set the conditional AOUT}
+{ $Define AOUT}
+
+{$I system.inc}
+
+{ used in syscall to report errors.}
+var
+  Errno : longint;
+
+{ Include constant and type definitions }
+{$i errno.inc    }  { Error numbers                 }
+{$i sysnr.inc    }  { System call numbers           }
+{$i sysconst.inc }  { Miscellaneous constants       }
+{$i systypes.inc }  { Types needed for system calls }
+
+{ Read actual system call definitions. }
+{$i signal.inc}
+{$i syscalls.inc }
+
+
+{*****************************************************************************
+                       Misc. System Dependent Functions
+*****************************************************************************}
+
+{$ifdef I386}
+{ this should be defined in i386 directory !! PM }
+const
+  fpucw : word = $1332;
+  FPU_Invalid = 1;
+  FPU_Denormal = 2;
+  FPU_DivisionByZero = 4;
+  FPU_Overflow = 8;
+  FPU_Underflow = $10;
+  FPU_StackUnderflow = $20;
+  FPU_StackOverflow = $40;
+
+{$endif I386}
+
+Procedure ResetFPU;
+begin
+{$ifdef I386}
+  asm
+    fninit
+    fldcw   fpucw
+  end;
+{$endif I386}
+end;
+
+
+procedure prthaltproc;external name '_haltproc';
+
+Procedure System_exit;
+Begin
+  prthaltproc;
+End;
+
+
+Function ParamCount: Longint;
+Begin
+  Paramcount:=argc-1;
+End;
+
+
+Function ParamStr(l: Longint): String;
+var
+  link,
+  hs : string;
+  i : longint;
+begin
+  if l=0 then
+   begin
+     str(sys_getpid,hs);
+     {$ifdef FreeBSD}
+      hs:='/proc/'+hs+'/file'#0;
+     {$else}
+      hs:='/proc/'+hs+'/exe'#0;
+     {$endif}
+     i:=Sys_readlink(@hs[1],@link[1],high(link));
+     { it must also be an absolute filename, linux 2.0 points to a memory
+       location so this will skip that }
+     if (i>0) and (link[1]='/') then
+      begin
+        link[0]:=chr(i);
+        paramstr:=link;
+      end
+     else
+      paramstr:=strpas(argv[0]);
+   end
+  else
+   if (l>0) and (l<argc) then
+    paramstr:=strpas(argv[l])
+  else
+    paramstr:='';
+end;
+
+
+Procedure Randomize;
+Begin
+  randseed:=sys_time;
+End;
+
+
+{*****************************************************************************
+                              Heap Management
+*****************************************************************************}
+
+var
+  _HEAP : pointer;external name 'HEAP';
+  _HEAPSIZE : longint;external name 'HEAPSIZE';
+
+function getheapstart:pointer;assembler;
+{$undef fpc_getheapstart_ok}
+{$ifdef i386}
+{$define fpc_getheapstart_ok}
+asm
+        leal    _HEAP,%eax
+end ['EAX'];
+{$endif i386}
+{$ifdef m68k}
+{$define fpc_getheapstart_ok}
+asm
+        lea.l   _HEAP,a0
+        move.l  a0,d0
+end['A0','D0'];
+{$endif m68k}
+{$ifdef powerpc}
+{$define fpc_getheapstart_ok}
+asm
+        lis r3,HEAP@ha
+        la r3,HEAP@l(r3)
+end['R3'];
+{$endif powerpc}
+{$ifndef fpc_getheapstart_ok}
+asm
+end;
+{$error Getheapstart code is not implemented }
+{$endif not fpc_getheapstart_ok}
+
+
+function getheapsize:longint;assembler;
+{$undef fpc_getheapsize_ok}
+{$ifdef i386}
+{$define fpc_getheapsize_ok}
+asm
+        movl    _HEAPSIZE,%eax
+end ['EAX'];
+{$endif i386}
+{$ifdef m68k}
+{$define fpc_getheapsize_ok}
+asm
+	move.l   _HEAPSIZE,d0
+end ['D0'];
+{$endif m68k}
+{$ifdef powerpc}
+{$define fpc_getheapsize_ok}
+asm
+        lis r9,HEAPSIZE@ha
+        lwz r3,HEAPSIZE@l(r9)
+end ['R0','R9'];
+{$endif powerpc}
+{$ifndef fpc_getheapsize_ok}
+asm
+end;
+{$error Getheapsize code is not implemented }
+{$endif not fpc_getheapsize_ok}
+
+
+Function sbrk(size : longint) : Longint;
+begin
+  sbrk:=Sys_mmap(0,Size,3,MAP_PRIVATE+MAP_ANONYMOUS,-1,0);
+  if sbrk<>-1 then
+   errno:=0;
+  {! It must be -1, not 0 as before, see heap.inc. Should be in sysmmap?}
+end;
+
+
+{ include standard heap management }
+{$I heap.inc}
+
+
+{*****************************************************************************
+                          Low Level File Routines
+*****************************************************************************}
+
+{
+  The lowlevel file functions should take care of setting the InOutRes to the
+  correct value if an error has occured, else leave it untouched
+}
+
+Procedure Errno2Inoutres;
+{
+  Convert ErrNo error to the correct Inoutres value
+}
+
+begin
+  if ErrNo=0 then { Else it will go through all the cases }
+   exit;
+  If errno<0 then Errno:=-errno;
+  case ErrNo of
+   Sys_ENFILE,
+   Sys_EMFILE : Inoutres:=4;
+   Sys_ENOENT : Inoutres:=2;
+    Sys_EBADF : Inoutres:=6;
+   Sys_ENOMEM,
+   Sys_EFAULT : Inoutres:=217;
+   Sys_EINVAL : Inoutres:=218;
+    Sys_EPIPE,
+    Sys_EINTR,
+      Sys_EIO,
+   Sys_EAGAIN,
+   Sys_ENOSPC : Inoutres:=101;
+ Sys_ENAMETOOLONG,
+    Sys_ELOOP,
+  Sys_ENOTDIR : Inoutres:=3;
+    Sys_EROFS,
+   Sys_EEXIST,
+   Sys_EISDIR,
+   Sys_ENOTEMPTY,
+   Sys_EACCES : Inoutres:=5;
+  Sys_ETXTBSY : Inoutres:=162;
+  else
+    InOutRes := Integer(Errno);
+  end;
+end;
+
+
+Procedure Do_Close(Handle:Longint);
+Begin
+  sys_close(Handle);
+  {Errno2Inoutres;}
+End;
+
+
+Procedure Do_Erase(p:pchar);
+{$ifdef BSD}
+ var FileInfo : Stat;
+{$endif}
+
+Begin
+  {$ifdef BSD} {or POSIX}
+  { verify if the filename is actually a directory }
+  { if so return error and do nothing, as defined  }
+  { by POSIX                                       }
+  if sys_stat(p,fileinfo)<0 then
+   begin
+     Errno2Inoutres;
+     exit;
+   end;
+  {$ifdef BSD}
+   if (fileinfo.mode and STAT_IFMT)=STAT_IFDIR then
+  {$else}
+   if s_ISDIR(fileinfo.st_mode) then
+  {$endif}
+   begin
+     InOutRes := 2;
+     exit;
+   end;
+  {$endif}
+  sys_unlink(p);
+  Errno2Inoutres;
+  {$ifdef Linux}
+  { tp compatible result }
+  if (Errno=Sys_EISDIR) then
+   InOutRes:=2;
+  {$endif}
+End;
+
+
+Procedure Do_Rename(p1,p2:pchar);
+Begin
+  sys_rename(p1,p2);
+  Errno2Inoutres;
+End;
+
+Function Do_Write(Handle,Addr,Len:Longint):longint;
+Begin
+  repeat
+    Do_Write:=sys_write(Handle,pchar(addr),len);
+  until ErrNo<>Sys_EINTR;
+  Errno2Inoutres;
+  if Do_Write<0 then
+   Do_Write:=0;
+End;
+
+
+Function Do_Read(Handle,Addr,Len:Longint):Longint;
+Begin
+  repeat
+    Do_Read:=sys_read(Handle,pchar(addr),len);
+  until ErrNo<>Sys_EINTR;
+  Errno2Inoutres;
+  if Do_Read<0 then
+   Do_Read:=0;
+End;
+
+
+Function Do_FilePos(Handle: Longint): Longint;
+Begin
+  Do_FilePos:=sys_lseek(Handle, 0, Seek_Cur);
+  Errno2Inoutres;
+End;
+
+
+Procedure Do_Seek(Handle,Pos:Longint);
+Begin
+  sys_lseek(Handle, pos, Seek_set);
+  errno2inoutres;
+End;
+
+
+Function Do_SeekEnd(Handle:Longint): Longint;
+begin
+  Do_SeekEnd:=sys_lseek(Handle,0,Seek_End);
+  errno2inoutres;
+end;
+
+Function Do_FileSize(Handle:Longint): Longint;
+var
+  Info : Stat;
+Begin
+  if sys_fstat(handle,info)=0 then
+   Do_FileSize:=Info.Size
+  else
+   Do_FileSize:=0;
+  Errno2Inoutres;
+End;
+
+
+Procedure Do_Truncate(Handle,fPos:longint);
+begin
+  sys_ftruncate(handle,fpos);
+  Errno2Inoutres;
+end;
+
+
+Procedure Do_Open(var f;p:pchar;flags:longint);
+{
+  FileRec and textrec have both Handle and mode as the first items so
+  they could use the same routine for opening/creating.
+  when (flags and $100)   the file will be append
+  when (flags and $1000)  the file will be truncate/rewritten
+  when (flags and $10000) there is no check for close (needed for textfiles)
+}
+var
+  oflags : longint;
+
+Begin
+{ close first if opened }
+  if ((flags and $10000)=0) then
+   begin
+     case FileRec(f).mode of
+      fminput,fmoutput,fminout : Do_Close(FileRec(f).Handle);
+      fmclosed : ;
+     else
+      begin
+        inoutres:=102; {not assigned}
+        exit;
+      end;
+     end;
+   end;
+{ reset file Handle }
+  FileRec(f).Handle:=UnusedHandle;
+{ We do the conversion of filemodes here, concentrated on 1 place }
+  case (flags and 3) of
+   0 : begin
+         oflags :=Open_RDONLY;
+         FileRec(f).mode:=fminput;
+       end;
+   1 : begin
+         oflags :=Open_WRONLY;
+         FileRec(f).mode:=fmoutput;
+       end;
+   2 : begin
+         oflags :=Open_RDWR;
+         FileRec(f).mode:=fminout;
+       end;
+  end;
+  if (flags and $1000)=$1000 then
+   oflags:=oflags or (Open_CREAT or Open_TRUNC)
+  else
+   if (flags and $100)=$100 then
+    oflags:=oflags or (Open_APPEND);
+{ empty name is special }
+  if p[0]=#0 then
+   begin
+     case FileRec(f).mode of
+       fminput :
+         FileRec(f).Handle:=StdInputHandle;
+       fminout, { this is set by rewrite }
+       fmoutput :
+         FileRec(f).Handle:=StdOutputHandle;
+       fmappend :
+         begin
+           FileRec(f).Handle:=StdOutputHandle;
+           FileRec(f).mode:=fmoutput; {fool fmappend}
+         end;
+     end;
+     exit;
+   end;
+{ real open call }
+  FileRec(f).Handle:=sys_open(p,oflags,438);
+  if (ErrNo=Sys_EROFS) and ((OFlags and Open_RDWR)<>0) then
+   begin
+     Oflags:=Oflags and not(Open_RDWR);
+     FileRec(f).Handle:=sys_open(p,oflags,438);
+   end;
+  Errno2Inoutres;
+End;
+
+
+Function Do_IsDevice(Handle:Longint):boolean;
+{
+  Interface to Unix ioctl call.
+  Performs various operations on the filedescriptor Handle.
+  Ndx describes the operation to perform.
+  Data points to data needed for the Ndx function. The structure of this
+  data is function-dependent.
+}
+var
+  Data : array[0..255] of byte; {Large enough for termios info}
+begin
+  Do_IsDevice:=(sys_ioctl(handle,IOCTL_TCGETS,@data)<>-1);
+end;
+
+
+{*****************************************************************************
+                           UnTyped File Handling
+*****************************************************************************}
+
+{$i file.inc}
+
+{*****************************************************************************
+                           Typed File Handling
+*****************************************************************************}
+
+{$i typefile.inc}
+
+{*****************************************************************************
+                           Text File Handling
+*****************************************************************************}
+
+{$DEFINE SHORT_LINEBREAK}
+{$DEFINE EXTENDED_EOF}
+
+{$i text.inc}
+
+{*****************************************************************************
+                           Directory Handling
+*****************************************************************************}
+
+Procedure MkDir(Const s: String);[IOCheck];
+Var
+  Buffer: Array[0..255] of Char;
+Begin
+  If (s='') or (InOutRes <> 0) then
+   exit;
+  Move(s[1], Buffer, Length(s));
+  Buffer[Length(s)] := #0;
+  sys_mkdir(@buffer, 511);
+  Errno2Inoutres;
+End;
+
+
+Procedure RmDir(Const s: String);[IOCheck];
+Var
+  Buffer: Array[0..255] of Char;
+Begin
+  if (s ='.') then
+    InOutRes := 16;
+  If (s='') or (InOutRes <> 0) then
+   exit;
+  Move(s[1], Buffer, Length(s));
+  Buffer[Length(s)] := #0;
+  sys_rmdir(@buffer);
+  {$ifdef BSD}
+    if (Errno=Sys_EINVAL) Then
+     InOutRes:=5
+    Else
+   {$endif}
+  Errno2Inoutres;
+End;
+
+
+Procedure ChDir(Const s: String);[IOCheck];
+Var
+  Buffer: Array[0..255] of Char;
+Begin
+  If (s='') or (InOutRes <> 0) then
+   exit;
+  Move(s[1], Buffer, Length(s));
+  Buffer[Length(s)] := #0;
+  sys_chdir(@buffer);
+  Errno2Inoutres;
+  { file not exists is path not found under tp7 }
+  if InOutRes=2 then
+   InOutRes:=3;
+End;
+
+
+procedure GetDir (DriveNr: byte; var Dir: ShortString);
+var
+  thisdir      : stat;
+  rootino,
+  thisino,
+  dotdotino    : longint;
+  rootdev,
+  thisdev,
+  dotdotdev    : dev_t;
+  thedir,dummy : string[255];
+  dirstream    : pdir;
+  d            : pdirent;
+  mountpoint,validdir : boolean;
+  predot       : string[255];
+begin
+  drivenr:=0;
+  dir:='';
+  thedir:='/'#0;
+  if sys_stat(@thedir[1],thisdir)<0 then
+   exit;
+  rootino:=thisdir.ino;
+  rootdev:=thisdir.dev;
+  thedir:='.'#0;
+  if sys_stat(@thedir[1],thisdir)<0 then
+   exit;
+  thisino:=thisdir.ino;
+  thisdev:=thisdir.dev;
+  { Now we can uniquely identify the current and root dir }
+  thedir:='';
+  predot:='';
+  while not ((thisino=rootino) and (thisdev=rootdev)) do
+   begin
+   { Are we on a mount point ? }
+     dummy:=predot+'..'#0;
+     if sys_stat(@dummy[1],thisdir)<0 then
+      exit;
+     dotdotino:=thisdir.ino;
+     dotdotdev:=thisdir.dev;
+     mountpoint:=(thisdev<>dotdotdev);
+   { Now, Try to find the name of this dir in the previous one }
+     dirstream:=opendir (@dummy[1]);
+     if dirstream=nil then
+      exit;
+     repeat
+       d:=sys_readdir (dirstream);
+       validdir:=false;
+       if (d<>nil) and
+          (not ((d^.name[0]='.') and ((d^.name[1]=#0) or ((d^.name[1]='.')
+                                 and (d^.name[2]=#0))))) and
+                                 (mountpoint or (d^.ino=thisino)) then
+        begin
+          dummy:=predot+'../'+strpas(@(d^.name[0]))+#0;
+          validdir:=not (sys_stat (@(dummy[1]),thisdir)<0);
+        end
+       else
+        validdir:=false;
+     until (d=nil) or
+           ((validdir) and (thisdir.dev=thisdev) and (thisdir.ino=thisino) );
+     { At this point, d.name contains the name of the current dir}
+     if (d<>nil) then
+      thedir:='/'+strpas(@(d^.name[0]))+thedir;
+     { closedir also makes d invalid }
+     if (closedir(dirstream)<0) or (d=nil) then
+      exit;
+     thisdev:=dotdotdev;
+     thisino:=dotdotino;
+     predot:=predot+'../';
+   end;
+{ Now rootino=thisino and rootdev=thisdev so we've reached / }
+  dir:=thedir
+end;
+
+{$ifdef Unix}
+{*****************************************************************************
+                             Thread Handling
+*****************************************************************************}
+
+{ include threading stuff, this is os independend part }
+{$I thread.inc}
+{$endif Unix}
+
+{*****************************************************************************
+                         SystemUnit Initialization
+*****************************************************************************}
+
+{$ifdef BSD}
+ procedure SignalToRunerror(Sig: longint; SigContext: SigContextRec;someptr:pointer); cdecl;
+{$else}
+ {$ifdef Solaris}
+  procedure SignalToRunerror(Sig: longint; SigContext: SigContextRec;someptr:pointer); cdecl;
+ {$else}
+  procedure SignalToRunerror(Sig: longint; SigContext: SigContextRec); cdecl;
+ {$endif}
+{$ENDIF}
+var
+
+  res,fpustate : word;
+begin
+  res:=0;
+  case sig of
+    SIGFPE :
+      begin
+    { this is not allways necessary but I don't know yet
+      how to tell if it is or not PM }
+{$ifdef I386}
+          fpustate:=0;
+          res:=200;
+  {$ifndef FreeBSD}
+           if assigned(SigContext.fpstate) then
+             fpuState:=SigContext.fpstate^.sw;
+  {$else}
+            fpustate:=SigContext.en_sw;
+    {$ifdef SYSTEM_DEBUG}
+           writeln('xx:',sigcontext.en_tw,' ',sigcontext.en_cw);
+    {$endif SYSTEM_DEBUG}
+  {$endif}
+  {$ifdef SYSTEM_DEBUG}
+          Writeln(stderr,'FpuState = ',FpuState);
+  {$endif SYSTEM_DEBUG}
+          if (FpuState and $7f) <> 0 then
+            begin
+              { first check te more precise options }
+              if (FpuState and FPU_DivisionByZero)<>0 then
+                res:=200
+              else if (FpuState and FPU_Overflow)<>0 then
+                res:=205
+              else if (FpuState and FPU_Underflow)<>0 then
+                res:=206
+              else if (FpuState and FPU_Denormal)<>0 then
+                res:=216
+              else if (FpuState and (FPU_StackOverflow or FPU_StackUnderflow))<>0 then
+                res:=207
+              else if (FpuState and FPU_Invalid)<>0 then
+                res:=216
+              else
+                res:=207;  {'Coprocessor Error'}
+            end;
+{$endif I386}
+          ResetFPU;
+        end;
+   SIGILL,
+   SIGBUS,
+   SIGSEGV :
+        res:=216;
+  end;
+{ give runtime error at the position where the signal was raised }
+  if res<>0 then
+   begin
+{$ifdef I386}
+     {$ifdef FreeBSD}
+      HandleErrorAddrFrame(res,SigContext.sc_eip,SigContext.sc_ebp);
+     {$else}
+      HandleErrorAddrFrame(res,SigContext.eip,SigContext.ebp);
+     {$endif}
+{$else}
+     HandleError(res);
+{$endif}
+   end;
+end;
+
+
+Procedure InstallSignals;
+const
+{$Ifndef BSD}
+ {$ifdef solaris}
+  act: SigActionRec =(sa_flags:SA_SIGINFO;Handler:(sa:@signaltorunerror;sa_mask:0);
+ {$else}
+  act: SigActionRec = (handler:(Sa:@SignalToRunError);sa_mask:0;sa_flags:0;
+                       Sa_restorer: NIL);
+ {$endif}
+{$ELSE}
+   act: SigActionRec = (handler:(Sa:@SignalToRunError);sa_flags:SA_SIGINFO;
+    sa_mask:0);
+{$endif}
+
+  oldact: PSigActionRec = Nil;          {Probably not necessary anymore, now
+                                         VAR is removed}
+begin
+  ResetFPU;
+  SigAction(SIGFPE,@act,oldact);
+{$ifndef Solaris}
+  SigAction(SIGSEGV,@act,oldact);
+  SigAction(SIGBUS,@act,oldact);
+  SigAction(SIGILL,@act,oldact);
+{$endif}
+end;
+
+
+procedure SetupCmdLine;
+var
+  bufsize,
+  len,j,
+  size,i : longint;
+  found  : boolean;
+  buf    : array[0..1026] of char;
+
+  procedure AddBuf;
+  begin
+    reallocmem(cmdline,size+bufsize);
+    move(buf,cmdline[size],bufsize);
+    inc(size,bufsize);
+    bufsize:=0;
+  end;
+
+begin
+  size:=0;
+  bufsize:=0;
+  i:=0;
+  while (i<argc) do
+   begin
+     len:=strlen(argv[i]);
+     if len>sizeof(buf)-2 then
+      len:=sizeof(buf)-2;
+     found:=false;
+     for j:=1 to len do
+      if argv[i][j]=' ' then
+       begin
+         found:=true;
+         break;
+       end;
+     if bufsize+len>=sizeof(buf)-2 then
+      AddBuf;
+     if found then
+      begin
+        buf[bufsize]:='"';
+        inc(bufsize);
+      end;
+     move(argv[i]^,buf[bufsize],len);
+     inc(bufsize,len);
+     if found then
+      begin
+        buf[bufsize]:='"';
+        inc(bufsize);
+      end;
+     if i<argc then
+      buf[bufsize]:=' '
+     else
+      buf[bufsize]:=#0;
+     inc(bufsize);
+     inc(i);
+   end;
+  AddBuf;
+end;
+
+
+Begin
+  IsConsole := TRUE;
+  IsLibrary := FALSE;
+  StackBottom := Sptr - StackLength;
+{ Set up signals handlers }
+  InstallSignals;
+{ Setup heap }
+  InitHeap;
+  InitExceptions;
+{ Arguments }
+  SetupCmdLine;
+{ Setup stdin, stdout and stderr }
+  OpenStdIO(Input,fmInput,StdInputHandle);
+  OpenStdIO(Output,fmOutput,StdOutputHandle);
+  OpenStdIO(StdOut,fmOutput,StdOutputHandle);
+  OpenStdIO(StdErr,fmOutput,StdErrorHandle);
+{ Reset IO Error }
+  InOutRes:=0;
+End.
+
+{
   $Log$
-  Revision 1.26  2002-08-13 18:11:08  florian
-    * heap stuff for powerpc fixed
-
-  Revision 1.25  2002/08/03 20:05:13  florian
-    + ppc implementation of heap functions added
-
-  Revision 1.24  2002/07/29 21:28:17  florian
-    * several fixes to get further with linux/ppc system unit compilation
-
-  Revision 1.23  2002/07/28 20:43:49  florian
-    * several fixes for linux/powerpc
-    * several fixes to MT
-
-  Revision 1.22  2002/05/31 13:37:24  marco
-   * more Renamefest
-
-  Revision 1.21  2002/04/21 15:55:00  carl
-  + initialize some global variables
-
-  Revision 1.20  2002/04/12 17:43:28  carl
-  + generic stack checking
-
-  Revision 1.19  2002/03/11 19:10:33  peter
-    * Regenerated with updated fpcmake
-
-  Revision 1.18  2001/10/14 13:33:21  peter
-    * start of thread support for linux
-
-  Revision 1.17  2001/09/30 21:10:20  peter
-    * erase(directory) returns now 2 to be tp compatible
-
-  Revision 1.16  2001/08/05 12:24:20  peter
-    * m68k merges
-
-  Revision 1.15  2001/07/16 19:51:36  marco
-   * A small note, copied from the Solaris patch. Do_close needs errnotoiores?
-
-  Revision 1.14  2001/07/15 11:57:16  peter
-    * merged m68k updates
-
-  Revision 1.13  2001/07/13 22:05:09  peter
-    * cygwin updates
-
-  Revision 1.12  2001/06/02 19:24:49  peter
-    * chdir rte 2 mapped to 3
-
-  Revision 1.11  2001/06/02 00:31:31  peter
-    * merge unix updates from the 1.0 branch, mostly related to the
-      solaris target
-
-  Revision 1.10  2001/04/23 20:33:31  peter
-    * also install sig handlers for sigill,sigbus
-
-  Revision 1.9  2001/04/13 22:39:05  peter
-    * removed warning
-
-  Revision 1.8  2001/04/12 17:53:43  peter
-    * fixed usage of already release memory in getdir
-
-  Revision 1.7  2001/03/21 21:08:20  hajny
-    * GetDir fixed
-
-  Revision 1.6  2001/03/16 20:09:58  hajny
-    * universal FExpand
-
-  Revision 1.5  2001/02/20 21:31:12  peter
-    * chdir,mkdir,rmdir with empty string fixed
-
-  Revision 1.4  2000/12/17 14:00:57  peter
-    * removed debug writelns
-
-  Revision 1.3  2000/10/09 16:35:51  marco
-   * Fixed the first (of many) ioctls that make building the IDE hard.
-
-  Revision 1.2  2000/09/18 13:14:51  marco
-   * Global Linux +bsd to (rtl/freebsd rtl/unix rtl/linux structure)
-
-  Revision 1.6  2000/09/11 13:48:08  marco
-   * FreeBSD support and removal of old sighandler
-
-  Revision 1.5  2000/08/13 08:43:45  peter
-    * don't check for directory in do_open (merged)
-
-  Revision 1.4  2000/08/05 18:33:51  peter
-    * paramstr(0) fix for linux 2.0 kernels (merged)
-
-  Revision 1.3  2000/07/14 10:33:10  michael
-  + Conditionals fixed
-
-  Revision 1.2  2000/07/13 11:33:49  michael
-  + removed logs
-
-}
+  Revision 1.27  2002-08-31 21:29:57  florian
+    * several PC related fixes
+
+  Revision 1.26  2002/08/13 18:11:08  florian
+    * heap stuff for powerpc fixed
+
+  Revision 1.25  2002/08/03 20:05:13  florian
+    + ppc implementation of heap functions added
+
+  Revision 1.24  2002/07/29 21:28:17  florian
+    * several fixes to get further with linux/ppc system unit compilation
+
+  Revision 1.23  2002/07/28 20:43:49  florian
+    * several fixes for linux/powerpc
+    * several fixes to MT
+
+  Revision 1.22  2002/05/31 13:37:24  marco
+   * more Renamefest
+
+  Revision 1.21  2002/04/21 15:55:00  carl
+  + initialize some global variables
+
+  Revision 1.20  2002/04/12 17:43:28  carl
+  + generic stack checking
+
+  Revision 1.19  2002/03/11 19:10:33  peter
+    * Regenerated with updated fpcmake
+
+  Revision 1.18  2001/10/14 13:33:21  peter
+    * start of thread support for linux
+
+  Revision 1.17  2001/09/30 21:10:20  peter
+    * erase(directory) returns now 2 to be tp compatible
+
+  Revision 1.16  2001/08/05 12:24:20  peter
+    * m68k merges
+
+  Revision 1.15  2001/07/16 19:51:36  marco
+   * A small note, copied from the Solaris patch. Do_close needs errnotoiores?
+
+  Revision 1.14  2001/07/15 11:57:16  peter
+    * merged m68k updates
+
+  Revision 1.13  2001/07/13 22:05:09  peter
+    * cygwin updates
+
+  Revision 1.12  2001/06/02 19:24:49  peter
+    * chdir rte 2 mapped to 3
+
+  Revision 1.11  2001/06/02 00:31:31  peter
+    * merge unix updates from the 1.0 branch, mostly related to the
+      solaris target
+
+  Revision 1.10  2001/04/23 20:33:31  peter
+    * also install sig handlers for sigill,sigbus
+
+  Revision 1.9  2001/04/13 22:39:05  peter
+    * removed warning
+
+  Revision 1.8  2001/04/12 17:53:43  peter
+    * fixed usage of already release memory in getdir
+
+  Revision 1.7  2001/03/21 21:08:20  hajny
+    * GetDir fixed
+
+  Revision 1.6  2001/03/16 20:09:58  hajny
+    * universal FExpand
+
+  Revision 1.5  2001/02/20 21:31:12  peter
+    * chdir,mkdir,rmdir with empty string fixed
+
+  Revision 1.4  2000/12/17 14:00:57  peter
+    * removed debug writelns
+
+  Revision 1.3  2000/10/09 16:35:51  marco
+   * Fixed the first (of many) ioctls that make building the IDE hard.
+
+  Revision 1.2  2000/09/18 13:14:51  marco
+   * Global Linux +bsd to (rtl/freebsd rtl/unix rtl/linux structure)
+
+  Revision 1.6  2000/09/11 13:48:08  marco
+   * FreeBSD support and removal of old sighandler
+
+  Revision 1.5  2000/08/13 08:43:45  peter
+    * don't check for directory in do_open (merged)
+
+  Revision 1.4  2000/08/05 18:33:51  peter
+    * paramstr(0) fix for linux 2.0 kernels (merged)
+
+  Revision 1.3  2000/07/14 10:33:10  michael
+  + Conditionals fixed
+
+  Revision 1.2  2000/07/13 11:33:49  michael
+  + removed logs
+
+}