mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-06-17 15:38:19 +02:00
651f34e27c
* ppc64: moved function prolog/epilog helper code into startup code * ppc64: added FPU configuration code in math unit (fixes tw3161) git-svn-id: trunk@1786 -
692 lines
20 KiB
PHP
692 lines
20 KiB
PHP
{
|
|
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
|
|
PowerPC64
|
|
|
|
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
|
|
****************************************************************************}
|
|
|
|
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
|
|
{$ifdef fpc_mtfsb0_corrected}
|
|
mtfsb0 21
|
|
mtfsb0 22
|
|
mtfsb0 23
|
|
{$endif fpc_mtfsb0_corrected}
|
|
|
|
{ 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;
|
|
|
|
{****************************************************************************
|
|
Move / Fill
|
|
****************************************************************************}
|
|
|
|
{$ifndef FPC_SYSTEM_HAS_MOVE}
|
|
{$define FPC_SYSTEM_HAS_MOVE}
|
|
procedure Move(const source;var dest;count:SizeInt);[public, alias: 'FPC_MOVE'];
|
|
type
|
|
bytearray = array [0..high(sizeint)-1] of byte;
|
|
var
|
|
i:longint;
|
|
begin
|
|
if count <= 0 then exit;
|
|
Dec(count);
|
|
if @source<@dest then
|
|
begin
|
|
for i:=count downto 0 do
|
|
bytearray(dest)[i]:=bytearray(source)[i];
|
|
end
|
|
else
|
|
begin
|
|
for i:=0 to count do
|
|
bytearray(dest)[i]:=bytearray(source)[i];
|
|
end;
|
|
end;
|
|
{$endif FPC_SYSTEM_HAS_MOVE}
|
|
|
|
|
|
{$ifndef FPC_SYSTEM_HAS_FILLCHAR}
|
|
{$define FPC_SYSTEM_HAS_FILLCHAR}
|
|
|
|
Procedure FillChar(var x;count:SizeInt;value:byte);
|
|
type
|
|
longintarray = array [0..high(sizeint) div 4-1] of longint;
|
|
bytearray = array [0..high(sizeint)-1] of byte;
|
|
var
|
|
i,v : longint;
|
|
begin
|
|
if count <= 0 then exit;
|
|
v := 0;
|
|
{ aligned? }
|
|
if (PtrUInt(@x) mod sizeof(PtrUInt))<>0 then
|
|
for i:=0 to count-1 do
|
|
bytearray(x)[i]:=value
|
|
else begin
|
|
v:=(value shl 8) or (value and $FF);
|
|
v:=(v shl 16) or (v and $ffff);
|
|
for i:=0 to (count div 4)-1 do
|
|
longintarray(x)[i]:=v;
|
|
for i:=(count div 4)*4 to count-1 do
|
|
bytearray(x)[i]:=value;
|
|
end;
|
|
end;
|
|
{$endif FPC_SYSTEM_HAS_FILLCHAR}
|
|
|
|
{$ifndef FPC_SYSTEM_HAS_FILLDWORD}
|
|
{$define FPC_SYSTEM_HAS_FILLDWORD}
|
|
procedure filldword(var x;count : SizeInt;value : dword); assembler; nostackframe;
|
|
asm
|
|
cmpdi 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:SizeInt;b:byte):int64; 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
|
|
cmpldi r4,0
|
|
mtctr r4
|
|
subi r10,r3,1
|
|
mr r0,r3
|
|
{ assume not found }
|
|
li r3,-1
|
|
ble .LIndexByteDone
|
|
.LIndexByteLoop:
|
|
lbzu r9,1(r10)
|
|
cmpld 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:SizeInt;b:word):int64; 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
|
|
cmpldi r4,0
|
|
mtctr r4
|
|
subi r10,r3,2
|
|
mr r0,r3
|
|
{ assume not found }
|
|
li r3,-1
|
|
ble .LIndexWordDone
|
|
.LIndexWordLoop:
|
|
lhzu r9,2(r10)
|
|
cmpld r9,r5
|
|
bdnzf cr0*4+eq,.LIndexWordLoop
|
|
{ r3 still contains -1 here }
|
|
bne .LIndexWordDone
|
|
sub r3,r10,r0
|
|
sradi 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:SizeInt;b:DWord):int64; 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
|
|
cmpldi r4,0
|
|
mtctr r4
|
|
subi r10,r3,4
|
|
mr r0,r3
|
|
{ assume not found }
|
|
li r3,-1
|
|
ble .LIndexDWordDone
|
|
.LIndexDWordLoop:
|
|
lwzu r9,4(r10)
|
|
cmpld r9,r5
|
|
bdnzf cr0*4+eq, .LIndexDWordLoop
|
|
{ r3 still contains -1 here }
|
|
bne .LIndexDWordDone
|
|
sub r3,r10,r0
|
|
sradi 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:SizeInt):int64; 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 }
|
|
cmpldi 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:SizeInt):int64; 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 }
|
|
cmpldi 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:SizeInt):int64; 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 }
|
|
cmpldi 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:SizeInt;b:Char):int64; 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? }
|
|
cmpldi 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)
|
|
cmpldi cr1,r10,0
|
|
cmpld 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 }
|
|
|
|
cmpldi 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 }
|
|
|
|
cmpldi 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? }
|
|
cmpldi cr7,r6,0
|
|
{ length 255 for s1? }
|
|
subfic. r7,r6,255
|
|
{ length 0 for s2? }
|
|
cmpldi 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
|
|
.LconcatDone:
|
|
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? }
|
|
cmpld cr1,r6,r4
|
|
cmpldi 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): SizeInt; [public,alias:'FPC_SHORTSTR_COMPARE']; compilerproc;
|
|
assembler;
|
|
{ TODO: improve, because the main compare loop does an unaligned access everytime.. :(
|
|
TODO: needs some additional opcodes not yet known to the compiler :( }
|
|
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 qwords (length/4) }
|
|
srdi. r5,r9,3
|
|
{ keep length mod 8 for the ends; note that the value in r9 <= 255
|
|
so we can use rlwinm safely }
|
|
rlwinm r9,r9,0,29,31
|
|
{ already check whether length mod 8 = 0 }
|
|
cmpldi 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 8 in ctr for loop }
|
|
mtctr r5
|
|
{ if length < 7, goto byte comparing }
|
|
beq .LShortStrCompare1
|
|
{ setup for use of update forms of load/store with qwords }
|
|
subi r4,r4,7
|
|
subi r8,r8,7
|
|
.LShortStrCompare4Loop:
|
|
ldu r3,8(r4)
|
|
ldu r10,8(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,7
|
|
addi r8,r8,7
|
|
.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']; {$ifdef hascompilerproc} compilerproc; {$endif} 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;
|
|
|
|
{$define FPC_SYSTEM_HAS_GET_CALLER_ADDR}
|
|
function get_caller_addr(framebp:pointer):pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe;
|
|
asm
|
|
cmpldi r3,0
|
|
beq .Lcaller_addr_frame_null
|
|
ld r3, 0(r3)
|
|
|
|
cmpldi r3,0
|
|
beq .Lcaller_addr_frame_null
|
|
ld r3, 16(r3)
|
|
.Lcaller_addr_frame_null:
|
|
end;
|
|
|
|
|
|
{$define FPC_SYSTEM_HAS_GET_CALLER_FRAME}
|
|
function get_caller_frame(framebp:pointer):pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe;
|
|
asm
|
|
cmpldi r3,0
|
|
beq .Lcaller_frame_null
|
|
ld r3, 0(r3)
|
|
.Lcaller_frame_null:
|
|
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
|
|
rldicl r3, r3, 0, 63
|
|
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_ODD_INT64}
|
|
function odd(l:int64):boolean;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe;
|
|
asm
|
|
rldicl r3, r3, 0, 63
|
|
end;
|
|
|
|
|
|
{$define FPC_SYSTEM_HAS_SQR_INT64}
|
|
function sqr(l:int64):int64;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe;
|
|
asm
|
|
mulld 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
|
|
cntlzd r3,r10
|
|
srdi r3,r3,6
|
|
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;
|
|
|
|
|
|
{$define FPC_SYSTEM_HAS_DECLOCKED_INT64}
|
|
function declocked(var l : int64) : boolean;assembler;nostackframe;
|
|
{ input: address of l in r3 }
|
|
{ output: boolean indicating whether l is zero after decrementing }
|
|
asm
|
|
.LDecLockedLoop:
|
|
ldarx r10,0,r3
|
|
subi r10,r10,1
|
|
stdcx. r10,0,r3
|
|
bne- .LDecLockedLoop
|
|
cntlzd r3,r10
|
|
srdi r3,r3,6
|
|
end;
|
|
|
|
{$define FPC_SYSTEM_HAS_INCLOCKED_INT64}
|
|
procedure inclocked(var l : int64);assembler;nostackframe;
|
|
asm
|
|
.LIncLockedLoop:
|
|
|
|
ldarx r10,0,r3
|
|
addi r10,r10,1
|
|
stdcx. r10,0,r3
|
|
bne- .LIncLockedLoop
|
|
end;
|
|
|