diff --git a/rtl/unix/serial.pp b/rtl/unix/serial.pp index 75d2741463..a0b670257c 100644 --- a/rtl/unix/serial.pp +++ b/rtl/unix/serial.pp @@ -1,5 +1,5 @@ { Unit for handling the serial interfaces for Linux and similar Unices. - (c) 2000 Sebastian Guenther, sg@freepascal.org; modified markMLl 2011. + (c) 2000 Sebastian Guenther, sg@freepascal.org; modified MarkMLl 2012. } unit Serial; @@ -81,6 +81,35 @@ function SerGetDSR(Handle: TSerialHandle): Boolean; function SerGetCD(Handle: TSerialHandle): Boolean; function SerGetRI(Handle: TSerialHandle): Boolean; +{ Set a line break state. If the requested time is greater than zero this is in + mSec, in the case of unix this is likely to be rounded up to a few hundred + mSec and to increase by a comparable increment; on unix if the time is less + than or equal to zero its absolute value will be passed directly to the + operating system with implementation-specific effect. If the third parameter + is omitted or true there will be an implicit call of SerDrain() before and + after the break. + + NOTE THAT on Linux, the only reliable mSec parameter is zero which results in + a break of around 250 mSec. Might be completely ineffective on Solaris. + } +procedure SerBreak(Handle: TSerialHandle; mSec: LongInt=0; sync: boolean= true); + +type TSerialIdle= procedure(h: TSerialHandle); + +{ Set this to a shim around Application.ProcessMessages if calling SerReadTimeout(), + SerBreak() etc. from the main thread so that it doesn't lock up a Lazarus app. } +var SerialIdle: TSerialIdle= nil; + +{ This is similar to SerRead() but adds a mSec timeout. Note that this variant + returns as soon as a single byte is available, or as dictated by the timeout. } +function SerReadTimeout(Handle: TSerialHandle; var Buffer; mSec: LongInt): LongInt; + +{ This is similar to SerRead() but adds a mSec timeout. Note that this variant + attempts to accumulate as many bytes as are available, but does not exceed + the timeout. Set up a SerIdle callback if using this in a main thread in a + Lazarus app. } +function SerReadTimeout(Handle: TSerialHandle; var Buffer: array of byte; count, mSec: LongInt): LongInt; + { ************************************************************************** } @@ -163,8 +192,10 @@ begin {$endif} else tios.c_cflag := B9600; end; +{$ifndef SOLARIS} tios.c_ispeed := tios.c_cflag; tios.c_ospeed := tios.c_ispeed; +{$endif} tios.c_cflag := tios.c_cflag or CREAD or CLOCAL; @@ -257,5 +288,104 @@ begin Result := (Flags and TIOCM_RI) <> 0; end; +procedure SerBreak(Handle: TSerialHandle; mSec: LongInt= 0; sync: boolean= true); +begin + if sync then + tcdrain(Handle); + if mSec <= 0 then + tcsendbreak(Handle, Abs(mSec)) + else + tcsendbreak(Handle, Trunc(mSec / 250)); + if sync then + tcdrain(Handle) +end; + +function SerReadTimeout(Handle: TSerialHandle; var Buffer; mSec: LongInt): LongInt; + +VAR readSet: TFDSet; + selectTimeout: TTimeVal; + +begin + fpFD_ZERO(readSet); + fpFD_SET(Handle, readSet); + selectTimeout.tv_sec := mSec div 1000; + selectTimeout.tv_usec := (mSec mod 1000) * 1000; + result := 0; + if fpSelect(Handle + 1, @readSet, nil, nil, @selectTimeout) > 0 then + result := fpRead(Handle, Buffer, 1) +end { SerReadTimeout } ; + +{$ifdef LINUX} + {$define SELECT_UPDATES_TIMEOUT} +{$endif} + +{$ifdef SELECT_UPDATES_TIMEOUT} + +function SerReadTimeout(Handle: TSerialHandle; var Buffer: array of byte; count, mSec: LongInt): LongInt; + +VAR readSet: TFDSet; + selectTimeout: TTimeVal; + +begin + fpFD_ZERO(readSet); + fpFD_SET(Handle, readSet); + selectTimeout.tv_sec := mSec div 1000; + selectTimeout.tv_usec := (mSec mod 1000) * 1000; + result := 0; + +// Note: this variant of fpSelect() is a thin wrapper around the kernel's syscall. +// In the case of Linux the syscall DOES update the timeout parameter. + + while fpSelect(Handle + 1, @readSet, nil, nil, @selectTimeout) > 0 do begin + Inc(result,fpRead(Handle, Buffer[result], count - result)); + if result >= count then + break; + if Assigned(SerialIdle) then + SerialIdle(Handle) + end +end { SerReadTimeout } ; + +{$else} + +function SerReadTimeout(Handle: TSerialHandle; var Buffer: array of byte; count, mSec: LongInt): LongInt; + +VAR readSet: TFDSet; + selectTimeout: TTimeVal; + uSecOnEntry, uSecElapsed: QWord; + + function now64uSec: QWord; + + var tv: timeval; + + begin + fpgettimeofday(@tv, nil); + result := tv.tv_sec * 1000000 + tv.tv_usec + end { now64uSec } ; + +begin + fpFD_ZERO(readSet); + fpFD_SET(Handle, readSet); + selectTimeout.tv_sec := mSec div 1000; + selectTimeout.tv_usec := (mSec mod 1000) * 1000; + result := 0; + uSecOnEntry := now64uSec; + +// Note: this variant of fpSelect() is a thin wrapper around the kernel's syscall. +// In the case of Solaris the syscall DOES NOT update the timeout parameter. + + while fpSelect(Handle + 1, @readSet, nil, nil, @selectTimeout) > 0 do begin + Inc(result,fpRead(Handle, Buffer[result], count - result)); + uSecElapsed := now64uSec - uSecOnEntry; + if (result >= count) or (uSecElapsed >= mSec * 1000) then + break; + selectTimeout.tv_sec := (mSec * 1000 - uSecElapsed) div 1000000; + selectTimeout.tv_usec := (mSec * 1000 - uSecElapsed) mod 1000000; + if Assigned(SerialIdle) then + SerialIdle(Handle) + end +end { SerReadTimeout } ; + +{$endif} + end.