* First public version

rtl/linux/serial.pp

@@ -0,0 +1,206 @@
+{ Unit for handling the serial interfaces under Linux.
+  (c) 2000 Sebastian Guenther, sg@freepascal.org
+}
+
+unit Serial;
+
+{$MODE objfpc}
+{$H+}
+{$PACKRECORDS C}
+
+interface
+
+uses Linux;
+
+type
+
+  TSerialHandle = LongInt;
+
+  TParityType = (NoneParity, OddParity, EvenParity);
+
+  TSerialFlags = set of (RtsCtsFlowControl);
+
+  TSerialState = record
+    LineState: LongWord;
+    tios: termios;
+  end;
+
+
+{ Open the serial device with the given device name, for example:
+    ttyS0, ttyS1... for normal serial ports
+    ttyI0, ttyI1... for ISDN emulated serial ports
+    other device names are possible; refer to your Linux documentation.
+  Returns "0" if device could not be found }
+function SerOpen(const DeviceName: String): TSerialHandle;
+
+{ Closes a serial device previously opened with SerOpen. }
+procedure SerClose(Handle: TSerialHandle);
+
+{ Flushes the data queues of the given serial device. }
+procedure SerFlush(Handle: TSerialHandle);
+
+{ Reads a maximum of "Count" bytes of data into the specified buffer.
+  Result: Number of bytes read. }
+function SerRead(Handle: TSerialHandle; var Buffer; Count: LongInt): LongInt;
+
+{ Tries to write "Count" bytes from "Buffer".
+  Result: Number of bytes written. }
+function SerWrite(Handle: TSerialHandle; var Buffer; Count: LongInt): LongInt;
+
+procedure SerSetParams(Handle: TSerialHandle; BitsPerSec: LongInt;
+  ByteSize: Integer; Parity: TParityType; StopBits: Integer;
+  Flags: TSerialFlags);
+
+{ Saves and restores the state of the serial device. }
+function SerSaveState(Handle: TSerialHandle): TSerialState;
+procedure SerRestoreState(Handle: TSerialHandle; State: TSerialState);
+
+{ Getting and setting the line states directly. }
+procedure SerSetDTR(Handle: TSerialHandle; State: Boolean);
+procedure SerSetRTS(Handle: TSerialHandle; State: Boolean);
+function SerGetCTS(Handle: TSerialHandle): Boolean;
+function SerGetDSR(Handle: TSerialHandle): Boolean;
+function SerGetRI(Handle: TSerialHandle): Boolean;
+
+
+{ ************************************************************************** }
+
+implementation
+
+
+function SerOpen(const DeviceName: String): TSerialHandle;
+begin
+  Result := fdOpen(DeviceName, OPEN_RDWR or OPEN_EXCL or OPEN_NOCTTY);
+end;
+
+procedure SerClose(Handle: TSerialHandle);
+begin
+  fdClose(Handle);
+end;
+
+procedure SerFlush(Handle: TSerialHandle);
+begin
+  fdFlush(Handle);
+end;
+
+function SerRead(Handle: TSerialHandle; var Buffer; Count: LongInt): LongInt;
+begin
+  Result := fdRead(Handle, Buffer, Count);
+end;
+
+function SerWrite(Handle: TSerialHandle; var Buffer; Count: LongInt): LongInt;
+begin
+  Result := fdWrite(Handle, Buffer, Count);
+end;
+
+procedure SerSetParams(Handle: TSerialHandle; BitsPerSec: LongInt;
+  ByteSize: Integer; Parity: TParityType; StopBits: Integer;
+  Flags: TSerialFlags);
+var
+  tios: termios;
+begin
+  ioctl(Handle, TCGETS, @tios);
+
+  case BitsPerSec of
+    50: tios.c_cflag := B50;
+    75: tios.c_cflag := B75;
+    110: tios.c_cflag := B110;
+    134: tios.c_cflag := B134;
+    150: tios.c_cflag := B150;
+    200: tios.c_cflag := B200;
+    300: tios.c_cflag := B300;
+    600: tios.c_cflag := B600;
+    1200: tios.c_cflag := B1200;
+    1800: tios.c_cflag := B1800;
+    2400: tios.c_cflag := B2400;
+    4800: tios.c_cflag := B4800;
+    19200: tios.c_cflag := B19200;
+    38400: tios.c_cflag := B38400;
+    57600: tios.c_cflag := B57600;
+    115200: tios.c_cflag := B115200;
+    230400: tios.c_cflag := B230400;
+    460800: tios.c_cflag := B460800;
+    else tios.c_cflag := B9600;
+  end;
+
+  case ByteSize of
+    5: tios.c_cflag := tios.c_cflag or CS5;
+    6: tios.c_cflag := tios.c_cflag or CS6;
+    7: tios.c_cflag := tios.c_cflag or CS7;
+    else tios.c_cflag := tios.c_cflag or CS8;
+  end;
+
+  case Parity of
+    OddParity: tios.c_cflag := tios.c_cflag or PARENB or PARODD;
+    EvenParity: tios.c_cflag := tios.c_cflag or PARENB;
+  end;
+
+  if StopBits = 2 then
+    tios.c_cflag := tios.c_cflag or CSTOPB;
+
+  if RtsCtsFlowControl in Flags then
+    tios.c_cflag := tios.c_cflag or CRTSCTS;
+
+  tios.c_cflag := tios.c_cflag or CLOCAL or CREAD;
+
+  ioctl(Handle, TCSETS, @tios);
+end;
+
+function SerSaveState(Handle: TSerialHandle): TSerialState;
+begin
+  ioctl(Handle, TIOCMGET, @Result.LineState);
+  ioctl(Handle, TCGETS, @Result.tios);
+end;
+
+procedure SerRestoreState(Handle: TSerialHandle; State: TSerialState);
+begin
+  ioctl(Handle, TCSETS, @State.tios);
+  ioctl(Handle, TIOCMSET, @State.LineState);
+end;
+
+procedure SerSetDTR(Handle: TSerialHandle; State: Boolean);
+const
+  DTR: Cardinal = TIOCM_DTR;
+begin
+  if State then
+    ioctl(Handle, TIOCMBIS, @DTR)
+  else
+    ioctl(Handle, TIOCMBIC, @DTR);
+end;
+
+procedure SerSetRTS(Handle: TSerialHandle; State: Boolean);
+const
+  RTS: Cardinal = TIOCM_RTS;
+begin
+  if State then
+    ioctl(Handle, TIOCMBIS, @RTS)
+  else
+    ioctl(Handle, TIOCMBIC, @RTS);
+end;
+
+function SerGetCTS(Handle: TSerialHandle): Boolean;
+var
+  Flags: Cardinal;
+begin
+  ioctl(Handle, TIOCMGET, @Flags);
+  Result := (Flags and TIOCM_CTS) <> 0;
+end;
+
+function SerGetDSR(Handle: TSerialHandle): Boolean;
+var
+  Flags: Cardinal;
+begin
+  ioctl(Handle, TIOCMGET, @Flags);
+  Result := (Flags and TIOCM_DSR) <> 0;
+end;
+
+function SerGetRI(Handle: TSerialHandle): Boolean;
+var
+  Flags: Cardinal;
+begin
+  ioctl(Handle, TIOCMGET, @Flags);
+  Result := (Flags and TIOCM_RI) <> 0;
+end;
+
+
+end.