home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / communic / miniterm / serielli.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1990-07-31  |  45.5 KB  |  1,514 lines
  1. (*************************************************************************)
  2. (*                                                                       *)
  3. (*  Unit SeriellInterface                                                *)
  4. (*                                                                       *)
  5. (*************************************************************************)
  6. (*                                                                       *)
  7. (* Programmierer ........ Stefan Graf / 4600 Dortmund 1 / BRD            *)
  8. (*                                                                       *)
  9. (* Programmiersprache ... Turbo-Pascal 5.0                               *)
  10. (*                                                                       *)
  11. (* Projekt .............. Verwaltung der ser. Schnittstellen im IBM      *)
  12. (*                                                                       *)
  13. (* Erststellt am ........ 02.07.89                                       *)
  14. (*                                                                       *)
  15. (* letzte Änderung am ... 31.07.90                                       *)
  16. (*                                                                       *)
  17. (* Revision ............. 1.14                                           *)
  18. (*                                                                       *)
  19. (*************************************************************************)
  20. (*                                                                       *)
  21. (* Beschreibung:                                                         *)
  22. (*                                                                       *)
  23. (* Programmierung und Verwaltung von bis zu 8 seriellen Schnittstellen   *)
  24. (* im IBM XT/AT/386.                                                     *)
  25. (* Alle Schnittstellen können bei Bedarf mit einer interrupt-gesteuerten *)
  26. (* Empfangsroutinen betrieben werden.                                    *)
  27. (* Die erweiterten Interrupt's des AT's oder der 386 werden unterstützt. *)
  28. (*                                                                       *)
  29. (* Änderungen                                                            *)
  30. (*                                                                       *)
  31. (*   1.01 Procedure SetStatusMask und Function SeriellStatus eingeführt  *)
  32. (*                                                                       *)
  33. (*   1.02 Parameter TransmitMask eingeführt.                             *)
  34. (*                                                                       *)
  35. (*   1.03 Beim Deinstallieren des Handlers werden nur noch die Leitungen *)
  36. (*        die mit der <Transmittmaske> definiert werden, zurückgesetzt.  *)
  37. (*                                                                       *)
  38. (*   1.04 Neue Funktionen definiert.                                     *)
  39. (*                                                                       *)
  40. (*   1.10 Neue Funktionen definiert.                                     *)
  41. (*                                                                       *)
  42. (*   1.13 Bug in der Ansteuerung der Handshake-Leitungen entfernt, und   *)
  43. (*        neue Funktionen definiert.                                     *)
  44. (*                                                                       *)
  45. (*************************************************************************)
  46.  
  47. {$R-}
  48. {$S-}
  49. {$O-}
  50.  
  51. UNIT SeriellInterface;
  52.  
  53. INTERFACE
  54.  
  55. (*************************************************************************)
  56.  
  57.   CONST
  58.     DSRInput  = $20;
  59.     CTSInput  = $10;
  60.     CDInput   = $80;
  61.     RIInput   = $40;
  62.     DTROutput = $01;
  63.     RTSOutput = $02;
  64.  
  65.     MaxKanal       = 8;      (* Max. sind acht Handler gleichzeitig nutzbar   *)
  66.  
  67.     NotInstall     = 20000;  (* Der Handler wurde noch nicht installiert      *)
  68.     NoHandler      = 20001;  (* Es ist kein freier Handler mehr vorhanden     *)
  69.     NoChip         = 20002;  (* An der Adresse liegt kein ser. Baustein       *)
  70.     WrongHandler   = 20003;  (* Falsche Handlernummer ( 1 < kanal > MaxKanal) *)
  71.     WrongBaudRate  = 20100;  (* Ungültige Baudrate                            *)
  72.     WrongStopBit   = 20101;  (* Ungültige Anzahl Stopp-Bits                   *)
  73.     WrongWordLen   = 20102;  (* Ungültige Übertragungswort-Länge              *)
  74.  
  75.  
  76. (*************************************************************************)
  77.  
  78.   TYPE
  79.     LineZustand  = (On,Off);
  80.     ParityType   = (None,Even,Odd,Mark,Space);
  81.     StopBitType  = 1..2;
  82.     WordLenType  = 5..8;
  83.     BaudRateType = 75..115200;
  84.  
  85.  
  86.     SeriellBuffer = ARRAY [0..$7FFF] OF CHAR;
  87.  
  88.     SeriellDiscrType = RECORD
  89.                          PortAdresse,                      (* Basis-Adresse des 8250               *)
  90.                          PortIRQ        : WORD;            (* Interrupt-Kanal der Schnittstelle    *)
  91.                          Transmit       : BOOLEAN;         (* FALSE, wenn Empfangspuffer fast voll *)
  92.                          TransmitMask   : BYTE;            (* Maske für die Statusleitungen        *)
  93.                          BufferSize,                       (* Grösse des Empfangspuffers in Byte   *)
  94.                          BufferFull,                       (* Füll-Grenze für den Empfangspuffer   *)
  95.                          Top,                              (* erstes Zeichen im Ringpuffers        *)
  96.                          Bottom,                           (* letztes Zeichen im Ringpuffer        *)
  97.                          Anzahl         : WORD;            (* Anzahl Zeichen im Ringpuffer         *)
  98.                          Buffer         : ^SeriellBuffer;  (* Pointer auf den Ringpuffer im Heap   *)
  99.                          Install        : BOOLEAN;         (* TRUE, wenn der Handler belegt ist    *)
  100.                          PortInterrupt,                    (* Pointer auf die Interruptroutine     *)
  101.                          OldVector      : POINTER;         (* Ursprünglicher Interrupt-Vektor      *)
  102.                          LineMask,
  103.                          OldIntMask,
  104.                          OldMCR,
  105.                          OldIER         : BYTE;
  106.                          CountInt,
  107.                          CountInChar,
  108.                          CountOutChar,
  109.                          CountError,
  110.                          CountOverflow  : WORD;
  111.                          NS16550Flag    : BOOLEAN;
  112.                        END;  (* of RECORD *)
  113.  
  114.  
  115. (*************************************************************************)
  116.  
  117.   VAR
  118.     SeriellOk    : BOOLEAN;   (* TRUE, wenn kein Fehler erkannt wurde *)
  119.     SeriellError : WORD;      (* <> 0, wenn ein Fehler erkannt wurde  *)
  120.  
  121.     FiFoAktiv    : BOOLEAN;
  122.  
  123.  
  124. (*************************************************************************)
  125.  
  126. (* Einrichten eines neuen Handlers für eine serielle Schnittstelle *)
  127. (* <adr>  = Basisadresse des 8250                                  *)
  128. (* <irq>  = Interruptkanal für diesen Baustein                     *)
  129. (*          Bei Kanal 0 wird keine Interruptroutine installiert    *)
  130. (* <size> = Grösse des Empfangspuffers                             *)
  131. (*                                                                 *)
  132. (* Mit der Handlernummer <kanal> legt man bei allen Routinen fest, *)
  133. (* welche Schnittstelle angesprochen wird.                         *)
  134.  
  135. PROCEDURE InstallSeriellHandler (adr,irq,size : WORD ; VAR kanal : WORD);
  136.  
  137.  
  138. (* Den Handler eineer seriellen Schnittstelle freigeben.           *)
  139. (* Die belegten Interrupt-Vektoren werden auf ihre alten Werte     *)
  140. (* gesetzt und der Speicher auf dem Heap freigegeben.              *)
  141.  
  142. PROCEDURE DeInstallSeriellHandler (kanal : WORD);
  143.  
  144.  
  145. (* Definition des Handlers <kanal> holen.                          *)
  146.  
  147. PROCEDURE GetHandlerInfo (kanal : WORD ; VAR adr,ir,buflen : WORD);
  148.  
  149.  
  150. (* Lesen von einer seriellen Schnittstelle.                        *)
  151. (* Die Handlernummer <kanal> gibt die Schnittstelle an.            *)
  152.  
  153. FUNCTION  SeriellRead (kanal : WORD) : CHAR;
  154.  
  155.  
  156. (* Das nächste Zeichen im Buffer holen, aber nicht aus dem Buffer  *)
  157. (* entfernen                                                       *)
  158.  
  159. PROCEDURE SeriellCheckRead (kanal : WORD ; VAR zeichen : CHAR ; VAR flag : BOOLEAN);
  160.  
  161.  
  162. (* Lesen von einer seriellen Schnittstelle.                        *)
  163. (* Die Handlernummer <kanal> gibt die Schnittstelle an.            *)
  164.  
  165. PROCEDURE SeriellWrite (kanal : WORD ; zeichen : CHAR);
  166.  
  167.  
  168. (* Empfängerpuffer der Schnittstelle <kanal> leeren.               *)
  169.  
  170. PROCEDURE ClearSeriellBuffer (kanal : WORD);
  171.  
  172.  
  173. (* Testen, ob für die Schnittstelle <kanal> ein Zeichen anliegt.   *)
  174.  
  175. FUNCTION  ReceiverReady (kanal : WORD) : BOOLEAN;
  176.  
  177.  
  178. (* Testen, ob die Schnittstelle <kanal> ein Zeichen senden kann.   *)
  179.  
  180. FUNCTION  TransmitterReady (kanal : WORD) : BOOLEAN;
  181.  
  182.  
  183. (* Testen, ob CTS-Leitung der Schnittstelle <kanal> aktiv ist.     *)
  184.  
  185. FUNCTION  ClearToSend (kanal : WORD) : BOOLEAN;
  186.  
  187.  
  188. (* Testen, ob DSR-Leitung der Schnittstelle <kanal> aktiv ist.     *)
  189.  
  190. FUNCTION  DataSetReady (kanal : WORD) : BOOLEAN;
  191.  
  192.  
  193. (* Teste, ob ein Break auf der Leitung erkannt wurde               *)
  194.  
  195. FUNCTION BreakDetected (kanal : WORD) : BOOLEAN;
  196.  
  197.  
  198. (* Testen, ob CD-Leitung der Schnittstelle <kanal> aktiv ist.      *)
  199.  
  200. FUNCTION  CarrierDetector (kanal : WORD) : BOOLEAN;
  201.  
  202.  
  203. (* Testen, ob im Empfangspuffer noch Platz ist.                    *)
  204. (* Wenn nicht, wurden die Handshake-Leitungen des Empfängers       *)
  205. (* gesperrt.                                                       *)
  206.  
  207. FUNCTION ReceiveFlowBreak (kanal : WORD) : BOOLEAN;
  208.  
  209.  
  210. (* Testen, ob der Sender gesperrt wurde.                           *)
  211. (* TRUE, wenn die Gegenstation keine Zeichen annehmen kann.        *)
  212.  
  213. FUNCTION SendFlowBreak (kanal : WORD) : BOOLEAN;
  214.  
  215.  
  216. (* Setzen oder Rücksetzen der DTR-Leitung.                         *)
  217.  
  218. PROCEDURE DataTerminalReady (kanal : WORD ; zustand : LineZustand);
  219.  
  220.  
  221. (* Setzen oder Rücksetzen der RTS-Leitung.                         *)
  222.  
  223. PROCEDURE RequestToSend (kanal : WORD ; zustand : LineZustand);
  224.  
  225.  
  226. (* Break-Signal ausgeben                                           *)
  227.  
  228. PROCEDURE SendBreak (kanal : WORD);
  229.  
  230.  
  231. (* Festlegen der Mask für die Auswertung der Statusleitungen der   *)
  232. (* Schnittstelle.                                                  *)
  233.  
  234. PROCEDURE SetStatusMask (kanal,mask : WORD);
  235.  
  236.  
  237. (* Festlegen der Mask für die Behandlung der Statusleitungen der   *)
  238. (* Schnittstelle wenn der Puffer voll ist.                         *)
  239. (* Zum Sperren des Senders werden die angegebenen Ausgänge auf 0   *)
  240. (* gesetzt.                                                        *)
  241.  
  242. PROCEDURE SetTransmitMask (kanal,mask : WORD);
  243.  
  244.  
  245. (* Testen, ob die Statusleitungen die mit SetStatusMask definiert  *)
  246. (* wurden, gesetzt sind.                                           *)
  247.  
  248. FUNCTION SeriellStatus (kanal : WORD) : BOOLEAN;
  249.  
  250.  
  251. (*******************************************************************)
  252.  
  253. (* Datenübertragungs-Parameter festlegen.                          *)
  254.  
  255. PROCEDURE SetParameter (kanal   : WORD;
  256.                         rate    : BaudRateType;
  257.                         parity  : ParitYType;
  258.                         stopbit : StopBitType;
  259.                         wordlen : WordLenType);
  260.  
  261.  
  262. (* Baudrate der Schnittstelle <kanal> festlegen.                   *)
  263. (* Für <baud> sind alle Werte zwischen 75 und 111500 gültig.       *)
  264.  
  265. PROCEDURE SetBaudrate (kanal : WORD ; rate : BaudRateType);
  266.  
  267.  
  268. (* Aktuelle Baudrate der Schnittstelle <kanal> ermitteln           *)
  269.  
  270. FUNCTION  GetBaudrate (kanal : WORD) : BaudRateType;
  271.  
  272.  
  273. (* Parityerzeugung und -Auswertung für die Schnittstelle <kanal>   *)
  274. (* festlegen. Zugelassen sind None,Even oder Odd                   *)
  275.  
  276. PROCEDURE SetParity (kanal : WORD ; parity : ParityType);
  277.  
  278.  
  279. (* Aktuelle Paritydefinitin der Schnittstelle <kanal< ermitteln    *)
  280.  
  281. FUNCTION  GetParity (kanal : WORD) : ParityType;
  282.  
  283.  
  284. (* Anzahl der Stopp-Bit's für die Schnittstelle <kanal> festlegen. *)
  285. (* Zugelassen sind die Werte 1 und 2.                              *)
  286.  
  287. PROCEDURE SetStopBit (kanal : WORD ; stopbit : StopBitType);
  288.  
  289.  
  290. (* Aktuelle Anzahl Stopp-Bit's für die Schnittstelle <kanal>       *)
  291. (* ermitteln                                                       *)
  292.  
  293. FUNCTION  GetStopBit (kanal : WORD) : StopBitType;
  294.  
  295.  
  296. (* Wort-Länge für die Schnittstelle <kanal> festlegen.             *)
  297. (* Mögliche Wort-Längen sind 5,6,7 und 8.                          *)
  298.  
  299. PROCEDURE SetWordLen (kanal : WORD ; wordlen : WordLenType);
  300.  
  301.  
  302. (* Aktuelle Wort-Länge der Schnittstelle <kanal> ermitteln.        *)
  303.  
  304. FUNCTION  GetWordLen (kanal : WORD) : WordLenType;
  305.  
  306.  
  307. (* Löschen der Schnittstellen-Statistik                            *)
  308.  
  309. PROCEDURE ClearHandlerStatistic (kanal : WORD);
  310.  
  311.  
  312. (* Zähler für die Anzahl Interrupts an der Schnittstelle <kanal>   *)
  313. (* einfragen.                                                      *)
  314.  
  315. FUNCTION GetIntCounter (kanal : WORD) : WORD;
  316.  
  317.  
  318. (* Zähler für die Anzahl der empfangene Zeichen an der Schnitt-     *)
  319. (* stelle <kanal> einfragen.                                        *)
  320.  
  321. FUNCTION GetReceiveCounter (kanal : WORD) : WORD;
  322.  
  323.  
  324. (* Zähler für die Anzahl gesendeten Zeichen an der Schnitt-         *)
  325. (* stelle <kanal> einfragen.                                        *)
  326.  
  327. FUNCTION GetSendCounter (kanal : WORD) : WORD;
  328.  
  329.  
  330. (* Zähler für die Anzahl der Empfangsfehler an der Schnitt-         *)
  331. (* stelle <kanal> einfragen.                                        *)
  332.  
  333. FUNCTION GetErrorCounter (kanal : WORD) : WORD;
  334.  
  335.  
  336. (* Zähler für die Anzahl der Pufferüberläufe an der Schnitt-        *)
  337. (* stelle <kanal> einfragen.                                        *)
  338.  
  339. FUNCTION GetOverflowCounter (kanal : WORD) : WORD;
  340.  
  341.  
  342. (*************************************************************************)
  343.  
  344. IMPLEMENTATION
  345.  
  346.   USES Dos;
  347.  
  348.   CONST
  349.     IntrCtrl1      = $20;    (* Basisadresse des ersten Interruptcontroler's  *)
  350.     IntrCtrl2      = $A0;    (* Basisadresse des zweiten Interruptcontroler's *)
  351.  
  352.  
  353. (*************************************************************************)
  354.  
  355.   VAR
  356.     i,
  357.     HandlerSize       : WORD;      (* Grösses eines Handler-Record's      *)
  358.  
  359.     altexitproc       : POINTER;   (* Pointer auf die alte Exit-Procedure *)
  360.  
  361.     SeriellDiscriptor : ARRAY [1..MaxKanal] OF SeriellDiscrType;
  362.  
  363.     Ticker            : LONGINT ABSOLUTE $40:$6C;
  364.  
  365.  
  366. (*************************************************************************)
  367.  
  368. {$L RS232Pas }
  369.  
  370. PROCEDURE SeriellIntrProc1; External;  (* Definition der externen Interruptroutinen *)
  371.  
  372. PROCEDURE SeriellIntrProc2; External;
  373.  
  374. PROCEDURE SeriellIntrProc3; External;
  375.  
  376. PROCEDURE SeriellIntrProc4; External;
  377.  
  378. PROCEDURE SeriellIntrProc5; External;
  379.  
  380. PROCEDURE SeriellIntrProc6; External;
  381.  
  382. PROCEDURE SeriellIntrProc7; External;
  383.  
  384. PROCEDURE SeriellIntrProc8; External;
  385.  
  386.  
  387. (*************************************************************************)
  388.  
  389.  
  390. PROCEDURE DisableInterrupt; InLine ($FA);
  391.  
  392. PROCEDURE EnableInterrupt; InLine ($FB);
  393.  
  394.  
  395. (*************************************************************************)
  396.  
  397. PROCEDURE ClearError;
  398.  
  399. BEGIN
  400.   SeriellOk:=TRUE;
  401.   SeriellError:=0;
  402. END;  (* of ClearError *)
  403.  
  404.  
  405. (*************************************************************************)
  406.  
  407. PROCEDURE SetError (err : WORD);
  408.  
  409. BEGIN
  410.   SeriellOk:=FALSE;
  411.   SeriellError:=err;
  412. END;  (* of SetErrror *)
  413.  
  414.  
  415. (*************************************************************************)
  416.  
  417. PROCEDURE InstallSeriellHandler;
  418.  
  419.   VAR
  420.     dummy : BYTE;
  421.  
  422.     wert  : WORD;
  423.  
  424. BEGIN
  425.   kanal:=1;
  426.   WHILE (SeriellDiscriptor [kanal].Install = TRUE) AND (kanal <= MaxKanal) DO INC (kanal);
  427.   IF (kanal <= MaxKanal) THEN BEGIN
  428.     wert:=PORT [adr + $06];
  429.     IF ((PORT [adr + $06] AND $0F) = 0) THEN BEGIN
  430.       WITH SeriellDiscriptor [kanal] DO BEGIN
  431.  
  432.         Transmit:=TRUE;
  433.  
  434.         Top:=0;
  435.         Bottom:=0;
  436.         Anzahl:=0;
  437.  
  438.         CountInt:=0;
  439.         CountInChar:=0;
  440.         CountOutChar:=0;
  441.         CountError:=0;
  442.         CountOverflow:=0;
  443.  
  444.         TransmitMask:=RTSOutput;
  445.  
  446.         PortAdresse:=adr;
  447.         PortIRQ:=irq;
  448.  
  449.         DisableInterrupt;
  450.  
  451.         OldIER:=PORT [PortAdresse + $01];
  452.  
  453.         adr:=PortAdresse + $04;
  454.         OldMCR:=PORT [adr];
  455.         PORT [adr]:=OldMCR AND $F7;            (* Alle Interrupts mit OUT 2 sperren  *)
  456.  
  457.         dummy:=PORT [PortAdresse + $02];
  458.         IF ((dummy AND $C0) > 0) THEN
  459.           NS16550Flag:=TRUE
  460.         ELSE BEGIN
  461.           PORT [PortAdresse + $02]:=$01;
  462.           dummy:=PORT [PortAdresse + $02];
  463.           NS16550Flag:=((dummy AND $C0) > 0);
  464.         END;  (* of ELSE *)
  465.  
  466.         IF NS16550Flag THEN BEGIN
  467.           IF FiFoAktiv THEN
  468.             PORT [PortAdresse + $02]:=$E1
  469.           ELSE PORT [PortAdresse + $02]:=0;
  470.         END;  (* of IF *)
  471.  
  472.         dummy:=PORT [PortAdresse];
  473.         dummy:=PORT [PortAdresse + $05];       (* Leitungsstatus-Register löschen    *)
  474.  
  475.         IF (PortIRQ <> 0) THEN BEGIN           (* Empfangsintr. nur bei IRQ <> 0 installieren *)
  476.  
  477.           IF (size > $7FFF) THEN size:=$7FFF;  (* Buffersize max. $7FFF            *)
  478.           IF (MaxAvail < size) THEN            (* wenn zuwenig Platz auf dem Heap, *)
  479.             BufferSize:=MaxAvail               (* dann wird der Buffer verkleinert *)
  480.           ELSE BufferSize:=size;
  481.  
  482.           GetMem (Buffer,BufferSize);          (* Speicher für den Empfangsbuffer reservieren *)
  483.  
  484.           BufferFull:=WORD (LONGINT (BufferSize) * 90 DIV 100);
  485.           IF (BufferFull < 10) THEN BufferFull:=10;
  486.  
  487.           PORT [PortAdresse + $01]:=$01;       (* Interrupt bei Empfang zulassen    *)
  488.  
  489.           adr:=PortAdresse + $04;
  490.           wert:=PORT [adr];
  491.           PORT [adr]:=wert OR TransmitMask OR $08;          (* Die Steuerleitungen setzen        *)
  492.  
  493.           IF (PortIRQ < 8) THEN BEGIN                        (* IRQ0 - IRQ7: erster 8259   *)
  494.             GetIntVec ($08 + PortIRQ,OldVector);             (* Interrupt-Vektor retten    *)
  495.             SetIntVec ($08 + PortIRQ,PortInterrupt);         (* und neu setzen             *)
  496.  
  497.             adr:=IntrCtrl1 + $01;
  498.             OldIntMask:=PORT [adr];
  499.             PORT [adr]:=OldIntMask AND ($FF XOR 1 SHL PortIRQ);
  500.             OldIntMask:=OldIntMask AND (1 SHL PortIRQ);
  501.           END  (* of IF THEN *)
  502.           ELSE BEGIN                                         (* IRQ8 - IRQ15: zweiter 8259 *)
  503.             GetIntVec ($70 + (PortIRQ - 8),OldVector);       (* Interrupt-Vektor retten    *)
  504.             SetIntVec ($70 + (PortIRQ - 8),PortInterrupt);   (* und neu setzen             *)
  505.  
  506.             adr:=IntrCtrl2 + $01;
  507.             OldIntMask:=PORT [adr];
  508.             PORT [adr]:=OldIntMask AND ($FF XOR 1 SHL (PortIRQ - 8));
  509.             OldIntMask:=OldIntMask AND (1 SHL (PortIRQ - 8));
  510.           END;  (* of ELSE *)
  511.         END  (* of IF THEN *)
  512.         ELSE BEGIN
  513.           Buffer:=NIL;                        (* Ohne Interrupt auch kein Puffer      *)
  514.           OldIntMask:=$00;
  515.         END;  (* of ELSE *)
  516.  
  517.         dummy:=PORT [PortAdresse];
  518.         dummy:=PORT [PortAdresse + $05];       (* Leitungsstatus-Register löschen    *)
  519.  
  520.         EnableInterrupt;
  521.  
  522.         Install:=TRUE;                         (* Handler als belegt kennzeichenen     *)
  523.         ClearError;
  524.       END;  (* of WITH *)
  525.     END  (* of IF THEN *)
  526.     ELSE BEGIN
  527.       kanal:=0;
  528.       SetError (NoChip);
  529.     END;  (* of ELSE *)
  530.   END  (* of IF THEN *)
  531.   ELSE BEGIN
  532.     kanal:=0;                                  (* kanal = 0 wenn kein Handler frei ist *)
  533.     SetError (NoHandler);
  534.   END;  (* of ELSE *)
  535. END;  (* of InstallSeriellHandler *)
  536.  
  537.  
  538. (*************************************************************************)
  539.  
  540. PROCEDURE DeInstallSeriellHandler;
  541.  
  542.   VAR
  543.     adr : WORD;
  544.  
  545. BEGIN
  546.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN          (* Nur gültige Handler bearbeiten     *)
  547.     WITH SeriellDiscriptor [kanal] DO BEGIN
  548.       IF Install THEN BEGIN
  549.         IF (Buffer <> NIL) THEN BEGIN                        (* Wenn ein Empfangspuffer angelegt   *)
  550.           FreeMem (Buffer,BufferSize);                       (* wurde, wird dieser vom Heap        *)
  551.           Buffer:=NIL;                                       (* entfernt.                          *)
  552.         END;  (* of IF *)
  553.  
  554.         DisableInterrupt;
  555.  
  556.         PORT [PortAdresse + $01]:=OldIER;                       (* alle Interrupts des 8250 sperren   *)
  557.  
  558.         PORT [PortAdresse + $04]:=OldMCR;
  559.  
  560.         IF (PortIRQ <> 0) THEN BEGIN                         (* Interrupt am 8259 sperren und den  *)
  561.           IF (PortIRQ < 8) THEN BEGIN                        (* die Vektor-Adresse restaureien.    *)
  562.             adr:=IntrCtrl1 + $01;
  563.             PORT [adr]:=PORT [adr] OR OldIntMask;
  564.             SetIntVec ($08 + PortIRQ,OldVector);
  565.           END  (* of IF *)
  566.           ELSE BEGIN
  567.             adr:=IntrCtrl2 + $01;
  568.             PORT [adr]:=PORT [adr] OR OldIntMask;
  569.             SetIntVec ($70 + (PortIRQ - 8),OldVector);
  570.           END;  (* of ELSE *)
  571.         END;  (* of IF *)
  572.  
  573.         EnableInterrupt;
  574.  
  575.         Install:=FALSE;                        (* Handler freigeben                  *)
  576.       END  (* of IF *)
  577.       ELSE SetError (NotInstall);
  578.     END;  (* of WITH *)
  579.   END  (* of IF *)
  580.   ELSE SetError (WrongHandler);
  581. END;  (* of DeInstallSeriellHandler *)
  582.  
  583.  
  584. (*************************************************************************)
  585.  
  586. PROCEDURE GetHandlerInfo;
  587.  
  588. BEGIN
  589.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN          (* Nur gültige Handler bearbeiten     *)
  590.     WITH SeriellDiscriptor [kanal] DO BEGIN
  591.       IF Install THEN BEGIN
  592.         adr:=PortAdresse;
  593.         ir:=PortIRQ;
  594.         buflen:=BufferSize;
  595.       END  (* of IF *)
  596.       ELSE SetError (NotInstall);
  597.     END;  (* of WITH *)
  598.   END  (* of IF *)
  599.   ELSE SetError (WrongHandler);
  600. END;  (* of GetHandlerInfo *)
  601.  
  602.  
  603. (*************************************************************************)
  604.  
  605. (* Lesen eines Zeichens vom seriellen Kanal <kanal> *)
  606.  
  607. FUNCTION SeriellRead; External;
  608.  
  609.  
  610. (*************************************************************************)
  611.  
  612. (* Lesen eines Zeichens vom seriellen Kanal <kanal> *)
  613.  
  614. PROCEDURE SeriellCheckRead;
  615.  
  616. BEGIN
  617.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN
  618.     WITH SeriellDiscriptor [kanal] DO BEGIN
  619.       IF Install THEN BEGIN
  620.         IF (Anzahl > 0) THEN BEGIN
  621.           zeichen:=Buffer^[Bottom];                (* Zeichen aus dem Puffer holen und     *)
  622.           flag:=TRUE;
  623.         END  (* of IF *)
  624.         ELSE flag:=FALSE;
  625.  
  626.         ClearError;
  627.       END  (* of IF THEN *)
  628.       ELSE SetError (NotInstall);
  629.     END;  (* of WITH *)
  630.   END  (* of IF THEN *)
  631.   ELSE SetError (WrongHandler);
  632. END;  (* of SeriellCheckRead *)
  633.  
  634.  
  635. (*************************************************************************)
  636.  
  637. PROCEDURE SeriellWrite; External;
  638.  
  639.  
  640. (*************************************************************************)
  641.  
  642. PROCEDURE ClearSeriellBuffer;
  643.  
  644.   VAR
  645.     adr : WORD;
  646.  
  647. BEGIN
  648.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN
  649.     WITH SeriellDiscriptor [kanal] DO BEGIN
  650.       IF Install THEN BEGIN
  651.         DisableInterrupt;
  652.  
  653.         Anzahl:=0;
  654.         Top:=0;
  655.         Bottom:=0;
  656.  
  657.         IF NOT (Transmit) THEN BEGIN                       (* Wenn der Puffer fast voll war,       *)
  658.           IF (Anzahl < (BufferSize - $10)) THEN BEGIN      (* teste, ob wieder Platz vorhanden ist *)
  659.             adr:=PortAdresse + $04;
  660.             Port [adr]:=Port [adr] OR TransmitMask;        (* Wenn ja, Steuerleitungen setzen und  *)
  661.             Transmit:=TRUE;                                (* das Flag für "Puffer voll" löschen.  *)
  662.           END;  (* of IF *)
  663.         END;  (* of IF *)
  664.  
  665.         EnableInterrupt;
  666.  
  667.         ClearError;
  668.       END  (* of IF *)
  669.       ELSE SetError (NotInstall);
  670.     END;  (* of WITH *)
  671.   END  (* of IF THEN *)
  672.   ELSE SetError (WrongHandler);
  673. END;  (* of ClearSeriellBuffer *)
  674.  
  675.  
  676. (*************************************************************************)
  677.  
  678. FUNCTION ReceiverReady; External;
  679.  
  680.  
  681. (*************************************************************************)
  682.  
  683. FUNCTION TransmitterReady;
  684.  
  685. BEGIN
  686.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN
  687.     WITH SeriellDiscriptor [kanal] DO BEGIN
  688.       IF Install THEN BEGIN
  689.         TransmitterReady:=((Port [PortAdresse + $05] AND $20) > 0);
  690.       END  (* of IF *)
  691.       ELSE TransmitterReady:=FALSE;
  692.     END;  (* of WITH *)
  693.     ClearError;
  694.   END  (* of IF THEN *)
  695.   ELSE BEGIN
  696.     TransmitterReady:=FALSE;
  697.     SetError (WrongHandler);
  698.   END;  (* of ELSE *)
  699. END;  (* of TransmitterReady *)
  700.  
  701.  
  702. (*************************************************************************)
  703.  
  704. FUNCTION ClearToSend;
  705.  
  706. BEGIN
  707.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN
  708.     WITH SeriellDiscriptor [kanal] DO BEGIN
  709.       IF Install THEN BEGIN
  710.         ClearToSend:=((Port [PortAdresse + $06] AND $10) > 0);
  711.       END  (* of IF *)
  712.       ELSE ClearToSend:=FALSE;
  713.     END;  (* of WITH *)
  714.     ClearError;
  715.   END  (* of IF *)
  716.   ELSE BEGIN
  717.     ClearToSend:=FALSE;
  718.     SetError (WrongHandler);
  719.   END;  (* of ELSE *)
  720. END;  (* of ClearToSend *)
  721.  
  722.  
  723. (*************************************************************************)
  724.  
  725. FUNCTION DataSetReady;
  726.  
  727. BEGIN
  728.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN
  729.     WITH SeriellDiscriptor [kanal] DO BEGIN
  730.       IF Install THEN BEGIN
  731.         DataSetReady:=((Port [PortAdresse + $06] AND $20) > 0);
  732.       END  (* of IF *)
  733.       ELSE DataSetReady:=FALSE;
  734.     END;  (* of WITH *)
  735.     ClearError;
  736.   END  (* of IF *)
  737.   ELSE BEGIN
  738.     DataSetReady:=FALSE;
  739.     SetError (WrongHandler);
  740.   END;  (* of ELSE *)
  741. END;  (* of DataSetReady *)
  742.  
  743.  
  744. (*************************************************************************)
  745.  
  746. FUNCTION CarrierDetector;
  747.  
  748. BEGIN
  749.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN
  750.     WITH SeriellDiscriptor [kanal] DO BEGIN
  751.       IF Install THEN BEGIN
  752.         CarrierDetector:=((Port [PortAdresse + $06] AND $80) > 0);
  753.       END  (* of IF *)
  754.       ELSE CarrierDetector:=FALSE;
  755.     END;  (* of WITH *)
  756.     ClearError;
  757.   END  (* of IF *)
  758.   ELSE BEGIN
  759.     CarrierDetector:=FALSE;
  760.     SetError (WrongHandler);
  761.   END;  (* of ELSE *)
  762. END;  (* of CarrierDetector *)
  763.  
  764.  
  765. (*************************************************************************)
  766.  
  767. FUNCTION BreakDetected;
  768.  
  769.   VAR
  770.     adresse : WORD;
  771.  
  772.     break   : BOOLEAN;
  773.  
  774. BEGIN
  775.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN
  776.     WITH SeriellDiscriptor [kanal] DO BEGIN
  777.       IF Install THEN BEGIN
  778.         adresse:=PortAdresse + $05;
  779.         break:=((Port [adresse] AND $08) > 0);
  780.         IF break THEN Port [adresse]:=Port [adresse] AND $F7;
  781.         BreakDetected:=break;
  782.       END  (* of IF *)
  783.       ELSE BreakDetected:=FALSE;
  784.     END;  (* of WITH *)
  785.     ClearError;
  786.   END  (* of IF *)
  787.   ELSE BEGIN
  788.     BreakDetected:=FALSE;
  789.     SetError (WrongHandler);
  790.   END;  (* of ELSE *)
  791. END;  (* of BreakDetected *)
  792.  
  793.  
  794. (*************************************************************************)
  795.  
  796. FUNCTION ReceiveFlowBreak;
  797.  
  798.   VAR
  799.     break   : BOOLEAN;
  800.  
  801. BEGIN
  802.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN
  803.     WITH SeriellDiscriptor [kanal] DO BEGIN
  804.       IF Install THEN
  805.         ReceiveFlowBreak:=NOT (Transmit)
  806.       ELSE ReceiveFlowBreak:=FALSE;
  807.     END;  (* of WITH *)
  808.     ClearError;
  809.   END  (* of IF *)
  810.   ELSE BEGIN
  811.     ReceiveFlowBreak:=FALSE;
  812.     SetError (WrongHandler);
  813.   END;  (* of ELSE *)
  814. END;  (* of ReceiveFlowBreak *)
  815.  
  816.  
  817. (*************************************************************************)
  818.  
  819. FUNCTION SendFlowBreak;
  820.  
  821. BEGIN
  822.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN
  823.     WITH SeriellDiscriptor [kanal] DO BEGIN
  824.       IF Install THEN BEGIN
  825.         SendFlowBreak:=((Port [PortAdresse + $06] AND LineMask) <> LineMask);
  826.       END  (* of IF *)
  827.       ELSE SendFlowBreak:=FALSE;
  828.     END;  (* of WITH *)
  829.     ClearError;
  830.   END  (* of IF *)
  831.   ELSE BEGIN
  832.     SendFlowBreak:=FALSE;
  833.     SetError (WrongHandler);
  834.   END;  (* of ELSE *)
  835. END;  (* of SendFlowBreak *)
  836.  
  837.  
  838. (*************************************************************************)
  839.  
  840. PROCEDURE DataTerminalReady;
  841.  
  842.   VAR
  843.     wert,
  844.     adr   : WORD;
  845.  
  846. BEGIN
  847.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN
  848.     WITH SeriellDiscriptor [kanal] DO BEGIN
  849.       IF Install THEN BEGIN
  850.         adr:=PortAdresse + $04;
  851.         wert:=PORT [adr];
  852.         IF (zustand = On) THEN
  853.           wert:=wert OR $01
  854.         ELSE wert:=wert AND $FE;
  855.         PORT [adr]:=wert;
  856.         ClearError;
  857.       END  (* of IF THEN *)
  858.       ELSE SetError (NotInstall);
  859.     END;  (* of WITH *)
  860.   END  (* of IF *)
  861.   ELSE SetError (WrongHandler);
  862. END;  (* of DataTerminalReady *)
  863.  
  864.  
  865. (*************************************************************************)
  866.  
  867. PROCEDURE RequestToSend;
  868.  
  869.   VAR
  870.     wert,
  871.     adr   : WORD;
  872.  
  873. BEGIN
  874.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN
  875.     WITH SeriellDiscriptor [kanal] DO BEGIN
  876.       IF Install THEN BEGIN
  877.         adr:=PortAdresse + $04;
  878.         wert:=PORT [adr];
  879.         IF (zustand = On) THEN
  880.           wert:=wert OR $02
  881.         ELSE wert:=wert AND $FD;
  882.         PORT [adr]:=wert;
  883.         ClearError;
  884.       END  (* of IF THEN *)
  885.       ELSE SetError (NotInstall);
  886.     END;  (* of WITH *)
  887.   END  (* of IF *)
  888.   ELSE SetError (WrongHandler);
  889. END;  (* of RequestToSend *)
  890.  
  891.  
  892. (*************************************************************************)
  893.  
  894. PROCEDURE SendBreak;
  895.  
  896.   VAR
  897.     breaktime : LONGINT;
  898.  
  899.     teiler,
  900.     adr       : WORD;
  901.  
  902. BEGIN
  903.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN
  904.     WITH SeriellDiscriptor [kanal] DO BEGIN
  905.       IF Install THEN BEGIN
  906.         adr:=PortAdresse + $03;
  907.         DisableInterrupt;
  908.         PORT [adr]:=PORT [adr] OR $80;
  909.         teiler:=PortW [PortAdresse];
  910.         PORT [adr]:=PORT [adr] AND $7F;
  911.         EnableInterrupt;
  912.         breaktime:=teiler DIV 200;
  913.         IF (breaktime < 1) THEN breaktime:=1;
  914.         breaktime:=Ticker + breaktime;
  915.         Port [adr]:=Port [adr] OR $40;
  916.         REPEAT
  917.         UNTIL (Ticker > breaktime);
  918.         Port [adr]:=Port [adr] AND $BF;
  919.         ClearError;
  920.       END  (* of IF THEN *)
  921.       ELSE SetError (NotInstall);
  922.     END;  (* of WITH *)
  923.   END  (* of IF *)
  924.   ELSE SetError (WrongHandler);
  925. END;  (* of SendBreak *)
  926.  
  927.  
  928. (*************************************************************************)
  929.  
  930. PROCEDURE SetStatusMask;
  931.  
  932. BEGIN
  933.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN
  934.     SeriellDiscriptor [kanal].LineMask:=(mask MOD $FF);
  935.     ClearError;
  936.   END  (* of IF THEN *)
  937.   ELSE SetError (WrongHandler);
  938. END;  (* of SetStatusMask *)
  939.  
  940.  
  941. (*************************************************************************)
  942.  
  943. PROCEDURE SetTransmitMask;
  944.  
  945. BEGIN
  946.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN
  947.     SeriellDiscriptor [kanal].TransmitMask:=(mask MOD $FF);
  948.     ClearError;
  949.   END  (* of IF THEN *)
  950.   ELSE SetError (WrongHandler);
  951. END;  (* of SetTransmitMask *)
  952.  
  953.  
  954. (*************************************************************************)
  955.  
  956. FUNCTION SeriellStatus;
  957.  
  958.   VAR
  959.     status : WORD;
  960.  
  961. BEGIN
  962.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN
  963.     WITH SeriellDiscriptor [kanal] DO BEGIN
  964.       IF Install THEN BEGIN
  965.         IF ((Port [PortAdresse + $05] AND $20) > 0) THEN
  966.           SeriellStatus:=((Port [PortAdresse + $06] AND LineMask) = LineMask)
  967.         ELSE SeriellStatus:=FALSE;
  968.         ClearError;
  969.       END  (* of IF *)
  970.       ELSE BEGIN
  971.         SeriellStatus:=FALSE;
  972.         SetError (NotInstall);
  973.       END;  (* of ELSE *)
  974.     END;  (* of WITH *)
  975.   END  (* of IF *)
  976.   ELSE BEGIN
  977.     SeriellStatus:=FALSE;
  978.     SetError (WrongHandler);
  979.   END;  (* of ELSE *)
  980. END;  (* of SeriellStatus *)
  981.  
  982.  
  983. (*************************************************************************)
  984.  
  985. (* Vor Beendigung des Programmes werden alle noch installierten Handler *)
  986. (* freigegeben.                                                         *)
  987.  
  988. {$F+}
  989. PROCEDURE SeriellInterfaceExit;
  990. {$F-}
  991.  
  992.    VAR
  993.      adr : WORD;
  994.  
  995. BEGIN
  996.   FOR i:=1 TO MaxKanal DO BEGIN
  997.     WITH SeriellDiscriptor [i] DO BEGIN
  998.       IF Install THEN BEGIN
  999.  
  1000.         IF (Buffer <> NIL) THEN BEGIN                        (* Wenn ein Empfangspuffer angelegt   *)
  1001.           FreeMem (Buffer,BufferSize);                       (* wurde, wird dieser vom Heap        *)
  1002.           Buffer:=NIL;                                       (* entfernt.                          *)
  1003.         END;  (* of IF *)
  1004.  
  1005.         DisableInterrupt;
  1006.  
  1007.         PORT [PortAdresse + $01]:=OldIER;                       (* alle Interrupts des 8250 sperren   *)
  1008.  
  1009.         PORT [PortAdresse + $04]:=OldMCR;
  1010.  
  1011.         IF (PortIRQ <> 0) THEN BEGIN                         (* Interrupt am 8259 sperren und den  *)
  1012.           IF (PortIRQ < 8) THEN BEGIN                        (* die Vektor-Adresse restaureien.    *)
  1013.             adr:=IntrCtrl1 + $01;
  1014.             PORT [adr]:=PORT [adr] OR OldIntMask;
  1015.             SetIntVec ($08 + PortIRQ,OldVector);
  1016.           END  (* of IF *)
  1017.           ELSE BEGIN
  1018.             adr:=IntrCtrl2 + $01;
  1019.             PORT [adr]:=PORT [adr] OR OldIntMask;
  1020.             SetIntVec ($70 + (PortIRQ - 8),OldVector);
  1021.           END;  (* of ELSE *)
  1022.         END;  (* of IF *)
  1023.  
  1024.         EnableInterrupt;
  1025.  
  1026.         Install:=FALSE;                        (* Handler freigeben                  *)
  1027.       END;  (* of IF *)
  1028.     END;  (* of WITH *)
  1029.   END;  (* of FOR *)
  1030.  
  1031.   ExitProc:=altexitproc;
  1032. END;  (* of SeriellInterfaceExit *)
  1033.  
  1034.  
  1035. (*************************************************************************)
  1036.  
  1037. (* Programmieren der seriellen Übertragungsparameter. *)
  1038.  
  1039. PROCEDURE SetParameter;
  1040.  
  1041.   VAR
  1042.     basisadr,
  1043.     wert      : WORD;
  1044.  
  1045. BEGIN
  1046.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN
  1047.     WITH SeriellDiscriptor [kanal] DO BEGIN
  1048.       IF Install THEN BEGIN
  1049.         DisableInterrupt;
  1050.         basisadr:=PortAdresse;
  1051.  
  1052.         PORT[basisadr + 3]:=$80;
  1053.         wert:=WORD (115200 DIV rate);
  1054.         PORTW [basisadr]:=wert;
  1055.  
  1056.         wert:=0;
  1057.  
  1058.         CASE Parity OF
  1059.            Even : wert:=wert OR $18;
  1060.             Odd : wert:=wert OR $08;
  1061.            Mark : wert:=wert OR $28;
  1062.           Space : wert:=wert OR $38;
  1063.         END;  (* of CASE *)
  1064.  
  1065.         IF (stopbit = 2) THEN wert:=wert OR $04;
  1066.  
  1067.         wert:=wert + (wordlen - 5);
  1068.  
  1069.         Port [basisadr + $03]:=wert;
  1070.  
  1071.         wert:=Port [basisadr + $05];
  1072.         EnableInterrupt;
  1073.         ClearError;
  1074.       END  (* of IF THEN *)
  1075.       ELSE SetError (NotInstall);
  1076.     END;  (* of WITH *)
  1077.   END  (* of IF *)
  1078.   ELSE SetError (WrongHandler);
  1079. END;  (* of SetParameter *)
  1080.  
  1081.  
  1082. (*************************************************************************)
  1083.  
  1084. (* Programmieren der Baudrate <rate> der ser. Schnittstelle an  *)
  1085. (* der Basisadresse <basisadr>                                  *)
  1086.  
  1087. PROCEDURE SetBaudrate;
  1088.  
  1089.   VAR
  1090.     basisadr,
  1091.     wert      : WORD;
  1092.  
  1093. BEGIN
  1094.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN
  1095.     WITH SeriellDiscriptor [kanal] DO BEGIN
  1096.       IF Install THEN BEGIN
  1097.         DisableInterrupt;
  1098.         basisadr:=PortAdresse;
  1099.         PORT[basisadr + 3]:=PORT[basisadr + 3] OR $80;
  1100.         wert:=WORD (115200 DIV rate);
  1101.         PORTW [basisadr]:=wert;
  1102.         PORT[basisadr + 3]:=PORT[basisadr + 3] AND $7F;
  1103.         wert:=Port [basisadr + $05];
  1104.         ClearError;
  1105.         EnableInterrupt;
  1106.       END  (* of IF THEN *)
  1107.       ELSE SetError (NotInstall);
  1108.     END;  (* of WITH *)
  1109.   END  (* of IF *)
  1110.   ELSE SetError (WrongHandler);
  1111. END;  (* of SetBaudrate *)
  1112.  
  1113.  
  1114. (*************************************************************************)
  1115.  
  1116. (* Ermitteln der Baudrate der ser. Schnittstelle an *)
  1117. (* der Basisdadresse <basisadr>.                    *)
  1118.  
  1119. FUNCTION GetBaudrate;
  1120.  
  1121.   VAR
  1122.     teiler,
  1123.     basisadr,
  1124.     wert      : WORD;
  1125.  
  1126. BEGIN
  1127.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN
  1128.     WITH SeriellDiscriptor [kanal] DO BEGIN
  1129.       IF Install THEN BEGIN
  1130.         basisadr:=PortAdresse;
  1131.         DisableInterrupt;
  1132.         PORT [basisadr + 3]:=PORT [basisadr + 3] OR $80;
  1133.         teiler:=PORTW[basisadr];
  1134.         PORT [basisadr + 3]:=PORT [basisadr + 3] AND $7F;
  1135.         EnableInterrupt;
  1136.         IF (teiler <> 0) THEN
  1137.           GetBaudrate:=LONGINT (115200 DIV teiler)
  1138.         ELSE GetBaudrate:=75;
  1139.         ClearError;
  1140.       END  (* of IF *)
  1141.       ELSE BEGIN
  1142.         GetBaudrate:=75;
  1143.         SetError (NotInstall);
  1144.       END;  (* of ELSE *)
  1145.     END;  (* of WITH *)
  1146.   END  (* of IF *)
  1147.   ELSE BEGIN
  1148.     GetBaudrate:=75;
  1149.     SetError (WrongHandler);
  1150.   END;  (* of ELSE *)
  1151. END;  (* of GetBaudrate *)
  1152.  
  1153.  
  1154. (*************************************************************************)
  1155.  
  1156. PROCEDURE SetParity;
  1157.  
  1158.   VAR
  1159.     basisadr,
  1160.     wert      : WORD;
  1161.  
  1162. BEGIN
  1163.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN
  1164.     WITH SeriellDiscriptor [kanal] DO BEGIN
  1165.       IF Install THEN BEGIN
  1166.         basisadr:=PortAdresse;
  1167.         DisableInterrupt;
  1168.         wert:=Port [basisadr + $03];
  1169.  
  1170.         wert:=wert AND $C7;
  1171.  
  1172.         CASE Parity OF
  1173.            Even : wert:=wert OR $18;
  1174.             Odd : wert:=wert OR $08;
  1175.            Mark : wert:=wert OR $28;
  1176.           Space : wert:=wert OR $38;
  1177.         END;  (* of CASE *)
  1178.  
  1179.         Port [basisadr + $03]:=wert;
  1180.  
  1181.         wert:=Port [basisadr + $05];
  1182.         EnableInterrupt;
  1183.       END  (* of IF *)
  1184.       ELSE SetError (NotInstall);
  1185.     END;  (* of WITH *)
  1186.   END  (* of IF *)
  1187.   ELSE SetError (WrongHandler);
  1188. END;  (* of SetParity *)
  1189.  
  1190.  
  1191. (*************************************************************************)
  1192.  
  1193. FUNCTION GetParity;
  1194.  
  1195.   VAR
  1196.     basisadr,
  1197.     wert      : WORD;
  1198.  
  1199. BEGIN
  1200.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN
  1201.     WITH SeriellDiscriptor [kanal] DO BEGIN
  1202.       IF Install THEN BEGIN
  1203.         basisadr:=PortAdresse;
  1204.         wert:=Port [basisadr + $03] AND $38;
  1205.         IF ((wert AND $08) > 0) THEN BEGIN
  1206.           wert:=wert SHR 4;
  1207.           CASE wert OF
  1208.             0 : GetParity:=Odd;
  1209.             1 : GetParity:=Even;
  1210.             2 : GetParity:=Mark;
  1211.             3 : GetParity:=Space;
  1212.           END;  (* of CASE *)
  1213.         END  (* of IF THEN *)
  1214.         ELSE GetParity:=None;
  1215.       END  (* of IF *)
  1216.       ELSE BEGIN
  1217.         GetParity:=None;
  1218.         SetError (NotInstall);
  1219.       END;  (* of ELSE *)
  1220.     END;  (* of WITH *)
  1221.   END  (* of IF *)
  1222.   ELSE BEGIN
  1223.     GetParity:=None;
  1224.     SetError (WrongHandler);
  1225.   END;  (* of ELSE *)
  1226. END;  (* of GetParity *)
  1227.  
  1228.  
  1229. (*************************************************************************)
  1230.  
  1231. PROCEDURE SetStopBit;
  1232.  
  1233.   VAR
  1234.     basisadr,
  1235.     wert      : WORD;
  1236.  
  1237. BEGIN
  1238.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN
  1239.     WITH SeriellDiscriptor [kanal] DO BEGIN
  1240.       IF Install THEN BEGIN
  1241.         basisadr:=PortAdresse;
  1242.         DisableInterrupt;
  1243.         wert:=Port [basisadr + $03];
  1244.         IF (stopbit = 2) THEN
  1245.           wert:=wert OR $04
  1246.         ELSE wert:=wert AND $FB;
  1247.         Port [basisadr + $03]:=wert;
  1248.         wert:=Port [basisadr + $05];
  1249.         EnableInterrupt;
  1250.       END  (* of IF THEN *)
  1251.       ELSE SetError (NotInstall);
  1252.     END;  (* of WITH *)
  1253.   END  (* of IF THEN *)
  1254.   ELSE SetError (WrongHandler);
  1255. END;  (* of SetStopBit *)
  1256.  
  1257. (*************************************************************************)
  1258.  
  1259. FUNCTION GetStopBit;
  1260.  
  1261.   VAR
  1262.     basisadr,
  1263.     wert      : WORD;
  1264.  
  1265. BEGIN
  1266.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN
  1267.     WITH SeriellDiscriptor [kanal] DO BEGIN
  1268.       IF Install THEN BEGIN
  1269.         basisadr:=PortAdresse;
  1270.         wert:=Port [basisadr + $03];
  1271.         IF ((wert AND $04) > 0) THEN
  1272.           GetStopBit:=2
  1273.         ELSE GetStopBit:=1;
  1274.       END  (* of IF *)
  1275.       ELSE BEGIN
  1276.         GetStopBit:=1;
  1277.         SetError (NotInstall);
  1278.       END;  (* of ELSE *)
  1279.     END;  (* of WITH *)
  1280.   END  (* of IF THEN *)
  1281.   ELSE BEGIN
  1282.     GetStopBit:=1;
  1283.     SetError (WrongHandler);
  1284.   END;  (* of ELSE *)
  1285. END;  (* of GetStopBit *)
  1286.  
  1287.  
  1288. (*************************************************************************)
  1289.  
  1290. PROCEDURE SetWordLen;
  1291.  
  1292.   VAR
  1293.     basisadr,
  1294.     wert      : WORD;
  1295.  
  1296. BEGIN
  1297.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN
  1298.     WITH SeriellDiscriptor [kanal] DO BEGIN
  1299.       IF Install THEN BEGIN
  1300.         basisadr:=PortAdresse;
  1301.         DisableInterrupt;
  1302.         wert:=Port [basisadr + $03];
  1303.         wert:=wert AND $FC;
  1304.         wert:=wert + (wordlen - 5);
  1305.         Port [basisadr + $03]:=wert;
  1306.         wert:=Port [basisadr + $05];
  1307.         EnableInterrupt;
  1308.       END  (* of IF THEN *)
  1309.       ELSE SetError (NotInstall);
  1310.     END;  (* of WITH *)
  1311.   END  (* of IF *)
  1312.   ELSE SetError (WrongHandler);
  1313. END;  (* of SetWordLen *)
  1314.  
  1315. (*************************************************************************)
  1316.  
  1317. FUNCTION GetWordLen;
  1318.  
  1319.   VAR
  1320.     basisadr,
  1321.     wert      : WORD;
  1322.  
  1323. BEGIN
  1324.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN
  1325.     WITH SeriellDiscriptor [kanal] DO BEGIN
  1326.       IF Install THEN BEGIN
  1327.         basisadr:=PortAdresse;
  1328.         wert:=Port [basisadr + $03];
  1329.         GetWordLen:=(wert AND $03) + 5;
  1330.       END  (* of IF THEN *)
  1331.       ELSE BEGIN
  1332.         GetWordLen:=5;
  1333.         SetError (NotInstall);
  1334.       END;  (* of IF *)
  1335.     END;  (* of WITH *)
  1336.   END  (* of IF THEN *)
  1337.   ELSE BEGIN
  1338.     GetWordLen:=5;
  1339.     SetError (WrongHandler);
  1340.   END;  (* of ELSE *)
  1341. END;  (* of GetWordLen *)
  1342.  
  1343.  
  1344. (*************************************************************************)
  1345.  
  1346. PROCEDURE ClearHandlerStatistic;
  1347.  
  1348. BEGIN
  1349.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN
  1350.     WITH SeriellDiscriptor [kanal] DO BEGIN
  1351.       IF Install THEN BEGIN
  1352.         CountInt:=0;
  1353.         CountInChar:=0;
  1354.         CountOutChar:=0;
  1355.         CountError:=0;
  1356.         CountOverflow:=0;
  1357.         ClearError;
  1358.       END  (* of IF THEN *)
  1359.       ELSE SetError (NotInstall);
  1360.     END;  (* of WITH *)
  1361.   END  (* of IF *)
  1362.   ELSE SetError (WrongHandler);
  1363. END;  (* of SetWordLen *)
  1364.  
  1365.  
  1366. (*************************************************************************)
  1367.  
  1368. FUNCTION GetIntCounter;
  1369.  
  1370. BEGIN
  1371.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN
  1372.     WITH SeriellDiscriptor [kanal] DO BEGIN
  1373.       IF Install THEN BEGIN
  1374.         GetIntCounter:=CountInt;
  1375.         ClearError;
  1376.       END  (* of IF THEN *)
  1377.       ELSE BEGIN
  1378.         GetIntCounter:=0;
  1379.         SetError (NotInstall);
  1380.       END;  (* of IF *)
  1381.     END;  (* of WITH *)
  1382.   END  (* of IF THEN *)
  1383.   ELSE BEGIN
  1384.     GetIntCounter:=0;
  1385.     SetError (WrongHandler);
  1386.   END;  (* of ELSE *)
  1387. END;  (* of GetIntCounter *)
  1388.  
  1389.  
  1390. (*************************************************************************)
  1391.  
  1392. FUNCTION GetReceiveCounter;
  1393.  
  1394. BEGIN
  1395.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN
  1396.     WITH SeriellDiscriptor [kanal] DO BEGIN
  1397.       IF Install THEN BEGIN
  1398.         GetReceiveCounter:=CountInChar;
  1399.         ClearError;
  1400.       END  (* of IF THEN *)
  1401.       ELSE BEGIN
  1402.         GetReceiveCounter:=0;
  1403.         SetError (NotInstall);
  1404.       END;  (* of IF *)
  1405.     END;  (* of WITH *)
  1406.   END  (* of IF THEN *)
  1407.   ELSE BEGIN
  1408.     GetReceiveCounter:=0;
  1409.     SetError (WrongHandler);
  1410.   END;  (* of ELSE *)
  1411. END;  (* of GetReceiveCounter *)
  1412.  
  1413.  
  1414. (*************************************************************************)
  1415.  
  1416. FUNCTION GetSendCounter;
  1417.  
  1418. BEGIN
  1419.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN
  1420.     WITH SeriellDiscriptor [kanal] DO BEGIN
  1421.       IF Install THEN BEGIN
  1422.         GetSendCounter:=CountOutChar;
  1423.         ClearError;
  1424.       END  (* of IF THEN *)
  1425.       ELSE BEGIN
  1426.         GetSendCounter:=0;
  1427.         SetError (NotInstall);
  1428.       END;  (* of IF *)
  1429.     END;  (* of WITH *)
  1430.   END  (* of IF THEN *)
  1431.   ELSE BEGIN
  1432.     GetSendCounter:=0;
  1433.     SetError (WrongHandler);
  1434.   END;  (* of ELSE *)
  1435. END;  (* of GetSendCounter *)
  1436.  
  1437.  
  1438. (*************************************************************************)
  1439.  
  1440. FUNCTION GetErrorCounter;
  1441.  
  1442. BEGIN
  1443.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN
  1444.     WITH SeriellDiscriptor [kanal] DO BEGIN
  1445.       IF Install THEN BEGIN
  1446.         GetErrorCounter:=CountError;
  1447.         ClearError;
  1448.       END  (* of IF THEN *)
  1449.       ELSE BEGIN
  1450.         GetErrorCounter:=0;
  1451.         SetError (NotInstall);
  1452.       END;  (* of IF *)
  1453.     END;  (* of WITH *)
  1454.   END  (* of IF THEN *)
  1455.   ELSE BEGIN
  1456.     GetErrorCounter:=0;
  1457.     SetError (WrongHandler);
  1458.   END;  (* of ELSE *)
  1459. END;  (* of GetErrorCounter *)
  1460.  
  1461.  
  1462. (*************************************************************************)
  1463.  
  1464. FUNCTION GetOverflowCounter;
  1465.  
  1466. BEGIN
  1467.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN
  1468.     WITH SeriellDiscriptor [kanal] DO BEGIN
  1469.       IF Install THEN BEGIN
  1470.         GetOverflowCounter:=CountOverflow;
  1471.         ClearError;
  1472.       END  (* of IF THEN *)
  1473.       ELSE BEGIN
  1474.         GetOverflowCounter:=0;
  1475.         SetError (NotInstall);
  1476.       END;  (* of IF *)
  1477.     END;  (* of WITH *)
  1478.   END  (* of IF THEN *)
  1479.   ELSE BEGIN
  1480.     GetOverflowCounter:=0;
  1481.     SetError (WrongHandler);
  1482.   END;  (* of ELSE *)
  1483. END;  (* of GetOverflowCounter *)
  1484.  
  1485.  
  1486. (*************************************************************************)
  1487.  
  1488. BEGIN
  1489.   HandlerSize:=SizeOf (SeriellDiscrType);
  1490.  
  1491.   FOR i:=1 TO MaxKanal DO BEGIN
  1492.     WITH SeriellDiscriptor [i] DO BEGIN
  1493.       Install:=FALSE;
  1494.       Buffer:=NIL;
  1495.       OldVector:=NIL;
  1496.     END;  (* of WITH *)
  1497.   END;  (* of FOR *)
  1498.  
  1499.   SeriellDiscriptor [1].PortInterrupt:=@SeriellIntrProc1;
  1500.   SeriellDiscriptor [2].PortInterrupt:=@SeriellIntrProc2;
  1501.   SeriellDiscriptor [3].PortInterrupt:=@SeriellIntrProc3;
  1502.   SeriellDiscriptor [4].PortInterrupt:=@SeriellIntrProc4;
  1503.   SeriellDiscriptor [5].PortInterrupt:=@SeriellIntrProc5;
  1504.   SeriellDiscriptor [6].PortInterrupt:=@SeriellIntrProc6;
  1505.   SeriellDiscriptor [7].PortInterrupt:=@SeriellIntrProc7;
  1506.   SeriellDiscriptor [8].PortInterrupt:=@SeriellIntrProc8;
  1507.  
  1508.   altexitproc:=ExitProc;
  1509.   ExitProc:=@SeriellInterfaceExit;
  1510.  
  1511.   SeriellError:=0;
  1512.   SeriellOk:=TRUE;
  1513.   FiFoAktiv:=TRUE;
  1514. END.  (* of UNIT SeriellInterface *)