HB_FUNC( P_CRC16 )
{
   char *ptr = hb_parc( 1 );
   int count = hb_parclen( 1 );

   register unsigned short crc = 0;

   while ( count-- > 0 )
      crc = updcrc( *ptr++, crc );

   /* swap Hi and Lo byte */
   hb_retnl( ( crc >> 8 ) | ( ( crc << 8 ) & 0xFF00 ) );
}

/* Taken from: contrib/unicode/hbcrc32.c

 * Harbour Unicode Support
 *
 * Source codes for functions:
 *    HB_CRC32()
 *    HB_NCRC32()
 *
 * Copyright 2004 Dmitry V. Korzhov 
 * www - http://www.harbour-project.org
*/

#define CRC32INIT    ( 0xFFFFFFFFL )

static ULONG crc32tbl[ 256 ] = {
0x00000000l,0x77073096l,0xEE0E612Cl,0x990951BAl,0x076DC419l,0x706AF48Fl,0xE963A535l,0x9E6495A3l,
0x0EDB8832l,0x79DCB8A4l,0xE0D5E91El,0x97D2D988l,0x09B64C2Bl,0x7EB17CBDl,0xE7B82D07l,0x90BF1D91l,
0x1DB71064l,0x6AB020F2l,0xF3B97148l,0x84BE41DEl,0x1ADAD47Dl,0x6DDDE4EBl,0xF4D4B551l,0x83D385C7l,
0x136C9856l,0x646BA8C0l,0xFD62F97Al,0x8A65C9ECl,0x14015C4Fl,0x63066CD9l,0xFA0F3D63l,0x8D080DF5l,
0x3B6E20C8l,0x4C69105El,0xD56041E4l,0xA2677172l,0x3C03E4D1l,0x4B04D447l,0xD20D85FDl,0xA50AB56Bl,
0x35B5A8FAl,0x42B2986Cl,0xDBBBC9D6l,0xACBCF940l,0x32D86CE3l,0x45DF5C75l,0xDCD60DCFl,0xABD13D59l,
0x26D930ACl,0x51DE003Al,0xC8D75180l,0xBFD06116l,0x21B4F4B5l,0x56B3C423l,0xCFBA9599l,0xB8BDA50Fl,
0x2802B89El,0x5F058808l,0xC60CD9B2l,0xB10BE924l,0x2F6F7C87l,0x58684C11l,0xC1611DABl,0xB6662D3Dl,
0x76DC4190l,0x01DB7106l,0x98D220BCl,0xEFD5102Al,0x71B18589l,0x06B6B51Fl,0x9FBFE4A5l,0xE8B8D433l,
0x7807C9A2l,0x0F00F934l,0x9609A88El,0xE10E9818l,0x7F6A0DBBl,0x086D3D2Dl,0x91646C97l,0xE6635C01l,
0x6B6B51F4l,0x1C6C6162l,0x856530D8l,0xF262004El,0x6C0695EDl,0x1B01A57Bl,0x8208F4C1l,0xF50FC457l,
0x65B0D9C6l,0x12B7E950l,0x8BBEB8EAl,0xFCB9887Cl,0x62DD1DDFl,0x15DA2D49l,0x8CD37CF3l,0xFBD44C65l,
0x4DB26158l,0x3AB551CEl,0xA3BC0074l,0xD4BB30E2l,0x4ADFA541l,0x3DD895D7l,0xA4D1C46Dl,0xD3D6F4FBl,
0x4369E96Al,0x346ED9FCl,0xAD678846l,0xDA60B8D0l,0x44042D73l,0x33031DE5l,0xAA0A4C5Fl,0xDD0D7CC9l,
0x5005713Cl,0x270241AAl,0xBE0B1010l,0xC90C2086l,0x5768B525l,0x206F85B3l,0xB966D409l,0xCE61E49Fl,
0x5EDEF90El,0x29D9C998l,0xB0D09822l,0xC7D7A8B4l,0x59B33D17l,0x2EB40D81l,0xB7BD5C3Bl,0xC0BA6CADl,
0xEDB88320l,0x9ABFB3B6l,0x03B6E20Cl,0x74B1D29Al,0xEAD54739l,0x9DD277AFl,0x04DB2615l,0x73DC1683l,
0xE3630B12l,0x94643B84l,0x0D6D6A3El,0x7A6A5AA8l,0xE40ECF0Bl,0x9309FF9Dl,0x0A00AE27l,0x7D079EB1l,
0xF00F9344l,0x8708A3D2l,0x1E01F268l,0x6906C2FEl,0xF762575Dl,0x806567CBl,0x196C3671l,0x6E6B06E7l,
0xFED41B76l,0x89D32BE0l,0x10DA7A5Al,0x67DD4ACCl,0xF9B9DF6Fl,0x8EBEEFF9l,0x17B7BE43l,0x60B08ED5l,
0xD6D6A3E8l,0xA1D1937El,0x38D8C2C4l,0x4FDFF252l,0xD1BB67F1l,0xA6BC5767l,0x3FB506DDl,0x48B2364Bl,
0xD80D2BDAl,0xAF0A1B4Cl,0x36034AF6l,0x41047A60l,0xDF60EFC3l,0xA867DF55l,0x316E8EEFl,0x4669BE79l,
0xCB61B38Cl,0xBC66831Al,0x256FD2A0l,0x5268E236l,0xCC0C7795l,0xBB0B4703l,0x220216B9l,0x5505262Fl,
0xC5BA3BBEl,0xB2BD0B28l,0x2BB45A92l,0x5CB36A04l,0xC2D7FFA7l,0xB5D0CF31l,0x2CD99E8Bl,0x5BDEAE1Dl,
0x9B64C2B0l,0xEC63F226l,0x756AA39Cl,0x026D930Al,0x9C0906A9l,0xEB0E363Fl,0x72076785l,0x05005713l,
0x95BF4A82l,0xE2B87A14l,0x7BB12BAEl,0x0CB61B38l,0x92D28E9Bl,0xE5D5BE0Dl,0x7CDCEFB7l,0x0BDBDF21l,
0x86D3D2D4l,0xF1D4E242l,0x68DDB3F8l,0x1FDA836El,0x81BE16CDl,0xF6B9265Bl,0x6FB077E1l,0x18B74777l,
0x88085AE6l,0xFF0F6A70l,0x66063BCAl,0x11010B5Cl,0x8F659EFFl,0xF862AE69l,0x616BFFD3l,0x166CCF45l,
0xA00AE278l,0xD70DD2EEl,0x4E048354l,0x3903B3C2l,0xA7672661l,0xD06016F7l,0x4969474Dl,0x3E6E77DBl,
0xAED16A4Al,0xD9D65ADCl,0x40DF0B66l,0x37D83BF0l,0xA9BCAE53l,0xDEBB9EC5l,0x47B2CF7Fl,0x30B5FFE9l,
0xBDBDF21Cl,0xCABAC28Al,0x53B39330l,0x24B4A3A6l,0xBAD03605l,0xCDD70693l,0x54DE5729l,0x23D967BFl,
0xB3667A2El,0xC4614AB8l,0x5D681B02l,0x2A6F2B94l,0xB40BBE37l,0xC30C8EA1l,0x5A05DF1Bl,0x2D02EF8Dl };

