home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / magazine / drdobbs / 1988 / 03 / porter / porter.ls2 < prev   
Text File  |  1979-12-31  |  3KB  |  108 lines
  1. Program hugemats;
  2.  
  3.   { Demo program to add two huge matrices > 64K, giving a third }
  4.  
  5. Const  maxRows = 250;
  6.        maxCols = 300;
  7.  
  8. Type   dataObj = word;
  9.        colPtr = ^colArray;
  10.        colArray = array [1..maxCols] of dataObj;
  11.        colNode = record
  12.            col : colPtr;
  13.          End;
  14.        rowPtr = ^rowArray;
  15.        rowArray = array [1..maxRows] of colNode;
  16.  
  17. Var    A, B, C : rowPtr;
  18.        x, y    : word;
  19.        error   : Boolean;
  20. { ------------------------------------------------------------- }
  21.  
  22. Procedure create (var D     : rowPtr;
  23.                   var error : Boolean);
  24.  
  25.   { Create huge array 'D' and pass back pointer to it }
  26.  
  27. Var   row : word;
  28.  
  29. Begin
  30.   Error := false;
  31.   If maxAvail > sizeof (rowArray) then     { if space available }
  32.     GetMem (D, sizeof (rowArray))          { allocate row array }
  33.   Else begin
  34.     D := nil;
  35.     Error := true;
  36.   End;
  37.   If D <> nil then
  38.     For row := 1 to maxRows do begin        { allocate all rows }
  39.       If not error then
  40.         If maxAvail > sizeof (colArray) then         { if space }
  41.           GetMem (D^ [row].col, sizeof (colArray))  { alloc row }
  42.         Else
  43.           Error := true;
  44.     End;
  45. End;
  46. { --------------------------- }
  47.  
  48. Procedure acquire (var D     : rowPtr;
  49.                    var error : Boolean);
  50.  
  51.   { Load data into array 'D' after creating it }
  52.  
  53. Var   row, c : word;
  54.  
  55. Begin
  56.   Create (D, error);
  57.   If not error then
  58.     For row := 1 to maxRows do
  59.       For c := 1 to maxCols do
  60.         D^ [row].col^ [c] := (row * 10) + c;   { modify to suit }
  61. End;
  62. { --------------------------- }
  63.  
  64. Begin   { main program }
  65.   Writeln ('Size of each array is ',
  66.            sizeof (rowArray) + (sizeof (colArray) * maxRows),
  67.            ' bytes');
  68.   Writeln ('Initial heap space = ', memAvail);
  69.   Writeln ('Setting up array A');
  70.   Acquire (A, error);
  71.  
  72.   If not error then begin
  73.     Writeln ('Remaining heap space = ', memAvail : 6);
  74.     Writeln ('Setting up array B');
  75.     Acquire (B, error);
  76.   End;
  77.  
  78.   If not error then begin
  79.     Writeln ('Remaining heap space = ', memAvail : 6);
  80.     Writeln ('Creating target array C');
  81.     Create (C, error);
  82.   End;
  83.  
  84.   If not error then
  85.     Begin
  86.       Writeln ('Remaining heap space = ', memAvail : 6);
  87.       Writeln ('Adding arrays');
  88.       For y := 1 to maxRows do
  89.         For x := 1 to maxCols do
  90.           C^[y].col^[x] := A^[y].col^[x] + B^[y].col^[x];
  91.  
  92.       Writeln;
  93.       Writeln ('Proof:');
  94.       Write   ('A [1, 1] + B [1, 1] = C [1, 1] = ');
  95.       Writeln (A^[1].col^[1] : 5, ' + ', B^[1].col^[1] : 5, ' = ',
  96.                C^[1].col^[1] : 5);
  97.       x := maxCols;
  98.       y := maxRows;
  99.       Write   ('A [m, n] + B [m, n] = C [m, n] = ');
  100.       Writeln (A^[y].col^[x] : 5, ' + ', B^[y].col^[x] : 5, ' = ',
  101.                C^[y].col^[x] : 5);
  102.     End
  103.   Else
  104.     Begin
  105.       Writeln ('Out of memory: program ended');
  106.       Write (#7);                                     { beep }
  107.     End;
  108. End.