ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/MAGAZINE/DDJMAG/DDJ8810.ZIP/HUGEAR.BAS

BASIC Source File | 1988-10-31 | 7.6 KB | 262 lines

_STRUCTURED PROGRAMMING_
by
Kent Porter

Listing 1.

' Program HUGEMATS.BAS
' Demo program to add two huge matrices > 64K, giving a third
' Written using Microsoft QuickBasic 4.00B
' Kent Porter, DDJ, October 1988

DEFINT A-Z                        ' All variables are integers
DECLARE SUB acquire (D())         ' Subroutine prototype
REM $DYNAMIC                      ' Use heap for arrays

' Constants
CONST maxRows = 250               ' Rows in matrices
CONST maxCols = 300               '  and columns

' Define arrays
OPTION BASE 1                     ' 1 is lowest subscript
DIM A(maxRows, maxCols)
DIM B(maxRows, maxCols)
DIM C(maxRows, maxCols)

' ----------------------------------------------------------------
' Main program follows
  CLS                             ' Clear screen
  size& = maxRows * 2
  size& = size& * maxCols         ' Array size as long int
  PRINT "Size of each array is"; size&; "bytes"

  PRINT "Setting up Array A"
  Acquire A()

  PRINT "Setting up Array B"
  Acquire B()

  PRINT "Adding arrays"
  FOR col = 1 TO maxCols
    FOR row = 1 TO maxRows
      C(row, col) = A(row, col) + B(row, col)
    NEXT row
  NEXT col

  PRINT "Proof:"
  PRINT "A(1, 1) + B(1,1) = C(1, 1) = ";
  PRINT A(1, 1); " + "; B(1, 1); " = "; C(1, 1)
  C = maxCols
  r = maxRows
  PRINT "A(max, max) + B(max, max) = C(max, max) = ";
  PRINT A(r, C); " + "; B(r, C); " = "; C(r, C)
' -----------------------------------------------------------

SUB Acquire (D())
  ' Load data into array 'D'

  FOR row = 1 TO maxRows
    FOR col = 1 TO maxCols
      D(row, col) = (row * 10) + col    ' Generate test data
    NEXT col
  NEXT row
END SUB

Listing 2.


PROGRAM DiskArr;
(* Illustrates disk-based arrays, adding two 500 x 500 arrays *)
(*   of REAL to yield a third.                                *)
(* Requires 4.5MB of disk space                               *)
(* Turbo Pascal 4.0                                           *)
(* Kent Porter, DDJ, October 1988                              *)

USES CRT, DOS;

CONST  maxRow = 499;
       maxCol = 499;
       Yes    = TRUE;
       No     = FALSE;

TYPE   ArrayRow = ARRAY [0..MaxCol] OF REAL;    (* Row buffer *)
       RowFile  = FILE OF ArrayRow;              (* File type *)
       BuffCtlBlock = RECORD      (* Row buffer control block *)
         CurrentRow : WORD;
         IsModified : BOOLEAN;
       END;

VAR    ArrA, ArrB, ArrC  : RowFile;
       RowA, RowB, RowC  : ArrayRow;
       BufA, BufB, BufC  : BuffCtlBlock;
       BufSize           : WORD;
       row, col, nCols   : WORD;

(* ---------------------------------------------------------- *)

PROCEDURE Acquire (VAR arr  : RowFile;
                   VAR cb   : BuffCtlBlock;
                   VAR buf  : ArrayRow;
                       name : String);

  (* Load data into disk array 'arr'                          *)
  (* If the file already exists, simply open it               *)
  (* Upon return, row 0 is loaded into the buffer             *)

VAR   r, c, nread : WORD;
      newfile     : BOOLEAN;

BEGIN
  cb.CurrentRow := 0;      (* Initialize buffer control block *)
  cb.IsModified := No;
  NewFile       := Yes;    (* Assume we have to make new file *)

  Assign (arr, name);
  {$I-}
  Reset (arr);                        (* Does the file exist? *)
  {$I+}
  IF IOResult = 0 THEN                 (* File already exists *)
    IF FileSize (arr) = maxRow+1 THEN        (* If right size *)
      NewFile := No;                (* then use existing file *)

  (* If we have to create a new file *)
  IF NewFile THEN BEGIN
    Rewrite (arr);                         (* Create the file *)
    FOR r := 0 TO maxRow DO BEGIN
      Gotoxy (1, WhereY-1); Writeln ('Row ',r:3); (* Show row *)
      FOR c := 0 TO maxCol DO
        Buf [c] := ((row * nCols) + c) * 1.0;    (* Test data *)
      Write (arr, buf);                 (* Write out full row *)
    END;
    Writeln;
  END;

  Seek (arr, 0);                         (* Go to top of file *)
  Read (arr, buf);                         (* Get first block *)