HB_FUNC( P_CRC32 )
{
   char * ptr = hb_parc( 1 );
   int count = hb_parclen( 1 );

   register ULONG crc = CRC32INIT;

   while( count-- > 0 )
      crc = updcrc32( *ptr++, crc );

   hb_retnl( crc ^ CRC32INIT );
}

HB_FUNC( P_OPEN )
{
   int fd = open( hb_parcx( 1 ), O_RDWR | O_NOCTTY | O_NDELAY ); /* File descriptor for the port */

   if( fd != -1 )
      fcntl( fd, F_SETFL, 0 );

   hb_retnl( fd );
}

HB_FUNC( P_INITPORTSPEED )
{
   struct termios options;
   int port = hb_parnl( 1 );
   int baud = B300;
   char * ptr = hb_parcx( 4 );
   int rc;

   tcgetattr( port, &options );

   /* let's set baud rate */
   switch( hb_parnl( 2 ) )
   {
      case 0:       baud = B0;       break; /* Drop line */
      case 50:      baud = B50;      break;
      case 75:      baud = B75;      break;
      case 110:     baud = B110;     break;
      case 150:     baud = B150;     break;
      case 200:     baud = B200;     break;
      case 300:     baud = B300;     break;
      case 600:     baud = B600;     break;
      case 1200:    baud = B1200;    break;
      case 1800:    baud = B1800;    break;
      case 2400:    baud = B2400;    break;
      case 4800:    baud = B4800;    break;
      case 9600:    baud = B9600;    break;
      case 19200:   baud = B19200;   break;
      case 38400:   baud = B38400;   break;
      case 57600:   baud = B57600;   break;
      case 115200:  baud = B115200;  break;
      case 230400:  baud = B230400;  break;
   }

   cfsetispeed( &options, baud );
   cfsetospeed( &options, baud );

   /* Enable the receiver and set local mode... */
   options.c_cflag |= ( CLOCAL | CREAD );

   /* Raw input from device */
   cfmakeraw( &options );

   /* Reset data bits ( cfmakeraw() puts it to CS8 ) */
   options.c_cflag &= ~CSIZE;

   /* Data bits */
   if( hb_parni( 3 ) == 8 )
      options.c_cflag |= CS8;
   else
      options.c_cflag |= CS7;

   /* Stop bits */
   if( hb_parni( 5 ) == 1 )
      options.c_cflag &= ~CSTOPB;

   /* Parity, only No, Even, Odd supported */
   switch ( *ptr )
   {
      case 'N':
      case 'n':
         options.c_cflag &= ~PARENB;

         options.c_iflag &= ~(INPCK);   /* disable input parity checking */
         break;

      case 'O':
      case 'o':
         options.c_cflag |= PARENB;
         options.c_cflag |= PARODD;

         options.c_iflag |= INPCK;
         break;

      case 'E':
      case 'e':
         options.c_cflag |= PARENB;
         options.c_cflag &= ~PARODD;

         options.c_iflag |= INPCK;
         break;
   }

   /* Every read() call returns as soon as a char is available OR after 3 tenths of a second */
   options.c_cc[ VMIN ] = 0;
   options.c_cc[ VTIME ] = 3;

   /* Set the new options for the port... */
   rc = tcsetattr( port, TCSAFLUSH, &options );

   hb_retnl( rc );
}

