diff --git a/rtl/i386/i386.inc b/rtl/i386/i386.inc index 59c2bac27b..09c96d957f 100644 --- a/rtl/i386/i386.inc +++ b/rtl/i386/i386.inc @@ -104,7 +104,7 @@ end; {$ifndef FPC_SYSTEM_HAS_MOVE} {$define FPC_SYSTEM_HAS_MOVE} -procedure Move(const source;var dest;count:SizeInt);[public, alias: 'FPC_MOVE'];assembler; +procedure Move(const source;out dest;count:SizeInt);[public, alias: 'FPC_MOVE'];assembler; var saveesi,saveedi : longint; asm @@ -188,7 +188,7 @@ end; {$ifndef FPC_SYSTEM_HAS_FILLCHAR} {$define FPC_SYSTEM_HAS_FILLCHAR} -Procedure FillChar(var x;count:SizeInt;value:byte);assembler; +Procedure FillChar(out x;count:SizeInt;value:byte);assembler; asm {A push is prefered over a local variable because a local @@ -229,7 +229,7 @@ end; {$ifndef FPC_SYSTEM_HAS_FILLWORD} {$define FPC_SYSTEM_HAS_FILLWORD} -procedure fillword(var x;count : SizeInt;value : word);assembler; +procedure fillword(out x;count : SizeInt;value : word);assembler; var saveedi : longint; asm @@ -266,7 +266,7 @@ end; {$ifndef FPC_SYSTEM_HAS_FILLDWORD} {$define FPC_SYSTEM_HAS_FILLDWORD} -procedure filldword(var x;count : SizeInt;value : dword);assembler; +procedure filldword(out x;count : SizeInt;value : dword);assembler; var saveedi : longint; asm diff --git a/rtl/inc/cgeneric.inc b/rtl/inc/cgeneric.inc index 12a89b9717..6d38e8d93f 100644 --- a/rtl/inc/cgeneric.inc +++ b/rtl/inc/cgeneric.inc @@ -21,10 +21,10 @@ {$ifndef FPC_SYSTEM_HAS_MOVE} {$define FPC_SYSTEM_HAS_MOVE} -procedure bcopy(const source;var dest;count:sizeuint); cdecl; external 'c' name 'bcopy'; +procedure bcopy(const source;out dest;count:sizeuint); cdecl; external 'c' name 'bcopy'; { we need this separate move declaration because we can't add a "public, alias" to the above } -procedure Move(const source;var dest;count:sizeint); [public, alias: 'FPC_MOVE'];{$ifdef SYSTEMINLINE}inline;{$endif} +procedure Move(const source;out dest;count:sizeint); [public, alias: 'FPC_MOVE'];{$ifdef SYSTEMINLINE}inline;{$endif} begin if count <= 0 then exit; @@ -35,9 +35,9 @@ end; {$ifndef FPC_SYSTEM_HAS_FILLCHAR} {$define FPC_SYSTEM_HAS_FILLCHAR} -procedure memset(var x; value: byte; count: sizeuint); cdecl; external 'c'; +procedure memset(out x; value: byte; count: sizeuint); cdecl; external 'c'; -Procedure FillChar(var x;count: sizeint;value:byte);{$ifdef SYSTEMINLINE}inline;{$endif} +Procedure FillChar(out x;count: sizeint;value:byte);{$ifdef SYSTEMINLINE}inline;{$endif} begin if count <= 0 then exit; @@ -48,7 +48,7 @@ end; {$ifndef FPC_SYSTEM_HAS_FILLBYTE} {$define FPC_SYSTEM_HAS_FILLBYTE} -procedure FillByte (var x;count : sizeint;value : byte );{$ifdef SYSTEMINLINE}inline;{$endif} +procedure FillByte (out x;count : sizeint;value : byte );{$ifdef SYSTEMINLINE}inline;{$endif} begin if count <= 0 then exit; diff --git a/rtl/inc/generic.inc b/rtl/inc/generic.inc index d4810a78ba..30c25aa4a9 100644 --- a/rtl/inc/generic.inc +++ b/rtl/inc/generic.inc @@ -22,7 +22,7 @@ type pstring = ^shortstring; {$ifndef FPC_SYSTEM_HAS_MOVE} -procedure Move(const source;var dest;count:SizeInt);[public, alias: 'FPC_MOVE']; +procedure Move(const source;out dest;count:SizeInt);[public, alias: 'FPC_MOVE']; type bytearray = array [0..high(sizeint)-1] of byte; var @@ -45,7 +45,7 @@ end; {$ifndef FPC_SYSTEM_HAS_FILLCHAR} -Procedure FillChar(var x;count:SizeInt;value:byte); +Procedure FillChar(out x;count:SizeInt;value:byte); type longintarray = array [0..high(sizeint) div 4-1] of longint; bytearray = array [0..high(sizeint)-1] of byte; @@ -74,7 +74,7 @@ end; {$ifndef FPC_SYSTEM_HAS_FILLBYTE} -procedure FillByte (var x;count : SizeInt;value : byte ); +procedure FillByte (out x;count : SizeInt;value : byte ); begin FillChar (X,Count,CHR(VALUE)); end; @@ -82,7 +82,7 @@ end; {$ifndef FPC_SYSTEM_HAS_FILLWORD} -procedure fillword(var x;count : SizeInt;value : word); +procedure fillword(out x;count : SizeInt;value : word); type longintarray = array [0..high(sizeint) div 4-1] of longint; wordarray = array [0..high(sizeint) div 2-1] of word; @@ -109,7 +109,7 @@ end; {$ifndef FPC_SYSTEM_HAS_FILLDWORD} -procedure FillDWord(var x;count : SizeInt;value : DWord); +procedure FillDWord(out x;count : SizeInt;value : DWord); type longintarray = array [0..high(sizeint) div 4-1] of longint; begin @@ -287,7 +287,7 @@ end; {$ifndef FPC_SYSTEM_HAS_MOVECHAR0} -procedure MoveChar0(Const buf1;var buf2;len:SizeInt); +procedure MoveChar0(Const buf1;out buf2;len:SizeInt); var I : longint; begin diff --git a/rtl/inc/system.inc b/rtl/inc/system.inc index 501ac664c5..8efb3c5c04 100644 --- a/rtl/inc/system.inc +++ b/rtl/inc/system.inc @@ -139,12 +139,12 @@ function CheckInitialStkLen(stklen : SizeUInt) : SizeUInt; forward; {$define SYSPROCDEFINED} {$endif cpuarm} -procedure fillchar(var x;count : SizeInt;value : boolean);{$ifdef SYSTEMINLINE}inline;{$endif} +procedure fillchar(out x;count : SizeInt;value : boolean);{$ifdef SYSTEMINLINE}inline;{$endif} begin fillchar(x,count,byte(value)); end; -procedure fillchar(var x;count : SizeInt;value : char);{$ifdef SYSTEMINLINE}inline;{$endif} +procedure fillchar(out x;count : SizeInt;value : char);{$ifdef SYSTEMINLINE}inline;{$endif} begin fillchar(x,count,byte(value)); end; diff --git a/rtl/inc/systemh.inc b/rtl/inc/systemh.inc index 9494258775..2b1c4164b2 100644 --- a/rtl/inc/systemh.inc +++ b/rtl/inc/systemh.inc @@ -367,13 +367,13 @@ ThreadVar {$endif} {$endif} -Procedure Move(const source;var dest;count:SizeInt);{$ifdef INLINEGENERICS}inline;{$endif} -Procedure FillChar(var x;count:SizeInt;Value:Boolean);{$ifdef SYSTEMINLINE}inline;{$endif} -Procedure FillChar(var x;count:SizeInt;Value:Char);{$ifdef SYSTEMINLINE}inline;{$endif} -Procedure FillChar(var x;count:SizeInt;Value:Byte);{$ifdef INLINEGENERICS}inline;{$endif} -procedure FillByte(var x;count:SizeInt;value:byte);{$ifdef INLINEGENERICS}inline;{$endif} -Procedure FillWord(var x;count:SizeInt;Value:Word); -procedure FillDWord(var x;count:SizeInt;value:DWord); +Procedure Move(const source;out dest;count:SizeInt);{$ifdef INLINEGENERICS}inline;{$endif} +Procedure FillChar(out x;count:SizeInt;Value:Boolean);{$ifdef SYSTEMINLINE}inline;{$endif} +Procedure FillChar(out x;count:SizeInt;Value:Char);{$ifdef SYSTEMINLINE}inline;{$endif} +Procedure FillChar(out x;count:SizeInt;Value:Byte);{$ifdef INLINEGENERICS}inline;{$endif} +procedure FillByte(out x;count:SizeInt;value:byte);{$ifdef INLINEGENERICS}inline;{$endif} +Procedure FillWord(out x;count:SizeInt;Value:Word); +procedure FillDWord(out x;count:SizeInt;value:DWord); function IndexChar(const buf;len:SizeInt;b:char):SizeInt; function IndexByte(const buf;len:SizeInt;b:byte):SizeInt;{$ifdef INLINEGENERICS}inline;{$endif} function Indexword(const buf;len:SizeInt;b:word):SizeInt; @@ -382,7 +382,7 @@ function CompareChar(const buf1,buf2;len:SizeInt):SizeInt; function CompareByte(const buf1,buf2;len:SizeInt):SizeInt;{$ifdef INLINEGENERICS}inline;{$endif} function CompareWord(const buf1,buf2;len:SizeInt):SizeInt; function CompareDWord(const buf1,buf2;len:SizeInt):SizeInt; -procedure MoveChar0(const buf1;var buf2;len:SizeInt); +procedure MoveChar0(const buf1;out buf2;len:SizeInt); function IndexChar0(const buf;len:SizeInt;b:char):SizeInt; function CompareChar0(const buf1,buf2;len:SizeInt):SizeInt;{$ifdef INLINEGENERICS}inline;{$endif} procedure prefetch(const mem);[internproc:fpc_in_prefetch_var]; diff --git a/rtl/m68k/m68k.inc b/rtl/m68k/m68k.inc index e3f6cbd1c1..6edb254056 100644 --- a/rtl/m68k/m68k.inc +++ b/rtl/m68k/m68k.inc @@ -80,7 +80,7 @@ function Sptr : Longint; {$define FPC_SYSTEM_HAS_FILLCHAR} -procedure FillChar(var x;count:longint;value:byte);[public,alias: 'FPC_FILL_OBJECT']; +procedure FillChar(out x;count:longint;value:byte);[public,alias: 'FPC_FILL_OBJECT']; begin asm move.l 8(a6), a0 { destination } @@ -232,7 +232,7 @@ end; {$define FPC_SYSTEM_HAS_MOVE} -procedure move(var source;var dest;count : longint); +procedure move(const source;out dest;count : longint); { base pointer+8 = source } { base pointer+12 = destination } { base pointer+16 = number of bytes to move} @@ -289,7 +289,7 @@ end; {$define FPC_SYSTEM_HAS_FILLWORD} -procedure fillword(var x;count : longint;value : word); +procedure fillword(out x;count : longint;value : word); begin asm move.l 8(a6), a0 { destination } diff --git a/rtl/powerpc/powerpc.inc b/rtl/powerpc/powerpc.inc index 3fab9cba4a..56fdca103c 100644 --- a/rtl/powerpc/powerpc.inc +++ b/rtl/powerpc/powerpc.inc @@ -1,1163 +1,1163 @@ -{ - - 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 (casey.duncan@state.co.us) - - 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 -****************************************************************************} -{ - -const - ppc_fpu_overflow = (1 shl (32-3)); - ppc_fpu_underflow = (1 shl (32-4)); - ppc_fpu_divbyzero = (1 shl (32-5)); - ppc_fpu_inexact = (1 shl (32-6)); - ppc_fpu_invalid_snan = (1 shl (32-7)); -} - -procedure fpc_enable_ppc_fpu_exceptions; -assembler; nostackframe; -asm - { clear all "exception happened" flags we care about} - mtfsfi 0,0 - mtfsfi 1,0 - mtfsfi 2,0 - mtfsfi 3,0 - mtfsb0 21 - mtfsb0 22 - mtfsb0 23 - - { enable invalid operations and division by zero exceptions. } - { No overflow/underflow, since those give some spurious } - { exceptions } - mtfsfi 6,9 -end; - - -procedure fpc_cpuinit; -begin - fpc_enable_ppc_fpu_exceptions; -end; - - -function fpc_get_ppc_fpscr: cardinal; -assembler; -var - temp: record a,b:longint; end; -asm - mffs f0 - stfd f0,temp - lwz r3,temp.b - { clear all exception flags } -{ - rlwinm r4,r3,0,16,31 - stw r4,temp.b - lfd f0,temp - a_mtfsf f0 -} -end; - -{ This function is never called directly, it's a dummy to hold the register save/ - load subroutines -} -{$ifndef MACOS} -label - _restfpr_14_x, - _restfpr_15_x, - _restfpr_16_x, - _restfpr_17_x, - _restfpr_18_x, - _restfpr_19_x, - _restfpr_20_x, - _restfpr_21_x, - _restfpr_22_x, - _restfpr_23_x, - _restfpr_24_x, - _restfpr_25_x, - _restfpr_26_x, - _restfpr_27_x, - _restfpr_28_x, - _restfpr_29_x, - _restfpr_30_x, - _restfpr_31_x, - _restfpr_14_l, - _restfpr_15_l, - _restfpr_16_l, - _restfpr_17_l, - _restfpr_18_l, - _restfpr_19_l, - _restfpr_20_l, - _restfpr_21_l, - _restfpr_22_l, - _restfpr_23_l, - _restfpr_24_l, - _restfpr_25_l, - _restfpr_26_l, - _restfpr_27_l, - _restfpr_28_l, - _restfpr_29_l, - _restfpr_30_l, - _restfpr_31_l; - -procedure saverestorereg;assembler; nostackframe; -asm -{ exit } -.globl _restfpr_14_x -_restfpr_14_x: lfd f14, -144(r11) -.globl _restfpr_15_x -_restfpr_15_x: lfd f15, -136(r11) -.globl _restfpr_16_x -_restfpr_16_x: lfd f16, -128(r11) -.globl _restfpr_17_x -_restfpr_17_x: lfd f17, -120(r11) -.globl _restfpr_18_x -_restfpr_18_x: lfd f18, -112(r11) -.globl _restfpr_19_x -_restfpr_19_x: lfd f19, -104(r11) -.globl _restfpr_20_x -_restfpr_20_x: lfd f20, -96(r11) -.globl _restfpr_21_x -_restfpr_21_x: lfd f21, -88(r11) -.globl _restfpr_22_x -_restfpr_22_x: lfd f22, -80(r11) -.globl _restfpr_23_x -_restfpr_23_x: lfd f23, -72(r11) -.globl _restfpr_24_x -_restfpr_24_x: lfd f24, -64(r11) -.globl _restfpr_25_x -_restfpr_25_x: lfd f25, -56(r11) -.globl _restfpr_26_x -_restfpr_26_x: lfd f26, -48(r11) -.globl _restfpr_27_x -_restfpr_27_x: lfd f27, -40(r11) -.globl _restfpr_28_x -_restfpr_28_x: lfd f28, -32(r11) -.globl _restfpr_29_x -_restfpr_29_x: lfd f29, -24(r11) -.globl _restfpr_30_x -_restfpr_30_x: lfd f30, -16(r11) -.globl _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 } -.globl _restfpr_14_l -_restfpr_14_l: lfd f14, -144(r11) -.globl _restfpr_15_l -_restfpr_15_l: lfd f15, -136(r11) -.globl _restfpr_16_l -_restfpr_16_l: lfd f16, -128(r11) -.globl _restfpr_17_l -_restfpr_17_l: lfd f17, -120(r11) -.globl _restfpr_18_l -_restfpr_18_l: lfd f18, -112(r11) -.globl _restfpr_19_l -_restfpr_19_l: lfd f19, -104(r11) -.globl _restfpr_20_l -_restfpr_20_l: lfd f20, -96(r11) -.globl _restfpr_21_l -_restfpr_21_l: lfd f21, -88(r11) -.globl _restfpr_22_l -_restfpr_22_l: lfd f22, -80(r11) -.globl _restfpr_23_l -_restfpr_23_l: lfd f23, -72(r11) -.globl _restfpr_24_l -_restfpr_24_l: lfd f24, -64(r11) -.globl _restfpr_25_l -_restfpr_25_l: lfd f25, -56(r11) -.globl _restfpr_26_l -_restfpr_26_l: lfd f26, -48(r11) -.globl _restfpr_27_l -_restfpr_27_l: lfd f27, -40(r11) -.globl _restfpr_28_l -_restfpr_28_l: lfd f28, -32(r11) -.globl _restfpr_29_l -_restfpr_29_l: lfd f29, -24(r11) -.globl _restfpr_30_l -_restfpr_30_l: lfd f30, -16(r11) -.globl _restfpr_31_l -_restfpr_31_l: lwz r0, 4(r11) - lfd f31, -8(r11) - mtlr r0 - ori r1, r11, 0 - blr -end; -{$endif MACOS} - -{**************************************************************************** - Move / Fill -****************************************************************************} - -{$ifndef FPC_SYSTEM_HAS_MOVE} -{$define FPC_SYSTEM_HAS_MOVE} -procedure Move(const source;var dest;count:longint);[public, alias: 'FPC_MOVE'];assembler; nostackframe; -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 < 63 ? (32 + max. alignment (31) } - cmpwi cr7,r5,63 - - { 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 } - dcbtst 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 r6 := 0, else r6 := -1 } - not r6,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 count < 15, copy everything byte by byte } - blt cr1,.LMoveBytes - - { if no 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,r6 - add r4,r4,r6 - - { 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 - -{$ifndef ppc603} - { check for 32 byte alignment } - andi. r7,r4,31 -{$endif non ppc603} - { 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 < 63, copy using dwords } - blt cr7,.LMoveDWords - -{$ifndef ppc603} - { # of dwords to copy to reach 32 byte alignment (*4) } - { (depends on forward/backward copy) } - - { if forward copy, r6 = -1 -> r8 := 32 } - { if backward copy, r6 = 0 -> r8 := 0 } - rlwinm r8,r6,0,31-6+1,31-6+1 - { if forward copy, we have to copy 32 - unaligned count bytes } - { if backward copy unaligned count bytes } - sub r7,r8,r7 - { if backward copy, the calculated value is now negate -> } - { make it positive again } - not r8, r6 - add r7, r7, r8 - xor r7, r7, r8 -{$endif not ppc603} - - { multiply the update count with 4 } - slwi r10,r10,2 - slwi r6,r6,2 - { and adapt the source and dest } - add r3,r3,r6 - add r4,r4,r6 - -{$ifndef ppc603} - beq cr0,.LMove32BytesAligned -.L32BytesAlignMoveLoop: - { count >= 39 -> align to 8 byte boundary and then use the FPU } - { since we're already at 4 byte alignment, use dword store } - subic. r7,r7,4 - lwzux r0,r3,r10 - subi r5,r5,4 - stwux r0,r4,r10 - bne .L32BytesAlignMoveLoop - -.LMove32BytesAligned: - { count div 32 ( >= 1, since count was >=63 } - 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 } -{$else not ppc603} - srwi r0,r5,4 - andi. r5,r5,15 -{$endif not ppc603} - cmpwi cr1,r5,11 - mtctr r0 - - { r0 := count div 4, will be moved to ctr when copying dwords } - srwi r0,r5,2 - -{$ifndef ppc603} - { 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 add r6 we will still have an 8 bytes } - { aligned address) } - add r3,r3,r6 - add r4,r4,r6 - - slwi r6,r6,1 - - { the dcbz offset must give a 32 byte aligned address when added } - { to the current dest address and its address must point to the } - { bytes that will be overwritten in the current iteration. In case } - { of a forward loop, the dest address has currently an offset of } - { -8 compared to the bytes that will be overwritten (and r6 = -8). } - { In case of a backward of a loop, the dest address currently has } - { an offset of +32 compared to the bytes that will be overwritten } - { (and r6 = 0). So the forward dcbz offset must become +8 and the } - { backward -32 -> (-r6 * 5) - 32 gives the correct offset } - slwi r7,r6,2 - add r7,r7,r6 - neg r7,r7 - subi r7,r7,32 - -.LMove32ByteDcbz: - lfdux f0,r3,r10 - lfdux f1,r3,r10 - lfdux f2,r3,r10 - lfdux f3,r3,r10 - { must be done only now, in case source and dest are less than } - { 32 bytes apart! } - dcbz r4,r7 - stfdux f0,r4,r10 - stfdux f1,r4,r10 - stfdux f2,r4,r10 - stfdux f3,r4,r10 - bdnz .LMove32ByteDcbz -.LMove32ByteLoopDone: -{$else not ppc603} -.LMove16ByteLoop: - lwzux r11,r3,r10 - lwzux r7,r3,r10 - lwzux r8,r3,r10 - lwzux r9,r3,r10 - stwux r11,r4,r10 - stwux r7,r4,r10 - stwux r8,r4,r10 - stwux r9,r4,r10 - bdnz .LMove16ByteLoop -{$endif not ppc603} - - { 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 } - sub r3,r3,r6 - sub r4,r4,r6 -{$ifndef ppc603} - srawi r10,r10,3 - srawi r6,r6,3 -{$else not ppc603} - srawi r10,r10,2 - srawi r6,r6,2 -{$endif not ppc603} - - { cr1 contains whether count <= 11 } - ble cr1,.LMoveBytes - -.LMoveDWords: - mtctr r0 - andi. r5,r5,3 - { r10 * 4 } - slwi r10,r10,2 - slwi r6,r6,2 - add r3,r3,r6 - add r4,r4,r6 - -.LMoveDWordsLoop: - lwzux r0,r3,r10 - stwux r0,r4,r10 - bdnz .LMoveDWordsLoop - - beq cr0,.LMoveDone - { make r10 again -1 or 1 } - sub r3,r3,r6 - sub r4,r4,r6 - srawi r10,r10,2 - srawi r6,r6,2 -.LMoveBytes: - add r3,r3,r6 - add r4,r4,r6 - mtctr r5 -.LMoveBytesLoop: - lbzux r0,r3,r10 - stbux r0,r4,r10 - bdnz .LMoveBytesLoop -.LMoveDone: -end; -{$endif FPC_SYSTEM_HAS_MOVE} - - -{$ifndef FPC_SYSTEM_HAS_FILLCHAR} -{$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 FPC_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 FPC_ABI_AIX} -asm - { no bytes? } - cmpwi cr6,r4,0 - { less than 15 bytes? } - cmpwi cr7,r4,15 - { less than 64 bytes? } - cmpwi cr1,r4,64 - { 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 - ble cr6,.LFillCharDone - { get the start of the data in the cache (and mark it as "will be } - { modified") } - dcbtst 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+1,31 - { move to ctr } - mtctr r10 - { check how many rest there is (to decide whether we'll use } - { FillCharSmall or FillCharVerySmall) } - cmplwi 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 .LFillCharVerySmall -.LFillCharNoZero: -{$ifdef FPC_ABI_AIX} - stw r5,-4(r1) - stw r5,-8(r1) - lfd f0,-8(r1) -{$else FPC_ABI_AIX} - stw r5,temp - stw r5,temp+4 - lfd f0,temp -{$endif FPC_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 } - li r10, 8 -.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 - { make r3 point again to the actual next byte that must be written } - addi r3,r3,8 - b .LFillCharVerySmall -.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; -{$endif FPC_SYSTEM_HAS_FILLCHAR} - - -{$ifndef FPC_SYSTEM_HAS_FILLDWORD} -{$define FPC_SYSTEM_HAS_FILLDWORD} -procedure filldword(var x;count : longint;value : dword); -assembler; nostackframe; -asm -{ registers: - r3 x - r4 count - r5 value -} - cmpwi cr0,r4,0 - mtctr r4 - subi r3,r3,4 - ble .LFillDWordEnd //if count<=0 Then Exit -.LFillDWordLoop: - stwu r5,4(r3) - bdnz .LFillDWordLoop -.LFillDWordEnd: -end; -{$endif FPC_SYSTEM_HAS_FILLDWORD} - - -{$ifndef FPC_SYSTEM_HAS_INDEXBYTE} -{$define FPC_SYSTEM_HAS_INDEXBYTE} -function IndexByte(const buf;len:longint;b:byte):longint; assembler; nostackframe; -{ 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 - ble .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; -{$endif FPC_SYSTEM_HAS_INDEXBYTE} - - -{$ifndef FPC_SYSTEM_HAS_INDEXWORD} -{$define FPC_SYSTEM_HAS_INDEXWORD} -function IndexWord(const buf;len:longint;b:word):longint; assembler; nostackframe; -{ 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 - ble .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 - srawi r3,r3,1 -.LIndexWordDone: -end; -{$endif FPC_SYSTEM_HAS_INDEXWORD} - - -{$ifndef FPC_SYSTEM_HAS_INDEXDWORD} -{$define FPC_SYSTEM_HAS_INDEXDWORD} -function IndexDWord(const buf;len:longint;b:DWord):longint; assembler; nostackframe; -{ 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 - ble .LIndexDWordDone -.LIndexDWordLoop: - lwzu r9,4(r10) - cmplw r9,r5 - bdnzf cr0*4+eq, .LIndexDWordLoop - { r3 still contains -1 here } - bne .LIndexDWordDone - sub r3,r10,r0 - srawi r3,r3,2 -.LIndexDWordDone: -end; -{$endif FPC_SYSTEM_HAS_INDEXDWORD} - - -{$ifndef FPC_SYSTEM_HAS_COMPAREBYTE} -{$define FPC_SYSTEM_HAS_COMPAREBYTE} -function CompareByte(const buf1,buf2;len:longint):longint; assembler; nostackframe; -{ 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 - ble .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; -{$endif FPC_SYSTEM_HAS_COMPAREBYTE} - - -{$ifndef FPC_SYSTEM_HAS_COMPAREWORD} -{$define FPC_SYSTEM_HAS_COMPAREWORD} -function CompareWord(const buf1,buf2;len:longint):longint; assembler; nostackframe; -{ 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 - ble .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; -{$endif FPC_SYSTEM_HAS_COMPAREWORD} - - -{$ifndef FPC_SYSTEM_HAS_COMPAREDWORD} -{$define FPC_SYSTEM_HAS_COMPAREDWORD} -function CompareDWord(const buf1,buf2;len:longint):longint; assembler; nostackframe; -{ 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 - ble .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; -{$endif FPC_SYSTEM_HAS_COMPAREDWORD} - - -{$ifndef FPC_SYSTEM_HAS_INDEXCHAR0} -{$define FPC_SYSTEM_HAS_INDEXCHAR0} -function IndexChar0(const buf;len:longint;b:Char):longint; assembler; nostackframe; -{ 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 - subi r0,r3,1 - { assume not found } - li r3,-1 - { if yes, do nothing } - ble .LIndexChar0Done -.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; -{$endif FPC_SYSTEM_HAS_INDEXCHAR0} - - -{**************************************************************************** - String -****************************************************************************} - -{$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN} -{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN} -function fpc_shortstr_to_shortstr(len:longint; const sstr: shortstring): shortstring; [public,alias: 'FPC_SHORTSTR_TO_SHORTSTR']; compilerproc; -assembler; nostackframe; -{ 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 0,r3 - - { put min(length(sstr),len) in r4 } - subfc r7,r10,r4 { r0 := r4 - r10 } - subfe r4,r4,r4 { if r3 >= r4 then r3' := 0 else r3' := -1 } - and r7,r7,r4 { if r3 >= r4 then r3' := 0 else r3' := r3-r10 } - add r4,r10,r7 { 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; - - -procedure fpc_shortstr_assign(len:longint;sstr,dstr:pointer);[public,alias:'FPC_SHORTSTR_ASSIGN']; -assembler; nostackframe; -{ 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 0,r5 - - { put min(length(sstr),len) in r3 } - subc r0,r3,r10 { r0 := r3 - r10 } - subfe r3,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; -{$endif FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN} - -(* -{$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT} -{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT} - -function fpc_shortstr_concat(const s1, s2: shortstring): shortstring; compilerproc; [public, alias: 'FPC_SHORTSTR_CONCAT']; -{ expects that (r3) contains a pointer to the result r4 to s1, r5 to s2 } -assembler; -asm - { load length s1 } - lbz r6, 0(r4) - { load length s2 } - lbz r10, 0(r5) - { length 0 for s1? } - cmplwi cr7,r6,0 - { length 255 for s1? } - subfic. r7,r6,255 - { length 0 for s2? } - cmplwi cr1,r10,0 - { calculate min(length(s2),255-length(s1)) } - subc r8,r7,r10 { r8 := r7 - r10 } - cror 4*6+2,4*1+2,4*7+2 - subfe r7,r7,r7 { if r7 >= r10 then r7' := 0 else r7' := -1 } - mtctr r6 - and r7,r8,r7 { if r7 >= r10 then r7' := 0 else r7' := r7-r10 } - add r7,r7,r10 { if r7 >= r10 then r7' := r10 else r7' := r7 } - - mr r9,r3 - - { calculate length of final string } - add r8,r7,r6 - stb r8,0(r3) - beq cr7, .Lcopys1loopDone - .Lcopys1loop: - lbzu r0,1(r4) - stbu r0,1(r9) - bdnz .Lcopys1loop - .Lcopys1loopDone: - mtctr r7 - beq cr6, .LconcatDone - .Lcopys2loop: - lbzu r0,1(r5) - stbu r0,1(r9) - bdnz .Lcopys2loop -end; -{$endif FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT} -*) - -{$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_APPEND_SHORTSTR} -{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_APPEND_SHORTSTR} - -procedure fpc_shortstr_append_shortstr(var s1: shortstring; const s2: shortstring); compilerproc; -{ expects that results (r3) contains a pointer to the current string s1, r4 } -{ high(s1) and (r5) a pointer to the one that has to be concatenated } -assembler; nostackframe; -asm - { load length s1 } - lbz r6, 0(r3) - { load length s2 } - lbz r10, 0(r5) - { length 0? } - cmplw cr1,r6,r4 - cmplwi r10,0 - - { calculate min(length(s2),high(result)-length(result)) } - sub r9,r4,r6 - subc r8,r9,r10 { r8 := r9 - r10 } - cror 4*7+2,4*0+2,4*1+2 - subfe r9,r9,r9 { if r9 >= r10 then r9' := 0 else r9' := -1 } - and r9,r8,r9 { if r9 >= r10 then r9' := 0 else r9' := r9-r10 } - add r9,r9,r10 { if r9 >= r10 then r9' := r10 else r9' := r9 } - - { calculate new length } - add r10,r6,r9 - { load value to copy in ctr } - mtctr r9 - { store new length } - stb r10,0(r3) - { go to last current character of result } - add r3,r6,r3 - - { if nothing to do, exit } - beq cr7, .LShortStrAppendDone - { and concatenate } -.LShortStrAppendLoop: - lbzu r10,1(r5) - stbu r10,1(r3) - bdnz .LShortStrAppendLoop -.LShortStrAppendDone: -end; -{$endif FPC_SYSTEM_HAS_FPC_SHORTSTR_APPEND_SHORTSTR} - -(* -{$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)) } - subfc r7,r10,r9 { r0 := r9 - r10 } - subfe r9,r9,r9 { if r9 >= r10 then r9' := 0 else r9' := -1 } - and r7,r7,r9 { if r9 >= r10 then r9' := 0 else r9' := r9-r8 } - add r9,r10,r7 { if r9 >= r10 then r9' := r10 else r9' := r9 } - - { first compare dwords (length/4) } - srwi. r5,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 - { so we can load r3 with 0, in case the strings both have length 0 } - mr r8,r3 - li r3, 0 - { length div 4 in ctr for loop } - mtctr r5 - { 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,r8,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 - mtctr r9 -LShortStrCompare1Loop: - lbzu r3,1(r4) - lbzu r10,1(r8) - sub. r3,r3,r10 - bdnzt cr0+eq,LShortStrCompare1Loop - bne LShortStrCompareDone -LShortStrCompareLen: - { also return result in flags, maybe we can use this in the CG } - mr. r3,r3 -LShortStrCompareDone: -end; -*) - - -{$ifndef FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR} -{$define FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR} -function fpc_pchar_to_shortstr(p:pchar):shortstring;[public,alias:'FPC_PCHAR_TO_SHORTSTR']; compilerproc; -assembler; nostackframe; -{$include strpas.inc} -{$endif FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR} - - -{$ifndef FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH} -{$define FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH} -function fpc_pchar_length(p:pchar):longint;assembler;[public,alias:'FPC_PCHAR_LENGTH']; compilerproc; nostackframe; -{$include strlen.inc} -{$endif FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH} - - -{$define FPC_SYSTEM_HAS_GET_FRAME} -function get_frame:pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe; -asm - { all abi's I know use r1 as stack pointer } - mr r3, r1 -end; - -{NOTE: On MACOS, 68000 code might call powerpc code, through the MixedMode manager, -(even in the OS in system 9). The pointer to the switching stack frame is then -indicated by the first bit set to 1. This is checked below.} - -{Both routines below assumes that framebp is a valid framepointer or nil.} - -{$define FPC_SYSTEM_HAS_GET_CALLER_ADDR} -function get_caller_addr(framebp:pointer):pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe; -asm - cmplwi r3,0 - beq .Lcaller_addr_invalid - lwz r3,0(r3) - cmplwi r3,0 - beq .Lcaller_addr_invalid -{$ifdef MACOS} - rlwinm r4,r3,0,31,31 - cmpwi r4,0 - bne cr0,.Lcaller_addr_invalid -{$endif MACOS} -{$ifdef FPC_ABI_AIX} - lwz r3,8(r3) -{$else FPC_ABI_AIX} - lwz r3,4(r3) -{$endif FPC_ABI_AIX} - blr -.Lcaller_addr_invalid: - li r3,0 -end; - - -{$define FPC_SYSTEM_HAS_GET_CALLER_FRAME} -function get_caller_frame(framebp:pointer):pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe; -asm - cmplwi r3,0 - beq .Lcaller_frame_invalid - lwz r3,0(r3) -{$ifdef MACOS} - rlwinm r4,r3,0,31,31 - cmpwi r4,0 - bne cr0,.Lcaller_frame_invalid -{$endif MACOS} - blr -.Lcaller_frame_invalid: - li r3,0 -end; - -{$define FPC_SYSTEM_HAS_ABS_LONGINT} -function abs(l:longint):longint; assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe; -asm - srawi r0,r3,31 - add r3,r0,r3 - xor r3,r3,r0 -end; - - -{**************************************************************************** - Math -****************************************************************************} - -{$define FPC_SYSTEM_HAS_ODD_LONGINT} -function odd(l:longint):boolean;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe; -asm - rlwinm r3,r3,0,31,31 -end; - - -{$define FPC_SYSTEM_HAS_SQR_LONGINT} -function sqr(l:longint):longint;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe; -asm - mullw r3,r3,r3 -end; - - -{$define FPC_SYSTEM_HAS_SPTR} -Function Sptr : Pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe; -asm - mr r3,r1 -end; - - -{**************************************************************************** - Str() -****************************************************************************} - -{ int_str: generic implementation is used for now } - - -{**************************************************************************** - Multithreading -****************************************************************************} - -{ do a thread save inc/dec } - -{$define FPC_SYSTEM_HAS_DECLOCKED_LONGINT} -function declocked(var l : longint) : boolean;assembler;nostackframe; -{ input: address of l in r3 } -{ output: boolean indicating whether l is zero after decrementing } -asm -.LDecLockedLoop: - lwarx r10,0,r3 - subi r10,r10,1 - stwcx. r10,0,r3 - bne- .LDecLockedLoop - cntlzw r3,r10 - srwi r3,r3,5 -end; - -{$define FPC_SYSTEM_HAS_INCLOCKED_LONGINT} -procedure inclocked(var l : longint);assembler;nostackframe; -asm -.LIncLockedLoop: - lwarx r10,0,r3 - addi r10,r10,1 - stwcx. r10,0,r3 - bne- .LIncLockedLoop -end; - - -{$IFDEF MORPHOS} -{ this is only required for MorphOS } -{$define FPC_SYSTEM_HAS_SYSRESETFPU} -procedure SysResetFPU;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} -var tmp: array[0..1] of dword; -asm - { setting fpu to round to nearest mode } - li r3,0 - stw r3,8(r1) - stw r3,12(r1) - lfd f1,8(r1) - mtfsf 7,f1 -end; -{$ENDIF} +{ + + 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 (casey.duncan@state.co.us) + + 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 +****************************************************************************} +{ + +const + ppc_fpu_overflow = (1 shl (32-3)); + ppc_fpu_underflow = (1 shl (32-4)); + ppc_fpu_divbyzero = (1 shl (32-5)); + ppc_fpu_inexact = (1 shl (32-6)); + ppc_fpu_invalid_snan = (1 shl (32-7)); +} + +procedure fpc_enable_ppc_fpu_exceptions; +assembler; nostackframe; +asm + { clear all "exception happened" flags we care about} + mtfsfi 0,0 + mtfsfi 1,0 + mtfsfi 2,0 + mtfsfi 3,0 + mtfsb0 21 + mtfsb0 22 + mtfsb0 23 + + { enable invalid operations and division by zero exceptions. } + { No overflow/underflow, since those give some spurious } + { exceptions } + mtfsfi 6,9 +end; + + +procedure fpc_cpuinit; +begin + fpc_enable_ppc_fpu_exceptions; +end; + + +function fpc_get_ppc_fpscr: cardinal; +assembler; +var + temp: record a,b:longint; end; +asm + mffs f0 + stfd f0,temp + lwz r3,temp.b + { clear all exception flags } +{ + rlwinm r4,r3,0,16,31 + stw r4,temp.b + lfd f0,temp + a_mtfsf f0 +} +end; + +{ This function is never called directly, it's a dummy to hold the register save/ + load subroutines +} +{$ifndef MACOS} +label + _restfpr_14_x, + _restfpr_15_x, + _restfpr_16_x, + _restfpr_17_x, + _restfpr_18_x, + _restfpr_19_x, + _restfpr_20_x, + _restfpr_21_x, + _restfpr_22_x, + _restfpr_23_x, + _restfpr_24_x, + _restfpr_25_x, + _restfpr_26_x, + _restfpr_27_x, + _restfpr_28_x, + _restfpr_29_x, + _restfpr_30_x, + _restfpr_31_x, + _restfpr_14_l, + _restfpr_15_l, + _restfpr_16_l, + _restfpr_17_l, + _restfpr_18_l, + _restfpr_19_l, + _restfpr_20_l, + _restfpr_21_l, + _restfpr_22_l, + _restfpr_23_l, + _restfpr_24_l, + _restfpr_25_l, + _restfpr_26_l, + _restfpr_27_l, + _restfpr_28_l, + _restfpr_29_l, + _restfpr_30_l, + _restfpr_31_l; + +procedure saverestorereg;assembler; nostackframe; +asm +{ exit } +.globl _restfpr_14_x +_restfpr_14_x: lfd f14, -144(r11) +.globl _restfpr_15_x +_restfpr_15_x: lfd f15, -136(r11) +.globl _restfpr_16_x +_restfpr_16_x: lfd f16, -128(r11) +.globl _restfpr_17_x +_restfpr_17_x: lfd f17, -120(r11) +.globl _restfpr_18_x +_restfpr_18_x: lfd f18, -112(r11) +.globl _restfpr_19_x +_restfpr_19_x: lfd f19, -104(r11) +.globl _restfpr_20_x +_restfpr_20_x: lfd f20, -96(r11) +.globl _restfpr_21_x +_restfpr_21_x: lfd f21, -88(r11) +.globl _restfpr_22_x +_restfpr_22_x: lfd f22, -80(r11) +.globl _restfpr_23_x +_restfpr_23_x: lfd f23, -72(r11) +.globl _restfpr_24_x +_restfpr_24_x: lfd f24, -64(r11) +.globl _restfpr_25_x +_restfpr_25_x: lfd f25, -56(r11) +.globl _restfpr_26_x +_restfpr_26_x: lfd f26, -48(r11) +.globl _restfpr_27_x +_restfpr_27_x: lfd f27, -40(r11) +.globl _restfpr_28_x +_restfpr_28_x: lfd f28, -32(r11) +.globl _restfpr_29_x +_restfpr_29_x: lfd f29, -24(r11) +.globl _restfpr_30_x +_restfpr_30_x: lfd f30, -16(r11) +.globl _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 } +.globl _restfpr_14_l +_restfpr_14_l: lfd f14, -144(r11) +.globl _restfpr_15_l +_restfpr_15_l: lfd f15, -136(r11) +.globl _restfpr_16_l +_restfpr_16_l: lfd f16, -128(r11) +.globl _restfpr_17_l +_restfpr_17_l: lfd f17, -120(r11) +.globl _restfpr_18_l +_restfpr_18_l: lfd f18, -112(r11) +.globl _restfpr_19_l +_restfpr_19_l: lfd f19, -104(r11) +.globl _restfpr_20_l +_restfpr_20_l: lfd f20, -96(r11) +.globl _restfpr_21_l +_restfpr_21_l: lfd f21, -88(r11) +.globl _restfpr_22_l +_restfpr_22_l: lfd f22, -80(r11) +.globl _restfpr_23_l +_restfpr_23_l: lfd f23, -72(r11) +.globl _restfpr_24_l +_restfpr_24_l: lfd f24, -64(r11) +.globl _restfpr_25_l +_restfpr_25_l: lfd f25, -56(r11) +.globl _restfpr_26_l +_restfpr_26_l: lfd f26, -48(r11) +.globl _restfpr_27_l +_restfpr_27_l: lfd f27, -40(r11) +.globl _restfpr_28_l +_restfpr_28_l: lfd f28, -32(r11) +.globl _restfpr_29_l +_restfpr_29_l: lfd f29, -24(r11) +.globl _restfpr_30_l +_restfpr_30_l: lfd f30, -16(r11) +.globl _restfpr_31_l +_restfpr_31_l: lwz r0, 4(r11) + lfd f31, -8(r11) + mtlr r0 + ori r1, r11, 0 + blr +end; +{$endif MACOS} + +{**************************************************************************** + Move / Fill +****************************************************************************} + +{$ifndef FPC_SYSTEM_HAS_MOVE} +{$define FPC_SYSTEM_HAS_MOVE} +procedure Move(const source;out dest;count:longint);[public, alias: 'FPC_MOVE'];assembler; nostackframe; +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 < 63 ? (32 + max. alignment (31) } + cmpwi cr7,r5,63 + + { 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 } + dcbtst 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 r6 := 0, else r6 := -1 } + not r6,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 count < 15, copy everything byte by byte } + blt cr1,.LMoveBytes + + { if no 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,r6 + add r4,r4,r6 + + { 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 + +{$ifndef ppc603} + { check for 32 byte alignment } + andi. r7,r4,31 +{$endif non ppc603} + { 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 < 63, copy using dwords } + blt cr7,.LMoveDWords + +{$ifndef ppc603} + { # of dwords to copy to reach 32 byte alignment (*4) } + { (depends on forward/backward copy) } + + { if forward copy, r6 = -1 -> r8 := 32 } + { if backward copy, r6 = 0 -> r8 := 0 } + rlwinm r8,r6,0,31-6+1,31-6+1 + { if forward copy, we have to copy 32 - unaligned count bytes } + { if backward copy unaligned count bytes } + sub r7,r8,r7 + { if backward copy, the calculated value is now negate -> } + { make it positive again } + not r8, r6 + add r7, r7, r8 + xor r7, r7, r8 +{$endif not ppc603} + + { multiply the update count with 4 } + slwi r10,r10,2 + slwi r6,r6,2 + { and adapt the source and dest } + add r3,r3,r6 + add r4,r4,r6 + +{$ifndef ppc603} + beq cr0,.LMove32BytesAligned +.L32BytesAlignMoveLoop: + { count >= 39 -> align to 8 byte boundary and then use the FPU } + { since we're already at 4 byte alignment, use dword store } + subic. r7,r7,4 + lwzux r0,r3,r10 + subi r5,r5,4 + stwux r0,r4,r10 + bne .L32BytesAlignMoveLoop + +.LMove32BytesAligned: + { count div 32 ( >= 1, since count was >=63 } + 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 } +{$else not ppc603} + srwi r0,r5,4 + andi. r5,r5,15 +{$endif not ppc603} + cmpwi cr1,r5,11 + mtctr r0 + + { r0 := count div 4, will be moved to ctr when copying dwords } + srwi r0,r5,2 + +{$ifndef ppc603} + { 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 add r6 we will still have an 8 bytes } + { aligned address) } + add r3,r3,r6 + add r4,r4,r6 + + slwi r6,r6,1 + + { the dcbz offset must give a 32 byte aligned address when added } + { to the current dest address and its address must point to the } + { bytes that will be overwritten in the current iteration. In case } + { of a forward loop, the dest address has currently an offset of } + { -8 compared to the bytes that will be overwritten (and r6 = -8). } + { In case of a backward of a loop, the dest address currently has } + { an offset of +32 compared to the bytes that will be overwritten } + { (and r6 = 0). So the forward dcbz offset must become +8 and the } + { backward -32 -> (-r6 * 5) - 32 gives the correct offset } + slwi r7,r6,2 + add r7,r7,r6 + neg r7,r7 + subi r7,r7,32 + +.LMove32ByteDcbz: + lfdux f0,r3,r10 + lfdux f1,r3,r10 + lfdux f2,r3,r10 + lfdux f3,r3,r10 + { must be done only now, in case source and dest are less than } + { 32 bytes apart! } + dcbz r4,r7 + stfdux f0,r4,r10 + stfdux f1,r4,r10 + stfdux f2,r4,r10 + stfdux f3,r4,r10 + bdnz .LMove32ByteDcbz +.LMove32ByteLoopDone: +{$else not ppc603} +.LMove16ByteLoop: + lwzux r11,r3,r10 + lwzux r7,r3,r10 + lwzux r8,r3,r10 + lwzux r9,r3,r10 + stwux r11,r4,r10 + stwux r7,r4,r10 + stwux r8,r4,r10 + stwux r9,r4,r10 + bdnz .LMove16ByteLoop +{$endif not ppc603} + + { 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 } + sub r3,r3,r6 + sub r4,r4,r6 +{$ifndef ppc603} + srawi r10,r10,3 + srawi r6,r6,3 +{$else not ppc603} + srawi r10,r10,2 + srawi r6,r6,2 +{$endif not ppc603} + + { cr1 contains whether count <= 11 } + ble cr1,.LMoveBytes + +.LMoveDWords: + mtctr r0 + andi. r5,r5,3 + { r10 * 4 } + slwi r10,r10,2 + slwi r6,r6,2 + add r3,r3,r6 + add r4,r4,r6 + +.LMoveDWordsLoop: + lwzux r0,r3,r10 + stwux r0,r4,r10 + bdnz .LMoveDWordsLoop + + beq cr0,.LMoveDone + { make r10 again -1 or 1 } + sub r3,r3,r6 + sub r4,r4,r6 + srawi r10,r10,2 + srawi r6,r6,2 +.LMoveBytes: + add r3,r3,r6 + add r4,r4,r6 + mtctr r5 +.LMoveBytesLoop: + lbzux r0,r3,r10 + stbux r0,r4,r10 + bdnz .LMoveBytesLoop +.LMoveDone: +end; +{$endif FPC_SYSTEM_HAS_MOVE} + + +{$ifndef FPC_SYSTEM_HAS_FILLCHAR} +{$define FPC_SYSTEM_HAS_FILLCHAR} + +Procedure FillChar(out x;count:longint;value:byte);assembler; +{ input: x in r3, count in r4, value in r5 } + +{$ifndef FPC_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 FPC_ABI_AIX} +asm + { no bytes? } + cmpwi cr6,r4,0 + { less than 15 bytes? } + cmpwi cr7,r4,15 + { less than 64 bytes? } + cmpwi cr1,r4,64 + { 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 + ble cr6,.LFillCharDone + { get the start of the data in the cache (and mark it as "will be } + { modified") } + dcbtst 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+1,31 + { move to ctr } + mtctr r10 + { check how many rest there is (to decide whether we'll use } + { FillCharSmall or FillCharVerySmall) } + cmplwi 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 .LFillCharVerySmall +.LFillCharNoZero: +{$ifdef FPC_ABI_AIX} + stw r5,-4(r1) + stw r5,-8(r1) + lfd f0,-8(r1) +{$else FPC_ABI_AIX} + stw r5,temp + stw r5,temp+4 + lfd f0,temp +{$endif FPC_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 } + li r10, 8 +.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 + { make r3 point again to the actual next byte that must be written } + addi r3,r3,8 + b .LFillCharVerySmall +.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; +{$endif FPC_SYSTEM_HAS_FILLCHAR} + + +{$ifndef FPC_SYSTEM_HAS_FILLDWORD} +{$define FPC_SYSTEM_HAS_FILLDWORD} +procedure filldword(out x;count : longint;value : dword); +assembler; nostackframe; +asm +{ registers: + r3 x + r4 count + r5 value +} + cmpwi cr0,r4,0 + mtctr r4 + subi r3,r3,4 + ble .LFillDWordEnd //if count<=0 Then Exit +.LFillDWordLoop: + stwu r5,4(r3) + bdnz .LFillDWordLoop +.LFillDWordEnd: +end; +{$endif FPC_SYSTEM_HAS_FILLDWORD} + + +{$ifndef FPC_SYSTEM_HAS_INDEXBYTE} +{$define FPC_SYSTEM_HAS_INDEXBYTE} +function IndexByte(const buf;len:longint;b:byte):longint; assembler; nostackframe; +{ 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 + ble .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; +{$endif FPC_SYSTEM_HAS_INDEXBYTE} + + +{$ifndef FPC_SYSTEM_HAS_INDEXWORD} +{$define FPC_SYSTEM_HAS_INDEXWORD} +function IndexWord(const buf;len:longint;b:word):longint; assembler; nostackframe; +{ 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 + ble .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 + srawi r3,r3,1 +.LIndexWordDone: +end; +{$endif FPC_SYSTEM_HAS_INDEXWORD} + + +{$ifndef FPC_SYSTEM_HAS_INDEXDWORD} +{$define FPC_SYSTEM_HAS_INDEXDWORD} +function IndexDWord(const buf;len:longint;b:DWord):longint; assembler; nostackframe; +{ 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 + ble .LIndexDWordDone +.LIndexDWordLoop: + lwzu r9,4(r10) + cmplw r9,r5 + bdnzf cr0*4+eq, .LIndexDWordLoop + { r3 still contains -1 here } + bne .LIndexDWordDone + sub r3,r10,r0 + srawi r3,r3,2 +.LIndexDWordDone: +end; +{$endif FPC_SYSTEM_HAS_INDEXDWORD} + + +{$ifndef FPC_SYSTEM_HAS_COMPAREBYTE} +{$define FPC_SYSTEM_HAS_COMPAREBYTE} +function CompareByte(const buf1,buf2;len:longint):longint; assembler; nostackframe; +{ 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 + ble .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; +{$endif FPC_SYSTEM_HAS_COMPAREBYTE} + + +{$ifndef FPC_SYSTEM_HAS_COMPAREWORD} +{$define FPC_SYSTEM_HAS_COMPAREWORD} +function CompareWord(const buf1,buf2;len:longint):longint; assembler; nostackframe; +{ 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 + ble .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; +{$endif FPC_SYSTEM_HAS_COMPAREWORD} + + +{$ifndef FPC_SYSTEM_HAS_COMPAREDWORD} +{$define FPC_SYSTEM_HAS_COMPAREDWORD} +function CompareDWord(const buf1,buf2;len:longint):longint; assembler; nostackframe; +{ 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 + ble .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; +{$endif FPC_SYSTEM_HAS_COMPAREDWORD} + + +{$ifndef FPC_SYSTEM_HAS_INDEXCHAR0} +{$define FPC_SYSTEM_HAS_INDEXCHAR0} +function IndexChar0(const buf;len:longint;b:Char):longint; assembler; nostackframe; +{ 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 + subi r0,r3,1 + { assume not found } + li r3,-1 + { if yes, do nothing } + ble .LIndexChar0Done +.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; +{$endif FPC_SYSTEM_HAS_INDEXCHAR0} + + +{**************************************************************************** + String +****************************************************************************} + +{$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN} +{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN} +function fpc_shortstr_to_shortstr(len:longint; const sstr: shortstring): shortstring; [public,alias: 'FPC_SHORTSTR_TO_SHORTSTR']; compilerproc; +assembler; nostackframe; +{ 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 0,r3 + + { put min(length(sstr),len) in r4 } + subfc r7,r10,r4 { r0 := r4 - r10 } + subfe r4,r4,r4 { if r3 >= r4 then r3' := 0 else r3' := -1 } + and r7,r7,r4 { if r3 >= r4 then r3' := 0 else r3' := r3-r10 } + add r4,r10,r7 { 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; + + +procedure fpc_shortstr_assign(len:longint;sstr,dstr:pointer);[public,alias:'FPC_SHORTSTR_ASSIGN']; +assembler; nostackframe; +{ 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 0,r5 + + { put min(length(sstr),len) in r3 } + subc r0,r3,r10 { r0 := r3 - r10 } + subfe r3,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; +{$endif FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN} + +(* +{$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT} +{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT} + +function fpc_shortstr_concat(const s1, s2: shortstring): shortstring; compilerproc; [public, alias: 'FPC_SHORTSTR_CONCAT']; +{ expects that (r3) contains a pointer to the result r4 to s1, r5 to s2 } +assembler; +asm + { load length s1 } + lbz r6, 0(r4) + { load length s2 } + lbz r10, 0(r5) + { length 0 for s1? } + cmplwi cr7,r6,0 + { length 255 for s1? } + subfic. r7,r6,255 + { length 0 for s2? } + cmplwi cr1,r10,0 + { calculate min(length(s2),255-length(s1)) } + subc r8,r7,r10 { r8 := r7 - r10 } + cror 4*6+2,4*1+2,4*7+2 + subfe r7,r7,r7 { if r7 >= r10 then r7' := 0 else r7' := -1 } + mtctr r6 + and r7,r8,r7 { if r7 >= r10 then r7' := 0 else r7' := r7-r10 } + add r7,r7,r10 { if r7 >= r10 then r7' := r10 else r7' := r7 } + + mr r9,r3 + + { calculate length of final string } + add r8,r7,r6 + stb r8,0(r3) + beq cr7, .Lcopys1loopDone + .Lcopys1loop: + lbzu r0,1(r4) + stbu r0,1(r9) + bdnz .Lcopys1loop + .Lcopys1loopDone: + mtctr r7 + beq cr6, .LconcatDone + .Lcopys2loop: + lbzu r0,1(r5) + stbu r0,1(r9) + bdnz .Lcopys2loop +end; +{$endif FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT} +*) + +{$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_APPEND_SHORTSTR} +{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_APPEND_SHORTSTR} + +procedure fpc_shortstr_append_shortstr(var s1: shortstring; const s2: shortstring); compilerproc; +{ expects that results (r3) contains a pointer to the current string s1, r4 } +{ high(s1) and (r5) a pointer to the one that has to be concatenated } +assembler; nostackframe; +asm + { load length s1 } + lbz r6, 0(r3) + { load length s2 } + lbz r10, 0(r5) + { length 0? } + cmplw cr1,r6,r4 + cmplwi r10,0 + + { calculate min(length(s2),high(result)-length(result)) } + sub r9,r4,r6 + subc r8,r9,r10 { r8 := r9 - r10 } + cror 4*7+2,4*0+2,4*1+2 + subfe r9,r9,r9 { if r9 >= r10 then r9' := 0 else r9' := -1 } + and r9,r8,r9 { if r9 >= r10 then r9' := 0 else r9' := r9-r10 } + add r9,r9,r10 { if r9 >= r10 then r9' := r10 else r9' := r9 } + + { calculate new length } + add r10,r6,r9 + { load value to copy in ctr } + mtctr r9 + { store new length } + stb r10,0(r3) + { go to last current character of result } + add r3,r6,r3 + + { if nothing to do, exit } + beq cr7, .LShortStrAppendDone + { and concatenate } +.LShortStrAppendLoop: + lbzu r10,1(r5) + stbu r10,1(r3) + bdnz .LShortStrAppendLoop +.LShortStrAppendDone: +end; +{$endif FPC_SYSTEM_HAS_FPC_SHORTSTR_APPEND_SHORTSTR} + +(* +{$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)) } + subfc r7,r10,r9 { r0 := r9 - r10 } + subfe r9,r9,r9 { if r9 >= r10 then r9' := 0 else r9' := -1 } + and r7,r7,r9 { if r9 >= r10 then r9' := 0 else r9' := r9-r8 } + add r9,r10,r7 { if r9 >= r10 then r9' := r10 else r9' := r9 } + + { first compare dwords (length/4) } + srwi. r5,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 + { so we can load r3 with 0, in case the strings both have length 0 } + mr r8,r3 + li r3, 0 + { length div 4 in ctr for loop } + mtctr r5 + { 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,r8,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 + mtctr r9 +LShortStrCompare1Loop: + lbzu r3,1(r4) + lbzu r10,1(r8) + sub. r3,r3,r10 + bdnzt cr0+eq,LShortStrCompare1Loop + bne LShortStrCompareDone +LShortStrCompareLen: + { also return result in flags, maybe we can use this in the CG } + mr. r3,r3 +LShortStrCompareDone: +end; +*) + + +{$ifndef FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR} +{$define FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR} +function fpc_pchar_to_shortstr(p:pchar):shortstring;[public,alias:'FPC_PCHAR_TO_SHORTSTR']; compilerproc; +assembler; nostackframe; +{$include strpas.inc} +{$endif FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR} + + +{$ifndef FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH} +{$define FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH} +function fpc_pchar_length(p:pchar):longint;assembler;[public,alias:'FPC_PCHAR_LENGTH']; compilerproc; nostackframe; +{$include strlen.inc} +{$endif FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH} + + +{$define FPC_SYSTEM_HAS_GET_FRAME} +function get_frame:pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe; +asm + { all abi's I know use r1 as stack pointer } + mr r3, r1 +end; + +{NOTE: On MACOS, 68000 code might call powerpc code, through the MixedMode manager, +(even in the OS in system 9). The pointer to the switching stack frame is then +indicated by the first bit set to 1. This is checked below.} + +{Both routines below assumes that framebp is a valid framepointer or nil.} + +{$define FPC_SYSTEM_HAS_GET_CALLER_ADDR} +function get_caller_addr(framebp:pointer):pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe; +asm + cmplwi r3,0 + beq .Lcaller_addr_invalid + lwz r3,0(r3) + cmplwi r3,0 + beq .Lcaller_addr_invalid +{$ifdef MACOS} + rlwinm r4,r3,0,31,31 + cmpwi r4,0 + bne cr0,.Lcaller_addr_invalid +{$endif MACOS} +{$ifdef FPC_ABI_AIX} + lwz r3,8(r3) +{$else FPC_ABI_AIX} + lwz r3,4(r3) +{$endif FPC_ABI_AIX} + blr +.Lcaller_addr_invalid: + li r3,0 +end; + + +{$define FPC_SYSTEM_HAS_GET_CALLER_FRAME} +function get_caller_frame(framebp:pointer):pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe; +asm + cmplwi r3,0 + beq .Lcaller_frame_invalid + lwz r3,0(r3) +{$ifdef MACOS} + rlwinm r4,r3,0,31,31 + cmpwi r4,0 + bne cr0,.Lcaller_frame_invalid +{$endif MACOS} + blr +.Lcaller_frame_invalid: + li r3,0 +end; + +{$define FPC_SYSTEM_HAS_ABS_LONGINT} +function abs(l:longint):longint; assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe; +asm + srawi r0,r3,31 + add r3,r0,r3 + xor r3,r3,r0 +end; + + +{**************************************************************************** + Math +****************************************************************************} + +{$define FPC_SYSTEM_HAS_ODD_LONGINT} +function odd(l:longint):boolean;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe; +asm + rlwinm r3,r3,0,31,31 +end; + + +{$define FPC_SYSTEM_HAS_SQR_LONGINT} +function sqr(l:longint):longint;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe; +asm + mullw r3,r3,r3 +end; + + +{$define FPC_SYSTEM_HAS_SPTR} +Function Sptr : Pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe; +asm + mr r3,r1 +end; + + +{**************************************************************************** + Str() +****************************************************************************} + +{ int_str: generic implementation is used for now } + + +{**************************************************************************** + Multithreading +****************************************************************************} + +{ do a thread save inc/dec } + +{$define FPC_SYSTEM_HAS_DECLOCKED_LONGINT} +function declocked(var l : longint) : boolean;assembler;nostackframe; +{ input: address of l in r3 } +{ output: boolean indicating whether l is zero after decrementing } +asm +.LDecLockedLoop: + lwarx r10,0,r3 + subi r10,r10,1 + stwcx. r10,0,r3 + bne- .LDecLockedLoop + cntlzw r3,r10 + srwi r3,r3,5 +end; + +{$define FPC_SYSTEM_HAS_INCLOCKED_LONGINT} +procedure inclocked(var l : longint);assembler;nostackframe; +asm +.LIncLockedLoop: + lwarx r10,0,r3 + addi r10,r10,1 + stwcx. r10,0,r3 + bne- .LIncLockedLoop +end; + + +{$IFDEF MORPHOS} +{ this is only required for MorphOS } +{$define FPC_SYSTEM_HAS_SYSRESETFPU} +procedure SysResetFPU;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} +var tmp: array[0..1] of dword; +asm + { setting fpu to round to nearest mode } + li r3,0 + stw r3,8(r1) + stw r3,12(r1) + lfd f1,8(r1) + mtfsf 7,f1 +end; +{$ENDIF} diff --git a/rtl/sparc/sparc.inc b/rtl/sparc/sparc.inc index 873ca74625..ac666a9910 100644 --- a/rtl/sparc/sparc.inc +++ b/rtl/sparc/sparc.inc @@ -91,7 +91,7 @@ function Sptr:Pointer;assembler;nostackframe; {$ifndef FPC_SYSTEM_HAS_MOVE} {$define FPC_SYSTEM_HAS_MOVE} -procedure Move(const source;var dest;count:longint);[public, alias: 'FPC_MOVE'];assembler; +procedure Move(const source;out dest;count:longint);[public, alias: 'FPC_MOVE'];assembler; { Registers: %l0 temp. to do copying