From c7f77296a988666dd4e74e3a0fd51bfaa2406078 Mon Sep 17 00:00:00 2001
From: Jonas Maebe <jonas@freepascal.org>
Date: Fri, 16 Mar 2007 16:01:26 +0000
Subject: [PATCH]   + brotl, brotr and bnot functions for macpas mode + tests

git-svn-id: trunk@6881 -
---
 .gitattributes      |   1 +
 rtl/inc/macpas.pp   |  79 ++++++++++++++++++
 tests/test/tbopr.pp | 195 ++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 275 insertions(+)
 create mode 100644 tests/test/tbopr.pp

diff --git a/.gitattributes b/.gitattributes
index 4c336fa584..b38da1f365 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -6656,6 +6656,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
diff --git a/rtl/inc/macpas.pp b/rtl/inc/macpas.pp
index d9499a05f0..8017a7b7cf 100644
--- a/rtl/inc/macpas.pp
+++ b/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
diff --git a/tests/test/tbopr.pp b/tests/test/tbopr.pp
new file mode 100644
index 0000000000..9bc4378082
--- /dev/null
+++ b/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.
\ No newline at end of file