/*=====================================================================*/
/*    serrano/prgm/project/bigloo/runtime/Clib/cerror.c                */
/*    -------------------------------------------------------------    */
/*    Author      :  Manuel Serrano                                    */
/*    Creation    :  Fri Jul 17 09:58:06 1992                          */
/*    Last change :  Tue May 13 10:29:41 2003 (serrano)                */
/*    Copyright   :  2002-03 Manuel Serrano                            */
/*    -------------------------------------------------------------    */
/*    Error messages                                                   */
/*=====================================================================*/
#include <bigloo.h>

/*---------------------------------------------------------------------*/
/*    Les recuperations externes                                       */
/*---------------------------------------------------------------------*/
#ifndef _MSC_VER
extern void perror();
extern char *strerror( int );
extern void exit( int );
extern int errno;
#endif

/*---------------------------------------------------------------------*/
/*    c_error ...                                                      */
/*---------------------------------------------------------------------*/
void
c_error( char *mes1, char *mes2, int err_no )
{
   fflush( stderr );
   if( errno )
      fprintf( stderr,
	       "*** INTERNAL ERROR(%s): %s -- %s\n",
	       strerror( errno ),mes1, mes2 );
   else
      fprintf( stderr, "*** INTERNAL ERROR: %s -- %s\n", mes1, mes2 );
   exit( err_no );
}

/*---------------------------------------------------------------------*/
/*    char *                                                           */
/*    c_typeof ...                                                     */
/*    -------------------------------------------------------------    */
/*    This function is only used for debugging purposes. It takes      */
/*    a Bigloo object as argument and try to find out a C string       */
/*    representation of its type. (This function is intended to        */
/*    be used under GDB or so.)                                        */
/*---------------------------------------------------------------------*/
char *
c_typeof( obj_t obj ) {
   if( INTEGERP( obj ) ) return "bint";
   if( REALP( obj ) ) return "breal";
   if( STRINGP( obj ) ) return "bstring";
   if( SYMBOLP( obj ) ) return "symbol";
   if( KEYWORDP( obj ) ) return "keyword";
   if( CHARP( obj ) ) return "bchar";
   if( BOOLEANP( obj ) ) return "bbool";
   if( NULLP( obj ) ) return "bnil";
   if( EXTENDED_PAIRP( obj ) ) return "epair";
   if( PAIRP( obj ) ) return "pair";
   if( VECTORP( obj ) ) return "vector";
   if( TVECTORP( obj ) ) return "tvector";
   if( STRUCTP( obj ) ) return "struct";
   if( PROCEDUREP( obj ) ) return "procedure";
   if( INPUT_PORTP( obj ) ) return "input-port";
   if( OUTPUT_PORTP( obj ) ) return "output-port";
   if( BINARY_PORTP( obj ) ) return "binary-port";
   if( CELLP( obj ) ) return "cell";
   if( CNSTP( obj ) ) return "bcnst";
   if( SOCKETP( obj ) ) return "socket";
   if( PROCESSP( obj ) ) return "process";
   if( CUSTOMP( obj ) ) return "custom";
   if( OPAQUEP( obj ) ) return "opaque";
   if( UCS2_STRINGP( obj ) ) return "ucs2_string";
   if( UCS2P( obj ) ) return "ucs2";
   			   
   if( BGL_OBJECTP( obj ) ) return "object";

   return "_";
}
