MODULE pi_forever;
(* computes pi forever *)

FROM Storage IMPORT ALLOCATE;
FROM Base10000IOBuffer IMPORT SetDelay, SquirtUnNormalizedBase10000Digit;



CONST
  block_digit_count = 20;

TYPE
  block         = ARRAY [0..14*block_digit_count-1] OF CARDINAL;
  arraytype     = POINTER TO aka_arraytype;
  aka_arraytype = RECORD
                    b    : block;
                    next : arraytype
                  END (* RECORD *);

VAR
  N, i, count  : CARDINAL;
  array, dummy : arraytype;

  (* paging efficiency variables..... *)
  blockno  : CARDINAL;
  blockptr : arraytype;




PROCEDURE read (position : CARDINAL) : CARDINAL;

VAR
  newblockno : CARDINAL;
  i          : CARDINAL;

BEGIN
  newblockno := position DIV (14*block_digit_count);
  IF newblockno <> blockno
  THEN
    blockno := newblockno;
    blockptr := array;
    FOR i := 1 TO blockno DO blockptr := blockptr^.next END (* FOR *)
  END (* IF *);
  RETURN blockptr^.b[position MOD (14*block_digit_count)]
END (* PROCEDURE *) read;



PROCEDURE write (position, value : CARDINAL);

VAR
  newblockno : CARDINAL;
  i          : CARDINAL;

BEGIN
  newblockno := position DIV (14*block_digit_count);
  IF newblockno <> blockno
  THEN
    blockno := newblockno;
    blockptr := array;
    FOR i := 1 TO blockno DO blockptr := blockptr^.next END (* FOR *)
  END (* IF *);
  blockptr^.b[position MOD (14*block_digit_count)] := value
END (* PROCEDURE *) write;





BEGIN (* main program *)
  N := block_digit_count; NEW(array); array^.next := NIL;

  WHILE TRUE DO
    blockno := 0; blockptr := array;
    FOR i := 0 TO 14*N-1 DO write(i, 2000) END (* FOR *);

    FOR count := N-1 TO 0 BY -1 DO
      SquirtUnNormalizedBase10000Digit(read(0));
      write(0, 0);
      FOR i := 1 TO 14*count+13 DO write(i, read(i)*10000) END (* FOR *);
      FOR i := 14*count+13 TO 1 BY -1 DO
        write(i-1, read(i-1) + (read(i) DIV (2*i+1))*i);
        write(i,                read(i) MOD (2*i+1)   )
      END (* FOR *)
    END (* FOR *);

    SquirtUnNormalizedBase10000Digit(read(0) DIV 10000 * 10000);
     (* instead of flushing, but avoiding 9999 logjam *)
    SetDelay(N); N := N*2;
    FOR i := 1 TO N DIV block_digit_count DIV 2 DO
      NEW(dummy); dummy^.next := array; array := dummy
    END (* FOR *)
  END (* WHILE *)
END (* MAIN MODULE *) pi_forever.