END;
(* -------------------------- *)

FUNCTION A (row, col : WORD) : REAL;

  (* Return indicated element from Array A *)

BEGIN
  IF row <> BufA.CurrentRow THEN BEGIN     (* Reading new row *)
    IF BufA.IsModified THEN BEGIN     (* Save row if modified *)
      Seek (ArrA, LONGINT (BufA.CurrentRow));
      Write (ArrA, RowA);
    END;
    Seek (ArrA, LONGINT (row));                (* Get new row *)
    Read (ArrA, RowA);
    BufA.IsModified := No; BufA.CurrentRow := row;
  END;
  A := RowA [col];                      (* Return the element *)
END;
(* -------------------------- *)

FUNCTION B (row, col : WORD) : REAL;

  (* Same as A, but from ArrB *)

BEGIN
  IF row <> BufB.CurrentRow THEN BEGIN
    IF BufB.IsModified THEN BEGIN
      Seek (ArrB, LONGINT (BufB.CurrentRow));
      Write (ArrB, RowB);
    END;
    Seek (ArrB, LONGINT (row));
    Read (ArrB, RowB);
    BufB.IsModified := No; BufB.CurrentRow := row;
  END;
  B := RowB [col];
END;
(* -------------------------- *)

FUNCTION C (row, col : WORD) : REAL;

  (* Same as A, but from ArrC *)

BEGIN
  IF row <> BufC.CurrentRow THEN BEGIN
    IF BufC.IsModified THEN BEGIN
      Seek (ArrC, LONGINT (BufC.CurrentRow));
      Write (ArrC, RowC);
    END;
    Seek (ArrC, LONGINT (row));
    Read (ArrC, RowC);
    BufC.IsModified := No; BufC.CurrentRow := row;
  END;
  C := RowC [col];
END;
(* -------------------------- *)

PROCEDURE WriteToC (row, col : WORD; val : REAL);

  (* Write val to C [row, col] *)

BEGIN
  IF row <> BufC.CurrentRow THEN BEGIN        (* If a new row *)
    IF BufC.IsModified THEN BEGIN          (* and old changed *)
      Seek (ArrC, LONGINT (BufC.CurrentRow));     (* save old *)
      Write (ArrC, RowC);
    END;
    Seek (ArrC, LONGINT (row));           (* then get new row *)
    Read (ArrC, RowC);
    BufC.CurrentRow := row;
  END;
  RowC [col] := val;                       (* and write to it *)
  BufC.IsModified := Yes;
END;
(* -------------------------- *)

BEGIN   (* Body of main program *)
  ClrScr;
  Writeln ('*** Disk Array Processor ***');
  nCols := MaxCol + 1;
  BufSize := SizeOf (ArrayRow);

  (* Create output array file and fill with zeros *)
  Assign (ArrC, 'ARRAY.C');
  Rewrite (ArrC);
  Writeln ('Initializing output array'); Writeln;
  FOR col := 0 TO maxCol DO
    RowC [col] := 0.0;
  FOR row := 0 TO maxRow DO BEGIN
    Gotoxy (1, WhereY-1); Writeln ('Row ', row:3);
    Write (ArrC, RowC);
  END;
  Seek (ArrC, 0); Read (ArrC, RowC);
  BufC.CurrentRow := 0; BufC.IsModified := No;

  (* Get the test data into A and B *)
  Gotoxy (1, WhereY-1); Writeln ('Setting up Array A');
  Acquire (ArrA, BufA, RowA, 'ARRAY.A');
  Gotoxy (1, WhereY-1); Writeln ('Setting up Array B');
  Acquire (ArrB, BufB, RowB, 'ARRAY.B');

  (* Add A and B, giving C *)
  Gotoxy (1, WhereY-1); ClrEol; Writeln ('Adding arrays');
  FOR row := 0 TO maxRow DO BEGIN
    Gotoxy (1, WhereY);
    Write ('Row ', row:3);
    FOR col := 0 TO maxCol DO
      WriteToC (row, col, (A (row, col) + B (row, col)));
  END;

  (* Display proof that it worked *)
  Gotoxy (1, WhereY); Writeln ('Addition completed');
  Writeln ('Proof:');
  Write   ('A (1, 1) + B (1, 1) = C (1, 1) = ');
  Writeln (A (1, 1):6:0, ' + ',
           B (1, 1):6:0, ' = ',
           C (1, 1):6:0);

  Write   ('A (maxRow, maxCol) + B (maxRow, maxCol) = ');
  Writeln ('C (maxRow, maxCol) = ');
  Writeln (A (maxRow, maxCol):6:0, ' + ',
           B (maxRow, maxCol):6:0, ' = ',
           C (maxRow, maxCol):6:0);
  Close (ArrC);
END.