Merged revisions 6881 via svnmerge from

svn+ssh://[email protected]/FPC/svn/fpc/trunk

........
r6881 | jonas | 2007-03-16 17:01:26 +0100 (Fri, 16 Mar 2007) | 2 lines

  + brotl, brotr and bnot functions for macpas mode + tests

........

git-svn-id: branches/fixes_2_2@6882 -

.gitattributes

@@ -6655,6 +6655,7 @@ tests/test/tarray5.pp svneol=native#text/plain
 tests/test/tarray6.pp svneol=native#text/plain
 tests/test/tasmread.pp svneol=native#text/plain
 tests/test/tasout.pp svneol=native#text/plain
+tests/test/tbopr.pp svneol=native#text/plain
 tests/test/tbrtlevt.pp svneol=native#text/plain
 tests/test/tcase1.pp svneol=native#text/plain
 tests/test/tcase2.pp svneol=native#text/plain

rtl/inc/macpas.pp

@@ -83,9 +83,27 @@ procedure BClr(var i: cardinal; j: cardinal); {$ifdef systeminline}inline;{$endi
 procedure BClr(var i: int64; j: cardinal); {$ifdef systeminline}inline;{$endif}
 procedure BClr(var i: qword; j: cardinal); {$ifdef systeminline}inline;{$endif}
 
+function BRotL(i: longint; j: cardinal): longint; {$ifdef systeminline}inline;{$endif}
+function BRotL(i,j: cardinal): cardinal; {$ifdef systeminline}inline;{$endif}
+function BRotL(i: int64; j: cardinal): int64; {$ifdef systeminline}inline;{$endif}
+function BRotL(i: qword; j: cardinal): qword; {$ifdef systeminline}inline;{$endif}
+
+function BRotR(i: longint; j: cardinal): longint; {$ifdef systeminline}inline;{$endif}
+function BRotR(i,j: cardinal): cardinal; {$ifdef systeminline}inline;{$endif}
+function BRotR(i: int64; j: cardinal): int64; {$ifdef systeminline}inline;{$endif}
+function BRotR(i: qword; j: cardinal): qword; {$ifdef systeminline}inline;{$endif}
+
+function BNot(i: longint): longint; {$ifdef systeminline}inline;{$endif}
+function BNot(i: cardinal): cardinal; {$ifdef systeminline}inline;{$endif}
+function BNot(i: int64): int64; {$ifdef systeminline}inline;{$endif}
+function BNot(i: qword): qword; {$ifdef systeminline}inline;{$endif}
+
 
 implementation
 
+{$r-}
+{$q-}
+
 
 function FCC(const literal: string): LongWord; {$ifdef systeminline}inline;{$endif}
 begin
@@ -303,6 +321,67 @@ begin
   i := i and not (qword(1) shl j);
 end;
 
+function BRotL(i: longint; j: cardinal): longint; {$ifdef systeminline}inline;{$endif}
+begin
+  result := (i shl j) or (i shr (32-j));
+end;
+
+function BRotL(i,j: cardinal): cardinal; {$ifdef systeminline}inline;{$endif}
+begin
+  result := (i shl j) or (i shr (32-j));
+end;
+
+function BRotL(i: int64; j: cardinal): int64; {$ifdef systeminline}inline;{$endif}
+begin
+  result := (i shl j) or (i shr (64-j));
+end;
+
+function BRotL(i: qword; j: cardinal): qword; {$ifdef systeminline}inline;{$endif}
+begin
+  result := (i shl j) or (i shr (64-j));
+end;
+
+function BRotR(i: longint; j: cardinal): longint; {$ifdef systeminline}inline;{$endif}
+begin
+  result := (i shr j) or (i shl (32-j));
+end;
+
+function BRotR(i,j: cardinal): cardinal; {$ifdef systeminline}inline;{$endif}
+begin
+  result := (i shr j) or (i shl (32-j));
+end;
+
+function BRotR(i: int64; j: cardinal): int64; {$ifdef systeminline}inline;{$endif}
+begin
+  result := (i shr j) or (i shl (64-j));
+end;
+
+function BRotR(i: qword; j: cardinal): qword; {$ifdef systeminline}inline;{$endif}
+begin
+  result := (i shr j) or (i shl (64-j));
+end;
+
+function BNot(i: longint): longint; {$ifdef systeminline}inline;{$endif}
+begin
+  result := not(i);
+end;
+
+function BNot(i: cardinal): cardinal; {$ifdef systeminline}inline;{$endif}
+begin
+  result := not(i);
+end;
+
+function BNot(i: int64): int64; {$ifdef systeminline}inline;{$endif}
+begin
+  result := not(i);
+end;
+
+function BNot(i: qword): qword; {$ifdef systeminline}inline;{$endif}
+begin
+  result := not(i);
+end;
+
+
 {$ifdef cpupowerpc}
 begin
   asm

tests/test/tbopr.pp

@@ -0,0 +1,195 @@
+{$mode macpas}
+
+{$r-}
+{$q-}
+
+procedure testlongintrot;
+const
+  haltoffset = 0;
+var
+  l : longint;
+begin
+  l := 1;
+  l := brotl(l,1);
+  if (l <> 2) then
+    halt(1+haltoffset);
+  l := brotr(l,1);
+  if (l <> 1) then
+    halt(2+haltoffset);
+
+  l := longint($80000001);
+  l := brotl(l,2);
+  if (l <> 6) then
+    halt(3+haltoffset);
+  l := brotr(l,3);
+  if (l <> longint($c0000000)) then
+    halt(4+haltoffset);
+
+  l := brotr(l,2);
+  // "longint($c0000000) shr 2" is evaluated using 64 bit :/
+  if (l <> (longint(cardinal($c0000000) shr 2))) then
+    halt(5+haltoffset);
+end;
+
+
+procedure testcardinalrot;
+const
+  haltoffset = 5;
+var
+  l : cardinal;
+begin
+  l := 1;
+  l := brotl(l,1);
+  if (l <> 2) then
+    halt(1+haltoffset);
+  l := brotr(l,1);
+  if (l <> 1) then
+    halt(2+haltoffset);
+
+  l := $80000001;
+  l := brotl(l,2);
+  if (l <> 6) then
+    halt(3+haltoffset);
+  l := brotr(l,3);
+  if (l <> $c0000000) then
+    halt(4+haltoffset);
+
+  l := brotr(l,2);
+  if (l <> (cardinal($c0000000) shr 2)) then
+    halt(5+haltoffset);
+end;
+
+
+procedure testint64rot;
+const
+  haltoffset = 10;
+var
+  l : int64;
+begin
+  l := 1;
+  l := brotl(l,1);
+  if (l <> 2) then
+    halt(1+haltoffset);
+  l := brotr(l,1);
+  if (l <> 1) then
+    halt(2+haltoffset);
+
+  l := $80000001;
+  l := brotl(l,2);
+  if (l <> $200000004) then
+    halt(3+haltoffset);
+  l := brotr(l,3);
+  if (l <> int64($8000000040000000)) then
+    halt(4+haltoffset);
+
+  l := brotr(l,2);
+  if (l <> (int64($8000000040000000) shr 2)) then
+    halt(5+haltoffset);
+end;
+
+
+procedure testqwordrot;
+const
+  haltoffset = 15;
+var
+  l : qword;
+begin
+  l := 1;
+  l := brotl(l,1);
+  if (l <> 2) then
+    halt(1+haltoffset);
+  l := brotr(l,1);
+  if (l <> 1) then
+    halt(2+haltoffset);
+
+  l := $80000001;
+  l := brotl(l,2);
+  if (l <> $200000004) then
+    halt(3+haltoffset);
+  l := brotr(l,3);
+  if (l <> qword($8000000040000000)) then
+    halt(4+haltoffset);
+
+  l := brotr(l,2);
+  if (l <> (qword($8000000040000000) shr 2)) then
+    halt(5+haltoffset);
+end;
+
+
+procedure testlongintnot;
+const
+  haltoffset = 20;
+var
+  l, j : longint;
+begin
+  l := low(longint);
+  for j := 1 to (maxlongint div 13579) do
+    begin
+      if not(l) <> bnot(l) then
+        halt(haltoffset+1);
+      inc(l,13579*2);
+    end;
+end;
+
+
+procedure testcardinalnot;
+const
+  haltoffset = 21;
+var
+  l, j : cardinal;
+begin
+  l := 0;
+  for j := 1 to (maxlongint div 13579) do
+    begin
+      if not(l) <> bnot(l) then
+        halt(haltoffset+1);
+      inc(l,13579*2);
+    end;
+end;
+
+
+procedure testint64not;
+const
+  haltoffset = 22;
+var
+  l, j : int64;
+begin
+  l := low(int64);
+  j := 1;
+  repeat
+    if not(l) <> bnot(l) then
+      halt(haltoffset+1);
+    inc(l,int64(13579)*high(longint)*2);
+    inc(j);
+  until (j = (high(int64) div (int64(13579) * high(longint))));
+end;
+
+
+procedure testqwordnot;
+const
+  haltoffset = 22;
+var
+  l, j : qword;
+begin
+  l := 0;
+  j := 1;
+  repeat
+    if not(l) <> bnot(l) then
+      halt(haltoffset+1);
+    inc(l,int64(13579)*high(longint)*2);
+    inc(j);
+  until (j = (high(int64) div (int64(13579) * high(longint))));
+end;
+
+
+begin
+  testlongintrot;
+  testcardinalrot;
+  testint64rot;
+  testqwordrot;
+
+  testlongintnot;
+  testcardinalnot;
+  testint64not;
+  testqwordnot;
+end.