home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1988 / 02 / mmr / release.pas < prev   
Pascal/Delphi Source File  |  1987-11-11  |  6KB  |  117 lines
  1. (*---------------------------------------------------------------------------*)
  2. (*                             RELEASE.PAS  (v2.0)                           *)
  3. (* Freigeben eines mit MARK gekennzeichneten Speicherbereichs (MS-DOS/Turbo) *)
  4. (*          (c) 1987  Karsten Gieselmann  &  PASCAL International            *)
  5. (*---------------------------------------------------------------------------*)
  6. PROGRAM ReleaseProgram (Output);
  7. {$I MAKEMAP.INC}               (* einbinden der die Liste liefernden Routine *)
  8. Var   Seg                 :Integer;      (* Segment des letzten MARK-Aufrufs *)
  9.       FirstProg, LastProg :Entry;
  10.  
  11. (* sucht in der Programm-Liste den letzten MARK-Eintrag;  wird dieser ge-
  12.    funden, so enthaelt "Segment" das Segment dieses Eintrags, anderenfalls
  13.    ist die Uebergabe-Variable gleich Null:                                   *)
  14. Procedure FindMarker (Var Segment :Integer);
  15.    Var ProgPtr :Entry;
  16.  
  17.    Function DVersion :Integer;                      (* DOS-Version ermitteln *)
  18.       Var Regs :Record
  19.                    AX,BX,CX,DX,BP,DI,SI,DS,ES,Flags :Integer
  20.                 End;
  21.    Begin
  22.       Regs.AX := $3000;   MsDos (Regs);            (* Funktion 30h           *)
  23.       DVersion := Lo (Regs.AX)                     (* "Hauptversionsnummer"  *)
  24.    End;                         (* "Hi (Regs.AX)" ergibt Unterversionsnummer *)
  25.  
  26.    Function MarkFound :Boolean;
  27.       Const MarkName = 'MARK';                    (* Name des MARK-Programms *)
  28.             MarkCode : Array [0..22] of Byte =
  29.                           ($FA,$0E,$07,$33,$C0,$8E,$D8,$89,$C6,$BF,$17,$01,
  30.                            $B9,$00,$02,$F3,$A5,$FB,$BA,$17,$05,$CD,$27);
  31.        Var found :Boolean;   i :Integer;
  32.    Begin
  33.       If DVersion >= 3 then found := (ProgPtr^.Name = MarkName)
  34.       else begin                                  (* DOS-Version kleiner 3.0 *)
  35.          found := true;
  36.          For i := 0 to 22 do
  37.             found := found and (Mem[ProgPtr^.Segment:$100+i] = MarkCode[i]);
  38.       End;
  39.       MarkFound := found
  40.    End;
  41.  
  42. Begin (* FindMarker *)
  43.    ProgPtr := LastProg;
  44.    While not MarkFound and (ProgPtr <> FirstProg) do ProgPtr := ProgPtr^.Last;
  45.    If ProgPtr <> FirstProg then Segment := ProgPtr^.Segment
  46.    else Segment := $0000                             (* MARK nicht gefunden! *)
  47. End;
  48.  
  49. (* kopiert die von MARK gesicherte Interrupt-Vektor-Tabelle wieder an ih-
  50.    ren ursprünglichen Platz am Speicheranfang bei Adresse $0000:$0000        *)
  51. Procedure RestoreIntVecTable (Seg :Integer);
  52. Begin
  53.    Inline ($FA/            (*  CLI                ;Interrupts verbieten      *)
  54.            $06/            (*  PUSH    ES         ;Extrasegment sichern      *)
  55.            $1E/            (*  PUSH    DS         ;Datensegment sichern      *)
  56.            $8B/$86/Seg/    (*  MOV     AX,Segm    ;MARK-Segment holen...     *)
  57.            $8E/$D8/        (*  MOV     DS,AX      ;...und nach DS laden      *)
  58.            $BE/$17/$01/    (*  MOV     SI,0117    ;Beginn der IntVec-Tabelle *)
  59.            $31/$C0/        (*  XOR     AX,AX      ;AX loeschen, ...          *)
  60.            $8E/$C0/        (*  MOV     ES,AX      ;...als Segment nach ES... *)
  61.            $89/$C7/        (*  MOV     DI,AX      ;...und als Offset nach DI *)
  62.            $B9/$00/$02/    (*  MOV     CX,0200    ;Laenge der IntVec-Tabelle *)
  63.            $F3/            (*  REPZ               ;Kopieren bis Tabellenende *)
  64.            $A5/            (*  MOVSW              ;                          *)
  65.            $1F/            (*  POP     DS         ;Datensegment wiederholen  *)
  66.            $07/            (*  POP     ES         ;Extrasegment wiederholen  *)
  67.            $FB)            (*  STI                ;Interrupts zulassen       *)
  68. End;
  69.  
  70. (*     liefert einen Zeiger auf den letzten Eintrag der Programm-Liste:      *)
  71. Procedure GetPtr (Var LastProg :Entry);
  72.    Var ProgPtr :Entry;
  73. Begin
  74.    ProgPtr := FirstProg;
  75.    While ProgPtr^.Next^.Next <> Nil do ProgPtr := ProgPtr^.Next;
  76.    LastProg := ProgPtr
  77. End;
  78.  
  79. (*    gibt den durch "ProgPtr" bezeichneten Speicherbereich wieder frei:     *)
  80. Procedure Release (ProgPtr :Entry);
  81.    VAR error: Boolean;
  82.    (*       gibt das vom DOS allokierte Segment "Segment" wieder frei:       *)
  83.    (*      (PASCAL 4/87, 'Externe Kommandos in Turbo Pascal', S.72 ff)       *)
  84.    Function MFree (Block_Segment :Integer) :Integer;
  85.       Var Regs :Record
  86.                    AX,BX,CX,DX,BP,DI,SI,DS,ES,Flags :Integer
  87.                 End;
  88.    Begin                             (* DOS-Funktion "Free Allocated Memory" *)
  89.       Regs.ES := Block_Segment;   Regs.AX := $4900;   MsDos (Regs);
  90.       If odd (Regs.Flags) then MFree := Lo (Regs.AX)  Else  MFree := 0;
  91.    End;
  92.  
  93. Begin (* Release *)
  94.    error := false;   Write ('Freigabe von ',ProgPtr^.Name);
  95.    If ProgPtr^.Segs = 2 then                        (* Environment freigeben *)
  96.       error := MFree (MemW[ProgPtr^.Segment:$2C]) <> 0;
  97.    error := error or (MFree (ProgPtr^.Segment) <> 0);
  98.    If error THEN  Write ('  Achtung: Fehler bei Freigabe');
  99.    Writeln;
  100. End;
  101.  
  102. Begin (* Release_Prog *)
  103.    Lowvideo;  WriteLn;  Write ('RELEASE  v2.0');
  104.    Writeln ('        (c) 1987  Karsten Gieselmann & PASCAL Int.');  Writeln;
  105.    MakeMemoryMap (FirstProg);                (* Zeiger auf 1. Programm holen *)
  106.    GetPtr (LastProg);                   (* Zeiger auf letztes Programm holen *)
  107.    FindMarker (Seg);
  108.    If Seg <> 0 then begin                  (* ist MARK ueberhaupt vorhanden? *)
  109.       RestoreIntVecTable (Seg); (* Interrupt-Vektoren wieder auf alten Stand *)
  110.       Repeat
  111.          Release (LastProg);                           (* Speicher freigeben *)
  112.          LastProg := LastProg^.Last;                   (* naechstes Programm *)
  113.       until Lower (LastProg^.Segment, Seg)   (* bis MARK-Segment freigegeben *)
  114.    End
  115.    else  WriteLn ('Fehler:  kein MARK gefunden!')
  116. End.
  117.