home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / spezial / 11 / progmap.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-04-17  |  6.7 KB  |  192 lines
  1. (* ┌───────────────────────────────────────────────────────────────────────┐
  2.    │         PROGMAP (3.0)  -  Belegungsliste des PC-Hauptspeichers        │
  3.    │                                                                       │
  4.    │    Copyright (c) 1987,1988,1989  Karsten Gieselmann & DMV Software    │
  5.    └───────────────────────────────────────────────────────────────────────┘ *)
  6.  
  7. {$IFDEF Ver40}                      (* Compilerschalter für Turbo Pascal 4.0 *)
  8.   {$R-,S-,I-,F-,V-,B-,N-}
  9. {$ENDIF}
  10.  
  11. {$IFDEF Ver50}                      (* Compilerschalter für Turbo Pascal 5.0 *)
  12.   {$R-,S-,I-,F-,V-,B-,N-,A-,E-,O-}
  13. {$ENDIF}
  14.  
  15.  
  16. Unit ProgMap;
  17.  
  18. Interface uses Dos;
  19.  
  20. Type ProgName  = String[8];       (* "reiner" Programmname (o. Pfad u. Ext.) *)
  21.  
  22.      EntryPtr  = ^ProgEntry;                     (* Eintrag für ein Programm *)
  23.      ProgEntry = Record
  24.                     Segment    : Word;                       (* Lade-Segment *)
  25.                     Name       : ProgName;             (* Name des Programms *)
  26.                     Segs       : Byte;                (* Anzahl der Segmente *)
  27.                     Paragraphs : Word;                  (* belegter Speicher *)
  28.                     Prev,                      (* Zeiger auf letzten Eintrag *)
  29.                     Next       : EntryPtr;    (* Zeiger auf nächsten Eintrag *)
  30.                  End;
  31.  
  32. Var  UnUsed : Word;        (* Größe der nicht belegten Blöcke in Paragraphen *)
  33.  
  34.  
  35. Procedure MakeMemoryMap(Var FirstProgPtr : EntryPtr);
  36.  
  37.   (* Diese Routine  erstellt eine nach Segmenten aufsteigend geordnete Liste
  38.      aller im Hauptspeicher befindlichen residenten Programme. Der durch un-
  39.      benutzte Blöcke  belegte Speicher wird in der globalen Variablen UnUsed
  40.      mitgezählt (Angabe in Paragraphen). Der Zugriff auf die von MakeMemory-
  41.      Map erstellte Liste erfolgt Über den VAR-Parameter FirstProgPtr, dieser
  42.      enthält einen Zeiger auf den ersten Listeneintrag.                      *)
  43.  
  44.  
  45.  
  46. Implementation
  47.  
  48.  
  49. Procedure MakeMemoryMap(Var FirstProgPtr : EntryPtr);
  50.  
  51.    Type MCB_Ptr  = ^MCB_Type;
  52.         MCB_Type = Record              (* Aufbau eines Memory Control Blocks *)
  53.                       ID      : Char;
  54.                       PSPSeg,
  55.                       Diff    : Word;
  56.                    End;
  57.  
  58.    Var  MCB        : MCB_Type;
  59.         CurrentMCB : MCB_Ptr;
  60.         FirstProg,                                             (* Listenkopf *)
  61.         ProgPtr    : EntryPtr;                              (* Arbeitszeiger *)
  62.  
  63.  
  64.    Function First_MCB : MCB_Ptr;
  65.  
  66.      (* liefert einen Zeiger auf den ersten Memory Control Block *)
  67.  
  68.       Var Regs : Registers;
  69.  
  70.       Begin
  71.       With Regs do
  72.          Begin
  73.          AH := $52;                          (* undokumentierte Funktion 52h *)
  74.          MsDos(Regs);
  75.          First_MCB := Ptr(MemW[ES:BX-2], 0);
  76.          End;
  77.       End;
  78.  
  79.  
  80.    Function NewEntry(PSPSeg : Word; Var ProgPtr : EntryPtr) : Boolean;
  81.  
  82.      (* durchsucht die nach Segmenten  aufsteigend sortierte  Programm-Liste
  83.         und liefert die Einfüge-Position;  befindet sich bereits ein Eintrag
  84.         in der Liste, bei welchem das Segment mit "PSPSeg" übereinstimmt, so
  85.         wird ein Zeiger auf diesen Eintrag übergeben. Handelt es sich um ein
  86.         neu in die Liste einzufügendes Element, wird TRUE zurückgegeben.     *)
  87.  
  88.       Begin
  89.       ProgPtr := FirstProg;
  90.       While (ProgPtr^.Next <> Nil) and (ProgPtr^.Segment < PSPSeg) do
  91.          ProgPtr := ProgPtr^.Next;
  92.       If ProgPtr <> FirstProg then
  93.          If PSPSeg < ProgPtr^.Segment then
  94.             ProgPtr := ProgPtr^.Prev;
  95.       NewEntry := (ProgPtr^.Segment <> PSPSeg);
  96.       End;
  97.  
  98.  
  99.    Procedure InsertNewProg(Var ProgPtr : EntryPtr);
  100.  
  101.      (* erzeugt ein neues Listenelement und fügt es hinter "ProgPtr" ein *)
  102.  
  103.       Var NewProg : EntryPtr;
  104.  
  105.       Begin
  106.       New(NewProg);
  107.       NewProg^.Next := ProgPtr^.Next;
  108.       NewProg^.Prev := ProgPtr;
  109.       ProgPtr^.Next := NewProg;
  110.       If NewProg^.Next <> Nil then
  111.          NewProg^.Next^.Prev := NewProg;
  112.       ProgPtr := NewProg;
  113.       End;
  114.  
  115.  
  116.    Procedure CheckEnvironment(Segment : Word; Var Name : ProgName);
  117.  
  118.      (* nimmt an, daß es sich bei dem bei Segment:0000 beginnenden Speicher-
  119.         bereich um ein Environment handelt und versucht den Namen des zuge-
  120.         hörigen Programms auszulesen (eingetragen erst ab DOS-Version 3.0!). *)
  121.  
  122.       Const Dot       = $2E; {.}
  123.             Colon     = $3A; {:}
  124.             BackSlash = $5C; {\}
  125.  
  126.       Var a, b, k : Word;           (* Indizes zum Auslesen des Environments *)
  127.  
  128.       Begin
  129.       b := 0;
  130.       While MemW[Segment:b] <> $0000 do Inc(b);    (* bis Ende der Variablen *)
  131.       If (MemW[Segment:b+2] = $0001) and (Mem[Segment:b+5] = Colon) then
  132.          Begin
  133.          Inc(b, 7);
  134.          While Mem[Segment:b] <> $00 do Inc(b);     (* Ende des Environments *)
  135.          While Mem[Segment:b] <> Dot do Dec(b);         (* Anfang des Suffix *)
  136.          Dec(b); a:= b;
  137.          While Mem[Segment:a] <> BackSlash do Dec(a);   (* Anfang des Namens *)
  138.          Name[0] := Chr(b-a);
  139.          For k:=1 to Ord(Name[0]) do
  140.             Name[k] := Chr(Mem[Segment:a+k]);              (* Namen kopieren *)
  141.          End;
  142.       End;
  143.  
  144.  
  145.    Begin
  146.    New(FirstProg);                                 (* Programm-Liste anlegen *)
  147.    With FirstProg^ do
  148.       Begin
  149.       Segment := 0;
  150.       Next    := Nil;
  151.       Prev    := Nil;
  152.       End;
  153.    UnUsed := 0;
  154.    CurrentMCB := First_MCB;                   (* Zeiger auf ersten MCB holen *)
  155.    Repeat
  156.       MCB := CurrentMCB^;
  157.       With MCB do
  158.          If PSPSeg > $0070 then         (* belegt und nicht vom DOS benutzt? *)
  159.             Begin
  160.             If NewEntry(PSPSeg, ProgPtr) then
  161.                Begin
  162.                InsertNewProg(ProgPtr);             (* neuen Eintrag erzeugen *)
  163.                With ProgPtr^ do
  164.                   Begin
  165.                   Segment    := PSPSeg;
  166.                   Segs       := 0;
  167.                   Paragraphs := 0;
  168.                   If ProgPtr = FirstProg^.Next then      (* Eintrag ist DOS! *)
  169.                      Name := 'DOS'
  170.                   else
  171.                      Name := '???';
  172.                   End;
  173.                End;
  174.             With ProgPtr^ do
  175.                Begin
  176.                Inc(Segs);
  177.                Inc(Paragraphs, MCB.Diff);
  178.                If Name = '???' then
  179.                   CheckEnvironment(Succ(Seg(CurrentMCB^)), Name);
  180.                End;
  181.             End
  182.          else
  183.             If PSPSeg = $0000 then               (* unbenutzer Speicherblock *)
  184.                Inc(UnUsed, Diff);
  185.       CurrentMCB := Ptr(Seg(CurrentMCB^)+MCB.Diff+1, 0);     (* nächster MCB *)
  186.    until MCB.ID = 'Z';
  187.    FirstProgPtr := FirstProg^.Next;
  188.    End;
  189.  
  190.  
  191. End.
  192.