HB_FUNC( P_READPORT )
{
   char Buffer[ 512 ];
   int nRead = read( hb_parnl( 1 ), Buffer, sizeof( Buffer ) );

   hb_retclen( nRead > 0 ? Buffer : NULL, nRead );
}

HB_FUNC( P_WRITEPORT )
{
   long n = write( hb_parnl( 1 ), hb_parcx( 2 ), hb_parclen( 2 ) );

   hb_retnl( n < 0 ? -1 : n );
}

HB_FUNC( P_DRAIN )
{
   hb_retnl( tcdrain( hb_parnl( 1 ) ) );
}

HB_FUNC( P_OUTFREE )
{
#if 0
   APIRET rc;
   RXQUEUE rxqueue = { 0 };

   if ( ( rc = DosDevIOCtl( ( HFILE ) hb_parnl( 1 ), IOCTL_ASYNC, ASYNC_GETOUTQUECOUNT,
                            NULL, 0L, NULL, &rxqueue, sizeof( RXQUEUE ), NULL ) ) == NO_ERROR )
      hb_retnl( rxqueue.cb - rxqueue.cch );
   else
      hb_retnl( -1 ); /* Put GetLastError() here, or better a second byref param? */
#endif
}

HB_FUNC( P_ISDCD )
{
   int status;

   if ( ioctl( hb_parnl( 1 ), TIOCMGET, &status ) == 0 )
      hb_retl( ( status & TIOCM_CD ) == TIOCM_CD );
   else
      hb_retl( FALSE );
}

HB_FUNC( P_ISRI )
{
   int status;

   if ( ioctl( hb_parnl( 1 ), TIOCMGET, &status ) == 0 )
      hb_retl( ( status & TIOCM_RI ) == TIOCM_RI );
   else
      hb_retl( FALSE );
}

HB_FUNC( P_ISDSR )
{
   int status;

   if ( ioctl( hb_parnl( 1 ), TIOCMGET, &status ) == 0 )
      hb_retl( ( status & TIOCM_DSR ) == TIOCM_DSR );
   else
      hb_retl( FALSE );
}

HB_FUNC( P_ISCTS )
{
   int status;

   if ( ioctl( hb_parnl( 1 ), TIOCMGET, &status ) == 0 )
      hb_retl( ( status & TIOCM_CTS ) == TIOCM_CTS );
   else
      hb_retl( FALSE );
}

HB_FUNC( P_CTRLCTS )
{
#if !defined( CRTSCTS ) && defined( __WATCOMC__ )
#  define CRTSCTS 020000000000
#endif
   struct termios options;
   int port = hb_parnl( 1 );
   int newvalue = hb_pcount() == 2 ? hb_parnl( 2 ) : -1;
   int curvalue;
   int rc;

   tcgetattr( port, &options );
   curvalue = ( options.c_cflag & CRTSCTS ) == CRTSCTS;

   if( newvalue == 0 )
      options.c_cflag &= ~CRTSCTS;
   else if( newvalue == 1 )
      options.c_cflag |= CRTSCTS;

   if( newvalue >= 0 )
      rc = tcsetattr( port, TCSAFLUSH, &options );

   hb_retni( curvalue ? 1 : 0 );
}

HB_FUNC( P_CTRLDTR )
{
   double nph = hb_parnd( 1 );
   double nnewval, noldval;
   unsigned int result = 0;

   ioctl( nph, TIOCMGET, &result );

   if( result & TIOCM_DTR )
      noldval = 1;
   else
      noldval = 0;

   if( noldval != nnewval )
   {
      if( nnewval == 0 )
         result &= ~TIOCM_DTR;
      else
         result |= TIOCM_DTR;

      ioctl( nph, TIOCMSET, &result );
   }

   hb_stornd( nnewval, 2 );
   hb_stornd( noldval, 3 );
}

