home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / BUFFR2.ZIP / BUFFARAY.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-01-04  |  13.7 KB  |  466 lines
  1. Unit BuffAray;
  2. {$R-,S-,O+}
  3.  
  4. { Defines a Buffered Generic VirtualArray. MaxSize = 32 MegaBytes.        }
  5.  
  6. { The BufferedArray Object is a very high performance virtual array using }
  7. { multiple (8) buffers to manage array accesses through RAM.              }
  8.  
  9. { Each BufferedArray is internally divided into 8 sectors, each sector    }
  10. { having 1 buffer assigned to it.  Buffers are constrained such that they }
  11. { can never read from or write to adjacent sectors, but freely "patrol"   }
  12. { within their own sector.  To save some access time, buffers do not ever }
  13. { flush to disk unless the particular buffer has been written to, with    }
  14. { the exceptions of the Copy and Store operations, which both Flush all   }
  15. { buffers of the target BufferedArray.                                    }
  16.  
  17. { The Maximum possible (total) buffer size is 524,168 bytes, and is       }
  18. { determined by GetMem's limit of 65521 bytes for a single structure.     }
  19. { The User may select the (total) Buffer space to be used during the INIT }
  20. { operation by the MaxBuffsize variable, or allow the method to utilize   }
  21. { (up to) all available RAM by selecting 0 for MaxBuffSize.               }
  22.  
  23. { Other than the differences in Load, Store, and Init, BufferedArrays     }
  24. { are functionally identical with the VirtualArray Object, although the   }
  25. { performance of the BufferedArray is a tremendous improvement.           }
  26.  
  27. { Remarks on Performance: There are 3 major influences on the performance }
  28. { characteristics of the BufferedArray. The first is "load factor" or the }
  29. { actual percentage of the disk file which resides in RAM.  The second is }
  30. { the size of the individual buffers themselves. As the size of the       }
  31. { buffers increases, the time required to Flush or Load each buffer also  }
  32. { increases.  Obviously, with a high load factor this is not much of a    }
  33. { problem, but with a low load factor and a lot of random accesses, much  }
  34. { time will be spent simply Loading or Flushing buffers.  The third is    }
  35. { proportional to the file size, and is simply the time required to SEEK  }
  36. { a random address within the file (before Flushing or Loading).          }
  37. { Of course, as with the much-maligned (by me) ExtendedArray, serial and  }
  38. { closely-spaced accessing is always quite good (unless for some reason   }
  39. { you force the buffers to be very small!).                               }
  40.  
  41. INTERFACE
  42.  
  43. Uses Dos,Crt;
  44.  
  45. Const
  46.   MaximumSize = 33554432; {32 MegaBytes}
  47.  
  48. Type
  49.  
  50.   Flex  = Array[0..0] of Byte;
  51.   Ptr   = ^Flex;
  52.  
  53.   BufferedArray = Object
  54.  
  55.                    ElSize    : Word;
  56.                    NumElems  : LongInt;
  57.                    Name      : String[65];
  58.                    F         : File;
  59.                    BSize     : Word;
  60.                    SSize     : LongInt;
  61.                    Buffer    : Array[0..7] of Ptr;
  62.                    UpDate    : Array[0..7] of Boolean;
  63.                    BuffLeft  : Array[0..8] of LongInt;
  64.  
  65.                    Procedure Create;
  66.                    Procedure Destroy;
  67.  
  68.                    Procedure Init (NumElements : LongInt; ElementSize : Word;
  69.                                    MaxBuffSize : LongInt; FileName : String);
  70.                    Procedure Load (FileName : String; ElementSize : Word;
  71.                                    MaxBuffSize : LongInt);
  72.  
  73.                    {NOTE: Performing a LOAD should ONLY be done as a DIRECT}
  74.                    {      substitution for performing an INIT operation}
  75.                    {      Of course, CREATE should be used first.}
  76.  
  77.                    Procedure Store;
  78.  
  79.                    {NOTE: Performing a STORE has the same effect as}
  80.                    {      performing a DESTROY, accept the data is}
  81.                    {      saved in the filename given when performing INIT}
  82.  
  83.            {FileNames May be up to 65 characters long, and may conist
  84.             of Directory and Path information as well as name and extension.
  85.             To Load, BufferedAray MUST be ONLY CREATEd (or DESTROYed)}
  86.  
  87.                    Procedure Accept (Var El; Index : LongInt; Size : Word);
  88.                    Procedure Retrieve (Var El; Index : LongInt; Size : Word);
  89.                    Procedure Copy (Var From : BufferedArray);
  90.                    Procedure Swap (I,J : LongInt);
  91.  
  92.                    Function MaxSize : LongInt;
  93.                    Function ElemSize : Word;
  94.                 End;
  95.  
  96. IMPLEMENTATION
  97.  
  98. Const
  99.   AbsoluteMaxBuffer = 524168;  {8 * 65521}
  100.  
  101. Procedure Error (Num : Byte; Name : String);
  102. Begin
  103.   WriteLn;
  104.   Write ('BufferedArray ERROR[',Num:1,']: ');
  105.   Case Num of
  106.             0 : WriteLn ('Insufficient Free Disk Space for Requested BufferedArray.');
  107.             1 : WriteLn ('Unable to Open File ',Name);
  108.             2 : WriteLn ('Attempted to Access with wrong size Element.');
  109.             3 : WriteLn ('***** INDEX OUT OF BOUNDS *****');
  110.             4 : WriteLn ('Attempted to Copy from Un-Initialized BufferedArray.');
  111.             5 : WriteLn ('Attempted to Copy to Un-Initialized BufferedArray: ',Name);
  112.             6 : WriteLn ('Insufficient Free Disk Space for Requested Copy Operation.');
  113.             7 : WriteLn ('Insufficient Memory for Requested Operation.');
  114.             8 : WriteLn ('Attempted to Open File beyond DOS Size Limit of ',MaximumSize,' Bytes');
  115.             9 : WriteLn ('**** Unable to Allocate Buffer for ',Name,' ****');
  116.            10 : WriteLn ('**** BufferSize Too Small or Insufficient Memory ****');
  117.            11 : WriteLn ('**** Attempted to Load file using wrong ElementSize ****');
  118.            12 : WriteLn ('**** Attempted to Load into Initialized (or Loaded) BufferedArray ****');
  119.           End;
  120.   WriteLn ('**** PROGRAM TERMINATED ****');
  121.   WriteLn;
  122.   Write ('Press <Return> to Continue.... ');
  123.   ReadLn;
  124.   HALT (0)
  125. End;
  126.  
  127. Function InBuff (V : BufferedArray; Index : LongInt; Buff : Byte) : Boolean;
  128. Begin
  129.   If (Index*V.ElemSize >= V.BuffLeft[Buff]) and
  130.      (Index*V.ElemSize < (V.BuffLeft[Buff] + V.BSize))
  131.     Then InBuff := True
  132.   Else InBuff := False
  133. End;
  134.  
  135. Procedure FlushBuff (Var V : BufferedArray; Buff : Byte);
  136. Begin
  137.   Seek (V.F,V.BuffLeft[Buff]);
  138.   BlockWrite (V.F,V.Buffer[Buff]^,V.BSize)
  139. End;
  140.  
  141. Procedure LoadBuff (Var V : BufferedArray; Buff : Byte);
  142. Begin
  143.   Seek (V.F,V.BuffLeft[Buff]);
  144.   BlockRead (V.F,V.Buffer[Buff]^,V.BSize)
  145. End;
  146.  
  147. Procedure MoveBuff (Var V : BufferedArray; Index : LongInt; Buff : Byte);
  148. Var
  149.   Base : LongInt;
  150. Begin
  151.   If V.UpDate[Buff] Then
  152.     Begin
  153.       FlushBuff (V,Buff);
  154.       V.UpDate[Buff] := False
  155.     End;
  156.  
  157.   Base := ((Index*V.ElemSize) - (V.BSize Div 2));
  158.   Base := Base - (Base Mod V.ElemSize);
  159.  
  160.   If Buff = 7
  161.     Then
  162.       If (Base+V.BSize) >= V.NumElems * V.ElemSize
  163.         Then
  164.           Base := (V.NumElems * V.ElemSize) - V.BSize;
  165.  
  166.   If Buff < 7
  167.     Then
  168.       If (Base+V.BSize) >= V.SSize*(Buff+1)
  169.         Then
  170.           Base := (LongInt(Buff+1)*V.SSize) - V.BSize;
  171.  
  172.   If Base < V.SSize*Buff
  173.     Then
  174.       Base := V.SSize*Buff;
  175.  
  176.   V.BuffLeft[Buff] := Base;
  177.  
  178.   LoadBuff (V,Buff)
  179. End;
  180.  
  181. Function Sector (V : BufferedArray; Index : LongInt) : Byte;
  182. Var
  183.   I    : Integer;
  184.   Test : LongInt;
  185.   Temp : LongInt;
  186. Begin
  187.   I := -1;
  188.   Test := 0;
  189.   Temp := (LongInt(V.ElemSize))*Index;
  190.  
  191.   While Test <= Temp do
  192.     Begin
  193.       I := I + 1;
  194.       Test := Test+V.SSize
  195.     End;
  196.  
  197.   If I > 7 Then I := 7;
  198.   Sector := Byte (I)
  199. End;
  200.  
  201. Procedure BufferedArray.Create;
  202. Var
  203.   I : Byte;
  204. Begin
  205.   ElSize := 0;
  206.   NumElems := 0;
  207.   For I := 0 to 7 do BuffLeft[I] := 0;
  208.   BSize := 0;
  209.   For I := 0 to 7 do UpDate[I] := False;
  210.   Name := '';
  211. End;
  212.  
  213. Procedure BufferedArray.Init (NumElements : LongInt; ElementSize : Word;
  214.                               MaxBuffSize : LongInt; FileName : String);
  215. Var
  216.   I,J       : LongInt;
  217.   Buff      : Ptr;
  218.   K,L       : Word;
  219.   BuffSize  : Word;
  220.   Buffers   : Byte;
  221.  
  222. Begin
  223.   Name := FileName;
  224.   I := NumElements * LongInt (ElementSize);
  225.  
  226.   If I > MaximumSize Then Error (8,'');
  227.  
  228.   If I > DiskFree(0) Then Error (0,'');
  229.  
  230.   If MaxBuffSize = 0 Then MaxBuffSize := MemAvail-1000;
  231.  
  232.   If MaxBuffSize > AbsoluteMaxBuffer Then MaxBuffSize := AbsoluteMaxBuffer;
  233.  
  234. {***Set up File***}
  235.  
  236.   Assign (F,Name);
  237.   {$I-} Rewrite (F,1); {$I+}
  238.   If IOResult <> 0 Then
  239.     Error (1,Name);
  240.  
  241.   If I < 65521 Then BuffSize := Word (I) Else BuffSize := 65521;
  242.   If BuffSize > MemAvail Then BuffSize := MemAvail;
  243.   If BuffSize = 0 Then Error (7,'');
  244.  
  245.   K := I Div BuffSize;
  246.   GetMem (Buff,BuffSize);
  247.   For L := 0 to BuffSize-1 do Buff^[L] := 0;
  248.   L := I-(LongInt(K) * BuffSize);
  249.  
  250.   If I >= BuffSize
  251.     Then
  252.       For J := 0 to K-1 do BlockWrite (F,Buff^,BuffSize);
  253.  
  254.   If L > 0 Then BlockWrite (F,Buff^,L);
  255.  
  256.   Reset (F,1);
  257.   FreeMem (Buff,BuffSize);
  258.   If Buff = Nil Then Error (9,Name);
  259.  
  260. {***Set up Buffers***}
  261.  
  262.   BSize := MaxBuffSize Div 8;
  263.  
  264.   If (LongInt(BSize) * 8) > (NumElements*LongInt(ElementSize))
  265.     Then BSize := (NumElements*LongInt(ElementSize)) Div 8;
  266.  
  267.   If BSize = 0 Then Error(10,'');
  268.   SSize := (NumElements*LongInt(ElementSize)) Div 8;
  269.   SSize := SSize - (SSize Mod ElementSize);
  270.   If BSize > SSize Then BSize := SSize;
  271.   BSize := BSize - (BSize Mod ElementSize);
  272.  
  273.   For Buffers := 0 to 7 do
  274.     Begin
  275.       BuffLeft[Buffers] := Buffers*SSize;
  276.       GetMem (Buffer[Buffers],BSize)
  277.     End;
  278.   BuffLeft[8] := (NumElements*LongInt(ElementSize))-1;
  279.  
  280.   NumElems := NumElements;
  281.   ElSize := ElementSize;
  282.   For Buffers := 0 to 7 do LoadBuff (Self,Buffers)
  283. End;
  284.  
  285. Procedure BufferedArray.Destroy;
  286. Var
  287.   I : Byte;
  288. Begin
  289.   Close (F);
  290.   Erase (F);
  291.   For I := 0 to 7 do
  292.     FreeMem (Buffer[I],BSize);
  293.   Create
  294. End;
  295.  
  296. Procedure BufferedArray.Store;
  297. Var
  298.   I : Byte;
  299. Begin
  300.   For I := 0 to 7 do FlushBuff (Self,I);
  301.   Close (F);
  302.   For I := 0 to 7 do
  303.     FreeMem (Buffer[I],BSize);
  304.   Create
  305. End;
  306.  
  307. Procedure BufferedArray.Load (FileName : String; ElementSize : Word;
  308.                               MaxBuffSize : LongInt);
  309. Var
  310.   I           : LongInt;
  311.   Buffers     : Byte;
  312.  
  313. Begin
  314.   If Name <> '' Then Error (12,'');
  315.   Name := FileName;
  316.  
  317.   Assign (F,Name);
  318.   {$I-} ReSet (F,1); {$I+}
  319.   If IOResult <> 0 Then
  320.     Error (1,Name);
  321.  
  322.   I := FileSize (F);
  323.   NumElems := I Div ElementSize;
  324.  
  325.   If NumElems*ElementSize <> I Then Error (11,Name);
  326.  
  327.   If MaxBuffsize = 0 Then MaxBuffSize := MemAvail - 1000;
  328.   If MaxBuffSize > AbsoluteMaxBuffer Then MaxBuffSize := AbsoluteMaxBuffer;
  329.   BSize := MaxBuffSize Div 8;
  330.  
  331.   If (LongInt(BSize) * 8) > (NumElems*LongInt(ElementSize))
  332.     Then BSize := (NumElems*LongInt(ElementSize)) Div 8;
  333.  
  334.   If BSize = 0 Then Error(10,'');
  335.   SSize := (NumElems*LongInt(ElementSize)) Div 8;
  336.   SSize := SSize - (SSize Mod ElementSize);
  337.   If BSize > SSize Then BSize := SSize;
  338.   BSize := BSize - (BSize Mod ElementSize);
  339.  
  340.   For Buffers := 0 to 7 do
  341.     Begin
  342.       BuffLeft[Buffers] := Buffers*SSize;
  343.       GetMem (Buffer[Buffers],BSize)
  344.     End;
  345.   BuffLeft[8] := (NumElems*LongInt(ElementSize))-1;
  346.  
  347.   ElSize := ElementSize;
  348.   For Buffers := 0 to 7 do LoadBuff (Self,Buffers)
  349. End;
  350.  
  351. Function BufferedArray.MaxSize : LongInt;
  352. Begin
  353.   MaxSize := NumElems
  354. End;
  355.  
  356. Function BufferedArray.ElemSize : Word;
  357. Begin
  358.   ElemSize := ElSize
  359. End;
  360.  
  361. Procedure BufferedArray.Accept (Var El; Index : LongInt; Size : Word);
  362. Var
  363.   Buff : Flex Absolute El;
  364.   Sect : Byte;
  365. Begin
  366.   Sect := Sector (Self,Index);
  367.   If Size <> ElSize Then Error (2,'');
  368.   If (Index >= NumElems) or (Index < 0) Then Error (3,'');
  369.  
  370.   If Not InBuff (Self,Index,Sect)
  371.     Then
  372.       MoveBuff (Self,Index,Sect);
  373.   Move (Buff,Buffer[Sect]^[(Index*ElemSize)-BuffLeft[Sect]],Size);
  374.   UpDate[Sect] := True
  375. End;
  376.  
  377. Procedure BufferedArray.Retrieve (Var El; Index : LongInt; Size : Word);
  378. Var
  379.   Buff : Flex Absolute El;
  380.   Sect : Byte;
  381. Begin
  382.   Sect := Sector (Self,Index);
  383.   If Size <> ElSize Then Error (2,'');
  384.   If (Index >= NumElems) or (Index < 0) Then Error (3,'');
  385.  
  386.   If Not InBuff (Self,Index,Sect)
  387.     Then
  388.       MoveBuff (Self,Index,Sect);
  389.   Move (Buffer[Sect]^[(Index*ElemSize)-BuffLeft[Sect]],Buff,Size)
  390. End;
  391.  
  392. Procedure BufferedArray.Copy (Var From : BufferedArray);
  393. Var
  394.   Buff       : Ptr;
  395.   NumRead    : Word;
  396.   NumWritten : Word;
  397.   BuffSize   : Word;
  398.   I          : LongInt;
  399.   Sect       : Byte;
  400.  
  401. Begin
  402.   For Sect := 0 to 7 do
  403.     Begin
  404.       FlushBuff (From,Sect);
  405.       FreeMem (Buffer[Sect],BSize)
  406.     End;
  407.   {$I-}
  408.   If (DiskFree(0)+FileSize(F)) <= FileSize(From.F) Then Error (6,Name);
  409.   Reset (From.F,1);
  410.   If IOResult <> 0 Then Error (4,'');
  411.   Rewrite (F,1);
  412.   If IOResult <> 0 Then Error (5,Name);
  413.   {$I+}
  414.   I := From.NumElems * LongInt (From.ElSize);
  415.   If I < 65521 Then BuffSize := Word (I) Else BuffSize := 65521;
  416.   If BuffSize > MemAvail Then BuffSize := MemAvail;
  417.   If BuffSize = 0 Then Error (7,'');
  418.   GetMem (Buff,BuffSize);
  419.  
  420.   Repeat
  421.     BlockRead (From.F,Buff^,BuffSize,NumRead);
  422.     BlockWrite (F,Buff^,NumRead,NumWritten);
  423.   Until (NumRead = 0) or (NumWritten <> NumRead);
  424.  
  425.   FreeMem (Buff,BuffSize);
  426.   Reset (From.F,1);
  427.   Reset (F,1);
  428.  
  429.   ElSize := From.ElSize;
  430.   SSize := From.SSize;
  431.   NumElems := From.NumElems;
  432.   BSize := From.BSize;
  433.   BuffLeft := From.BuffLeft;
  434.   For Sect := 0 to 7 do
  435.     Begin
  436.       GetMem (Buffer[Sect],BSize);
  437.       LoadBuff (Self,Sect);
  438.     End
  439. End;
  440.  
  441. Procedure BufferedArray.Swap (I,J : LongInt);
  442. Var
  443.   T1,T2 : Ptr;
  444. Begin
  445.   GetMem (T1,ElSize);
  446.   GetMem (T2,ElSize);
  447.   If (T1=Nil) or (T2=Nil) Then Error (7,'');
  448.   Retrieve (T1^,I,ElSize);
  449.   Retrieve (T2^,J,ElSize);
  450.   Accept (T1^,J,ElSize);
  451.   Accept (T2^,I,ElSize);
  452.   FreeMem (T1,ElSize);
  453.   FreeMem (T2,ElSize)
  454. End;
  455.  
  456. {$F+}
  457. Function HeapErrorTrap (Size : Word) : Integer;
  458. Begin
  459.   HeapErrorTrap := 1  { New and GetMem return Nil if out_of_memory }
  460. End;
  461. {$F-}
  462.  
  463. BEGIN
  464.   HeapError := @HeapErrorTrap;
  465. END.
  466.