/*=====================================================================*/
/*    serrano/prgm/project/bigloo/runtime/Clib/crgc.c                  */
/*    -------------------------------------------------------------    */
/*    Author      :  Manuel Serrano                                    */
/*    Creation    :  Sun Sep 13 11:58:32 1998                          */
/*    Last change :  Fri Nov 14 21:23:13 2003 (serrano)                */
/*    -------------------------------------------------------------    */
/*    Rgc runtime (mostly port handling).                              */
/*=====================================================================*/
#include <stdio.h>
#include <errno.h> 
#include <sys/types.h>
#include <sys/stat.h>
#include <string.h>
#ifndef _MSC_VER
#   include <dirent.h>
#   include <sys/file.h>
#   include <sys/time.h>
#else
#   include <io.h>
#   include <windows.h>
#endif
#if( !(defined( NeXT ) && (defined( mc68000 ) || defined( i386 ))) )
#   ifdef HAVE_TERMIO
#      include <termio.h>
#   endif
#endif
#if !defined( sony_news ) && \
    !(defined( NeXT ) && (defined( mc68000 ) || defined( i386 ))) && \
    !defined( _MSC_VER )
#   include <unistd.h>
#endif
#include <bigloo.h>
#if( defined( sony_news ) || (defined( NeXT ) && defined( mc68000 )) )
#   include <ctype.h>
#endif
#if POSIX_FILE_OPS
#   include <unistd.h>
#endif

/*---------------------------------------------------------------------*/
/*    isascii                                                          */
/*---------------------------------------------------------------------*/
#if( !defined( isascii ) )
#   define isascii( c ) (!((c) & ~0177))
#endif

#define RGC_DEBUG
#undef RGC_DEBUG

/*---------------------------------------------------------------------*/
/*    C importations                                                   */
/*---------------------------------------------------------------------*/
extern obj_t bigloo_case_sensitive;
extern obj_t string_to_keyword( char * );

/*---------------------------------------------------------------------*/
/*    int                                                              */
/*    bgl_feof ...                                                     */
/*    -------------------------------------------------------------    */
/*    We explicitly define this function because on some system        */
/*    feof is a macro.                                                 */
/*---------------------------------------------------------------------*/
int
bgl_feof( FILE *stream ) {
   return feof( stream );
}

/*---------------------------------------------------------------------*/
/*    long                                                             */
/*    bgl_nb_fread ...                                                 */
/*    -------------------------------------------------------------    */
/*    In constrast to fread, this function does not block on input, if */
/*    not enough characters are available.                             */
/*---------------------------------------------------------------------*/
long
bgl_nb_fread( char *ptr, long size, long nmemb, FILE *stream ) {
   long  num = size * nmemb;
   char *buf = ptr;
   int   c;

#ifdef POSIX_FILE_OPS
   return read( fileno( stream ), ptr, num);
#else
   while( ((c = getc( stream )) != EOF) ) {
      *buf++ = c;

      if( c == '\n' ) break;
      if( --num <= 0 ) break;
   }

   return (long)(buf - ptr);
#endif
}

/*---------------------------------------------------------------------*/
/*    static void                                                      */
/*    rgc_enlarge_buffer ...                                           */
/*    -------------------------------------------------------------    */
/*    This function augments the size of a port's buffer. An error is  */
/*    raised if there is not enough room for the allocation.           */
/*    The size must be given as parameter.                             */
/*---------------------------------------------------------------------*/
static void
rgc_enlarge_buffer( obj_t port, long n ) {
   long bufsize = INPUT_PORT( port ).bufsiz;
   long abufsize = INPUT_PORT( port ).abufsiz;

   if( n <= bufsize ) return;

   // FIXME where does 2 come from?
   if( bufsize == 2 ) {
      C_FAILURE( "input-port",
		 "Can't enlarge buffer for non bufferized port (see the user manual for details)",
		 port );
   } else {
      // FIXME
      // can we use GC_REALLOC and if yes, how??
      unsigned char *buffer = (char *)GC_MALLOC_ATOMIC( n );

#if defined( RGC_DEBUG )
      printf( "rgc_enlarge_buffer: bufsize: %d new: %d\n", bufsize, n );
#endif

      if( !buffer )
	 C_FAILURE( "rgc_enlarge_buffer", "Can't enlarge buffer", port );

      memcpy( buffer, RGC_BUFFER( port ), abufsize );
      RGC_BUFFER( port )        = (unsigned char *)buffer;

      INPUT_PORT( port ).bufsiz = n;
   }
}
  