HB_FUNC( P_INITPORTSPEED )
{
   LINECONTROL lctl;
   DCBINFO dcb;
   USHORT Baud = ( USHORT ) hb_parnl( 2 );
   char * ptr = hb_parcx( 4 );

   memset( &dcb, 0, sizeof( dcb ) );
   memset( &lctl, 0, sizeof( lctl ) );

   /* OS/2 has Mark and Space parity options */
   switch( *ptr )
   {
      case 'N':
      case 'n':
         lctl.bParity = 0;
         break;
      case 'O':
      case 'o':
         lctl.bParity = 1;
         break;
      case 'E':
      case 'e':
         lctl.bParity = 2;
         break;
      case 'M':
      case 'm':
         lctl.bParity = 3;
         break;
      case 'S':
      case 's':
         lctl.bParity = 4;
   }

   lctl.bDataBits = hb_parnl( 3 );
   lctl.bStopBits = hb_parnl( 5 ) == 1 ? 0 : hb_parnl( 5 );    /* 1 == 1.5 stop bits only valid with 5 data bits */
   lctl.fTransBreak = 0;

   if( DosDevIOCtl( ( HFILE ) hb_parnl( 1 ), IOCTL_ASYNC, ASYNC_SETBAUDRATE, &Baud,
                    sizeof( USHORT ), NULL, NULL, 0L, NULL ) == NO_ERROR )
   {
      if( DosDevIOCtl( ( HFILE ) hb_parnl( 1 ), IOCTL_ASYNC, ASYNC_SETLINECTRL,
                       &lctl, sizeof( LINECONTROL ), NULL, NULL, 0L, NULL ) == NO_ERROR )
      {
         /* tp_ help says: on port open
         DTR      ON   (value 1)
         CTS      OFF
         DCD      IGNORE
         DSR      OFF
         RTS      ON   (value 1)
         XON/XOFF OFF
         */
         dcb.fbCtlHndShake = MODE_DTR_HANDSHAKE | MODE_RTS_HANDSHAKE;

         /* 0x20 == full duplex */
         dcb.fbFlowReplace = MODE_RTS_HANDSHAKE | 0x20;

         dcb.fbTimeout = MODE_NO_WRITE_TIMEOUT | MODE_NOWAIT_READ_TIMEOUT;

         if( DosDevIOCtl( ( HFILE ) hb_parnl( 1 ), IOCTL_ASYNC, ASYNC_SETDCBINFO, &dcb,
                          sizeof(DCBINFO), 0L, NULL, 0L, NULL ) == NO_ERROR )
            hb_retnl( 0 );
         else
            hb_retnl( -3 );
      }
      else
         hb_retnl( -2 );
   }
   else
      hb_retnl( -1 );
}

HB_FUNC( P_READPORT )
{
   char Buffer[ 512 ];
   ULONG nRead = 0;
   APIRET rc = DosRead( ( HFILE ) hb_parnl( 1 ), Buffer, sizeof( Buffer ), &nRead );

   hb_retclen( rc == NO_ERROR ? Buffer : NULL, nRead );
}

HB_FUNC( P_WRITEPORT )
{
   ULONG nWritten = 0;
   APIRET rc = DosWrite( ( HFILE ) hb_parnl( 1 ), hb_parcx( 2 ), hb_parclen( 2 ), &nWritten );

   hb_retnl( rc == NO_ERROR ? ( long ) nWritten : -1 ); /* Put GetLastError() on error, or better a second byref param? */
}

HB_FUNC( P_OUTFREE )
{
   APIRET rc;
   RXQUEUE rxqueue;

   memset( &rxqueue, 0, sizeof( rxqueue ) );

   if( ( rc = DosDevIOCtl( ( HFILE ) hb_parnl( 1 ), IOCTL_ASYNC, ASYNC_GETOUTQUECOUNT,
                           NULL, 0L, NULL, &rxqueue, sizeof(RXQUEUE), NULL ) ) == NO_ERROR )
      hb_retnl( rxqueue.cb - rxqueue.cch );
   else
      hb_retnl( -1 ); /* Put GetLastError() here, or better a second byref param? */
}

HB_FUNC( P_ISDCD )
{
   BYTE instat;

   /* if DosDevIOCtl() returns an error, return no DCD */
   if( DosDevIOCtl( ( HFILE ) hb_parnl( 1 ), IOCTL_ASYNC, ASYNC_GETMODEMINPUT,
                    NULL, 0, NULL, &instat, sizeof( instat ), NULL ) == NO_ERROR )
      hb_retl( ( instat & DCD_ON ) == DCD_ON );
   else
      hb_retl( FALSE );
}

HB_FUNC( P_ISRI )
{
   BYTE instat;

   if( DosDevIOCtl( ( HFILE ) hb_parnl( 1 ), IOCTL_ASYNC, ASYNC_GETMODEMINPUT,
                    NULL, 0, NULL, &instat, sizeof( instat ), NULL ) == NO_ERROR )
      hb_retl( ( instat & RI_ON ) == RI_ON );
   else
      hb_retl( FALSE );
}

HB_FUNC( P_ISDSR )
{
   BYTE instat;

   if( DosDevIOCtl( ( HFILE ) hb_parnl( 1 ), IOCTL_ASYNC, ASYNC_GETMODEMINPUT,
                    NULL, 0, NULL, &instat, sizeof( instat ), NULL ) == NO_ERROR )
      hb_retl( ( instat & DSR_ON ) == DSR_ON );
   else
      hb_retl( FALSE );
}

HB_FUNC( P_ISCTS )
{
   BYTE instat;

   if( DosDevIOCtl( ( HFILE ) hb_parnl( 1 ), IOCTL_ASYNC, ASYNC_GETMODEMINPUT,
                    NULL, 0, NULL, &instat, sizeof( instat ), NULL ) == NO_ERROR )
      hb_retl( ( instat & CTS_ON ) == CTS_ON );
   else
      hb_retl( FALSE );
}

