home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / qpdemo / beispiel / bigheap.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-07-21  |  7.6 KB  |  293 lines
  1. UNIT bigheap;
  2. {
  3.     BIGHEAP.PAS
  4.  
  5.     Neue Version von GetMem und FreeMem, um Speicherblöcke
  6.     zuzuweisen, die größer als 65520 Byte sind.
  7.  
  8.     Diese Routinen können benutzt werden, um Heap-Speicherblöcke
  9.     zu handhaben, die größer als die maximal erlaubten bei den
  10.     vordefinierten GetMem und FreeMem sind. Sie sind besonders
  11.     nützlich bei Grafik-Bildpuffern, die leicht 65520 Byte
  12.     überschreiten können.
  13. }
  14.  
  15. {===============================================================}
  16.         INTERFACE
  17. {===============================================================}
  18.  
  19.  
  20. VAR HeapError : Pointer;  { Prozedur für Heap-Fehler }
  21.  
  22. { Neue Blockversion der Heap-Handhabungsprozeduren }
  23. PROCEDURE GetMem ( VAR p : Pointer; nachfrage : LongInt );
  24. PROCEDURE FreeMem( VAR p : Pointer; groesse   : LongInt );
  25.  
  26. {===============================================================}
  27.         IMPLEMENTATION
  28. {===============================================================}
  29.  
  30.  
  31. TYPE
  32.     { Verschiedene Records werden benutzt, um auf die Segment- und
  33.       Offsetteile des Zeigers zuzugreifen
  34.     }
  35.     zeiger_rec = RECORD CASE Integer OF
  36.     1 : ( p : Pointer );
  37.     2 : ( w : RECORD
  38.         offset,
  39.         segment : Word
  40.         END
  41.         );
  42.     END;
  43.  
  44.     { Elemente der freien Liste }
  45.     frei_rec = RECORD
  46.     anfang, { zeigt zum Anfang des freien Blocks }
  47.     ende    { zeigt zum Ende des freien Blocks }
  48.         : Pointer;
  49.     END;
  50.  
  51.     frei_list  = ARRAY[0..8189] OF frei_rec;
  52.     zfrei_list = ^frei_list;
  53.  
  54.     { Typ der neuen Heap-Fehlerfunktion }
  55.     heap_fehlerfunktion      = FUNCTION( s : LongInt ) : Integer;
  56.  
  57.     { Typ der alten Heap-Fehlerfunktion }
  58.     alte_heap_fehlerfunktion = FUNCTION( s : Word    ) : Integer;
  59.  
  60. CONST
  61.     groesster_block = 65520;
  62.  
  63. {=============== anz_frei ====================================
  64.     gibt die Blockanzahl in der freien Liste zurück
  65. }
  66. FUNCTION anz_frei : Integer;
  67.     BEGIN
  68.     anz_frei := (8192 - Ofs(FreePtr^) DIV 8) MOD 8192;
  69.     END;
  70.  
  71.  
  72. {=============== veraend_form ======================================
  73.     ergibt die veränderte Form eines Zeigers
  74. }
  75. FUNCTION veraend_form( p : Pointer ) : LongInt;
  76.     VAR zwang : zeiger_rec;  { Record für Zeigerumwandlung }
  77.     BEGIN
  78.     zwang.p := p;
  79.     veraend_form := (LongInt(zwang.w.segment) SHL 4) + zwang.w.offset;
  80.     END;
  81.  
  82.  
  83. {=============== normal_form =====================================
  84.     ergibt die normale Form eines Zeigers
  85. }
  86. FUNCTION normal_form( p : Pointer ) : Pointer;
  87.     VAR zwang : zeiger_rec;  { Record für Zeigerumwandlung }
  88.     BEGIN
  89.     zwang.p := p;
  90.     zwang.w.segment := zwang.w.segment SHL 12 + (zwang.w.offset SHR 4);
  91.     zwang.w.offset := zwang.w.offset AND $f;
  92.     normal_form := zwang.p;
  93.     END;
  94.  
  95.  
  96. {=============== erh_normal ====================================
  97.     erhöht einen "normalen" Zeiger
  98. }
  99. PROCEDURE erh_normal( VAR p : Pointer; erhoehen : LongInt);
  100.     BEGIN
  101.     p := normal_form( Pointer(veraend_form(p) + erhoehen) );
  102.     END;
  103.  
  104.  
  105. {=============== diff_normal =================================
  106.     ergibt die Differenz zwischen den zwei "normalen" Zeigern
  107. }
  108. FUNCTION diff_normal( p1, p2 : Pointer ) : LongInt;
  109.     BEGIN
  110.     diff_normal := veraend_form(p1) - veraend_form(p2);
  111.     END;
  112.  
  113.  
  114. {=============== frei_blockgroesse ===============================
  115.     ergibt die Größe eines freien Blocks
  116. }
  117. FUNCTION frei_blockgroesse( block : frei_rec ) : LongInt;
  118.     BEGIN
  119.     frei_blockgroesse := diff_normal( block.ende, block.anfang);
  120.     END;
  121.  
  122.  
  123. {=============== block_entfernen ==================================
  124.     entfernt einen Block von der freien Liste
  125. }
  126. PROCEDURE block_entfernen( VAR block : frei_rec );
  127.     TYPE
  128.     union = RECORD CASE Integer OF
  129.         1 : ( p   : Pointer );
  130.         2 : ( fl_zgr : zfrei_list );
  131.         3 : ( w   : RECORD offset, segment : Word END );
  132.         END;
  133.     VAR zwang : union;  { Record für Zeigerumwandlung }
  134.     BEGIN
  135.     zwang.p  := FreePtr;
  136.     block   := zwang.fl_zgr^[0];
  137.     FreePtr := Ptr( zwang.w.segment, zwang.w.offset + SizeOf(frei_rec) );
  138.     END;
  139.  
  140.  
  141. {=============== pool_groesse =====================================
  142.     ergibt die Größe des freien Pools
  143. }
  144. FUNCTION pool_groesse : LongInt;
  145.     VAR zwang : zeiger_rec;  { Record für Zeigerumwandlung }
  146.     BEGIN
  147.     zwang.p := FreePtr;
  148.     IF (zwang.w.offset = 0) THEN Inc( zwang.w.segment, $1000 );
  149.     pool_groesse := diff_normal( zwang.p, HeapPtr );
  150.     END;
  151.  
  152.  
  153. {=============== FAR-Heapfunktionen ============================}
  154.  
  155. {$F+}
  156.  
  157. {=============== heap_funktion =================================
  158.     Neue Vorgabe-Funktion für HeapErr
  159.     0 bedeutet Abbruch mit Laufzeit-Fehler 203
  160. }
  161. FUNCTION heap_funktion( groesse : LongInt ) : Integer;
  162.     BEGIN
  163.     heap_funktion := 0;
  164.     END;
  165.  
  166. {=============== kleine_heap_funktion ===========================
  167.     ersetzt alte HeapErr-Funkion
  168.     ruft die neue Heapfehler-Funktion auf (oder die vom Benutzer
  169.     bestimmte Ersetzungsfunktion)
  170.     HINWEIS: benutzt einen Typzwang um die Funktion in der
  171.              HeapError-Globalvariablen aufzurufen
  172. }
  173. FUNCTION kleine_heap_funktion( groesse : Word ) : Integer;
  174.     BEGIN
  175.     kleine_heap_funktion := heap_fehlerfunktion(HeapError)(groesse);
  176.     END;
  177.  
  178. {$F-}
  179. {=============== Ende der FAR-Heapfunktionen =====================}
  180.  
  181.  
  182.  
  183. {=============== GetMem ========================================
  184.     längere Version von GetMem
  185. }
  186. PROCEDURE GetMem( VAR p : Pointer; nachfrage : LongInt);
  187.     LABEL
  188.     Nochmals, Schneiden;
  189.     VAR
  190.     fl_zgr             : zfrei_list;
  191.     letzter_Block, anz : Integer;
  192.     aktion             : Integer;
  193.     BEGIN
  194.     { Normale Heaproutinen benutzen, falls Nachfrage klein ist }
  195.     IF (nachfrage <= groesster_block) THEN
  196.     BEGIN
  197.     System.GetMem( p, Word(nachfrage) );
  198.     Exit;
  199.     END;
  200.  
  201.     { Auf Eingang in freie Liste prüfen, die groß genug für den
  202.       Block ist
  203.     }
  204. Nochmals:
  205.     letzter_Block := anz_frei;
  206.     IF (letzter_Block = 0) THEN  { keine freien Blöcke }
  207.     GOTO Schneiden;
  208.  
  209.     fl_zgr := FreePtr;
  210.     FOR anz := 0 TO letzter_Block - 1 DO
  211.     IF (frei_blockgroesse( fl_zgr^[anz] ) >= nachfrage) THEN
  212.         BEGIN
  213.  
  214.         { Block gefunden, in zwei Blöcke teilen }
  215.         p := fl_zgr^[anz].anfang;
  216.  
  217.         { Startzeiger einstellen }
  218.         erh_normal( fl_zgr^[anz].anfang, nachfrage );
  219.  
  220.         { der Block fällt aus der freien Liste, falls
  221.           nichts übrig ist
  222.         }
  223.         IF (frei_blockgroesse( fl_zgr^[anz] ) = 0) THEN
  224.         block_entfernen( fl_zgr^[anz] );
  225.         { fertig }
  226.         Exit;
  227.         END;
  228.  
  229.     { Hier sind keine Blöcke der freien Liste groß genug.
  230.       Sie müssen aus dem Pool "herausgeschnitten" werden.
  231.     }
  232. Schneiden:
  233.     { Genug Speicher im Pool? }
  234.     IF (pool_groesse < nachfrage + FreeMin) THEN
  235.     BEGIN
  236.     { Nicht genug Speicher, HeapError-Funktion aufrufen
  237.       Typzwang benutzen, um indirekten Aufruf durch die
  238.       globale HeapError Zeigervariable zu machen.
  239.     }
  240.     aktion := heap_fehlerfunktion(HeapError)( nachfrage );
  241.     CASE aktion OF
  242.         1 :    { NIL-Zeiger zu Programm zurückgeben }
  243.         BEGIN
  244.         p := NIL;
  245.         Exit;
  246.         END;
  247.         2 :    { Zuweisung wiederholen }
  248.         GOTO Nochmals;
  249.         ELSE   { Heapüberlauf-Laufzeitfehler erstellen }
  250.         RunError( 203 );
  251.         END;
  252.     END;
  253.  
  254.     { Es ist nun genug Speicher vorhanden }
  255.     p := HeapPtr;
  256.     erh_normal( HeapPtr, nachfrage );
  257.     END;
  258.  
  259.  
  260. {=============== FreeMem ======================================
  261.     längere Version von FreeMem
  262. }
  263. PROCEDURE FreeMem( VAR p : Pointer; groesse : LongInt);
  264.     LABEL
  265.     Wiederholen;
  266.  
  267.     BEGIN
  268. Wiederholen:
  269.     IF (groesse <= groesster_block) THEN
  270.     BEGIN
  271.     System.FreeMem( p, Word(groesse) );
  272.     Exit;
  273.     END;
  274.     System.FreeMem( p, groesster_block );
  275.     erh_normal( p, groesster_block );
  276.     Dec( groesse, groesster_block );
  277.     GOTO Wiederholen;
  278.     END;
  279.  
  280.  
  281.  
  282. {=============== unit INITIALISATION ==========================}
  283. BEGIN
  284. HeapError := @heap_funktion;
  285. System.HeapError := @kleine_heap_funktion;
  286.  
  287. { FreeMin anpassen, um Platz für FreeList zu schaffen, wenn die
  288.   großen Blöcke zurückzugewiesen werden. (für 3 Eingänge der
  289.   freien Liste
  290. }
  291. Inc( System.FreeMin, 3 * SizeOf( frei_rec ) );
  292. END.
  293.