/*---------------------------------------------------------------------*/
/*    static void                                                      */
/*    rgc_double_buffer ...                                            */
/*    -------------------------------------------------------------    */
/*    This function doubles the size of a port's buffer. An error is   */
/*    raised if there is not enough room for the allocation.           */
/*---------------------------------------------------------------------*/
static void
rgc_double_buffer( obj_t port ) {
   long bufsize = INPUT_PORT( port ).bufsiz;
   rgc_enlarge_buffer( port, bufsize * 2 );
}

/*---------------------------------------------------------------------*/
/*    static void                                                      */
/*    shift_buffer ...                                                 */
/*---------------------------------------------------------------------*/
static void
shift_buffer( obj_t port ) {
   long bufsize    = INPUT_PORT( port ).bufsiz;
   long abufsize   = INPUT_PORT( port ).abufsiz;
   long matchstart = INPUT_PORT( port ).matchstart;
   unsigned char *buffer = RGC_BUFFER( port );
   long movesize = abufsize - matchstart;

   assert( abufsize > 0 );

   /* we shift the buffer left and we fill the buffer */
   memmove( (char *)&buffer[ 0 ], (char *)&buffer[ matchstart ], movesize );

   INPUT_PORT( port ).abufsiz   -= matchstart;
   INPUT_PORT( port ).matchstop -= matchstart;
   INPUT_PORT( port ).forward   -= matchstart;
   INPUT_PORT( port ).lastchar   = RGC_BUFFER( port )[ matchstart - 1 ];
   INPUT_PORT( port ).matchstart = 0;
}
 
/*---------------------------------------------------------------------*/
/*    static bool_t                                                    */
/*    rgc_size_fill_buffer ...                                         */
/*---------------------------------------------------------------------*/
static bool_t
rgc_size_fill_buffer( obj_t port, int abufsize, int size ) {
   unsigned char *buffer = RGC_BUFFER( port );
   int result;
   
#if defined( RGC_DEBUG )
   assert( abufsize >= 1 );
   assert( (abufsize + size) == INPUT_PORT( port ).bufsiz );

   printf( "rgc_size_fill_file_buffer: abufsize: %d  size: %d\n", abufsize, size );
   assert( size > 0 );
#endif

   /* we start reading at ABUFSIZE - 1 because we have */
   /* to remove the '\0' sentinel that ends the buffer */
   if( INPUT_PORT( port ).kindof != KINDOF_PROCEDURE ) {
      result = INPUT_PORT( port ).sysread( &buffer[ abufsize - 1 ],
					   1,
					   size,
					   (FILE *) INPUT_PORT(port).file );
   } else {
      unsigned char *big_data = NULL;
      result = INPUT_PORT( port ).sysread( &buffer[ abufsize - 1 ],
					   1,
					   size,
					   (FILE *) INPUT_PORT(port).file,
					   &big_data);
      if( big_data ) {
	 /* don't really know how to avoid enlarging the buffer here   */
	 /* I think it's somehow better than calling it inside sysread */
	 /* functions     //cl                                         */
	 shift_buffer( port );
	 abufsize = INPUT_PORT( port ).abufsiz;
	 rgc_enlarge_buffer( port, abufsize + result );
	 buffer = RGC_BUFFER( port );
	 memmove( &buffer[ abufsize - 1 ], big_data, result );
      }
   }

#ifdef POSIX_FILE_OPS
   if (result < 0)
      C_FAILURE( "read", "Error while reading on file", port );

   if (result == 0)
      INPUT_PORT( port ).eof = 1;
#else
   if( ferror( (FILE *)INPUT_PORT( port ).file ) )
      C_FAILURE( "read", "Error while reading on file", port );

   if( INPUT_PORT( port ).syseof( INPUT_PORT( port ).file ) )
      INPUT_PORT( port ).eof = 1;
#endif

   abufsize += result;

   INPUT_PORT( port ).abufsiz = abufsize;

   assert( INPUT_PORT( port ).abufsiz <= INPUT_PORT( port ).bufsiz );

#if defined( RGC_DEBUG )
   printf( "FIN de fill: size: %d  asize: %d  forward: %d  mstart: %d  mstop: %d\n",
	   INPUT_PORT( port ).bufsiz, INPUT_PORT( port ).abufsiz,
	   INPUT_PORT( port ).forward, 
	   INPUT_PORT( port ).matchstart, INPUT_PORT( port ).matchstop );
   printf( "buffer: [%s]\n", buffer );
#endif

   if( abufsize > 0 ) {
      buffer[ abufsize - 1 ] = '\0';

      return 1;
   } else {
      return 0;
   }
}