HB_FUNC( P_CTRLCTS )
{
   hb_retni( 0 );
}

HB_FUNC( P_INITPORTSPEED )
{
   DCB dcb;
   char values[ 20 ];
   LPTSTR lpValues;

   FillMemory( &dcb, sizeof( dcb ), 0 );
   dcb.DCBlength = sizeof( dcb );

   snprintf( values, sizeof( values ), "%lu,%1s,%1lu,%1lu", hb_parnl( 2 ), hb_parcx( 4 ), hb_parnl( 3 ), hb_parnl( 5 ) );
   lpValues = HB_TCHAR_CONVTO( values );

   if( BuildCommDCB( lpValues, &dcb ) )
   {
      if( SetCommState( ( HANDLE ) hb_parnl( 1 ), &dcb ) )
      {
         COMMTIMEOUTS timeouts;

         /* read/write operations return immediatly */
         timeouts.ReadIntervalTimeout = MAXDWORD;
         timeouts.ReadTotalTimeoutMultiplier = 0;
         timeouts.ReadTotalTimeoutConstant = 0;
         timeouts.WriteTotalTimeoutMultiplier = 0;
         timeouts.WriteTotalTimeoutConstant = 0;

         hb_retnl( SetCommTimeouts( ( HANDLE ) hb_parnl( 1 ), &timeouts ) ? 0 : -1 );
      }
      else
         hb_retnl( -1 );
   }
   else
      hb_retnl( -1 );

   HB_TCHAR_FREE( lpValues );
}

HB_FUNC( P_READPORT )
{
   char Buffer[ 512 ];
   DWORD nRead = 0;
   OVERLAPPED Overlapped;
   BOOL bRet;

   memset( &Overlapped, 0, sizeof( OVERLAPPED ) );
   bRet = ReadFile( ( HANDLE ) hb_parnl( 1 ), Buffer, sizeof( Buffer ), &nRead, &Overlapped );
   hb_retclen( bRet ? Buffer : NULL, nRead );
}

HB_FUNC( P_WRITEPORT )
{
   DWORD nWritten = 0;
   OVERLAPPED Overlapped;
   BOOL bRet;

   memset( &Overlapped, 0, sizeof( OVERLAPPED ) );
   bRet = WriteFile( ( HANDLE ) hb_parnl( 1 ), hb_parcx( 2 ), hb_parclen( 2 ), &nWritten, &Overlapped );
   hb_retnl( bRet ? ( long ) nWritten : -1 ); /* Put GetLastError() on error, or better a second byref param? */
}

function tp_baud( nPort, nNewBaud )

   local nRes

   default nNewBaud to 0

   if ! isport( nPort ) .OR. Empty( s_aPorts[ nPort, TPFP_NAME ] )
      return TE_NOPORT
   endif

   if ! isopenport( nPort )
      return 0
   endif

   if nNewBaud > 0
      if ( nRes := p_InitPortSpeed( s_aPorts[ nPort, TPFP_HANDLE ] ,;
                                    nNewBaud,;
                                    s_aPorts[ nPort, TPFP_DBITS  ] ,;
                                    s_aPorts[ nPort, TPFP_PARITY ] ,;
                                    s_aPorts[ nPort, TPFP_SBITS  ] ) ) == 0

         s_aPorts[ nPort, TPFP_BAUD ] := nNewBaud


      else
         // set error code
      endif
   endif

return s_aPorts[ nPort, TPFP_BAUD ]

function tp_inkey( nSecs )
   if valtype( nSecs ) == "U"
      return inkey()
   endif
return inkey( nSecs )

function tp_idle( lNewval )
   if lNewval == .t.
      return .t.
   endif
return .f.

function tp_delay( nTime )

   default nTime to 0

   if nTime < 0
      return nil

   elseif nTime > 1800
      nTime := 1800

   endif

   ThreadSleep( nTime * 1000 )

return nil

function tp_close( nPort, nTimeout )

   default nTimeout to 0

   /* Clipper returns 0 even if a port is not open */
   if ! isopenport( nPort )
      return 0
   endif

   if nTimeout > 0
      tp_flush( nPort, nTimeout )
   endif

   if s_aPorts[ nPort, TPFP_HANDLE ] >= 0

      fClose( s_aPorts[ nPort, TPFP_HANDLE ] )

      /* Port parameters should stay the same for the case the port
         gets reopened
      */
      s_aPorts[ nPort, TPFP_OC ] := .F.
      s_aPorts[ nPort, TPFP_INBUF ] := ""
      s_aPorts[ nPort, TPFP_HANDLE ] := -1
   endif

return 0

function tp_reopen( nPort, nInSize, nOutSize )

   LOCAL nBaud, nData, cParity, nStop, cPortName

   default nInSize to 1536, nOutSize to 1536

   if ! isport( nPort ) .OR. Empty( s_aPorts[ nPort, TPFP_NAME ] )
      return TE_NOPORT
   endif

   cPortname   := s_aPorts[ nPort, TPFP_NAME ]
   nBaud       := s_aPorts[ nPort, TPFP_BAUD ]
   nData       := s_aPorts[ nPort, TPFP_DBITS ]
   cParity     := s_aPorts[ nPort, TPFP_PARITY ]
   nStop       := s_aPorts[ nPort, TPFP_SBITS  ]

