really fixed FillChar and fixed FillWord. fixes 8 tests.

git-svn-id: trunk@25622 -

rtl/arm/setjump.inc

@@ -14,6 +14,92 @@
 
  **********************************************************************}
 
+var
+  // This is a BSS variable, so it will be initialized to #0
+  // This HAS to be larger than the amount if FPC_SETJMP call in the binary
+  // To avoid excessive linear searches use at least Calls*1.5 rounded up to the next power of 2
+  // If the size gets changed, the code below also needs adjustment
+  setjmp_counter: array[0..$2000-1] of TSetJmpCounter;
+
+// This function MUST return 0
+function fpc_count_setjmp: LongInt; assembler; nostackframe;
+asm
+  // lr = Original Address
+  // r0 = HashValue = (Address >> 2) and $1FFF
+  // r1 = HashBase
+  // r2 = CallerAddress in hashtable
+  // r3 = Counter
+
+  // Those two shifts are the "hashfunction"
+  // The result can be used as an index into the hashtable
+  // These required shift amount can be calculated like this
+  // lshift = 32-clz($hashmask)-2
+  // rshift = rshift - 1
+  // This only works on ARM-Code where the lower two lr bits are always 0
+  ldr r1, .LCounterBuffer
+  mov r0, lr, lsl #17
+  mov r0, r0, lsr #16
+
+.LSlotLoop:
+  // Did we wrap?
+  tst   r0, #0x10000
+  // If so, reset to #0
+  movne r0, #0
+
+  // Load Address and counter
+  ldrd  r2, r3, [r1, r0]
+
+  // If the Address is 0, create a new slot
+  cmp   r2, #0
+  beq   .LNewSlot
+
+  // A once set Address is not going to change!
+  cmp   r2, lr
+  // Address did not match? Next!
+  addne r0, r0, #8
+  bne   .LSlotLoop
+
+  // We'll not increment atomicaly here, because that has a lot of overhead
+  // and very little gain, we might miss a small amount of calls, but thats not a big issue
+  // Increment counter
+  add r3, r3, #1
+  // Adjust base to be on the counter
+  add r0, r0, #4
+  str r3, [r1, r0]
+  mov r0, #0
+  bx lr
+
+.LNewSlot:
+  stmfd sp!, {r0, r1, r2, lr}
+  add   r0, r0, r1 // Address of the address ...
+  mov   r1, lr     // New value
+  mov   r2, #0     // OldValue
+  blx   InterlockedCompareExchange
+  ldmfd sp!, {r0, r1, r2, lr}
+  b     .LSlotLoop
+
+.LCounterBuffer:
+  .long setjmp_counter
+end;
+
+procedure fpc_dump_setjmp;
+var cnt: LongInt;
+begin
+  for cnt:=Low(setjmp_counter) to High(setjmp_counter) do
+    begin
+      if setjmp_counter[cnt].counter > 0 then
+        begin
+          writeln('Address: [$',hexstr(setjmp_counter[cnt].Address - 4,8), '] Count:',setjmp_counter[cnt].Counter);
+        end;
+    end;
+end;
+
+function fpc_setjmp_table_entry(idx: LongWord): PSetJmpCounter;
+begin
+  fpc_setjmp_table_entry:=nil;
+  if (idx < $2000) then fpc_setjmp_table_entry:=@setjmp_counter[idx];
+end;
+
 function fpc_setjmp(var S : jmp_buf) : longint;assembler;[Public, alias : 'FPC_SETJMP'];nostackframe; compilerproc;
   asm
     {$if defined(FPUVFPV2) or defined(FPUVFPV3) or defined(FPUVFPV3_D16)}
@@ -52,12 +138,7 @@ function fpc_setjmp(var S : jmp_buf) : longint;assembler;[Public, alias : 'FPC_S
     bx          lr
     {$else}
     stmia   r0,{v1-v6, sl, fp, sp, lr}
-    mov     r0,#0
-    {$ifdef CPUARM_HAS_BX}
-    bx      lr
-    {$else}
-    mov pc,lr
-    {$endif}
+    b       fpc_count_setjmp
     {$endif}
   end;
 

rtl/arm/setjumph.inc

@@ -26,4 +26,12 @@ type
 function setjmp(var S : jmp_buf) : longint;[external name 'FPC_SETJMP'];
 procedure longjmp(var S : jmp_buf;value : longint);[external name 'FPC_LONGJMP'];
 
-
+type
+  TSetJmpCounter = record
+    Address: LongWord;
+    Counter: LongWord;
+  end;
+  PSetJmpCounter = ^TSetJmpCounter;
+
+procedure fpc_dump_setjmp;
+function fpc_setjmp_table_entry(idx: LongWord): PSetJmpCounter;

rtl/inc/system.inc

@@ -949,6 +949,11 @@ Begin
 {$ifdef SYSTEMDEBUG}
   writeln('InternalExit');
 {$endif SYSTEMDEBUG}
+
+{$IFDEF CPUARM}
+  fpc_dump_setjmp;
+{$ENDIF}
+
   while exitProc<>nil Do
    Begin
      InOutRes:=0;