/*---------------------------------------------------------------------*/
/*    bool_t                                                           */
/*    rgc_fill_buffer ...                                              */
/*---------------------------------------------------------------------*/
BGL_RUNTIME_DEF
bool_t
rgc_fill_buffer( obj_t port ) {
   long bufsize    = INPUT_PORT( port ).bufsiz;
   long abufsize   = INPUT_PORT( port ).abufsiz;
   long matchstart = INPUT_PORT( port ).matchstart;

#if defined( RGC_DEBUG )
   printf( "rgc_fill_buffer: bufsize: %d  abufsize: %d  forward: %d  mstart: %d  mstop: %d\n",
	   bufsize, abufsize, INPUT_PORT( port ).forward,
	   INPUT_PORT( port ).matchstart, INPUT_PORT( port ).matchstop );
   puts( "~~~~~ rgc_fill_buffer ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" );
   printf( "eof: %d  mstart: %d  mstop: %d\n",
	   INPUT_PORT( port ).eof,
	   INPUT_PORT( port ).matchstart,
	   INPUT_PORT( port ).matchstop );
#endif
   /* In every case, forward has to be unwinded */
   /* because forward has reached the sentinel  */
   INPUT_PORT( port ).forward--;

   /* an input port that has seen its eof       */
   /* cannot be filled anymore                  */
   if( INPUT_PORT( port ).eof ) {
      return 0;
   } else {
      if( abufsize < bufsize )
	 /* the buffer is not full, we fill it */
	 return rgc_size_fill_buffer( port, abufsize, bufsize - abufsize );
      else {
	 if( matchstart > 0 ) {
	    shift_buffer( port );
	    abufsize = INPUT_PORT( port ).abufsiz;
	    return rgc_size_fill_buffer( port, abufsize, bufsize - abufsize );
	 } else {
	    /* the current token is too large for the buffer */
	    /* we have to enlarge it.                        */
	    /* Note: see rgc_size_fil_buffer for other       */
	    /* enlarge_buffer                                */
	    rgc_double_buffer( port );

	    /* undo forward--                                */
	    INPUT_PORT( port ).forward++;

	    return rgc_fill_buffer( port );
	 }
      }
   }
}

/*---------------------------------------------------------------------*/
/*    obj_t                                                            */
/*    rgc_buffer_substring ...                                         */
/*    -------------------------------------------------------------    */
/*    This function makes no bound checks because these tests have     */
/*    already been performed in the grammar.                           */
/*---------------------------------------------------------------------*/
BGL_RUNTIME_DEF
obj_t
rgc_buffer_substring( obj_t ip, long offset, long end ) {
   long start = INPUT_PORT( ip ).matchstart;
   long len   = end - offset;

#if defined( RGC_DEBUG )
   printf( "buffer-substring: start: %d  stop: %d  forward: %d  abufsiz: %d\n",
	   start, INPUT_PORT( ip ).matchstop,
	   INPUT_PORT( ip ).forward, INPUT_PORT( ip ).abufsiz );
#endif

   return string_to_bstring_len( (char *)&RGC_BUFFER( ip )[ start + offset ],
				 len );
}

/*---------------------------------------------------------------------*/
/*    CHEAT_BUFFER                                                     */
/*---------------------------------------------------------------------*/
#define CHEAT_BUFFER() \
   long stop  = INPUT_PORT( ip ).matchstop; \
   char bck; \
   bck = RGC_BUFFER( ip )[ stop ]; \
   RGC_BUFFER( ip )[ stop ] = '\0';

/*---------------------------------------------------------------------*/
/*    RESTORE_BUFFER                                                   */
/*---------------------------------------------------------------------*/
#define RESTORE_BUFFER() \
   RGC_BUFFER( ip )[ stop ] = bck;