return tp_open( nPort, nInSize, nOutSize, nBaud, nData, cParity, nStop, cPortName )

function tp_open( nPort, nInSize, nOutSize, nBaud, nData, cParity, nStop, cPortname )

   local nRes, lPortExist

   #ifdef __PLATFORM__LINUX
   local nFileCase, nDirCase
   #endif

   default nInSize to 1536, nOutSize to 1536
   default nBaud to 1200, nData to 8, cParity to "N", nStop to 1

   /* Serial ports name are made up of cPortName + nPort if nPort is not NIL */
   #ifdef __PLATFORM__LINUX
   default cPortName to "/dev/ttyS"
   #else
   default cPortName to "COM"          // Ok for Win32 and OS/2
   #endif

   /* This way compatibility is retained for ports 1-4 on Win32 and Linux, but,
      should necessity arise, it is possible to simply pass a NIL on nPort and
      a full name on cPortName
   */
   #ifdef __PLATFORM__LINUX
   cPortname := AllTrim( cPortname ) + iif( ValType( nPort ) == "N", AllTrim( Str( nPort - 1 ) ), "" )
   #else
   cPortname := AllTrim( cPortname ) + iif( ValType( nPort ) == "N", AllTrim( Str( nPort ) ), "" )
   #endif

   #ifdef __PLATFORM__LINUX
   nFileCase := Set( _SET_FILECASE, 0 )
   nDirCase := Set( _SET_DIRCASE, 0 )
   #endif
   lPortExist := File( cPortname )
   #ifdef __PLATFORM__LINUX
   Set( _SET_FILECASE, nFileCase )
   Set( _SET_DIRCASE, nDirCase )
   #endif

   if ! lPortExist
      return TE_NOPORT
   endif

   if ! isport( nPort )
      return TE_NOPORT
   endif

   s_aPorts[ nPort, TPFP_NAME   ] := cPortname
   s_aPorts[ nPort, TPFP_BAUD   ] := nBaud
   s_aPorts[ nPort, TPFP_DBITS  ] := nData
   s_aPorts[ nPort, TPFP_PARITY ] := cParity
   s_aPorts[ nPort, TPFP_SBITS  ] := nStop
   s_aPorts[ nPort, TPFP_OC     ] := .F.
   s_aPorts[ nPort, TPFP_INBUF  ] := ""
   s_aPorts[ nPort, TPFP_INBUF_SIZE ] := nInSize

   #ifdef __PLATFORM__LINUX
   // Maybe we should have a p_Open() on every platform
   s_aPorts[ nPort, TPFP_HANDLE ] := p_Open( cPortname )
   #else
   s_aPorts[ nPort, TPFP_HANDLE ] := fOpen( cPortname, FO_READWRITE )
   #endif

   if s_aPorts[ nPort, TPFP_HANDLE ] >= 0

      /* low level C functions are prefixed p_ (don't ask me why :)) */
      if ( nRes := p_InitPortSpeed( s_aPorts[ nPort, TPFP_HANDLE ] ,;
                                    s_aPorts[ nPort, TPFP_BAUD   ] ,;
                                    s_aPorts[ nPort, TPFP_DBITS  ] ,;
                                    s_aPorts[ nPort, TPFP_PARITY ] ,;
                                    s_aPorts[ nPort, TPFP_SBITS  ] ) ) == 0

         s_aPorts[ nPort, TPFP_OC ] := .T.
         return nRes

      else

         tp_Close( s_aPorts[ nPort, TPFP_HANDLE ] )
         return nRes

      endif

   endif

   // set error code to a static var to have tp_error() work as expected
   //cnHandle := ferror()

   s_aPorts[ nPort, TPFP_NAME   ] := ""
   s_aPorts[ nPort, TPFP_HANDLE ] := -1
   s_aPorts[ nPort, TPFP_BAUD   ] := 1200
   s_aPorts[ nPort, TPFP_DBITS  ] := 8
   s_aPorts[ nPort, TPFP_PARITY ] := "N"
   s_aPorts[ nPort, TPFP_SBITS  ] := 1
   s_aPorts[ nPort, TPFP_OC     ] := .F.
   s_aPorts[ nPort, TPFP_INBUF  ] := ""
   s_aPorts[ nPort, TPFP_INBUF_SIZE  ] := 0

return TE_CONFL   // maybe should return something different?

function tp_recv( nPort, nLength, nTimeout )

   local nDone
   local cRet := ""

   default nLength to s_aPorts[ nPort, TPFP_INBUF_SIZE  ]
   default nTimeout to 0

   FetchChars( nPort )

   nDone := Seconds() + iif( nTimeout >= 0, nTimeout, 0 )

   while Len( s_aPorts[ nPort, TPFP_INBUF ] ) < nLength .AND.;
         ( nTimeout < 0 .OR. Seconds() < nDone )

      if ! tp_idle()
         FetchChars( nPort )
      else
         exit
      endif

   enddo

   if nLength > Len( s_aPorts[ nPort, TPFP_INBUF ] )
      cRet := s_aPorts[ nPort, TPFP_INBUF ]
      s_aPorts[ nPort, TPFP_INBUF ] := ""
   else
      cRet := SubStr( s_aPorts[ nPort, TPFP_INBUF ], 1, nLength )
      s_aPorts[ nPort, TPFP_INBUF ] := SubStr( s_aPorts[ nPort, TPFP_INBUF ], nLength + 1 )
   endif

