home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / dtx9303 / rtc / util.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1993-06-03  |  8.6 KB  |  266 lines
  1. (* ------------------------------------------------------ *)
  2. (*                      UTIL.PAS                          *)
  3. (*            (c) Jörn Eichler & DMV-Verlag               *)
  4. (* ------------------------------------------------------ *)
  5. UNIT Util;
  6.  
  7. INTERFACE
  8.  
  9. TYPE
  10.   PtrRec = RECORD      (* Bildet einen Zeiger im Speicher *)
  11.     Ofs : Word;        (* nach, so daß auf seine Bestand- *)
  12.     Seg : Word;        (* teile zugegriffen werden kann.  *)
  13.   END;
  14.  
  15.   pFloat = ^tFloat;    (* Zeiger auf eine Floatvariable   *)
  16.   tFloat = Real;       (* Grundlage ist Real              *)
  17.  
  18.   pLinkHeader = ^tLinkHeader;
  19.                        (* Beginn jedes Link-Kontroll-     *)
  20.   tLinkHeader = RECORD (* Blocks (Objekt<->Prozedur)      *)
  21.     ShortJMP : Byte;   (* short jmp an den Beginn des     *)
  22.     Offset   : ShortInt;(* eigentlichen Verknüpfungscodes *) 
  23.     LinkSize : Word;   (* Länge des Kontrollblocks        *)
  24.                        (* ab hier DataSize eigene Daten   *)
  25.   END;
  26.  
  27. VAR
  28.   BIOSTimer : LongInt ABSOLUTE $40:$6C;
  29.  
  30.   FUNCTION  GetInterruptLink(Method, Self : Pointer;
  31.                              DataSize     : Byte) : Pointer;
  32.   FUNCTION  GetProcedureLink(Method, Self : Pointer;
  33.                              DataSize     : Byte) : Pointer;
  34.   PROCEDURE DisposeLink(VAR Link : Pointer);
  35.  
  36.   FUNCTION  GetCPUOccupation : INTEGER;
  37.                                    (* CPU-Ressourcen in % *)
  38.  
  39.   FUNCTION  PtrToInt(p : Pointer) : LongInt;         
  40.   FUNCTION  IntToPtr(l : LongInt) : Pointer;          
  41.   FUNCTION  AddPtr(p : Pointer; Size : LongInt) : Pointer;   
  42.   PROCEDURE IncPtr(VAR p; Size : LongInt);        
  43.   PROCEDURE NormalizePtr(VAR p);
  44.  
  45. IMPLEMENTATION
  46.  
  47. CONST
  48.   LowestCPUOccupation : LongInt = 0;
  49.  
  50.   FUNCTION GetCPUOccupation : INTEGER;
  51.     (* Ermittelt die momentane Auslastung der CPU in      *)
  52.     (* Prozent relativ zur geringsten Auslastung, bei     *)
  53.     (* der diese Routine aufgerufen wurde. Gemessen wird  *)
  54.     (* die Beanspruchung des Systems durch Hintergrund-   *)
  55.     (* prozesse.                                          *)
  56.   VAR
  57.     StartTimer : LongInt;
  58.     Occupation : LongInt;
  59.   BEGIN
  60.     Occupation := 0;
  61.     StartTimer := BIOSTimer + 1;
  62.     WHILE (StartTimer > BIOSTimer) DO ;
  63.     StartTimer := BIOSTimer + 2;
  64.     WHILE (StartTimer > BIOSTimer) DO
  65.       Inc(Occupation);
  66.     IF (Occupation > LowestCPUOccupation) THEN
  67.       LowestCPUOccupation := Occupation;
  68.     GetCPUOccupation := 100 -
  69.             Round((Occupation / LowestCPUOccupation) * 100);
  70.   END;
  71.  
  72.   PROCEDURE InterruptLink; ASSEMBLER;
  73.   ASM
  74.  
  75.     (* Header wird von der Link-Routine eingefügt! *)
  76.  
  77.     PUSH  AX
  78.     PUSH  BX
  79.     PUSH  CX
  80.     PUSH  DX
  81.     PUSH  SI
  82.     PUSH  DI
  83.     PUSH  DS
  84.     PUSH  ES
  85.  
  86.     MOV  AX, Seg @DATA  (* DS mit Datensegment laden  *)
  87.     MOV  DS, AX
  88.     MOV  AX, $FFFF      (* Segmentteil von Self       *)
  89.     PUSH AX
  90.     MOV  AX, $FFFF      (* Offsetteil von Self        *)
  91.     PUSH AX
  92.     DB   $9A            (* call intersegment direct   *)
  93.     DD   0              (* method address             *)
  94.  
  95.     POP  ES
  96.     POP  DS
  97.     POP  DI
  98.     POP  SI
  99.     POP  DX
  100.     POP  CX
  101.     POP  BX
  102.     POP  AX
  103.     IRET
  104.   END;
  105.  
  106.   FUNCTION GetInterruptLink(Method, Self : Pointer;
  107.                             DataSize     : Byte ) : Pointer;
  108.     (* Ermöglicht die Verwendung einer Objekt-Methode als *)
  109.     (* Interrupt-Routine. Die Methode muß dabei ohne      *)
  110.     (* Parameter definiert sein. Der zurückgelieferte     *)
  111.     (* Kontrollblock dient gleichzeitig zur               *)
  112.     (* Deinstallation der Verknüpfung und wird als        *)
  113.     (* Interruptroutine verwendet.                        *)
  114.     (* Eingabe:                                           *)
  115.     (*   Method   = Zeiger auf die Objektmethode          *)
  116.     (*              (z.B. @Demo.Method)                   *)
  117.     (*   Self     = Zeiger auf die Instanz (immer @Self)  *)
  118.     (*   DataSize = eventuell noch zusätzlich verwendbarer*)
  119.     (*              Speicher auf dem innerhalb des        *)
  120.     (*              Kontrollblockes (nach dem tLinkHeader)*)
  121.     (*  Ausgabe:                                          *)
  122.     (*   Zeiger auf den Kontrollblock, der wie ein Zeiger *)
  123.     (*   auf eine Interruptroutine verwendet werden kann  *)
  124.     (*   und zur Deinstallation der Verknüpfung benötigt  *)
  125.     (*   wird. NIL = Fehler.                              *)
  126.   TYPE
  127.     pInterruptLink = ^tInterruptLink;
  128.     tInterruptLink = RECORD
  129.       Code1   : ARRAY[1..14] OF BYTE;
  130.       SelfSeg : Word;
  131.       Code2   : ARRAY[1..2] OF BYTE;
  132.       SelfOfs : WORD;
  133.       Code3   : ARRAY[1..2] OF BYTE;
  134.       Method  : Pointer;
  135.       Code4   : ARRAY[1..9] OF BYTE;
  136.     END;
  137.   VAR
  138.     Link : Pointer;
  139.   BEGIN
  140.     GetInterruptLink := NIL;
  141.     IF (Method = NIL) OR (Self = NIL) OR
  142.        (DataSize > 122) THEN Exit;
  143.     GetMem(Link, SizeOf(tInterruptLink) +
  144.            SizeOf(tLinkHeader) + DataSize);
  145.     WITH pLinkHeader(Link)^ DO BEGIN
  146.       ShortJMP := $EB;
  147.       Offset   := 2 + DataSize;
  148.       LinkSize := SizeOf(tInterruptLink) +
  149.                   SizeOf(tLinkHeader) + DataSize;
  150.     END;
  151.     GetInterruptLink := Link;
  152.     IncPtr(Link, SizeOf(tLinkHeader) + DataSize);
  153.     Move(Pointer(@InterruptLink)^, Link^,
  154.          SizeOf(tInterruptLink));
  155.     WITH pInterruptLink(Link)^ DO BEGIN
  156.       SelfSeg := PtrRec(Self).Seg;
  157.       SelfOfs := PtrRec(Self).Ofs;
  158.     END;
  159.     pInterruptLink(Link)^.Method := Method;
  160.   END;
  161.  
  162.   PROCEDURE ProcedureLink; ASSEMBLER;
  163.   ASM
  164.  
  165.   (* Header wird von Link-Prozedur eingefügt,
  166.     DS muß bereits Datensegment
  167.     enthalten, die übrigen Register sind undefiniert... *)
  168.  
  169.     POP  AX               (* Rücksprungadresse sichern  *)
  170.     POP  BX
  171.  
  172.     MOV  CX, $FFFF        (* @Self als impliziten Para- *)
  173.     PUSH CX               (* meter auf den Stack        *)
  174.     MOV  CX, $FFFF
  175.     PUSH CX
  176.  
  177.     PUSH BX               (* Rücksprungadresse zurück-  *)
  178.     PUSH AX               (* schreiben                  *)
  179.  
  180.     DB   $EA              (* jump intersegment direct   *)
  181.     DD   0                (* method address             *)
  182.   END;
  183.  
  184.   FUNCTION GetProcedureLink(Method, Self : Pointer;
  185.                             DataSize     : BYTE) : Pointer;
  186.     (* Ermöglicht die Verwendung einer Objektmethode als  *)
  187.     (* "normale" Funktion bzw. Prozedur z.B. über         *)
  188.     (* Prozedurzeiger.                                    *)
  189.   TYPE
  190.     pProcedureLink = ^tProcedureLink;
  191.     tProcedureLink = RECORD
  192.       Code1   : ARRAY [1..3] OF BYTE;
  193.       SelfSeg : WORD;
  194.       Code2   : ARRAY [1..2] OF BYTE;
  195.       SelfOfs : WORD;
  196.       Code3   : ARRAY [1..4] OF BYTE;
  197.       Method  : Pointer;
  198.     END;
  199.   VAR
  200.     Link : Pointer;
  201.   BEGIN
  202.     GetProcedureLink := NIL;
  203.     IF (Method = NIL) OR (Self = NIL) OR
  204.        (DataSize > 122) THEN Exit;
  205.     GetMem(Link, SizeOf(tProcedureLink) +
  206.            SizeOf(tLinkHeader) + DataSize);
  207.     WITH pLinkHeader(Link)^ DO BEGIN
  208.       ShortJMP := $EB;
  209.       Offset   := 2 + DataSize;
  210.       LinkSize := SizeOf(tProcedureLink) +
  211.                   SizeOf(tLinkHeader) + DataSize;
  212.     END;
  213.     GetProcedureLink := Link;
  214.     IncPtr(Link, SizeOf(tLinkHeader) + DataSize);
  215.     Move(Pointer(@ProcedureLink)^, Link^,
  216.          SizeOf(tProcedureLink));
  217.     WITH pProcedureLink(Link)^ DO BEGIN
  218.       SelfSeg := PtrRec(Self).Seg;
  219.       SelfOfs := PtrRec(Self).Ofs;
  220.     END;
  221.     pProcedureLink(Link)^.Method := Method;
  222.   END;
  223.  
  224.   PROCEDURE DisposeLink(VAR Link : Pointer);
  225.   (* Löscht die mittels GetInterruptLink oder             *)
  226.   (* GetProcedureLink erstellte Verknüpfung zwischen einer*)
  227.   (* Objektmethode und ihrem Äquvivalent vom Heap.        *)
  228.   BEGIN
  229.     IF (Link <> NIL) AND
  230.        (pLinkHeader(Link)^.ShortJMP = $EB) THEN BEGIN
  231.       FreeMem(Link, pLinkHeader(Link )^.LinkSize);
  232.       Link := NIL;
  233.     END;
  234.   END;
  235.  
  236.   FUNCTION PtrToInt(p : Pointer) : LongInt;
  237.   BEGIN
  238.     PtrToInt := (LongInt(PtrRec(p).Seg) SHL 4) +
  239.                 PtrRec(p).Ofs;
  240.   END;
  241.  
  242.   FUNCTION IntToPtr(l : LongInt) : Pointer;
  243.   BEGIN
  244.     IntToPtr := Ptr(Word(l SHR 4), l AND $F);
  245.   END;
  246.  
  247.   FUNCTION AddPtr(p : Pointer; Size : LongInt) : Pointer;
  248.   BEGIN
  249.     AddPtr := IntToPtr(PtrToInt(p) + Size);
  250.   END;
  251.  
  252.   PROCEDURE IncPtr(VAR p; Size : LongInt);
  253.   BEGIN
  254.     Pointer(p) := IntToPtr(PtrToInt(Pointer(p)) + Size);
  255.   END;
  256.  
  257.   PROCEDURE NormalizePtr(VAR p);
  258.   BEGIN
  259.     Inc(PtrRec(p).Seg, PtrRec(p).Ofs SHR 4);
  260.     PtrRec(p).Ofs := PtrRec(p).Ofs AND $F;
  261.   END;
  262.  
  263. END.
  264. (* ------------------------------------------------------ *)
  265. (*                 Ende von UTIL.PAS                      *)
  266.