/*---------------------------------------------------------------------*/
/*    long                                                             */
/*    rgc_buffer_fixnum ...                                            */
/*---------------------------------------------------------------------*/
BGL_RUNTIME_DEF
long
rgc_buffer_fixnum( obj_t ip ) {
   long res;
   
   CHEAT_BUFFER();
   
   res = atol( (const char *)&RGC_BUFFER(ip)[ INPUT_PORT( ip ).matchstart ] );
   
   RESTORE_BUFFER();
   
   return res;
}

/*---------------------------------------------------------------------*/
/*    obj_t                                                            */
/*    rgc_buffer_integer ...                                           */
/*---------------------------------------------------------------------*/
BGL_RUNTIME_DEF
obj_t
rgc_buffer_integer( obj_t ip ) {
   long stop = INPUT_PORT( ip ).matchstop;
   long start = INPUT_PORT( ip ).matchstart;
   long res = 0;
   int sign = 1;

   /* the sign */
   if( RGC_BUFFER(ip)[ start ] == '+' ) {
      start++;
   } else {
      if( RGC_BUFFER(ip)[ start ] == '-' ) {
	 start++;
	 sign = -1;
      }
   }

   /* skip the 0 padding */
   while( (start < stop) && RGC_BUFFER(ip)[ start ] == '0' )
      start++;

   /* the real number */
   while( start < stop ) {
      long res2;
      res2 = res * 10 + (RGC_BUFFER(ip)[ start ] - '0');

      if( res2 < res )
	 goto llong;

      res = res2;
      start++;
   }

#define BGL_MAX_FIXNUM_BITS (((1 << PTR_ALIGNMENT) << 3) - PTR_ALIGNMENT - 1)
#define BGL_MAX_FIXNUM ((1 << BGL_MAX_FIXNUM_BITS) - 1)
   if( res > BGL_MAX_FIXNUM )
      return LLONG_TO_BLLONG( (BGL_LONGLONG_T)(sign > 0 ? res : -res) );
   else
      return BINT( sign > 0 ? res : -res );
      
#undef BGL_MAX_FIXNUM
#undef BGL_MAX_FIXNUM_BITS   
llong:
   {
      BGL_LONGLONG_T lres = (BGL_LONGLONG_T)res;

      while( start < stop ) {
	 lres = lres * 10 + (RGC_BUFFER(ip)[ start ] - '0');
	 start++;
      }

      return LLONG_TO_BLLONG( sign > 0 ? lres : -lres );
   }
}

/*---------------------------------------------------------------------*/
/*    double                                                           */
/*    rgc_buffer_flonum ...                                            */
/*---------------------------------------------------------------------*/
BGL_RUNTIME_DEF
double
rgc_buffer_flonum( obj_t ip ) {
   double res;
   
   CHEAT_BUFFER();
  
   res = strtod( (const char *)&RGC_BUFFER(ip)[ INPUT_PORT(ip).matchstart ], 0 );
   
   RESTORE_BUFFER();
   
   return res;
}

/*---------------------------------------------------------------------*/
/*    obj_t                                                            */
/*    rgc_buffer_symbol ...                                            */
/*---------------------------------------------------------------------*/
BGL_RUNTIME_DEF
obj_t
rgc_buffer_symbol( obj_t ip ) {
   unsigned char *aux;
   obj_t sym;
   long start = INPUT_PORT( ip ).matchstart;
   
   CHEAT_BUFFER();
   
   aux = &RGC_BUFFER( ip )[ start ];
   
   sym = string_to_symbol( (char *)aux );

   RESTORE_BUFFER();
   
   return sym;
}

/*---------------------------------------------------------------------*/
/*    obj_t                                                            */
/*    rgc_buffer_upcase_symbol ...                                     */
/*---------------------------------------------------------------------*/
BGL_RUNTIME_DEF
obj_t
rgc_buffer_upcase_symbol( obj_t ip ) {
   unsigned char *aux;
   obj_t sym;
   long start = INPUT_PORT( ip ).matchstart;
   unsigned char *walk;
   
   CHEAT_BUFFER();
   
   aux = &RGC_BUFFER( ip )[ start ];
   
   for( walk = aux; *walk; walk++ )
      if( isascii( *walk ) )
	 *walk = toupper( *walk );

   sym = string_to_symbol( (char *)aux );

   RESTORE_BUFFER();
   
   return sym;
}