return cRet

function tp_send( nPort, cString, nTimeout )

   local nWritten, nTotWritten, nDone

   default cString to "", nTimeout to 0

   if ! isopenport( nPort )
      return 0
   endif

   if Empty( cString )
      return 0
   endif

   nDone := Seconds() + iif( nTimeout >= 0, nTimeout, 0)
   nWritten := nTotWritten := 0

   while nTotWritten < Len( cString ) .AND. ;
         ( nTimeout < 0 .OR. Seconds() <= nDone )

      nWritten := p_WritePort( s_aPorts[ nPort, TPFP_HANDLE ], SubStr( cString, nTotWritten + 1 ) )

      if nWritten >= 0

         nTotWritten += nWritten

         if nTotWritten < Len( cString )

            if ! tp_idle()
               ThreadSleep( 1000 )
            else
               exit
            endif

         endif

      else     // nWritten < 0, error occurred
         exit

      endif

   enddo

return nTotWritten

function tp_sendsub( nPort, cString, nStart, nLength, nTimeout )

   default nStart to 1, nLength to Len( cString )

return tp_send( nPort, SubStr( cString, nStart, nLength ), nTimeout )

function tp_recvto( nPort, cDelim, nMaxlen, nTimeout )

   local cChar
   local nAt
   local nStartPos := 1, nFirst := 0
   local nDone, cRet := ""


   if ! isopenport( nPort )
      return ""
   endif

   if !( ValType( cDelim ) == "C" ) .OR. Empty( cDelim )
      return ""
   endif

   default nMaxlen to 64999      /* dos telepathy def. on xharbour could be higher */
   default nTimeout to 0


   FetchChars( nPort )

   /* Telepathy ng: [...] If nTimeout is omitted or zero, reads until finding the
                    delimiter or the input buffer is empty. */
   if nTimeout == 0 .AND. Empty( s_aPorts[ nPort, TPFP_INBUF ] )
      return ""
   endif

   nDone := Seconds() + iif( nTimeout >= 0, nTimeout, 0 )

   while ( nTimeout < 0 .OR. Seconds() < nDone )

      if Len( cDelim ) == 1

         nAt := hb_At( cDelim, s_aPorts[ nPort, TPFP_INBUF ], nStartPos )

         if nAt > 0 .AND. iif( nFirst > 0, nAt < nFirst, .T. )
            nFirst := nAt
         endif

      else

         FOR EACH cChar IN cDelim

            nAt := hb_At( cChar, s_aPorts[ nPort, TPFP_INBUF ], nStartPos )

            if nAt > 0 .AND. iif( nFirst > 0, nAt < nFirst, .T. )
               nFirst := nAt
            endif

         NEXT

      endif

      // I've found it
      if nFirst > 0
         exit

      else
         // Next loop I don't need to search that part of the input buffer that
         // I've already just searched for
         nStartPos := Max( Len( s_aPorts[ nPort, TPFP_INBUF ] ), 1 )

         // I've read more characters than I'm allowed to, so I exit
         if nStartPos >= nMaxLen
            exit
         endif

         if ! tp_idle()
            FetchChars( nPort )
         else
            exit
         endif
      endif

   enddo

   if nFirst > 0
      cRet := Left( s_aPorts[ nPort, TPFP_INBUF ], nFirst )
      s_aPorts[ nPort, TPFP_INBUF ] := SubStr( s_aPorts[ nPort, TPFP_INBUF ], nFirst + 1 )
   endif

return cRet

function tp_lookfor( nPort, cLookfor )

   if ! isopenport( nPort )
      return 0
   endif

   FetchChars( nPort )

return At( cLookfor, s_aPorts[ nPort, TPFP_INBUF ] )

function tp_inchrs( nPort )

   if ! isopenport( nPort )
      return 0
   endif

   FetchChars( nPort )

return Len( s_aPorts[ nPort, TPFP_INBUF ] )

function tp_outfree( nPort )

   if ! isopenport( nPort )
      return 0
   endif

return p_OutFree( s_aPorts[ nPort, TPFP_HANDLE ] )

function tp_clearin( nPort )

   if isopenport( nPort )
      FetchChars( nPort )
      s_aPorts[ nPort, TPFP_INBUF ] := ""
   endif

return nil

function tp_clrkbd()

   clear typeahead

return nil

function tp_crc16( cString )

return p_CRC16( cString )

function tp_crc32( cString )

return p_CRC32( cString )

