Turbo Toolbox/Turbo_Toolbox.iso/1988/10_11/mmr/release.pas

Pascal/Delphi Source File | 1988-07-19 | 5.8 KB | 166 lines

(* ------------------------------------------------------------------------- *)
(*                            RELEASE.PAS (v3.1)                             *)
(*                Freigeben eines MARKierten Speicherbereichs                *)
(*      Copyright (c) 1988  Karsten Gieselmann  &  TOOLBOX                   *)
(* ------------------------------------------------------------------------- *)

{$R-,S-,I-,V-,B-,N-}                       (* größtmögliche Geschwindigkeit! *)

PROGRAM Release;

USES Dos, ProgMap;                                        (* benötigte Units *)

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 DosVersion : BYTE;
VAR
  Regs : Registers;
BEGIN
  WITH Regs DO BEGIN
    AH := $30;
    MsDos (Regs);
    DosVersion := AL;                              (* "Major version number" *)
  END;
END;

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);
BEGIN
  WITH ProgPtr^ DO
    IF 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 := Last;
  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,Seg     ;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;

(* ----------------------------- Hauptprogramm ----------------------------- *)

BEGIN
  MakeMemoryMap (FirstProg);            (* Zeiger auf erstes  Programm holen *)
  GetPtr (LastProg);                    (* Zeiger auf letztes Programm holen *)
  WriteLn (^M^J'RELEASE  v3.1'^M^J);
  CASE MarkFound(Seg) OF

    OK:
      BEGIN
        RestoreIntVecTable (Seg);      (* Interrupt-Vektoren auf alten Stand *)
        REPEAT
          ReleaseMemory (LastProg);                    (* Speicher freigeben *)
          WITH LastProg^ DO
            IF Segment <> Seg THEN              (* MARK wird nicht angezeigt *)
              WriteLn (Name, ' released....');
          LastProg := LastProg^.Last;                   (* nächstes Programm *)
        UNTIL LastProg^.Segment < Seg;       (* bis MARK-Segment freigegeben *)
      END;

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

    ShellError:
      WriteLn ('Can''t release across current DOS shell!');

  END;
END.