Turbo Toolbox/Turbo_Toolbox.iso/spezial/11/release.pas

Pascal/Delphi Source File | 1989-04-17 | 5.8 KB | 179 lines

(* ┌───────────────────────────────────────────────────────────────────────┐
   │     RELEASE (3.0)  -  Freigeben eines MARKierten Speicherbereichs     │
   │                                                                       │
   │    Copyright (c) 1987,1988,1989  Karsten Gieselmann & DMV Software    │
   └───────────────────────────────────────────────────────────────────────┘ *)

{$IFDEF Ver40}                      (* Compilerschalter für Turbo Pascal 4.0 *)
  {$R-,S-,I-,F-,V-,B-,N-}
{$ENDIF}

{$IFDEF Ver50}                      (* Compilerschalter für Turbo Pascal 5.0 *)
  {$R-,S-,I-,F-,V-,B-,N-,A-,E-,O-}
{$ENDIF}

{$M 2048, 1024, 655360}                             (* Speicherkonfiguration *)


Program Release;

Uses  Dos, ProgMap;

Const OK         = 0;                        (* Rückgabe-Codes für MarkFound *)
      NotFound   = 1;
      ShellError = 2;

Var   Seg        : Word;                 (* Segment des letzten MARK-Aufrufs *)
      FirstProg,
      LastProg   : EntryPtr;


Function MarkFound(Var Segment : Word) : Byte;

  (* sucht in der Programm-Liste den letzten MARK-Eintrag;  wird dieser ge-
     funden, so enthält "Segment" das Segment dieses Eintrags. Entsprechend
     dem Erfolg der Operation wird eine Kennzahl (siehe oben) zurückgegeben. *)

   Var ProgPtr : EntryPtr;


   Function MarkFound_ : Boolean;

      Type  Search   = Array[0..22] of Char;

      Const MarkName = 'MARK';                    (* Name des MARK-Programms *)

            MarkCode : Search = (#$FA,#$0E,#$07,#$33,#$C0,#$8E,#$D8,#$89,#$C6,
                                 #$BF,#$17,#$01,#$B9,#$00,#$02,#$F3,#$A5,#$FB,
                                 #$BA,#$17,#$05,#$CD,#$27);

      Function DosVersion : Word;
         Inline($B4/$30/$CD/$21);

      Begin
      With ProgPtr^ do
         If Lo(DosVersion) >= 3 then
            MarkFound_ := (Name = MarkName)
         else
            MarkFound_ := (Search(Ptr(Segment,$100)^) = Search(MarkCode));
      End;


   Begin
   MarkFound := NotFound;
   ProgPtr := LastProg;
   While not MarkFound_ and (ProgPtr <> FirstProg) do
      With ProgPtr^ do
         If Name = 'COMMAND' then
            Begin
            MarkFound := ShellError;
            Exit;
            End
         else
            ProgPtr := Prev;
   If ProgPtr <> FirstProg then
      Begin
      Segment := ProgPtr^.Segment;
      MarkFound := OK;
      End;
   End;


Procedure RestoreIntVecTable(Seg : Word);

  (* kopiert die von MARK gesicherte Interrupt-Vektor-Tabelle wieder an ih-
     ren ursprünglichen Platz am Speicheranfang bei Adresse $0000:$0000      *)

   Begin
   Inline ($FA/            (*  CLI                ;Interrupts verbieten      *)
           $06/            (*  PUSH    ES         ;Extrasegment sichern      *)
           $1E/            (*  PUSH    DS         ;Datensegment sichern      *)
           $8B/$86/Seg/    (*  MOV     AX,Segm    ;MARK-Segment holen...     *)
           $8E/$D8/        (*  MOV     DS,AX      ;...und nach DS laden      *)
           $BE/$17/$01/    (*  MOV     SI,0117    ;Beginn der IntVec-Tabelle *)
           $31/$C0/        (*  XOR     AX,AX      ;AX löschen, ...           *)
           $8E/$C0/        (*  MOV     ES,AX      ;...als Segment nach ES... *)
           $89/$C7/        (*  MOV     DI,AX      ;...und als Offset nach DI *)
           $B9/$00/$02/    (*  MOV     CX,0200    ;Länge der IntVec-Tabelle  *)
           $F3/            (*  REPZ               ;Kopieren bis Tabellenende *)
           $A5/            (*  MOVSW              ;                          *)
           $1F/            (*  POP     DS         ;Datensegment wiederholen  *)
           $07/            (*  POP     ES         ;Extrasegment wiederholen  *)
           $FB)            (*  STI                ;Interrupts zulassen       *)
   End;


Procedure GetPtr(Var LastProg : EntryPtr);

  (* liefert einen Zeiger auf den letzten Eintrag der Programm-Liste *)

   Var ProgPtr : EntryPtr;

   Begin
   ProgPtr := FirstProg;
   While ProgPtr^.Next^.Next <> Nil do
      ProgPtr := ProgPtr^.Next;
   LastProg := ProgPtr;
   End;


Procedure ReleaseMemory(ProgPtr : EntryPtr);

  (* gibt den durch "ProgPtr" bezeichneten Speicherbereich wieder frei *)


   Procedure ReleaseBlock(Segment : Word);

     (* gibt das vom DOS allokierte Segment "Segment" wieder frei *)

      Var Regs : Registers;

      Begin
      With Regs do
         Begin
         ES := Segment;
         AH := $49;                  (* DOS-Funktion "Free Allocated Memory" *)
         MsDos(Regs);
         If Odd(Flags) then
            WriteLn('Error releasing ', ProgPtr^.Name);
         End
      End;


   Begin
   With ProgPtr^ do
      Begin
      If Segs = 2 then                              (* Environment freigeben *)
         ReleaseBlock(MemW[Segment:$2C]);
      ReleaseBlock(Segment);
      End;
   End;


Begin
MakeMemoryMap(FirstProg);               (* Zeiger auf erstes  Programm holen *)
GetPtr(LastProg);                       (* Zeiger auf letztes Programm holen *)
WriteLn;
Case MarkFound(Seg) of

   OK:
      Begin
      RestoreIntVecTable(Seg);  (* Interrupt-Vektoren wieder auf alten Stand *)
      Repeat
         ReleaseMemory(LastProg);                      (* Speicher freigeben *)
         With LastProg^ do
            If Segment <> Seg then              (* MARK wird nicht angezeigt *)
               WriteLn(Name, ' released....');
         LastProg := LastProg^.Prev;                    (* nächstes Programm *)
      until LastProg^.Segment < Seg;         (* bis MARK-Segment freigegeben *)
      End;

   NotFound:
      WriteLn('MARK not found!');

   ShellError:
      WriteLn('Cannot release across DOS shells!');

   End;
End.