home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / nicol / sti_aloc / sti_demo.pas next >
Encoding:
Pascal/Delphi Source File  |  1980-01-01  |  4.4 KB  |  134 lines
  1. {$R-,S-}                                    {turn off range & stack checks  }
  2.  
  3. Program STI_Demo;                           {demonstration program for STI  }
  4.  
  5. Uses  Crt,STIAlloc;                         {large allocatio unit           }
  6.  
  7. Type
  8.   DataPtr = ^DataRec;                       {pointer to the test data type  }
  9.   DataRec = record                          {the actual test data type      }
  10.               Name : string[80];
  11.               Age  : longint;
  12.             end;
  13.  
  14. var
  15.   Loop,                                     {general loop variable          }
  16.   ArraySize,                                {size of the array              }
  17.   Errors        : LongInt;                  {number of errors               }
  18.   DataArray     : DataPtr;                  {the array                      }
  19.   DataAddr      : LongInt;                  {the address (linear) of the arr}
  20.   Dummy         : DataRec;                  {dummy data variable            }
  21.  
  22. {---------------------------------------------------------------------------}
  23.  
  24. function GetElementPtr(ElementNo : LongInt) : DataPtr;
  25.  
  26. begin
  27.   GetElementPtr :=                          {return a pointer to the data   }
  28.       STI_Linear2Ptr(DataAddr+(ElementNo*SizeOf(DataRec)));
  29. end;
  30.  
  31. {---------------------------------------------------------------------------}
  32.  
  33. procedure GetElement(ElementNo : LongInt; Var GotData : DataRec);
  34.  
  35. begin
  36.   GotData := GetElementPtr(ElementNo)^;     {return the actual data         }
  37. end;
  38.  
  39. {---------------------------------------------------------------------------}
  40.  
  41. procedure PutElement(ElementNo : Longint; NewData : DataRec);
  42.  
  43. begin
  44.   GetElementPtr(ElementNo)^ := NewData;     {store the data                 }
  45. end;
  46.  
  47. {---------------------------------------------------------------------------}
  48.  
  49. procedure Explain;
  50.  
  51. Var
  52.   Dummy : char;
  53.  
  54. begin
  55.   writeln('                                 STI_DEMO                       ');
  56.   writeln('                                                                ');
  57.   writeln('             A demonstration program for STIALLOC.PAS, a unit   ');
  58.   writeln('             that supplies the ability to allocate very large   ');
  59.   writeln('             amounts of memory.                                 ');
  60.   writeln('                                                                ');
  61.   writeln('             Press any key to continue....                      ');
  62.   repeat until keypressed;
  63.   Dummy := ReadKey;
  64.   ClrScr;
  65. end;
  66.  
  67. {---------------------------------------------------------------------------}
  68.  
  69. begin
  70.   ClrScr;                                   {clear the screen               }
  71.   Explain;
  72.   WriteLn('Maximum Available Memory = ',MaxAvail); {write the available size}
  73.   ArraySize  := (MaxAvail div SizeOf(DataRec));    {get the array size      }
  74.   STI_GetMem(DataArray,ArraySize  * SizeOf(DataRec)); {get the memory       }
  75.   if DataArray = nil then begin             {make sure we did get it        }
  76.     WriteLn('Unable to allocate array of ',ArraySize ,' elements');
  77.     Halt(1);
  78.   end;
  79.  
  80.   {this saves us from recomputing Linear(LongArray) repeatedly}
  81.  
  82.   DataAddr := STI_Ptr2Linear(DataArray);
  83.  
  84.   {show memory status}
  85.  
  86.   WriteLn('Allocated ',ArraySize  * SizeOf(DataRec), ' bytes');
  87.   WriteLn('Maximum Available Memory = ',MaxAvail);
  88.   WriteLn('Successfully allocated array of ',ArraySize ,' elements');
  89.  
  90.   {initialize the array}
  91.  
  92.   writeln;
  93.   WriteLn('Initializing array...');
  94.   for Loop := 0 to ArraySize -1 do
  95.      begin
  96.        Dummy.Age  := Loop;
  97.        Dummy.Name := 'Software Technology International';
  98.        PutElement(Loop, Dummy);
  99.        GotoXY(1,7); writeln(Dummy.Name);
  100.        GotoXY(1,8); writeln(Dummy.Age);
  101.      end;
  102.  
  103.   {validate the array contents}
  104.  
  105.   writeln;
  106.   WriteLn('Validating array contents...');
  107.   Errors := 0;
  108.   for Loop := 0 to ArraySize -1 do
  109.     begin
  110.       GetElement(Loop,Dummy);
  111.       GotoXY(1,11); writeln(Dummy.Name);
  112.       GotoXY(1,12); writeln(Dummy.Age);
  113.       if (Dummy.Age <> Loop)  then
  114.         begin
  115.           WriteLn('Error at element ',Loop,':  should be ',Loop,', is ',Dummy.Age);
  116.           Inc(Errors);
  117.         end;
  118.     end;
  119.   writeln;
  120.  
  121.   {show status}
  122.  
  123.   if Errors = 0 then
  124.     WriteLn('No errors found')
  125.   else
  126.     WriteLn(Errors, ' errors found');
  127.  
  128.   {release the memory}
  129.  
  130.   WriteLn('Releasing memory...');
  131.   STI_FreeMem(DataArray, ArraySize  * SizeOf(DataRec));
  132.   WriteLn('MaxAvail = ', MaxAvail);
  133. end.
  134.