/*---------------------------------------------------------------------*/
/*    obj_t                                                            */
/*    rgc_buffer_downcase_symbol ...                                   */
/*---------------------------------------------------------------------*/
BGL_RUNTIME_DEF
obj_t
rgc_buffer_downcase_symbol( obj_t ip ) {
   unsigned char *aux;
   obj_t sym;
   long start = INPUT_PORT( ip ).matchstart;
   unsigned char *walk;
   
   CHEAT_BUFFER();
   
   aux = &RGC_BUFFER( ip )[ start ];
   
   for( walk = aux; *walk; walk++ )
      if( isascii( *walk ) )
	 *walk = tolower( *walk );

   sym = string_to_symbol( (char *)aux );

   RESTORE_BUFFER();
   
   return sym;
}

/*---------------------------------------------------------------------*/
/*    obj_t                                                            */
/*    rgc_buffer_keyword ...                                           */
/*---------------------------------------------------------------------*/
BGL_RUNTIME_DEF
obj_t
rgc_buffer_keyword( obj_t ip ) {
   unsigned char *aux;
   obj_t key;
   long start = INPUT_PORT( ip ).matchstart;
   
   CHEAT_BUFFER();
   
   aux = &RGC_BUFFER( ip )[ start ];
   
   key = string_to_keyword( (char *)aux );

   RESTORE_BUFFER();

   return key;
}
 
/*---------------------------------------------------------------------*/
/*    obj_t                                                            */
/*    rgc_buffer_downcase_keyword ...                                  */
/*---------------------------------------------------------------------*/
BGL_RUNTIME_DEF
obj_t
rgc_buffer_downcase_keyword( obj_t ip ) {
   unsigned char *aux;
   obj_t key;
   long start = INPUT_PORT( ip ).matchstart;
   unsigned char *walk;
   
   CHEAT_BUFFER();
   
   aux = &RGC_BUFFER( ip )[ start ];
   
   for( walk = aux; *walk; walk++ )
      if( isascii( *walk ) )
	 *walk = tolower( *walk );

   key = string_to_keyword( (char *)aux );

   RESTORE_BUFFER();

   return key;
}
 
/*---------------------------------------------------------------------*/
/*    obj_t                                                            */
/*    rgc_buffer_upcase_keyword ...                                    */
/*---------------------------------------------------------------------*/
BGL_RUNTIME_DEF
obj_t
rgc_buffer_upcase_keyword( obj_t ip ) {
   unsigned char *aux;
   obj_t key;
   long start = INPUT_PORT( ip ).matchstart;
   unsigned char *walk;
   
   CHEAT_BUFFER();
   
   aux = &RGC_BUFFER( ip )[ start ];
   
   for( walk = aux; *walk; walk++ )
      if( isascii( *walk ) )
	 *walk = toupper( *walk );

   key = string_to_keyword( (char *)aux );

   RESTORE_BUFFER();

   return key;
}
 
/*---------------------------------------------------------------------*/
/*    int                                                              */
/*    rgc_buffer_unget_char ...                                        */
/*---------------------------------------------------------------------*/
BGL_RUNTIME_DEF
int
rgc_buffer_unget_char( obj_t ip, int c ) {
   if( INPUT_PORT( ip ).matchstop > 0 ) {
      INPUT_PORT( ip ).matchstop--;
   } else {
      RGC_BUFFER( ip )[ 0 ] = c;
      if( INPUT_PORT( ip ).abufsiz == 0 ) {
	 INPUT_PORT( ip ).abufsiz = 1;
	 RGC_BUFFER( ip )[ 1 ] = '\0';
      }
   }

   return c;
}

/*---------------------------------------------------------------------*/
/*    bool_t                                                           */
/*    rgc_buffer_bol_p ...                                             */
/*    -------------------------------------------------------------    */
/*    Is the matchstart position located at the beginning of a line?   */
/*---------------------------------------------------------------------*/
BGL_RUNTIME_DEF
bool_t
rgc_buffer_bol_p( obj_t ip ) {
#if( defined( RGC_DEBUG ) )
   printf( "RGC_BUFFER_BOL_P: mstart: %d  [mstart]: %d  lastchar: %d  --> %d\n",
	   INPUT_PORT( ip ).matchstart, 
	   RGC_BUFFER( ip )[ INPUT_PORT( ip ).matchstart - 1 ],
	   INPUT_PORT( ip ).lastchar,
	   INPUT_PORT( ip ).lastchar == '\n' );
#endif
   
   if( INPUT_PORT( ip ).matchstart > 0 )
      return RGC_BUFFER( ip )[ INPUT_PORT( ip ).matchstart - 1 ] == '\n';
   else
      return INPUT_PORT( ip ).lastchar == '\n';
}

