Source code in the modula-2 programming language

DEFINITION MODULE B10AsBin;

(* Returns a number representing the B10 of the passed-in number N.
   The result has the same binary digits as B10 has decimal digits,
   e.g. N = 7 returns 9 = 1001 binary, representing 1001 decimal.
   Returns 0 if the procedure fails.
   In TopSpeed Modula-2, CARDINAL is unsigned 16-bit, LONGCARD is unsigned 32-bit.
*)
PROCEDURE CalcB10AsBinary( N : CARDINAL) : LONGCARD;

END B10AsBin.


IMPLEMENTATION MODULE B10AsBin;

FROM Storage IMPORT ALLOCATE, DEALLOCATE;

PROCEDURE CalcB10AsBinary( N : CARDINAL) : LONGCARD;
CONST
  MaxPower2 = 80000000H; (* 2^31 *)
VAR
  pSums : POINTER TO ARRAY CARDINAL OF CARDINAL;
  pWhen : POINTER TO ARRAY CARDINAL OF LONGCARD;
  b10bin, pwr2 : LONGCARD;
  j, j_stop, nrSums, res10, s : CARDINAL;
BEGIN
  IF (N <= 1) THEN RETURN LONGCARD(N) END; (* dispose of trivial cases *)
  (* TopSpeed Modula-2 doesn't seem to have dynamic arrays,
     so we use a workaround *)
  ALLOCATE( pSums, N*SIZE(CARDINAL));
  ALLOCATE( pWhen, N*SIZE(LONGCARD));
  FOR j := 0 TO N - 1 DO pWhen^[j] := 0; END;

  b10bin := 0; (* result := 0; gets overwritten if procedure succeeds *)
  res10 := 1;  pwr2 := 1;
  pSums^[0] := 0;  pSums^[1] := 1;  nrSums := 2;
  pWhen^[1] := 1; (* record first occurrence of sum = 1 mod N *)
  REPEAT
    res10 := 10*res10 MOD N;  pwr2 := 2*pwr2;
    j := 0;  j_stop := nrSums;
    REPEAT
      (* Possible new sums created by addition of res10 *)
      s := pSums^[j] + res10;
      IF (s >= N) THEN DEC(s, N); END;  (* take sums mod N *)
      IF (pWhen^[s] = 0) THEN (* if we haven't had this sum already *)
        pWhen^[s] := pWhen^[pSums^[j]] + pwr2; (* record first occurrence *)
        IF (s = 0) THEN b10bin := pWhen^[0]; (* if s = 0 then done *)
        ELSE
          pSums^[nrSums] := s;  INC( nrSums); (* else store the sum s *)
        END;
      END;
      INC(j);
    UNTIL (j = j_stop) OR (b10bin > 0);
  UNTIL (pwr2 = MaxPower2) OR (b10bin > 0);
  DEALLOCATE( pSums, N*SIZE(CARDINAL));
  DEALLOCATE( pWhen, N*SIZE(LONGCARD));
  RETURN b10bin;
END CalcB10AsBinary;
END B10AsBin.


MODULE B10Demo;

FROM B10AsBin IMPORT CalcB10AsBinary;
IMPORT IO;
FROM Str IMPORT CardToStr;

CONST NrValues = 34;
TYPE DemoValues = ARRAY [1..NrValues] OF CARDINAL;
VAR
  values : DemoValues;
  b10 : LONGCARD;
  j : CARDINAL;
  b10Str : ARRAY [0..31] OF CHAR;
  ok : BOOLEAN;
BEGIN
  values := DemoValues( 1, 2, 3, 4, 5, 6, 7, 8, 9, 10,
  95, 96, 97, 98, 99, 100, 101, 102, 103, 104, 105,
  297, 576, 594, 891, 909, 999, 1998, 2079, 2251, 2277, 2439, 2997, 4878);
  FOR j := 1 TO NrValues DO
    b10 := CalcB10AsBinary( values[j]);
    CardToStr( b10, b10Str, 2, ok);
    IO.WrCard( values[j], 4); IO.WrStr( '  ');
    IO.WrStr( b10Str); IO.WrLn;
  END;
END B10Demo.