- -------------------------
- -- Implementation Note --
- -------------------------
-
- -- The design of this spec is very awkward, as a result of Ada 95 not
- -- permitting in-out parameters for function formals (most naturally
- -- Generator values would be passed this way). In pure Ada 95, the only
- -- solution is to use the heap and pointers, and, to avoid memory leaks,
- -- controlled types.
-
- -- This is awfully heavy, so what we do is to use Unrestricted_Access to
- -- get a pointer to the state in the passed Generator. This works because
- -- Generator is a limited type and will thus always be passed by reference.
-
- type Pointer is access all State;
-
- -----------------------
- -- Local Subprograms --
- -----------------------
-
- procedure Euclid (P, Q : Int; X, Y : out Int; GCD : out Int);
-
- function Euclid (P, Q : Int) return Int;
-
- function Square_Mod_N (X, N : Int) return Int;
-
- ------------
- -- Euclid --
- ------------
-
- procedure Euclid (P, Q : Int; X, Y : out Int; GCD : out Int) is
-
- XT : Int := 1;
- YT : Int := 0;
-
- procedure Recur
- (P, Q : Int; -- a (i-1), a (i)
- X, Y : Int; -- x (i), y (i)
- XP, YP : in out Int; -- x (i-1), y (i-1)
- GCD : out Int);
-
- procedure Recur
- (P, Q : Int;
- X, Y : Int;
- XP, YP : in out Int;
- GCD : out Int)
- is
- Quo : Int := P / Q; -- q <-- |_ a (i-1) / a (i) _|
- XT : Int := X; -- x (i)
- YT : Int := Y; -- y (i)
-
- begin
- if P rem Q = 0 then -- while does not divide
- GCD := Q;
- XP := X;
- YP := Y;
- else
- Recur (Q, P - Q * Quo, XP - Quo * X, YP - Quo * Y, XT, YT, Quo);
-
- -- a (i) <== a (i)
- -- a (i+1) <-- a (i-1) - q*a (i)
- -- x (i+1) <-- x (i-1) - q*x (i)
- -- y (i+1) <-- y (i-1) - q*y (i)
- -- x (i) <== x (i)
- -- y (i) <== y (i)
-
- XP := XT;
- YP := YT;
- GCD := Quo;
- end if;
- end Recur;
-
- -- Start of processing for Euclid
-
- begin
- Recur (P, Q, 0, 1, XT, YT, GCD);
- X := XT;
- Y := YT;
- end Euclid;
-
- function Euclid (P, Q : Int) return Int is
- X, Y, GCD : Int;
- pragma Unreferenced (Y, GCD);
- begin
- Euclid (P, Q, X, Y, GCD);
- return X;
- end Euclid;