freepascal.compiler/rtl/arm/arm.inc

{

    This file is part of the Free Pascal run time library.
    Copyright (c) 2003 by the Free Pascal development team.

    Processor dependent implementation for the system unit for
    ARM

    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.

 **********************************************************************}

{$asmmode gas}

procedure fpc_cpuinit;
begin
{$if not(defined(wince)) and not(defined(gba)) and not(defined(nds))}
  asm
    rfs r0
    and r0,r0,#0xffe0ffff
    orr r0,r0,#0x00020000
    wfs r0
  end;
{$endif}
end;

{****************************************************************************
                       stack frame related stuff
****************************************************************************}

{$IFNDEF INTERNAL_BACKTRACE}
{$define FPC_SYSTEM_HAS_GET_FRAME}
function get_frame:pointer;assembler;nostackframe;{$ifdef SYSTEMINLINE}inline;{$endif}
asm
  mov    r0,r11
end ['R0'];
{$ENDIF not INTERNAL_BACKTRACE}

{$define FPC_SYSTEM_HAS_GET_CALLER_ADDR}
function get_caller_addr(framebp:pointer):pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif}
asm
  movs r0,r0
  beq .Lg_a_null
  ldr r0,[r0,#-4]
.Lg_a_null:
end ['R0'];


{$define FPC_SYSTEM_HAS_GET_CALLER_FRAME}
function get_caller_frame(framebp:pointer):pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif}
asm
  movs r0,r0
  beq .Lgnf_null
  ldr r0,[r0,#-12]
.Lgnf_null:
end ['R0'];


{$define FPC_SYSTEM_HAS_SPTR}
Function Sptr : pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif}
asm
  mov    r0,sp
end ['R0'];


{$define FPC_SYSTEM_HAS_FILLCHAR}
Procedure FillChar(var x;count:longint;value:byte);assembler;nostackframe;
asm
        // less than 0?
        cmp r1,#0
        movlt pc,lr
        mov     r3,r0
        cmp     r1,#8           // at least 8 bytes to do?
        blt     .LFillchar2
        orr r2,r2,r2,lsl #8
        orr r2,r2,r2,lsl #16
.LFillchar0:
        tst     r3,#3           // aligned yet?
        strneb r2,[r3],#1
        subne   r1,r1,#1
        bne     .LFillchar0
        mov     ip,r2
.LFillchar1:
        cmp     r1,#8           // 8 bytes still to do?
        blt     .LFillchar2
        stmia   r3!,{r2,ip}
        sub     r1,r1,#8
        cmp     r1,#8           // 8 bytes still to do?
        blt     .LFillchar2
        stmia   r3!,{r2,ip}
        sub     r1,r1,#8
        cmp     r1,#8           // 8 bytes still to do?
        blt     .LFillchar2
        stmia   r3!,{r2,ip}
        sub     r1,r1,#8
        cmp     r1,#8           // 8 bytes still to do?
        stmgeia r3!,{r2,ip}
        subge   r1,r1,#8
        bge     .LFillchar1
.LFillchar2:
        movs r1,r1              // anything left?
        moveq pc,lr
        rsb     r1,r1,#7
        add     pc,pc,r1,lsl #2
        mov     r0,r0
        strb r2,[r3],#1
        strb r2,[r3],#1
        strb r2,[r3],#1
        strb r2,[r3],#1
        strb r2,[r3],#1
        strb r2,[r3],#1
        strb r2,[r3],#1
        mov pc,lr
end;


