home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / magazine / drdobbs / 1988 / 10 / hugear.bas < prev    next >
BASIC Source File  |  1988-10-31  |  8KB  |  262 lines
  1. _STRUCTURED PROGRAMMING_
  2. by
  3. Kent Porter
  4.  
  5. Listing 1. 
  6.  
  7. ' Program HUGEMATS.BAS
  8. ' Demo program to add two huge matrices > 64K, giving a third
  9. ' Written using Microsoft QuickBasic 4.00B
  10. ' Kent Porter, DDJ, October 1988
  11.  
  12. DEFINT A-Z                        ' All variables are integers
  13. DECLARE SUB acquire (D())         ' Subroutine prototype
  14. REM $DYNAMIC                      ' Use heap for arrays
  15.  
  16. ' Constants
  17. CONST maxRows = 250               ' Rows in matrices
  18. CONST maxCols = 300               '  and columns
  19.  
  20. ' Define arrays
  21. OPTION BASE 1                     ' 1 is lowest subscript
  22. DIM A(maxRows, maxCols)
  23. DIM B(maxRows, maxCols)
  24. DIM C(maxRows, maxCols)
  25.  
  26. ' ----------------------------------------------------------------
  27. ' Main program follows
  28.   CLS                             ' Clear screen
  29.   size& = maxRows * 2
  30.   size& = size& * maxCols         ' Array size as long int
  31.   PRINT "Size of each array is"; size&; "bytes"
  32.  
  33.   PRINT "Setting up Array A"
  34.   Acquire A()
  35.  
  36.   PRINT "Setting up Array B"
  37.   Acquire B()
  38.  
  39.   PRINT "Adding arrays"
  40.   FOR col = 1 TO maxCols
  41.     FOR row = 1 TO maxRows
  42.       C(row, col) = A(row, col) + B(row, col)
  43.     NEXT row
  44.   NEXT col
  45.  
  46.   PRINT "Proof:"
  47.   PRINT "A(1, 1) + B(1,1) = C(1, 1) = ";
  48.   PRINT A(1, 1); " + "; B(1, 1); " = "; C(1, 1)
  49.   C = maxCols
  50.   r = maxRows
  51.   PRINT "A(max, max) + B(max, max) = C(max, max) = ";
  52.   PRINT A(r, C); " + "; B(r, C); " = "; C(r, C)
  53. ' -----------------------------------------------------------
  54.  
  55. SUB Acquire (D())
  56.   ' Load data into array 'D'
  57.  
  58.   FOR row = 1 TO maxRows
  59.     FOR col = 1 TO maxCols
  60.       D(row, col) = (row * 10) + col    ' Generate test data
  61.     NEXT col
  62.   NEXT row
  63. END SUB
  64.  
  65. Listing 2.
  66.  
  67.  
  68. PROGRAM DiskArr;
  69. (* Illustrates disk-based arrays, adding two 500 x 500 arrays *)
  70. (*   of REAL to yield a third.                                *)
  71. (* Requires 4.5MB of disk space                               *)
  72. (* Turbo Pascal 4.0                                           *)
  73. (* Kent Porter, DDJ, October 1988                              *)
  74.  
  75. USES CRT, DOS;
  76.  
  77. CONST  maxRow = 499;
  78.        maxCol = 499;
  79.        Yes    = TRUE;
  80.        No     = FALSE;
  81.  
  82. TYPE   ArrayRow = ARRAY [0..MaxCol] OF REAL;    (* Row buffer *)
  83.        RowFile  = FILE OF ArrayRow;              (* File type *)
  84.        BuffCtlBlock = RECORD      (* Row buffer control block *)
  85.          CurrentRow : WORD;
  86.          IsModified : BOOLEAN;
  87.        END;
  88.  
  89. VAR    ArrA, ArrB, ArrC  : RowFile;
  90.        RowA, RowB, RowC  : ArrayRow;
  91.        BufA, BufB, BufC  : BuffCtlBlock;
  92.        BufSize           : WORD;
  93.        row, col, nCols   : WORD;
  94.  
  95. (* ---------------------------------------------------------- *)
  96.  
  97. PROCEDURE Acquire (VAR arr  : RowFile;
  98.                    VAR cb   : BuffCtlBlock;
  99.                    VAR buf  : ArrayRow;
  100.                        name : String);
  101.  
  102.   (* Load data into disk array 'arr'                          *)
  103.   (* If the file already exists, simply open it               *)
  104.   (* Upon return, row 0 is loaded into the buffer             *)
  105.  
  106. VAR   r, c, nread : WORD;
  107.       newfile     : BOOLEAN;
  108.  
  109. BEGIN
  110.   cb.CurrentRow := 0;      (* Initialize buffer control block *)
  111.   cb.IsModified := No;
  112.   NewFile       := Yes;    (* Assume we have to make new file *)
  113.  
  114.   Assign (arr, name);
  115.   {$I-}
  116.   Reset (arr);                        (* Does the file exist? *)
  117.   {$I+}
  118.   IF IOResult = 0 THEN                 (* File already exists *)
  119.     IF FileSize (arr) = maxRow+1 THEN        (* If right size *)
  120.       NewFile := No;                (* then use existing file *)
  121.  
  122.   (* If we have to create a new file *)
  123.   IF NewFile THEN BEGIN
  124.     Rewrite (arr);                         (* Create the file *)
  125.     FOR r := 0 TO maxRow DO BEGIN
  126.       Gotoxy (1, WhereY-1); Writeln ('Row ',r:3); (* Show row *)
  127.       FOR c := 0 TO maxCol DO
  128.         Buf [c] := ((row * nCols) + c) * 1.0;    (* Test data *)
  129.       Write (arr, buf);                 (* Write out full row *)
  130.     END;
  131.     Writeln;
  132.   END;
  133.  
  134.   Seek (arr, 0);                         (* Go to top of file *)
  135.   Read (arr, buf);                         (* Get first block *)
  136. END;
  137. (* -------------------------- *)
  138.  
  139. FUNCTION A (row, col : WORD) : REAL;
  140.  
  141.   (* Return indicated element from Array A *)
  142.  
  143. BEGIN
  144.   IF row <> BufA.CurrentRow THEN BEGIN     (* Reading new row *)
  145.     IF BufA.IsModified THEN BEGIN     (* Save row if modified *)
  146.       Seek (ArrA, LONGINT (BufA.CurrentRow));
  147.       Write (ArrA, RowA);
  148.     END;
  149.     Seek (ArrA, LONGINT (row));                (* Get new row *)
  150.     Read (ArrA, RowA);
  151.     BufA.IsModified := No; BufA.CurrentRow := row;
  152.   END;
  153.   A := RowA [col];                      (* Return the element *)
  154. END;
  155. (* -------------------------- *)
  156.  
  157. FUNCTION B (row, col : WORD) : REAL;
  158.  
  159.   (* Same as A, but from ArrB *)
  160.  
  161. BEGIN
  162.   IF row <> BufB.CurrentRow THEN BEGIN
  163.     IF BufB.IsModified THEN BEGIN
  164.       Seek (ArrB, LONGINT (BufB.CurrentRow));
  165.       Write (ArrB, RowB);
  166.     END;
  167.     Seek (ArrB, LONGINT (row));
  168.     Read (ArrB, RowB);
  169.     BufB.IsModified := No; BufB.CurrentRow := row;
  170.   END;
  171.   B := RowB [col];
  172. END;
  173. (* -------------------------- *)
  174.  
  175. FUNCTION C (row, col : WORD) : REAL;
  176.  
  177.   (* Same as A, but from ArrC *)
  178.  
  179. BEGIN
  180.   IF row <> BufC.CurrentRow THEN BEGIN
  181.     IF BufC.IsModified THEN BEGIN
  182.       Seek (ArrC, LONGINT (BufC.CurrentRow));
  183.       Write (ArrC, RowC);
  184.     END;
  185.     Seek (ArrC, LONGINT (row));
  186.     Read (ArrC, RowC);
  187.     BufC.IsModified := No; BufC.CurrentRow := row;
  188.   END;
  189.   C := RowC [col];
  190. END;
  191. (* -------------------------- *)
  192.  
  193. PROCEDURE WriteToC (row, col : WORD; val : REAL);
  194.  
  195.   (* Write val to C [row, col] *)
  196.  
  197. BEGIN
  198.   IF row <> BufC.CurrentRow THEN BEGIN        (* If a new row *)
  199.     IF BufC.IsModified THEN BEGIN          (* and old changed *)
  200.       Seek (ArrC, LONGINT (BufC.CurrentRow));     (* save old *)
  201.       Write (ArrC, RowC);
  202.     END;
  203.     Seek (ArrC, LONGINT (row));           (* then get new row *)
  204.     Read (ArrC, RowC);
  205.     BufC.CurrentRow := row;
  206.   END;
  207.   RowC [col] := val;                       (* and write to it *)
  208.   BufC.IsModified := Yes;
  209. END;
  210. (* -------------------------- *)
  211.  
  212. BEGIN   (* Body of main program *)
  213.   ClrScr;
  214.   Writeln ('*** Disk Array Processor ***');
  215.   nCols := MaxCol + 1;
  216.   BufSize := SizeOf (ArrayRow);
  217.  
  218.   (* Create output array file and fill with zeros *)
  219.   Assign (ArrC, 'ARRAY.C');
  220.   Rewrite (ArrC);
  221.   Writeln ('Initializing output array'); Writeln;
  222.   FOR col := 0 TO maxCol DO
  223.     RowC [col] := 0.0;
  224.   FOR row := 0 TO maxRow DO BEGIN
  225.     Gotoxy (1, WhereY-1); Writeln ('Row ', row:3);
  226.     Write (ArrC, RowC);
  227.   END;
  228.   Seek (ArrC, 0); Read (ArrC, RowC);
  229.   BufC.CurrentRow := 0; BufC.IsModified := No;
  230.  
  231.   (* Get the test data into A and B *)
  232.   Gotoxy (1, WhereY-1); Writeln ('Setting up Array A');
  233.   Acquire (ArrA, BufA, RowA, 'ARRAY.A');
  234.   Gotoxy (1, WhereY-1); Writeln ('Setting up Array B');
  235.   Acquire (ArrB, BufB, RowB, 'ARRAY.B');
  236.  
  237.   (* Add A and B, giving C *)
  238.   Gotoxy (1, WhereY-1); ClrEol; Writeln ('Adding arrays');
  239.   FOR row := 0 TO maxRow DO BEGIN
  240.     Gotoxy (1, WhereY);
  241.     Write ('Row ', row:3);
  242.     FOR col := 0 TO maxCol DO
  243.       WriteToC (row, col, (A (row, col) + B (row, col)));
  244.   END;
  245.  
  246.   (* Display proof that it worked *)
  247.   Gotoxy (1, WhereY); Writeln ('Addition completed');
  248.   Writeln ('Proof:');
  249.   Write   ('A (1, 1) + B (1, 1) = C (1, 1) = ');
  250.   Writeln (A (1, 1):6:0, ' + ',
  251.            B (1, 1):6:0, ' = ',
  252.            C (1, 1):6:0);
  253.  
  254.   Write   ('A (maxRow, maxCol) + B (maxRow, maxCol) = ');
  255.   Writeln ('C (maxRow, maxCol) = ');
  256.   Writeln (A (maxRow, maxCol):6:0, ' + ',
  257.            B (maxRow, maxCol):6:0, ' = ',
  258.            C (maxRow, maxCol):6:0);
  259.   Close (ArrC);
  260. END.
  261.  
  262.