home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1988 / 02 / mmr / ed. next >
Text File  |  1994-04-10  |  19KB  |  352 lines
  1. (*---------------------------------------------------------------------------*)
  2. (*                           MAKEMAP.INC  (v2.0)                             *)
  3. (*  Anfertigung eines Belegungsplanes des PC-Hauptspeichers (MS-DOS/Turbo)   *)
  4. (*            (c) 1987  Karsten Gieselmann  &  PASCAL International          *)
  5. (*---------------------------------------------------------------------------*)
  6. Type ProgName = String[8];        (* "reiner" Programmname (o. Pfad u. Ext.) *)
  7.      Entry  = ^ProgEntry;                       (* Eintrag fuer ein Programm *)
  8.      ProgEntry = Record
  9.                     Segment    :Integer;                     (* Lade-Segment *)
  10.                     Name       :ProgName;              (* Name des Programms *)
  11.                     Segs       :Integer;              (* Anzahl der Segmente *)
  12.                     Paragraphs :Integer;                (* belegter Speicher *)
  13.                     Last,                      (* Zeiger auf letzten Eintrag *)
  14.                     Next       :Entry;       (* Zeiger auf naechsten Eintrag *)
  15.                  End;
  16. Var  FreeBlocks :Integer;   (* Groesse der nicht belegten Bloecke in Paragr. *)
  17.  
  18. (*       Vergleichsfunktion "a < b" fuer CARDINAL-Zahlen (0..$FFFF):         *)
  19. Function Lower (a,b :Integer) :Boolean;
  20. Begin
  21.    Inline ($31/$C0/        (*  XOR    AX,AX       ;                          *)
  22.            $8B/$5E/$06/    (*  MOV    BX,[BP+06]  ;a holen                   *)
  23.            $3B/$5E/$04/    (*  CMP    BX,[BP+04]  ;Vergleich:  a < b ?       *)
  24.            $73/$01/        (*  JNC    *+1         ;nein:  dann Abbruch       *)
  25.            $40/            (*  INC    AX          ;sonst Bedingung erfuellt  *)
  26.            $88/$46/$08)    (*  MOV    [BP+08],AL  ;Ergebnis auf Stapel       *)
  27. End;
  28.  
  29. (* Diese Prozedur erstellt eine nach Segmenten geordnete Liste aller im
  30.    Speicher befindlichen residenten Programme. Der durch unbenutzte Bloecke
  31.    freie Speicher wird in der globalen  Variablen  "FreeBlocks" mitgezaehlt
  32.    (Angabe in Paragraphen). Der Uebergabe-Parameter "FirstProgPtr" enthaelt
  33.    einen Zeiger auf den ersten Listeneintrag.                                *)
  34. Procedure MakeMemoryMap (Var FirstProgPtr :Entry);
  35.    Type MCB_Ptr  = ^MCB_Type;
  36.         MCB_Type = Record              (* Aufbau eines Memory Control Blocks *)
  37.                       ID           :Char;
  38.                       PSPSeg, Diff :Integer;
  39.                    End;
  40.    Var  MCB                :MCB_Type;
  41.         CurrentMCB         :MCB_Ptr;
  42.         FirstProg, ProgPtr :Entry;           (* Listenkopf und Arbeitszeiger *)
  43.  
  44.  
  45.    (*        liefert einen Zeiger auf den ersten Memory Control Block:       *)
  46.    Function First_MCB :MCB_Ptr;
  47.       Var Regs :Record  AX,BX,CX,DX,BP,DI,SI,DS,ES,Flags :Integer  End;
  48.    Begin
  49.       Regs.AX := $5200;  MsDos (Regs);       (* undokumentierte Funktion 52h *)
  50.       With Regs do  First_MCB := Ptr (MemW[ES:BX-2], 0);
  51.    End;
  52.  
  53.    (* durchsucht die nach Segmenten  aufsteigend sortierte  Programm-Liste
  54.       und liefert die Einfuege-Position. Befindet sich bereits ein Eintrag
  55.       in der Liste, bei welchem das Segment mit "PSPSeg" uebereinstimmt, so
  56.       wird ein Zeiger auf diesen Eintrag uebergeben:                         *)
  57.    Procedure GetProgPos (PSPSeg :Integer; Var ProgPtr :Entry);
  58.    Begin
  59.       ProgPtr := FirstProg;
  60.       While (ProgPtr^.Next <> Nil) and Lower (ProgPtr^.Segment, PSPSeg) do
  61.          ProgPtr := ProgPtr^.Next;
  62.       If ProgPtr <> FirstProg then
  63.          If Lower (PSPSeg, ProgPtr^.Segment) then  ProgPtr := ProgPtr^.Last
  64.    End;
  65.  
  66.    (*   erzeugt ein neues Listenelement und fuegt es hinter "ProgPtr" ein:   *)
  67.    Procedure InsertNewProg (Var ProgPtr :Entry);
  68.       Var NewProg :Entry;
  69.    Begin
  70.       New (NewProg);                NewProg^.Next := ProgPtr^.Next;
  71.       NewProg^.Last := ProgPtr;     ProgPtr^.Next := NewProg;
  72.       If NewProg^.Next <> Nil then  NewProg^.Next^.Last := NewProg;
  73.       ProgPtr := NewProg
  74.    End;
  75.  
  76.    (* holt das  Environment-Segment aus dem  PSP (Offset 2Ch) und  schaut
  77.       dort nach dem vom DOS (erst ab Version 3.0!) abgelegten Dateinamen.
  78.       Bei erfolgreicher Suche werden Pfad und Extension abgeschnitten und
  79.       der reine Programmname uebergeben:                                     *)
  80.    Function GetProgName (PSPSeg :Integer) :ProgName;
  81.       Var Name          :String[255];
  82.           EnvSeg,EnvOfs :Integer;        (* Segment, Offset des Environments *)
  83.           p             :Byte;
  84.    Begin
  85.       EnvSeg := MemW [MCB.PSPSeg:$2C];  EnvOfs := 0;  Name := '';
  86.       While (MemW[EnvSeg:EnvOfs] <> $0000) do   (* bis Ende des Env.-Strings *)
  87.          EnvOfs := succ (EnvOfs);
  88.       If MemW[EnvSeg:EnvOfs+2] = $0001 then begin (* Datein. ist eingetragen *)
  89.          EnvOfs := EnvOfs + 4;                      (* EnvOfs auf Dateinamen *)
  90.          While Mem[EnvSeg:EnvOfs] <> $00 do begin (* bis zum Ende des Namens *)
  91.             Name := Name + chr(Mem[EnvSeg:EnvOfs]);  EnvOfs := succ (EnvOfs)
  92.          End;
  93.          Repeat                                       (* Pfadnamen abspalten *)
  94.             p := Pos ('\', Name);  Delete (Name, 1, p);
  95.          until p = 0;
  96.       End;
  97.       p := pred (Pos('.',Name));
  98.       GetProgName := Copy (Name,1,p);                 (* Extension abspalten *)
  99.    End;
  100.  
  101. Begin (* MakeMemoryMap *)
  102.    New (FirstProg);                                (* Programm-Liste anlegen *)
  103.    FirstProg^.Next := Nil;   FirstProg^.Last := Nil;   FreeBlocks := 0;
  104.    CurrentMCB := First_MCB;                   (* Zeiger auf ersten MCB holen *)
  105.    Repeat
  106.       MCB := CurrentMCB^;
  107.       With MCB do                       (* belegt und nicht vom DOS benutzt: *)
  108.          If Lower ($0070,PSPSeg) then begin
  109.             GetProgPos (PSPSeg, ProgPtr);
  110.             If (ProgPtr <> FirstProg) and (ProgPtr^.Segment = PSPSeg) then
  111.                With ProgPtr^ do Begin
  112.                   Segs := succ (Segs);   Paragraphs := Paragraphs + Diff;
  113.                   If Name <> 'DOS' THEN Name := GetProgName (PSPSeg);
  114.                End
  115.             else begin                             (* neuen Eintrag erzeugen *)
  116.                InsertNewProg (ProgPtr);
  117.                With ProgPtr^ do Begin
  118.                   Segment := PSPSeg;   Segs := 1;   Paragraphs := Diff;
  119.                   If ProgPtr = FirstProg^.Next then      (* Eintrag ist DOS! *)
  120.                      Name := 'DOS'
  121.                   else  Name := '???'
  122.                End
  123.             End;
  124.          End
  125.          else
  126.             If PSPSeg = $0000 then               (* unbenutzer Speicherblock *)
  127.                FreeBlocks := FreeBlocks + Diff;
  128.       CurrentMCB := Ptr(Seg(CurrentMCB^)+succ(MCB.Diff),0); (* naechster MCB *)
  129.    until MCB.ID = 'Z';
  130.    FirstProgPtr := FirstProg^.Next
  131. End;
  132. (*---------------------------------------------------------------------------*)
  133. (*                           MAKEMAP.INC  (v2.0)                             *)
  134. (*---------------------------------------------------------------------------*)
  135. (*                            MAKEMARK.PAS  (v1.0)                           *)
  136. (*      Erzeugen der superkurzen MARKer-Datei MARK.COM (MS-DOS/Turbo)        *)
  137. (*           (c) 1987  Karsten Gieselmann  &  PASCAL International           *)
  138. (*---------------------------------------------------------------------------*)
  139. Program MakeMark (Output, ComFile);
  140. Const Code :Array [0..22] of Byte =
  141.               ($FA,         (*  CLI              ;Interrupts verbieten       *)
  142.                $0E,         (*  PUSH    CS       ;Codesegment...             *)
  143.                $07,         (*  POP     ES       ;...nach ES laden           *)
  144.                $33,$C0,     (*  XOR     AX,AX    ;AX loeschen...             *)
  145.                $8E,$D8,     (*  MOV     DS,AX    ;...als Segment nach DS...  *)
  146.                $89,$C6,     (*  MOV     SI,AX    ;...und als Offset nach SI  *)
  147.                $BF,$17,$01, (*  MOV     DI,0117  ;Beginn der IntVec-Tabelle  *)
  148.                $B9,$00,$02, (*  MOV     CX,0200  ;Laenge der Tabelle         *)
  149.                $F3,         (*  REPZ             ;Kopieren bis Tabellenende  *)
  150.                $A5,         (*  MOVSW            ;                           *)
  151.                $FB,         (*  STI              ;Interrupts zulassen        *)
  152.                $BA,$17,$05, (*  MOV     DX,0517  ;22 Code-, 1024 Datenbytes  *)
  153.                $CD,$27);    (*  INT     27       ;...resident machen         *)
  154.       ComFileName = 'MARK.COM';
  155. Var   ComFile :File of Byte;
  156.       Count   :Integer;
  157. Begin
  158.   Assign (ComFile, ComFileName);  ReWrite (ComFile);
  159.   For Count := 0 to pred(SizeOf(Code)) do  Write (ComFile, Code[Count]);
  160.   Close (ComFile);
  161.   WriteLn;  Writeln ('COM-File ', ComFileName, ' generiert!');  Writeln;
  162. End.
  163. Θ│+ÉÉ═½Copyright (C) 1985 BORLAND IncΘVv2Default display modeP ppO.è'
  164. Σ∙tC.èPΦ╣X■╠u≤°├║ ╟n.╞ö╛p& 4& t·&╟╕&îL√δ(*---------------------------------------------------------------------------*)
  165. (*                                 MAP.PAS                                   *)
  166. (*    Ausgabe einer Belegungstabelle des PC-Hauptspeichers (MS-DOS/Turbo)    *)
  167. (*           (c) 1987  Karsten Gieselmann  &  PASCAL International           *)
  168. (*---------------------------------------------------------------------------*)
  169. PROGRAM Map (Output);
  170. (* {$P512} *)           (* fuer DOS-Ein/Ausgabeumleitung Klammern entfernen! *)
  171. {$I MAKEMAP.INC}               (* einbinden der die Liste liefernden Routine *)
  172.  
  173. Const LastIntr = $7F;              (* Test auf Anzapfen bis zu diesem Vektor *)
  174. Type  StringType = String[4];         (* Typ fuer die Dez-Hex-Transformation *)
  175. Var   IntrCount,         (* Zahl der angezapften Interrupts für ein Programm *)
  176.       i           :Byte;
  177.       FreeMemory  :Real; (* Groesse des verbleibenden RAM-Speichers in Bytes *)
  178.       ProgPtr     :Entry;
  179.       IntrSegment,
  180.       NextSegment :Integer;
  181.       Hooked      :Boolean;
  182.  
  183. (*         wandelt ein Dezimalbyte in den entsprechenden Hexadezimalwert:    *)
  184. Function HexByte (b :Byte) :StringType;
  185.    Const HexDigit :Array [0..15] of Char = '0123456789ABCDEF';
  186. Begin   HexByte := HexDigit[b shr 4] + HexDigit[b and $0F]   End;
  187.  
  188. (*          wandelt ein Dezimalwort in den entsprechenden Hexadezimalwert:   *)
  189. Function HexWord (w :Integer) :StringType;
  190. Begin   HexWord := HexByte (w shr 8) + HexByte (w and $FF)   End;
  191.  
  192. (*         rechnet in Paragraphen gegebene Speichergroesse in Bytes um:      *)
  193. Function ByteSize (Paragraphs :Integer) :Real;
  194. Begin
  195.    If Paragraphs < 0 then  ByteSize := (Paragraphs + 65536.0) * 16.0
  196.    else  ByteSize := Paragraphs * 16.0
  197. End;
  198.  
  199. Begin (* Map *)
  200.    MakeMemoryMap (ProgPtr);   LowVideo;
  201.    WriteLn;   Write ('MAP  v2.0  -  Speicherbelegungstabelle');
  202.    WriteLn ('   (c) 1987   K.Gieselmann & PASCAL Int.');
  203.    WriteLn;
  204.    Write (' Adresse    Programm   Seg    Bytes    ');
  205.    Write ('          Interrupt-Vektoren'^M^J);
  206.    Write ('─────────   ────────   ───   ──────   ');
  207.    Write ('──────────────────────────────────────────');
  208.    While ProgPtr <> Nil do Begin
  209.       With ProgPtr^ do
  210.          If ProgPtr^.Next <> Nil then Begin
  211.             Write (HexWord(Segment), ':0000   ');
  212.             Write (Name, '':8-Length(Name));
  213.             Write (Segs:6, ByteSize(Paragraphs):9:0, ' ');
  214.             IntrCount := 1;   NextSegment := Next^.Segment;
  215.             If Name <> 'DOS' then        (* das DOS zapft keine Vektoren an! *)
  216.                For i:=$00 to LastIntr do Begin
  217.                   IntrSegment := MemW[0:i*4+2] + MemW[0:i*4] shr 4;
  218.                   If not Lower (IntrSegment, Segment) then
  219.                      If not Lower (NextSegment, IntrSegment) then Begin
  220.                         If IntrCount mod 12 = 0 then  Write ('':36);
  221.                         Write (HexByte(i):4);   IntrCount := succ (IntrCount)
  222.                      End
  223.                End;
  224.             If IntrCount mod 12 <> 0 then  WriteLn
  225.          End
  226.          else begin                (* letzter Eintrag ist laufendes Progamm! *)
  227.             FreeMemory := ByteSize (Paragraphs + FreeBlocks);
  228.             WriteLn (^J'Freier RAM-Speicher:', FreeMemory:15:0);
  229.             WriteLn (^J'Nächste Ladeadresse: ', HexWord(Segment))
  230.          End;
  231.       ProgPtr := ProgPtr^.Next
  232.    End;
  233.    WriteLn
  234. End.
  235. ·3└Ä╪ë╞┐╣≤Ñ√║═'Θ│+ÉÉ═½Copyright (C) 1985 BORLAND IncΘVv2Default display modeP ppO.è'
  236. Σ∙tC.èPΦ╣X■╠u≤°├╗ ╟n.╞ö╛p& 4& t·&╟╕&îL√δ(*---------------------------------------------------------------------------*)
  237. (*                             RELEASE.PAS  (v2.0)                           *)
  238. (* Freigeben eines mit MARK gekennzeichneten Speicherbereichs (MS-DOS/Turbo) *)
  239. (*          (c) 1987  Karsten Gieselmann  &  PASCAL International            *)
  240. (*---------------------------------------------------------------------------*)
  241. PROGRAM ReleaseProgram (Output);
  242. {$I MAKEMAP.INC}               (* einbinden der die Liste liefernden Routine *)
  243. Var   Seg                 :Integer;      (* Segment des letzten MARK-Aufrufs *)
  244.       FirstProg, LastProg :Entry;
  245.  
  246. (* sucht in der Programm-Liste den letzten MARK-Eintrag;  wird dieser ge-
  247.    funden, so enthaelt "Segment" das Segment dieses Eintrags, anderenfalls
  248.    ist die Uebergabe-Variable gleich Null:                                   *)
  249. Procedure FindMarker (Var Segment :Integer);
  250.    Var ProgPtr :Entry;
  251.  
  252.    Function DVersion :Integer;                      (* DOS-Version ermitteln *)
  253.       Var Regs :Record
  254.                    AX,BX,CX,DX,BP,DI,SI,DS,ES,Flags :Integer
  255.                 End;
  256.    Begin
  257.       Regs.AX := $3000;   MsDos (Regs);            (* Funktion 30h           *)
  258.       DVersion := Lo (Regs.AX)                     (* "Hauptversionsnummer"  *)
  259.    End;                         (* "Hi (Regs.AX)" ergibt Unterversionsnummer *)
  260.  
  261.    Function MarkFound :Boolean;
  262.       Const MarkName = 'MARK';                    (* Name des MARK-Programms *)
  263.             MarkCode : Array [0..22] of Byte =
  264.                           ($FA,$0E,$07,$33,$C0,$8E,$D8,$89,$C6,$BF,$17,$01,
  265.                            $B9,$00,$02,$F3,$A5,$FB,$BA,$17,$05,$CD,$27);
  266.        Var found :Boolean;   i :Integer;
  267.    Begin
  268.       If DVersion >= 3 then found := (ProgPtr^.Name = MarkName)
  269.       else begin                                  (* DOS-Version kleiner 3.0 *)
  270.          found := true;
  271.          For i := 0 to 22 do
  272.             found := found and (Mem[ProgPtr^.Segment:$100+i] = MarkCode[i]);
  273.       End;
  274.       MarkFound := found
  275.    End;
  276.  
  277. Begin (* FindMarker *)
  278.    ProgPtr := LastProg;
  279.    While not MarkFound and (ProgPtr <> FirstProg) do ProgPtr := ProgPtr^.Last;
  280.    If ProgPtr <> FirstProg then Segment := ProgPtr^.Segment
  281.    else Segment := $0000                             (* MARK nicht gefunden! *)
  282. End;
  283.  
  284. (* kopiert die von MARK gesicherte Interrupt-Vektor-Tabelle wieder an ih-
  285.    ren ursprünglichen Platz am Speicheranfang bei Adresse $0000:$0000        *)
  286. Procedure RestoreIntVecTable (Seg :Integer);
  287. Begin
  288.    Inline ($FA/            (*  CLI                ;Interrupts verbieten      *)
  289.            $06/            (*  PUSH    ES         ;Extrasegment sichern      *)
  290.            $1E/            (*  PUSH    DS         ;Datensegment sichern      *)
  291.            $8B/$86/Seg/    (*  MOV     AX,Segm    ;MARK-Segment holen...     *)
  292.            $8E/$D8/        (*  MOV     DS,AX      ;...und nach DS laden      *)
  293.            $BE/$17/$01/    (*  MOV     SI,0117    ;Beginn der IntVec-Tabelle *)
  294.            $31/$C0/        (*  XOR     AX,AX      ;AX loeschen, ...          *)
  295.            $8E/$C0/        (*  MOV     ES,AX      ;...als Segment nach ES... *)
  296.            $89/$C7/        (*  MOV     DI,AX      ;...und als Offset nach DI *)
  297.            $B9/$00/$02/    (*  MOV     CX,0200    ;Laenge der IntVec-Tabelle *)
  298.            $F3/            (*  REPZ               ;Kopieren bis Tabellenende *)
  299.            $A5/            (*  MOVSW              ;                          *)
  300.            $1F/            (*  POP     DS         ;Datensegment wiederholen  *)
  301.            $07/            (*  POP     ES         ;Extrasegment wiederholen  *)
  302.            $FB)            (*  STI                ;Interrupts zulassen       *)
  303. End;
  304.  
  305. (*     liefert einen Zeiger auf den letzten Eintrag der Programm-Liste:      *)
  306. Procedure GetPtr (Var LastProg :Entry);
  307.    Var ProgPtr :Entry;
  308. Begin
  309.    ProgPtr := FirstProg;
  310.    While ProgPtr^.Next^.Next <> Nil do ProgPtr := ProgPtr^.Next;
  311.    LastProg := ProgPtr
  312. End;
  313.  
  314. (*    gibt den durch "ProgPtr" bezeichneten Speicherbereich wieder frei:     *)
  315. Procedure Release (ProgPtr :Entry);
  316.    VAR error: Boolean;
  317.    (*       gibt das vom DOS allokierte Segment "Segment" wieder frei:       *)
  318.    (*      (PASCAL 4/87, 'Externe Kommandos in Turbo Pascal', S.72 ff)       *)
  319.    Function MFree (Block_Segment :Integer) :Integer;
  320.       Var Regs :Record
  321.                    AX,BX,CX,DX,BP,DI,SI,DS,ES,Flags :Integer
  322.                 End;
  323.    Begin                             (* DOS-Funktion "Free Allocated Memory" *)
  324.       Regs.ES := Block_Segment;   Regs.AX := $4900;   MsDos (Regs);
  325.       If odd (Regs.Flags) then MFree := Lo (Regs.AX)  Else  MFree := 0;
  326.    End;
  327.  
  328. Begin (* Release *)
  329.    error := false;   Write ('Freigabe von ',ProgPtr^.Name);
  330.    If ProgPtr^.Segs = 2 then                        (* Environment freigeben *)
  331.       error := MFree (MemW[ProgPtr^.Segment:$2C]) <> 0;
  332.    error := error or (MFree (ProgPtr^.Segment) <> 0);
  333.    If error THEN  Write ('  Achtung: Fehler bei Freigabe');
  334.    Writeln;
  335. End;
  336.  
  337. Begin (* Release_Prog *)
  338.    Lowvideo;  WriteLn;  Write ('RELEASE  v2.0');
  339.    Writeln ('        (c) 1987  Karsten Gieselmann & PASCAL Int.');  Writeln;
  340.    MakeMemoryMap (FirstProg);                (* Zeiger auf 1. Programm holen *)
  341.    GetPtr (LastProg);                   (* Zeiger auf letztes Programm holen *)
  342.    FindMarker (Seg);
  343.    If Seg <> 0 then begin                  (* ist MARK ueberhaupt vorhanden? *)
  344.       RestoreIntVecTable (Seg); (* Interrupt-Vektoren wieder auf alten Stand *)
  345.       Repeat
  346.          Release (LastProg);                           (* Speicher freigeben *)
  347.          LastProg := LastProg^.Last;                   (* naechstes Programm *)
  348.       until Lower (LastProg^.Segment, Seg)   (* bis MARK-Segment freigegeben *)
  349.    End
  350.    else  WriteLn ('Fehler:  kein MARK gefunden!')
  351. End.
  352.