/*---------------------------------------------------------------------*/
/*    bool_t                                                           */
/*    rgc_buffer_eol_p ...                                             */
/*    -------------------------------------------------------------    */
/*    Does the buffer contain, at its first non match position, a `\n' */
/*    character?                                                       */
/*---------------------------------------------------------------------*/
BGL_RUNTIME_DEF
bool_t
rgc_buffer_eol_p( obj_t ip ) {
   int c = RGC_BUFFER_GET_CHAR( ip );
   
#if( defined( RGC_DEBUG ) )   
   long f = INPUT_PORT( ip ).forward;
#endif
   
#if( defined( RGC_DEBUG ) )   
   printf( "RGC_BUFFER_EOL_P: forward: %d %d", f, c );
#endif
   
   if( !c ) {
      if( !RGC_BUFFER_EMPTY( ip ) ) {
	 INPUT_PORT( ip ).forward--;
	 
#if( defined( RGC_DEBUG ) )   
	 puts( "   not empty --> 0" );
#endif
	 return 0;
      }

      if( INPUT_PORT( ip ).kindof == KINDOF_CONSOLE ) {
#if( defined( RGC_DEBUG ) )   
	 puts( "  kindof == CONSOLE --> 1" );
#endif
	 return 1;
      }
      if( rgc_fill_buffer( ip ) )
	 return rgc_buffer_eol_p( ip );
      else {
#if( defined( RGC_DEBUG ) )   
	 puts( "   not rgc_fill_buffer --> 0" );
#endif
	 return 0;
      }
   } else {
      INPUT_PORT( ip ).forward--;
#if( defined( RGC_DEBUG ) )   
      printf( "   --> %d\n", c == '\n' );
#endif
      return c == '\n';
   }
}

/*---------------------------------------------------------------------*/
/*    bool_t                                                           */
/*    rgc_buffer_bof_p ...                                             */
/*    -------------------------------------------------------------    */
/*    Is the match position at the beginning of the file?              */
/*---------------------------------------------------------------------*/
BGL_RUNTIME_DEF
bool_t
rgc_buffer_bof_p( obj_t ip ) {
   return INPUT_PORT( ip ).filepos == 0;
}

/*---------------------------------------------------------------------*/
/*    bool_t                                                           */
/*    rgc_buffer_eof_p ...                                             */
/*    -------------------------------------------------------------    */
/*    Is the input port at its end-of-file position?                   */
/*---------------------------------------------------------------------*/
BGL_RUNTIME_DEF
bool_t
rgc_buffer_eof_p( obj_t ip ) {
   int c = RGC_BUFFER_GET_CHAR( ip );

#if( defined( RGC_DEBUG ) )   
   long f = INPUT_PORT( ip ).forward;
#endif
   
#if( defined( RGC_DEBUG ) )   
   printf( "RGC_BUFFER_EOF_P: forward: %d %d", f, c );
#endif
   
   if( !c ) {
      if( !RGC_BUFFER_EMPTY( ip ) ) {
	 INPUT_PORT( ip ).forward--;
	 
#if( defined( RGC_DEBUG ) )   
	 puts( "   not empty --> 0" );
#endif
	 return 0;
      }
      else
	 INPUT_PORT( ip ).forward--;
	 
#if( defined( RGC_DEBUG ) )   
	 puts( "   --> 1" );
#endif
	 return 1;
   } else {
      INPUT_PORT( ip ).forward--;
#if( defined( RGC_DEBUG ) )   
      puts( "   not empty --> 0" );
#endif
      return 0;
   }
}

