home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / dtx9101 / xheap / memtest.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-09-13  |  9.6 KB  |  294 lines

  1. (* ------------------------------------------------------ *)
  2. (*                      MEMTEST.PAS                       *)
  3. (* Dieses ist KEINE Super-Demo, sondern nur ein Testprg.  *)
  4. (* Dieses Program zeigt, wie man die UNIT XHeap anwendet. *)
  5. (* Es zeigt graphisch die 64K-Blöcke und die Loch-        *)
  6. (* listenverwaltung. Es wird ein zufällig-großes Stück    *)
  7. (* Speicher angefordert und wieder freigegeben.           *)
  8. (* Man kann mit Tastendruck den Test abbrechen, wobei zum *)
  9. (* Schluß ein sauber aufgeräumter Speicher übrigbleiben   *)
  10. (* wird (oder soll).                                      *)
  11. (*                                                        *)
  12. (*     (c) 1991 Dipl.Ing. O. Grossklaus & DMV-Verlag      *)
  13. (* ------------------------------------------------------ *)
  14. {$M 16384,0,655360}
  15. {$A-,B-,D+,E-,F-,I-,L+,N-,O-,R+,S+}
  16.  
  17. PROGRAM MemTest;
  18.  
  19. USES
  20.   Graph, XHeap, Crt, Dos;
  21.  
  22. CONST
  23.   MaxE        = 7500;     { Maximale Anzahl der zu belegenden XZeiger }
  24.   MaxTakeSize = 2500;     { Maximalgröße einer Anforderung            }
  25.  
  26.   ID : ARRAY [BlockType] OF STRING [3] = ('EMS', 'HDD');
  27.  
  28. TYPE
  29.   BufferPtr   = ^Buffer;
  30.   Buffer      = ARRAY [1..1000] of CHAR;
  31.   LinePtrType = RECORD
  32.                   Ptr    : BufferPtr;        { jeder beliebige Typ       }
  33.                   PageNr : WORD;             { Blocknummer des Speichers }
  34.                 END;
  35.   LineSize    = RECORD
  36.                   XPtr : LinePtrType;                          { XZeiger }
  37.                   Size : WORD;            { Größe der Anforderung merken }
  38.                 END;
  39.  
  40. VAR
  41.   MaxY       : INTEGER;
  42.   f          : TEXT;
  43.   i          : WORD;
  44.   Max        : WORD;
  45.   Size       : WORD;
  46.                       { Alle Zeiger werden hier für den Test gespeichert }
  47.   DemoPtrs   : ARRAY [1..MaxE] OF LineSize;
  48.   AbsMaxLLEs : WORD;
  49.  
  50.  
  51.   PROCEDURE ShowEms;
  52.     (* den aktuellen Stand des aktuellen 64K-Blocks zeigen *)
  53.   VAR
  54.     M     : REAL;
  55.     i     : BYTE;
  56.     Block : BYTE;
  57.  
  58.     PROCEDURE ShowBlock;
  59.       (* den Block selbst zeigen *)
  60.     VAR
  61.       X1, Y1,
  62.       X2, Y2  : INTEGER;
  63.       LLCount : WORD;
  64.     BEGIN
  65.       X1 := Pred(Descriptor^.BlockNr) * 40;
  66.       X2 := X1 + 30;
  67.                                   { Platz für den Descriptor }
  68.       Y1 := MaxY;
  69.       Y2 := MaxY - Round(SizeOf(Descriptor^) * M);
  70.       SetFillStyle(SolidFill, Yellow);
  71.       Bar(X1, Y1, X2, Y2);
  72.                          { Platz für die LochListe (benutzt) }
  73.       LLCount := 1;
  74.       WHILE LochListe^[LLCount].Size <> 0 DO
  75.         INC(LLCount);
  76.       Y1 := Y2 - 1;
  77.       Y2 := MaxY - Round(SizeOf(Descriptor^) * M) -
  78.                    Round(4 * LLCount * M);
  79.       IF Y2 > Y1 THEN
  80.         Y2 := Pred(Y1);
  81.       SetFillStyle(SolidFill, DarkGray);
  82.       Bar(X1, Y1, X2, Y2);
  83.                        { Platz für die LochListe (unbenutzt) }
  84.       Y1 := Y2 - 1;
  85.       Y2 := MaxY - Round(SizeOf(Descriptor^) * M) -
  86.                    Round(4 * MaxLLEntrys * M);
  87.       SetFillStyle(SolidFill, LightGray);
  88.       Bar(X1, Y1, X2, Y2);
  89.                                      { alles erstmal besetzt }
  90.       Y1 := Y2 - 1;
  91.       Y2 := 0;
  92.       SetFillStyle(SolidFill, Red);
  93.       Bar(X1, Y1, X2, Y2);
  94.                                          { Zeige alle Löcher }
  95.       IF Descriptor^.Typ = EMSType THEN
  96.         SetFillStyle(SolidFill, Green)
  97.       ELSE
  98.         SetFillStyle(SolidFill, White);
  99.       LLCount := 1;
  100.       WHILE LochListe^[LLCount].Size > 0 DO BEGIN
  101.         X2 := X1 + 30;
  102.         WITH LochListe^[LLCount] DO BEGIN
  103.           Y1 := MaxY - Round(Offset * M);
  104.           Y2 := MaxY - Round((Offset + Size) * M);
  105.         END;
  106.         Bar(X1, Y1, X2, Y2);
  107.         INC(LLCount);
  108.       END;
  109.       LLCount := 0;
  110.       REPEAT
  111.         INC(LLCount);
  112.       UNTIL LochListe^[LLCount].Size = 0;
  113.       DEC(LLCount);
  114.       IF LLCount > AbsMaxLLEs THEN
  115.         AbsMaxLLEs := LLCount;
  116.     END;
  117.  
  118.     PROCEDURE ShowWindow;
  119.       (* Zusatzinformationen anzeigen *)
  120.     CONST
  121.       Rect : ARRAY[1..4] of PointType =
  122.              ((X :  1; Y :  1),
  123.               (X : 69; Y :  1),
  124.               (X : 69; Y : 75),
  125.               (X :  1; Y : 75));
  126.     VAR
  127.       Dummy : STRING;
  128.     BEGIN
  129.       IF (Descriptor^.BlockNr < 3) THEN
  130.         Exit;
  131.       SetColor(Black);
  132.       SetFillStyle(SolidFill, Black);
  133.       FillPoly(SizeOf(Rect) div SizeOf(PointType), Rect);
  134.       SetColor(White);
  135.       WITH Descriptor^ DO
  136.         OutTextXY(3, 3, 'Blk:' + ID[Typ]);        { Blocktyp }
  137.       Str(Size, Dummy);
  138.       OutTextXY(3, 11, 'Sze:' + Dummy);{ letzte angef. Größe }
  139.       Str(EMSBlocks, Dummy);
  140.       OutTextXY(3, 19, 'EMS:' + Dummy);  { Anzahl EMS-Blöcke }
  141.       Str(FileBlocks, Dummy);
  142.       OutTextXY(3, 27, 'HDD:' + Dummy); { Anzahl File-Blöcke }
  143.       Str(Max, Dummy);
  144.       OutTextXY(3, 35, 'Max:' + Dummy);    { Benutze XZeiger }
  145.       Str(AbsMaxLLEs, Dummy);
  146.       OutTextXY(3, 43, 'LLE:' + Dummy);{ Anzahl Locheinträge }
  147.       Str(Descriptor^.BlockNr, Dummy);
  148.       OutTextXY(3, 51, 'BNr:' + Dummy);        { Blocknummer }
  149.       Str(Descriptor^.BlkUsed, Dummy);
  150.       OutTextXY(3, 59, 'BLu:' + Dummy); { Anzahl Benutzungen }
  151.       Str(Descriptor^.AnzPtr, Dummy);
  152.       OutTextXY(3, 67, 'Apt:' + Dummy);      { Anzahl Zeiger }
  153.     END;
  154.  
  155.   BEGIN                     { mehr geht nicht auf den Screen }
  156.     M := MaxY / 65535;                     { Skalierungsfaktor }
  157.     IF Descriptor^.BlockNr < 17 THEN
  158.       ShowBlock;
  159.     ShowWindow;
  160.   END;
  161.  
  162.   PROCEDURE Init;
  163.     (* Graphik initialisieren (ohne viel TAM-TAM) *)
  164.   VAR
  165.     GD, GM : INTEGER;
  166.   BEGIN
  167.     GD := Detect;
  168.     InitGraph(GD, GM, '');
  169.   END;
  170.  
  171.   FUNCTION LLCheck : BOOLEAN;
  172.     (* Lochlisteneinträge auf Korrektheit überprüfen *)
  173.   VAR
  174.     LLCount : WORD;
  175.     Dummy   : BOOLEAN;
  176.   BEGIN
  177.     Dummy := TRUE;
  178.     { Erster Eintr.beinhaltet die Gesamtmenge freien Speichers }
  179.     IF (LochListe^[1].Size <>
  180.        (SwapBufferSize-(SizeOf(DescType)+SizeOf(LochLst)))) OR
  181.        (LochListe^[1].Offset <>
  182.        (SizeOf(DescType) + SizeOf(LochLst))) THEN BEGIN
  183.       Writeln(f,#13,#10,'    1 Size : ',
  184.               LochListe^[1].Size:6,
  185.               ' Offset : ',
  186.               LochListe^[1].Offset);
  187.       Writeln(#13,#10,'    1 Size : ',
  188.               LochListe^[1].Size:6,
  189.               ' Offset : ',
  190.               LochListe^[1].Offset);
  191.       Dummy := FALSE;
  192.     END;
  193.                    { alle anderen Locheinträge müssen 0 sein }
  194.     FOR LLCount := 2 TO MaxLLEntrys DO
  195.       IF (LochListe^[LLCount].Size <> 0) OR
  196.          (LochListe^[LLCount].Offset <> 0) THEN BEGIN
  197.         Writeln(f,LLCount:5,
  198.                 ' Size : ',
  199.                 LochListe^[1].Size:6,
  200.                 ' Offset : ',
  201.                 LochListe^[1].Offset);
  202.         Writeln(LLCount:5,
  203.                 ' Size : ',
  204.                 LochListe^[1].Size:6,
  205.                 ' Offset : ',
  206.                 LochListe^[1].Offset);
  207.         Dummy := FALSE;
  208.       END;
  209.     LLCheck := Dummy;
  210.   END;
  211.  
  212.  
  213. BEGIN
  214.   AbsMaxLLEs := 0;              { Gesamtzahl der benutzten Locheinträge }
  215.   ClrScr;
  216.   Randomize;
  217.   Init;                                         { Graphik bereitstellen }
  218.   MaxY := GetMaxY;
  219.   I    := 1;
  220.   Max  := 0;
  221.  
  222.                                        { XZeiger auf NIL initialisieren }
  223.   FillChar(DemoPtrs, SizeOf(DemoPtrs), #0);
  224.   Size := 1 + Random(MaxTakeSize);
  225.  
  226.                                                 { Belegen des Speichers }
  227.   WHILE MemAvailX(Size) AND
  228.         (NOT KeyPressed) AND
  229.         (I <= MaxE) DO BEGIN
  230.     GetMemX(DemoPtrs[I].XPtr, Size);
  231.     DemoPtrs[I].Size := Size;
  232.     ShowEms;               { Zeige den EMS/HDD-Zustand des akt. Blockes }
  233.     Inc(I);
  234.     Inc(Max);
  235.     Size := 1 + Random(MaxTakeSize);
  236.   END;
  237.  
  238.                { Freigeben und Neubelegen einzelner beliebiger Speicher }
  239.   WHILE NOT KeyPressed DO BEGIN
  240.     I := Random(Max) + 1;
  241.     IF DemoPtrs[I].XPtr.Ptr <> NIL THEN
  242.       FreeMemX(DemoPtrs[I].XPtr, DemoPtrs[I].Size);
  243.     Size := 1 + Random(MaxTakeSize);
  244.     IF MemAvailX(Size) THEN BEGIN
  245.       GetMemX(DemoPtrs[I].XPtr, Size);
  246.       DemoPtrs[I].Size := Size;
  247.     END;
  248.     ShowEms;
  249.   END;
  250.                                    { Freigeben aller Speicherstückchen }
  251.   FOR I := 1 TO Max DO BEGIN
  252.     IF DemoPtrs[I].XPtr.Ptr <> NIL THEN
  253.       FreeMemX(DemoPtrs[I].XPtr, DemoPtrs[I].Size);
  254.     ShowEms;
  255.   END;
  256.   Delay(3000);
  257.   CloseGraph;
  258.  
  259.               { Prüfroutinen, ob die Verwaltung korrekt gearbeitet hat }
  260.   Assign(f,'Logbuch.txt');
  261.   Rewrite(f);
  262.   FOR I := 1 TO (EMSBlocks + FileBlocks) DO BEGIN
  263.     BlendeBlockEin(I);
  264.     WITH Descriptor^ DO BEGIN
  265.       Write(f,'Block ',
  266.              BlockNr:3,
  267.              ' (',
  268.              ID[Typ],
  269.              ') ',
  270.              AnzPtr :3,                 { Muß zum Schluß immer 0 sein }
  271.              ' ',
  272.              BlkUsed :6 );                                { Statistik }
  273.       Write('Block ',
  274.              BlockNr:3,
  275.              ' (',
  276.              ID[Typ],
  277.              ') ',
  278.              AnzPtr :3,                 { Muß zum Schluß immer 0 sein }
  279.              ' ',
  280.              BlkUsed :6 );                                { Statistik }
  281.     END;
  282.     IF LLCheck THEN BEGIN
  283.       WriteLn(f, '  LL OK');        { Verwaltung der Blk hat geklappt }
  284.       WriteLn(   '  LL OK');        { Verwaltung der Blk hat geklappt }
  285.     END ELSE BEGIN
  286.       WriteLn(f, '  ALARM');                      { Verwaltungsfehler }
  287.       WriteLn(   '  ALARM');                      { Verwaltungsfehler }
  288.     END;
  289.   END;
  290.   Close(f);
  291. END.
  292. (* ---------------------------------------------------------------- *)
  293. (*                    Ende von MEMTEST.PAS                          *)
  294.