(*
{$define FPC_SYSTEM_HAS_MOVE}
procedure Move(const source;var dest;count:longint);[public, alias: 'FPC_MOVE'];assembler;nostackframe;
asm
	// count <=0 ?
	cmp r2,#0
	movle pc,lr
	// overlap?
	cmp r2,r1
	bls .Lnoverlap
	add r3,r0,r2
	cmp r3,r2
	bls .Lnooverlap
	// overlap, copy backward
.Loverlapped
  subs r2,r2,#1
  ldrb r3,[r0,r2]
  strb r3,[r1,r2]
  bne .Loverlapped
  mov pc,lr
.Lnooverlap:
  // less then 16 bytes to copy?
  cmp r2,#16
  // yes, the forget about the whole optimizations
  // and do a bytewise copy
  blt .Lbyteloop

  // both uneven aligned?
  eor r3,r0,r1
  tst r3,#1

  bne .Ldifferentaligned
  // yes, then align
  // alignment to 4 byte boundries is enough
  ldrb ip,[r0],#1
  sub r2,r2,#1
  stb ip,[r1],#1
  tst r3,#2
  bne .Ldifferentaligned
  ldrh ip,[r0],#2
  sub r2,r2,#2
  sth ip,[r1],#2

.Ldifferentaligned
  // qword aligned?
  orrs r3,r0,r1
  tst r3,#7
  bne .Ldwordloop
.Lqwordloop:
  sub r2,r2,#8
  ldmia r0!,{r3,ip}
  stmia r1!,{r3,ip}



.Lbyteloop:
  ldrb r3,[r0],#1
  strb r3,[r1],#1
  subs r2,r2,#1
  bne .Lbyteloop
  mov pc,lr
end;
*)

var
  fpc_system_lock: longint; export name 'fpc_system_lock';

function InterLockedDecrement (var Target: longint) : longint; assembler; nostackframe;
asm
// lock
  ldr r3, .Lfpc_system_lock
  mov r1, #1
.Lloop:
  swp r2, r1, [r3]
  cmp r2, #0
  bne .Lloop
// do the job
  ldr r1, [r0]
  sub r1, r1, #1
  str r1, [r0]
  mov r0, r1
// unlock and return
  str r2, [r3]
  mov pc, lr

.Lfpc_system_lock:
  .long fpc_system_lock
end;


function InterLockedIncrement (var Target: longint) : longint; assembler; nostackframe;
asm
// lock
  ldr r3, .Lfpc_system_lock
  mov r1, #1
.Lloop:
  swp r2, r1, [r3]
  cmp r2, #0
  bne .Lloop
// do the job
  ldr r1, [r0]
  add r1, r1, #1
  str r1, [r0]
  mov r0, r1
// unlock and return
  str r2, [r3]
  mov pc, lr

.Lfpc_system_lock:
  .long fpc_system_lock
end;


function InterLockedExchange (var Target: longint;Source : longint) : longint; assembler; nostackframe;
asm
  swp r1, r1, [r0]
  mov r0,r1
end;

function InterLockedExchangeAdd (var Target: longint;Source : longint) : longint; assembler; nostackframe;
asm
// lock
  ldr r3, .Lfpc_system_lock
  mov r2, #1
.Lloop:
  swp r2, r2, [r3]
  cmp r2, #0
  bne .Lloop
// do the job
  ldr r2, [r0]
  add r1, r1, r2
  str r1, [r0]
  mov r0, r2
// unlock and return
  mov r2, #0
  str r2, [r3]
  mov pc, lr

.Lfpc_system_lock:
  .long fpc_system_lock
end;


function InterlockedCompareExchange(var Target: longint; NewValue: longint; Comperand: longint): longint; assembler; nostackframe;
asm
// lock
  ldr r12, .Lfpc_system_lock
  mov r3, #1
.Lloop:
  swp r3, r3, [r12]
  cmp r3, #0
  bne .Lloop
// do the job
  ldr r3, [r0]
  cmp r3, r2
  streq r1, [r0]
  mov r0, r3
// unlock and return
  mov r3, #0
  str r3, [r12]
  mov pc, lr

.Lfpc_system_lock:
  .long fpc_system_lock
end;

{$define FPC_SYSTEM_HAS_DECLOCKED_LONGINT}
function declocked(var l: longint) : boolean; inline;
begin
  Result:=InterLockedDecrement(l) = 0;
end;

{$define FPC_SYSTEM_HAS_INCLOCKED_LONGINT}
procedure inclocked(var l: longint); inline;
begin
  InterLockedIncrement(l);
end;