home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / dtx9303 / rtc / attimer.pas next >
Encoding:
Pascal/Delphi Source File  |  1993-06-03  |  12.2 KB  |  398 lines
  1. (* ------------------------------------------------------ *)
  2. (*                    ATTIMER.PAS                         *)
  3. (* Die Unit »ATTimer« ermöglicht einen einfachen und      *)
  4. (* sicheren Zugriff auf den RTC-Timer des AT. Der Timer   *)
  5. (* kann auf eine (nahezu) beliebige Frequenz zwischen 2   *)
  6. (* und 8192 Hz eingestellt werden, Subroutinen des        *)
  7. (* Anwenders ihrerseits mit einer eigenen Frequenz be-    *)
  8. (* trieben werden.                                        *)               
  9. (* WICHTIG: Da mit der Unit ein Programm bis zu 8192 mal  *)
  10. (* in der Sekunde aufgerufen wird, kann es gerade in      *)
  11. (* Multitasking-Systemen zu einer Überlastung kommen, die *)
  12. (* bis zu einer totalen Blockierung des Systems führen    *)
  13. (* kann. Die vom Timer aufgerufenen Routinen sollten daher*)
  14. (* möglichst kurz und schnell abzuarbeiten sein, sowie der*) 
  15. (* Timer selbst mit einer möglichst geringen Frequenz     *)
  16. (* installiert werden.                                    *)
  17. (*          (c) 1993 Jörn Eichler & DMV-Verlag            *)
  18. (* ------------------------------------------------------ *)
  19. UNIT ATTimer;
  20.  
  21. {$G+}                        (* UNIT nur ab 286 lauffähig *)
  22.  
  23. INTERFACE
  24.  
  25. USES Util;
  26.  
  27. TYPE
  28.  
  29.   (* Kontrollblock für eine vom Anwender
  30.      installierte Routine *)             
  31.  
  32.   pUserProcHead = ^tUserProcHead;
  33.   tUserProcHead = RECORD
  34.     Code1       : ARRAY [1..3] OF BYTE;
  35.     WaitCounter : WORD;
  36.     WaitTicks   : WORD;
  37.     Code2       : ARRAY [1..14] OF BYTE;
  38.     CallAddress : Pointer;
  39.     Code3       : BYTE;
  40.     JumpAddress : Pointer;
  41.     Frequency   : tFloat;
  42.   END;
  43.  
  44. CONST
  45.   MaxFrequency   = 8192;
  46.   stRTCInstalled = 1;
  47.  
  48.   RTCFrequency  : INTEGER = 0;
  49.   RTCTimerCalls : LongInt = 0;
  50.   RTCStatus     : BYTE    = 0;
  51.  
  52.   PROCEDURE InstallRTCTimer(Frequency : INTEGER);
  53.   PROCEDURE DeInstallRTCTimer;
  54.  
  55.   FUNCTION  InstallRTCUserProc(UserProc : Pointer;
  56.                       aFrequency : tFloat) : pUserProcHead;
  57.   PROCEDURE DeInstallRTCUserProc
  58.                       (VAR Control : pUserProcHead);
  59.  
  60. IMPLEMENTATION
  61.  
  62. USES Dos;
  63.  
  64. CONST
  65.   IRQ8         = $70;
  66.   RTCSelect    = $70;
  67.   RTCReadWrite = $71;
  68.  
  69. VAR
  70.   BIOSRunning  : Byte ABSOLUTE $40:$A0;
  71.                            (* BIOS feststellen & sperren *)
  72.   OldStatusA   : WORD;     (* RTC-Status sichern         *)
  73.   OldExitProc,
  74.   OldIRQ8      : Pointer;
  75.  
  76.  
  77.   PROCEDURE NoRTCProc; ASSEMBLER;
  78.     (* Rücksprung der Userprocs *)
  79.   ASM
  80.     RETF
  81.   END;
  82.  
  83. CONST
  84.   FirstRTCProc : pUserProcHead = @NoRTCProc;
  85.     (* Liste der Userprocs *)
  86.  
  87.   PROCEDURE FastRTCTimer; ASSEMBLER;
  88.   ASM
  89.     STI
  90.     PUSHA
  91.     PUSH DS
  92.     PUSH ES
  93.  
  94.     MOV  AX, Seg @DATA    (* DS mit Turbo-DS laden   *)
  95.     MOV  DS, AX
  96.  
  97.     MOV  AL, $0C          (* RTC Statusbyte C lesen  *)     
  98.     OUT  RTCSelect, AL
  99.     IN   AL, RTCReadWrite
  100.     TEST AL, $40          (* Ursache des Aufrufs     *)
  101.     JZ   @@En
  102.  
  103.     ADD  Word Ptr [RTCTimerCalls], 1
  104.     ADC  Word Ptr [RTCTimerCalls+2], 0
  105.     CALL FirstRTCProc
  106.   @@En:
  107.     MOV  AL, $20          (* EOI-Kommando an 8259     *)
  108.     OUT  $A0, AL          (* AT-8259 ansteuern        *)
  109.     OUT  $20, AL          (* PC-8259 ansteuern        *)
  110.     POP  ES               (* Register vom Stack holen *)
  111.     POP  DS
  112.     POPA
  113.     IRET                  (* Interrupt beenden        *)
  114.   END;
  115.  
  116.   PROCEDURE SlowRTCTimer; ASSEMBLER;
  117.     (* BIOS-kompatibler Timer *)
  118.   ASM
  119.     STI
  120.     PUSHA
  121.     PUSH DS
  122.     PUSH ES
  123.  
  124.     MOV  AX, Seg @DATA
  125.     MOV  DS, AX
  126.  
  127.     MOV  AL, $0B            (* RTC Steuerbyte B lesen   *)
  128.     MOV  DX, RTCSelect
  129.     OUT  DX, AL
  130.     INC  DX
  131.     JMP  @@W1               (* Warteroutine             *)
  132.   @@W1:
  133.     JMP  @@W2
  134.   @@W2:
  135.     JMP  @@W3
  136.   @@W3:
  137.     JMP  @@W4
  138.   @@W4:
  139.     IN   AL, DX
  140.     MOV  AH, AL
  141.  
  142.     MOV  AL, $0C           (* RTC Statusbyte C lesen  *)
  143.     MOV  DX, RTCSelect
  144.     OUT  DX, AL
  145.     INC  DX
  146.     JMP  @@W5              (* Warten ... (s. Text)    *)
  147.   @@W5:
  148.     JMP  @@W6
  149.   @@W6:
  150.     JMP  @@W7
  151.   @@W7:
  152.     JMP  @@W8
  153.   @@W8:
  154.     IN   AL, DX
  155.     AND  AL, AH            (* Fehlaufrufe ausblenden   *)
  156.     TEST AL, $40           (* Ursache des Aufrufs der  *)
  157.     JZ   @@En              (* zyklische Interrupt?     *)
  158.  
  159.     ADD  Word Ptr [RTCTimerCalls], 1
  160.     ADC  Word Ptr [RTCTimerCalls+2], 0
  161.     CALL FirstRTCProc
  162.  
  163.   @@En:
  164.     MOV  AL, $20           (* EOI-Kommando an 8259      *)
  165.     OUT  $A0, AL           (* AT-8259 ansteuern         *)
  166.     OUT  $20, AL           (* PC-8259 ansteuern         *)
  167.     POP  ES
  168.     POP  DS
  169.     POPA
  170.     IRET                                  
  171.   END;
  172.  
  173.   PROCEDURE WaitRTCPorts;
  174.     (* 4 SHORT JMPS zum Warten *)
  175.   INLINE($EB / $00 / $EB / $00 / $EB / $00 / $EB / $00 );
  176.  
  177.   PROCEDURE CLI; INLINE($FA);
  178.     (* Interrupts sperren     *)
  179.   PROCEDURE STI; INLINE($FB);
  180.     (* Interrupts freigeben   *)
  181.  
  182.   PROCEDURE InstallRTCTimer(Frequency : INTEGER);
  183.     (* Eingabe:                                           *)                  
  184.     (* Frequency = Frequenz, mit der Timer betrieben      *)
  185.     (*             werden soll                            *)
  186.     (* Ausgabe:                                           *)
  187.     (* RTCFrequency = tatsächliche Frequenz des Timers    *)
  188.     (*                (0 = nicht installiert)             *)
  189.     (* RTCStatus    = Status des Timers                   *)
  190.     (*                (Bit0 = 1: Timer installiert)       *)
  191.   VAR
  192.     Exp : BYTE;
  193.  
  194.     FUNCTION GetExp : BYTE;
  195.       (* Exponent zur Basis 2 holen *)
  196.     VAR
  197.       i    : BYTE;
  198.       Mask : WORD;
  199.     BEGIN
  200.       i    := 12;           (* max. 2^12 zulässig         *)
  201.       Mask := $1000;        (* binäre Entsprechung (2^12) *)
  202.       WHILE (i > 0) AND ((Mask AND Frequency) = 0) DO BEGIN
  203.          (* 1. Bit suchen *)
  204.         Dec(i);
  205.         Mask := Mask SHR 1;
  206.       END;
  207.       IF (i = 0) THEN       (* kein Bit gesetzt?           *)
  208.         GetExp := 1         (* Exponent = 1 (-> 2^1hz)     *)
  209.       ELSE IF (Frequency > Mask) THEN
  210.                             (* Frequenz nicht 2^x?         *) 
  211.         GetExp := i + 1     (* nächsthöhere Frequenz       *)
  212.       ELSE
  213.         GetExp := i;
  214.     END;
  215.  
  216.     FUNCTION InstallTimer(TimerProc : Pointer) : BOOLEAN;
  217.     VAR
  218.       Dummy       : BYTE;
  219.       StartTicks,
  220.       StartTimer  : LongInt;
  221.     BEGIN
  222.       SetIntVec(IRQ8, TimerProc);
  223.                              (* neuen IRQ8 installieren   *)
  224.       Port[RTCSelect] := $A; (* Frequenz programmieren    *)
  225.       WaitRTCPorts;
  226.       Port[RTCReadWrite] := $20 + ($F - (Exp - 1));
  227.       Port[$A1]          := Port[$A1] AND $FE;
  228.                              (* IRQ8 freigeben            *)
  229.       Port[RTCSelect]    := $B;                  
  230.                              (* zyklischen Timer freigeben*)
  231.       WaitRTCPorts;
  232.       Dummy              := Port[RTCReadWrite] OR $40;
  233.       WaitRTCPorts;
  234.       Port[RTCSelect]    := $B;
  235.       WaitRTCPorts;
  236.       Port[RTCReadWrite] := Dummy;
  237.  
  238.       StartTicks := BIOSTimer;
  239.                             (* Installationserfolg testen *)
  240.       StartTimer := RTCTimerCalls;
  241.       WHILE (StartTimer = RTCTimerCalls) AND
  242.             (( StartTicks + 9 ) > BIOSTimer) DO ;
  243.       InstallTimer := (StartTimer <> RTCTimerCalls);
  244.     END;
  245.  
  246.   BEGIN
  247.     DeInstallRTCTimer;
  248.     IF (Frequency >= MaxFrequency) THEN
  249.       Exp := 13
  250.     ELSE
  251.       Exp := GetExp;
  252.     GetIntVec(IRQ8, OldIRQ8); (* alten IRQ retten         *)
  253.     Port[$70] := $A;          (* Status A der RTC sichern *)
  254.     WaitRTCPorts;
  255.     OldStatusA := Port[$71];
  256.     IF NOT (InstallTimer(@FastRTCTimer)) THEN
  257.       IF NOT (InstallTimer(@SlowRTCTimer)) THEN BEGIN
  258.         Port[$70] := $A;      (* Installation gescheitert *)
  259.         WaitRTCPorts;
  260.         Port[$71] := OldStatusA;
  261.         SetIntVec(IRQ8, OldIRQ8);
  262.         Exit;
  263.       END;
  264.     RTCFrequency := 1 SHL Exp;
  265.     RTCStatus    := stRTCInstalled;
  266.     BIOSRunning  := BIOSRunning OR 1;
  267.                               (* RTC für BIOS sperren     *)     
  268.   END;
  269.  
  270.   PROCEDURE DeInstallRTCTimer;
  271.     (* Deinstalliert den zuvor mit InstallRTCTimer        *)
  272.     (* installierten Timer und stellt den alten Status der*)
  273.     (* RTC wieder her. Alle noch nicht deinstallierten    *)
  274.     (* Benutzerroutinen werden von DeInstallRTCTimer aus  *)
  275.     (* dem Speicher entfernt!                             *)
  276.   VAR
  277.     Dummy  : BYTE;
  278.     RunPtr : pUserProcHead;
  279.   BEGIN
  280.     IF ((RTCStatus AND stRTCInstalled) = stRTCInstalled)
  281.     THEN BEGIN
  282.       Port[RTCSelect]    := $A;
  283.       WaitRTCPorts;
  284.       Port[RTCReadWrite] := OldStatusA;
  285.       WaitRTCPorts;
  286.       Port[RTCSelect]    := $B;
  287.       WaitRTCPorts;
  288.       Dummy              := Port[RTCReadWrite] AND $BF;
  289.       WaitRTCPorts;
  290.       Port[RTCSelect]    := $B;
  291.       WaitRTCPorts;
  292.       Port[RTCReadWrite] := Dummy;
  293.       SetIntVec(IRQ8, OldIRQ8);
  294.       RunPtr := FirstRTCProc;
  295.       WHILE (RunPtr <> @NoRTCProc) DO BEGIN
  296.         FirstRTCProc := RunPtr^.JumpAddress;
  297.         Dispose(RunPtr);
  298.         RunPtr := FirstRTCProc;
  299.       END;
  300.       RTCFrequency  := 0;
  301.       RTCStatus     := 0;
  302.       RTCTimerCalls := 0;
  303.       BIOSRunning   := BIOSRunning AND $FE;
  304.     END;
  305.   END;
  306.  
  307. {$F+}
  308.   PROCEDURE UserProcHead; ASSEMBLER;
  309.      (* Kontrollcode der Userprocs *)
  310. {$F-}
  311.   ASM
  312.     CALL @@GetIP            (* IP auf den Stack bringen   *)
  313.     DW   $9090              (* Frequenzmodulationszähler  *)
  314.     DW   $9090              (* Frequenzmodulationswert    *)
  315.   @@GetIP:                                                 
  316.     POP  SI                 (* SI zeigt jetzt auf Daten   *)
  317.     DEC  Word Ptr CS:[SI]   (* Zähler erniedrigen         *)
  318.     JNZ  @@END              (* erst bei 0 Userroutine     *)
  319.     MOV  AX, CS:[SI+2]      (* zunächst Zähler neu        *)
  320.     MOV  CS:[SI], AX        (* initialisieren             *)
  321.     CALL UserProcHead       (* call intersegment direct   *)
  322.   @@END:                                                  
  323.     JMP  UserProcHead       (* jump intersegment direct   *)
  324.   END;
  325.  
  326.   FUNCTION InstallRTCUserProc(UserProc : Pointer;
  327.                       aFrequency : tFloat) : pUserProcHead;
  328.     (* Installiert eine Anwenderroutine, die mit einer    *)
  329.     (* bestimmten Frequenz vom RTC-Timer aufgerufen wird. *)
  330.     (* Die Routine muß dabei »far« definiert sein und     *)
  331.     (* zudem ohne Parameter aufgerufen werden. Sie sollte *)
  332.     (* möglichst schnell abgearbeitet werden, damit das   *)
  333.     (* System nicht überlastet wird. Die Frequenz sollte  *)
  334.     (* möglichst eine Potenz von 2 sein, da ansonsten     *)
  335.     (* leicht Rundungsfehler auftreten.                   *)
  336.   VAR
  337.     Control : pUserProcHead;
  338.   BEGIN
  339.     InstallRTCUserProc := NIL;                  
  340.     IF (UserProc = NIL) OR (aFrequency > RTCFrequency) OR
  341.        ((RTCFrequency / aFrequency) > 65535) THEN Exit;
  342.     New(Control);
  343.     IF (Control = NIL) THEN Exit;
  344.     Move(Pointer(@UserProcHead)^, Control^,
  345.          SizeOf(tUserProcHead));
  346.     WITH Control^ DO BEGIN
  347.       WaitTicks   := Round(RTCFrequency / aFrequency); 
  348.       WaitCounter := WaitTicks;
  349.       CallAddress := UserProc;
  350.       JumpAddress := FirstRTCProc;
  351.       Frequency   := aFrequency;
  352.     END;
  353.     CLI;
  354.     FirstRTCProc := Control;
  355.     STI;
  356.     InstallRTCUserProc := Control;
  357.   END;
  358.  
  359.   PROCEDURE DeInstallRTCUserProc(VAR Control : pUserProcHead);
  360.   VAR
  361.     RunPtr : pUserProcHead;
  362.   BEGIN
  363.     IF (Control = NIL) THEN Exit;
  364.     IF (FirstRTCProc = Control) THEN BEGIN
  365.       CLI;
  366.       FirstRTCProc := pUserProcHead(Control)^.JumpAddress;
  367.       STI;
  368.     END ELSE BEGIN
  369.       RunPtr := FirstRTCProc;       (* Block suchen       *)
  370.       WHILE (RunPtr <> @NoRTCProc) AND
  371.             (RunPtr^.JumpAddress <> Control) DO
  372.         RunPtr := RunPtr^.JumpAddress;
  373.       IF (RunPtr^.JumpAddress = Control) THEN BEGIN
  374.         CLI;
  375.         RunPtr^.JumpAddress :=
  376.                          pUserProcHead(Control)^.JumpAddress;
  377.         STI;
  378.       END ELSE
  379.         Exit;
  380.     END;
  381.     Dispose(pUserProcHead(Control));
  382.     Control := NIL;
  383.   END;
  384.  
  385.   PROCEDURE ExitATTimer; FAR;
  386.   BEGIN
  387.     ExitProc := OldExitProc;
  388.     DeInstallRTCTimer;
  389.   END;
  390.  
  391. BEGIN
  392.   OldExitProc := ExitProc;
  393.   ExitProc    := @ExitATTimer;
  394. END.
  395. (* ------------------------------------------------------ *)
  396. (*               Ende von ATTIMER.PAS                     *)
  397.  
  398.