home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1991 / 07_08 / tricks / swap.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-02-25  |  6.4 KB  |  218 lines
  1. (* ------------------------------------------------------ *)
  2. (*                    SWAP.PAS                            *)
  3. (*  Das Modul erlaubt das Auslagern von dynamischen       *)
  4. (*  Variablen in eine Disketten-/Plattendatei.            *)
  5. (*         (c) 1991 Ralf Homburg & TOOLBOX                *)                                    }
  6. (* ------------------------------------------------------ *)
  7. {$I-}
  8. UNIT Swap;
  9.  
  10. INTERFACE
  11.  
  12. CONST
  13.   SwapFile = 'SwapFile';  { Name der Swapdatei. Kann be-   }
  14.                           { liebig gewählt werden.         }
  15.   SwapSign = -123454321;  { Kennung zur Unterscheidung von }
  16.                           { geswapten und nicht geswapten  }
  17.                           { Zeigern.                       }
  18.  
  19.   FUNCTION SwappedOut(VAR Ptr) : BOOLEAN;
  20.   { "Ptr" ist ein beliebiger Zeiger. SwappedOut gibt TRUE  }
  21.   { zurück, wenn der Inhalt des Zeigers mit SwapOut ausge- }
  22.   { lagert wurde. Die Funktion kann z.B. dazu genutzt wer- }
  23.   { den, um festzustellen, ob SwapIn bzw. SwapOut erfolg-  }
  24.   { reich waren.                                           }
  25.  
  26.   PROCEDURE SwapOut(VAR Ptr; Size : WORD);
  27.   { "Ptr" ist ein beliebiger Zeiger, der auf einen mit New }
  28.   { bzw. GETMEM zugewiesenen Speicherbereich von "Size"    }
  29.   { Bytes zeigt. SwapOut sichert den Inhalt des Zeigers in }
  30.   { die mit "SwapFile" festgelegte Swap-Datei. Der von     }
  31.   { "Ptr" belegte Heap wird freigegeben, sofern kein Da-   }
  32.   { teifehler beim Speichern aufgetreten ist, und der Zei- }
  33.   { ger "Ptr" wird auf eine zum Zurückladen des alten In-  }
  34.   { halts erforderliche Struktur verbogen.                 }
  35.   { Achtung! Der Zeiger darf bis zum Aufruf von SwapIn     }
  36.   { nicht mehr manipuliert werden!                         }
  37.  
  38.   PROCEDURE SwapIn(VAR Ptr);
  39.  { "Ptr" ist ein mit SwapOut geswappter Zeiger. SwapIn re- }
  40.  { stauriert die in der Swapdatei gespeicherten Daten des  }
  41.  { Zeigers. Dazu muß allerdings ausreichend Platz auf dem  }
  42.  { Heap vorhanden sein. Ansonsten wird der Aufruf von      }
  43.  { SwapIn ignoriert.                                       }
  44.  
  45.  
  46. IMPLEMENTATION
  47.  
  48. TYPE
  49.   BlockPtr = ^Block;
  50.   Block    =  RECORD
  51.                 Sign,
  52.                 FirstRec,
  53.                 LastRec  : LONGINT;
  54.                 Prev,
  55.                 Next     : BlockPtr;
  56.               END;
  57. VAR
  58.   OldExitProc : Pointer;
  59.   FirstFree,
  60.   LastFree,
  61.   FirstUsed,
  62.   LastUsed    : BlockPtr;
  63.   SFile       : FILE;
  64.  
  65.   PROCEDURE InsertBlock(VAR First, Last, Block : BlockPtr);
  66.   BEGIN
  67.     Block^.Next := NIL;
  68.     Block^.Prev := Last;
  69.     IF Last <> NIL THEN
  70.       Last^.Next := Block;
  71.     Last := Block;
  72.     IF First = NIL THEN
  73.       First := Block;
  74.   END;
  75.  
  76.   PROCEDURE RemoveBlock(VAR First, Last, Block : BlockPtr);
  77.   BEGIN
  78.     IF Block^.Prev <> NIL THEN
  79.       Block^.Prev^.Next := Block^.Next
  80.     ELSE
  81.       First := Block^.Next;
  82.     IF Block^.Next <> NIL THEN
  83.       Block^.Next^.Prev := Block^.Prev
  84.     ELSE
  85.       Last := Block^.Prev;
  86.   END;
  87.  
  88.   FUNCTION SwappedOut(VAR Ptr) : BOOLEAN;
  89.   VAR
  90.     Block : BlockPtr ABSOLUTE Ptr;
  91.   BEGIN
  92.     SwappedOut := (Block^.Sign = SwapSign);
  93.   END;
  94.  
  95.   FUNCTION GetFreeBlock(Size : WORD) : BlockPtr;
  96.   VAR
  97.     Block : BlockPtr;
  98.   BEGIN
  99.     Block := FirstFree;
  100.     WHILE (Block <> NIL) AND
  101.           (Block^.LastRec - Block^.FirstRec + 1 < Size) DO
  102.       Block := Block^.Next;
  103.     IF Block = NIL THEN BEGIN
  104.       New(Block);
  105.       Block^.FirstRec := FileSize(SFile);
  106.       Block^.LastRec := Block^.FirstRec + Size - 1;
  107.       InsertBlock(FirstFree, LastFree, Block);
  108.     END;
  109.     GetFreeBlock := Block;
  110.   END;
  111.  
  112.   PROCEDURE SetBlockFree(VAR Block : BlockPtr);
  113.   VAR
  114.     Search : BlockPtr;
  115.     Found  : BOOLEAN;
  116.   BEGIN
  117.     InsertBlock(FirstFree, LastFree, Block);
  118.     Search := FirstFree;
  119.     Found := FALSE;
  120.     WHILE (Search <> NIL) AND NOT(Found) DO BEGIN
  121.       IF Search^.FirstRec - 1 = Block^.LastRec THEN BEGIN
  122.         Search^.FirstRec := Block^.FirstRec;
  123.         RemoveBlock(FirstFree, LastFree, Block);
  124.         Dispose(Block);
  125.         Block := Search;
  126.         Found := TRUE;
  127.       END;
  128.       Search := Search^.Next;
  129.     END;
  130.     Search := FirstFree;
  131.     Found := FALSE;
  132.     WHILE (Search <> NIL) AND NOT(Found) DO BEGIN
  133.       IF Search^.LastRec + 1 = Block^.FirstRec THEN BEGIN
  134.         Search^.LastRec := Block^.LastRec;
  135.         RemoveBlock(FirstFree, LastFree, Block);
  136.         Dispose(Block);
  137.         Found := TRUE;
  138.       END;
  139.       Search := Search^.Next;
  140.     END;
  141.   END;
  142.  
  143.   PROCEDURE SwapOut(VAR Ptr; Size : WORD);
  144.   VAR
  145.     Data   : Pointer ABSOLUTE Ptr;
  146.     Block,
  147.     Free   : BlockPtr;
  148.     Result : WORD;
  149.   BEGIN
  150.     IF (Data <> NIL) AND NOT SwappedOut(Ptr) THEN BEGIN
  151.       Free := GetFreeBlock(Size);
  152.       Seek(SFile, Free^.FirstRec);
  153.       BlockWrite(SFile, Data^, Size, Result);
  154.       IF (IOResult = 0) AND (Result = Size) THEN BEGIN
  155.         New(Block);
  156.         Block^.Sign := SwapSign;
  157.         Block^.FirstRec := Free^.FirstRec;
  158.         Block^.LastRec := Block^.FirstRec + Size - 1;
  159.         InsertBlock(FirstUsed, LastUsed, Block);
  160.         FreeMem(Data, Size);
  161.         Data := Block;
  162.         IF Free^.LastRec > Block^.LastRec THEN
  163.           Free^.FirstRec := Block^.LastRec + 1
  164.         ELSE BEGIN
  165.           RemoveBlock(FirstFree, LastFree, Free);
  166.           Dispose(Free);
  167.         END;
  168.       END;
  169.     END;
  170.   END;
  171.  
  172.   PROCEDURE SwapIn(VAR Ptr);
  173.   VAR
  174.     Data   : Pointer;
  175.     Block  : BlockPtr ABSOLUTE Ptr;
  176.     Size,
  177.     Result : WORD;
  178.   BEGIN
  179.     Size := Block^.LastRec - Block^.FirstRec + 1;
  180.     IF (Block <> NIL) AND (SwappedOut(Ptr)) AND
  181.        (MaxAvail >= Size) THEN BEGIN
  182.       GetMem(Data, Size);
  183.       Seek(SFile, Block^.FirstRec);
  184.       BlockRead(SFile, Data^, Size, Result);
  185.       IF (IOResult = 0) AND (Result = Size) THEN BEGIN
  186.         RemoveBlock(FirstUsed, LastUsed, Block);
  187.         SetBlockFree(Block);
  188.         Pointer(Ptr) := Data;
  189.       END ELSE
  190.         FreeMem(Data, Size);
  191.     END;
  192.   END;
  193.  
  194. {$F+}
  195.   PROCEDURE NewExitProc;
  196.   BEGIN
  197.     ExitProc := OldExitProc;
  198.     Close(SFile);
  199.     Erase(SFile);
  200.   END;
  201. {$F-}
  202.  
  203. BEGIN
  204.   FirstFree   := NIL;
  205.   LastFree    := NIL;
  206.   FirstUsed   := NIL;
  207.   LastUsed    := NIL;
  208.   OldExitProc := ExitProc;
  209.   ExitProc    := @NewExitProc;
  210.   Assign(SFile, SwapFile);
  211.   Rewrite(SFile, 1);
  212.   IF IOResult <> 0 THEN Halt;
  213. END.
  214. (* ------------------------------------------------------ *)
  215. (*               Ende von SWAP.PAS                        *)
  216.  
  217.  
  218.