home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1988 / 12 / praxis / monitor.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-09-13  |  16.6 KB  |  383 lines
  1. (* ┌───────────────────────────────────────────────────────────────────────┐
  2.    │       MONITOR (v1.0)  -  Überwachung der Programm-Ladevorgänge        │
  3.    │                                                                       │
  4.    │              (c) 1988   TOOLBOX  &  Karsten Gieselmann                │
  5.    └───────────────────────────────────────────────────────────────────────┘ *)
  6.  
  7. {$R-,S-,I-,V-,B-,N-}     (* keine Fehlerprüfungen, maximale Geschwindigkeit! *)
  8. {$M 1024,2048,2048}               (* minimaler Stackbedarf reicht schon aus! *)
  9.  
  10. PROGRAM Monitor;
  11.  
  12. USES
  13.   Dos;                                  (* Mehr Units werden nicht benötigt! *)
  14.  
  15. CONST
  16.   Version : STRING[16] = 'RSM Monitor v1.0';     (* Versionsname und -nummer *)
  17.   Name    = 'MONITOR.EXE';                     (* Name des MONITOR-Programms *)
  18.   IFC     = $65;                        (* Interruptvektor zur Adreßübergabe *)
  19.  
  20. (* ------- Routinen für Umschaltung auf einen eigenen Laufzeitstapel ------- *)
  21.  
  22. VAR
  23.   SaveSS, SaveSP,                 (* Zwischenspeicher für alten Stapelzeiger *)
  24.   MonSS, MonSP    : WORD;                   (* Zeiger auf den MONITOR-Stapel *)
  25.  
  26.  
  27. PROCEDURE SwitchStack;
  28.   (* vom aktuellen Stack auf den Monitor-Stapel umschalten *)
  29. INLINE(
  30.   $8C/$16/SaveSS/                (*  MOV [SaveSS],SS   ;alten Stapelzeiger...*)
  31.   $89/$26/SaveSP/                (*  MOV [SaveSP],SP   ;...sichern           *)
  32.   $FA/                           (*  CLI               ;Interrupts verbieten *)
  33.   $8E/$16/MonSS/                 (*  MOV SS,[MonSS]    ;Zeiger auf eigenen...*)
  34.   $8B/$26/MonSP/                 (*  MOV SP,[MonSP]    ;..Stapel richten!    *)
  35.   $FB);                          (*  STI               ;Interrupts erlauben  *)
  36.  
  37.  
  38. PROCEDURE RestoreStack;
  39.   (* vom Monitor-Stapel zurück auf den gesicherten Stack schalten *)
  40. INLINE(
  41.   $FA/                           (*  CLI               ;Interrupts verbieten *)
  42.   $8E/$16/SaveSS/                (*  MOV SS,[SaveSS]   ;Zeiger restaurieren  *)
  43.   $8B/$26/SaveSP/                (*  MOV SP,[SaveSP]   ;                     *)
  44.   $FB);                          (*  STI               ;Interrupts erlauben  *)
  45.  
  46. (* ----------------- Routinen zum Aufbau der Programmliste ----------------- *)
  47.  
  48. TYPE
  49.   VectorTable = ARRAY[0..$FF] OF POINTER;                (* Interrupttabelle *)
  50.   ProgramData = RECORD
  51.                   ProgramName   : ^STRING;   (* Name des geladenen Programms *)
  52.                   ProgramSeg,                   (* Ladesegment des Programms *)
  53.                   EnvironSeg    : WORD;     (* Adresse des Umgebungsbereichs *)
  54.                   ProgramSize,                     (* Programmgröße in Bytes *)
  55.                   EnvironSize   : LONGINT;        (* Umgebungsgröße in Bytes *)
  56.                   TotalHooked   : BYTE;          (* Anzahl benutzte Vektoren *)
  57.                   HookedVectors : SET OF BYTE;           (* Vektoren-Nummern *)
  58.                   SavedVectors  : ^VectorTable;       (* gesicherte Vektoren *)
  59.                 END;
  60.  
  61. CONST
  62.   ListSize = 100;                        (* maximale Größe der Programmliste *)
  63.  
  64. VAR
  65.   ProgramList    : ARRAY[0..ListSize] OF ^ProgramData;          (* die Liste *)
  66.   j, k           : BYTE;                                    (* Zählvariablen *)
  67.   c              : ^CHAR;
  68.   LastEntry,                             (* Index des letzten Listenelements *)
  69.   ES_,
  70.   CurrentPSP     : WORD;              (* PSP des zuletzt geladenen Programms *)
  71.   CurrentName    : STRING;           (* Name des zuletzt geladenen Programms *)
  72.   Overflow,                           (* ist ein Listenüberlauf aufgetreten? *)
  73.   Released,                       (* letztes Programm aus Speicher entfernt? *)
  74.   Terminated     : BOOLEAN;                   (* Programmausführung beendet? *)
  75.   BackupTable    : VectorTable;               (* gesicherte Interrupttabelle *)
  76.   InterruptTable : VectorTable ABSOLUTE 0:0;    (* aktuelle Interrupttabelle *)
  77.  
  78.  
  79. PROCEDURE InitializeList;
  80.   (* bereitet die Liste für die Aufnahme von Daten vor *)
  81. VAR
  82.   k : WORD;
  83. BEGIN
  84.   Overflow := FALSE;
  85.   BackupTable := InterruptTable;
  86.   BackupTable[$22] := POINTER(MemL[MemW[PrefixSeg:$16]:$0A]);
  87.   GetMem(ProgramList[0], SizeOf(Version));
  88.   Move(Version, ProgramList[0]^, SizeOf(Version));
  89.   SetIntVec(IFC, @ProgramList[0]);                     (* Zeiger auf Kennung *)
  90.   FOR k:=1 TO ListSize DO
  91.     ProgramList[k] := NIL;          (* Ausgangszustand der Liste ist "leer"! *)
  92.   LastEntry := 0;
  93.   CurrentName := Name;          (* den ersten Eintrag belegt MONITOR selbst! *)
  94.   Terminated := TRUE;
  95.   Released := FALSE;
  96. END;
  97.  
  98.  
  99. PROCEDURE AppendProgram;
  100.   (* hängt das zuletzt geladene Programm an die Programmliste an *)
  101. BEGIN
  102.   Inc(LastEntry);                                  (* nächstes Listenelement *)
  103.   New(ProgramList[LastEntry]);
  104.   WITH ProgramList[LastEntry]^ DO BEGIN  (* Listenelement mit Daten besetzen *)
  105.     GetMem(ProgramName, Succ(Length(CurrentName)));
  106.     Move(CurrentName, ProgramName^, Succ(Length(CurrentName)));
  107.     ProgramSeg := CurrentPSP;
  108.     EnvironSeg := MemW[ProgramSeg:$2C];
  109.     ProgramSize := LONGINT(MemW[ProgramSeg-1:3])*16;
  110.     IF (EnvironSeg <> 0) AND (MemW[EnvironSeg-1:1] = ProgramSeg) THEN
  111.       EnvironSize := LONGINT(MemW[EnvironSeg-1:3])*16
  112.     ELSE
  113.       EnvironSize := 0;
  114.     HookedVectors := [];
  115.     TotalHooked := 0;
  116.     FOR k:=0 TO 255 DO
  117.       IF BackupTable[k] <> InterruptTable[k] THEN BEGIN   (* Vektor benutzt? *)
  118.         HookedVectors := HookedVectors + [k];
  119.         Inc(TotalHooked);
  120.       END;
  121.     GetMem(SavedVectors, TotalHooked*SizeOf(POINTER));     (* Vektor sichern *)
  122.     j := 0;
  123.     FOR k:=0 TO 255 DO
  124.       IF k IN HookedVectors THEN BEGIN
  125.         SavedVectors^[j] := BackupTable[k];
  126.         Inc(j);
  127.       END;
  128.   END;
  129. END;
  130.  
  131.  
  132. PROCEDURE DeleteProgram(Index : WORD);
  133.   (* löscht alle Programme von Index..LastEntry aus der Liste heraus *)
  134. BEGIN
  135.   IF (Index > 0) AND (Index <= LastEntry) THEN           (* erlaubter Index? *)
  136.     WITH ProgramList[Index]^ DO BEGIN
  137.       FreeMem(SavedVectors, TotalHooked*SizeOf(POINTER));
  138.       FreeMem(ProgramName, Succ(Length(ProgramName^)));
  139.       Dispose(ProgramList[Index]);
  140.       ProgramList[Index] := NIL;
  141.       IF Index = LastEntry THEN     (* gelöschtes Programm war das letzte... *)
  142.         Dec(LastEntry);                           (* ...also Liste verkürzen *)
  143.     END;
  144. END;
  145.  
  146.  
  147. PROCEDURE ExitCheck;
  148.   (* Programm wurde normal beendet:  es erfolgt keine Aufnahme in die Pro-
  149.      grammliste bzw. Shell-Programme werden wieder aus der Liste entfernt.   *)
  150. BEGIN
  151.   Terminated := TRUE;                 (* Programmausführung wurde beendet... *)
  152.   Released := TRUE;                 (* ...und Programm aus Speicher entfernt *)
  153.   IF CurrentName = '' THEN
  154.     DeleteProgram(LastEntry);          (* war schon in Liste: wieder löschen *)
  155.   CurrentName := '';
  156. END;
  157.  
  158. (* ---- Interruptroutinen zur Überwachung des "DOS Process Management" ----- *)
  159.  
  160. TYPE
  161.   IntRegisters = RECORD CASE BYTE OF
  162.                     1 : (BP,ES,DS,DI,SI,DX,CX,BX,AX,IP,CS,Flags : WORD);
  163.                     2 : (Dummy : ARRAY[1..5] OF WORD;
  164.                          DL,DH,CL,CH,BL,BH,AL,AH : BYTE);
  165.                  END;
  166.  
  167. VAR
  168.   SaveInt20,                (* alte Werte der vom MONITOR benutzten Vektoren *)
  169.   SaveInt21,
  170.   SaveInt27,
  171.   ChainAddr : POINTER;
  172.   RegsAddr  : ^IntRegisters;
  173.  
  174.  
  175. FUNCTION PSP : WORD;
  176.   (* ermittelt das Ladesegment des aktuellen Programms *)
  177. INLINE(
  178.   $B4/$62/                     (*  MOV   AH,62    ;Funktion Nr.62, "Get PSP" *)
  179.   $9C/                         (*  PUSHF          ;Flags für Interruptaufruf *)
  180.   $FF/$1E/SaveInt21/           (*  CALL  FAR [..] ;Int-Aufruf simulieren     *)
  181.   $89/$D8);                    (*  MOV   AX,BX    ;PSP nach AX zur Übergabe  *)
  182.  
  183.  
  184. PROCEDURE ChainInt(Regs : IntRegisters; Address : POINTER);
  185.   (* Weiterführen der Interrupt-Bearbeitung durch die alte Service-Routine;
  186.      Restaurieren der CPU-Register gemäß "Regs" und Verzweigung zu "Address" *)
  187. INLINE(
  188.   $5B/                  (*  POP  BX         ;"Address" nach AX:BX holen      *)
  189.   $58/                  (*  POP  AX         ;                                *)
  190.   $5E/                  (*  POP  SI         ;Zeiger auf "Regs" nach DS:SI    *)
  191.   $1F/                  (*  POP  DS         ;                                *)
  192.   $87/$5C/$0E/          (*  XCHG BX,[SI+0E] ;Regs.BX <-> BX (=Ofs(Address))  *)
  193.   $87/$44/$10/          (*  XCHG AX,[SI+10] ;Regs.AX <-> AX (=Seg(Address))  *)
  194.   $8B/$54/$16/          (*  MOV  DX,[SI+16] ;DX mit Regs.Flags besetzen...   *)
  195.   $52/                  (*  PUSH DX         ;...und über den Stapel...       *)
  196.   $9D/                  (*  POPF            ;...in das Statusregister laden  *)
  197.   $8C/$DA/              (*  MOV  DX,DS      ;                                *)
  198.   $FA/                  (*  CLI             ;Interrupts unterbinden          *)
  199.   $8E/$D2/              (*  MOV  SS,DX      ;Stapelzeiger auf "Regs"         *)
  200.   $89/$F4/              (*  MOV  SP,SI      ;                                *)
  201.   $FB/                  (*  STI             ;Interrupts wieder erlauben      *)
  202.   $5D/                  (*  POP  BP         ;Register gemäß "Regs" besetzen  *)
  203.   $07/                  (*  POP  ES         ;                                *)
  204.   $1F/                  (*  POP  DS         ;                                *)
  205.   $5F/                  (*  POP  DI         ;                                *)
  206.   $5E/                  (*  POP  SI         ;                                *)
  207.   $5A/                  (*  POP  DX         ;                                *)
  208.   $59/                  (*  POP  CX         ;                                *)
  209.   $CB);                 (*  RETF            ;und Sprung zu "Address" (AX:BX) *)
  210.  
  211.  
  212. {$F+}     (* alle Interruptroutinen müssen im FAR-Modell kompiliert werden!! *)
  213.  
  214. PROCEDURE ISR_Int20(BP : WORD); INTERRUPT;
  215.   (* Interrupt 20h: "Program Terminate" *)
  216. VAR
  217.   Regs : IntRegisters ABSOLUTE BP;       (* Register beim Interrupt-Eintritt *)
  218. BEGIN
  219.   ChainAddr := SaveInt20;
  220.   RegsAddr := @Regs;
  221.   IF NOT Overflow THEN BEGIN
  222.     SwitchStack;                            (* auf eigenen Stapel umschalten *)
  223.     ExitCheck;                        (* Programm beendet und nicht resident *)
  224.     RestoreStack;                          (* wieder zurück zum alten Stapel *)
  225.   END;
  226.   ChainInt(Regs, ChainAddr);           (* weiter mit der alten Int20-Routine *)
  227. END;
  228.  
  229.  
  230. PROCEDURE ISR_Int23(BP : WORD); INTERRUPT;
  231.   (* Interrupt 23h: "Control-C Handler Address" *)
  232. VAR
  233.   Regs : IntRegisters ABSOLUTE BP;       (* Register beim Interrupt-Eintritt *)
  234. BEGIN
  235.   ChainAddr := SaveInt23;
  236.   RegsAddr := @Regs;
  237.   IF NOT Overflow THEN BEGIN
  238.     SwitchStack;                            (* auf eigenen Stapel umschalten *)
  239.     ExitCheck;                        (* Programm beendet und nicht resident *)
  240.     RestoreStack;                          (* wieder zurück zum alten Stapel *)
  241.   END;
  242.   ChainInt(Regs, ChainAddr);           (* weiter mit der alten Int27-Routine *)
  243. END;
  244.  
  245.  
  246. PROCEDURE ISR_Int21(BP : WORD); INTERRUPT;
  247.   (* Interrupt 21h: DOS-Funktionsinterrupt *)
  248. VAR
  249.   Regs : IntRegisters ABSOLUTE BP;       (* Register beim Interrupt-Eintritt *)
  250. BEGIN
  251.   ChainAddr := SaveInt21;
  252.   RegsAddr := @Regs;
  253.   IF NOT Overflow THEN WITH Regs DO
  254.     CASE AH OF
  255.       $31 :                                                (* "Keep Process" *)
  256.         BEGIN
  257.           CurrentPSP := PSP;                      (* Programm-Segment merken *)
  258.           Terminated := TRUE;            (* beendet und resident installiert *)
  259.         END;
  260.  
  261.       $49 :                                       (* "Free Allocated Memory" *)
  262.         BEGIN
  263.           ES_ := ES;                          (* Zugriff auf Regs.ES sichern *)
  264.           SwitchStack;                      (* auf eigenen Stapel umschalten *)
  265.           IF (ES_ = CurrentPSP) AND Terminated THEN
  266.             Released := TRUE
  267.           ELSE                                          (* Liste durchsuchen *)
  268.             FOR k:=LastEntry DOWNTO 1 DO
  269.               IF ProgramList[k]^.ProgramSeg = ES_ THEN          (* in Liste? *)
  270.                 DeleteProgram(k);
  271.           RestoreStack;                    (* wieder zurück zum alten Stapel *)
  272.         END;
  273.  
  274.       $4B :
  275.         IF AL = 0 THEN BEGIN                   (* "Load and Execute Program" *)
  276.           c := Ptr(DS, DX);                (* Zeiger auf Programmnamen holen *)
  277.           SwitchStack;                      (* auf eigenen Stapel umschalten *)
  278.           IF NOT Terminated THEN                      (* ein Shell-Programm! *)
  279.             CurrentPSP := PSP;
  280.           IF NOT Released THEN           (* letztes Programm nicht entfernt: *)
  281.             AppendProgram;                      (* ...dann an Liste anhängen *)
  282.           k := 0;
  283.           WHILE c^ <> #0 DO BEGIN               (* neuen Programmnamen holen *)
  284.             CurrentName[k+1] := Upcase(c^);
  285.             Inc(LONGINT(c));                             (* nächstes Zeichen *)
  286.             Inc(k);
  287.           END;
  288.           CurrentName[0] := Chr(k);               (* Zeichenlänge des Namens *)
  289.           BackupTable := InterruptTable;         (* Interrupttabelle sichern *)
  290.           SaveInt23 := InterruptTable[$23];              (* alter ^C-Handler *)
  291.           InterruptTable[$23] := @ISR_Int23;           (* eigener ^C-Handler *)
  292.           Terminated := FALSE;
  293.           Released := FALSE;
  294.           RestoreStack;                    (* wieder zurück zum alten Stapel *)
  295.         END;
  296.  
  297.       $00, $4C :                       (* "Terminate Program", "End Process" *)
  298.         BEGIN
  299.           SwitchStack;                      (* auf eigenen Stapel umschalten *)
  300.           ExitCheck;                  (* Programm beendet und nicht resident *)
  301.           RestoreStack;                    (* wieder zurück zum alten Stapel *)
  302.         END;
  303.     END;
  304.   ChainInt(Regs, ChainAddr)            (* weiter mit der alten Int21-Routine *)
  305. END;
  306.  
  307.  
  308. PROCEDURE ISR_Int27(BP : WORD); INTERRUPT;
  309.   (* Interrupt 27h: "Terminate and Stay Resident" *)
  310. VAR
  311.   Regs : IntRegisters ABSOLUTE BP;       (* Register beim Interrupt-Eintritt *)
  312. BEGIN
  313.   ChainAddr := SaveInt27;
  314.   RegsAddr := @Regs;
  315.   IF NOT Overflow THEN BEGIN
  316.     CurrentPSP := PSP;                            (* Programm-Segment merken *)
  317.     Terminated := TRUE;                  (* beendet und resident installiert *)
  318.   END;
  319.   ChainInt(Regs, ChainAddr);           (* weiter mit der alten Int27-Routine *)
  320. END;
  321.  
  322.  
  323. FUNCTION ReInstall(Size : WORD) : INTEGER;
  324.   (* Abschalten des MONITORs beim Auftreten eines Heap-Überlaufs *)
  325. BEGIN
  326.   Overflow := TRUE;                   (* MONITOR-Routinen außer Kraft setzen *)
  327.   MemL[0:IFC*4] := $FFFFFFFF;                    (* Listenüberlauf anzeigen! *)
  328.   RestoreStack;                         (* wieder zurück zum alten Stapel... *)
  329.   ChainInt(RegsAddr^, ChainAddr); (* ...und weiter mit der abgebrochenen ISR *)
  330. END;
  331.  
  332. {$F-}                 (* Ende der im FAR-Modell zu kompilierenden Routinen!! *)
  333.  
  334. (* ------------------------- Installationsteil ----------------------------- *)
  335.  
  336. FUNCTION InterfaceNotUsed : BOOLEAN;
  337.   (* ist der Interface-Interruptvektor bereits benutzt? *)
  338. VAR
  339.   Address : POINTER;
  340. BEGIN
  341.   GetIntVec(IFC, Address);
  342.   InterfaceNotUsed := (Address = Ptr($0000, $0000));
  343. END;
  344.  
  345.  
  346. PROCEDURE RestoreVectors;
  347.   (* Rücksetzen der von Turbo benutzten Interruptvektoren *)
  348. BEGIN
  349.   SetIntVec($00, SaveInt00);
  350.   SetIntVec($24, SaveInt24);
  351. END;
  352.  
  353.  
  354. PROCEDURE Install_ISRs;
  355.   (* Installation der Monitor-Prozeduren als Interrupt-Service-Routinen *)
  356. BEGIN
  357.   GetIntVec($20, SaveInt20);                (* Sichern der alten Vektoren... *)
  358.   GetIntVec($21, SaveInt21);
  359.   GetIntVec($27, SaveInt27);
  360.   SetIntVec($20, @ISR_Int20);         (* ...und Installieren der neuen ISR's *)
  361.   SetIntVec($21, @ISR_Int21);
  362.   SetIntVec($27, @ISR_Int27);
  363. END;
  364.  
  365.  
  366. BEGIN
  367.   Write(^M^J, Version);                          (* Versionsmeldung ausgeben *)
  368.   IF InterfaceNotUsed THEN
  369.     WriteLn(' installiert!')
  370.   ELSE BEGIN                                                     (* Abbruch! *)
  371.     WriteLn(' nicht installiert,');
  372.     WriteLn('Programm bereits resident oder Interface-Vektor benutzt!');
  373.     Halt;
  374.   END;
  375.   MonSS := SSeg;                                       (* Stapelwerte merken *)
  376.   MonSP := SPtr;
  377.   RestoreVectors;                (* von Turbo benutzte Vektoren zurücksetzen *)
  378.   InitializeList;                            (* Programmliste initialisieren *)
  379.   HeapError := @ReInstall;        (* eigene Heap-Fehlerbehandlung aktivieren *)
  380.   Install_ISRs;                     (* eigene Interruptroutinen installieren *)
  381.   Keep(0);                                             (* resident machen!!! *)
  382. END.
  383.