Реализована функция длинного умножения (#130)

bmstu-iu9 · Nov 24, 2017 · 41b89b2 · 41b89b2
1 parent 52fa9ce
commit 41b89b2
Show file tree

Hide file tree

Showing 7 changed files with 136 additions and 10 deletions.
diff --git a/autotests/Library/Library-LongMath-OK.sref → .../Library-LongMath-Add-Sub-Compare-OK.sref b/autotests/Library/Library-LongMath-OK.sref → .../Library-LongMath-Add-Sub-Compare-OK.sref
diff --git a/autotests/Library/Library-LongMath-Mul-OK.sref b/autotests/Library/Library-LongMath-Mul-OK.sref
@@ -0,0 +1,27 @@
+//FROM Library
+$EXTERN Mul;
+
+Eq { (e.X) e.X = (e.X); }
+
+$ENTRY Go {
+  = <Test-Mul>;
+}
+
+// 9999*99 = 989901
+N-9999 { = 4294967295 4294967295 4294967295 4294967295; }
+N-99 { = 4294967295 4294967295; }
+N-989901 { = 4294967295 4294967294 4294967295 4294967295 0 1; }
+
+Test-Mul {
+  = <Eq (1) <Mul 1 1>>
+    <Eq ('-' 1) <Mul 1 '-' 1>>
+    <Eq ('-' 1) <Mul ('-' 1) 1>>
+    <Eq (1) <Mul ('-' 1) '-' 1>>
+    <Eq (0) <Mul 0 1 2 3>>
+    <Eq (0) <Mul (2 3 1) 0>>
+    <Eq (670592745) <Mul 12345 54321>>
+    <Eq (100000) <Mul 100 1000>>
+    <Eq (100000) <Mul 1000 100>>
+    <Eq (<N-989901>) <Mul (<N-9999>) <N-99>>>
+    <Eq (<N-989901>) <Mul (<N-99>) <N-9999>>>;
+}
diff --git a/autotests/Library/Library-Math-OK.sref b/autotests/Library/Library-Math-OK.sref
@@ -15,5 +15,5 @@ $ENTRY Go {
     <Eq <Mod 1024 30> 4>
     <Eq (<Add 3000000000 3000000000>) 1 1705032704>
     <Eq (<Sub 0 1>) '-' 1>
-    <Eq <Mul 65536 65536> 0>;
+    <Eq (<Mul 65536 65536>) 1 0>;
 }
diff --git a/autotests/Library/run.bat b/autotests/Library/run.bat
@@ -32,7 +32,8 @@ setlocal
 
   call :SIMPLE_TESTS OK ^
     Library-Math-OK ^
-    Library-LongMath-OK ^
+    Library-LongMath-Add-Sub-Compare-OK ^
+    Library-LongMath-Mul-OK ^
     Library-FOpen-FReadLine-FClose ^
     Library-IntFromStr-StrFromInt-Chr-Ord ^
     Library-SymbCompare ^

diff --git a/autotests/Library/run.sh b/autotests/Library/run.sh
@@ -28,7 +28,8 @@ run_all_tests() {
 
   simple_tests ok \
     Library-Math-OK \
-    Library-LongMath-OK \
+    Library-LongMath-Add-Sub-Compare-OK \
+    Library-LongMath-Mul-OK \
     Library-FOpen-FReadLine-FClose \
     Library-IntFromStr-StrFromInt-Chr-Ord \
     Library-SymbCompare \

diff --git a/src/srlib/Library.sref b/src/srlib/Library.sref
@@ -272,6 +272,103 @@ $ENTRY Get {
 }
 
 
+/**
+  20. <Mul t.FirstNumber e.SecondNumber> == e.NormedNumber
+*/
+$ENTRY Mul {
+  // optimization for two digits
+  s.First s.Second = <Mul-Digits s.First s.Second>;
+
+  // TODO: заменить на условия!!!
+  e.ArithmArg
+    = <NormArithmArg e.ArithmArg> : (e.First) e.Second
+    = <Mul-Normed (e.First) e.Second>;
+}
+
+Mul-Digits {
+%%
+  ARITHM_PRELUDE
+
+  /*
+    Double-word multiplication scheme:
+
+    (x,y,z,t) = (F,i)*(S,e)     -- first * second
+
+       S   e        (A,a) = F * S
+     ---------      (B,b) = i * S
+     |\ b|\ d|      (C,c) = F * e
+    i| \ | \ |t     (D,d) = i * e
+     |B \|D \|
+     ---------      t = d
+     |\ a|\ c|      (Z,z) = b + D + c
+    F| \ | \ |z     (Y,y) = B + a + C + Z
+     |A \|C \|      x = A + Y
+     ---------
+       x   y        (x,y) = (A, a) + B + C + Z
+  */
+
+  using refalrts::UInt32;
+
+  UInt32 F = first >> 16;
+  UInt32 i = first & 0xFFFFU;
+  UInt32 S = second >> 16;
+  UInt32 e = second & 0xFFFFU;
+
+  UInt32 Aa = F * S;
+  UInt32 Bb = i * S;
+  UInt32 Cc = F * e;
+  UInt32 Dd = i * e;
+
+  UInt32 Zz = (Bb & 0xFFFFU) + (Dd >> 16) + (Cc & 0xFFFFU);
+  UInt32 zt = (Zz << 16) + (Dd & 0xFFFFU);
+  UInt32 xy = Aa + (Bb >> 16) + (Cc >> 16) + (Zz >> 16);
+
+  if (xy > 0) {
+    refalrts::reinit_number(arg_begin, xy);
+    refalrts::reinit_number(pFunc, zt);
+    refalrts::splice_to_freelist(pFirst, arg_end);
+  } else {
+    refalrts::reinit_number(arg_begin, zt);
+    refalrts::splice_to_freelist(pFunc, arg_end);
+  }
+
+  return refalrts::cSuccess;
+%%
+}
+
+Mul-Normed {
+  ('+' e.First) '+' e.Second = <Mul-Nat (e.First) e.Second>;
+  ('+' e.First) '-' e.Second = '-' <Mul-Nat (e.First) e.Second>;
+  ('+' e.First) 0            = 0;
+  ('-' e.First) '+' e.Second = '-' <Mul-Nat (e.First) e.Second>;
+  ('-' e.First) '-' e.Second = <Mul-Nat (e.First) e.Second>;
+  ('-' e.First) 0            = 0;
+  (0)           e.AnySecond  = 0;
+}
+
+Mul-Nat {
+  (e.First) s.SecondLast = <Mul-Nat-Line e.First s.SecondLast>;
+
+  (e.First) e.Second s.SecondLast
+    = <Add-Nat
+        (<Mul-Nat (e.First) e.Second> 0) <Mul-Nat-Line e.First s.SecondLast>
+      >;
+}
+
+Mul-Nat-Line {
+  s.FirstLast s.Second = <Mul-Digits s.FirstLast s.Second>;
+
+  e.First s.FirstLast s.Second
+    = <Mul-Digits s.FirstLast s.Second>
+    : {
+        s.MulHigh s.MulLow
+          = <Add-Nat (<Mul-Nat-Line e.First s.Second>) s.MulHigh> s.MulLow;
+
+        s.MulLow = <Mul-Nat-Line e.First s.Second> s.MulLow;
+      };
+}
+
+
 /**
   22. <Open s.Mode s.FileNo e.FileName> == []
   s.Mode ::= 'r' | 'w' | 'a' | s.COMPOUND | (s.CHAR*)
@@ -839,12 +936,6 @@ $LABEL stdin, stdout, stderr, stout;
 
 %%
 
-$ENTRY Mul {
-%%
-  ARITHM(*, ARITHM_NO_CHECK);
-%%
-}
-
 $ENTRY Div {
 %%
   ARITHM(/, ARITHM_ZERODIV);

diff --git a/src/srlib/common/refal5-builtins.srefi b/src/srlib/common/refal5-builtins.srefi
@@ -35,6 +35,12 @@ $EXTERN Explode;
 $EXTERN Get;
 
 
+// 20. Mul
+
+//FROM Library
+$EXTERN Mul;
+
+
 // 22. Open
 
 //FROM Library
@@ -116,7 +122,7 @@ $EXTERN Write;
 /******************************* NOT REFACTORED *******************************/
 
 //FROM Library
-$EXTERN Mul, Div, Mod, Chr, Ord,
+$EXTERN Div, Mod, Chr, Ord,
   IntFromStr, StrFromInt,
   SymbCompare, Implode;