function tp_waitfor( ... )

   local aParam := hb_AParams()
   local nPort, nTimeout, lIgnorecase

   nPort := aParam[ 1 ]
   nTimeout := aParam[ 2 ]
   lIgnorecase := aParam[ Len( aParam ) ]

   if ! isopenport( nPort )
      return 0
   endif

   default nTimeout to -1
   default lIgnorecase to .f.

   /*

   if ntimeout < 0
      nDone := _clock() + 999999
   elseif ntimeout == 0
      nDone := 4
   else
      nDone := _clock() + nTimeout
   endif

   while ( nDone > _clock() .or. nFirst == 100000 ) .and. ! tp_idle()

      if nFirst == 100000
         nFirst := 99999
      endif

      FetchChars( nPort )

      for x := 1 to len( acList )
         if lIgnorecase
            nAt := at( upper( acList[ x ] ), upper( s_aPorts[ nPort, TPFP_INBUF ] ))
         else
            nAt := at( acList[ x ] , s_aPorts[ nPort, TPFP_INBUF ] )
         endif
         if nAt > 0 .and. nAt < nFirst
            nFirst := nAt
            nRet := x
         endif
      next

      if nFirst < 64000
         exit
      endif

#if 0
      sched_yield() // C level function
#endif

   enddo

   if nFirst < 64000
      tp_recv( nPort, nAt + len( acList[ nRet ] ))
      return nRet
   endif
   */

return 0



/* We cannot set, well, _I_ think we cannot, CTS without setting RTS flowcontrol, so this

   function and tp_ctrlrts() do the same thing, that is set/reset CRTSCTS flowcontol */

function tp_ctrlcts( nPort, nNewCtrl )

   local nCurValue

    if ! isopenport( nPort )
      return 0
   endif

   if Valtype( nNewCtrl ) == "U"
      nCurValue := p_ctrlcts( s_aPorts[ nPort, TPFP_HANDLE ] )

   else
      nCurValue := p_ctrlcts( s_aPorts[ nPort, TPFP_HANDLE ], nNewCtrl )

   endif

return nCurValue

function tp_ctrlrts( nPort, nNewCtrl )

return tp_ctrlcts( nPort, nNewCtrl )

function tp_isdcd( nPort )

   if ! isopenport( nPort )
      return .f.
   endif

return p_isdcd( s_aPorts[ nPort, TPFP_HANDLE ] )

function tp_isri( nPort )

   if ! isopenport( nPort )
      return .f.
   endif

return p_isri( s_aPorts[ nPort, TPFP_HANDLE ] )

function tp_isdsr( nPort )

   if ! isopenport( nPort )
      return .f.
   endif

return p_isdsr( s_aPorts[ nPort, TPFP_HANDLE ] )

function tp_iscts( nPort )

   if ! isopenport( nPort )
      return .f.
   endif

return p_iscts( s_aPorts[ nPort, TPFP_HANDLE ] )

function tp_flush( nPort, nTimeout )

   local nStart := Seconds()
   local nRes

   default nTimeout to 0

   if ! isopenport( nPort )
      return TE_CLOSED
   endif

   nRes := p_Drain( s_aPorts[ nPort, TPFP_HANDLE ] )

   // Sleep rest of timeout
   /*
   if nTimeout > 0 .AND. Seconds() - nStart < nTimeout
      ThreadSleep( ( nTimeout - ( Seconds() - nStart ) ) * 1000 )
   endif
   */

   // NB: returns timeout on error trying to reach compatibility with other platforms
   //     to be tested
return iif( nRes == 0, 0, TE_TMOUT )

function tp_flush( nPort, nTimeout )

   local nDone

   default nTimeout to -1

   if ! isopenport( nPort )
      return TE_CLOSED
   endif

   if nTimeout > 1800
      nTimeout := 1800
   endif

   nDone := Seconds() + iif( nTimeout >= 0, nTimeout, 0 )

   while tp_OutFree( nPort ) > 0 .AND. ;
         ( nTimeout < 0 .OR. Seconds() < nDone )
         hb_IdleState()
   enddo

return iif( tp_OutFree( nPort ) > 0, TE_TMOUT, 0 )

static function isopenport( nPort )

   if ! isport( nPort )
      return .f.
   endif

return s_aPorts[ nPort, TPFP_OC ]

static function isport( nPort )

   if valtype( nPort ) != "N" .or. nPort < 1 .or. nPort > TP_MAXPORTS
      return .f.
   endif

return .t.

static function FetchChars( nPort )

   local cStr := ""

   if ! isopenport( nPort )
      return 0
   endif

   cStr := p_ReadPort( s_aPorts[ nPort, TPFP_HANDLE ] )

   if ! Empty( cStr )
      s_aPorts[ nPort, TPFP_INBUF ] += cStr
   endif

return Len( cStr )

INIT PROCEDURE _tpinit()

   local x

   if s_aPorts == nil
      s_aPorts := array( TP_MAXPORTS )
      for x := 1 to len( s_aPorts )
         /// port name, file handle, baud, data bits, parity, stop bits, Open?, input buffer, input buff.size
         s_aPorts[ x ] := { "", -1, 1200, 8, "N", 1, .F., "", 0 }
      next
   endif

return

procedure tp_uninstall()
   /* NOTE: dummy function, solely for compatibility. */
   return