home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / BUFFRA.ZIP / BUFFARAY.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-01-09  |  13.5 KB  |  460 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. Procedure Error (Num : Byte; Name : String);
  99. Begin
  100.   WriteLn;
  101.   Write ('BufferedArray ERROR: ');
  102.   Case Num of
  103.             0 : WriteLn ('Insufficient Free Disk Space for Requested BufferedArray.');
  104.             1 : WriteLn ('Unable to Open File ',Name);
  105.             2 : WriteLn ('Attempted to Access with wrong size Element.');
  106.             3 : WriteLn ('***** INDEX OUT OF BOUNDS *****');
  107.             4 : WriteLn ('Attempted to Copy from Un-Initialized BufferedArray.');
  108.             5 : WriteLn ('Attempted to Copy to Un-Initialized BufferedArray: ',Name);
  109.             6 : WriteLn ('Insufficient Free Disk Space for Requested Copy Operation.');
  110.             7 : WriteLn ('Insufficient Memory for Requested Operation.');
  111.             8 : WriteLn ('Attempted to Open File beyond DOS Size Limit of ',MaximumSize,' Bytes');
  112.             9 : WriteLn ('**** Unable to Allocate Buffer for ',Name,' ****');
  113.            10 : WriteLn ('**** BufferSize Too Small or Insufficient Memory ****');
  114.            11 : WriteLn ('**** Attempted to Load file using wrong ElementSize ****');
  115.            12 : WriteLn ('**** Attempted to Load into Initialized (or Loaded) BufferedArray ****');
  116.           End;
  117.   WriteLn ('**** PROGRAM TERMINATED ****');
  118.   WriteLn;
  119.   Write ('Press <Return> to Continue.... ');
  120.   ReadLn;
  121.   HALT (0)
  122. End;
  123.  
  124. Function InBuff (V : BufferedArray; Index : LongInt; Buff : Byte) : Boolean;
  125. Begin
  126.   If (Index*V.ElemSize >= V.BuffLeft[Buff]) and
  127.      (Index*V.ElemSize < (V.BuffLeft[Buff] + V.BSize))
  128.     Then InBuff := True
  129.   Else InBuff := False
  130. End;
  131.  
  132. Procedure FlushBuff (Var V : BufferedArray; Buff : Byte);
  133. Begin
  134.   Seek (V.F,V.BuffLeft[Buff]);
  135.   BlockWrite (V.F,V.Buffer[Buff]^,V.BSize)
  136. End;
  137.  
  138. Procedure LoadBuff (Var V : BufferedArray; Buff : Byte);
  139. Begin
  140.   Seek (V.F,V.BuffLeft[Buff]);
  141.   BlockRead (V.F,V.Buffer[Buff]^,V.BSize)
  142. End;
  143.  
  144. Procedure MoveBuff (Var V : BufferedArray; Index : LongInt; Buff : Byte);
  145. Var
  146.   Base : LongInt;
  147. Begin
  148.   If V.UpDate[Buff] Then
  149.     Begin
  150.       FlushBuff (V,Buff);
  151.       V.UpDate[Buff] := False
  152.     End;
  153.  
  154.   Base := ((Index*V.ElemSize) - (V.BSize Div 2));
  155.   Base := Base - (Base Mod V.ElemSize);
  156.  
  157.   If Buff = 7
  158.     Then
  159.       If (Base+V.BSize) >= V.NumElems * V.ElemSize
  160.         Then
  161.           Base := (V.NumElems * V.ElemSize) - V.BSize;
  162.  
  163.   If Buff < 7
  164.     Then
  165.       If (Base+V.BSize) >= V.SSize*(Buff+1)
  166.         Then
  167.           Base := (LongInt(Buff+1)*V.SSize) - V.BSize;
  168.  
  169.   If Base < V.SSize*Buff
  170.     Then
  171.       Base := V.SSize*Buff;
  172.  
  173.   V.BuffLeft[Buff] := Base;
  174.  
  175.   LoadBuff (V,Buff)
  176. End;
  177.  
  178. Function Sector (V : BufferedArray; Index : LongInt) : Byte;
  179. Var
  180.   I    : Integer;
  181.   Test : LongInt;
  182.   Temp : LongInt;
  183. Begin
  184.   I := -1;
  185.   Test := 0;
  186.   Temp := (LongInt(V.ElemSize))*Index;
  187.  
  188.   While Test <= Temp do
  189.     Begin
  190.       I := I + 1;
  191.       Test := Test+V.SSize
  192.     End;
  193.  
  194.   If I > 7 Then I := 7;
  195.   Sector := Byte (I)
  196. End;
  197.  
  198. Procedure BufferedArray.Create;
  199. Var
  200.   I : Byte;
  201. Begin
  202.   ElSize := 0;
  203.   NumElems := 0;
  204.   For I := 0 to 7 do BuffLeft[I] := 0;
  205.   BSize := 0;
  206.   For I := 0 to 7 do UpDate[I] := False;
  207.   Name := '';
  208. End;
  209.  
  210. Procedure BufferedArray.Init (NumElements : LongInt; ElementSize : Word;
  211.                               MaxBuffSize : LongInt; FileName : String);
  212. Var
  213.   I,J       : LongInt;
  214.   Buff      : Ptr;
  215.   K,L       : Word;
  216.   BuffSize  : Word;
  217.   Buffers   : Byte;
  218.  
  219. Begin
  220.   Name := FileName;
  221.   I := NumElements * LongInt (ElementSize);
  222.  
  223.   If I > MaximumSize Then Error (8,'');
  224.  
  225.   If I > DiskFree(0) Then Error (0,'');
  226.  
  227.   If MaxBuffSize = 0 Then MaxBuffSize := MemAvail-1000;
  228.  
  229.   Assign (F,Name);
  230.   {$I-} Rewrite (F,1); {$I+}
  231.   If IOResult <> 0 Then
  232.     Error (1,Name);
  233.  
  234.   If I < 65521 Then BuffSize := Word (I) Else BuffSize := 65521;
  235.   If BuffSize > MemAvail Then BuffSize := MemAvail;
  236.   If BuffSize = 0 Then Error (7,'');
  237.  
  238.   K := I Div BuffSize;
  239.   GetMem (Buff,BuffSize);
  240.   For L := 0 to BuffSize-1 do Buff^[L] := 0;
  241.   L := I-(LongInt(K) * BuffSize);
  242.  
  243.   If I >= BuffSize
  244.     Then
  245.       For J := 0 to K-1 do BlockWrite (F,Buff^,BuffSize);
  246.  
  247.   If L > 0 Then BlockWrite (F,Buff^,L);
  248.  
  249.   Reset (F,1);
  250.   FreeMem (Buff,BuffSize);
  251.   If Buff = Nil Then Error (9,Name);
  252.  
  253.   BSize := ((MaxBuffSize Div 8) Div ElementSize) * ElementSize;
  254.  
  255.   If BSize > 65521
  256.     Then
  257.       BSize := (65521 Div ElementSize) * ElementSize;
  258.  
  259.   If (LongInt(BSize) * 8) > (NumElements*LongInt(ElementSize))
  260.     Then BSize := (NumElements*ElementSize);
  261.  
  262.   If BSize = 0 Then Error(10,'');
  263.   SSize := (NumElements*LongInt(ElementSize)) Div 8;
  264.   SSize := SSize - (SSize Mod ElementSize);
  265.   If BSize > SSize Then BSize := SSize;
  266.  
  267.   For Buffers := 0 to 7 do
  268.     Begin
  269.       BuffLeft[Buffers] := Buffers*SSize;
  270.       GetMem (Buffer[Buffers],BSize)
  271.     End;
  272.   BuffLeft[8] := (NumElements*LongInt(ElementSize))-1;
  273.  
  274.   NumElems := NumElements;
  275.   ElSize := ElementSize;
  276.   For Buffers := 0 to 7 do LoadBuff (Self,Buffers)
  277. End;
  278.  
  279. Procedure BufferedArray.Destroy;
  280. Var
  281.   I : Byte;
  282. Begin
  283.   Close (F);
  284.   Erase (F);
  285.   For I := 0 to 7 do
  286.     FreeMem (Buffer[I],BSize);
  287.   Create;
  288. End;
  289.  
  290. Procedure BufferedArray.Store;
  291. Var
  292.   I : Byte;
  293. Begin
  294.   For I := 0 to 7 do FlushBuff (Self,I);
  295.   Close (F);
  296.   For I := 0 to 7 do
  297.     FreeMem (Buffer[I],BSize);
  298.   Create
  299. End;
  300.  
  301. Procedure BufferedArray.Load (FileName : String; ElementSize : Word;
  302.                               MaxBuffSize : LongInt);
  303. Var
  304.   I           : LongInt;
  305.   Buffers     : Byte;
  306.  
  307. Begin
  308.   If Name <> '' Then Error (12,'');
  309.   Name := FileName;
  310.  
  311.   Assign (F,Name);
  312.   {$I-} ReSet (F,1); {$I+}
  313.   If IOResult <> 0 Then
  314.     Error (1,Name);
  315.  
  316.   I := FileSize (F);
  317.   NumElems := I Div ElementSize;
  318.  
  319.   If NumElems*ElementSize <> I Then Error (11,Name);
  320.  
  321.   BSize := ((MaxBuffSize Div 8) Div ElementSize) * ElementSize;
  322.  
  323.   If (BSize = 0) or (BSize > 65521)
  324.     Then
  325.       BSize := (65521 Div ElementSize) * ElementSize;
  326.   If (LongInt(BSize) * 8) > (NumElems*LongInt(ElementSize))
  327.     Then BSize := (NumElems*ElementSize);
  328.   While BSize*8 > MemAvail do BSize := BSize - ElementSize;
  329.   If BSize = 0 Then Error(10,'');
  330.   SSize := (NumElems*LongInt(ElementSize)) Div 8;
  331.   SSize := SSize - (SSize Mod ElementSize);
  332.   If BSize > SSize Then BSize := SSize;
  333.  
  334.   For Buffers := 0 to 7 do
  335.     Begin
  336.       BuffLeft[Buffers] := Buffers*SSize;
  337.       GetMem (Buffer[Buffers],BSize)
  338.     End;
  339.   BuffLeft[8] := (NumElems*LongInt(ElementSize))-1;
  340.  
  341.   ElSize := ElementSize;
  342.   For Buffers := 0 to 7 do LoadBuff (Self,Buffers)
  343. End;
  344.  
  345. Function BufferedArray.MaxSize : LongInt;
  346. Begin
  347.   MaxSize := NumElems
  348. End;
  349.  
  350. Function BufferedArray.ElemSize : Word;
  351. Begin
  352.   ElemSize := ElSize
  353. End;
  354.  
  355. Procedure BufferedArray.Accept (Var El; Index : LongInt; Size : Word);
  356. Var
  357.   Buff : Flex Absolute El;
  358.   Sect : Byte;
  359. Begin
  360.   Sect := Sector (Self,Index);
  361.   If Size <> ElSize Then Error (2,'');
  362.   If (Index >= NumElems) or (Index < 0) Then Error (3,'');
  363.  
  364.   If Not InBuff (Self,Index,Sect)
  365.     Then
  366.       MoveBuff (Self,Index,Sect);
  367.   Move (Buff,Buffer[Sect]^[(Index*ElemSize)-BuffLeft[Sect]],Size);
  368.   UpDate[Sect] := True
  369. End;
  370.  
  371. Procedure BufferedArray.Retrieve (Var El; Index : LongInt; Size : Word);
  372. Var
  373.   Buff : Flex Absolute El;
  374.   Sect : Byte;
  375. Begin
  376.   Sect := Sector (Self,Index);
  377.   If Size <> ElSize Then Error (2,'');
  378.   If (Index >= NumElems) or (Index < 0) Then Error (3,'');
  379.  
  380.   If Not InBuff (Self,Index,Sect)
  381.     Then
  382.       MoveBuff (Self,Index,Sect);
  383.   Move (Buffer[Sect]^[(Index*ElemSize)-BuffLeft[Sect]],Buff,Size)
  384. End;
  385.  
  386. Procedure BufferedArray.Copy (Var From : BufferedArray);
  387. Var
  388.   Buff       : Ptr;
  389.   NumRead    : Word;
  390.   NumWritten : Word;
  391.   BuffSize   : Word;
  392.   I          : LongInt;
  393.   Sect       : Byte;
  394.  
  395. Begin
  396.   For Sect := 0 to 7 do
  397.     Begin
  398.       FlushBuff (From,Sect);
  399.       FreeMem (Buffer[Sect],BSize)
  400.     End;
  401.   {$I-}
  402.   If (DiskFree(0)+FileSize(F)) <= FileSize(From.F) Then Error (6,Name);
  403.   Reset (From.F,1);
  404.   If IOResult <> 0 Then Error (4,'');
  405.   Rewrite (F,1);
  406.   If IOResult <> 0 Then Error (5,Name);
  407.   {$I+}
  408.   I := From.NumElems * LongInt (From.ElSize);
  409.   If I < 65521 Then BuffSize := Word (I) Else BuffSize := 65521;
  410.   If BuffSize > MemAvail Then BuffSize := MemAvail;
  411.   If BuffSize = 0 Then Error (7,'');
  412.   GetMem (Buff,BuffSize);
  413.  
  414.   Repeat
  415.     BlockRead (From.F,Buff^,BuffSize,NumRead);
  416.     BlockWrite (F,Buff^,NumRead,NumWritten);
  417.   Until (NumRead = 0) or (NumWritten <> NumRead);
  418.  
  419.   FreeMem (Buff,BuffSize);
  420.   Reset (From.F,1);
  421.   Reset (F,1);
  422.  
  423.   ElSize := From.ElSize;
  424.   SSize := From.SSize;
  425.   NumElems := From.NumElems;
  426.   BSize := From.BSize;
  427.   BuffLeft := From.BuffLeft;
  428.   For Sect := 0 to 7 do
  429.     Begin
  430.       GetMem (Buffer[Sect],BSize);
  431.       LoadBuff (Self,Sect);
  432.     End
  433. End;
  434.  
  435. Procedure BufferedArray.Swap (I,J : LongInt);
  436. Var
  437.   T1,T2 : Ptr;
  438. Begin
  439.   GetMem (T1,ElSize);
  440.   GetMem (T2,ElSize);
  441.   If (T1=Nil) or (T2=Nil) Then Error (7,'');
  442.   Retrieve (T1^,I,ElSize);
  443.   Retrieve (T2^,J,ElSize);
  444.   Accept (T1^,J,ElSize);
  445.   Accept (T2^,I,ElSize);
  446.   FreeMem (T1,ElSize);
  447.   FreeMem (T2,ElSize)
  448. End;
  449.  
  450. {$F+}
  451. Function HeapErrorTrap (Size : Word) : Integer;
  452. Begin
  453.   HeapErrorTrap := 1  { New and GetMem return Nil if out_of_memory }
  454. End;
  455. {$F-}
  456.  
  457. BEGIN
  458.   HeapError := @HeapErrorTrap;
  459. END.
  460.