/*---------------------------------------------------------------------*/
/*    static int                                                       */
/*    file_charready ...                                               */
/*---------------------------------------------------------------------*/
static int
file_charready( FILE *f ) {
#ifndef _MSC_VER
#   if( BGL_HAVE_SELECT )
       fd_set readfds;
       struct timeval timeout;
       int fno = fileno( f ) + 1;

       FD_ZERO( &readfds );
       FD_SET( fileno( f ), &readfds );
       timeout.tv_sec = 0; timeout.tv_usec = 0;

       return select( fno, &readfds, NULL, NULL, &timeout );
#   else
       return 0;
#   endif
#else
    HANDLE hFile = (HANDLE)_get_osfhandle( _fileno( f ) );

    return ((WaitForSingleObject( hFile, 0) == WAIT_OBJECT_0) ? 1 : 0);
#endif
}

/*---------------------------------------------------------------------*/
/*    boot_t                                                           */
/*    bgl_rgc_charready ...                                            */
/*---------------------------------------------------------------------*/
BGL_RUNTIME_DEF
bool_t
bgl_rgc_charready( obj_t port ) {
   switch( (long)INPUT_PORT( port ).kindof ) {
      case (long)KINDOF_CLOSED:
	 return 0;
	 
      case (long)KINDOF_STRING:
	 return ((INPUT_PORT( port ).forward+1) < INPUT_PORT( port ).abufsiz);
	 
      case (long)KINDOF_FILE:
	 return ((INPUT_PORT( port ).forward+1) < INPUT_PORT( port ).abufsiz)
	    || !bgl_feof( INPUT_PORT( port ).file );
	 
      case (long)KINDOF_PROCPIPE:
      case (long)KINDOF_PIPE:
      case (long)KINDOF_CONSOLE:
      case (long)KINDOF_SOCKET:
	 return ((INPUT_PORT( port ).forward+1) < INPUT_PORT( port ).abufsiz)
	    || file_charready( INPUT_PORT( port ).file );
	 
      case (long)KINDOF_PROCEDURE:
	 /* to know if a char is available we only could call the procedure */
	 /* this could block, so we just return true                        */
	 return 1;

      default:
	 return 0;
   }
}

/*---------------------------------------------------------------------*/
/*    static int                                                       */
/*    rgc_do_blit ...                                                  */
/*---------------------------------------------------------------------*/
static int
rgc_do_blit( obj_t p, char *s, int o, int l ) {
   RGC_START_MATCH( p );

   while( ((INPUT_PORT( p ).abufsiz - INPUT_PORT( p ).matchstart) <= l)
	  && !(INPUT_PORT( p ).eof) ) {
      INPUT_PORT( p ).forward = INPUT_PORT( p ).abufsiz;
      rgc_fill_buffer( p );
   }

   if( (INPUT_PORT( p ).abufsiz - INPUT_PORT( p ).matchstart) <= l )
      l = (INPUT_PORT( p ).abufsiz - INPUT_PORT( p ).matchstart - 1);

   INPUT_PORT( p ).forward = INPUT_PORT( p ).matchstart + l;
   RGC_STOP_MATCH( p );
   RGC_SET_FILEPOS( p );
   bcopy( &RGC_BUFFER( p )[ INPUT_PORT( p ).matchstart ], &s[ o ], l );
   
   return l;
}
   
/*---------------------------------------------------------------------*/
/*    int                                                              */
/*    rgc_blit_string ...                                              */
/*---------------------------------------------------------------------*/
int
rgc_blit_string( obj_t p, obj_t bs, int o, int l ) {
   char *s = BSTRING_TO_STRING( bs );
   int bsz = INPUT_PORT( p ).bufsiz;

   if( bsz == 2 ) {
      /* we are reading from a non bufferized port, we have to read */
      /* each character at a time. */
      int i;

      for( i = 0; i < l; i++ ) {
	 char c;
	 RGC_START_MATCH( p );
	 if( !(c = RGC_BUFFER_GET_CHAR( p )) ) {
	    rgc_fill_buffer( p );
	    c = RGC_BUFFER_GET_CHAR( p );
	 }
	 RGC_STOP_MATCH( p );
	 s[ o + i ] = c;
      }
      s[ o + i ] = 0;

      return l;
   } else {
      /* we are reading characters from a bufferized port we can */
      /* read all the characters at a time. */
      if( l <= bsz ) {
	 return rgc_do_blit( p, s, o, l );
      } else {
	 int r = 0;
	 while( l > bsz ) {
	    r += rgc_do_blit( p, s, o, bsz );
	    o += bsz;
	    l -= bsz;
	 }
	 r += rgc_do_blit( p, s, o, l );
      
	 return r;
      }
   }
}
